home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug018.ark
/
CASUAL.ASM
next >
Wrap
Assembly Source File
|
1984-04-29
|
40KB
|
1,570 lines
;ABBREVIATIONS USED IN COMMENTS:
;
;-> INTO
;ABS( ) ABSOLUTE VALUE OF ( )
;ADR ADDRESS
;ARG ARGUMENT
;BUF BUFFER
;BOTX BEGINNING OF TEXT
;CR CARRIAGE RETURN
;CRLF CARRIAGE RETURN, LINE FEED
;CHR CHARACTER
;CMPR COMPARE
;DECR DECREMENT
;EOP END OF PROGRAM
;EXPR EXPRESSION
;EOS END OF STATEMENT, OR END OF STRING
;EOTX END OF TEXT
;EOB END OF BUFFER
;EOL END OF LINE
;FC FALSE CARRY
;FUN FUNCTION
;FZ FALSE ZERO
;INIT INITIALIZE
;INFO INFORMATION
;INCR INCREMENT
;INST INSTRUCTION
;INP INPUT
;LANG LANGUAGE
;LF LINE FEED
;LINE # LINE NUMBER
;LL LINE LENGTH
;NEOTX NEW END OF TEXT
;OEOTX OLD END OF TEXT
;OP OPERATOR
;OS OPERATING SYSTEM
;PS PARTIAL SUM
;PGM PROGRAM
;QUO QUOTIENT
;RETADR RETURN ADDRESS
;RELOP RELATIONAL OPPERATOR ( <, >, =, # )
;REG REGISTER
;ROT ROUTINE
;STK STACK
;STMT STATEMENT
;SONL START OF NEXT LHNE
;SO>L START OF GREATER THAN LINE
;SO<L START OF LESS THAN LINE
;SOL START OF LINE
;SUB SUBTRACT
;SOS START OF STATEMENT
;SR SUBROUTINE
;SIG DIG SIGNIFICANT DIGIT
;TXA TEXT ADDRESS POINTER
;TST TEST
;TZ TRUE ZERO
;VAL VALUE
;VAR VARIABLE
;VARNAM VARIABLE NAME
;
;
; C A S U A L
;
; CHICAGO AREA SMALL USERS ALGORITHMIC LANGUAGE
;
; WRITTEN BY: ROBERT A. VAN VALZAH
; 1140 HICKORY TRAIL
; DOWNERS GROVE, IL.
; 60515
;
; H (312) 852-0472
; W (312) 971-2010 X 227
;
JMP INIT ;WILL BE POKED TO JMP ENTR
DW USRL ;ADR OF ADR OF ADR OF USERS ML ROT
DW SUBS ;ADR OF ROT USED TO GET USR FUN ARG
;
;RESTART SUBROUTINES. 0 IS SYSTEM RE-ENTRY. 7 IS OPEN.
;1 - 6 ARE USED.
;
;
;RESTART 1 IS THE TST FUNCTION. IN SOURCE CODE IT MUST
;BE FOLLOWED BY AN IFNOT PSEUDO - OP. IT APPEARS LIKE THIS:
;
; TST '+'
; IFNOT TRY- ;CHR AT H IS NOT '+'',' JUMP TO TRY-
; ;FALLS THROUGH TO HERE IF CHR AT H IS '+''
;COMPARED TO THE CHR POINTED TO BY H. IF THE
;TEST IS TRUE, THE IFNOT ADDRESS IS IGNORED AND TST RETURNS.
;ALSO H IS BUMPED AND IT FALLS THROUGH TO NXTC TOSET FLAGS
;IF THE TEST IS FALSE, THE RETURN ADDRESS ON THE STACK
;IS IGNORED AND THE IFNOT ADDRESS IS RETURNED TO,
;WITHOUT BUMPING H.
;STACK USAGE: 2 BYTES. MUNCHES A & FLAGS.
;
ORG 10Q
MOV A,M ;FETCH TEST CHR
XTHL ;TXA ON STK, REFERENCE ADR -> H
CMP M ;COMPARE WITH REFERENCE
INX H ;MOVE RETADR
JMP TST1 ;CONTINUES AT TST1
;
;RESTART 2 IS THE FETCH THE NEXT CHR ROUTINE. H IS BUMPED
;BEFORE THE FETCH. SPACES ARE IGNORED. ON RETURN: FC
;MEANS NON-NUMERIC (NOT 0 - 9), TZ IF A STATEMENT TERMINATOR
;(COLON OR END OF LINE NULL). STACK USAGE: 2 BYTES.
;
ORG 20Q
NXTC: INX H ;BUMP TXA TO NEXT CHR
MOV A,M ;FETCH IT
CPI '9'+1 ;IS IT 0 - 9
RNC ;>9 CARRY FALSE
JMP NXTD ;CONTINUED AT NXTD
;
;RESTART 3 IS THE XPRESSION EVALUATOR. THE VALUE IS
;RETURNED IN PHE DE REG. SEE CONTINUATION FOR MORE INFO.
;
ORG 30Q
CALL EXPA ;GET THE VALUE OF EXPR -> DE
XCHG ;RESULT -> H, TXA -> DE
JMP EXP1 ;CONTINUED AT EXP1
;
;RESTART 4 IS THE DEVO (DEVICE OUTPUT) ROUTINE. THE CHR
;IN THE A REG IS SENT TO THE OUTPUT DEVICE. DOESN'T
;MUNCH ANY REGS OR FLAGS. STACK USAGE: 4 BYTES.
;
ORG 40Q
PUSH PSW ;SAVE A AND FLAGS
DEVQ: IN 17 ;GET READY STATUS -> A
TORM: ANI 1 ;MASK TO THE BIT WE WANT
JMP DEVP ;CONTINUED AT DEVP
;
;RESTART 5 IS THE MESSAGE PRINTER. IT SENDS CHRS
;FROM MEMORY IMMEDIATLY FOLLOWING THE CALL TO IT UNTIL ONE
;WITH BIT 7 HI COMES ALONG. THE RETURN ADDRESS IS
;MODIFIED. STACK USAGE: 6 BYTES.
;
ORG 50Q
MSG: XTHL ;PRINT ADR -> H
MSG1: MOV A,M ;FETCH A CHR
RST 4 ;SEND IT
INX H ;BUMP TXA AND RETURN ADDRESS
ORA A ;BIT 7 HI YET ?
JMP MSG2 ;CONTINUED AT MSG2
;
;RESTART 6 IS A 16 BIT UNSIGNED COMPARE (CMPR). FLAGS ARE
;SET LIKE H - DE. STACK USAGE: 2 BYTES.
;
ORG 60Q
MOV A,H
SUB D
RNZ
MOV A,L
SUB E
RET
DW SPRS ;ADR OF ADR OF ADR OF STACK RESET
;
;RESTART 7 IS OPEN FOR INTERRUPT USE.
;A RETURN IS PUT THERE SO INTERRUPTS WILL BE IGNORED TILL
;IT IS PATCHED OUT. THREE BYTES ARE LEFT FOR A JUMP
;PO AN INTERRUPT SERVICE ROUTINE.
;
ORG 70Q
RET
ORG 73Q
EXP1: SHLD LRES ;SAVE RESULT
XCHG ;RESTORE TXA
RET
;
NXTD: CPI ' ' ;IGNORE BLANKS
JZ NXTC
CPI '0' ;<0?
CMC
INR A ;SET FLAG WTIHOUT AFFECTING CARRY
DCR A
RET
TST1: JNZ NGOT ;NO MATCH
INX H ;MATCH - IGONRE IFNOT ADR
INX H
XTHL ;RESTORE TXA
JMP NXTC ;FOUND IT, INCR TXA AND SET FLAGS
NGOT: MOV A,M ;LOW ORDER IFNOT ADR -> A
INX H
MOV H,M ;IFNOT ADR ON STK, RESTORE TXA
MOV L,A
XTHL
RET
;
MSG2: JP MSG1 ;BIT 7 WAS LOW, PRINT MORE
XTHL ;WAS HIGH, TIME TO RETURN
RET
;
;ERRO IS THE ERROR MESSAGE PRINTER. IT MUST ALLWAYS BE
;CALLED, PHE RETURN ADDRESS IS USED AS THE ERROR NUMBER.
;
SNER: CALL ERRO ;SYNTAX ERROR TO BE JUMPED TO
ERRO: RST 5 ;PRINT 'ERROR'
DB 15Q,12Q,'ERRO','R'+200Q
XTHL ;PRINT ERROR ADDRESS
CALL HLPT
CALL INPT ;PRINT LINE NUMBER OF ERROR
LHLD SSTM ;START OF LAST STATEMENT -> H
DCX H
POP D ;ERROR TXA -> DE
ERRP: RST 6 ;AT BAD SPOT YET?
JNZ ERRQ ;NOPE - PRINT A CHR
RST 5 ;YUP - INSERT A '?'
DB '?'+200Q
ERRQ: RST 2 ;END OF STMT?
JZ ENTR ;YUP - BACK TO COMMAND MODE
RST 4 ;NOPE - PRINT ONE CHR AND
JMP ERRP ;KEEP TRYING
;
;MAIN INTERPRETER ENTRY AND RE-ENTRY POINT. ENTR SENDS RLF
;AND ENTERS LINE INPUT MODE. NOCR DOES SAME, WITHOUT CRLF.
;NUMBERED LINES ARE EDITED INTO TEXT BUFFER.
;UN-NUMBERED LINES ARE PASSED TO STMT FOR EXECUTION.
;
ENTR: CALL CRLF
NOCR: CALL RSSP ;RESET 8080 STACK
RST 5 ;PRINT PROMPT PERIOD '.'
DB '.'+200Q
LXI H,-1 ;SET IMMEDIATE MODE FLAG
SHLD CURL
CALL GETL ;FETCH AN INPUT LINE
RST 2 ;BLANK LINE?
JZ NOCR ;YUP - IGNORE
JNC STMU ;NOT NUMERIC - EXECUTE IT
;
;START OF LINE TEXT EDITOR
;
;TEXT BUFFER FORMAT:
;
; 000
;BOTX: LINE 1
; LINE 2
; LINE 3
; 000
;EOTX: 000
;
;LINE STORAGE FORMAT:
;
; LINE NUMBER LOW 8 BITS
; LINE NUMBER HIGH 8 BITS
; CHRS WHICH APPEAR ON LINE
; 000
;
CALL DEINT ;GET LINE # -> DE
PUSH H ;FIRST CHRADR SAVE
PUSH D ;SAVE LINE #
PUSH PSW ;ZERO TRUE IF BLANK LINE
LXI B,2 ;LINE LENGTH 3 BYTE OVERHEAD
EDT: MOV A,M ;COUNT UP LINE LENGTH -> B
ORA A
INX H
INX B
JNZ EDT ;KEEP COUNTING
POP PSW ;RESTORE FLAGS
PUSH B ;SAVE LINE LENTH
PUSH PSW ;SAVE FLAGS
CALL LFND ;INSERT ADR -> @, SONL -> H
PUSH B ;SAVE INSERT ADR
JNC EDT2 ;COULDN'T FIND, SO INSERT ONLY
XCHG ;SONL -> DE
LHLD EOTX
EDT1: LDAX D ;DELETE OLD LINE
STAX B
INX B
INX D
RST 6 ;DONE YET?
JNC EDT1 ;NOPE
MOV H,B ;SAVE NEW EOTX
MOV L,C
DCX H
SHLD EOTX
EDT2: POP D ;INSERT ADR -> DE
POP PSW ;ANYTHING TO INSERT?
JZ NOCR ;NOPE - EXIT EDITOR
LHLD EOTX
XTHL ;EOTX -> B, LL -> H
POP B
DAD B ;NEW EOTX -> H
PUSH H ;SAVE IT
CALL EOM1 ;ROOM FOR THIS LINE?
PUSH B
XTHL ;OEOTX -> H, NEOTX -> B
POP B
ED21: RST 6 ;MOVE UP FOR NEW LINE
MOV A,M ;FROM OEOTX -> NEOTX
STAX B
DCX B
DCX H
JNZ ED21 ;NOT DONE YET
POP H ;RESTORE NEOTX
SHLD EOTX
XCHG ;INSERT ADR -> H
POP D ;LINE # -> DE
MOV M,E ;PUT N NEW LINE #
INX H
MOV M,D
INX H
POP D ;ADROF TEXT ON LINE
EDT3: LDAX D ;PUT IT IN BUFFER
MOV M,A
INX H
INX D
ORA A
JNZ EDT3 ;NOT DONE INSERTING
JMP NOCR ;GET ANOTHER LINE
;
;LFND IS THE LINE FINDER.
;TRIES TO FIND THE LINE # IN DE IN THE BUFFER.
;IT WILL EITHER FIND IT, OR HIT THE EOB FIRST, OR GO
;ONE LINE PAST BUT NOT HIT EOB. RETURN CONDITIONS FOLLOW:
;
; IF
; --
; EOB GOT IT NEXT >
; --- ------ ------
; HL EOB SONL SO>L
; BC EOB SOL SO<L
; CARRY FALSE TRUE FALSE
; ZERO TRUE TRUE FALSE
;
;USES ALL REGS AND FLAGS EXCEPT DE. STACK USAGE: 6 BYTES.
;
LFND: LHLD BOTX ;START AT BEGINNING OF TEXT
LFNE: MOV B,H ;SAVE START OF LINE -> B
MOV C,L
MOV A,M ;EOB?
INX H
ORA M
DCX H
RZ ;YUP - ZERO TRUE, CARRY FALSE
MOV A,M ;RELOAD LOW ORDER -> A
INX H
PUSH H ;SAVE SOL TXA+1
MOV H,M ;LINE # -> H
MOV L,A
RST 6 ;LINE # WE WANT ?
POP H ;SOL+1 -> H
PUSH PSW ;SAVE RESULT OF COMPARE
INX H ;START OF NEXT LINE -> H
CALL FSNL
POP PSW ;RESTORE RESULT OF COMPARE
CMC ;FOUND IT?
RZ ;YUP - CARRY, ZERO TRUE
CMC ;PAST IT?
RNC ;YUP - CARRY, ZERO FALSE
JMP LFNE ;NOPE - KEEP LOOKING
;
;THIS IS THE INTERPRETER CONTROL SECTION.
;
;STMT IS THE STATEMENT EXECUTOR. ENTER IT ITH THE TXA
;OF THE STRING TO BE EXECUTED -1 IN H. KEEPS GOING TILL:
;IT FINDS LINE # 0, CONTROL C (^C) ABORT, OR GOTO
;-1 (MINUS ONE). IT PUSHES THE ADDRESS OF RTRN
;BEFORELEAVING, SO WHEN THE STMT HANDLER RETURNS, IT SHOWS
;UP AT RTRN. AT RTRN, TXA SHOULD POINT TO COLON (:) OR
;END OF LINE NULL.
;
RTRN: CALL ABRT ;TEST FOR CONTROL C (^C)
MOV A,M ;MORE ON THIS LINE?
COLN: CPI ':'
JZ STMT ;YUP - EXECUTE IT
ORA A ;END OF LINE?
CNZ ERRO ;NOPE - ILLEGAL TERMINATION CHR
INX H ;MOVE TO SONL
CALL FELN ;LINE # -> DE, RE-ENTER IF EOB
XCHG ;MAKE IT CURRENT LINE
SHLD CURL
XCHG
STMT: RST 2
STMU: SHLD SSTM ;SAVE THE START OF THIS STATEMENT
LXI D,RTRN ;PUSH DESIRED RETURN ADR
PUSH D
RZ
RST 1
DB '?' ;A PRINT STMT?
SIPK: DW NPRT ;MIGHT BE POKED TO NPRU
PRT1: JZ CRLF
CR1: RZ ;RETURN WITH NO CR IF TERMINATOR
RST 1
DB ';'
DW PCOM
JMP CR1 ;IGNORE SEMICOLONS - NO CR IF EOS
PCOM: RST 1
DB ':' ;A COMMA ?
DW QUOT
MVI A,11 ;YUP - SEND A TAB
RST 4
JMP CR1 ;NO CR IF EOS
QUOT: MOV A,M ;LEADING SLASH FOR LITERAL ?
CPI '/'
JNZ PXCL ;NOPE - TRY CHR$
INX H ;YUP - MOVE OVER SLASH
QUOS: MOV A,M ;FETCH A CHR
ORA A ;END OF LINE ?
CZ ERRO ;YUP - NO CLOSING SLASH ERROR
INX H
CPI '/' ;FINAL SLASH?
JZ PEXQ ;YUP
RST 4 ;NOPE - SEND IT
JMP QUOS ;DO MORE
PXCL: RST 1
DB '>' ;A CHR$ FUNCTION ?
PXPK: DW PRI1 ;TRY STRING PRINT, MIGHT BE POKED
RST 3
MOV A,E ;TRUNCATED EXPR -> A
RST 4 ;SEND IT
JMP PEXQ
PEXP: RST 3 ;MUST BE AN RST 3ESSION
PUSH H ;SAVE H DURING PRINT
XCHG ;NUMBER TO PRINT -> H
CALL SHLP ;PRINT THE SIGNED NUMBER
POP H ;RESTORE TXA
PEXQ: DCX H ;SET Z FLAG IF EOS
RST 2
JMP PRT1
NPRU: PUSH H ;SAVE SOL TXA ON STK
INX H
RST 1
DB '=' ;SECOND CHR '='' '?
DW CMD1 ;NOPE - MUST BE A COMMAND OR ARRAY
RST 3 ;YUP - EVALUATE RIGHT SIDE
XTHL ;SOL -> H, FOR 24 BETWEEN
;CURRENT EOTX AND SP. BOTH MUNCH PSW & A.
;
EOM: LHLD EOTX ;CURRENT EOTX
EOM1: PUSH D ;SAVE DE
XCHG ;SAVE HIS H
LXI H,-24Q ;LOOKING FOR 24 BYTES
DAD SP ;ADD IN CURRENT SP
RST 6 ;SUBTRACT PASSED H
XCHG ;RESTORE HIS H
POP D ;RESOTRE DE
RNC ;PLENTY OF ROOM LEFT - RETURN
CALL ERRO ;OUT OF MEMORY ERROR
;
;THIS ROUTINE INPUTS A LINE OF TEXT AND PLACES IT
;AT LINB WHEN ENTERED AT GETL. RUBOUT
;DELETES THE PREVIOUS CHR. CONTROL U (^U) DELETES THE
;ENTIRE LINE BEING TTS LINE NUMBER
INX H
MOV H,M
MOV L,A
SHLD DLAD
JMP GOT ;DO A GOTO
MEMA: RST 1
DB '!' ;SET A MEMORY ADDRESS ?
DW POKT
XCHG ;STORE NEW MEMORY ADDRESS
SHLD MADR
POP H ;RESTORE EOS TXA
RET
POKT: RST 1
DB '&' ;A POKE ?
DW OUT1
LHLD MADR ;GET THE SET MEMORY ADDRESS
MOV M,E ;POKE IT WITH LOW ORDER EXPR
POP H ;RESTORE EOS TXA
RET
OUT1: RST 1
DB '_' ;AN OUT INST ?
DW PAD1 ;NOPE
MVI A,323Q ;OUT INST BINARY -> MEMORY (RAM)
STA RAMIO
MOV A,E ;DATA TO OUTPUT -> A
POP H ;RESTORE EOS TXA
JMP RAMIO ;DO THE OUT, AND RETURN
PAD1: RST 1
DB '@' ;SET PORT NUMBER ?
DW DEF1
MOV A,E ;TRUNCATED EXPRESSION -> A
STA RAMIO+1 ;SET NEW PORT NUMBER INTO RAM
POP H ;RESTORE EOS TXA
RET
DEF1: RST 1
DB '^' ;DEFINE A FUNCTION ?
DFPK: DW BSES ;MIGHT BE POKED TO LETS
INX H ;MOVE TXA TO EXPRESSION
SHLD DEFF ;SAVE FUNCTIONS TXA
POP H ;RESTORE EOS TXA
RET
LETS: CALL LOKU ;GET THE INDES OF THE VAR
MOV M,E ;STORE THE VAL IN MEMORY
JNZ LETT ;DON'T WRITE HI BYTE IF SINGLE ARRAY
INX H
MOV M,D
LETT: POP H ;IGNORE TXA FROM LOKU
POP H ;RESTORE EOS TXA
RET
;FSNL FINDS THE START OF THE NEXT LINE IN MEMORY.
;HL IS BUMPED TO POINT TO THE LO ORDER LINE NUMBER OF THAT
;LINE. A & PSW GET MUNCHED. STACK USAGE: 2 BYTES.
;
FSNL: MOV A,M
INX H
ORA A ;ENDING NULL YET?
JNZ FSNL
RET
;
;EOM AND EOM1 CHECK TO MAKE SURE THAT THERE IS AT LEAST 24
;BYTES OF STK SPACE LEFT FOR NORMAL OPERATIONS. EOM1 LOOKS
;FOR 24 BETWEEN H AND CURRENT SP. EOM LOOKS FOR 24 BETWEEN
;CURRENT EOTX AND SP. BOTH MUNCH PSW & A.
;
EOM: LHLD EOTX ;CURRENT EOTX
EOM1: PUSH D ;SAVE DE
XCHG ;SAVE HIS H
LXI H,-24Q ;LOOKING FOR 24 BYTES
DAD SP ;ADD IN CURRENT SP
RST 6 ;SUBTRACT PASSED H
XCHG ;RESTORE HIS H
POP D ;RESOTRE DE
RNC ;PLENTY OF ROOM LEFT - RETURN
CALL ERRO ;OUT OF MEMORY ERROR
;
;THIS ROUTINE INPUTS A LINE OF TEXT AND PLACES IT
;AT LINB WHEN ENTERED AT GETL. RUBOUT
;DELETES THE PREVIOUS CHR. CONTROL U (^U) DELETES THE
;ENTIRE LINE BEING TYPED AND STARTS OVER. A MAXIMUM
;OF LBUL CHRS WILL BE ACCEPTED AFTER WHICH THE
;BELL WILL RING INSTEAD OF ECHOING CHRS AS NORMAL.
;CONTROL CHRS OTHER THAN CONTROL U, CONTROL G (BELL),
;AND CARRIAGE RETURN WILL NOT BE ECHOED BUT IGNORED.
;ROUTINE RETURNS ON ENTRY OF A CARRIAGE RETURN BY
;ECHOING A CRLF AND PLACING 3 NULLS AT THE END OF BUFFER.
;ON EXIT, H POINT LINB-1. STACK USAGE: 10 BYTES.
;
GETJ: DCX H ;DECR CHR POINTER
RST 5 ;SEND A BACK SLASH
DB '\'+200Q
DCR B ;DECR CHR COUNTER
JNZ GETM ;DELETED TOO MANY? - NOPE
GETK: CALL CRLF
GETL: LXI H,LINB ;CHRS WILL GOHERE
MVI B,1 ;INITIALIZE CHR COUNT
GETM: CALL TTYI ;GET CHR -> A
CPI 7 ;A BELL?
JZ GETN ;YUP - PUT IN BUFFER
CPI 15Q ;A CR?
JZ CRLE ;YUP - EXIT THRU CRLF
CPI 25Q ;CONTROL U?
JZ GETK ;YUP - START OVER
CPI ' ' ;< SPACE, CONTROL CHR ?
JC GETM ;YUP - IGNORE
CPI 177Q ;RUBOUT?
JZ GETJ ;YUP - IGNOR LAST CHR
GETN: MOV C,A ;SAVE CHR
MOV A,B ;GET LINE LENGTH -> A
CPI LBUL+1 ;COMPARE WITH MAXIMUM
MVI A,7 ;GET READY TO RING BELL IF TOO LONG
JNC GETO ;RING IT
MOV A,C ;RESTORE CHR
MOV M,C ;PUT IT IN BUFFER
INX H ;INCR BUFFER POINTER
INR B ;INCR CHR COUNTER
GETO: RST 4 ;ECHO CHR
JMP GETM ;DO SOME MORE
;
;THIS ROUTINE FETCHES A LINE NUMBER FROM MEMORY -> DE.
;IF IT IS LINE 0 (ZERO), THIS MEANS EOB AND IT GOES TO ENTR.
;IF NOT 0, JUST RETURN. MUNCHES DE & A & FLAGS, BUMPS H.
;HL POINTS TO LOW ORDER ON ENTRY, HI ORDER ON EXIT.
;STACK USAGE: 2 BYTES.
;
FELN: MOV E,M ;LO ORDER -> E
INX H
MOV D,M ;HI ORDER -> D
MOV A,D ;IS DE = 0 ?
ORA E
RNZ ;NOPE - RETURN
RST 0 ;YUP - BACK TO COMMAND MODE
;
;
;EXPRESSION EVALUATOR. USES ALL REGISTERS. RESULT IS LEFT
;IN THE DE REGISTER. WILL PROBABLY RECURSE AT LEAST ONCE.
;
; HIERARCHY
;
;EVALUATED FIRST ( )
; *, /
; +, -
;EVALUATED LAST <, >, =, #
;
;OPERATORS ON THE SAME LEVEL ARE EVALUATED LEFT TO RIGHT.
;
; <EXPR> ::= <SUM> I <SUM><<SUM> I <SUM>><SUM>
; <SUM>=<SUM> I <SUM>#<SUM>
;
;STACK USAGE: >= 10 BYTES. CALLS EOM BEFORE RECURSING.
;
EXPA: CALL SUM ;GET LEFT SUM
EXPS: RST 1
DB '<' ;FOLLOWED BY '<'' '?
DW TRYG
CALL RSUM ;GET RIGHT SUM AND COMPARE
RNC ;FALSE - DE = 0
MOV E,A ;TRUE - MAKE DE = 1
RET
TRYG: RST 1
DB '>' ;GREATER THAN ?
DW TRYE
CALL RSUM ;GET RIGHT SUM
RC ;FALSE
RZ ;EQUAL IS FALSE
MOV E,A ;TRUE
RET
TRYE: RST 1
DB '=' ;EQUAL TO ?
DW TRYN
CALL RSUM ;GET RIGHT SUM
RNZ ;NOT EQUAL IS FALSE
MOV E,A
RETI: RET
TRYN: RST 1
DB '#' ;NOT EQUAL TO ?
DW RETI ;NO RELOPS - RETURN
CALL RSUM ;GET RIGHT SUM
RZ
MOV E,A
RET
;
;RSUM GETS THE RIGHT SUM AFTER A RELOP HAS BEEN FOUND.
;ENTER WITH LEFT SUM IN DE. AFTER FETCHING THE RIGHT SUM,
;RIGHT AND LEFT ARE COMPARED WITH A 16 BIT SIGNED COMPARE.
;ON EXIT: FLAGS ARE SET LIKE LEFT - RIGHT,
;DE = 0, A = 1, TXA POINTS TO END OF EXPRESSION.
;
RSUM: PUSH D ;LEFT ON STK
CALL SUM ;GET RIGHT SUM -> DE
XTHL ;LEFT -> H, TXA ON STK
MOV A,H ;COMPARE SIGN OF LEFT AND RIGHT
XRA D
JP SAMS ;SAME SIGN - DON'T SWAP
XCHG
SAMS: RST 6 ;DO THE COMPARE
POP H ;RESTORE TXA
LXI D,0 ;SETUP RESULT OF RELOP
MVI A,1 ;DO A LE A IF TRUE
RET
;
;SUM EVALUATOR.
;<SUM> ::= <TERM> I <SUM> + <TERM> I <SUM> - <TERM>
;
;THE VALUE OF THE SUM IS T IN DE ON EXIT.
;
SUM: CALL TERM ;GET LEFT TERM
SUMA: RST 1
DB '+' ;FOLLOWED BY A '+'' '?
DW SUN
PUSH D ;SAVE LEFT HALF
CALL TERM ;GET RIGHT HALF
SUM1: XTHL ;LEFT -> H, TXA ON STACK
DAD D ;RIGHT + LEFT -> H
XCHG ;RESULT -> DE
POP H ;RESTORE TXA
JMP SUMA ;CHECK FOR MORE SUMS
SUN: RST 1
DB '-' ;FOLLOWED BY '-'' '?
DW RETI ;NOPE - DONEWITH ALL SUMS
PUSH D ;SAVE LEFT TERM
CALL TERM ;GETRIGHT HALF
CALL COMD ;DE = -RIGHT
JMP SUM1 ;RESULT = -LEFT + RIGHT
;
;TERM EVALUATOR.
;<TERM> ::= <FACT> I <TERM> * <FACT> I <TERM> / <FACT>
;
TERM: CALL FACT ;GET LEFT FACT
TERA: RST 1
DB '*' ;FOLLOWED BY AN '*'' '?
DW TERN ;NOPE - TRY DIVISION
PUSH D ;SAVE LEFT FACT
CALL FACT ;GET RIGNT FACT
XTHL ;LEFT -> H, TXA ON STACK
PUSH H
LXI H,RAMIO ;NUMBER OF BITS
MVI M,11H
LXI B,0 ;CLEAR PARTIAL PRODUCT
LOOP: MOV A,D ;16 BIT DE ROTATE RIGHT
RAR
MOV D,A
MOV A,E
RAR
MOV E,A
DCR M ;ONE BIT DONE
JZ MULS ;ALL BITS DONE
XTHL
JNC SKIP ;BIT NOT ONE - SKIP ADD
PUSH H
DAD B
MOV B,H
MOV C,L
POP H
SKIP: ORA A ;CLEAR CARRY
MOV A,L ;16 BIT H ROTATE LEFT
RAL
MOV L,A
MOV A,H
RAL
MOV H,A
XTHL
JMP LOOP
MULS: POP D ;CLEAN JUNK OFFSTACK
MOV D,B ;RESULT -> DE
MOV E,C
POP H ;RESTORE TXA
JMP TERA ;LOOK FOR ADDITIONAL OPERATORS
TERN: RST 1
DB '/' ;FOLLOWED BY '/'' '?
DW RETI ;NOPE - DONE WITH ALL FACTORS
PUSH D ;SAVE LEFT FACT
CALL FACT ;GET RIGHT FACT
CALL CHSG ;CHANGE SIGN IF NEEDED
XTHL ;TXA ON STK, LEFT -> H
XCHG ;LEFT -> DE, ABS(RIGHT) -> H
CALL CHS1 ;ABS(LEFT) -> DE
PUSH B ;SAVE SIGN OF RESULT
MOV B,H
MOV C,L ;ABS(RIGHT) -> B
XCHG ;ABS(LEFT) -> H
DV02: MOV A,B ;DIVISION BY ZERO?
ORA C
CZ ERRO ;YUP - ERROR
LXI D,0 ;CLEAR QUOTIENT
DIV1: MOV A,L ;LEFT = LEFT -RIGHT
SUB C
MOV L,A
MOV A,H
SBB B
MOV H,A
INX D ;QUO=QUO + 1
JNC DIV1 ;STILL POSITIVE - SUB AGAIN
DCX D ;TOO FAR - QUO = QUO -1
DAD B ;GET REMAINDER -> H
SHLD RMDR ;SAVE IT
POP B ;GET THE SIGN OF RESULT
MOV A,B
ORA A
CM COMD ;COMPLIMENT RESULT MAYBE
POP H ;RESTORE TXA
JMP TERA ;LOOK FOR ADDITONAL OPERATORS
;
;
;FACTOREVALUATOR.
;<FACT> ::= <CONSTANT> I <VARIABLE> I -<FACT>
; +<FACT> I (<EXPR>) I . I ? I $ I %
; I & I @ I ^ I \
;
;VALUE OF FACTOR LEFT IN DE ON EXIT.
;
FACT: RST 1
DB '+' ;UNARY PLUS ?
DW FACA ;IGNORE IT
FACA: DCX H ;IS THIS A CONSTANT?
RST 2 ;SET FLAGS, TC IS 0 - 9, TZ IS TERMN
JC DEINT ;YUP - GET VAL -> DE AND EXIT
CZ ERRO ;MISSING EXPRESSION ERROR
RST 1
DB '-' ;UNARY MINUS ?
DW TRY2
CALL FACT ;GET FACTOR TO NEGATE
JMP COMD ;COMPLIMENT IT, RETURN FROM COMD
TRY2: RST 1
DB '.' ;CURRENT LINE ?
DW TRY1
XCHG ;SAVE TXA IN DE
LHLD CURL ;GET CURRENT LINE # -> DE
XCHG ;RESTORE TXA
RET
TRY1: RST 1
DB '$' ;RETURN ADDRESS ?
DW TRY3
XCHG ;SAVE TXA
LHLD DLAD ;GET RETURN ADDRESS -> H
XCHG ;RESTORE TXA
RET
TRY3: RST 1
DB '%' ;DIVISION REMAINDER ?
DW TRY4
XCHG ;SAVE TXA
LHLD RMDR ;GET REMAINDER -> H
XCHG ;RESTORE TXA
RET
TRY4: RST 1
DB '!' ;PEEK ?
DW TRY5
XCHG ;SAVE TXA
LHLD MADR ;GET LAST MEMORY ADDRESS -> H
MOV A,M ;PEEK -> A
XCHG ;RESTORE TXA
JMP ARET ;RETURN VALUE IN A REG
TRY5: RST 1
DB '&' ;PORT INPUT ?
DW TRY6
MVI A,333Q
STA RAMIO ;SETUP INP INST IN RAM
CALL RAMIO ;EXECUTE IT
ARET: MOV E,A ;SETUP TWO BYTE VALUE -> DE
MVI D,0
RET
TRY6: RST 1
DB '^' ;USER DEFINED FUNCTION REFERENCE ?
DW TRY7
PUSH H ;SAVE TXA
CALL EOM ;VERIFY ROOM FOR RECURSION
LHLD DEFF ;TXA OF DEFINITION
RST 3 ;EVALUATE THE FUNCTION
POP H ;RESTORE TXA
RET
TRY7: RST 1
DB '_' ;RESULT OF LAST EXPRESSION ?
DW USR1
XCHG ;SAVE TXA
LHLD LRES ;GET LAST EXPR RESULT -> H
XCHG
RET
USR1: RST 1
DB '@' ;MACHINE LANGUAGE CALL ?
DW TRY8
PUSH H ;SAVE TXA
CALL EOM ;ENUF STACK SPACE ?
LHLD USRL ;HIS ROT ADR ON STK, TXA -> H
XTHL
RET ;GOTO TO HIS ROT
;
;SAMPLE USR ROT TO RETURN THE ASCII VALUE OF THE CHR
;FOLLOWING THE @.
;
USR: MOV E,M ;SETUP TWO BYTE VALUE -> DE
MVI D,0
INX H ;MOVE TXA OVER CHR
RET
;
TRY8: RST 1
DB '\' ;SINGLE CHR INPUT ?
DW TRY9
CALL TTYI ;GET THE INPUT -> A
JMP ARET
TRY9: RST 1
DB '(' ;EXPRESSION IN PARENTHESIS ?
DW TRY0
PUSH H ;MAKE SURE THERE IS ROOM BEFORE
CALL EOM ;RECURSING
POP H
RST 3 ;RECURSIVE
RST 1
DB ')' ;GOT TO HAVE A RIGHT TO MATCH
DW SNER ;NOPE - ERROR
RET
TRYV: CALL LOKU ;GET THE VARIABLES INDES -> H
MOV E,M ;VAR VAL -> DE
MVI D,0 ;CLEAR HIGH BITS IF SINGLE ARRAY
JNZ TRYW ;SINGLE BYTE ARRAY, DON'T LOAD HI
INX H
MOV D,M
TRYW: POP H ;RESTORE TXA, PUSHED BY LOKU
RET
;
;TRY0 WILL HANDLE THE INPUT OPERATOR IF PRESENT. EXECUTION
;WILL STOP AND A '?'' 'WILL BE PRINTED ON THE OUTPUT DEVICE.
;THE USER RESPONDS WITH ANY VALID EXPRESSION, AND HITS
;BETURN. IT IS NOT A GOOD IDEA TO TYPE QUESTION MARKS
;IN RESPONSE TO AN INPUT STMT. MUNCHES LINB.
;
TRY0: RST 1
DB '?' ;THE LINE INPUT OPERATOR ?
DW TRYV
RST 5 ;SEND THE QUESTION MARK
DB '?',' '+200Q
PUSH H ;SAVE THE TXA
CALL EOM ;VERIFY ROOM FOR RECURSION
CALL GETL ;GET HIS INPUT
RST 2 ;GET FIRST CHR$ RETURN ?
JZ ENTR ;YUP - CLEAR STK AND RE-ENTER
RST 3 ;EVALUATE HIS INPUT RECURSIVE
POP H ;RESTORE TXA
RET
;
;
;COMMAND PROCESSOR.
;
CMD1: RST 1
DB '[' ;ARRAY LET STMT ?
DW CMD ;NOPE - IT'S A COMMAND
LOP: MOV A,M ;MOVE TO RIGHT EXPR
INX H
CPI ']'
JNZ LOP
INX H ;MOVE OVER '=''
RST 3 ;EXPR VALUE -> DE
XTHL ;EOS TXA ON STK, SOS TXA -> H
JMP LETS ;DO THE ASSIGNMENT
CMD: POP H ;RESTORE SOL TXA
RST 1
DB 'L' ;LIST COMMAND ?
DW NEW1
CALL DEINT ;GET ARG -> DE, 0 IF NO ARG
CALL LFND ;FIND THAT LINE
MOV H,B ;START ADDRESS -> H
MOV L,C
DB 76Q ;SETUP BOGUS LAI
LISC: INX H ;SKIPPED FIRST TIME THRU, FROM LAI
LISA: CALL ABRT ;CONTROL C (^C) CHECK
CALL CRLF
CALL FELN ;FETCH LINE # -> DE, EXIT IF ZERO
PUSH H ;SAVE DURING PRINT
XCHG ;LINE # -> H
CALL NOSP ;PRINT IT
POP H ;FIRST CHR OF LINE
LISB: INX H ;GET A CHR
MOV A,M
ORA A ;EOL?
JZ LISC ;LAST ON LINE - DO NEXT LINE
RST 4 ;NOT LAST - PRINT IT
JMP LISB ;DO REST OF LINE
;
NEW1: RST 1
DB 'N' ;NEW COMMAND ?
DW RUN1
LHLD BOTX ;PUT EOB MARK IN BUFFER
XRA A ;A=0
MOV M,A
INX H
MOV M,A
INX H
MOV M,A
SHLD EOTX
RSSP: POP B ;RETURN ADDRESS -> B
LHLD SPRS ;HOLDS STACK RESET ADDRESS
SPHL
PUSH B ;RESTORE RETURN ADDESS
LHLD BOTX ;INCASE THIS IS SUICIDAL
DCX H ;BOTX - 1 -> H
RET
;
RUN1: RST 1
DB 'R' ;RUN COMMAND ?
DW OS1
JZ RSSP ;NO ARG - RESET STACK AND GO
RST 3 ;GET THE ARGUMENT
JMP GOTA ;DO A GOTO
;
;THESE ROUTINES ARE USED TO PRINT THE 16 BITS IN THE
;H~EGISTER AS DECIMAL ASCII ON THE TERMINAL. INPTPRINTS
;THE NUMBER IN CURL IF IT IS NOT 65535 (NOT IMMEDIATE MODE).
;THE WORD 'I'N' 'PRECEDES THE NUMBER IF IT IS PRINTED. SHLP
;PRINTS A 15 BIT SIGNED NUMBER IN H (-32768 TO 32767).
;HLPT PRINTS THE 16 BIT UNSIGNED NUMBER IN H (0 TO 65535).
;NOSP PRINTS 16 BIT UNSIGNED NUMBERS IN H WITHOUT THE
;LEADING SPACE NORMALLY PRINTED. ALL NUMBERS ARE FOLLOWED
;BY ONE TRAILING SPACE. SHLP PRINTS A MINUS SIGN ('-'')'
;IN PLACE OF THE LEADING SPACE IF H IS NEGATIVE.
;STACK USAGE: 8 BYTES. MUNCHES ALL REGS.
;
INPT: LHLD CURL ;CURRENT LINE NUMBER -> H
MOV A,H ;IS IT 377 377
ANA L
INR A
RZ ;YUP - RETURN PRINT NOTHING
RST 5 ;NOPE - PRINT 'I'N'
DB 'I','N'+200Q
HLPT: RST 5 ;PRINT A SPACE
DB ' '+200Q
NOSP: LXI D,TENS ;POINT TO POWERS OF TEN TABLE
PUSH D ;PUT TABLE ADR ON STACK
MVI C,1 ;CLAR SIGNIFICANT DIGIT FLAG
POSI: XTHL ;NUMBER ON STK, TABLE -> H
MOV E,M ;POWER OF TEN -> DE
INX H
MOV D,M
INX H
XTHL ;TABLE ON STK, NUMBER -> H
MVI B,0 ;THIS DIGIT = 0
DIVD: MOV A,L ;16 BIT SUBTRACT H = H - DE
SUB E
MOV L,A
MOV A,H
SBB D
MOV H,A
INR B ;INCREMENT THIS DIGIT
JNC DIVD ;NOT NEGATIVE YET - KEEP SUBTRACING
DCR B ;GONE ONE TOO FAR, DIGIT = DIGIT -1
DAD D ;GONE TOO FAR, ADD BACK TEN POWER
XRA A ;A=0
ORA B ;IS THIS DIGIT ZERO ?
JNZ PRNT ;NOPE - PRINT IT
ORA C ;ANY SIGNIFICANT DIGITS YET ?
JNZ BYPA ;NOPE - DON'T PRINT THIS ZERO
PRNT: ADI '0' ;ADD IN ASCII BIAS
MVI C,0 ;SET SIGINIFICANT DIGIT FLAG
RST 4 ;SEND THIS DIGIT
BYPA: MOV A,E ;ON THE LAST DIGIT ?
DCR A
JNZ POSI ;NOPE - DO NEXT ONE
POP D ;YUP - CLEAN UP STACK
MOV A,C ;SIGNIFICANT DIGIT FLAG -> A
ORA A ;HAVE WE SENT ANY SIG DIGS YET ?
JZ SPOU ;YUP - OUTPUT THE TRAILING SPACE
RST 5 ;NOPE - WE'RE PRINTING A ZERO
DB '0'+200Q ;SEND A '0''
SPOU: RST 5 ;PRINT A SPACE
DB ' '+200Q
RET
TENS: DW 10000,1000,100,10,1
SHLP: XCHG ;NUMBER -> DE
CALL CHSG ;ABS(NUMBER) -> DE
XCHG ;ABS(NUMBER) -> H
JP HLPT ;WAS POSITIVE, PRINT SPACE
RST 5 ;PRINT THE MINUS SIGN ('-'')'
DB '-'+200Q
JMP NOSP ;PRINT THE NUMBER
;
;
;DEINT TAKES ASCII FROM MEMORY INTO BINARY IN DE.
;MOVES TXA UNTIL CHR IS NOT 0 - 9.
;STACK USAGE: 4 BYTES. MUNCHES ALL REGS EXCEPT B.
;
DEINT: DCX H ;DECR FOR FETCH
LXI D,0 ;CLEAR PARTIAL SUM
DEIM: RST 2 ;RST 2 CHR 0 - 9?
RNC ;NOPE - DONE
PUSH H ;SAVE CHR ADR
MOV H,D ;PARTIAL SUM -> H
MOV L,E
DAD D ;HL = DE * 10
DAD H ;PS = PS * 10
DAD D
DAD H
SUI '0' ;REMOVE ASCII BIAS
MOV E,A ;SETUP 16 BIT DIGIT -> DE
MVI D,0
DAD D ;ADD IN NEW DIGIT
XCHG ;PARTIAL SUM -> DE
POP H ;RESOTRE TXA
JMP DEIM
;
;CHS1 CHECKS THE SIGN OF DE REG. IF POSITIVE, RETURN A
;MUNCHED, SIGN BIT FALSE. IF NEGATIVE, COMPLIMENT DE,
;A MUNCHED, SIGN BIT SAME AS THAT OF B REG. CHSG
;CLEARS THE SIGN BIT OF B REG FIRST. COMD UNCONDITIONALLY
;COMPLIMENTS DE REG. STACK USAGE: 2 BYTES.
;
CHSG: MVI B,0 ;CLEAR RESULT SIGN
CHS1: MOV A,D ;IS DE POSITIVE ?
ORA A
RP ;YUP - RETURN
MOV A,B ;NOPE - FLIP SIGN OF B
XRI 200Q
MOV B,A ;AND FALL THRU TO COMPLIMENT DE
COMD: MOV A,D
CMA
MOV D,A
MOV A,E
CMA
MOV E,A
INX D
RET
;
;
;RAM DEFINITIONS
;
BOTX: DW EOP ;ADR OF FIRST CHR IN BUFFER
EOTX: DW EOP+2 ;ADR OF LAST CHR IN BUFFER
CURL: DW -1 ;CURRENT LINE NUMBER
LBUL EQU 72 ;INPUT LINE BUFFER LENGTH
OS EQU 374Q*256 ;ADDRESS OF OPERATING SYSTEM
LINB: DB 0 ;LEAVE SPACE FOR INPUT LINE BUF
ORG $+LBUL+2
SPRS: DW 10Q*256 ;ADDRESS OF STACK POINTER RESET
LRES: DW 0 ;HOLDS RESULT OF LAST EXPR EVAL
DLAD: DW 0 ;HOLDS RETURN LINE NUMBER FOR '$''
DEFF: DW COLN+1 ;INITIALIZE TXA OF USER DEFINED FUN
USRL: DW USR ;ADROF USERS MACHINE LANG CALL
SSTM: DW EOP ;INITIALIZE START OF LAST STMT
RAMIO: OUT 10 ;RAM AREA FOR INP AND OUT
RET
MADR: DW 0 ;SAVE AREA FOR PEEK / POKE ADDRESSES
RMDR: DW 0 ;SAVE AREA FOR DIVISION REMAINDER
VART: DB 0 ;LEAVE ROOM FOR PROGRAM VARIABLES
ORG $+51
;
;
;
;DEVO STARTS AT RESTART 4.
;DEVO: PUSH PSW
; IN 1
; ANI 2
DEVP: JZ DEVQ ;NOT READY
POP PSW
TODP: OUT 10H
RET
DW 0 ;PATCH ROOM
;
;TTYI GETS A CHR FROM THE INPUT DEVICE. CAN MUNCH A AND
;FLAGS. STACK USAGE: 4 BYTES.
;
TTYI: CALL TRDY ;IS INPUT READY ?
TIA: JZ TTYI ;NOPE - KEEP TRYING
TIDP: IN 16
ANI 177Q
RET
DW 0 ;LEAVE ROOM FOR PATCHES
;
;TEST TERMINAL INPUT READY BIT STATUS. MUNCHES A & FLAGS.
;STACK USAGE: 2 BYTES.
;
TRDY: IN 17 ;GET INPUT STATUS
TIRM: ANI 2 ;MASK TO INPUT @EADY BIT
RET ;FZ MEANS READY, TZ MEANS NOT READY
DW 0 ;ROOM FOR PATCHES
;
CRLE: XRA A ;A CONTINUATION OF GETL
MOV M,A ;PUTS EOB/EOL MARK IN LINB
INX H
MOV M,A
INX H
MOV M,A
LXI H,LINB-1
;
;CRLF SEND A CARRIAGE RETURN AND LINE FEED TO TERMINAL.
;MUNCHES A & FLAGS. STACK USAGE: 8 BYTES.
;
CRLF: RST 5
DB 15Q,212Q
RET
;
;ABRT CHECKS THE CONSOLE DEVICE FOR A CHR AND IF THERE,
;CHECK IF IT'S A CONTROL C. IF NOT, RETURN WITH A MUNCHED.
;IF YES, FALL THROUGH TO STOP ROUTINE.
;STACK USAGE: 6 BYTES.
;
ABRT: CALL TRDY ;IS DATA READY FLAG UP ?
TIB: RZ ;NOPE - RETURN
CALL TTYI ;YUP - FETCH THE CHR
CPI 3 ;A CONTROL C (^C) ?
RNZ ;NOPE - RETURN
RST 0 ;BACK TO ENTRY POINT
;
;
OS1: RST 1
DB 'O' ;JMP TO OS ?
OSPK: DW SAV1 ;MIGHT BE POKED TO SNEB
JMP OS
;
;LOKU GETS THE INDES OF THE VARIBLE POINTED TO BY H AND
;RETUNS THEM IN H. THE TXA IS BUMPED OVER THE VARNAM,
;AND PUSHED BEFORE RETURNING. YOU MUST POP AFTER CALLING
;LOKU. USES ALL REGS EXCEPT DE. STACK USAGE: 4 BYTES IF
;VAR IS A - Z, >= 16 IF SUBSCRIPTED. ZERO FLAG IS TRUE
;IF IT IS DOUBLE BYTE VAR (SIMPLE OR DOUBLE ARRAY). ZERO
;IS FALSE IF SINGLE BYTE VARIABLE (SINGLE BYTE ARRAY).
;
LOKU: MOV A,M ;VARNAM -> A
SUI 'A' ;IS IT A - Z ?
LKP1: JC DARY ;NOPE
CPI 27 ;26 LETTERS + 1
LKP2: JNC DARY ;NOPE - TRY ARRAYS IF NOT POKED
;SAVE NEW TXA ON STACK BEFORE RETURNING
INX H ;MOVE TXA OVER VARNAM
XTHL ;PUT TXA ON STK
PUSH H ;PUT RETURN ADDRSS BACK
LXI H,VART ;BASE ADDRESS -> H
RLC ;MULTIPLY INDEX BY 2
MOV C,A ;TWO BYTE INDEX -> B
MVI B,0
DAD B ;ADD IN INDEX TO BASE
XRA A ;SET ZERO FLAG, THIS IS DOUBLE BYTE
RET
;
EOP1 EQU $ ;THIS WILL BE BOTX-1 IF ARRAYS,
;STRING, AND TAPE / SAVE ARE DELETED
;
DARY: RST 1
DB '"' ;DOUBLEBYTE ARRAY ?
DW SARY
CALL SUBS ;GET THE SUBSCRIPT -> B
XTHL ;INDES -> H, TXA ON STK
PUSH H
LHLD DBSE
DAD B
DAD B
XRA A ;SET ZERO FLAG, THIS IS DOUBLE BYTE
RET
SARY: RST 1
DB '''' ;SINGLE BYTE ARRAY ?
DW SNER
SSUB: CALL SUBS ;SUBSCRIPT -> B
XTHL ;TXA ON STK, INDES -> H
PUSH H
LHLD SBSE
DAD B
ORI 1 ;RESET ZERO FLAG, TO SAY SINGLE BYTE
RET
;
;SUBS GETS THE SUBSCRIPT FOR A STRING OR ARRAY -> B.
;MUNCHES ALL REGS EXCEPT DE. STACK USAGE: >= 14 BYTES.
;
SUBS: PUSH D ;SAVE DE
RST 1
DB '[' ;IGNORE '[''
DW SUB0
SUB0: RST 3 ;GET THE SUBSCRIPT -> DE
MOV B,D ;SUBSCRIPT -> B
MOV C,E
POP D ;RESTORE DE
RST 1
DB ']' ;IGNORE ']''
DW SUB1
SUB1: RET
;
BSES: RST 1
DB '''' ;SET SINGLE BYTE ARRAY BASE ?
DW BSED
XCHG ;NEW BASE -> H
SHLD SBSE ;SAVE NEW BASE
POP H ;RESTORE EOS TXA
RET
BSED: RST 1
DB '"' ;SET DOUBLE BYTE ARRAY BASE ?
DW LETS ;MUST BE A LET
XCHG ;NEW BASE ->H
SHLD DBSE ;SAVE NEW BASE
POP H ;RESTORE EOS TXA
RET
;
SBSE: DW 370Q*256+10Q ;ADR OF SINGLE BYTE ARRAY BASE ADR
DBSE: DW 370Q*256+10Q ;ADR OF DOUBLE BYTE ARRAY BASE ADR
;
EOP2 EQU $ ;THIS WILL BE BOTX-1 IF STRINGS AND
;TAPE / SAVE ARE DELETED.
;
PRI1: RST 1
DB ')' ;PRINT STRING ARRAY ?
DW PEXP
CALL SSUB ;GET STRING TXA -> H, TXA ON STK
XCHG ;STRING TXA -> DE
POP H ;TXA BACK -> H
STRA: LDAX D ;GET A STRING CHR
ORA A ;EOS YET ?
JZ PEXQ ;YUP - DO MORE OF ? STMT
RST 4 ;NOPE - PRINT IT
INX D ;BUMP STRING TXA
JMP STRA ;PRINT SOME MORE
;
NPRT: RST 1
DB ')' ;STRING INPUT ?
DW NPRU
CALL SSUB ;GET STRING DESTINATION TXA -> H
RST 5 ;PRINT PROMPT '-' '
DB '-',' '+200Q
CALL GETL+3 ;USE GETL TO INPUT STRING
POP H ;GET TXA BACK, (PUSHED BY SSUB)
RET
;
EOP3 EQU $ ;THIS WILL BOTX-1 IF SAVE / TAPE
;IS DELETED
;
;SAV1 PUNCHES TAPES OF THE CONTENTS OF THE TEXT
;BUFFER. RETURNS TO COMMAND MODE WHEN DONE.
;COMMAND IS FOLLOWED BY A SINGLE CHR PROGRAM NAME SO
;MORE THAN ONE PGM CAN BE PUT ON A TAPE. IF CR IS
;GIVEN FOR NAME, PUNCH NAME AS A NULL.
;
;TAPE FORMAT:
;
; 252 START CHR
; XXX NAME OF PROGRAM, 000 IF NULL NAME
; NNN DATA BYTES BETWEEN BOTX AND EOTX
; 000
; 000
; 000 EOT IS MARKED BY THREE NULLS
;
SAV1: RST 1
DB 'S' ;SAVE COMMAND ?
DW TAP1
MVI A,252Q ;START OF TAPE CHR
CALL PNOU ;SEND IT
MOV A,M ;PROGRAM NAME CHR -> A
CALL PNOU ;SEND IT
LHLD EOTX ;STOP ADDRESS -> DE
XCHG
LHLD BOTX ;START OF TEXT ADR -> H
SAVA: MOV A,M ;CHR OF PROGRAM -> A
CALL PNOU ;SEND IT
RST 6 ;DONE YET ?
INX H ;BUMP TXA
JNZ SAVA ;NOPE - KEEP SAVING
RST 0 ;ALL DONE, RE-ENTER
;
;TAP1 READS A TAPE FROM THE READER INTO THE TEXT
;BUFFER. RETURNS TO COMMAND MODE WHEN DONE. COMMAND IS
;FOLLOWED BY A SINGLE CHR PROGRAM NAME, LIKE SAVE.
;IT WILL SEARCH THE TAPE FOR A START CHR FOLLOWED BY THE
;NAME GIVEN. IF CR IS GIVEN FOR A NAME, TAKE FIRST ONE
;FOUND. IF THE NAMED PROGRAM CAN'T BE FOUND, THE TEXT
;BUFFER IS LEFT ALONE. WHEN READING STARTS, THE NAME
;BYTE FROM TAPE IS ECHOED SO YOU'LL KNOW IT IS LOADING.
;
TAP1: RST 1
DB 'T' ;READ A TAPE COMMAND ?
DW SNER
TAPA: CALL CHIN ;GET A CHR
CPI 252Q ;START CHR ?
JNZ TAPA ;NOPE - KEEP LOOKING
CALL CHIN ;YUP - GET NAME CHR
CMP M ;THE ONE WE WANT ?
JZ TAPF ;YUP - START READING
MOV B,A ;SAVE NAME IN B
MOV A,M ;DID HE GIVE DON'T CARE NAME ?
ORA A
MOV A,B ;NAME FROM TAPE -> A
JNZ TAPA ;NOPE - DON'T READ THIS ONE IN
TAPF: RST 4 ;SEND NAME OF PGM BEING READ
LHLD BOTX ;WHERE IT WILL GO
TAPB: MVI C,3 ;INITIALIZE EOT NULL COUNTER
TAPC: CALL CHIN ;GET A CHR
MOV M,A ;PUT IN RAM
CALL EOM1 ;PGM TOO BIG ?
MOV A,M ;GET CHR BACK
INX H ;BUMP
ORA A ;A NULL ?
JNZ TAPB ;NOPE - KEEP READING
DCR C ;DECR EOT NULL COUNT
JNZ TAPC ;NOT THIRD ONE - KEEP READING
DCX H ;STORE NEW EOTX
SHLD EOTX
RST 0 ;BACK TO COMMAND MODE
;
;PNOU IS THE PUNCH DRIVER USED BY SAVE. ENTER WITH CHR TO
;SEND IN A REG. STACK USAGE: 2 BYTES.
;
PNOU: PUSH PSW ;SAVE CHR TO SEND
PNOV: IN 5 ;GET PUNCH STATUS
CORM: ANI 2 ;READY YET ?
COA: JZ PNOV
POP PSW ;IT'S READY, SEND THE CHR
CODP: OUT 16
RET
;
;CHIN IS THE READER INPUT ROUTINE CALLED BY THE SAVE
;COMMAND. IT MUNCHES A & FLAGS. STACK USAGE: 2 BYTES.
;
CHIN: IN 5 ;GET READER STATUS
CIRM: ANI 1 ;READY YET ?
CIA: JZ CHIN ;NOPE - WAIT FOR T
CIDP: IN 4 ;GOT A READY, GET THE INPUT
RET
;
PGE EQU 7*256 ;PAGE FOR BINARY LOADER
EOP EQU $ ;THIS IS BOTX-1 IF TAPE / SAVE ARE KEPT
;
;
;INIT IS THE INITIALIZATION ROUTINE. IT IS LOCATED IN THE
;MIDDLE OF THE CASUAL PROGRAM STORAGE AREA. IT IS ENTERED
;WHEN CASUAL IS EXECUTED AFTER LOADING. IT POKES OUT
;THE JUMP TO IT. RESPOND TO 'M'EM SIZ ?' 'WITH THE
;DECIMAL NUMBER OF THE HIGHEST ADDRESS TO BE USED BY CASUAL
;OR HIT CARRIAGE RETURN TO USE ALL RAM AVAILABLE.
;
INIT: LXI SP,PGE+256 ;SETUP TEMPORARY STACK POINTER
RST 5 ;SEND 'M'EM SIZ? ' 'MESSAGE
DB 15Q,12Q,'MEM SIZ','?'+200Q
CALL GETL ;GET HIS RESPONSE
RST 2 ;FETCH FIRST CHR, A RETURN ?
JNZ NUM ;NOPE - GET A NUMBER
LXI H,MMEM ;START OF RAM SEARCH
INIS: MOV A,M ;GET A CHR FROM MEMORY
CMA
MOV M,A ;WRITE IT BACK COMPLIMENTED
CMP M ;DID IT GO ?
CMA ;/RESTORE MEMORY
MOV M,A
JNZ INIU ;NOPE - THIS IS END OF RAM
INX H ;YUP - KEEP TRYING
JMP INIS
NUM: CALL DEINT ;GET NUMERIC ARGUMENT
XCHG ;REQUESTE ADDRESS -> H
LXI D,MMEM ;MINIMUM POSSIBLE ADR -> DE
RST 6 ;REQUEST < MINIMUM ?
JC INIT ;YUP - GIVE THE CHUMP ANOTHER CHANCE
DCX H ;FIRST LOC FOR STACK
MOV A,M ;GET CONTENTS
CMA
MOV M,A ;WRITE IT BACK COMPLIMENTED
CMP M ;DID IT GO ?
CMA
MOV M,A ;RESTORE CONTENTS
INX H
JNZ INIT ;NOPE - NO RAM WHERE HE SAYS
;
MMEM EQU $ ;LOWEST LOC FOR STACK RESET
;
INIU: SHLD SPRS ;YUP - MAKE IT THE STACK RESET ADR
LXI H,EOP ;BOTX IF HE SAYS 'Y'ES'
CALL WANT ;ASK 'W'ANT SAVE / TAPE?'
DB 'SAVE/TAPE','?'+200Q
CALL YSNO ;GET HIS ANSWER
LXI H,SNER ;HE SAID NO - POKE OUT TEST
SHLD OSPK ;FOR SAVE / TAPE
LXI H,EOP3 ;BOTX IF HE SAYS YES -> H
CALL WANT ;ASK 'W'ANT STRING I/O'
DB 'STR I/O','?'+200Q
CALL YSNO ;GET HIS ANSWER
LXI H,PEXP ;HE SAID NO, POKE OUT STRING PRINT
SHLD PXPK
LXI H,NPRU ;POKE OUT STRING INPUT TEST
SHLD SIPK
LXI H,EOP2 ;BOTX IF HE SAYS YES -> H
CALL WANT ;ASK 'W'ANT ARRAYS? '
DB 'ARRAYS','?'+200Q
CALL YSNO ;GET HIS ANSWER
LXI H,SNER ;HE SAID NO, POKE OUT ARRAY LOOKUP
SHLD LKP1+1 ;MAKE IT A SYNTAX ERROR
SHLD LKP2+1
JMP ICON ;CONTNUED AT ICON
;
ORG PGE ;PUT IN JUMP TO BINL FOR BOOT
JMP BINL
;
ICON: LXI H,LETS ;MAKE ARRAY ASSIGNMENT ILLEGAL
SHLD DFPK
LXI H,EOP1 ;THIS IS BOTX -> H
INIV: XRA A ;DO A 'N'EW' 'COMMAND
MOV M,A ;BOTX WILL BE IN H
INX H ;NOW
SHLD BOTX ;SAVE IT
MOV M,A ;DO A NEW
INX H
MOV M,A
INX H
MOV M,A
SHLD EOTX
LXI H,ENTR ;POKE OUT JMP TO INIT
SHLD 1 ;MAKE IT A JUMP TO ENTR
RST 5 ;PRINT SIGN ON MESSAGE
DB 15Q,12Q,'CASUA','L'+200Q
JMP ICN2 ;CONTINUED AT ICN2
;
;ROUTINE TO GET 'Y'' 'OR 'N'' 'ANSWER FROM TERMINAL.
;TZ MEANS 'Y'',' FZ MEANS 'N''.'
;
YSNO: CALL TTYI ;GET HIS CHR
RST 4 ;ECHO IT
CPI 'Y' ;YES ?
JZ INIV
RET
WANT: RST 5 ;SR TO PRINT 'W'ANT'
DB 15Q,12Q,'WANT',' '+200Q
JMP MSG
;
ORG PGE+101Q;
;THIS SECTION POKES THE BINARY LOADER TO THE SAME /O
;CONFIGURATION USED BY THE BOOTSTRAP LOADER AT ZERO.
;THIS IS EXECUTED ONLY ONCE, UPON ENTRY FROM THE
;BOOTSTRAP. AFTER THE FIRST TIME EXECUTED, THE JUMP
;AT WORD 0 OF THE BINARY LOADER PAGE IS POKED TO JUMP
;AROUND THE I/O POKE.
;
BINL: LDA 7 ;INPUT STATUS PORT #-> A
STA RDIN+1 ;POKE INPUT ROUTINE
LHLD 11Q ;STATUS MASK ->L, RFZ OR RTZ -> H
MOV A,H ;CHANGE RTZ OR RFZ INTO JFZ OR JTZ
ADI 2
MOV H,A
SHLD POK1+1 ;POKE THE INPUT ROUTINE
LDA 14Q ;INPUT DATA PORT # -> A
STA POK2+1 ;POKE THE INPUT ROUTINE
LXI H,REAC ;POKE OUT THE JUMP TO BINL
SHLD PGE+1 ;MAKE IT A JUMP TO READ-3
REAC: LXI SP,PGE+256
READ: MVI C,0 ;CLEAR CHECKSUM
CALL RDIN ;GET A CHR FROM TAPE
CPI 277Q ;IS ITAN EOT CHR ?
JZ GOTO ;YUP - LOOK FOR START ADDRESS
CPI 377Q ;NOPE - IS IT A START OF BLOCK ?
JNZ READ ;NOPE - MUST BE LEADER, KEEP LOOKING
CALL ADIN ;GET THE LOAD ADDRESS -> H
CALL RDIN ;BLOCK LENGTH -> A
ORA A ;BLOCK LENGTH = 0 ?
JZ CKSM ;YUP - NO DATA, VERIFY CHECKSUM
MOV E,A ;MOVE BLOCK LENGTH -> E
DATA: CALL RDIN ;GET A DATA BYTE FROM TAPE
MOV M,A ;PUT IT INTO MEMORY
CMP M ;DID IT WRITE PROPERLY ?
JNZ MERR ;NOPE - GIVE A CAN'T WRITE ERROR
ADD C ;UPDATE CHECKSUM -> A
MOV C,A ;UPDATED CHECKSUM -> C
INX H ;BUMP THE LOAD ADDRESS
DCR E ;DONE WITH THIS BLOCK YET ?
JNZ DATA ;NOPE - GET MORE DATA BYTES
CKSM: CALL RDIN ;DONE WITH BLOCK, GET CHECKSUM -> A
CMP C ;DOES IT MATCH CALCULATED VALUE ?
JZ READ ;YUP - LOOK FOR ANOTHER BLOCK
MVI A,'C' ;NOPE - GIVE CHECKSUM ERROR
DB 1 ;SETUP A BOGUS LXI B INSTRUCTION
MERR: MVI A,'M'
ERR: OUT 1
OUT 10Q
OUT 21Q
OUT 23Q
STA PGE+377Q
JMP ERR ;LOOP FOREVER
;
;THIS SUBROUTINE GETS TWO BYTES FROM TAPE INTO H.
;
ADIN: CALL RDIN ;GET FIRST BYTE
MOV L,A ;MOVE IT INTO -> L
CALL RDIN ;GET SECOND BYTE
MOV H,A ;MOVE IT INTO -> H
RET
;
;COMES HERE WHEN EOT CHR IS FOUND. IF A 100 BYTE FOLLOWS
;THE EOT, THE NEXT TWO BYTES ARE TAKEN TO BE A START ADDRESS
;CONTROL IS TRANSFERRED TO THIS ADDRESS. IF NO 100 BYTE IS
;FOUND, WE ENTER AN INFINITE LOOP.
;
GOTO: CALL RDIN ;GET A CHR FROM TAPE
CPI 100Q ;IS IT A 100 (OCTAL)
FORE: JNZ FORE ;NOPE - JUMP HERE FOREVER
CALL ADIN ;START ADDRESS -> H
PCHL ;INDIRECT JUMP TO START ADDRESS
;
;THIS SUBROUTINE FETCHES A CHR FROM THE INPUT DEVICE.
;THE CHR IS RETURNED IN THE A REG. MUNCHES A & PSW.
;
RDIN: IN 5 ;INPUT READY STATUS -> A
POK1: ANI 1 ;MASK OFF UNNECESSARY BITS
JZ RDIN ;JUMP IF NOT READY, KEEP TRYING
POK2: IN 4 ;IT'S READY - GET THE DATA -> A
RET
LLOC EQU $ ;SAVE ADDRESS OF LAST BYTE USED
;
ICN2: RST 5 ;CONTINUE SIGN ON MESSAGE
DB ' V .16',15Q,212Q
LHLD SPRS
XCHG ;LAST LOC -> DE
LHLD BOTX ;FIRST -> H
MOV A,E ;DIFFERENCE -> H
SUB L
MOV L,A
MOV A,D
SBB H
MOV H,A
CALL NOSP ;PRINT DIFFERENCE
RST 5 ;PRINT 'B'YTES FREE'
DB 'BYTES FRE','E'+200Q
RST 0 ;RESET STACK AND ENTER
;
;THIS IS THE ROUTINE USED TO PUNCH MEMORY IN BOOTSTRAP FMT.
;
ORG PGE+512
MAKR: LXI SP,$+256
MVI B,377Q ;SEND 255 LEADER CHRS
MAKS: MVI A,LLOC AND 0FFH ;LEADER CHR -> A
CALL PNOU ;SEND A CHR OF LEADER
DCR B ;DONE WITH LEADER YET ?
JNZ MAKS ;NOPE - SEND SOME MORE
LXI H,LLOC-1 ;HIGHEST ADR TO SENT -> H
MAKT: MOV A,M ;GET A CHR TO PUNCH -> A
CALL PNOU ;PUNCH IT
DCR L ;PUNCHED IT ALL YET ?
JNZ MAKT ;NOPE - KEEP SENDING
MOV A,M ;SEND LAST CHR
CALL PNOU
JMP 7200H ;ALL DONE, BACK TO MONITOR
;
END