CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug011.ark / TINIDISK.ASM < prev next >

Wrap

Assembly Source File | 1985-02-10 | 63.4 KB | 1,905 lines

;************************************************************** ;* ;* TINY BASIC FOR INTEL 8080 ;* VERSION 1.0 ;* BY LI-CHEN WANG ;* 10 JUNE, 1976 ;* @COPYLEFT ;* ALL WRONGS RESERVED ;* ;************************************************************** ;* ;* ;*** ZERO PAGE SUBROUTINES *** ;* ;* THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW ;* MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7. ;* THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS ;* THE THREE BYTE INSTRUCTION CALL LLHH. TINY BASIC WILL ;* USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR ;* THE SEVEN MOST FREQUENTLY USED SUBROUTINES. ;* TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS ;* SECTION. THEY CAN BE REACHED ONLY BY 3-BYTE CALLS. ;* IN ORDER TO CONFIGURE THE SYSTEM FOR USE WITH CPM I HAVE ;* MOVED SOME OF THE ROUTINES AROUND. START WILL NOW BE AT ;* LOCATION 100H AND THIS SECTION WILL END AT LOCATION 3FH ;* WITH A JUMP TO 108H. ;* ; ORG 8H ; XTHL ;*** TSTC OR RST 1 *** ; RST 5 ;IGNORE BLANKS AND ; CMP M ;TEST CHARACTER ; JMP TC1 ;REST OF THIS IS AT TC1 ;* ;CRLF MVI A,0DH ;*** CRLF *** ;* ; PUSH PSW ;*** OUTC OR RST 2 *** ; LDA OCSW ;PRINT CHARACTER ONLY ; ORA A ;IFF OCSW SWITCH IS ON ; JMP OC2 ;REST OF THIS IS AT OC2 ;* ; CALL EXPR2 ;*** EXPR OR RST 3 *** ; PUSH H ;EVALUATE AN EXPRESION ; JMP EXPR1 ;REST OF IT IS AT EXPR1 ; DB 'W' ;* ; MOV A,H ;*** COMP OR RST 4 *** ; CMP D ;COMPARE HL WITH DE ; RNZ ;RETURN CORRECT C AND ; MOV A,L ;Z FLAGS ; CMP E ;BUT OLD A IS LOST ; RET ; DB 'AN' ;* ;SS1 LDAX D ;*** IGNBLK/RST 5 *** ; CPI 40Q ;IGNORE BLANKS ; RNZ ;IN TEXT (WHERE DE->) ; INX D ;AND RETURN THE FIRST ; JMP SS1 ;NON-BLANK CHAR. IN A ;* ; POP PSW ;*** FINISH/RST 6 *** ; CALL FIN ;CHECK END OF COMMAND ; JMP QWHAT ;PRINT "WHAT?" IFF WRONG ; DB 'G' ;* ; RST 5 ;*** TSTV OR RST 7 *** ; SUI 100Q ;TEST VARIABLES ; RC ;C:NOT A VARIABLE ; JMP TSTV1 ;JUMP AROUND RESERVED AREA ORG 100H ;OF CPM. START JMP NINIT ;GO TO INITIALIZATION ROUTINE. JIF TSTV1 JNZ TV1 ;NOT "@" ARRAY INX D ;IT IS THE "@" ARRAY CALL PARN ;@ SHOULD BE FOLLOWED DAD H ;BY (EXPR) AS ITS INDEX JC QHOW ;IS INDEX TOO BIG? PUSH D ;WILL IT OVERWRITE XCHG ;TEXT? CALL SIZE ;FIND SIZE OF FREE RST 4 ;AND CHECK THAT JC ASORRY ;IFF SO, SAY "SORRY" SS1A LXI H,VARBGN ;IFF NOT, GET ADDRESS CALL SUBDE ;OF @(EXPR) AND PUT IT POP D ;IN HL RET ;C FLAG IS CLEARED TV1 CPI 33Q ;NOT @, IS IT A TO Z? CMC ;IFF NOT RETURN C FLAG RC INX D ;IFF A THROUGH Z TV1A LXI H,VARBGN ;COMPUTE ADDRESS OF RLC ;THAT VARIABLE ADD L ;AND RETURN IT IN HL MOV L,A ;WITH C FLAG CLEARED MVI A,0 ADC H MOV H,A RET ;* ;* TSTC XCH HL,(SP) ;*** TSTC OR RST 1 *** ;* IGNBLK THIS IS AT LOC. 8 ;* CMP M AND THEN JMP HERE TC1 INX H ;COMPARE THE BYTE THAT JZ TC2 ;FOLLOWS THE RST INST. PUSH B ;WITH THE TEXT (DE->) MOV C,M ;IFF NOT =, ADD THE 2ND MVI B,0 ;BYTE THAT FOLLOWS THE DAD B ;RST TO THE OLD PC POP B ;I.E., DO A RELATIVE DCX D ;JUMP IFF NOT = TC2 INX D ;IFF =, SKIP THOSE BYTES INX H ;AND CONTINUE XTHL RET ;* TSTNUM LXI H,0 ;*** TSTNUM *** MOV B,H ;TEST IFF THE TEXT IS RST 5 ;A NUMBER TN1 CPI 60Q ;IFF NOT, RETURN 0 IN RC ;B AND HL CPI 72Q ;IFF NUMBERS, CONVERT RNC ;TO BINARY IN HL AND MVI A,360Q ;SET A TO # OF DIGITS ANA H ;IFF H>255, THERE IS NO JNZ QHOW ;ROOM FOR NEXT DIGIT INR B ;B COUNTS # OF DIGITS PUSH B MOV B,H ;HL=10;*HL+(NEW DIGIT) MOV C,L DAD H ;WHERE 10;* IS DONE BY DAD H ;SHIFT AND ADD DAD B DAD H LDAX D ;AND (DIGIT) IS FROM INX D ;STRIPPING THE ASCII ANI 17Q ;CODE ADD L MOV L,A MVI A,0 ADC H MOV H,A POP B LDAX D ;DO THIS DIGIT AFTER JP TN1 ;DIGIT. S SAYS OVERFLOW QHOW PUSH D ;*** ERROR: "HOW?" *** AHOW LXI D,HOW JMP ERROR HOW DB 'HOW?',0DH OK DB 'OK',0DH WHAT DB 'WHAT?',0DH SORRY DB 'SORRY',0DH ;* ;************************************************************** ;* ;* *** MAIN *** ;* ;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM ;* AND STORES IT IN THE MEMORY. ;* ;* AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE ;* STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS ;* ">" AND READS A LINE. IFF THE LINE STARTS WITH A NON-ZERO ;* NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER ;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR) ;* IS STORED IN THE MEMORY. IFF A LINE WITH THE SAME LINE ;* NUMBER IS ALREDY THERE, IT IS REPLACED BY THE NEW ONE. IF ;* THE REST OF THE LINE CONSISTS OF A 0DHONLY, IT IS NOT STORED ;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED. ;* ;* AFTER A LINE ISs INSERTED, REPLACED, OR DELETED, THE PROGRAM ;* LOOPS BACK AND ASK FOR ANOTHER LINE. THIS LOOP WILL BE ;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE ;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRCT". ;* ;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION ;* LABELED "TXTBGN" AND ENDED AT "TXTEND". WE ALWAYS FILL THIS ;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED ;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF". ;* ;* THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER ;* THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN ;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND ;* (SEE NEXT SECTION), "CURRNT" SHOULD POINT TO A 0. ;* RSTART LXI SP,STACK ;SET STACK POINTER ST1 CALL CRLF ;AND JUMP TO HERE LXI D,OK ;DE->STRING SUB A ;A=0 CALL PRTSTG ;PRINT STRING UNTIL 0DH LXI H,ST2+1 ;LITERAL 0 SHLD CURRNT ;CURRNT->LINE # = 0 ST2 LXI H,0 SHLD LOPVAR SHLD STKGOS ST3 MVI A,76Q ;PROMPT '>' AND CALL GETLN ;READ A LINE PUSH D ;DE->END OF LINE ST3A LXI D,BUFFER ;DE->BEGINNING OF LINE CALL TSTNUM ;TESt IFF IT IS A NUMBER RST 5 MOV A,H ;HL=VALUE OF THE # OR ORA L ;0 IFF NO # WAS FOUND POP B ;BC->END OF LINE JZ DIRECT DCX D ;BACKUP DE AND SAVE MOV A,H ;VALUE OF LINE # THERE STAX D DCX D MOV A,L STAX D PUSH B ;BC,DE->BEGIN, END PUSH D MOV A,C SUB E PUSH PSW ;A=# OF BYTES IN LINE CALL FNDLN ;FIND THIS LINE IN SAVE PUSH D ;AREA, DE->SAVE AREA JNZ ST4 ;NZ:NOT FOUND, INSERT PUSH D ;Z:FOUND, DELETE IT CALL FNDNXT ;FIND NEXT LINE ;* DE->NEXT LINE POP B ;BC->LINE TO BE DELETED LHLD TXTUNF ;HL->UNFILLED SAVE AREA CALL MVUP ;MOVE UP TO DELETE MOV H,B ;TXTUNF->UNFILLED AREA MOV L,C SHLD TXTUNF ;UPDATE ST4 POP B ;GET READY TO INSERT LHLD TXTUNF ;BUT FIRT CHECK IF POP PSW ;THE LENGTH OF NEW LINE PUSH H ;IS 3 (LINE # AND CR) CPI 3 ;THEN DO NOT INSERT JZ RSTART ;MUST CLEAR THE STACK ADD L ;COMPUTE NEW TXTUNF MOV L,A MVI A,0 ADC H MOV H,A ;HL->NEW UNFILLED AREA ST4A LXI D,TXTEND ;CHECK TO SEE IF THERE RST 4 ;IS ENOUGH SPACE JNC QSORRY ;SORRY, NO ROOM FOR IT SHLD TXTUNF ;OK, UPDATE TXTUNF POP D ;DE->OLD UNFILLED AREA CALL MVDOWN POP D ;DE->BEGIN, HL->END POP H CALL MVUP ;MOVE NEW LINE TO SAVE JMP ST3 ;AREA ;* ;************************************************************** ;* ;* *** TABLES *** DIRECT *** & EXEC *** ;* ;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE. ;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION ;* OF CODE ACCORDING TO THE TABLE. ;* ;* AT 'EXEC', DE SHOULD POINT TO THE STRING AD HL SHOULD POINT ;* TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING, ;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF ;* ALL DIRECT AND STATEMENT COMMANDS. ;* ;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL ;* MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.', ;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'. ;* ;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM ;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND ;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH ;* BYTE SET TO 1. ;* ;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IFF THE ;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL ;* MATCH THIS NULL ITEM AS DEFAULT. ;* TAB1 EQU $ ;DIRECT COMMANDS DB 'LIST' DB LIST SHR 8 + 128,LIST AND 0FFH DB 'RUN' DB RUN SHR 8 + 128,RUN AND 255 DB 'NEW' DB NEW SHR 8 + 128,NEW AND 255 DB 'LOAD' DB DLOAD SHR 8 + 128,DLOAD AND 255 DB 'SAVE' DB DSAVE SHR 8 + 128,DSAVE AND 255 DB 'BYE',80H,0H ;GO BACK TO CPM TAB2 EQU $ ;DIRECT/TATEMENT DB 'NEXT' DB NEXT SHR 8 + 128,NEXT AND 255 DB 'LET' DB LET SHR 8 + 128,LET AND 255 DB 'OUT' DB OUTCMD SHR 8 + 128,OUTCMD AND 255 DB 'POKE' DB POKE SHR 8 + 128,POKE AND 255 DB 'WAIT' DB WAITCM SHR 8 + 128,WAITCM AND 255 DB 'IF' DB IFF SHR 8 + 128,IFF AND 255 DB 'GOTO' DB GOTO SHR 8 + 128,GOTO AND 255 DB 'GOSUB' DB GOSUB SHR 8 + 128,GOSUB AND 255 DB 'RETURN' DB RETURN SHR 8 + 128,RETURN AND 255 DB 'REM' DB REM SHR 8 + 128,REM AND 255 DB 'FOR' DB FOR SHR 8 + 128,FOR AND 255 DB 'INPUT' DB INPUT SHR 8 + 128,INPUT AND 255 DB 'PRINT' DB PRINT SHR 8 + 128,PRINT AND 255 DB 'STOP' DB STOP SHR 8 + 128,STOP AND 255 DB DEFLT SHR 8 + 128,DEFLT AND 255 DB 'YOU CAN ADD MORE' ;COMMANDS BUT ;REMEMBER TO MOVE DEFAULT DOWN. TAB4 EQU $ ;FUNCTIONS DB 'RND' DB RND SHR 8 + 128,RND AND 255 DB 'INP' DB INP SHR 8 + 128,INP AND 255 DB 'PEEK' DB PEEK SHR 8 + 128,PEEK AND 255 DB 'USR' DB USR SHR 8 + 128,USR AND 255 DB 'ABS' DB ABS SHR 8 + 128,ABS AND 255 DB 'SIZE' DB SIZE SHR 8 + 128,SIZE AND 255 DB XP40 SHR 8 + 128,XP40 AND 255 DB 'YOU CAN ADD MORE' ;FUNCTIONS BUT REMEMBER ;TO MOVE XP40 DOWN TAB5 EQU $ ;"TO" IN "FOR" DB 'TO' DB FR1 SHR 8 + 128,FR1 AND 255 DB QWHAT SHR 8 + 128,QWHAT AND 255 TAB6 EQU $ ;"STEP" IN "FOR" DB 'STEP' DB FR2 SHR 8 + 128,FR2 AND 255 DB FR3 SHR 8 + 128,FR3 AND 255 TAB8 EQU $ ;RELATION OPERATORS DB '>=' DB XP11 SHR 8 + 128,XP11 AND 255 DB '#' DB XP12 SHR 8 + 128,XP12 AND 255 DB '>' DB XP13 SHR 8 + 128,XP13 AND 255 DB '=' DB XP15 SHR 8 + 128,XP15 AND 255 DB '<=' DB XP14 SHR 8 + 128,XP14 AND 255 DB '<' DB XP16 SHR 8 + 128,XP16 AND 255 DB XP17 SHR 8 + 128,XP17 AND 255 ;* DIRECT LXI H,TAB1-1 ;*** DIRECT *** ;* EXEC EQU $ ;*** EXEC *** EX0 RST 5 ;IGNORE LEADING BLANKS PUSH D ;SAVE POINTER EX1 LDAX D ;IFF FOUND '.' IN STRING INX D ;BEFORE ANY MISMATCH CPI 56Q ;WE DECLARE A MATCH JZ EX3 INX H ;HL->TABLE CMP M ;IFF MATCH, TEST NEXT JZ EX1 MVI A,177Q ;ELSE, SEE IFF BIT 7 DCX D ;OF TABLEIS SET, WHICH CMP M ;IS THE JUMP ADDR. (HI) JC EX5 ;C:YES, MATCHED EX2 INX H ;NC:NO, FIND JUMP ADDR. CMP M JNC EX2 INX H ;BUMP TO NEXT TAB. ITEM POP D ;RESTORE STRING POINTER JMP EX0 ;TEST AGAINST NEXT ITEM EX3 MVI A,177Q ;PARTIAL MATCH, FIND EX4 INX H ;JUMP ADDR., WHICH IS CMP M ;FLAGGED BY BIT 7 JNC EX4 EX5 MOV A,M ;LOAD HL WITH THE JUMP INX H ;ADDRESS FROM THE TABLE MOV L,M ANI 177Q ;MASK OFF BIT 7 MOV H,A POP PSW ;CLEAN UP THE GABAGE PCHL ;AND WE GO DO IT ;* ;************************************************************** ;* ;* WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT ;* COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE ;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST ;* SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS ;* TANSFERED TO OTHER SECTIONS AS FOLLOWS: ;* ;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' ;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IFF ANY; ELSE ;* GO BACK TO 'RSTART'. ;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. ;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. ;* FOR ALL OTHERS: IFF 'CURRNT' -> 0, GO TO 'RSTART', ELSE ;* GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) ;* ;************************************************************** ;* ;* *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** ;* ;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' ;* ;* 'STOP(CR)' GOES BACK TO 'RSTART' ;* ;* 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN ;* 'CURRNT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE ;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM. ;* ;* THERE ARE 3 MORE ENTRIES IN 'RUN': ;* 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT. ;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT. ;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE. ;* ;* 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET ;* LINE, AND JUMP TO 'RUNTSL' TO DO IT. ;* 'DLOAD' LOADS A NAMED PROGRAM FROM DISK. ;* 'DSAVE' SAVES A NAMED PROGRAM ON DISK. ;* 'FCBSET' SETS UP THE FILE CONTROL BLOCK FOR SUBSEQUENT DISK I/O. ;* NEW CALL ENDCHK ;*** NEW(CR) *** LXI H,TXTBGN SHLD TXTUNF ;* STOP CALL ENDCHK ;*** STOP(CR) *** JMP RSTART ;* RUN CALL ENDCHK ;*** RUN(CR) *** LXI D,TXTBGN ;FIRST SAVED LINE ;* RUNNXL LXI H,0 ;*** RUNNXL *** CALL FNDLNP ;FIND WHATEVER LINE # JC RSTART ;C:PASSED TXTUNF, QUIT ;* RUNTSL XCHG ;*** RUNTSL *** SHLD CURRNT ;SET 'CURRNT'->LINE # XCHG INX D ;BUMP PASS LINE # INX D ;* RUNSML CALL CHKIO ;*** RUNSML *** LXI H,TAB2-1 ;FIND COMMAND IN TAB2 JMP EXEC ;AND EXECUTE IT ;* GOTO RST 3 ;*** GOTO EXPR *** PUSH D ;SAVE FOR ERROR ROUTINE CALL ENDCHK ;MUST FIND A 0DH CALL FNDLN ;FIND THE TARGET LINE JNZ AHOW ;NO SUCH LINE # POP PSW ;CLEAR THE "PUSH DE" JMP RUNTSL ;GO DO IT CPM EQU 5 ;DISK PARAMETERS FCB EQU 5CH SETDMA EQU 26 OPEN EQU 15 READD EQU 20 WRITED EQU 21 CLOSE EQU 16 MAKE EQU 22 DELETE EQU 19 ;* DLOAD RST 5 ;IGNORE BLANKS PUSH H ;SAVE H CALL FCBSET ;SET UP FILE CONTROL BLOCK PUSH D ;SAVE THE REST PUSH B LXI D,FCB ;GET FCB ADDRESS MVI C,OPEN ;PREPARE TO OPEN FILE CALL CPM ;OPEN IT CPI 0FFH ;IS IT THERE? JZ QHOW ;NO, SEND ERROR XRA A ;CLEAR A STA FCB+32 ;START AT RECORD 0 LXI D,TXTUNF ;GET BEGINNING LOAD PUSH D ;SAVE DMA ADDRESS MVI C,SETDMA ; CALL CPM ;SET DMA ADDRESS MVI C,READD ; LXI D,FCB CALL CPM ;READ SECTOR CPI 1 ;DONE? JC RDMORE ;NO, READ MORE JNZ QHOW ;BAD READ MVI C,CLOSE LXI D,FCB CALL CPM ;CLOSE FILE POP D ;THROW AWAY DMA ADD. POP B ;GET OLD REGISTERS BACK POP D POP H RST 6 ;FINISH RDMORE POP D ;GET DMA ADDRESS LXI H,80H ;GET 128 DAD D ;ADD 128 TO DMA ADD. XCHG ;PUT IT BACK IN D JMP LOAD ;AND READ SOME MORE ;* DSAVE RST 5 ;IGNORE BLANKS PUSH H ;SAVE H CALL FCBSET ;SETUP FCB PUSH D PUSH B ;SAVE OTHERS LXI D,FCB MVI C,DELETE CALL CPM ;ERASE FILE IF IT EXISTS LXI D,FCB MVI C,MAKE CALL CPM ;MAKE A NEW ONE CPI 0FFH ;IS THERE SPACE? JZ QHOW ;NO, ERROR XRA A ;CLEAR A STA FCB+32 ;START AT RECORD 0 LXI D,TXTUNF ;GET BEGINNING SAVE PUSH D ;SAVE DMA ADDRESS MVI C,SETDMA ; CALL CPM ;SET DMA ADDRESS MVI C,WRITED LXI D,FCB CALL CPM ;WRITE SECTOR ORA A ;SET FLAGS JNZ QHOW ;IF NOT ZERO, ERROR POP D ;GET DMA ADD. BACK LDA TXTUNF+1 ;AND MSB OF LAST ADD. CMP D ;IS D SMALLER? JC SAVDON ;YES, DONE JNZ WRITMOR ;DONT TEST E IF NOT EQUAL LDA TXTUNF ;IS E SMALLER? CMP E JC SAVDON ;YES, DONE WRITMOR LXI H,80H DAD D ;ADD 128 TO DMA ADD. XCHG ;GET IT BACK IN D JMP SAVE ;WRITE SOME MORE SAVDON MVI C,CLOSE LXI D,FCB CALL CPM ;CLOSE FILE POP B ;GET REGISTERS BACK POP D POP H RST 6 ;FINISH ;* FCBSET LXI H,FCB ;GET FILE CONTROL BLOCK ADDRESS MVI M,0 ;CLEAR ENTRY TYPE FNCLR INX H ;NEXT LOCATION MVI M,' ' ;CLEAR TO SPACE MVI A,FCB+8 AND 255 CMP L ;DONE? JNZ FNCLR ;NO, DO IT AGAIN INX H ;NEXT MVI M,'T' ;SET FILE TYPE TO 'TBI' INX H MVI M,'B' INX H MVI M,'I' EXRC INX H ;CLEAR REST OF FCB MVI M,0 MVI A,FCB+15 AND 255 CMP L ;DONE? JNZ EXRC ;NO, CONTINUE LXI H,FCB+1 ;GET FILENAME START FN LDAX D ;GET CHARACTER CPI 0DH ;IS IT A 'CR' RZ ;YES, DONE CPI '!' ;LEGAL CHARACTER? JC QWHAT ;NO, SEND ERROR CPI '[' ;AGAIN JNC QWHAT ;DITTO MOV M,A ;SAVE IT IN FCB INX H ;NEXT INX D MVI A,FCB+9 AND 255 CMP L ;LAST? JNZ FN ;NO, CONTINUE RET ;TRUNCATE AT 8 CHARACTERS ;* ;************************************************************* ;* ;* *** LIST *** & PRINT *** ;* ;* LIST HAS TWO FORMS: ;* 'LIST(CR)' LISTS ALL SAVED LINES ;* 'LIST #(CR)' START LIST AT THIS LINE # ;* YOU CAN STOP THE LISTING BY CONTROL C KEY ;* ;* PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)' ;* WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK- ;* ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS. ;* ;* A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLSs ;* THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO ;* BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT ;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IFF NO FORMAT IS ;* SPECIFIED, 6 POSITIONS WILL BE USED. ;* ;* A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF ;* DOUBLE QUOTES. ;* ;* A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF) ;* ;* A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN ;* PRINTED OR IFF THE LIST IS A NULL LIST. HOWEVER IFF THE LIST ;* ENDED WITH A COMMA, NO (CRL) IS GENERATED. ;* LIST CALL TSTNUM ;TEST IFF THERE IS A # CALL ENDCHK ;IFF NO # WE GET A 0 CALL FNDLN ;FIND THIS OR NEXT LINE LS1 JC RSTART ;C:PASSED TXTUNF CALL PRTLN ;PRINT THE LINE CALL CHKIO ;STOP IFF HIT CONTROL-C CALL FNDLNP ;FIND NEXT LINE JMP LS1 ;AND LOOP BACK ;* PRINT MVI C,6 ;C = # OF SPACES RST 1 ;IFF NULL LIST & ";" DB 73Q DB 6Q CALL CRLF ;GIVE CR-LF AND JMP RUNSML ;CONTINUE SAME LINE PR2 RST 1 ;IFF NULL LIST (CR) DB 0DH DB 6Q CALL CRLF ;ALSO GIVE CR-LF AND JMP RUNNXL ;GO TO NEXT LINE PR0 RST 1 ;ELSE IS IT FORMAT? DB '#' DB 5Q RST 3 ;YES, EVALUATE EXPR. MOV C,L ;AND SAVE IT IN C JMP PR3 ;LOOK FOR MORE TO PRINT PR1 CALL QTSTG ;OR IS IT A STRING? JMP PR8 ;IFF NOT, MUST BE EXPR. PR3 RST 1 ;IFF ",", GO FIND NEXT DB ',' DB 6Q CALL FIN ;IN THE LIST. JMP PR0 ;LIST CONTINUES PR6 CALL CRLF ;LIST ENDS RST 6 PR8 RST 3 ;EVALUATE THE EXPR PUSH B CALL PRTNUM ;PRINT THE VALUE POP B JMP PR3 ;MORE TO PRINT? ;* ;************************************************************** ;* ;* *** GOSUB *** & RETURN *** ;* ;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' ;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE ;* SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED ;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED. ;* THE STACK POINTER IS SAVED IN 'STKGOS'. THE OLD 'STKGOS' IS ;* SAVED IN THE STACK. IFF WE ARE IN THE MAIN ROUTINE, 'STKGOS' ;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE), ;* BUT WE STILL SAVE IT AS A FLAG FORr NO FURTHER 'RETURN'S. ;* ;* 'RETURN(CR)' UNDOS EVERYHING THAT 'GOSUB' DID, AND THUS ;* RETURN THE EXCUTION TO THE COMMAND AFTER THE MOST RECENT ;* 'GOSUB'. IFF 'STKGOS' IS ZERO, IT INDICATES THAT WE ;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR. ;* GOSUB CALL PUSHA ;SAVE THE CURRENT "FOR" RST 3 ;PARAMETERS PUSH D ;AND TEXT POINTER CALL FNDLN ;FIND THE TARGET LINE JNZ AHOW ;NOT THERE. SAY "HOW?" LHLD CURRNT ;FOUND IT, SAVE OLD PUSH H ;'CURRNT' OLD 'STKGOS' LHLD STKGOS PUSH H LXI H,0 ;AND LOAD NEW ONES SHLD LOPVAR DAD SP SHLD STKGOS JMP RUNTSL ;THEN RUN THAT LINE RETURN CALL ENDCHK ;THERE MUST BE A 0DH LHLD STKGOS ;OLD STACK POINTER MOV A,H ;0 MEANS NOT EXIST ORA L JZ QWHAT ;SO, WE SAY: "WHAT?" SPHL ;ELSE, RESTORE IT POP H SHLD STKGOS ;AND THE OLD 'STKGOS' POP H SHLD CURRNT ;AND THE OLD 'CURRNT' POP D ;OLD TEXT POINTER CALL POPA ;OLD "FOR" PARAMETERS RST 6 ;AND WE ARE BACK HOME ;* ;************************************************************** ;* ;* *** FOR *** & NEXT *** ;* ;* 'FOR' HAS TWO FORMS: ;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2' ;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH ;* EXP1=1. (I.E., WITH A STEP OF +1.) ;* TBI WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE ;* CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXPR2 AND EXP1 ;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTERr ETC. IN ;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC', ;* 'LOPLMT', 'LOPLN', AND 'LOPPT'. IFF THERE IS ALREADY SOME- ;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO ;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK ;* BEFORE THE NEW ONE OVERWRITES IT. ;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IFF THIS SAME ;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP. ;* IFF THAT IS THE CASE THEN THE OLD 'FOR' LOOP IS DEACTIVATED. ;* (PURGED FROM THE STACK..) ;* ;* 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL) ;* END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED ;* WITH THE 'LOPVAR'. IFF THEY ARE NOT THE SAME, TBI DIGS IN ;* THE STACK TO FIND THE RIGHTt ONE AND PURGES ALL THOSE THAT ;* DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO ;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IFF IT ;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND ;* FOLLOWING THE 'FOR'. IFF OUTSIDE THE LIMIT, THE SAVE ARER ;* IS PURGED AND EXECUTION CONTINUES. ;* FOR CALL PUSHA ;SAVE THE OLD SAVE AREA CALL SETVAL ;SET THE CONTROL VAR. DCX H ;HL IS ITS ADDRESS SHLD LOPVAR ;SAVE THAT LXI H,TAB5-1 ;USE 'EXEC' TO LOOK JMP EXEC ;FOR THE WORD 'TO' FR1 RST 3 ;EVALUATE THE LIMIT SHLD LOPLMT ;SAVE THAT LXI H,TAB6-1 ;USE 'EXEC' TO LOOK JMP EXEC ;FOR THE WORD 'STEP' FR2 RST 3 ;FOUND IT, GET STEP JMP FR4 FR3 LXI H,1Q ;NOT FOUND, SET TO 1 FR4 SHLD LOPINC ;SAVE THAT TOO FR5 LHLD CURRNT ;SAVE CURRENT LINE # SHLD LOPLN XCHG ;AND TEXT POINTER SHLD LOPPT LXI B,12Q ;DIG INTO STACK TO LHLD LOPVAR ;FIND 'LOPVAR' XCHG MOV H,B MOV L,B ;HL=0 NOW DAD SP ;HERE IS THE STACK DB 76Q FR7 DAD B ;EACH LEVEL IS 10 DEEP MOV A,M ;GET THAT OLD 'LOPVAR' INX H ORA M JZ FR8 ;0 SAYS NO MORE IN IT MOV A,M DCX H CMP D ;SAME AS THIS ONE? JNZ FR7 MOV A,M ;THE OTHER HALF? CMP E JNZ FR7 XCHG ;YES, FOUND ONE LXI H,0Q DAD SP ;TRY TO MOVE SP MOV B,H MOV C,L LXI H,12Q DAD D CALL MVDOWN ;AND PURGE 10 WORDS SPHL ;IN THE STACK FR8 LHLD LOPPT ;JOB DONE, RESTORE DE XCHG RST 6 ;AND CONTINUE ;* NEXT RST 7 ;GET ADDRESS OF VAR. JC QWHAT ;NO VARIABLE, "WHAT?" SHLD VARNXT ;YES, SAVE IT NX0 PUSH D ;SAVE TEXT POINTER XCHG LHLD LOPVAR ;GET VAR. IN 'FOR' MOV A,H ORA L ;0 SAYS NEVER HAD ONE JZ AWHAT ;SO WE ASK: "WHAT?" RST 4 ;ELSE WE CHECK THEM JZ NX3 ;OK, THEY AGREE POP D ;NO, LET'S SEE CALL POPA ;PURGE CURRENT LOOP LHLD VARNXT ;AND POP ONE LEVEL JMP NX0 ;GO CHECK AGAIN NX3 MOV E,M ;COME HERE WHEN AGREED INX H MOV D,M ;DE=VALUE OF VAR. LHLD LOPINC PUSH H DAD D ;ADD ONE STEP XCHG LHLD LOPVAR ;PUT IT BACK MOV M,E INX H MOV M,D LHLD LOPLMT ;HL->LIMIT POP PSW ;OLD HL ORA A JP NX1 ;STEP > 0 XCHG NX1 CALL CKHLDE ;COMPARE WITH LIMIT POP D ;RESTORE TEXT POINTER JC NX2 ;OUTSIDE LIMIT LHLD LOPLN ;WITHIN LIMIT, GO SHLD CURRNT ;BACK TO THE SAVED LHLD LOPPT ;'CURRNT' AND TEXT XCHG ;POINTER RST 6 NX2 CALL POPA ;PURGE THIS LOOP RST 6 ;* ;************************************************************** ;* ;* *** REM *** IFF *** INPUT *** & LET (& DEFLT) *** ;* ;* 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. ;* TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION. ;* ;* 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE ;* COMMANDS (INCLUDING OUTHER 'IF'S) SEPERATED BY SEMI-COLONS. ;* NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE ;* EXPR. IFF IT IS NON-ZERO, EXECUTION CONTINUES. IFF THE ;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND ;* EXECUTION CONTINUES AT THE NEXT LINE. ;* ;* 'IPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED ;* BY A LIST OF ITEMS. IFF THE ITEM IS A STRING IN SINGLE OR ;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS ;* IN 'PRINT'. IFF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS ;* PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN ;* EXPR. TO BE TYPED IN. THE VARIABLE ISs THEN SET TO THE ;* VALUE OF THIS EXPR. IFF THE VARIABLE IS PROCEDED BY A STRING ;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE ;* PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. ;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR. ;* ;* IFF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", ;* "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT. ;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C. ;* THIS IS HANDLED IN 'INPERR'. ;* ;* 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS. ;* EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR. ;* TBI EVALUATES THE EXPR. AND SET THE VARIBLE TO THAT VALUE. ;* TB WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'. ;* THIS IS DONE BY 'DEFLT'. ;* REM LXI H,0Q ;*** REM *** DB 76Q ;* IFF RST 3 ;*** IFF *** MOV A,H ;IS THE EXPR.=0? ORA L JNZ RUNSML ;NO, CONTINUE CALL FNDSKP ;YES, SKIP REST OF LINE JNC RUNTSL JMP RSTART ;* INPERR LHLD STKINP ;*** INPERR *** SPHL ;RESTORE OLD SP POP H ;AND OLD 'CURRNT' SHLD CURRNT POP D ;AND OLD TEXT POINTER POP D ;REDO INPUT ;* INPUT EQU $ ;*** INPUT *** IP1 PUSH D ;SAVE IN CASE OF ERROR CALL QTSTG ;IS NEXT ITEM A STRING? JMP IP2 ;NO RST 7 ;YES. BUT FOLLOWED BY A JC IP4 ;VARIABLE? NO. JMP IP3 ;YES. INPUT VARIABLE IP2 PUSH D ;SAVE FOR 'PRTSTG' RST 7 ;MUST BE VARIABLE NOW JC QWHAT ;"WHAT?" IT IS NOT? LDAX D ;GET READY FOR 'RTSTG' MOV C,A SUB A STAX D POP D CALL PRTSTG ;PRINT STRING AS PROMPT MOV A,C ;RESTORE TEXT DCX D STAX D IP3 PUSH D ;SAVE IN CASE OF ERROR XCHG LHLD CURRNT ;ALSO SAVE 'CURRNT' PUSH H LXI H,IP1 ;A NEGATIVE NUMBER SHLD CURRNT ;AS A FLAG LXI H,0Q ;SAVE SP TOO DAD SP SHLD STKINP PUSH D ;OLD HL MVI A,72Q ;PRINT THIS TOO CALL GETLN ;AND GET A LINE IP3A LXI D,BUFFER ;POINTS TO BUFFER RST 3 ;EVALUATE INPUT NOP ;CAN BE 'CALL ENDCHK' NOP NOP POP D ;OK, GET OLD HL XCHG MOV M,E ;SAVE VALUE IN VAR. INX H MOV M,D POP H ;GET OLD 'CURRNT' SHLD CURRNT POP D ;AND OLD TEXT POINTER IP4 POP PSW ;PURGE JUNK IN STACK RST 1 ;IS NEXT CH. ','? DB ',' DB 3Q JMP IP1 ;YES, MORE ITEMS. IP5 RST 6 ;* DEFLT LDAX D ;*** DEFLT *** CPI 0DH ;EMPTY LINE IS OK JZ LT1 ;ELSE IT IS 'LET' ;* LET CALL SETVAL ;*** LET *** RST 1 ;SET VALUE TO VAR. DB ',' DB 3Q JMP LET ;ITEM BY ITEM LT1 RST 6 ;UNTIL FINISH ;* ;************************************************************** ;* ;* *** EXPR *** ;* ;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. ;* <EXPR>::=<EXPR2> ;* <EXPR2><REL.OP.><EXPR2> ;* WHERE <REL.OP.> IS ONE OF THE OPERATORSs IN TAB8 AND THE ;* RESULT OF THESE OPERATIONS IS 1 IFF TRUE AND 0 IFF FALSE. ;* <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....) ;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS. ;* <EXPR3>::=<EXPR4>(<* OR /><EXPR4>)(....) ;* <EXPR4>::=<VARIABLE> ;* <FUNCTION> ;* (<EXPR>) ;* <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR> ;* AS INDEX, FNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND ;* <EXPR4> CAN BE AN <EXPR> IN PARANTHESE. ;* ;* EXPR CALL EXPR2 THIS IS AT LOC. 18 ;* PUSH HL SAVE <EXPR2> VALUE EXPR1 LXI H,TAB8-1 ;LOOKUP REL.OP. JMP EXEC ;GO DO IT XP11 CALL XP18 ;REL.OP.">=" RC ;NO, RETURN HL=0 MOV L,A ;YES, RETURN HL=1 RET XP12 CALL XP18 ;REL.OP."#" RZ ;FALSE, RETURN HL=0 MOV L,A ;TRUE, RETURN HL=1 RET XP13 CALL XP18 ;REL.OP.">" RZ ;FALSE RC ;ALSO FALSE, HL=0 MOV L,A ;TRUE, HL=1 RET XP14 CALL XP18 ;REL.OP."<=" MOV L,A ;SET HL=1 RZ ;REL. TRUE, RETURN RC MOV L,H ;ELSE SET HL=0 RET XP15 CALL XP18 ;REL.OP."=" RNZ ;FALSE, RETRUN HL=0 MOV L,A ;ELSE SET HL=1 RET XP16 CALL XP18 ;REL.OP."<" RNC ;FALSE, RETURN HL=0 MOV L,A ;ELSE SET HL=1 RET XP17 POP H ;NOT REL.OP. RET ;RETURN HL=<EXPR2> XP18 MOV A,C ;SUBROUTINE FOR ALL POP H ;REL.OP.'S POP B PUSH H ;REVERSE TOP OF STACK PUSH B MOV C,A CALL EXPR2 ;GET 2ND <EXPR2> XCHG ;VALUE IN DE NOW XTHL ;1ST <EXPR2> IN HL CALL CKHLDE ;COMPARE 1ST WITH 2ND POP D ;RESTORE TEXT POINTER LXI H,0Q ;SET HL=0, A=1 MVI A,1 RET ;* EXPR2 RST 1 ;NEGATIVE SIGN? DB '-' DB 6Q LXI H,0Q ;YES, FAKE '0-' JMP XP26 ;TREAT LIKE SUBTRACT XP21 RST 1 ;POSITIVE SIGN? IGNORE DB '+' DB 0Q XP22 CALL EXPR3 ;1ST <EXPR3> XP23 RST 1 ;ADD? DB '+' DB 25Q PUSH H ;YES, SAVE VALUE CALL EXPR3 ;GET 2ND<EXPR3> XP24 XCHG ;2ND IN DE XTHL ;1ST IN HL MOV A,H ;COMPARE SIGN XRA D MOV A,D DAD D POP D ;RESTORE TEXT POINTER JM XP23 ;1ST 2ND SIGN DIFFER XRA H ;1ST 2ND SIGN EQUAL JP XP23 ;SO ISp RESULT JMP QHOW ;ELSE WE HAVE OVERFLOW XP25 RST 1 ;SUBTRACT? DB '-' DB 203Q XP26 PUSH H ;YES, SAVE 1ST <EXPR3> CALL EXPR3 ;GET 2ND <EXPR3> CALL CHGSGN ;NEGATE JMP XP24 ;AND ADD THEM ;* EXPR3 CALL EXPR4 ;GET 1ST <EXPR4> XP31 RST 1 ;MULTIPLY? DB '*' DB 54Q PUSH H ;YES, SAVE 1ST CALL EXPR4 ;AND GET 2ND <EXPR4> MVI B,0Q ;CLEAR B FOR SIGN CALL CHKSGN ;CHECK SIGN XCHG ;2ND IN DE NOW XTHL ;1ST IN HL CALL CHKSGN ;CHECK SIGN OF 1ST MOV A,H ;IS HL > 255 ? ORA A JZ XP32 ;NO MOV A,D ;YES, HOW ABOUT DE ORA D XCHG ;PUT SMALLER IN HL JNZ AHOW ;ALSO >, WILL OVERFLOW XP32 MOV A,L ;THIS IS DUMB LXI H,0Q ;CLEAR RESULT ORA A ;ADD AND COUNT JZ XP35 XP33 DAD D JC AHOW ;OVERFLOW DCR A JNZ XP33 JMP XP35 ;FINISHED XP34 RST 1 ;DIVIDE? DB '/' DB 104Q PUSH H ;YES, SAVE 1ST <EXPR4> CALL EXPR4 ;AND GET 2ND ONE MVI B,0Q ;CLEAR B FOR SIGN CALL CHKSGN ;CHECK SIGN OF 2ND XCHG ;PUT 2ND IN DE XTHL ;GET 1ST IN HL CALL CHKSGN ;CHECK SIGN OF 1ST MOV A,D ;DIVIDE BY 0? ORA E JZ AHOW ;SAY "HOW?" PUSH B ;ELSE SAVE SIGN CALL DIVIDE ;USE SUBROUTINE MOV H,B ;RESULT IN HL NOW MOV L,C POP B ;GET SIGN BACK XP35 POP D ;AND TEXT POINTER MOV A,H ;HL MUST BE + ORA A JM QHOW ;ELSE IT IS OVERFLOW MOV A,B ORA A CM CHGSGN ;CHANGE SIGN IFF NEEDED JMP XP31 ;LOOK OR MORE TERMS ;* EXPR4 LXI H,TAB4-1 ;FIND FUNCTION IN TAB4 JMP EXEC ;AND GO DO IT XP40 RST 7 ;NO, NOT A FUNCTION JC XP41 ;NOR A VARIABLE MOV A,M ;VARIABLE INX H MOV H,M ;VALUE IN HL MOV L,A RET XP41 CALL TSTNUM ;OR IS IT A NUMBER MOV A,B ;# OF DIGIT ORA A RNZ ;OK PARN RST 1 ;NO DIGIT, MUST BE DB '(' DB 5Q RST 3 ;"(EXPR)" RST 1 DB ')' DB 1Q XP42 RET XP43 JMP QWHAT ;ELSE SAY: "WHAT?" ;* RND CALL PARN ;*** RND(EXPR) *** MOV A,H ;EXPR MUST BE + ORA A JM QHOW ORA L ;AND NON-ZERO JZ QHOW PUSH D ;SAVE BOTH PUSH H LHLD RANPNT ;GET MEMORY AS RANDOM LXI D,LSTROM ;NUMBER RST 4 JC RA1 ;WRAP AROUND IFF LAST LXI H,START RA1 MOV E,M INX H MOV D,M SHLD RANPNT POP H XCHG PUSH B CALL DIVIDE ;RND(N)=MOD(M,N)+1 POP B POP D INX H RET ;* ABS CALL PARN ;*** ABS(EXPR) *** CALL CHKSGN ;CHECK SIGN MOV A,H ;NOTE THAT -32768 ORA H ;CANNOT CHANGE SIGN JM QHOW ;SO SAY: "HOW?" RET SIZE LHLD TXTUNF ;*** SIZE *** PUSH D ;GET THE NUMBER OF FREE XCHG ;BYTES BETWEEN 'TXTUNF' SIZEA LXI H,VARBGN ;AND 'VARBGN' CALL SUBDE POP D RET ;* ;********************************************************* ;* ;* *** OUT *** INP *** WAIT *** POKE *** PEEK *** & USR ;* ;* OUT I,J(,K,L) ;* ;* OUTPUTS EXPRESSION 'J' TO PORT 'I', AND MAY BE REPEATED ;* AS IN DATA 'L' TO PORT 'K' AS MANY TIMES AS NEEDED ;* THIS COMMAND MODIFIES ;* THIS COMMAND MODIFIES ;* THIS COMMAND MODIFY'S A SMALL SECTION OF CODE LOCATED ;* JUST ABOVE ADDRESS 2K ;* ;* INP (I) ;* ;* THIS FUNCTION RETURNS DATA READ FROM INPUT PORT 'I' AS ;* IT'S VALUE. ;* IT ALSO MODIFIES CODE JUST ABOVE 2K. ;* ;* WAIT I,J,K ;* ;* THIS COMMAND READS THE STATUS OF PORT 'I', EXCLUSIVE OR'S ;* THE RESULT WITH 'K' IF THERE IS ONE, OR IF NOT WITH 0, ;* AND'S WITH 'J' AND RETURNS WHEN THE RESULT IS NONZERO. ;* ITS MODIFIED CODE IS ALSO ABOVE 2K. ;* ;* POKE I,J(,K,L) ;* ;* THIS COMMAND WORKS LIKE OUT EXCEPT THAT IT PUTS DATA 'J' ;* INTO MEMORY LOCATION 'I'. ;* ;* PEEK (I) ;* ;* THIS FUNCTION WORKS LIKE INP EXCEPT IT GETS IT'S VALUE ;* FROM MEMORY LOCATION 'I'. ;* ;* USR (I(,J)) ;* ;* USR CALLS A MACHINE LANGUAGE SUBROUTINE AT LOCATION 'I' ;* IF THE OPTIONAL PARAMETER 'J' IS USED ITS VALUE IS PASSED ;* IN H&L. THE VALUE OF THE FUNCTION SHOULD BE RETURNED IN H&L. ;* ;************************************************************ ;* OUTCMD RST 3 MOV A,L STA OUTIO + 1 RST 1 DB ',' DB 2FH RST 3 MOV A,L CALL OUTIO RST 1 DB ',' DB 03H JMP OUTCMD RST 6 WAITCM RST 3 MOV A,L STA WAITIO + 1 RST 1 DB ',' DB 1BH RST 3 PUSH H RST 1 DB ',' DB 7H RST 3 MOV A,L POP H MOV H,A JMP $ + 2 MVI H,0 JMP WAITIO INP CALL PARN MOV A,L STA INPIO + 1 MVI H,0 JMP INPIO JMP QWHAT POKE RST 3 PUSH H RST 1 DB ',' DB 12H RST 3 MOV A,L POP H MOV M,A RST 1 DB ',',03H JMP POKE RST 6 PEEK CALL PARN MOV L,M MVI H,0 RET JMP QWHAT USR PUSH B RST 1 DB '(',28D ;QWHAT RST 3 ;EXPR RST 1 DB ')',7 ;PASPARM PUSH D LXI D,USRET PUSH D PUSH H RET ;CALL USR ROUTINE PASPRM RST 1 DB ',',14D PUSH H RST 3 RST 1 DB ')',9 POP B PUSH D LXI D,USRET PUSH D PUSH B RET ;CALL USR ROUTINE USRET POP D POP B RET JMP QWHAT ;* ;************************************************************** ;* ;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** ;* ;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL ;* ;* 'SUBDE' SUBTRACTS DE FROM HL ;* ;* 'CHKSGN' CHECKS SIGN OF HL. IFF +, NO CHANGE. IFF -, CHANGE ;* SIGN AND FLIP SIGN OF B. ;* ;* 'CHGSGN' CHNGES SIGN OF HL AND B UNCONDITIONALLY. ;* ;* 'CKHLE' CHECKS SIGN OF HL AND DE. IFF DIFFERENT, HL AND DE ;* ARE INTERCHANGED. IFF SAME SIGN, NOT INTERCHANGED. EITHER ;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. ;* DIVIDE PUSH H ;*** DIVIDE *** MOV L,H ;DIVIDE H BY DE MVI H,0 CALL DV1 MOV B,C ;SAVE RESULT IN B MOV A,L ;(REMAINDER+L)/DE POP H MOV H,A DV1 MVI C,377Q ;RESULT IN C DV2 INR C ;DUMB ROUTINE CALL SUBDE ;DIVIDE BY SUBTRACT JNC DV2 ;AND COUNT DAD D RET ;* SUBDE MOV A,L ;*** SUBDE *** SUB E ;SUBTRACT DE FROM MOV L,A ;HL MOV A,H SBB D MOV H,A RET ;* CHKSGN MOV A,H ;*** CHKSGN *** ORA A ;CHECK SIGN OF HL RP ;IFF -, CHANGE SIGN ;* CHGSGN MOV A,H ;*** CHGSGN *** CMA ;CHANGE SIGN OF HL MOV H,A MOV A,L CMA MOV L,A INX H MOV A,B ;AND ALSO FLIP B XRI 200Q MOV B,A RET ;* CKHLDE MOV A,H XRA D ;SAME SIGN? JP CK1 ;YES, COMPARE XCHG ;NO, XCH AND COMP CK1 RST 4 RET ;* ;************************************************************** ;* ;* *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) *** ;* ;* "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND ;* THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE ;* TO THAT VALUE. ;* ;* "FIN" CHECKS THE END OF A COMMAND. IFF IT ENDED WITH ";", ;* EXECUTION CONTINUES. IFF IT ENDED WITH A CR, IT FINDS THE ;* NEXT LINE AND CONTINUE FROM THERE. ;* ;* "ENDCHK" CHECKS IFF A COMMAND IS ENDED WITH CR. THIS IS ;* REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) ;* ;* "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). ;* IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" ;* INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP ;* O THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED ;* AND TBI IS RESTARTED. HOWEVER, IFF 'CURRNT' -> ZERO ;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT ;* PRINTED. AND IFF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' ;* COMMAND, THE INPUT LINE IS NOT PRINTED AND EXECUTION IS ;* NOT TERMINATED BUT CONTINUED AT 'INPERR'. ;* ;* RELATED TO 'ERROR' ARE THE FOLLOWING: ;* 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?" ;* 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'. ;* 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. ;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS ;* SETVAL RST 7 ;*** SETVAL *** JC QWHAT ;"WHAT?" NO VARIABLE PUSH H ;SAVE ADDRESS OF VAR. RST 1 ;PASS "=" SIGN DB '=' DB 10Q RST 3 ;EVALUATE EXPR. MOV B,H ;VALUE IN BC NOW MOV C,L POP H ;GET ADDRESS MOV M,C ;SAVE VALUE INX H MOV M,B RET SV1 JMP QWHAT ;NO "=" SIGN ;* FIN RST 1 ;*** FIN *** DB 73Q DB 4Q POP PSW ;";", PURGE RET ADDR. JMP RUNSML ;CONTINUE SAME LINE FI1 RST 1 ;NOT ";", IS IT CR? DB 0DH DB 4Q POP PSW ;YES, PURGE RET ADDR. JMP RUNNXL ;RUN NEXT LINE FI2 RET ;ELSE RETURN TO CALLER ;* ENDCHK RST 5 ;*** ENDCHK *** CPI 0DH ;END WITH CR? RZ ;OK, ELSE SAY: "WHAT?" ;* QWHAT PUSH D ;*** QWHAT *** AWHAT LXI D,WHAT ;*** AWHAT *** ERROR SUB A ;*** ERROR *** CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' POP D ;OR 'SORRY' LDAX D ;SAVE THE CHARACTER PUSH PSW ;AT WHERE OLD DE -> SUB A ;AND PUT A 0 THERE STAX D LHLD CURRNT ;GET CURRENT LINE # PUSH H MOV A,M ;CHECK THE VALUE INX H ORA M POP D JZ RSTART ;IFF ZERO, JUST RERSTART MOV A,M ;IFF NEGATIVE, ORA A JM INPERR ;REDO INPUT CALL PRTLN ;ELSE PRINT THE LINE DCX D ;UPTO WHERE THE 0 IS POP PSW ;RESTORE THE CHARACTER STAX D MVI A,77Q ;PRINTt A "?" RST 2 SUB A ;AND THE REST OF THE CALL PRTSTG ;LINE JMP RSTART QSORRY PUSH D ;*** QSORRY *** ASORRY LXI D,SORRY ;*** ASORRY *** JMP ERROR ;* ;************************************************************** ;* ;* *** GETLN *** FNDLN (& FRIENDS) *** ;* ;* 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT ;* THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS THE ;* THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL ;* ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE ;* THE LAST CHARATER (IFF THERE IS ONE), AND ALT-MOD IS USED TO ;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER. ;* 0DHSIGNALS THE END OF A LINE, AND CAUE 'GETLN' TO RETURN. ;* ;* 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE ;* TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IFF THE ;* LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE ;* (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z. ;* IFF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE # ;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IFF ;* WE REACHED THE END OF TEXT SAVE ARE AND CANNOT FIND THE ;* LINE, FLAGS ARE C & NZ. ;* 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE ;* AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS ;* ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH. ;* 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #. ;* 'FNDNXT' WILL BUMP DE BY 2, FIND A 0DHAND THEN START SEARCH. ;* 'FNDSKP' USE DE TO FIND A CR, AND THEN STRART SEARCH. ;* GETLN RST 2 ;*** GETLN *** LXI D,BUFFER ;PROMPT AND INIT GL1 CALL CHKIO ;CHECK KEYBOARD JZ GL1 ;NO INPUT, WAIT CPI 177Q ;DELETE LST CHARACTER? JZ GL3 ;YES CPI 12Q ;IGNORE LF JZ GL1 ORA A ;IGNORE NULL JZ GL1 CPI 134Q ;DELETE THE WHOLE LINE? JZ GL4 ;YES STAX D ;ELSE, SAVE INPUT INX D ;AND BUMP POINTER CPI 15Q ;WAS IT CR? JNZ GL2 ;NO MVI A,12Q ;YES, GET LINE FEED RST 2 ;CALL OUTC AND LINE FEED RET ;WE'VE GOT A LINE GL2 MOV A,E ;MORE FREE ROOM? CPI BUFEND AND 0FFH JNZ GL1 ;YES, GET NEXT INPUT GL3 MOV A,E ;DELETE LAST CHARACTER CPI BUFFER AND 0FFH ;BUT DO WE HAVE ANY? JZ GL4 ;NO, REDO WHOLE LINE DCX D ;YES, BACKUP POINTER MVI A,'_' ;AND ECHO A BACK-SPACE RST 2 JMP GL1 ;GO GET NEXT INPUT GL4 CALL CRLF ;REDO ENTIRE LINE MVI A,136Q ;CR, LF AND UP-ARROW JMP GETLN ;* FNDLN MOV A,H ;*** FNDLN *** ORA A ;CHECK SIGN OF HL JM QHOW ;IT CANNT BE - LXI D,TXTBGN ;INIT. TEXT POINTER ;* FNDLNP EQU $ ;*** FNDLNP *** FL1 PUSH H ;SAVE LINE # LHLD TXTUNF ;CHECK IFF WE PASSED END DCX H RST 4 POP H ;GET LINE # BACK RC ;C,NZ PASSED END LDAX D ;WE DID NOT, GET BYTE 1 SUB L ;IS THIS THE LINE? MOV B,A ;COMPARE LOW ORDER INX D LDAX D ;GET BYTE 2 SBB H ;COMPARE HIGH ORDER JC FL2 ;NO, NOT THERE YET DCX D ;ELSE WE EITHER FOUND ORA B ;IT, OR IT IS NOT THERE RET ;NC,Z:FOUND; NC,NZ:NO ;* FNDNXT EQU $ ;*** FNDNXT *** INX D ;FIND NEXT LINE FL2 INX D ;JUST PASSED BYTE 1 & 2 ;* FNDSKP LDAX D ;*** FNDSKP *** CPI 0DH ;TRY TO FIND 0DH JNZ FL2 ;KEEP LOOKING INX D ;FOUND CR, SKIP OVER JMP FL1 ;CHECK IFF END OF TEXT ;* ;************************************************************* ;* ;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN *** ;* ;* 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING ;* AND RETURNS TO CAL╠ER WHEN EITHER A 0DHIS PRINTED OR WHEN ;* THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE ;* CALLER). OLD A IS STORED IN B, OLD B IS LOST. ;* ;* 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE ;* QUOTE. IFF NONE OF THESE, RETURN TO CALLER. IFF BACK-ARROW, ;* OUTPUT A 0DHWITHOUT A LF. IFF SINGLE OR DOUBLE QUOTE, PRINT ;* THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. ;* AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED ;* OVER (USUALLY A JUMP INSTRUCTION). ;* ;* 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED ;* IFF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C. ;* HOWEVER, IFF THE NUMBER OF DIGITS IS LARGER THAN THE # IN ;* C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO ;* PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT. ;* ;* 'PRTLN' PRINSrA SAVED TEXT LINE WITH LINE # AND ALL. ;* PRTSTG MOV B,A ;*** PRTSTG *** PS1 LDAX D ;GET A CHARACTERr INX D ;BUMP POINTER CMP B ;SAME AS OLD A? RZ ;YES, RETURN RST 2 ;ELSE PRINT IT CPI 0DH ;WAS IT A CR? JNZ PS1 ;NO, NEXT RET ;YES, RETURN ;* QTSTG RST 1 ;*** QTSTG *** DB '"' DB 17Q MVI A,42Q ;IT IS A " QT1 CALL PRTSTG ;PRINT UNTIL ANOTHER CPI 0DH ;WAS LAST ONE A CR? POP H ;RETURN ADDRESS JZ RUNNXL ;WAS CR, RUN NEXT LINE QT2 INX H ;SKIP 3 BYTES ON RETURN INX H INX H PCHL ;RETURN QT3 RST 1 ;IS IT A ' ? DB 47Q DB 5Q MVI A,47Q ;YES, DO SAME JMP QT1 ;AS IN " QT4 RST 1 ;IS IT BACK-ARROW? DB 137Q DB 10Q MVI A,215Q ;YES, 0DHWITHOUT LF!! RST 2 ;DO IT TWICE TO GIVE RST 2 ;TTY ENOUGH TIME POP H ;RETURN ADDRESS JMP QT2 QT5 RET ;NONE OF ABOVE ;* PRTNUM PUSH D ;*** PRTNUM *** LXI D,12Q ;DECIMAL PUSH D ;SAVE AS A FLAG MOV B,D ;B=SIGN DCR C ;C=SPACES CALL CHKSGN ;CHECK SIGN JP PN1 ;NO SIGN MVI B,55Q ;B=SIGN DCR C ;'-' TAKES SPACE PN1 PUSH B ;SAVE SIGN & SPACE PN2 CALL DIVIDE ;DEVIDE HL BY 10 MOV A,B ;RESULT 0? ORA C JZ PN3 ;YES, WE GOT ALL XTHL ;NO, SAVE REMAINDER DCR L ;AND COUNT SPACE PUSH H ;HL IS OLD BC MOV H,B ;MOVE RESULT TO BC MOV L,C JMP PN2 ;AND DIVIDE BY 10 PN3 POP B ;WE GOT ALL DIGITS IN PN4 DCR C ;THE STACK MOV A,C ;LOOK AT SPACE COUNT ORA A JM PN5 ;NO LEADING BLANKS MVI A,40Q ;LEADING BLANKS RST 2 JMP PN4 ;MORE? PN5 MOV A,B ;PRINT SIGN RST 2 ;MAYBE - OR NULL MOV E,L ;LAST REMAINDER IN E PN6 MOV A,E ;CHECK DIGIT IN E CPI 12Q ;10 IS FLAG FOR NO MORE POP D RZ ;IFF SO, RETURN ADI 60Q ;ELSE CONVERT TO ASCII RST 2 ;AND PRINT THE DIGIT JMP PN6 ;GO BACK FOR MORE ;* PRTLN LDAX D ;*** PRTLN *** MOV L,A ;LOW ORDER LINE # INX D LDAX D ;HIGH ORDER MOV H,A INX D MVI C,4Q ;PRINT 4 DIGIT LINE # CALL PRTNUM MVI A,40Q ;FOLLOWED BY A BLANK RST 2 SUB A ;AND THEN THE TEXT CALL PRTSTG RET ;* ;************************************************************** ;* ;* *** MVUP *** MVDOWN *** POPA *** & PUSHA *** ;* ;* 'MVUP' MOVES A BLOCK UP FROM HERE DE-> TO WHERE BC-> UNTIL ;* DE = HL ;* ;* 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL-> ;* UNTIL DE = BC ;* ;* 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE ;* STACK ;* ;* 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE ;* STACK ;* MVUP RST 4 ;*** MVUP *** RZ ;DE = HL, RETURN LDAX D ;GET ONE BYTE STAX B ;MOVE IT INX D ;INCREASE BOTH POINTERS INX B JMP MVUP ;UNTIL DONE ;* MVDOWN MOV A,B ;*** MVDOWN *** SUB D ;TEST IFF DE = BC JNZ MD1 ;NO, GO MOVE MOV A,C ;MAYBE, OTHER BYTE? SUB E RZ ;YES, RETURN MD1 DCX D ;ELSE MOVE A BYTE DCX H ;BUT FIRST DECREASE LDAX D ;BOTH POINTERS AND MOV M,A ;THEN DO IT JMP MVDOWN ;LOOP BACK ;* POPA POP B ;BC = RETURN ADDR. POP H ;RESTORE LOPVAR, BUT SHLD LOPVAR ;=0 MEANS NO MORE MOV A,H ORA L JZ PP1 ;YEP, GO RETURN POP H ;NOP, RESTORE OTHERS SHLD LOPINC POP H SHLD LOPLMT POP H SHLD LOPLN POP H SHLD LOPPT PP1 PUSH B ;BC = RETURN ADDR. RET ;* PUSHA LXI H,STKLMT ;*** PUSHA *** CALL CHGSGN POP B ;BC=RETURN ADDRESS DAD SP ;IS STACK NEAR THE TOP? JNC QSORRY ;YES, SORRY FOR THAT. LHLD LOPVAR ;ELSE SAVE LOOP VAR.S MOV A,H ;BUT IFF LOPVAR IS 0 ORA L ;THAT WILL BE ALL JZ PU1 LHLD LOPPT ;ELSE, MORE TO SAVE PUSH H LHLD LOPLN PUSH H LHLD LOPLMT PUSH H LHLD LOPINC PUSH H LHLD LOPVAR PU1 PUSH H PUSH B ;BC = RETURN ADDR. RET ;* ;************************************************************** ;* ;* *** OUTC *** & CHKIO ****! ;* THESE ARE THE ONLY I/O ROUTINES IN TBI. ;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IFF OCSW=0 ;* 'OUTC' WILL JUST RETURN TO THE CALLER. IFF OCSW IS NOT 0, ;* IT WILL OUTPUT THE BYTE IN A. IFF THAT IS A CR, A LF IS ALSO ;* SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN, ALL REG. ;* ARE RESTORED. ;* ;* 'CHKIO' CHECKS THE INPUT. IFF NO INPUT, IT WILL RETURN TO ;* THE CALLER WITH THE Z FLAG SET. IFF THERE IS INPUT, Z FLAG ;* IS CLEARED AND THE INPUT BYTE IS IN A. HOWERER, IFF THE ;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND ;* Z FLAG IS RETURNED. IFF A CONTROL-C IS READ, 'CHKIO' WILL ;* RESTART TBI AND DO NOT RETURN TO THE CALLER. ;* ;* OUTC PUSH AF THIS IS AT LOC. 10 ;* LD A,OCSW CHECK SOFTWARE SWITCH ;* IOR A OC2 JNZ OC3 ;IT IS ON POP PSW ;IT IS OFF RET ;RESTORE AF AND RETURN OC3 POP A ;GET OLD A BACK PUSH B ;SAVE B ON STACK PUSH D ;AND D PUSH H ;AND H TOO STA OUTCAR ;SAVE CHARACTER MOV E,A ;PUT CHAR. IN E FOR CPM MVI C,2 ;GET CONOUT COMMAND CALL CPM ;CALL CPM AND DO IT LDA OUTCAR ;GET CHAR. BACK CPI 0DH ;WAS IT A 'CR'? JNZ DONE ;NO, DONE MVI E,0AH ;GET LINEFEED MVI C,2 ;AND CONOUT AGAIN CALL CPM ;CALL CPM DONE LDA OUTCAR ;GET CHARACTER BACK IDONE POP H ;GET H BACK POP D ;AND D POP B ;AND B TOO RET ;DONE AT LAST CHKIO PUSH B ;SAVE B ON STACK PUSH D ;AND D PUSH H ;THEN H MVI C,11 ;GET CONSTAT WORD CALL CPM ;CALL THE BDOS ORA A ;SET FLAGS JNZ CI1 ;IF READY GET CHARACTER JMP IDONE ;RESTORE AND RETURN CI1 MVI C,1 ;GET CONIN WORD CALL CPM ;CALL THE BDOS CPI 0FH ;IS IT CONTROL-O? JNZ CI2 ;NO, MORE CHECKING LDA OCSW ;CONTROL-O FLIP OCSW CMA ;ON TO OFF, OFF TO ON STA OCSW ;AND PUT IT BACK JMP CHKIO ;AND GET ANOTHER CHARACTER CI2 CPI 3 ;IS IT CONTROL-C? JNZ IDONE ;RETURN AND RESTORE IF NOT JMP RSTART ;YES, RESTART TBI LSTROM EQU $ ;ALL ABOVE CAN BE ROM OUTIO OUT 0FFH RET WAITIO IN 0FFH XRA H ANA L JZ WAITIO RST 6 INPIO IN 0FFH MOV L,A RET OUTCAR DB 0 ;OUTPUT CHAR. STORAGE OCSW DB 0FFH ;SWITCH FOR OUTPUT CURRNT DW 0 ;POINTS TO CURRENT LINE STKGOS DW 0 ;SAVES SP IN 'GOSUB' VARNXT DW 0 ;TEMPORARY STORAGE STKINP DW 0 ;SAVES SP IN 'INPUT' LOPVAR DW 0 ;'FOR' LOOP SAVE AREA LOPINC DW 0 ;INCREMENT LOPLMT DW 0 ;LIMIT LOPLN DW 0 ;LINE NUMBER LOPPT DW 0 ;TEXT POINTER RANPNT DW START ;RANDOM NUMBER POINTER TXTUNF DW TXTBGN ;->UNFILLED TEXT AREA TXTBGN DS 1 ;TEXT SAVE AREA BEGINS MSG1 DB 7FH,7FH,7FH,'SHERRY BROTHERS TINY BASIC VER. 3.1',0DH INIT MVI A,0FFH STA OCSW ;TURN ON OUTPUT SWITCH MVI A,0CH ;GET FORM FEED RST 2 ;SEND TO CRT PATLOP SUB A ;CLEAR ACCUMULATOR LXI D,MSG1 ;GET INIT MESSAGE CALL PRTSTG ;SEND IT LSTRAM LDA 7 ;GET FBASE FOR TOP STA RSTART+2 DCR A ;DECREMENT FOR OTHER POINTERS STA SS1A+2 ;AND FIX THEM TOO STA TV1A+2 STA ST3A+2 STA ST4A+2 STA IP3A+2 STA SIZEA+2 STA GETLN+3 STA PUSHA+2 LXI H,ST1 ;GET NEW START JUMP SHLD START+1 ;AND FIX IT JMP ST1 ; RESTART TABLE ORG 0A50H RSTBL: XTHL ;*** TSTC OR RST 1 *** RST 5 ;IGNORE BLANKS AND CMP M ;TEST CHARACTER JMP TC1 ;REST OF THIS IS AT TC1 ;* CRLF: EQU 0EH ;EXECUTE TIME LOCATION OF THIS INSTRUCTION. MVI A,0DH ;*** CRLF *** ;* PUSH PSW ;*** OUTC OR RST 2 *** LDA OCSW ;PRINT CHARACTER ONLY ORA A ;IFF OCSW SWITCH IS ON JMP OC2 ;REST OF THIS IS AT OC2 ;* CALL EXPR2 ;*** EXPR OR RST 3 *** PUSH H ;EVALUATE AN EXPRESION JMP EXPR1 ;REST OF IT IS AT EXPR1 DB 'W' ;* MOV A,H ;*** COMP OR RST 4 *** CMP D ;COMPARE HL WITH DE RNZ ;RETURN CORRECT C AND MOV A,L ;Z FLAGS CMP E ;BUT OLD A IS LOST RET DB 'AN' ;* SS1: EQU 28H ;EXECUTE TIME LOCATION OF THIS INSTRUCTION. LDAX D ;*** IGNBLK/RST 5 *** CPI 40Q ;IGNORE BLANKS RNZ ;IN TEXT (WHERE DE->) INX D ;AND RETURN THE FIRST JMP SS1 ;NON-BLANK CHAR. IN A ;* POP PSW ;*** FINISH/RST 6 *** CALL FIN ;CHECK END OF COMMAND JMP QWHAT ;PRINT "WHAT?" IFF WRONG DB 'G' ;* RST 5 ;*** TSTV OR RST 7 *** SUI 100Q ;TEST VARIABLES RC ;C:NOT A VARIABLE JMP TSTV1 ;JUMP AROUND RESERVED AREA ; ROUTINE TO COPY RESTART TABLE INTO LOW MEMORY RST1: EQU 8 ;LOCATION FIRST REATART ROUTINE EOT: EQU 40H ;LAST LOC TO BE FILLED ORG 0AA0H NINIT: LXI H,RST1 ;POINT TO BEGINNING OF MODEL TABLE LXI D,RSTBL NXT: LDAX D MOV M,A INX H INX D MVI A,EOT CMP L JNZ NXT LXI H,INIT SHLD START+1 JMP START ORG 0F00H TXTEND EQU $ ;TEXT SAVE AREA ENDS VARBGN DS 2*27 ;VARIABLE @(0) DS 1 ;EXTRA BYTE FOR BUFFER BUFFER DS 80 ;INPUT BUFFER BUFEND EQU $ ;BUFFER ENDS DS 40 ;EXTRA BYTES FOR STACK STKLMT EQU $ ;TOP LIMIT FOR STACK ORG 2000H STACK EQU $ ;STACK STARTS HERE END