Skip to content

Instantly share code, notes, and snippets.

@maly

maly/alpha-basic-1000.lst

Created September 11, 2020 11:29
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save maly/813858080d3fed142f2554af392ae964 to your computer and use it in GitHub Desktop.
Save maly/813858080d3fed142f2554af392ae964 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
alpha-basic-1000.lst
0000 ;*************************************************************
0000 ;
0000 ; TINY BASIC FOR INTEL 8080
0000 ; VERSION 2.0
0000 ; BY LI-CHEN WANG
0000 ; MODIFIED AND TRANSLATED
0000 ; TO INTEL MNEMONICS
0000 ; BY ROGER RAUSKOLB
0000 ; 10 OCTOBER,1976
0000 ; @COPYLEFT
0000 ; ALL WRONGS RESERVED
0000 ;
0000 ;*************************************************************
0000 ;
0000 ; *** ZERO PAGE SUBROUTINES ***
0000 ;
0000 ; THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
0000 ; MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
0000 ; THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
0000 ; THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL
0000 ; USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR
0000 ; THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
0000 ; TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
0000 ; SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
0000 ;
0000 ;
0000 .ENGINE alpha
0000 .macro DWA,
0000 ;
0000 DB >%%1 + 128
0000 DB <%%1
0000 .endm
0000
0000 ;
1000 .ORG 1000H
1000 31 FF FF START: LXI SP,STACK ;*** COLD START ***
1003 3E FF MVI A,0FFH
1005 C3 FD 16 JMP INIT
1008 ;
1008 ;
1008 3E 0D CRLF: MVI A,CR ;*** CRLF ***
100A ;
100A RST2:
100A OUTC:
100A F5 PUSH PSW ;*** OUTC OR RST 2 ***
100B 3A 03 80 LDA OCSW ;PRINT CHARACTER ONLY
100E B7 ORA A ;IF OCSW SWITCH IS ON
100F C3 27 17 JMP OC2 ;REST OF THIS IS AT OC2
1012 ;
1012 RST3:
1012 EXPR:
1012 CD D2 13 CALL EXPR2 ;*** EXPR OR RST 3 ***
1015 E5 PUSH H ;EVALUATE AN EXPRESSION
1016 C3 8E 13 JMP EXPR1 ;REST OF IT AT EXPR1
1019 57 DB "W"
101A ;
101A RST4:
101A COMP:
101A 7C MOV A,H ;*** COMP OR RST 4 ***
101B BA CMP D ;COMPARE HL WITH DE
101C C0 RNZ ;RETURN CORRECT C AND
101D 7D MOV A,L ;Z FLAGS
101E BB CMP E ;BUT OLD A IS LOST
101F C9 RET
1020 41 4E DB "AN"
1022 ;
1022 RST5:
1022 IGNBLK:
1022 1A SS1: LDAX D ;*** IGNBLK/RST 5 ***
1023 FE 20 CPI 20H ;IGNORE BLANKS
1025 C0 RNZ ;IN TEXT (WHERE DE->)
1026 13 INX D ;AND RETURN THE FIRST
1027 C3 22 10 JMP SS1 ;NON-BLANK CHAR. IN A
102A ;
102A RST6:
102A FINISH:
102A F1 POP PSW ;*** FINISH/RST 6 ***
102B CD 4A 15 CALL FIN ;CHECK END OF COMMAND
102E C3 63 15 JMP QWHAT ;PRINT "WHAT?" IF WRONG
1031 47 DB "G"
1032 ;
1032 RST7:
1032 TSTV:
1032 CD 22 10 CALL IGNBLK ;*** TSTV OR RST 7 ***
1035 D6 40 SUI 40H ;TEST VARIABLES
1037 D8 RC ;C:NOT A VARIABLE
1038 C2 56 10 JNZ TV1 ;NOT "@" ARRAY
103B 13 INX D ;IT IS THE "@" ARRAY
103C CD 89 14 CALL PARN ;@ SHOULD BE FOLLOWED
103F 29 DAD H ;BY (EXPR) AS ITS INDEX
1040 DA A4 10 JC QHOW ;IS INDEX TOO BIG?
1043 D5 PUSH D ;WILL IT OVERWRITE
1044 EB XCHG ;TEXT?
1045 CD E8 14 CALL SIZE ;FIND SIZE OF FREE
1048 CD 1A 10 CALL COMP ;AND CHECK THAT
104B DA 93 15 JC ASORRY ;IF SO, SAY "SORRY"
104E 21 00 FC LXI H,VARBGN ;IF NOT GET ADDRESS
1051 CD 0B 15 CALL SUBDE ;OF @(EXPR) AND PUT IT
1054 D1 POP D ;IN HL
1055 C9 RET ;C FLAG IS CLEARED
1056 FE 1B TV1: CPI 1BH ;NOT @, IS IT A TO Z?
1058 3F CMC ;IF NOT RETURN C FLAG
1059 D8 RC
105A 13 INX D ;IF A THROUGH Z
105B 21 00 FC LXI H,VARBGN ;COMPUTE ADDRESS OF
105E 07 RLC ;THAT VARIABLE
105F 85 ADD L ;AND RETURN IT IN HL
1060 6F MOV L,A ;WITH C FLAG CLEARED
1061 3E 00 MVI A,0
1063 8C ADC H
1064 67 MOV H,A
1065 C9 RET
1066 ;
1066 RST1:
1066 TSTC:
1066 E3 XTHL ;*** TSTC OR RST 1 ***
1067 CD 22 10 CALL IGNBLK ;IGNORE BLANKS AND
106A BE CMP M ;TEST CHARACTER
106B 23 TC1: INX H ;COMPARE THE BYTE THAT
106C CA 76 10 JZ TC2 ;FOLLOWS THE RST INST.
106F C5 PUSH B ;WITH THE TEXT (DE->)
1070 4E MOV C,M ;IF NOT =, ADD THE 2ND
1071 06 00 MVI B,0 ;BYTE THAT FOLLOWS THE
1073 09 DAD B ;RST TO THE OLD PC
1074 C1 POP B ;I.E., DO A RELATIVE
1075 1B DCX D ;JUMP IF NOT =
1076 13 TC2: INX D ;IF =, SKIP THOSE BYTES
1077 23 INX H ;AND CONTINUE
1078 E3 XTHL
1079 C9 RET
107A ;
107A 21 00 00 TSTNUM: LXI H,0 ;*** TSTNUM ***
107D 44 MOV B,H ;TEST IF THE TEXT IS
107E CD 22 10 CALL IGNBLK ;A NUMBER
1081 FE 30 TN1: CPI 30H ;IF NOT, RETURN 0 IN
1083 D8 RC ;B AND HL
1084 FE 3A CPI 3AH ;IF NUMBERS, CONVERT
1086 D0 RNC ;TO BINARY IN HL AND
1087 3E F0 MVI A,0F0H ;SET B TO # OF DIGITS
1089 A4 ANA H ;IF H>255, THERE IS NO
108A C2 A4 10 JNZ QHOW ;ROOM FOR NEXT DIGIT
108D 04 INR B ;B COUNTS # OF DIGITS
108E C5 PUSH B
108F 44 MOV B,H ;HL=10*HL+(NEW DIGIT)
1090 4D MOV C,L
1091 29 DAD H ;WHERE 10* IS DONE BY
1092 29 DAD H ;SHIFT AND ADD
1093 09 DAD B
1094 29 DAD H
1095 1A LDAX D ;AND (DIGIT) IS FROM
1096 13 INX D ;STRIPPING THE ASCII
1097 E6 0F ANI 0FH ;CODE
1099 85 ADD L
109A 6F MOV L,A
109B 3E 00 MVI A,0
109D 8C ADC H
109E 67 MOV H,A
109F C1 POP B
10A0 1A LDAX D ;DO THIS DIGIT AFTER
10A1 F2 81 10 JP TN1 ;DIGIT. S SAYS OVERFLOW
10A4 D5 QHOW: PUSH D ;*** ERROR "HOW?" ***
10A5 11 AB 10 AHOW: LXI D,HOW
10A8 C3 67 15 JMP ERROR
10AB 48 4F 57 3F HOW: DB "HOW?"
10AF 0D DB CR
10B0 4F 4B OK: DB "OK"
10B2 0D DB CR
10B3 57 48 41 54 3F WHAT: DB "WHAT?"
10B8 0D DB CR
10B9 53 4F 52 52 59 SORRY: DB "SORRY"
10BE 0D DB CR
10BF ;
10BF ;*************************************************************
10BF ;
10BF ; *** MAIN ***
10BF ;
10BF ; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
10BF ; AND STORES IT IN THE MEMORY.
10BF ;
10BF ; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
10BF ; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
10BF ; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
10BF ; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
10BF ; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
10BF ; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
10BF ; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
10BF ; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
10BF ; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
10BF ;
10BF ; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
10BF ; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
10BF ; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
10BF ; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
10BF ;
10BF ; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
10BF ; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
10BF ; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
10BF ; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
10BF ;
10BF ; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
10BF ; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
10BF ; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
10BF ; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
10BF ;
10BF 31 FF FF RSTART: LXI SP,STACK
10C2 CD 08 10 ST1: CALL CRLF ;AND JUMP TO HERE
10C5 11 B0 10 LXI D,OK ;DE->STRING
10C8 97 SUB A ;A=0
10C9 CD 07 16 CALL PRTSTG ;PRINT STRING UNTIL CR
10CC 21 D3 10 LXI H,ST2+1 ;LITERAL 0
10CF 22 04 80 SHLD CURRNT ;CURRENT->LINE # = 0
10D2 21 00 00 ST2: LXI H,0
10D5 22 0C 80 SHLD LOPVAR
10D8 22 06 80 SHLD STKGOS
10DB 3E 3E ST3: MVI A,3EH ;PROMPT ">" AND
10DD CD 99 15 CALL GETLN ;READ A LINE
10E0 D5 PUSH D ;DE->END OF LINE
10E1 11 37 FC LXI D,BUFFER ;DE->BEGINNING OF LINE
10E4 CD 7A 10 CALL TSTNUM ;TEST IF IT IS A NUMBER
10E7 CD 22 10 CALL IGNBLK
10EA 7C MOV A,H ;HL=VALUE OF THE # OR
10EB B5 ORA L ;0 IF NO # WAS FOUND
10EC C1 POP B ;BC->END OF LINE
10ED CA 05 18 JZ DIRECT
10F0 1B DCX D ;BACKUP DE AND SAVE
10F1 7C MOV A,H ;VALUE OF LINE # THERE
10F2 12 STAX D
10F3 1B DCX D
10F4 7D MOV A,L
10F5 12 STAX D
10F6 C5 PUSH B ;BC,DE->BEGIN, END
10F7 D5 PUSH D
10F8 79 MOV A,C
10F9 93 SUB E
10FA F5 PUSH PSW ;A=# OF BYTES IN LINE
10FB CD DD 15 CALL FNDLN ;FIND THIS LINE IN SAVE
10FE D5 PUSH D ;AREA, DE->SAVE AREA
10FF C2 12 11 JNZ ST4 ;NZ:NOT FOUND, INSERT
1102 D5 PUSH D ;Z:FOUND, DELETE IT
1103 CD FB 15 CALL FNDNXT ;FIND NEXT LINE
1106 ;DE->NEXT LINE
1106 C1 POP B ;BC->LINE TO BE DELETED
1107 2A 18 80 LHLD TXTUNF ;HL->UNFILLED SAVE AREA
110A CD 9E 16 CALL MVUP ;MOVE UP TO DELETE
110D 60 MOV H,B ;TXTUNF->UNFILLED AREA
110E 69 MOV L,C
110F 22 18 80 SHLD TXTUNF ;UPDATE
1112 C1 ST4: POP B ;GET READY TO INSERT
1113 2A 18 80 LHLD TXTUNF ;BUT FIRST CHECK IF
1116 F1 POP PSW ;THE LENGTH OF NEW LINE
1117 E5 PUSH H ;IS 3 (LINE # AND CR)
1118 FE 03 CPI 3 ;THEN DO NOT INSERT
111A CA BF 10 JZ RSTART ;MUST CLEAR THE STACK
111D 85 ADD L ;COMPUTE NEW TXTUNF
111E 6F MOV L,A
111F 3E 00 MVI A,0
1121 8C ADC H
1122 67 MOV H,A ;HL->NEW UNFILLED AREA
1123 11 00 FC LXI D,TXTEND ;CHECK TO SEE IF THERE
1126 CD 1A 10 CALL COMP ;IS ENOUGH SPACE
1129 D2 92 15 JNC QSORRY ;SORRY, NO ROOM FOR IT
112C 22 18 80 SHLD TXTUNF ;OK, UPDATE TXTUNF
112F D1 POP D ;DE->OLD UNFILLED AREA
1130 CD A9 16 CALL MVDOWN
1133 D1 POP D ;DE->BEGIN, HL->END
1134 E1 POP H
1135 CD 9E 16 CALL MVUP ;MOVE NEW LINE TO SAVE
1138 C3 DB 10 JMP ST3 ;AREA
113B ;
113B ;*************************************************************
113B ;
113B ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
113B ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
113B ; COMMAND TABLE LOOKUP CODE OF "DIRECT" AND "EXEC" IN LAST
113B ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
113B ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
113B ;
113B ; FOR "LIST", "NEW", AND "STOP": GO BACK TO "RSTART"
113B ; FOR "RUN": GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
113B ; GO BACK TO "RSTART".
113B ; FOR "GOTO" AND "GOSUB": GO EXECUTE THE TARGET LINE.
113B ; FOR "RETURN" AND "NEXT": GO BACK TO SAVED RETURN LINE.
113B ; FOR ALL OTHERS: IF "CURRENT" -> 0, GO TO "RSTART", ELSE
113B ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN "FINISH".)
113B ;*************************************************************
113B ;
113B ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
113B ;
113B ; "NEW(CR)" SETS "TXTUNF" TO POINT TO "TXTBGN"
113B ;
113B ; "STOP(CR)" GOES BACK TO "RSTART"
113B ;
113B ; "RUN(CR)" FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
113B ; "CURRENT"), AND START EXECUTE IT. NOTE THAT ONLY THOSE
113B ; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
113B ;
113B ; THERE ARE 3 MORE ENTRIES IN "RUN":
113B ; "RUNNXL" FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
113B ; "RUNTSL" STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
113B ; "RUNSML" CONTINUES THE EXECUTION ON SAME LINE.
113B ;
113B ; "GOTO EXPR(CR)" EVALUATES THE EXPRESSION, FIND THE TARGET
113B ; LINE, AND JUMP TO "RUNTSL" TO DO IT.
113B ;
113B CD 5D 15 NEW: CALL ENDCHK ;*** NEW(CR) ***
113E 21 1A 80 LXI H,TXTBGN
1141 22 18 80 SHLD TXTUNF
1144 ;
1144 CD 5D 15 STOP: CALL ENDCHK ;*** STOP(CR) ***
1147 C3 BF 10 JMP RSTART
114A ;
114A C3 00 00 BYE: JMP 0
114D ;
114D CD 5D 15 RUN: CALL ENDCHK ;*** RUN(CR) ***
1150 11 1A 80 LXI D,TXTBGN ;FIRST SAVED LINE
1153 ;
1153 21 00 00 RUNNXL: LXI H,0 ;*** RUNNXL ***
1156 CD E5 15 CALL FNDLP ;FIND WHATEVER LINE #
1159 DA BF 10 JC RSTART ;C:PASSED TXTUNF, QUIT
115C ;
115C EB RUNTSL: XCHG ;*** RUNTSL ***
115D 22 04 80 SHLD CURRNT ;SET "CURRENT"->LINE #
1160 EB XCHG
1161 13 INX D ;BUMP PASS LINE #
1162 13 INX D
1163 ;
1163 CD 41 17 RUNSML: CALL CHKIO ;*** RUNSML ***
1166 21 7F 17 LXI H,TAB2-1 ;FIND COMMAND IN TAB2
1169 C3 08 18 JMP EXEC ;AND EXECUTE IT
116C ;
116C CD 12 10 GOTO: CALL EXPR ;*** GOTO EXPR ***
116F D5 PUSH D ;SAVE FOR ERROR ROUTINE
1170 CD 5D 15 CALL ENDCHK ;MUST FIND A CR
1173 CD DD 15 CALL FNDLN ;FIND THE TARGET LINE
1176 C2 A5 10 JNZ AHOW ;NO SUCH LINE #
1179 F1 POP PSW ;CLEAR THE PUSH DE
117A C3 5C 11 JMP RUNTSL ;GO DO IT
117D ;
117D ;
117D OUTP:
117D CD 12 10 CALL EXPR
1180 7D MOV a,l
1181 32 01 80 STA inram+1
1184 3E D3 MVI a,0xd3
1186 32 00 80 STA inram
1189 3E C9 MVI a,0xc9
118B 32 02 80 STA inram+2
118E ;
118E CD 66 10 CALL tstc
1191 2C DB ","
1192 0A DB op2-$-1
1193 ;
1193 CD 12 10 CALL EXPR
1196 7D MOV a,l
1197 ;
1197 CD 00 80 CALL inram
119A C3 63 11 JMP runsml
119D C3 A5 10 OP2: JMP ahow
11A0 ;
11A0 ;*************************************************************
11A0 ;
11A0 ; *** LIST *** & PRINT ***
11A0 ;
11A0 ; LIST HAS TWO FORMS:
11A0 ; "LIST(CR)" LISTS ALL SAVED LINES
11A0 ; "LIST #(CR)" START LIST AT THIS LINE #
11A0 ; YOU CAN STOP THE LISTING BY CONTROL C KEY
11A0 ;
11A0 ; PRINT COMMAND IS "PRINT ....;" OR "PRINT ....(CR)"
11A0 ; WHERE "...." IS A LIST OF EXPRESIONS, FORMATS, BACK-
11A0 ; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
11A0 ;
11A0 ; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
11A0 ; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
11A0 ; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
11A0 ; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
11A0 ; SPECIFIED, 6 POSITIONS WILL BE USED.
11A0 ;
11A0 ; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
11A0 ; DOUBLE QUOTES.
11A0 ;
11A0 ; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
11A0 ;
11A0 ; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
11A0 ; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
11A0 ; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
11A0 ;
11A0 CD 7A 10 LIST: CALL TSTNUM ;TEST IF THERE IS A #
11A3 CD 5D 15 CALL ENDCHK ;IF NO # WE GET A 0
11A6 CD DD 15 CALL FNDLN ;FIND THIS OR NEXT LINE
11A9 DA BF 10 LS1: JC RSTART ;C:PASSED TXTUNF
11AC CD 89 16 CALL PRTLN ;PRINT THE LINE
11AF CD 41 17 CALL CHKIO ;STOP IF HIT CONTROL-C
11B2 CD E5 15 CALL FNDLP ;FIND NEXT LINE
11B5 C3 A9 11 JMP LS1 ;AND LOOP BACK
11B8 ;
11B8 0E 06 PRINT: MVI C,6 ;C = # OF SPACES
11BA CD 66 10 CALL TSTC ;IF NULL LIST & ";"
11BD 3B DB 3BH
11BE 06 DB PR2-$-1
11BF CD 08 10 CALL CRLF ;GIVE CR-LF AND
11C2 C3 63 11 JMP RUNSML ;CONTINUE SAME LINE
11C5 CD 66 10 PR2: CALL TSTC ;IF NULL LIST (CR)
11C8 0D DB CR
11C9 06 DB PR0-$-1
11CA CD 08 10 CALL CRLF ;ALSO GIVE CR-LF AND
11CD C3 53 11 JMP RUNNXL ;GO TO NEXT LINE
11D0 CD 66 10 PR0: CALL TSTC ;ELSE IS IT FORMAT?
11D3 23 DB "#"
11D4 07 DB PR1-$-1
11D5 CD 12 10 CALL EXPR ;YES, EVALUATE EXPR.
11D8 4D MOV C,L ;AND SAVE IT IN C
11D9 C3 E2 11 JMP PR3 ;LOOK FOR MORE TO PRINT
11DC CD 15 16 PR1: CALL QTSTG ;OR IS IT A STRING?
11DF C3 F3 11 JMP PR8 ;IF NOT, MUST BE EXPR.
11E2 CD 66 10 PR3: CALL TSTC ;IF ",", GO FIND NEXT
11E5 2C DB ","
11E6 06 DB PR6-$-1
11E7 CD 4A 15 CALL FIN ;IN THE LIST.
11EA C3 D0 11 JMP PR0 ;LIST CONTINUES
11ED CD 08 10 PR6: CALL CRLF ;LIST ENDS
11F0 CD 2A 10 CALL FINISH
11F3 CD 12 10 PR8: CALL EXPR ;EVALUATE THE EXPR
11F6 C5 PUSH B
11F7 CD 45 16 CALL PRTNUM ;PRINT THE VALUE
11FA C1 POP B
11FB C3 E2 11 JMP PR3 ;MORE TO PRINT?
11FE ;
11FE ;*************************************************************
11FE ;
11FE ; *** GOSUB *** & RETURN ***
11FE ;
11FE ; "GOSUB EXPR;" OR "GOSUB EXPR (CR)" IS LIKE THE "GOTO"
11FE ; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
11FE ; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
11FE ; SUBROUTINE "RETURN". IN ORDER THAT "GOSUB" CAN BE NESTED
11FE ; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
11FE ; THE STACK POINTER IS SAVED IN "STKGOS", THE OLD "STKGOS" IS
11FE ; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, "STKGOS"
11FE ; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
11FE ; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER "RETURN"S.
11FE ;
11FE ; "RETURN(CR)" UNDOS EVERYTHING THAT "GOSUB" DID, AND THUS
11FE ; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
11FE ; "GOSUB". IF "STKGOS" IS ZERO, IT INDICATES THAT WE
11FE ; NEVER HAD A "GOSUB" AND IS THUS AN ERROR.
11FE ;
11FE CD D4 16 GOSUB: CALL PUSHA ;SAVE THE CURRENT "FOR"
1201 CD 12 10 CALL EXPR ;PARAMETERS
1204 D5 PUSH D ;AND TEXT POINTER
1205 CD DD 15 CALL FNDLN ;FIND THE TARGET LINE
1208 C2 A5 10 JNZ AHOW ;NOT THERE. SAY "HOW?"
120B 2A 04 80 LHLD CURRNT ;FOUND IT, SAVE OLD
120E E5 PUSH H ;"CURRNT" OLD "STKGOS"
120F 2A 06 80 LHLD STKGOS
1212 E5 PUSH H
1213 21 00 00 LXI H,0 ;AND LOAD NEW ONES
1216 22 0C 80 SHLD LOPVAR
1219 39 DAD SP
121A 22 06 80 SHLD STKGOS
121D C3 5C 11 JMP RUNTSL ;THEN RUN THAT LINE
1220 CD 5D 15 RETURN: CALL ENDCHK ;THERE MUST BE A CR
1223 2A 06 80 LHLD STKGOS ;OLD STACK POINTER
1226 7C MOV A,H ;0 MEANS NOT EXIST
1227 B5 ORA L
1228 CA 63 15 JZ QWHAT ;SO, WE SAY: "WHAT?"
122B F9 SPHL ;ELSE, RESTORE IT
122C E1 POP H
122D 22 06 80 SHLD STKGOS ;AND THE OLD "STKGOS"
1230 E1 POP H
1231 22 04 80 SHLD CURRNT ;AND THE OLD "CURRNT"
1234 D1 POP D ;OLD TEXT POINTER
1235 CD B8 16 CALL POPA ;OLD "FOR" PARAMETERS
1238 CD 2A 10 CALL FINISH ;AND WE ARE BACK HOME
123B ;
123B ;*************************************************************
123B ;
123B ; *** FOR *** & NEXT ***
123B ;
123B ; "FOR" HAS TWO FORMS:
123B ; "FOR VAR=EXP1 TO EXP2 STEP EXP3" AND "FOR VAR=EXP1 TO EXP2"
123B ; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
123B ; EXP3=1. (I.E., WITH A STEP OF +1.)
123B ; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
123B ; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
123B ; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
123B ; THE "FOR" SAVE AREA, WHICH CONSISTS OF "LOPVAR", "LOPINC",
123B ; "LOPLMT", "LOPLN", AND "LOPPT". IF THERE IS ALREADY SOME-
123B ; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
123B ; "LOPVAR"), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
123B ; BEFORE THE NEW ONE OVERWRITES IT.
123B ; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
123B ; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE "FOR" LOOP.
123B ; IF THAT IS THE CASE, THEN THE OLD "FOR" LOOP IS DEACTIVATED.
123B ; (PURGED FROM THE STACK..)
123B ;
123B ; "NEXT VAR" SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
123B ; END OF THE "FOR" LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
123B ; WITH THE "LOPVAR". IF THEY ARE NOT THE SAME, TBI DIGS IN
123B ; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
123B ; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE "STEP" TO
123B ; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
123B ; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
123B ; FOLLOWING THE "FOR". IF OUTSIDE THE LIMIT, THE SAVE AREA
123B ; IS PURGED AND EXECUTION CONTINUES.
123B ;
123B CD D4 16 FOR: CALL PUSHA ;SAVE THE OLD SAVE AREA
123E CD 31 15 CALL SETVAL ;SET THE CONTROL VAR.
1241 2B DCX H ;HL IS ITS ADDRESS
1242 22 0C 80 SHLD LOPVAR ;SAVE THAT
1245 21 E0 17 LXI H,TAB5-1 ;USE "EXEC" TO LOOK
1248 C3 08 18 JMP EXEC ;FOR THE WORD "TO"
124B CD 12 10 FR1: CALL EXPR ;EVALUATE THE LIMIT
124E 22 10 80 SHLD LOPLMT ;SAVE THAT
1251 21 E6 17 LXI H,TAB6-1 ;USE "EXEC" TO LOOK
1254 C3 08 18 JMP EXEC ;FOR THE WORD "STEP"
1257 CD 12 10 FR2: CALL EXPR ;FOUND IT, GET STEP
125A C3 60 12 JMP FR4
125D 21 01 00 FR3: LXI H,1H ;NOT FOUND, SET TO 1
1260 22 0E 80 FR4: SHLD LOPINC ;SAVE THAT TOO
1263 2A 04 80 FR5: LHLD CURRNT ;SAVE CURRENT LINE #
1266 22 12 80 SHLD LOPLN
1269 EB XCHG ;AND TEXT POINTER
126A 22 14 80 SHLD LOPPT
126D 01 0A 00 LXI B,0AH ;DIG INTO STACK TO
1270 2A 0C 80 LHLD LOPVAR ;FIND "LOPVAR"
1273 EB XCHG
1274 60 MOV H,B
1275 68 MOV L,B ;HL=0 NOW
1276 39 DAD SP ;HERE IS THE STACK
1277 3E DB 3EH
1278 09 FR7: DAD B ;EACH LEVEL IS 10 DEEP
1279 7E MOV A,M ;GET THAT OLD "LOPVAR"
127A 23 INX H
127B B6 ORA M
127C CA 99 12 JZ FR8 ;0 SAYS NO MORE IN IT
127F 7E MOV A,M
1280 2B DCX H
1281 BA CMP D ;SAME AS THIS ONE?
1282 C2 78 12 JNZ FR7
1285 7E MOV A,M ;THE OTHER HALF?
1286 BB CMP E
1287 C2 78 12 JNZ FR7
128A EB XCHG ;YES, FOUND ONE
128B 21 00 00 LXI H,0H
128E 39 DAD SP ;TRY TO MOVE SP
128F 44 MOV B,H
1290 4D MOV C,L
1291 21 0A 00 LXI H,0AH
1294 19 DAD D
1295 CD A9 16 CALL MVDOWN ;AND PURGE 10 WORDS
1298 F9 SPHL ;IN THE STACK
1299 2A 14 80 FR8: LHLD LOPPT ;JOB DONE, RESTORE DE
129C EB XCHG
129D CD 2A 10 CALL FINISH ;AND CONTINUE
12A0 ;
12A0 CD 32 10 NEXT: CALL TSTV ;GET ADDRESS OF VAR.
12A3 DA 63 15 JC QWHAT ;NO VARIABLE, "WHAT?"
12A6 22 08 80 SHLD VARNXT ;YES, SAVE IT
12A9 D5 NX0: PUSH D ;SAVE TEXT POINTER
12AA EB XCHG
12AB 2A 0C 80 LHLD LOPVAR ;GET VAR. IN "FOR"
12AE 7C MOV A,H
12AF B5 ORA L ;0 SAYS NEVER HAD ONE
12B0 CA 64 15 JZ AWHAT ;SO WE ASK: "WHAT?"
12B3 CD 1A 10 CALL COMP ;ELSE WE CHECK THEM
12B6 CA C3 12 JZ NX3 ;OK, THEY AGREE
12B9 D1 POP D ;NO, LET'S SEE
12BA CD B8 16 CALL POPA ;PURGE CURRENT LOOP
12BD 2A 08 80 LHLD VARNXT ;AND POP ONE LEVEL
12C0 C3 A9 12 JMP NX0 ;GO CHECK AGAIN
12C3 5E NX3: MOV E,M ;COME HERE WHEN AGREED
12C4 23 INX H
12C5 56 MOV D,M ;DE=VALUE OF VAR.
12C6 2A 0E 80 LHLD LOPINC
12C9 E5 PUSH H
12CA 7C MOV A,H
12CB AA XRA D
12CC 7A MOV A,D
12CD 19 DAD D ;ADD ONE STEP
12CE FA D5 12 JM NX4
12D1 AC XRA H
12D2 FA F9 12 JM NX5
12D5 EB NX4: XCHG
12D6 2A 0C 80 LHLD LOPVAR ;PUT IT BACK
12D9 73 MOV M,E
12DA 23 INX H
12DB 72 MOV M,D
12DC 2A 10 80 LHLD LOPLMT ;HL->LIMIT
12DF F1 POP PSW ;OLD HL
12E0 B7 ORA A
12E1 F2 E5 12 JP NX1 ;STEP > 0
12E4 EB XCHG ;STEP < 0
12E5 CD 27 15 NX1: CALL CKHLDE ;COMPARE WITH LIMIT
12E8 D1 POP D ;RESTORE TEXT POINTER
12E9 DA FB 12 JC NX2 ;OUTSIDE LIMIT
12EC 2A 12 80 LHLD LOPLN ;WITHIN LIMIT, GO
12EF 22 04 80 SHLD CURRNT ;BACK TO THE SAVED
12F2 2A 14 80 LHLD LOPPT ;"CURRNT" AND TEXT
12F5 EB XCHG ;POINTER
12F6 CD 2A 10 CALL FINISH
12F9 E1 NX5: POP H
12FA D1 POP D
12FB CD B8 16 NX2: CALL POPA ;PURGE THIS LOOP
12FE CD 2A 10 CALL FINISH
1301 ;
1301 ;*************************************************************
1301 ;
1301 ; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
1301 ;
1301 ; "REM" CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
1301 ; TBI TREATS IT LIKE AN "IF" WITH A FALSE CONDITION.
1301 ;
1301 ; "IF" IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
1301 ; COMMANDS (INCLUDING OTHER "IF"S) SEPERATED BY SEMI-COLONS.
1301 ; NOTE THAT THE WORD "THEN" IS NOT USED. TBI EVALUATES THE
1301 ; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
1301 ; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
1301 ; EXECUTION CONTINUES AT THE NEXT LINE.
1301 ;
1301 ; "INPUT" COMMAND IS LIKE THE "PRINT" COMMAND, AND IS FOLLOWED
1301 ; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
1301 ; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
1301 ; IN "PRINT". IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
1301 ; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
1301 ; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
1301 ; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
1301 ; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
1301 ; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
1301 ; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
1301 ;
1301 ; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
1301 ; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
1301 ; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
1301 ; THIS IS HANDLED IN "INPERR".
1301 ;
1301 ; "LET" IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
1301 ; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
1301 ; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
1301 ; TBI WILL ALSO HANDLE "LET" COMMAND WITHOUT THE WORD "LET".
1301 ; THIS IS DONE BY "DEFLT".
1301 ;
1301 21 00 00 REM: LXI H,0H ;*** REM ***
1304 3E DB 3EH ;THIS IS LIKE "IF 0"
1305 ;
1305 CD 12 10 IFF: CALL EXPR ;*** IF ***
1308 7C MOV A,H ;IS THE EXPR.=0?
1309 B5 ORA L
130A C2 63 11 JNZ RUNSML ;NO, CONTINUE
130D CD FD 15 CALL FNDSKP ;YES, SKIP REST OF LINE
1310 D2 5C 11 JNC RUNTSL ;AND RUN THE NEXT LINE
1313 C3 BF 10 JMP RSTART ;IF NO NEXT, RE-START
1316 ;
1316 2A 0A 80 INPERR: LHLD STKINP ;*** INPERR ***
1319 F9 SPHL ;RESTORE OLD SP
131A E1 POP H ;AND OLD "CURRNT"
131B 22 04 80 SHLD CURRNT
131E D1 POP D ;AND OLD TEXT POINTER
131F D1 POP D ;REDO INPUT
1320 ;
1320 INPUT: ;*** INPUT ***
1320 D5 IP1: PUSH D ;SAVE IN CASE OF ERROR
1321 CD 15 16 CALL QTSTG ;IS NEXT ITEM A STRING?
1324 C3 30 13 JMP IP2 ;NO
1327 CD 32 10 CALL TSTV ;YES, BUT FOLLOWED BY A
132A DA 6E 13 JC IP4 ;VARIABLE? NO.
132D C3 42 13 JMP IP3 ;YES. INPUT VARIABLE
1330 D5 IP2: PUSH D ;SAVE FOR "PRTSTG"
1331 CD 32 10 CALL TSTV ;MUST BE VARIABLE NOW
1334 DA 63 15 JC QWHAT ;"WHAT?" IT IS NOT?
1337 1A LDAX D ;GET READY FOR "PRTSTR"
1338 4F MOV C,A
1339 97 SUB A
133A 12 STAX D
133B D1 POP D
133C CD 07 16 CALL PRTSTG ;PRINT STRING AS PROMPT
133F 79 MOV A,C ;RESTORE TEXT
1340 1B DCX D
1341 12 STAX D
1342 D5 IP3: PUSH D ;SAVE TEXT POINTER
1343 EB XCHG
1344 2A 04 80 LHLD CURRNT ;ALSO SAVE "CURRNT"
1347 E5 PUSH H
1348 21 20 13 LXI H,IP1 ;A NEGATIVE NUMBER
134B 22 04 80 SHLD CURRNT ;AS A FLAG
134E 21 00 00 LXI H,0H ;SAVE SP TOO
1351 39 DAD SP
1352 22 0A 80 SHLD STKINP
1355 D5 PUSH D ;OLD HL
1356 3E 3A MVI A,3AH ;PRINT THIS TOO
1358 CD 99 15 CALL GETLN ;AND GET A LINE
135B 11 37 FC LXI D,BUFFER ;POINTS TO BUFFER
135E CD 12 10 CALL EXPR ;EVALUATE INPUT
1361 00 NOP ;CAN BE "CALL ENDCHK"
1362 00 NOP
1363 00 NOP
1364 D1 POP D ;OK, GET OLD HL
1365 EB XCHG
1366 73 MOV M,E ;SAVE VALUE IN VAR.
1367 23 INX H
1368 72 MOV M,D
1369 E1 POP H ;GET OLD "CURRNT"
136A 22 04 80 SHLD CURRNT
136D D1 POP D ;AND OLD TEXT POINTER
136E F1 IP4: POP PSW ;PURGE JUNK IN STACK
136F CD 66 10 CALL TSTC ;IS NEXT CH. ","?
1372 2C DB ","
1373 03 DB IP5-$-1
1374 C3 20 13 JMP IP1 ;YES, MORE ITEMS.
1377 CD 2A 10 IP5: CALL FINISH
137A ;
137A 1A DEFLT: LDAX D ;*** DEFLT ***
137B FE 0D CPI CR ;EMPTY LINE IS OK
137D CA 8B 13 JZ LT1 ;ELSE IT IS "LET"
1380 ;
1380 CD 31 15 LET: CALL SETVAL ;*** LET ***
1383 CD 66 10 CALL TSTC ;SET VALUE TO VAR.
1386 2C DB ","
1387 03 DB LT1-$-1
1388 C3 80 13 JMP LET ;ITEM BY ITEM
138B CD 2A 10 LT1: CALL FINISH ;UNTIL FINISH
138E ;
138E ;*************************************************************
138E ;
138E ; *** EXPR ***
138E ;
138E ; "EXPR" EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
138E ; <EXPR>::<EXPR2>
138E ; <EXPR2><REL.OP.><EXPR2>
138E ; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
138E ; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
138E ; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
138E ; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
138E ; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
138E ; <EXPR4>::=<VARIABLE>
138E ; <FUNCTION>
138E ; (<EXPR>)
138E ; <EXPR> IS RECURSIVE SO THAT VARIABLE "@" CAN HAVE AN <EXPR>
138E ; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
138E ; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
138E ;
138E ;EXPR: CALL EXPR2 ;THIS IS AT LOC. 18
138E ; PUSH H ;SAVE <EXPR2> VALUE
138E 21 EE 17 EXPR1: LXI H,TAB8-1 ;LOOKUP REL.OP.
1391 C3 08 18 JMP EXEC ;GO DO IT
1394 CD BD 13 XP11: CALL XP18 ;REL.OP.">="
1397 D8 RC ;NO, RETURN HL=0
1398 6F MOV L,A ;YES, RETURN HL=1
1399 C9 RET
139A CD BD 13 XP12: CALL XP18 ;REL.OP."#"
139D C8 RZ ;FALSE, RETURN HL=0
139E 6F MOV L,A ;TRUE, RETURN HL=1
139F C9 RET
13A0 CD BD 13 XP13: CALL XP18 ;REL.OP.">"
13A3 C8 RZ ;FALSE
13A4 D8 RC ;ALSO FALSE, HL=0
13A5 6F MOV L,A ;TRUE, HL=1
13A6 C9 RET
13A7 CD BD 13 XP14: CALL XP18 ;REL.OP."<="
13AA 6F MOV L,A ;SET HL=1
13AB C8 RZ ;REL. TRUE, RETURN
13AC D8 RC
13AD 6C MOV L,H ;ELSE SET HL=0
13AE C9 RET
13AF CD BD 13 XP15: CALL XP18 ;REL.OP."="
13B2 C0 RNZ ;FALSE, RETURN HL=0
13B3 6F MOV L,A ;ELSE SET HL=1
13B4 C9 RET
13B5 CD BD 13 XP16: CALL XP18 ;REL.OP."<"
13B8 D0 RNC ;FALSE, RETURN HL=0
13B9 6F MOV L,A ;ELSE SET HL=1
13BA C9 RET
13BB E1 XP17: POP H ;NOT .REL.OP
13BC C9 RET ;RETURN HL=<EXPR2>
13BD 79 XP18: MOV A,C ;SUBROUTINE FOR ALL
13BE E1 POP H ;REL.OP.'S
13BF C1 POP B
13C0 E5 PUSH H ;REVERSE TOP OF STACK
13C1 C5 PUSH B
13C2 4F MOV C,A
13C3 CD D2 13 CALL EXPR2 ;GET 2ND <EXPR2>
13C6 EB XCHG ;VALUE IN DE NOW
13C7 E3 XTHL ;1ST <EXPR2> IN HL
13C8 CD 27 15 CALL CKHLDE ;COMPARE 1ST WITH 2ND
13CB D1 POP D ;RESTORE TEXT POINTER
13CC 21 00 00 LXI H,0H ;SET HL=0, A=1
13CF 3E 01 MVI A,1
13D1 C9 RET
13D2 ;
13D2 CD 66 10 EXPR2: CALL TSTC ;NEGATIVE SIGN?
13D5 2D DB "-"
13D6 06 DB XP21-$-1
13D7 21 00 00 LXI H,0H ;YES, FAKE "0-"
13DA C3 04 14 JMP XP26 ;TREAT LIKE SUBTRACT
13DD CD 66 10 XP21: CALL TSTC ;POSITIVE SIGN? IGNORE
13E0 2B DB "+"
13E1 00 DB XP22-$-1
13E2 CD 0E 14 XP22: CALL EXPR3 ;1ST <EXPR3>
13E5 CD 66 10 XP23: CALL TSTC ;ADD?
13E8 2B DB "+"
13E9 15 DB XP25-$-1
13EA E5 PUSH H ;YES, SAVE VALUE
13EB CD 0E 14 CALL EXPR3 ;GET 2ND <EXPR3>
13EE EB XP24: XCHG ;2ND IN DE
13EF E3 XTHL ;1ST IN HL
13F0 7C MOV A,H ;COMPARE SIGN
13F1 AA XRA D
13F2 7A MOV A,D
13F3 19 DAD D
13F4 D1 POP D ;RESTORE TEXT POINTER
13F5 FA E5 13 JM XP23 ;1ST AND 2ND SIGN DIFFER
13F8 AC XRA H ;1ST AND 2ND SIGN EQUAL
13F9 F2 E5 13 JP XP23 ;SO IS RESULT
13FC C3 A4 10 JMP QHOW ;ELSE WE HAVE OVERFLOW
13FF CD 66 10 XP25: CALL TSTC ;SUBTRACT?
1402 2D DB "-"
1403 92 DB XP42-$-1
1404 E5 XP26: PUSH H ;YES, SAVE 1ST <EXPR3>
1405 CD 0E 14 CALL EXPR3 ;GET 2ND <EXPR3>
1408 CD 15 15 CALL CHGSGN ;NEGATE
140B C3 EE 13 JMP XP24 ;AND ADD THEM
140E ;
140E CD 72 14 EXPR3: CALL EXPR4 ;GET 1ST <EXPR4>
1411 CD 66 10 XP31: CALL TSTC ;MULTIPLY?
1414 2A DB "*"
1415 2D DB XP34-$-1
1416 E5 PUSH H ;YES, SAVE 1ST
1417 CD 72 14 CALL EXPR4 ;AND GET 2ND <EXPR4>
141A 06 00 MVI B,0H ;CLEAR B FOR SIGN
141C CD 12 15 CALL CHKSGN ;CHECK SIGN
141F E3 XTHL ;1ST IN HL
1420 CD 12 15 CALL CHKSGN ;CHECK SIGN OF 1ST
1423 EB XCHG
1424 E3 XTHL
1425 7C MOV A,H ;IS HL > 255 ?
1426 B7 ORA A
1427 CA 30 14 JZ XP32 ;NO
142A 7A MOV A,D ;YES, HOW ABOUT DE
142B B2 ORA D
142C EB XCHG ;PUT SMALLER IN HL
142D C2 A5 10 JNZ AHOW ;ALSO >, WILL OVERFLOW
1430 7D XP32: MOV A,L ;THIS IS DUMB
1431 21 00 00 LXI H,0H ;CLEAR RESULT
1434 B7 ORA A ;ADD AND COUNT
1435 CA 64 14 JZ XP35
1438 19 XP33: DAD D
1439 DA A5 10 JC AHOW ;OVERFLOW
143C 3D DCR A
143D C2 38 14 JNZ XP33
1440 C3 64 14 JMP XP35 ;FINISHED
1443 CD 66 10 XP34: CALL TSTC ;DIVIDE?
1446 2F DB "/"
1447 4E DB XP42-$-1
1448 E5 PUSH H ;YES, SAVE 1ST <EXPR4>
1449 CD 72 14 CALL EXPR4 ;AND GET THE SECOND ONE
144C 06 00 MVI B,0H ;CLEAR B FOR SIGN
144E CD 12 15 CALL CHKSGN ;CHECK SIGN OF 2ND
1451 E3 XTHL ;GET 1ST IN HL
1452 CD 12 15 CALL CHKSGN ;CHECK SIGN OF 1ST
1455 EB XCHG
1456 E3 XTHL
1457 EB XCHG
1458 7A MOV A,D ;DIVIDE BY 0?
1459 B3 ORA E
145A CA A5 10 JZ AHOW ;SAY "HOW?"
145D C5 PUSH B ;ELSE SAVE SIGN
145E CD F5 14 CALL DIVIDE ;USE SUBROUTINE
1461 60 MOV H,B ;RESULT IN HL NOW
1462 69 MOV L,C
1463 C1 POP B ;GET SIGN BACK
1464 D1 XP35: POP D ;AND TEXT POINTER
1465 7C MOV A,H ;HL MUST BE +
1466 B7 ORA A
1467 FA A4 10 JM QHOW ;ELSE IT IS OVERFLOW
146A 78 MOV A,B
146B B7 ORA A
146C FC 15 15 CM CHGSGN ;CHANGE SIGN IF NEEDED
146F C3 11 14 JMP XP31 ;LOOK FOR MORE TERMS
1472 ;
1472 21 C9 17 EXPR4: LXI H,TAB4-1 ;FIND FUNCTION IN TAB4
1475 C3 08 18 JMP EXEC ;AND GO DO IT
1478 CD 32 10 XP40: CALL TSTV ;NO, NOT A FUNCTION
147B DA 83 14 JC XP41 ;NOR A VARIABLE
147E 7E MOV A,M ;VARIABLE
147F 23 INX H
1480 66 MOV H,M ;VALUE IN HL
1481 6F MOV L,A
1482 C9 RET
1483 CD 7A 10 XP41: CALL TSTNUM ;OR IS IT A NUMBER
1486 78 MOV A,B ;# OF DIGIT
1487 B7 ORA A
1488 C0 RNZ ;OK
1489 CD 66 10 PARN: CALL TSTC
148C 28 DB "("
148D 09 DB XP43-$-1
148E CD 12 10 CALL EXPR ;"(EXPR)"
1491 CD 66 10 CALL TSTC
1494 29 DB ")"
1495 01 DB XP43-$-1
1496 C9 XP42: RET
1497 C3 63 15 XP43: JMP QWHAT ;ELSE SAY: "WHAT?"
149A ;
149A CD 89 14 RND: CALL PARN ;*** RND(EXPR) ***
149D 7C MOV A,H ;EXPR MUST BE +
149E B7 ORA A
149F FA A4 10 JM QHOW
14A2 B5 ORA L ;AND NON-ZERO
14A3 CA A4 10 JZ QHOW
14A6 D5 PUSH D ;SAVE BOTH
14A7 E5 PUSH H
14A8 2A 16 80 LHLD RANPNT ;GET MEMORY AS RANDOM
14AB 11 38 18 LXI D,LSTROM ;NUMBER
14AE CD 1A 10 CALL COMP
14B1 DA B7 14 JC RA1 ;WRAP AROUND IF LAST
14B4 21 00 10 LXI H,START
14B7 5E RA1: MOV E,M
14B8 23 INX H
14B9 56 MOV D,M
14BA 22 16 80 SHLD RANPNT
14BD E1 POP H
14BE EB XCHG
14BF C5 PUSH B
14C0 CD F5 14 CALL DIVIDE ;RND(N)=MOD(M,N)+1
14C3 C1 POP B
14C4 D1 POP D
14C5 23 INX H
14C6 C9 RET
14C7 ;
14C7 CD 89 14 ABS: CALL PARN ;*** ABS(EXPR) ***
14CA 1B DCX D
14CB CD 12 15 CALL CHKSGN ;CHECK SIGN
14CE 13 INX D
14CF C9 RET
14D0 ;
14D0 ;
14D0 INFN:
14D0 CD 89 14 CALL PARN
14D3 7D MOV a,l
14D4 32 01 80 STA inram+1
14D7 3E DB MVI a,0xDB ;instruction IN
14D9 32 00 80 STA inram
14DC 3E C9 MVI a,0xc9 ;instruction RET
14DE 32 02 80 STA inram+2
14E1 CD 00 80 CALL inram
14E4 6F MOV l,a
14E5 26 00 MVI h,0
14E7 C9 RET
14E8 2A 18 80 SIZE: LHLD TXTUNF ;*** SIZE ***
14EB D5 PUSH D ;GET THE NUMBER OF FREE
14EC EB XCHG ;BYTES BETWEEN "TXTUNF"
14ED 21 00 FC LXI H,VARBGN ;AND "VARBGN"
14F0 CD 0B 15 CALL SUBDE
14F3 D1 POP D
14F4 C9 RET
14F5 ;
14F5 ;*************************************************************
14F5 ;
14F5 ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
14F5 ;
14F5 ; "DIVIDE" DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
14F5 ;
14F5 ; "SUBDE" SUBSTRACTS DE FROM HL
14F5 ;
14F5 ; "CHKSGN" CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
14F5 ; SIGN AND FLIP SIGN OF B.
14F5 ;
14F5 ; "CHGSGN" CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
14F5 ;
14F5 ; "CKHLDE" CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
14F5 ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
14F5 ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
14F5 ;
14F5 E5 DIVIDE: PUSH H ;*** DIVIDE ***
14F6 6C MOV L,H ;DIVIDE H BY DE
14F7 26 00 MVI H,0
14F9 CD 00 15 CALL DV1
14FC 41 MOV B,C ;SAVE RESULT IN B
14FD 7D MOV A,L ;(REMINDER+L)/DE
14FE E1 POP H
14FF 67 MOV H,A
1500 0E FF DV1: MVI C,0FFH ;RESULT IN C
1502 0C DV2: INR C ;DUMB ROUTINE
1503 CD 0B 15 CALL SUBDE ;DIVIDE BY SUBTRACT
1506 D2 02 15 JNC DV2 ;AND COUNT
1509 19 DAD D
150A C9 RET
150B ;
150B 7D SUBDE: MOV A,L ;*** SUBDE ***
150C 93 SUB E ;SUBSTRACT DE FROM
150D 6F MOV L,A ;HL
150E 7C MOV A,H
150F 9A SBB D
1510 67 MOV H,A
1511 C9 RET
1512 ;
1512 7C CHKSGN: MOV A,H ;*** CHKSGN ***
1513 B7 ORA A ;CHECK SIGN OF HL
1514 F0 RP ;IF -, CHANGE SIGN
1515 ;
1515 7C CHGSGN: MOV A,H ;*** CHGSGN ***
1516 F5 PUSH PSW
1517 2F CMA ;CHANGE SIGN OF HL
1518 67 MOV H,A
1519 7D MOV A,L
151A 2F CMA
151B 6F MOV L,A
151C 23 INX H
151D F1 POP PSW
151E AC XRA H
151F F2 A4 10 JP QHOW
1522 78 MOV A,B ;AND ALSO FLIP B
1523 EE 80 XRI 80H
1525 47 MOV B,A
1526 C9 RET
1527 ;
1527 7C CKHLDE: MOV A,H
1528 AA XRA D ;SAME SIGN?
1529 F2 2D 15 JP CK1 ;YES, COMPARE
152C EB XCHG ;NO, XCH AND COMP
152D CD 1A 10 CK1: CALL COMP
1530 C9 RET
1531 ;
1531 ;*************************************************************
1531 ;
1531 ; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
1531 ;
1531 ; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
1531 ; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
1531 ; TO THAT VALUE.
1531 ;
1531 ; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH "?,
1531 ; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
1531 ; NEXT LINE AND CONTINUE FROM THERE.
1531 ;
1531 ; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
1531 ; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
1531 ;
1531 ; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
1531 ; IT THEN PRINTS THE LINE POINTED BY "CURRNT" WITH A "?"
1531 ; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
1531 ; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
1531 ; AND TBI IS RESTARTED. HOWEVER, IF "CURRNT" -> ZERO
1531 ; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
1531 ; PRINTED. AND IF "CURRNT" -> NEGATIVE # (INDICATING "INPUT"
1531 ; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
1531 ; NOT TERMINATED BUT CONTINUED AT "INPERR".
1531 ;
1531 ; RELATED TO "ERROR" ARE THE FOLLOWING:
1531 ; "QWHAT" SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
1531 ; "AWHAT" JUST GET MESSAGE "WHAT?" AND JUMP TO "ERROR".
1531 ; "QSORRY" AND "ASORRY" DO SAME KIND OF THING.
1531 ; "AHOW" AND "AHOW" IN THE ZERO PAGE SECTION ALSO DO THIS.
1531 ;
1531 CD 32 10 SETVAL: CALL TSTV ;*** SETVAL ***
1534 DA 63 15 JC QWHAT ;"WHAT?" NO VARIABLE
1537 E5 PUSH H ;SAVE ADDRESS OF VAR.
1538 CD 66 10 CALL TSTC ;PASS "=" SIGN
153B 3D DB "="
153C 0A DB SV1-$-1
153D CD 12 10 CALL EXPR ;EVALUATE EXPR.
1540 44 MOV B,H ;VALUE IS IN BC NOW
1541 4D MOV C,L
1542 E1 POP H ;GET ADDRESS
1543 71 MOV M,C ;SAVE VALUE
1544 23 INX H
1545 70 MOV M,B
1546 C9 RET
1547 C3 63 15 SV1: JMP QWHAT ;NO "=" SIGN
154A ;
154A CD 66 10 FIN: CALL TSTC ;*** FIN ***
154D 3B DB 3BH
154E 04 DB FI1-$-1
154F F1 POP PSW ;";", PURGE RET. ADDR.
1550 C3 63 11 JMP RUNSML ;CONTINUE SAME LINE
1553 CD 66 10 FI1: CALL TSTC ;NOT ";", IS IT CR?
1556 0D DB CR
1557 04 DB FI2-$-1
1558 F1 POP PSW ;YES, PURGE RET. ADDR.
1559 C3 53 11 JMP RUNNXL ;RUN NEXT LINE
155C C9 FI2: RET ;ELSE RETURN TO CALLER
155D ;
155D CD 22 10 ENDCHK: CALL IGNBLK ;*** ENDCHK ***
1560 FE 0D CPI CR ;END WITH CR?
1562 C8 RZ ;OK, ELSE SAY: "WHAT?"
1563 ;
1563 D5 QWHAT: PUSH D ;*** QWHAT ***
1564 11 B3 10 AWHAT: LXI D,WHAT ;*** AWHAT ***
1567 97 ERROR: SUB A ;*** ERROR ***
1568 CD 07 16 CALL PRTSTG ;PRINT "WHAT?", "HOW?"
156B D1 POP D ;OR "SORRY"
156C 1A LDAX D ;SAVE THE CHARACTER
156D F5 PUSH PSW ;AT WHERE OLD DE ->
156E 97 SUB A ;AND PUT A 0 THERE
156F 12 STAX D
1570 2A 04 80 LHLD CURRNT ;GET CURRENT LINE #
1573 E5 PUSH H
1574 7E MOV A,M ;CHECK THE VALUE
1575 23 INX H
1576 B6 ORA M
1577 D1 POP D
1578 CA BF 10 JZ RSTART ;IF ZERO, JUST RESTART
157B 7E MOV A,M ;IF NEGATIVE,
157C B7 ORA A
157D FA 16 13 JM INPERR ;REDO INPUT
1580 CD 89 16 CALL PRTLN ;ELSE PRINT THE LINE
1583 1B DCX D ;UPTO WHERE THE 0 IS
1584 F1 POP PSW ;RESTORE THE CHARACTER
1585 12 STAX D
1586 3E 3F MVI A,3FH ;PRINT A "?"
1588 CD 0A 10 CALL OUTC
158B 97 SUB A ;AND THE REST OF THE
158C CD 07 16 CALL PRTSTG ;LINE
158F C3 BF 10 JMP RSTART ;THEN RESTART
1592 ;
1592 D5 QSORRY: PUSH D ;*** QSORRY ***
1593 11 B9 10 ASORRY: LXI D,SORRY ;*** ASORRY ***
1596 C3 67 15 JMP ERROR
1599 ;
1599 ;*************************************************************
1599 ;
1599 ; *** GETLN *** FNDLN (& FRIENDS) ***
1599 ;
1599 ; "GETLN" READS A INPUT LINE INTO "BUFFER". IT FIRST PROMPT
1599 ; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
1599 ; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
1599 ; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
1599 ; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
1599 ; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
1599 ; CR SIGNALS THE END OF A LINE, AND CAUSE "GETLN" TO RETURN.
1599 ;
1599 ; "FNDLN" FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
1599 ; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
1599 ; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
1599 ; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
1599 ; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
1599 ; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
1599 ; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
1599 ; LINE, FLAGS ARE C & NZ.
1599 ; "FNDLN" WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
1599 ; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
1599 ; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
1599 ; "FNDLNP" WILL START WITH DE AND SEARCH FOR THE LINE #.
1599 ; "FNDNXT" WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
1599 ; "FNDSKP" USE DE TO FIND A CR, AND THEN START SEARCH.
1599 ;
1599 CD 0A 10 GETLN: CALL OUTC ;*** GETLN ***
159C 11 37 FC LXI D,BUFFER ;PROMPT AND INIT.
159F CD 41 17 GL1: CALL CHKIO ;CHECK KEYBOARD
15A2 CA 9F 15 JZ GL1 ;NO INPUT, WAIT
15A5 FE 7F CPI 7FH ;DELETE LAST CHARACTER?
15A7 CA C6 15 JZ GL3 ;YES
15AA CD 0A 10 CALL OUTC ;INPUT, ECHO BACK
15AD FE 0A CPI 0AH ;IGNORE LF
15AF CA 9F 15 JZ GL1
15B2 B7 ORA A ;IGNORE NULL
15B3 CA 9F 15 JZ GL1
15B6 FE 7D CPI 7DH ;DELETE THE WHOLE LINE?
15B8 CA D5 15 JZ GL4 ;YES
15BB 12 STAX D ;ELSE SAVE INPUT
15BC 13 INX D ;AND BUMP POINTER
15BD FE 0D CPI 0DH ;WAS IT CR?
15BF C8 RZ ;YES, END OF LINE
15C0 7B MOV A,E ;ELSE MORE FREE ROOM?
15C1 FE 77 CPI <BUFEND
15C3 C2 9F 15 JNZ GL1 ;YES, GET NEXT INPUT
15C6 7B GL3: MOV A,E ;DELETE LAST CHARACTER
15C7 FE 37 CPI <BUFFER ;BUT DO WE HAVE ANY?
15C9 CA D5 15 JZ GL4 ;NO, REDO WHOLE LINE
15CC 1B DCX D ;YES, BACKUP POINTER
15CD 3E 5C MVI A,5CH ;AND ECHO A BACK-SLASH
15CF CD 0A 10 CALL OUTC
15D2 C3 9F 15 JMP GL1 ;GO GET NEXT INPUT
15D5 CD 08 10 GL4: CALL CRLF ;REDO ENTIRE LINE
15D8 3E 5E MVI A,05EH ;CR, LF AND UP-ARROW
15DA C3 99 15 JMP GETLN
15DD ;
15DD 7C FNDLN: MOV A,H ;*** FNDLN ***
15DE B7 ORA A ;CHECK SIGN OF HL
15DF FA A4 10 JM QHOW ;IT CANNOT BE -
15E2 11 1A 80 LXI D,TXTBGN ;INIT TEXT POINTER
15E5 ;
15E5 FNDLP: ;*** FDLNP ***
15E5 E5 FL1: PUSH H ;SAVE LINE #
15E6 2A 18 80 LHLD TXTUNF ;CHECK IF WE PASSED END
15E9 2B DCX H
15EA CD 1A 10 CALL COMP
15ED E1 POP H ;GET LINE # BACK
15EE D8 RC ;C,NZ PASSED END
15EF 1A LDAX D ;WE DID NOT, GET BYTE 1
15F0 95 SUB L ;IS THIS THE LINE?
15F1 47 MOV B,A ;COMPARE LOW ORDER
15F2 13 INX D
15F3 1A LDAX D ;GET BYTE 2
15F4 9C SBB H ;COMPARE HIGH ORDER
15F5 DA FC 15 JC FL2 ;NO, NOT THERE YET
15F8 1B DCX D ;ELSE WE EITHER FOUND
15F9 B0 ORA B ;IT, OR IT IS NOT THERE
15FA C9 RET ;NC,Z:FOUND, NC,NZ:NO
15FB ;
15FB FNDNXT: ;*** FNDNXT ***
15FB 13 INX D ;FIND NEXT LINE
15FC 13 FL2: INX D ;JUST PASSED BYTE 1 & 2
15FD ;
15FD 1A FNDSKP: LDAX D ;*** FNDSKP ***
15FE FE 0D CPI CR ;TRY TO FIND CR
1600 C2 FC 15 JNZ FL2 ;KEEP LOOKING
1603 13 INX D ;FOUND CR, SKIP OVER
1604 C3 E5 15 JMP FL1 ;CHECK IF END OF TEXT
1607 ;
1607 ;*************************************************************
1607 ;
1607 ; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
1607 ;
1607 ; "PRTSTG" PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
1607 ; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
1607 ; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
1607 ; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
1607 ;
1607 ; "QTSTG" LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
1607 ; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
1607 ; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
1607 ; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
1607 ; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
1607 ; OVER (USUALLY A JUMP INSTRUCTION.
1607 ;
1607 ; "PRTNUM" PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
1607 ; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
1607 ; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
1607 ; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
1607 ; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
1607 ;
1607 ; "PRTLN" PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
1607 ;
1607 47 PRTSTG: MOV B,A ;*** PRTSTG ***
1608 1A PS1: LDAX D ;GET A CHARACTER
1609 13 INX D ;BUMP POINTER
160A B8 CMP B ;SAME AS OLD A?
160B C8 RZ ;YES, RETURN
160C CD 0A 10 CALL OUTC ;ELSE PRINT IT
160F FE 0D CPI CR ;WAS IT A CR?
1611 C2 08 16 JNZ PS1 ;NO, NEXT
1614 C9 RET ;YES, RETURN
1615 ;
1615 CD 66 10 QTSTG: CALL TSTC ;*** QTSTG ***
1618 22 DB 22h
1619 0F DB QT3-$-1
161A 3E 22 MVI A,22H ;IT IS A "
161C CD 07 16 QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER
161F FE 0D CPI CR ;WAS LAST ONE A CR?
1621 E1 POP H ;RETURN ADDRESS
1622 CA 53 11 JZ RUNNXL ;WAS CR, RUN NEXT LINE
1625 23 QT2: INX H ;SKIP 3 BYTES ON RETURN
1626 23 INX H
1627 23 INX H
1628 E9 PCHL ;RETURN
1629 CD 66 10 QT3: CALL TSTC ;IS IT A '?
162C 27 DB 27H
162D 05 DB QT4-$-1
162E 3E 27 MVI A,27H ;YES, DO THE SAME
1630 C3 1C 16 JMP QT1 ;AS IN "
1633 CD 66 10 QT4: CALL TSTC ;IS IT BACK-ARROW?
1636 5F DB 5FH
1637 0C DB QT5-$-1
1638 3E 8D MVI A,08DH ;YES, CR WITHOUT LF
163A CD 0A 10 CALL OUTC ;DO IT TWICE TO GIVE
163D CD 0A 10 CALL OUTC ;TTY ENOUGH TIME
1640 E1 POP H ;RETURN ADDRESS
1641 C3 25 16 JMP QT2
1644 C9 QT5: RET ;NONE OF ABOVE
1645 ;
1645 06 00 PRTNUM: MVI B,0 ;*** PRTNUM ***
1647 CD 12 15 CALL CHKSGN ;CHECK SIGN
164A F2 50 16 JP PN1 ;NO SIGN
164D 06 2D MVI B,"-" ;B=SIGN
164F 0D DCR C ;"-" TAKES SPACE
1650 D5 PN1: PUSH D ;SAVE
1651 11 0A 00 LXI D,0AH ;DECIMAL
1654 D5 PUSH D ;SAVE AS A FLAG
1655 0D DCR C ;C=SPACES
1656 C5 PUSH B ;SAVE SIGN & SPACE
1657 CD F5 14 PN2: CALL DIVIDE ;DIVIDE HL BY 10
165A 78 MOV A,B ;RESULT 0?
165B B1 ORA C
165C CA 67 16 JZ PN3 ;YES, WE GOT ALL
165F E3 XTHL ;NO, SAVE REMAINDER
1660 2D DCR L ;AND COUNT SPACE
1661 E5 PUSH H ;HL IS OLD BC
1662 60 MOV H,B ;MOVE RESULT TO BC
1663 69 MOV L,C
1664 C3 57 16 JMP PN2 ;AND DIVIDE BY 10
1667 C1 PN3: POP B ;WE GOT ALL DIGITS IN
1668 0D PN4: DCR C ;THE STACK
1669 79 MOV A,C ;LOOK AT SPACE COUNT
166A B7 ORA A
166B FA 76 16 JM PN5 ;NO LEADING BLANKS
166E 3E 20 MVI A,20H ;LEADING BLANKS
1670 CD 0A 10 CALL OUTC
1673 C3 68 16 JMP PN4 ;MORE?
1676 78 PN5: MOV A,B ;PRINT SIGN
1677 B7 ORA A
1678 C4 10 00 CNZ 10H
167B 5D MOV E,L ;LAST REMAINDER IN E
167C 7B PN6: MOV A,E ;CHECK DIGIT IN E
167D FE 0A CPI 0AH ;10 IS FLAG FOR NO MORE
167F D1 POP D
1680 C8 RZ ;IF SO, RETURN
1681 C6 30 ADI 30H ;ELSE CONVERT TO ASCII
1683 CD 0A 10 CALL OUTC ;AND PRINT THE DIGIT
1686 C3 7C 16 JMP PN6 ;GO BACK FOR MORE
1689 ;
1689 1A PRTLN: LDAX D ;*** PRTLN ***
168A 6F MOV L,A ;LOW ORDER LINE #
168B 13 INX D
168C 1A LDAX D ;HIGH ORDER
168D 67 MOV H,A
168E 13 INX D
168F 0E 04 MVI C,4H ;PRINT 4 DIGIT LINE #
1691 CD 45 16 CALL PRTNUM
1694 3E 20 MVI A,20H ;FOLLOWED BY A BLANK
1696 CD 0A 10 CALL OUTC
1699 97 SUB A ;AND THEN THE NEXT
169A CD 07 16 CALL PRTSTG
169D C9 RET
169E ;
169E ;*************************************************************
169E ;
169E ; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
169E ;
169E ; "MVUP" MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
169E ; DE = HL
169E ;
169E ; "MVDOWN" MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
169E ; UNTIL DE = BC
169E ;
169E ; "POPA" RESTORES THE "FOR" LOOP VARIABLE SAVE AREA FROM THE
169E ; STACK
169E ;
169E ; "PUSHA" STACKS THE "FOR" LOOP VARIABLE SAVE AREA INTO THE
169E ; STACK
169E ;
169E CD 1A 10 MVUP: CALL COMP ;*** MVUP ***
16A1 C8 RZ ;DE = HL, RETURN
16A2 1A LDAX D ;GET ONE BYTE
16A3 02 STAX B ;MOVE IT
16A4 13 INX D ;INCREASE BOTH POINTERS
16A5 03 INX B
16A6 C3 9E 16 JMP MVUP ;UNTIL DONE
16A9 ;
16A9 78 MVDOWN: MOV A,B ;*** MVDOWN ***
16AA 92 SUB D ;TEST IF DE = BC
16AB C2 B1 16 JNZ MD1 ;NO, GO MOVE
16AE 79 MOV A,C ;MAYBE, OTHER BYTE?
16AF 93 SUB E
16B0 C8 RZ ;YES, RETURN
16B1 1B MD1: DCX D ;ELSE MOVE A BYTE
16B2 2B DCX H ;BUT FIRST DECREASE
16B3 1A LDAX D ;BOTH POINTERS AND
16B4 77 MOV M,A ;THEN DO IT
16B5 C3 A9 16 JMP MVDOWN ;LOOP BACK
16B8 ;
16B8 C1 POPA: POP B ;BC = RETURN ADDR.
16B9 E1 POP H ;RESTORE LOPVAR, BUT
16BA 22 0C 80 SHLD LOPVAR ;=0 MEANS NO MORE
16BD 7C MOV A,H
16BE B5 ORA L
16BF CA D2 16 JZ PP1 ;YEP, GO RETURN
16C2 E1 POP H ;NOP, RESTORE OTHERS
16C3 22 0E 80 SHLD LOPINC
16C6 E1 POP H
16C7 22 10 80 SHLD LOPLMT
16CA E1 POP H
16CB 22 12 80 SHLD LOPLN
16CE E1 POP H
16CF 22 14 80 SHLD LOPPT
16D2 C5 PP1: PUSH B ;BC = RETURN ADDR.
16D3 C9 RET
16D4 ;
16D4 21 78 FC PUSHA: LXI H,STKLMT ;*** PUSHA ***
16D7 CD 15 15 CALL CHGSGN
16DA C1 POP B ;BC=RETURN ADDRESS
16DB 39 DAD SP ;IS STACK NEAR THE TOP?
16DC D2 92 15 JNC QSORRY ;YES, SORRY FOR THAT
16DF 2A 0C 80 LHLD LOPVAR ;ELSE SAVE LOOP VAR'S
16E2 7C MOV A,H ;BUT IF LOPVAR IS 0
16E3 B5 ORA L ;THAT WILL BE ALL
16E4 CA FA 16 JZ PU1
16E7 2A 14 80 LHLD LOPPT ;ELSE, MORE TO SAVE
16EA E5 PUSH H
16EB 2A 12 80 LHLD LOPLN
16EE E5 PUSH H
16EF 2A 10 80 LHLD LOPLMT
16F2 E5 PUSH H
16F3 2A 0E 80 LHLD LOPINC
16F6 E5 PUSH H
16F7 2A 0C 80 LHLD LOPVAR
16FA E5 PU1: PUSH H
16FB C5 PUSH B ;BC = RETURN ADDR.
16FC C9 RET
16FD ;
16FD ;*************************************************************
16FD ;
16FD ; *** OUTC *** & CHKIO ***
16FD ;
16FD ; THESE ARE THE ONLY I/O ROUTINES IN TBI.
16FD ; "OUTC" IS CONTROLLED BY A SOFTWARE SWITCH "OCSW". IF OCSW=0
16FD ; "OUTC" WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0,
16FD ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO
16FD ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG.
16FD ; ARE RESTORED.
16FD ;
16FD ; "CHKIO" CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO
16FD ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG
16FD ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE
16FD ; INPUT IS A CONTROL-O, THE "OCSW" SWITCH IS COMPLIMENTED, AND
16FD ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, "CHKIO" WILL
16FD ; RESTART TBI AND DO NOT RETURN TO THE CALLER.
16FD ;
16FD ;OUTC: PUSH PSW ;THIS IS AT LOC. 10
16FD ; LDA OCSW ;CHECK SOFTWARE SWITCH
16FD ; ORA A
16FD ;
16FD ACIA_C: EQU 0DEh
16FD ACIA_D: EQU 0DFh
16FD ;
16FD 32 03 80 INIT: STA OCSW
1700 3E 03 MVI A,3 ;RESET ACIA
1702 D3 DE OUT ACIA_C
1704 3E 15 MVI A,15H ;15H FOR 8N1, 11H FOR 8N2
1706 D3 DE OUT ACIA_C
1708 16 19 MVI D,19H
170A PATLOP:
170A CD 08 10 CALL CRLF
170D 15 DCR D
170E C2 0A 17 JNZ PATLOP
1711 97 SUB A
1712 11 60 17 LXI D,MSG1
1715 CD 07 16 CALL PRTSTG
1718 21 00 10 LXI H,START
171B 22 16 80 SHLD RANPNT
171E 21 1A 80 LXI H,TXTBGN
1721 22 18 80 SHLD TXTUNF
1724 C3 BF 10 JMP RSTART
1727 C2 2C 17 OC2: JNZ OC3 ;IT IS ON
172A F1 POP PSW ;IT IS OFF
172B C9 RET ;RESTORE AF AND RETURN
172C DB DE OC3: IN ACIA_C ;COME HERE TO DO OUTPUT
172E E6 02 ANI 2H ;STATUS BIT
1730 CA 2C 17 JZ OC3 ;NOT READY, WAIT
1733 F1 POP PSW ;READY, GET OLD A BACK
1734 D3 DF OUT ACIA_D ;AND SEND IT OUT
1736 FE 0D CPI CR ;WAS IT CR?
1738 C0 RNZ ;NO, FINISHED
1739 3E 0A MVI A,LF ;YES, WE SEND LF TOO
173B CD 0A 10 CALL OUTC ;THIS IS RECURSIVE
173E 3E 0D MVI A,CR ;GET CR BACK IN A
1740 C9 RET
1741 ;
1741 DB DE CHKIO: IN ACIA_C ;*** CHKIO ***
1743 00 NOP ;STATUS BIT FLIPPED?
1744 E6 01 ANI 01H ;MASK STATUS BIT
1746 C8 RZ ;NOT READY, RETURN "Z"
1747 DB DF IN ACIA_D ;READY, READ DATA
1749 E6 7F ANI 7FH ;MASK BIT 7 OFF
174B FE 0F CPI 0FH ;IS IT CONTROL-O?
174D C2 5A 17 JNZ CI1 ;NO, MORE CHECKING
1750 3A 03 80 LDA OCSW ;CONTROL-O FLIPS OCSW
1753 2F CMA ;ON TO OFF, OFF TO ON
1754 32 03 80 STA OCSW
1757 C3 41 17 JMP CHKIO ;GET ANOTHER INPUT
175A FE 03 CI1: CPI 3H ;IS IT CONTROL-C?
175C C0 RNZ ;NO, RETURN "NZ"
175D C3 BF 10 JMP RSTART ;YES, RESTART TBI
1760 ;
1760 54 49 4E 59 20 MSG1: DB "TINY "
1765 42 41 53 49 43 DB "BASIC"
176A 0D DB CR
176B ;
176B ;*************************************************************
176B ;
176B ; *** TABLES *** DIRECT *** & EXEC ***
176B ;
176B ; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
176B ; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
176B ; OF CODE ACCORDING TO THE TABLE.
176B ;
176B ; AT "EXEC", DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
176B ; TO THE TABLE-1. AT "DIRECT", DE SHOULD POINT TO THE STRING.
176B ; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
176B ; ALL DIRECT AND STATEMENT COMMANDS.
176B ;
176B ; A "." IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
176B ; MATCH WILL BE CONSIDERED AS A MATCH. E.G., "P.", "PR.",
176B ; "PRI.", "PRIN.", OR "PRINT" WILL ALL MATCH "PRINT".
176B ;
176B ; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
176B ; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
176B ; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
176B ; BYTE SET TO 1.
176B ;
176B ; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
176B ; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
176B ; MATCH THIS NULL ITEM AS DEFAULT.
176B ;
176B TAB1: ;DIRECT COMMANDS
176B 4C 49 53 54 DB "LIST"
176F ;*Macro unroll: DWA LIST
176F 91 DB >LIST + 128
1770 A0 DB <LIST
1771 52 55 4E DB "RUN"
1774 ;*Macro unroll: DWA RUN
1774 91 DB >RUN + 128
1775 4D DB <RUN
1776 4E 45 57 DB "NEW"
1779 ;*Macro unroll: DWA NEW
1779 91 DB >NEW + 128
177A 3B DB <NEW
177B 42 59 45 DB "BYE"
177E ;*Macro unroll: DWA BYE
177E 91 DB >BYE + 128
177F 4A DB <BYE
1780 ;
1780 TAB2: ;DIRECT/STATEMENT
1780 4E 45 58 54 DB "NEXT"
1784 ;*Macro unroll: DWA NEXT
1784 92 DB >NEXT + 128
1785 A0 DB <NEXT
1786 4C 45 54 DB "LET"
1789 ;*Macro unroll: DWA LET
1789 93 DB >LET + 128
178A 80 DB <LET
178B 49 46 DB "IF"
178D ;*Macro unroll: DWA IFF
178D 93 DB >IFF + 128
178E 05 DB <IFF
178F 47 4F 54 4F DB "GOTO"
1793 ;*Macro unroll: DWA GOTO
1793 91 DB >GOTO + 128
1794 6C DB <GOTO
1795 47 4F 53 55 42 DB "GOSUB"
179A ;*Macro unroll: DWA GOSUB
179A 91 DB >GOSUB + 128
179B FE DB <GOSUB
179C 52 45 54 55 52 4E DB "RETURN"
17A2 ;*Macro unroll: DWA RETURN
17A2 92 DB >RETURN + 128
17A3 20 DB <RETURN
17A4 52 45 4D DB "REM"
17A7 ;*Macro unroll: DWA REM
17A7 93 DB >REM + 128
17A8 01 DB <REM
17A9 46 4F 52 DB "FOR"
17AC ;*Macro unroll: DWA FOR
17AC 92 DB >FOR + 128
17AD 3B DB <FOR
17AE 49 4E 50 55 54 DB "INPUT"
17B3 ;*Macro unroll: DWA INPUT
17B3 93 DB >INPUT + 128
17B4 20 DB <INPUT
17B5 50 52 49 4E 54 DB "PRINT"
17BA ;*Macro unroll: DWA PRINT
17BA 91 DB >PRINT + 128
17BB B8 DB <PRINT
17BC 53 54 4F 50 DB "STOP"
17C0 ;*Macro unroll: DWA STOP
17C0 91 DB >STOP + 128
17C1 44 DB <STOP
17C2 4F 55 54 50 DB "OUTP"
17C6 ;*Macro unroll: DWA OUTP
17C6 91 DB >OUTP + 128
17C7 7D DB <OUTP
17C8 ;*Macro unroll: DWA DEFLT
17C8 93 DB >DEFLT + 128
17C9 7A DB <DEFLT
17CA ;
17CA TAB4: ;FUNCTIONS
17CA 52 4E 44 DB "RND"
17CD ;*Macro unroll: DWA RND
17CD 94 DB >RND + 128
17CE 9A DB <RND
17CF 41 42 53 DB "ABS"
17D2 ;*Macro unroll: DWA ABS
17D2 94 DB >ABS + 128
17D3 C7 DB <ABS
17D4 49 4E 50 DB "INP"
17D7 ;*Macro unroll: DWA INFN
17D7 94 DB >INFN + 128
17D8 D0 DB <INFN
17D9 53 49 5A 45 DB "SIZE"
17DD ;*Macro unroll: DWA SIZE
17DD 94 DB >SIZE + 128
17DE E8 DB <SIZE
17DF ;*Macro unroll: DWA XP40
17DF 94 DB >XP40 + 128
17E0 78 DB <XP40
17E1 ;
17E1 TAB5: ;"TO" IN "FOR"
17E1 54 4F DB "TO"
17E3 ;*Macro unroll: DWA FR1
17E3 92 DB >FR1 + 128
17E4 4B DB <FR1
17E5 ;*Macro unroll: DWA QWHAT
17E5 95 DB >QWHAT + 128
17E6 63 DB <QWHAT
17E7 ;
17E7 TAB6: ;"STEP" IN "FOR"
17E7 53 54 45 50 DB "STEP"
17EB ;*Macro unroll: DWA FR2
17EB 92 DB >FR2 + 128
17EC 57 DB <FR2
17ED ;*Macro unroll: DWA FR3
17ED 92 DB >FR3 + 128
17EE 5D DB <FR3
17EF ;
17EF TAB8: ;RELATION OPERATORS
17EF 3E 3D DB ">="
17F1 ;*Macro unroll: DWA XP11
17F1 93 DB >XP11 + 128
17F2 94 DB <XP11
17F3 23 DB "#"
17F4 ;*Macro unroll: DWA XP12
17F4 93 DB >XP12 + 128
17F5 9A DB <XP12
17F6 3E DB ">"
17F7 ;*Macro unroll: DWA XP13
17F7 93 DB >XP13 + 128
17F8 A0 DB <XP13
17F9 3D DB "="
17FA ;*Macro unroll: DWA XP15
17FA 93 DB >XP15 + 128
17FB AF DB <XP15
17FC 3C 3D DB "<="
17FE ;*Macro unroll: DWA XP14
17FE 93 DB >XP14 + 128
17FF A7 DB <XP14
1800 3C DB "<"
1801 ;*Macro unroll: DWA XP16
1801 93 DB >XP16 + 128
1802 B5 DB <XP16
1803 ;*Macro unroll: DWA XP17
1803 93 DB >XP17 + 128
1804 BB DB <XP17
1805 ;
1805 21 6A 17 DIRECT: LXI H,TAB1-1 ;*** DIRECT ***
1808 ;
1808 EXEC: ;*** EXEC ***
1808 CD 22 10 EX0: CALL IGNBLK ;IGNORE LEADING BLANKS
180B D5 PUSH D ;SAVE POINTER
180C 1A EX1: LDAX D ;IF FOUND "." IN STRING
180D 13 INX D ;BEFORE ANY MISMATCH
180E FE 2E CPI 2EH ;WE DECLARE A MATCH
1810 CA 29 18 JZ EX3
1813 23 INX H ;HL->TABLE
1814 BE CMP M ;IF MATCH, TEST NEXT
1815 CA 0C 18 JZ EX1
1818 3E 7F MVI A,07FH ;ELSE SEE IF BIT 7
181A 1B DCX D ;OF TABLE IS SET, WHICH
181B BE CMP M ;IS THE JUMP ADDR. (HI)
181C DA 30 18 JC EX5 ;C:YES, MATCHED
181F 23 EX2: INX H ;NC:NO, FIND JUMP ADDR.
1820 BE CMP M
1821 D2 1F 18 JNC EX2
1824 23 INX H ;BUMP TO NEXT TAB. ITEM
1825 D1 POP D ;RESTORE STRING POINTER
1826 C3 08 18 JMP EX0 ;TEST AGAINST NEXT ITEM
1829 3E 7F EX3: MVI A,07FH ;PARTIAL MATCH, FIND
182B 23 EX4: INX H ;JUMP ADDR., WHICH IS
182C BE CMP M ;FLAGGED BY BIT 7
182D D2 2B 18 JNC EX4
1830 7E EX5: MOV A,M ;LOAD HL WITH THE JUMP
1831 23 INX H ;ADDRESS FROM THE TABLE
1832 6E MOV L,M
1833 E6 7F ANI 7FH ;MASK OFF BIT 7
1835 67 MOV H,A
1836 F1 POP PSW ;CLEAN UP THE GABAGE
1837 E9 PCHL ;AND WE GO DO IT
1838 ;
1838 LSTROM: ;ALL ABOVE CAN BE ROM
8000 .ORG 8000H ;HERE DOWN MUST BE RAM
8000 ; ORG 0800H
8000 INRAM: DS 3 ; space for IN x;ret;
8003 OCSW: DS 1 ;SWITCH FOR OUTPUT
8004 CURRNT: DS 2 ;POINTS TO CURRENT LINE
8006 STKGOS: DS 2 ;SAVES SP IN "GOSUB"
8008 VARNXT: DS 2 ;TEMP STORAGE
800A STKINP: DS 2 ;SAVES SP IN "INPUT"
800C LOPVAR: DS 2 ;"FOR" LOOP SAVE AREA
800E LOPINC: DS 2 ;INCREMENT
8010 LOPLMT: DS 2 ;LIMIT
8012 LOPLN: DS 2 ;LINE NUMBER
8014 LOPPT: DS 2 ;TEXT POINTER
8016 RANPNT: DS 2 ;RANDOM NUMBER POINTER
8018 TXTUNF: DS 2 ;->UNFILLED TEXT AREA
801A TXTBGN: DS 2 ;TEXT SAVE AREA BEGINS
FC00 .ORG 0fc00H
FC00 ; ORG 1F00H
FC00 TXTEND: DS 0 ;TEXT SAVE AREA ENDS
FC00 VARBGN: DS 55 ;VARIABLE @(0)
FC37 BUFFER: DS 64 ;INPUT BUFFER
FC77 BUFEND: DS 1 ;BUFFER ENDS
FC78 STKLMT: DS 1 ;TOP LIMIT FOR STACK
FFFF .ORG 0ffffH
FFFF ; ORG 2000H
FFFF STACK: DS 0 ;STACK STARTS HERE
FFFF ;
FFFF CR: EQU 0DH
FFFF LF: EQU 0AH
FFFF ;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment