Bill Gates Microsoft BASIC for 6502 Original Source Code [1978]

Tekst piosenki

TITLE BASIC M6502 8K VER 1.1 BY MICRO-SOFT
SEARCH M6502
SALL
RADIX 10 ;THROUGHOUT ALL BUT MATH-PAK.

$Z:: ;STARTING POINT FOR M6502 SIMULATOR
ORG 0 ;START OFF AT LOCATION ZERO.
SUBTTL SWITCHES,MACROS.

REALIO=4 ;5=STM
;4=APPLE.
;3=COMMODORE.
;2=OSI
;1=MOS TECH,KIM
;0=PDP-10 SIMULATING 6502
INTPRC==1 ;INTEGER ARRAYS.
ADDPRC==1 ;FOR ADDITIONAL PRECISION.
LNGERR==0 ;LONG ERROR MESSAGES.
TIME== 0 ;CAPABILITY TO SET AND READ A CLK.
EXTIO== 0 ;EXTERNAL I/O.
DISKO== 0 ;SAVE AND LOAD COMMANDS
NULCMD==1 ;FOR THE „NULL” COMMAND
GETCMD==1
RORSW==1
ROMSW==1 ;TELLS IF THIS IS ON ROM.
CLMWID==14
LONGI==1 ;LONG INITIALIZATION SWITCH.
STKEND=511
BUFPAG==0
LINLEN==72 ;TERMINAL LINE LENGTH.
BUFLEN==72 ;INPUT BUFFER SIZE.
ROMLOC= ^O20000 ;ADDRESS OF START OF PURE SEGMENT.
KIMROM=1
IFE ROMSW,
IFN REALIO-1,
IFN ROMSW,< RAMLOC= ^O40000 ;USED ONLY IF ROMSW=1 IFE REALIO, RAMLOC=^O1400>>
IFE REALIO-3,< DISKO==1 RAMLOC==^O2000 ROMLOC=^O140000 NULCMD==0 GETCMD==1 linlen==40 BUFLEN==81 CQOPEN=^O177700 CQCLOS=^O177703 CQOIN= ^O177706 ;OPEN CHANNEL FOR INPUT CQOOUT=^O177711 ;FILL FOR COMMO. CQCCHN=^O177714 CQINCH=^O177717 ;INCHR'S CALL TO GET A CHARACTER OUTCH= ^O177722 CQLOAD=^O177725 CQSAVE=^O177730 CQVERF=^O177733 CQSYS= ^O177736 ISCNTC=^O177741 CZGETL=^O177744 ;CALL POINT FOR "GET" CQCALL=^O177747 ;CLOSE ALL CHANNELS CQTIMR=^O215 BUFPAG==2 BUF==256*BUFPAG STKEND==507 CQSTAT=^O226 CQHTIM=^O164104 EXTIO==1 TIME==1 GETCMD==1 CLMWID==10 PI=255 ;VALUE OF PI CHARACTER FOR COMMODORE. ROMSW==1 RORSW==1 TRMPOS=^O306>
IFE REALIO-1,
JSR SYNCHR>
DEFINE DT(Q),< IRPC Q, LDAI -1 ;MAKE TXTPTR POINT TO STA TXTPTR ;CRUNCHED LINE. LISTRT: RTS ;RETURN TO CALLER. ; ; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE ; WHOSE NUMBER IS PASSED IN "LINNUM". ; THERE ARE TWO POSSIBLE RETURNS: ; ; 1) CARRY SET. ; LOWTR POINTS TO THE LINK FIELD IN THE LINE ; WHICH IS THE ONE SEARCHED FOR. ; ; 2) CARRY NOT SET. ; LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE ; PROGRAM GREATER THAN THE ONE SOUGHT AFTER. ; FNDLIN: LDWX TXTTAB ;LOAD [X,A] WITH [TXTTAB] FNDLNC: LDYI 1 STWX LOWTR ;STORE [X,A] INTO LOWTR LDADY LOWTR ;SEE IF LINK IS 0 BEQ FLINRT INY INY LDA LINNUM+1 ;COMP HIGH ORDERS OF LINE NUMBERS. CMPDY LOWTR BCC FLNRTS ;NO SUCH LINE NUMBER. BEQ FNDLO1 DEY BNE AFFRTS ;ALWAYS BRANCH. FNDLO1: LDA LINNUM DEY CMPDY LOWTR ;COMPARE LOW ORDERS. BCC FLNRTS ;NO SUCH NUMBER. BEQ FLNRTS ;GO TIT. AFFRTS: DEY LDADY LOWTR ;FETCH LINK. TAX DEY LDADY LOWTR BCS FNDLNC ;ALWAYS BRANCHES. FLINRT: CLC ;C MAY BE HIGH. FLNRTS: RTS ;RETURN TO CALLER. ; ; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL ; AS VARIABLE SPACE. ; SCRATH: BNE FLNRTS ;MAKE SURE THERE IS A TERMINATOR. SCRTCH: LDAI 0 ;GET A CLEARER. TAY ;SET UP INDEX. STADY TXTTAB ;CLEAR FIRST LINK. INY STADY TXTTAB LDA TXTTAB CLC ADCI 2 STA VARTAB ;SETUP [VARTAB]. LDA TXTTAB+1 ADCI 0 STA VARTAB+1 RUNC: JSR STXTPT LDAI 0 ;SET ZERO FLAG ; ; THIS CODE IS FOR THE CLEAR COMMAND. ; CLEAR: BNE STKRTS ;SYNTAX ERROR IF NO TERMINATOR. ; ; CLEAR INITIALIZES THE VARIABLE AND ; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE) ; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI" ; WHICH RESETS THE STACK. ; CLEARC: LDWD MEMSIZ ;FREE UP STRING SPACE. STWD FRETOP IFN EXTIO,< JSR CQCALL> ;CLOSE ALL OPEN FILES.
LDWD VARTAB ;LIBERATE THE
STWD ARYTAB ;VARIABLES AND
STWD STREND ;ARRAYS.
FLOAD: JSR RESTOR ;RESTORE DATA.
;
; STKINI RESETS THE STACK POINTER ELIMINATING
; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO „FNDFOR” WILL ALWAYS
; FIND A NON-„FOR” ENTRY AT THE BOTTOM OF THE STACK.
;
STKINI: LDXI TEMPST ;INITIALIZE STRING TEMPORARIES.
STX TEMPPT
PLA ;SETUP RETURN ADDRESS.
TAY
PLA
LDXI STKEND-257
TXS
PHA
TYA
PHA
LDAI 0
STA OLDTXT+1 ;DISALLOWING CONTINUING
STA SUBFLG ;ALLOW SUBSCRIPTS.
STKRTS: RTS

STXTPT: CLC
LDA TXTTAB
ADCI 255
STA TXTPTR
LDA TXTTAB+1
ADCI 255
STA TXTPTR+1 ;SETUP TEXT POINTER.
RTS
PAGE
SUBTTL THE „LIST” COMMAND.

LIST: BCC GOLST ;IT IS A DIGIT.
BEQ GOLST ;IT IS A TERMINATOR.
CMPI MINUTK ;DASH PRECEDING?
BNE STKRTS ;NO, SO SYNTAX ERROR.
GOLST: JSR LINGET ;GET LINE NUMBER INTO NUMLIN.
JSR FNDLIN ;FIND LINE .GE. [NUMLIN].
JSR CHRGOT ;GET LAST CHARACTER.
BEQ LSTEND ;IF END OF LINE, # IS THE END.
CMPI MINUTK ;DASH?
BNE FLNRTS ;IF NOT, SYNTAX ERROR.
JSR CHRGET ;GET NEXT CHAR.
JSR LINGET ;GET END #.
BNE FLNRTS ;IF NOT TERMINATOR, ERROR.
LSTEND: PLA
PLA ;GET RID OF „NEWSTT” RTS ADDR.
LDA LINNUM ;SEE IF IT WAS EXISTENT.
ORA LINNUM+1
BNE LIST4 ;IT WAS TYPED.
LDAI 255
STA LINNUM
STA LINNUM+1 ;MAKE IT HUGE.
LIST4: LDYI 1
IFE REALIO-3,< STY DORES>
LDADY LOWTR ;IS LINK ZERO?
BEQ GRODY ;YES, GO TO READY.
IFN REALIO,< JSR ISCNTC> ;LISTEN FOR CONT-C.
JSR CRDO ;PRINT CRLF TO START WITH.
INY
LDADY LOWTR
TAX
INY
LDADY LOWTR ;GET LINE NUMBER.
CMP LINNUM+1 ;SEE IF BEYOND LAST.
BNE TSTDUN ;GO DETERMINE RELATION.
CPX LINNUM ;WAS EQUAL SO TEST LOW ORDER.
BEQ TYPLIN ;EQUAL, SO LIST IT.
TSTDUN: BCS GRODY ;IF LINE IS GR THAN LAST, THEN DUNE.
TYPLIN: STY LSTPNT
JSR LINPRT ;PRINT AS INT WITHOUT LEADING SPACE.
LDAI ” ” ;ALWAYS PRINT SPACE AFTER NUMBER.
PRIT4: LDY LSTPNT ;GET POINTER TO LINE BACK.
ANDI 127
PLOOP: JSR OUTDO ;PRINT CHAR.
IFE REALIO-3,< CMPI 34 BNE PLOOP1 COM DORES> ;IF QUOTE, COMPLEMENT FLAG.
PLOOP1: INY
BEQ GRODY ;IF WE HAVE PRINTED 256 CHARACTERS
;THE PROGRAM MUST BE MISFORMATED IN
;MEMORY DUE TO A BAD LOAD OR BAD
;HARDWARE. LET THE GUY RECOVER
LDADY LOWTR ;GET NEXT CHAR. IS IT ZERO?
BNE QPLOP ;YES. END OF LINE.
TAY
LDADY LOWTR
TAX
INY
LDADY LOWTR
STX LOWTR
STA LOWTR+1
BNE LIST4 ;BRANCH IF SOMETHING TO LIST.
GRODY: JMP READY
;IS IT A TOKEN?
QPLOP: BPL PLOOP ;NO, HEAD FOR PRINTER.
IFE REALIO-3,< CMPI PI BEQ PLOOP BIT DORES ;INSIDE QUOTE MARKS? BMI PLOOP> ;YES, JUST TYPE THE CHARACTER.
SEC
SBCI 127 ;GET RID OF SIGN BIT AND ADD 1.
TAX ;MAKE IT A COUNTER.
STY LSTPNT ;SAVE POINTER TO LINE.
LDYI 255 ;LOOK AT RES’D WORD LIST.
RESRCH: DEX ;IS THIS THE RES’D WORD?
BEQ PRIT3 ;YES, GO TOSS IT UP..
RESCR1: INY
LDA RESLST,Y, ;END OF ENTRY?
BPL RESCR1 ;NO, CONTINUE PASSING.
BMI RESRCH
PRIT3: INY
LDA RESLST,Y
BMI PRIT4 ;END OF RESERVED WORD.
JSR OUTDO ;PRINT IT.
BNE PRIT3 ;END OF ENTRY? NO, TYPE REST.
PAGE
SUBTTL THE „FOR” STATEMENT.
;
; A „FOR” ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
; TOKEN (FORTK) 1 BYTE
; A POINTER TO THE LOOP VARIABLE 2 BYTES
; THE STEP 4+ADDPRC BYTES
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
; THE UPPER VALUE 4+ADDPRC BYTES
; THE LINE NUMBER OF THE „FOR” STATEMENT 2 BYTES
; A TEXT POINTER INTO THE „FOR” STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;

FOR: LDAI 128 ;DON’T RECOGNIZE
STA SUBFLG ;SUBSCRIPTED VARIABLES.
JSR LET ;READ THE VARIABLE AND ASSIGN IT
;THE CORRECT INITIAL VALUE AND STORE
;A POINTER TO THE VARIABLE IN VARPNT.
JSR FNDFOR ;PNTR IS IN VARPNT, AND FORPNT.
BNE NOTOL ;IF NO MATCH, DON’T ELIMINATE ANYTHING.
TXA ;MAKE IT ARITHMETICAL.
ADCI FORSIZ-3 ;ELIMINATE ALMOST ALL.
TAX ;NOTE C=1, THEN PLA, PLA.
TXS ;MANIFEST.
NOTOL: PLA ;GET RID OF NEWSTT RETURN ADDRESS
PLA ;IN CASE THIS IS A TOTALLY NEW ENTRY.
LDAI 8+ADDPRC
JSR GETSTK ;MAKE SURE 16 BYTES ARE AVAILABLE.
JSR DATAN ;GET A COUNT IN [Y] OF THE NUMBER OF
;CHACRACTERS LEFT IN THE „FOR” STATEMENT
;[TXTPTR] IS UNAFFECTED.
CLC ;PREP TO ADD.
TYA ;SAVE IT FOR PUSHING.
ADC TXTPTR
PHA
LDA TXTPTR+1
ADCI 0
PHA
PSHWD CURLIN ;PUT LINE NUMBER ON STACK.
SYNCHK TOTK ;”TO” IS NECESSARY.
JSR CHKNUM ;VALUE MUST BE A NUMBER.
JSR FRMNUM ;GET UPPER VALUE INTO FAC.
LDA FACSGN ;PACK FAC.
ORAI 127
AND FACHO
STA FACHO ;SET PACKED SIGN BIT.
LDWDI LDFONE
STWD INDEX1
JMP FORPSH ;PUT FAC ONTO STACK, PACKED.
LDFONE: LDWDI FONE ;PUT 1.0 INTO FAC.
JSR MOVFM
JSR CHRGOT
CMPI STEPTK ;A STEP IS GIVEN?
BNE ONEON ;NO. ASSUME 1.0.
JSR CHRGET ;YES. ADVANCE POINTER.
JSR FRMNUM ;READ THE STEP.
ONEON: JSR SIGN ;GET SIGN IN ACCA.
JSR PUSHF ;PUSH FAC ONTO STACK (THRU A).
PSHWD FORPNT ;PUT PNTR TO VARIABLE ON STACK.
NXTCON: LDAI FORTK ;PUT A FORTK ONTO STACK.
PHA
; BNEA NEWSTT ;SIMULATE BNE TO NEWSTT. JUST FALL IN.
PAGE
SUBTTL NEW STATEMENT FETCHER.
;
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
; IS „:” OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
; IT CAN MERELY DO A RTS WHEN IT IS DONE.
;
NEWSTT: IFN REALIO,< JSR ISCNTC> ;LISTEN FOR CONTROL-C.
LDWD TXTPTR ;LOOK AT CURRENT CHARACTER.
IFN BUFPAG,< CPYI BUFPAG> ;SEE IF IT WAS DIRECT BY CHECK FOR BUF’S PAGE NUMBER
BEQ DIRCON
STWD OLDTXT ;SAVE IN CASE OF RESTART BY INPUT.
IFN BUFPAG,
LDYI 0
IFE BUFPAG,
LDADY TXTPTR
BNE MORSTS ;NOT NULL — CHECK WHAT IT IS
LDYI 2 ;LOOK AT LINK.
LDADY TXTPTR ;IS LINK 0?
CLC ;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
JEQ ENDCON ;YES – RAN OFF THE END.
INY ;PUT LINE NUMBER IN CURLIN.
LDADY TXTPTR
STA CURLIN
INY
LDADY TXTPTR
STA CURLIN+1
TYA
ADC TXTPTR
STA TXTPTR
BCC GONE
INC TXTPTR+1
GONE: JSR CHRGET ;GET THE STATEMENT TYPE.
JSR GONE3
JMP NEWSTT
GONE3: BEQ ISCRTS ;IF TERMINATOR, TRY AGAIN.
;NO NEED TO SET UP CARRY SINCE IT WILL
;BE ON IF NON-NUMERIC AND NUMERICS
;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
GONE2: SBCI ENDTK ;” ON … GOTO AND GOSUB” COME HERE.
BCC GLET
CMPI SCRATK-ENDTK+1
BCS SNERRX ;SOME RES’D WORD BUT NOT
;A STATEMENT RES’D WORD.
ASL A, ;MULTIPLY BY TWO.
TAY ;MAKE AN INDEX.
LDA STMDSP+1,Y
PHA
LDA STMDSP,Y
PHA ;PUT DISP ADDR ONTO STACK.
JMP CHRGET
GLET: JMP LET ;MUST BE A LET
MORSTS: CMPI „:”
BEQ GONE ;IF A „:” CONTINUE STATEMENT
SNERR1: JMP SNERR ;NEITHER 0 OR „:” SO SYNTAX ERROR
SNERRX: CMPI GOTK-ENDTK
BNE SNERR1
JSR CHRGET ;READ IN THE CHARACTER AFTER „GO „
SYNCHK TOTK
JMP GOTO
PAGE
SUBTTL RESTORE,STOP,END,CONTINUE,NULL,CLEAR.

RESTOR: SEC
LDA TXTTAB
SBCI 1
LDY TXTTAB+1
BCS RESFIN
DEY
RESFIN: STWD DATPTR ;READ FINISHES COME TO „RESFIN”.
ISCRTS: RTS

IFE REALIO-1,< ISCNTC: LDAI 1 BIT ^O13500 BMI ISCRTS LDXI 8 LDAI 3 CMPI 3>
IFE REALIO-2,< ISCNTC: LDA ^O176000 REPEAT 4, LSR A, BCC ISCRTS JSR INCHR ;EAT CHAR THAT WAS TYPED CMPI 3> ;WAS IT A CONTROL-C??

IFE REALIO-4,< ISCNTC: LDA ^O140000 ;CHECK THE CHARACTER CMPI ^O203 BEQ ISCCAP RTS ISCCAP: JSR INCHR CMPI ^O203>
STOP: BCS STOPC ;MAKE [C] NONZERO AS A FLAG.
END: CLC
STOPC: BNE CONTRT ;RETURN IF NOT CONT-C OR
;IF NO TERMINATOR FOR STOP OR END.
;[C]=0 SO WILL NOT PRINT „BREAK”.
LDWD TXTPTR
IFN BUFPAG,< LDX CURLIN+1 INX>
BEQ DIRIS
STWD OLDTXT
STPEND: LDWD CURLIN
STWD OLDLIN
DIRIS: PLA ;POP OFF NEWSTT ADDR.
PLA
ENDCON: LDWDI BRKTXT
IFN REALIO,< LDXI 0 STX CNTWFL>
BCC GORDY ;CARRY CLEAR SO DON’T PRINT „BREAK”.
JMP ERRFIN
GORDY: JMP READY ;TYPE „READY”.

IFE REALIO,< DDT: PLA ;GET RID OF NEWSTT RETURN. PLA HRRZ 14,.JBDDT## JRST 0(14)>
CONT: BNE CONTRT ;MAKE SURE THERE IS A TERMINATOR.
LDXI ERRCN ;CONTINUE ERROR.
LDY OLDTXT+1 ;A STORED TXTPTR OF ZERO IS SETUP
;BY STKINI AND INDICATES THERE IS
;NOTHING TO CONTINUE.
JEQ ERROR ;”STOP”, „END”, TYPING CRLF TO
;”INPUT” AND ^C SETUP OLDTXT.
LDA OLDTXT
STWD TXTPTR
LDWD OLDLIN
STWD CURLIN
CONTRT: RTS ;RETURN TO CALLER.

IFN NULCMD,< NULL: JSR GETBYT BNE CONTRT ;MAKE SURE THERE IS TERMINATOR. INX CPXI 240 ;IS THE NUMBER REASONABLE? BCS FCERR1 ;"FUNCTION CALL" ERROR. DEX ;BACK -1 STX NULCNT RTS FCERR1: JMP FCERR>
PAGE
SUBTTL LOAD AND SAVE SUBROUTINES.

IFE REALIO-1,< ;KIM CASSETTE I/O SAVE: TSX ;SAVE STACK POINTER STX INPFLG LDAI STKEND-256-200 STA ^O362 ;SETUP DUMMY STACK FOR KIM MONITOR LDAI 254 ;MAKE ID BYTE EQUAL TO FF HEX STA ^O13771 ;STORE INTO KIM ID LDWD TXTTAB ;START DUMPING FROM TXTTAB STWD ^O13765 ;SETUP SAL,SAH LDWD VARTAB ;STOP AT VARTAB STWD ^O13767 ;SETUP EAL,EAH JMP ^O14000 RETSAV: LDX INPFLG ;RESORE THE REAL STACK POINTER TXS LDWDI TAPMES ;SAY IT WAS DONE JMP STROUT GLOAD: DT"LOADED" 0 TAPMES: DT"SAVED" ACRLF 0 PATSAV: BLOCK 20 LOAD: LDWD TXTTAB ;START DUMPING IN AT TXTTAB STWD ^O13765 ;SETUP SAL,SAH LDAI 255 STA ^O13771 LDWDI RTLOAD STWD ^O1 ;SET UP RETURN ADDRESS FOR LOAD JMP ^O14163 ;GO READ THE DATA IN RTLOAD: LDXI STKEND-256 ;RESET THE STACK TXS LDWDI READY STWD ^O1 LDWDI GLOAD ;TELL HIM IT WORKED JSR STROUT LDXY ^O13755 ;GET LAST LOCATION TXA ;ITS ONE TOO BIG BNE DECVRT ;DECREMENT [X,Y] NOP DECVRT: NOP STXY VARTAB ;SETUP NEW VARIABLE LOCATION JMP FINI> ;RELINK THE PROGRAM
IFE REALIO-4,< SAVE: SEC ;CALCLUATE PROGRAM SIZE IN POKER LDA VARTAB SBC TXTTAB STA POKER LDA VARTAB+1 SBC TXTTAB+1 STA POKER+1 JSR VARTIO JSR CQCOUT ;WRITE PROGRAM SIZE [POKER] JSR PROGIO JMP CQCOUT ;WRITE PROGRAM. LOAD: JSR VARTIO JSR CQCSIN ;READ SIZE OF PROGRAM INTO POKER CLC LDA TXTTAB ;CALCULATE VARTAB FROM SIZE AND ADC POKER ;TXTTAB STA VARTAB LDA TXTTAB+1 ADC POKER+1 STA VARTAB+1 JSR PROGIO JSR CQCSIN ;READ PROGRAM. LDWDI TPDONE JSR STROUT JMP FINI TPDONE: DT"LOADED" 0 VARTIO: LDWDI POKER STWD ^O74 LDAI POKER+2 STWD ^O76 RTS PROGIO: LDWD TXTTAB STWD ^O74 LDWD VARTAB STWD ^O76 RTS>
PAGE
SUBTTL RUN,GOTO,GOSUB,RETURN.
RUN: JEQ RUNC ;IF NO LINE # ARGUMENT.
JSR CLEARC ;CLEAN UP — RESET THE STACK.
JMP RUNC2 ;MUST REPLACE RTS ADDR.
;
; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS:
; THE GOSUTK ONE BYTE
; THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
; A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
;
; HIGH ADDRESS.
;
; TOTAL FIVE BYTES.
;
GOSUB: LDAI 3
JSR GETSTK ;MAKE SURE THERE IS ROOM.
PSHWD TXTPTR ;PUSH ON THE TEXT POINTER.
PSHWD CURLIN ;PUSH ON THE CURRENT LINE NUMBER.
LDAI GOSUTK
PHA ;PUSH ON A GOSUB TOKEN.
RUNC2: JSR CHRGOT ;GET CHARACTER AND SET CODES FOR LINGET.
JSR GOTO ;USE RTS SCHEME TO „NEWSTT”.
JMP NEWSTT

GOTO: JSR LINGET ;PICK UP THE LINE NUMBER IN „LINNUM”.
JSR REMN ;SKIP TO END OF LINE.
LDA CURLIN+1
CMP LINNUM+1
BCS LUK4IT
TYA
SEC
ADC TXTPTR
LDX TXTPTR+1
BCC LUKALL
INX
BCSA LUKALL ;ALWAYS GOES.
LUK4IT: LDWX TXTTAB
LUKALL: JSR FNDLNC ;[X,A] ARE ALL SET UP.
QFOUND: BCC USERR ;GOTO LINE IS NONEXISTANT.
LDA LOWTR
SBCI 1
STA TXTPTR
LDA LOWTR+1
SBCI 0
STA TXTPTR+1
GORTS: RTS ;PROCESS THE STATEMENT.
;
; „RETURN” RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
; AND ELIMINATES ALL THE „FOR” ENTRIES IN FRONT OF THE „GOSUB” ENTRY.
;
RETURN: BNE GORTS ;NO TERMINATOR=BLOW HIM UP.
LDAI 255
STA FORPNT+1 ;MAKE SURE THE VARIABLE’S PNTR
;NEVER GETS MATCHED.
JSR FNDFOR ;GO PAST ALL THE „FOR” ENTRIES.
TXS
CMPI GOSUTK ;RETURN WITHOUT GOSUB?
BEQ RETU1
LDXI ERRRG
SKIP2
USERR: LDXI ERRUS ;NO MATCH SO „US” ERROR.
JMP ERROR ;YES.
SNERR2: JMP SNERR
RETU1: PLA ;REMOVE GOSUTK.
PULWD CURLIN ;GET LINE NUMBER „GOSUB” WAS FROM.
PULWD TXTPTR ;GET TEXT PNTR FROM „GOSUB”.
DATA: JSR DATAN ;SKIP TO END OF STATEMENT,
;SINCE WHEN „GOSUB” STUCK THE TEXT PNTR
;ONTO THE STACK, THE LINE NUMBER ARG
;HADN’T BEEN READ YET.
ADDON: TYA
CLC
ADC TXTPTR
STA TXTPTR
BCC REMRTS
INC TXTPTR+1
REMRTS: RTS ;”NEWSTT” RTS ADDR IS STILL THERE.

DATAN: LDXI „:” ;”DATA” TERMINATES ON „:” AND NULL.
SKIP2
REMN: LDXI 0 ;THE ONLY TERMINATOR IS NULL.
STX CHARAC ;PRESERVE IT.
LDYI 0 ;THIS MAKES CHARAC=0 AFTER SWAP.
STY ENDCHR
EXCHQT: LDA ENDCHR
LDX CHARAC
STA CHARAC
STX ENDCHR
REMER: LDADY TXTPTR
BEQ REMRTS ;NULL ALWAYS TERMINATES.
CMP ENDCHR ;IS IT THE OTHER TERMINATOR?
BEQ REMRTS ;YES, IT’S FINISHED.
INY ;PROGRESS TO NEXT CHARACTER.
CMPI 34 ;IS IT A QUOTE?
BNE REMER ;NO, JUST CONTINUE.
BEQA EXCHQT ;YES, TIME TO TRADE.
PAGE
SUBTTL „IF … THEN” CODE.
IF: JSR FRMEVL ;EVALUATE A FORMULA.
JSR CHRGOT ;GET CURRENT CHARACTER.
CMPI GOTOTK ;IS TERMINATING CHARACTER A GOTOTK?
BEQ OKGOTO ;YES.
SYNCHK THENTK ;NO, IT MUST BE „THEN”.
OKGOTO: LDA FACEXP ;0=FALSE. ALL OTHERS TRUE.
BNE DOCOND ;TRUE !
REM: JSR REMN ;SKIP REST OF STATEMENT.
BEQA ADDON ;WILL ALWAYS BRANCH.
DOCOND: JSR CHRGOT ;TEST CURRENT CHARACTER.
BCS DOCO ;IF A NUMBER, GOTO IT.
JMP GOTO
DOCO: JMP GONE3 ;INTERPRET NEW STATEMENT.
PAGE
SUBTTL „ON … GO TO …” CODE.
ONGOTO: JSR GETBYT ;GET VALUE IN FACLO.
PHA ;SAVE FOR LATER.
CMPI GOSUTK ;AN „ON … GOSUB” PERHAPS?
BEQ ONGLOP ;YES.
SNERR3: CMPI GOTOTK ;MUST BE „GOTOTK”.
BNE SNERR2
ONGLOP: DEC FACLO
BNE ONGLP1 ;SKIP ANOTHER LINE NUMBER.
PLA ;GET DISPATCH CHARACTER.
JMP GONE2
ONGLP1: JSR CHRGET ;ADVANCE AND SET CODES.
JSR LINGET
CMPI 44 ;IS IT A COMMA?
BEQ ONGLOP
PLA ;REMOVE STACK ENTRY (TOKEN).
ONGRTS: RTS ;EITHER END-OF-LINE OR SYNTAX ERROR.
PAGE
SUBTTL LINGET — READ A LINE NUMBER INTO LINNUM
;
; „LINGET” READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
;
; LINE NUMBERS RANGE FROM 0 TO 64000-1.
;
; THE ANSWER IS RETURNED IN „LINNUM”.
; „TXTPTR” IS UPDATED TO POINT TO THE TERMINATING CHARCTER
; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
; CODES SET UP TO REFLECT ITS VALUE.
;
LINGET: LDXI 0
STX LINNUM ;INITIALIZE LINE NUMBER TO ZERO.
STX LINNUM+1
MORLIN: BCS ONGRTS ;IT IS NOT A DIGIT.
SBCI „0”-1 ;-1 SINCE C=0.
STA CHARAC ;SAVE CHARACTER.
LDA LINNUM+1
STA INDEX
CMPI 25 ;LINE NUMBER WILL BE .LT. 64000?
BCS SNERR3
LDA LINNUM
ASL A, ;MULTIPLY BY 10.
ROL INDEX
ASL A
ROL INDEX
ADC LINNUM
STA LINNUM
LDA INDEX
ADC LINNUM+1
STA LINNUM+1
ASL LINNUM
ROL LINNUM+1
LDA LINNUM
ADC CHARAC ;ADD IN DIGIT.
STA LINNUM
BCC NXTLGC
INC LINNUM+1
NXTLGC: JSR CHRGET
JMP MORLIN

PAGE
SUBTTL „LET” CODE.
LET: JSR PTRGET ;GET PNTR TO VARIABLE INTO „VARPNT”.
STWD FORPNT ;PRESERVE POINTER.
SYNCHK EQULTK ;”=” IS NECESSARY.
IFN INTPRC,< LDA INTFLG ;SAVE FOR LATER. PHA>
LDA VALTYP ;RETAIN THE VARIABLE’S VALUE TYPE.
PHA
JSR FRMEVL ;GET VALUE OF FORMULA INTO „FAC”.
PLA
ROL A, ;CARRY SET FOR STRING, OFF FOR
;NUMERIC.
JSR CHKVAL ;MAKE SURE „VALTYP” MATCHES CARRY.
;AND SET ZERO FLAG FOR NUMERIC.
BNE COPSTR ;IF NUMERIC, COPY IT.
COPNUM:
IFN INTPRC,< PLA ;GET NUMBER TYPE. QINTGR: BPL COPFLT ;STORE A FLTING NUMBER. JSR ROUND ;ROUND INTEGER. JSR AYINT ;MAKE 2-BYTE NUMBER. LDYI 0 LDA FACMO ;GET HIGH. STADY FORPNT ;STORE IT. INY LDA FACLO ;GET LOW. STADY FORPNT RTS>
COPFLT: JMP MOVVF ;PUT NUMBER @FORPNT.

COPSTR:
IFN INTPRC, ;IF STRING, NO INTFLG.
INPCOM:
IFN TIME,< LDY FORPNT+1 ;TI$? CPYI ZERO/256 ;ONLY TI$ CAN BE THIS ON ASSIG. BNE GETSPT ; WAS NOT TI$. JSR FREFAC ;WE WONT NEEDIT. CMPI 6 ;LENGTH CORRECT? BNE FCERR2 LDYI 0 ;YES. DO SETUP. STY FACEXP ;ZERO FAC TO START WITH. STY FACSGN TIMELP: STY FBUFPT ;SAVE POSOTION. JSR TIMNUM ;GET A DIGIT. JSR MUL10 ;WHOLE QTY BY 10. INC FBUFPT LDY FBUFPT JSR TIMNUM JSR MOVAF TAX ;IF NUM=0 THEN NO MULT. BEQ NOML6 ;IF =0, GO TIT. INX ;MULT BY TWO. TXA JSR FINML6 ;ADD IN AND MULT BY 2 GIVES *6. NOML6: LDY FBUFPT INY CPYI 6 ;DONE ALL SIX? BNE TIMELP JSR MUL10 ;ONE LAST TIME. JSR QINT ;SHIFT IT OVER TO THE RIGHT. LDXI 2 SEI ;DISALLOW INTERRUPTS. TIMEST: LDA FACMOH,X STA CQTIMR,X DEX BPL TIMEST ;LOOP 3 TIMES. CLI ;TURN ON INTS AGAIN. RTS TIMNUM: LDADY INDEX ;INDEX SET UP BY FREFAC. JSR QNUM BCC GOTNUM FCERR2: JMP FCERR ;MUST BE NUMERIC STRING. GOTNUM: SBCI "0"-1 ;C IS OFF. JMP FINLOG> ;ADD IN DIGIT TO FAC.

GETSPT: LDYI 2 ;GET PNTR TO DESCRIPTOR.
LDADY FACMO
CMP FRETOP+1 ;SEE IF IT POINTS INTO STRING SPACE.
BCC DNTCPY ;IF [FRETOP],GT.[2&3,FACMO], DON’T COPY.
BNE QVARIA ;IT IS LESS.
DEY
LDADY FACMO
CMP FRETOP ;COMPARE LOW ORDERS.
BCC DNTCPY
QVARIA: LDY FACLO
CPY VARTAB+1 ;IF [VARTAB].GT.[FACMO], DON’T COPY.
BCC DNTCPY
BNE COPY ;IT IS LESS.
LDA FACMO
CMP VARTAB ;COMPARE LOW ORDERS.
BCS COPY
DNTCPY: LDWD FACMO
JMP COPYZC
COPY: LDYI 0
LDADY FACMO
JSR STRINI ;GET ROOM TO COPY STRING INTO.
LDWD DSCPNT ;GET POINTER TO OLD DESCRIPTOR, SO
STWD STRNG1 ;MOVINS CAN FIND STRING.
JSR MOVINS ;COPY IT.
LDWDI DSCTMP ;GET POINTER TO OLD DESCRIPTOR.
COPYZC: STWD DSCPNT ;REMEMBER POINTER TO DESCRIPTOR.
JSR FRETMS ;FREE UP THE TEMPORARY WITHOUT
;FREEING UP ANY STRING SPACE.
LDYI 0
LDADY DSCPNT
STADY FORPNT
INY ;POINT TO STRING PNTR.
LDADY DSC