Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / sigm / vol095 / crowe.z80 < prev next >

Wrap

Text File | 1984-04-29 | 136.6 KB | 5,086 lines

;COPYRIGHT 1978 BY PAT CROWE ;********************************************************************** ; Z80 ASSEMBLER VERSION 1.1 ; WRITTEN BY PAT CROWE ; 22 RINGSBURY CLOSE ; PURTON ; SWINDON ; SN5 9DE ; ENGLAND ;************************************************************************* ;CONSTANTS ;************************************************************************* CR EQU 0DH ; ASCII CARRIAGE RETURN LF EQU 0AH ; ASCII LINE FEED HT EQU 09H ; ASCII HORIZ. TAB FORMFD EQU 0CH ; ASCII FORM FEED NUL EQU 0 ; ASCII NULL SPACE EQU 20H ; ASCII SPACE DEL EQU 0FFH ; ASCII DELETE CTOK EQU 71H ; TOKEN FOR UNCONDIT. OPND KW 'C' CCOND EQU 8BH ; TOKEN FOR CONDITIONAL OPND KW 'C' XYMASK EQU 0FBH ; MASK TO RECOGNISE IX/IY TOKENS IXORIY EQU 1AH ; COMMON VALUE OF IX/IY TOKENS INTTOK EQU 90H ; OPERAND TOKEN FOR 'INTEGER' ORGTOK EQU 1 ; TOKEN FOR 'ORG' PSEUDO-OP EQUTOK EQU 2 ; TOKEN FOR 'EQU' PSEUDO-OP DEFLTK EQU 3 ; TOKEN FOR 'DEFL' PSEUDO-OP DEFSTK EQU 7 ; TOKEN FOR 'DEFS' PSEUDO-OP TITTOK EQU 09H ; TOKEN FOR 'TITLE' PSEUDO-OP DEFMTK EQU 08H ; TOKEN FOR 'DEFM' PSUEDO-OP PLUTOK EQU 07H ; TOKEN FOR MONADIC PLUS MINTOK EQU 0FH ; TOKEN FOR MONADIC MINUS LBTOK EQU 0B0H ; TOKEN FOR '(' EXPTOK EQU 35H ; TOKEN FOR EXPONENTIATION ASKTOK EQU 3DH ; TOKEN FOR MULTIPLY MAXFSK EQU 10D ; MAX SIZE OF ARITHMETIC ; FUNCTION STACK MAXASK EQU 20D ; MAX SIZE OF ARITH STACK PLINES EQU 66 ; NO OF LINES ON LIST DEVICE PAGE LBFSZ EQU 64 ; LINE BUFFER CAPACITY ACBSIZ EQU 32 ; SIZE OF ASSD CODE BUFFER TITSIZ EQU 32 ; SIZE OF TITLE BUFFER RECSIZ EQU 16 ; MAX NO OF DATA BYTES PER OBJ RECORD SPERL EQU 5 ; NO OF SYMBOLS PER LINE ; IN SYMBOL TABLE LISTING STKSIZ EQU 68 ; SIZE OF STACK ; CP/M LINKS CPM EQU 5 ;FDOS ENTRY BOOT EQU 0 ;WARM START SETDMA EQU 26 ;CP/M FUNCTION OPNFIL EQU 15 ;OPEN FILE CLSFIL EQU 16 ;CLOSE FILE DELFIL EQU 19 ;DELETE FILE MAKFIL EQU 22 ;CREATE FILE RDNR EQU 20 ;READ NEXT RECORD WRNR EQU 21 ;WRITE NEXT RECORD PRBUF EQU 9 ;PRINT STRING ON CONSOLE DFCB EQU 5CH ;DEFAULT FCB DEFBUF EQU 80H ;DEFAULT BUFFER GETCON EQU 0F009H ;PFM-80 CONSOLE INPUT PUTCON EQU 0F00CH ;PFM-80 CONSOLE OUTPUT CTLZ EQU 1AH ;EOF CHARACTER ;**************************************************************************** ;START OF PROGRAM. ;I/O ROUTINE JUMP TABLE. ;THE USER SHOULD PLACE THE ADDRESSES OF HIS ;OWN I/O SUBROUTINES IN THE LOCATIONS IN ;THIS TABLE CONTAINING THE DESTINATIONS OF ;JP INSTRUCTIONS. ALL I/O IS PERFORMED VIA ;THIS TABLE. ;**************************************************************************** ORG 100H START: JR MAIN ; JUMP PAST JUMP TABLE CI: JP CONIN ; JUMP TO USER CONSOLE IN SUBR CO: JP CONOUT ; JUMP TO USER CONSOLE OUT SUBR LO: JP LSTO ; JUMP TO USER LIST OUT SUBR RI: JP RDRIN ; JUMP TO USER READER IN SUBR PCHO: JP PCHOUT ; JUMP TO USER PUNCH OUT SUBR MEMCHK: JP MEMCK ; JUMP TO USER MEM CHECK SUBR EXEC: JP BOOT ; JUMP TO USER MONITOR ENTRY POINT ;MAIN PROGRAM LOOP. ;**************************************************************************** MAIN: LD SP,0F900H ; SET STACK POINTER CALL INITA ; INITIALIZE ASSEMBLER CALL PHRLD ; PRINT HERALD MAIN1: CALL GTPNO ; GET PASS NO. JP Z,EXEC ; RETURN TO SYSTEM MONITOR LD A,(PASSNO) ; IS IT PASS 1? CP 1 CALL Z,INITA ; IF SO, INITIALIZE CALL PASS ; PERFORM 1 PASS LD HL,AFLAGS ; TEST SYMB TAB OVERFLOW FLAG BIT 2,(HL) ; JR Z,MAIN1 ; JUMP IF NOT SET LD HL,WARNNG ; ELSE PRINT WARNING ON CONSOLE CALL CONST JR MAIN1 ; GO DO ANOTHER PASS ;................................................ WARNNG: DEFB CR ; SYMTAB OVERFLOW WARNING MESSAGE DEFB LF DEFM 'SYMBOL TABLE OVERFLOW' DEFB CR DEFB LF DEFB 0 ;**************************************************************************** ;PRINT HERALD ON CONSOLE DEVICE. ;**************************************************************************** PHRLD: PUSH HL ; SAVE REG LD HL,HERALD ; SET POINTER TO HERALD MESSAGE CALL CONST POP HL ; REPLACE REG RET HERALD: DEFB CR DEFB LF DEFM 'CROWE Z80 ASSEMBLER V1.1' DEFB CR DEFB LF DEFM 'COPYRIGHT PAT CROWE 1978' DEFB CR DEFB LF DEFB 0 ;.............................................. ;PRINT STRING ON CONSOLE DEVICE ;ON ENTRY HL POINTS AT STRING ;END OF STRING MARKER IS 0 ;.............................................. CONST: PUSH BC ; SAVE REG CONST1: LD A,(HL) AND A JR Z,CONST2 LD C,A CALL CO INC HL JR CONST1 CONST2: POP BC ; REPLACE REG RET ;********************************************************************** ;GET PASS NUMBER ;ZERO FLAG SET IF 'Q' TYPED ;********************************************************************** GTPNO: PUSH HL ; SAVE REGISTERS PUSH BC GTPNO1: LD HL,CRLF ; POINT TO CR LF STRING CALL CONST ; OUTPUT STRING TO CONSOLE DEVICE LD HL,PASNO? ; POINT TO 'PASS NO.?' STRING CALL CONST ; OUTPUT STRING TO CONSOLE CALL CI ; GET CHAR FROM CONSOLE KEYBOARD LD C,A ; SAVE IN B AND C REGISTERS LD B,A CALL CO ; ECHO CHAR TO CONSOLE LD A,B CP 'Q' ; QUIT? JR Z,GTPNO2 ; JUMP IF SO CP '1' ; INPUT IN RANGE 1-4 ? JR C,GTPNO1 ; NO, GO ASK FOR ANOTHER CP '5' JR NC,GTPNO1 ; DITTO AND 7 ; MASK TO GET BINARY PASS NO. LD (PASSNO),A ; SAVE IN PASS NO. STORE LD HL,CRLF ; OUTPUT ANOTHER CR LF TO CONSOLE XOR A ; CLEAR ZERO FLAG INC A GTPNO2: POP BC ; REPLACE REGISTERS POP HL RET ; AND RETURN CRLF: DEFB CR DEFB LF DEFB 0 PASNO?: DEFM 'PASS NO. = ' DEFB 0 ;**************************************************************************** ;PERFORM A PASS ;**************************************************************************** PASS: CALL INITP ; INITIALIZE FOR PASS PASS1: CALL INITL ; INITIALIZE FOR LINE CALL GLIN ; GET A LINE CALL GLAB ; GET LABEL JR Z,PASS4 ; JMP IF NO MORE PROC. REQD. CALL GETOR ; GET OPERATOR TOKEN JR Z,PASS4 ; JUMP IF NO MORE PROC. REQD. LD A,(ORTKBF) ; IS OPERATOR 'TITLE'? CP TITTOK ; TOKEN FOR TITLE? JR NZ,PASS2 ; NO, IS OPERATOR 'DEFM'? CALL TITL ; YES, PROCESS ITS OPERAND JR PASS5 PASS2: CP DEFMTK ; TOKEN FOR 'DEFM'? JR NZ,PASS3 CALL DM ; YES, PROCESS ITS OPERAND JR PASS5 PASS3: CALL GTOD ; NEITHER, PROCESS NORMAL OPERANDS JR Z,PASS4 ; JMP IF NO MORE PROC. REQD. PASS5: CALL PTOK ; PROCESS TOKENS PASS4: CALL PFRLO ; PERFORM RELEVANT OUTPUT LD A,(AFLAGS) ; TEST FOR END STATEMENT BIT 1,A JR Z,PASS1 ; GO PROCESS ANOTHER LINE IF NOT RET ;************************************************************************** ;INITIALIZE ASSEMBLER ;************************************************************************** INITA: PUSH HL ; SAVE REGS PUSH BC ; XOR A ; CLEAR ACC LD (TITBUF),A ; EMPTY TITLE BUFFER LD (SYMTAB),A ; CLEAR SYMBOL TABLE LD HL,SYMTAB ; PUT SYMBOL TABLE START ADDR LD (SYMEND),HL ; INTO 'END OF SYMBOL TABLE' STORE LD HL,AFLAGS ; CLEAR SYMTAB OVERFLOW FLAG RES 2,(HL) CALL MEMCHK ; GET HIGHEST AVAIL MEM IN B-A LD HL,MEMTOP ; SAVE IN MEMTOP LD (HL),A INC HL LD (HL),B POP BC ; REPLACE REGS POP HL RET ;**************************************************************************** ;INITIALIZE PASS ;**************************************************************************** INITP: PUSH BC ; SAVE REG XOR A ; CLEAR ACC. LD (OBJCNT),A ; CLEAR OBJECT BUFFER COUNT LD (ADREFC),A ; SET ADDR REF CNTR = 0 LD (ADREFC+1),A LD (PAGE+1),A ; SET PAGE NO. = 1 INC A LD (PAGE),A LD A,PLINES-9 ; SET LINE NO. = MAX SIZE LD (LINE),A LD A,(PASSNO) ; GET PASS NO. CP 3 JR NZ,INITP1 ; JUMP IF NOT CALL RUNOUT ; PUNCH 30 CM RUNOUT LD C,CR ; PUNCH CR CALL PCHO LD C,LF ; PUNCH LF CALL PCHO JR INITP3 INITP1: CP 2 ; PASS 2? JR Z,INITP2 ; JUMP IF SO CP 4 ; PASS 4? JR NZ,INITP3 ; JUMP IF NOT INITP2: LD C,FORMFD ; LIST FORM FEED CALL LO LD C,CR ; LIST CR CALL LO LD C,LF ; LIST 3 LF'S LD B,3 CALL OUTC CALL LFEED ; LIST PAGE HEADER INITP3: POP BC ; REPLACE REG RET ;************************************************************************** ;INITIALIZE LINE ;*************************************************************************** INITL: PUSH BC ; SAVE REGS PUSH HL XOR A ; CLEAR ACC LD HL,ASSCOD ; SET PNTR TO ASSD CODE BUFFER LD B,ACBSIZ ; LOAD CNTR WITH SIZE OF BUFFER INITL1: LD (HL),A ; CLEAR A LOCATION INC HL ; INCR PNTR DJNZ INITL1 ; LOOP UNTIL DONE LD (ASCDNO),A ; SET 'BYTES ASSD CODE' = 0 LD (ODBT1),A ; CLEAR OPERAND TOKEN BUFFERS LD (ODBT2),A LD HL,0 ; CLEAR OPERAND INTEGER BUFFERS LD (ODINT1),HL LD (ODINT2),HL LD (ORTKBF),HL ; CLEAR OPERATOR TOKEN BUFFER LD HL,(ADREFC) ; COPY ADDR REF CNTR LD (ADDISR),HL ; INTO ADDR DIS REG LD HL,AFLAGS ; SET PNTR TO ASSEMBLER FLAGS RES 0,(HL) ; CLEAR ADDR DISCONTINUITY FLAG RES 1,(HL) ; CLEAR 'END' FLAG POP HL POP BC RET ;************************************************************************ ;GET LINE FROM READER ;COPIES LINE OF SOURCE TEXT INTO LINBUF ;ECHOES TO PRINTER IF PASS2 ;************************************************************************* GLIN: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD B,LBFSZ-1 ; SET LINE BUFFER SIZE LD HL,LINBUF ; SET POINTER TO LINE BUFFER LD DE,0 ; CLEAR TAB COUNTER (E) & STATUS REG LD A,SPACE ; PUT SPACE CHAR IN ERROR BUFFER LD (ERRBUF),A LD A,(PASSNO) ; SET 'PASS2' FLAG IF PASS 2 CP 2 JR NZ,GLIN1 SET 0,D GLIN1: CALL RI ; GET CHAR FROM READER LD C,A ; SAVE IT IN C CP CR ; IS IT CR? JR Z,GLIN2 CP HT ; IS IT TAB? JR Z,GLIN3 CP LF ; IS IT LINE FEED? JR Z,GLIN1 ; IGNORE CP NUL ; IS IT A NULL CHAR? JR Z,GLIN1 ; IGNORE CP DEL ; IS IT A DELETE CHAR? JR Z,GLIN1 ; IGNORE AND 60H ; IS IT ANY OTHER CONTROL CHAR? JR NZ,GLIN5 LD C,'I' ; PUT 'ILLEGAL CHAR'IN ERROR DISP CALL ERROR JR GLIN1 GLIN5: LD A,C ; GET CHAR BACK CP ';' ; SET COMMENT FLAG IF ';' JR NZ,GLIN7 SET 1,D GLIN7: LD (HL),A ; PUT IN BUFFER INC HL ; INCREMENT BUFFER POINTER BIT 0,D ; IF PASS 2 FLAG SET, CALL NZ,LO ; OUTPUT CHAR TO LIST DEVICE INC E ; INCREMENT TAB COUNTER GLIN11: DEC B ; BUFFER FULL? JR NZ,GLIN1 GLIN9: CALL RI ; SCAN TO NEXT CR FROM READER CP CR JR NZ,GLIN9 LD (HL),A ; PUT CR IN BUFFER LD C,A ; IF PASS 2 FLAG SET BIT 0,D CALL NZ,LO ; OUTUT CR TO LIST DEVICE BIT 1,D ; REACHED COMMENT BEFORE BUFFER FULL? JR NZ,GLIN4 LD C,'L' ; PUT 'LINE TOO LONG' IN ERROR DISP CALL ERROR JR GLIN4 GLIN2: LD (HL),A ; PUT CR IN BUFFER BIT 0,D ; IF PASS 2 FLAG SET CALL NZ,LO ; OUTPUT TO LIST DEVICE JR GLIN4 GLIN3: LD C,SPACE ; TAB. PUT SPACE IN BUFFER LD (HL),C INC HL BIT 0,D ; IF PASS 2 FLAG SET, CALL NZ,LO ; OUTPUT TO LIST DEVICE INC E ; REACHED NEXT TAB POSITION? LD A,7 AND E JR Z,GLIN11 DEC B ; BUFFER FULL? JR Z,GLIN9 JR GLIN3 GLIN4: POP BC ; REPLACE REGS POP DE POP HL RET ;********************************************************************** ;GET LABEL ;LOCATES LABEL (IF ANY) IN LINBUF AND PUTS IT IN LABBUF. ;LEAVES POINTER TO CHARACTER AFTER LABEL IN LINPNT. ;ZERO SET IF NOTHING ELSE TO PROCESS ;********************************************************************** GLAB: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD HL,LINBUF ; SET POINTER TO LINE BUFFER LD DE,LABBUF ; SET POINTER TO LABEL BUFFER LD B,0 ; CLEAR STATUS REG GLAB1: LD A,(HL) ; SCAN TO FIRST NON SPACE CHAR CP SPACE JR NZ,GLAB2 SET 2,B ; SET 'NOT FIRST COL' FLAG INC HL ; POINT TO NEXT CHAR JR GLAB1 GLAB2: CP CR ; NULL LINE? JR Z,GLAB8 CP ';' ; COMMENT? JR Z,GLAB8 CP 'A' ; IT IS A-Z? JR C,GLAB5 CP 'Z'+1 JR NC,GLAB5 CALL GSYM ; PUT SYMBOL IN BUFFER LD A,(HL) ; FOLLOWED BY ':'? CP ':' JR Z,GLAB3 ; JUMP IF FOLLOWED BY ':' ; I.E. IT'S A LABEL BIT 2,B ; STARTED IN FIRST COLUMN? JR NZ,GLAB6 ; JUMP IF NOT LABEL JR GLAB7 GLAB3: INC HL LD A,(HL) GLAB7: CP SPACE ; FOLLOWED BY SP/CR/;? JR Z,GLAB4 CP CR JR Z,GLAB4 CP ';' JR Z,GLAB4 GLAB5: CALL DNOPS ; RESERVE 4 DEFAULT NOP'S CALL ADJARC ; ADJUST ADDRESS REF COUNTER XOR A ; SET ZERO FLAG JR GLAB8 GLAB6: LD HL,LINBUF ; SET POINTER TO START OF LINBUF XOR A ; SET 'NO LABEL IN BUFFER' LD (LABBUF),A GLAB4: LD (LINPNT),HL ; DEPOSIT LINE POINTER XOR A ; CLEAR ZERO FLAG INC A GLAB8: POP BC ; REPLACE REGS POP DE POP HL RET ;********************************************************************* ;GET OPERATOR TOKEN, ;LOCATES OPERATOR (IF ANY) AND PUTS TOKEN AND VALUE FOR IT IN ORTKBF. ;LEAVES POINTER TO CHARACTER AFTER OPERATOR IN LINPNT ;ZERO FLAG SET IF NOTHING ELSE TO PROCESS. ;********************************************************************** GETOR: PUSH HL ; SAVE REGISTERS PUSH DE PUSH BC EXX PUSH HL PUSH DE PUSH BC LD HL,(LINPNT) ; FETCH PONTER TO LINE BUFFER GETOR1: CALL SCNSP ; SCAN TO FIRST NON SPACE CHAR GETOR5: CP CR ; IS IT CR? JR Z,GETOR2 CP ';' ; IS IT ';'? JP Z,GETOR2 CALL ALPHA ; IS IT A LETTER? JR NC,GETOR3 ; NO, SYNTAX ERROR LD DE,SYMBUF+1 ; SET POINTER TO SYMBOL BUFFER LD B,0 ; SET COUNT = 0 GETOR4: LD (DE),A ; PUT CHAR IN OPERATOR BUFFER INC HL ; INCR LINBUF POINTER INC DE ; INCREMENT SYMBUF POINTER INC B ; INCR CHAR COUNT LD A,5 ; GREATER THAN 5? CP B JR C,GETOR3 ; YES, SYNTAX ERROR LD A,(HL) ; GET NEXT CHAR CALL ALPHA ; IS IT A LETTER JR C,GETOR4 ; YES, LOOP LD A,B ; SAVE # OF OPR CHARS IN SYMBUF LD (SYMBUF),A LD A,(HL) ; FETCH NEXT CHAR AGAIN CP SPACE JP Z,GETOR6 CP CR JR Z,GETOR6 CP ';' JR NZ,GETOR3 ; INVALID SYNTAX GETOR6: EXX ; SET UP PARAMETERS FOR OPTOK LD HL,ORLSTP LD DE,ORTKBF LD C,2 CALL OPTOK ; GET TOKENS FROM LIST EXX JR Z,GETOR3 ; INVALID SYNTAX, NOT IN LIST GETOR2: LD (LINPNT),HL ; DEPOSIT LINE BUFFER POINTER XOR A ; CLEAR ZERO FLAG INC A GETOR7: POP BC ; RECOVER REGISTERS POP DE POP HL EXX POP BC POP DE POP HL RET GETOR3: CALL DNOPS ; RESERVE 4 DEFAULT NOP'S CALL ADJARC ; ADJUST ADDRESS REF COUNTER XOR A ; SET ZERO FLAG JR GETOR7 ;********************************************************************** ;GET OPERAND TOKENS AND VALUES ;LOCATES OPERANDS (IF ANY) AND SETS TOKENS FOR THEM IN ODBT1/ODBT2 ;AND CORRESPONDING INTEGER VALUES (IF ANY) IN ODINT1/ODINT2. ;ZERO FLAG SET IF NOTHING ELSE TO PROCESS ;********************************************************************** GTOD: PUSH IX ; SAVE REGISTERS PUSH IY PUSH HL PUSH DE PUSH BC EXX PUSH HL PUSH DE PUSH BC LD HL,(LINPNT) ; GET LINE BUFFER POINTER LD B,0 ; CLEAR B (OPERAND COUNTER, ; 'BRACKETS' FLAG & 'QUOTE' FLAG) GTOD1: CALL SCNSP ; SCAN TO FIRST NON SPACE CHAR CP ',' ; IS IT A COMMA? JR NZ,GTOD2 BIT 0,B ; YES, FOUND 1 OPERAND? JP Z,GTOD25 ; NO, SYNTAX ERROR INC HL ; YES, SCAN TO NEXT NON SP CHAR CALL SCNSP JR GTOD3 GTOD2: CP ';' ; IS IT A ';'? JP Z,GTOD24 CP CR ; OR A CR? JP Z,GTOD24 GTOD3: PUSH HL ; NO, SET POINTER TO START POP IX ; OF OPERAND IN IX ; SCAN TO NEXT DELIMITER RES 6,B ; CLEAR QUOTE FLAG GTOD4: LD A,(HL) ; GET CHAR IN A CP '''' ; IS IT A '? JR NZ,GTOD18 ; JUMP IF NOT LD A,B ; COMPLEMENT QUOTE FLAG XOR 01000000B LD B,A JR GTOD28 ; AND CONTINUE TO SCAN GTOD18: CP CR ; IS IT CR? JR Z,GTOD5 ; FOUND DELIMITER, JUMP CP SPACE ; IS IT SPACE JR Z,GTOD27 ; JUMP IF SO CP ',' ; IS IT A COMMA? JR Z,GTOD27 ; JUMP IF SO CP ';' ; IS IT ; ? JR NZ,GTOD28 ; CONTINUE SCAN OF NONE OF THESE GTOD27: BIT 6,B ; IS QUOTE FLAG SET? JR Z,GTOD5 ; JUMP IF NOT, FOUND DELIMITER GTOD28: INC HL ; POINT TO NEXT CHAR JR GTOD4 ; AND LOOP ; FOUND DELIMITER GTOD5: PUSH HL ; SET POINTER (IY) TO CHAR POP IY ; AFTER END OF OPERAND INC B ; INCR # OF OPERANDS FOUND LD A,B ; IS IT > 2 ? AND 3 CP 3 JP Z,GTOD25 ; YES, SYNTAK ERROR RES 7,B ; CLEAR BRACKETS FLAG LD A,(IX) ; DOES IT START WITH ( ? CP '(' JR NZ,GTOD6 LD A,(IY-1) ; DOES IT END WITH ) ? CP ')' JR NZ,GTOD6 SET 7,B ; SET BRACKETS FLAG IN B INC IX ; AND CLOSE IN POINTERS DEC IY GTOD6: PUSH IX ; GET POINTER TO START OF OPERAND POP HL LD DE,SYMBUF+1 ; SET POINTER TO SYMBUF LD C,0 ; ZERO CHAR COUNT GTOD10: LD A,(HL) ; FETCH A CHAR CALL ALPHA ; IS IT A LETTER? JR NC,GTOD7 LD (DE),A INC C ; INCR COUNT INC HL ; AND POINTERS INC DE LD A,C CP 3 JR NZ,GTOD10 JR GTOD9 ; MORE THAN 2 LETTERS, GO ; EVALUATE EXPRESSION GTOD7: CP '''' ; NOT LETTER, IS IT '? JR NZ,GTOD8 LD (DE),A ; SAVE IT IN BUFFER INC HL ; POINT TO CHAR FOLLOWING INC C ; INCREMENT COUNT GTOD8: LD A,C ; PUT COUNT IN SYMBUF LD (SYMBUF),A AND A ; IF COUNT=0 THEN JR Z,GTOD9 ; GO TO EVAL EXPRESSION EXX ; GET OPERAND KEYWORK TOKEN LD HL,OPKLST LD DE,TEMP LD C,1 ; 1 BYTE PER TOKEN CALL OPTOK EXX JR Z,GTOD9 ; JUMP IF NO KEYWORD FOUND LD C,A ; SAVE TOKEN IN C CP CTOK ; TOKEN FOR C? JR NZ,GTOD12 LD A,(ORTKBF) BIT 7,A ; IS OPERATOR CONDITIONAL? JR Z,GTOD12 LD C,CCOND ; TOKEN FOR CONDITIONAL 'C' GTOD12: LD A,C ; GET TOKEN AND XYMASK ; IS IT IX/IY ? CP IXORIY JR NZ,GTOD14 LD A,(HL) ; GET FOLLOWING CHAR CP '+' JR Z,GTOD13 CP '-' JR NZ,GTOD14 GTOD13: LD A,C ; CONVERT TOKEN TO DUMMY VALUE AND 0FH OR 0C0H LD C,A PUSH HL ; CLOSE POINTER IN TO START OF EXPRESS POP IX CALL EVAL ; GET VALUE OF EXPRESSION IN HL JR Z,GTOD25 ; SYNTAX ERROR BIT 0,B ; FOUND 1 OPERAND? JR Z,GTOD15 LD (ODINT1),HL ; SAVE VALUE IN 1ST OPERAND BUFFER JR GTOD11 GTOD15: LD (ODINT2),HL ; SAVE VALUE IN 2ND OPND BUFF JR GTOD11 GTOD14: PUSH IY ; END OF OPERAND? POP DE AND A ; CLEAR CARRY FLAG SBC HL,DE JR NZ,GTOD25 ; SYNTAX ERROR JR GTOD11 GTOD9: CALL EVAL ; EVALUATE EXPRESSION ; RESULT IN HL JR Z,GTOD25 ; SYNTAX ERROR BIT 0,B ; FOUND 1 OPERAND? JR Z,GTOD17 LD (ODINT1),HL ; SAVE VALUE IN FIRST OPERAND BUFFER JR GTOD16 GTOD17: LD (ODINT2),HL ; SAVE VALUE IN 2ND OPND BUFF GTOD16: LD C,INTTOK ; SET TOKEN FOR 'INTEGER' GTOD11: BIT 7,B ; WAS IT IN BRACKETS? JR Z,GTOD21 ; NO LD HL,BKLST ; YES, CHECK IF VALID, POINT TO LIST GTOD20: LD A,(HL) ; GET A TOKEN INC HL ; POINT TO REPLACEMENT TOKEN AND A ; IS TOKEN 0 ? JR Z,GTOD25 ; YES, NOT IN LIST, SYN. ERR. CP C ; IS IT EQUAL TO ACTUAL TOKEN? JR Z,GTOD19 ; YES, GO REPLACE IT INC HL ; POINT TO NEXT TOKEN JR GTOD20 GTOD19: LD C,(HL) ; REPLACE TOKEN WITH ; BRACKETTED VERSION. INC IY ; OPEN OUR FINAL POINTER AGAIN GTOD21: LD A,C ; SAVE TOKEN IN RELEVANT BUFFER BIT 0,B ; FOUND 1 OPERAND? JR Z,GTOD22 LD (ODBT1),A ; SAVE TOKEN IN 1ST OPND BUFF JR GTOD23 GTOD22: LD (ODBT2),A ; SAVE TOKEN IN 2ND OPND BUFF GTOD23: PUSH IY ; POINT AT NEXT THING POP HL JP GTOD1 ; GO PROCESS NEXT TOKEN GTOD24: XOR A ; CLEAR ZERO FLAG INC A GTOD26: POP BC ; REPLACE SAVED REGISTERS POP DE POP HL EXX POP BC POP DE POP HL POP IY POP IX RET GTOD25: CALL DNOPS ; APPEND DEFAULT NOP'S CALL ADJARC ; ADJUST ADDRESS REF COUNTER XOR A JR GTOD26 ;************************************************************************ ;EVALUATE AN EXPRESSION ;ON ENTRY AND EXIT: ; IX POINTS AT FIRST CHAR OF EXPRESSION ; IY POINTS AT CHAR AFTER END OF EXPRESSION ;ON EXIT: ; HL CONTAINS VALUE OF EXPRESSION ; AND ZERO FLAG IS SET IF SYNTAX ERROR ;************************************************************************ EVAL: PUSH DE ; SAVE REGISTERS PUSH BC EXX PUSH BC XOR A ; CLEAR ROUTINE FLAG REGISTER LD B,A EXX LD (ARCNT),A ; CLEAR STACKS LD (FCNT),A PUSH IX ; POINT TO START OF EXPR. POP HL EVAL1: PUSH IY ; END OF EXPRESSION? POP DE ; I.E. HL=IY ? EX DE,HL AND A ; CLEAR CARRY SBC HL,DE EX DE,HL JP Z,EOEX ; END OF EXPRESSION JP C,EVAL6 ; END OF EXPRESSION ERROR LD A,(HL) ; GET A CHAR CALL DIGIT ; IS IT A DIGIT? JR C,LIT ; YES, GO PROCESS LITERAL CALL ALPHA ; IS IT A LETTER? JR C,SYMB ; YES, GO PROCESS SYMBOL CP '.' ; IS IT A '.'? JR Z,MCF ; YES, GO PROCESS M/CHAR FUNCTION CP '''' ; IS IT A '? JR Z,ASC ; YES, GO PROC. ASCII CHAR CP '(' ; IS IT A '('? JP Z,LBKT ; YES, GO PROC. LEFT BRKT CP ')' ; IS IT ')'? JP Z,RBKT ; YES, GO PROC. R.H. BRKT CP '$' ; IS IT '$'? JR Z,CURLC ; YES, GO PROC. CURR. LOC. SCHF: CALL PSCF ; PROCESS AS SINGLE CHAR. FUNCTION JP Z,EVAL3 ; INVALID CHAR ERROR JR FUN LIT: CALL PLIT ; PROCESS AS LITERAL JR OPND SYMB: CALL PSYMB JR OPND ASC: CALL PASC ; PROCESS OS ASCII STRING JR OPND CURLC: LD DE,(ADREFC) ; CURRENT VALUE OF ADDR REF ; COUNTER REQUIRED INC HL ; POINT TO NEXT EXPR CHAR JR OPND1 OPND: JP C,EVAL4 ; 'VALUE' ERROR OPND1: CALL PUDE ; PUSH VALUE (IN DE) ONTO ; ARITHMETIC STACK JP Z,EVAL5 ; STACK OVERFLOW ERROR EXX ; SET 'LAST UNIT' FLAG SET 0,B EXX JR EVAL1 MCF: CALL PMCF JP Z,EVAL6 ; SYNTAX ERROR FUN: LD A,(FTOKR) ; GET FUNCTION TOKEN CP PLUTOK ; IS IT TOKEN FOR +? JR Z,FUN1 CP MINTOK ; IS IT TOKEN FOR -? JR NZ,FUN2 ; +/- FUN1: EXX ; WAS LAST UNIT START/(/FUNCTION ? BIT 0,B EXX JR Z,FUN3 ADD A,5DH ; CHANGE TOKEN TO DIADIC LD (FTOKR),A JP FUN3 FUN2: CP 3DH ; DIADIC FUNCTION JR C,FUN3 EXX ; WAS LAST UNIT START/(/FUNCTION? BIT 0,B EXX JP Z,EVAL6 ; SYNTAX ERROR FUN3: CALL POFU ; GET PREVIOUS FUNCTION JR Z,FUN4 ; NO PREVIOUS FUN, PUSH NEW ONE LD E,A ; SAVE TOP OF STACK IN E LD A,(FTOKR) ; GET NEW FUNCTION TOKEN AND 7 ; MASK OFF PRIORITY BITS IN NEW OPR LD B,A ; SAVE IN B LD A,E AND 7 ; MASK OFF PRIORITY BITS OF TOS CP B ; COMPARE PRIORITIES JR NC,FUN5 ; GO DO A FUNCTION ; NEW FUNCTION HAS HIGHER ; PRIORITY SO PUSH IT ON ; STACK. LD A,E ; FIRST PUSH BACK TOP OF STACK CALL PUFU FUN4: LD A,(FTOKR) ; THEN PUSH NEW FUNCTION CALL PUFU JR Z,EVAL5 ; STACK OVERFLOW ERROR EXX ; CLEAR 'LAST UNIT' FLAG RES 0,B EXX JP EVAL1 FUN5: LD A,E ; PUT T O S IN ACC CALL FUNC ; PERFORM A FUNCTION JR Z,EVAL6 ; SYNTAX ERROR JR FUN3 ; GO TRY NEXT FUNCTION ON STACK ;.................................................. LBKT: INC HL ; POINT TO NEXT EXPR CHAR LD A,LBTOK ; SET TOKEN FOR '(' CALL PUFU ; PUSH ON FUNCTION STACK JR Z,EVAL5 ; STACK OVERFLOW ERROR EXX ; CLEAR 'LAST UNIT' FLAG RES 0,B EXX JP EVAL1 ;.................................................. RBKT: INC HL RBKT2: CALL POFU ; POP FUNCTION STACK JR Z,EVAL7 ; EMPTY, BALANCE ERROR CP LBTOK ; IS IT A (? JR Z,RBKT1 CALL FUNC ; PERFORM THE FUNCTION JR Z,EVAL6 ; SYNTAX ERROR JR RBKT2 ; MORE OPS TO DO ? RBKT1: EXX ; SET 'LAST UNIT' FLAG SET 0,B EXX JP EVAL1 ;................................................. ; END OF EXPRESSION EOEX: CALL POFU ; POP FUNCTION STACK JR Z,EOEX1 ; NO MORE FUNCTIONS CP LBTOK JR Z,EVAL7 ; BALANCE ERROR CALL FUNC ; PERFORM THE FUNCTION JR Z,EVAL6 ; SYNTAX ERROR JR EOEX EOEX1: CALL PODE ; GET EXPR VALUE IN DE JR Z,EVAL6 ; SYNTAX ERROR (STACK EMPTY) LD A,(ARCNT) ; CHECK IF STACK NOW EMPTY AND A JR NZ,EVAL6 ; SYNTAX ERROR EX DE,HL EXX BIT 1,B ; TEST FOR ARITH OVERFLOW EXX JR Z,EOEX2 LD C,'A' EOEX4: CALL ERROR ; INDICATE ARITH OVERFLOW EOEX2: XOR A ; CLEAR ZERO FLAG INC A EOEX3: EXX POP BC EXX POP BC POP DE RET EVAL3: LD C,'I' JR EVAL8 EVAL4: LD C,'V' ; VALUE ERROR LD HL,0 ; SET RESULT=0 JR EOEX4 ; NOT FATAL EVAL5: LD C,'O' ; STACK OVERFLOW ERROR JR EVAL8 EVAL6: LD C,'S' ; SYNTAX ERROR JR EVAL8 EVAL7: LD C,'B' ; BALANCE ERROR EVAL8: CALL ERROR ; SET ERROR INDICATOR XOR A ; SET ZERO (ERROR) FLAG JR EOEX3 ; AND PREPARE TO EXIT ;********************************************************************** ;PROCESS LITERAL. ;THIS SUBROUTINE INCLUDES PBIN, PDEC, ;PHEX, POCT. ;ON ENTRY: ; HL POINTS TO FIRST CHAR OF LITERAL ;ON EXIT: ; HL POINTS TO CHAR AFTER LITERAL ; DE CONTAINS VALUE OF LITERAL ; CARRY FLAG IS SET FOR VALUE ERROR ;********************************************************************** PLIT: PUSH HL ; SAVE POINTER TO START OF LIT. PLIT1: LD A,(HL) ; GET CHAR CALL HEXDG ; IS IT VALID DIG FOR LIT.? JR NC,PLIT2 INC HL ; YES, POINT TO NEXT CHAR JR PLIT1 PLIT2: DEC HL ; NO, GO BACK TO LAST CHAR LD A,(HL) ; FETCH IT TO ACC. POP HL ; REPLACE POINTER TO START OF LIT. CP 'B' ; WAS FINAL CHAR 'B' JP Z,PBIN ; BINARY LITERAL CP 'D' ; 'D'? JP Z,PDEC ; DECIMAL LITERAL CP 'H' ; 'H'? JP Z,PHEX ; HEX LITERAL CP 'O' ; 'O'? JP Z,POCT ; OCTAL LITERAL CP 'Q' ; 'Q'? JP Z,POCT ; OCTAL LITERAL JP PDEC ; DECIMAL LITERAL ;********************************************************************** ;PROCESS BINARY LITERAL. ;********************************************************************** PBIN: PUSH BC ; SAVE REGISTERS LD DE,0 ; CLEAR 16 BIT ACC. PBIN1: LD A,(HL) ; GET CHAR CALL HEXDG ; VALID IN A LITERAL? JR NC,PBIN2 CP '1'+1 ; VALID IN BINARY LIT.? JR NC,PBIN2 SUB '0' ; CONVERT ASCII TO BINARY LD C,A CALL SHLDE ; SHIFT DE LEFT CALL ADCDE ; & ADD NEW DIG. TO DE INC HL ; INCREMENT POINTER TO NEXT CHAR. JR PBIN1 PBIN2: CP 'B' ; CHAR NOT BIN. DIG.. IS IT 'B'? JR NZ,PBIN4 INC HL ; YES, POINT TO NEXT CHAR LD A,(HL) ; GET IT IN ACC CALL HEXDG ; VALID CHAR FOR A LIT.? PBIN3: POP BC RET PBIN4: SCF ; SET CARRY FOR ERROR JR PBIN3 ;********************************************************************** ;PROCESS OCTAL LITERAL ;********************************************************************** POCT: PUSH BC LD DE,0 ; CLEAR 16 BIT ACC. POCT1: LD A,(HL) ; GET CHAR CALL HEXDG ; VALID IN LITERAL? JR NC,POCT3 CP '7'+1 ; VALID IN OCTAL LIT.? JR NC,POCT3 SUB '0' ; CONVERT ASCII TO BINARY LD C,A LD B,3 ; SHIFT DE LEFT 3 TIMES POCT2: CALL SHLDE DEC B ; DONE 3 SHIFTS YET? JR NZ,POCT2 CALL ADCDE ; ADD NEW DIGIT TO DE INC HL ; INCR POINTER TO NEXT CHAR JR POCT1 POCT3: CP 'O' ; CHAR NOT OCT DIG. IS IT 'O'? JR Z,POCT4 CP 'Q' ; IS IT 'Q'? JR NZ,POCT6 POCT4: INC HL ; YES, POINT TO NEXT CHAR LD A,(HL) ; GET IT IN ACC CALL HEXDG ; VALID CHAR IN A LIT.? POCT5: POP BC RET POCT6: SCF ; SET CARRY FOR ERROR JR POCT5 ;********************************************************************* ;PROCESS DECIMAL LITERAL. ;********************************************************************* PDEC: PUSH BC LD DE,0 ; CLEAR 16 BIT ACC. PDEC1: LD A,(HL) ; GET CHAR CALL HEXDG ; VALID IN A LIT.? JR NC,PDEC2 CP '9'+1 ; VALID IN A DEC. LIT.? JR NC,PDEC2 SUB '0' ; CONVERT ASCII TO BINARY LD C,A LD B,0 PUSH BC LD B,D LD C,E CALL SHLDE ; DE X 2 CALL SHLDE ; DE X 4 CALL ADCDE ; DE X 5 CALL SHLDE ; DE X 10 POP BC ; RECOVER NEW DIGIT CALL ABCDE ; ADD IN NEW DIGIT INC HL ; POINT TO NEXT CHAR JR PDEC1 PDEC2: CP 'D' JR NZ,PDEC3 INC HL LD A,(HL) ; GET IT IN ACC PDEC3: CALL HEXDG POP BC RET ;******************************************************************* ;PROCESS HEXADECIMAL LITERAL. ;******************************************************************* PHEX: PUSH BC LD DE,0 ; CLEAR 16 BIT ACC. PHEX1: LD A,(HL) ; GET CHAR CALL HEXDG ; VALID IN A LITERAL? JR NC,PHEX4 CP 'F'+1 ; VALID IN A HEX LIT.? JR NC,PHEX4 SUB '0' ; CONVERT ASCII TO BINARY CP 10D JR C,PHEX2 SUB 'A'-'0'-10D PHEX2: LD C,A LD B,4 ; SHIFT DE LEFT 4 TIMES PHEX3: CALL SHLDE DEC B ; DONE4 SHIFTS YET? JR NZ,PHEX3 CALL ADCDE ; ADD NEW DIGIT TO DE INC HL ; INCREMENT POINTER TO NEXT CHAR JR PHEX1 PHEX4: CP 'H' ; CHAR NOT HEX. IS IT 'H'? JR NZ,PHEX6 ; NO INC HL ; YES, POINT TO NEXT CAR LD A,(HL) ; GET IT IN ACC CALL HEXDG ; VALID CHAR FOR A LIT.? PHEX5: POP BC RET PHEX6: SCF ; SET CARRY FOR ERROR JR PHEX5 ;******************************************************************* ;HEXDG. IS CHAR IN ACC VALID IN A LITERAL. ;CARRY SET IF HEX DIGIT OR H/O/Q. ;******************************************************************* HEXDG: CALL DIGIT ; CARRY SET IF 0-9 RET C CP 'A' JR C,HEXDG1 CP 'F'+1 RET C CP 'H' JR Z,HEXDG2 CP 'O' JR Z,HEXDG2 CP 'Q' JR Z,HEXDG2 HEXDG1: AND A ; NOT HEX DIG., CLEAR CARRY RET HEXDG2: SCF ; HEX DIGIT, SET CARRY RET ;********************************************************************* ;SHIFT DE LEFT 1 BIT - ENTER 0 FROM RIGHT. ;SET 'VALUE' ERROR IF OVERFLOW. ;********************************************************************* SHLDE: EX DE,HL ; DO SHIFT BY ADDITION IN HL ADD HL,HL EX DE,HL RET NC ; NO CARRY, SO RETURN PUSH BC ; CARRY, SO INDICATE 'V' ERROR LD C,'V' CALL ERROR POP BC RET ;********************************************************************* ;ADD BC TO DE - SET 'VALUE' ERROR IF OVERFLOW. ;********************************************************************* ABCDE: PUSH BC EX DE,HL ; DO ADDITION IN HL ADD HL,BC ; DO ADDITION EX DE,HL ; GET RESULT BACK TO DE JR NC,ABCDE1 LD C,'V' ; CARRYOUT SO INDICATE 'V' ERROR CALL ERROR ABCDE1: POP BC RET ;********************************************************************* ;ADD C TO DE - NO OVERFLOW INDICATION ;********************************************************************* ADCDE: PUSH BC EX DE,HL LD B,0 ADD HL,BC EX DE,HL POP BC RET ;********************************************************************* ;PROCESS SYMBOL. ;GET SYMBOL AND FETCH ITS VALUE FROM THE SYMBOL TABLE. RETURN VALUE ;IN DE. ;******************************************************************** PSYMB: PUSH BC ; SAVE REGISTERS LD DE,SYMBUF ; SET PNTR TO SYMBOL BUFFER CALL GSYM ; GET SYMB FROM LINE TO SYMBUF PUSH HL ; SAVE PNTR TO CHAR AFTER SYMB CALL LOCATE ; FIND SYMB IN SYMTAB JR NZ,PSYMB1 ; NOT IN TABLE? LD E,(HL) ; MOVE VALUE TO DE INC HL LD D,(HL) JR PSYMB2 PSYMB1: LD C,'U' ; INDICATE 'UNDEFINED' ERROR CALL ERROR LD DE,0 ; SET DE=0 DEFAULT VALUE PSYMB2: POP HL ; REPLACE REGISTERS POP BC AND A ; CLEAR CARRY FLAG SO RET ; AS NOT TO INDICATE 'VALUE' ERROR ;********************************************************************* ;PROCESS ASCII LITERAL. ;RETURN VALUE OF 1 OR 2 ASCII CHARACTERS. ;ON ENTRY: ; HL POINTS TO START QUOTE ;ON EXIT: ; HL POINTS TO CHAR AFTER CLOSE QUOTE ; DE CONTAINS VALUE ; CARRY FLAG SET IF ERROR ;*********************************************************************** PASC: LD DE,0 ; CLEAR 16 BIT ACC. DE INC HL ; POINT TO CHAR AFTER QUOTE CALL DOUBQ ; IS NEXT CHAR CLOSING QUOTE? JR NZ,PASC2 ; JUMP IF SO LD E,(HL) ; OTHERWISE SAVE CHAR IN E INC HL ; POINT TO NEXT CHAR CALL DOUBQ ; NEXT CHAR CLOSE QUOTE? JR NZ,PASC2 ; JUMP IF SO LD D,(HL) ; OTHERWISE SAVE IN D INC HL ; POINT TO NEXT CHAR CALL DOUBQ ; NEXT CHAR CLOSE QUOTE? JR NZ,PASC2 ; JUMP IF SO PASC1: SCF ; ERROR, SET CARRY RET PASC2: AND A ; NO ERROR, CLEAR CARRY RET ;...................................................... ;DOUBLE QUOTE. ;IS NEXT ITEM IN STRING A CHARACTER OF THE END OF THE ASCII ;LITERAL? ON ENTRY: HL POINTS AT THE NEXT ITEM, ON EXIT: HL ;HAS BEEN INCREMENTED IF DOUBLE QUOTE. ZERO SET IF CHAR. ;...................................................... DOUBQ: LD A,(HL) ; GET CHAR CP '''' ; IS IT A QUOTE? JR NZ,DOUBQ1 ; JUMP IF NOT INC HL ; POINT TO NEXT CHAR LD A,(HL) ; GET IT CP '''' ; IS IT A QUOTE? RET ; ZERO SET FOR CHAR ; CLEARED IF LAST QUOTE WAS ; CLOSE QUOTE. DOUBQ1: XOR A ; LIT CHAR. SET ZERO. RET ;******************************************************************** ;PROCESS MULTI-CHAR FUNCTION. ;ON ENTRY: ; HL POINTS TO FIRST CHAR OF FUNCTION STRING ;ON EXIT: ; HL POINTS TO CHAR AFTER FUNCTION STRING ; FTOKR CONTAINS TOKEN FOR FUNCTION ; ZERO FLAG SET FOR ERROR ;******************************************************************** PMCF: PUSH BC ; SAVE REGISTERS PUSH DE INC HL ; POINT TO CHAR AFTER '.' LD A,(HL) ; GET IT CALL ALPHA ; IS IT A LETTER? JR NC,PMCF1 ; NO, SYNTAX ERROR LD DE,SYMBUF ; SET POINTER TO SYMBUF CALL GSYM ; GET FUNCTION IN SYMBUF INC HL ; INCR PNTR PUSH HL ; AND SAVE IT ON STACK CP '.' ; WAS CHAR AFT. FUN. '.'? JR NZ,PMCF2 ; JUMP IF NOT LD A,(SYMBUF) ; GET NO OF CHARS CP 5 ; MORE THAN 4? JR NC,PMCF2 ; JUMP IF SO LD DE,FTOKR ; PNTR TO TOKEN REG. LD HL,MFLSTP ; PNTR TO OPR LIST LD C,1 ; 1 TOKEN/ENTRY IN LIST CALL OPTOK ; GET TOKEN JR PMCF3 PMCF1: XOR A ; SET ZERO TO INDICATE ERR. JR PMCF4 PMCF2: XOR A ; SET ZERO TO INDICATE ERROR PMCF3: POP HL PMCF4: POP DE POP BC RET ;*********************************************************************** ;PROCESS SINGLE CHAR FUNCTION. ;ON ENTRY: ; HL POINTS AT FUNCTION CHAR ;ON EXIT: ; HL POINTS TO CHAR AFTER FUNCTION CHAR(S) ; FTOKR CONTAINS TOKEN FOR FUNCTION ; ZERO FLAG SET IF ERROR ;*********************************************************************** PSCF: PUSH BC ; SAVE REGISTERS PUSH DE LD B,(HL) ; GET POTENTIAL FUNCTION INC HL ; & INCR PNTR LD DE,SCF1 ; SET UP POINTER TO LIST PSCF1: LD A,(DE) ; GET LIST ENTRY AND A ; IS IT ZERO? JR Z,PSCF3 ; END OF LIST, INVAL. CHAR CP B ; MATCH? INC DE ; INCR. PNTR. TO TOKEN JR Z,PSCF2 ; JUMP IF MATCH INC DE ; OTHERWISE POINT TO NEXT ENTRY JR PSCF1 ; LOOP PSCF2: LD A,(DE) ; GET THE TOKEN LD (FTOKR),A ; & PUT IN TOKEN REG. CP ASKTOK ; IS IT * ?(MAYBE **) JR NZ,PSCF4 ; JUMP IF NOT LD A,(HL) ; GET NEXT CHAR CP '*' ; IS IT '*'? JR NZ,PSCF4 ; JUMP IF NOT LD A,EXPTOK ; PUT TOKEN FOR ** IN REG LD (FTOKR),A INC HL ; AND INCR PNTR AND A ; CLEAR ZERO FLAG JR PSCF4 PSCF3: XOR A ; SET ZERO TO INDICATE ERROR PSCF4: POP DE ; REPLACE REGS POP BC RET ;*********************************************************************** ;PUSH ACC TO FUNCTION STACK. ;BYTE IN A IS PUSHED ONTO THE FUNCTION ;STACK (FSTK). IF NOT POSSIBLE OWING TO ;THE STACK BEING FULL, THEN THE ZERO FLAG ;IS SET ON EXIT. ;*********************************************************************** PUFU: PUSH HL ; SAVE REGISTERS PUSH BC EX AF,AF' ; SAVE FUNCTION LD HL,FSTK ; LOAD START OF STACK ADDR LD A,(FCNT) ; GET STACK COUNTER CP MAXFSK ; IS STACK FULL? JR NC,PUFU2 LD C,A ; COMPUTE TOP OF STACK LD B,0 ADD HL,BC ; TOP OF STACK IN HL INC A ; INCREMENT STACK COUNTER LD (FCNT),A ; AND STORE NEW VALUE EX AF,AF' ; GET FUNCTION BACK LD (HL),A ; PUSH ONTO FUNCTION STACK XOR A ; CLEAR ZERO FLAG INC A PUFU1: POP BC ; REPLACE REGISTERS POP HL RET PUFU2: XOR A ; SET ZERO FLAG (STACK FULL) JR PUFU1 ;*********************************************************************** ;POP FROM FUNCTION STACK TO ACC ;THE TOP BYTE ON THE FUNCTION STACK IS ;POPPED INTO THE A REG. IF THE STACK WAS ;ALREADY EMPTY, THE ZERO FLAG IS SET ON ;EXIT ;*********************************************************************** POFU: PUSH HL ; SAVE REGS. PUSH BC LD HL,FSTK ; LOAD START OF STACK ADDR LD A,(FCNT) ; GET STACK COUNTER AND A ; TEST FOR EMPTY STACK JR Z,POFU1 DEC A LD (FCNT),A LD C,A LD B,0 ADD HL,BC XOR A ; CLEAR ZERO FLAG INC A LD A,(HL) ; GET STACK TOP TO ACC POFU1: POP BC ; REPLACE REGS. POP HL RET ;*********************************************************************** ;PUSH FROM DE TO ARITHMETIC STACK ;THE WORD IN DE IS PUSHED ONTO THE ;ARITHMETIC STACK. IF NOT POSSIBLE ;OWING TO THE STACK BEING FULL, THEN ;THE ZERO FLAG IS SET ON EXIT. ;*********************************************************************** PUDE: PUSH HL ; SAVE REGS. PUSH BC LD HL,ARSTK ; LOAD START OF STACK ADDR LD A,(ARCNT) ; GET STACK COUNTER CP MAXASK ; IS STACK FULL? JR NC,PUDE2 LD C,A ; COMPUTE TOP OF STACK LD B,0 ADD HL,BC ; TOP OF STACK IN HL ADD A,2 ; INCREMENT COUNTER BY 1 WORD LD (ARCNT),A ; STORE NEW VALUE OF COUNTER LD (HL),E ; PUSH DE ONTO STACK INC HL LD (HL),D XOR A ; CLEAR ZERO FLAG INC A PUDE1: POP BC POP HL RET PUDE2: XOR A ; SET ZERO FLAG (ERROR) JR PUDE1 ;********************************************************************** ;POP FROM ARITHMETIC STACK TO DE ;THE TOP WORD ON THE ARITHMETIC STACK ;IS POPPED INTO THE DE REG PAIR. IF ;THE STACK WAS EMPTY, THEN THE ZERO ;FLAG IS SET ON EXIT ;********************************************************************** PODE: PUSH HL ; SAVE REGS PUSH BC LD HL,ARSTK ; LOAD START OF STACK ADDR LD A,(ARCNT) ; GET STACK COUNTER AND A ; IS STACK EMPTY? JR Z,PODE1 SUB 2 ; DECR STACK COUNTER LD (ARCNT),A ; AND SAVE NEW VALUE LD C,A ; COMPUTE TOP OF STACK LD B,0 ADD HL,BC LD E,(HL) ; POP STACK TO DE INC HL LD D,(HL) XOR A ; CLEAR ZERO FLAG INC A PODE1: POP BC ; REPLACE REGS POP HL RET ;********************************************************************* ;PERFORM A FUNCTION ;ON ENTRY: ; A CONTAINS THE COMBINED FUNCTION ; TOKEN/PRIORITY VALUE. ;ON EXIT: ; THE REQUIRED ASSEMBLY TIME FUNCTION ; HAS BEEN PERFORMED USING VALUE(S) ; ON THE ARITHMETIC STACK AND LEAVING ; THE RESULT THERE. ; IF THE STACK DID NOT CONTAIN ENOUGH ; VALUES THEN THE ZERO FLAG IS SET. ; ;THE FOLLOWING SUBROUTINES STARTING WITH ;THE LETTER F ARE ALL ASSEMBLY TIME ;ARITHMETIC/LOGIC FUNCTIONS, OPERATING ON ;THE ARITHMETIC STACK, AND BEING CALLED ;INDIRECTLY BY FUNC ;******************************************************************** FUNC: PUSH HL ; SAVE REGS. PUSH DE PUSH BC SRL A ; GET (FUNC TOKEN)*2 SRL A AND 0FEH LD C,A ; COMPUTE POINTER TO SUBROUTINE LD B,0 ; START ADDR POINTER LD HL,FUNLST ADD HL,BC LD E,(HL) ; PUT SUBR START ADDR IN HL INC HL LD D,(HL) EX DE,HL LD DE,FUNC1 ; CALL RELEVANT FUNCTION INDIRECTLY PUSH DE JP (HL) FUNC1: POP BC POP DE POP HL RET ;............................................................. ;FUNCTION LIST. ;CONTAINS POINTERS TO THE FUNCTION ;SUBROUTINES, USED BY SUBR 'FUNC' ;FOR AN INDIRECT SUBR CALL BASED ON ;THE VALUE OF THE ARITHMETIC ;FUNCTION TOKEN. ;............................................................. FUNLST: DEFW FMNPL DEFW FMNMN DEFW FNOT DEFW FHIGH DEFW FLOW DEFW FRES DEFW FEXP DEFW FMULT DEFW FDIV DEFW FMOD DEFW FSHR DEFW FSHL DEFW FDIPL DEFW FDIMN DEFW FAND DEFW FOR DEFW FXOR DEFW FEQ DEFW FGT DEFW FLT DEFW FUGT DEFW FULT ;************************************************************** ;FUNCTION MONADIC PLUS. ;************************************************************** FMNPL: PUSH DE ; SAVE REG CALL PODE ; SEE IF VALUE AVAILABLE ON STACK JR Z,FMNPL1 ; JUMP IF NOT (ZERO SET) CALL PUDE ; PUSH BACK ON STACK FMNPL1: POP DE ; REPLACE REG RET ;************************************************************** ;FUNCTION MONADIC MINUS. ;************************************************************** FMNMN: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE OFF ARITH STACK JR Z,FMNMN1 ; JUMP IF EMPTY LD HL,0 ; PUT 0 INTO HL AND A ; CLEAR CARRY SBC HL,DE ; SUBTRACT VALUE FROM 0 EX DE,HL ; GET RESULT IN DE CALL PUDE ; PUSH BACK ON STACK FMNMN1: POP HL ; REPLACE REGS. POP DE RET ;************************************************************** ;FUNCTION NOT ;************************************************************** FNOT: PUSH DE ; SAVE REG. CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FNOT1 ; JUMP IF EMPTY LD A,D ; COMPLEMENT DE CPL LD D,A LD A,E CPL LD E,A CALL PUDE ; PUSH BACK ON ARITH STACK FNOT1: POP DE ; REPLACE REG. RET ;************************************************************** ;FUNCTION HIGH. ;RETURNS HIGH BYTE OF ARGUMENT AS RESULT. ;************************************************************** FHIGH: PUSH DE ; SAVE REGISTERS CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FHIGH1 ; ERROR IF EMPTY LD E,D ; PUT HIGH BYTE IN DE LD D,0 CALL PUDE ; PUSH RESULT ON ARITH STACK FHIGH1: POP DE RET ;************************************************************** ;FUNCTION LOW. ;RETURNS LOW BYTE OF ARGUMENT AS RESULT. ;************************************************************** FLOW: PUSH DE ; SAVE REGISTERS CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FLOW1 ; ERROR IF EMPTY LD D,0 ; LOW BYTE ONLY REQD CALL PUDE ; PUSH BACK RESULT FLOW1: POP DE ; REPLACE REGS RET ;*************************************************************** ;FNCTION RESULT ;CLEARS ARITHMETIC OVERFLOW FLAG ;*************************************************************** FRES: EXX ; CLEAR OVERFLOW FLAG RES 1,B ; BIT 1 IN REG B EXX RET ;*************************************************************** ;FUNCTION EXPONENTIATE ;*************************************************************** FEXP: PUSH HL ; SAVE REGS PUSH DE CALL PODE ; GET EXPONENT FROM STACK JR Z,FEXP5 ; JMP IF ARITH STACK EMPTY EX DE,HL ; PUT EXPONENT IN HL CALL PODE ; GET OTHER NUMBER IN DE JR Z,FEXP5 ; JUMP IF STACK EMPTY LD A,H ; EXPONENT ZERO? OR L JR NZ,FEXP1 ; JUMP IF NOT LD DE,1 ; RESULT = 1 CALL PUDE ; PUSH IT ON STACK JR FEXP5 FEXP1: BIT 7,H ; EXPONENT NEGATIVE? JR Z,FEXP2 ; JUMP IF NOT LD DE,0 ; RESULT = 0 CALL PUDE ; PUSH IT ON STACK JR FEXP5 FEXP2: CALL PUDE ; PUSH THE NUMBER FEXP3: DEC HL ; DECR EXPONENT LD A,H ; IS IT ZERO NOW? OR L JR Z,FEXP4 ; JUMP IF SO CALL PUDE ; PUSH THE NUMBER CALL FMULT ; & MULTIPLY JR FEXP3 ; LOOP FEXP4: XOR A ; CLEAR ZERO FLAG INC A FEXP5: POP DE ; REPLACE REGISTERS POP HL RET ; ******************************************************************* ; FUNCTION MULTIPLY ; ******************************************************************* FMULT: PUSH HL ; SAVE REGISTERS PUSH DE PUSH BC EXX PUSH DE LD E,0 ; CLEAR E' (SIGN FLAG) EXX CALL PODE ; GET A VALUE FROM ARITH STACK JR Z,FMULT6 ; JUMP IF EMPTY BIT 7,D ; IS IT NEGATIVE? CALL NZ,NEGDE ; IF SO, NEGATE, AND COMPLEMENT ; SIGN FLAG EX DE,HL CALL PODE ; GET ANOTHER VALUE FROM STACK JR Z,FMULT6 ; JUMP IF EMPTY BIT 7,D ; IS IT -VE CALL NZ,NEGDE ; IF SO, NEGATE, AND COMPL. ; SIGN FLAG AND A ; CLEAR CARRY SBC HL,DE ; TEST FOR LARGER NO. ADD HL,DE ; MULTIPLIER SHOULD BE SMALLER JR NC,FMULT1 ; JUMP IF CORRECT EX DE,HL ; OTHERWISE SWAP NOS. FMULT1: LD B,H ; PUT MULTIPLICAND IN BC LD C,L LD HL,0 ; CLEAR HL FOR ACCUMALATOR FMULT2: LD A,D ; IS MULTIPLIER 0? OR E JR Z,FMULT5 ; JUMP IF FINISHED SRL D ; SHIFT DE RIGHT INTO CARRY RR E JR NC,FMULT4 ; JUMP IF ZERO CARRY AND A ; CLEAR CARRY ADC HL,BC ; ADD MULTIPLICAND TO RUNNING TOTAL JP M,FMULT3 ; JUMP IF OVERFLOW TO BIT 15 JR NC,FMULT4 ; JUMP IF NO O/F TO BIT 16 FMULT3: EXX ; SET OVERFLOW FLAG SET 1,B EXX FMULT4: SLA C ; SHIFT MULTIPLICAND LEFT RL B JR FMULT2 ; LOOP FMULT5: EX DE,HL ; GET RESULT BACK IN DE EXX ; SHOULD RESULT BE -VE? BIT 0,E ; (PRODUCT SIGN IN E') EXX CALL NZ,NEGDE CALL PUDE ; PUSH PRODUCT ONTO ARITH STACK FMULT6: EXX ; REPLACE REGS. POP DE EXX POP BC POP DE POP HL RET ;*********************************************************************** ;FUNCTION DIVIDE ;*********************************************************************** FDIV: PUSH HL ; SAVE REGISTERS PUSH DE CALL PODE ; GET DIVISOR FROM ARITH STACK JR Z,FDIV1 ; JUMP IF EMPTY EX DE,HL ; PUT IN HL CALL PODE ; GET DIVIDEND FROM ARITH STACK JR Z,FDIV1 ; JUMP IF EMPTY CALL DIV ; DO THE DIVISION CALL PUDE ; PUSH QUOTIENT (IN DE) ONTO STACK FDIV1: POP DE ; REPLACE REGISTERS POP HL RET ;********************************************************************** ;FUNCTION MODULO ;********************************************************************** FMOD: PUSH HL ; SAVE REGISTERS PUSH DE CALL PODE ; GET DIVISOR FROM ARITH STACK JR Z,FMOD1 ; JUMP IF EMPTY EX DE,HL ; PUT IN HL CALL PODE ; GET DIVIDEND FOM ARITH STACK JR Z,FMOD1 ; JUMP IF EMPTY CALL DIV ; DO THE DIVISION EX DE,HL ; GET REMAINDER IN DE CALL PUDE ; PUSH ONTO ARITH STACK FMOD1: POP DE ; REPLACE REGISTERS POP HL RET ;********************************************************************** ;DIVIDE ;THIS SUBROUTINE IS USED BY FDIV AND FMOD ;IT DIVIDES DE BY HL, LEAVING THE QUOTIENT ;IN DE AND THE REMAINDER IN HL. ;SIGNED 16 BIT ARITHMETIC IS USED. ;********************************************************************** DIV: PUSH BC ; SAVE REGISTERS EXX PUSH DE LD DE,0 ; CLEAR DE' (D'=PLACE COUNT) ; (E'=SIGN COUNT) EXX BIT 7,D ; IS DIVIDEND -VE? JR Z,DIV1 ; JUMP IF NOT EXX ; OTHERWISE FLAG IN E', BIT 7 SET 7,E ; TO GIVE SIGN OF REMAINDER EXX DIV1: BIT 7,D ; IS DIVIDEND -VE? CALL NZ,NEGDE ; IF SO NEGATE, AND INCR ; QUOTIENT SIGN BIT (E' BIT 0) EX DE,HL ; SWAP NOS. BIT 7,D ; IS DIVISOR -VE? CALL NZ,NEGDE ; IF SO NEGATE AND ; INCR QUOTIENT SIGN FLAG LD A,D ; IS DIVISOR ZERO? OR E JR NZ,DIV2 ; JUMP IF NOT LD C,'Z' ; FLAG 'DIV BY ZERO' ERROR CALL ERROR LD HL,0 ; RETURN ZERO RESULTS LD DE,0 JR DIV6 ; GO TO END DIV2: EXX ; INCR PLACE COUNT INC D EXX SLA E ; SHIFT DIVISOR LEFT UNTIL SIGN RL D ; SET, COUNTING NO. OF PLACES JP P,DIV2 LD BC,0 ; CLEAR QUOTIENT REG BC DIV3: SLA C ; SHIFT QUOTIENT LEFT RL B SRL D RR E AND A ; CLEAR CARRY SBC HL,DE ; SUBTRACT DIVISOR FROM DIVIDEND JR C,DIV4 ; JUMP IF TOO MUCH SUBTRACTION INC BC ; OTHERWISE INCR QUOTIENT JR DIV5 DIV4: ADD HL,DE ; REPLACE EXCESSIVE SUBTRACTION DIV5: EXX ; DECR PLACE COUNT DEC D EXX JR NZ,DIV3 ; LOOP IF NOT FINISHED LD D,B ; TRANSFER QUOTIENT TO DE LD E,C EX DE,HL ; SWAP WITH REMAINDER EXX ; GET SIGN FLAGS INTO C LD A,E EXX LD C,A BIT 7,C ; WAS DIVIDEND -VE? CALL NZ,NEGDE ; NEGATE REMAINDER IF SO EX DE,HL ; SWAP BACK NOS. BIT 0,C ; IS QUOTIENT -VE? CALL NZ,NEGDE ; NEGATE IF SO DIV6: EXX ; REPLACE REGISTERS POP DE EXX POP BC RET ;************************************************************************* ;NEGATE DE ;USED BE FMULT AND DIV TO NEGATE CONTENTS OF DE ;AND COMPLEMENT A SIGN FLAG HELD IN E' BIT 0 ;************************************************************************* NEGDE: PUSH HL ; SAVE HL LD HL,0 ; NEGATE SIGNED NO. IN DE AND A ; CLEAR CARRY SBC HL,DE ; SUBTRACT DE FROM 0 EX DE,HL ; GET RESULT INTO DE EXX ; COMPLEMENT PRODUCT SIGN ; BIT IN E' RR E CCF RL E EXX POP HL RET ;************************************************************************ ;FUNCTION SHIFT RIGHT. ;************************************************************************ FSHR: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FSHR3 ; ERROR IF EMPTY EX DE,HL ; OTHERWISE PUT IN HL CALL PODE ; GET VALUE TO BE SHIFTED JR Z,FSHR3 ; JUMP IF EMPTY, ERROR FSHR1: LD A,H ; TEST HL FOR ZERO OR L ; AND CLEAR CARRY JR Z,FSHR2 ; JUMP IF NO MORE SHIFTING SRL D ; SHIFT DE RIGHT ONE BIT RR E DEC HL ; DECR NO. OF SHIFTS REQD JR FSHR1 ; LOOP FSHR2: CALL PUDE ; PUSH RESULT BACK ON STACK FSHR3: POP HL ; REPLACE REGS POP DE RET ;*********************************************************************** ;FUNCTION SHIFT LEFT ;*********************************************************************** FSHL: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FSHL3 ; JUMP IF EMPTY, ERROR EX DE,HL ; GET VALUE IN HL CALL PODE ; GET VALUE TO BE SHIFTED JR Z,FSHL3 ; ERROR IF EMPTY FSHL1: LD A,H ; TEST HL FOR ZERO OR L ; AND CLEAR CARRY JR Z,FSHL2 SLA E ; SHIFT DE LEFT 1 BIT RL D DEC HL ; DECR NO. OF SHIFTS REGD. JR FSHL1 ; LOOP FSHL2: CALL PUDE ; PUSH RESULT ON ARITH STACK FSHL3: POP HL ; REPLACE REGS. POP DE RET ;********************************************************************* ;FUNCTION DIADIC ADDITION ;********************************************************************* FDIPL: PUSH HL ; SAVE REGISTERS PUSH DE CALL PODE ; GET 1ST VALUE TO BE ADDED JR Z,FDIPL6 ; STACK EMPTY- ERROR EX DE,HL ; PUT 1ST VALUE IN HL CALL PODE ; GET 2ND VALUE JR Z,FDIPL6 ; STACK EMPTY ERROR EXX ; CLEAR +VE/-VE FLAGS IN B' RES 6,B ; (-VE) RES 7,B ; (+VE) EXX LD A,H ; BOTH VALUES -VE? AND D JP P,FDIPL1 EXX ; YES, SET 'BOTH -VE' FLAG SET 6,B EXX JR FDIPL2 FDIPL1: LD A,H ; BOTH VALUES +VE? OR D JP M,FDIPL2 EXX ; YES, SET BOTH +VE FLAG SET 7,B EXX FDIPL2: AND A ; CLEAR CARRY FLAG ADC HL,DE ; ADD THE 2 VALUES EXX JP M,FDIPL3 BIT 6,B ; RESULT +VE JR Z,FDIPL5 JR FDIPL4 ; SET OVERFLOW FLAG FDIPL3: BIT 7,B JR Z,FDIPL5 FDIPL4: SET 1,B ; SET OVERFLOW FLAG FDIPL5: EXX EX DE,HL ; GET RESULT IN DE CALL PUDE ; PUSH RESULT ON STACK FDIPL6: POP DE POP HL RET ;******************************************************************** ;FUNCTION DIADIC MINUS. ;******************************************************************** FDIMN: PUSH HL ; SAVE REGS. PUSH DE CALL PODE ; GET MINUEND FROM STACK JR Z,FDIMN6 ; JUMP IF EMPTY, ERROR EX DE,HL ; PUT IN HL CALL PODE ; GET SUBTRAHEND JR Z,FDIMN6 ; JUMP IF EMPTY EXX ; CLEAR +VE/-VE FLAGS IN B' RES 6,B ; (-VE EXPECTED FLAG) RES 7,B ; (+VE EXPECTED FLAG) EXX LD A,D AND A ; TEST SIGN OF SUBTRAHEND JP M,FDIMN1 ; JUMP IF -VE LD A,H AND A ; TEST SIGN OF MINUEND JP P,FDIMN2 ; JUMP IF OF OPPOSITE SIGN ; NO OVERFLOW POSSIBLE EXX ; OTHERWISE SET SET 7,B ; +VE EXPECTED FLAG EXX JR FDIMN2 FDIMN1: LD A,H ; TEST SIGN OF MINUEND AND A JP M,FDIMN2 ; JUMP IF OF OPPOSITE SIGN ; NO OVERFLOW POSSIBLE EXX ; SET '-VE EXPECTED' FLAG SET 6,B EXX FDIMN2: EX DE,HL ; GET SUBTRAHEND IN HL AND A ; CLEAR CARRY SBC HL,DE ; DO THE SUBTRACTION EX DE,HL ; GET THE RESULT IN DE EXX ; PREPARE TO EXAMINE B' JP M,FDIMN3 ; JUMP IF -VE RESULT BIT 6,B ; RESULT +VE, WAS -VE EXPECTED? JR NZ,FDIMN4 ; JUMP IF SO JR FDIMN5 ; OTHERWISE NO OVERFLOW FDIMN3: BIT 7,B ; RESULT -VE, WAS +VE EXPECTED? JR Z,FDIMN5 ; JUMP IF NOT FDIMN4: SET 1,B ; SET OVERFLOW FLAG (1,B') FDIMN5: EXX ; SWITCH REGS BACK CALL PUDE ; PUSH RESULT ON ARITH STACK FDIMN6: POP DE ; REPLACE REGS POP HL RET ;********************************************************************** ;FUNCTION AND ;********************************************************************** FAND: PUSH DE ; SAVE REGISTERS PUSH HL CALL PODE ; GET VALUE FROM STACK JR Z,FAND1 ; JUMP IF EMPTY EX DE,HL CALL PODE ; GET THE OTHER VALUE JR Z,FAND1 ; JUMP IF STACK EMPTY LD A,D ; DO 16 BIT LOGICAL AND AND H LD D,A ; WITH RESULT IN DE LD A,E AND L LD E,A CALL PUDE ; PUSH RESULT ON STACK FAND1: POP HL ; REPLACE REGS POP DE RET ;********************************************************************* ;FUNCTION OR ;********************************************************************* FOR: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FOR1 ; JUMP IF STACK EMPTY EX DE,HL ; PUT IN HL CALL PODE ; GET THE OTHER VALUE JR Z,FOR1 ; JUMP IF STACK EMPTY LD A,D ; DO 16 BIT LOGICAL OR OR H ; ON HL AND DE LD D,A ; RESULT IN DE LD A,E OR L LD E,A CALL PUDE ; PUSH RESULT ON STACK FOR1: POP HL ; REPLACE REGS POP DE RET ;******************************************************************** ;FUNCTION EXCLUSIVE OR ;******************************************************************** FXOR: PUSH DE ; SAVE REGS PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FXOR1 ; JUMP IF STACK EMPTY EX DE,HL ; PUT IT IN HL CALL PODE ; GET THE OTHER VALUE JR Z,FXOR1 ; JUMP IF STACK EMPTY LD A,D ; DO 16 BIT XOR ON HL AND DE XOR H LD D,A ; RESULT IN DE LD A,E XOR L LD E,A CALL PUDE ; PUSH RESULT ON ARITH STACK FXOR1: POP HL ; REPLACE REGS POP DE RET ;******************************************************************* ;FUNCTION EQUALS ;******************************************************************* FEQ: PUSH DE ; SAVE REGS PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FEQ2 ; JUMP IF STACK EMPTY EX DE,HL ; PUT IT IN HL CALL PODE ; GET ANOTHER VALUE IN DE JR Z,FEQ2 ; JUMP IF STACK EMPTY AND A ; CLEAR CARRY SBC HL,DE ; COMPARE VALUES LD DE,0 ; RESULT IN DE (0 OR 1) JR NZ,FEQ1 ; JUMP IF VALUES NOT EQUAL DEC DE ; OTHERWISE LET RESULT= -1 FEQ1: CALL PUDE ; PUSH RESULT ON STACK FEQ2: POP HL ; REPLACE REGS POP DE RET ;********************************************************************* ;FUNCTION GREATER THAN ;********************************************************************* FGT: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FGT2 ; JUMP IF STACK EMPTY EX DE,HL CALL PODE ; GET THE OTHER VALUE IN DE JR Z,FGT2 ; JUMP IF STACK EMPTY LD A,D ; ADD 8000H TO EACH NO. ADD A,80H LD D,A LD A,H ADD A,80H LD H,A AND A ; CLEAR CARRY SBC HL,DE ; COMPARE VALUES LD DE,0 ; RESULT IN DE (0 OR 1) JR NC,FGT1 ; JUMP IF NOT GREATER THAN DEC DE ; OTHERWISE RESULT= -1 FGT1: CALL PUDE ; PUSH RESULT ON STACK FGT2: POP HL ; REPLACE REGS POP DE RET ;********************************************************************* ;FUNCTION LESS THAN ;********************************************************************* FLT: PUSH DE ; SAVE REGS PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FLT2 ; JUMP IF STACK EMPTY EX DE,HL ; PUT VALUE IN HL CALL PODE ; GET THE OTHER VALUE IN DE JR Z,FLT2 ; JUMP IF STACK EMPTY LD A,D ; ADD 8000H TO EACH NO. ADD A,80H LD D,A LD A,H ADD A,80H LD H,A EX DE,HL ; SWAP NOS. AND A ; CLEAR CARRY SBC HL,DE ; COMPARE VALUES LD DE,0 ; RESULT IN DE (0 OR 1) JR NC,FLT1 ; JUMP IF NOT LESS THAN DEC DE ; OTHERWISE RESULT= -1 FLT1: CALL PUDE ; PUSH RESULT ON STACK FLT2: POP HL ; REPLACE REGS POP DE RET ;******************************************************************** ;FUNCTION UNSIGNED GREATER THAN ;******************************************************************** FUGT: PUSH DE ; SAVE REGS PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FUGT2 ; JUMP IF STACK EMPTY EX DE,HL CALL PODE ; GET THE OTHER VALUE IN DE JR Z,FUGT2 ; JUMP IF STACK EMPTY AND A ; CLEAR CARRY SBC HL,DE ; COMPARE VALUES LD DE,0 ; RESULT IN DE (0 OR 1) JR NC,FUGT1 ; JUMP IF NOT GREATER THAN DEC DE ; OTHERWISE RESULT= -1 FUGT1: CALL PUDE ; PUSH RESULT ON STACK FUGT2: POP HL ; REPLACE REGS POP DE RET ;******************************************************************** ;FUNCTION UNSIGNED LESS THAN ;******************************************************************** FULT: PUSH DE ; SAVE REGS. PUSH HL CALL PODE ; GET VALUE FROM ARITH STACK JR Z,FULT2 ; JUMP IF STACK EMPTY EX DE,HL ; PUT VALUE IN HL CALL PODE ; GET THE OTHER VALUE IN DE JR Z,FULT2 ; JUMP IF STACK EMPTY EX DE,HL ; SWAP NOS. AND A ; CLEAR CARRY SBC HL,DE ; COMPARE VALUES LD DE,0 ; RESULT IN DE (0 OR 1) JR NC,FULT1 ; JUMP IF NO LESS THAN DEC DE ; OTHERWISE RESULT= -1 FULT1: CALL PUDE ; PUSH RESULT ON STACK FULT2: POP HL ; REPLACE REGS POP DE RET ;******************************************************************* ;GET TITLE TO TITLE BUFFER. ;ON ENTRY: ; (LINPNT) POINTS AT CHAR AFTER THE ; 'TITLE' PSEUDO-OPERATOR. ;ON EXIT: ; THE OPERAND (A STRING BETWEEN SINGLE ; QUOTES) HAS BEEN TRANSFERED TO THE TITLE BUFFER. ;******************************************************************* TITL: PUSH HL ; SAVE REGISTERS PUSH DE PUSH BC LD HL,TITBUF ; CLEAR TITLE BUFFER LD C,TITSIZ+1 XOR A TITL1: LD (HL),A INC HL DEC C JR NZ,TITL1 LD HL,(LINPNT) ; GET LINE POINTER CALL STR ; FIND STRING JR Z,TITL5 ; NOT FOUND LD A,C ; GET COUNT OF STRING CP TITSIZ+1 ; MORE CHARS THAN SIZE OF TITBUF? JR C,TITL2 LD C,TITSIZ ; YES, FORCE TO TITBUF SIZE JR TITL3 TITL2: AND A ; IS IT 0 CHARS? JR Z,TITL5 TITL3: EX DE,HL ; DO TRANSFER LD DE,TITBUF TITL4: CALL DOUBQ ; SKIP CHAR IF COUBLE QUOTE LDI ; TRANSFER A CHAR JP PE,TITL4 ; JUMP IF TRANSFER NOT COMPLETE TITL5: POP BC ; REPLACE REGISTERS POP DE POP HL RET ;************************************************************************ ;GET DEFM OPERAND. ;ON ENTRY: ; (LINPNT) POINTS AT CHAR AFTER ; DEFM PSEUDO-OPERATOR. ;ON EXIT: ; THE OPERAND (A STRING BETWEEN QUOTES) ; HAS BEEN TRANSFERED INTO THE ; ASSEMBLED CODE BUFFER. ;************************************************************************ DM: PUSH HL ; SAVE REGISTERS PUSH DE PUSH BC LD HL,(LINPNT) ; GET LINE POINTER CALL STR ; FIND STRING JR Z,DM4 ; NOT FOUND LD A,C ; GET COUNT OF STRING CP ACBSIZ+1 ; MORE CHARS THAN SIZE OF A.C. BUFF? JR C,DM1 ; NO LD C,ACBSIZ ; YES, FORCE TO SIZE OF BUFFER JR DM2 DM1: AND A JR Z,DM4 DM2: LD A,C ; SET NO. OF ASSD BYTES LD (ASCDNO),A NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP EX DE,HL ; DO TRANSFER LD DE,ASSCOD DM3: CALL DOUBQ ; SKIP CHAR IF DOUBLE QUOTE LDI ; TRANSFER A CHAR JP PE,DM3 ; JUMP IF TRANSFER NOT COMPLETE DM4: POP BC ; REPLACE REGISTERS POP DE POP HL RET ;************************************************************************** ;LOCATE STRING ;ON ENTRY: ; HL POINTS TO CHAR AFTER OPERAND ;ON EXIT: ; HL POINTS TO FIRST CHAR OF ACTUAL STRING. ; BC CONTAINS NO OF CHARS IN THAT STRING ; (COUNTING 2 QUOTES AS 1 CHAR) ; ZERO FLAG IS SET FOR SYNTAX ERROR ;************************************************************************** STR: CALL SCNSP ; SCAN TO NEXT NON SP CHAR CP '''' ; IS IT A ' ? JR NZ,STR4 ; SYNTAX ERROR, STRING NOT FOUND INC HL ; POINT TO NEXT CHAR LD D,H ; SAVE POINTER IN DE LD E,L LD BC,0 ; CLEAR BC STR1: ; COUNT CHARS TO NEXT 7 CALL DOUBQ ; END OF STRING QUOTE? JR NZ,STR2 ; JUMP IF SO LD A,(HL) ; GET CHAR CP CR ; IS IT CR? JR Z,STR4 ; JUMP IF SO, ERROR INC HL ; INCR PNTR INC C ; AND CNTR JR STR1 ; LOOP STR2: CALL SCNSP ; FIND NEXT NON SP CHAR CP CR ; MUST BE CR/; JR Z,STR3 CP ';' JR Z,STR3 PUSH BC ; SYNTAX ERROR, BUT STRING FOUND LD C,'S' CALL ERROR ; INDICATE SYNTAX ERROR POP BC STR3: XOR A INC A RET STR4: LD C,'S' ; SYNTAX ERROR, STRING NOT FOUND CALL ERROR ; INDICATE ERROR XOR A ; SET ZERO FLAG (FOR ERROR) RET ; AND RETURN ;*********************************************************************** ;PROCESS TOKENS ;PRODUCE ASSEMBLED CODE IN BUFFER BASED ON OPERATOR ;AND OPERAND TOKENS. ;*********************************************************************** PTOK: PUSH IX ; SAVE REGS PUSH HL PUSH DE PUSH BC LD A,(ODBT1) ; PUT OPD BYTE 1 IN B LD B,A LD A,(ODBT2) ; PUT OPD BYTE 2 IN C LD C,A LD HL,(ODINT1) ; PUT OPD INTEGER IN HL LD DE,(ODINT2) ; PUT OPD INTEGER IN DE LD A,(ORTKBF) ; GET OPERATOR TOKEN CP ORGTOK ; TOKEN FOR ORG? JR Z,PTOK4 ; JUMP IF SO CALL PLAB ; PROCESS LABEL EXX PUSH HL ; SAVE REGS PUSH DE PUSH BC LD A,(ORTKBF) ; GET TOKEN AGAIN AND 7FH ; MASK OFF CONDITIONAL FLAG BIT ADD A,A ; DOUBLE IT LD E,A ; PUT INTO DE LD D,0 LD HL,PORL ; PUT 'PROCESS OPR' LIST PNTR IN HL ADD HL,DE ; ADD DE TO GET PNTR TO PNTR TO ROUTIN LD E,(HL) ; GET POINTER IN DE INC HL LD D,(HL) EX DE,HL ; PUT IN HL CALL ODPBT ; GET OPD PAIR BYTE LD B,A ; SAVE IN B PTOK1: LD A,(HL) ; GET VALID TOKEN FROM LIST INC HL ; INCR LIST POINTER CP 0FFH ; COMPARE WITH END OF LIST FLAG JR Z,PTOK3 ; END OF LIST, NOT VALID COMBINATION CP 0FEH ; E.O.L. - NO NOP'S, NO ERROR IND JR Z,PTOK8 CP 0FDH ; END OF LIST - ERROR IND ONLY JR NZ,PTOK9 LD C,'S' ; INDICATE SYNTAX ERROR CALL ERROR JR PTOK8 PTOK9: CP B ; COMPARE TOKEN JR Z,PTOK2 ; JUMP IF MATCH INC HL ; POINT TO NEXT TOKEN INC HL JR PTOK1 ; AND LOOP PTOK2: LD C,(HL) ; GET ADDR OF SUBROUTINE FROM LIST INC HL LD H,(HL) LD L,C PUSH HL ; GET ADDR IN IX POP IX LD HL,PTOK8 ; PUSH RETURN ADDR PUSH HL EXX ; SWAP REGISTER BANKS JP (IX) ; AND CALL INDIRECT PTOK3: CALL DNOPS ; SYNTAX ERROR, APPEND NOP'S JR PTOK8 PTOK4: CALL PORG ; PROCESS ORG JR PTOK7 PTOK8: CALL ADJARC ; ADJUST ADDR REF CNTR EXX ; REPLACE REGS POP BC POP DE POP HL EXX PTOK7: POP BC POP DE POP HL POP IX RET ;********************************************************************* ;SYNTAX ERROR ;ALL THE FOLLOWING PROCESS SUBROUTINES ;RETURN VIA THIS SUBROUTINE IF THEY ;NEED TO APPEND NOP'S IF THE CASE OF ;A SYNTAX ERROR. ;********************************************************************* SYNERR: CALL DNOPS ; ERROR, APPEND DEFAULT NOP'S RET ;................................................... ;PROCESS OPERATOR LIST ;CONTAINS ADDRESSES OF SUBROUTINES ;TO PROCESS VARIOUS OPERATOR GROUPS. ;................................................... PORL: DEFW LSTNUL ; NULL ROUTINE FOR NO OPERATOR DEFW LSTNUL ; NULL ROUTINE FOR ORG DEFW LSTNUL ; NULL ROUTINE FOR EQU DEFW LSTNUL ; NULL FOUTINE FOR DEFL DEFW LST04 ; END DEFW LST05 ; DEFB DEFW LST06 ; DEFW DEFW LST07 ; DEFS DEFW LSTNUL ; NULL ROUTINE FOR DEFM DEFW LSTNUL ; NULL ROUTINE FOR TITLE DEFW LST0B ; SINGLE BYTE, NO OPERAND DEFW LST0B ; DOUBLE BYTE, NO OPERAND DEFW LST0C ; AND OR XOR CP SUB DEFW LST0D ; INC DEC DEFW LST0E ; IM DEFW LST0F ; RLC RL SLA RRC RR SRA SRL DEFW LST10 ; BIT SET RES DEFW LST11 ; JP DEFW LST12 ; JR DEFW LST13 ; DJNZ DEFW LST14 ; CALL DEFW LST15 ; RET DEFW LST16 ; RST DEFW LST17 ; IN DEFW LST18 ; OUT DEFW LST19 ; PUSH POP DEFW LST1A ; EX DEFW LST1B ; ADC SBC DEFW LST1C ; ADD DEFW LST1D ; LD ;......................................................... LSTNUL: DEFB 0FEH ;......................................................... LST04: DEFB 0 ; NO OPD DEFW GP04 DEFB 90H ; SINGLE INTEGER DEFW GP04 DEFB 0FDH ;......................................................... LST05: DEFB 90H ; DEFB N DEFW GP05 DEFB 0FFH ;......................................................... LST06: DEFB 90H ; DEFW NN DEFW GP06 DEFB 0FFH ;......................................................... LST07: DEFB 90H ; DEFS N DEFW GP07 DEFB 0FDH ;......................................................... LST0B: DEFB 0 ; NO OPERAND DEFW GP0B DEFB 0FFH ;......................................................... LST0C: DEFB 70H ; OPR R DEFW GP0C1 DEFB 90H ; OPR N DEFW GP0C2 DEFB 40H ; OPR (HL)/(IX)/(IY) DEFW GP0C3 DEFB 0B0H ; OPR (IX+D)/(IY+D) DEFW GP0C3 DEFB 0FFH ;......................................................... LST0D: DEFB 70H ; OPR R DEFW GP0D1 DEFB 40H ; OPR (HL)/(IX)/(IY) DEFW GP0D2 DEFB 0B0H ; OPR (IX+D)/(IY+D) DEFW GP0D2 DEFB 10H ; OPR RP DEFW GP0D3 DEFB 0FFH ;.......................................................... LST0E: DEFB 90H ; IM N DEFW GP0E DEFB 0FFH ;.......................................................... LST0F: DEFB 70H ; OPR R DEFW GP0F1 DEFB 40H ; OPR (HL)/(IX)/(IY) DEFW GP0F2 DEFB 0B0H ; OPR (IX+D)/(IY+D) DEFW GP0F2 DEFB 0FFH ;.......................................................... LST10: DEFB 97H ; OPR B,R DEFW GP101 DEFB 94H ; OPR B,(HL)/(IX)/(IY) DEFW GP102 DEFB 9BH ; OPR B,(IX+D)/(IY+) DEFW GP102 DEFB 0FFH ;........................................................... LST11: DEFB 40H ; JP (HL)/(IX)/(IY) DEFW GP111 DEFB 89H ; JP CC,NN DEFW GP112 DEFB 90H ; JP NN DEFW GP113 DEFB 0FFH ;............................................................ LST12: DEFB 89H ; JR CC,E DEFW GP121 DEFB 90H ; JR E DEFW GP122 DEFB 0FFH ;............................................................ LST13: DEFB 90H ; DJNZ NN DEFW GP13 DEFB 0FFH ;........................................................... LST14: DEFB 89H ; CALL CC,NN DEFW GP141 DEFB 90H ; CALL NN DEFW GP142 DEFB 0FFH ;............................................................ LST15: DEFB 00H ; RET DEFW GP151 DEFB 80H ; RET CC DEFW GP152 DEFB 0FFH ;............................................................ LST16: DEFB 90H ; RST N DEFW GP16 DEFB 0FFH ;............................................................ LST17: DEFB 7DH ; IN A,(N) DEFW GP171 DEFB 7AH ; IN R,(C) DEFW GP172 DEFB 0FFH ;............................................................ LST18: DEFB 0A7H ; OUT (C),R DEFW GP181 DEFB 0D7H ; OUT (N),A DEFW GP182 DEFB 0FFH ;............................................................. LST19: DEFB 10H ; OPR RP DEFW GP19 DEFB 0FFH ;............................................................. LST1A: DEFB 51H ; EX (SP),HL/IX/IY DEFW GP1A1 DEFB 1EH ; EX AF,AF' DEFW GP1A2 DEFB 11H ; EX DE,HL DEFW GP1A3 DEFB 0FFH ;............................................................. LST1B: DEFB 77H ; OPR A,R DEFW GP1B1 DEFB 79H ; OPR A,N DEFW GP1B2 DEFB 74H ; OPR A,(HL)/(IX)/(IY) DEFW GP1B3 DEFB 7BH ; OPR A,(IX+D)/(IY+D) DEFW GP1B3 DEFB 11H ; OPR HL,SS DEFW GP1B4 DEFB 0FFH ;............................................................... LST1C: DEFB 77H ; ADD A,R DEFW GP1C1 DEFB 79H ; ADD A,N DEFW GP1C2 DEFB 74H ; ADD A,(HL)/(IX)/(IY) DEFW GP1C3 DEFB 7BH ; ADD A,(IX+D)/(IY+D) DEFW GP1C3 DEFB 11H ; ADD HL/IX/IY,RP DEFW GP1C4 DEFB 0FFH ;............................................................... LST1D: DEFB 76H ; LD A,(BC)/(DE) DEFW GP1D1 DEFB 72H ; LD A,I/R DEFW GP1D2 DEFB 7DH ; LD A,(NN) DEFW GP1D3 DEFB 67H ; LD (BC)/(DE),A DEFW GP1D4 DEFB 49H ; LD (HL)/(IX)/(IY),N DEFW GP1D5 DEFB 19H ; LD RP,NN DEFW GP1D6 DEFB 1DH ; LD RP,(NN) DEFW GP1D7 DEFB 47H ; LD (HL)/(IX)/(IY),R DEFW GP1D8 DEFB 27H ; LD I/R,A DEFW GP1D9 DEFB 0B9H ; LD (IX+D)/(IY+D),N DEFW GP1D5 DEFB 0B7H ; LD (IX+D)/(IY+D),R DEFW GP1D8 DEFB 0D7H ; LD (NN),A DEFW GP1DA DEFB 0D1H ; LD (NN),RP DEFW GP1DB DEFB 74H ; LD (HL)/(IX)/(IY) DEFW GP1DC DEFB 7BH ; LD R,(IX+D)/(IY+D) DEFW GP1DC DEFB 79H ; LD R,N DEFW GP1DD DEFB 77H ; LD R,R DEFW GP1DE DEFB 11H ; LD SP,HL/IX/IY DEFW GP1DF DEFB 0FFH ;********************************************************************** ;ENTRY AND EXIT CONDITIONS FOR PORG, PLAB AND ;ALL GP... SUBROUTINES. ; ;ON ENTRY: ; B CONTAINS OPERAND-1 TOKEN BYTE ; C CONTAINS OPERAND-2 TOKEN BYTE ; HL CONTAINS OPERAND-1 INTEGER ; DE CONTAINS OPERAND-2 INTEGER ;ON EXIT: ; ASSEMBLED CODE HAS BEEN PLACED IN ASSEMBLED ; CODE BUFFER (ASSCOD). ; ADDRESS REFERENCE COUNTER HAS BEEN ADJUSTED. ;********************************************************************** ; ;********************************************************************** ;PROCESS ORG ;********************************************************************** PORG: PUSH HL ; SAVE REGS PUSH BC CALL ODPBT ; GET OPERAND PAIR BYTE IN A CP 90H ; SINGLE INTEGER? JR NZ,PORG1 ; JUMP OTHERWISE LD HL,(ODINT1) ; GET OPERAND-1 INTEGER LD (ADREFC),HL ; PUT IN ADDR REG CNTR LD (ADDISR),HL ; AND ADDR DISP REG LD HL,AFLAGS ; SET ADDR DISCONTINUITY FLAG SET 0,(HL) JR PORG2 PORG1: LD C,'S' ; INDICATE SYNTAX ERROR CALL ERROR PORG2: POP BC ; REPLACE REGS POP HL RET ;********************************************************************** ;PROCESS LABEL (INCLUDES EQU AND DEFL) ;********************************************************************** PLAB: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD A,(ORTKBF) ; GET OPR TOKEN PUSH AF ; SAVE ON STACK CP DEFLTK ; IS IT DEFL? JR Z,PLAB1 CP EQUTOK ; OR EQU? JR NZ,PLAB2 PLAB1: LD (ADDISR),HL ; DISPLAY VALUE IF SO CALL ODPBT ; GET OPD PAIR BYTE CP 90H ; SINGLE INTEGER? JR Z,PLAB3 ; JUMP IF SO, OK LD C,'S' ; ELSE INDICATE SYNTAX ERROR CALL ERROR JR PLAB3 PLAB2: LD HL,(ADREFC) ; GET CURRENT ADDR (LABEL VALUE) PLAB3: LD B,H ; COPY LABEL VALUE INTO BC LD C,L CALL LBSYM ; PUT LABEL AND VALUE IN SYMBUF JR Z,PLAB13 ; JUMP IF NO LABEL PRESENT CALL SYMCH ; CHECK IF SYMBOL IS RESERVED WORD JR NC,PLAB5 ; JUMP IF NOT PLAB13: POP AF ; GET OPR TOKEN PUSH AF CP DEFLTK ; IS IT DEFL? JR Z,PLAB4 CP EQUTOK ; OR EQU? JR NZ,PLAB12 PLAB4: LD C,'S' ; INDICATE SYNTAX ERROR IF SO CALL ERROR JR PLAB12 PLAB5: POP AF ; GET OPR TOKEN PUSH AF CP DEFLTK ; IS IT DEFL? JR NZ,PLAB6 ; JUMP IF NOT SET 0,(HL) ; SET DEFL FLAG IN ATTRIB PLAB6: CALL LOCATE ; LOCATE IN SYMBOL TABLE JR Z,PLAB8 ; JUMP IF ALREADY IN TABLE LD A,(PASSNO) ; IS THIS PASS 1? CP 1 JR Z,PLAB7 ; JUMP IF SO LD C,'P' ; OTHERWISE INDICATE PHASE ERROR CALL ERROR JR PLAB12 PLAB7: CALL INSERT ; INSERT IN SYMBOL TABLE JR PLAB12 ; ALREADY IN TABLE PLAB8: LD A,(PASSNO) ; IS THIS PASS 1? CP 1 JR Z,PLAB11 ; JUMP IF SO INC HL ; MULT DEFN FLAG SET? INC HL BIT 1,(HL) JR Z,PLAB9 ; JUMP IF NOT LD C,'M' ; INDICATE MULT DEFN ERROR CALL ERROR JR PLAB12 PLAB9: POP AF ; GET OPR TOKEN PUSH AF CP DEFLTK ; IS IT DEFL? JR NZ,PLAB10 ; JUMP IF NOT DEC HL ; INSERT NEW VALUE LD (HL),B DEC HL LD (HL),C JR PLAB12 PLAB10: ; HAS VALUE CHANGED? DEC HL ; GET OLD VALUE IN DE LD D,(HL) DEC HL LD E,(HL) EX DE,HL ; GET IT INTO HL AND A ; CLEAR CARRY SBC HL,BC ; AND COMPARE OLD AND NEW VALUES JR Z,PLAB12 ; JUMP IF EQUAL EX DE,HL ; ELSE INSERT NEW VALUE LD (HL),C INC HL LD (HL),B LD C,'P' ; AND INDICATE PHASE ERROR CALL ERROR JR PLAB12 PLAB11: INC HL ; POINT TO ATTRIBUTE BYTE INC HL POP AF ; GET OPR TOKEN PUSH AF CP DEFLTK ; IS IT DEFL? JR NZ,PLAB14 ; JUMP IF NOT BIT 0,(HL) ; TEST DEFL FLAG JR NZ,PLAB12 ; JUMP IF SET PLAB14: SET 1,(HL) ; SET MULT DEFN FLAG PLAB12: POP AF ; REPLACE REGS POP BC POP DE POP HL RET ;******************************************************************* ;PROCESS END (GROUP 04) ;******************************************************************* GP04: LD (STADDR),HL ; LOAD START ADDR WITH INTEGER LD (ADDISR),HL ; LOAD ADDR DIS REG WITH INTEGER LD HL,AFLAGS ; SET 'END' FLAG SET 1,(HL) RET ;******************************************************************** ;PROCESS DEFB ;******************************************************************** GP05: CALL CHKOF ; CHECK FOR OVERFLOW BEYOND ; 8 BIT VALUE (AND FLAG IF SO) LD A,L ; APPEND 1 BYTE TO ASSD CODE BUFF CALL APPBT ; APPEND BYTE TO ASSD CODE BUFF RET ;******************************************************************** ;PROCESS DEFW ;******************************************************************** GP06: CALL APPWD ; APPEND TO ASSD CODE BUFF RET ;******************************************************************** ;PROCESS DEFS (GROUP 07) ;******************************************************************** GP07: LD DE,(ADREFC) ; ADD INTEGER TO ADDR REF CNTR ADD HL,DE LD (ADREFC),HL LD HL,AFLAGS ; SET ADDR DISCONT. FLAG SET 0,(HL) RET ;******************************************************************** ;PROCESS NO OPERAND. ;******************************************************************** GP0B: LD A,(ORTKBF) ; GET OPR GROUP CP 0AH ; IS IT GROUP 0A? JR Z,GP0B1 ; SKIP PREFIX BYTE IF SO LD A,0EDH ; LOAD PREFIX BYTE TO ASSD CODE BUFF CALL APPBT ; APPEND TO ASSD CODE BUFFER GP0B1: LD A,(ORTKBF+1) ; GET OPCODE IN A CALL APPBT ; AND APPEND TO ASSD CODE BUFF RET ;******************************************************************** ;PROCESS AND/OR/XOR/CP/SUB (GROUP 0C) ;******************************************************************** ;GROUP 0C - R ;******************************************************************** GP0C1: LD A,(ORTKBF+1) ; GET OPR DISTING BITS LD C,B ; COMBINE REG BITS CALL ISREG OR 10000000B ; BUILD OP-CODE CALL APPBT ; APPEND RESULT TO ASSD CODE BUFFER RET ;******************************************************************** ;GROUP 0C - N ;******************************************************************** GP0C2: LD A,(ORTKBF+1) ; GET OPR DISTING BITS OR 11000110B ; BUILD OP-CODE CALL APPBT ; APPEND IT TO ASSD CODE BUFF CALL CHKOF ; INDICATE OVERFLOW ERROR IF ANY LD A,L ; PUT INTEGER IN ASSD CODE BUFFER CALL APPBT RET ;******************************************************************* ;GROUP 0C - (HL)/(IX+D)/(IY+D) ;******************************************************************* GP0C3: CALL INDPF ; GENERATE INDEX PREFIX, IF REQD LD A,(ORTKBF+1) ; GET OPR DISTING BITS OR 10000110B ; BUILD OP-CODE CALL APPBT ; APPEND TO ASSD CODE BUFF CALL DISBT ; APPEND DISP. IF REQD RET ;******************************************************************* ;PROCESS INC/DEC (GROUP 0D) ;******************************************************************* ;GROUP 0D - R ;******************************************************************* GP0D1: LD C,B LD A,(ORTKBF+1) ; GET OPR DISTING. BIT AND 00000001B OR 00000100B ; BUILD OP-CODE CALL IDREG ; INSERT REGISTER BITS CALL APPBT ; APPEND OPCODE TO BUFFER RET ;****************************************************************** ;GROUP 0D - (HL)/(IX+D)/(IY+D) ;****************************************************************** GP0D2: CALL INDPF ; GENERATE INDEX PREFIX IF REGD LD A,(ORTKBF+1) ; GET OPERATOR DISTING. BIT AND 00000001B OR 00110100B ; GENERATE OP-CODE CALL APPBT ; APPEND TO BUFFER CALL DISBT ; APPEND DISP. IF REQD RET ;****************************************************************** ;GROUP 0D - IX/IY/BC/DE/HL/SP ;****************************************************************** GP0D3: LD A,B ; GET OPERAND BYTE-1 CP 17H ; CHECK IF AF REFERENCE JP Z,SYNERR ; JUMP IF IT IS, ERROR CALL INDPF ; GENERATE INDEX PREFIX IF REQD LD C,B ; PUT OPERAND BYTE IN C LD A,(ORTKBF+1) ; GET OPR DISTING. BIT AND 00001000B OR 00000011B ; BUILD OP-CODE CALL IREGP ; INSERT REGISTER PAIR BITS CALL APPBT ; APPEND THIS OPCODE TO BUFFER RET ;****************************************************************** ;PROCESS IM (GROUP 0E) ;****************************************************************** GP0E: LD A,H ; GET HIGH BYTE AND A ; CHECK IT IS 0 JP NZ,SYNERR ; ERROR IF NOT, SO JUMP LD A,L ; GET LOW BYTE CP 3 ; IS IT 0,1 OR 2? JP NC,SYNERR ; JUMP IF NOT, ERROR AND A ; IS IT ZERO? JR Z,GP0E1 ; JUMP IF SO INC A ; OTHERWISE INCREMENT GP0E1: LD C,A ; PUT IT IN C LD A,0EDH ; APPEND PREFIX BYTE CALL APPBT ; TO ASSD CODE BUFFER LD A,01000110B ; GENERATE OP-CODE CALL IDREG ; INSERT PARAMETER BITS CALL APPBT ; APPEND TO ASSD CODE BUFF RET ;****************************************************************** ;PROCESS RLC/RL/SLA/RRC/RR/SRA/SRL (GROUP 0F) ;****************************************************************** ;GROUP 0F - R ;**************************************************************** GP0F1: LD A,0CBH ; APPEND PREFIX BYTE CALL APPBT ; TO ASSD CODE BUFF LD C,B ; PUT OPD BYTE 1 IN C LD A,(ORTKBF+1) ; GET OPD DISTING. BITS CALL ISREG ; INSERT REGISTER BITS CALL APPBT RET ;****************************************************************** ;GROUP OF - (HL)/(IX+D)/(IY+D) ;****************************************************************** GP0F2: CALL INDPF ; APPEND INDEX PREFIX BYTE IF REQD LD A,0CBH CALL APPBT ; APPEND PREFIX BYTE CALL DISBT ; APPEND DISPLACEMENT BYTE IF REQD LD A,(ORTKBF+1) ; GET OPR DISTING. BITS OR 00000110B ; BUILD OP-CODE CALL APPBT ; APPEND TO ASSD CODE BUFF RET ;************************************************************************* ;PROCESS BIT/SET/RES (GROUP 10) ;************************************************************************* ;GROUP 10 - B,R ;************************************************************************* GP101: ; OPD INTEGER ; MUST BE IN RANGE 0-7 LD A,L ; SEE IF ANY BITS OTHER THAN AND 11111000B ; 3 L.S. BITS ARE 1 OR H JP NZ,SYNERR ; JUMP IF SO, ERROR LD A,0CBH ; APPEND PREFIX BYTE TO BUFFER CALL APPBT LD A,(ORTKBF+1) ; GET OPD DISTING. BITS CALL ISREG ; COMBINE REGISTER BITS LD C,L ; GET INTEGER IN C CALL IDREG ; COMBINE INTEGER BITS CALL APPBT ; APPEND OP-CODE TO BUFFER RET ;************************************************************************ ;GROUP 10 - B,(HL)/(IX+D)/(IY+D) ;************************************************************************ GP102: ; OPD INTEGER ; MUST BE IN RANGE 0-7 LD A,L ; SEE IF ANY BITS OTHER THAN AND 11111000B ; 3 L.S. BITS ARE 1 OR H JP NZ,SYNERR ; JUMP IF SO, ERROR LD B,C CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,0CBH ; APPEND OP-CODE PREFIX CALL APPBT LD C,L ; GET INTEGER IN C EX DE,HL ; GET DISPLACEMENT INTEGER CALL DISBT ; APPEND IF REQD LD A,(ORTKBF+1) ; GET OPD DISTING. BITS OR 00000110B ; BUILD OP-CODE CALL IDREG ; COMBINE INTEGER BITS CALL APPBT RET ;*********************************************************************** ;PROCESS JP (GROUP 11) ;*********************************************************************** ;*********************************************************************** ;GROUP 11 - (HL)/(IX)/(IY) ;*********************************************************************** GP111: CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,0E9H ; APPEND OP-CODE PREFIX TO BUFFER CALL APPBT RET ;*********************************************************************** ;GROUP 11 - CC,NN ;*********************************************************************** GP112: LD C,B ; GET OPD BYTE 1 IN C LD A,11000010B ; BUILD OP-CODE CALL IDREG ; COMBINE CONDITION BITS CALL APPBT ; APPEND OP-CODE TO BUFFER EX DE,HL ; GET INTEGER CALL APPWD ; APPEND LOW BYTE RET ;********************************************************************** ;GROUP 11 - NN ;********************************************************************** GP113: LD A,0C3H ; APPEND OP-CODE TO BUFFER CALL APPBT CALL APPWD ; APPEND INTEGER RET ;********************************************************************** ;PROCESS JR (GROUP 12) ;********************************************************************** ;********************************************************************** ;GROUP 12 CC,E ;********************************************************************** GP121: BIT 2,B ; CHECK IF PO/PE/P/M JP NZ,SYNERR ; JUMP IF SO, ERROR LD C,B ; PUT OPR BYTE 1 IN C EX DE,HL ; GET OPD INTEGER 2 CALL CDIS ; CALCULATE DISPLACEMENT NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP LD A,00100000B ; BUILD OP-CODE CALL IDREG ; COMBINE CONDITION BITS CALL APPBT ; APPEND OP-CODE TO BUFFER LD A,L ; GET DISPLACEMENT CALL APPBT ; APPEND TO BUFFER RET ;********************************************************************* ;GROUP 12 - E ;********************************************************************* GP122: CALL CDIS ; CALCULATE DISPLACEMENT NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP LD A,18H ; APPEND OP-CODE TO BUFFER CALL APPBT LD A,L ; APPEND DISP TO BUFFER CALL APPBT RET ;********************************************************************* ;PROCESS DJNZ (GROUP 13) ;********************************************************************* GP13: CALL CDIS ; CALCULATE DISPLACEMENT NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP LD A,10H ; APPEND OP-CODE TO BUFFER CALL APPBT LD A,L ; APPEND DISP TO BUFFER CALL APPBT RET ;********************************************************************* ;CALCULATE DISPLACEMENT ;********************************************************************* CDIS: PUSH DE ; SAVE REGS PUSH BC LD DE,(ADREFC) ; GET ADDR REF CNTR INC DE ; ADD 2 (ALLOW FOR INCRD PC) INC DE AND A ; CLEAR CARRY SBC HL,DE ; GET DISPLACEMENT FROM CURR LOC. LD A,L ; CHECK FOR 8 BIT OVERFLOW AND 10000000B OR H JR Z,CDIS2 ; JUMP IF NO OVERFLOW LD A,L ; CHECK -VE OVERFLOW OR 01111111B AND H CPL AND A JR Z,CDIS2 ; JUMP IF NO OVERFLOW CDIS1: LD C,'R' ; INDICATE RANGE ERROR CALL ERROR XOR A ; CLEAR ZERO FLAG INC A CDIS2: POP BC ; REPLACE REGS POP DE RET ;******************************************************************** ;PROCESS CALL (GROUP 14) ;******************************************************************** ;******************************************************************** ;GROUP 14 - CC,NN ;******************************************************************** GP141: LD C,B ; GET OPD BYTE 1 IN C LD A,11000100B ; BUILD OP-CODE CALL IDREG ; COMBINE CONDITION BIT CALL APPBT ; APPEND OP-CODE TO BUFFER EX DE,HL ; GET INTEGER CALL APPWD ; APPEND INTEGER RET ;******************************************************************** ;GROUP 14 - NN ;******************************************************************** GP142: LD A,0CDH ; APPEND OP-CODE TO BUFFER CALL APPBT CALL APPWD ; APPEND INTEGER RET ;******************************************************************** ;PROCESS RET (GROUP 15) ;******************************************************************** ;******************************************************************** ;GROUP 15 - NO OPERAND ;******************************************************************** GP151: LD A,0C9H ; APPEND OP-CODE TO BUFFER CALL APPBT RET ;******************************************************************** ;GROUP 15 - CC ;******************************************************************** GP152: LD C,B ; GET OPD BYTE 1 IN C LD A,11000000B ; BUILD OP-CODE CALL IDREG ; COMBINE CONDITION BITS CALL APPBT ; APPEND OP-CODE TO BUFFER RET ;******************************************************************** ;PROCESS RST (GROUP 16) ;******************************************************************** GP16: ; INTEGER MAY ONLY BE 0/08H/ ; 10H/18H/20H/28H/30H/38H LD A,L ; CHECK FOR INVALID VALUE AND 11000111B OR H JP NZ,SYNERR ; JUMP IF INVALID LD A,L ; BUILD OP-CODE OR 11000111B CALL APPBT ; APPEND TO BUFFER RET ;******************************************************************** ;PROCESS IN (GROUP 17) ;******************************************************************** ;******************************************************************** ;GROUP 17 - A,(N) ;******************************************************************** GP171: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,D ; INTEGER MUST BE < 256 AND A NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP LD A,0DBH ; APPEND OP-CODE TO BUFFER CALL APPBT LD A,E ; APPEND INTEGER TO BUFFER CALL APPBT RET ;******************************************************************** ;GROUP 17 - R,(C) ;******************************************************************** GP172: LD A,0EDH ; APPEND OP-CODE PREFIX TO BUFFER CALL APPBT LD C,B ; GET OPD BYTE 1 IN C LD A,01000000B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BITS CALL APPBT RET ;******************************************************************** ;PROCESS OUT (GROUP 18) ;******************************************************************** ;******************************************************************** ;GROUP 18 - (C),R ;******************************************************************** GP181: LD A,0EDH ; APPEND OP-CODE PREFIX TO BUFFER CALL APPBT LD A,01000001B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BITS CALL APPBT ; APPEND TO BUFFER RET ;******************************************************************* ;GROUP 18 - (N),A ;******************************************************************* GP182: LD A,C ; GET OPD BYTE 2 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT LD A,H ; MUST BE < 256 AND A NOP ; ROOM FOR SPARE INSTRUCTION NOP NOP LD A,0D3H ; APPEND OP-CODE TO BUFFER CALL APPBT LD A,L ; APPEND INTEGER TO BUFFER CALL APPBT RET ;******************************************************************* ;PROCESS PUSH/POP (GROUP 19) ;******************************************************************* GP19: LD A,(ODBT1) ; GET OPD BYTE 1 CP 13H ; SP NOT PERMITTED JP Z,SYNERR LD C,B ; GET OPD BYTE 1 IN C CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,(ORTKBF+1) ; GET APR DISTING. BITS CALL IREGP ; COMBINE REG PAIR BITS CALL APPBT ; APPEND TO BUFFER RET ;******************************************************************** ;PROCESS EX (GROUP 1A) ;******************************************************************** ;******************************************************************** ;GROUP 1A - (SP),HL/IX/IY ;******************************************************************** GP1A1: LD B,C ; GET OPR BYTE 2 IN C LD A,C AND 3 ; MUST BE HL/IX/IY CP 2 JP NZ,SYNERR ; JUMP IF NOT, ERROR CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,0E3H ; APPEND AP-CODE TO BUFFER CALL APPBT RET ;******************************************************************** ;GROUP 1A - AF,AF' ;******************************************************************** GP1A2: LD A,B ; GET OPD BYTE 1 CP 17H ; MUST BE AF JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,08H ; APPEND OP-CODE TO BUFFER CALL APPBT RET ;******************************************************************** ;GROUP 1A - DE,HL ;******************************************************************** GP1A3: LD A,B ; GET SPD BYTE 1 CP 11H ; MUST BE DE JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,C ; GET OPD BYTE 2 CP 12H ; MUST BE HL JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,0EBH ; APPEND OP-CODE TO BUFFER CALL APPBT RET ;******************************************************************** ;PROCESS ADC/SBC (GROUP 1B) ;******************************************************************** ;GROUP 1B - A,R ;******************************************************************** GP1B1: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,(ORTKBF+1) ; GET OPD DISTING BITS AND 00010000B ; AND MASK IT OR 10001000B ; BUILD OP-CODE CALL ISREG ; COMBINE REGISTER BITS CALL APPBT ; APPEND BYTE TO BUFFER RET ;******************************************************************* ;GROUP 1B - A,N ;******************************************************************* GP1B2: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,(ORTKBF+1) ; GET OPR DISTING BITS AND 00010000B ; AND MASK IT OR 11001110B ; BUILD OP-CODE CALL APPBT ; APPEND TO BUFFER EX DE,HL ; GET INTEGER IN HL CALL CHKOF ; FLAG OVERFLOW FROM L IF ANY LD A,L ; APPEND INTEGER TO BUFFER CALL APPBT RET ;******************************************************************* ;GROUP 1B A,(HL)/(IX+D)/(IY+D) ;******************************************************************* GP1B3: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD B,C ; PUT OPD BYTE 2 IN B CALL INDPF ; APPEND INDEX PREFIX IF ANY LD A,(ORTKBF+1) ; GET OPR DISTING BIT AND 00010000B ; AND MASK IT OR 10001110B ; BUILD OP-CODE CALL APPBT ; APPEND IT TO BUFFER EX DE,HL ; GET DISP. INTEGER CALL DISBT ; APPEND DISPLACEMENT INTEGER IF REQD RET ;******************************************************************** ;GROUP 1B - HL,BC/DE/HL/SP ;******************************************************************** GP1B4: LD A,B ; GET OPD BYTE 1 CP 12H ; MUST BE HL JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,C ; GET OPD BYTE 2 CP 14H ; MUST BE BC/DE/HL/SP JP NC,SYNERR ; JUMP IF NOT, ERROR LD A,0EDH ; APPEND PREFIX BYTE TO BUFFER CALL APPBT LD A,(ORTKBF+1) ; GET OPR DISTING BIT AND 00001000B ; MASK IT OR 01000010B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS CALL APPBT ; APPEND IT TO BUFFER RET ;******************************************************************* ;PROCESS ADD (GROUP 1C) ;******************************************************************* ;******************************************************************* ;GROUP 1C - A,R ;******************************************************************* GP1C1: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,10000000B ; BUILD OP-CODE CALL ISREG ; COMBINE REG BITS CALL APPBT ; APPEND TO BUFFER RET ;******************************************************************* ;GROUP 1C - A,N ;******************************************************************* GP1C2: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,0C6H ; APPEND OP-CODE CALL APPBT EX DE,HL ; GET INTEGER IN HL CALL CHKOF ; FLAG ANY OVERFLOW FROM L LD A,L ; APPEND INTEGER TO BUFFER CALL APPBT RET ;******************************************************************** ;GROUP 1C - A,(HL)/(IX+D)/(IY+D) ;******************************************************************** GP1C3: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR LD B,C ; PUT OPD BYTE 2 IN B CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,86H ; APPEND OP-CODE TO BUFFER CALL APPBT EX DE,HL ; GET DISP INTEGER IN HL CALL DISBT ; APPEND IT IF REQD RET ;******************************************************************** ;GROUP 1C - HL/IX/IY,RP ;******************************************************************** GP1C4: LD A,B ; GET OPD BYTE 1 AND 11B ; MUST BE HL/IX/IY CP 10B JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,C ; GET OPD BYTE 2 AND 11B ; IS IT BC/DE/SP CP 10B JR NZ,GP1C41 ; JUMP IF SO LD A,C ; IS IT SAME AS OPD 1? CP B JP NZ,SYNERR ; JUMP IF NOT, ERROR GP1C41: CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,00001001B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS CALL APPBT RET ;******************************************************************** ;PROCESS LD (GROUP 1D) ;******************************************************************** ;******************************************************************** ;GROUP 1D - A,(BC)/(DE) ;******************************************************************** GP1D1: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,00001010B ; BUILD OP-CODE CALL IREGP ; COMBINE REG BITS CALL APPBT ; APPEND OP-CODE TO BUFFER RET ;******************************************************************** ;GROUP 1D - A,I/R ;******************************************************************** GP1D2: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,0EDH ; APPEND PREFIX BYTE TO BUFFER CALL APPBT LD A,01010111B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BIT CALL APPBT ; APPEND OP-CODE TO BUFFER RET ;******************************************************************** ;GROUP 1D - A,(NN) ;******************************************************************** GP1D3: LD A,B ; GET OPD BYTE 1 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR EX DE,HL ; GET INTEGER IN HL LD A,3AH ; APPEND OP-CODE TO BEFFER CALL APPBT CALL APPWD ; APPEND INTEGER RET ;******************************************************************** ;GROUP 1D - (BC)/(DE),A ;******************************************************************** GP1D4: LD A,C ; GET OPD BYTE 2 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD C,B ; PUT OPD BYTE 1 IN C LD A,00000010B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS CALL APPBT ; APPEND OP-CODE TO BUFFER RET ;******************************************************************* ;GROUP 1D - (HL)/(IX+D)/(IY+D),N ;******************************************************************* GP1D5: CALL INDPF ; APPEND INDEX PREFIX TO BUFFER LD A,36H CALL APPBT ; APPEND OP-CODE CALL DISBT ; APPEND DISP BYTE IF REQD EX DE,HL ; GET INTEGER IN HL CALL CHKOF ; FLAG OVERFLOW FROM L LD A,L ; APPEND INTEGER TO BUFFER CALL APPBT RET ;******************************************************************* ;GROUP 1D - BC/DE/HL/SP/IX/IY,NN ;******************************************************************* GP1D6: LD A,B ; GET OPD BYTE 1 CP 17H ; MUST NOT BE AF REG PAIR JP Z,SYNERR ; JUMP IF IT IS, ERROR LD C,B ; GET OPD BYTE 1 IN C CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,00000001B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS CALL APPBT ; APPEND OP-CODE EX DE,HL ; GET INTEGER IN HL CALL APPWD ; APPEND INTEGER RET ;******************************************************************* ;GROUP 1D - BC/DE/HL/SP/IX/IY,(NN) ;******************************************************************* GP1D7: LD A,B ; GET OPD BYTE 1 LD C,B ; PUT IN C CP 17H ; MUST NOT BE AF JP Z,SYNERR ; JUMP IF IT IS, ERROR AND 11B ; TEST FOR HL/IX/IY CP 10B ; TREAT HL/IX/IY SEPARATELY JR Z,GP1D71 ; JUMP IF HL/IX/IY LD A,0EDH ; APPEND PREFIX BYTE CALL APPBT LD A,01001011B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS JR GP1D72 GP1D71: CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,2AH ; APPEND OP-CODE TO BUFFER GP1D72: CALL APPBT EX DE,HL ; GET INTEGER IN HL CALL APPWD ; APPEND INTEGER RET ;******************************************************************** ;GROUP 1D - (HL)/(IX+D)/(IY+D),R ;******************************************************************** GP1D8: CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,01110000B ; BUILD OP-CODE CALL ISREG ; COMBINE REG BITS CALL APPBT ; APPEND OP-CODE TO BUFFER CALL DISBT ; APPEND TO BUFFER IF REQD RET ;******************************************************************** ;GROUP 1D - I/R,A ;******************************************************************** GP1D9: LD A,C ; GET OPD BYTE 2 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD C,B ; PUT OPD BYTE 1 IN C LD A,0EDH ; APPEND PREFIX BYTE CALL APPBT LD A,01000111B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BIT CALL APPBT ; APPEND OP-CODE RET ;******************************************************************** ;GROUP 1D - (NN),A ;******************************************************************** GP1DA: LD A,C ; GET OPD BYTE 2 CP 77H ; MUST BE 'A' REG JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,32H ; APPEND OP-CODE TO BUFFER CALL APPBT CALL APPWD ; APPEND INTEGER RET ;******************************************************************** ;GROUP 1D = (NN),BC/DE/HL/SP/IX/IY ;******************************************************************** GP1DB: LD A,C ; GET OPD BYTE 2 LD B,C ; PUT IN B CP 17H ; MUST NOT BE AF JP Z,SYNERR ; JUMP IF IT IS, ERROR AND 11B ; TEST FOR HL/IX/IY CP 10B JR Z,GP1DB1 ; JUMP TO TREAT HL/IX/IY SEPARATELY LD A,0EDH ; APPEND PREFIX BYTE CALL APPBT LD A,01000011B ; BUILD OP-CODE CALL IREGP ; COMBINE REG PAIR BITS JR GP1DB2 GP1DB1: CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,22H ; PUT OP-CODE IN A GP1DB2: CALL APPBT ; APPEND OP-CODE CALL APPWD ; APPEND INTEGER RET ;********************************************************************** ;GROUP 1D - R,(HL)/(IX+D)/(IY+D) ;********************************************************************** GP1DC: LD A,B ; SWAP B AND C LD B,C LD C,A CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,01000110B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BITS CALL APPBT ; APPEND OP-CODE EX DE,HL ; GET INTEGER IN HL CALL DISBT ; APPEND DISP BYTE IF REQD RET ;********************************************************************** ;GROUP 1D - R,N ;********************************************************************** GP1DD: LD C,B ; PUT OPD BYTE 1 IN C LD A,00000110B ; BUILD OP-CODE CALL IDREG ; COMBINE REG BITS CALL APPBT ; APPEND OP-CODE TO BUFFER EX DE,HL ; GET INTEGER IN HL CALL CHKOF ; FLAG OVERFLOW FROM L LD A,L ; APPEND INTEGER TO BUFFER CALL APPBT RET ;********************************************************************** ;GROUP 1D - R,R ;********************************************************************** GP1DE: LD A,01000000B ; BUILD OP-CODE CALL ISREG ; COMBINE SOURCE REG BITS LD C,B CALL IDREG ; COMBINE DEST REG BITS CALL APPBT ; APPEND OP-CODE RET ;********************************************************************* ;GROUP 1D - SP,HL/IX/IY ;********************************************************************* GP1DF: LD A,B ; GET OPD BYTE 1 CP 13H ; MUST BE SP JP NZ,SYNERR ; JUMP IF NOT, ERROR LD A,C ; GET OPD BYTE 2 LD B,C ; PUT IN B AND 11B ; MUST BE HL/IX/IY CP 10B JP NZ,SYNERR ; JUMP IF NOT, ERROR CALL INDPF ; APPEND INDEX PREFIX IF REQD LD A,0F9H ; APPEND OP-CODE TO BUFFER CALL APPBT RET ;******************************************************************* ;GET OPERAND PAIR BYTE ;THE M.S. NIBBLE OF AN OPERAND TOKEN BYTE ;SIGNIFIES THE OPERAND GROUP (0-E). THIS ;SUBROUTINE BUILDS A BYTE WHOSE M.S. NIBBLE ;IS THE GROUP OF OPERAND 1 AND WHOSE L.S. ;NIBBLE IS THE GROUP OF OPERAND 2. ;THIS COMPOSITE BYTE IS CALLED THE OPERAND ;PAIR BYTE AND IS USED TO DETERMINE WHICH ;PROCESSING SUBROUTINE (GP...) TO USE TO ;GENERATE THE ASSEMBLED CODE. ; ;ON EXIT: ; A CONTAINS THE OPERAND BYTE PAIR ;******************************************************************* ODPBT: PUSH BC ; SAVE BC LD A,(ODBT1) ; GET 1ST OPERAND BYTE AND 0F0H ; MASK OPERAND GROUP NIBBLE LD B,A ; SAVE IN B LD A,(ODBT2) ; GET 2ND OPERAND BYTE AND 0F0H ; MASK OPERAND GROUP NIBBLE RRCA ; SHIFT INTO LOWER 4 BITS RRCA RRCA RRCA OR B ; CONSTRUCT COMPOSITE OPERAND ; GROUP BYTE IN A POP BC ; REPLACE BC RET ;****************************************************************** ;GENERATE INDEX REGISTER PREFIX BYTE ;ON ENTRY: ; B CONTAINS OPERAND TOKEN ;PREFIX IS APPENDED TO ASSD CODE BUFFER IF ;OPERAND IS IX OR IY. ;****************************************************************** INDPF: BIT 3,B ; IS OPERAND IX OR IY? RET Z ; NO PREFIX IF NOT, RETURN LD A,0DDH ; PUT PREFIX BYTE FOR IX IN A BIT 2,B ; IS OPERAND IY? JR Z,INDPF1 ; JUMP IF NOT LD A,0FDH ; PUT PREFIX BYTE FOR IY IN A INDPF1: CALL APPBT ; APPEND BYTE TO ASSD CODE BUFFER RET ;****************************************************************** ;GENERATE DISPLACEMENT BYTE ;USE NO. IN HL FOR DISPLACEMENT ;B CONTAINS OPERAND BYTE ;****************************************************************** DISBT: BIT 3,B ; IS OPERAND IX OR IY? RET Z ; IF NOT, NO DISP. BYTE REQD CALL CHKOF ; CHECK NO. IN HL FOR 8 BIT OVERFLOW LD A,L ; GET L.S. BYTE IN ACC. CALL APPBT ; AND APPEND TO ASSD CODE BUFFER RET ;****************************************************************** ;CHECK OVERFLOW FROM L ;VALUE ERROR INDICATED IF SO ;****************************************************************** CHKOF: PUSH BC ; SAVE BC LD A,H ; GET REG CONTAINING POSSIBLE OVERFLOW AND A ; IS IT ZERO? JR Z,CHKOF1 ; IF SO, NO OVERFLOW INC A ; WAS IT -1? (FF) JR Z,CHKOF1 ; IF SO, NO OVERFLOW LD C,'V' ; OTHERWISE INDICATE 'VALUE' ERROR CALL ERROR CHKOF1: POP BC ; REPLACE BC RET ;***************************************************************** ;INSERT SOURCE REG ;ON ENTRY: ; C CONTAINS OPERAND BYTE ; A CONTAINS CODE BYTE BEING BUILT ;ON EXIT: ; A HAS HAD THE REGISTER VALUE INSERTED ; TO BITD 0,1 & 2 ;***************************************************************** ISREG: PUSH BC ; SAVE REG LD B,A ; SAVE CODE BEING BUILT IN B LD A,C ; GET OPERAND BYTE FROM C AND 00000111B ; MASK REGISTER VALUE OR B ; COMBINE WITH CODE BEING BUILT POP BC ; REPLACE REG RET ;****************************************************************** ;INSERT DESTINATION REGISTER ;ON ENTRY: ; C CONTAINS OPERAND BYTE ; A CONTAINS CODE BYTE BEING BUILT ;ON EXIT: ; A HAS HAD THE REGISTER VALUE INSERTED ; TO BITS 3,4 & 5 ;****************************************************************** IDREG: PUSH BC ; SAVE BC LD B,A ; SAVE CODE BEING BUILT IN B LD A,C ; GET OPERAND BYTE FROM C AND 00000111B ; MASK REGISTER VALUE RLCA ; SHIFT TO DESTINATION REG POSITION RLCA RLCA OR B ; COMBINE WITH CODE BEING BUILT POP BC ; REPLACE BC RET ;****************************************************************** ;INSERT REGISTER PAIR ;ON ENTRY: ; C CONTAINS OPERAND BYTE ; A CONTAINS CODE BYTE BEING BUILT ;ON EXIT: ; A HAS HAD THE REGISTER PAIR VALUE ; INSERTED TO BITS 4 & 5. ;****************************************************************** IREGP: PUSH BC ; SAVE BC LD B,A ; SAVE CODE BEING BUILT IN B LD A,C ; GET OPERAND BYTE FROM C AND 00000011B ; MASK REGISTER PAIR VALUE RLCA ; SHIFT TO CORRECT REG PAIR POSITION RLCA RLCA RLCA OR B ; COMBINE WITH CODE BEING BUILT POP BC ; REPLACE BC RET ;******************************************************************* ;APPEND WORD TO ASSEMBLED CODE BUFFER ;******************************************************************* APPWD: LD A,L ; APPEND LOW BYTE CALL APPBT LD A,H ; APPEND HIGH BYTE CALL APPBT RET ;******************************************************************* ;APPEND BYTE TO ASSEMBLED CODE BUFFER ;******************************************************************* APPBT: PUSH HL ; SAVE REGISTERS PUSH DE EX AF,AF' ; SAVE NEW BYTE IN A' LD HL,ASSCOD ; SET POINTER TO ASSD CODE BUFF LD A,(ASCDNO) ; GET 'NO. BYTES ASSD CODE' LD E,A ; TO E LD D,0 ; CLEAR D ADD HL,DE ; ADD TO POINTER EX AF,AF' ; RECOVER NEW BYTE LD (HL),A ; AND PUT IN ASSD CODE BUFF INC E ; INCR CNTR LD A,E ; AND REPLACE LD (ASCDNO),A ; IN 'NO. BYTES ASSD CODE' POP DE ; REPLACE REGS POP HL RET ;******************************************************************* ;ADJUST ADDRESS REFERENCE COUNTER ;******************************************************************* ADJARC: PUSH HL ; SAVE REGS PUSH DE LD HL,(ADREFC) ; GET ADDR REF CNTR LD A,(ASCDNO) ; ADD TO THIS VALUE THE NO. LD E,A LD D,0 ; OF BYTES OF ASSD CODE ADD HL,DE ; AND PUT BACK INTO LD (ADREFC),HL ; ADDR REF CNTR POP DE ; REPLACE REGS POP HL RET ;****************************************************************** ;DEFAULT NOP'S ;****************************************************************** DNOPS: PUSH BC ; SAVE BC LD C,'S' ; INDICATE SYNTAX ERROR CALL ERROR LD A,4 ; RESERVE 4 BYTES NOP'S LD (ASCDNO),A POP BC ; REPLACE BC RET ;****************************************************************** ;PERFORM RELEVANT OUTPUT ;****************************************************************** PFRLO: LD A,(PASSNO) ; WHICH PASS? CP 1 RET Z ; NO OUTPUT ON PASS 1 CP 2 JR Z,PFRLO1 ; JUMP IF PASS 2 CP 3 JR Z,PFRLO2 ; JUMP IF PASS 3 LD A,(ERRBUF) CP SPACE RET Z CALL OLNBF ; OUTPUT LINE BUFFER TO LIST DEV. CALL LSTLN ; LIST RESULTS OF ASSEMBLY RET PFRLO1: CALL LSTLN ; LIST RESULTS OF ASSEMBLY LD A,(AFLAGS) ; TEST 'END' FLAG BIT 1,A RET Z ; LOOP IF NOT END CALL LSYMT ; LIST SYMBOL TABLE RET PFRLO2: CALL OBJO ; DO OBJECT FILE OUTPUT RET ;***************************************************************** ;OUTPUT CONTENTS OF LINE BUFFER TO LIST DEV. ;***************************************************************** OLNBF: PUSH HL ; SAVE REGS PUSH BC LD HL,LINBUF ; SET POINTER TO LINE BUFFER OLNBF1: LD C,(HL) ; GET A CHAR CALL LO ; OUTPUT TO LIST DEVICE LD A,C ; WAS IT CR? CP CR JR Z,OLNBF2 ; JUMP IF SO INC HL JR OLNBF1 OLNBF2: POP BC ; REPLACE REGS POP HL RET ;**************************************************************** ;LIST RESULT OF ASSEMBLY OF 1 LINE. ;**************************************************************** LSTLN: PUSH HL ; SAVE REGS PUSH DE PUSH BC PUSH IX LD A,(ERRBUF) ; PRINT CONTENTS OF ERROR BUFFER LD C,A CALL LO LD C,SPACE ; PRINT SPACE CALL LO LD HL,(ADDISR) ; GET CONT. OF ADDR DISP. REG LD A,(ASCDNO) ; GET NO. OF BYTES OF ASSD. CODE LD D,A ; INTO D LD IX,ASSCOD ; SET POINTER TO ASSD. CODE LSTLN3: LD E,4 ; MAX. NO. OF BYTES/LINE PUSH DE ; PRESERVE D CALL LISTAD ; PRINT ADDR REF. POP DE LD C,SPACE ; PRINT SPACE CALL LO LD A,D ; ANY BYTES TO PRINT AND A JR Z,LSTLN4 ; JUMP IF NOT LSTLN1: LD A,(IX) ; GET BYTE PUSH DE ; PRESERVE D CALL LISTBT ; PRINT 1 BYTE POP DE INC IX ; INCR POINTER TO NEXT BYTE INC HL ; INCR CORRES. ADDR. REF. DEC E DEC D ; DECR NO OF BYTES JR Z,LSTLN4 ; JUMP IF NONE LEFT LD A,E ; PRINTED 4 ON THIS LINE? AND A JR NZ,LSTLN1 ; JUMP IF NOT LSTLN2: CALL LFEED LD C,CR ; PRINT CR CR SP SP LD B,2 CALL OUTC LD C,SPACE LD B,2 CALL OUTC JR LSTLN3 LSTLN4: RLC E ; PRINT SPACES UP TO BEGINNING OF TEXT INC E LD B,E LD C,SPACE CALL OUTC ; OUTPUT CHAR N TIMES CALL LFEED ; PRINT LF OR NEW PAGE HEADER POP IX ; REPLACE REGS POP BC POP DE POP HL RET ;******************************************************************* ;OUTPUT CHAR N TIMES TO LIST DEVICE ;******************************************************************* OUTC: CALL LO ; COUNT IN B DJNZ OUTC RET ;******************************************************************* ;LIST BYTE ;CONVERTS BYTE IN ACC TO 2 ASCII ;HEXADECIMAL CHARACTERS AND OUTPUTS THEM ;TO LIST OR PUNCH DEVICE DEPENDING ON PASS. ;THE BYTE IS ALSO SUBTRACTED FROM D TO ;HELP COMPUTE CHECKSUMS. ;******************************************************************* LISTBT: PUSH BC ; SAVE REGS LD B,A ; SAVE BYTE IN B AND 0F0H ; GET M.S. NIBBLE RRCA RRCA RRCA RRCA CALL BINHX ; CONVERT TO ASCII HEXADECIMAL LD C,A ; OUTPUT TO RELEVANT DEVICE CALL XO LD A,B ; GET BYTE AGAIN AND 0FH ; GET L.S. NIBBLE CALL BINHX ; CONVERT TO ASCII HEX LD C,A ; OUTPUT TO RELEVANT DEVICE CALL XO LD A,D ; GET CUMULATIVE CHECKSUM SUB B ; SUBTRACT NEW BYTE LD D,A ; REPLACE CHECKSUM POP BC ; REPLACE REG RET ;................................................................. BINHX: CP 10D ; CONVERT VALUE IN A TO ASCII HEX JR NC,BINHX1 ADD A,'0' RET BINHX1: ADD A,'A'-10D RET ;********************************************************************** ;OUTPUT TO DEVICE RELEVANT TO PASS NO. ;********************************************************************** XO: LD A,(PASSNO) CP 3 JP Z,PCHO JP LO ;********************************************************************** ;LIST ADDRESS ;********************************************************************** LISTAD: LD A,H CALL LISTBT LD A,L CALL LISTBT RET ;********************************************************************** ;LINE FEED. ;********************************************************************** LFEED: PUSH BC ; SAVE REGS LD A,(LINE) ; TIME FOR A NEW PAGE? CP PLINES-9-1 JR NC,LFEED1 INC A ; INCREMENT LINE NO. LD (LINE),A LD C,LF ; PRINT LF CALL LO JR LFEED2 LFEED1: CALL HEADR ; PRINT PAGE HEADER LD C,SPACE LD B,16D CALL OUTC LFEED2: POP BC ; REPLACE REGS RET ;********************************************************************* ;PRINT PAGE HEADER ON LIST DEVICE ;********************************************************************* HEADR: PUSH HL ; SAVE REGS PUSH BC LD C,CR ; PRINT CR, 5 X LF CALL LO LD C,LF LD B,5 CALL OUTC LD HL,PHEAD ; POINTER TO PAGE HEADING CALL LSTST JR HEADR1 PHEAD: DEFM 'CROWE Z80 ASSEMBLER V1.1 PAGE ' DEFB 0 HEADR1: CALL PRNTP ; PRINT PAGE NO. CALL INCP ; INCREMENT PAGE NO. XOR A ; ZERO LINE NO. LD (LINE),A LD C,CR ; PRINT CR LF CALL LO LD C,LF CALL LO LD HL,TITBUF ; PRINT CONTENTS OF TITLE BUFFER CALL LSTST LD C,CR ; PRINT CR, 3 X LR, 16 X SP CALL LO LD C,LF LD B,3 CALL OUTC POP BC ; REPLACE REGS POP HL RET ;********************************************************************** ;LIST STRING ;********************************************************************** LSTST: PUSH BC ; SAVE REG LSTST1: LD A,(HL) ; GET A CHAR AND A ; TEST FOR TERMINATOR CHAR JR Z,LSTST2 LD C,A ; IF NOT, PRINT IT CALL LO INC HL ; INCREMENT POINTER JR LSTST1 ; LOOP LSTST2: POP BC ; REPLACE REGS RET ;********************************************************************** ;PRINT PAGE NO. ;********************************************************************** PRNTP: PUSH HL ; SAVE REGS PUSH DE LD DE,0 ; CLEAR DIGIT CNTR AND NON ZERO FLAG LD HL,PAGE+1 CALL PNT2DG DEC HL CALL PNT2DG POP DE ; REPLACE REGS POP HL RET ;.................................................................... ;PRINT 2 DIGITS ;.................................................................... PNT2DG: RLD ; ROTATE NIBBLES CALL PNTDG ; PRINT A DIGIT RLD ; ROTATE NIBBLES CALL PNTDG ; PRINT A DIGIT RLD ; ROTATE NIBBLES RET ;................................................................... ;PRINT A DIGIT ;................................................................... PNTDG: PUSH BC ; SAVE REG LD B,A ; INCR DIGIT COUNT INC E AND 0FH JR NZ,PNTDG1 ; IS IT 0? BIT 0,D ; LEADING ZERO? JR NZ,PNTDG2 JR PNTDG3 PNTDG1: SET 0,D ; NON ZERO, SET FLAG PNTDG2: OR 30H ; CONVERT TO ASCII LD C,A ; PRINT IT CALL LO PNTDG3: LD A,B POP BC ; REPLACE REG RET ;******************************************************************* ;INCREMENT PAGE NO. ;******************************************************************* INCP: PUSH HL ; SAVE REG LD HL,(PAGE) ; GET PAGE NO (4 DIG BCD) LD A,L ; INCREMENT L.S. BYTE ADD A,1 DAA ; DECIMAL ADJUST LD L,A LD A,H ; CARRY TO M.S. BYTE ADC A,0 DAA ; DECIMAL ADJUST LD H,A LD (PAGE),HL ; REPLACE PAGE NO. POP HL ; REPLACE REG RET ;******************************************************************* ;LIST SYMBOL TABLE ;******************************************************************* LSYMT: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD C,CR ; OUTPUT CR CALL LO LD A,(LINE) ; GET LINE NO. LSYMT1: CP PLINES-9-1 ; BOTTOM OF PAGE? JR NC,LSYMT3 ; JUMP IF SO INC A ; ELSE INCR LINE NO. LD B,A ; SAVE IN B LD C,LF ; OUTPUT LF CALL LO LD A,B ; GET LINE NO. IN A JR LSYMT1 ; LOOP LSYMT3: CALL HEADR ; PRINT PAGE HEADER LD HL,SYMTAB ; POINT AT SYMBOL TABLE LSYMT4: LD D,SPERL ; LOAD NO OF SYMBOLS PER LINE LSYMT5: LD A,(HL) ; GET CHAR COUNT AND A ; IS IT ZERO? JR Z,LSYM10 ; JUMP IF SO, END OF TABLE LD B,A ; PUT COUNT IN B LD E,7 ; SPACES COUNT IN E INC HL ; INCR PNTR ; PRINT SYMBOL LSYMT6: LD C,(HL) ; GET CHAR IN C CALL LO ; OUTPUT TO LIST DEVICE INC HL ; INCR PNTR DEC E ; DECR SPACE CNTR DEC B ; DECR CHAR CNTR JR NZ,LSYMT6 ; LOOP IF NOT FINISHED LD B,E ; GET SPACES COUNT LD C,SPACE ; AND OUTPUT THAT NO. CALL OUTC ; OF SPACES INC HL ; INCR PNTR TO VALUE LD A,(HL) ; GET M.S. BYTE PUSH DE ; SAVE DE CALL LISTBT ; OUTPUT IN HEX DEC HL ; POINT AT L.S. BYTE LD A,(HL) ; GET IT CALL LISTBT ; OUTPUT IN HEX POP DE ; REPLACE DE INC HL ; POINT TO ATTRIBUTE BYTE INC HL LD C,SPACE ; OUTPUT A SPACE CALL LO LD C,SPACE ; SET UP A FURTHER SPACE BIT 1,(HL) ; M FLAG SET? INC HL ; (INCR POINTER) JR Z,LSYMT7 ; JUMP IF NOT LD C,'M' ; CHANGE SPACE TO 'M' LSYMT7: CALL LO ; OUTPUT CHAR DEC D ; DECR SYM/LINE CNT JR Z,LSYMT8 ; JUMP IF DONE LD C,SPACE ; ELSE OUTPUT 2 SPACES LD B,2 CALL OUTC JR LSYMT5 ; AND LOOP LSYMT8: LD A,(LINE) ; GET LINE NO. CP PLINES-9-1 ; BOTTOM OF PAGE? JR NC,LSYMT9 ; JUMP IF SO INC A ; ELSE INCR LINE NO. LD (LINE),A LD C,CR ; LIST CR/LF CALL LO LD C,LF CALL LO JR LSYMT4 ; AND LOOP LSYMT9: CALL HEADR ; PRINT PAGE HEADER JR LSYMT4 ; AND LOOP LSYM10: POP BC ; REPLACE REGS POP DE POP HL RET ;*************************************************************** ;OBJECT OUTPUT. ;PERFORM OUTPUT OF OBJECT CODE USING THE INTEL ;HEXADECIMAL OBJECT FORMAT WITH RECORD LENGTH ;OF 'RECSIZ' ;*************************************************************** OBJO: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD HL,AFLAGS ; END FLAG SET? BIT 1,(HL) JR Z,OBJO2 ; JUMP IF NOT CALL ODREC ; PUNCH DATA RECORD CALL OEREC ; PUNCH EOF RECORD CALL RUNOUT ; PUCH TAPE RUNOUT JR OBJO7 OBJO2: BIT 0,(HL) ; ADDR DISCONTINUITY FLAG SET? JR Z,OBJO3 ; JUMP IF NOT CALL ODREC ; PUNCH DATA RECORD JR OBJO7 OBJO3: LD C,0 ; CLEAR PNTR TO ASSD CODE BUFFER LD A,(ASCDNO) ; ANY BYTES OF ASSD CODE? LD B,A ; SAVE NO. IN B AND A ; ZERO? OBJO4: JR Z,OBJO7 ; JUMP IF ZERO LD HL,(ADDISR) ; GET ADDR DISP REG IN HL LD A,(OBJCNT) ; ANY BYTES IN OBJECT BUFFER? AND A JR NZ,OBJO5 ; JUMP IF SO LD (RECADR),HL ; ELSE COPY ADDR DISP REG ; INTO RECORD ADDR OBJO5: INC HL ; INCR ADDR DISP REG LD (ADDISR),HL ; TRANSFR BYTE FROM ASSD CODE BUFF ; TO OBJECT BUFFER LD HL,ASSCOD ; POINT AT ASSD CODE BUFF LD E,C ; PUT ASSD CODE BUFF CNTR IN DE LD D,0 ADD HL,DE ; COMPUTE PNTR TO BYTE FOR TRANSFER LD A,(HL) ; GET BYTE EX AF,AF' ; SAVE IN A' LD HL,OBJBUF ; POINT AT OBJECT BUFF LD A,(OBJCNT) ; PUT OBJ BUFF CNTR IN DE LD E,A ADD HL,DE ; COMPUTE PNTR TO INSERT POSITION EX AF,AF' ; GET BACK BYTE LD (HL),A ; AND APPEND TO OBJECT BUFFER LD A,E ; GET OBJ COUNT INC A ; INCREMENT IT LD (OBJCNT),A ; REPLACE COUNT IN OBJCNT CP RECSIZ ; ENOUGH BYTES FOR A RECORD JR NZ,OBJO6 ; JUMP IF NOT CALL ODREC ; ELSE OUTPUT DATA RECORD OBJO6: INC C ; INCREMENT ASD CODE BUFF CNTR DEC B ; DECR NO OF BYTES JR OBJO4 ; AND LOOP OBJO7: POP BC ; REPLACE REGS POP DE POP HL RET ;*********************************************************************** ;OUTPUT DATA RECORD ;OUTPUTS DATA RECORD USING INTEL'S HEXADECIMAL ;OBJECT CODE FORMAT ;*********************************************************************** ODREC: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD A,(OBJCNT) ; GET NO OF BYTES IN OBJ BUFF AND A ; IS IT ZERO? JR Z,ODREC2 ; JUMP IF SO LD B,A ; PUT COUNT IN B LD C,':' ; OUTPUT RECORD MARK CALL PCHO ; TO PUNCH DEVICE LD D,0 ; CLEAR CHECKSUM REG D LD A,B ; OUTPUT BYTE COUNT CALL LISTBT LD HL,(RECADR) ; OUTPUT RECORD ADDR CALL LISTAD XOR A ; OUTPUT RECORD TYPE (0) CALL LISTBT LD HL,OBJBUF ; SET PNTR TO OBJECT BUFFER ODREC1: LD A,(HL) ; OUTPUT DATA BYTE CALL LISTBT INC HL ; INCR PNTR DEC B ; DECR COUNT JR NZ,ODREC1 ; LOOP IF NOT ZERO LD A,D ; OUTPUT CHECKSUM CALL LISTBT LD C,CR ; OUTPUT CR CALL PCHO LD C,LF ; OUTPUT LF CALL PCHO XOR A ; SET NO. OF BYTES IN OBJBUF=0 LD (OBJCNT),A ODREC2: POP BC ; REPLACE REGS POP DE POP HL RET ;******************************************************************** ;OUTPUT END OF FILE RECORD ;OUTPUTS END OF FILE RECORD TO PUNCH DEVICE ;USING INTEL'S HEXADECIMAL OBJECT FORMAT ;******************************************************************** OEREC: PUSH HL ; SAVE REGS PUSH DE PUSH BC LD C,':' ; OUTPUT RECORD MARK CALL PCHO XOR A ; CLEAR A AND CHECKSUM (IN D) LD D,A CALL LISTBT ; OUTPUT ZERO BYTE COUNT LD HL,(STADDR) ; GET START ADDR CALL LISTAD ; AND OUTPUT IT LD A,1 ; OUTPUT RECORD TYPE (1) CALL LISTBT LD A,D ; OUTPUT CHECKSUM CALL LISTBT LD C,CR ; OUTPUT CR CALL PCHO LD C,LF ; OUTPUT LF CALL PCHO POP BC ; REPLACE REGS POP DE POP HL RET ;******************************************************************* ;RUNOUT ;OUTPUTS 30 CM OF BLANK TAPE FOR PUNCHED TAPE ;LEADER AND TRAILER. ;IF NOT REQUIRED PUT 'RET' IN FIRST LOCATION ;OF SUBROUTINE. ;******************************************************************* RUNOUT: RET;PUSH BC ; SAVE REG LD B,120 ; PUT COUNT IN B LD C,NUL ; PUT NULL CHAR IN C RUN1: CALL PCHO ; OUTPUT CHAR TO PUNCH DJNZ RUN1 ; LOOP UNTIL DONE POP BC ; REPLACE REG RET ;******************************************************************* ;GET SYMBOL ;ON ENTRY: ; HL POINTS AT 1ST CHAR OF SYMBOL ; DE POINTS AT BUFFER ;ON EXIT: ; HL POINTS AT CHAR AFTER SYMBOL ; BUFFER CONTAINS SYMBOL ;******************************************************************* GSYM: PUSH IX ; SAVE REGISTERS PUSH BC LD B,0 ; CLEAR CHAR COUNT PUSH DE ; SAVE START OF BUFFER POINTER POP IX INC DE ; LEAVE SPACE IN BUFF FOR CHAR COUNT GSYM1: LD (DE),A ; PUT CHAR IN BUFFER INC DE ; INCREMENT POINTERS INC HL INC B ; AND COUNTER LD A,B ; IS THAT 6 CHARS? CP 6 JR Z,GSYM2 LD A,(HL) ; FETCH NEXT CHAR CALL VALID ; IS IT VALID IN A SYMBOL? JR C,GSYM1 ; JUMP IF SO GSYM3: LD (IX),B ; NO, END OF SYMBOL POP BC ; REPLACE SAVED REGISTERS POP IX RET GSYM2: LD A,(HL) ; SCAN TO FIRST NON VALID CHAR CALL VALID JR NC,GSYM3 INC HL JR GSYM2 ;********************************************************************** ;VALID LABEL CHAR? ;ON ENTRY: ; A CONTAINS CHARACTER ;ON EXIT: ; A CONTANS CHARACTER ; CARRY FLAG IS SET IF VALID. ;************************************************************************ VALID: CP 'A' JR C,VALID1 CP 'Z'+1 RET C ; VALID VALID1: CP '0' JR C,VALID2 CP '9'+1 RET C ; VALID VALID2: CP '?' JR Z,VALID3 CP '-' JR Z,VALID3 SCF ; NOT VALID, CLEAR CARRY FLAG. CCF RET VALID3: SCF ; VALID, SET CARRY FLAG RET ;********************************************************************* ;GET TOKEN(S) FROM LIST ;ON ENTRY: ; SYMBUF CONTAINS SYMBOL ; HL CONTAINS POINTER TO LIST POINTER TABLE ; DE POINTS AT DESTINATION FOR TOKENS ; C CONTAINS NO. OF TOKEN BYTES PER LIST ENTRY. ;ON EXIT: ; TOKEN(S) ARE IN DESTINATION. ; LAST ONE IS ALSO IN A ; ZERO FLAG SET IF NOT IN LIST. ;********************************************************************** OPTOK: PUSH DE ; SAVE PTR TO DEST FOR TOKENS. LD A,(SYMBUF) ; GET NO. OF BYTES IN STRING LD B,A PUSH BC ; SAVE TOKEN BYTE COUNT (C) ; AND STRING CHAR COUNT (B) SUB 1 ; (BYTES IN STRING - 1) RLCA ; *2 LD E,A LD D,0 ADD HL,DE ; POINTER TO CORRECT WORD OF PNTR TABL LD A,(HL) INC HL LD H,(HL) LD L,A ; HL POINTS TO CORRECT SECTION OF LIST OPTOK3: LD DE,SYMBUF+1 POP BC PUSH BC ; B CONTAINS NO. OF CHARS IN STRING LD A,(HL) ; GET FIRST CHAR OF LIST ENTRY OR A ; IS IT 0? JR Z,OPTOK4 ; YES, END OF LIST OPTOK1: EX DE,HL ; NO, COMPARE A CHAR CP (HL) EX DE,HL INC HL ; INCR POINTERS INC DE JR NZ,OPTOK2 ; CHARS NOT EQU, GO TO NEXT ENTRY DEC B ; CHARS EQU, DECR COUNT LD A,(HL) ; GET A CHAR JR NZ,OPTOK1 ; MORE CHARS TO COMPARE POP BC ; NO MORE CHARS TO COMPARE POP DE ; MATCH FOUND, GET POINTER AND ; COUNT FOR TOKEN BUFFER. OPTOK5: LD A,(HL) LD (DE),A ; TRANSFER A BYTE INC HL INC DE DEC C JR NZ,OPTOK5 INC C ; CLEAR ZERO FLAG RET ; AND RETURN OPTOK4: POP BC ; ADJUST STACK POP DE RET ; AND RETURN OPTOK2: LD A,B ; ADD REMAINING COUNT+ ; (NO OF TOKENS)-1 TO LIST PNTR POP BC PUSH BC ADD A,C DEC A LD E,A LD D,0 ADD HL,DE ; HL POINTING TO NEXT LIST ENTRY JR OPTOK3 ; GO CHECK NEXT ENTRY ;************************************************************************* ;LOCATE A GIVEN SYMBOL IN THE SYMBOL TABLE, ;OR THE CORRECT ALPHABETIC LOCATION FOR IT. ;ON ENTRY: ; SEARCHED SYMBOL IS IN SYMBOL BUFFER. ;ON EXIT: ; DE CONTAINS PNTR TO START OF ENTRY ; OR ALPHABETIC INSERTION POSITION. ; HL POINTS AT VALUE IF PRESENT ; ZERO FLAG SET IF FOUND IN TABLE. ;************************************************************************* LOCATE: PUSH BC ; SAVE REGISTERS PUSH IX LD HL,SYMTAB ; SET POINTER TO SYMBOL TABLE LOC1: PUSH HL ; SAVE POINTER TO START OF ENTRY POP DE ; IN DE LD C,(HL) ; SAVE NO OF CHARS IN SYM IN C INC C ; TEST C FOR ZERO DEC C JR Z,LOC3 ; IF ZERO THEN END OF TABLE LD IX,SYMBUF ; SET POINTER TO SYMBOL BUFFER LD B,(IX) ; SAVE NO OF CHARS IN SEARCHED SYM INC HL ; MOVE BOTH POINTERS TO 1ST INC IX ; CHARS OF SYMBOLS LOC2: LD A,(IX) ; COMPARE A CHAR CP (HL) JR C,LOC3 ; TOO FAR JR NZ,LOC5 ; NOT FAR ENOUGH ; CHARS EQUAL SO FAR INC HL ; MOVE BOTH POINTERS ON 1 INC IX DEC C ; DECR TABL SYM CHAR COUNT JR Z,LOC6 DEC B ; DECR SEARCHED SYM CHAR COUNT JR Z,LOC3 ; TOO FAR JR LOC2 ; EQUAL SO FAR LOC6: DEC B JR Z,LOC4 ; MATCH FOUND, RETURN WITH ZERO ; FLAG SET, DE POINTING AT ; ENTRY, & HL AT VALUE LOC5: LD A,3 ; SET POINTER TO NEXT ENTRY ; (ADD COUNTER+3 TO TABLE POINTER) ADD A,C LD C,A LD B,0 ADD HL,BC JR LOC1 LOC3: INC C ; TOO FAR, RESET ZERO FLAG LOC4: POP IX ; REPLACE REGS & RETURN POP BC ; WITH ZERO FLAG=0 RET ; DE CONTAINS START OF ENTRY ;*********************************************************************** ;TRANSFER LABEL (AND VALUE) TO SYMBOL BUFFER ;ON ENTRY: HL CONTAINS VALUE OF LABEL ;ON EXIT: HL CONTAINS POINTER TO ATTRIBUTE BYTE ; IN SYMBOL BUFFER ;*********************************************************************** LBSYM: PUSH BC ; SAVE REGS PUSH DE LD A,(LABBUF) ; HOW MANY CHARS IN LABEL? AND A ; IS IT ZERO? JR Z,LBSYM1 ; JUMP IF SO, NO LABEL INC A ; ADD 1 TO NUMBER LD C,A ; AND PUT IT IN BC LD B,0 PUSH HL ; SAVE VALUE OF LABEL LD HL,LABBUF ; SET SOURCE PNTR = LABEL BUFFER LD DE,SYMBUF ; SET DEST PNTR = SYMBOL BUFFER LDIR ; TRANSFER LABEL TO SYMBOL BUFFER EX DE,HL ; PUT SYMBOL BUFF PNTR IN HL POP DE ; GET VALUE IN DE LD (HL),E ; AND PUT IN SYMBUF INC HL LD (HL),D INC HL LD (HL),0 ; CLEAR ATTRIBUTES BYTE XOR A ; CLEAR ZERO FLAG INC A LBSYM1: POP DE ; REPLACE REGS POP BC RET ;*********************************************************************** ;CHECK SYMBOL IS NOT RESERVED WORD ;ON ENTRY SYMBOL IS IN SYMBUF ;CARRY FLAG SET IF RESERVED WORD. ;*********************************************************************** SYMCH: PUSH HL ; SAVE REGISTERS PUSH DE PUSH BC ; CHECK IF SYMB = RESERVED WORD LD A,(SYMBUF) ; GET NO OF CHARS IN SYMB CP 6 ; MORE THAN 5 ? JR NC,SYMCH3 ; IF SO NOT RESERVED WORD LD DE,TEMP ; CHECK IF IN OPERATOR LIST LD HL,ORLSTP ; PNTR TO OPR LIST PNTR TABLE LD C,2 ; 2 TOKENS/ENTRY IN LIST CALL OPTOK ; IN LIST? JR NZ,SYMCH1 ; JUMP IF SO LD A,(SYMBUF) ; GET NO OF CHARS IN SYMB CP 4 ; MORE THAT 3? JR NC,SYMCH3 ; IF SO NOT RESERVED WORD LD DE,TEMP ; CHECK IF IN OPND KW LIST LD HL,OPKLST ; PNTR TO LIST PNTR TABLE LD C,1 ; 1 TOKEN/ENTRY IN LIST CALL OPTOK ; IN LIST? JR Z,SYMCH2 ; JUMP IF NOT ; RESERVED WORD USED SYMCH1: LD C,'W' ; INDICATE ERROR CALL ERROR SCF ; SET CARRY FLAG JR SYMCH3 SYMCH2: AND A ; NOT RESERVED WORD, CLEAR CARRY SYMCH3: POP BC ; REPLACE REGISTERS POP DE POP HL RET ;********************************************************************** ;INSERT SYMBOL INTO SYMBOL TABLE ;ON ENTRY DE POINTS AT INSERTION POSITION ;SYMBOL IS IN SYMBOL BUFFER (SYMBUF) ;********************************************************************** INSERT: EXX ; SAVE REGS PUSH HL PUSH DE PUSH BC EXX PUSH HL PUSH BC PUSH DE LD HL,(MEMTOP) ; GET POINTER TO TOP OF LD DE,-10 ; AVAILABLE RAM (WITH ROOM FOR ANOTHER ADD HL,DE ; ENTRY) LD DE,(SYMEND) ; GET PNTR TO END OF SYMBOL TABLE AND A ; CLEAR CARRY SBC HL,DE ; IS TABLE FULL? JR NC,INSRT1 ; JUMP IF NOT LD HL,AFLAGS ; SET SYM TAB OVERFLOW FLAG SET 2,(HL) POP DE ; ADJUST STACK JR INSRT2 INSRT1: POP DE ; LEAVE PNTR TO INSERT POS IN DE' PUSH DE EXX POP DE ; GET PNTR TO INSERT POS ; OPEN UP A GAP IN TABLE USING ; BLOCK MOVE. DE WILL CONTAIN DEST. ; HL THE SOURCE AND BC THE NO. ; OF BYTES AND A ; CLEAR CARRY LD HL,(SYMEND) ; FIND NO OF BYTES BETWEEN INSERTION SBC HL,DE ; POSITION AND END OF SYMBOL INC HL ; TABLE PUSH HL ; SAVE NO OF BYTES ON STACK LD HL,(SYMEND) LD D,H LD E,L LD A,(SYMBUF) ; CALCULATE NO OF BYTES FOR INSERTION ADD A,4 LD C,A ; PUT IN BC LD B,0 PUSH BC ; SAVE IN BC' EXX POP BC EXX ADD HL,BC LD (SYMEND),HL ; SAVE NEW END OF SYMBOL TABLE EX DE,HL POP BC ; NO OF BYTES LDDR ; MOVE BLOCK TO OPEN GAP ; INSERT NEW SYMBOL RECORD ; INTO GAP EXX LD HL,SYMBUF LDIR INSRT2: POP BC ; REPLACE REGS POP HL EXX POP BC POP DE POP HL EXX RET ;********************************************************************* ;SCAN TO NEXT NON SPACE CHAR ;ON ENTRY: ; HL CONTAINS POINTER ;ON EXIT: ; HL POINTS AT FIRST NON-SPACE CHAR ;********************************************************************* SCNSP: LD A,(HL) ; GET A CHAR CP SPACE ; IS IT A SPACE? RET NZ ; IF NOT RETURN INC HL ; INCREMENT POINTER JR SCNSP ;********************************************************************* ;CHECK IF ASCII CHAR IN ACC ;IS A LETTER. SET CARRY FLAG IF SO. ;********************************************************************* ALPHA: CP 'A' JR C,ALPHA1 CP 'Z'+1 RET ALPHA1: OR A ; NOT LETTER, CLEAR CARRY RET ;********************************************************************* ;CHECK IF DIGIT (0-9) IN ACC. ;IF SO, RETURN WITH CARRY SET. ;********************************************************************* DIGIT: CP '0' JR C,DIGIT1 CP '9'+1 RET DIGIT1: OR A ; NOT DIGIT, CLEAR CARRY RET ;******************************************************************** ;ERROR ROUTINE. SET ERROR CHAR IF NOT ;ALREADY SET. ;ON ENTRY: ; C CONTAINS ASCII ERROR CHAR ;ON EXIT: ; ERRBUF CONTAINS ERROR CHAR ;******************************************************************* ERROR: LD A,(ERRBUF) ; GET CONTENT OF ERROR DISPLAY REG. CP SPACE ; IS IT A SPACE? RET NZ LD A,C ; YES, REPLACE WITH ERROR INDICATOR LD (ERRBUF),A RET ;******************************************************************* ;OPERATOR LIST ;EACH SECTION OF LIST CONTAINS OPERATOR ;STRING FOLLOWED BY OPERATOR GROUP TOKEN ;(1-1D) FOLLOWED BY OPERATOR VALUE. ;******************************************************************* ORLSTP: DEFW OR1 ; POINTER LIST TO THE SECTIONS DEFW OR2 ; OF THE OPERATOR LIST WITH DEFW OR3 ; DIFFERENT NOS. OF CHARS DEFW OR4 DEFW OR5 OR1: DEFB 0 ; OPERATOR LIST ITSELF OR2: DEFM 'LD' DEFB 1DH DEFB 00H DEFM 'JP' DEFB 91H DEFB 00H DEFM 'CP' DEFB 0CH DEFB 38H DEFM 'IN' DEFB 17H DEFB 00H DEFM 'OR' DEFB 0CH DEFB 30H DEFM 'DI' DEFB 0AH DEFB 0F3H DEFM 'EI' DEFB 0AH DEFB 0FBH DEFM 'IM' DEFB 0EH DEFB 00H DEFM 'RL' DEFB 0FH DEFB 10H DEFM 'RR' DEFB 0FH DEFB 18H DEFM 'JR' DEFB 92H DEFB 00H DEFM 'EX' DEFB 1AH DEFB 00H DEFB 00H OR3: DEFM 'INC' DEFB 0DH DEFB 00H DEFM 'DEC' DEFB 0DH DEFB 09H DEFM 'OUT' DEFB 18H DEFB 00H DEFM 'AND' DEFB 0CH DEFB 20H DEFM 'ORG' DEFB 01H DEFB 00H DEFM 'EQU' DEFB 02H DEFB 00H DEFM 'END' DEFB 04H DEFB 00H DEFM 'EXX' DEFB 0AH DEFB 0D9H DEFM 'DAA' DEFB 0AH DEFB 27H DEFM 'CPL' DEFB 0AH DEFB 2FH DEFM 'CCF' DEFB 0AH DEFB 3FH DEFM 'SCF' DEFB 0AH DEFB 37H DEFM 'NOP' DEFB 0AH DEFB 00H DEFM 'RLA' DEFB 0AH DEFB 17H DEFM 'RRA' DEFB 0AH DEFB 1FH DEFM 'LDI' DEFB 0BH DEFB 0A0H DEFM 'LDD' DEFB 0BH DEFB 0A8H DEFM 'CPI' DEFB 0BH DEFB 0A1H DEFM 'CPD' DEFB 0BH DEFB 0A9H DEFM 'NEG' DEFB 0BH DEFB 44H DEFM 'RLD' DEFB 0BH DEFB 6FH DEFM 'RRD' DEFB 0BH DEFB 67H DEFM 'INI' DEFB 0BH DEFB 0A2H DEFM 'IND' DEFB 0BH DEFB 0AAH DEFM 'XOR' DEFB 0CH DEFB 28H DEFM 'RLC' DEFB 0FH DEFB 00H DEFM 'SLA' DEFB 0FH DEFB 20H DEFM 'RRC' DEFB 0FH DEFB 08H DEFM 'SRA' DEFB 0FH DEFB 28H DEFM 'SRL' DEFB 0FH DEFB 38H DEFM 'BIT' DEFB 10H DEFB 40H DEFM 'SET' DEFB 10H DEFB 0C0H DEFM 'RES' DEFB 10H DEFB 80H DEFM 'RET' DEFB 95H DEFB 00H DEFM 'RST' DEFB 16H DEFB 00H DEFM 'POP' DEFB 19H DEFB 0C1H DEFM 'ADC' DEFB 1BH DEFB 08H DEFM 'SBC' DEFB 1BH DEFB 10H DEFM 'ADD' DEFB 1CH DEFB 00H DEFM 'SUB' DEFB 0CH DEFB 10H DEFB 00H OR4: DEFM 'CALL' DEFB 94H DEFB 00H DEFM 'DEFL' DEFB 03H DEFB 00H DEFM 'DEFB' DEFB 05H DEFB 00H DEFM 'DEFW' DEFB 06H DEFB 00H DEFM 'DEFS' DEFB 07H DEFB 00H DEFM 'DEFM' DEFB 08H DEFB 00H DEFM 'HALT' DEFB 0AH DEFB 76H DEFM 'RLCA' DEFB 0AH DEFB 07H DEFM 'RRCA' DEFB 0AH DEFB 0FH DEFM 'LDIR' DEFB 0BH DEFB 0B0H DEFM 'LDDR' DEFB 0BH DEFB 0B8H DEFM 'CPIR' DEFB 0BH DEFB 0B1H DEFM 'CPDR' DEFB 0BH DEFB 0B9H DEFM 'RETI' DEFB 0BH DEFB 4DH DEFM 'RETN' DEFB 0BH DEFB 45H DEFM 'INIR' DEFB 0BH DEFB 0B2H DEFM 'INDR' DEFB 0BH DEFB 0BAH DEFM 'OUTI' DEFB 0BH DEFB 0A3H DEFM 'OTIR' DEFB 0BH DEFB 0B3H DEFM 'OUTD' DEFB 0BH DEFB 0ABH DEFM 'OTDR' DEFB 0BH DEFB 8BH DEFM 'DJNZ' DEFB 13H DEFB 00H DEFM 'PUSH' DEFB 19H DEFB 0C5H DEFB 00H OR5: DEFM 'TITLE' DEFB 09H DEFB 00H DEFB 00H ;********************************************************************** ;OPERAND KEYWORD LIST ;CONTAINS OPERAND KEYWORDS FOLLOWED BY ;TOKENS FOR THEM. ;********************************************************************** OPKLST: DEFW OPKW1 ; POINTER LIST TO DIFFERENT DEFW OPKW2 ; SECTIONS OF OPERAND DEFW OPKW3 ; KEYWORD LIST. OPKW1: DEFB 'A' DEFB 77H DEFB 'B' DEFB 70H DEFB 'C' DEFB 71H DEFB 'D' DEFB 72H DEFB 'E' DEFB 73H DEFB 'H' DEFB 74H DEFB 'L' DEFB 75H DEFB 'Z' DEFB 89H DEFB 'P' DEFB 8EH DEFB 'M' DEFB 8FH DEFB 'I' DEFB 20H DEFB 'R' DEFB 21H DEFB 00H OPKW2: DEFM 'AF' DEFB 17H DEFM 'BC' DEFB 10H DEFM 'DE' DEFB 11H DEFM 'HL' DEFB 12H DEFM 'SP' DEFB 13H DEFM 'IX' DEFB 1AH DEFM 'IY' DEFB 1EH DEFM 'NC' DEFB 8AH DEFM 'NZ' DEFB 88H DEFM 'PE' DEFB 8DH DEFM 'PO' DEFB 8CH DEFB 00H OPKW3: DEFM 'AF''' DEFB 0E0H DEFB 00H ;********************************************************************* ;BRACKETABLE OPERAND LIST. ;********************************************************************* BKLST: DEFB 12H ; HL DEFB 40H ; (HL) DEFB 1AH ; IX DEFB 48H ; (IX) DEFB 1EH ; IY DEFB 4CH ; (IY) DEFB 13H ; SP DEFB 50H ; (SP) DEFB 11H ; DE DEFB 61H ; (DE) DEFB 10H ; BC DEFB 60H ; (BC) DEFB 71H ; C DEFB 0A0H ; (C) DEFB 0CAH ; IX+D DEFB 0BAH ; (IX+D) DEFB 0CEH ; IY+D DEFB 0BEH ; (IY+D) DEFB 90H ; N DEFB 0D0H ; (N) DEFB 00H ; END OF LIST ;********************************************************************* ;MULTI-CHARACTER FUNCTION LIST. ;********************************************************************* MFLSTP: DEFW MCF1 DEFW MCF2 DEFW MCF3 DEFW MCF4 MCF1: DEFB 0 MCF2: DEFM 'OR' DEFB 7AH DEFM 'EQ' DEFB 89H DEFM 'GT' DEFB 91H DEFM 'LT' DEFB 99H DEFB 0 MCF3: DEFM 'NOT' DEFB 17H DEFM 'LOW' DEFB 27H DEFM 'RES' DEFB 2EH DEFM 'MOD' DEFB 4DH DEFM 'SHR' DEFB 55H DEFM 'SHL' DEFB 5DH DEFM 'AND' DEFB 73H DEFM 'XOR' DEFB 82H DEFM 'UGT' DEFB 0A1H DEFM 'ULT' DEFB 0A9H DEFB 0 MCF4: DEFM 'HIGH' DEFB 1FH DEFB 0 ;*********************************************************************** ;SINGLE CHAR FUNCTION LIST. ;*********************************************************************** SFLSTP: DEFW SCF1 ; POINTER TO LIST SCF1: DEFM '+' DEFB 7H DEFM '-' DEFB 0FH DEFM '\' DEFB 17H DEFM '*' DEFB 3DH DEFM '/' DEFB 45H DEFM '&' DEFB 73H DEFM '^' DEFB 7AH DEFM '=' DEFB 89H DEFM '>' DEFB 91H DEFM '<' DEFB 99H DEFB 0 ; ;****************************************************************** ; LINKAGES TO CP/M START HERE - J.P.J. 4/5/82 ;****************************************************************** ; ; SRCFCB: DEFB 0 ;FCB STARTS WITH 0 FOR DEFAULT DRIVE SRCFN: DEFM ' ' ;RESERVE 8 CHARS FOR FILE NAME DEFM 'Z80' ;USE EXTENSION OF Z80 DEFB 0 ;START WITH EXTENT 0 DEFS 23 ;23 BYTES FOR CP/M SRCPTR: DEFS 2 ;FOR CHARACTER POINTER SRCOPN: DEFM 'C' ;DECLARE CLOSED ; LSTFCB: DEFB 0 ;LISTING FILE SETUP LSTFN: DEFM ' ' DEFM 'PRN' ;PRINT FILE DEFB 0 ;EXTENT 0 DEFS 23 LSTPTR: DEFS 2 LSTOPN: DEFM 'C' ; HEXFCB: DEFB 0 ;SAME FOR HEX FILE HEXFN: DEFM ' ' DEFM 'HEX' DEFB 0 DEFS 23 HEXPTR: DEFS 2 HEXOPN: DEFM 'C' ; MEMCK: LD A, (7H) ;GET HIGH ORDER BYTE OF BDOS ENTRY LD B,A ;XFER TO B LD A, (6H) ;LOW BYTE TO A RET ; CONOUT: PUSH BC ;NO REGISTERS MAY BE DESTROYED PUSH DE PUSH HL OUT4: LD A,C CALL PUTCON ; GENRET: POP HL ;GENERAL RETURN FOR ALL SUBR'S POP DE POP BC RET ; ; OPNOUT: PUSH DE ;OPEN (DE) FCB FOR OUTPUT LD C, DELFIL ;FIRST DELETE CURRENT CALL CPM POP DE LD C, MAKFIL ;THEN RE-CREATE JP CPM ; CONIN: PUSH BC ;CONSOLE INP IS ONLY COMMON PUSH DE ; POINT FOR ALL PASSES SO DO PUSH HL ; SETUP HERE ; LD A, (SRCOPN) ;IS SRC OPEN? CP 'O' CALL NZ, CPYFCB ;IF NOT, CREATE FCB'S LD HL, (NXTPAS) ;POINT TO PASS SEQUENCE LD A, (HL) ;GET NEXT PASS NUMBER INC HL ;UPDATE POINTER LD (NXTPAS), HL ;SAVE POINTER PUSH AF ; CP 'Q' ;QUIT ? CALL Z, FLUSH ;YES, FLUSH BUFFERS POP AF PUSH AF ; CP '1' ;PASS 1? JR Z, PAS1 CP '2' ;PASS 2? JP Z, PAS2 CP '3' ;PASS 3? JP Z, PAS3 CP '4' ;PASS 4 USES CONSOLE OUTPUT JR Z, PAS1 INPRET: POP AF ;IF NONE OF ABOVE, EXIT JR GENRET ; NXTPAS: DEFW SEQNO ;SEQUENCE # POINTER SEQNO: DEFM '1423Q' ;DEFAULT SEQUENCE CPYFCB: LD HL, DFCB+9 ;POINT TO FILE EXTENSION LD DE, SEQNO+2 ;POINT TO PASS 2 FLAG LD A, (HL) ;GET DRIVE/SKIP FLAG FOR LST CP 'N' JR Z, CPYF1 ;IF N, SKIP THE SRC LIST CP 'B' ;PUT ON DRIVE B? JR NZ, DOIT ;NO, PUT LISTING ON DRIVE A LD A, 2 ;B IS DRIVE 2 LD (LSTFCB),A ;SET DRIVE BYTE TO 'B' JR DOIT CPYF1: LD (DE), A ;SKIP IT DOIT: INC HL ;POINT TO HEX SWITCH INC DE ;POINT TO PASS 3 FLAG LD A,(HL) ;GET DRIVE/SKIP FOR HEX CP 'N' ;SKIP? JR Z, CPYF2 ;IF Z, SKIP CP 'B' ;PUT ON DRIVE B? JR NZ, COPYIT ;IF NOT 'B' NO LD A,2 ;B IS DRIVE 2 LD (HEXFCB),A JR COPYIT CPYF2: LD (DE), A ;DON'T DO IT COPYIT: LD BC, 8H ;SETUP FOR LDIR ; LD DE, SRCFN ;DESTINATION PUSH BC CALL MOVFCB ; LD DE, LSTFN POP BC PUSH BC CALL MOVFCB ; LD DE, HEXFN POP BC ; MOVFCB: LD HL, DFCB+1 ;FILE NAME STARTS IN POS 1 LDIR RET ; PAS1: XOR A ;MAKE SURE OPEN FIRST LD (SRCFCB+12), A ; EXTENT LD DE, SRCFCB LD C, OPNFIL CALL CPM CP 0FFH ;SUCESSFUL? JR Z, NOSRC ; NO, LET US KNOW LD A, 'O' ; DECLARE OPEN LD (SRCOPN), A XOR A ;FIRST RECORD IS #0 LD (SRCFCB+32), A LD HL, SRCBUF+1024 LD (SRCPTR), HL JR INPRET ; NOSRC: LD DE, NFMSG ;NO FILE MESSAGE ERROUT: LD C, PRBUF ;PRINT STRING FUNCTION CALL CPM CALL GETCON ;WAIT FOR KEYSTROKE TO EXIT JP BOOT ; NFMSG: DEFB CR DEFB LF DEFM 'NO SOURCE FILE FOUND' DEFB CR DEFB LF DEFM '$' ; PAS2: LD A, (HEXOPN) ;HEX FILE OPEN FROM PREV? CP 'O' CALL Z, FLUSH ;YES, FLUSH AND CLOSE ; LD DE, LSTFCB ;OPEN LISTING FILE CALL OPNOUT CP 0FFH ;SUCESSFUL? JR Z, DSKERR ;NO, ERROR MSG LD A, 'O' LD (LSTOPN),A ;DECLARE OPEN XOR A ;START WITH RECORD 0 LD (LSTFCB+32), A LD HL, LSTBUF ;DECLARE EMPTY LD (LSTPTR), HL JR PAS1 ;GO OPEN SRC ; DSKERR: LD DE, ERRMSG JR ERROUT ;GOTO ERROR OUTPUT RTN ; ERRMSG: DEFB CR DEFB LF DEFM 'DISK ERROR, ASSEMBLY ABORTED' DEFB CR DEFB LF DEFM '$' ; PAS3: LD A, (LSTOPN) ;LIST STILL OPEN? CP 'O' CALL Z, FLUSH ;YES, FLUSH AND CLOSE LD DE, HEXFCB CALL OPNOUT ;OPEN HEX FILE FOR OUTPUT CP 0FFH ;SUCESS? JR Z, DSKERR ;NO, ABORT ; LD A, 'O' LD (HEXOPN),A ;DECLARE OPEN XOR A LD (HEXFCB+32), A LD HL, HEXBUF ;DECLARE EMPTY LD (HEXPTR), HL JP PAS1 ;GO OPEN SRC ; FLUSH: LD A, (HEXOPN) ;HEX FILE OPEN? CP 'O' ; IF O, YES JR Z, HEXFL ; LD A, (LSTOPN) ;LIST FILE OPEN? CP 'O' ; IF O, YES RET NZ ; NO OPEN OUTPUT FILES, EXIT ; LD DE, LSTBUF ;DE POINTS TO START LD HL, (LSTPTR) ;HL POINTS TO CURRENT CHAR LD BC, LSTFCB ;NEED FCB PTR FOR CP/M JR MTBUF ; HEXFL: LD DE, HEXBUF ;COMMENTS AS FOR LST FILE LD HL, (HEXPTR) LD BC, HEXFCB ; MTBUF: LD A, L ;FIND IF ON RECORD BOUNDARY AND 127 JR Z, MTBUF2 ;IF Z, YES LD (HL), CTLZ ;PUT ^Z AS EOF MARK ; MTBUF2: PUSH BC ;SAVE FCB PTR OR A ;CLEAR CARRY SBC HL, DE ;CALC # BYTES IN BUFFER JR NZ, AREREC ;IF NZ, ARE RECORDS TO WRITE POP BC ;ELSE EXIT RET ; AREREC: LD B, 7 ;B = SHIFT COUNTER DIV128: SRL H ; BYTES/128 = # RECORDS RR L DJNZ DIV128 ;LOOP TIL DONE ; LD B, L ;B = # RECORDS OR A ;FIND IF EVEN RECORD AGAIN JR Z, EVNREC ; INC B ;DON'T WANT TO LOSE PARTIAL EVNREC: EX DE, HL ;HL = BUFFER POINTER POP DE ;DE = FCB POINTER ; CALL FLBUF ;WRITE BUFFER TO DISK LD C, CLSFIL ;CLOSE FUNCTION PUSH DE CALL CPM POP DE LD HL, 38 ;(DE+38) = FILE OPEN FLAG ADD HL, DE LD (HL), 'C' ;DECLARE CLOSED RET ; FLBUF: PUSH BC ;B=#RECS, C=CHAR PUSH HL ;HL=BUFFER POINTER PUSH DE ;DE=FCB PTR ; EX DE, HL ;DE NOW = BUFFER PTR LD C, SETDMA CALL CPM ;DMA NOW = BUFFER ; POP DE ;GET FCB PTR BACK PUSH DE LD C, WRNR ;WRITE NEXT REC FUNCTION CALL CPM ; OR A ;SET FLAGS JP NZ, DSKERR ; POP DE POP HL POP BC ; DEC B RET Z ;IF Z, ALL RECORDS WRITTEN ; LD A, L ADD A, 128 ;UPDATE DATA POINTER LD L, A JR NC, FLBUF INC H JR FLBUF ; PCHOUT: PUSH BC PUSH DE PUSH HL LD HL, (HEXPTR) ;BUFFER POINTER LD A,H ;GET HIGH ORDER CP (HEXBUF+1025)/256 ;FULL? JR Z, DMPHEX ;IF Z, BUFFER FULL ; HEXCHR: LD (HL),C INC HL ;NOT FULL, JUST STORE CHAR LD (HEXPTR), HL JP GENRET ; DMPHEX: PUSH BC ;SAVE CHAR LD B, 8 ;8 RECORD BUFFER LD HL, HEXBUF ;SETUP FOR FLBUF LD DE, HEXFCB CALL FLBUF ; POP BC ;GET CHAR BACK LD HL, HEXBUF ;START AT BEGINNING AGAIN JR HEXCHR ; LSTO: PUSH BC PUSH DE PUSH HL LD A,(PASSNO) ;GET CURRENT PASS CP 4 ;IS IT PASS 4 ? JP Z, OUT4 ;IF YES, OUTPUT TO CONSOLE LD HL, (LSTPTR) ;NO, OUTPUT TO .PRN LD A, H CP (LSTBUF+1025)/256 ;FULL? JR Z, DMPLST ;YES, FLUSH ; LSTCHR: LD (HL), C ;STORE CHAR IN I/O BUFFER INC HL ;UPDATE POINTER LD (LSTPTR), HL JP GENRET ; DMPLST: PUSH BC LD B, 8 ;BUFFER = 8 RECORDS LD HL, LSTBUF ;START AT BEGINNING LD DE, LSTFCB ;FCB FOR CP/M CALL FLBUF ; POP BC ;GET THIS OUTPUT CHAR BACK LD HL, LSTBUF ;RESTART AT BEGINNING JR LSTCHR ; RDRIN: PUSH BC PUSH DE PUSH HL LD HL, (SRCPTR) ;GET SRC POINTER LD A, H CP (SRCBUF+1025)/256 ;PAST END? JR Z, SRCRD ;YES, GO GET MORE ; NXTCHR: LD A, (HL) ;GET CHAR INC HL LD (SRCPTR), HL ;SAVE POINTER JP GENRET ; SRCRD: LD BC, 0880H ;B=#RECS, C=BYTES/REC LD DE, SRCBUF ;DESTINATION ; NXTREC: PUSH DE PUSH BC LD C, SETDMA CALL CPM ; LD DE, SRCFCB LD C, RDNR ;READ NEXT RECORD CALL CPM ; POP BC POP DE CP 1 ;1 MEANS FILE DONE JR Z, SRCDON ; LD A, E ;UPDATE DESTINATION ADD A, C LD E, A JR NC, DOK INC D DOK: DEC B ;DONE 8 RECORDS? JR NZ, NXTREC ;NO, CONTINUE ; SRCDON: LD HL, SRCBUF ;START AT BEGINNING JR NXTCHR ; ; ; ;********************************************************************** ;RAM STORAGE AREA. ;********************************************************************** MEMTOP: DEFS 2 ; HIGHEST AVAILABLE RAM LOC. ADDR PASSNO: DEFS 1 ; PASS NUMBER LINPNT: DEFS 2 ; POINTER TO LINE BUFFER LINBUF: DEFS LBFSZ ; LINE BUFFER LABBUF: DEFS 7 ; LABEL BUFFER SYMBUF: DEFS 10 ; SYMBOL BUFFER PAGE: DEFS 2 ; PAGE NO. (BCD) LINE: DEFS 1 ; LINE NUMBER ERRBUF: DEFS 1 ; ERROR INDICATOR BUFFER ADREFC: DEFS 2 ; ADDRESS REFERENCE COUNTER ADDISR: DEFS 2 ; ADDRESS DISPLAY REGISTER ASCDNO: DEFS 1 ; NO. OF BYTES OF ASSEMBLED CODE ASSCOD: DEFS ACBSIZ ; ASSEMBLED CODE BUFFER TITBUF: DEFS TITSIZ+1 ; TITLE BUFFER SYMEND: DEFS 2 ; POINTER TO END OF SYMBOL TABLE ORTKBF: DEFS 2 ; OPERATOR TOKEN BUFFER TEMP: DEFS 2 ; DUMMY LOCATION ODBT1: DEFS 1 ; OPERAND-1 TOKEN BUFFER ODBT2: DEFS 1 ; OPERAND-2 TOKEN BUFFER ODINT1: DEFS 2 ; OPERAND-1 VALUE ODINT2: DEFS 2 ; OPERAND-2 VALUE AFLAGS: DEFS 1 ; ASSEMBLY FLAGS ; BIT 0 - ADDR DISCONT. FLAG ; BIT 1 - END FLAG ; BIT 2 - SYMB TABLE O/F FLAG OBJCNT: DEFS 1 ; NO OF BYTES IN OBJ BUFF RECADR: DEFS 2 ; TARGET ADDR OF 1ST BYTE OF RECORD STADDR: DEFS 2 ; START ADDR BUFFER FOR 'END' OPD OBJBUF: DEFS RECSIZ ; OBJECT CODE BUFFER FTOKR: DEFS 1 ; FUNCTION TOKEN REGISTER FCNT: DEFS 1 ; FUNCTION STACK COUNTER FSTK: DEFS MAXFSK ; START OF FUNCTION STACK ARCNT: DEFS 1 ; ARITHMETIC STACK COUNTER ARSTK: DEFS MAXASK ; ARITHMETIC STACK DEFS STKSIZ STACK: DEFS 0 ; STACK FROM HERE BACK ^ ; ORG 1F00H ; MUST START ON PAGE BOUNDARY ; SRCBUF: DEFS 1024 LSTBUF: DEFS 1024 HEXBUF: DEFS 1024 ; SYMTAB: DEFS 0 ; SYMBOL TABLE HERE TO MEMTOP END