On October, 13th, 2016, Kevin Savetz uploaded scans of the source code for Atari PILOT to archive.org. They were provided to him by the author, Harry Stewart, and here’s a reasonably accurate transcription.
.TITLE "PILOT -- H.B. STEWART"
;
; PILOT PROGRAM EQUATE FILE
;
; EDIT #59-- 1 DECEMBER-80
;
0000 DEBUG=0 ; INCLUDE DEBUG CODE IF 1, DON'T IF 0.
; COLLEEN SYSTEM I/O
E456 CIO = $E456
E400 IOVBAS = $E400 ; COLLEEN VECTOR BASE ADDRESS
E406 EPUTC = $E406 ; "E:" PUT CHARACTER.
E414 SGETC = $E414 ; "S:" GET CHARACTER.
E416 SPUTC = $E416 ; "S:" PUT CHARACTER.
E41A SSPEC = $E41A ; "S:" SPECIAL.
0010 IOCBSZ = 16 ; # OF BYTES PER IOCB.
0000 IOCB0 = $00 ; CONSOLE INPUT/OUTPUT
0010 IOCB1 = IOCB0+IOCBSZ ; (UNUSED).
0020 IOCB2 = IOCB1+IOCBSZ ; GRAPHICS INPUT & OUTPUT
0030 IOCB3 = IOCB2+IOCBSZ ; LOAD & SAVE I/O.
0040 IOCB4 = IOCB3+IOCBSZ ; IN: & OUT: USE IOCB4 THRU IOCB7.
0070 IOCB7 = 3*IOCBSZ+IOCB4
0340 ICHID = $0340 ; IOCB HANDLER I. D.
0341 ICDNO = ICHID+1 ; DEVICE #.
0342 ICCOM = ICDNO+1 ; COMMAND BYTE.
0343 ICSTA = ICCOM+1 ; STATUS BYTE.
0344 ICBAL = ICSTA+1 ; BUFFER ADDRESS (LO).
0345 ICBAH = ICBAL+1 ; BUFFER ADDRESS (HI)
0346 ICRLL = ICBAH+1 ; RECORD LENGTH (LO).
0347 ICRLH = ICRLL+1 ; RECORD LENGTH (HI).
0348 ICBLL = ICRLH+1 ; BUFFER LENGTH (LO).
0349 ICBLH = ICBLL+1 ; BUFFER LENGTH (HI).
034A ICAUX1 = ICBLH+1 ; AUX1.
034B ICAUX2 = ICAUX1+1 ; AUX2.
0022 ICCOMZ = $0022 ; ZERO PAGE IOCB COMMAND BYTE.
0003 OPEN = $03 ; OPEN COMMAND.
000C CLOSE = $0C ; CLOSE COMMAND.
0007 GETC = $07 ; GET CHARACTER COMMAND.
000B PUTC = $0B ; PUT CHARACTER COMMAND.
0005 GETR = $05 ; GET RECORD COMMAND.
0009 PUTR = $09 ; PUT RECORD COMMAND.
0011 DRAW = $11 ; DRAW LINE. SPECIAL COMMAND.
0012 FILL = $12 ; FILL SPECIAL COMMAND.
0004 OREAD = $04 ; OPEN DIRECTION.
0008 OWRIT = $08 ; OPEN DIRECTION.
0010 SPLIT = $10 ; SPLIT SCREEN OPTION.
0020 NOCLR = $20 ; INHIBIT SCREEN CLEAR OPTION.
001C CUP = $1C ; CURSOR UP.
001D CDOWN = $1D ; CURSOR DOWN.
001E CLEFT = $1E ; CURSOR LEFT.
001F CRIGHT = $1F ; CURSOR RIGHT.
009B EOL = $9B ; ATASCII END OF LINE
007D CLEAR = $7D ; MONITOR CLEAR SCREEN
00FD BELL = $FD ; BELL CODE
; COLLEEN DATA BASE
02E7 MEMLO = $02E7 ; LOWEST AVAILABLE RAM [WORD].
02E5 MEMHI = $02E5 ; HIGHEST AVAILABLE RAM [WORD].
000E APPMHI = $000E ; APPLICATION MEM HI [WORD].
0011 BREAK = $0011 ; BREAK KEY FLAG
02FC CH = $02FC ; KEYBOARD MATRIX CODE INPUT
02F0 CRSINH = $02F0 ; CURSOR INHIBIT FLAG.
02FE DSPFLG = $02FE ; CONTROL BYTE DISPLAY FLAG.
0232 SSKCTL = $0232
0012 RTCLOK = $0012 ; 60 HZ CLOCK
0052 LMARGN = $0052 ; SCREEN LEFT MARGIN.
0053 RMARGN = $0053 ; SCREEN RIGHT MARGIN.
0055 COLCRS = $0055 ; SCREEN COLUMN [WORD].
0054 ROWCRS = $0054 ; SCREEN ROW [BYTE].
005B OLDCOL = $005B ; OLD SCREEN COLUMN.
005A OLDROW = $005A ; OLD SCREEN ROW.
02FB ATACHR = $02FB ; LAST ATASCII CHARACTER OR PLOT POINT
02FD FILDAT = $02FD ; FILL DATA.
0008 WARMST = $0008 ; WARMSTART FLAG (0 IF POWERUP)
000A DOSVEC = $000A ; DOS START VECTOR.
E471 BYELOC = $E471 ; BLACK BOARD ENTRY POINT
02C4 COLOR0 = $02C4 ; COLOR REGISTER 0 VALUE.
0270 PADDL0 = $0270 ; PADDLE CONTROLLER 0.
0278 STICK0 = $0278 ; JOYSTICK 0.
027C PTRIG0 = $027C ; PADDLE TRIGGER 0
0284 STRIG0 = $0284 ; JOYSTICK TRIGGER 0.
0234 LPENH = $0234 ; LIGHTPEN HORIZONTAL POSITION.
0235 LPENV = $0235 ; LIGHTPEN VERTICAL POSITION.
0291 TXTCOL = $0291 ; SPLIT SCREEN TEXT COLUMN
02B6 INVFLG = $02B6 ; INVERSE VIDEO FLAG FOR KEYBOARD.
; PILOT ERROR CODES
0080 NS = $80 ; "NOT A SYNTAX ERROR" FLAG.
0001 RDYTXT = 1 ; READY.
0081 EOPERR = 1+NS ; END OF PROGRAM STORAGE REACHED DURING RUN
0081 AUTOXT = 1+NS ; EXIT AUTO-INPUT MODE.
0002 CNDERR = 2 ; CONDITION FIELD ERROR (':' EXPECTED)
0002 NSTERR = 2 ; GRAPHICS SUB-COMMAND NESTING ERROR.
0081 ENDERR = 1+NS ; USE STACK EMPTY ON END COMMAND.
0002 JNKERR = 2 ; JUNK AT END OF STATEMENT.
0086 IOERR = 6+NS ; I/O ERROR.
0002 IVCERR = 2 ; INVALID COMMAND.
0002 ATMERR = 2 ; INVALID ATOM SYNTAX.
0002 IMPERR = 2 ; IMPROPER COMMAND PARAMETER.
0089 INSERR = 9+NS ; INSUFFICIENT STORAGE FOR OPERATION.
0087 ABTERR = 7+NS ; OPERATOR ABORT.
000A UNDERR = 10 ; UNDEFINED LABEL OPERAND
008B USOERR = 11+NS ; USE STACK OVERFLOW.
0002 EXPERR = 2 ; EXPRESSION ERROR.
008C INTERR = 12+NS ; INTERNAL BUG ERROR.
008D LNOERR = 13+NS ; LINE # OUT OF RANGE.
; 14 IS RESERVED.
000F OLLERR = 15 ; OVERLENGTH INPUT LINE
; 16-21 ARE RESERVED.
0096 FILERR = 22+NS ; TO MANY IN/OUTS
0017 SIGNON = 23 ; POWER-UP SIGN-ON MESSAGE
0018 TRCMES = 24 ; TRACE PREAMBLE
; 8 RESERVED
0083 NRCERR = 3+NS ; NOT RUN MODE COMMAND. IMMEDIATE ONLY
0084 DIVERR = 4+NS ; DIVIDE BY ZERO
0085 SCNERR = 5+NS ; SCREEN MODE CONFLICT
; ATOM IDENTIFIER CODES (PRODUCED BY 'ATOM')
0001 NULL = 1 ; NULL ATOM.
0002 NUM = 2 ; NUMERIC CONSTANT.
0004 NVAR = 4 ; NUMERIC VARIABLE OR POINTER TO WORD.
0008 SVAR = 8 ; STRING VARIABLE.
0010 USVAR = 16 ; UNDEFINED STRING VARIABLE.
0020 TEXT = 32 ; TEXT.
0040 OPR = 64 ; OPERATOR.
0080 BPTR = 128 ; POINTER TO BYTE
; EDGE DETECT STATUS BITS
0008 ELEFT = 8 ; LEFT EDGE.
0004 ERIGHT = 4 ; RIGHT EDGE.
0002 EBOTOM = 2 ; BOTTOM EDGE.
0001 ETOP = 1 ; TOP EDGE
; PILOT CONFIGURATION PARAMETERS.
0010 USTKSZ = 16 ; 8 LEVELS IN USE STACK.
0002 ELEVEL = 2 ; # OF EXPRESSION STACK () LEVELS.
000E ESTKSZ = 4*ELEVEL+6 ; EXPRESSION STACK SIZE.
00FE ACCLNG = 254 ; ACCEPT BUFFER LENGTH.
00FE TEXLNG = 254 ; TEXT EXPRESSION BUFFER LENGTH.
007A LINLNG = 122 ; COMMAND/ACCEPT INPUT LINE LENGTH.
270F MAXLN = 9999 ; MAXIMUM PROGRAM LINE NUMBER.
0004 AUREGS = 4 ; 4 AUDIO REGISTERS.
0007 SCNMOD = 7 ; 4 COLOR, 160 * 96.
000F DNSIZE = 15 ; DEVICE/FILENAME MAXIMUM LENGTH.
0050 XC = 80 ; GRAPHICS SCREEN CENTER X AXIS.
0030 YC = 48 ; GRAPHICS SCREEN CENTER Y AXIS.
0028 TCOL = 40 ; TEXT SCREEN # OF COLUMNS.
0018 TROW = 24 ; TEXT SCREEN # OF ROWS.
; COLLEEN HARDWARE EQUATES
D200 AUDF1 = $D200 ; AUDIO #1 FREQUENCY DIVIDER
D201 AUDC1 = AUDF1+1 ; AUDIO #1 TYPE/VOLUME.
D20F SKCTL = $D20F ; SERIAL PORT CONTROL
D20F SKSTAT = $D20F ; SERIAL PORT STATUS.
D208 AUDCTL = $D208 ; AUDIO CONTROL REGISTER.
D302 PACTL = $D302 ; PIA CASSETTE CONTROL.
00B4 CASSON = $34+$80 ; CASSETTE ON.
00BC CASSOF = $3C+$80 ; CASSETTE OFF.
D20A PKYRND = $D20A ; POKEY RANDOM NUMBER.
; MISCELLANEOUS
0004 PCUP = 4 ; PEN COLOR = 'UP'.
;
; PILOT DATA BASE
;
*=$0080
0080 DTAB =* ; BASE ADDRESS FOR DXXXI UTILITIES & OTHERS
0080 INLN *=*+4 ; INPUT LINE POINTER.
0084 NXTLN *=*+2 ; NEXT LINE POINTER (RUN MODE).
0086 ACOLR2 *=*+1 ; AUTO-NUMBER COLOR REGISTER 2.
0087 ACOLR1 *=*+1 ; AUTO-NUMBER COLOR REGISTER 1.
0088 ACLN *=*+4 ; ACCEPT LINE POINTER.
008C TELN *=*+4 ; TEXT EXPRESSION RESULT POINTER
0090 USTKP *=*+1 ; USE STACK POINTER (0 - N*2).
0091 ESTKP *=*+1 ; EXPRESSION STACK POINTER.
0092 EXEC *=*+1 ; 0 = SYNTAX CHECK, ELSE EXECUTE (FOR X-ROUTINES)
0093 EXPSTK *=*+ESTKSZ ; EXPRESSION STACK.
00A1 TEMP *=*+6 ; TEMPORARY STORAGE FOR BOTTOM LEVEL ROUTINES.
00A7 TEMP2 *=*+4 ; MORE TEMPORARY STORAGE.
00AB XTEMP *=*+3 ; TEMPORARY STORAGE FOR X-ROUTINES.
00AE S1L *=*+2 ; DYNAMIC STORAGE AREA LIMITS.
00B0 S1H *=*+2
00B2 S2L *=*+2
00B4 S2H *=*+2
00B6 POINT *=*+2 ; 'ATOM' RETURN PARAMETER & 'PSF' WORK POINTER.
00B8 NUMBER *=*+2 ; 'ATOM' RETURN PARAMETER & 'PSTOP' ERROR # SAVE
00BA LP *=*+4 ; STRING PACKAGE LIST POINTER.
00BE NP *=*+4 ; NAME POINTER.
00C2 DP *=*+4 ; DATA POINTER.
00C6 MP *=*+4 ; PATTERN MATCH POINTER
00CA SP *=*+4 ; SOURCE POINTER (BOTTOM LEVEL).
00CE PP *=*+4 ; PATTERN POINTER (BOTTOM LEVEL)
00D2 MEMA *=*+2 ; MEMORY MANAGEMENT ADDRESS PARAMETER.
00D4 MEMB *=*+2 ; BYTE COUNT PARAMETER.
00D6 MSP *=*+2 ; SOURCE POINTER.
00D8 MDP *=*+2 ; DESTINATION POINTER
00DA MBC *=*+2 ; WORKING BYTE COUNT.
00DC LINENO *=*+2 ; STATEMENT LINE # (MUST BE IN ZERO PAGE).
00DE LS *=*+2 ; 'XLIST' START LINE #, 'XGRAPH' ITERATION COUNT & 'SCNDEV'
00E0 LE *=*+2 ; 'XLIST' END LINE #, 'GMOVE' REGISTER SAVE & 'SCNDEV'.
00E2 MFDEL ; MATCH FIELD DELIMITER ',' OR '|'
00E2 ACC *=*+2 ; WORKING NUMERIC ACCUMULATOR
00E4 IOSTAT *=*+2 ; COLLEEN I/O ERROR STATUS [WORD].
00E6 GXNEW *=*+3 ; GRAPHICS NEXT POSITION (LSB,MSB,FRACTION).
00E9 GYNEW *=*+3 ;
00EC GX *=*+3 ; GRAPHICS X POSITION (LSB,MSB,FRACTION).
00EF GY *=*+3 ; GRAPHICS Y POSITION (LSB,MSB,FRACTION).
00F2 THETA *=*+2 ; POLAR ANGLE.
00F4 GNUMB *=*+4 ; GRAPHICS WORKING STORAGE. & 'XACCPT' TEMPORARY
00F8 XXXX *=*+1 ; 'SCNDEV' & 'PSTOP' USE.
00F9 ALINE *=*+2 ; AUTO-INPUT & RENUMBER LINE NUMBER.
00FB AINC *=*+2 ; AUTO-INPUT & RENUMBER LINE INCREMENT
00FD MATCHF *=*+1 ; MATCH RESULT [0 = FALSE, ELSE MATCH FIELD #]
00FE EXECF *=*+1 ; CONDITION RESULT [0 = NO EXECUTE, ELSE EXECUTE]
00FF RUN *=*+1 ; 0 = IMMEDIATE MODE, ELSE RUN MODE
; REDEFINES OF STRING & MEM ???? VARIABLES FOR GRAPHICS USE
00BE GX1 = NP ; WORKING X [3 BYTES]
00C1 GY1 = GX1+3 ; Y [3 BYTES]
00C4 GX2 = GY1+3 ; X [3 BYTES]
00C7 GY2 = GX2+3 ; Y [3 BYTES]
00CA DELX = GY2+3 ; DELTA X [2 BYTES]
00CC DELY = DELX+2 ; Y [2 BYTES]
00CE GACC = DELY+2 ; WORKING ACCUMULATOR [4 BYTES]
00D2 GTEMP = GACC+4 ; TEMP [4 BYTES]
00D6 GTEMP2 = GTEMP+4 ; TEMP [4 BYTES]
*=$0500
0500 IOEDIS *=*+2 ; I/O ERROR STOP DISABLE
; EXTRA BYTE TO PROTECT AGAINST WORD POKE
0502 XJUMP *=*+3 ; FIRST BYTE = JMP COMMAND (X-ROUTINES)
0505 GJUMP *=*+3 ; FIRST BYTE = JMP COMMAWD (G-ROUTINES)
0508 SJUMP *=*+3 ; FIRST BYTE = JMP COMMAND ('SOP')
050B USESTK *=*+USTKSZ ; USE STACK.
051B VARTAB *=*+52 ; VARIABLE TABLE (26 ENTRIES FOR A-Z).
054F CTABXR *=*+2 ; COMMAND TABLE INDEX ('CMATCH' RETURN ARG).
; (FIRST BYTE IS UNUSED.)
0551 DIGIT *=*+1
0552 SAVYR *=*+1 ; 'MLOOP' SAVE Y REGISTER.
0553 PEN *=*+1 ; GRAPHICS PEN SELECT
0554 GRFLAG *=*+1 ; GRAPHICS MODE FLAG (0=NOT GRAPHICS, ELSE GRAPHICS).
0555 AUDIOR *=*+AUREGS+AUREGS ; AUDIO VARIABLE POINTERS
055D AUX1 *=*+1 ; I/O AUX1 OVERRIDE BYTE
055E AUX2 *=*+1 ; I/O AUX2 OVERRIDE BYTE.
*=*+1 ; 'OPNBUF'-1 USED BY 'SCNDEV'
0560 OPNBUF *=*+DNSIZE+1 ; DEVICE NAME BUFFER FOR OPEN
0570 CDEST *=*+2 ; 'CHOT' DESTINATION IDENTIFIER & SAVE BYTE
0572 LOADFG *=*+1 ; 0 IF NOT LOADING, ELSE LOADING
0573 MATCHX *=*+2 ; 'XMATCH' FIELD INDEX VALUES
0575 TRACE *=*+1 ; RUN-TIME TRACE FLAG (TRACE IF <> 0)
0576 AUTOIN *=*+1 ; AUTO-INPUT FLAG (ACTIVE IF <> 0)
0577 TEXBUF *=*+TEXLNG+1 ; TEXT EXPRESSION BUFFFR
0676 COMBUF *=*+LINLNG+1 ; COMMAND INPUT BUFFER.
06F1 GSMODE *=*+1 ; GRAPHICS SCREEN MODE
000E SPARES = $700-* ; *** THIS HAD BETTER BE POSITIVE ***
; NOTE: ALL SOURCE LINES OF THE FORM SHOWN BELOW ARE REDUNDANT. THE
; LINE IS LEFT THERE TO SHOW THE ASSUMPTION. THE LINE WOULD NORMALLY
; BE ASSEMBLED EXCEPT FOR THIS DAMN REQUIREMENT TO SCRUNCH THE CODE :
;
; *S* LDA #0 ; COMMENT
;
; NOTE: THE USE OF THE TERM '(BRA)' IN A COMMENT INDICATES THAT THE
; PARTICULAR BRANCH INSTRUCTIONS USED WILL ALWAYS BRANCH IN THE
; PARTICULAR CIRCUMSTANCES. THE BRANCH IS SUPPOSED TO BE A TWO BYTE
; JUMP
; POWER-UP ROUTINE AND INITIALIZATION
.IF DEBUG
*=$9800 ; CHECK CONTENT OF $9FFC: MUST NOT BE 00
.ENDIF
.IF DEBUG-1
*=$A000 ; CARTRIDGE BODY
.ENDIF
A000 A9 06 INIT LDA #EPUTC-IOVBAS ; ESTABLISH CHOT DESTINATION AS E
A002 8D 70 05 STA CDEST
A005 A5 08 LDA WARMST ; WARM START?
A007 D0 40 BNE INI015 ; YES
A009 A2 80 LDX #$80 ; NO -- CLEAR UPPER HALF OF PAGE ZERO
; *S* LDA #0
A00B 95 00 INI010 STA 0,X
A00D E8 INX
A00E D0 FB BNE INI010 ; CONTINUE TILL PAGE WRAP POINT
A010 A9 4C LDA #$4C ; PUT JMP OP-CODE IN JUMP VECTORS
A012 8D 02 05 STA XJUMP+0
A015 8D 05 05 STA GJUMP+0
A018 8D 08 05 STA SJUMP+0
A01B A9 16 LDA #$16 ; AUTO-NUMBER SCREEN = DARK YELLOW
A01D 85 86 STA ACOLR2
; *S* LDA #$00 ; AUTO-NUMBER LETTERS = BLACK
; *S* STA ACOLR1
A01F A9 17 LDA #SIGNON ; GENERATE SIGN-ON MESSAGE
A021 20 12 BF JSR MESSOT
A024 AD E7 02 LDA MEMLO ; ESTABLISH MEMORY LIMITS FOR ALLOCATION
A027 85 88 STA ACLN ; ACCEPT BUFFER
A029 85 AE STA S1L ; PROGRAM STORAGE AREA
A02B AD E8 02 LDA MEMLO+1
A02E 85 89 STA ACLN+1
A030 18 CLC
A031 69 01 ADC #1 ; NEXT PAGE
A033 85 AF STA S1L+1
A035 20 FF A9 JSR CLRPRG
A038 AD E5 02 LDA MEMHI
A03B 85 B4 STA S2H
A03D 85 B2 STA S2L
A03F AD E6 02 LDA MEMHI+1
A042 85 B5 STA S2H+1
A044 85 B3 STA S2L+1
A046 20 3B B8 JSR ZERVAR ; ZERO THE NUMERIC VARIABLES
A049 A9 00 INI015 LDA #0 ; ZERO ...
A04B 8D 54 05 STA GRFLAG ; ... GRAPHICS SCREEN FLAG ...
A04E 8D 72 05 STA LOADFG ; ... LOAD FLAG ...
A051 8D 75 05 STA TRACE ; ... TRACE FLAG ...
A054 8D 76 05 STA AUTOIN ; ... AUTO-INPUT FLAG ...
A057 8D 5D 05 STA AUX1 ; ... I/O AUX1 ...
A05A 8D 5E 05 STA AUX2 ; ... I/O AUX2 ...
A05D 85 FD STA MATCHF ; ... & MATCH RESULT
A05F A9 07 LDA #SCNMOD ; SETUP DEFAULT GRAPHICS SCREEN MODE
A061 8D F1 06 STA GSMODE
A064 20 2F B8 JSR NULACC ; SET ACCEPT BUFFER TO NULL
A067 A9 77 LDA #TEXBUF
A069 85 8C STA TELN
A06B A9 05 LDA #TEXBUF/256
A06D 85 8D STA TELN+1
A06F 20 54 B2 JSR REMDEV ; REMOVE DEVICE ASSIGNMENTS FROM STRING LIST
A072 20 7F BA JSR GEX050 ; RECAPTURE GRAPHICS REGION IF NECESSARY
A075 4C 33 BF JMP RDYMES ; GENERATE "READY" MESSAGE & RETURN
;
; MAIN LOOP FOR PILOT INTERPRETER.
;
A078 A2 FF MLE LDX #$FF ; INITIALIZE STACK POINTER
A07A 9A TXS
A07B 20 00 A0 JSR INIT ; INITIALIZE REST OF ENVIRONMENT
; *** EXTERNAL ENTRY POINT ***
A07E A9 00 MLRES LDA #0 ; RESET ...
A080 85 FF STA RUN ; ... RUN FLAG ...
A082 8D FE 02 STA DSPFLG ; ... DISPLAY FLAG ...
A085 8D B6 02 STA INVFLG ; ... INVERT VIDEO FLAG ...
A088 8D 00 05 STA IOEDIS ; ... & ERROR STOP DISABLE FLAG
A08B A9 DC LDA #XTYPE ; MAKE COMMAND - *T
A08D 8D 03 05 STA XJUMP+1
A090 A9 A6 LDA #XTYPE/256
A092 8D 04 05 STA XJUMP+2
A095 85 FE STA EXECF ; CONDITION FLAG = TRUE
A097 A9 BC LDA #CASSOF ; CASSETTE MOTOR OFF
A099 8D 02 D3 STA PACTL
A09C 20 72 B8 JSR AUDCLR ; CLEAR AUDIO REGISTERS
; *** EXTERNAL ENTRY POINT ***
A09F A9 76 MLLOAD LDA #COMBUF ; RE-ESTABLISH CONSOLE BUFFER INPUT
A0A1 85 80 STA INLN
A0A3 A9 06 LDA #COMBUF/256
A0A5 85 81 STA INLN+1
A0A7 20 C8 BE MLOOP JSR TONES ; GENERATE AUDIO
A0AA 20 1D A2 JSR GETCOM ; GET A COMMAND INPUT
A0AD D0 3A BNE ML0089 ; ERROR (SKIP BRANCH).
; NOTE: THE Y REGISTER IS ASSUMED TO CONTAIN THE INDEX TO 'INLN'
; THROUGHOUT THIS ROUTINE. ALL CALLED ROUTINES WILL BE
; RESPONSIBLE FOR MAINTAINING ITS INTEGRITY.
A0AF AD 76 05 LDA AUTOIN ; AUTO-INPUT MODE?
A0B2 D0 3A BNE ML0100 ; YES
A0B4 20 C1 B7 JSR SCNLBL ; SCAN OVER LABEL IF PRESENT
A0B7 F0 07 BEQ ML0030 ; YES -- SAW A VALID LABEL
A0B9 B1 80 LDA (INLN),Y ; CHECK FOR LINE NUMBER
A0BB 20 7A B7 JSR CNUMBR
A0BE 90 39 BCC ML0110 ; YES -- EDIT MODE
A0C0 84 82 ML0030 STY INLN+2 ; SAVE INDEX TO SOURCE CODE
A0C2 A5 FF LDA RUN ; SEE IF RUN OR IMEDIATE MODE.
A0C4 D0 0D BNE ML0080 ; RUN MODE -- NO NEED TO SYNTAX CHECK
; UN-NUMBERED LINE -- IMMEDIATE EXECUTION
A0C6 A2 00 LDX #CTABI-CTAB ; SETUP FOR IMMEDIATE MODE COMMANDS
A0C8 20 A6 A2 JSR SYCMND ; IMMEDIATE MODE -- SYNTAX CHECK CODE
A0CB D0 1C BNE ML0089 ; ERROR -- DON'T EXECUTE THE COMMAND
A0CD A4 82 LDY INLN+2 ; RESTORE SOURCE CODE POINTER
A0CF A2 00 LDX #CTABI-CTAB ; SETUP FOR IMMEDIATE MODE COMMANDS
A0D1 F0 13 BEQ ML0085 ; *S* (BRA).
A0D3 AD 75 05 ML0080 LDA TRACE ; TRACE EXECUTION?
A0D6 F0 0C BEQ ML0082 ; NO
A0D8 A9 18 LDA #TRCMES ; YES -- PRINT TRACE LINE HEADER
A0DA 20 12 BF JSR MESSOT
A0DD A0 00 LDY #INLN-DTAB ; PRINT SOURCE STATEMENT
A0DF 20 09 B8 JSR PSF
A0E2 A4 82 LDY INLN+2
A0E4 A2 1F ML0082 LDX #CTABR-CTAB ; SETUP FOR RUN MODE COMMANDS
A0E6 20 AA A2 ML0085 JSR EXCMND ; EXECUTE THE COMMAND.
A0E9 D0 50 ML0089 BNE ML0155 ; RUN-TIME ERROR (SKIP BRANCH POINT)
A0EB 4C A7 A0 JMP MLOOP ; GET NEXT COMMAND
; AUTO-INPUT MODE -- SUPPLY THE LINE NUMBER.
A0EE A5 F9 ML0100 LDA ALINE ; SUPPLY THE LINE NUMBER.
A0F0 85 B8 STA NUMBER
A0F2 A5 FA LDA ALINE+1
A0F4 85 B9 STA NUMBER+1
A0F6 4C FC A0 JMP ML0112
; NUMBERED LINE INPUT -- EDIT MODE.
A0F9 20 E8 A4 ML0110 JSR ATOM ; CONVERT LINE NUMBER TO BINARY IN 'NUMBER'
A0FC 20 FA B7 ML0112 JSR SLB ; SKIP BLANKS BETWEEN LINE # & STATEMENT.
A0FF 84 82 STY INLN+2 ; SAVE INPUT LINE POINTER
A101 A2 38 LDX #NUMBER-DTAB
A103 20 63 AF JSR CHKLN ; CHECK LINE # FOR RANGE.
A106 B0 61 BCS ML0200 ; OUT OF RANGE.
A108 A9 00 LDA #0 ; CLEAR USE STACK ON INSERT/DELETE
A10A 85 90 STA USTKP
A10C A5 B9 LDA NUMBER+1 ; SAVE LINE NUMBER
A10E 85 DC STA LINENO ; ... IN INVERTED FORM (STRING NAME)
A110 A5 B8 LDA NUMBER
A112 85 DD STA LINENO+1
A114 A4 82 LDY INLN+2 ; RESTORE INPUT LINE INDEX
A116 20 C1 B7 JSR SCNLBL ; SKIP OVER LABEL IF PRESENT.
A119 F0 19 BEQ ML0150 ; LABEL FOUND.
A11B B1 80 LDA (INLN),Y ; CHECK FOR NULL STATEMENT.
A11D C9 9B CMP #EOL
A11F D0 13 BNE ML0150 ; NON-NULL -- STATEMENT IS TO BE ENTERED.
A121 AD 76 05 LDA AUTOIN ; AUTO-INPUT MODE?
A124 F0 08 BEQ ML0140 ; NO
A126 20 59 A1 JSR LVAUTO ; LEAVE AUTO-INPUT MODE
A129 A9 81 LDA #AUTOXT ; GENERATE MESSAGE AS WE LEAVE
A12B 4C E9 A1 JMP ML0985
A12E 20 06 A2 ML0140 JSR LDELET ; YES -- DELETE NUMBERED LINE.
A131 4C A7 A0 JMP MLOOP
A134 A4 82 ML0150 LDY INLN+2 ; RESTORE INPUT LINE POINTER.
A136 A2 00 LDX #CTABI-CTAB ; SETUP FOR RUN MODE COMMANDS.
A138 20 A6 A2 JSR SYCMND ; SYNTAX CHECK THE STATEMENT.
A13B D0 2F ML0155 BNE ML0900 ; SYNTAX ERROR (SKIP BRANCH POINT).
A13D AD 50 05 LDA CTABXR+1 ; SEE IF COMMAND FOUND IS IMMEDIATE ONLY.
A140 C9 1F CMP #CTABR-CTAB
A142 B0 04 BCS ML0160 ; NO.
A144 A9 83 LDA #NRCERR ; YES -- ERROR.
A146 D0 24 BNE ML0900 ; (BRA).
A148 A4 82 ML0160 LDY INLN+2 ; RESTORE INPUT LINE POINTER.
A14A 20 F2 A1 JSR LINSRT ; INSERT THE NEW LINE.
A14D D0 1D BNE ML0900 ; NO ROOM FOR NEW LINE.
A14F A2 79 LDX #ALINE-DTAB ; INCREMENT AUTO-INPUT LINE #.
A151 A0 7B LDY #AINC-DTAB ; (EVEN IF NOT IN AUTO-INPUT MODE).
A153 20 80 B5 JSR DADDI
A156 4C A7 A0 JMP MLOOP ; GET NEXT COMMAND.
A159 A2 00 LVAUTO LDX #0 ; RESET AUTO-INPUT MODE.
A15B 8E 76 05 STX AUTOIN
A15E A2 94 LDX #$94 ; RESTORE NORMAL SCREEN COLOR.
A160 8E C6 02 STX COLOR0+2
A163 A2 CA LDX #$CA
A165 8E C5 02 STX COLOR0+1
A168 60 PUP RTS ; *** ANY OLD 'RTS' WILL DO FOR 'PUP' ***
A169 20 59 A1 ML0200 JSR LVAUTO ; LEAVE AUTO-INPUT MODE & FALL INTO 'PSTOP'
; SYNTAX/RUN-TIME ERROR PROCESSOR
; *** EXTERNAL ENTRY POINT
; A = ERROR CODE
; Y = INDEX TO ERROR IN STATEMENT
A16C ML0900
A16C A2 FF PSTOP LDX #$FF ; RE-INIT STACK POINTER.
A16E 9A TXS
A16F 8E FE 02 STX DSPFLG ; SET DISPLAY FLAG.
A172 8C 52 05 STY SAVYR ; SAVE INDEX TO
A175 85 B8 STA NUMBER ; SAVE ERROR NUMBER
A177 A9 06 LDA #EPUTC-IOVBAS ; RE-ESTABLISH 'E:' AS 'CHOT' OUTPUT
A179 8D 70 05 STA CDEST
A17C 20 60 B8 JSR NEWLIN
A17F A5 FF LDA RUN ; IF IMMEDIATE ...
A181 05 83 ORA INLN+3 ; ... & EMPTY INPUT LINE ...
A183 F0 6A BEQ ML0990 ; ... THEN IGNORE ERROR (BREAK)
A185 A5 B8 LDA NUMBER
A187 C9 81 CMP #EOPERR ; SEE IF ERROR IS END OF PROGRAM.
A189 F0 5E BEQ ML0985 ; YES -- NO STATEMENT TO PRINT
A18B A8 TAY ; (SET CC)
A18C 30 11 BMI ML0947 ; YES -- NO HIGHLIGHTED CHARACTER.
A18E AC 52 05 LDY SAVYR ; HIGHLIGHT THE ERROR CHARACTER
A191 B1 80 LDA (INLN),Y
A193 85 F8 STA XXXX ; SAVE FOR LATER RESTORATION
A195 C9 9B CMP #EOL
A197 D0 02 BNE ML0945
A199 A9 20 LDA #' ; REPLACE EOL WITH BLANK.
A19B 49 80 ML0945 EOR #$80 ; INVERT COLOR.
A19D 91 80 STA (INLN),Y
A19F A5 FF ML0947 LDA RUN ; SEE IF RUN OR IMMEDIATE MODE.
A1A1 F0 08 BEQ ML0950 ; IMMEDIATE.
A1A3 A0 00 LDY #INLN-DTAB
A1A5 20 09 B8 JSR PSF ; RUN -- PRINT STORAGE FORMAT.
A1A8 4C B2 A1 JMP ML0960
A1AB ML0950
; *S* LDA #0 ; *** OR DON'T USE 'INLN'+2 AS TEMP STORE ***
A1AB 85 82 STA INLN+2
A1AD A2 00 LDX #INLN-DTAB ; IMMEDIATE -- PRINT INPUT LINE.
A1AF 20 53 B1 JSR PRTSTG
A1B2 A5 B8 ML0960 LDA NUMBER ; WAS THERE A HIGHLIGHTED CHARACTER?
A1B4 30 0E BMI ML0963 ; NO.
A1B6 AC 52 05 LDY SAVYR ; RESTORE ORIGINAL CHARACTER.
A1B9 A5 F8 LDA XXXX
A1BB 91 80 STA (INLN),Y
A1BD C9 9B CMP #EOL ; WAS IT THE EOL
A1BF D0 03 BNE ML0963 ; NO.
A1C1 20 6F AF JSR CHOT ; YES -- DO IT NOW.
A1C4 A9 08 ML0963 LDA #8 ; PREFIX MESSAGE WITH '***
A1C6 20 12 BF JSR MESSOT
A1C9 A5 B8 LDA NUMBER
A1CB C9 86 CMP #IOERR ; I/O ERROR?
A1CD D0 0A BNE ML0981 ; NO.
A1CF A4 E4 LDY IOSTAT ; YES -- BREAK?
A1D1 C0 80 CPY #128
A1D3 D0 04 BNE ML0981 ; NO.
A1D5 A9 87 LDA #ABTERR ; YES -- CHANGE ERROR CODE
A1D7 85 B8 STA NUMBER
A1D9 20 12 BF ML0981 JSR MESSOT ; GENERATE ERROR MESSAGE
A1DC A5 B8 LDA NUMBER
A1DE C9 86 CMP #IOERR ; I/O ERROR?
A1E0 D0 05 BNE ML0982 ; NO.
A1E2 A2 64 LDX #IOSTAT-DTAB ; YES -- PRINT ERROR STATUS.
A1E4 20 0B B7 JSR DECASC
A1E7 A9 08 ML0982 LDA #8 ; APPEND '***' TO END OF MESSAGE.
; *** EXTERNAL ENTRY POINT FROM 'MLOOP' ***
A1E9 20 12 BF ML0985 JSR MESSOT
A1EC 20 60 B8 JSR NEWLIN
A1EF 4C 7E A0 ML0990 JMP MLRES ; GET NEXT COMMAND.
; LINE INSERT AND DELETE ROUTINES
;
; LINSRT -- INSERT NUMBERED LINE TO STATEMENT LIST
;
; CALLING SEQUENCE:
;
; 'LINENO' = LINE # (BINARY)
; 'INLN' POINTS TO STATMENT TO INSERT
; X = INDEX TO FIRST BYTE OF STORAGE STATEMENT
;
; JSR LINSRT
; BNE NO ROOM IN MEMORY OR OTHER PROBLEM
;
A1F2 20 0C A2 LINSRT JSR NUMNAM ; SETUP 'LINENO' AS STRING NAME
A1F5 84 C4 STY DP+2 ; SETUP STRING DATA POINTER
A1F7 A5 80 LDA INLN
A1F9 85 C2 STA DP
A1FB A5 81 LDA INLN+1
A1FD 85 C3 STA DP+1
A1FF A5 83 LDA INLN+3
A201 85 C5 STA DP+3
A203 4C B8 B2 JMP SINSRT ; INSERT LINE & RETURN WITH CC SET
;
; LDELET -- NUMBERED LINE DELETE FROM STATEMENT LIST
;
; CALLING SEQUENCE:
;
; 'LINENO' = LINE # (BINARY)
;
; JSR LDELET
; BNE LINE NOT FOUND OR OTHER PROBLEM
;
A206 20 0C A2 LDELET JSR NUMNAM ; SETUP 'LINENO' AS STRING NAME
A209 4C 9F B2 JMP SDELET ; DELETE LINE & RETURN WITH CC SET
;
; NUMNAM -- SETUP 'LINENO' AS STRING NAME & SETUP ACCESS TO STATEMENT LIST
;
A20C A9 DC NUMNAM LDA #LINENO
A20E 85 BE STA NP
A210 A9 00 LDA #LINENO/256
A212 85 BF STA NP+1
; *S* LDA #0
A214 85 C0 STA NP+2
A216 A9 02 LDA #2
A218 85 C1 STA NP+3
A21A 4C 92 B7 JMP STMLST ; SETUP TO ACCESS STATEMENT LIST & RETURN
;
; GETCOM -- GET A COMMAND LINE FOR THE MAIN LOOP
;
; CALLING SEQUENCE.
;
; 'LOADFG' = 0 IF NOT LOADING FROM DEVICE, ELSE LOADING
; 'RUN' = 0 IF IMMEDIATE MODE, ELSE RUN MODE.
; 'NXTLN' POINTS TO NEXT RUN MODE LINE
;
; JSR GETCOM
; BNE ERROR (A = ERROR NUMBER)
;
; 'INLN' POINTS TO NEW COMMAND LINE.
; Y = INDEX TO START OF STATEMENT.
; 'NXTLN' POINTS TO NEXT RUN MODE LINE.
;
A21D AD 72 05 GETCOM LDA LOADFG ; LOADING FROM DEVICE?
A220 D0 32 BNE GEC200 ; YES.
A222 A5 FF LDA RUN ; RUN MODE?
A224 F0 24 BEQ GEC100 ; NO -- IMMEDIATE.
A226 20 46 B8 GEC010 JSR ABRTCK ; YES -- CHECK FOR OPERATOR ABORT.
A229 A2 00 LDX #INLN-DTAB ; GET NEXT STATEMENT ADDRESS
A22B A0 04 LDY #NXTLN-DTAB
A22D 20 CF B3 JSR DMOVI
A230 A0 00 LDY #0 ; GET & SAVE LINE END INDEX.
A232 B1 80 LDA (INLN),Y
A234 85 83 STA INLN+3
A236 A0 30 LDY #S1H-DTAB ; END OF PROGRAM?
A238 20 63 B5 JSR DCMPI
A23B D0 03 BNE GEC020 ; NO -- KEEP TRUCKIN'.
A23D A9 81 LDA #EOPERR ; RETURN WITH INDICATOR.
A23F 60 RTS
A240 A2 04 GEC020 LDX #NXTLN-DTAB ; POINT TO NEXT LINE.
A242 20 10 B4 JSR SNXTI
A245 A0 06 LDY #6 ; SET INDEX TO START OF STATEMENT.
A247 A9 00 LDA #0 ; SET CC FOR RETURN.
A249 60 RTS
; GET A LINE FROM THE CONSOLE.
A24A GEC100
; *S* LDA #0 ; CLEAR LINE LENGTH FOR "BREAK".
A24A 85 83 STA INLN+3
A24C A2 00 LDX #INLN-DTAB ; GET AN INPUT LINE FROM CONSOLE.
A24E 20 9E AF JSR GETLIN
A251 A0 00 LDY #0 ; SET INDEX TO START OF STATEMENT (CC TOO)
A253 60 RTS
; GET DATA FROM DEVICE ASSIGNED TO IOCB 3.
A254 86 A1 GEC200 STX TEMP ; SAVE REGISTERS.
A256 A5 80 LDA INLN ; SETUP BUFFER ADDRESS.
A258 8D 74 03 STA IOCB3+ICBAL
A25B A5 81 LDA INLN+1
A25D 8D 75 03 STA IOCB3+ICBAH
A260 A9 05 LDA #GETR ; GET RECORD COMMAND.
A262 8D 72 03 STA IOCB3+ICCOM
A265 A9 79 LDA #LINLNG-1 ; SETUP MAXIMUM LINE LENGTH.
A267 8D 78 03 STA IOCB3+ICBLL
A26A A9 00 LDA #LINLNG-1/256
A26C 8D 79 03 STA IOCB3+ICBLH
A26F A2 30 LDX #IOCB3 ; GET RECORD.
A271 20 56 E4 JSR CIO
A274 AD 78 03 LDA IOCB3+ICBLL ; PUT START/END INDICES IN POINTER.
A277 85 83 STA INLN+3
A279 A9 00 LDA #0
A27B 85 82 STA INLN+2
A27D C0 00 CPY #0 ; ERROR?
A27F 10 21 BPL GEC250 ; NO.
; *S* LDA #0 ; THAT OR END-OF-FILE.
A281 8D 72 05 STA LOADFG ; STOP LOADING IN EITHER CASE.
A284 C0 88 CPY #$88 ; END OF FILE?
A286 D0 17 BNE GEC220 ; NO.
A288 20 FD B0 JSR DCLOSE ; YES -- CLOSE DEVICE.
A28B A5 FF LDA RUN ; IS THE USER PROGRAM RUNNING?
A28D F0 0A BEQ GEC210 ; NO -- IMMEDIATE LOAD OR LOAD ERROR.
A28F A5 AE LDA S1L ; YES -- SETUP TO RUN PROGRAM LOADED.
A291 85 84 STA NXTLN
A293 A5 AF LDA S1L+1
A295 85 85 STA NXTLN+1
A297 D0 8D BNE GEC010 ; (BRA).
A299 20 33 BF GEC210 JSR RDYMES ; GENERATE "READY" MESSAGE.
A29C 4C 7E A0 JMP MLRES ; GRACEFUL TERMINATION OF LOAD.
A29F 4C E6 B0 GEC220 JMP DOP005 ; ABORT LOAD OPERATION.
A2A2 A6 A1 GEC250 LDX TEMP ; RESTORE REGISTER.
A2A4 A8 TAY ; SETUP INDEX TO START OF STATEMENT (=0)
A2A5 60 RTS ; RETURN WITH CC SET.
;
; SYCMND -- SYNTAX CHECK THE COMMAND
;
; CALLING SEQUENCE:
;
; X = INDEX TO COMMAND TABLE START
; 'INLN' POINTS TO THE STATEMENT
; Y = INDEX TO START OF STATEMENT
;
; JSR SYCMND
; BNE SYNTAX ERROR (A = ERROR CODE)
;
; 'CTABXR'+1 = INDEX TO COMMAND TABLE ENTRY FOR MATCH.
;
A2A6 A9 00 SYCMND LDA #0 ; RESET
A2A8 F0 02 BEQ EXC010 ; (BRA).
;
; EXCMND -- EXECUTE THE COMMAND
;
; CALLING SEQUENCE:
;
; X = INDEX TO COMMAND TABLE START.
; 'INLN' POINTS TO THE STATEMENT
; Y = INDEX TO START OF STATEMENT
;
; JSR EXCMND
; BNE SYNTAX OR RUN-TIME ERROR (A = ERROR CODE)
;
; 'CTABXR'+1 = INDEX TO COMMAND TABLE ENTRY FOR MATCH.
;
A2AA A9 FF EXCMND LDA #$FF ; SET . . .
A2AC 85 92 EXC010 STA EXEC ; ... EXECUTE FLAG.
A2AE 20 C1 B7 JSR SCNLBL ; SCAN PAST LABEL IF PRESENT
A2B1 20 FA B7 JSR SLB
A2B4 20 E0 B7 JSR CHKTRM ; NULL LINE?
A2B7 D0 08 BNE EXC020 ; NO.
A2B9 A9 20 EXC015 LDA #CTABR+1-CTAB ; YES -- DONE ...
A2BB 8D 50 05 STA CTABXR+1 ; ... MAKE IT LOOK LIKE RUN-TIME COMMAND.
A2BE A9 00 LDA #0 ; SET CC FOR EXIT
A2C0 60 RTS ; RETURN WITH CC SET.
A2C1 C9 3A EXC020 CMP #': ; COMMAND CONTINUATION?
A2C3 D0 1D BNE EXC040 ; NO.
A2C5 C8 INY ; YES
A2C6 A5 92 LDA EXEC ; EXECUTE MODE?
A2C8 F0 EF BEQ EXC015 ; NO -- ALL DONE.
A2CA A5 FF LDA RUN ; IMMEDIATE EXECUTE?
A2CC F0 2C BEQ EXC050 ; YES -- USE 'EXECF' & 'XJUMP' FROM PRIOR COMM
A2CE AD 04 05 LDA XJUMP+2 ; NO -- CHECK FOR 'T', 'Y', 'N' OR 'R '
A2D1 C9 A7 CMP #XREM+1/256
A2D3 90 25 BCC EXC050 ; ????
A2D5 D0 07 BNE EXC030 ; INVALID.
A2D7 AD 03 05 LDA XJUMP+1 ; NOT SURE -- CHECK FURTHER
A2DA C9 5E CMP #XREM+1
A2DC 90 1C BCC EXC050 ; O.K.
A2DE 88 EXC030 DEY
A2DF A9 02 LDA #IVCERR ; INVALID CONTINUATION.
A2E1 60 RTS
A2E2 20 10 A3 EXC040 JSR CMATCH ; FIND COMMAND
A2E5 D0 28 BNE EXC900 ; INVALID
A2E7 BD 2F A4 LDA CDTAB,X ; MOVE ADDRESS TO JUMP INSTRUCTION
A2EA 8D 03 05 STA XJUMP+1
A2ED BD 30 A4 LDA CDTAB+1,X
A2F0 8D 04 05 STA XJUMP+2
A2F3 20 9D A4 JSR COND ; PROCESS CONDITION IF PRESENT
A2F6 A5 92 LDA EXEC ; EXECUTE MODE?
A2F8 F0 04 BEQ EXC070 ; NO -- SYNTAX SCAN ONLY.
A2FA A5 FE EXC050 LDA EXECF ; EXECUTE COMMAND?
A2FC F0 11 BEQ EXC900 ; NO -- NORMAL EXIT.
A2FE A5 92 EXC070 LDA EXEC ; SET CC FOR X-ROUTINES.
A300 20 02 05 JSR XJUMP ; YES -- EXECUTE (OR SCAN).
A303 D0 0A BNE EXC900 ; ERROR -- RETURN WITH CC SET.
A305 20 FA B7 JSR SLB ; SKIP ANY BLANKS.
A308 20 E0 B7 JSR CHKTRM ; STATEMENT TERMINATOR?
A30B F0 02 BEQ EXC900 ; YES -- O. K.
A30D A9 02 LDA #JNKERR ; JUNK -- ERROR.
A30F 60 EXC900 RTS ; RETURN WITH CC SET.
;
; CMATCH -- COMMAND MATCH ROUTINE
;
; CALLING SEQUENCE:
;
; X = INDEX TO CTAB TO START SCAN.
; 'INLN' POINTS TO SOURCE STATEMENT.
; Y = INDEX TO START OF COMMAND NAME.
;
; JSR CMATCH
; BNE NO MATCH IN TABLE (A = ERROR CODE)
;
; X = VALUE OF 'CTAB' DATA BYTE FOR ENTRY (AND $7F).
; Y = INDEX TO START OF FIELD AFTER COMMAND NAME.
; 'CTABXR'+1 = INDEX TO COMMAND TABLE ENTRY FOR MATCH.
;
; NOTE: NAME MATCH MUST BE EXACT FOR THE REST OF THE
; STATEMENT TO BE PROCESSED CORRECTLY. FOR EXAMPLE:
; "TYPEN:" WILL BE SCANNED AS TY<JUNK>:, NOT
; T<JUNK>N:
A310 20 FA B7 CMATCH JSR SLB ; SKIP LEADING BLANKS.
; *** EXTERNAL ENTRY POINT FROM 'ATOM' ***
A313 84 A1 CMAT2 STY TEMP ; SAVE INDEX.
A315 88 DEY ; (PRE-DECREMENT).
A316 C8 CMA005 INY
A317 BD 3A A3 CMA010 LDA CTAB,X ; SEE IF END OF NAME IN TABLE.
A31A 30 15 BMI CMA070 ; YES -- MATCH FOUND.
A31C E8 INX
A31D D1 80 CMP (INLN),Y ; MATCH SO FAR?
A31F F0 F5 BEQ CMA005 ; YES -- CONTINUE COMPARISON.
A321 E8 CMA020 INX ; SCAN TO END OF NAME ENTRY.
A322 BD 39 A3 LDA CTAB-1,X
A325 10 FA BPL CMA020
A327 A4 A1 LDY TEMP ; RESTORE SOURCE INDEX.
A329 BD 3A A3 LDA CTAB,X ; CHECK FOR END OF TABLE.
A32C D0 E9 BNE CMA010 ; NO -- KEEP CHECKING.
A32E A9 02 LDA #IVCERR ; TABLE END -- INVALID COMMAND.
A330 60 RTS
A331 8E 50 05 CMA070 STX CTABXR+1 ; SAVE INDEX FOR CALLER.
A334 29 7F AND #$7F ; REMOVE SIGN BIT FROM TABLE BYTE.
A336 AA TAX ; PUT IN X AS ADVERTISED.
A337 A9 00 LDA #0 ; SET CC FOR EXIT.
A339 60 RTS
;
; COMMAND TABLE
;
; CONSISTS OF N ENTRIES, EACH OF THE FOLLOWING FORMAT:
;
; .BYTE "<COMMAND NAME>",$80+INDEX TO DATA TABLE
;
; THE TOTAL NUMBER OF BYTES IN THE TABLE MAY NOT EXCEED 256.
; ORDER OF ENTRIES IS IMPORTANT, THE FIRST FOUND MATCH IS ACCEPTED. NOT
; THE BEST FIT.
;
0080 SB=$80 ; SIGN BIT.
A33A CTAB=* ; COMMAND TABLE BASE ADDRESS.
A33A CTABI=* ; IMMEDIATE MODE ONLY COMMANDS.
A33A 4C 49 53 .BYTE "LIST",SB+CDLIST-CDTAB ; LIST STORED PROGRAM.
A33D 54 80
A33F 52 55 4E .BYTE "RUN",SB+CDRUN-CDTAB ; RUN STORED PROGRAM.
A342 84
A343 44 4F 53 .BYTE "DOS",SB+CDDOS-CDTAB ; GO TO DOS UTILITY.
A346 86
A347 53 41 56 .BYTE "SAVE",SB+CDSAVE-CDTAB ; SAVE STORED PROGRAM.
A34A 45 8A
A34C 4E 45 57 .BYTE "NEW",SB+CDNEW-CDTAB ; CLEAR PROGRAM & VARS.
A34F B6
A350 41 55 54 .BYTE "AUTO",SB+CDAUTO-CDTAB ; AUTO-INPUT.
A353 4F 8C
A355 52 45 4E .BYTE "REN",SB+CDREN-CDTAB ; RENUMBER PROGRAM.
A358 8E
A359 CTABR=* ; IMMEDIATE OR RUN MODE COMMANDS.
A359 44 55 4D .BYTE "DUMP",SB+CDDUMP-CDTAB ; DUMP.
A35C 50 82
A35E 4C 4F 41 .BYTE "LOAD",SB+CDLOAD-CDTAB ; LOAD.
A361 44 88
A363 54 52 41 .BYTE "TRACE",SB+CDTRC-CDTAB ; TRACE.
A366 43 45 92
A369 56 4E 45 .BYTE "VNEW",SB+CDNEWV-CDTAB ; VNEW.
A36C 57 B8
A36E CTABC=* ; PRIOR COMMANDS DON'T REQUIRE A ':'.
A36E 43 41 4C .BYTE "CALL",SB+CDCAL-CDTAB ; CALL.
A371 4C 90
A373 54 41 50 .BYTE "TAPE",SB+CDCASS-CDTAB ; CASSETTE ON/OFF.
A376 45 94
A378 54 53 59 .BYTE "TSYNC",SB+CDSYNC-CDTAB ; CASSETTE SYNC.
A37B 4E 43 96
A37E 52 45 41 .BYTE "READ",SB+CDIN-CDTAB ; READ RECORD.
A381 44 BA
A383 57 52 49 .BYTE "WRITE",SB+CDOUT-CDTAB ; WRITE RECORD.
A386 54 45 BC
A389 43 4C 4F .BYTE "CLOSE",SB+CDDONE-CDTAB ; CLOSE FILE.
A38C 53 45 BE
A38F 54 98 .BYTE "T",SB+CDT-CDTAB ; TYPE.
A391 41 9A .BYTE "A",SB+CDA-CDTAB ; ACCEPT.
A393 43 9C .BYTE "C",SB+CDC-CDTAB ; COMPUTE.
A395 55 9E .BYTE "U",SB+CDU-CDTAB ; USE (RUN ONLY).
A397 45 A0 .BYTE "E",SB+CDE-CDTAB ; END (RUN ONLY).
A399 4A 4D A2 .BYTE "JM",SB+CDJM-CDTAB ; JUMP ON MATCH (RUN ONLY).
A39C 4A A4 .BYTE "J",SB+CDJ-CDTAB ; JUMP (RUN ONLY).
A39E 47 52 A6 .BYTE "GR",SB+CDG-CDTAB ; GRAPHICS.
A3A1 4D 53 A8 .BYTE "MS",SB+CDMS-CDTAB ; MATCH (PRODUCING) STRING.
A3A4 4D AA .BYTE "M",SB+CDM-CDTAB ; MATCH.
A3A6 53 4F AC .BYTE "SO",SB+CDS-CDTAB ; SOUNDS.
A3A9 52 AE .BYTE "R",SB+CDR-CDTAB ; REMARK.
A3AB 50 41 B0 .BYTE "PA",SB+CDW-CDTAB ; PAUSE.
A3AE 59 B2 .BYTE "Y",SB+CDY-CDTAB ; TYPE IF YES.
A3B0 4E B4 .BYTE "N",SB+CDN-CDTAB ; TYPE IF NO.
A3B2 50 4F 53 .BYTE "POS",SB+CDPOS-CDTAB ; POSITION.
A3B5 C0
A3B6 00 .BYTE 0 ; END OF TABLE.
A3B7 OPTAB=* ; NUMERIC/RELATIONAL OPERATORS.
A3B7 2B C2 .BYTE "+",SB+CDPLUS-CDTAB
A3B9 2D C4 .BYTE "-",SB+CDSUB-CDTAB
A3BB 2F C6 .BYTE "/",SB+CDDIV-CDTAB
A3BD 2A C8 .BYTE "*",SB+CDMUL-CDTAB
A3BF 3C 3E CA .BYTE "<>",SB+CDNE-CDTAB
A3C2 3E 3D CC .BYTE ">=",SB+CDGE-CDTAB
A3C5 3C 3D CE .BYTE "<=",SB+CDLE-CDTAB
A3C8 3D D0 .BYTE "=",SB+CDEQ-CDTAB
A3CA 3E D4 .BYTE ">",SB+CDGT-CDTAB
A3CC 3C D2 .BYTE "<",SB+CDLT-CDTAB
A3CE 5C D6 .BYTE "\",SB+CDMOD-CDTAB
A3D0 00 .BYTE 0 ; END OF TABLE
A3D1 GTAB=* ; GRAPHICS SUB-COMMAND TABLE
A3D1 44 52 41 .BYTE "DRAWTO",SB+CDDRWT-CDTAB
A3D4 57 54 4F
A3D7 D8
A3D8 44 52 41 .BYTE "DRAW",SB+CDDRW-CDTAB
A3DB 57 DA
A3DD 54 55 52 .BYTE "TURNTO",SB+CDTRNT-CDTAB
A3E0 4E 54 4F
A3E3 DC
A3E4 54 55 52 .BYTE "TURN",SB+CDTRN-CDTAB
A3E7 4E DE
A3E9 47 4F 54 .BYTE "GOTO",SB+CDGOTO-CDTAB
A3EC 4F E0
A3EE 46 49 4C .BYTE "FILLTO",SB+CDFILT-CDTAB
A3F1 4C 54 4F
A3F4 E4
A3F5 46 49 4C .BYTE "FILL",SB+CDFIL-CDTAB
A3F8 4C E6
A3FA 47 4F E2 .BYTE "GO",SB+CDGO-CDTAB
A3FD 50 45 4E .BYTE "PEN",SB+CDPEN-CDTAB
A400 E8
A401 43 4C 45 .BYTE "CLEAR",SB+CDCLR-CDTAB
A404 41 52 EA
A407 51 55 49 .BYTE "QUIT",SB+CDEXIT-CDTAB
A40A 54 EC
A40C 00 .BYTE 0 ; END OF TABLE.
A40D PCTAB=* ; PEN COLOR TABLE.
A40D 52 45 44 .BYTE "RED",SB+1
A410 81
A411 59 45 4C .BYTE "YELLOW",SB+2
A414 4C 4F 57
A417 82
A418 42 4C 55 .BYTE "BLUE",SB+3
A41B 45 83
A41D 45 52 41 .BYTE "ERASE",SB+0
A420 53 45 80
A423 55 50 84 .BYTE "UP",SB+PCUP
A426 00 .BYTE 0 ; END OF TABLE.
A427 CCTAB=* ; CASSETTE/TRACE COMMAND TABLE
A427 4F 4E B4 .BYTE "ON",CASSON
A42A 4F 46 46 .BYTE "OFF",CASSOF
A42D BC
A42E 00 .BYTE 0 ; END OF TABLE.
00F5 TABLEN=*-CTAB ; MUST NOT EXCEED 0100 HEX.
;
; COMMAND DATA TABLE
;
; CONSISTS OF N ENTRIES OF ANY LENGTH, THE INDICES TO THIS TABLE ARE
; CONTAINED IN 'CTAB'. THE TOTAL NUMBER OF BYTES IN THE TABLE MAY NOT
; EXCEED 128.
;
A42F CDTAB=* ; COMMAND DATA TABLE BASE ADDRESS.
A42F 26 AE CDLIST .WORD XLIST
A431 D5 AA CDDUMP .WORD XDUMP
A433 C0 A7 CDRUN .WORD XRUN
A435 B8 A7 CDDOS .WORD XDOS
A437 05 AE CDLOAD .WORD XLOAD
A439 D4 AD CDSAVE .WORD XSAVE
A43B C1 AE CDAUTO .WORD XAUTO
A43D 1F AF CDREN .WORD XREN
A43F 0C AA CDCAL .WORD XCALL
A441 C0 AD CDTRC .WORD XTRACE
A443 91 AD CDCASS .WORD XCASS
A445 A2 AD CDSYNC .WORD XCSYNC
A447 DC A6 CDT .WORD XTYPE
A449 E3 A7 CDA .WORD XACCPT
A44B 37 AB CDC .WORD XCMPUT
A44D 25 AA CDU .WORD XUSE
A44F 92 A7 CDE .WORD XEND
A451 A7 AA CDJM .WORD XJMPM
A453 48 AA CDJ .WORD XJMP
A455 FE AB CDG .WORD XGRAPH
A457 51 A9 CDMS .WORD XMWSP
A459 B6 A8 CDM .WORD XMATCH
A45B 9B AC CDS .WORD XSOUND
A45D 5D A7 CDR .WORD XREM
A45F 6D AD CDW .WORD XWAIT
A461 4F A7 CDY .WORD XTYPE2
A463 57 A7 CDN .WORD XTYPE3
A465 F8 A9 CDNEW .WORD XNEW
A467 BA A9 CDNEWV .WORD XNEWV
A469 DE AC CDIN .WORD XIN
A46B 29 AD CDOUT .WORD XOUT
A46D 5C AD CDDONE .WORD XDONE
A46F 60 A7 CDPOS .WORD XPOS
A471 80 B5 CDPLUS .WORD DADDI
A473 90 B5 CDSUB .WORD DSUBI
A475 D5 B5 CDDIV .WORD DDIVI
A477 A2 B5 CDMUL .WORD DMULI
A479 6C B6 CDNE .WORD DNETI
A47B 83 B6 CDGE .WORD DGETI
A47D 8A B6 CDLE .WORD DLETI
A47F 65 B6 CDEQ .WORD DEQTI
A481 7C B6 CDLT .WORD DLTTI
A483 73 B6 CDGT .WORD DGTTI
A485 33 B6 CDMOD .WORD DMODI
A487 C1 B9 CDDRWT .WORD GDRWTO
A489 0A BA CDDRW .WORD GDRW
A48B F4 B9 CDTRNT .WORD GTRNTO
A48D 36 BA CDTRN .WORD GTRN
A48F C5 B9 CDGOTO .WORD GGOTO
A491 0E BA CDGO .WORD GGO
A493 BD B9 CDFILT .WORD GFILTO
A495 06 BA CDFIL .WORD GFIL
A497 4B BA CDPEN .WORD GPEN
A499 9A BA CDCLR .WORD GCLEAR
A49B 5D BA CDEXIT .WORD GEXIT
006E TABLEN = *-CDTAB ; THIS MUST NOT EXCEED 0080 HEX.
;
; COND -- CONDITIONAL EXECUTION PROCESSOR
;
; CALLING SEQUENCE:
;
; 'INLN' POINTS TO STATEMENT TO BE PROCESSED
; Y = INDEX TO START OF CONDITION.
; 'MATCHF' = 0 (FALSE) OR $FF (TRUE) , RESULT OF PRIOR 'M' COMMAND.
;
; JSR COND
;
; Y = INDEX TO ':' IN STATEMENT + 1.
; 'EXECF' = 0 IF STATEMENT IS NOT TO BE EXECUTED.
;
; NOTE: GOES TO 'PSTOP' ON ERROR.
;
A49D A9 FF COND LDA #$FF ; PRESET EXECUTE FLAG.
A49F 85 FE STA EXECF
A4A1 20 FA B7 JSR SLB ; GET FIRST CHAR OF CONDITION FIELD
A4A4 C9 59 CMP #'Y ; CHECK FOR 'Y' OR 'N' FIRST.
A4A6 D0 05 BNE CND010
A4A8 A5 FD LDA MATCHF ; 'Y' IF 'MATCHF' IS TRUE, RESULT IS TRUE.
A4AA 4C B7 A4 JMP CND015
A4AD C9 4E CND010 CMP #'N
A4AF D0 0C BNE CND030 ; NOT 'Y' OR 'N'.
A4B1 A5 FD LDA MATCHF ; 'N' -- IF 'MATCHF' IS FALSE, RESULT IS TRUE
A4B3 F0 04 BEQ CND017
A4B5 A9 00 LDA #0
A4B7 85 FE CND015 STA EXECF
A4B9 C8 CND017 INY
A4BA 20 FA B7 JSR SLB ; GET NEXT NON-BLANK CHARACTER.
A4BD C9 28 CND030 CMP #'( ; SEE IF ARITHMETIC EXPRESSION.
A4BF D0 14 BNE CND050 ; NO -- ALL DONE.
A4C1 20 92 B8 JSR EXP ; EVALUATE EXPRESSION IN PARENS.
A4C4 A5 94 LDA EXPSTK+1 ; SEE IF RESULT > ZERO.
A4C6 30 06 BMI CND032 ; NO -- NEGATIVE.
A4C8 D0 08 BNE CND040 ; YES -- POSITIVE & NON-ZERO.
A4CA A5 93 LDA EXPSTK ; NOT SURE -- TEST LSB.
A4CC D0 04 BNE CND040 ; POSITIVE & NON-ZERO.
A4CE A9 00 CND032 LDA #0 ; NO -- CONDITION FALSE.
A4D0 85 FE STA EXECF
A4D2 20 FA B7 CND040 JSR SLB ; GET NEXT NON-BLANK CHARACTER.
A4D5 C9 3A CND050 CMP #': ; COLON?
A4D7 D0 02 BNE CND080 ; NO.
A4D9 C8 INY ; SKIP OVER ':'
A4DA 60 CND070 RTS
A4DB AD 50 05 CND080 LDA CTABXR+1 ; ':' REQUIRED FOR THIS COMMAND?
A4DE C9 34 CMP #CTABC-CTAB
A4E0 90 F8 BCC CND070 ; NO.
A4E2 88 DEY
A4E3 A9 02 LDA #CNDERR ; YES -- ERROR.
A4E5 4C 6C A1 JMP PSTOP
;
; ATOM -- FIND, IDENTIFY & EVALUATE THE NEXT ATOM IN THE STATEMENT LINE.
;
; CALLING SEQUENCE:
;
; 'INLN' POINTS TO THE STATEMENT LINE,
; Y = INDEX TO END OF PRIOR ATOM + 1.
;
; JSR ATOM
; BNE SYNTAX ERROR
;
; A = ATOM IDENTIFIER CODE
; Y = INDEX TO END OF ATOM + 1 (OR BEGINNING OF ATOM FOR TEXT TYPE)
; 'NUMBER' = VALUE OF NUMERIC CONSTANT OR NUMERIC VARIABLE.
; 'POINT' = ADDRESS OF NUMERIC VARIABLE OR OPERATOR ROUTINE.
; 'NP' POINTS TO STRING VARIABLE NAME.
; 'DP' POINTS TO STRING VARIABLE VALUE (IF DEFINED).
;
A4E8 20 FA B7 ATOM JSR SLB ; SKIP LEADING BLANKS, IF PRESENT.
; *** INTERNAL RE-ENTRY POINT ***
A4EB 20 E0 B7 ATOM2 JSR CHKTRM ; NULL ATOM (STATEMENT TERMINATOR)?
A4EE F0 33 BEQ ATM100 ; YES.
A4F0 C9 23 CMP #'# ; NUMERIC VARIABLE?
A4F2 F0 34 BEQ ATM200 ; YES.
A4F4 C9 40 CMP #'@ ; POINTER?
A4F6 F0 57 BEQ ATM250 ; YES.
A4F8 C9 24 CMP #'$ ; STRING VARIABLE?
A4FA D0 03 BNE ATM003 ; NO.
A4FC 4C 8B A5 JMP ATM300 ; YES.
A4FF C9 25 ATM003 CMP #'% ; JOYSTICK/PADDLE/LIGHTPEN?
A501 D0 03 BNE ATM005 ; NO.
A503 4C F2 A5 JMP ATM700 ; YES.
A506 20 7A B7 ATM005 JSR CNUMBR ; NUMERIC LITERAL?
A509 B0 03 BCS ATM010 ; NO
A50B 4C D4 A5 JMP ATM400 ; YES.
A50E 20 88 B7 ATM010 JSR CLETTR ; CONTEXT DEPENDENT TEXT?
A511 B0 03 BCS ATM020 ; NO.
A513 4C DD A5 JMP ATM500 ; YES.
A516 A2 7D ATM020 LDX #OPTAB-CTAB ; SPECIAL OPERATOR?
A518 20 13 A3 JSR CMAT2
A51B D0 03 BNE ATM099 ; NO.
A51D 4C E1 A5 JMP ATM600 ; YES.
A520 A9 02 ATM099 LDA #ATMERR ; NONE OF THE ABOVE -- ERROR.
A522 60 RTS ; RETURN WITH CC SET.
; NULL ATOM -- <EOL>
A523 A9 01 ATM100 LDA #NULL
A525 4C D7 A6 JMP ATMRET
; NUMERIC VARIABLE -- #<LETTER>
A528 C8 ATM200 INY
A529 B1 80 LDA (INLN),Y ; GET VARIABLE NAME
A52B 20 88 B7 JSR CLETTR ; IS IT A PROPER LETTER?
A52E B0 F0 BCS ATM099 ; NO -- SYNTAX ERROR.
A530 38 SEC ; (CLEAR BORROW)
A531 E9 41 SBC #'A ; RELATIVIZE
A533 0A ASL A ; *2.
A534 AA TAX ; INDEX TO 'VARTAB *
A535 18 CLC ; CALCULATE ADDRESS OF VAR
A536 69 1B ADC #VARTAB
A538 85 B6 STA POINT
A53A A9 05 LDA #VARTAB/256
A53C 69 00 ADC #0
A53E 85 B7 STA POINT+1
A540 C8 INY ; SCAN TO END OF ATOM
; JSR SCEOA ; SCAN TO END OF ATOM.
A541 BD 1B 05 LDA VARTAB,X ; MOVE VALUE TO 'NUMBER'.
A544 85 B8 STA NUMBER
A546 BD 1C 05 LDA VARTAB+1,X
A549 85 B9 STA NUMBER+1
A54B A9 04 LDA #NVAR
A54D D0 6B BNE ATM340 ; (BRA) TO 'ATMRET'
; POINTER (INDIRECT REFERENCE) -- @[B]<NUMERIC QUANTITY>
A54F C8 ATM250 INY ; EXAMINE CHARACTER AFTER '@'
A550 B1 80 LDA (INLN),Y
A552 C9 42 CMP #'B ; POINTER TO BYTE?
A554 08 PHP ; SAVE ANSWER.
A555 D0 03 BNE ATM255 ; NO -- POINTER TO WORD.
A557 C8 INY ; YES -- SKIP OVER 'B'
A558 B1 80 LDA (INLN),Y ; GET CHARACTER AFTER 'B'.
A55A 20 EB A4 ATM255 JSR ATOM2 ; SEE WHAT FOLLOWS *** RECURSIVE CALL ***
A55D D0 28 BNE ATM290 ; ERROR.
A55F 29 06 AND #NVAR+NUM ; MUST BE NUMERIC.
A561 F0 24 BEQ ATM290 ; ERROR.
A563 A5 B8 LDA NUMBER ; RESULT IS ADDRESS OF DATA.
A565 85 B6 STA POINT
A567 A5 B9 LDA NUMBER+1
A569 85 B7 STA POINT+1
A56B 84 A1 STY TEMP ; SAVE LINE INDEX.
A56D A0 00 LDY #0 ; GET DATA VALUE NOW.
A56F B1 B6 LDA (POINT),Y
A571 85 B8 STA NUMBER
A573 28 PLP ; POINTER TO BYTE?
A574 D0 06 BNE ATM260 ; NO -- POINTER TO WORD.
A576 84 B9 STY NUMBER+1 ; YES -- MSB = 0.
A578 A9 80 LDA #BPTR ; TYPE = POINTER TO BYTE,
A57A D0 07 BNE ATM270 ; (BRA).
A57C C8 ATM260 INY
A57D B1 B6 LDA (POINT),Y ; GET MSB OF DATA WORD.
A57F 85 B9 STA NUMBER+1
A581 A9 04 LDA #NVAR ; TYPE = POINTER TO WORD.
A583 A4 A1 ATM270 LDY TEMP ; RESTORE LINE INDEX.
A585 D0 33 BNE ATM340 ; (BRA) SKIP TO NORMAL RETURN.
A587 28 ATM290 PLP ; CLEANUP STACK BEFORE RETURN.
A588 4C 20 A5 JMP ATM099 ; ERROR RETURN.
; STRING VARIABLE -- $<ANY NUMBER OF ALPHANUM>
A58B C8 ATM300 INY ; EXAMINE CHARACTER AFTER '$'
A58C B1 80 LDA (INLN),Y
A58E C9 24 CMP #'$ ; STRING INDIRECTION?
A590 F0 2B BEQ ATM350 ; YES.
A592 20 A4 B7 JSR CKEOA ; NO -- STRING NAME ERROR?
A595 F0 89 BEQ ATM099 ; YES.
A597 A5 80 LDA INLN ; NO -- SET NAME POINTER TO NAME.
A599 85 BE STA NP
A59B A5 81 LDA INLN+1
A59D 85 BF STA NP+1
A59F 84 C0 STY NP+2
A5A1 20 B9 B7 JSR SCEOA ; SCAN TO END OF ATOM.
A5A4 84 C1 STY NP+3 ; SAVE END INDEX.
A5A6 98 ATM320 TYA ; SAVE LINE INDEX.
A5A7 48 PHA
A5A8 20 9B B7 JSR SETSVL ; SET LIST POINTER TO STRING VARIABLES.
A5AB 20 81 B2 JSR SFIND ; FIND VARIABLE IF DEFINED,
A5AE D0 06 BNE ATM330 ; UNDEFINED.
A5B0 68 PLA ; RESTORE LINE INDEX.
A5B1 A8 TAY
A5B2 A9 08 LDA #SVAR ; DEFINED STRING VARIABLE.
A5B4 D0 04 BNE ATM340 ; (BRA) TO 'ATMRET'
A5B6 68 ATM330 PLA ; RESTORE LINE INDEX.
A5B7 A8 TAY
A5B8 A9 10 LDA #USVAR ; UNDEFINED STRING VARIABLE.
A5BA 4C D7 A6 ATM340 JMP ATMRET ; *** SKIP BRANCH POINT ***
A5BD 20 8B A5 ATM350 JSR ATM300 ; INDIRECTION -- GET NAME *** RECURSIVE CALL ***.
A5C0 D0 11 BNE ATM360 ; ERROR
A5C2 C9 10 CMP #USVAR ; UNDEFINED STRING?
A5C4 F0 F4 BEQ ATM340 ; YES -- ALL DONE.
A5C6 84 A1 STY TEMP ; DEFINED -- USE DATA AS NAME FOR TARGET.
A5C8 A2 3E LDX #NP-DTAB
A5CA A0 42 LDY #DP-DTAB
A5CC 20 C5 B3 JSR PMOVE
A5CF A4 A1 LDY TEMP
A5D1 D0 D3 BNE ATM320 ; (BRA) NOW GET STRING.
A5D3 60 ATM360 RTS
; NUMERIC LITERAL -- <DIGIT><ANY NUMBER OF DIGITS>
A5D4 A2 00 ATM400 LDX #INLN-DTAB ; POINT TO POINTER.
A5D6 20 B2 B6 JSR ASCDEC ; CONVERT TO BINARY, RESULT TO 'NUMBER
A5D9 A9 02 LDA #NUM
A5DB D0 DD BNE ATM340 ; (BRA) TO 'ATMRET'.
; TEXT -- <LETTER><ANY NUMBER OF CHARACTERS>
A5DD A9 20 ATM500 LDA #TEXT
A5DF D0 D9 BNE ATM340 ; (BRA) TO 'ATMRET'
; OPERATOR -- <OPERATOR>
A5E1 BD 2F A4 ATM600 LDA CDTAB,X ; GET OPERATE ROUTINE ADDRESS.
A5E4 85 B6 STA POINT
A5E6 BD 30 A4 LDA CDTAB+1,X
A5E9 85 B7 STA POINT+1
A5EB A9 40 LDA #OPR
A5ED D0 CB BNE ATM340 ; (BRA) TO 'ATMRET'
; CONTROLLERS -- %<P!J!T><NUMBER> OR %<X!Y!Z!A!H!V!L!M!F>
A5EF 4C 20 A5 ATM720 JMP ATM099 ; ERROR.
A5F2 C8 ATM700 INY ; SKIP OVER '%'.
A5F3 B1 80 LDA (INLN),Y ; GET NEXT CHARACTER.
A5F5 C9 50 CMP #'P ; PADDLE CONTROLLER?
A5F7 F0 2F BEQ ATM730 ; YES.
A5F9 C9 46 CMP #'F ; FREE MEMORY?
A5FB F0 3C BEQ ATM740 ; YES.
A5FD C9 4A CMP #'J ; JOYSTICK?
A5FF F0 51 BEQ ATM760 ; YES.
A601 C9 54 CMP #'T ; TRIGGER?
A603 F0 5D BEQ ATM770 ; YES.
A605 C9 58 CMP #'X ; GRAPHICS X?
A607 F0 72 BEQ ATM782 ; YES.
A609 C9 59 CMP #'Y ; GRAPHICS Y?
A60B F0 72 BEQ ATM784 ; YES.
A60D C9 5A CMP #'Z ; GRAPHICS PIXEL VALUE.
A60F F0 79 BEQ ATM788 ; YES.
A611 C9 41 CMP #'A ; GRAPHICS THETA ANGLE?
A613 F0 6E BEQ ATM786 ; YES.
A615 C9 48 CMP #'H ; LIGHTPEN HORIZONTAL?
A617 F0 78 BEQ ATM790 ; YES.
A619 C9 56 CMP #'V ; LIGHTPEN VERTICAL?
A61B F0 79 BEQ ATM795 ; YES.
A61D C9 4C CMP #'L ; LIGHTPEN TRIGGER?
A61F F0 7A BEQ ATM796 ; YES.
A621 C9 4D CMP #'M ; MATCH RESULT?
A623 D0 CA BNE ATM720 ; NO.
A625 4C AE A6 JMP ATM798 ; YES.
; READ PADDLE CONTROLLER
A628 20 B3 A6 ATM730 JSR ATM800 ; GET VALUE THAT FOLLOWS 'P'.
A62B D0 28 BNE ATM761 ; ERROR.
A62D 29 07 AND #$07 ; PADDLE # MODULO 8.
A62F AA TAX
A630 38 SEC ; (CLEAR BORROW).
A631 A9 E4 LDA #228 ; RESULT = 228 - VALUE READ.
A633 FD 70 02 SBC PADDL0,X
A636 4C 71 A6 JMP ATM780
; CALCULATE FREE MEMORY
A639 C8 ATM740 INY ; SKIP OVER 'F'.
A63A 38 SEC
A63B A5 B2 LDA S2L ; 'NUMBER' = 'S2L' - 'S1H' + 1.
A63D E5 B0 SBC S1H
A63F 85 B8 STA NUMBER
A641 A5 B3 LDA S2L+1
A643 E5 B1 SBC S1H+1
A645 85 B9 STA NUMBER+1
A647 E6 B8 INC NUMBER
A649 D0 02 BNE ATM745
A64B E6 B9 INC NUMBER+1
A64D A9 02 ATM745 LDA #NUM ; TYPE = NUMBER.
A64F 4C D7 A6 JMP ATMRET
; READ JOYSTICK
A652 20 B3 A6 ATM760 JSR ATM800 ; GET VALUE THAT FOLLOWS 'J'.
A655 D0 6A ATM761 BNE ATM890 ; ERROR *** SKIP BRANCH POINT ***
A657 29 03 AND #$03 ; JOYSTICK # MODULO 4
A659 AA TAX
A65A BD 78 02 LDA STICK0,X ; GET JOYSTICK DATA FROM DATA BASE
A65D 49 0F EOR #$0F ; INVERT DATA READ
A65F 4C 71 A6 JMP ATM780
; READ TRIGGER
A662 20 B3 A6 ATM770 JSR ATM800 ; GET VALUE THAT FOLLOWS 'T'.
A665 D0 5A BNE ATM890 ; ERROR.
A667 29 0F AND #$0F ; TRIGGER # MODULO 16
A669 AA TAX
A66A BD 7C 02 LDA PTRIG0,X ; RESULT = SINGLE BIT.
A66D 49 FF EOR #$FF
A66F 29 01 AND #$01
A671 A2 00 ATM780 LDX #0 ; M.S.B. = 0.
A673 85 B8 ATM781 STA NUMBER ; STORE RESULT.
A675 86 B9 STX NUMBER+1
A677 A9 02 LDA #NUM ; NUMERIC RESULT.
A679 D0 5C BNE ATMRET ; (BRA).
; GRAPHICS PARAMETERS
A67B A2 6C ATM782 LDX #GX-DTAB ; GRAPHICS X COORDINATE.
A67D B0 46 BCS ATM900 ; (BRA).
A67F A2 6F ATM784 LDX #GY-DTAB ; GRAPHICS Y COORDINATE.
A681 B0 42 BCS ATM900 ; (BRA).
A683 A5 F2 ATM786 LDA THETA ; GRAPHICS THETA ANGLE.
A685 A6 F3 LDX THETA+1
A687 C8 INY
A688 D0 E9 BNE ATM781 ; (BRA).
A68A C8 ATM788 INY
A68B 20 A7 BC JSR GREAD ; READ GRAPHICS DATA.
A68E 4C 71 A6 JMP ATM780
; READ LIGHTPEN
A691 AD 34 02 ATM790 LDA LPENH ; LIGHTPEN HORIZONTAL VALUE.
A694 B0 0C BCS ATM797 ; (BRA).
A696 AD 35 02 ATM795 LDA LPENV ; LIGHTPEN VERTICAL VALUE.
A699 B0 07 BCS ATM797 ; (BRA).
A69B AD 78 02 ATM796 LDA STICK0 ; GET LIGHTPEN TRIGGER.
A69E 49 01 EOR #$01 ; INVERT BIT OF INTEREST.
A6A0 29 01 AND #$01
A6A2 A6 92 ATM797 LDX EXEC ; EXECUTE MODE?
A6A4 F0 05 BEQ ATM79B ; NO.
A6A6 A2 0A LDX #$0A ; BACKGROUND = LIGHT GRAY
A6A8 8E C8 02 STX COLOR0+4
A6AB C8 ATM79B INY
A6AC D0 C3 BNE ATM780 ; (BRA).
; READ MATCH FLAG.
A6AE A5 FD ATM798 LDA MATCHF ; MATCH RESULT FLAG.
A6B0 C8 INY
A6B1 D0 BE BNE ATM780 ; (BRA).
; SUBROUTINE TO PROCESS NUMBER FOLLOWING %P, %J & %T.
A6B3 C8 ATM800 INY ; SKIP OVER 'P' OR 'J' OR 'T '
A6B4 20 E8 A4 JSR ATOM ; *** RECURSIVE CALL ***.
A6B7 D0 09 BNE ATM895 ; ERROR.
A6B9 29 06 AND #NVAR+NUM ; NUMERIC RESULT?
A6BB F0 05 BEQ ATM895 ; NO -- ERROR.
A6BD A5 B8 LDA NUMBER ; YES.
A6BF C5 B8 CMP NUMBER ; SET CC FOR NORMAL EXIT.
A6C1 60 ATM890 RTS ; RETURN WITH CC SET.
A6C2 A9 02 ATM895 LDA #ATMERR ; INVALID # AFTER LETTER.
A6C4 60 RTS ; RETURN WITH CC SET.
; SUBROUTINE TO ROUND & STORE THE GRAPHICS COORDINATES
A6C5 C8 ATM900 INY
A6C6 B5 82 LDA DTAB+2,X ; GET FRACTIONAL PORTION.
A6C8 2A ROL A ; MSB OF FRACTION TO CARRY BIT
A6C9 B5 80 LDA DTAB+0,X ; ROUND LSB.
A6CB 69 00 ADC #0
A6CD 85 B8 STA NUMBER
A6CF B5 81 LDA DTAB+1,X ; CARRY TO MSB.
A6D1 69 00 ADC #0
A6D3 85 B9 STA NUMBER+1
A6D5 A9 02 LDA #NUM ; NUMERIC RESULT.
A6D7 85 A1 ATMRET STA TEMP ; SET CC FOR EXIT.
A6D9 C5 A1 CMP TEMP
A6DB 60 RTS
; XTYPE -- TYPE COMMAND PROCESS
;
A6DC 20 43 B9 XTYPE JSR TEXP ; PROCESS TEXT EXPRESSION.
; *S* LDA EXEC ; EXECUTE MODE?
A6DF F0 6D BEQ XTP090 ; NO.
A6E1 A6 8F LDX TELN+3 ; CHECK FOR NULL TEXT
A6E3 F0 0C BEQ XTP010 ; NULL.
A6E5 BD 76 05 LDA TEXBUF-1,X ; NON-NULL -- CHECK FINAL CHARACTER
A6E8 C9 5C CMP #'\ ; IS IT EOL SUPPRESS?
A6EA D0 05 BNE XTP010 ; NO.
A6EC C6 8F DEC TELN+3 ; YES -- SUPPRESS ALSO.
A6EE 4C F8 A6 JMP XTP020
A6F1 A9 9B XTP010 LDA #EOL ; INSERT EOL.
A6F3 9D 77 05 STA TEXBUF,X
A6F6 E6 8F INC TELN+3
; TYPE WITH WORD SPLIT AVOIDANCE.
A6F8 84 AC XTP020 STY XTEMP+1 ; SAVE STATEMENT INDEX.
A6FA A4 8E LDY TELN+2 ; STARTING INDEX.
A6FC C4 8F CPY TELN+3
A6FE F0 4A BEQ XTP080 ; NULL OUTPUT -- ALL DONE.
A700 84 AB XTP022 STY XTEMP ; SAVE INDEX.
A702 A6 55 LDX COLCRS ; GET CURRENT CURSOR POSITION.
A704 AD 54 05 LDA GRFLAG ; DIFFERENT CURSOR IF SPLIT SCREEN.
A707 F0 03 BEQ XTP025
A709 AE 91 02 LDX TXTCOL ; SPLIT SCREEN -- USE OTHER CURSOR
A70C 86 AD XTP025 STX XTEMP+2 ; SAVE STARTING COLUMN #.
A70E CA DEX ; PRE-CONDITION THE INDEX.
A70F B1 8C XTP030 LDA (TELN),Y ; FIND LENGTH OF NEXT WORD.
A711 E8 INX
A712 C8 INY
A713 C4 8F CPY TELN+3
A715 F0 04 BEQ XTP035 ; END OF TEXT.
A717 C9 20 CMP #' ; SPACE?
A719 D0 F4 BNE XTP030 ; NO -- KEEP SCANNING.
A71B A4 AB XTP035 LDY XTEMP ; END OF WORD -- CHECK FOR WORD SPLIT
A71D E4 53 CPX RMARGN ; DOES IT WRAP SCREEN?
A71F F0 0B BEQ XTP040 ; NO -- OUTPUT IT.
A721 90 09 BCC XTP040 ; NO -- OUTPUT IT.
A723 A5 AD LDA XTEMP+2 ; YES -- IS THIS THE 1ST WORD OF LINE?
A725 C5 52 CMP LMARGN
A727 F0 03 BEQ XTP040 ; YES -- FORGET ABOUT NEW LINE.
A729 20 60 B8 JSR NEWLIN ; NO -- START A NEW LINE.
A72C B1 8C XTP040 LDA (TELN),Y ; OUTPUT THE WORD JUST SCANNED.
A72E C9 20 CMP #' ; SPACE?
A730 D0 06 BNE XTP050 ; NO.
A732 E4 53 CPX RMARGN ; YES -- IS IT THE LAST POSITION?
A734 D0 02 BNE XTP050 ; NO.
A736 A9 9B LDA #EOL ; YES -- CHANGE TO EOL.
A738 20 6F AF XTP050 JSR CHOT
A73B C8 INY
A73C C4 8F CPY TELN+3 ; END OF TEXT?
A73E F0 0A BEQ XTP080 ; YES.
A740 88 DEY
A741 B1 8C LDA (TELN),Y ; SPACE?
A743 C8 INY
A744 C9 20 CMP #' ; SPACE?
A746 D0 E4 BNE XTP040 ; NO -- NOT END OF WORD.
A748 F0 B6 BEQ XTP022 ; YES -- NOW DO NEXT WORD (BRA).
A74A A4 AC XTP080 LDY XTEMP+1 ; RESTORE STATEMENT INDEX
A74C A9 00 LDA #0 ; SET CC FOR EXIT.
A74E 60 XTP090 RTS ; RETURN WITH CC SET.
; 'Y' COMMAND PROCESSOR
A74F F0 8B XTYPE2 BEQ XTYPE ; SYNTAX SCAN ONLY *** SKIP BRANCH POINT ***
A751 A5 FD LDA MATCHF ; Y COMMAND (SAME AS 'TY').
A753 D0 87 BNE XTYPE
A755 F0 06 BEQ XTP400
; 'N' COMMAND PROCESSOR
A757 F0 83 XTYPE3 BEQ XTYPE ; SYNTAX SCAN ONLY.
A759 A5 FD LDA MATCHF ; N COMMAND (SAME AS 'TN').
A75B F0 F2 BEQ XTYPE2 ; SKIP BRANCH TO 'XTYPE'.
A75D XREM ; REMARK COMMAND PROCESSOR TOO
A75D 4C 02 B8 XTP400 JMP SCNEOL ; SCAN TO END OF LINE & RETURN WITH CC SET
;
; XPOS -- POSITION COMMAND PROCESSOR
;
A760 20 92 B8 XPOS JSR EXP ; COLUMN NUMBER.
A763 A5 92 LDA EXEC ; EXECUTE MODE?
A765 F0 0F BEQ XP0020 ; NO.
A767 A5 94 LDA EXPSTK+1 ; RANGE CHECK THE COLUMN #.
A769 D0 24 BNE XP0900 ; TOO LARGE.
A76B A5 93 LDA EXPSTK+0
A76D C9 28 CMP #TCOL
A76F B0 1E BCS XP0900 ; TOO LARGE.
A771 85 55 STA COLCRS ; O.K. -- STORE IT.
A773 8D 91 02 STA TXTCOL ; SPLIT SCREEN TOO.
A776 20 EE B7 XP0020 JSR SKPSEP ; SKIP SEPARATOR.
A779 20 92 B8 JSR EXP ; ROW NUMBER.
A77C A5 92 LDA EXEC ; EXECUTE MODE?
A77E F0 0E BEQ XP0090 ; NO.
A780 A5 94 LDA EXPSTK+1 ; RANGE CHECK THE ROW #.
A782 D0 0B BNE XP0900 ; TOO LARGE.
A784 A5 93 LDA EXPSTK+0
A786 C9 18 CMP #TROW
A788 B0 05 BCS XP0900 ; TOO LARGE.
A78A 85 54 STA ROWCRS ; O.K. -- STORE IT.
A78C A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
A78E 60 XP0090 RTS ; RETURN WITH CC SET.
A78F A9 02 XP0900 LDA #IMPERR ; COLUMN/ROW OUT OF RANGE
A791 60 RTS ; RETURN WITH CC SET.
;
; XEND -- END STATEMENT PROCESSOR
;
A792 F0 14 XEND BEQ XEN090 ; SYNTAX SCAN ONLY.
A794 A6 90 LDX USTKP ; USE STACK POINTER.
A796 F0 13 BEQ XEN095 ; STACK EMPTY.
A798 86 FF STX RUN ; SET RUN MODE EVEN IF ALREADY SET.
A79A CA DEX ; GET NEXT LINE ADDRESS FROM STACK
A79B CA DEX
A79C 86 90 STX USTKP
A79E BD 0B 05 LDA USESTK,X
A7A1 85 84 STA NXTLN
A7A3 BD 0C 05 LDA USESTK+1,X
A7A6 85 85 STA NXTLN+1
A7A8 A9 00 XEN090 LDA #0 ; O.K. -- SET CC FOR EXIT.
A7AA XDS090
A7AA 60 RTS
A7AB 20 37 B2 XEN095 JSR CLOSEM ; CLOSE ALL OPEN FILES.
A7AE 84 AB STY XTEMP
A7B0 20 54 B2 JSR REMDEV
A7B3 A4 AB LDY XTEMP
A7B5 A9 81 LDA #ENDERR ; STOP CONDITION.
A7B7 60 RTS
;
; XDOS -- DOS COMMAND PROCESSOR
;
A7B8 F0 F0 XDOS BEQ XDS090 ; SYNTAX SCAN ONLY
A7BA EE F0 02 INC CRSINH ; ENABLE CURSOR
A7BD 6C 0A 00 JMP (DOSVEC) ; YES.
;
; XRUN -- RUN COMMAND PROCESSOR
;
A7C0 F0 20 XRUN BEQ XRN090 ; SYNTAX SCAN ONLY.
A7C2 85 FF STA RUN ; YES -- ENTER RUN MODE.
A7C4 20 CE A9 JSR XNV010 ; CLEAR ALL VARIABLES.
A7C7 A5 AE LDA S1L ; SETUP THE NEXT LINE POINTER.
A7C9 85 84 STA NXTLN
A7CB A5 AF LDA S1L+1
A7CD 85 85 STA NXTLN+1
A7CF 20 9A BA JSR GCLEAR ; CLEAR SCREEN.
A7D2 20 B9 BE JSR GPINIT ; INITIALIZE GRAPHICS PARAMETERS.
A7D5 84 AB STY XTEMP
A7D7 20 2F B8 JSR NULACC ; SET ACCEPT BUFFER TO NULL.
A7DA A4 AB LDY XTEMP
A7DC A9 00 LDA #0 ; MAKE MATCH FLAG FALSE ...
A7DE 85 90 STA USTKP ; ... USE STACK INDEX ...
A7E0 85 FD STA MATCHF ; ... & SET CC ALSO.
A7E2 60 XRN090 RTS
;
; XACCPT -- ACCEPT COMMAND PROCESSOR
;
A7E3 20 E7 B7 XACCPT JSR CHKEQS ; '='?
A7E6 D0 06 BNE XAC003 ; NO OR NOT YET
A7E8 A9 01 LDA #NULL ; SETUP FOR NULL TARGET
A7EA 85 AB STA XTEMP
A7EC D0 26 BNE XAC022 ; (BRA).
A7EE 20 E8 A4 XAC003 JSR ATOM ; CHECK FOR VARIABLE
A7F1 D0 08 BNE XAC009 ; ERROR.
A7F3 85 AB STA XTEMP ; SAVE ATOM TYPE.
A7F5 29 9D AND #SVAR+USVAR+NVAR+NULL+BPTR
A7F7 D0 03 BNE XAC020 ; VALID ATOM TYPE
A7F9 A9 02 LDA #IMPERR ; NONE OF THE ABOVE -- ERROR.
A7FB 60 XAC009 RTS ; RETURN WITH CC SET.
A7FC 20 E7 B7 XAC020 JSR CHKEQS ; CHECK FOR ASSIGNMENT OPTION.
A7FF F0 13 BEQ XAC022 ; YES.
A801 A5 92 LDA EXEC ; EXECUTE MODE?
A803 F0 F6 BEQ XAC009 ; NO.
A805 84 AC STY XTEMP+1 ; SAVE STATEMENT INDEX.
A807 A2 0C LDX #TELN-DTAB ; GET A LINE TO THE TEXP BUFFER
A809 20 9E AF JSR GETLIN
A80C C6 8F DEC TELN+3 ; REMOVE EOL
A80E 20 A8 B9 JSR TRAILB ; PROCESS UNDERSCORE IF PRESENT.
A811 4C 40 A8 JMP XAC024
A814 C8 XAC022 INY ; YES -- SKIP OVER '='.
A815 A5 AB LDA XTEMP ; SEE IF TARGET IS A STRING.
A817 29 18 AND #SVAR+USVAR
A819 F0 03 BEQ XAC023 ; NO.
A81B 20 A0 AB JSR SAVIT
A81E A5 B6 XAC023 LDA POINT ; SAVE 'POINT'.
A820 85 F4 STA GNUMB
A822 A5 B7 LDA POINT+1
A824 85 F5 STA GNUMB+1
A826 20 43 B9 JSR TEXP ; EVALUATE TEXT EXPRESSION.
; *S* LDA EXEC ; EXECUTE MODE?
A829 F0 D0 BEQ XAC009 ; NO.
A82B 84 AC STY XTEMP+1 ; YES -- RESTORE 'NP'
A82D A5 AB LDA XTEMP ; SEE IF TARGET IS A STRING?
A82F 29 18 AND #SVAR+USVAR
A831 F0 03 BEQ XAC238 ; NO.
A833 20 EF AB JSR RESIT ; YES -- RESTORE 'NP' FROM 'MP'
A836 A4 AC XAC238 LDY XTEMP+1
A838 A5 F4 LDA GNUMB ; RESTORE 'POINT'
A83A 85 B6 STA POINT
A83C A5 F5 LDA GNUMB+1
A83E 85 B7 STA POINT+1
;
; *** EXTERNAL ENTRY POINT FROM '.IN' ***
; EXPECTS STATMENT INDEX IN 'XTEMP+1'
; TARGET ATOM TYPE IN 'XTEMP'
; 'POINT' OR 'NP' SETUP PER 'ATOM' CALL.
;
A840 A5 8E XAC024 LDA TELN+2 ; MOVE START INDEX
A842 85 8A STA ACLN+2
A844 AA TAX
A845 A8 TAY
A846 A9 20 LDA #' ; INSERT LEADING BLANK
A848 D0 16 BNE XAC027 ; (BRA).
A84A E4 8F XAC025 CPX TELN+3 ; DONE?
A84C F0 27 BEQ XAC030 ; YES.
A84E BD 77 05 LDA TEXBUF,X ; NO -- GET NEXT CHAR
A851 E8 INX
A852 C0 FD XAC026 CPY #ACCLNG-1
A854 F0 1F BEQ XAC030 ; ACCEPT BUFFER FULL
; CHARACTER CONVERSION HERE.
A856 C9 61 CMP #'A+$20 ; LOWER CASE ALPHA?
A858 90 06 BCC XAC027 ; NO.
A85A C9 7B CMP #'Z+1+$20
A85C B0 02 BCS XAC027 ; NO.
A85E 49 20 EOR #$20 ; YES -- CONVERT TO UPPER CASE.
A860 91 88 XAC027 STA (ACLN),Y
A862 C8 INY
A863 C9 20 CMP #' ; BLANK?
A865 D0 E3 BNE XAC025 ; NO.
A867 E4 8F XAC028 CPX TELN+3 ; YES -- SKIP MULTIPLES.
A869 F0 0F BEQ XAC031 ; END OF TEXT.
A86B BD 77 05 LDA TEXBUF,X ; GET NEXT CHARACTER.
A86E E8 INX
A86F C9 20 CMP #' ; BLANK?
A871 D0 DF BNE XAC026 ; NO -- STORE IT.
A873 F0 F2 BEQ XAC028 ; YES -- IGNORE IT (BRA).
A875 A9 20 XAC030 LDA #' ; ADD TRAILING BLANK.
A877 91 88 STA (ACLN),Y
A879 C8 INY
A87A 84 8B XAC031 STY ACLN+3 ; END INDEX.
A87C A5 AB LDA XTEMP ; CHECK PARAMETER TYPE AGAIN.
A87E C9 01 CMP #NULL
A880 F0 2F BEQ XAC190 ; NONE -- ALL DONE
A882 29 84 AND #NVAR+BPTR
A884 D0 03 BNE XAC100 ; NUMERIC VARIABLE
A886 4C 91 AB JMP XCM300 ; STRING VARIABLE -- GO TO COMMON CODE & RET
A889 A0 FF XAC100 LDY #-1 ; CONVERT NUMBER TO BINARY REPRESENTATION
A88B C8 XAC110 INY ; SCAN TO NUMBER OR EOL
A88C B1 8C LDA (TELN),Y ; GET A CHAR
A88E C9 9B CMP #EOL ; END OF LINE?
A890 F0 09 BEQ XAC120 ; YES -- DONE
A892 C9 2D CMP #'- ; NO -- MINUS SIGN?
A894 F0 05 BEQ XAC120 ; YES -- DONE
A896 20 7A B7 JSR CNUMBR ; NO -- NUMERIC DIGIT?
A899 B0 F0 BCS XAC110 ; NO -- KEEP SCANNING
A89B A2 0C XAC120 LDX #TELN-DTAB ; NOW CONVERT NUMBER WE FOUND
A89D 20 B2 B6 JSR ASCDEC
A8A0 A0 00 LDY #0 ; MOVE VALUE TO VARIABLE.
A8A2 A5 B8 LDA NUMBER
A8A4 91 B6 STA (POINT),Y
A8A6 A5 AB LDA XTEMP ; SEE IF POINTER TO BYTE,
A8A8 C9 80 CMP #BPTR
A8AA F0 05 BEQ XAC190 ; YES -- ALL DONE.
A8AC C8 INY
A8AD A5 B9 LDA NUMBER+1
A8AF 91 B6 STA (POINT),Y
A8B1 A4 AC XAC190 LDY XTEMP+1 ; RESTORE LINE POINTER
A8B3 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
A8B5 60 RTS ; RETURN WITH CC SET.
;
; XMATCH -- MATCH COMMAND PROCESSOR
;
A8B6 B1 80 XMATCH LDA (INLN),Y ; GET FIRST MATCH FIELD BYTE.
A8B8 C9 9B CMP #EOL
A8BA D0 03 BNE XMA010
A8BC A9 02 LDA #IMPERR ; NULL MATCH FIELD IS ERROR
A8BE 60 XMA009 RTS ; RETURN WITH CC SET.
A8BF 20 43 B9 XMA010 JSR TEXP ; EVALUATE TEXT EXPRESSION OPERAND.
; *S* LDA EXEC ; EXECUTE MODE?
A8C2 F0 FA BEQ XMA009 ; NO -- DONE.
A8C4 A9 00 LDA #0 ; RESET MATCH FIELD NUMBER AND FLAG.
A8C6 85 FD STA MATCHF
A8C8 A9 2C LDA #', ; ',' IS DEFAULT MATCH FIELD DELIMITER
A8CA 85 E2 STA MFDEL
A8CC A5 8E LDA TELN+2 ; CHECK FOR NULL RESULT.
A8CE C5 8F CMP TELN+3
A8D0 F0 76 BEQ XMA400 ; NULL PATTERN -- NO MATCH.
; THROUGHOUT THE MAIN LOOP THE X REGISTER WILL = ACCEPT START INDEX.
A8D2 A6 8A LDX ACLN+2 ; ACCEPT BUFFER START INDEX
A8D4 84 AC STY XTEMP+1 ; SAVE INPUT INDEX.
A8D6 A4 8E LDY TELN+2 ; SETUP MATCH PATTERN START INDEX.
A8D8 B1 8C LDA (TELN),Y ; CHECK FOR ALTERNATE FIELD DELIMITER
A8DA C9 7C CMP #'|
A8DC D0 05 BNE XMA050 ; NO ALTERNATE SPECIFIED.
A8DE 85 E2 STA MFDEL ; SET ALTERNATE.
A8E0 C8 INY ; SKIP OVER VERTICAL BAR.
A8E1 D0 0C BNE XMA060 ; (BRA).
A8E3 B1 8C XMA050 LDA (TELN),Y ; GET 1ST CHAR OF OPERAND.
A8E5 C9 1F CMP #CRIGHT ; RIGHT ARROW?
A8E7 D0 0C BNE XMA100 ; NO.
A8E9 E8 INX ; YES -- SKIP FIRST CHAR IN ACCEPT BUFFER.
A8EA C8 INY ; SKIP OVER RIGHT ARROW TOO.
A8EB E4 8B CPX ACLN+3 ; NULL ACCEPT BUFFER?
A8ED F0 59 BEQ XMA400 ; YES -- NO MATCH.
A8EF C4 8F XMA060 CPY TELN+3 ; NULL OPERAND?
A8F1 F0 55 BEQ XMA400 ; YES.
A8F3 D0 EE BNE XMA050 ; NO (BRA).
A8F5 84 AB XMA100 STY XTEMP ; MATCH DATA INDEX (INNER LOOP),
A8F7 84 A2 STY TEMP+1 ; MATCH DATA INDEX (OUTER LOOP).
A8F9 86 A1 STX TEMP
A8FB 86 8A STX ACLN+2
A8FD E6 FD INC MATCHF ; INCREMENT MATCH FIELD NUMBER.
A8FF A4 AB XMA120 LDY XTEMP ; SEE IF ALL OF PATTERN HAS MATCHED
A901 E6 AB INC XTEMP
A903 C4 8F CPY TELN+3
A905 F0 37 BEQ XMA300 ; YES.
A907 B1 8C LDA (TELN),Y ; NOT SURE.
A909 C5 E2 CMP MFDEL
A90B F0 31 BEQ XMA300 ; YES.
A90D A4 8A LDY ACLN+2 ; NO -- MORE DATA TO MATCH?
A90F E6 8A INC ACLN+2
A911 C4 8B CPY ACLN+3
A913 F0 04 BEQ XMA140 ; NO -- AT END OF BUFFER.
A915 D1 88 CMP (ACLN),Y ; YES -- COMPARE DATA TO PATTERN
A917 F0 E6 BEQ XMA120 ; SO FAR SO GOOD.
A919 A5 A2 XMA140 LDA TEMP+1 ; RESET MATCH PATTERN INDEX.
A91B 85 AB STA XTEMP
A91D E6 A1 INC TEMP ; INCREMENT 'ACCBUF' INDEX.
A91F A5 A1 LDA TEMP
A921 85 8A STA ACLN+2
A923 C5 8B CMP ACLN+3
A925 D0 D8 BNE XMA120
A927 A4 A2 LDY TEMP+1 ; INCREMENT 'TEXBUF' INDEX TO NEXT FIELD.
A929 B1 8C XMA160 LDA (TELN),Y
A92B C4 8F CPY TELN+3 ; END OF MATCH PATTERN DATA?
A92D F0 09 BEQ XMA200 ; YES -- NO MATCH.
A92F C8 INY
A930 C5 E2 CMP MFDEL
A932 D0 F5 BNE XMA160 ; KEEP SCANNING.
A934 C4 8F CPY TELN+3 ; END OF MATCH STATEMENT?
A936 D0 BD BNE XMA100 ; NO.
A938 A9 00 XMA200 LDA #0 ; NO MATCH -- RESET FLAG.
A93A 85 FD STA MATCHF
A93C F0 0A BEQ XMA400 ; (BRA).
A93E A5 A1 XMA300 LDA TEMP ; SAVE START & END INDICES TO MATCH FIELD...
A940 8D 73 05 STA MATCHX ; ... FOR 'XMWSP'.
A943 A5 8A LDA ACLN+2
A945 8D 74 05 STA MATCHX+1
A948 A4 AC XMA400 LDY XTEMP+1 ; RESTORE INPUT LINE INDEX.
A94A A9 00 LDA #0 ; CLEAR LINE INDEX.
A94C 85 8A STA ACLN+2
A94E 4C 02 B8 JMP SCNEOL ; SCAN TO END OF INPUT LINE & RETURN.
;
; XMWSP -- MATCH WITH STRING PRODUCTION COMMAND PROCESSOR
;
A951 20 B6 A8 XMWSP JSR XMATCH ; FIRST DO ALL OF MATCH COMMAND.
A954 D0 30 BNE XMS090 ; SYNTAX ERROR.
A956 A5 92 LDA EXEC ; EXECUTE MODE?
A958 F0 2C BEQ XMS090 ; NO -- DONE (SYNTAX SAME AS MATCH).
A95A A5 FD LDA MATCHF ; WAS MATCH SUCCESSFUL?
A95C F0 28 BEQ XMS090 ; NO -- ALL DONE.
A95E 84 AB STY XTEMP
A960 8A TXA ; NOW SET $LEFT = DATA FROM ACCEPT START
A961 AC 73 05 LDY MATCHX ; ... TO START OF MATCH - 1.
A964 A2 00 LDX #LFTSTG-STAB
A966 20 87 A9 JSR MAKSTG
A969 D0 17 BNE XMS080 ; ERROR.
A96B AD 73 05 LDA MATCHX ; THEN SET $MATCH = DATA FROM MATCH.
A96E AC 74 05 LDY MATCHX+1
A971 A2 05 LDX #MATSTG-STAB
A973 20 87 A9 JSR MAKSTG
A976 D0 0A BNE XMS080 ; ERROR.
A978 AD 74 05 LDA MATCHX+1 ; THEN BRIGHT = DATA FROM MATCH +1 ...
A97B A4 8B LDY ACLN+3 ; ... TO END.
A97D A2 0B LDX #RITSTG-STAB
A97F 20 87 A9 JSR MAKSTG
A982 08 XMS080 PHP ; SAVE CC.
A983 A4 AB LDY XTEMP ; RESTORE INDEX.
A985 28 PLP
A986 60 XMS090 RTS ; RETURN WITH CC SET.
A987 85 C4 MAKSTG STA DP+2 ; DEFINE DATA PORTION.
A989 84 C5 STY DP+3
A98B A5 88 LDA ACLN
A98D 85 C2 STA DP
A98F A5 89 LDA ACLN+1
A991 85 C3 STA DP+1
A993 BD A9 A9 LDA STAB,X ; DEFINE NAME PORTION.
A996 85 C1 STA NP+3
A998 E8 INX
A999 86 C0 STX NP+2
A99B A9 A9 LDA #STAB
A99D 85 BE STA NP
A99F A9 A9 LDA #STAB/256
A9A1 85 BF STA NP+1
A9A3 20 9B B7 JSR SETSVL ; NAMED STRING VARIABLE LIST.
A9A6 4C B8 B2 JMP SINSRT ; INSERT STRING & RETURN WITH CC SET.
A9A9 STAB=* ; MATCH STRING NAME TABLE.
A9A9 05 4C 45 LFTSTG .BYTE LSEND,"LEFT"
A9AC 46 54
0005 LSEND=*-STAB
A9AE 0B 4D 41 MATSTG .BYTE MSEND,"MATCH"
A9B1 54 43 48
000B MSEND=*-STAB
A9B4 11 52 49 RITSTG .BYTE RSEND,"RIGHT"
A9B7 47 48 54
0011 RSEND=*-STAB
;
; XNEWV -- NEW VARIABLES COMMAND PROCESSOR
;
A9BA 20 FA B7 XNEWV JSR SLB ; SKIP LEADING BLANKS.
A9BD 20 E0 B7 JSR CHKTRM ; STATEMENT TERMINATOR?
A9C0 F0 0C BEQ XNV010 ; YES -- NO OPERANDS IS VALID.
A9C2 C9 23 CMP #'#
A9C4 F0 07 BEQ XNV008 ; NUMERIC VARIABLES ONLY.
A9C6 C9 24 CMP #'$
A9C8 F0 03 BEQ XNV008 ; STRING VARIABLES ONLY.
A9CA A9 02 LDA #IMPERR ; IMPROPER OPERAND,
A9CC 60 RTS ; RETURN WITH CC SET.
A9CD C8 XNV008 INY
; *** EXTERNAL ENTRY POINT FROM
A9CE 85 AB XNV010 STA XTEMP ; SAVE OPERAND.
A9D0 A5 92 LDA EXEC ; EXECUTE MODE?
A9D2 F0 21 BEQ XNV090 ; NO.
A9D4 A5 AB LDA XTEMP ; GET OPERAND.
A9D6 C9 23 CMP #'# ; CLEAR ONLY NUMERIC VARIABLES?
A9D8 F0 0B BEQ XNV020 ; YES -- SKIP STRING VARIABLES.
A9DA A5 B4 LDA S2H ; CLEAR STRING VARIABLES.
A9DC 85 B2 STA S2L
A9DE A5 B5 LDA S2H+1
A9E0 85 B3 STA S2L+1
A9E2 20 37 B2 JSR CLOSEM ; CLOSE IOCBS 3 THROUGH 7.
A9E5 A5 AB XNV020 LDA XTEMP ; GET OPERAND.
A9E7 C9 24 CMP #'$ ; CLEAR ONLY STRING VARIABLES?
A9E9 F0 03 BEQ XNV080 ; YES -- SKIP NUMERIC VARIABLES.
A9EB 20 3B B8 JSR ZERVAR ; ZERO NUMERIC VARIABLES & SET CC FOR EXIT.
A9EE A5 FF XNV080 LDA RUN ; RUN MODE?
A9F0 D0 03 BNE XNV090 ; YES -- DON'T PRINT 'READY'
A9F2 20 33 BF JSR RDYMES ; NO -- PRINT 'READY'.
A9F5 XNE090
A9F5 A9 00 XNV090 LDA #0 ; SET CC FOR EXIT.
A9F7 60 RTS ; RETURN WITH CC SET.
;
; XNEW -- NEW PROGRAM PROCESSOR
;
A9F8 F0 FB XNEW BEQ XNE090 ; SYNTAX SCAN ONLY
A9FA 20 FF A9 JSR CLRPRG ; CLEAR THE PROGRAM STORAGE AREA
A9FD F0 CF BEQ XNV010 ; (BRA) NOW CLEAR THE VARIABLES ALSO
A9FF A5 AE CLRPRG LDA S1L ; YES -- CLEAR PROGRAM STORAGE AREA
AA01 85 B0 STA S1H
AA03 A5 AF LDA S1L+1
AA05 85 B1 STA S1H+1
AA07 A9 00 LDA #0
AA09 85 90 STA USTKP ; CLEAR USE STACK,
AA0B 60 RTS ; RETURN WITH CC AND A * ZERO
;
; XCALL -- CALL MEMORY LOCATION PROCESSOR
;
AA0C 20 92 B8 XCALL JSR EXP ; ADDRESS SHOULD FOLLOW
AA0F A5 92 LDA EXEC ; EXECUTE MODE? ; NO.
AA11 F0 0E BEQ XCL090
AA13 98 TYA ; SAVE THE LINE INDEX FOR THE USER.
AA14 48 PHA
AA15 20 22 AA JSR XCL100 ; "OFF WE GO, INTO THE WILD BLUE YONDER"
AA18 68 PLA ; UNBELIEVEABLE, THE USER RETURNED.
AA19 A8 TAY ; RESTORE THE LINE INDEX.
AA1A 58 CLI ; JUST IN CASE!
AA1B D8 CLD ; DITTO.
AA1C A9 00 LDA #0 ; SET CC FOR EXIT,
AA1E 60 RTS ; RETURN WITH CC SET.
AA1F A9 02 XCL080 LDA #IMPERR ; ERROR.
AA21 60 XCL090 RTS ; RETURN WITH CC SET.
AA22 6C 93 00 XCL100 JMP (EXPSTK) ; TOO LATE TO CHANGE YOUR MIND.
;
; XUSE -- USE COMMAND PROCESSOR
;
AA25 F0 21 XUSE BEQ XJMP ; LET 'XJMP' PERFORM SYNTAX CHECK.
AA27 A5 FF LDA RUN ; IF IMMEDIATE -- DON'T PUT ANYTHING IN STACK.
AA29 F0 19 BEQ XUS100
AA2B A6 90 LDX USTKP ; USE STACK POINTER.
AA2D E0 10 CPX #USTKSZ
AA2F F0 10 BEQ XUS090 ; STACK FULL.
AA31 A5 84 LDA NXTLN ; NEXT LINE ADDRESS TO USE STACK.
AA33 9D 0B 05 STA USESTK,X
AA36 A5 85 LDA NXTLN+1
AA38 9D 0C 05 STA USESTK+1,X
AA3B E8 INX
AA3C E8 INX
AA3D 86 90 STX USTKP
AA3F D0 0C BNE XJP005 ; REST OF COMMAND IS JUST LIKE 'J:' (BRA).
AA41 A9 8B XUS090 LDA #USOERR ; STACK OVERFLOW ERROR.
AA43 60 RTS
AA44 85 90 XUS100 STA USTKP ; CLEAR USE STACK.
AA46 F0 05 BEQ XJP005 ; (BRA).
;
; XJMP -- JUMP COMMAND PROCESSOR
;
AA48 D0 03 XJMP BNE XJP005 ; EXECUTE MODE
AA4A 4C C1 B7 JMP SCNLBL ; SCAN OVER LABEL & RETURN.
; *** EXTERNAL ENTRY POINT (FROM 'XJMPM' & 'XUSE') ***
AA4D 20 FA B7 XJP005 JSR SLB
AA50 C8 INY ; SKIP OVER '*'
AA51 84 C4 STY DP+2 ; SETUP 'DP' TO POINT TO JUMP LABEL
AA53 20 B9 B7 JSR SCEOA ; SCAN TO END OF LABEL.
AA56 84 C5 STY DP+3
AA58 A5 80 LDA INLN
AA5A 85 C2 STA DP
AA5C A5 81 LDA INLN+1
AA5E 85 C3 STA DP+1
AA60 20 92 B7 JSR STMLST ; SETUP TO SCAN STATEMENT LIST.
AA63 84 AB STY XTEMP ; SAVE INPUT LINE POINTER
AA65 A2 3A XJP030 LDX #LP-DTAB ; CHECK FOR END OF STATEMENT LIST
AA67 20 9D B3 JSR SEND
AA6A F0 36 BEQ XJP200 ; END OF LIST -- LABEL NOT FOUND.
AA6C A0 06 LDY #6 ; CHECK FOR PRESENCE OF LABEL.
AA6E B1 BA LDA (LP),Y
AA70 C9 2A CMP #'*
AA72 D0 26 BNE XJP060 ; NO -- TRY NEXT STATEMENT
AA74 C8 INY
AA75 84 C8 STY MP+2 ; YES -- SETUP 'MP' TO POINT TO STATEMENT LABEL.
AA77 B1 BA XJP040 LDA (LP),Y ; SCAN TO END OF LABEL.
AA79 C8 INY
AA7A 20 A4 B7 JSR CKEOA ; END OF ATOM (LABEL)?
AA7D D0 F8 BNE XJP040 ; NO.
AA7F 88 DEY
AA80 84 C9 STY MP+3
AA82 A5 BA LDA LP ; SETUP POINTERS FOR ...
AA84 85 C6 STA MP ; ... 'SCOMP' CALL ...
AA86 85 84 STA NXTLN ; ... & STATEMENT TO EXECUTE.
AA88 A5 BB LDA LP+1
AA8A 85 C7 STA MP+1
AA8C 85 85 STA NXTLN+1
AA8E 20 F8 B2 JSR SCOMP ; COMPARE LABELS.
AA91 D0 07 BNE XJP060 ; NO MATCH.
AA93 A4 AB LDY XTEMP ; RESTORE INPUT LINE POINTER
AA95 84 FF STY RUN ; SET RUN MODE EVEN IF ALREADY SET.
AA97 A9 00 LDA #0
AA99 60 RTS ; RETURN WITH CC SET.
AA9A A2 3A XJP060 LDX #LP-DTAB ; GET POINTER TO NEXT STATEMENT.
AA9C 20 10 B4 JSR SNXTI
AA9F 4C 65 AA JMP XJP030
AAA2 A4 C4 XJP200 LDY DP+2 ; RESTORE LINE INDEX.
AAA4 A9 0A LDA #UNDERR ; UNDEFINED LABEL.
AAA6 60 RTS ; RETURN WITH CC SET.
;
; XJMPM -- JUMP ON MATCH RESULT COMMAND PROCESSOR
;
AAA7 D0 0C XJMPM BNE XJM030 ; EXECUTE MODE
AAA9 20 C1 B7 JSR SCNLBL ; SCAN OVER FIRST LABEL
AAAC D0 26 BNE XJM090 ; NOT EVEN ONE LABEL -- ERROR
AAAE 20 C1 B7 XJM010 JSR SCNLBL ; SCAN OVER REMAINING LABELS
AAB1 F0 FB BEQ XJM010
AAB3 D0 1D BNE XJM050 ; NORMAL RETURN.
AAB5 A5 FD XJM030 LDA MATCHF ; WAS PREVIOUS MATCH SUCCESSFUL?
AAB7 F0 11 BEQ XJM043 ; NO -- NO JUMP
AAB9 AA TAX ; YES -- USE FIELD # AS LOOP COUNT.
AABA CA XJM040 DEX
AABB D0 10 BNE XJM045 ; NOT THERE YET.
AABD 20 EE B7 JSR SKPSEP ; PRE-VALIDATE NEXT LABEL.
AAC0 20 E0 B7 JSR CHKTRM ; END OF STATEMENT?
AAC3 F0 0F BEQ XJM090 ; YES -- O.K.
AAC5 20 4D AA JSR XJP005 ; LET 'XJMP' DO THE DIRTY WORK.
AAC8 D0 0A BNE XJM090 ; ERROR.
AACA 4C 02 B8 XJM043 JMP SCNEOL ; SCAN TO END OF STATEMENT & RETURN.
AACD 20 C1 B7 XJM045 JSR SCNLBL ; SCAN OVER LABEL.
AAD0 F0 E8 BEQ XJM040 ; THERE WAS ONE THERE.
AAD2 A9 00 XJM050 LDA #0 ; TOO FEW LABELS IS O. K.
AAD4 XDU090
AAD4 60 XJM090 RTS ; RETURN WITH CC SET.
;
; XDUMP -- STRING & NUMERIC VARIABLE DUMP COMMAND PROCESSOR
;
AAD5 F0 FD XDUMP BEQ XDU090 ; SYNTAX SCAN.
AAD7 84 AC STY XTEMP+1 ; YES -- SAVE INPUT LINE INDEX
.IF DEBUG
LDA #CLEAR ; CLEAR SCREEN.
JSR CHOT
.ENDIF
AAD9 CE FE 02 DEC DSPFLG ; SET DISPLAY CONTROL CHARS FLAG
; DUMP ALL OF THE STRING VARIABLES
.IF DEBUG
LDA #16 ; PRODUCE STRING VARIABLE HEADER
JSR MESSOT
JSR NEWLIN
.ENDIF
AADC 20 9B B7 JSR SETSVL ; POINT TO STRING LIST.
AADF A2 3A XDU005 LDX #LP-DTAB
AAE1 20 9D B3 JSR SEND ; END OF STRING STORAGE?
AAE4 F0 2E BEQ XDU080 ; YES -- DONE.
AAE6 A2 38 LDX #NUMBER-DTAB ; MOVE STRING POINTER TO NUMBER
AAE8 A0 3A LDY #LP-DTAB
AAEA 20 CF B3 JSR DMOVI
AAED A9 24 LDA #'$ ;PREFIX NAME WITH '$'.
AAEF 20 6F AF JSR CHOT
AAF2 A0 02 LDY #2
AAF4 20 1F AB JSR PRTSFD ; PRINT STRING NAME.
AAF7 XDU020
.IF DEBUG
JSR PRTEQS ; SEPARATE NAME AND DATA WITH '='
.ENDIF
.IF DEBUG-1
AAF7 A9 3D LDA #'= ; SEPARATE NAME AND DATA WITH '='
AAF9 20 6F AF JSR CHOT
.ENDIF
AAFC A9 27 LDA #'' ; DELIMIT STRING DATA WITH '.
AAFE 20 6F AF JSR CHOT
AB01 20 1F AB JSR PRTSFD ; PRINT STRING DATA,
AB04 A9 27 XDU040 LDA #'' ; CLOSING DELIMITER,
AB06 20 6F AF JSR CHOT
AB09 20 60 B8 JSR NEWLIN ; END OF STRING.
AB0C A2 3A LDX #LP-DTAB ; INCREMENT TO NEXT STRING.
AB0E 20 10 B4 JSR SNXTI
AB11 4C DF AA JMP XDU005
; DUMP ALL OF THE NON-ZERO NUMERIC VARIABLES
AB14 20 60 B8 XDU080 JSR NEWLIN
.IF DEBUG
LDA #17 ; NUMERIC VARIABLE HEADER
JSR MESSOT
JSR NEWLIN
LDY #0
XDU082 LDA VARTAB,Y ; MOVE VARIABLE VALUE TO 'NUMBER'
STA NUMBER
LDA VARTAB+1,Y
STA NUMBER+1
ORA NUMBER ; TEST FOR ZERO VALUE
BEQ XDU005 ; ZERO -- DON'T PRINT
LDA #'*
JSR CHOT
TYA
LSR A ; PRODUCE VARIABLE NAME
ADC #'A
JSR CHOT
JSR PRTEQS ; '='
XDU085 INY ; BUMP INDEX TO NEXT VARIABLE.
INY
CPY #52 ; DONE?
BNE XDU082 ; NO.
JSR NEWLIN
JSR NEWLIN
; DUMP THE CONTENT OF THE USE STACK
LDA #18 ; PRODUCE USE STACK HEADER
JSR MESSOT
JSR NEWLIN
LDX USTKP ; STACK EMPTY?
BEQ XDU088 ; YES.
XDU087 JSR SPACE ; NO -- PRINT LINE #(S).
LDA USESTK-2,X ; GET POINTER TO STORED LINE.
STA POINT
LDA USESTK-1,X
STA POINT+1
JSR GTLNNO ; EXTRACT LINE NUMBER.
STX XTEMP
LDX #LINENO-DTAB ; PRINT LINE NUMBER.
JSR DECASC
LDX XTEMP
DEX
DEX
BNE XDU087 ; MORE TO PRINT.
JSR NEWLIN
XDU088 JSR NEWLIN
; DUMP THE GRAPHICS PARAMETERS
LDA #19 ; PRODUCE GRAPHICS HEADER.
JSR MESSOT
JSR NEWLIN
LDA #'X ; X=FLOOR(<VALUE>).
JSR CHOT
JSR PRTEQS ; '='.
LDX #GX-DTAB
JSR DECASC
JSR SPACES
LDA #'Y ; Y=FLOOR(<VALUE>).
JSR CHOT
JSR PRTEQS ; '='.
LDX #GY-DTAB
JSR DECASC
JSR SPACES
LDA #20 ; THETA=<VALUE>.
JSR MESSOT
LDX #THETA-DTAB
JSR DECASC
JSR NEWLIN
; REPORT ON FREE MEMORY
JSR NEWLIN
LDA #21 ; FREE MEMORY = <VALUE>.
JSR MESSOT
LDY #S2L-DTAB ; <VALUE> = 'S2L' - 'S1H' + 1.
JSR DLOADA
LDY #S1H-DTAB
JSR DSUBA
LDA #1
JSR DADDS
JSR DECASC ; PRINT RESULT.
JSR NEWLIN
.ENDIF
AB17 EE FE 02 INC DSPFLG ; RESET DISPLAY CONTROL CHARS FLAG.
AB1A A4 AC LDY XTEMP+1 ; DONE -- RESTORE INPUT LINE INDEX.
AB1C A9 00 LDA #0 ; SET CC FOR EXIT.
AB1E 60 RTS ; RETURN WITH CC SET.
.IF DEBUG
PRTEQS LDA #'= ; PRINT '=' ...
JMP CHOT ; ... & RETURN.
.ENDIF
AB1F B1 B8 PRTSFD LDA (NUMBER),Y ; GET NAME/DATA LENGTH.
AB21 AA TAX
AB22 F0 12 BEQ PFD090 ; DONE.
AB24 C8 PFD010 INY
AB25 D0 02 BNE PFD020
AB27 E6 B9 INC NUMBER+1 ; INDEX WRAPAROUND -- BUMP POINTER.
AB29 B1 B8 PFD020 LDA (NUMBER),Y ; GET CHARACTER.
AB2B 20 6F AF JSR CHOT
AB2E CA DEX ; DONE?
AB2F D0 F3 BNE PFD010 ; NO.
AB31 C8 INY ; YES.
AB32 D0 02 BNE PFD090
AB34 E6 B9 INC NUMBER+1 ; INDEX WRAPAROUND -- BUMP POINTER.
AB36 60 PFD090 RTS
;
; COMPUTE COMMAND PROCESSOR
;
AB37 20 E8 A4 XCMPUT JSR ATOM ; CHECK FOR TARGET VARIABLE
AB3A D0 63 BNE XCM900 ; INVALID ATOM.
AB3C C9 04 CMP #NVAR
AB3E F0 0B BEQ XCM100 ; NUMERIC ASSIGNMENT.
AB40 C9 80 CMP #BPTR ; BYTE POINTER?
AB42 F0 07 BEQ XCM100 ; YES -- SAME AS NUMERIC VARIABLE.
AB44 29 18 AND #SVAR+USVAR ; STRING ASSIGNMENT?
AB46 D0 36 BNE XCM200 ; YES.
AB48 A9 02 XCM092 LDA #IMPERR ; NO -- ERROR.
AB4A 60 RTS
; ARITHMETIC ASSIGNMENT
AB4B 85 AB XCM100 STA XTEMP ; SAVE TARGET TYPE.
AB4D 20 E7 B7 JSR CHKEQS ; CHECK FOR ASSIGNMENT OPERATOR NEXT.
AB50 D0 F6 BNE XCM092 ; ASSIGNMENT SYNTAX ERROR.
AB52 A5 B6 LDA POINT ; SAVE TARGET ADDRESS.
AB54 48 PHA
AB55 A5 B7 LDA POINT+1
AB57 48 PHA
AB58 C8 INY ; PREPARE TO EVALUATE EXPRESSION.
AB59 20 92 B8 JSR EXP ; EVALUATE EXPRESSION.
AB5C 68 PLA ; RESTORE TARGET ADDRESS.
AB5D 85 B7 STA POINT+1
AB5F 68 PLA
AB60 85 B6 STA POINT
AB62 A5 92 LDA EXEC ; EXECUTE MODE?
AB64 F0 39 BEQ XCM900 ; NO.
AB66 84 AC STY XTEMP+1 ; SAVE LINE INDEX.
AB68 A0 00 LDY #0 ; STORE RESULT TO TARGET.
AB6A A5 93 LDA EXPSTK
AB6C 91 B6 STA (POINT),Y
AB6E A5 AB LDA XTEMP ; SEE IF TARGET IS POINTER TO BYTE.
AB70 C9 80 CMP #BPTR
AB72 F0 05 BEQ XCM120 ; YES -- ALL DONE.
AB74 C8 INY
AB75 A5 94 LDA EXPSTK+1
AB77 91 B6 STA (POINT),Y
AB79 A4 AC XCM120 LDY XTEMP+1 ; RESTORE LINE INDEX.
AB7B A9 00 LDA #0 ; COMPUTE WAS A SUCCESS.
AB7D 60 RTS
; STRING ASSIGNMENT
AB7E 20 E7 B7 XCM200 JSR CHKEQS ; ASSIGNMENT OPERATOR?
AB81 D0 C5 BNE XCM092 ; NO -- ERROR
AB83 20 A0 AB JSR SAVIT ; SAVE 'NP' TO 'MP' TEMPORARILY
AB86 C8 INY ; SKIP OVER '='
AB87 20 43 B9 JSR TEXP ; EVALUATE TEXT EXPRESSION
; *S* LDA EXEC ; EXECUTE MODE?
AB8A F0 13 BEQ XCM900 ; NO -- DON'T DO ASSIGNMENT
AB8C 84 AC STY XTEMP+1
AB8E 20 EF AB JSR RESIT ; RESTORE 'NP' FROM 'MP'.
; *** EXTERNAL ENTRY POINT FROM 'XACCPT' ***
AB91 A2 42 XCM300 LDX #DP-DTAB ; MOVE 'TELN' TO 'DP'
AB93 A0 0C LDY #TELN-DTAB
AB95 20 C5 B3 JSR PMOVE
AB98 20 B8 B2 JSR SINSRT ; INSERT STRING.
AB9B 08 PHP
AB9C A4 AC LDY XTEMP+1
AB9E 28 PLP
AB9F 60 XCM900 RTS ; RETURN WITH CC SET.
ABA0 A5 92 SAVIT LDA EXEC ; EXECUTE MODE?
ABA2 F0 40 BEQ SAV090 ; NO.
ABA4 98 TYA ; SAVE Y REGISTER
ABA5 48 PHA
ABA6 A5 B0 LDA S1H ; 'MEMA' = 'S1H'
ABA8 85 D2 STA MEMA
ABAA 85 C6 STA MP ; 'MP' = 'S1H' ALSO.
ABAC A5 B1 LDA S1H+1
ABAE 85 D3 STA MEMA+1
ABB0 85 C7 STA MP+1
ABB2 A9 01 LDA #257 ; 'MEMB' = 257.
ABB4 85 D4 STA MEMB
; *S* LDA #257/256
ABB6 85 D5 STA MEMB+1
ABB8 20 27 B4 JSR MALLOC ; *** ALL THIS JUST FOR OVERFLOW TEST??? ***
ABBB D0 2F BNE SAV190
ABBD A0 02 LDY #2 ; TARGET STRING START INDEX.
ABBF 84 C8 STY MP+2
ABC1 84 C9 STY MP+3
ABC3 A4 C0 LDY NP+2 ; SOURCE STRING START INDEX.
ABC5 C4 C1 CPY NP+3 ; NULL SOURCE?
ABC7 F0 1C BEQ SAV100 ; YES -- ERROR.
ABC9 C4 C1 SAV010 CPY NP+3 ; END OF STRING
ABCB F0 15 BEQ SAV080 ; YES
ABCD B1 BE LDA (NP),Y ; NO -- GET A CHAR
ABCF C8 INY
ABD0 84 A1 STY TEMP
ABD2 20 A4 B7 JSR CKEOA ; END OF ATOM (STRING NAME)?
ABD5 F0 0E BEQ SAV100 ; YES -- ERROR
ABD7 A4 C9 LDY MP+3 ; STORE A CHAR
ABD9 91 C6 STA (MP),Y
ABDB C8 INY
ABDC 84 C9 STY MP+3
ABDE A4 A1 LDY TEMP
ABE0 D0 E7 BNE SAV010 ; TRY AGAIN (BRA).
ABE2 68 SAV080 PLA ; RESTORE Y REGISTER
ABE3 A8 TAY
ABE4 60 SAV090 RTS
ABE5 20 EF AB SAV100 JSR RESIT ; UNDO WHAT WE DID
ABE8 68 PLA ; RESTORE Y REGISTFR
ABE9 A8 TAY
ABEA A9 82 LDA #ATMERR+NS ; INVALID STRING NAME
ABEC 4C 6C A1 SAV190 JMP PSTOP ; ABORT COMMAND
ABEF A5 C6 RESIT LDA MP ; DEALLOCATE TEMPORARY MEMORY
ABF1 85 B0 STA S1H
ABF3 A5 C7 LDA MP+1
ABF5 85 B1 STA S1H+1
ABF7 A2 3E LDX #NP-DTAB ; RESTORE 'NP' FROM 'MP'
ABF9 A0 46 LDY #MP-DTAB
ABFB 4C C5 B3 JMP PMOVE ; & RETURN
;
; XGRAPH -- GRAPHICS COMMAND PROCESSOR
;
ABFE A5 92 XGRAPH LDA EXEC ; EXECUTE MODE?
AC00 F0 08 BEQ XGR020 ; NO
AC02 AD 54 05 LDA GRFLAG ; YES -- GRAPHICS SCREEN OPEN?
AC05 D0 03 BNE XGR020 ; YES
AC07 20 D5 AF JSR GSOPEN ; NO -- OPEN GRAPHICS SCREEN
AC0A 20 19 AC XGR020 JSR GCOMND ; PROCESS ONE GRAPHICS SUB-COMMAND
AC0D 20 FA B7 JSR SLB ; SEE IF MULTIPLES
AC10 C8 INY
AC11 C9 3B CMP #';
AC13 F0 E9 BEQ XGRAPH ; YES.
AC15 88 DEY ; NO -- ALL DONE
AC16 A9 00 LDA #0 ; CLEAR CC FOR NORMAL EXIT
AC18 60 RTS ; RETURN WITH CC SET.
; 'GCOMND' PROCESS ONE GRAPHICS SUB-COMMAND OR NESTED GROUP
AC19 20 FA B7 GCOMND JSR SLB ; SKIP LEADING BLANKS.
AC1C C9 28 CMP #'( ; CHECK FOR GROUPING WITH '(' & ')'
AC1E F0 22 BEQ GCM100
AC20 20 E8 A4 JSR ATOM ; CHECK ATOM TYPE.
AC23 D0 1A BNE GCM090 ; ATOM ERROR.
AC25 29 86 AND #NUM+NVAR+BPTR ; IF NUMERIC, THEN TREAT AS ITERATION COUNT
AC27 D0 2A BNE GCM200 ; YEP.
AC29 A2 97 LDX #GTAB-CTAB ; NO -- ASSUME ITS A SUB-COMMAND.
AC2B 20 10 A3 JSR CMATCH
AC2E D0 0F BNE GCM090 ; NO -- ERROR.
AC30 BD 2F A4 LDA CDTAB,X ; SETUP ADDRESS OF G-ROUTINE.
AC33 8D 06 05 STA GJUMP+1
AC36 BD 30 A4 LDA CDTAB+1,X
AC39 8D 07 05 STA GJUMP+2
AC3C 4C 05 05 JMP GJUMP ; GO TO G-ROUTINE & RETURN.
AC3F 4C 6C A1 GCM090 JMP PSTOP ; FATAL ERROR -- STOP EXECUTION.
; THIS SECTION HANDLES NESTED GROUPS.
AC42 C8 GCM100 INY ; SKIP OVER '('.
AC43 20 FE AB JSR XGRAPH ; PROCESS ONE SUB-COMMAND OR NESTED GROUP
AC46 20 FA B7 JSR SLB
AC49 C8 INY
AC4A C9 29 CMP #') ; MATCHING PAREN?
AC4C F0 4C BEQ GCM390 ; YES -- O.K.
AC4E 88 DEY ; NO -- ERROR.
AC4F A9 02 LDA #NSTERR
AC51 D0 EC BNE GCM090 ; (BRA).
; THIS SECTION HANDLES ITERATIONS
AC53 A5 92 GCM200 LDA EXEC ; EXECUTE MODE?
AC55 F0 36 BEQ GCM300 ; NO -- SYNTAX SCAN ONLY.
AC57 A5 B8 LDA NUMBER ; SEE IF ZERO ITERATIONS.
AC59 05 B9 ORA NUMBER+1
AC5B F0 30 BEQ GCM300 ; YES -- SCAN OVER ITERATION BODY.
AC5D A5 DE LDA LS ; NO -- SAVE COUNTER ('LS') ...
AC5F 48 PHA
AC60 A5 DF LDA LS+1
AC62 48 PHA
AC63 98 TYA ; ... & LINE INDEX,
AC64 48 PHA
AC65 A5 B8 LDA NUMBER ; GET LOOP COUNT TO 'LS'.
AC67 85 DE STA LS
AC69 A5 B9 LDA NUMBER+1
AC6B 85 DF STA LS+1
AC6D 20 19 AC GCM220 JSR GCOMND ; PROCESS ONE COMMAND.
AC70 A2 5E LDX #LS-DTAB ; DECREMENT ITERATION COUNT
AC72 A9 FF LDA #-1
AC74 20 4D B6 JSR DADDS
AC77 A5 DE LDA LS ; CHECK FOR RESULT = 0.
AC79 05 DF ORA LS+1
AC7B F0 08 BEQ GCM240 ; DONE.
AC7D 20 46 B8 JSR ABRTCK ; CHECK FOR OPERATOR ABORT.
AC80 68 PLA ; NOT DONE -- RESTORE SCAN INDEX
AC81 48 PHA
AC82 A8 TAY
AC83 D0 E8 BNE GCM220 ; (BRA) EXECUTE BODY AGAIN.
AC85 68 GCM240 PLA ; THROW AWAY STARTING INDEX.
AC86 68 PLA ; RESTORE 'LS'.
AC87 85 DF STA LS+1
AC89 68 PLA
AC8A 85 DE STA LS
AC8C 60 RTS
; THIS SECTION SYNTAX SCANS THE BODY OF AN ITERATION.
AC8D A5 92 GCM300 LDA EXEC ; SAVE CURRENT VALUE.
AC8F 48 PHA
AC90 A9 00 LDA #0 ; SETUP FOR SCAN ONLY
AC92 85 92 STA EXEC
AC94 20 19 AC JSR GCOMND ; *** RECURSIVE CALL ***
AC97 68 PLA
AC98 85 92 STA EXEC ; RESTORE MODE.
AC9A 60 GCM390 RTS ; RETURN WITH CC SET.
;
; XSOUND -- SOUND COMMAND PROCESSOR
;
AC9B A2 08 XSOUND LDX #AUREGS*2 ; SETUP INDEX TO # OF REGS
AC9D 86 AB STX XTEMP
AC9F A5 92 LDA EXEC ; EXECUTE MODE?
ACA1 F0 03 BEQ XSD020 ; NO.
ACA3 20 72 B8 JSR AUDCLR ; YES -- CLEAR AUDIO REGISTERS
ACA6 20 E8 A4 XSD020 JSR ATOM ; SCAN FOR VARIABLE NAME.
ACA9 D0 32 BNE XSD090 ; ATOM SYNTAX ERROR
ACAB C9 01 CMP #NULL ; END OF OPERANDS?
ACAD F0 2E BEQ XSD090 ; YES.
ACAF C9 02 CMP #NUM ; NUMERIC CONSTANT?
ACB1 D0 08 BNE XSD023 ; NO.
ACB3 A5 B8 LDA NUMBER ; YES -- SAVE VALUE.
ACB5 09 80 ORA #$80 ; SET FLAG FOR 'TONES'
ACB7 85 B7 STA POINT+1
ACB9 D0 04 BNE XSD027 ; (BRA).
ACBB 29 84 XSD023 AND #NVAR+BPTR ; NUMERIC VARIABLE?
ACBD F0 1C BEQ XSD085 ; NO.
ACBF A6 AB XSD027 LDX XTEMP ; GET INDEX (5 - OPERAND #).
ACC1 A5 92 LDA EXEC ; EXECUTE MODE?
ACC3 F0 0A BEQ XSD030 ; NO -- CONTINUE SYNTAX SCAN.
ACC5 A5 B6 LDA POINT ; YES -- PUT VAR ADDRESS TO LIST.
ACC7 9D 53 05 STA AUDIOR-2,X
ACCA A5 B7 LDA POINT+1
ACCC 9D 54 05 STA AUDIOR-1,X
ACCF CA XSD030 DEX
ACD0 CA DEX
ACD1 F0 0A BEQ XSD090 ; NO MORE OPERANDS ALLOWED.
ACD3 86 AB STX XTEMP
ACD5 20 EE B7 JSR SKPSEP ; SKIP SEPARATOR.
ACD8 4C A6 AC JMP XSD020
ACDB XIN080
ACDB A9 02 XSD085 LDA #IMPERR ; IMPROPER OPERAND.
ACDD XIN090
ACDD 60 XSD090 RTS ; RETURN WITH CC SET.
;
; XIN -- READ COMMAND PROCESSOR
;
ACDE A9 04 XIN LDA #OREAD ; READ DIRECTION.
ACE0 20 B7 B1 JSR SCNDEV ; CONVERT DEVICE SPEC TO IOCB INDEX.
ACE3 D0 F8 BNE XIN090 ; ERROR.
ACE5 86 AD STX XTEMP+2 ; SAVE IOCB INDEX.
ACE7 20 EE B7 JSR SKPSEP ; SKIP OVER SEPARATOR.
ACEA 20 E8 A4 JSR ATOM ; FIND TYPE OF VARIABLE.
ACED D0 EE BNE XIN090 ; ERROR.
ACEF 85 AB STA XTEMP
ACF1 29 9D AND #SVAR+USVAR+NVAR+NULL+BPTR ; VALID TYPE?
ACF3 F0 E6 BEQ XIN080 ; NO.
ACF5 A5 92 LDA EXEC ; EXECUTE MODE?
ACF7 F0 E4 BEQ XIN090 ; NO.
ACF9 84 AC STY XTEMP+1 ; SAVE LINE INDEX.
ACFB A6 AD LDX XTEMP+2 ; GET IOCB INDEX.
ACFD A0 00 LDY #0 ; INIT INDEX TO ACCEPT BUFFER.
ACFF 84 8E STY TELN+2
AD01 AD 60 05 LDA OPNBUF ; SEE IF READING FROM TEXT SCREEN.
AD04 C9 45 CMP #'E
AD06 D0 04 BNE XIN030 ; NO.
AD08 98 TYA ; YES -- ENABLE CURSOR (Y = 0).
AD09 20 65 B8 JSR CRSNOP ; MAKE IT APPEAR.
AD0C 20 11 B1 XIN030 JSR DIN ; GET A CHARACTER FROM DEVICE.
AD0F C9 9B CMP #EOL ; END OF LINE?
AD11 F0 0E BEQ XIN040 ; YES -- DONE.
AD13 91 8C STA (TELN),Y
AD15 C8 INY
AD16 C0 FE CPY #TEXLNG ; BUFFER FULL?
AD18 D0 F2 BNE XIN030 ; NO.
AD1A 20 11 B1 XIN035 JSR DIN ; YES -- FLUSH TO EOL.
AD1D C9 9B CMP #EOL
AD1F D0 F9 BNE XIN035
AD21 84 8F XIN040 STY TELN+3 ; SAVE STRING END INDEX.
AD23 20 65 B8 JSR CRSNOP ; DISABLE CURSOR AGAIN (A = $9B)
AD26 4C 40 A8 JMP XAC024 ; GO TO ACCEPT CODE TO FINISH PROCESSING.
;
; XOUT -- WRITE COMMAND PROCESSOR
;
AD29 A9 08 XOUT LDA #OWRIT ; WRITE DIRECTION.
AD2B 20 B7 B1 JSR SCNDEV ; CONVERT I/O SPEC TO DEVICE INDEX.
AD2E D0 2B BNE XOT090 ; ERROR.
AD30 86 AB STX XTEMP ; SAVE IOCB INDEX.
AD32 B1 80 LDA (INLN),Y
AD34 20 E0 B7 JSR CHKTRM ; TERMINATOR FOLLOWING DEVICE SPEC?
AD37 F0 01 BEQ XOT005 ; YES -- DON'T ADVANCE INDEX.
AD39 C8 INY ; NO -- SKIP OVER SINGLE SEPARATOR.
AD3A 20 43 B9 XOT005 JSR TEXP ; REST OF STATEMENT IS A TEXT EXPRESSION
; *S* LDA EXEC ; EXECUTE MODE?
AD3D F0 1C BEQ XOT090 ; NO.
AD3F 84 AC STY XTEMP+1 ; SAVE LINE INDEX.
AD41 A6 AB LDX XTEMP ; GET IOCB INDEX.
AD43 A4 8E LDY TELN+2 ; START OF TEXT EXPRESSION EVALUATION.
AD45 C4 8F XOT010 CPY TELN+3 ; DONE?
AD47 F0 09 BEQ XOT020 ; YES.
AD49 B9 77 05 LDA TEXBUF,Y ; NO -- PUT CHAR TO DEVICE.
AD4C 20 16 B1 JSR DOUT
AD4F C8 INY
AD50 D0 F3 BNE XOT010 ; (BRA).
AD52 A9 9B XOT020 LDA #EOL ; TERMINATE RECORD.
AD54 20 16 B1 JSR DOUT
AD57 A4 AC LDY XTEMP+1
AD59 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT,
AD5B 60 XOT090 RTS ; RETURN WITH CC SET.
;
; XDONE -- CLOSE COMMAND PROCESSOR
;
AD5C A9 00 XDONE LDA #0 ; INVALID OPEN CODE MEANS CLOSE.
AD5E 20 B7 B1 JSR SCNDEV ; CONVERT DEVICE SPEC TO IOCB INDEX,
AD61 D0 09 BNE XDN090 ; ERROR.
AD63 A5 92 LDA EXEC ; EXECUTE MODE?
AD65 F0 05 BEQ XDN090 ; NO.
AD67 20 FD B0 JSR DCLOSE ; YES -- CLOSE IOCB & DEVICE.
AD6A A9 00 LDA #0 ; SET CC FOR NORMAL EXIT
AD6C XWT090
AD6C 60 XDN090 RTS ; RETURN WITH CC SET
;
; WAIT COMMAND PROCESSOR
;
AD6D 20 92 B8 XWAIT JSR EXP ; THERE MUST BE AN EXPRESSION FOLLOWING
AD70 A5 92 LDA EXEC ; EXECUTE MODE?
AD72 F0 F8 BEQ XWT090 ; NO -- ALL DONE.
AD74 A2 13 LDX #EXPSTK-DTAB ; YES -- WORK WITH COUNT
AD76 84 AB STY XTEMP ; SAVE LINE INDEX
AD78 A4 AB XWT010 LDY XTEMP ; RESTORE INDEX
AD7A A5 93 LDA EXPSTK ; ALL DONE?
AD7C 05 94 ORA EXPSTK+1
AD7E F0 EC BEQ XWT090 ; YES
AD80 A4 14 LDY RTCLOK+2 ; NO -- WAIT FOR ...
AD82 20 46 B8 XWT020 JSR ABRTCK ; ... OPERATOR ABORT
AD85 C4 14 CPY RTCLOK+2
AD87 F0 F9 BEQ XWT020 ; ... OR CLOCK TO CHANGE
AD89 A9 FF LDA #-1 ; DECREMENT COUNT
AD8B 20 4D B6 JSR DADDS
AD8E 4C 78 AD JMP XWT010
;
; XCASS -- CASSETTE ON/OFF COMMAND PROCESSOR
;
AD91 A2 ED XCASS LDX #CCTAB-CTAB ; CHECK FOR 'ON' OR 'OFF'.
AD93 20 10 A3 JSR CMATCH
AD96 D0 09 BNE XCA090 ; NOT FOUND -- ERROR.
AD98 A5 92 LDA EXEC ; EXECUTE MODE?
AD9A F0 05 BEQ XCA090 ; NO.
AD9C 8E 02 D3 STX PACTL ; YES -- ISSUE COMMAND.
AD9F A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
ADA1 60 XCA090 RTS ; RETURN WITH CC SET
;
; XCSYNC -- CASSETTE SYNC COMMAND PROCESSOR
;
ADA2 F0 1B XCSYNC BEQ XCS090 ; SYNTAX SCAN.
ADA4 AD 02 D3 LDA PACTL ; CHECK CASSETTE MOTOR.
ADA7 29 08 AND #$08
ADA9 D0 12 BNE XCS080 ; MOTOR OFF.
ADAB A9 10 LDA #$10 ; ON - WAIT FOR MARK TO SPACE
ADAD 20 46 B8 XCS010 JSR ABRTCK ; WAIT FOR BREAK...
ADB0 2C 0F D2 BIT SKSTAT
ADB3 F0 F8 BEQ XCS010 ; ... OR MARK.
ADB5 20 46 B8 XCS020 JSR ABRTCK ; WAIT FOR BREAK...
ADB8 2C 0F D2 BIT SKSTAT
ADBB D0 F8 BNE XCS020 ; ... OR SPACE.
ADBD A9 00 XCS080 LDA #0 ; SET CC FOR NORMAL EXIT.
ADBF 60 XCS090 RTS ; RETURN WITH CC SET.
;
; XTRACE -- TRACE MODE ON/OFF COMMAND
;
ADC0 A2 ED XTRACE LDX #CCTAB-CTAB ; CHECK FOR 'ON' OR 'OFF'.
ADC2 20 10 A3 JSR CMATCH
ADC5 D0 0C BNE XTR090 ; NOT FOUND -- ERROR.
ADC7 A5 92 LDA EXEC ; EXECUTE MODE?
ADC9 F0 08 BEQ XTR090 ; NO.
ADCB 8A TXA ; YES -- 'OFF' RESULTS IN ...
ADCC 49 3C EOR #CASSOF-$80 ; ... 0 IN REGISTER A.
ADCE 8D 75 05 STA TRACE ; SET FLAG.
ADD1 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
ADD3 60 XTR090 RTS ; RETURN WITH CC SET.
;
; XSAVE -- SAVE COMMAND PROCESSOR
;
ADD4 20 9C B0 XSAVE JSR DNAME ; EXTRACT DEVICE/FILENAME.
ADD7 20 EE B7 JSR SKPSEP ; SKIP SEPARATO(S).
ADDA A5 92 LDA EXEC
ADDC F0 24 BEQ XSV090 ; NO.
ADDE A2 30 LDX #IOCB3
ADE0 A9 08 LDA #OWRIT ; YES -- OPEN DEVICE FOR OUTPUT.
ADE2 20 B7 B0 JSR DOPEN
ADE5 A9 0B LDA #PUTC ; SETUP IOCB FOR PUT CHARACTER.
ADE7 9D 42 03 STA ICCOM,X
ADEA A9 B0 LDA #$80+IOCB3 ; RE-ROUTE 'CHOT' OUTPUT TO DEVICE.
ADEC 8D 70 05 STA CDEST
ADEF 20 30 AE JSR LISTER ; OUTPUT PROGRAM TO DEVICE.
ADF2 A2 30 LDX #IOCB3
ADF4 20 FD B0 JSR DCLOSE ; CLOSE DEVICE.
ADF7 A9 06 LDA #EPUTC-IOVBAS ; RESTORE 'CHOT' OUTPUT.
ADF9 8D 70 05 STA CDEST
; *** EXTERNAL ENTRY POINT FROM 'XLIST' ***
ADFC 20 33 BF XSV050 JSR RDYMES ; GENERATE "READY" MESSAGE.
ADFF A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
AE01 XLD090
AE01 60 RTS ; RETURN WITH CC SET.
AE02 4C 30 AE XSV090 JMP LISTER ; SYNTAX CHECK & RETURN WITH CC SET.
;
; XLOAD -- LOAD COMMAND PROCESSOR
;
AE05 20 7E B1 XLOAD JSR SFNAME ; EXTRACT DEVICE/FILENAME
AE08 D0 F7 BNE XLD090 ; ERROR.
AE0A A5 92 LDA EXEC ; EXECUTE MODE?
AE0C F0 F3 BEQ XLD090 ; NO.
AE0E A2 30 LDX #IOCB3
AE10 A9 04 LDA #OREAD ; YES -- OPEN DEVICE FOR READING.
AE12 20 B7 B0 JSR DOPEN
AE15 8E 72 05 STX LOADFG ; SET LOAD FLAG.
AE18 A5 FF LDA RUN ; RUN MODE LOAD? #
AE1A F0 03 BEQ XLD050 ; NO -- IMMEDIATE (DON'T CLEAR PROGRAM)
AE1C 20 FF A9 JSR CLRPRG ; CLEAR PROGRAM STORAGE AREA.
AE1F A9 00 XLD050 LDA #0 ; CLEAR USE STACK.
AE21 85 90 STA USTKP
AE23 4C 9F A0 JMP MLLOAD ; LOAD UNTIL I/O ERROR OR END OF FILE.
; SEE 'GETCOM'.
;
; XLIST -- LIST COMMAND PROCESSOR
;
; *** EXTERNAL ENTRY POINT FROM 'XSAVE' ***
AE26 20 30 AE XLIST JSR LISTER ; DO THE LIST PROCESS,
AE29 D0 04 BNE XLS009 ; ERROR.
AE2B A5 92 LDA EXEC ; EXECUTE MODE?
AE2D D0 CD BNE XSV050 ; YES -- SIGN OFF & RETURN.
AE2F 60 XLS009 RTS ; RETURN WITH CC SET
AE30 20 E8 A4 LISTER JSR ATOM ; GET START LINE#
AE33 D0 FA BNE XLS009 ; ERROR -- RETURN.
AE35 C9 01 CMP #NULL
AE37 F0 3B BEQ XLS200 ; NO START LINE #.
AE39 C9 02 CMP #NUM
AE3B D0 16 BNE XLS029 ; SYNTAX ERROR.
AE3D A5 B8 LDA NUMBER ; SAVE VALUE IN 'LS'.
AE3F 85 DE STA LS
AE41 A5 B9 LDA NUMBER+1
AE43 85 DF STA LS+1
AE45 20 EE B7 JSR SKPSEP ; SKIP SEPARATOR.
AE48 20 E8 A4 JSR ATOM ; GET ENDING LINE #.
AE4B D0 E2 BNE XLS009 ; INVALID ATOM.
AE4D C9 01 CMP #NULL
AE4F F0 1D BEQ XLS180 ; NO END LINE #.
AE51 C9 02 CMP #NUM
AE53 D0 69 XLS029 BNE XLS900 ; SYNTAX ERROR (SKIP BRANCH POINT)
AE55 A5 B8 LDA NUMBER ; SAVE VALUE IN 'LE'.
AE57 85 E0 STA LE
AE59 A5 B9 LDA NUMBER+1
AE5B 85 E1 STA LE+1
AE5D 84 AB STY XTEMP
AE5F A2 60 LDX #LE-DTAB ; CHECK FOR END >= START.
AE61 A0 5E LDY #LS-DTAB
AE63 20 63 B5 JSR DCMPI
AE66 08 PHP
AE67 A4 AB LDY XTEMP
AE69 28 PLP
AE6A B0 16 BCS XLS235 ; END >= START.
AE6C 90 50 BCC XLS900 ; END < START.
AE6E A5 DE XLS180 LDA LS ; FORCE END = START.
AE70 A6 DF LDX LS+1
AE72 B0 0A BCS XLS230 ; (BRA).
AE74 A9 00 XLS200 LDA #0 ; DEFAULT -- START = 0
AE76 85 DE STA LS
AE78 85 DF STA LS+1
AE7A A9 0F LDA #MAXLN ; DEFAULT -- END = 9999
AE7C A2 27 LDX #MAXLN/256
AE7E 85 E0 XLS230 STA LE
AE80 86 E1 STX LE+1
AE82 A5 92 XLS235 LDA EXEC ; EXECUTE MODE?
AE84 F0 3A BEQ XLS990 ; NO.
AE86 84 AB STY XTEMP
AE88 A5 AE LDA S1L ; SETUP 'POINT' TO POINT TO PROGRAM STORAGE.
AE8A 85 B6 STA POINT
AE8C A5 AF LDA S1L+1
AE8E 85 B7 STA POINT+1
AE90 A2 36 XLS240 LDX #POINT-DTAB
AE92 20 9D B3 JSR SEND ; CHECK FOR END OF STATEMENT LIST.
AE95 F0 22 BEQ XLS260 ; DONE.
AE97 20 54 B8 JSR GTLNNO ; MOVE LINE # TO 'LINENO' (USES 'POINT')
AE9A A2 5C LDX #LINENO-DTAB ; SEE IF >= START LINE.
AE9C A0 5E LDY #LS-DTAB
AE9E 20 63 B5 JSR DCMPI
AEA1 90 0E BCC XLS250 ; NO -- DON'T PRINT.
AEA3 A2 60 LDX #LE-DTAB ; SEE IF <= END LINE.
AEA5 A0 5C LDY #LINENO-DTAB
AEA7 20 63 B5 JSR DCMPI
AEAA 90 0D BCC XLS260 ; NO -- DONE.
AEAC A0 36 LDY #POINT-DTAB
AEAE 20 09 B8 JSR PSF ; PRINT STORAGE FORM LINE.
AEB1 A2 36 XLS250 LDX #POINT-DTAB ; ADVANCE TO NEXT LINE.
AEB3 20 10 B4 JSR SNXTI
AEB6 4C 90 AE JMP XLS240
AEB9 A4 AB XLS260 LDY XTEMP
AEBB A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
AEBD 60 RTS ; RETURN WITH CC SET
AEBE A9 02 XLS900 LDA #IMPERR ; IMPROPER PARAMETER ERROR.
AEC0 60 XLS990 RTS ; RETURN WITH CC SET.
;
; XAUTO -- AUTO-INPUT COMMAND PROCESSOR
;
AEC1 20 DA AE XAUTO JSR NUMNUM ; GET LINE # AND INCREMENT.
AEC4 D0 13 BNE XAU090 ; ERROR.
AEC6 A5 92 LDA EXEC ; EXECUTE MODE?
AEC8 F0 0F BEQ XAU090 ; NO.
AECA 8D 76 05 STA AUTOIN ; YES -- SET AUTO-INPUT MODE.
AECD A5 86 LDA ACOLR2 ; SET SCREEN BACKGROUND COLOR.
AECF 8D C6 02 STA COLOR0+2
AED2 A5 87 LDA ACOLR1 ; SET SCREEN LETTER COLOR.
AED4 8D C5 02 STA COLOR0+1
AED7 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
AED9 60 XAU090 RTS ; RETURN WITH CC SET.
AEDA A9 00 NUMNUM LDA #0 ; SETUP DEFAULT VALUES.
AEDC 85 FA STA ALINE+1
AEDE 85 FC STA AINC+1
AEE0 A9 0A LDA #10 ; LINE # & INCREMENT = 10.
AEE2 85 F9 STA ALINE
AEE4 85 FB STA AINC
AEE6 20 E8 A4 JSR ATOM ; GET STARTING LINE #.
AEE9 D0 33 BNE NMN990 ; ERROR.
AEEB C9 01 CMP #NULL
AEED F0 2C BEQ NMN090 ; DEFAULT TO 10, 10.
AEEF C9 02 CMP #NUM
AEF1 D0 29 BNE NMN900 ; SYNTAX ERROR.
AEF3 A5 B8 LDA NUMBER ; SET VALUE IN 'ALINE'.
AEF5 85 F9 STA ALINE
AEF7 A5 B9 LDA NUMBER+1
AEF9 85 FA STA ALINE+1
AEFB 20 EE B7 JSR SKPSEP ; SKIP SEPARATOR(S).
AEFE 20 E8 A4 JSR ATOM ; GET LINE # INCREMENT.
AF01 D0 1B BNE NMN990 ; ERROR.
AF03 C9 01 CMP #NULL
AF05 F0 14 BEQ NMN090 ; DEFAULTS TO XX.10.
AF07 C9 02 CMP #NUM
AF09 D0 11 BNE NMN900 ; SYNTAX ERROR.
AF0B A5 B8 LDA NUMBER ; SET VALUE IN 'AINC'
AF0D 85 FB STA AINC
AF0F A5 B9 LDA NUMBER+1
AF11 85 FC STA AINC+1
AF13 30 07 BMI NMN900 ; NEGATIVE INCREMENT IS ILLEGAL.
AF15 05 FB ORA AINC ; TEST FOR ZERO INCREMENT.
AF17 F0 03 BEQ NMN900 ; ZERO -- ERROR.
AF19 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT,
AF1B 60 NMN090 RTS ; RETURN WITH CC SET.
AF1C A9 02 NMN900 LDA #IMPERR ; IMPROPER PARAMETER ERROR.
AF1E 60 NMN990 RTS ; RETURN WITH CC SET.
;
; XREN -- RENUMBER COMMAND PROCESSOR
;
AF1F 20 DA AE XREN JSR NUMNUM ; GET LINE # AND INCREMENT
AF22 D0 3B BNE XNU090 ; ERROR.
AF24 A5 92 LDA EXEC ; EXECUTE MODE?
AF26 F0 37 BEQ XNU090 ; NO.
AF28 84 AB STY XTEMP ; SAVE LINE INDEX.
AF2A A5 AE LDA S1L ; SETUP POINTER TO PROGRAM STORAGE AREA
AF2C 85 B6 STA POINT
AF2E A5 AF LDA S1L+1
AF30 85 B7 STA POINT+1
AF32 A2 36 XNU010 LDX #POINT-DTAB ; END OF PROGRAM?
AF34 20 9D B3 JSR SEND
AF37 F0 1F BEQ XNU080 ; YES -- DONE.
AF39 A2 79 LDX #ALINE-DTAB ; CHECK FOR LINE # IN RANGE.
AF3B 20 63 AF JSR CHKLN
AF3E B0 20 BCS XNU190 ; OUT OF RANGE.
AF40 A0 03 LDY #3 ; NO -- ALTER NUMBER.
AF42 A5 FA LDA ALINE+1
AF44 91 B6 STA (POINT),Y
AF46 C8 INY
AF47 A5 F9 LDA ALINE
AF49 91 B6 STA (POINT),Y
AF4B A0 7B LDY #AINC-DTAB ; INCREMENT LINE NUMBER.
AF4D 20 80 B5 JSR DADDI
AF50 A2 36 LDX #POINT-DTAB ; NEXT STATEMENT.
AF52 20 10 B4 JSR SNXTI
AF55 4C 32 AF JMP XNU010
AF58 20 33 BF XNU080 JSR RDYMES ; GENERATE "READY" MESSAGE
AF5B A4 AB LDY XTEMP ; RESTORE LINE INDEX.
AF5D A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
AF5F 60 XNU090 RTS ; RETURN WITH CC SET.
AF60 A4 AB XNU190 LDY XTEMP ; RESTORE LINE INDEX.
AF62 60 RTS ; RETURN WITH CC SET
;
; CHKLN -- CHECK STATEMENT LINE # FOR OUT OF RANGE.
;
; CALLING SEQUENCE:
;
; X = DTAB INDEX TO LINE 1NUMBER.
;
; JSR CHKLN
; BCS OUT OF RANGE (A = ERROR CODE)
;
AF63 A0 27 CHKLN LDY #MAXLN+1/256
AF65 A9 10 LDA #MAXLN+1
AF67 20 5D B5 JSR DCWCI
AF6A 90 02 BCC CLN090 ; NOT OUT OF RANGE.
AF6C A9 8D LDA #LNOERR
AF6E 60 CLN090 RTS
;
; I/O SUBSYTEM ROUTINES
;
;
; CHOT -- PRINT ONE CHARACTER TO "E:
;
; A = ATASCII CHARACTER
; 'CDEST' I/O ROUTINE OFFSET OR $80+XX OR $FF.
;
; JSR CHOT
;
AF6F 86 A1 CHOT STX TEMP ; SAVE REGISTERS.
AF71 84 A2 STY TEMP+1
AF73 AE 70 05 LDX CDEST ; PREPARE TO OUTPUT TO DEVICE.
AF76 30 0E BMI CHO100 ; SPECIAL OUTPUT.
AF78 20 73 B1 JSR IOHAND
; *** EXTERNAL ENTRY POINT ***
AF7B C0 00 IOERCK CPY #0 ; ERROR CHECK.
AF7D 10 1A BPL CHO120 ; O.K.
; *** EXTERNAL ENTRY POINT ***
AF7F 84 E4 IOE010 STY IOSTAT ; SAVE I/O STATUS.
AF81 A9 86 LDA #IOERR
AF83 4C 6C A1 JMP PSTOP ; STOP ON ERROR.
AF86 E0 FF CHO100 CPX #$FF ; RESULT TO 'TEXBUF '?
AF88 F0 05 BEQ CHO110 ; YES.
AF8A A2 30 LDX #IOCB3 ; NO -- TO IOCB 3.
AF8C 4C 21 B1 JMP DIO005 ; OUTPUT CHARACTER AND RETURN.
AF8F A4 8F CHO110 LDY TELN+3 ; GET INDEX.
AF91 C0 FE CPY #TEXLNG ; BUFFER FULL?
AF93 F0 04 BEQ CHO120 ; YES -- STORE NO MORE.
AF95 91 8C STA (TELN),Y ; NO -- STORE CHARACTER.
AF97 E6 8F INC TELN+3
AF99 A4 A2 CHO120 LDY TEMP+1 ; RESTORE REGISTERS.
AF9B A6 A1 LDX TEMP
AF9D 60 RTS
;
; GETLIN -- GET LINE FROM "E:"
;
; CALLING SEQUENCE:
;
; X = OFFSET TO BUFFER ADDRESS.
;
; JSR GETLIN
;
; DTAB(X+2) = 0 -- START INDEX.
; DTAB(X+3) = LINE LENGTH -- END INDEX.
;
AF9E 86 A3 GETLIN STX TEMP+2 ; SAVE INDICES
AFA0 84 A4 STY TEMP+3
AFA2 A9 00 LDA #0 ; ENABLE TEXT CURSOR
AFA4 95 82 STA DTAB+2,X ; AS ADVERTISED.
AFA6 20 65 B8 JSR CRSNOP ; MAKE CURSOR SHOW NOW.
AFA9 B5 80 LDA DTAB,X ; SETUP BUFFER ADDRESS.
AFAB 8D 44 03 STA IOCB0+ICBAL
AFAE B5 81 LDA DTAB+1,X
AFB0 8D 45 03 STA IOCB0+ICBAH
AFB3 A9 05 LDA #GETR ; GET RECORD COMMAND.
AFB5 8D 42 03 STA IOCB0+ICCOM
AFB8 A9 79 GTL010 LDA #LINLNG-1 ; SETUP MAXIMUM LINE LENGTH FOR READ
AFBA 8D 48 03 STA IOCB0+ICBLL
AFBD A2 00 LDX #IOCB0 ; IOCB 0.
AFBF 8E 49 03 STX IOCB0+ICBLH ; *S*.
AFC2 20 56 E4 JSR CIO ; DO I/O.
.IF DEBUG
CPY #$89 ; TRUNCATED RECORD?
BNE GTL020 ; NO.
LDA #OLLERR ; YES -- INFORM OPERATOR & TRY AGAIN
JSR MESSOT
JMP GTL010
.ENDIF
AFC5 98 GTL020 TYA ; ERROR CHECK
AFC6 30 B7 BMI IOE010 ; ERROR.
AFC8 20 65 B8 JSR CRSNOP ; DISABLE TEXT CURSOR (A <> 0)
AFCB A6 A3 LDX TEMP+2 ; RESTORE INDICES.
AFCD A4 A4 LDY TEMP+3
AFCF AD 48 03 LDA IOCB0+ICBLL ; SETUP END INDEX.
AFD2 95 83 STA DTAB+3,X
AFD4 60 RTS
;
; GSOPEN -- OPEN THE GRAPHICS SCREEN
;
; THIS ROUTINE COMPRESSES MEMORY/ OPENS THE GRAPHICS SCREEN AND DE-COMPRESSES
; THE MEMORY AGAIN.
;
AFD5 84 A7 GSOPEN STY TEMP2 ; SAVE LINE SCAN INDEX.
; FIRST COMPRESS THE RAM STORAGE, LEAVING THE FREE AREA AT THE HIGH ADDRESSES
; BY REMOVING THE GAP BETWEEN THE PROGRAM STORAGE AREA AND THE STRING
; STORAGE AREA.
AFD7 A5 B0 LDA S1H ; 'MDP' = 'S1H' (DESTINATION)
AFD9 85 D8 STA MDP
AFDB A5 B1 LDA S1H+1
AFDD 85 D9 STA MDP+1
AFDF A5 B2 LDA S2L ; 'MSP' = 'S2L' (SOURCE)
AFE1 85 D6 STA MSP
AFE3 A5 B3 LDA S2L+1
AFE5 85 D7 STA MSP+1
AFE7 38 SEC ; 'MBC' = 'S2H' - 'S2L' (BYTE COUNT)
AFE8 A5 B4 LDA S2H ; ('TEMP2'+1 = SAME).
AFEA E5 B2 SBC S2L
AFEC 85 DA STA MBC
AFEE 85 A8 STA TEMP2+1 ; (SAVE FOR LATER)
AFF0 A5 B5 LDA S2H+1
AFF2 E5 B3 SBC S2L+1
AFF4 85 DB STA MBC+1
AFF6 85 A9 STA TEMP2+2
AFF8 18 CLC ; 'APPMHI' = 'S1H' + 'MBC'.
AFF9 A5 B0 LDA S1H
AFFB 65 DA ADC MBC
AFFD 85 0E STA APPMHI
AFFF A5 B1 LDA S1H+1
B001 65 DB ADC MBC+1
B003 85 0F STA APPMHI+1
B005 20 0C B5 JSR MOVIA ; MOVE STRING STORAGE DOWN.
; NOW ATTEMPT TO OPEN 'S:' TO THE DESIRED SCREEN MODE; THERE MAY NOT BE
; ENOUGH MEMORY * HOWEVER.
B008 A9 53 LDA #'S ; DEVICE NAME = 'S'
B00A 8D 60 05 STA OPNBUF
B00D A9 9B LDA #EOL
B00F 8D 61 05 STA OPNBUF+1
B012 A9 1C LDA #OWRIT+OREAD+SPLIT ; SCREEN OPTIONS.
B014 8D 6A 03 STA IOCB2+ICAUX1
B017 AD F1 06 LDA GSMODE
B01A 8D 6B 03 STA IOCB2+ICAUX2
B01D A9 03 LDA #OPEN ; OPEN COMMAND.
B01F 8D 62 03 STA IOCB2+ICCOM
B022 A2 20 LDX #IOCB2 ; OPEN DEVICE ON IOCB 2.
B024 20 48 B1 JSR BUFPNT ; SETUP OPEN BUFFER POINTER
B027 20 56 E4 JSR CIO
B02A 84 E4 STY IOSTAT ; SAVE STATUS FOR LATER.
B02C 30 24 BMI GS0020 ; ERROR -- DON'T PLOT POINT.
B02E CE F0 02 DEC CRSINH ; INHIBIT THE CURSOR.
B031 A9 46 LDA #$46 ; ESTABLISH ALTERNATE COLORS.
B033 8D C4 02 STA COLOR0+0 ; RED
B036 A9 1A LDA #$1A ; YELLOW (MUST HAVE VALUE $XA).
B038 8D C5 02 STA COLOR0+1
; LDA #$94
; STA COLOR0+2
B03B 20 B9 BE JSR GPINIT ; INITIALIZE GRAPHICS PARAMETERS.
B03E AD F1 06 LDA GSMODE ; DEFAULT SCREEN MODE?
B041 C9 07 CMP #SCNMOD
B043 D0 0D BNE GS0020 ; NO DON'T PLOT CURSOR
B045 A2 00 LDX #0 ; SET CURSOR POSITION.
B047 A0 6C LDY #GX-DTAB
B049 20 96 BC JSR SETCUR
B04C AD 53 05 LDA PEN
B04F 20 3C B1 JSR TOUT ; PLOT SINGLE POINT.
; NOW MOVE THE STRING STORAGE AREA UP TO THE CURRENT TOP OF MEMORY SO
; THAT THE FREE AREA IS ONCE AGAIN BETWEEN THE PROGRAM STORAGE AREA AND
; THE STRING STORAGE AREA.
B052 A5 A8 GS0020 LDA TEMP2+1 ; 'MBC' = PRIOR 'MBC' (BYTE COUNT).
B054 85 DA STA MBC
B056 A5 A9 LDA TEMP2+2
B058 85 DB STA MBC+1
B05A A5 B0 LDA S1H ; 'MSP' = 'S1H' (SOURCE).
B05C 85 D6 STA MSP
B05E A5 B1 LDA S1H+1
B060 85 D7 STA MSP+1
B062 20 77 B0 JSR GS0100 ; DO FINAL SETUP AND MOVE.
B065 A4 E4 LDY IOSTAT ; SEE IF THERE WAS AN I/O ERROR,
B067 10 08 BPL GS0090 ; NO.
B069 A2 20 LDX #IOCB2 ; YES -- CLOSE DEVICE & REPORT ERROR.
B06B 20 FD B0 JSR DCLOSE
B06E 4C 7F AF JMP IOE010
B071 A4 A7 GS0090 LDY TEMP2 ; RESTORE SCAN INDEX.
B073 8C 54 05 STY GRFLAG ; SET GRAPHICS SCREEN FLAG.
B076 60 RTS
; *** EXTERNAL ENTRY POINT FROM 'GEXIT' ***
B077 38 GS0100 SEC ; 'MDP' = 'MEMHI' - 'MBC' (DESTINATION).
B078 AD E5 02 LDA MEMHI
B07B 85 B4 STA S2H ; 'S2H' = 'MEMHI'.
B07D 85 0E STA APPMHI
B07F E5 DA SBC MBC
B081 85 D8 STA MDP
B083 85 B2 STA S2L ; 'S2L' = SAME AS NEW 'MDP'
B085 AD E6 02 LDA MEMHI+1 ; NOW AS ABOVE FOR MSB.
B088 85 B5 STA S2H+1
B08A 85 0F STA APPMHI+1
B08C E5 DB SBC MBC+1
B08E 85 D9 STA MDP+1
B090 85 B3 STA S2L+1
B092 A2 8E LDX #APPMHI+$100-DTAB ; DECRMENT 'APPMHI' BY ONE.
B094 A9 FF LDA #-1
B096 20 4D B6 JSR DADDS
B099 4C 30 B5 JMP MOVDA ; MOVE STRING STORAGE TO TOP OF MEM & RETURN.
;
; DNAME -- EXTRACT DEVICE/FILENAME
;
; CALLING SEQUENCE:
;
; Y = INDEX TO START OF NAME
;
; JSR DNAME
;
; Y = INDEX TO NAME DELIMITER.
; X = 'OPNBUF' INDEX TO CHAR AFTER NAME (EOL).
; 'OPNBUF' RECEIVES NAME
;
B09C 20 FA B7 DNAME JSR SLB ; SKIP READING BLANKS.
; *S* JMP FNAME ; NAME TO 'OPNBUF' & RETURN
B09F A2 00 FNAME LDX #0
B0A1 B1 80 FNM010 LDA (INLN),Y
B0A3 20 D8 B7 JSR CHKSEP ; SEPARATOR?
B0A6 F0 09 BEQ FNM020 ; YES -- DONE.
B0A8 9D 60 05 STA OPNBUF,X ; NO -- PART OF NAME.
B0AB E8 INX
B0AC C8 INY
B0AD E0 0F CPX #DNSIZE ; NAME TOO LONG?
B0AF D0 F0 BNE FNM010 ; NO -- KEEP SCANNING.
B0B1 A9 9B FNM020 LDA #EOL ; END OF NAME.
B0B3 9D 60 05 STA OPNBUF,X
B0B6 60 RTS
;
; DOPEN -- DEVICE OPEN
;
; CALLING SEQUENCE:
;
; 'IOEDIS' <> 0 INDICATES TO IGNORE I/O ERROR.
; X = IOCB INDEX.
; A = OPEN DIRECTION + AUX1 OPTIONS.
; 'OPNBUF' CONTAINS DEVICE/FILENAME.
;
; JSR DOPEN
;
; RETURNS ONLY IF OPEN SUCCEEDED.
;
B0B7 48 DOPEN PHA ; SAVE OPEN CODE.
B0B8 20 FD B0 JSR DCLOSE ; *** JUST IN CASE ***.
B0BB 68 PLA ; RESTORE OPEN CODE
; *S* STX TEMP
; *S* STY TEMP+1
B0BC 0D 5D 05 ORA AUX1 ; MERGE USER BYTE.
B0BF 9D 4A 03 STA ICAUX1,X ; SETUP OPEN DIRECTION.
B0C2 20 6C B2 JSR CHKDEV ; CHECK FOR INVALID OPEN
B0C5 AD 5E 05 LDA AUX2 ; SETUP AUX2
B0C8 9D 4B 03 STA ICAUX2,X
B0CB A9 00 LDA #0
B0CD 9D 48 03 STA ICBLL,X ; SETUP FOR ACCUMULATOR XFER OF
B0D0 9D 49 03 STA ICBLH,X
B0D3 8D 5D 05 STA AUX1 ; CLEAR USER BYTES
B0D6 8D 5E 05 STA AUX2
B0D9 A9 03 LDA #OPEN ; OPEN COMMAND
B0DB 9D 42 03 STA ICCOM,X
B0DE 20 48 B1 JSR BUFPNT ; SETUP OPEN BUFFER POINTER
B0E1 20 56 E4 JSR CIO
; JSR COLORS ; RE-ESTABLISH SPECIAL COLORS.
; ; *** NEEDED ONLY IF OUTPUT TO S: OR E: ALLOWED
; ; IN GRAPHICS MODE ***
; *S* TYA ; CHECK STATUS.
B0E4 10 26 BPL DOP010 ; O.K.
; *** EXTERNAL ENTRY POINT ***
;
; X = IOCB INDEX.
; Y = ERROR STATUS ON ENTRY.
B0E6 AD 00 05 DOP005 LDA IOEDIS ; ERROR STOP DISABLED?
B0E9 08 PHP
B0EA A9 9B LDA #EOL ; (RETURN EOL CHAR ON ERROR).
B0EC 28 PLP
B0ED F0 08 BEQ DOP007 ; NO.
B0EF A5 FF LDA RUN ; YES -- IS IT ALSO RUN MODE?
B0F1 08 PHP
B0F2 A9 9B LDA #EOL ; RETURN EOL ON ERROR.
B0F4 28 PLP
B0F5 D0 15 BNE DOP010 ; YES.
B0F7 20 FD B0 DOP007 JSR DCLOSE ; NO -- CLOSE FILE IN ERROR.
B0FA 4C 7F AF JMP IOE010 ; ERROR -- STOP (SKIP BRANCH POINT)
;
; DCLOSE -- CLOSE IOCB
;
; CALLING SEQUENCE:
;
; X = IOCB INDEX
;
; JSR DCLOSE
;
; NOTE: CLOSE STATUS IS OF NO IMPORTANCE TO THIS ROUTINE.
;
B0FD 86 A1 DCLOSE STX TEMP
B0FF 84 A2 STY TEMP+1
B101 A9 0C LDA #CLOSE
B103 9D 42 03 STA ICCOM,X
B106 20 56 E4 JSR CIO
B109 20 72 B8 JSR AUDCLR ; CLEAR AUDIO REGISTERS.
; *** EXTERNAL ENTRY POINT ***
B10C DOP010
B10C A6 A1 DIO010 LDX TEMP
B10E A4 A2 LDY TEMP+1
B110 60 RTS
;
; DIN & DOUT -- IOCB DATA IN AND OUT
;
; CALLING SEQUENCE:
;
; 'IQEDIS' <> 0 INDICATES TO IGNORE I/O ERROR.
; X = IOCB INDEX
; A = DATA ('DOUT' ONLY)
;
; JSR DIN/DOUT
;
; A = DATA ('DIN' ONLY), RETURNS EOL ON ERROR.
;
B111 48 DIN PHA
B112 A9 07 LDA #GETC ; SETUP COMMAND BYTE.
B114 D0 03 BNE DIO003 ; (BRA).
B116 48 DOUT PHA ; SAVE DATA BYTE.
B117 A9 0B LDA #PUTC ; SETUP COMMAND BYTE.
B119 9D 42 03 DIO003 STA ICCOM,X
B11C 68 PLA
B11D 86 A1 STX TEMP ; SAVE REGISTERS.
B11F 84 A2 STY TEMP+1
; *** EXTERNAL ENTRY POINT FROM 'CHOT' ***
B121 20 56 E4 DIO005 JSR CIO
B124 84 E4 STY IOSTAT ; SAVE I/O STATUS.
; *S* CPY #0 ; CHECK STATUS.
B126 10 E4 BPL DIO010 ; O.K.
B128 A9 9B LDA #EOL ; RETURN EOL ON ERROR.
B12A C0 88 CPY #$88 ; END OF FILE?
B12C D0 B8 BNE DOP005 ; NO -- FATAL ERROR (SKIP BRANCH).
B12E F0 DC BEQ DIO010 ; YES -- RETURN EOL (BRA).
;
; TIN -- GRAPHICS DATA INPUT
;
; CALLING SEQUENCE:
;
; JSR TIN
;
; A = ONE GRAPHICS PIXEL
;
B130 86 A1 TIN STX TEMP ; SAVE REGISTERS.
B132 84 A2 STY TEMP+1
B134 A2 14 LDX #SGETC-0 ; GET CHARACTER FROM 'S'.
B136 20 73 B1 JSR IOHAND
B139 4C 7B AF JMP IOERCK ; CHECK FOR ERROR & RETURN.
;
; TOUT -- GRAPHICS DATA OUTPUT
;
; CALLING SEQUENCE:
;
; A = ONE GRAPHICS PIXEL
;
; JSR TOUT
;
B13C 86 A1 TOUT STX TEMP ; SAVE REGISTERS.
B13E 84 A2 STY TEMP+1
B140 A2 16 LDX #SPUTC-IOVBAS ; PUT CHARACTER TO 'S:'.
B142 20 73 B1 JSR IOHAND
B145 4C 7B AF JMP IOERCK ; CHECK FOR ERROR & RETURN.
B148 A9 60 BUFPNT LDA #OPNBUF ; POINT TO NAME BUFFER FOR OPEN.
B14A 9D 44 03 STA ICBAL,X
B14D A9 05 LDA #OPNBUF/256
B14F 9D 45 03 STA ICBAH,X
B152 60 RTS
;
; PRTSTG -- PRINT TEXT DATA
;
; CALLING SEQUENCE:
;
; X = OFFSET TO TEXT DATA POINTER.
;
; JSR PRTSTG
;
B153 84 AA PRTSTG STY TEMP2+3
B155 B5 80 LDA DTAB,X ; MOVE POINTER
B157 85 A7 STA TEMP2
B159 B5 81 LDA DTAB+1,X
B15B 85 A8 STA TEMP2+1
B15D B5 83 LDA DTAB+3,X ; ENDING INDEX.
B15F 85 A9 STA TEMP2+2
B161 B4 82 LDY DTAB+2,X ; STARTING INDEX.
B163 C4 A9 PRS010 CPY TEMP2+2 ; COMPARE START INDEX WITH END INDEX.
B165 F0 09 BEQ PRS080 ; EQUAL -- DONE.
B167 B1 A7 LDA (TEMP2),Y ; GET NEXT CHARACTER.
B169 C8 INY
B16A 20 6F AF JSR CHOT ; PRINT CHARACTER.
B16D 4C 63 B1 JMP PRS010
B170 A4 AA PRS080 LDY TEMP2+3
B172 60 RTS
;
; IOHAND -- DIRECT I/O TO INTERFACE ROUTINE
;
; CALLING SEQUENCE:
;
; X = I/O ROUTINE OFFSET TO ADDRESS TABLE ENTRY
;
; JSR IOHAND
;
; CLOBBERS Y REGISTER.
;
B173 A8 IOHAND TAY ; SAVE REGISTER A.
B174 BD 01 E4 LDA IOVBAS+1,X ; GET ADDRESS MSB.
B177 48 PHA
B178 BD 00 E4 LDA IOVBAS+0,X ; GET ADDRESS LSB.
B17B 48 PHA
B17C 98 TYA ; RESTORE REGISTER A.
B17D 60 RTS ; (JMP) TO HANDLER.
;
; SFNAME -- GET DEVICE NAME AND STORE IN 'OPNBUF'
;
; CALLING SEQUENCE:
;
; EXEC = 0 FOR SCAN MODE. ELSE EXECUTE
; XXXX = INPUT LINE INDEX
; Y = INDEX TO EOL IN 'OPNBUF'
;
; JSR SFNAME
; BNE ERROR (A = ERROR CODE).
;
; 'OPNBUF' = DEVICE NAME
; ???? INPUT LINE INDEX TO FIELD AFTER DEVICE/FILENAME
;
B17E 20 E8 A4 SFNAME JSR ATOM ; GET DEVICE/FILENAME.
B181 D0 0A BNE SFN090 ; ERROR.
B183 C9 20 CMP #TEXT ; TEXT LITERAL?
B185 F0 07 BEQ SFN100 ; YES.
B187 29 18 AND #SVAR+USVAR ; STRING NAME?
B189 D0 0B BNE SFN200 ; YES.
B18B A9 02 LDA #IMPERR ; NO -- ERROR.
B18D 60 SFN090 RTS ; RETURN WITH CC SET.
; SCAN TEXT LITERAL DATA TO EXTRACT DEVICE/FILENAME.
B18E 20 9F B0 SFN100 JSR FNAME ; NAME TO 'OPNBUF'.
B191 84 F8 STY XXXX ; SAVE LINE INDEX.
B193 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
B195 60 RTS ; RETURN WITH CC SET.
; DEVICE/FILENAME IS A STRING VARIABLE VALUE
B196 A5 92 SFN200 LDA EXEC ; EXECUTE MODE?
B198 F0 F3 BEQ SFN090 ; NO -- DONE.
B19A 84 F8 STY XXXX
B19C A2 00 LDX #0
B19E A4 C4 LDY DP+2
B1A0 C4 C5 SFN220 CPY DP+3 ; DONE?
B1A2 F0 0B BEQ SFN250 ; YES.
B1A4 B1 C2 LDA (DP),Y ; NO -- MOVE NAME.
B1A6 9D 60 05 STA OPNBUF,X
B1A9 C8 INY
B1AA E8 INX
B1AB E0 0F CPX #DNSIZE ; OVERLENGTH NAME?
B1AD D0 F1 BNE SFN220 ; O.K. SO FAR.
B1AF A9 9B SFN250 LDA #EOL
B1B1 9D 60 05 STA OPNBUF,X
B1B4 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
B1B6 60 RTS ; RETURN WITH CC SET.
;
; SCNDEV -- GET DEVICE NAME AND SETUP FOR 'READ: 'WRITE:' OR 'CLOSE:'
;
; CALLING SEQUENCE:
;
; 'EXEC' = 0 FOR SCAN MODE, ELSE EXECUTE
; Y = INPUT LINE INDEX.
; A = AUX1 OPEN CODE. (0 = CLOSE, ELSE OPEN).
;
B1B7 85 E0 SCNDEV STA LE ; SAVE DEVICE OPEN CODE.
B1B9 20 7E B1 JSR SFNAME ; EXTRACT FILENAME.
B1BC D0 34 BNE SCD290 ; ERROR.
B1BE A5 92 LDA EXEC ; EXECUTE MODE?
B1C0 F0 30 BEQ SCD290 ; NO -- ALL DONE.
B1C2 A9 00 LDA #0 ; DELIMIT DEVICE NAME AS STRING NAME.
B1C4 85 E4 STA IOSTAT ; CLEAR I/O STATUS.
B1C6 85 C0 STA NP+2
B1C8 E8 INX
B1C9 86 C1 STX NP+3
B1CB A9 40 LDA #'@ ; PREFIX NAME WITH '@'.
B1CD 8D 5F 05 STA OPNBUF-1
B1D0 A9 5F LDA #OPNBUF-1
B1D2 85 BE STA NP
B1D4 A9 05 LDA #OPNBUF-1/256
B1D6 85 BF STA NP+1
B1D8 20 9B B7 JSR SETSVL ; SETUP TO ACCESS STRING VARIABLE LIST.
B1DB 20 81 B2 JSR SFIND ; SEE IF STRING EXISTS.
B1DE D0 13 BNE SCD300 ; NO.
B1E0 A4 C4 LDY DP+2 ; YES -- GET IOCB INDEX FROM VALUE.
B1E2 B1 C2 LDA (DP),Y
B1E4 48 PHA
B1E5 A5 E0 LDA LE ; LOOK AT "OPEN" CODE.
B1E7 D0 03 BNE SCD270 ; NORMAL IN OR OUT.
B1E9 20 9F B2 JSR SDELET ; 'DONE' -- DELETE NAME.
B1EC 68 SCD270 PLA
B1ED AA TAX
B1EE A4 F8 LDY XXXX
B1F0 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
B1F2 60 SCD290 RTS ; RETURN WITH CC SET.
; FIRST ACCESS TO DEVICE, DO IMPLICIT OPEN.
B1F3 20 6C B2 SCD300 JSR CHKDEV ; CHECK FOR VALID DEVICE.
B1F6 A5 E0 LDA LE ; CHECK "OPEN" CODE.
B1F8 D0 05 BNE SCD310 ; NORMAL IN OR OUT.
B1FA A4 F8 LDY XXXX ; RESTORE INDEX.
B1FC A9 02 LDA #IMPERR ; 'DONE' -- CLOSING NON-OPEN FILE.
B1FE 60 RTS
B1FF 20 26 B2 SCD310 JSR FNDIOB ; FIND A FREE IOCB, IF AVAILABLE.
B202 D0 21 BNE SCD900 ; NONE AVAILABLE.
B204 A5 E0 LDA LE ; GET AUX OPEN CODE
B206 20 B7 B0 JSR DOPEN ; OPEN DEVICE
B209 86 DE STX LS ; SAVE IOCB # ASSOCIATED WITH DEVICE.
B20B 8E F0 02 STX CRSINH ; INHIBIT CURSOR JUST IN CASE
B20E A9 DE LDA #LS
B210 85 C2 STA DP
B212 A9 00 LDA #LS/296
B214 85 C3 STA DP+1
; *S* LDA #0
B216 85 C4 STA DP+2
B218 A9 01 LDA #1
B21A 85 C5 STA DP+3
B21C 20 B8 B2 JSR SINSRT ; INSERT NAMED STRING CONTAINING INFO
B21F 08 PHP
B220 A6 DE LDX LS
B222 A4 F8 LDY XXXX
B224 28 PLP
B225 60 SCD900 RTS ; RETURN WITH CC SET
;
; FINDIOB -- FIND A FREE IOCB
;
; CALLING SEQUENCE:
;
; JSR FNDIOB
; BNE NO FREE IOCB (A = ERROR CODE)
;
; X = = IOCB INDEX.
;
B226 A2 40 FNDIOB LDX #IOCB4 ; START WITH IOCB #4.
B228 BD 40 03 FND010 LDA ICHID,X ; TEST FOR CURRENTLY UNUSED
B22B C9 FF CMP #$FF
B22D F0 07 BEQ FND090 ; FOUND ONE.
B22F 20 42 B2 JSR NXTIOB ; BUMP INDEX TO NEXT IOCB.
B232 D0 F4 BNE FND010 ; MORE TO CHECK.
B234 A9 96 LDA #FILERR ; NONE AVAILABLE.
B236 60 FND090 RTS ; RETURN WITH CC SET.
;
; CLOSEM -- CLOSE IOCBS 3 THROUGH 7 (WHETHER OPEN OR NOT).
;
B237 A2 30 CLOSEM LDX #IOCB3 ; START WITH IOCB #3.
B239 20 FD B0 CLM010 JSR DCLOSE ; CLOSE THE IOCB.
B23C 20 42 B2 JSR NXTIOB ; BUMP INDEX TO NEXT IOCB.
B23F D0 F8 BNE CLM010 ; MORE TO DO.
B241 60 RTS
;
; NXTIOB -- BUMP INDEX TO NEXT IOCB.
;
; CALLING SEQUENCE:
;
; X = IOCB INDEX
;
; JSR NXTIOB
; BEQ INDEX PAST IOCB #7
;
; X = IOCB INDEX TO NEXT IOCB
;
B242 8A NXTIOB TXA
B243 18 CLC
B244 69 10 ADC #IOCBSZ
B246 AA TAX
B247 E0 80 CPX #IOCB7+IOCBSZ
B249 RDV090
B249 CKD090
B249 60 RTS ; RETURN WITH CC SET.
;
; REMDEV -- REMOVE DEVICE ASSIGNMENTS FROM STRING LIST
;
B24A A2 52 RDV000 LDX #MEMA-DTAB ; REMOVE STRING VAR FROM LIST.
B24C A0 3A LDY #LP-DTAB
B24E 20 CF B3 JSR DMOVI
B251 20 A4 B4 JSR MDEALL
B254 20 9B B7 REMDEV JSR SETSVL ; SETUP TO SCAN STRING VARIABLES ...
B257 A2 3A LDX #LP-DTAB ; ... TO REMOVE ALL DEVICE ASSIGNMENTS
B259 20 9D B3 RDV010 JSR SEND ; END OF LIST?
B25C F0 EB BEQ RDV090 ; YES.
B25E A0 03 LDY #3 ; NO -- LOOK AT 1ST CHARACTER OF NAME.
B260 B1 BA LDA (LP),Y
B262 C9 40 CMP #'@ ; IS IT '@' (I/O ASSIGNMENT)?
B264 F0 E4 BEQ RDV000 ; YES -- REMOVE IT FROM LIST.
B266 20 10 B4 JSR SNXTI ; GO TO NEXT ITEM IN LIST.
B269 4C 59 B2 JMP RDV010
; CHKDEV -- CHECK FOR VALID DEVICE
B26C AD 54 05 CHKDEV LDA GRFLAG ; GRAPHICS SCREEN?
B26F F0 D8 BEQ CKD090 ; NO -- NO RESTRICTIONS.
B271 AD 60 05 LDA OPNBUF ; CHECK FOR 'E' OR 'S'.
B274 C9 45 CMP #'E
B276 F0 04 BEQ CKD010 ; INVALID -- CLOBBERS SCREEN
B278 C9 53 CMP #'S
B27A D0 CD BNE CKD090
B27C A9 85 CKD010 LDA #SCNERR
B27E 4C 6C A1 JMP PSTOP
;
; THIS PACKAGE HAS THREE LEVELS OF STRING HANDLING ROUTINES:
;
; NAMED STRING HANDLING -- SFIND, SDELET & SINSRT
;
; TEXT DATA HANDLING -- SCOMP
;
; IMPLEMENTATION UTILITIES -- IFIND, SEND, PSETUP, PMOVE, ICOMP,
; ILENG, SNXTI, IMATCH & IALLOC
;
;
; NAMED STRING HANDLING
;
; THESE ROUTINES USE THE FOLLOWING VARIABLES:
;
; NP = POINTER TO STRING NAME.
; DP = POINTER TO STRING DATA PORTION.
; LP = POINTER TO START OF LIST OF NAMED STRINGS (S1L OR S2L).
;
;
; SFIND -- FIND NAMED STRING IN LIST
;
; CALLING SEQUENCE:
;
; LP POINTS TO START OF LIST OF NAMED STRINGS
; NP POINTS TO NAME TO FIND IN LIST
;
; JSR SFIND
; BNE NAME NOT IN LIST OR NAME IS NULL
;
; DP POINTS TO DATA PORTION OF NAMED STRING FOUND IN LIST
;
B281 20 FE B2 SFIND JSR IFIND ; FIND NAME IN LIST.
B284 D0 18 BNE SFI080 ; NOT FOUND.
B286 A2 42 LDX #DP-DTAB ; SET 'DP' TO POINT TO DATA
B288 A0 4E LDY #PP-DTAB
B28A 20 CF B3 JSR DMOVI
B28D A5 D1 LDA PP+3 ; SKIP OVER NAME PORTION.
B28F 20 51 B6 JSR DADDP
B292 A9 01 LDA #1 ; SET START INDEX.
B294 85 C4 STA DP+2
B296 A0 00 LDY #0 ; SET END INDEX.
B298 18 CLC
B299 71 C2 ADC (DP),Y
B29B 85 C5 STA DP+3
B29D 98 TYA ; SET CC FOR EXIT.
B29E 60 SFI080 RTS ; RETURN WITH CC SET
;
; SDELET -- DELETE NAMED STRING FROM LIST
;
; CALLING SEQUENCE:
;
; NP POINTS TO STRING NAME
; LP POINTS TO START OF LIST OF NAMED STRNGS
;
; JSR SDELET
; BNE NAMED STRING NOT FOUND OR NAME IS NULL
;
B29F 20 FE B2 SDELET JSR IFIND ; FIND STRING IN LIST.
B2A2 D0 13 BNE SDL090 ; NAMED STRING NOT FOUND.
; *** EXTERNAL ENTRY POINT ***
B2A4 A2 52 SDEL2 LDX #MEMA-DTAB ; MEMA = PP (FOR DEALLOCATE CALL)
B2A6 A0 4E LDY #PP-DTAB
B2A8 20 CF B3 JSR DMOVI
B2AB 20 A4 B4 JSR MDEALL ; DELETE STRING.
B2AE A2 4E LDX #PP-DTAB ; PP = MEMA.
B2B0 A0 52 LDY #MEMA-DTAB
B2B2 20 CF B3 JSR DMOVI
B2B5 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
B2B7 60 SDL090 RTS ; RETURN WITH CC SET.
;
; SINSRT -- NAMED STRING INSERT
;
; CALLING SEQUENCE:
;
; NP POINTS TO STRING NAME
; DP POINTS TO STRING DATA PORTION
; LP POINTS TO START OF NAMED STRING LIST
;
; JSR SINSRT
; BNE NAME IS NULL# OR NO ROOM FOR STRING IN LIST
;
B2B8 20 FE B2 SINSRT JSR IFIND ; IS NAME ALREADY IN LIST?
B2BB D0 03 BNE SIN020 ; NO.
B2BD 20 A4 B2 JSR SDEL2 ; YES -- DELETE OLD OCCURRENCE.
B2C0 A9 00 SIN020 LDA #0 ; CALCULATE ALLOCATION SIZE.
B2C2 85 D4 STA MEMB
B2C4 85 D5 STA MEMB+1
B2C6 A2 54 LDX #MEMB-DTAB ; STRING SIZE = NAME SIZE ...
B2C8 38 SEC
B2C9 A5 C1 LDA NP+3
B2CB E5 C0 SBC NP+2
B2CD 20 51 B6 JSR DADDP
B2D0 38 SEC ; ... + DATA PORTION SIZE ...
B2D1 A5 C5 LDA DP+3
B2D3 E5 C4 SBC DP+2
B2D5 20 51 B6 JSR DADDP
B2D8 A9 04 LDA #4 ; ... +4 BYTES OF OVERHEAD.
B2DA 20 51 B6 JSR DADDP
B2DD A2 52 LDX #MEMA-DTAB ; ALLOCATE ADDRESS FROM 'IFIND; CALL IN PP
B2DF A0 4E LDY #PP-DTAB
B2E1 20 CF B3 JSR DMOVI
B2E4 20 27 B4 JSR MALLOC ; ALLOCATE SPACE IN LIST
B2E7 D0 0E BNE SIN090 ; NOT ENOUGH ROOM.
B2E9 A2 3E LDX #NP-DTAB ; MOVE NAME TO NEW STRING ...
B2EB A0 02 LDY #2 ; ... STARTING AFTER ALLOCATION SIZE.
B2ED 20 DA B3 JSR SMOVI
B2F0 A2 42 LDX #DP-DTAB ; NOW MOVE DATA PORTION.
B2F2 20 DA B3 JSR SMOVI
B2F5 A9 00 LDA #0 ; SET CC FOR NORMAL EXIT.
B2F7 60 SIN090 RTS ; RETURN WITH CC SET.
;
; TEXT DATA UTILITIES
;
; THESE ROUTINES USE THE FOLLOWING VARIABLES:
;
; DP = POINTER TO TEXT DATA
; MP = POINTER TO TEXT PATTERN DATA
; AP1 = AUXILLIARY POINTER TO TEXT SUB-STRING
; AP2 = AUXILLIARY POINTER TO TEXT SUB-STRING
;
;
; SCOMP -- COMPARE TWO TEXT STRINGS
;
; CALLING SEQUENCE:
;
; DP POINTS TO DATA TEXT
; MP POINTS TO DATA TEXT
;
; JSR SCOMP
; BEQ DATA TEXTS ARE IDENTICAL
; BCS DP TEXT >= MP TEXT
; BCC DP TEXT < MP TEXT
;
; NOTE: THE COMPARISON IS BASED UPON THE STANDARD ATASCII COLLATION
; SEQUENCE; WHEN ONE TEXT IS A SUBSET OF THE FIRST PART OF THE
; OTHER TEXT, THE SHORTER ONE IS CONSIDERED TO BE < THE LONGER ONE.
;
B2F8 20 B7 B3 SCOMP JSR PSETUP ; DP TO SP, MP TO PP.
B2FB 4C 34 B3 JMP ICOMP ; COMPARE TEXT & RETURN WITH CC SET.
;
; GENERAL STRING IMPLEMENTATION UTILITIES
;
; THESE ROUTINES USE THE FOLLOWING VARIABLES:
;
; SP = SOURCE TEXT POINTER
; PP = PATTERN TEXT POINTER
;
;
; IFIND -- FIND NAMED STRING IN LIST
;
; CALLING SEQUENCE:
;
; NP POINTS TO DESIRED NAME
; LP POINTS TO START OF NAMED STRING LIST
;
; JSR IFIND
; BNE NOT FOUND (PP POINTS TO SUCCESSOR)
;
; PP POINTS TO NAMED STRING IN LIST
;
B2FE A5 C0 IFIND LDA NP+2 ; NAME NULL?
B300 C5 C1 CMP NP+3
B302 F0 2D BEQ IFI080 ; YES -- DONE
B304 A2 4A LDX #SP-DTAB ; SP = NP.
B306 A0 3E LDY #NP-DTAB
B308 20 C5 B3 JSR PMOVE
B30B A2 4E LDX #PP-DTAB ; PP = LP.
B30D A0 3A LDY #LP-DTAB
B30F 20 C5 B3 JSR PMOVE
B312 IFI020
; *S* LDX #PP-DTAB
B312 20 9D B3 JSR SEND ; END OF LIST?
B315 F0 1A BEQ IFI080 ; YES -- DONE.
B317 A9 03 LDA #3 ; NO -- SETUP START INDEX ...
B319 85 D0 STA PP+2
B31B 18 CLC ; ... & END INDEX (TO NAME).
B31C A0 02 LDY #2
B31E 71 CE ADC (PP),Y
B320 85 D1 STA PP+3
B322 20 34 B3 JSR ICOMP ; NAME COMPARISON.
B325 F0 0C BEQ IFI090 ; FOUND IT!
B327 90 08 BCC IFI080 ; PAST CORRECT SPOT IN ORDERED LIST.
B329 A2 4E LDX #PP-DTAB ; SKIP TO NEXT LIST ENTRY.
B32B 20 10 B4 JSR SNXTI
B32E 4C 12 B3 JMP IFI020 ; TRY AGAIN.
B331 A9 FF IFI080 LDA #$FF ; SET CC FOR EXIT (NOT FOUND).
B333 60 IFI090 RTS ; RETURN WITH CC SET.
;
; ICOMP -- COMPARE TEXT DATA
;
; CALLING SEQUENCE:
;
; SP POINTS TO DATA TEXT
; PP POINTS TO DATA TEXT
;
; JSR ICOMP
; BEQ DATA TEXTS ARE IDENTICAL
; BCS SP DATA >= PP DATA
; BCC SP DATA < PP DATA
;
B334 20 A9 B3 ICOMP JSR ILENG ; SEE IF EQUAL LENGTHS.
B337 F0 3B BEQ IMATCH ; YES -- COMPARE & RETURN.
B339 B0 1D BCS ICO050 ; PP DATA SHORTER THAN SP DATA.
B33B A5 D1 LDA PP+3 ; SAVE STARTING VALUE.
B33D 85 A7 STA TEMP2
B33F 38 SEC ; (CLEAR BORROW).
B340 A5 CD LDA SP+3 ; ADJUST PP DATA LENGTH FOR COMPARISON.
B342 E5 CC SBC SP+2
B344 18 CLC
B345 65 D0 ADC PP+2
B347 85 D1 STA PP+3
B349 20 74 B3 JSR IMATCH ; NOW COMPARE.
B34C 08 PHP
B34D A5 A7 LDA TEMP2 ; RESTORE ALTERED PARAMETER.
B34F 85 D1 STA PP+3
B351 28 PLP
B352 D0 1F BNE IC0090 ; NOT EQUAL -- CC SET FOR EXIT.
B354 A9 FF LDA #$FF ; SET CC FOR EXIT
B356 18 CLC
B357 60 RTS ; RETURN WITH CC SET.
B358 A5 CD ICO050 LDA SP+3 ; SAVE STARTING VALUE.
B35A 85 A7 STA TEMP2
B35C 18 CLC
B35D A5 CC LDA SP+2 ; ADJUST SP LENGTH FOR COMPARISON
B35F 65 D1 ADC PP+3
B361 38 SEC
B362 E5 D0 SBC PP+2
B364 85 CD STA SP+3
B366 20 74 B3 JSR IMATCH ; NOW COMPARE.
B369 08 PHP
B36A A5 A7 LDA TEMP2 ; RESTORE ALTERED PARAMETER.
B36C 85 CD STA SP+3
B36E 28 PLP
B36F D0 02 BNE IC0090 ; NOT EQUAL -- CC SET FOR EXIT.
B371 A9 FF LDA #$FF ; SET CC FOR EXIT.
; *S* SEC
B373 60 IC0090 RTS ; RETURN WITH CC SET
;
; IMATCH -- MATCH TWO TEXT DATA STRINGS
;
; CALLING SEQUENCE
;
; SP = SOURCE DATA TEXT (SOURCE DATA MUST BE LONGER THAN PATTERN)
; PP = PATTERN DATA TEXT
;
; JSR IMATCH
; BEQ PATTERN IS CONTAINED WITHIN SOURCE
; BCS SOURCE COLLATES >= PATTERN
; BCC SOURCE COLLATES < PATTERN
;
B374 A5 CC IMATCH LDA SP+2 ; SAVE STARTING INDICES.
B376 85 A1 STA TEMP
B378 A5 D0 LDA PP+2
B37A 85 A2 STA TEMP+1
B37C A4 D0 IMT010 LDY PP+2 ; SEE IF ALL OF PATTERN HAS MATCHED.
B37E C4 D1 CPY PP+3
B380 F0 10 BEQ IMT090 ; YES -- ALL DONE.
B382 A4 CC LDY SP+2 ; NO -- COMPARE ANOTHER BYTE.
B384 B1 CA LDA (SP),Y
B386 E6 CC INC SP+2
B388 A4 D0 LDY PP+2
B38A D1 CE CMP (PP),Y
B38C D0 04 BNE IMT090 ; NO COMPARE -- CC SET FOR EXIT.
B38E E6 D0 INC PP+2
B390 B0 EA BCS IMT010 ; (BRA).
B392 08 IMT090 PHP ; SAVE CC.
B393 A5 A1 LDA TEMP ; RESTORE STARTING INDICES.
B395 85 CC STA SP+2
B397 A5 A2 LDA TEMP+1
B399 85 D0 STA PP+2
B39B 28 PLP ; RESTORE CC.
B39C SEN090
B39C 60 RTS ; RETURN WITH CC SET.
;
; SEND -- CHECK FOR END OF STRING LIST
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET TO LIST POINTER
;
; JSR SEND
; BEQ END OF LIST REACHED
;
; Y IS ALTERED
B39D A0 30 SEND LDY #S1H-DTAB ; SEE IF END OF REGION #1.
B39F 20 63 B5 JSR DCMPI
B3A2 F0 F8 BEQ SEN090 ; YES.
B3A4 A0 34 LDY #S2H-DTAB ; SEE IF END OF REGION #2 ...
B3A6 4C 63 B5 JMP DCMPI ; ... RETURN WITH CC SET.
;
; ILENG -- COMPARE LENGTHS OF SOURCE TEXT AND PATTERN TEXT
;
; CALLING SEQUENCE:
;
; SP POINTS TO SOURCE DATA TEXT
; PP POINTS TO PATTERN DATA TEXT
;
; JSR ILENG
; BEQ DATA TEXTS ARE EQUAL LENGTH
; BCS SOURCE TEXT >= PATTERN TEXT
; BCC SOURCE TEXT < PATTERN TEXT
;
B3A9 A5 D1 ILENG LDA PP+3
B3AB 38 SEC
B3AC E5 D0 SBC PP+2
B3AE 85 A1 STA TEMP
B3B0 A5 CD LDA SP+3
B3B2 E5 CC SBC SP+2
B3B4 E5 A1 SBC TEMP ; CC = SP LENGTH - PP LENGTH.
B3B6 60 RTS
;
; PSETUP -- MOVE POINTERS (DP TO SP, MP TO PP)
;
; CALLING SEQUENCE:
;
; JSR PSETUP
;
; SP = DP
; PP = MP
;
B3B7 A2 4A PSETUP LDX #SP-DTAB ; SP = DP.
B3B9 A0 42 LDY #DP-DTAB
B3BB 20 C5 B3 JSR PMOVE
B3BE A2 4E LDX #PP-DTAB ; PP = MP.
B3C0 A0 46 LDY #MP-DTAB
B3C2 4C C5 B3 JMP PMOVE ; AND RETURN.
;
; PMOVE -- MOVE STRING/DATA TEXT POINTERS
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET
; Y = DTAB OFFSET
;
; JSR PMOVE
;
; DTAB(X) = DTAB(Y) (4 BYTE MOVE)
;
B3C5 B9 82 00 PMOVE LDA DTAB+2,Y
B3C8 95 82 STA DTAB+2,X
B3CA B9 83 00 LDA DTAB+3,Y
B3CD 95 83 STA DTAB+3,X
; *** EXTERNAL ENTRY POINT
B3CF B9 80 00 DMOVI LDA DTAB,Y
B3D2 95 80 STA DTAB,X
B3D4 B9 81 00 LDA DTAB+1,Y
B3D7 95 81 STA DTAB+1,X
B3D9 60 RTS
.IF DEBUG
;
; IALLOC -- ALLOCATE MEMORY
;
; CALLING SEQUENCE:
;
; A = # OF BYTES TO ALLOCATE
;
; JSR IALLOC
; BNE NOT ENOUGH ROOM
;
; DP POINTS TO NEW ALLOCATION + 2 (START OF STRING)
;
;
IALLOC STA MEMB ; SETUP MEMB = #BYTES ...
LDA #0
STA MEMB+1
LDA #3 ; ... + 3.
LDX #MEMB-DTAB
JSR DADDS
LDX #MEMA-DTAB ; SETUP MEMA - ALLOCATION ADDRESS.
LDY #S2L-DTAB
JSR DMOVI
JSR MALLOC ; ALLOCATE MEMORY.
BNE IAL090 ; NOT ENOUGH ROOM.
LDX #DP-DTAB ; DP = ADDRESS OF STRING STORAGE AREA.
LDY #MEMA-DTAB
JSR DMOVI
LDA #2
JSR DADDS
LDA #1 ; SET STARTING & ENDING INDICES.
STA DP+2
STA DP+3
LDA #0 ; SET CC FOR EXIT.
IAL090 RTS ; RETURN WITH CC SET.
.ENDIF
;
; SMOVI -- MOVE TEXT DATA TO MEMA (FORMING STRING)
;
; CALLING SEQUENCE:
;
; X = DTAB INDEX TO STRING POINTER
; Y = MEMA OFFSET TO START STORING
;
; JSR SMOVI
;
; MEMA = LAST LOCATION STORED INTO + 1
; Y = 0
;
B3DA B5 80 SMOVI LDA DTAB,X ; MOVE SOURCE POINTER TO TEMP.
B3DC 85 A1 STA TEMP
B3DE B5 81 LDA DTAB+1,X
B3E0 85 A2 STA TEMP+1
B3E2 B5 82 LDA DTAB+2,X
B3E4 85 A3 STA TEMP+2
B3E6 B5 83 LDA DTAB+3,X
B3E8 85 A4 STA TEMP+3
B3EA 38 SEC ; CALCULATE STRING LENGTH ...
B3EB A5 A4 LDA TEMP+3
B3ED E5 A3 SBC TEMP+2
B3EF 91 D2 SMO010 STA (MEMA),Y ; ... & STORE IN TARGET AREA.
B3F1 C8 INY
B3F2 84 A5 STY TEMP+4 ; SAVE INDEX.
B3F4 A4 A3 LDY TEMP+2 ; DONE?
B3F6 C4 A4 CPY TEMP+3
B3F8 F0 08 BEQ SMO090 ; YES.
B3FA B1 A1 LDA (TEMP),Y ; NO -- MOVE A BYTE.
B3FC E6 A3 INC TEMP+2
B3FE A4 A5 LDY TEMP+4 ; GET TARGET INDEX.
B400 D0 ED BNE SMO010 ; (BRA).
B402 A9 00 SMO090 LDA #0 ; PREPARE FOR D. P. ADDITION.
B404 85 A6 STA TEMP+5
B406 A2 52 LDX #MEMA-DTAB ; PREPARE TO BUMP MEMA.
B408 A0 25 LDY #TEMP+4-DTAB
B40A 20 80 B5 JSR DADDI
B40D A0 00 LDY #0 ; AS PROMISED.
B40F 60 RTS
;
; SNXTI -- POINT TO NEXT STRING IN LIST
;
; CALLING SEQUENCE:
;
; X = DATA OFFSET TO STRING LIST POINTER
;
; JSR SNXTI
;
; DTAB (X) = POINTER TO NEXT STRING IN LIST
B410 B5 81 SNXTI LDA DTAB+1,X ; MOVE STRING POINTER TO TEMP.
B412 85 A2 STA TEMP+1
B414 B5 80 LDA DTAB,X
B416 85 A1 STA TEMP
B418 A0 00 LDY #0 ; ADD ADDRESS TO ...
B41A 18 CLC
B41B 71 A1 ADC (TEMP),Y ; ... ALLOCATION LENGTH ...
B41D 95 80 STA DTAB,X ; ... TO GET NEXT ADDRESS.
B41F C8 INY
B420 A5 A2 LDA TEMP+1
B422 71 A1 ADC (TEMP),Y
B424 95 81 STA DTAB+1,X
B426 60 RTS
;
; MEMORY MANAGEMENT PACKAGE
;
; AVAILABLE MEMORY IS DIVIDED INTO TWO REGIONS WHICH GROW TOWARD EACH OTHER
; THE REGIONS ARE DEFINED BY FOUR POINTER VARIABLES:
;
; 'S1L' POINTS TO BOTTOM OF REGION #1
; 'S1H' POINTS TO FIRST UNUSED LOCATION ABOVE REGION #1
; 'S2L' POINTS TO BOTTOM OF REGION #2
; 'S2H' POINTS TO FIRST UNUSED LOCATION ABOVE REGION #2
;
; THREE ROUTINES ARE PROVIDED TO ALLOCATE AND DEALLOCATE MEMORY:
;
; 'MALLOC' IS USED TO ALLOCATE MEMORY
; 'MDEALL' IS USED TO DEALLOCATE MEMORY
;
; THE TWO REGIONS ARE MAINTAINED AS TWO COMPRESSED STACKS, ALLOCATION
; AND DEALLOCATION INVOLVES THE MOVEMENT OF DATA TO CREATE AND
; ELIMINATE HOLES IN THE STACKS.
;
;
; MALLOC -- MEMORY ALLOCATE
;
; CALLING SEQUENCE:
;
; 'MEMA' CONTAINS THE ADDRESS OF THE START OF ALLOCATION
; REGION #1: DATA AT START ADDRESS AND ABOVE ARE MOVED UP.
; REGION #2: DATA BELOW START ADDRESS ARE MOVED DOWN.
; 'MEMB' CONTAINS THE NUMBER OF BYTES TO ALLOCATE
;
; JSR MALLOC
; BNE NOT ENOUGH MEMORY TO SATISFY ALLOCATION
;
; 'MEMA' CONTAINS LOWEST ADDRESS IN THE ALLOCATED BLOCK
; FIRST TWO BYTES OF ALLOCATED BLOCK = BLOCK SIZE
;
B427 A0 30 MALLOC LDY #S1H-DTAB ; ACC = S1H ...
B429 20 9E B6 JSR DLOADA
B42C A0 54 LDY #MEMB-DTAB ; ... + MEMB.
B42E 20 A8 B6 JSR DADDA
B431 A0 32 LDY #S2L-DTAB ; COMPARE ACC WITH S2L
B433 20 AD B6 JSR DCMPA
B436 B0 69 BCS MAL300 ; NOT ENOUGH ROOM.
B438 A2 52 LDX #MEMA-DTAB ; SEE IF ALLOCATION IN
B43A A0 32 LDY #S2L-DTAB
B43C 20 63 B5 JSR DCMPI
B43F B0 28 BCS MAL100 ; REGION #2.
; ALLOCATE FROM REGION #1
B441 A2 56 LDX #MSP-DTAB ; MSP MEMA.
B443 A0 52 LDY #MEMA-DTAB
B445 20 CF B3 JSR DMOVI
B448 A2 58 LDX #MDP-DTAB ; MDP = MEMA ...
B44A 20 CF B3 JSR DMOVI
B44D A0 54 LDY #MEMB-DTAB ; ... + MEMB
B44F 20 80 B5 JSR DADDI
B452 A2 5A LDX #MBC-DTAB ; MBC = S1H ...
B454 A0 30 LDY #S1H-DTAB
B456 20 CF B3 JSR DMOVI
B459 A0 52 LDY #MEMA-DTAB ; ... - MEMA.
B45B 20 90 B5 JSR DSUBI
B45E A2 30 LDX #S1H-DTAB ; S1H = ACC (= S1H + MEMB)
B460 20 A3 B6 JSR DSTORA
B463 20 30 B5 JSR MOVDA ; MOVE DATA UPWARD.
B466 4C 94 B4 JMP MAL200
; ALLOCATE IN REGION #2
B469 A2 56 MAL100 LDX #MSP-DTAB ; MSP = SSL.
B46B A0 32 LDY #S2L-DTAB
B46D 20 CF B3 JSR DMOVI
B470 A2 5A LDX #MBC-DTAB ; MBC = MEMA ...
B472 A0 52 LDY #MEMA-DTAB
B474 20 CF B3 JSR DMOVI
B477 A0 32 LDY #S2L-DTAB ; ... - SSL.
B479 20 90 B5 JSR DSUBI
B47C A2 32 LDX #S2L-DTAB ; SSL = SSL - MEMB.
B47E A0 54 LDY #MEMB-DTAB
B480 20 90 B5 JSR DSUBI
B483 A2 58 LDX #MDP-DTAB ; MDP = SSL (NEW VALUE).
B485 A0 32 LDY #S2L-DTAB
B487 20 CF B3 JSR DMOVI
B48A A2 52 LDX #MEMA-DTAB ; MEMA = MEMA - MEMB.
B48C A0 54 LDY #MEMB-DTAB
B48E 20 90 B5 JSR DSUBI
B491 20 0C B5 JSR MOVIA ; MOVE DATA DOWNWARD.
; COMMON CODE
B494 A0 00 MAL200 LDY #0 ; MOVE BLOCK SIZE TO BLOCK
B496 A5 D4 LDA MEMB
B498 91 D2 STA (MEMA),Y
B49A C8 INY
B49B A5 D5 LDA MEMB+1
B49D 91 D2 STA (MEMA),Y
B49F 88 DEY ; SET CC FOR NORMAL EXIT.
B4A0 60 RTS
B4A1 A9 89 MAL300 LDA #INSERR ; SET CC FOR ERROR EXIT.
B4A3 60 RTS
;
; MDEALL -- MEMORY DEALLOCATE
;
; CALLING SEQUENCE:
;
; 'MEMA' = ADDRESS OF BLOCK TO DEALLOCATE
; FIRST 2 BYTES OF BLOCK = SIZE OF BLOCK
;
; JSR MDEALL
;
; 'MEMA' = ADDRESS OF BLOCK FOLLOWING DEALLOCATED BLOCK (AFTER DEALL)
;
B4A4 A0 00 MDEALL LDY #0 ; GET SIZE OF BLOCK TO MEMB.
B4A6 B1 D2 LDA (MEMA),Y
B4A8 85 D4 STA MEMB
B4AA C8 INY
B4AB B1 D2 LDA (MEMA),Y
B4AD 85 D5 STA MEMB+1
B4AF A2 52 LDX #MEMA-DTAB ; SEE IF IN REGION #1 OR #2.
B4B1 A0 32 LDY #S2L-DTAB
B4B3 20 63 B5 JSR DCMPI
B4B6 B0 29 BCS MDA100 ; REGION #2.
; DEALLOCATE FROM REGION #1.
B4B8 A2 56 LDX #MSP-DTAB ; MSP = MEMA ...
B4BA A0 52 LDY #MEMA-DTAB
B4BC 20 CF B3 JSR DMOVI
B4BF A0 54 LDY #MEMB-DTAB ; ... + MEMB.
B4C1 20 80 B5 JSR DADDI
B4C4 A2 5A LDX #MBC-DTAB ; MBC = S1H ...
B4C6 A0 30 LDY #S1H-DTAB
B4C8 20 CF B3 JSR DMOVI
B4CB A0 56 LDY #MSP-DTAB ; ... - MSP.
B4CD 20 90 B5 JSR DSUBI
B4D0 A2 30 LDX #S1H-DTAB ; S1H = S1H - MEMB.
B4D2 A0 54 LDY #MEMB-DTAB
B4D4 20 90 B5 JSR DSUBI
B4D7 A2 58 LDX #MDP-DTAB ; MDP = MEMA.
B4D9 A0 52 LDY #MEMA-DTAB
B4DB 20 CF B3 JSR DMOVI
B4DE 4C 0C B5 JMP MOVIA ; MOVE DATA DOWNWARD & RETURN.
; DEALLOCATE MEMORY IN REGION #2
B4E1 A2 56 MDA100 LDX #MSP-DTAB ; MSP = S2L.
B4E3 A0 32 LDY #S2L-DTAB
B4E5 20 CF B3 JSR DMOVI
B4E8 A2 5A LDX #MBC-DTAB ; MBC = MEMA ...
B4EA A0 52 LDY #MEMA-DTAB
B4EC 20 CF B3 JSR DMOVI
B4EF A0 32 LDY #S2L-DTAB ; ... - SSL.
B4F1 20 90 B5 JSR DSUBI
B4F4 A2 32 LDX #S2L-DTAB ; SSL = SSL + MEMB.
B4F6 A0 54 LDY #MEMB-DTAB
B4F8 20 80 B5 JSR DADDI
B4FB A2 58 LDX #MDP-DTAB ; MDP = SSL (NEW VALUE).
B4FD A0 32 LDY #S2L-DTAB
B4FF 20 CF B3 JSR DMOVI
B502 A2 52 LDX #MEMA-DTAB ; MEMA = MEMA + MEMB.
B504 A0 54 LDY #MEMB-DTAB
B506 20 80 B5 JSR DADDI
B509 4C 30 B5 JMP MOVDA ; MOVE DATA UPWARD & RETURN.
;
; MOVE UTILITIES FOR MEMORY MANAGEMENT
;
; MOVE BLOCKS OF DATA WITH EITHER INCREASING OR DECREASING ADDRESS
;
; THREE VARIABLES CONTROL THE MOVE ROUTINES:
;
; 'MSP' CONTAINS POINTER TO SOURCE DATA LOCATION
; 'MDP' CONTAINS POINTER TO DESTINATION DATA LOCATION
; 'MBC' CONTAINS THE NUMBER OF BYTES TO MOVE
;
;
; MOVIA -- MOVE DATA BLOCK WITH INCREASING ADDRESS
;
; CALLING SEQUENCE:
;
; 'MSP', 'MDP' & 'MBC' SETUP
;
; JSR MOVIA
;
B50C A5 DA MOVIA LDA MBC ; SEE IF BYTE COUNT = ZERO.
B50E AA TAX ; SAVE LSB OF BYTE COUNT.
B50F 05 DB ORA MBC+1
B511 F0 1C BEQ MVI090 ; ZERO -- NOTHING TO DO.
B513 A0 00 LDY #0 ; INDEX TO DATA BLOCK.
B515 B1 D6 MVI010 LDA (MSP),Y ; MOVE DATA.
B517 91 D8 STA (MDP),Y
B519 C8 INY ; BUMP INDEX.
B51A D0 04 BNE MVI020 ; NO PAGE WRAP.
B51C E6 D7 INC MSP+1 ; PAGE WRAP -- BUMP POINTER VARIABLES
B51E E6 D9 INC MDP+1
B520 CA MVI020 DEX ; DONE?
B521 D0 04 BNE MVI030 ; NO.
B523 A5 DB LDA MBC+1 ; NOT SURE -- CHECK FURTHER.
B525 F0 08 BEQ MVI090 ; YES -- DONE.
B527 E0 FF MVI030 CPX #$FF ; MAINTAIN D. P. BYTE COUNT.
B529 D0 EA BNE MVI010
B52B C6 DB DEC MBC+1 ; BORROW FROM MSB.
B52D B0 E6 BCS MVI010 ; (BRA).
B52F 60 MVI090 RTS
;
; MOVDA -- MOVE DATA BLOCK WITH DECREASING ADDRESS
;
; CALLING SEQUENCE:
;
; 'MSP', 'MDP', & 'MBC' SETUP
;
; JSR MOVDA
;
B530 A5 DA MOVDA LDA MBC ; SETUP BYTE COUNT ...
B532 AA TAX
B533 A8 TAY ; ... AND DATA INDEX.
B534 05 DB ORA MBC+1 ; TEST FOR ZERO BYTE COUNT.
B536 F0 24 BEQ MVD090 ; ZERO -- NOTHING TO DO.
B538 18 CLC ; ADJUST POINTERS FOR START.
B539 A5 D7 LDA MSP+1
B53B 65 DB ADC MBC+1
B53D 85 D7 STA MSP+1
B53F 18 CLC
B540 A5 D9 LDA MDP+1
B542 65 DB ADC MBC+1
B544 85 D9 STA MDP+1
B546 88 MVD010 DEY ; DECREMENT INDEX.
B547 C0 FF CPY #$FF ; WRAP?
B549 D0 06 BNE MVD020 ; NO.
B54B C6 DB DEC MBC+1 ; YES -- DECREMENT ALL POINTERS (MSB).
B54D C6 D7 DEC MSP+1
B54F C6 D9 DEC MDP+1
B551 B1 D6 MVD020 LDA (MSP),Y ; MOVE A DATA BYTE.
B553 91 D8 STA (MDP),Y
B555 CA DEX ; DONE?
B556 D0 EE BNE MVD010 ; NO -- CONTINUE.
B558 A5 DB LDA MBC+1 ; NOT SURE -- CHECK FURTHER.
B55A D0 EA BNE MVD010 ; NO -- CONTINUE.
B55C 60 MVD090 RTS ; YES -- RETURN.
;
; DOUBLE PRECISION ROUTINES
;
; ALL VARIABLES ARE ACCESSED VIA THEIR OFFSET FROM SYMBOL 'DTAB'.
; NORMALLY THE X AND/OR Y REGISTERS CONTAIN THE 'DTAB' OFFSET
; VALUES TO THE VARIABLE(S) TO BE DEALT WITH.
;
;
; DCWCI -- DOUBLE BYTE UNSIGNED COMPARE WITH CONSTANT.
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET TO VARIABLE.
; Y = MSB OF CONSTANT.
; A = LSB OF CONSTANT.
;
; JSR DCWCI ; UNSIGNED COMPARE.
;
; CC = DTAB(X) : Y,A
;
B55D 85 A7 DCWCI STA TEMP2 ; SAVE LSB.
B55F 84 A8 STY TEMP2+1 ; SAVE MSB.
B561 A0 27 LDY #TEMP2-DTAB
; *S* JMP DCMPI ; COMPARE & RETURN.
;
; DCMPI -- DOUBLE BYTE UNSIGNED COMPARE INDEXED
;
; CALLING SEQUENCE:
;
; X = DATA #1 OFFSET
; Y = DATA #2 OFFSET
;
; JSR DCMPI
; BEQ DTAB(X) = DTAB(Y)
; BCS DTAB(X) >= DTAB(Y)
; BCC DTAB(X) < DTAB(Y)
;
; CC = DTAB(X) : DTAB(Y) (UNSIGNED)
;
B563 B5 81 DCMPI LDA DTAB+1,X ; COMPARE MSBS.
B565 D9 81 00 CMP DTAB+1,Y
B568 D0 05 BNE DCM090 ; NOT EQUAL -- ALL
B56A B5 80 DCM010 LDA DTAB,X ; EQUAL -- COMPARE
B56C D9 80 00 CMP DTAB,Y
B56F 60 DCM090 RTS
;
; DSCMI -- DOUBLE BYTE SIGNED COMPARE INDEXED
;
; CALLING SEQUENCE:
;
; X = DATA #1 OFFSET
; Y = DATA #2 OFFSET
;
; JSR DSCMI
; BEQ DTAB(X) = DTAB(Y)
; BCS DTAB(X) >= DTAB(Y)
; BCC DTAB(X) < DTAB(Y)
;
B570 B9 81 00 DSCMI LDA DTAB+1,Y ; COMPARE MSBS FIRST.
B573 49 80 EOR #$80
B575 85 A1 STA TEMP
B577 B5 81 LDA DTAB+1,X
B579 49 80 EOR #$80
B57B C5 A1 CMP TEMP
B57D F0 EB BEQ DCM010 ; EQUAL -- COMPARE LSBS.
B57F 60 RTS ; NOT EQUAL -- ALL DONE.
;
; DMOVI -- DOUBLE BYTE MOVE INDEXED
;
; CALLING SEQUENCE:
;
; X = DESTINATION OFFSET
; Y = SOURCE OFFSET
;
; JSR DMOVI
;
; DTAB(X) = DTAB(Y)
;
; *** SEE 'PMOVE' FOR THE 'DMOVI' CODE ***
;
;
; DADDI -- DOUBLE PRECISION ADD
;
; CALLING SEQUENCE:
;
; X = OFFSET TO
; Y = OFFSET TO
;
; JSR DADDI
; BVS OVERFLOW
;
; DTAB(X) = DTAB(X) + DTAB(Y)
;
B580 18 DADDI CLC
B581 B5 80 DADDIX LDA DTAB,X
B583 79 80 00 ADC DTAB,Y
B586 95 80 STA DTAB,X
B588 B5 81 LDA DTAB+1,X
B58A 79 81 00 ADC DTAB+1,Y
B58D 95 81 STA DTAB+1,X
B58F 60 RTS
;
; DSUBI -- DOUBLE PRECISION SUBTRACT
;
; CALLING SEQUENCE:
;
; X = OFFSET
; Y = OFFSET
;
; JSR DSUBI
; BVS OVERFLOW
; BEQ RESULT = 0
;
; DTAB(X) = DTAB(X) - DTAB(Y)
;
B590 38 DSUBI SEC
B591 B5 80 DSUBIX LDA DTAB,X
B593 F9 80 00 SBC DTAB,Y
B596 95 80 STA DTAB,X
B598 B5 81 LDA DTAB+1,X
B59A F9 81 00 SBC DTAB+1,Y
B59D 95 81 STA DTAB+1,X
B59F 15 80 ORA DTAB,X ; SET CC FOR ZERO TEST
B5A1 60 RTS
;
; DMULI -- DOUBLE PRECISION MULTIPLY
;
; CALLING SEQUENCE:
;
; X = OFFSET
; Y = OFFSET
;
; JSR DMULI
;
; DTAB (X) = DTAB (X) * DTAB(Y)
B5A2 A9 10 DMULI LDA #16 ; SETUP LOOP COUNTER.
B5A4 85 A3 STA TEMP+2
B5A6 A9 00 LDA #0 ; INITIALIZE TEMP ACCUMULATOR.
B5A8 85 A1 STA TEMP
B5AA 85 A2 STA TEMP+1
B5AC 16 80 DMU010 ASL DTAB,X ; DOUBLE PRECISION SHIFT LEFT.
B5AE 36 81 ROL DTAB+1,X
B5B0 90 0F BCC DMU020 ; NO BIT PRESENT.
B5B2 18 CLC ; BIT SET -- ADD TO PARTIAL.
B5B3 A5 A1 LDA TEMP
B5B5 79 80 00 ADC DTAB,Y
B5B8 85 A1 STA TEMP
B5BA A5 A2 LDA TEMP+1
B5BC 79 81 00 ADC DTAB+1,Y
B5BF 85 A2 STA TEMP+1
B5C1 C6 A3 DMU020 DEC TEMP+2 ; DONE?
B5C3 F0 07 BEQ DMU090 ; YES -- RESULT IS IN 'TEMP'.
B5C5 06 A1 ASL TEMP ; NO -- DOUBLE PRECISION SHIFT LEFT
B5C7 26 A2 ROL TEMP+1
B5C9 4C AC B5 JMP DMU010
B5CC A5 A1 DMU090 LDA TEMP ; DONE -- MOVE RESULT.
B5CE 95 80 STA DTAB,X
B5D0 A5 A2 LDA TEMP+1
B5D2 95 81 STA DTAB+1,X
B5D4 60 RTS
;
; DDIVI -- DOUBLE PRECISION DIVIDE
;
; CALLING SEQUENCE:
;
; X = OFFSET TO DIVIDEND
; Y = OFFSET TO DIVISOR
;
; JSR DDIVI
;
; DTAB(X) = DTAB(X) / DTAB(Y) (SIGNED)
; 'TEMP' = REMAINDER (SIGN MAY BE WRONG!!!)
;
B5D5 B9 80 00 DDIVI LDA DTAB,Y ; CHECK FOR DIVIDE BY ZERO.
B5D8 19 81 00 ORA DTAB+1,Y
B5DB D0 05 BNE DDI003 ; NO -- O.K.
B5DD A9 84 LDA #DIVERR ; ERROR.
B5DF 4C 6C A1 JMP PSTOP
B5E2 A9 11 DDI003 LDA #16+1 ; SETUP LOOP COUNTER.
B5E4 85 A3 STA TEMP+2
B5E6 86 A4 STX TEMP+3 ; SAVE INDEX TO DIVIDEND
B5E8 A9 00 LDA #0 ; INITIALIZE REMAINDER.
B5EA 85 A1 STA TEMP
B5EC 85 A2 STA TEMP+1
B5EE B9 81 00 LDA DTAB+1,Y ; SEE IF DIVISOR IS NEGATIVE.
B5F1 85 A6 STA TEMP+5
B5F3 10 06 BPL DDI006 ; NO.
B5F5 20 3F B6 JSR DNEGI ; YES -- NEGATE DIVIDEND ...
B5F8 20 2B B6 JSR DDI093 ; ... & DIVISOR (*** CRAZY CALL ***).
B5FB B5 81 DDI006 LDA DTAB+1,X ; SEE IF DIVIDEND IS NEGATIVE.
B5FD 85 A5 STA TEMP+4
B5FF 10 03 BPL DDI008 ; NO.
B601 20 3F B6 JSR DNEGI ; YES -- NEGATE IT NOW (& THEN AGAIN LATER).
B604 18 DDI008 CLC
B605 A6 A4 DDI010 LDX TEMP+3 ; GET INDEX TO DIVIDEND.
B607 36 80 ROL DTAB,X ; DOUBLE PRECISION ROTATE.
B609 36 81 ROL DTAB+1,X
B60B C6 A3 DEC TEMP+2 ; DONE?
B60D F0 11 BEQ DDI090 ; YES.
B60F 26 A1 ROL TEMP ; NO.
B611 26 A2 ROL TEMP+1
B613 A2 21 LDX #TEMP-DTAB ; IS REMAINDER < DIVISOR?
B615 20 63 B5 JSR DCMPI
B618 90 EB BCC DDI010 ; YES.
B61A 20 90 B5 JSR DSUBI ; NO.
B61D 38 SEC
B61E B0 E5 BCS DDI010 ; (BRA).
B620 A5 A5 DDI090 LDA TEMP+4 ; SEE IF RESULT IS TO BE NEGATED.
B622 10 03 BPL DDI092 ; NO.
B624 20 3F B6 JSR DNEGI ; YES -- NEGATE POSITIVE RESULT.
B627 A5 A6 DDI092 LDA TEMP+5 ; WAS DIVISOR NEGATED EARLIER.
B629 10 07 BPL DDI095 ; NO.
B62B 98 DDI093 TYA ; YES -- NEGATE IT BACK TO ORIGINAL SIGN.
B62C AA TAX
B62D 20 3F B6 JSR DNEGI
B630 A6 A4 LDX TEMP+3 ; RESTORE INDEX.
B632 60 DDI095 RTS
;
; DMODI -- MODULO OF SORTS
;
; CALLING SEQUENCE:
;
; X = OFFSET TO DIVIDEND
; Y = OFFSET OT DIVISOR
;
; JSR DMODI
;
; DTAB(X) = DTAB (X) MOD DTAB(Y)
;
B633 20 D5 B5 DMODI JSR DDIVI ; FIRST DO DIVISION.
B636 A5 A1 LDA TEMP ; TAKE ADVANTAGE OF SIDE EFFECT
B638 95 80 STA DTAB,X
B63A A5 A2 LDA TEMP+1
B63C 95 81 STA DTAB+1,X
B63E 60 RTS
;
; DNEGI --/DOUBLE PRECISION NEGAT
;
; CALLING SEQUENCE
;
; X = OFFSET TO NUMBER
;
; JSR DNEGI
;
; DTAB(X) = -DTAB(X)
;
B63F 38 DNEGI SEC ; (CLEAR BORROW).
B640 A9 00 LDA #0
B642 F5 80 SBC DTAB,X
B644 95 80 STA DTAB,X
B646 A9 00 LDA #0
B648 F5 81 SBC DTAB+1,X
B64A 95 81 STA DTAB+1,X
B64C 60 RTS
;
; DADDS -- ADD A REGISTER TO DOUBLE BYTE
;
; CALLING SEQUENCE:
;
; A = SIGNED BINARY NUMBER (-128 TO 127)
; X = DTAB OFFSET TO DP NUMBER
;
; JSR DADDS
;
; DTAB ( X ) = DTAB ( X ) + A
;
B64D C9 00 DADDS CMP #0 ; SEE IF POSITIVE OR NEGATIVE
B64F 30 0A BMI DDA030 ; NEGATIVE.
; *** EXTERNAL ENTRY POINT ***
B651 18 DADDP CLC ; POSITIVE -- ADD.
B652 75 80 ADC DTAB,X
B654 95 80 STA DTAB,X
B656 90 02 BCC DDA010 ; NO CARRY.
B658 F6 81 INC DTAB+1,X ; CARRY -- ADD TO MSB.
B65A 60 DDA010 RTS
B65B 18 DDA030 CLC
B65C 75 80 ADC DTAB,X
B65E 95 80 STA DTAB,X
B660 B0 02 BCS DDA040 ; NO BORROW.
B662 D6 81 DEC DTAB+1,X ; BORROW -- SUB FROM MSB.
B664 60 DDA040 RTS
; RELATIONAL TESTS
;
; CALLING SEQUENCE:
;
; X = DATA #1 OFFSET
; Y = DATA #2 OFFSET
;
; JSR DXXTI ONE OF SIX ROUTINES
;
; DTAB(X) = 1 IF RELATION TRUE, 0 IF FALSE.
;
B665 20 63 B5 DEQTI JSR DCMPI ; UNSIGNED COMPARE (FASTER THAN SIGNED).
B668 F0 27 BEQ DTRUE ; EQUAL RESULTS IN TRUE.
B66A D0 29 BNE DFALSE ; UNEQUAL RESULTS IN FALSE.
B66C 20 63 B5 DNETI JSR DCMPI ; UNSIGNED COMPARE (FASTER THAN SIGNED).
B66F D0 20 BNE DTRUE ; UNEQUAL RESULTS IN TRUE.
B671 F0 22 BEQ DFALSE ; EQUAL RESULTS IN FALSE.
B673 20 70 B5 DGTTI JSR DSCMI ; SIGNED COMPARE.
B676 F0 1D BEQ DFALSE ; EQUAL RESULTS IN FALSE.
B678 90 1B BCC DFALSE ; LESS THAN RESULTS IN FALSE.
B67A B0 15 BCS DTRUE ; GREATER THAN RESULTS IN TRUE.
B67C 20 70 B5 DLTTI JSR DSCMI ; SIGNED COMPARE.
B67F 90 10 BCC DTRUE ; LESS THAN RESULTS IN TRUE.
B681 B0 12 BCS DFALSE ; GREATER THAN OR EQUAL RESULTS IN FALSE.
B683 20 70 B5 DGETI JSR DSCMI ; SIGNED COMPARE.
B686 B0 09 BCS DTRUE ; GREATER THAN OR EQUAL RESULTS IN TRUE.
B688 90 0B BCC DFALSE ; LESS THAN RESULTS IN FALSE.
B68A 20 70 B5 DLETI JSR DSCMI ; SIGNED COMPARE.
B68D F0 02 BEQ DTRUE ; EQUAL RESULTS IN TRUE.
B68F B0 04 BCS DFALSE ; GREATER THAN RESULTS IN FALSE.
; *S* BCC DTRUE ; LESS THAN RESULTS IN TRUE.
B691 A9 01 DTRUE LDA #1 ; "TRUE" ...
B693 D0 02 BNE DFA010 ; ... TO VARIABLE.
B695 A9 00 DFALSE LDA #0 ; "FALSE" ...
B697 95 80 DFA010 STA DTAB,X ; ... TO VARIABLE.
B699 A9 00 LDA #0
B69B 95 81 STA DTAB+1,X
B69D 60 RTS
;
; ACCUMULATOR FUNCTIONS -- ASSUME THE EXISTENCE OF A DOUBLE PRECISION
; VARIABLE WITHIN 'DTAB' NAMED 'ACC'.
;
;
; DLOADA -- LOAD 'ACC' WITH DATA
;
; CALLING SEQUENCE:
;
; Y = OFFSET TO SOURCE DATA
;
; JSR DLOADA
;
; X = ACC OFFSET
; 'ACC' = DTAB(Y)
;
B69E A2 62 DLOADA LDX #ACC-DTAB
B6A0 4C CF B3 JMP DMOVI
;
; DSTORA -- STORE 'ACC' TO LOCATION
;
; CALLING SEQUENCE:
;
; X = OFFSET TO DESTINATION
;
; JSR DSTORA
;
; Y = 'ACC' OFFSET
; DTAB(X) = 'ACC'
;
B6A3 A0 62 DSTORA LDY #ACC-DTAB
B6A5 4C CF B3 JMP DMOVI
;
; DADDA -- ADD DATA TO 'ACC'
; CALLING SEQUENCE:
;
; Y = OFFSET TO DATA
;
; JSR DADDA
;
; X = 'ACC' OFFSET
; 'ACC' = 'ACC' + DTAB(Y)
;
B6A8 A2 62 DADDA LDX #ACC-DTAB
B6AA 4C 80 B5 JMP DADDI
.IF DEBUG
;
; DSUBA -- SUBTRACT DATA FROM 'ACC'
;
; CALLING SEQUENCE:
;
; Y = OFFSET TO DATA
;
; JSR DSUBA
; BEQ RESULT = 0
;
; X = 'ACC' OFFSET
; 'ACC' = 'ACC' - DTAB(Y)
;
DSUBA LDX #ACC-DTAB
JMP DSUBI
.ENDIF
;
; DCMPA -- COMPARE 'ACC' WITH DATA (UNSIGNED)
;
; CALLING SEQUENCE:
;
; Y = DATA OFFSET
;
; JSR DCMPA
;
; CC = 'ACC' : DTAB(Y) (UNSIGNED)
; X = 'ACC' OFFSET
;
B6AD A2 62 DCMPA LDX #ACC-DTAB
B6AF 4C 63 B5 JMP DCMPI
;
; ASCDEC -- DECIMAL IN ASCII TO BINARY CONVERSION
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET TO POINTER VARIABLE
; Y = OFFSET WITHIN STRING TO START OF NUMBER.
;
; JSR ASCDEC
;
; 'NUMBER' = RESULT OF CONVERSION (MODULO 2**16)
; Y = INDEX TO END OF NUMBER DELIMITER
; USES 'TEMP' THRU 'TEMP'+4
;
B6B2 A9 00 ASCDEC LDA #0 ; INITIALIZE RESULT.
B6B4 85 B8 STA NUMBER
B6B6 85 B9 STA NUMBER+1
B6B8 B5 80 LDA DTAB,X ; MOVE POINTER.
B6BA 85 A3 STA TEMP+2
B6BC B5 81 LDA DTAB+1,X
B6BE 85 A4 STA TEMP+3
B6C0 B5 83 LDA DTAB+3,X ; SAVE END INDEX.
B6C2 85 A5 STA TEMP+4
B6C4 B1 A3 LDA (TEMP+2),Y
B6C6 C9 2D CMP #'- ; UNARY MINUS?
B6C8 D0 09 BNE ASC010 ; NO.
B6CA C8 INY ; YES -- SKIP OVER IT.
B6CB 20 D3 B6 JSR ASC010 ; *** RECURSIVE CALL ***
B6CE A2 38 LDX #NUMBER-DTAB
B6D0 4C 3F B6 JMP DNEGI ; NEGATE RESULT & RETURN.
B6D3 C4 A5 ASC010 CPY TEMP+4 ; END OF STRING?
B6D5 F0 33 BEQ ASC090 ; YES.
B6D7 B1 A3 LDA (TEMP+2),Y ; GET A CHARACTER.
B6D9 20 7A B7 JSR CNUMBR ; VALID DECIMAL DIGIT?
B6DC B0 2C BCS ASC090 ; NO -- DONE.
B6DE C8 INY
B6DF 48 PHA ; YES -- SAVE IT.
B6E0 06 B8 ASL NUMBER ; X2.
B6E2 26 B9 ROL NUMBER+1
B6E4 A5 B9 LDA NUMBER+1 ; SAVE X2.
B6E6 85 A2 STA TEMP+1
B6E8 A5 B8 LDA NUMBER
B6EA 85 A1 STA TEMP
B6EC 0A ASL A ; X4
B6ED 26 B9 ROL NUMBER+1
B6EF 0A ASL A ; X8
B6F0 26 B9 ROL NUMBER+1
B6F2 18 CLC ; X10 = X8 + X2
B6F3 65 A1 ADC TEMP
B6F5 85 B8 STA NUMBER
B6F7 90 03 BCC ASC020
B6F9 E6 B9 INC NUMBER+1
B6FB 18 CLC
B6FC 68 ASC020 PLA ; GET NEW DIGIT
B6FD 65 B8 ADC NUMBER ; ADD TO PARTIAL RESULT
B6FF 85 B8 STA NUMBER
B701 A5 B9 LDA NUMBER+1
B703 65 A2 ADC TEMP+1
B705 85 B9 STA NUMBER+1
B707 4C D3 B6 JMP ASC010
B70A 60 ASC090 RTS
;
; DECASC -- BINARY TO DECIMAL IN ASCII CONVERSION
;
; CALLING SEQUENCE:
;
; X = DTAB INDEX TO SIGNED VALUE
;
; JSR DECASC
;
; PRINTS RESULT TO 'CHOT' ROUTINE
; USES 'TEMP'+2 THRU 'TEMP'+5 & 'TEMP2' THRU 'TEMP2'+2
;
B70B 84 A6 DECASC STY TEMP+5 ; SAVE Y REGISTER.
B70D B5 80 LDA DTAB,X ; MOVE DATA TO TEMPORARY STORAGE.
B70F 85 A7 STA TEMP2
B711 B5 81 LDA DTAB+1,X
B713 85 A8 STA TEMP2+1
B715 10 0A BPL DEC020 ; NUMBER IS POSITIVE.
B717 A2 27 LDX #TEMP2-DTAB ; NEGATE NUMBER.
B719 20 3F B6 JSR DNEGI
B71C A9 2D LDA #'- ; PRINT LEADING MINUS SIGN.
B71E 20 6F AF JSR CHOT ; PRINT A CHARACTER.
B721 A0 00 DEC020 LDY #0 ; INITIALIZE CONVERSION INDEX ...
B723 84 A9 STY TEMP2+2 ; ... & LEADING ZERO SUPPRESS FLAG.
B725 B9 70 B7 DEC030 LDA PTEN,Y ; GET POWER OF TEN.
B728 85 A3 STA TEMP+2
B72A B9 71 B7 LDA PTEN+1,Y
B72D 85 A4 STA TEMP+3
B72F 84 A5 STY TEMP+4 ; SAVE INDEX TO TABLE.
B731 A9 30 LDA #'0 ; INITIALIZE DIGIT.
B733 8D 51 05 STA DIGIT
B736 A2 27 LDX #TEMP2-DTAB ; PREPARE FOR SUCCESSIVE SUBTRACTION.
B738 A0 23 LDY #TEMP+2-DTAB
B73A 20 90 B5 DEC040 JSR DSUBI
B73D A5 A8 LDA TEMP2+1 ; SEE IF RESULT IS NEGATIVE.
B73F 30 05 BMI DEC045 ; YES -- ENOUGH ALREADY.
B741 EE 51 05 INC DIGIT ; NO -- KEEP SUBTRACTING.
B744 D0 F4 BNE DEC040 ; (BRA).
B746 20 80 B5 DEC045 JSR DADDI ; NOW CORRECT FROM ONE TOO MANY SUBTRACTS.
B749 A5 A9 LDA TEMP2+2 ; SEE IF NON-ZERO DIGIT HAS BEEN PRINTED YET
B74B D0 09 BNE DEC050 ; YES --PRINT ALL SUBSEQUENT DIGITS.
B74D AD 51 05 LDA DIGIT ; NO -- SEE IF THIS DIGIT IS ANOTHER ZERO
B750 C9 30 CMP #'0
B752 F0 08 BEQ DEC060 ; YES IT IS -- SUPPRESS IT.
B754 85 A9 STA TEMP2+2 ; NO -- SET FLAG AND PRINT DIGIT.
B756 AD 51 05 DEC050 LDA DIGIT ; PRINT DIGIT.
B759 20 6F AF JSR CHOT
B75C A4 A5 DEC060 LDY TEMP+4 ; RESTORE TABLE INDEX.
B75E C8 INY
B75F C8 INY
B760 C0 0A CPY #PTENL ; DONE?
B762 D0 C1 BNE DEC030 ; NO.
B764 A5 A9 LDA TEMP2+2 ; WAS THE NUMBER = 0?
B766 D0 05 BNE DEC070 ; NO.
B768 A9 30 LDA #'0 ; YES -- PRINT SINGLE ZERO DIGIT.
B76A 20 6F AF JSR CHOT
B76D A4 A6 DEC070 LDY TEMP+5 ; YES -- RESTORE Y REGISTER ...
B76F 60 RTS ; ... & RETURN.
B770 10 27 E8 PTEN .WORD 10000,1000,100,10,1 ; DECREASING POWERS OF TEN.
B773 03 64 00
B776 0A 00 01
B779 00
000A PTENL=*-PTEN ; TABLE LENGTH IN WORDS
;
; CNUMBR -- CHECK ASCII CHARACTER FOR VALID NUMBER ('0' - '9')
;
; CALLING SEQUENCE:
;
; A = ASCII CHARACTER
;
; JSR CNUMBR
; BCS NOT DECIMAL DIGIT
;
; A = BINARY DIGIT
;
B77A C9 30 CNUMBR CMP #'0 ; < '0?
B77C 90 04 BCC CNU010 ; YES -- INVALID.
B77E C9 3A CMP #'9+1 ; > '9?
B780 90 02 BCC CNU020 ; NO -- VALID DECIMAL DIGIT
B782 38 CNU010 SEC ; SET CARRY FOR EXIT.
B783 60 RTS
B784 E9 2F CNU020 SBC #'0-1 ; (ADJUST FOR CARRY CLEAR)
B786 18 CLC ; SET CC FOR EXIT
B787 60 RTS
;
; CLETTR -- CHECK ASCII CHARACTER FOR ALPHA LETTER ('A' - 'Z')
;
; CALLING SEQUENCE:
;
; A = ASCII CHARACTER
;
; JSR CLETTR
; BCS NOT ALPHA LETTER
;
; A = ASCII CHARACTER
;
B788 C9 41 CLETTR CMP #'A ; < 'A?
B78A 90 04 BCC CLE010 ; YES -- NOT ALPHA
B78C C9 5B CMP #'Z+1 ; > 'Z?
B78E 90 01 BCC CLE020 ; NO -- VALID LETTER.
B790 38 CLE010 SEC ; SET CARRY FOR EXIT.
B791 60 CLE020 RTS
;
; STMLST -- SETUP LIST POINTER TO STATEMENT LIST
;
B792 STMLST
B792 A5 AE SETPGL LDA S1L ; 'LP' = 'S1L'
B794 85 BA STA LP
B796 A5 AF LDA S1L+1
B798 85 BB STA LP+1
B79A 60 RTS
; SETSVL - SETUP LIST POINTER TO NAMED STRING LIST
B79B A5 B2 SETSVL LDA S2L ; 'LP' = 'S2L'
B79D 85 BA STA LP
B79F A5 B3 LDA S2L+1
B7A1 85 BB STA LP+1
B7A3 60 RTS
;
; CKEOA -- CHECK FOR END OF ATOM (NON-ALPHANUMERIC CHARACTER)
;
; CALLING SEQUENCE.
;
; A = ASCII CHARACTER
;
; JSR CKEOA
; BEQ END OF ATOM (NOT AN ALPHANUMERIC CHARACTER)
;
B7A4 20 88 B7 CKEOA JSR CLETTR ; ALPHA LETTER?
B7A7 90 0C BCC CKE090 ; YES.
B7A9 48 PHA
B7AA 20 7A B7 JSR CNUMBR ; NO -- NUMERIC CHARACTER?
B7AD 68 PLA
B7AE 90 05 BCC CKE090 ; YES.
B7B0 85 A1 STA TEMP ; NEITHER -- SET CC FOR EXIT.
B7B2 C5 A1 CMP TEMP
B7B4 60 RTS
B7B5 C9 FF CKE090 CMP #$FF ; SET CC FOR EXIT.
B7B7 60 RTS
;
; SCEOA -- SCAN TO END OF ATOM
;
B7B8 C8 INY
B7B9 B1 80 SCEOA LDA (INLN),Y
B7BB 20 A4 B7 JSR CKEOA ; END OF ATOM?
B7BE D0 F8 BNE SCEOA-1 ; NO.
B7C0 60 RTS ; YES -- RETURN WITH CC SET.
;
; SCNLBL -- IDENTIFY (& SCAN TO END OF) LABEL
;
; CALLING SEQUENCE:
;
; Y = INDEX TO INPUT LINE.
;
; JSR SCNLBL
; BNE NO LABEL PRESENT (A = CODE).
;
; Y = INDEX TO END OF LABEL + 1
;
; NOTE: JUMPS TO 'PSTOP' IF INVALID LABEL NAME FOUND.
;
B7C1 20 EE B7 SCNLBL JSR SKPSEP ; SKIP LEADING BLANKS AND/OR COMMAS.
B7C4 C9 2A CMP #'* ; LABEL PREFIX DELIMITER?
B7C6 F0 03 BEQ SCL005 ; YES.
B7C8 A9 02 LDA #IMPERR ; NO LABEL.
B7CA 60 RTS
B7CB C8 SCL005 INY
B7CC B1 80 LDA (INLN),Y
B7CE 20 A4 B7 JSR CKEOA ; SEE IF AT LEAST ONE ALPHANUMERIC.
B7D1 D0 E6 BNE SCEOA ; YES -- SCAN TO END OF ATOM & RETURN.
B7D3 A9 02 LDA #ATMERR ; NO -- INVALID LABEL NAME.
B7D5 4C 6C A1 JMP PSTOP
;
; CHKSEP -- CHECK FOR OPERAND SEPARATOR CHARACTER
;
; CALLING SEQUENCE:
;
; A = CHARACTER.
;
; JSR CHKSEP
; BNE NOT A SEPARATOR
;
B7D8 C9 20 CHKSEP CMP #' ; BLANK?
B7DA F0 0A BEQ CKS090 ; YES.
B7DC C9 2C CMP #', ; COMMA?
B7DE F0 06 BEQ CKS090 ; YES.
; *S* JMP CHKTRM ; END OF STATEMENT CHECK & RETURN.
;
; CHKTRM -- CHECK FOR STATEMENT TERMINATOR (EOL OR '[').
;
; CALLING SEQUENCE:
;
; A = CHARACTER.
;
; JSR CHKTRM
; BNE NOT STATEMENT TERMINATOR.
;
B7E0 C9 9B CHKTRM CMP #EOL
B7E2 F0 02 BEQ CKT090
B7E4 C9 5B CMP #'[
B7E6 CKS090
B7E6 60 CKT090 RTS
;
; CHKEQS -- CHECK FOR EQUAL SIGN
;
; CALLING SEQUENCE:
;
; Y = 'INLN' INDEX.
;
; JSR CHKEQS
; BEQ 1ST NON-BLANK CHARACTER WAS '='.
;
; Y = 'INLN' INDEX TO 1ST NON-BLANK CHAR.
;
B7E7 20 FA B7 CHKEQS JSR SLB ; SKIP LEADING BLANKS.
B7EA C9 3D CMP #'=
B7EC 60 RTS ; RETURN WITH CC SET.
;
; SKPSEP -- SKIP OPERAND SEPARATOR(S)
;
; CALLING SEQUENCE:
;
; Y = INDEX TO INPUT LINE
;
; JSR SKPSEP
;
; Y = INDEX TO FIRST NON-SEPARATOR FOUND
;
; NOTE: ANY STRING OF CONSECUTIVE BLANKS AND/OR COMMAS IS TREATED AS A SINGLE
; SEPARATOR.
;
B7ED C8 INY
B7EE B1 80 SKPSEP LDA (INLN),Y
B7F0 C9 20 CMP #' ; BLANK?
B7F2 F0 F9 BEQ SKPSEP-1 ; YES.
B7F4 C9 2C CMP #', ; COMMA?
B7F6 F0 F5 BEQ SKPSEP-1 ; YES.
B7F8 60 SKS090 RTS
;
; SLB -- SKIP LEADING BLANKS
;
; CALLING SEQUENCE:
;
; JSR SLB
;
; A = FIRST NON-BLANK CHARACTER FOUND.
;
B7F9 C8 INY
B7FA B1 80 SLB LDA (INLN),Y
B7FC C9 20 CMP #' ; BLANK?
B7FE F0 F9 BEQ SLB-1 ; YES -- KEEP SCANNING.
B800 60 RTS
;
; SCNEOL -- SCAN TO END OF LINE
;
B801 C8 INY
B802 B1 80 SCNEOL LDA (INLN),Y
B804 C9 9B CMP #EOL
B806 D0 F9 BNE SCNEOL-1
B808 60 RTS ; RETURN WITH CC SET.
;
; PSF -- PRINT A STORAGE FORMAT LINE
;
; CALLING SEQUENCE:
;
; Y = INDEX TO LINE POINTER.
;
; JSR PSF
;
B809 A2 36 PSF LDX #POINT-DTAB ; MOVE POINTER TO 'POINT'
B80B 20 CF B3 JSR DMOVI
B80E 20 54 B8 JSR GTLNNO ; GET LINE # TO 'LINENO'
B811 A2 5C LDX #LINENO-DTAB
B813 20 0B B7 JSR DECASC ; PRINT BINARY LINE #.
.IF DEBUG
JSR SPACE ; PUT SPACE BETWEEN LINE # AND STATMENT.
.ENDIF
.IF DEBUG-1
B816 A9 20 LDA #' ; PUT SPACE BETWEEN LINE # AND STATEMENT
B818 20 6F AF JSR CHOT
.ENDIF
B81B C8 INY ; GET STATEMENT LENGTH.
B81C B1 B6 LDA (POINT),Y
B81E AA TAX
B81F CE FE 02 DEC DSPFLG ; DISPLAY CONTROL CHARACTERS.
B822 C8 PSF010 INY ; PRINT STATEMENT BODY.
B823 B1 B6 LDA (POINT),Y
B825 20 6F AF JSR CHOT
B828 CA DEX
B829 D0 F7 BNE PSF010
B82B EE FE 02 INC DSPFLG ; BACK TO ZERO.
B82E 60 RTS
;
; NULACC SET THE ACCEPT BUFFER TO NULL (SINGLE SPACE)
;
B82F A0 00 NULACC LDY #0
B831 A9 20 LDA #' ; SINGLE SPACE.
B833 91 88 STA (ACLN),Y
B835 84 8A STY ACLN+2 ; START INDEX.
B837 C8 INY
B838 84 8B STY ACLN+3 ; END INDEX.
B83A 60 RTS
;
; ZERVAR -- ZERO NUMERIC VARIABLES
;
B83B A2 34 ZERVAR LDX #52 ; 26 VARIABLES.
B83D A9 00 LDA #0
B83F 9D 1A 05 ZNV010 STA VARTAB-1,X
B842 CA DEX
B843 D0 FA BNE ZNV010
B845 60 RTS ; RETURN WITH CC AND A = ZERO.
;
; ABRTCK -- BREAK KEY ABORT CHECK
;
B846 48 ABRTCK PHA ; (SEE 'XSYNC').
B847 A5 11 LDA BREAK ; OPERATOR ABORT?
B849 D0 07 BNE ABC090 ; NO.
B84B C6 11 DEC BREAK ; YES -- RESET FLAG.
B84D A9 87 LDA #ABTERR ; STOP WITH STATUS CODE.
B84F 4C 6C A1 JMP PSTOP
B852 68 ABC090 PLA
B853 60 RTS
;
; GTLNNQ -- GET LINE # FROM STORAGE LINE
;
; CALLING SEQUENCE:
;
; 'POINT' POINTS TO STORAGE LINE
;
; JSR GTLNNO
;
; 'LINENO' = BINARY LINE #
; Y = 4
;
B854 A0 03 GTLNNO LDY #3
B856 B1 B6 LDA (POINT),Y
B858 85 DD STA LINENO+1 ; RE-INVERT ORDER.
B85A C8 INY
B85B B1 B6 LDA (POINT),Y
B85D 85 DC STA LINENO
B85F 60 RTS
; NEWLIN -- ISSUE NEW LINE SEQUENCE TO 'CHOT'
B860 A9 9B NEWLIN LDA #EOL
B862 4C 6F AF JMP CHOT ; NEWLINE & RETURN
; SPACE(S) -- ISSUE SPACE(S) TO 'CHOT'
.IF DEBUG
SPACES LDA #' ; TWO SPACES.
JSR CHOT
SPACE LDA #' ; ONE SPACE.
JMP CHOT
.ENDIF
;
; CRSNOP -- COMPLICATED NOP TO UPDATE CURSOR INHIBIT/ENABLE STATE
;
; CALLING SEQUENCE:
;
; A = 0 TO ENABLE CURSOR, ELSE DISABLE CURSOR.
;
B865 8D F0 02 CRSNOP STA CRSINH ; SET CURSOR INHIBIT FLAG.
B868 A9 1C LDA #CUP ; CURSOR UP ...
B86A 20 6F AF JSR CHOT
B86D A9 1D LDA #CDOWN ; ... THEN DOWN ...
B86F 4C 6F AF JMP CHOT ; ... & RETURN.
;
; AUDCLR -- CLEAR AUDIO REGISTERS AND SELECTS
;
B872 A9 03 AUDCLR LDA #$03 ; MAGIC CONSTANT FROM D. CRANE, 27-AUG-79
B874 8D 32 02 STA SSKCTL
B877 8D 0F D2 STA SKCTL
B87A A9 00 LDA #0
B87C 8D 08 D2 STA AUDCTL ; SET AUDIO TO 4 INDEPENDENT REGISTERS.
B87F A2 08 LDX #AUREGS*2
B881 9D FE D1 AUC010 STA AUDF1-2,X ; CLEAR ALL ACTIVE TONES.
B884 9D FF D1 STA AUDC1-2,X
B887 9D 53 05 STA AUDIOR-2,X ; CLEAR 'SO' SELECTS.
B88A 9D 54 05 STA AUDIOR-1,X
B88D CA DEX
B88E CA DEX
B88F D0 F0 BNE AUC010
B891 60 RTS
;
; EXP -- ARITHMETIC EXPRESSION EVALUATOR
;
; CALLING SEQUENCE:
;
; 'INLN' POINTS TO LINE TO BE EVALUATED
; Y = INDEX TO START OF EXPRESSION
;
; JSR EXP
;
; Y = INDEX TO END OF EXPRESSION + 1
; 'EXPSTK'+0 & +1 = RESULT OF EVALUATION.
;
B892 A9 00 EXP LDA #0 ; INITIALIZE CRITICAL VARIABLES.
B894 85 91 STA ESTKP
B896 20 CA B8 EXPRC JSR EXPVAL ; CHECK FOR OPERAND & GET VALUE TO STACK.
B899 20 FA B7 EXP030 JSR SLB ; SKIP LEADING BLANKS
B89C 84 A7 STY TEMP2 ; SAVE INDEX.
B89E 20 E8 A4 JSR ATOM ; CHECK FOR OPERATOR.
B8A1 D0 1F BNE EXP080 ; INVALID ATOM.
B8A3 C9 40 CMP #OPR
B8A5 D0 1B BNE EXP080 ; NOT AN OPERATOR.
B8A7 A6 91 LDX ESTKP ; PUSH OPERATOR ROUTINE ADDR TO EXP STACK.
B8A9 E0 0E CPX #ESTKSZ
B8AB F0 18 BEQ EXP192 ; STACK FULL.
B8AD A5 B6 LDA POINT
B8AF 95 93 STA EXPSTK,X
B8B1 A5 B7 LDA POINT+1
B8B3 95 94 STA EXPSTK+1,X
B8B5 E8 INX
B8B6 E8 INX
B8B7 86 91 STX ESTKP
B8B9 20 CA B8 JSR EXPVAL ; CHECK FOR OPERAND & GET VALUE TO STACK.
B8BC 20 1B B9 JSR SOP ; OPERATE ON STACK DATA.
B8BF 4C 99 B8 JMP EXP030
B8C2 A4 A7 EXP080 LDY TEMP2
B8C4 60 RTS
B8C5 A9 02 EXP192 LDA #EXPERR
B8C7 4C 6C A1 EXP194 JMP PSTOP
;
; EXPVAL -- VALIDATE OPERAND & PUSH VALUE TO STACK
;
; CALLING SEQUENCE:
;
; Y = INDEX TO 'INLN'
;
; JSR EXPVAL
;
B8CA 20 FA B7 EXPVAL JSR SLB
B8CD C9 2D CMP #'- ; UNARY MINUS?
B8CF D0 0D BNE EXV010 ; NO.
B8D1 C8 INY ; YES.
B8D2 20 CA B8 JSR EXPVAL ; *** RECURSIVE CALL ***
B8D5 A5 91 LDA ESTKP ; GET OFFSET TO RESULT.
B8D7 18 CLC
B8D8 69 11 ADC #EXPSTK-DTAB-2
B8DA AA TAX
B8DB 4C 3F B6 JMP DNEGI ; NEGATE RESULT RETURN.
B8DE C9 28 EXV010 CMP #'( ; LEFT PAREN?
B8E0 D0 0C BNE EXV020 ; NO.
B8E2 C8 INY
B8E3 20 96 B8 JSR EXPRC ; YES -- EVALUATE SUB-EXPRESSION.
B8E6 B1 80 LDA (INLN),Y
B8E8 C9 29 CMP #') ; MATCHING RIGHT PAREN?
B8EA D0 D9 BNE EXP192 ; NO -- ERROR.
B8EC C8 INY ; YES -- SKIP OVER IT.
B8ED 60 RTS
B8EE C9 3F EXV020 CMP #'? ; RANDOM NUMBER?
B8F0 D0 0D BNE EXV030 ; NO.
B8F2 AD 0A D2 LDA PKYRND ; YES -- GET RANDOM # FROM POKEY.
B8F5 85 B8 STA NUMBER
B8F7 AD 0A D2 LDA PKYRND
B8FA 85 B9 STA NUMBER+1
B8FC C8 INY ; SKIP OVER '?'
B8FD D0 09 BNE EXV040 ; (BRA).
B8FF 20 E8 A4 EXV030 JSR ATOM
B902 D0 C3 BNE EXP194 ; ERROR.
B904 29 86 AND #NUM+NVAR+BPTR ; NUMERIC VARIABLE, POINTER OR CONSTANT?
B906 F0 BD BEQ EXP192 ; NO -- ERROR
B908 A6 91 EXV040 LDX ESTKP ; RESULT TO STACK.
B90A E0 0E CPX #ESTKSZ
B90C F0 B7 BEQ EXP192 ; STACK OVERFLOW.
B90E A5 B8 LDA NUMBER
B910 95 93 STA EXPSTK,X
B912 A5 B9 LDA NUMBER+1
B914 95 94 STA EXPSTK+1,X
B916 E8 INX
B917 E8 INX
B918 86 91 STX ESTKP
B91A 60 RTS
;
; SOP -- STACK OPERATE
;
; CALLING SEQUENCE:
;
B91B A5 92 SOP LDA EXEC ; EXECUTE?
B91D F0 1C BEQ SOP050 ; NO -- JUST REJUSTIFY THE STACK
B91F 84 A7 STY TEMP2
B921 A5 91 LDA ESTKP ; GET EXP STACK INDEX.
.IF DEBUG
CMP #6 ; SEE IF STACK HAS AT LEAST 3 ENTRIES
BCC SOP090 ; NO -- PROBLEM!
.ENDIF
B923 18 CLC ; YES -- CONVERT STACK INDEX TO 'DTAB' INDEX.
B924 69 11 ADC #EXPSTK-DTAB-2
B926 A8 TAY
B927 AA TAX
B928 CA DEX ; INDEX TO OPERATOR PROCESSOR ADDRESS.
B929 CA DEX
B92A B5 80 LDA DTAB,X ; GET OPERATE ROUTINE ADDRESS.
B92C 8D 09 05 STA SJUMP+1
B92F B5 81 LDA DTAB+1,X
B931 8D 0A 05 STA SJUMP+2
B934 CA DEX ; INDEX TO TARGET ENTRY.
B935 CA DEX
B936 20 08 05 JSR SJUMP ; OPERATE ON DATA.
B939 A4 A7 LDY TEMP2
B93B 38 SOP050 SEC ; (CLEAR BORROW).
B93C A5 91 LDA ESTKP ; ADJUST STACK INDEX.
B93E E9 04 SBC #4
B940 85 91 STA ESTKP
B942 60 RTS
.IF DEBUG
SOP090 LDA #INTERR ; INTERNAL BUG.
JMP PSTOP
.ENDIF
; TEXP -- EVALUATE TEXT EXPRESSION
;
; Y = POINTER TO START OF TEXT EXPR IN 'INLN'
;
; JSR TEXP
; BNE EXECUTE MODE
;
; TEXP+2 = 0
; TEXP+3 = END OF TEXT EXPRESSION.
;
; THE EOL IS NOT PART OF THE RESULTANT TEXT
;
B943 A5 92 TEXP LDA EXEC ; EXECUTE MODE?
B945 D0 03 BNE TEX005 ; YES.
B947 4C 02 B8 JMP SCNEOL ; NO -- SCAN TO EOL & RETURN.
B94A A9 00 TEX005 LDA #0 ; INIT RESULT LENGTH COUNT ...
B94C 85 8F STA TELN+3
B94E 85 8E STA TELN+2 ; ... & STARTING INDEX.
B950 AD 70 05 LDA CDEST ; SAVE 'CHOT' DESTINATION.
B953 8D 71 05 STA CDEST+1
B956 A9 FF LDA #$FF
B958 8D 70 05 STA CDEST ; YES -- RE-ROUTE 'CHOT' OUTPUT TO 'TEXBUF'.
B95B B1 80 TEX010 LDA (INLN),Y ; GET A CHARACTER.
B95D 20 E0 B7 JSR CHKTRM ; STATEMENT TERMINATOR?
B960 F0 40 BEQ TEX400 ; YES.
B962 C9 25 CMP #'% ; SPECIAL NUMBER?
B964 F0 13 BEQ TEX100 ; YES.
B966 C9 40 CMP #'@ ; POINTER?
B968 F0 0F BEQ TEX100 ; YES.
B96A C9 23 CMP #'# ; NUMERIC VARIABLE DELIMITER?
B96C F0 0B BEQ TEX100 ; YES.
B96E C9 24 CMP #'$ ; STRING VARIABLE DELIMITER?
B970 F0 07 BEQ TEX100 ; YES.
B972 C8 TEX020 INY
B973 20 6F AF JSR CHOT ; YES -- PRINT TEXT LITERAL.
B976 4C 5B B9 JMP TEX010
B979 48 TEX100 PHA ; SAVE THE TEXT CHARACTER.
B97A 98 TYA ; SAVE THE Y REG.
B97B 48 PHA
B97C 20 E8 A4 JSR ATOM ; GET VALUE.
B97F F0 05 BEQ TEX220 ; O.K.
B981 68 TEX210 PLA ; NOT ATOM -- RESTORE Y REG ...
B982 A8 TAY
B983 68 PLA ; ... & CHARACTER.
B984 D0 EC BNE TEX020 ; (BRA).
B986 C9 10 TEX220 CMP #USVAR ; UNDEFINED STRING?
B988 F0 F7 BEQ TEX210 ; YES -- PRINT LITERALLY.
B98A C9 08 CMP #SVAR ; DEFINED STRING?
B98C F0 0A BEQ TEX300 ; YES -- PRINT VALUE.
; NUMERIC DATA
B98E 68 PLA ; NO -- MUST BE NUMERIC VALUE.
B98F 68 PLA ; CLEAR STACK.
B990 A2 38 LDX #NUMBER-DTAB ; VALUE OF NUMBER.
B992 20 0B B7 JSR DECASC ; CONVERT TO ASCII & OUTPUT.
B995 4C 5B B9 JMP TEX010 ; CONTINUE.
; STRING VARIABLE
B998 68 TEX300 PLA ; CLEAR THE STACK
B999 68 PLA
B99A A2 42 LDX #DP-DTAB ; INDEX TO STRING VALUE
B99C 20 53 B1 JSR PRTSTG
B99F 4C 5B B9 JMP TEX010
B9A2 AD 71 05 TEX400 LDA CDEST+1 ; RESTORE 'CHOT' DESTINATION.
B9A5 8D 70 05 STA CDEST
; *** EXTERNAL ENTRY POINT FROM 'XACCPT ' ***
B9A8 A6 8F TRAILB LDX TELN+3 ; EXAMINE LAST CHAR OF TEXP.
B9AA E4 8E CPX TELN+2
B9AC F0 0C BEQ TEX480 ; NULL RESULT.
B9AE BD 76 05 LDA TEXBUF-1,X ; GET LAST CHAR IN BUFFER.
B9B1 C9 5F CMP #'_ ; UNDERSCORE?
B9B3 D0 05 BNE TEX480 ; NO.
B9B5 A9 20 LDA #' ; YES -- REPLACE WITH BLANK.
B9B7 9D 76 05 STA TEXBUF-1,X
B9BA A5 92 TEX480 LDA EXEC ; THE CC IS BEING SET TO REFLECT THE STATE
; OF THE 'EXEC' FLAG BECAUSE EVERY SINGLE
; JSR TO 'TEXP' USED TO BE FOLLOWED BY A
; 'LDA EXEC' INSTRUCTION. THESE HAVE ALL BEEN
; BEEN "COMMENTED" OUT; WHEN WILL THIS ALL END?
B9BC 60 RTS
;
; HEREIN RESIDE THE LOWER LEVEL GRAPHICS ROUTINES FOR PILOT GRAPHICS
;
0022 PENPOS = ICCOMZ
;
;
; 'DRAWTO', 'FILLTO' & 'GOTO' SUB-COMMAND PROCESSOR
;
B9BD A9 12 GFILTO LDA #FILL ; PEN DOWN.
B9BF D0 06 BNE GGT005 ; (BRA).
B9C1 A9 11 GDRWTO LDA #DRAW ; PEN DOWN.
B9C3 D0 02 BNE GGT005 ; (BRA).
B9C5 A9 00 GGOTO LDA #0 ; PEN UP.
B9C7 85 22 GGT005 STA PENPOS ; SET PEN POSITION.
B9C9 20 92 B8 JSR EXP ; GET X-COORDINATE
B9CC A5 92 LDA EXEC ; EXECUTE MODE?
B9CE F0 08 BEQ GGT010 ; NO.
B9D0 A5 93 LDA EXPSTK ; YES -- UPDATE X.
B9D2 85 E6 STA GXNEW
B9D4 A5 94 LDA EXPSTK+1
B9D6 85 E7 STA GXNEW+1
B9D8 20 EE B7 GGT010 JSR SKPSEP ; SKIP OPERAND SEPARATOR.
B9DB 20 92 B8 JSR EXP ; GET Y-COORDINATE.
B9DE A5 92 LDA EXEC ; EXECUTE MODE?
B9E0 F0 11 BEQ GGT090 ; NO.
B9E2 A5 93 LDA EXPSTK ; YES -- UPDATE Y.
B9E4 85 E9 STA GYNEW
B9E6 A5 94 LDA EXPSTK+1
B9E8 85 EA STA GYNEW+1
B9EA A9 00 LDA #0 ; CLEAR FRACTIONAL PORTION OF X & Y
B9EC 85 E8 STA GXNEW+2
B9EE 85 EB STA GYNEW+2
B9F0 20 A7 BA JSR GMOVE ; NOW EFFECT MOVE.
B9F3 GTT090
B9F3 60 GGT090 RTS ; RETURN.
B9F4 20 92 B8 GTRNTO JSR EXP ; GET POLAR ANGLE.
B9F7 A5 92 LDA EXEC ; EXECUTE MODE?
B9F9 F0 F8 BEQ GTT090 ; NO.
B9FB A5 93 LDA EXPSTK ; YES -- UPDATE POLAR ANGLE.
B9FD 85 F2 STA THETA
B9FF A5 94 LDA EXPSTK+1
BA01 85 F3 STA THETA+1
BA03 4C 41 BC JMP MOD360 ; MODULO 360 & RETURN.
BA06 A9 12 GFIL LDA #FILL ; PEN DOWN.
BA08 D0 06 BNE GGO005
BA0A A9 11 GDRW LDA #DRAW ; PEN DOWN.
BA0C D0 02 BNE GGO005
BA0E A9 00 GGO LDA #0 ; PEN UP.
BA10 85 22 GGO005 STA PENPOS ; SET PEN POSITION.
BA12 20 92 B8 JSR EXP ; GET MAGNITUDE OP MOVE.
BA15 A5 92 LDA EXEC ; EXECUTE MODE?
BA17 F0 40 BEQ GGO090 ; NO.
BA19 A9 01 LDA #1 ; COS(THETA) = SIN(THETA+90)
BA1B 20 C8 BC JSR SINVAL ; GY = GY + (<EXP> * COS (THETA)).
BA1E 20 83 BD JSR TMULT
BA21 A2 69 LDX #GYNEW-DTAB
BA23 20 C5 BD JSR TADDI
BA26 A9 00 LDA #0
BA28 20 C8 BC JSR SINVAL ; GX = GX + (<EXP> * SIN(THETA)).
BA2B 20 83 BD JSR TMULT
BA2E A2 66 LDX #GXNEW-DTAB
BA30 20 C5 BD JSR TADDI
BA33 4C A7 BA JMP GMOVE ; NOW EFFECT MOVE RETURN.
BA36 20 92 B8 GTRN JSR EXP ; POLAR ANGLE DELTA THETA.
BA39 A5 92 LDA EXEC ; EXECUTE MODE?
BA3B F0 1C BEQ GTR090 ; NO.
BA3D 84 AB STY XTEMP ; YES -- SAVE INDEX.
BA3F A2 72 LDX #THETA-DTAB ; THETA = THETA + DELTA.
BA41 A0 13 LDY #EXPSTK-DTAB
BA43 20 80 B5 JSR DADDI
BA46 A4 AB LDY XTEMP
BA48 4C 41 BC JMP MOD360 ; MODULO 360 & RETURN.
BA4B A2 D3 GPEN LDX #PCTAB-CTAB ; MATCH OPERAND.
BA4D 20 10 A3 JSR CMATCH
BA50 D0 08 BNE GPN099 ; NO MATCH.
BA52 A5 92 LDA EXEC ; EXECUTE MODE?
BA54 F0 03 BEQ GPN090 ; NO.
BA56 8E 53 05 STX PEN ; YES SET PEN COLOR.
BA59 GGO090
BA59 GTR090
BA59 60 GPN090 RTS
BA5A 4C 6C A1 GPN099 JMP PSTOP
BA5D A5 92 GEXIT LDA EXEC ; EXECUTE MODE?
BA5F F0 38 BEQ GEX090 ; NO.
BA61 84 AB STY XTEMP
; CLOSE GRAPHICS SCREEN BY CLOSING 'S' & 'E' AND OPENING 'E'
BA63 A2 20 LDX #IOCB2 ; CLOSE 'S'.
BA65 20 FD B0 JSR DCLOSE
BA68 A2 00 LDX #IOCB0 ; CLOSE 'E'.
BA6A 20 FD B0 JSR DCLOSE
; *S* LDX #0 ; RESET GRAPHICS MODE FLAG.
BA6D 8E 54 05 STX GRFLAG
BA70 A9 45 LDA #'E ; PUT "E" IN OPEN BUFFER
BA72 8D 60 05 STA OPNBUF
BA75 A9 9B LDA #EOL
BA77 8D 61 05 STA OPNBUF+1
BA7A A9 0C LDA #OREAD+OWRIT ; OPEN AGAIN.
BA7C 20 B7 B0 JSR DOPEN
; MOVE THE STRING STORAGE AREA UPWARD TO RE-CAPTURE THE SPACE USED
; BY THE GRAPHICS SCREEN.
; *** EXTERNAL ENTRY FROM 'INIT' ***
BA7F 38 GEX050 SEC ; 'MBC' = 'S2H' - 'S2L' (BYTE COUNT).
BA80 A5 B4 LDA S2H
BA82 E5 B2 SBC S2L
BA84 85 DA STA MBC
BA86 A5 B5 LDA S2H+1
BA88 E5 B3 SBC S2L+1
BA8A 85 DB STA MBC+1
BA8C A5 B2 LDA S2L ; 'MSP' = 'S2L ' (SOURCE)
BA8E 85 D6 STA MSP
BA90 A5 B3 LDA S2L+1
BA92 85 D7 STA MSP+1
BA94 20 77 B0 JSR GS0100 ; SETUP ADDITIONAL PARMS & MOVE THE DATA.
BA97 A4 AB LDY XTEMP
BA99 GCL090
BA99 60 GEX090 RTS
; *** CALLED BY 'XRUN' TOO ***
BA9A A5 92 GCLEAR LDA EXEC ; EXECUTE MODE? NO.
BA9C F0 FB BEQ GCL090 ; NO.
BA9E A9 00 LDA #0 ; TO AVOID ERROR $8D IF CURSOR AT LOWER ...
BAA0 85 54 STA ROWCRS ; ... RIGHT CORNER OF SCREEN.
BAA2 A9 7D LDA #CLEAR ; YES -- CLEAR GRAPHICS SCREEN ...
BAA4 4C 3C B1 JMP TOUT ; ... & RETURN.
; LOWER LEVEL GRAPHICS UTILITIES
BAA7 84 E0 GMOVE STY LE ; SAVE Y REGISTER.
BAA9 A2 0C LDX #12 ; 4 VARIABLES OF 3 BYTES EACH.
BAAB B5 E5 GMV010 LDA GXNEW-1,X
BAAD 2A ROL A
BAAE B5 E3 LDA GXNEW-3,X
BAB0 69 00 ADC #0
BAB2 95 BB STA GX1-3,X
BAB4 B5 E4 LDA GXNEW-2,X
BAB6 69 00 ADC #0
BAB8 95 BC STA GX1-2,X
BABA A9 00 LDA #0
BABC 95 BD STA GX1-1,X
BABE CA DEX
BABF CA DEX
BAC0 CA DEX
BAC1 D0 E8 BNE GMV010
BAC3 AD 53 05 LDA PEN ; PEN COLOR = 'UP'?
BAC6 8D FB 02 STA ATACHR ; SET COLOR FOR DISPLAY
BAC9 8D FD 02 STA FILDAT ; SET FILL DATA TOO.
BACC C9 04 CMP #PCUP
BACE F0 04 BEQ GMV10B ; YES -- NO PLOTTING.
BAD0 A5 22 LDA PENPOS ; PEN POSITION?
BAD2 D0 03 BNE GMV011 ; DOWN.
BAD4 4C BF BB GMV10B JMP GMV150 ; UP.
BAD7 A2 4A GMV011 LDX #DELX-DTAB ; COMPUTE DELTA X AND DELTA Y.
BAD9 A0 3E LDY #GX1-DTAB ; 'DELX' = 'GX1' ...
BADB 20 CF B3 JSR DMOVI
BADE A0 44 LDY #GX2-DTAB ; ... - 'GX2' ...
BAE0 20 90 B5 JSR DSUBI
BAE3 70 20 BVS GMVOVF ; DELTA X EXCEEDS MAXIMUM.
BAE5 A2 4C LDX #DELY-DTAB ; 'DELY' = 'GY1' ...
BAE7 A0 41 LDY #GY1-DTAB
BAE9 20 CF B3 JSR DMOVI
BAEC A0 47 LDY #GY2-DTAB ; ... - 'GY2'.
BAEE 20 90 B5 JSR DSUBI
BAF1 70 12 BVS GMVOVF ; DELTA Y EXCEEDS MAXIMUM.
; CHECK FOR LINE SEGMENT WITHIN SCREEN LIMITS
; THE CLIPPING ALGORITHM USED HERE IS DESCRIBED IN SECTION 5-1 OF THE
; SECOND EDITION OF "PRINCIPLES OF INTERACTIVE COMPUTER GRAPHICS" BY
; NEWMAN & SPROULL.
BAF3 A2 3E GMV012 LDX #GX1-DTAB ; TEST END POINT.
BAF5 20 DD BB JSR INTEST
BAF8 85 F4 STA GNUMB ; SAVE RESULT.
BAFA A2 44 LDX #GX2-DTAB ; TEST END POINT.
BAFC 20 DD BB JSR INTEST
BAFF 85 F5 STA GNUMB+1 ; SAVE RESULT.
BB01 25 F4 AND GNUMB
BB03 F0 03 BEQ GMV013 ; PART OF LINE MAY BE IN SCREEN.
BB05 4C D7 BB GMVOVF JMP GMV157 ; NO PART OF LINE IS IN SCREEN.
BB08 A5 F4 GMV013 LDA GNUMB
BB0A 05 F5 ORA GNUMB+1
BB0C D0 03 BNE GMV014 ; PART OF LINE IS OFF THE SCREEN.
BB0E 4C A0 BB JMP GMV120 ; ALL OF LINE IS IN SCREEN.
BB11 A2 3E GMV014 LDX #GX1-DTAB ; FIND AN INTERSECTION WITH AN EDGE
BB13 A5 F4 LDA GNUMB ; IS XI,Y1 OUTSIDE SCREEN?
BB15 D0 04 BNE GMV015 ; YES.
BB17 A2 44 LDX #GX2-DTAB ; NO -- THEN X2, Y2 MUST BE.
BB19 A5 F5 LDA GNUMB+1
BB1B 48 GMV015 PHA ; SAVE INTERSECT STATUS.
BB1C 29 08 AND #ELEFT ; LEFT EDGE INTERSECTION?
BB1E F0 08 BEQ GMV020 ; NO.
BB20 A9 B1 LDA #-XC+1 ; YES -- 'GACC' = LEFT EDGE X VALUE.
BB22 85 CE STA GACC
BB24 A9 FF LDA #-1
BB26 D0 0C BNE GMV025 ; (BRA).
BB28 68 GMV020 PLA ; GET STATUS.
BB29 48 PHA
BB2A 29 04 AND #ERIGHT ; RIGHT EDGE INTERSECTION?
BB2C F0 33 BEQ GMV030 ; NO.
BB2E A9 4F LDA #XC-1 ; YES -- 'GACC' = RIGHT EDGE X VALUE.
BB30 85 CE STA GACC
BB32 A9 00 LDA #0
BB34 85 CF GMV025 STA GACC+1 ; EXTEND SIGN.
BB36 A0 4E LDY #GACC-DTAB ; GX1 OR GX2 = 'GACC'.
BB38 20 CF B3 JSR DMOVI
BB3B 8A TXA ; GY1 OR GY2 = (GACC-GX ) * DELY / DELX + GY.
BB3C 48 PHA
BB3D A2 4E LDX #GACC-DTAB
BB3F A0 6C LDY #GX-DTAB
BB41 20 B0 BE JSR RSUBI
BB44 A0 4C LDY #DELY-DTAB
BB46 20 D9 BD JSR QMULT
BB49 A0 4A LDY #DELX-DTAB
BB4B 20 3C BE JSR QDIV
.IF DEBUG
BNE GMV041 ; OVERFLOW -- DON'T DRAW.
.ENDIF
BB4E A0 6F LDY #GY-DTAB
BB50 20 A9 BE JSR RADDI
BB53 68 PLA
BB54 AA TAX
BB55 A5 CE LDA GACC
BB57 95 83 STA DTAB+3,X
BB59 A5 CF LDA GACC+1
BB5B 95 84 STA DTAB+4,X
BB5D 68 PLA ; CLEAR STACK.
BB5E 4C F3 BA JMP GMV012 ; KEEP THIS UP UNTIL LINE SEGMENT IS CLIPPED.
BB61 68 GMV030 PLA ; GET STATUS.
BB62 48 PHA
BB63 29 02 AND #EBOTOM ; BOTTOM EDGE INTERSECTION?
BB65 F0 08 BEQ GMV040 ; NO.
BB67 A9 D1 LDA #-YC+1 ; YES -- 'GACC' = BOTTOM EDGE Y VALUE.
BB69 85 CE STA GACC
BB6B A9 FF LDA #-1
BB6D D0 06 BNE GMV045 ; (BRA).
BB6F GMV040
.IF DEBUG
PLA ; GET STATUS.
PHA
AND #ETOP ; TOP EDGE INTERSECTION?
BNE GMV042 ; YES.
GMV041 LDA #INTERR ; NO -- IMPLEMENTATION BUG.
JMP PSTOP
GMV042=*
.ENDIF
BB6F A9 2F LDA #YC-1 ; 'GACC' = TOP EDGE Y VALUE.
BB71 85 CE STA GACC
BB73 A9 00 LDA #0
BB75 85 CF GMV045 STA GACC+1 ; EXTEND SIGN.
BB77 95 84 STA DTAB+4,X ; GY1 OR GY2 = 'GACC'.
BB79 A5 CE LDA GACC
BB7B 95 83 STA DTAB+3,X
BB7D 8A TXA ; SAVE X REGISTER.
BB7E 48 PHA ; GX1 OR GX2 = (GACC - GY) * DELX / DELY + QX
BB7F A2 4E LDX #GACC-DTAB
BB81 A0 6F LDY #GY-DTAB
BB83 20 B0 BE JSR RSUBI
BB86 A0 4A LDY #DELX-DTAB
BB88 20 D9 BD JSR QMULT
BB8B A0 4C LDY #DELY-DTAB
BB8D 20 3C BE JSR QDIV
.IF DEBUG
BNE GMV041 ; OVERFLOW. DON'T DRAW
.ENDIF
BB90 A0 6C LDY #GX-DTAB
BB92 20 A9 BE JSR RADDI
BB95 68 PLA
BB96 AA TAX
BB97 A0 4E LDY #GACC-DTAB
BB99 20 CF B3 JSR DMOVI
BB9C 68 PLA ; CLEAR THE STACK.
BB9D 4C F3 BA JMP GMV012 ; KEEP THIS UP UNIIL LINE SEGMENT IS CLIPPED.
BBA0 A2 00 GMV120 LDX #0 ; SET LINE SEGMENT END ...
BBA2 A0 3E LDY #GX1-DTAB
BBA4 20 96 BC JSR SETCUR
BBA7 A2 06 LDX #OLDROW-ROWCRS ; ... & START POINTS.
BBA9 A0 44 LDY #GX2-DTAB
BBAB 20 96 BC JSR SETCUR
BBAE 20 37 BC JSR NEWCUR ; ESTABLISH NEW CURSOR LOCATION.
BBB1 A4 E0 LDY LE ; RESTORE Y REGISTER.
BBB3 86 A1 STX TEMP ; SAVE REGISTERS.
BBB5 84 A2 STY TEMP+1
BBB7 A2 1A LDX #SSPEC-IOVBAS ; GO TO 'S:' SPECIAL ENTRY.
BBB9 20 73 B1 JSR IOHAND
BBBC 4C 7B AF JMP IOERCK ; CHECK FOR ERRORS & RETURN.
; PEN UP (GOTO AND GO)
BBBF A2 3E GMV150 LDX #GX1-DTAB ; CHECK FOR POINT IN SCREEN.
BBC1 20 DD BB JSR INTEST
BBC4 D0 11 BNE GMV157 ; NOT IN SCREEN -- DON'T PLOT.
BBC6 A2 00 LDX #0 ; SET NEW CURSOR POSITION.
BBC8 A0 3E LDY #GX1-DTAB
BBCA 20 96 BC JSR SETCUR ; CONVERT TO HANDLER COORDINATES.
BBCD AD 53 05 LDA PEN ; PLOT SINGLE POINT.
BBD0 C9 04 CMP #PCUP ; PEN COLOR = 'UP'?
BBD2 F0 03 BEQ GMV157 ; YES -- NO POINT PLOT.
BBD4 20 3C B1 JSR TOUT
BBD7 20 37 BC GMV157 JSR NEWCUR ; ESTABLISH NEW CURSOR POSITION.
BBDA A4 E0 LDY LE ; RESTORE Y REGISTER.
BBDC 60 RTS
;
; INTEST -- TEST FOR POINT WITHIN SCREEN LIMITS.
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET TO X,Y PAIR (EACH TRIPLE PRECISION)
;
; JSR INTEST
; BEQ POINT IN SCREEN
;
; A = EDGE TEST BITS (OOOOLRBT), WHERE 1=OUT OF BOUNDS FOR THAT EDGE.
;
BBDD 84 A9 INTEST STY TEMP2+2 ; SAVE Y REGISTER.
BBDF A0 27 LDY #TEMP2-DTAB
BBE1 A9 00 LDA #0 ; INITIALIZE RESULT BYTE.
BBE3 48 PHA
BBE4 85 A8 STA TEMP2+1
BBE6 B5 81 LDA DTAB+1,X ; CHECK SIGN OF POSITION.
BBE8 30 0E BMI INT010 ; NEGATIVE -- COULDN'T BE BEYOND RIGHT EDGE.
BBEA A9 50 LDA #XC ; SETUP RIGHT EDGE X POSITION.
BBEC 85 A7 STA TEMP2
BBEE 20 70 B5 JSR DSCMI ; TEST RIGHT EDGE.
BBF1 90 16 BCC INT020 ; INSIDE SCREEN.
BBF3 68 PLA ; OUTSIDE -- SET STATUS BIT.
BBF4 09 04 ORA #ERIGHT
BBF6 D0 10 BNE INT019 ; (BRA).
BBF8 A9 B0 INT010 LDA #-XC ; SETUP LEFT EDGE POSITION.
BBFA 85 A7 STA TEMP2
BBFC C6 A8 DEC TEMP2+1
BBFE 20 70 B5 JSR DSCMI ; TEST LEFT EDGE.
BC01 90 02 BCC INT012 ; OUTSIDE.
BC03 D0 04 BNE INT020 ; INSIDE.
BC05 68 INT012 PLA ; OUTSIDE -- SET STATUS BIT.
BC06 09 08 ORA #ELEFT
BC08 48 INT019 PHA
BC09 E8 INT020 INX ; ADVANCE TO Y POSITION.
BC0A E8 INX
BC0B E8 INX
BC0C A9 00 LDA #0
BC0E 85 A8 STA TEMP2+1
BC10 B5 81 LDA DTAB+1,X ; CHECK SIGN OF POSITION.
BC12 10 12 BPL INT030 ; POSITIVE -- COULDN'T BE BELOW BOTTOM EDGE.
BC14 A9 D0 LDA #-YC ; SETUP BOTTOM EDGE POSITION.
BC16 85 A7 STA TEMP2
BC18 C6 A8 DEC TEMP2+1
BC1A 20 70 B5 JSR DSCMI ; TEST BOTTOM EDGE.
BC1D 90 02 BCC INT022 ; OUTSIDE.
BC1F D0 12 BNE INT040 ; INSIDE.
BC21 68 INT022 PLA ; OUTSIDE -- SET STATUS BIT.
BC22 09 02 ORA #EBOTOM
BC24 D0 0C BNE INT039 ; (BRA).
BC26 A9 30 INT030 LDA #YC ; SETUP TOP EDGE POSITION.
BC28 85 A7 STA TEMP2
BC2A 20 70 B5 JSR DSCMI ; TEST TOP EDGE.
BC2D 90 04 BCC INT040 ; INSIDE.
BC2F 68 PLA ; OUTSIDE -- SET STATUS BIT.
BC30 09 01 ORA #ETOP
BC32 48 INT039 PHA
BC33 A4 A9 INT040 LDY TEMP2+2 ; RESTORE Y REGISTER.
BC35 68 PLA ; GET STATUS BYTE FOR EXIT.
BC36 60 RTS
;
; NEWCUR -- MOVE NEW CURSOR TO CURRENT CURSOR.
;
BC37 A2 06 NEWCUR LDX #6 ; 2 VARIABLES OF 3 BYTES EACH
BC39 B5 E5 NWC010 LDA GXNEW-1,X
BC3B 95 EB STA GX-1,X
BC3D CA DEX
BC3E D0 F9 BNE NWC010
BC40 60 RTS
;
; MOD360 -- 'THETA ' = 'THETA' MODULO 360
;
BC41 A5 F3 MOD360 LDA THETA+1 ; SEE IF ANGLE IS NEGATIVE.
BC43 10 20 BPL MOD020 ; NO.
BC45 A2 72 LDX #THETA-DTAB ; YES.
BC47 20 3F B6 JSR DNEGI ; GET ABSOLUTE VALUE.
BC4A A5 F3 LDA THETA+1 ; THETA = 32768 IS A SPECIAL CASE.
BC4C 30 3F BMI MOD030
BC4E 20 41 BC JSR MOD360 ; *** RECURSIVE CALL ***
BC51 A5 F2 LDA THETA ; TEST FOR RESULT = 0.
BC53 05 F3 ORA THETA+1
BC55 F0 0D BEQ MOD019 ; YES -- DONE.
BC57 A9 68 LDA #360 ; NO -- THETA = 360 - MOD(ABS(THETA))
BC59 38 SEC
BC5A E5 F2 SBC THETA
BC5C 85 F2 STA THETA
BC5E A9 01 LDA #360/256
BC60 E5 F3 SBC THETA+1
BC62 85 F3 STA THETA+1
BC64 60 MOD019 RTS
BC65 A5 F3 MOD020 LDA THETA+1 ; COMPARE WITH 360.
BC67 C9 01 CMP #360/256
BC69 D0 04 BNE MOD025
BC6B A5 F2 LDA THETA
BC6D C9 68 CMP #360
BC6F 90 24 MOD025 BCC MOD090 ; THETA < 360.
BC71 A9 68 LDA #360 ; PREPARE TO DIVIDE BY 360.
BC73 85 A7 STA TEMP2
BC75 A9 01 LDA #360/256
BC77 85 A8 STA TEMP2+1
BC79 84 A9 STY TEMP2+2
BC7B A2 72 LDX #THETA-DTAB
BC7D A0 27 LDY #TEMP2-DTAB
BC7F 20 D5 B5 JSR DDIVI
BC82 A4 A9 LDY TEMP2+2
BC84 A5 A1 LDA TEMP ; REMAINDER IN 'TEMP' AFTER DIVIDE.
BC86 85 F2 STA THETA
BC88 A5 A2 LDA TEMP+1
BC8A 85 F3 STA THETA+1
BC8C 60 RTS
BC8D A9 08 MOD030 LDA #8 ; 32768 MOD 360 = 8
BC8F 85 F2 STA THETA
BC91 A9 00 LDA #0
BC93 85 F3 STA THETA+1
BC95 60 MOD090 RTS
;
; SETCUR -- SET HANDLER CURSOR
;
; CALLING SEQUENCE:
;
; X = 0 FOR CURRENT CURSOR, 6 FOR PRIOR CURSOR.
; Y = DTAB OFFSET TO TRIPLE PRECISION X,Y POSITION.
;
; JSR SETCUR
;
BC96 B9 80 00 SETCUR LDA DTAB,Y
BC99 18 CLC
BC9A 69 50 ADC #XC
BC9C 95 55 STA COLCRS,X
BC9E 38 SEC ; (CLEAR BORROW).
BC9F A9 30 LDA #YC
BCA1 F9 83 00 SBC DTAB+3,Y
BCA4 95 54 STA ROWCRS,X
BCA6 60 RTS
;
; GREAD -- READ GRAPHICS DATA FROM SCREEN.
;
; CALLING SEQUENCE:
;
; CURSOR ALREADY SET TO LOCATION TO READ.
;
; JSR GREAD
;
; A = VALUE OF PIXEL AT CURSOR LOCATION
;
BCA7 A5 92 GREAD LDA EXEC ; EXECUTE MODE?
BCA9 F0 1C BEQ GRD090 ; NO.
BCAB AD 54 05 LDA GRFLAG ; YES -- GRAPHI
BCAE F0 17 BEQ GRD090 ; NO.
BCB0 A2 3E LDX #GX1-DTAB ; YES -- CHECK FOR POINT IN SCREEN LIMITS.
BCB2 20 DD BB JSR INTEST
BCB5 D0 0E BNE GRD080 ; NOT IN LIMITS -- RETURN VALUE OF ZERO.
BCB7 98 TYA ; SAVE Y REGISTER.
BCB8 48 PHA
BCB9 A2 00 LDX #0 ; SET CURSOR POSITION.
BCBB A0 3E LDY #GX1-DTAB
BCBD 20 96 BC JSR SETCUR
BCC0 68 PLA ; RESTORE Y REGISTER.
BCC1 A8 TAY
BCC2 4C 30 B1 JMP TIN ; GET PIXEL VALUE & RETURN.
BCC5 A9 00 GRD080 LDA #0 ; RETURN VALUE OF ZERO.
BCC7 60 GRD090 RTS
;
; SINVAL GET VALUE OF SIN(THETA+A*90)
;
; CALLING SEQUENCE:
;
; A = QUADRANT OFFSET (0-3)
; 'THETA' = ANGLE (0-359)
;
; JSR SINVAL
;
; 'TEMP' = SIN(THETA + A*90)
;
BCC8 85 A3 SINVAL STA TEMP+2 ; SAVE QUADRANT OFFSET.
BCCA 84 A4 STY TEMP+3
BCCC A0 72 LDY #THETA-DTAB ; 'ACC' = 'THETA'
BCCE 20 9E B6 JSR DLOADA ; X = 'ACC' - 'DTAB'.
BCD1 A9 5A LDA #90 ; 'TEMP ' = 90.
BCD3 85 A1 STA TEMP
BCD5 A9 00 LDA #90/256
BCD7 85 A2 STA TEMP+1
; NORMALIZE THETA TO 0 - 90 RANGE AND USE TRIG EQUALITIES TO COMPUTE SINE
BCD9 A0 21 SNV010 LDY #TEMP-DTAB ; IS 'ACC' <= 90.
BCDB 20 63 B5 JSR DCMPI
BCDE F0 09 BEQ SNV020 ; YES.
BCE0 90 07 BCC SNV020 ; YES.
BCE2 E6 A3 INC TEMP+2 ; NOT YET -- INCREMENT QUADRANT.
BCE4 20 90 B5 JSR DSUBI ; 'ACC' = 'ACC' - 90.
BCE7 D0 F0 BNE SNV010 ; (BRA UNLESS RESULT = 0).
BCE9 A6 E2 SNV020 LDX ACC ; RESULT IS 0 TO 90 FOR TABLE LOOKUP
BCEB A5 A3 LDA TEMP+2 ; QUADRANT #.
BCED 29 03 AND #$03 ; MODULO 4.
BCEF F0 18 BEQ SNV100 ; QUADRANT 0.
BCF1 C9 01 CMP #1
BCF3 D0 08 BNE SNV040
BCF5 A9 5A LDA #90 ; QUADRANT 1.
BCF7 E5 E2 SBC ACC
BCF9 AA TAX
BCFA 4C 09 BD JMP SNV100
BCFD C9 02 SNV040 CMP #2
BCFF F0 20 BEQ SNV150 ; QUADRANT 2.
BD01 A9 5A LDA #90 ; QUADRANT 3.
BD03 E5 E2 SBC ACC
BD05 AA TAX
BD06 4C 21 BD JMP SNV150
BD09 A9 00 SNV100 LDA #0 ; GET VALUE FROM TABLE.
BD0B E0 57 CPX #87 ; 87 THRU 90?
BD0D 90 08 BCC SNV120 ; NO -- USE TABLE.
BD0F 85 A1 STA TEMP ; SPECIAL CASE -- FORCE TO 1.0.
BD11 A9 01 LDA #1
BD13 85 A2 STA TEMP+1
BD15 D0 12 BNE SNV900 ; (BRA).
BD17 85 A2 SNV120 STA TEMP+1 ; MSB = 0.
BD19 BD 2C BD LDA SINTAB,X
BD1C 85 A1 STA TEMP ; LSB = VALUE FROM TABLE.
BD1E 4C 29 BD JMP SNV900
BD21 20 09 BD SNV150 JSR SNV100 ; GET VALUE TO 'TEMP ' ***.
BD24 A2 21 LDX #TEMP-DTAB ; THEN NEGATE VALUE.
BD26 20 3F B6 JSR DNEGI
BD29 A4 A4 SNV900 LDY TEMP+3
BD2B 60 RTS
; SINE TABLE VALUES FOR 0 THROUGH 86 DEGREES
BD2C SINTAB=* ; SIN(X) * 256 X
BD2C 00 04 09 .BYTE 0,4,9,13,18 ; 0 - 4
BD2F 0D 12
BD31 16 1B 1F .BYTE 22,27,31,36,40 ; 5 - 9
BD34 24 28
BD36 2C 31 35 .BYTE 44,49,53,58,62 ; 10-14
BD39 3A 3E
BD3B 42 47 4B .BYTE 66,71,75,79,83 ; 15-19
BD3E 4F 53
BD40 58 5C 60 .BYTE 88,92,96,100,104 ; 20-24
BD43 64 68
BD45 6C 70 74 .BYTE 108,112,116,120,124 ; 25-29
BD48 78 7C
BD4A 80 84 88 .BYTE 128,132,136,139,143 ; 30-34
BD4D 8B 8F
BD4F 93 96 9A .BYTE 147,150,154,158,161 ; 35-39
BD52 9E A1
BD54 A5 A8 AB .BYTE 165,168,171,175,178 ; 40-44
BD57 AF B2
BD59 B5 B8 BB .BYTE 181,184,187,190,193 ; 45-49
BD5C BE C1
BD5E C4 C7 CA .BYTE 196,199,202,204,207 ; 50-54
BD61 CC CF
BD63 D2 D4 D7 .BYTE 210,212,215,217,219 ; 55-59
BD66 D9 DB
BD68 DE E0 E2 .BYTE 222,224,226,228,230 ; 60-64
BD6B E4 E6
BD6D E8 EA EC .BYTE 232,234,236,237,239 ; 65-69
BD70 ED EF
BD72 F1 F2 F3 .BYTE 241,242,243,245,246 ; 70-74
BD75 F5 F6
BD77 F7 F8 F9 .BYTE 247,248,249,250,251 ; 75-79
BD7A FA FB
BD7C FC FD FE .BYTE 252,253,254,254,255 ; 80-84
BD7F FE FF
BD81 FF FF .BYTE 255,255 ; 85-86
;
; TMULT TRIPLE PRECISION MULTIPLY
;
; CALLING SEQUENCE:
;
; 'EXPSTK' = WORD OF SIGNED DATA
; 'TEMP' = WORD OF SIGNED DATA
;
; JSR TMULT
;
; 'GNUMB'+1 = MSB OF RESULT
; 'GNUMB'+0 = MIDDLE OF RESULT
; 'GNUMB'+2 = LSB OF RESULT
;
BD83 A9 00 TMULT LDA #0 ; CLEAR RESULT REGISTER
BD85 85 F4 STA GNUMB
BD87 85 F5 STA GNUMB+1
BD89 85 F6 STA GNUMB+2
BD8B 85 A6 STA TEMP+5 ; SIGN EXTENSION BYTES.
BD8D 85 A5 STA TEMP+4
BD8F A5 A2 LDA TEMP+1 ; EXTEND SIGN OF 'TEMP'
BD91 10 02 BPL TMU005 ; SIGN IS POSITIVE.
BD93 C6 A6 DEC TEMP+5 ; SIGN IS NEGATIVE.
BD95 A5 94 TMU005 LDA EXPSTK+1 ; EXTEND SIGN OF 'EXPSTK'
BD97 10 02 BPL TMU008 ; SIGN IS POSITIVE.
BD99 C6 A5 DEC TEMP+4 ; SIGN IS NEGATIVE.
BD9B A2 18 TMU008 LDX #24 ; SETUP LOOP COUNT.
BD9D 06 A1 TMU010 ASL TEMP
BD9F 26 A2 ROL TEMP+1
BDA1 26 A6 ROL TEMP+5
BDA3 90 13 BCC TMU020
BDA5 18 CLC
BDA6 A5 F6 LDA GNUMB+2
BDA8 65 93 ADC EXPSTK
BDAA 85 F6 STA GNUMB+2
BDAC A5 F4 LDA GNUMB+0
BDAE 65 94 ADC EXPSTK+1
BDB0 85 F4 STA GNUMB+0
BDB2 A5 F5 LDA GNUMB+1
BDB4 65 A5 ADC TEMP+4
BDB6 85 F5 STA GNUMB+1
BDB8 CA TMU020 DEX
BDB9 F0 09 BEQ TMU090
BDBB 06 F6 ASL GNUMB+2
BDBD 26 F4 ROL GNUMB+0
BDBF 26 F5 ROL GNUMB+1
BDC1 4C 9D BD JMP TMU010
BDC4 60 TMU090 RTS
;
; TADDI -- TRIPLE PRECISION ADDITION
;
; CALLING SEQUENCE:
;
; X = DTAB OFFSET
;
; JSR TADDI
;
; DTAB(X) = DTAB(X) + 'GNUMB'
;
; NOTE: MSB IS DTAB(X+1), MIDDLE IS DTAB(X+0), LSB IS DTAB(X+2).
;
BDC5 18 TADDI CLC
BDC6 B5 82 LDA DTAB+2,X
BDC8 65 F6 ADC GNUMB+2
BDCA 95 82 STA DTAB+2,X
BDCC B5 80 LDA DTAB+0,X
BDCE 65 F4 ADC GNUMB
BDD0 95 80 STA DTAB+0,X
BDD2 B5 81 LDA DTAB+1,X
BDD4 65 F5 ADC GNUMB+1
BDD6 95 81 STA DTAB+1,X
BDD8 60 RTS
;
; QMULT -- 16 * 16 YIELDING 32 BIT SIGNED MULTIPLY
;
; CALLING SEQUENCE:
;
; 'GACC' = 2 BYTE MULTIPLICAND.
; Y = DTAB OFFSET TO 2 BYTE MULTIPLIER.
;
; JSR QMULT
;
; 'GACC'[4 BYTE] = 'GACC'[2 BYTE] * 'DTAB'(Y)[2 BYTE]
;
BDD9 A2 04 QMULT LDX #4
BDDB B5 CD QML010 LDA GACC-1,X
BDDD 95 D1 STA GTEMP-1,X
BDDF A9 00 LDA #0
BDE1 95 CD STA GACC-1,X
BDE3 95 D5 STA GTEMP2-1,X
BDE5 CA DEX
BDE6 D0 F3 BNE QML010
BDE8 B9 80 00 LDA DTAB,Y
BDEB 85 D6 STA GTEMP2
BDED B9 81 00 LDA DTAB+1,Y
BDF0 85 D7 STA GTEMP2+1
BDF2 10 06 BPL QML015
BDF4 A9 FF LDA #-1 ; EXTEND SIGN.
BDF6 85 D8 STA GTEMP2+2
BDF8 85 D9 STA GTEMP2+3
BDFA A5 D3 QML015 LDA GTEMP+1
BDFC 10 04 BPL QML020
BDFE A9 FF LDA #-1 ; EXTEND SIGN.
BE00 D0 02 BNE QML022 ; (BRA).
BE02 A9 00 QML020 LDA #0
BE04 85 D4 QML022 STA GTEMP+2
BE06 85 D5 STA GTEMP+3
BE08 A2 20 LDX #32 ; SETUP LOOP COUNT.
BE0A 06 D2 QML030 ASL GTEMP ; LONG SHIFT LEFT.
BE0C 26 D3 ROL GTEMP+1
BE0E 26 D4 ROL GTEMP+2
BE10 26 D5 ROL GTEMP+3
BE12 90 19 BCC QML040 ; MSB NOT SET.
BE14 18 CLC ; BIT SET -- ADD TO PARTIAL.
BE15 A5 CE LDA GACC
BE17 65 D6 ADC GTEMP2
BE19 85 CE STA GACC
BE1B A5 CF LDA GACC+1
BE1D 65 D7 ADC GTEMP2+1
BE1F 85 CF STA GACC+1
BE21 A5 D0 LDA GACC+2
BE23 65 D8 ADC GTEMP2+2
BE25 85 D0 STA GACC+2
BE27 A5 D1 LDA GACC+3
BE29 65 D9 ADC GTEMP2+3
BE2B 85 D1 STA GACC+3
BE2D CA QML040 DEX ; DONE?
BE2E F0 0B BEQ QML090 ; YES.
BE30 06 CE ASL GACC ; LONG SHIFT LEFT.
BE32 26 CF ROL GACC+1
BE34 26 D0 ROL GACC+2
BE36 26 D1 ROL GACC+3
BE38 4C 0A BE JMP QML030
BE3B 60 QML090 RTS
;
; QDIV -- 32 DIVIDED BY 16 YIELDING 16 BIT SIGNED DIVIDE.
;
; CALLING SEQUENCE:
;
; 'GACC' = 4 BYTE DIVIDEND.
; Y = DTAB OFFSET TO 2 BYTE DIVISOR.
;
; JSR QDIV
; BNE OVERFLOW
;
; 'GACC'[2 BYTE] = 'GACC'[4 BYTE] / 'DTAB'(Y)[2 BYTE]
; X = DTAB OFFSET TO 'GACC'.
;
BE3C QDIV .IF DEBUG
LDA DTAB,Y ; CHECK FOR DIVIDE BY ZERO.
ORA DTAB+1,Y
BEQ QDV097
.ENDIF
BE3C A9 21 LDA #32+1 ; LOOP COUNT.
BE3E 85 A1 STA TEMP
BE40 A9 00 LDA #0
BE42 85 D2 STA GTEMP ; CLEAR REMAINDER TO START.
BE44 85 D3 STA GTEMP+1
BE46 B9 81 00 LDA DTAB+1,Y ; SEE IF DIVISOR IS NEGATIVE.
BE49 85 A2 STA TEMP+1 ; SAVE FOR LATER.
BE4B 10 08 BPL QDV003 ; NO.
BE4D 98 TYA ; YES -- NEGATE DIVISOR ...
BE4E AA TAX
BE4F 20 3F B6 JSR DNEGI
BE52 20 8F BE JSR QNEGA ; ... & DIVIDEND.
BE55 A5 D1 QDV003 LDA GACC+3 ;SEE IF DIVIDEND IS NEGATIVE.
BE57 85 A3 STA TEMP+2 ; SAVE FOR LATER.
BE59 10 03 BPL QDV006 ; NO.
BE5B 20 8F BE JSR QNEGA
BE5E A2 52 QDV006 LDX #GTEMP-DTAB
BE60 18 CLC
BE61 26 CE QDV010 ROL GACC ; LONG ROTATE LEFT.
BE63 26 CF ROL GACC+1
BE65 26 D0 ROL GACC+2
BE67 26 D1 ROL GACC+3
BE69 C6 A1 DEC TEMP ; DONE?
BE6B F0 0F BEQ QDV090 ; YES.
BE6D 26 D2 ROL GTEMP ; NO -- REMAINDER * 2.
BE6F 26 D3 ROL GTEMP+1
BE71 20 63 B5 JSR DCMPI ; IS REMAINDER < DIVISOR?
BE74 90 EB BCC QDV010 ; YES.
BE76 20 90 B5 JSR DSUBI ; NO -- CORRECT FOR THAT.
BE79 38 SEC
BE7A B0 E5 BCS QDV010 ; (BRA).
BE7C A5 A3 QDV090 LDA TEMP+2 ; DONE -- SEE IF RESULT IS TO BE NEGATED?
BE7E 10 03 BPL QDV093 ; NO.
BE80 20 8F BE JSR QNEGA ; YES.
BE83 A5 A2 QDV093 LDA TEMP+1 ; SEE IF DIVISOR WAS NEGATED AT BEGINNING
BE85 10 05 BPL QDV096 ; NO.
BE87 98 TYA
BE88 AA TAX
BE89 20 3F B6 JSR DNEGI ; YES -- CORRECT FOR THAT.
BE8C A2 4E QDV096 LDX #GACC-DTAB ; AS ADVERTISED.
.IF DEBUG
; CHECK FOR OVERFLOW IN RESULT
LDA GACC+1 ; CHECK MSB OF USABLE PORTION
BPL QDV098 ; POSITIVE.
LDA GACC+2
AND GACC+3
QDV097 CMP #-1
JMP QDV099
QDV098 LDA GACC+2
ORA GACC+3
.ENDIF
BE8E 60 QDV099 RTS ; RETURN WITH CC SET.
;
; QNEGA -- 4 BYTE NEGATE
;
; CALLING SEQUENCE:
;
; JSR QNEGA
;
; 'GACC'[4 BYTE] = -'GACC'[4 BYTE]
;
BE8F 38 QNEGA SEC ; CLEAR BORROW.
BE90 A9 00 LDA #0
BE92 E5 CE SBC GACC
BE94 85 CE STA GACC
BE96 A9 00 LDA #0
BE98 E5 CF SBC GACC+1
BE9A 85 CF STA GACC+1
BE9C A9 00 LDA #0
BE9E E5 D0 SBC GACC+2
BEA0 85 D0 STA GACC+2
BEA2 A9 00 LDA #0
BEA4 E5 D1 SBC GACC+3
BEA6 85 D1 STA GACC+3
BEA8 60 RTS
;
; RADDI -- DOUBLE PRECISION ADD WITH ROUND FROM FRACTION
;
BEA9 B9 82 00 RADDI LDA DTAB+2,Y ; GET FRACTION.
BEAC 2A ROL A ; MSB OF FRACTION TO CARRY
BEAD 4C 81 B5 JMP DADDIX
;
; RSUBI -- DOUBLE PRECISION SUBTRACT WITH BORROW FROM FRACTION
;
BEB0 B9 82 00 RSUBI LDA DTAB+2,Y ; GET FRACTION.
BEB3 49 80 EOR #$80 ; INVERT MSB OF FRACTION.
BEB5 2A ROL A ; INVERTED MSB TO CARRY.
BEB6 4C 91 B5 JMP DSUBIX
; GPINIT -- INITIALIZE GRAPHICS PARAMETERS (X/ Y, THETA & PEN COLOR)
BEB9 A9 02 GPINIT LDA #2 ; PEN = YELLOW.
BEBB 8D 53 05 STA PEN
BEBE A2 0E LDX #14 ; SET X, Y & THETA TO ZERO.
BEC0 A9 00 LDA #0
BEC2 95 E5 GPI010 STA GXNEW-1,X
BEC4 CA DEX
BEC5 D0 FB BNE GPI010
BEC7 60 RTS
;
; AUDIO TONE GENERATION PROCESSOR
;
BEC8 A2 08 TONES LDX #AUREGS*2 ; SETUP TO SCAN REGISTER ASSIGN TABLE.
BECA BD 53 05 TON010 LDA AUDIOR-2,X ; POINTER TO VARIABLE.
BECD 85 B6 STA POINT
BECF 1D 54 05 ORA AUDIOR-1,X ; NULL ENTRY IF RESULT IS ZERO.
BED2 F0 1D BEQ TON090 ; END OF ENTRIES.
BED4 BD 54 05 LDA AUDIOR-1,X ; FINISH MOVING NON-NULL POINTER.
BED7 85 B7 STA POINT+1
BED9 30 04 BMI TON020 ; NUMERIC CONSTANT.
BEDB A0 00 LDY #0 ; NOW GET VALUE.
BEDD B1 B6 LDA (POINT),Y
BEDF 29 1F TON020 AND #$1F ; MODULO 32.
BEE1 A8 TAY
BEE2 B9 F2 BE LDA AUDTAB,Y ; GET FREQ FROM TABLE.
BEE5 9D FE D1 STA AUDF1-2,X ; PUT IN HARDWARE.
BEE8 A9 A4 LDA #$A4 ; QUARTER VOLUME.
BEEA 9D FF D1 STA AUDC1-2,X
BEED CA DEX
BEEE CA DEX
BEEF D0 D9 BNE TON010
BEF1 60 TON090 RTS
BEF2 00 AUDTAB .BYTE 0 ; REST
BEF3 F3 E6 D9 .BYTE 243,230,217,204,193,182
BEF6 CC C1 B6
BEF9 AC A2 99 .BYTE 172,162,153,144,136,128
BEFC 90 88 80
BEFF 79 72 6C .BYTE 121,114,108,102,96,91
BF02 66 60 5B
BF05 55 51 4C .BYTE 85,81,76,72,68,64
BF08 48 44 40
BF0B 3C 39 35 .BYTE 60,57,53,50,47,45
BF0E 32 2F 2D
BF11 2A .BYTE 42
;
; MESSOT -- MESSAGE GENERATOR
;
; CALLING SEQUENCE:
;
; A = MESSAGE # (INDEX TO INTERNAL TABLE)
;
; JSR MESSOT
;
BF12 MESSOT=*
BF12 29 7F AND #$7F ; MASK OFF SIGN BIT
.IF DEBUG
BEQ MSO100 ; ; IS ILLEGAL.
CMP #MTSIZ+1
BCS MSO100 ; ; IS TOO LARGE.
.ENDIF
BF14 AA TAX
BF15 BD 42 BF LDA MESTAB-1,X ; GET MESSAGE ADDRESS DELTA FROM TABLE.
.IF DEBUG
CLC
ADC #MES0 ; ADD TO BASE ADDRESS.
.ENDIF
BF18 85 A7 STA TEMP2
BF1A A9 BF LDA #MES0/256
.IF DEBUG
ADC #0
.ENDIF
BF1C 85 A8 STA TEMP2+1
BF1E A0 00 LDY #0
BF20 B1 A7 MSO010 LDA (TEMP2),Y
BF22 F0 0E BEQ MSO090 ; DONE (NO EOL AT END).
BF24 C8 INY ; BUMP POINTER.
BF25 C9 9B CMP #EOL
BF27 F0 06 BEQ MSO020 ; DONE.
BF29 20 6F AF JSR CHOT
BF2C 4C 20 BF JMP MSO010
BF2F 20 60 B8 MSO020 JSR NEWLIN
BF32 60 MSO090 RTS
.IF DEBUG
MSO100 STA ACC ; PRINT # INSTEAD OF CANNED MESSAGE.
LDA #0
STA ACC+1
LDA #14
JSR MESSOT ; *** RECURSIVE CALL ***
LDX #ACC-DTAB
JSR DECASC
JMP NEWLIN
.ENDIF
; RDYMES -- GENERATE "READY" MESSAGE SEQUENCE.
BF33 84 A9 RDYMES STY TEMP2+2 ; SAVE Y REG.
BF35 20 60 B8 JSR NEWLIN
BF38 A9 01 LDA #RDYTXT ; "READY" TEXT
BF3A 20 12 BF JSR MESSOT
BF3D 20 60 B8 JSR NEWLIN
BF40 A4 A9 LDY TEMP2+2
BF42 60 RTS
BF43 5B MESTAB .BYTE MES1-MES0
BF44 61 .BYTE MES2-MES0
BF45 6E .BYTE MES3-MES0
BF46 7D .BYTE MES4-MES0
BF47 89 .BYTE MES5-MES0
BF48 8E .BYTE MES6-MES0
BF49 5B .BYTE MES7-MES0
BF4A 99 .BYTE MES8-MES0
BF4B 9F .BYTE MES9-MES0
BF4C A7 .BYTE MES10-MES0
BF4D AE .BYTE MES11-MES0
BF4E 61 .BYTE MES12-MES0
BF4F BA .BYTE MES13-MES0
BF50 61 .BYTE MES14-MES0
BF51 61 .BYTE MES15-MES0
BF52 61 .BYTE MES16-MES0
BF53 61 .BYTE MES17-MES0
BF54 61 .BYTE MES18-MES0
BF55 61 .BYTE MES19-MES0
BF56 61 .BYTE MES20-MES0
BF57 61 .BYTE MES21-MES0
BF58 C2 .BYTE MES22-MES0
BF59 D5 .BYTE MES23-MES0
BF5A D0 .BYTE MES24-MES0
0018 MTSIZ = *-MESTAB
; IF 'DEBUG ' = 0 THEN ALL MESSAGES MUST FIT IN ONE MEMORY PAGE.
BF5B MES0=* ; MESSAGE DATA BASE ADDRESS
.IF DEBUG-1
BF00 MES0=MES0/256*256 ; PAGE ALIGN BASE ADDRESS
.ENDIF
BF5B MES7
BF5B 52 45 41 MES1 .BYTE "READY",0
BF5E 44 59 00
.IF DEBUG-1
BF61 MES12
BF61 MES14
BF61 MES15
BF61 MES16
BF61 MES17
BF61 MES18
BF61 MES19
BF61 MES20
BF61 MES21
.ENDIF
BF61 57 48 41 MES2 .BYTE "WHAT'S THAT?",0
BF64 54 27 53
BF67 20 54 48
BF6A 41 54 3F
BF6D 00
BF6E 49 4D 4D MES3 .BYTE "IMMEDIATE ONLY",0
BF71 45 44 49
BF74 41 54 45
BF77 20 4F 4E
BF7A 4C 59 00
BF7D 44 49 56 MES4 .BYTE "DIVIDE BY 0",0
BF80 49 44 45
BF83 20 42 59
BF86 20 30 00
BF89 4F 4F 50 MES5 .BYTE "OOPS",0
BF8C 53 00
BF8E 49 2F 4F MES6 .BYTE "I/O ERROR ",0
BF91 20 45 52
BF94 52 4F 52
BF97 20 00
BF99 20 2A 2A MES8 .BYTE " *** ",0
BF9C 2A 20 00
BF9F 4E 4F 20 MES9 .BYTE "NO ROOM",0
BFA2 52 4F 4F
BFA5 4D 00
BFA7 57 48 45 MES10 .BYTE "WHERE?",0
BFAA 52 45 3F
BFAD 00
BFAE 55 3A 20 MES11 .BYTE "U: TOO DEEP",0
BFB1 54 4F 4F
BFB4 20 44 45
BFB7 45 50 00
.IF DEBUG
MES12 .BYTE "BUG!",0
.ENDIF
BFBA 4C 49 4E MES13 .BYTE "LINE #?",0
BFBD 45 20 23
BFC0 3F 00
.IF DEBUG
MES14 .BYTE "ERROR #",0
MES15 .BYTE "PLEASE SHORTEN",EOL
MES16 .BYTE "$ VARS: ",EOL
MES17 .BYTE "# VARS: ",EOL
MES18 .BYTE "USE STACK: ",EOL
MES19 .BYTE "GR PARMS: ",EOL
MES20 .BYTE "THETA=",0
MES21 .BYTE "FREE MEMORY=",0
.ENDIF
BFC2 54 4F 4F MES22 .BYTE "TOO MANY I/OS",0
BFC5 20 4D 41
BFC8 4E 59 20
BFCB 49 2F 4F
BFCE 53 00
BFD0 2D 2D 3E MES24 .BYTE "--> ",0
BFD3 20 00
00D5 TABLEN= *-MES0 ; MUST NOT EXCEED 00FF HEX.
BFD5 41 54 41 MES23 .BYTE "ATARI PILOT (C) COPYRIGHT ATARI 1980",EOL
BFD8 52 49 20
BFDB 50 49 4C
BFDE 4F 54 20
BFE1 28 43 29
BFE4 20 43 4F
BFE7 50 59 52
BFEA 49 47 48
BFED 54 20 41
BFF0 54 41 52
BFF3 49 20 31
BFF6 39 38 30
BFF9 9B
*=$BFFA ; CARTRIDGE OVERHEAD.
BFFA 78 A0 .WORD MLE ; RESTART VECTOR.
BFFC 00 05 .BYTE $00,$05 ; I.D., BOOT DOS & START CARTRIDGE.
BFFE 68 A1 .WORD PUP ; POWER-UP VECTOR.
.END