home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG031.ARK
/
TBASICA4.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
44KB
|
1,869 lines
CON99 DB 43H
DB 1
DB 99H
DB 99H
DB 99H
DB 50H
* RTN. D.15
* INSERT CODED LINE INTO SOURCE CODE FILE
* USES ESRC, INSR, AND SLIN
ICLS LHLD ESRC ;CHECK FOR INSERTION AT END
XCHG ;TO DE
LHLD FRAV ;GET FFRAV
CALL CMP16 ;SAME?
JNZ ICLS2 ;NOPE
ICLS3 LHLD ESRC
XCHG ;TO DE
LHLD INSR
CALL CMP16 ;COMPARE THE ADDRESSES
JZ ICLS1 ;SAME, SO NO MOVES REQUIRED
LHLD SLIN ;COMPUTE "TO" ADDRESS
CALL SUB16 ;HL=SLIN-ESRC
PUSH H ;SAVE IT
PUSH H ;AND AGAIN
LHLD INSR ;COMPUTE NUMBER OF BYTES TO MOVE
XCHG ;TO DE
LHLD SLIN
CALL SUB16 ;HL=SLIN-INSR
MOV C,L ;BC=HL
MOV B,H
POP D ;FINISH COMPUTING "TO" ADDRESS
LHLD INSR
XCHG ;DE<>HL
DAD D ;HL=INSR+SLIN-ESRC
XCHG ;TO DE
CALL MOVE ;MOVE THAT STUFF UP
POP B ;GET SLIN-ESRC
PUSH B ;SAVE IT AGAIN
LHLD INSR ;GET "TO" ADDRESS
XCHG ;TO DE
LHLD SLIN ;GET "FROM" ADDRESS
CALL MOVE ;MOVE IT
SHLD ESRC ;SET NEW END OF SOURCE
MVI M,80H ;STORE END CODE
SHLD FRAV ;UPDATE FRAV
LHLD INSR ;GET OLD INSERTION ADDRESS
POP D ;GET SLIN-ESRC
DAD D ;ADD THEM
SHLD INSR ;SAVE IT
RET ;DONE....
ICLS2 LHLD FRAV ;MOVE LINE DOWN
XCHG
LHLD SLIN
CALL SUB16
MOV C,L
MOV B,H
LHLD ESRC
XCHG
CALL MOVE
XCHG
DAD B
SHLD SLIN ;UPDATE SLIN
JMP ICLS3
ICLS1 LHLD SLIN ;GET NEW INSERTION ADDRESS
SHLD ESRC ;SET ALL THESE CRAZY FLAGS
MVI M,80H ;STORE END CODE
SHLD FRAV ;UPDATE FRAV
SHLD INSR
RET ;DONE..
* RTN. D.16
* PROCESS CODED LINE
CLPR LDA CMND ;CHECK IT WE'RE IN COMMAND MODE
ANA A ;SET FLAGS
JNZ CLPR1 ;SEEM TO BE
CALL ICLS ;INSERT THE LINE IF WE'RE NOT
LDA EDITM ;CHECK FOR EDIT MODE
ANA A
JNZ EDIT2 ;SURE WAS
JMP RSTRR ;LOOP FOR ANOTHER LINE
CLPR1 CALL SUBS ;GET ADDRESS
PUSH H
LHLD PNTR
SHLD PNTRA
LHLD SLIN ;SET UP NEW PNTR
SHLD PNTR
SHLD NPNTR
LHLD SDIR ;SET UP FARY IF RUN NOT READY
LDA RURD
ANA A
JNZ CLPR9 ;IT'S OKAY ALREADY
SHLD FARY ;SET IT UP
CLPR9 POP H ;FIRST ADDRESS TO EXECUTE
JMP RUN ;RUN IT
* THE FOLLOWING IS A TABLE OF ALL INTRINSIC FUNCTIONS
* RECOGNIZED BY TARBELL BASIC. THEY ARE IN OPCODE ORDER
FUNT DB 'AB','S'+80H
DB 'AS','C'+80H
DB 'AT','N'+80H
DB 'CHR','$'+80H
DB 'CO','S'+80H
DB 'EX','P'+80H
DB 'FR','E'+80H
DB 'IN','P'+80H
DB 'IN','T'+80H
DB 'LEFT','$'+80H
DB 'LE','N'+80H
DB 'LO','G'+80H
DB 'MID','$'+80H
DB 'OCT','$'+80H
DB 'PEE','K'+80H
DB 'PO','S'+80H
DB 'RIGHT','$'+80H
DB 'RN','D'+80H
DB 'SG','N'+80H
DB 'SI','N'+80H
DB 'SPACE','$'+80H
DB 'SP','C'+80H
DB 'SQ','R'+80H
DB 'STR','$'+80H
DB 'TA','B'+80H
DB 'TA','N'+80H
DB 'US','R'+80H
DB 'VA','L'+80H
DB 'MATC','H'+80H
DB 'HEX','$'+80H
DB 'CAL','L'+80H
DB 'LO','C'+80H
DB 'HE','X'+80H
* RTN. D.17
* PROCESS INTRINSIC FUNCTIONS
* CHECKS TO SEE IF TOKEN AT TSCN IS A VALID
* INTRINSIC FUNCTION. IF IT IS, EXIT IS WITH ZERO AND
* THE OPCODE IN A. IF IT IS NOT, EXIT IS NOT ZERO.
PFUN LHLD TSCN ;GET TOKEN ADDRESS
LXI D,FUNT ;TABLE ADDRESS
LXI B,33 ;NUMBER OF ITEMS ON TABLE
CALL STSRH ;SEARCH THE TABLE
RNZ ;NO FIND
PUSH B ;SAVE OFFSET
CALL USCN ;SCAN OFF NEXT TOKEN
JC SPRAT ;SYNTAX ERROR IF NONE
LHLD TSCN ;GET THE ADDRESS
MOV A,M ;GET IT
CPI '('+80H ;SEE IF IT'S RIGHT
JNZ SPRAT ;NOPE!!
CALL BSCN ;SCAN BACK TO LAST TOKEN
POP B ;RESTORE OFFSET
MVI A,3FH ;OPCODE OFFSET
ADD C ;FORM THE CODE
MVI C,1 ;SET THE ZERO FLAG
DCR C
RET ;DONE.
* RTN. D.18
* CHECK FOR SEMICOLON OR COMMA
* IF IT IS, EXITS WITH ZERO SET AND OPCODE IN
* A. IF NOT, ZERO IS CLEARED.
SCCC LHLD TSCN ;GET TOKEN ADDRESS
MOV A,M ;GET THE CHARACTER
CPI ';'+80H ;CHECK FOR SEMICOLON
JZ SCCC1 ;IT IS
CPI ','+80H ;CHECK FOR COMMA
RNZ ;IT WASN'T
MVI A,0DH ;SET OPCODE
RET ;DONE
SCCC1 MVI A,0EH ;GET OPCODE
RET ;DONE.
* RTN. D.19
* INSERT CODE BYTE
* A = CODE BYTE
ICBY LHLD SLIN ;GET ADDRESS TO PUT THE THING
MOV M,A ;STUFF IT IN
INX H ;UPDATE INDEX
SHLD SLIN ;SAVE IT
RET ;DONE
* RTN. D.20
* NORMAL STATEMENT PROCESSOR
* A = NORMAL INDEX
NSPR ADI 09FH ;ADD OFFSET TO FORM OPCODE
STA OPFLG ;SAVE IT
CALL ICBY ;INSERT IN STRING
CALL USCN ;CHECK FOR ANY EXPRESSION FOLLOWING
JC ENPR ;RETURN IF NOTHING FOLLOWS
CALL BSCN ;SCAN BACK TO WHENCE WE STARTED
NSPR1 CALL EVEX ;PROCESS THIS EXPRESSION
JMP ENPR ;PROCESS END OF EXPRESSION
INTBL DB ':'+80H
DB 'GOT','O'+80H
DB 'T','O'+80H
DB 'STE','P'+80H
DB 'THE','N'+80H
DB 0A7H
DB 0DCH ;BACKSLASH
DB 'GOSU','B'+80H
DB 'ELS','E'+80H
DB 89H
* RTN. D.22
* PROCESS INTERMEDIARIES
PINT LHLD TSCN ;GET ADDRESS OF TOKEN
LXI D,INTBL ;GET ADDRESS OF TABLE OF INTERMEDIARYS
LXI B,10 ;NUMBER OF ITEMS TO LOOK FOR
CALL STSRH
MOV A,C ;FIND # TO C
RET ;DONE.
* RTN. D.21
* END OF STATEMENT PROCESSOR
* RETURNS IF END IS OK, GOES TO EXEC3 IF A COLON,
* SYNTAX ERROR (10) OTHERWISE
ENPR LDA ESCN ;END OF LINE?
CPI 2
RZ ;YUP
ENPR2 CALL PINT ;CHECK INTERMEDIATE CODE
JNZ EXEC3 ;PROCESS AS STATEMENT
CPI 2 ;GOTO?
JZ EXEC3 ;YUP
CPI 8 ;GOSUB?
JZ EXEC3 ;YUP
CPI 1 ;COLON?
MVI B,9EH ;JUST IN CASE
JZ ENPR1 ;YUP
CPI 6 ;REMARK
JZ PREM ;YUP
CPI 7 ;BACKSLASH?
MVI B,9DH ;JUST IN CASE
JZ ENPR1 ;YUP
CPI 10 ;IS IT A TAB?
MVI B,9CH ;JUST IN CASE
JZ ENPR1 ;YUP
CPI 9 ;ELSE?
MVI B,9BH ;JUST IN CASE
JZ ENPR1 ;YUP
JMP SPRAT ;MUST BE ILLEGAL
ENPR1 MOV A,B
CALL ICBY ;INSERT IT
CALL USCN ;GET THE NEXT TOKEN
JC SPRAT ;OUT OF DATA
JMP ENPR2 ;TRY AGAIN
INTB DW INON
DW INGO
DW INFO
DW INGT
DW INGS
DW INIF
DW INRE
DW INCH
DW INON
DW INRT
* RTN. D.23
INRT LDA ESCN ;ARE WE NEAR THE END?
CPI 2
JZ ENPR ;YUP
CALL INSN ;PROCESS THE STATEMENT NAME
JMP ENPR ;DONE
* PROCESS ODDBALL STATEMENTS
* IN: A = STATEMENT CODE
PROS CPI 11 ;IS IT REMARK?
JNZ PROS1 ;NOPE
MVI A,7 ;CORRECT
PROS1 PUSH PSW ;SAVE THE CODE
ADI 7FH ;ADD OFFSET
STA OPFLG
CALL ICBY ;INSERT IN CODE STRING
POP PSW ;RESTORE THE CODE
MOV E,A ;SET IN DE
MVI D,0
LXI H,INTB ;SET UP TO LOOKUP ADDRESS OF PROCESSOR
CALL TABLE ;LOOK IT UP
MOV L,C ;MOVE THE RESULT TO HL
MOV H,B
PCHL ;JUMP TO THE PROCESSOR
ODTBL DB 'O','N'+80H
DB 'GOPRO','C'+80H
DB 'FO','R'+80H
DB 'GOT','O'+80H
DB 'GOSU','B'+80H
DB 'I','F'+80H
DB 'RE','M'+80H
DB 'CHANNE','L'+80H
DB 'O','N'+80H
DB 'RESTOR','E'+80H
DB 'REMAR','K'+80H
NOTBL DB 'CLOA','D'+80H
DB 'CSAV','E'+80H
DB 'ASSIG','N'+80H
DB 'DAT','A'+80H
DB 'DE','F'+80H
DB 'DI','M'+80H
DB 'DRO','P'+80H
DB 'INPU','T'+80H
DB 'LE','T'+80H
DB 'EN','D'+80H
DB 'NEX','T'+80H
DB 'OU','T'+80H
DB 'POK','E'+80H
DB 'PRIN','T'+80H
DB 'PROCEDUR','E'+80H
DB 'REA','D'+80H
DB 'RECEIV','E'+80H
DB 'BSAV','E'+80H
DB 'RETUR','N'+80H
DB 'STO','P'+80H
DB 'WAI','T'+80H
DB 'CLEA','R'+80H
DB 'BLOA','D'+80H
DB 'BPU','T'+80H
DB 'BGE','T'+80H
CHCKA CALL CHCK ;CHECK INTEGRITY
MOV B,A ;SAVE TO B
LDA CHECK ;GET THE CHECK BYTE
CMP B ;COMPARE IT
RZ ;IT'S OKAY, BASIC LIVES!
CHCKB LXI H,CKMSG ;OOPS, A DESTROYED BIT OR TWO SOMEWHERE
CALL MSGER ;TELL THE OPERATOR
JMP CHCKB ;DO IT AGAIN
SUBS LDA RURD ;IS RUN READY?
ANA A ;SET FLAGS
LHLD FRAV ;JUST IN CASE
RZ ;NOPE
LHLD PNTR ;YUP
RET ;DONE.
CKMSG DB 'BASIC IS CRASHED',8DH
* RTN. D.24
* CHECK FOR STATEMENT
* JUMPS TO PROCESSOR IF IT IS A STATEMENT
CHST LHLD TSCN ;SET UP CASER
SHLD CASER
LHLD TSCN ;GET ADDRESS OF TOKEN
XRA A ;CLEAR A
STA STFLG ;CLEAR NOT STATEMENT FLAG
MOV A,M ;CHECK FOR ? FOR PRINT
CPI '?'+80H
MVI A,14 ;PRINT ITEM NUMBER
JZ NSPR ;SURE WAS
LXI D,NOTBL ;GET ADDRESS OF TABLE OF NORMAL STATEMENTS
LXI B,19H ;NUMBER OF NORMAL STATEMENTS
CALL STSRH ;SEARCH
MOV A,C ;CODE TO A
JZ NSPR ;FOUND
CHST1 LHLD TSCN ;GET ADDRESS OF TOKEN
LXI D,ODTBL ;GET ADDRESS OF TABLE OF ODDBALL STATEMENTS
LXI B,11 ;NUMBER OF ODDBALL STATEMENT TYPES
CALL STSRH ;SEARCH IT
MOV A,C ;GET CODE FOUND IF ANY
JZ PROS ;JUMP TO PROCESS ODDBALL STATEMENT
MVI A,0FFH ;SET NOT STATEMENT FLAG
STA STFLG ;SET IT
RET ;NOT A STATEMENT
COTBL DB 'CAD','D'+80H
DB 'CLEA','R'+80H
DB 'CLOA','D'+80H
DB 'CON','T'+80H
DB 'CSAV','E'+80H
DB 'DELET','E'+80H
DB 'ENTE','R'+80H
DB 'LIS','T'+80H
DB 'NE','W'+80H
DB 'RU','N'+80H
DB 'EDI','T'+80H
DB 'SYMBO','L'+80H
DB 'BY','E'+80H
* RTN. D.25
* EXECUTIVE
RSTRT LDA CSST ;CHECK FOR CASSETTE MODE
ANA A ;SET FLAGS
JNZ EXCE1 ;CASSETTE MODE
CALL CRLF ;PRINT HEAD TO THE LEFT
RSTRR LXI SP,STACK+100 ;SET UP THE STACK POINTER
EXEC2 LDA CSST ;CHECK FOR CASSETTE MODE
ANA A
JNZ EXCE1 ;CASSETTE MODE
LDA CMND ;CHECK FOR COMMAND MODE
ANA A ;SET FLAGS
JZ EXECA ;NOPE
MVI A,'>' ;COMMAND MODE PROMPT
JMP EXECB ;SKIP THE NEXT
EXECA MVI A,':' ;ENTER MODE PROMPT
EXECB CALL TOUT ;OUTPUT IT
EXCE1 CALL SUBS ;GET END OF SOURCE
LXI D,100 ;ADD 100 TO IT
DAD D
MVI M,80H ;CLEAR OUT A BYTE
INX H ;GET NEXT ADDRESS
MVI M,80H ;AND ANOTHER ONE
INX H ;UPDATE
LDA CSST ;CHECK FOR CASSETTE MODE
STA CATV ;STORE AS CASSETTE/TV MODE
CALL LIIN ;INPUT A LINE FROM THE KEYBOARD
JNC EXEC1 ;SOMETHING WAS INPUTTED
MVI A,0FFH ;SET COMMAND MODE
STA CMND ;DONE
LDA CSST ;CHECK FOR CASSETTE MODE
ANA A
JZ EXCYY ;NOT CASSETTE MODE
STC ;STOP MOTORS
CALL CAIN
EXCYY XRA A ;CLEAR CSST MODE
STA CSST
JMP RSTRT ;TRY AGAIN
EXEC1 XRA A ;CLEAR A
STA ESCN ;CLEAR END OF SCAN FLAG
CALL SUBS ;SET UP NEXT SCAN AND SOURCE LINE FLAGS
LXI D,101
SHLD SLIN ;SOURCE LINE FLAG
DAD D
EXE77 SHLD NSCN ;NEXT SCAN FLAG
CALL USCN ;UPSCAN TWICE TO GET FIRST TOKEN
CALL USCN ;AGAIN
LHLD TSCN ;GET ADDRESS OF THIS TOKEN
MOV A,M ;CHECK FOR COLON
CPI ':'+80H
LXI B,7 ;CHECK FIND NUMBER JUST IN CAST
JZ EXE80 ;SURE WAS
LXI D,COTBL ;TABLE OF COMMANDS
LXI B,13 ;NUMBER OF COMMANDS TO DECODE
CALL STSRH ;SEARCH THE COMMAND TABLE
JNZ EXEC3 ;WASN'T A COMMAND
EXE80 LXI H,COJMP ;TABLE OF COMMAND PROCESSING ENTRANCES
MOV D,B ;MOVE BC TO DE
MOV E,C
LDA CMND ;CHECK FOR COMMAND MODE
ANA A
JNZ EXE88 ;SURE IS
MOV A,C ;GET COMMAND TYPE
CPI 10 ;CHECK FOR VALIDITY IN ENTER MODE
JNC EXE88 ;OK
CPI 9
JZ EXEC3 ;NOT OK
CPI 6
JC EXEC3 ;NOT OK
EXE88 CALL TABLE ;GET ADDRESS
MOV H,B ;MOVE BC TO HL
MOV L,C
MVI A,0FFH ;SET COMMAND MODE
STA CMND
PCHL ;JUMP TO PROCESS COMMAND
EXEC3 CALL CHST ;CHECK TO SEE IF THIS TOKEN IS A STATEMENT
LDA STFLG ;GET STATEMENT FLAG
ANA A ;SET FLAGS
JNZ EXEC4 ;WASN'T A STATEMENT
JMP CLPR ;PROCESS THE CODED LINE
EXEC4 LHLD TSCN ;GET ADDRESS
MOV A,M ;GET CHARACTER
CPI 89H ;IS IT A TAB?
JZ EXECTAB ;YUP
CALL BSCN ;SCAN BACK
LHLD NSCN ;CHECK FOR = SIGN
EX000 MOV A,M ;GET A BYTE
ANA A ;CHECK FOR END REACHED
JZ EXEC5 ;YUP
CPI 20H
JNZ EXXZZ ;NOT A SPACE
INX H ;CHECK FOR = NEXT
MOV A,M ;GET A BYTE
ANI 7FH ;STRIP END BIT
CPI '='
JNZ EXEC5 ;NOT A "LET" STATEMENT
DCX H
EXXZZ INX H ;NEXT BYTE
CPI '=' ;CHECK FOR THE EQUALS SIGN
JNZ EX000 ;TRY AGAIN
INIF4 MVI A,0A8H ;CODE FOR "LET" STATEMENT
LXI H,EXEC3+3 ;RETURN ADDRESS
PUSH H ;ONTO THE STACK
LXI H,STFLG ;CLEAR OUT THE STATEMENT FLAG
MVI M,0
STA OPFLG ;STORE CODE
CALL ICBY ;INSERT IN LINE
JMP NSPR1 ;PROCESS THE LET STATEMENT
EXEC5 LDA CMND ;CHECK FOR MODE
ANA A ;SET FLAGS
MVI B,8 ;POSSIBLE ERROR
JNZ ERROR ;NO LABELS IN COMMAND MODE!
CALL USCN ;GET EVERYTHING BACK TO NORMAL
CALL LGLB ;CHECK FOR LABEL LEGALITY
MVI B,7 ;POSSIBLE ERROR
JC ERROR ;ILLEGAL LABEL
MVI A,9FH ;GET STATEMENT OPCODE
CALL ICBY ;INSERT IT
MVI A,6 ;START OF STATEMENT NAME CODE
CALL ICBY ;INSERT IT
LHLD TSCN ;GET TOKEN ADDRESS
MVI A,1 ;STATEMENT NAME CODE
CALL GTNM ;GET THE SYMBOL NUMBER
PUSH B
MVI B,7 ;POSSIBLE ERROR
JC ERROR ;STATEMENT NAME USED AS VARIABLE NAME
POP B
MOV A,C ;MOVE SYMBOL NUMBER INTO CODE LINE
MOV L,C
MOV H,B
SHLD EDITS
CALL ICBY
MOV A,B
CALL ICBY
MVI A,7
CALL ICBY
CALL USCN ;GET NEXT TOKEN
JC SPRAT ;ERROR IF ONLY A LABEL
JMP EXEC3 ;GET REST OF STATEMENT
EXECTAB MVI A,9CH ;STORE THE OPCODE
CALL ICBY
CALL USCN ;GET NEXT TOKEN
JMP EXEC3 ;DO IT
PRSY LXI H,PRSYMSG1 ;DUMP THE TITLE OUT
CALL MSGER
LDA RURD ;SEE IF WE ARE ALREADY SET UP
ANA A
JNZ PRSYSKIP ;YUP
CALL ASDA ;SET IT ALL UP
CALL AVAP
PRSYSKIP LHLD SNUM ;GET NUMBER OF SYMBOLS
MOV B,H ;TO BC
MOV C,L
LHLD SDIR ;GET START OF DIRECTORY
PUSH H ;TO THE STACK
LHLD STAB ;GET START OF THE SYMBOL TABLE
PRSY1 CALL COUNT ;ADVANCE ONE SYMBOL
DAD D
MOV A,M ;GET A BYTE
ANA A
JNZ PRSY1A ;NOT AN ARRAY NAME
INX H
PRSY1A XTHL ;ADVANCE THE DIRECTORY
INX H
INX H
INX H
XTHL ;DID THAT
DCX B ;UPDATE SYMBOL COUNT
MOV A,B ;CHECK FOR DONENESS
ORA C
JZ RSTRT ;ALL DONE PEOPLE
PUSH B ;SAVE EM
PUSH H
CALL MSGER ;DUMP THE LABEL NAME
PRSY2 LDA POSIT ;SEE IF WE'RE AT THE COLUMN YET
CPI 32
JZ PRSY3 ;YUP
MVI A,20H
CALL TOUT ;NO, SO DUMP A SPACE
JMP PRSY2 ;TRY AGAIN
PRSY3 POP H ;RESTORE
POP B
XTHL ;GET DIRECTORY
INX H
INX H
PUSH H ;SAVE IT
PUSH B
MOV A,M ;GET ID BYTE
ANI 1 ;IS IT LABEL?
JNZ PRSY3A ;YUP
MOV A,M
ANI 2 ;IS IT A VARIABLE?
JNZ PRSY3B ;YUP
LXI H,PRSYMSG2
JMP PRSY3C
PRSY3A LXI H,PRSYMSG3
JMP PRSY3C
PRSY3B LXI H,PRSYMSG4
PRSY3C CALL MSGER
POP B
POP H ;GET BACK LOCATION
DCX H
MOV D,M ;FISH OUT THE POINTER
DCX H
MOV E,M
PUSH H ;SAVE IT
XCHG
PUSH B
LXI D,TMP1 ;CONVERSION PLACE
CALL BBCD ;CONVERT TO BINARY
LHLD FRAV ;GET PLACE TO CONVERT TO
XCHG
LXI H,TMP1
CALL NMST ;CONVERT TO NUMBER
XCHG
DCX H
MOV A,M ;SET LAST BIT
ORI 80H
MOV M,A
LHLD FRAV
CALL MSGER ;DUMP IT OUT
CALL CRLF ;SEND A CARRIAGE RETURN
POP B
POP H ;RESTORE ADDRESS
XTHL ;TRADE
JMP PRSY1 ;DO IT AGAIN
* RTN. D.26
* ON STATEMENT PROCESSOR
INON LHLD SLIN ;SAVE ADDRESS OF OPCODE
PUSH H
CALL EVEX ;PROCESS EXPRESSION
CALL PINT ;CHECK FOR "GOTO"
CPI 2
JZ INON1 ;IT'S A GOTO
CPI 8 ;CHECK FOR A GOSUB
JNZ SPRAT ;NOPE, SO ERROR
POP H ;CHANGE OPCODE
DCX H
MVI M,88H ;STORE THE NEW ONE
PUSH H ;SET STACK UP
INON1 POP H ;CLEAN UP THE STACK
CALL PLDL ;PROCESS LINE DESCRIPTOR LIST
JMP ENPR ;END OF LINE PROCESSING
* RTN. D.27
* GOPROC STATEMENT PROCESSOR
INGO CALL INSN ;PROCESS THE STATEMENT NAME
JC ENPR ;NO TRANSFER LIST
CALL SCCC ;CHECK FOR COMMA
CPI 0DH ;COMPARE
MVI B,10H ;ERROR CODE JUST IN CASE
JNZ ERROR ;SYNTAX ERROR
CALL EVEX ;PROCESS EXPRESSION
JMP ENPR ;END PROCESSOR
* RTN. D.28
* INSERT STATEMENT NAME
INSN JMP PLDS ;USE PROCESS LINE DESCRIPTOR ROUTINE
* RTN. D.29
* FOR STATEMENT PROCESSOR
INFO MVI A,0A8H ;GET CODE FOR "LET" STATEMENT
STA OPFLG ;SET ASSIGNMENT MODE FOR =
CALL EVEX ;EVALUATE THE EXPRESSION
CALL PINT ;CHECK FOR "TO"
CPI 3 ;CHECK IT
MVI B,19H ;ERROR CODE JUST IN CASE
JNZ ERROR ;NO "TO"
CALL EVEX ;GET THE NEXT PART
CALL PINT ;SEE IF THERE IS A "STEP"
CPI 4 ;COMPARE CODES
JNZ ENPR ;NOPE, WE MUST BE DONE
CALL EVEX ;GET THE STEP INTERVAL
JMP ENPR ;DONE
* RTN. D.30
* GOTO STATEMENT PROCESSOR
INGT CALL INSN ;GET STATEMENT NAME
JMP ENPR ;DONE
* RTN. D.31
* GOSUB STATEMENT PROCESSOR
INGS JMP INGT ;SAME AS GOTO
* RTN. D.31
* IF STATEMENT PROCESSOR
INIF CALL EVEX ;GET EXPRESSION
CALL PINT ;GET CODE FOR INTERMEDIARY
CPI 2 ;IS IT A "GOTO"?
JZ EXEC3 ;SO GET THE NAME
CPI 5 ;IS IT A "THEN"?
JNZ SPRAT ;SYNTAX ERROR
CALL USCN ;SCAN OFF ANOTHER TOKEN
JC SPRAT ;NOTHING FOLLOWING, SYNTAX ERROR
CALL CHST ;CHECK TO SEE IF THE TOKEN IS A STATEMENT
LDA STFLG ;CHECK IT OUT
ANA A
JZ CLPR ;IT WAS A STATEMENT, SO PROCESS IT
CALL BSCN ;CHECK FOR "=" SIGN
LHLD NSCN
INIF1 MOV A,M ;GET A BYTE
ANA A ;CHECK FOR END REACHED
JZ INIF2 ;YUP
CPI 20H ;CHECK FOR SPACE
JNZ INIF3 ;NOPE
INX H ;CHECK FOR "=" NEXT
MOV A,M ;GET IT
ANI 7FH ;STRIP END BIT
CPI '=' ;CHECK IT OUT
JNZ INIF2 ;NOT A LET STATEMENT
DCX H ;CORRECT INDEX
INIF3 INX H
CPI '=' ;CHECK FOR = SIGN
JNZ INIF1 ;TRY AGAIN
JMP INIF4 ;PUT IN THE LET STATEMENT
INIF2 CALL USCN ;CORRECT IT
MVI A,83H ;SET IN THE GOTO CODE
CALL ICBY ;INSERT THE CODE BYTE
CALL BSCN ;BACK OFF, JACK
XRA A ;CLEAR THE STATEMENT FLAG
STA STFLG
JMP INGT ;PROCESS AS GOTO
* RTN. D.33
* REMARKS PROCESSOR
INRE JMP PREM ;DO IT THIS WAY
* RTN. D.34
* CHANNEL PROCESSOR
INCH CALL EVEX ;PROCESS EXPRESSION
JMP ENPR ;DONE
* RTN. D.35
* GET INCREMENT
GTIN LXI D,1 ;PRESET INCREMENT TO MINIMUM
CPI 8 ;IS A>=8?
RNC ;YUP
PUSH H ;SAVE ADDRESS
ANA A ;IS A=0?
JZ GTIN2 ;YUP
DCR A ;IS A=1?
JZ GTIN3 ;YUP
CPI 3 ;IS A=4?
JZ GTIN4 ;YUP
CPI 4 ;IS A=4?
JZ GTIN4 ;YUP
LXI D,4 ;LABEL NUMBER
POP H ;RESTORE ADDRESS
RET ;DONE
GTIN4 LXI D,8 ;NUMBER
POP H ;RESTORE ADDRESS
RET ;DONE
GTIN3 DCX H ;UPDATE INDEX
INX D ;UPDATE COUNTER
MOV A,M ;GET A BYTE
ANA A ;IS IT A ZERO?
JNZ GTIN3 ;NOPE
POP H ;RESTORE ADDRESS
RET ;DONE
GTIN2 INX H ;UPDATE INDEX
INX D ;UPDATE COUNTER
MOV A,M ;GET A BYTE
CPI 1 ;IS IT A ONE?
JNZ GTIN2 ;NOPE
POP H ;RESTORE ADDRESS
RET ;DONE
* RTN. D.36
* MOVE FORWARD ONE STATEMENT IN SOURCE
* TSCN CONTAINS ADDRESS OF CURRENT STATEMENT
MFOS LHLD LINE ;GET CURRENT STATEMENT
INX H ;GET NEXT BYTE
MFOS2 XCHG ;TO DE
LHLD ESRC ;CHECK FOR RUNOVER
CALL CMP16 ;COMPARE
JZ MFOS1 ;YUP
LHLD SLIN ;DIRECT MODE
CALL CMP16
JZ MFOS1 ;YUP
XCHG ;BACK TO HL
MOV A,M ;CHECK FOR A STATEMENT HERE
ANA A ;IS IT ANOTHER STATEMENT
JM MFOS1 ;YUP
MFOS1A CALL GTIN ;NOPE
DAD D ;ADD INCREMENT
JMP MFOS2 ;LOOP TO TRY AGAIN
MFOS1 SHLD LINE ;SAVE IT
XCHG ;TO DE
LHLD FSRC ;SEE IF WE'RE WITHIN THE PROGRAM
DCX H ;CORRECT
CALL CMP16 ;CHECK IT OUT
JNC MFOS3 ;NO GOOD
LHLD ESRC ;CHECK FOR WITHIN STORED PROGRAM
CALL CMP16 ;CHECK IT OUT
XCHG ;GET LINE BACK TO HL
RNC ;GOOD FOR SURE
XCHG ;BACK TO DE
LHLD FRAV ;CHECK FOR DIRECT MODE LEAP
DCX H ;CORRECT
CALL CMP16 ;CHECK IT OUT
JNC MFOS3 ;NO GOOD
LHLD SLIN ;AGAIN
CALL CMP16 ;CHECK IT OUT
XCHG ;TO HL
RNC ;IT'S GOOD FOR SURE
MFOS3 MVI B,7 ;ERROR TYPE
LHLD ESRC ;RESET LINE
SHLD LINE
JMP ERROR ;GO DO IT
* RTN. D.37
* MOVE BACKWARDS ONE STATEMENT IN SOURCE
MBOS LHLD LINE ;GET CURRENT STATEMENT
DCX H ;GET LAST ONE
MBOS1 MOV A,M ;GET A BYTE
ANA A ;SET FLAGS
JM MFOS1 ;FOUND THE LAST STATEMENT
MBOS1A CALL GTIN ;GET THE INCREMENT
CALL SUB16 ;HL=HL-DE
JMP MBOS1 ;LOOP TO TRY AGAIN
* RTN. D.38
* ASSIGN STATEMENT AND DEF ADDRESSES
ASDA LHLD ESRC ;STORE THE FAKE END
MVI M,0FFH
LHLD SNUM ;NUMBER OF SYMBOLS
XCHG ;TO DE
LHLD SDIR ;SYMBOL DIRECTORY
ASD00 INX H ;GET ID BYTE
INX H
MVI A,5 ;CHECK FOR DEF OR STATEMENT
ANA M
JZ ASD01 ;NOPE
DCX H ;STORE A 0
MVI M,0
DCX H
MVI M,0
INX H
INX H
ASD01 INX H ;GET NEXT ONE
DCX D ;CHECK FOR DONENESS
MOV A,D
ORA E
JNZ ASD00 ;NOT YET
LHLD FSRC ;SET UP LIN FLAG
SHLD LINE
ASDA1 MOV A,M ;GET STATEMENT BYTE
CPI 9FH ;IS THIS A STATEMENT NAME?
JZ ASDA3 ;YUP
CPI 0A4H ;IS THIS A DEF FNXXX STATEMENT?
JZ ASDA2 ;YUP
ASDA4 XCHG ;HL TO DE
LHLD ESRC ;GET END OF SOURCE ADDRESS
CALL CMP16 ;SEE IF WE ARE DONE YET
RZ ;YUP
ASDAQ CALL MFOS ;GET NEXT STATEMENT
JMP ASDA1 ;LOOP TO PROCESS IT
ASDA3 INX H ;GET ADDRESS OF STATEMENT NAME NUMBER
INX H
MOV C,M ;GET NUMBER TO BC
INX H
MOV B,M
CALL DFND ;GET THE ADDRESS OF POINTER
MOV A,H ;CHECK FOR POINTER = 0
ORA L
JNZ ASD20 ;DUPLICATE NAME ERROR
ASDAM LXI H,LINE ;ADDRESS OF LINE POINTER
LXI B,2 ;NUMBER OF BYTES
DCX D
DCX D
CALL MOVE ;MOVE THE NUMBER IN
JMP ASDAQ ;LOOP FOR NEXT STATEMENT
ASDA2 INX H ;GET ADDRESS OF SYMBOL LABEL
INX H
MOV A,M ;GET THE ID BYTE
CPI 2 ;CHECK IT
MVI B,10H ;ERROR CODE JUST IN CASE
JNZ ERROR ;SYNTAX ERROR
INX H ;GET NUMBER ADDRESS
MOV C,M ;GET THE NUMBER
INX H
MOV B,M
CALL DFND ;FIND THE POINTER ADDRESS
MOV A,H ;CHECK FOR POINTER = 0
ORA L
JNZ ASD10 ;DUPLICATE FNXX ERROR
JMP ASDAM ;CONTINUE PROCESSING
* RTN. D.39
* ASSIGN VARIABLE AND ARRAY POINTER SPACE
AVAP LXI B,1 ;SET UP FOR FIRST SYMBOL
LHLD SDIR ;SET UP FARY
SHLD FARY
LHLD ESRC ;GET FIRST ADDRESS FOR VARIABLES
AVAP3 PUSH H ;SAVE IT
AVAP1 CALL DFND ;FIND THE POINTER
CPI 2 ;IS IT A VARIABLE?
JZ AVAP4 ;YUP
CPI 16 ;IS IT AN ARRAY?
JZ AVAP2 ;YUP
AVAPD MOV D,B ;BC TO DE
MOV E,C
LHLD SNUM ;SEE IF WE ARE DONE YET
INX B ;UPDATE SYMBOL NUMBER
CALL CMP16 ;CHECK
JNZ AVAP1 ;NOPE
POP H ;GET ADDRESS BACK
SHLD FRAV ;SAVE NEXT AVAILABLE
RET ;DONE
AVAP4 PUSH D
PUSH B
LHLD STAB ;GET START OF SYMBOL TABLE
AVAP41 CALL COUNT
DAD D
DCX B
MOV A,B
ORA C
JNZ AVAP41 ;LOOP TILL WE FIND IT
DCX H
MOV A,M
CPI '$'+80H ;SEE IF IT'S A DOLLAR SIGN
POP B
POP D
JNZ AVAP2 ;REGULAR VARIABLE
POP H ;RESTORE
PUSH B ;SAVE
PUSH D ;SAVE
PUSH H ;SAVE
XCHG ;STORE THE POINTER
DCX H
MOV M,D
DCX H
MOV M,E
XCHG
MVI A,81H ;ID BYTE
INX H
INX H
INX H ;BACKPOINTER ADDRESS
XCHG
LXI H,1
CALL AMBL ;ASSIGN MEMORY BLOCK FOR STRING
MVI M,80H ;STORE A NULL
XCHG ;ADDRESS TO DE
POP H ;RESTORE BLOCK ADDRESS
MVI M,8 ;STORE BLOCK ID
INX H ;UPDATE
INX H
INX H
MOV M,E ;STORE POINTER
INX H
MOV M,D
INX H
INX H ;CORRECT NEXT ADDRESS
POP D ;RESTORE
POP B
PUSH H ;SAVE
JMP AVAPD
AVAP2 POP H ;GET ADDRESS BACK
XCHG ;FREE HL
DCX H ;GET POINTER ADDRESS
MOV M,D ;STORE THE ADDRESS
DCX H
MOV M,E
XCHG ;GET HL BACK
MVI A,6 ;ZERO OUT 6 BYTES
AVAPA MVI M,0FFH ;STORE A FILLER
INX H ;UPDATE
DCR A
JNZ AVAPA
PUSH H ;STUFF IT ON THE STACK
JMP AVAPD ;LOOP FOR THE NEXT ONE
ASD20 CALL ASD30 ;PRINT THE SYMBOL
MVI B,20H ;DUPLICATE STATEMENT ERROR
LXI H,ASD40 ;PRINT DUP STATEMENT MESSAGE
CALL MSGER
JMP ASDAQ ;GET NEXT SYMBOL
ASD10 CALL ASD30 ;PRINT THE SYMBOL
MVI B,21H ;DUPLICATE FNXX ERROR
LXI H,ASD50 ;PRINT DUP DEF MESSAGE
CALL MSGER
JMP ASDAQ ;GET NEXT SYMBOL
ASD30 PUSH B ;SAVE SYMBOL NUMBER
MVI A,0DH ;SEND A CARRIAGE RETURN
CALL TOUT
POP B ;RESTORE SYMBOL NUMBER
LXI H,TMP9 ;STORE AS A TOKEN
MVI M,2
INX H
MOV M,C
INX H
MOV M,B
LXI H,TMP9 ;DUMP IT
CALL PRIT
RET
ASD40 DB ' DUP STATE N','M'+80H
ASD50 DB ' DUP DE','F'+80H
COLON DB ':'+80H
* RTN. D.40
* UNDO POLISH STRING AND PRINT IT
* IN: HL=LAST ADDRESS OF POLISH STRING (09 CODE)
UPOS PUSH H ;SAVE ADDRESS
LHLD FARY ;SET UP UNPOLISH STRING ADDRESS
XCHG
LDA RURD ;IS RUN READY?
ANA A
JZ UPOO1 ;NOPE
LHLD PNTR ;YUP, SO USE SPACE AFTER STACK
JMP UPOO2 ;SKIP
UPOO1 LHLD SLIN ;SET UP STACK ADDRESS
UPOO2 MVI B,0 ;STACK COUNT TO 0
DCX D ;STORE END FLAG
MVI A,9
STAX D
UPOS1 XTHL ;GET POLISH STRING ADDRESS
UPOS3 DCX H ;GET THE ONE BEFORE IT
MOV A,M ;AYE, AYE, SIR
PUSH D ;SAVE NEW STRING ADDRESS
CALL GTIN ;GET THE INCREMENT
CALL SUB16 ;FIND THE BEGINNING OF THIS TOKEN
INX H
POP D ;RESTORE NEW STRING ADDRESS
MOV A,M ;GET FIRST CHARACTER
CPI 9 ;IS IT THE END YET?
JZ UPOS2 ;YUP
CPI 6 ;IS IT A LABEL, LITERAL, OR CONSTANT?
JC UPOS4 ;YUP
CPI 0EH ;IS IT A SEMICOLON?
JZ UPOSW ;YUP
CPI 0DH ;IS IT A COMMA?
JZ UPOSW ;YUP
XTHL ;MUST BE AN OPERATOR OR FUNCTION
MOV C,A ;STICK THE CHARACTER IN C
CPI 40H ;IS IT A FUNCTION?
JP UPOSM ;YUP
CPI 34H ;IS IT ARRAY OR FN OPERATOR?
JP UPOSN ;YUP
CPI 20H ;IS IT BIGGER THAN AN OPERATOR?
JP DMS10 ;YUP, SO NO NEED TO CHECK PRECEDENCE
CPI 0FH ;IS IT AN OPERATOR?
JM DMS10 ;NOPE, SO NO NEED TO CHECK PRECEDENCE
LDAX D ;GET BYTE FROM UNPOLISH STRING
CPI 20H ;CHECK FOR OTHER THAN OPERATOR
JNC DMS48 ;NOT AN OPERATOR
DCR A ;CHECK PRECEDENC
CMP C ;COMPARE
JP DMS11 ;OOPS, NEED A PAREN OR TWO
DMS48 INR B ;CHECK FOR EMPTY STACK
DCR B
JZ UPOS5 ;SURE IS
DMS10 DCX H ;GET TOP OF STACK
MOV A,M
CPI 20H ;CHECK FOR PAREN ON STACK
INX H ;SET STACK BACK
JZ UPOS5 ;NO NEED TO CHECK FURTHER
DCR A ;SET UP FOR COMPARE
CMP C ;CHECK FOR STACK HAVING PRECEDENCE
JM UPOS5 ;STACK'S OK
DMS11 MVI M,20H ;STORE CODE FOR "(" ON STACK
INX H ;UPDATE COUNTERS
INR B
DCX D ;STICK A ")" ON OUTPUT
MVI A,21H
STAX D
UPOS5 MOV M,C ;STORE OPERATOR ON STACK
INX H
INR B ;UPDATED THE COUNTERS
JMP UPOS1 ;LOOP FOR ANOTHER TOKEN
UPOSW DCX D ;NEXT BYTE OF UNPOLISH STRING
STAX D ;STORE THE COMMA OR SEMICOLON
XTHL
DCX H
MOV A,M
INX H
CPI 3BH
JNZ UP02
DCX H
DCR B
UP02 XTHL
JMP UPOS3 ;CONTINUE PROCESSING
UPOSM MOV M,A ;STUFF IT ON THE STACK
INX H
MVI M,20H ;STUFF A '(' ON
INX H
INR B
INR B
CPI 49H ;CHECK FOR MULTI-ARGUMENT FUNCTIONS
JZ UP00
CPI 5EH ;IS IT CALL(X,X)?
JZ UP00 ;SURE IS
CPI 50H
JZ UP00
CPI 4CH
JZ UP01
CPI 5CH ;CHECK FOR A MATCH
JZ UP01 ;SURE WAS
UPOSO DCX D ;STICK A ')' ON
MVI A,21H
STAX D
JMP UPOS1 ;LOOP FOR ANOTHER ONE
UP10 XTHL
DCX H
MOV A,M
INX H
XTHL
CPI 0DH
JZ UPOS1
DCX H
DCR B
JMP UPOS6
UPOSN MOV M,A ;ON THE STACK
INX H
INR B
JMP UPOSO
UP01 MVI M,3BH
INX H
INR B
UP00 MVI M,3BH
INX H
INR B
JMP UPOSO
UPOSP XTHL
DCX H
MOV A,M ;GET NEXT TOKEN
INX H
XTHL
INX H ;UNPOP ARRAY OPERATOR
INR B
CPI 0DH ;COMMA?
JZ UPOS1 ;YUP
CPI 0EH ;SEMICOLON?
JZ UPOS1 ;YUP
DCX H ;POP ONE
DCR B
DCX D ;MOVE ON A'('
MVI A,20H
STAX D
JMP UPOS1 ;AND ANOTHER ONE
UPOS4 PUSH B ;SAVE REGISTERS
PUSH D
MOV A,M ;GET A BYTE
CALL GTIN ;GET INCREMENT
XTHL ;GET STRING ADDRESS
CALL SUB16 ;COMPUTE THE NEW ONE
XCHG ;STICK IT IN YOUR DE
MOV C,L ;BC = HL
MOV B,H
POP H ;GET SOURCE ADDRESS BACK
CALL MOVE ;MOVE IT IN
POP B ;GET BACK THE COUNTER
XTHL ;GET THE STACK RIGHT
UPOS6 INR B ;CHECK FOR EMPTY STACK
DCR B
JZ UPOS1 ;SURE IS, SO LOOP FOR ANOTHER TOKEN
DCX H ;GET ONE OFF STACK
DCR B
MOV A,M
INX H
INR B
CPI 3BH
JZ UP10
DCX H
DCR B
CPI 34H ;IS IT ARRAY?
JZ UPOSP ;YUP
CPI 36H ;IS IT FN?
JZ UPOSP ;YUP
DCX D ;MAKE ROOM ON STRING
STAX D ;STUFF IT IN
CPI 40H ;CHECK FOR FUNCTION
JP UPOS6 ;LOOP FOR ANOTHER ONE OFF STACK
CPI 20H ;IS IT "("?
JZ UPOS6 ;YUP
CPI 1DH ;CHECK FOR UNARYS
JZ UPOS6
CPI 1EH
JZ UPOS6
JMP UPOS1 ;OK, WE GOT ONE
UPOS2 POP H ;GET BACK STACK TO NORMAL
XCHG ;TO HL
UPOS7 PUSH H ;SAVE STRING ADDRESS
CALL PRIT ;PRINT THIS TOKEN
POP H
MOV A,M ;GET INCREMENT FOR THIS TOKEN
CALL GTIN
DAD D ;ADD IT
MOV A,M ;GET NEXT BYTE
CPI 9 ;IS IT THE END FLAG?
JNZ UPOS7 ;NOPE
RET ;DONE.
LOTB DB ','+80H
DB ';'+80H
DB '='+80H
* RTN. D.41
* PRINT INTERNAL FORM
* HL = ADDRESS OF TOKEN TO PRINT
PRIT MOV A,M ;GET A BYTE
CPI 34H ;IS IT AN ARRAY OPERATOR?
RZ ;YUP
CPI 36H ;IS IT A FUNCTION OPERATOR?
RZ ;YUP
CPI 0A0H ;CHECK FOR NORMAL STATEMENT
JC PRIT8 ;NOPE
LXI H,NOTBL ;ADDRESS OF NORMAL STATEMENT TABLE
SUI 0A0H ;SUBTRACT OFFSET
JMP PRITP ;DUMP IT OUT
PRIT8 CPI 80H ;CHECK FOR AN ODDBALL STATEMENT
JC PRIT7 ;NOPE
LXI H,ODTBL ;ADDRESS OF ODDBALL STATEMENT TABLE
SUI 80H ;SUBTRACT OFFSET
CPI 8 ;CHECK FOR ON..GOSUB
JNZ PRITP ;NOPE
XRA A ;YUP
PRITP CALL PRIT2 ;DUMP IT
LXI H,DRAT ;SEND A SPACE OUT
CALL LNOT
RET
PRIT7 CPI 40H ;CHECK FOR AN INTRINSIC FUNCTION
JC PRIT1 ;NOPE
LXI H,FUNT ;ADDRESS OF FUNCTION TABLE
SUI 40H ;DUMP IT OUT
JMP PRIT2
PRIT1 CPI 2FH ;CHECK FOR AN INTERMEDIARY
JC PRIT3 ;NOPE
LXI H,INTBL ;ADDRESS OF INTERMEDIARY TABLE
SUI 2FH ;SUBTRACT OFFSET
JMP PRIT2
PRIT3 CPI 10H ;CHECK FOR NORMAL OPERATOR
JC PRIT4 ;NOPE
CPI 10H ;CHECK FOR WORD OPERATORS
JZ PRITW
CPI 11H
JZ PRITW
CPI 12H
JZ PRITW
CPI 1EH
JZ PRITW
LXI H,OTBL ;OPERATOR TABLE ADDRESS
SUI 10H ;SUBTRACT OFFSET
JMP PRIT2
PRIT4 CPI 0DH ;CHECK FOR LOW OPERATORS
JC PRIT5 ;NOPE
LXI H,LOTB ;LOW OPERATORS TABLE ADDRESS
SUI 0DH ;SUBTRACT OFFSET
JMP PRIT2 ;DO IT
PRIT5 ANA A ;IS IT A STRING START?
JNZ PRIT6 ;NOPE
INX H ;GET FIRST CHARACTER
PUSH H ;SAVE ADDRESS
LXI H,DRAT1 ;QUOTE MESSAGE
CALL LNOT ;SEND IT OUT
POP H ;GET BACK THE ADDRESS
CALL LNOT ;SEND IT OUT
LXI H,DRAT1 ;ANOTHER QUOT
JMP PRITZ ;DO IT
PRITW PUSH PSW
LXI H,DRAT
CALL LNOT ;SEND A SPACE
LXI H,OTBL
POP PSW
SUI 10H ;SUBTRACT OFFSET
CALL PRIT2 ;SEND IT
LXI H,DRAT ;SEND ANOTHER SPACE
CALL LNOT
RET ;DONE
PRIT6 CPI 4 ;IS IT A NUMBER?
JNZ PRIT9 ;NOPE
XCHG ;SET UP INDEXES
LDA RURD ;SEE IF READY TO RUN
ANA A
JZ P0000 ;NOPE
LHLD PNTR ;YUP
JMP P0001
P0000 LHLD SLIN
P0001 XCHG
PUSH D ;SAVE ADDRESS FOR NUMBER
INX H
CALL NMST ;CONVERT INTO A STRING
XCHG ;LAST ADDRESS TO HL
DCX H ;SET UPPER BIT
MOV A,M
ORI 80H
MOV M,A
POP H ;GET ADDRESS BACK
JMP PRITZ ;DO IT
PRIT9 INX H ;GET NAME NUMBER
MOV C,M
INX H
MOV B,M
PUSH B ;SAVE IT
LHLD STAB ;START OF SYMBOL TABLE
PRITB DCX B ;CHECK COUNT
MOV A,B
ORA C
JZ PRITA ;FOUND IT
CALL COUNT ;COUNT CHARACTERS
DAD D ;ADD TO INDEX
JMP PRITB ;LOOP TO TRY AGAIN
PRITA MOV A,M ;GET FIRST CHARACTER
ANA A ;SEE IF IT IS ZERO
JNZ PRITC ;NOPE
INX H ;CORRECT
PRITC CALL LNOT ;DUMP IT
POP B ;RESTORE SYMBOL NUMBER
CALL DFND ;GET ID BYTE
RET ;DONE
DRAT DB 0A0H
PRIT2 MOV C,A ;COUNT TO C
PRITE DCR C ;CHECK FOR C=0
JM PRITZ ;YUP
CALL COUNT ;COUNT CHARACTERS
DAD D
JMP PRITE ;LOOP AGAIN
PRITZ CALL LNOT ;DUMP IT
RET
* RTN. D.42
* FIND END OF EXPRESSION AND DUMP IT
* IN: HL = ADDRESS OF FIRST BYTE OF SOURCE EXPRESSION
* OUT: HL = ADDRESS AFTER EXPRESSION
FEND MOV A,M ;GET A BYTE
CALL GTIN ;GET THE INCREMENT
DAD D ;ADD TO HL
MOV A,M ;GET NEXT BYTE
CPI 9 ;IS IT END OF EXPRESSION??
JNZ FEND ;NOPE
PUSH H ;SAVE THE ADDRESS
CALL UPOS ;DUMP THE EXPRESSION
POP H ;RECOVER ADDRESS
INX H ;GET NEXT BYTE
RET ;DONE..
* RTN. D.43
* DUMP NAME
DMNM PUSH H ;SAVE ADDRESS
CALL PRIT ;DUMP IT
POP H ;GET ADDRESS BACK
MOV A,M ;GET THE BYTE
CALL GTIN ;GET THE INCREMENT
DAD D ;ADD IT
XCHG ;TO DE
LHLD ESRC ;CHECK FOR OVERRUN
CALL CMP16
XCHG ;BACK TO HL
RZ ;SURE IS
MOV A,M ;GET NEXT BYTE
CPI 8 ;CHECK FOR OFFSET
RNZ ;NOPE
INX H ;YUP
PUSH H ;SAVE IT
LXI H,DMNMM ;PLUS MESSAGE
CALL LNOT ;SEND IT
POP H ;RESTORE HL
JMP FEND ;PROCESS IT
* RTN. D.44
* DUMP STATEMENT
* IN: HL = ADDRESS OF FIRST BYTE OF STATEMENT
LOOKAH MOV A,M ;GET A BYTE
CPI 9FH ;IS IT A TAB,COLON, OR BACKSLASH?
RNC ;CAN'T BE
CPI 9CH
RC ;NOPE
INX H ;TRY AGAIN
JMP LOOKAH
DMST MOV A,M ;GET A BYTE
CPI 9FH ;IS IT A STATEMENT NAME???
JZ DMST1 ;YUP
CPI 9BH ;IS IT AN ELSE?
JZ DMELS ;YUP
CPI 9CH ;IS IT A TAB?
JZ DMSTAB ;YUP
PUSH H ;SAVE IT AGAIN
CALL PRIT ;PRINT THE STATEMENT NAME
POP H ;RECOVER ADDRESS
MOV A,M ;GET A BYTE AGAIN
CPI 0A0H ;IS IT A NORMAL STATEMENT
JP DMST2 ;YUP
SUI 80H ;SUBTRACT OFFSET
ADD A ;MULTIPLY BY TWO
XCHG ;HL TO DE
LXI H,DUJM ;JUMP TABLE
CALL ADHL ;ADD A TO HL
MOV C,M ;GET ADDRESS OUT
INX H
MOV B,M
XCHG ;DE BACK TO HL
INX H ;NEXT TOKEN
PUSH B ;ADDRESS TO THE STACK
RET ;JUMP TO PROCESSOR
DMELS PUSH H ;SAVE IT
LXI H,DMELSE ;DUMP THE MESSAGE
CALL LNOT
POP H ;RESTORE
INX H
JMP DMST
DMST1 INX H ;GET NEXT BYTE
CALL DMNM ;DUMP THE NAME
PUSH H ;SAVE HL
LXI H,WWWWW ;SPACE MESSAGE
CALL LNOT ;SEND IT
POP H ;RESTORE HL
JMP DMST ;DUMP THE REST OF THE STATEMENT
DMSTAB PUSH H
LXI H,DMSTBMS ;SEND THE TAB OUT
CALL LNOT
POP H
INX H
JMP DMST
DMSTBMS DB 89H
WWWWW DB 0A0H ;SPACE MESSAGE
DMST2 INX H ;GET NEXT BYTE
MOV A,M ;CHECK FOR EXPRESSION FOLLOWING
CPI 9
JNZ DMST5 ;NOPE
DMST3 CALL FEND ;DUMP THE EXPRESSION
DMST5 XCHG ;SWAP
LHLD ESRC
CALL CMP16 ;CHECK FOR OVERRUN
XCHG
JZ DMST6
MOV A,M
CPI 35H ;IS IT A REMARKS INDICATOR?
JNZ DMST6 ;NOPE
PUSH H ;SAVE ADDRESS
LXI H,DMSG1 ;SEND A QUOTE OUT
CALL LNOT ;GONE
POP H ;GET ADDRESS BACK
DMSTC INX H ;GET FIRST BYTE OF REMARKS
INX H
DMSTD CALL LNOT ;SEND THEM OUT
INX H ;GET NEXT BYTE ADDRESS
DMST6 SHLD FLST ;SAVE THE NEXT ADDRESS OF STATEMENT
MOV A,M ;CHECK FOR A COLON BYTE
CPI 9EH
JZ DMS00 ;SURE WAS
CPI 9DH ;CHECK FOR BACKSLASH
JZ DMS65 ;SURE WAS
CALL LOOKAH ;GET NEXT SIGNIFICANT STATEMENT
MOV A,M ;IS IT AN "ELSE"?
CPI 9BH
LHLD FLST ;SET UP TO CONTINUE IF IT IS
JZ DMST ;SURE IS
LXI H,DMSG2 ;SEND A CARRIAGE RETURN
CALL LNOT ;SEND IT
RET ;DONE
DMS00 LXI H,COLON ;SEND A COLON OUT
CALL LNOT
LHLD FLST ;GET ADDRESS BACK
INX H ;GET ADDRESS OF FOLLOWING STATEMENT
JMP DMST ;DUMP IT OUT, TOO.
DMSG9 DB ','+80H
DMSG1 DB 20H ;QUOTES MESSAGE
DB 0A7H
DMSG2 DB 08DH ;CARRIAGE RETURN MESSAGE
DUJM DW DMST4 ;TABLE OF JUMPS FOR SPECIAL STATEMENTS
DW DMST7
DW DMST9
DW DMST8
DW DMST8
DW DMSTA
DW DMSTC
DW DMST5
DW DMSTT
DW DMST8
DMST4 CALL FEND ;DUMP EXPRESSION
PUSH H ;SAVE ADDRESS
LXI H,DMSG3 ;"GOTO" MESSAGE
DMSTU CALL LNOT ;SEND IT
POP H ;RECOVER ADDRESS
CALL DNLS ;SEND THE LIST OF LINE DESCRIPTORS
JMP DMST5 ;CHECK FOR REMARKS FOLLOWING
DMST7 CALL DMNM ;PROCESS NAME
MOV A,M ;CHECK FOR EXPRESSION FOLLOWING
CPI 9
JNZ DMST5 ;NONE
PUSH H ;SAVE ADDRESS
LXI H,DMSG9 ;COMMA
CALL LNOT ;SEND IT
POP H ;RECOVER ADDRESS
JMP DMST3 ;DUMP THE EXPRESSION
JMP DMST3 ;GET FOLLOWING EXPRESSION
DMST8 CALL DMNM ;PROCESS NAME
JMP DMST5 ;CHECK FOR REMARKS
DMST9 CALL FEND ;PROCESS EXPRESSION
PUSH H ;SAVE ADDRESS
LXI H,DMSG4 ;DUMP A "TO"
CALL LNOT ;THERE YOU GO
POP H ;RECOVER ADDRESS
CALL FEND ;GET NEXT EXPRESSION
MOV A,M ;GET NEXT BYTE
CPI 9 ;CHECK FOR ANOTHER EXPRESSION
JNZ DMST5 ;NOPE, SO LOOK FOR REMARKS
PUSH H ;SAVE ADDRESS
LXI H,DMSG5 ;DUMP A "STEP"
CALL LNOT ;DUMP IT DUMMY
POP H ;RECOVER ADDRESS
JMP DMST3 ;DUMP THE LAST EXPRESSION AND QUIT
DMSTA CALL FEND ;DUMP EXPRESSION
DMSTB PUSH H ;SAVE ADDRESS
LXI H,DMSG6 ;DUMP A "THEN"
CALL LNOT ;SEND IT
POP H ;GET BACK THE ADDRESS
CALL DMST ;PROCESS AS ANOTHER COMPLETE STATEMEN
RET ;DONE
DMELSE DB ' ELSE',' '+80H
DMSG3 DB ' GOTO',0A0H
DMSG4 DB ' TO',0A0H
DMSG5 DB ' STEP',0A0H
DMSG6 DB ' THEN',0A0H
* RTN. D.45
* DUMP NAME LIST
DNLS CALL DMNM ;DUMP A NAME
MOV A,M ;GET A BYTE
CPI 6 ;IS IT A NAME?
JZ DNLS1 ;YUP
RET ;NOPE
DNLS1 PUSH H ;SAVE HL
LXI H,LOTB ;COMMA MESSAGE
CALL LNOT ;SEND IT
POP H ;GET HL BACK
JMP DNLS ;DUMP THE NEXT ONE
* RTN. D.46
* FIND LINE IN SOURCE, WITH OFFSET
* IN: BC = SYMBOL NUMBER
* DE = OFFSET (+- 32K)
LILO PUSH D ;SAVE OFFSET
PUSH B ;SAVE 'EM
LDA RUNF ;ARE WE RUNNING?
ANA A
JNZ LILO7 ;YUP
CALL ASDA ;ASSIGN ALL STATEMENT NAMES
LILO7 POP B ;GET 'EM BACK
CALL DFND ;GET THE POINTER
XCHG
LHLD ESRC
INX H
CALL CMP16
JC LILOG ;TOO BIG
LHLD FSRC
DCX H
CALL CMP16
JNC LILOG ;TOO SMALL
XCHG
SHLD LINE
MOV A,M ;CHECK FOR A STATEMENT
CPI 9FH
MVI B,7 ;ERROR CODE JUST IN CASE
JNZ ERROR
POP B ;GET OFFSET TO BC
INR B ;CHECK FOR NEGATIVE
DCR B
JP LILO1 ;NOPE
INX B ;YUP, SO DECREASE BY ONE
LILO1 MOV A,B ;CHECK FOR BC=0
ORA C
RZ ;SURE WAS
CALL LILO3 ;MOVE UP OR BACK ONE STATEMENT
PUSH D ;SAVE D
XCHG
LHLD ESRC
CALL CMP16
JZ LIL82 ;ERROR
LHLD SLIN
CALL CMP16
JZ LIL82
XCHG
POP D
LILO2 INR B ;SET FLAGS FOR B
DCR B
JM LILO4 ;WE'S GOIN' BACKWARDS
DCX B ;ANOTHER ONE DOWN THE DRAIN
JMP LILO1 ;SEE IF WE'RE DONE YET
LILO4 INX B ;THE BACKWARDS MOVE
JMP LILO1 ;CHECK FOR DONENESS
LILO3 PUSH B ;SAVE THE OFFSET COUNT
INR B ;SET FLAGS FOR B
DCR B
JM LILO5 ;TIME FOR A BACKSTROKE
LILOF MOV A,M ;GET A BYTE
PUSH PSW ;SAVE IT
CALL MFOS ;MOVE FORWARD ONE STATEMENT
POP PSW ;GET BYTE BACK
CPI 9FH ;IS IT A NAME?
JZ LILOF ;YUP
CPI 85H ;IS IT AN IF?
JZ LILOF ;YUP
CPI 9CH ;IS IT A TAB
JZ LILOF ;YUP!
MOV A,M ;CHECK FOR COLON BYTE
CPI 9EH
JZ LIL00 ;SURE WAS
CPI 9BH ;IS IT AN ELSE?
JZ LIL00 ;YUP
CPI 9DH
JZ LIL00
LILO6 POP B ;GET BACK THE OFFSET COUNT
RET ;DONE
LILO5 CALL LILOBAK ;MOVE BACK
CALL LILOBAK ;MOVE BACK AGAIN
MOV A,M ;GET A BYTE
PUSH PSW ;SAVE IT
CALL MFOS ;MOVE UP
POP PSW ;GET BYTE BACK
CPI 9FH ;IS IT A STATEMENT NAME?
JZ LILO5 ;YUP
CPI 85H ;IS IT AN IF?
JZ LILO5
CPI 9EH ;CHECK FOR COLON BYTE
JZ LIL01 ;SURE WAS
CPI 9BH ;IS IT AN ELSE?
JZ LIL01 ;YUP
CPI 9DH
JZ LIL01
CPI 9CH ;IS IT A TAB?
JZ LILO5 ;YUP
JMP LILO6 ;NOPE
LILOG MVI B,7 ;ILLEGAL STATEMENT
JMP ERROR
LIL00 INX H ;GET NEXT ADDRESS
SHLD LINE ;MAKE IT NEXT
JMP LILOF ;CONTINUE
LIL01 CALL LILOBAK ;BACK UP, JACK
JMP LILO5
LILOBAK CALL MBOS ;BACK UP
MOV A,M ;CHECK FOR TAB
CPI 9CH
JZ LILOBAK ;SURE IS, SO BACK UP AGAIN
RET ;DON
DMNMM DB ' &',0A0H
DMS65 LXI H,DMS66 ;SEND BACKSLASH/CARRIAGE RETURN
JMP DMS00+3 ;SEND IT OUT
DMS66 DB 5CH ;BACKSLASH
DB 8DH ;CARRIAGE RETURN
LIL82 MVI B,7
JMP ERROR
DMSTT CALL FEND ;DUMP EXPRESSION
PUSH H ;SAVE ADDRESS
LXI H,DMGOS ;GOSUB MESSAGE
JMP DMSTU ;FINISH IT UP
DMGOS DB ' GOSUB',0A0H
* RTN. D.47
* GET LINE AND OFFSET FOR COMMANDS
GLFC CALL USCN ;GET NEXT TOKEN
RC ;THERE AIN'T NONE, BOSS
LHLD TSCN ;GET ADDRESS OF TOKEN
CALL SSRC ;SEE IF IT'S IN THE TABLE
PUSH B ;SAVE THE SYMBOL NUMBER
MVI B,7 ;ERROR CODE JUST IN CASE
JNZ ERROR ;NOT EVEN LISTED!
ANI 3FH ;STRIP OFF UPPER TWO BITS
CPI 1 ;MAKE SURE IT'S A STATEMENT
JNZ ERROR ;NOT A STATEMENT!!!!!!!
CALL USCN ;SCAN OFF THE NEXT TOKEN
JNC GLFC1 ;NOT THE END YET
GLFC4 LXI D,0 ;CLEAR DE
GLFC2 XRA A ;CLEAR CARRY
POP B ;GET BACK SYMBOL NUMBER
RET ;DONE.....
GLFC1 LHLD TSCN ;ADDRESS OF TOKEN
MOV A,M ;GET THE TOKEN
CPI '+'+80H ;IS IT A PLUS SIGN?
JZ GLFC5 ;YUP
CPI '-'+80H ;IS IT A MINUS SIGN?
JNZ GLFC3 ;NOPE
GLFC5 PUSH PSW ;SAVE IT
CALL USCN ;SCAN OFF YET ANOTHER TOKEN.
MVI B,10H ;ERROR CODE JUST IN CASE
JC ERROR ;RAN INTO THE END, BUMP.
CALL LGNM ;CONVERT TO A NUMBER
MVI B,10H ;ERROR CODE IN CASE A STONE IS ENTERING
JC ERROR ;HE WAS
LXI H,TMP10 ;ADDRESS OF NUMBER
CALL BCDB ;CONVERT NUMBER TO BINARY
POP PSW ;GET THE TOKEN BACK
XCHG ;HL TO DE
CPI '-'+80H ;WAS IT A MINUS SIGN
JNZ GLFC2 ;NOPE
MOV A,D ;YES, SO 1'S COMPLEMENT TIME
CMA
MOV D,A
MOV A,E
CMA
MOV E,A
INX D ;CORRECT FOR 2'S COMPLEMENT
JMP GLFC2 ;CONTINUE TOWARDS LEAVING
GLFC3 CALL BSCN ;OOPS, BACK UP
JMP GLFC4 ;EXIT WITHOUT ANY OFFSET
* RTN. D.48
* LIST COMMAND INTERPRETER
LIST LHLD FSRC ;GET FIRST ADDRESS OF SOURC
SHLD FLST ;MAKE THIS THE FIRST ADDRESS TO LIST
LHLD ESRC ;GET LAST ADDRESS OF SOURCE
LDA CSST ;SET CATV APPROPRIATELY
STA CATV
SHLD LLST ;MAKE THIS THE LAST ADDRESS TO LIST
CALL GLFC ;GET LINE
JC LIST1 ;THIS PARAMETER NOT INPUTTED
CALL LILO ;FIND THE ADDRESS
SHLD FLST ;CHANGE THE FIRST ADDRESS TO LIST
CALL GLFC ;GET LINE
JC LIST1 ;THIS PARAMETER NOT INPUTTED
CALL LILO ;FIND THE ADDRESS
SHLD LINE ;MOVE UP ONE MORE
LISTK MOV A,M ;GET A BYTE
PUSH PSW ;SAVE IT
CALL MFOS ;MOVE UP ONE
POP PSW ;CHECK FOR NAMES AND IFS
CPI 85H
JZ LISTK
CPI 9FH
JZ LISTK
CPI 9EH
JZ LISTK
CPI 9DH
JZ LISTK
CPI 9CH
JZ LISTK
CPI 9BH
JZ LISTK
SHLD LLST ;CHANGE THE LAST ADDRESS TO LIST
LIST1 XRA A ;GET FIRST ADDRESS TO DE
LIS33 LHLD FLST
XCHG
LHLD LLST ;GET LAST ADDRESS
CALL CMP16 ;CHECK RELATIVE SIZE
JZ LISTW ;DONE
JC SPRAT ;REVERSED PARAMETERS
LIST2 XCHG ;PUT 'EM BACK
CALL DMST ;DUMP THE STATEMENT OUT
CALL CONT ;CHECK FOR CONTROL C
JZ RSTRT ;IT WAS PUSHED
JMP LIS33 ;GET THE NEXT ONE
LISTW LDA CSST
ANA A
JZ RSTRT
LXI H,DMSG2
CALL LNOT
XRA A
STA CSST
STA CATV
STC
INR A ;CLEAR ZERO FLAG
CALL COUT
JMP RSTRT
* RTN. D.49
* ENTER COMMAND INTERPRETER
ENTR LHLD ESRC ;GET END OF SOURCE
XRA A ;CLEAR RUN READY FLAG
STA RURD
SHLD INSR ;SET INSERTION POINT THERE
CALL GLFC ;CHECK FOR A PARAMETER
MVI A,0 ;SET ENTER MODE
STA CMND
JC RSTRT ;NONE
CALL LILO ;GET THE ADDRESS
SHLD INSR ;SET INSERTION POINT THERE
JMP RSTRT ;BACK TO THE MAINSTREAM
* RTN. D.50
* DELETE COMMAND INTERPRETER
DLTE CALL GLFC ;CHECK FOR A PARAMETER
PUSH B ;SAVE BC
MVI B,10H ;ERROR CODE JUST IN CASE
JC ERROR ;NO PARAMETERS ENTERED
POP B ;RECOVER BC
CALL LILO ;GET ADDRESS
SHLD FLST ;SET UP FLAGS
SHLD LLST
CALL GLFC ;CHECK FOR SECOND PARAMETER
JC DLTE1 ;NOPE
CALL LILO ;GET ADDRESS
SHLD LLST ;SAVE IT
DLTE1 MOV A,M ;GET A BYTE
PUSH PSW ;SAVE IT
CALL MFOS ;MOVE FORWARD ONE
POP PSW ;RESTORE PSW
CPI 9FH ;CHECK FOR A STATEMENT NAME
JZ DLTE1 ;NOPW
CPI 85H ;CHECK FOR IF
JZ DLTE1 ;YUP
CPI 9CH ;IS IT A TAB?
JZ DLTE1 ;SURE IS
MOV A,M ;CHECK FOR COLON OR BACKSLASH
CPI 9EH
JZ DLTE4 ;SURE WAS
CPI 9BH ;IS IT AN ELSE?
JZ DLTE4 ;YUP
CPI 9DH
JNZ DLTE2 ;NOPE
DLTE4 CALL MFOS ;MOVE UP TWO
JMP DLTE1 ;TRY AGAIN
DLTE2 XCHG ;HL TO DE
LHLD ESRC ;END OF SOURCE
CALL SUB16 ;GET THE DIFFERENCE
MOV A,H ;CHECK FOR NONE TO MOVE
ORA L
JZ DLTE3 ;MUST BE LAST STATEMENT DELETED
MOV C,L
MOV B,H
LHLD FLST ;GET FIRST ADDRESS TO KILL
XCHG ;SWAP
CALL MOVE ;MOVE 'EM DOWN
XCHG ;FLST TO HL
DAD B ;ADD N
SHLD ESRC ;NEW END OF SOURCE
* RTN. D.51
* CLEAR COMMAND PROCESSOR
CLER XRA A ;CLEAR RURD (RUN READY FLAG)
STA RURD
LDA EDITM
ANA A ;ARE WE IN EDIT MODE?
JZ RSTRT ;NOPE
LXI SP,STACK+100
PUSH H ;SET UP FOR BACK TO EDIT
JMP PSSF ;MOVE FORWARD ONE STATEMENT
DLTE3 LHLD FLST ;NEW END
SHLD ESRC
JMP CLER
* RTN. D.52
* RUN COMMAND PROCESSOR
PRUN LHLD ESRC ;MAKE SURE THERE IS A PROGRAM
XCHG
LHLD FSRC
CALL CMP16
JZ RSTRT ;NONE LOADED
CALL CHCKA ;CHECK BASIC'S INTEGRITY.
CALL GLFC ;LOOK FOR A SPECIFIC LINE
LHLD FSRC ;PRESET DATA FLAGS
SHLD DATAP
LXI H,0
SHLD DATAT
SHLD DATAW
LHLD SDIR ;INITIALIZE ARRAY SPACE
SHLD FARY
LHLD FRAV ;INITIALIZE PNTR
SHLD PNTR
SHLD NPNTR
LHLD FSRC ;GET START OF SOURCE IN CASE THERE IS NO
* SPECIFIED LINE
JC PRUN2 ;TWERE'NT NONE
CALL LILO ;FIND THE ADDRESS
PRUN2 LDA RURD ;GET RUN READY FLAG
ANA A ;IS IT SET?
JNZ RUN ;ALREADY SET
PUSH H ;SAVE START ADDRESS
CALL ASDA ;ASSIGN STATEMENT ADDRESSES
CALL AVAP ;ASSIGN ARRAY POINTER AND VARIABLE SPACE
MVI A,0FFH ;SET RUN READY
STA RURD
LHLD FRAV ;INITIALIZE PNTR
SHLD PNTR
POP H ;GET BACK ADDRESS
JMP RUN ;SO GO RUN ALREADY
* RTN. D.53
* CONT COMMAND INTERPRETER
PCNT LDA RURD ;RUN READY?
ANA A ;FIND OUT
JZ PCNT1 ;NOPE
LHLD LINEA ;GET CURRENT LINE ADDRESS
XCHG ;SEE IF WE ARE DONE
LHLD ESRC
XCHG
CALL CMP16
JZ PCNT1 ;YUP
JMP RUN ;GO RUN IT
PCNT1 MVI B,22H ;ERROR
JMP ERROR
* RTN. D.54
* NEW COMMAND PROCESSOR
PNEW CALL PNEW1 ;INITIALIZE ALL THIS CRAP
JMP RSTRT ;DONE
PNEW1 LXI H,1 ;GET A 16 BIT ONE
SHLD SNUM ;NUMBER OF SYMBOLS IS ONE
LHLD MEND ;END OF MEMORY
SHLD STAB ;IS EQUAL TO THE START OF SYMBOLS
MVI M,80H ;AND SET THE END IN
DCX H ;GET MEND-3
MVI M,0
DCX H
MVI M,0
DCX H
MVI M,0
SHLD SDIR ;START OF DIRECTORY
XRA A ;CLEAR A
STA RURD ;CLEAR THE RUN READY FLAG
LHLD EBSC ;GET END BASIC FLAG
SHLD FSRC ;STORE SOURCE FLAGS
SHLD ESRC
SHLD FRAV ;INITIALIZE FRAV
LXI H,C2767 ;INITIALIZE SEED
LXI D,SEED
LXI B,6
CALL MOVE
CALL CHCKA ;CHECK ON THE INTERPRETER'S INTEGRITY
INERT RET ;DONE....
* RTN. D.55
* CLOAD STATEMENT PROCESSOR
PCLD CALL PNEW1 ;MAKE ROOM FOR A NEW PROGRAM
PCLD1 LXI H,PCLDM ;CADD ENTRANCE
CALL MSGER ;SEND NOTIFIER
XRA A ;SEND START MOTORS
CALL CAIN
CALL USCN ;SCAN OFF NEXT TOKEN
MVI B,10H ;ERROR CODE JUST IN CASE
JC ERROR ;NO INPUT, DUMMY
PCLD2 LHLD ESRC ;GET ADDRESS TO INPUT TO
CALL LICA ;INPUT A LINE FROM THE CASSETTE
LHLD ESRC ;GET ADDRESS AGAIN
MOV A,M ;GET THE BYTE
CPI 1 ;WAS IT NAME INDICATOR?
JNZ PCLD2 ;NOPE
INX H ;GET NEXT ADDRESS
XCHG ;HL TO DE
LHLD TSCN ;GET CHARACTER
MOV A,M
ORI 80H ;INSERT STROBE
XCHG ;DE TO HL
CMP M ;ARE THEY THE SAME ?
JNZ PCLD2 ;NOPE
MVI A,0FFH ;SET CSST AND ENTER MODE
STA CSST
XRA A
STA CMND
LHLD ESRC ;SET UP INSERTION POINT
SHLD INSR
JMP RSTRT ;INPUT 'EM
LINK4 LINK B:TBASICA5