URL
https://opencores.org/ocsvn/cpu8080/cpu8080/trunk
Subversion Repositories cpu8080
[/] [cpu8080/] [tags/] [update/] [project/] [tinybasic.asm] - Rev 9
Go to most recent revision | Compare with Previous | Blame | View Log
;**************************************************************
;*
;* 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
;* 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
Go to most recent revision | Compare with Previous | Blame | View Log