CP/M

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

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug018.ark / CASUAL.ASM next >

Wrap

Assembly Source File | 1984-04-29 | 39.1 KB | 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