 COPY ASSM1.A/1
 COPY ASSM2.A/1
 COPY ASSM3.A/1
 END
****************************************************************
*                                                              *
*                                                              *
*                 ***     ***     ***    *   *                 *
*                *   *   *   *   *   *   ** **                 *
*                *   *   *       *       * * *                 *
*                *****    ***     ***    *   *                 *
*                *   *       *       *   *   *                 *
*                *   *   *   *   *   *   *   *                 *
*                *   *    ***     ***    *   *                 *
*                                                              *
*                                                              *
*                    8080   DISK  ASSEMBLER                    *
*                                                              *
*                      ASSM  1.1  (MOD 0)                      *
*                       OCTOBER 9, 1978                        *
*                                                              *
*                     COPYRIGHT (C)   1977                     *
*               PROCESSOR TECHNOLOGY CORPORATION               *
*                                                              *
*                                                              *
****************************************************************
*                                                              *
*                                                              *
*  FORMAT:                                                     *
*                                                              *
*  <INFIL>,<LISFIL>,<BINFIL>,<ERRFIL>,<SYMFIL>,S=options       *
*                                                              *
*     WHERE: ALL BUT <INFILE> ARE OPTIONAL                     *
*        AND ANY <filename> IS OF THE FORM:                    *
*        filename,filename/unit, OR filenumber                 *
*                                                              *
*  <INFIL>  = disk SOURCE FILE name                            *
*  <LISFIL> = disk LIST FILE name                              *
*  <BINFIL> = disk OBJECT FILE name                            *
*  <ERRFIL> = disk ERROR FILE name                             *
*  <SYMFIL> = disk SYMBOL FILE name, or '='                    *
*             which will cause it to be the                    *
*             same file as <LISFIL>                            *
*  options  = ANY COMBINATION OF: form,A,L,#,P,X               *
*                                                              *
*  options:                                                    *
*     A:     INFILE IS IN ALS8 FORMAT                          *
*     L:     INFILE HAS LINE NUMBERS                           *
*     #:     GENERATE NEW LINE NUMBERS FOR LISTFILE            *
*     P:     PAGAGNATE LISTFILE                                *
*     X:     PRODUCE A CROSS REFERENCE LISTING                 *
*     form:  FORMAT OF LISTFILE (0-3) (SEE BELOW)              *
*                                                              *
*     A - X MAY BE PROCEEDED BY A + OR - TO TURN THE           *
*       OPTION ON OR OFF.  IF NEITHER, + IS ASSUMED            *
*     DEFAULT:  +#, +P, -X; A AND L ARE DETERMINED             *
*       BY SCANNING FIRST FEW LINES OF CODE                    *
*                                                              *
*  FORMAT:  0     no format                                    *
*           1     minimum  (72)                                *
*           2     nominal  (80)                                *
*           3     maximum  (132)                               *
*                                                              *
*                                                              *
****************************************************************
 TITL DISK ASSEMBLER"ASSM 1.1 (MOD 0)
*
*                EQUATES
*
 COPY NPTDEFS  PTDOS DEFINITIONS
TMARG EQU 5  TOP MARGIN FOR PAGNATION
BMARG EQU 62  BOTTOM MARGIN FOR PAGNATION
CR EQU 13  ASCII CARRIAGE RETURN
LF EQU 10  ASCII LINEFEED
LLAB EQU 5
IBFLN EQU 120  INPUT BUFFERS (IBUF) LENGTH
TRUE EQU 0FFH
*   /////  DIRECT REFERENCE TO SYSTEM  /////
GLOBG EQU 5*34  SIZE OF GARBAGE AT START OF "SYSGLOBL" /////
DNAMP EQU GLOBG+GLNAM  OFFSET INTO "SYSGLOBL" OF DISK NAME
*
*
 ASCF 0
 IFLS
 ORG 100H
 XEQ ASSMD
*
****************************************************************
*
*                INITIALIZE
*
ASSMD LXI D,NBUF+10  ZERO NAME BUFFER
 MVI B,8
 XRA A
 CALL ZBU1
 LXI D,IBUF+IBFLN
 MVI B,IBFLN
 MVI A,' '
 CALL ZBU1
*
 LHLD SYSGLO
 LXI D,GLCIF
 DAD D
 MOV A,M  CIFILE
 STA CIUNT  SAVE INTERNAL
 LHLD SYSGLO
 LXI D,GLCOF
 DAD D
 MOV A,M
 STA CONIT  SAVE COFILE INTERNAL FOR LATER ADDITIONS
*
 LHLD SYSGLO
 LXI D,GLFLG  GET ADDRESS OF CHARACTER FLAG
 DAD D
 SHLD CHARFL
*
*  SET DOS ERROR TRAP FOR RETURN TO HERE
*
 LHLD SYSGLO
 LXI D,GLERM
 DAD D
 SHLD ERMPT
 MOV E,M
 MVI M,-1
 INX H
 MOV D,M
 MVI M,-1
 XCHG .  GET BACK ORGINAL DOS ERROR TRAP
 SHLD ERSWC  SAVE DOS ERROR SWITCHES
*
 CALL GARGS  READ ARGUMENTS FROM CIFILE
*
****************************************
*
*
*
*                ASSEMBLER CODE
*
 LXI D,STMSG  PRINT START MESSAGE
 LDA HOFLG  DOES USER WANT US TO PRINT IT?
 CPI '-'
 CNZ PRINT  YEP
 XRA A
 STA SYMA1  START SYMBOL TABLE
 LXI H,COBUF
 SHLD LADDR
*
ASM3 LXI H,100H  DEFAULT ORG ADDRESS
 SHLD ASPC
 SHLD BBUF
 SHLD BADDR
 LXI H,0
 SHLD BCOUNT
*
ASM0 LXI SP,AREA+18  SET STACK POINTER
 LDA PASI  ON PASS 1?
 ORA A
 JNZ ASM2  NO-PASS 2 OR 3
*
ASM1 CALL GTLIN  GET LINE FROM INFILE
 CALL PAS1
 JMP ASM1
*
*
ASM2 CALL GTLIN  GET LINE FROM INFILE
 CALL PAS2
 CALL LOUT  OUTPUT LINE TO LISFILE (&ERRFILE IF ERR)
 JMP ASM2
*
****************************************
*
*
*    GET LINE FROM IN-FILE(OR COPY FILE) TO IBUF
*
GTLIN LDA EOFLG  END OF FILE ON LAST CALL?
 ORA A
 JNZ INEOF  YES-DONE READING THIS FILE
 LXI H,OBUF  CLEAR OBUF
 MVI A,>IBUF
 CALL CLER
 LXI H,IBUF  PUT CR AT IBUF IN CASE OF SHORT LINE
 MVI M,CR
*
 CALL PAUSE  PAUSE/EXIT ON SPACEBAR/MODE SELECT
*
 LHLD RLINE  READ INTO MEMORY AT RLINE
 XCHG .
 LXI B,IBFLN
*
GTLI1 MVI L,CR  UNTILL A CR IS READ
 LDA CPYSS  GET CURRENT COPY FILE
 CPI 0FFH  IS THERE ANY?
 JNZ GTLI2  YES-USE IT
 LDA INUM  NO-USE IN-FILE
*
GTLI2 MOV H,A
 CALL SYS
 DB DRDOP
 CALL EOFTS
 MOV A,C  GET BYTES READ COUNT
 CPI IBFLN  WERE ANY READ
 JZ INEOF  NO-HIT EOF
 ORA A  WAS MAX READ COUNT HIT?
 CZ GTLI7  YES-CHECK FOR LINE LONGER THAN IBFLN
 LDA AOFLG  ALS8 FORMAT?
 CPI '+'
 JNZ GENUM  NO-DONE READING LINE, CHECK # OPTION
*
GTLI6 LHLD RLINE
 XCHG .
 LDAX D  GET ALS8 BYTE COUNT
 CPI 1
 JNZ GTLI9  NOT=1, SKIP AHEAD
 MOV A,C  ALS8 BYTE COUNT=1,SHIFT IBUF LEFT
 CPI IBFLN-1  ONLY ONE BYTE READ?
 JZ INEOF  YES-DONE READING HIT EOF
 CALL GTLI4  GO DO THE SHIFTING
 JMP GTLI6  GO TEST LINE AGAIN
*
*
GTLI9 CPI CR  ONLY ONE BYTE READ (ALS8 COUNT=CR)?
 JZ GTLI3
*
GTLI8 ADD C  ADD IBFLN-(BYTES READ) TO ALS8 COUNT
 CPI IBFLN  IS IT IBFLN? (ALS8 COUNT=BYTES READ?)
 CNZ ERR8  IF BYTES READ <> ALS8 BYTE COUNT-ERROR
 LHLD RLINE
 MVI M,' '  BLANK OUT ALS8 BYTE COUNT
 JMP GENUM  DONE READING LINE, CHECK # OPTION
*
*
*   READ REST OF LINE IF 1ST BYTE WAS CR
*
GTLI3 MOV A,C  GET BYTES READ COUNT
 CPI IBFLN-1  ONLY 1?
 INX D  DON'T WANT TO WRITE OVER BYTE COUNT
 JZ GTLI1  YES-GO READ REST OF LINE
 MVI A,13  NO-HAS ALREADY BEEN HERE, LINE IS READ IN
 JMP GTLI8  RESTORE BYTE COUNT TO A AND RECHECK LINE
*
*
*   SHIFT IBUF LEFT ONE
*
GTLI4 INR C  UPDATE READ COUNT SINCE DELETING 1ST BYTE
 LHLD RLINE
 INX H
GTLI5 MOV A,M  GET NEXT BYTE
 STAX D  MOVE IT TO ONE LOCATION EARLIER
 CPI CR
 RZ .  DONE SHIFT IF CR
 INX D
 INX H
 JMP GTLI5
*
*
*  HANDLE LINES LONGER THAN IBFLN
*
GTLI7 DCX D
 LDAX D  GET LAST BYTE READ
 CPI CR  WAS IT A CR?
 INX D
 RZ .  YES-JUST FITS, SO OK
 MOV A,H  NO-SPACE OVER GARBAGE TILL CR
 PUSH B
 LXI B,0FFFFH
 MVI D,1
 MVI L,CR
 CALL SYS
 DB SPAOP
 CALL EOFTS
 POP B
 RET
*******************
*
*
*  GENERATE LINE NUMBERS (IN DECIMAL)
*
GENUM LDA NOFLG  LINE NUMBER GENERATION WANTED?
 CPI '+'
 RNZ .  NOPE
 LHLD LINO  PUT NEW LINE NUMBERS IN IN/OUT BUFFER
 SHLD IBUF-5
 LHLD LINO+2
 SHLD IBUF-5+2
 LXI H,LINO+3  INCREMENT LINE NUMBER IN LINO
 MVI E,4
*
GENU1 MOV A,M
 CPI '9'
 INR M
 RC .
 MVI M,'0'
 DCX H
 DCR E
 JNZ GENU1
 RET .
*
**********
*
*
INEOF XRA A  RESET EOFLG
 STA EOFLG
 LDA CPYSS  IS THERE A CURRENT COPY FILE?
 CPI 0FFH
 JZ EASS0  NO-END OF A PASS
 CALL CLOSE  CLOSE CURRENT COPY FILE
 CALL CPYPO  POP OUT NEW COPY FILE
 JMP GTLIN
*
********************
*
*     PAUSE/EXIT ON SPACEBAR/MODE SELECT
*
PAUSE CALL CONTST  IS KEY PRESSED?
 RZ .  NO
 CALL CONIN  GET CHARACTER
 ORA A
 JZ DONE1  IF MODE SELECT, DONE
 CPI ' '
 JNZ PAUS1  IF NOT BLANK RETURN IT TO CI
PAUS2 CALL CONIN  PAUSE TILL ANOTHER KEY HIT
 ORA A
 JZ DONE1  IF MODE SELECT, DONE
 CPI ' '
 RZ .  IF BLANK, STOP PAUSING
 CPI '0'
 JC PAUS2  IF NON-DIGIT, IGNORE
 CPI '9'+1
 JNC PAUS2  LIKEWISE
PAUS1 LHLD CHARFL
 MOV M,A
 RET .
*
****************************************
*
*
*    OUTPUT LINE TO LIST FILE IF THERE IS ONE
*    OUTPUT ERROR LINE TO ERROR FILE IF THERE IS ONE
*
LOUT LDA PASI
 CPI 2  PASS 3?
 RNC .  YES
 CALL EOUT  OUTPUT TO ENUM IF ERROR
 LDA LNUM  IS THERE A LIST FILE?
 INR A
 RZ .  NO-RETURN
 LDA OBUF+18  IS THERE AN ERROR?
 CPI ' '
 JNZ LOUT2  YES-SKIP NLST FLAG CHECK
 LDA ALST  IS NLST FLAG SET?
 ORA A
 RNZ .  YES-RETURN
*
LOUT2 CALL FORMT  FORMAT OUTPUT
 LDA POFLG  PAGINATION WANTED?
 CPI '+'
 LDA LNUM
 CZ PAGE  YES
 CALL PAGEUP  BUMP COUNT OF LINES ON PAGE (MOD 66)
 LDA LNUM  OUTPUT TO LIST FILE
*
LOUT1 LXI B,255
 LXI D,OBUF
 MVI L,CR
 CALL SYS  WRITE TILL CR
 DB DWROP
 CALL ERR0
 MVI B,LF  FOLLOW WITH LINEFEED
 CALL WB
 CALL ERRWB
 RET .
*
*
*  OUTPUT LINE TO EFILE IF THERE IS ONE
*
EOUT CALL FORMT  FORMAT OUTPUT
 LDA OBUF+18  IS THERE AN ERROR?
 CPI ' '
 RZ .  NO-RETURN
 LDA ENUM  IS THERE AN ERROR FILE?
 CPI 0FFH
 RZ .  NO-RETURN
 JMP LOUT1
*
*
*   OUTPUT LINE TO SYMBOL FILE
*
SOUT PUSH D
 LHLD SBPTR  GET SBUF LINE POINTER
 MVI M,CR  PLACE A MARKER THERE
 INX H
 MVI M,LF
 LDA POFLG  PAGNATION WANTED?
 CPI '+'
 LDA SNUM
 CZ PAGE  YES
 CALL PAGEUP  BUMP COUNT OF LINES ON PAGE (MOD 66)
 LXI H,SBUF  POINT TO START OF SBUF
 SHLD SBPTR  RESET SBPTR THERE
 LDA SNUM
 LXI B,134
 XCHG .
 MVI L,LF
 CALL SYS
 DB DWROP
 CALL ERR0
 POP D
 RET .
*
*
*   CHECK FOR AND SKIP OVER PAGE BOUNDRIES
*
PAGE MOV C,A  SAVE FILE NUMBER
 LDA PGCNT  UPDATE COUNT OF LINES ON PAGE
 CPI TMARG  ABOVE TOP MARGIN?
 JC PAGEABOVE  YES
 CPI BMARG+1  BELOW BOTTOM MARGIN?
 RC .  NO-WITHIN MARGINS
*
 SUI 66
PAGEABOVE CMA A
 INR A
 ADI TMARG
 CALL PAGEMOVE
*
 MVI A,TMARG  SET LINE NUMBER
 STA PGCNT
 CALL PGHEAD  OUTPUT PAGE HEADER
 RET .
*
*
PAGEMOVE DCR A  OUTPUT A CRLF'S TO FILE #C
 RM .
 CALL PAGECR
 JMP PAGEMOVE
*
*
PAGECR MOV B,A
 PUSH B
 MOV A,C
 LXI B,2
 LXI D,CRLF
 CALL SYS
 DB WBLOP
 CALL ERR0
 POP B
 MOV A,B
 RET .
*
*
NEWPAGE MOV C,A  MOVE TO NEW PAGE
 INR A
 RZ .  FILE NOT OPEN
 LDA POFLG
 CPI '+'
 RNZ .  PAGINATION NOT WANTED
 MVI A,67
 LXI H,PGCNT
 SUB M
 CPI 66
 RZ .  ALREADY AT TOP OF PAGE
 CALL PAGEMOVE
 MVI A,1
 STA PGCNT
 RET .
*
*
PAGEUP LDA PGCNT  INCREMENT COUNT OF LINES ON PAGE (MOD 66)
 INR A
 STA PGCNT
 CPI 67
 RC .
 SUI 66
 STA PGCNT
 RET .
*
****************************************
*
*
*     PASS 1 OF ASSEMBLER. USED TO FORM SYMBOL TABLE
*
PAS1 CALL ZBUF  CLEAR BUFFER
 STA PASI  SET FOR PASS 1
 LXI H,IBUF  INITIALIZE LINE POINTER
 SHLD PNTR  SAVE ADDRESS
 MOV A,M  FETCH CHARACTER
 CPI ' '  CHECK FOR A BLANK
 JZ OPC  JUMP IF NO LABEL
 CPI '*'  CHECK FOR COMMENT
 RZ .  RETURN IF COMMENT
 CPI ';'  SAME THING
 RZ .
 CPI CR  SAME THING
 RZ .
*
*   PROCESS LABEL
*
 CALL SLAB  GET AND CHECK LABEL
 JC LERR  ERROR IN LABEL
 PUSH PSW
 LDA IFFLG
 ORA A
 JZ LPRC1
 POP PSW
 JMP OPC
*
*
LPRC1 CALL LCHK  CHECK CHARACTER AFTER LABEL
 JZ LPRC2
 POP PSW
 JMP LERR  ERROR IN LABEL
LPRC2 POP PSW
 JZ ERRD  DUPLICATE LABEL
*
 CALL MLAB1  STORE LABEL
 XCHG
 SHLD TABA  SAVE TABLE ADDRESS FOR EQU
 LDA ASPC+1  FETCH PC (HIGH)
 MOV M,A  STORE IN TABLE
 INX H
 LDA ASPC  FETCH PC (LOW)
 MOV M,A  STORE IN TABLE
 INX H
 MVI M,0  SET TABLE TERMINATION
 SHLD STEND  SAVE SYMTAB'S ENDING ADDRESS
 LXI H,LBCNT+3  BUMP COUNT OF SYMBOLS (IN ASCII-DECIMAL)
 MVI E,4
 CALL GENU1
*
*    PROCESS OPCODE
*
OPC CALL ZBUF  ZERO WORKING BUFFER
 CALL SBLK  SCAN TO OPCODE
 JC OPCCR  FOUND CARRIAGE RETURN
 LXI D,ABUF
 CALL ALPS  PLACE OPCODE IN BUFFER
 CPI ' '  CHECK FOR BLANK AFTER OPCODE
 JC OPCD  CR AFTER OPCODE
 JNZ OERR  ERROR IF NO BLANK
 JMP OPCD  CHECK OPCODE
*
OPCCR LXI H,IBUF  FOUND CR BEFORE OPCODE, CHECK FOR LABLE
 MOV A,M
 CPI ' '
 JNZ OERR  FOUND LABLEP-SO OPCODE ERROR
 LDA PASI  CHECK PASS
 ORA A
 RZ .  ON PASS 1 JUST IGNORE LINE
 JMP COMNT  ON PASS2 TREAT AS COMMENT
*
*
MLAB1 MVI C,LLAB  LABEL LENGTH
 LXI H,ABUF  SET BUFFER ADDRESS
MLAB MOV A,M  FETCH NEXT CHARACTER
 STAX D  STORE IN SYMBOL TABLE
 INX D
 INX H
 DCR C  DECREMENT COUNT
 JNZ MLAB
 RET
*
*
*    THIS ROUTINE CHECKS THE CHARACTER AFTER A LABEL FOR A
*    BLANK OR A COLON.
*
LCHK LHLD PNTR
 MOV A,M  GET CHARACTER AFTER LABEL
 CPI ' '  CHECK FOR A BLANK
 RZ .   RETURN IF A BLANK
 CPI ':'  CHECK FOR A COLON
 RNZ
 INX H
 SHLD PNTR  SAVE POINTER
 RET
*
*
*       PROCESS ANY PSEUDO OPS THAT NEED TO BE IN PASS 1
*
PSU1 CALL SBLK  SCAN TO OPERAND
 LDAX D  FETCH VALUE
 ORA A
 JZ ORG1  ORG OPCODE
 JM DAT21  DATA STATEMENT
 CPI 2
 JC EQU1
 JZ RES1
 CPI 8
 JZ ASC1
 CPI 17
 JZ ASCZ1
 CPI 9
 JZ ASM0
 CPI 12
 JZ ACO1  DDB SAME AS DW IN PASS ONE
 CPI 13
 JZ CPY  "COPY"
 CPI 14
 JZ IFPRC
 CPI 4
 JZ EASS  "END"
 RNC .  IGNORE ALL OVER 4
*
*     DO DW PSEUDO/OP
*
ACO1 MVI C,2  2 BYTE INSTRUCTION
ACO11 MVI B,0
ACO12 LHLD ASPC  UPDATE PC
 DAD B
 SHLD ASPC
 RET .
*
*
*     PROCESS TITLE
*
TITLP LDA PASI  IGNORE ON PASS 3
 CPI 2
 JZ ASM0
 CALL SBLK  SCAN TO TITLE
 XCHG .
 LXI H,TITLBUF  POINT TO TITLE BUFFER
TITL1 LDAX D  GET CHARACTER
 CPI CR
 INX D
 JZ TDON1
 CPI '"'  FIRST DELIMITER?
 JZ TITL2
 MOV M,A
 INX H
 JMP TITL1
*
*
TITL2 MVI M,0  STORE DELIMITER
 INX H
TITL3 LDAX D
 CPI '"'
 JZ TDON1
 CPI CR
 JZ TDON1
 MOV M,A
 INX H
 INX D
 JMP TITL3
*
*
TDON1 MVI M,0
 INX H
 MVI M,0
 JMP ASM0
*
*
*     DO ORG PSEUDO-OP
*
ORG1 CALL ASCN  GET OPERAND
 LDA OBUF+18  FETCH ERROR INDICATOR
 CPI ' '  CHECK FOR AN ERROR
 JNZ LOUT  ERROR DON'T CHANGE PC
 SHLD ASPC  STORE NEW ORIGIN
 LDA IBUF  GET FIRST CHARACTER
 CPI ' '  CHECK FOR LABEL
 RZ
 JMP EQUS  CHANGE LABEL VALUE
*
*
*    DO EQU PSEUDO-OP
*
EQU1 CALL ASCN  GET OPERAND
 LDA IBUF  FETCH 1ST CHARACTER
 CPI ' '  CHECK FOR LABEL
 JZ ERRM  MISSING LABEL
*
EQUS XCHG
 LHLD TABA  SYMBOL TABLE ADDRESS
 MOV M,D  STORE LABEL VALUE
 INX H
 MOV M,E
 LDA OBUF+18  OUTPUT TO ERROR FILE IF OBUF+18 HAS ERROR
 CPI ' '
 JNZ LOUT
 RET .
*
*
*   PROCESS IF STATEMENT
*
IFPRC LDA IFFLG
 ORA A
 JNZ IFALS
 CALL ASBL
 LDA OBUF+18
 CPI ' '
 JNZ LOUT  IF ERROR OUTPUT IT
 MOV A,H
 ORA L
 JZ IFALS
 XRA A
*
IFPRI STA IFFLG
 JMP IFLTS
*
IFALS LDA IFFLG
 INR A
 JMP IFPRI
*
*
ENDIF LDA IFFLG
 DCR A
 JP IFPRI
 XRA A
 JMP IFPRI
*
*
IFLST XRA A
 INR A
 STA ILFLG
 JMP ASM0
*
*
*   DO DS PSEUDO-OP
*
RES1 CALL ASCN  GET OPERAND
 MOV B,H
 MOV C,L
 LDA OBUF+18
 CPI ' '  ERROR?
 JNZ LOUT
 JMP RES21  ADD VALUE TO PROGRAM COUNTER
*
*
*    DO ASCZ PSEUDO-OP
*
ASCZ1 MOV A,M  GET FIRST CHARACTER
 CPI CR  CARRIAGE RETURN
 RZ .
 MOV D,A  SAVE AS DELIMITER
 LXI B,1  SET BYTE COUNT TO 1
 JMP ASC11
*
*
*    DO ASC PSEUDO-OP
*
ASC1 MOV A,M  GET FIRST CHARACTER
 CPI CR  CARRIAGE RETURN
 RZ
 MOV D,A  SAVE AS DELIMITER
 LXI B,0  SET BYTE COUNT TO 0
*
ASC11 INX H
 MOV A,M  GET NEXT CHARACTER
 CPI CR  CARRIAGE RETURN
 JZ RES21  UPDATE PC
 CMP D  FOUND DELIMITER
 JZ RES21
 INX B
 JMP ASC11
*
*******************
*
*
*      PERFORM PASS 2 OF THE ASSEMBLER
*
PAS2 LXI H,OBUF  SET OUTPUT BUFFER ADDRESS
 LDA ASPC+1  FETCH PC (HIGH)
 CALL BINH0  CONVERT FOR OUTPUT
 INX H
 LDA ASPC  FETCH PC (LOW)
 CALL BINH0  CONVERT FOR OUTPUT
 SHLD OIND  SAVE OUTPUT ADDRESS
 CALL ZBUF  CLEAR BUFFER
 LXI H,IBUF  INITIALIZE LINE POINTER
*
 SHLD PNTR  SAVE POINTER
 MOV A,M  FETCH FIRST CHARACTER
 CPI ' '  CHECK FOR LABEL
 JZ OPC  GET OPCODE
 CPI '*'  CHECK FOR COMMENT
 JZ COMNT  PROCESS COMMENT LINE
 CPI ';'  ANOTHER COMMENT
 JZ COMNT
 CPI CR  ANOTHER COMMENT
 JZ COMNT
 CALL SLAB  SCAN OFF LABEL
 JC LERR  ERROR IN LABEL
 CALL LCHK  CHECK FOR A BLANK OR COLON
 JNZ LERR  ERROR IF NOT A BLANK
 JMP OPC
*
*
COMNT LDA IFFLG  IS IF FLAG SET?
 ORA A
 JZ COMT2  NO-PRINT AS NORMAL COMMENT
*
IFLTS LDA ILFLG  IS IF LIST FLAG SET?
 ORA A
 JZ ASM0  NO-DON'T PRINT;YES-PRINT AS COMMENT
*
COMT2 LXI H,2020H
 SHLD OBUF  BLANK OUT ADDRESSES ON COMMENT LINES
 SHLD OBUF+2
 RET
*
*
*      PROCESS PSEUDO OPS FOR PASS 2
*
PSU2 LDAX D
 ORA A
 JZ ORG2  ORG OPCODE
 JM DAT2  DATA OPCODE
 CPI 2
 JC EQU2  EQUATE OPCODE
 JZ RES2
 CPI 5
 JZ FRMFEED
 CPI 8
 JZ ASC2
 CPI 17
 JZ ASCZ2
 CPI 9
 JZ TITLP
 CPI 10
 JZ XEQP  PROCESS XEQ ADDRESS
 CPI 11
 JZ ASCFP  PROCESS ASCII FLAG
 CPI 12
 JZ DDBP  DOUBLE BYTE PROCESS
 CPI 14
 JZ IFPRC
 CPI 16
 JZ IFLST
 CPI 13
 JZ CPY  "COPY"
 CPI 4
 JZ END2  "END"
 JNC LST   MUST BE "LST" OR "NLST"
 JMP ACO2  MUST BE DW
*
*
*     DO DW PSEUDO-OP
*
ACO2 CALL SBLK  SCAN TO ARGUMENT
 CALL TYS6  GET VALUE
 JMP ACO1
*
*     GET VALUE OF EQUATE FOR LISTING
*
EQU2 CALL ASBL  GET VALUE
EQU3 XCHG .  TO DE
 CALL COMNT
 LHLD OIND
 INX H
 INX H
 MOV A,D
 CALL BINH0  CONVERT D TO LISTING
 INX H
 MOV A,E
 JMP BINH0
*
*
*    DEFINE DOUBLE BYTE
*
DDBP CALL ASBL
 MOV A,H  GET HIGH
 MOV D,L
 CALL TYS6A
 JMP ACO1
*
*
*     DO DS PSEUDO-OP
*
RES2 CALL ASBL  GET OPERAND
 MOV B,H
 MOV C,L
 LHLD BBUF  FETCH STORAGE COUNTER
 DAD B  ADD VALUE
 PUSH B
 CALL ORG3  UPDATE BINARY FILE
 POP B
RES21 JMP ACO12
*
*
*    DO DB PSEUDO-OP
*
DAT2 CALL SBLK  SCAN TO FIRST ARGUMENT
 LHLD PNTR  COPY LINE INTO INTO SPARE BUFFER
 LXI D,BUFR
DAT24 MOV A,M
 STAX D
 INX D
 INX H
 CPI CR
 JNZ DAT24
 LXI H,BUFR
 SHLD PNTR
 MVI A,4  ONLY WANT 4 DB VALUES PER LINE
 STA DBCNT
DA2TA CALL ASCN  GET ARGUMENT
 INR A
 CPI 2  CHECK ARGUMENT FOR RANGE
 CNC ERRV  OPERAND OUT OF RANGE
 MOV A,L
 CALL ASTO  OUTPUT BYTE TO LIST AND BIN FILES
 CALL DAT22  UPDATE PC AND CHECK FOR MORE ARGS
 PUSH PSW  SAVE FLAGS
 LDA DBCNT  UPDATE DBCNT
 DCR A
 STA DBCNT
 CZ DAT25  4 DB VALUES ON LINE, SO OUTPUT IT
 POP PSW  RESTORE FLAGS
 JZ DA2TA  IF MORE ARGS, PROCESS THEM
 LDA OBUF+6  DOES LAST LINE HAVE ANY VALUES ON IT?
 CPI ' '
 CNZ DAT25 YES-OUTPUT LAST LINE
 JMP ASM0  NOTHING LEFT TO LIST
*
DAT22 MVI C,1
 CALL ACO11  UPDATE PC BY C
 LHLD PNTR  CHECK NEXT CHARACTER
 MOV A,M
 CPI ','
 RNZ .
 INX H
 SHLD PNTR  IF ',' MOVE PNTR OVER IT
 RET .
*
DAT21 CALL SBLK  SCAN TO FIRST ARGUMENT
DAT2A CALL ASCN  GET ARGUMENT
 CALL DAT22  UPDATE PC AND CHECK FOR MORE ARGS
 JZ DAT2A  IF MORE, PROCESS THEM
 RET .
*
DAT25 LDA OBUF  IS THIS FIRST LINE?
 CPI ' '
 JZ DAT26  NO-SKIP AHEAD
 CALL LOUT  YES-OUTPUT IT
 JMP DAT28
DAT26 LDA ASFLG
 ORA A
 JZ DAT27  IF ASFLG NOT SET, SKIP AHEAD
 CALL LOUT
 JMP DAT28
DAT27 LDA OBUF+18
 CPI ' '
 JZ DAT28  IF NO ERRORS, SKIP AHEAD
 CALL LOUT
DAT28 MVI A,4  RESET DBCNT
 STA DBCNT
 MVI A,' '
 LXI D,OBUF+20
 MVI B,20
 CALL ZBU1  FILL OBUF WITH BLANKS
 MVI A,CR  PLACE CR AT END OF OBUF
 STA OBUF+20
 LXI H,OBUF+3
 SHLD OIND  SET BUFFER POINTER
 RET .
*
*
*   DO XEQ PSEUDO-OP
*
XEQP CALL ASBL
 LDA OBUF+18
 CPI ' '  CHECK FOR ERROR
 RNZ .  IF ERROR
 STA XQFLG
 SHLD XQADR
 JMP EQU3
*
*
*    DO ORG PSEUDO-OP
*
ORG2 CALL ASBL  GET NEW ORIGIN
 LDA OBUF+18  GET ERROR INDICATOR
 CPI ' '  CHECK FOR AN ERROR
 RNZ .  DON'T MODIFY PC IF ERROR
 SHLD ASPC  STORE NEW PC
 MOV A,H
 LXI H,OBUF
 CALL BINH0
 INX H
 LDA ASPC
 CALL BINH0
 LHLD ASPC
*
ORG3 SHLD BBUF
 CALL UPDATE
 LHLD BBUF
 SHLD BADDR  NEW BUFFER ADDRESS
 RET
*
*
*    DO PAGE PSEUDO-OP
*
FRMFEED LDA PASI  IGNORE ON PASS 3
 CPI 2
 JZ ASM2
 LDA LNUM
 CALL NEWPAGE
 JMP ASM2
*
*  SET ASCII OUTPUT FLAG
*
ASCFP CALL ASBL
 MOV A,L
 STA ASFLG  STORE NEW ASCII FLAG
 JMP ASM0
*
*
*   PROCESS LST AND NLST PSEUDO-OPS
*
LST SUI 6
 STA ALST  SET LIST SWITCH
 JMP ASM0
*
*
*    DO ASCZ PSEUDO-OP
*
ASCZ2 CALL SBLK  SCAN TO OPERAND
 JC ERRA  FOUND CR
 MOV C,A  SAVE DELIMITER
 INX H
 MOV A,M  GET NEXT CHARACTER
 CPI CR
 JZ ERRA
 CMP C  FOUND DELIMITER
 JZ ERRA
 MVI B,-7
 LXI D,BUFR  POINT TO SPARE BUFFER
*
ASCZST STAX D  STORE CHARACTER
 INX H
 INX D
 MOV A,M
 CPI CR
 JZ ASCZDN
 CMP C
 JNZ ASCZST
*
ASCZDN XRA A  STORE THE EXTRA ZERO BYTE AT END OF SPARE BUFFER
 STAX D
 INX D
 MOV A,C
 JMP ASCDN
*
*
*    DO ASC PSEUDO-OP
*
ASC2 CALL SBLK  SCAN TO OPERAND
 JC ERRA  FOUND CR
 MOV C,A  SAVE DELIMITER
 INX H
 MOV A,M  GET NEXT CHARACTER
 CPI CR
 JZ ERRA
 CMP C  FOUND DELIMITER
 JZ ERRA
 MVI B,-7
 LXI D,BUFR  POINT TO SPARE BUFFER
*
ASCST STAX D  STORE CHARACTER
 INX H
 INX D
 MOV A,M
 CPI CR
 JZ ASCDN
 CMP C  DELIMITER?
 JNZ ASCST  KEEP STORING
*
ASCDN STAX D  SAVE DELIMITER
 LXI H,BUFR  RESET POINTER
ASC21 MOV A,M  GET NEXT CHARACTER
 CPI CR
 JZ ASC23
 CMP C  FOUND DELIMITER
 JZ ASC23
 SHLD PNTR
 LHLD ASPC
 INX H  INCREMENT PROGRAM COUNTER
 SHLD ASPC  SAVE PC
 INR B
 PUSH B
 CALL ASTO  STORE OBJECT BYTE
 LHLD OIND  GET POINTER INTO OBUF
 MOV A,L
 CPI >OBUF+15
 JNZ ASC22
*  OUTPUT LINE IF APPROPRIATE
 POP B
 PUSH B
 MOV A,B
 ORA A
 JM ASOUT  FIRST TIME THROUGH
 LDA ASFLG  GET OUTPUT SWITCH
 ORA A
 JZ ASC2A  NO OUTPUT
*
ASOUT CALL LOUT
ASC2A POP B
 MVI B,0
 PUSH B
 CALL COMNT  ASCII BLANKS
 MVI A,CR
 STA OBUF+16  PUT CR IN BUFFER
 LXI H,OBUF+3
 SHLD OIND  SET BUFFER POINTER
*
ASC22 LHLD PNTR
 POP B
 INX H
 JMP ASC21
*
*   GET HERE AT END OF SCAN
*
ASC23 MOV A,B
 ORA A  ANYTHING ON LINE
 RM
 LDA ASFLG  GET ASCII LISTING FLAG
 ORA A
 JZ ASM0  THE FLAG SAYS NO
 MOV A,B
 ORA A
 JZ ASM0  NOTHING TO LIST
*
 LHLD OIND  GET LAST CHARACTER ON LINE
 INX H
 MVI M,CR  PUT IN A CR
 RET
*
*
*      DO END PSEDO-OP FOR PASS 2
*
END2 CALL COMNT
 CALL LOUT  PRINT OUT THE LINE
 JMP EASS
*
*
*
*      PROCESS 1 BYTE INSTRUCTIONS WITHOUT OPERANDS
*
*
*   PROCESS STAX AND LDAX INSTRUCTIONS
*
TYP2 CALL ASBL  FETCH OPERAND
 CNZ ERRR  ILLEGAL REGISTER
 MOV A,L  GET LOW ORDER OPERAND
 ORA A  SET FLAGS
 JZ TY31  OPERAND = 0
 CPI 2  OPERAND = 2
 CNZ ERRR  ILLEGAL REGISTER
 JMP TY31
*
*
*   PROCESS PUSH,POP,INX,DCX,DAD INSTRUCTIONS
*
TYP3 CALL ASBL  FETCH OPERAND
 CNZ ERRR  ILLEGAL REGISTER
 MOV A,L  GET LOW ORDER OPERAND
 RRC .  CHECK LOW ORDER BIT
 CC ERRR  ILLEGAL REGISTER
 RAL .  RESTORE OPERAND
 CPI 8
 CNC ERRR  ILLEGAL REGISTER
*
TY31 RLC .  MULTIPLY BY 8
 RAL
 RAL
TY32 MOV B,A
 LDAX D  FETCH OPCODE BASE
 ADD B  FORM OPCODE
 CPI 118  CHECK FOR MOV M,M
 CZ ERRR  ILLEGAL REGISTER
 JMP ASTO0
*
*
*   PROCESS ACCUMULATOR, INR,DCR,MOV,RST INSTRUCTIONS
*
TYP4 CALL ASBL  FETCH OPERAND
 CNZ ERRR  ILLEGAL REGISTER
 MOV A,L  GET LOW ORDER OPERAND
 CPI 8
 CNC ERRR  ILLEGAL REGISTER
 LDAX D  FETCH OPCODE BASE
 CPI 64  CHECK FOR MOV INSTRUCTION
 JZ TY41
 CPI 199
 MOV A,L
 JZ TY31  RST INSTRUCTION
 JM TY32  ACCUMULATOR INSTRUCTION
 JMP TY31  INR,DCR
*
*
*   PROCESS MOV INSTRUCTION
*
TY41 DAD H  MULTIPLY OPERAND BY 8
 DAD H
 DAD H
 ADD L  FORM OPCODE
 STAX D  SAVE OPCODE
 CALL MPNT  INCREMENT POINTER
 CALL ASCN  GET NEXT OPERAND
 CNZ ERRR  ILLEGAL REGISTER
 MOV A,L  FETCH LOW ORDER OPERAND
 CPI 8
 CNC ERRR  ILLEGAL REGISTER
 JMP TY32
*
*
*   PROCESS IMMEDIATE INSTRUCTIONS
*   IMMEDIATE BYTE CAN BE BETWEEN -256 AND +255
*   MVI INSTRUCTION IS A SPECIAL CASE AND CONTAINS 2
*   ARGUMENTS IN OPERAND
*
TYP5 PUSH PSW  SAVE INSTRUCTION
 CALL SBLK  SCAN TO ARGUMENT
 POP PSW  RESTORE INSTRUCTION
 CPI 6  CHECK FOR MVI INSTRUCTION
 CZ TY56
 CALL ASTO  STORE OBJECT BYTE
*
 CALL ASCN  GET IMMEDIATE ARGUMENT
 INR A
 CPI 2  CHECK OPERAND FOR RANGE
 CNC ERRV  OPERAND OUT OF RANGE
 MOV A,L
 JMP ASTO0
*
*
*  FETCH 1ST ARGUMENT FOR MVI AND LXI INSTRUCTIONS
*
TY56 CALL ASCN  FETCH ARGUMENT
 CNZ ERRR  ILLEGAL REGISTER
 MOV A,L  GET LOW ORDER ARGUMENT
 CPI 8
 CNC ERRR  ILLEGAL REGISTER
 DAD H  MULTIPLY BY 8
 DAD H
 DAD H
 LDAX D  FETCH OPCODE BASE
 ADD L  FORM OPCODE
 MOV E,A  SAVE OBJECT BYTE
*
MPNT LHLD PNTR  FETCH POINTER
 INX H  INCREMENT POINTER
 SHLD PNTR
 MOV A,E  GET OBJECT BYTE
 RET
*
*
*    PROCESS 3 BYTE INSTRUCTIONS
*
*  LXI INSTRUCTION IS A SPECIAL CASE
*
TYP6 PUSH PSW  SAVE INSTRUCTION
 CALL SBLK  SCAN TO ARGUMENT
 POP PSW  RESTORE INSTRUCTION
 CPI 1  CHECK FOR LXI INSTRUCTION
 JNZ TY6  JUMP IF NOT LXI
 CALL SBLK  SCAN TO FIRST ARGUMENT
 CALL TY56  GET REGISTER
 ANI 08H  CHECK FOR ILLEGAL REGISTER
 CNZ ERRR  REGISTER ERROR
 MOV A,E  GET OPCODE
 ANI 0F7H  CLEAR BIT IN ERROR
TY6 CALL ASTO  STORE OBJECT BYTE
*
TYS6 CALL ASCN  FETCH OPERAND
 MOV A,L
 MOV D,H
TYS6A CALL ASTO0  STORE 2ND BYTE
 MOV A,D
*
*   STORE OBJECT CODE TO LIST FILE
*
ASTO0 MOV B,A  SAVE OBJECT BYTE
 LHLD PNTR
 MOV A,M
 CPI ','  ARE THERE MORE ARGUMENTS ON LINE?
 MOV A,B  RESTORE OBJECT BYTE
 JNZ ASTO  NO-OK
 CALL ERRS  YES-SYNTAX ERROR
*
ASTO MOV B,A  SAVE OPCODE
 LDA PASI
 CPI 2  PASS 3?
 RNC .  YES
 LHLD OIND  OUTPUT TO OBUF FOR LISTING
 INX H
 INX H
 MOV A,B
 CALL BINH0  CONVERT TO ASCII
 SHLD OIND
*
*   STORE OBJECT CODE TO BINARY FILE
*
 LDA BNUM  IS THERE AND OBJECT FILE?
 INR A
 RZ .  NO-THEN RETURN
*
 LHLD LADDR  GET LINE ADDRESS
 MOV M,B
 INX H
 SHLD LADDR  NEW LINE ADDRESS
 LHLD BBUF  GET CODE ADDRESS
 INX H
 SHLD BBUF
*
*   IS BINARY FILE UPDATE NEEDED?
*
 LDA BCOUNT  BUMP LINE COUNT
 INR A
 STA BCOUNT
 CPI 100  AT THE END?
 RC
*
* UPDATE BINARY FILE & ZERO RECORD & LINE
*
UPDATE LDA BCOUNT
 ORA A
 RZ .  NO UPDATE IF ZERO
*
 PUSH H
 PUSH D
 PUSH B
 LXI H,BCOUNT  POINT TO COUNT
 MOV A,M  GET IT
 INX H
 MVI B,0
 MOV M,B  MAKE SURE IT'S ZERO
 DCX H
 XCHG .  DE HAVE POINTER
 ADI 4  BUMP LENGTH
 MOV C,A
 LDA BNUM  OBJECT FILE
 CALL SYS
 DB WBLOP  WRITE IT OUT
*
 CALL ERR0
 XRA A
 STA BCOUNT
 LXI H,COBUF
 SHLD LADDR
 LHLD BBUF
 SHLD BADDR
 POP B
 POP D
 POP H
 RET
*
*
*
* GET HERE WHEN END PSEUDO-OP IS FOUND OR WHEN END OF FILE
* OCCURS IN SOURCE STATEMENTS.  CONTROL IS SET FOR EITHER
* PASS 2 OR ASSEMBLEY TERMINATES IF FINISHED.
*
EASS0 POP H  GET RID OF GTLIN'S RETURN ADDRESS
EASS CALL CPYCL  CLOSE ALL COPY FILES
 MVI D,0  REWIND IN-FILE
 LDA INUM
 CALL SYS
 DB SPAOP
 CALL ERR0
 LXI H,'0'*256+'0'  SET LINO TO '0000'
 SHLD LINO
 SHLD LINO+2
 LXI H,PASI  PASS INDICATOR
 MOV A,M
 CPI 1
 JZ EASS1  END OF PASS 2?
 JNC SYM7  IN PASS 3?
*
*  SET UP FOR PASS 2
*
 INR M  SET FOR PASS 2
 MVI A,0  RESET IFFLG
 STA IFFLG
 CALL OUTLF  OUTPUT A LINEFEED TO CONSOLE
 CALL ORDER  ORDER THE SYM TAB
 JMP ASM3
*
*
*  DONE WITH PASS 2
*
EASS1 LDA BNUM  IS THERE A BINARY FILE?
 INR A
 JZ EASS2  NO-SKIP AHEAD
 CALL UPDATE  YES-MAKE SURE IT IS UPDATED
 LDA XQFLG  XEQ ADDRESS?
 ORA A
 JZ EASS2  NO-SKIP AHEAD
 LXI D,XQADR  POINT TO ADDRESS
 LXI B,2  TWO BYTES
 LDA BNUM
 CALL SYS
 DB WBLOP
 CALL ERR0
*
EASS2 CALL OUTCR  OUTPUT A CRLF TO CONSOLE
 LDA LNUM
 CALL NEWPAGE  FORMFEED
 LDA SNUM  IS THERE A SYMBOL FILE?
 INR A
 JZ DONE  NO-DONE
 LXI H,PASI
 INR M  YES-SET FOR PASS 3
*
*  OUTPUT SYMBOL TABLE
*
 LDA POFLG  PAGNATION WANTED?
 CPI '+'
 JNZ SYMP2  NO
 MVI A,1  YES-RESET COUNT OF LINES ON PAGE
 STA PGCNT
*
SYMP2 XRA A
SYMP3 STA SCNT  SET LINE COUNT
 LXI H,SYMAD  GET SYMBOL TABLE ADDRESS
 MOV D,H
 MOV E,L
SYM1 LXI B,LLAB-1  PROCESS SYMBOLS IN ALPHABETICAL ORDER
 MOV A,M  FETCH CHARACTER
 ORA A  CHECK FOR END OF TABLE
 JZ SYM3
 DAD B
 XCHG
 DAD B
 XCHG
 INR C  SYMBOL CHARACTER COUNT
 CALL COMO  COMPARE SYMBOLS, CLEAR CARRY IF NEW LOW SYMBOL
 INX H
 INX D
 LXI B,LLAB+2
 JC SYM2  JUMP IF LARGE SYMBOL
 MOV D,H  SET NEW LOW (ALPHABETICALLY) SYMBOL
 MOV E,L
SYM2 DAD B
 JMP SYM1
SYM3 XCHG
 MOV A,M
 DCR A
 JM SYMDONE
 INR A
 SHLD SYMSAV
 CALL SYMOT
 LDA XOFLG  CROSS REFERENCE WANTED?
 CPI '+'
 JZ ASM3  YES
*
*   OUTPUT SYMBOL TABLE
*
 LDA SLNSZ  GET SYMLIST MAX LINE SIZE
 MOV B,A
 LDA SCNT  GET LINE COUNT
 INR A
 CMP B  LINE FILLED?
SYM7 LHLD SYMSAV
 MVI M,-1  DELETE SYMBOL
 JC SYMP3
 CALL SOUT  IF LINE FULL OUTPUT IT
 CALL PAUSE  PAUSE/EXIT ON SPACEBAR/MODE SELECT
 JMP SYMP2
*
*
SYMOT MVI C,LLAB
SYM4 MOV B,A
 ORA A
 JNZ SYM5
 MVI B,' '  GET A BLANK
*
SYM5 CALL OUT8
 INX H
 MOV A,M  GET A SYMBOL
 DCR C
 JNZ SYM4
 MVI C,3
 CALL BLKO
 MOV D,M
 INX H
 MOV E,M
 PUSH H
 CALL ADOUT
 POP D
 MVI C,5
 CALL BLKO
 RET .
*
SYMDONE CALL SOUT  MAKE SURE LAST UPDATE IS OUTPUT
 LDA SNUM
 CALL NEWPAGE  MOVE TO NEW PAGE
 JMP DONE
*
**********
*
*
OUTCR MVI B,CR  OUTPUT A CRLF TO CONSOLE
 CALL OUTER  DO THE CR,THEN FALL THROUGH TO LF
OUTLF  MVI B,LF  OUTPUT A LINEFEED TO CONSOLE
OUTER MVI A,1
 CALL WB
 CALL ERR0
 RET .
*
****************************************
*
*
* THIS ROUTINE SCANS THROUGH A CHARACTER STRING UNTIL
* THE FIRST NON BLANK CHARACTER IS FOUND
*
* ON RETURN CARRY = 1 INDICATES A CR AS FIRST NON BLANK CHR
*
SBLK LHLD PNTR  FETCH ADDRESS
SBL1 MOV A,M  FETCH CHARACTER
 INX H
 CPI ' '
 JZ SBL1
 DCX H
 SHLD PNTR
 RET
*
****************************************
*
* THE FOLLOWING IS ADDED FOR "COPY" STMNTS TO ALLOW
* COPYING FROM SOURCE FILES.   GLENN S. TENNEY 77-02-15
*
CPYPO EQU $  POP ONE FILE FROM COPY STACK
 LXI D,CPYSS+1  FROM ADDR
 LXI H,CPYSS  TO ADDR
 MVI B,CPYNN-1  LENGTH
 CALL MOVL  MOVE FM LEFT SIDE
 MVI M,0FFH  FLAG AS END OF CPY STACK
 LHLD NAMPTR  MOVE TITLE NAME POINTER
 LXI D,-18
 DAD D
 SHLD NAMPTR
 RET .  COPY NOW POPPED
*
MOVL LDAX D  GET BYTE TO MOVE FROM RIGHT
 MOV M,A  MOVE IT
 INX D  NEXT SENDING FIELD
 INX H  NEXT RCV FIELD
 DCR B  DROP COUNT
 JNZ MOVL  NOT DONE YET
 RET .  MOVE FM LEFT ALL DONE
*
*
MOVR LDAX D  GET CHAR TO MOVE FM RIGHT
 MOV M,A  MOVE ONE CHAR
 DCX D  NEXT SENDING FIELD
 DCX H  NEXT RCV FIELD
 DCR B  DROP COUNT
 JNZ MOVR  NOT DONE YET
 RET .  MOVE FM RIGHT ALL DONE
*
*
CPY EQU $  THIS HANDLES THE "COPY" PSUEDO
 LDA CPYSS+CPYNN-1  GET LAST CPY FILE IN STACK
 CPI 0FFH  IS THERE ROOM FOR ANOTHER
 JNZ ERRV  NO--SHOW VALUE ERROR
 CALL SBLK  SCAN TO NON BLANK
 JC ERRS  INVALID IF NO NAME
 DCX H  DROP BACK TO NAME-1
 CALL NAME  PROCESS NAME AND OPEN IT
 MOV C,A  SAVE FILE NUMBER
 MVI B,CPYNN-1  LENGTH
 LXI D,CPYSS+CPYNN-2  SENDING FIELD
 LXI H,CPYSS+CPYNN-1  RCV FIELD
 CALL MOVR  MOVE FROM RIGHT
 MOV M,C  POST NEW FILE NUMBER
 LDA PASI  PASS 1 OR 2
 ORA A
 RZ .  RET IF PASS ONE
 JMP COMNT   PASS TWO=COMMENT
*
*
****************************************
*
CLER MVI M,' '
 INX H
 CMP L
 JNZ CLER
 RET .
*
*
ZBUF XRA A  GET THE ZERO
 LXI D,ABUF+35
 MVI B,35
ZBU1 DCX D
 STAX D
 DCR B
 JNZ ZBU1
 RET
*
*
SEAR LDAX D  FETCH CHAR
 CMP M
 JNZ INCA
 INX H
 INX D
 DCR C
 JNZ SEAR
 RET .  GOT IT
*
INCA MOV A,C
 ADD E
 MOV E,A
 JNC INCA1
 INR D
INCA1 INR C  RESET ZERO FLAG
 RET
*
*
BLKO CALL BLK1
 DCR C
 JNZ BLKO
 RET
*
BLK1 MVI B,' '
 JMP OUT8
*
*
COMO ORA A  CLEAR CARRY FLAG
CO1 LDAX D
 SBB M
 JZ CO2
CO2 DCX D
 DCX H
 DCR C
 JNZ CO1
 RET
*
*
RMOV LDAX D
 DCX D
 CMP C
 RZ
 MOV M,A
 DCX H
 JMP RMOV
*
*
*
*
ADEC LXI H,0
ADE1 LDAX B
 ORA A
 RZ
 MOV D,H
 MOV E,L
 DAD H
 DAD H
 DAD D
 DAD H
 SUI 48
 CPI 10
 CMC
 RC
 MOV E,A
 MVI D,0
 DAD D
 INX B
 JMP ADE1
*
*
AHEX LXI H,0
AHE1 LDAX B
 CALL MAP  MAP FROM LOWER TO UPPER CASE
 ORA A
 RZ
 DAD H
 DAD H
 DAD H
 DAD H
 CALL AHS1
 CPI 10H
 CMC
 RC
 ADD L
 MOV L,A
 INX B
 JMP AHE1
*
*
AHS1 SUI 48
 CPI 10
 RC
 SUI 7
 CPI 10
 RNC
 MVI A,-1
 RET
*
*
AOCT LXI H,0
AOC1 LDAX B
 ORA A
 RZ
 DAD H
 DAD H
 DAD H
 SUI '0'
 CPI 8
 CMC
 RC
 ADD L
 MOV L,A
 INX B
 JMP AOC1
*
*
ABIN LXI H,0
ABI1 LDAX B
 ORA A
 RZ .
 DAD H
 SUI '0'
 CPI 2
 CMC .
 RC .
 ADD L
 MOV L,A
 INX B
 JMP ABI1
*
BINH LXI H,HCON
BINH0 MOV B,A
 RAR
 RAR
 RAR
 RAR
 CALL BIN1
 MOV M,A
 INX H
 MOV A,B
 CALL BIN1
 MOV M,A
 RET
*
*
BIN1 ANI 0FH
 ADI 48
 CPI 58
 RC
 ADI 7
 RET
*
*
ADOUT MOV A,D
 RAL
 MOV C,A
 MOV A,D
 CALL DUMO
 MOV A,C
 RAR
 MOV A,E
*
*
DUMO CALL BINH
 LXI H,HCON
 MOV B,M
 CALL OUT8
 INX H
 MOV B,M
*
*
OUT8 LDA SNUM
 PUSH H
 PUSH D
 PUSH B
 LHLD SBPTR  PLACE BYTE IN SBUF
 MOV M,B
 INX H
 SHLD SBPTR
 POP B
 POP D
 POP H
 RET
*
****************************************
*
*
* THIS ROUTINE CHECKS THE LEGAL OPCODES IN BOTH PASS 1 AND
* PASS 2. IN PASS 1 THE PROGRAM COUNTER IS INCREMENTED BY
* THE CORRECT NUMBER OF BYTES. AN ADDRESS IS ALSO SET SO
* THAT AN INDEXED JUMP CAN BE MADE TO PROCESS THE OPCODE
* FOR PASS2.
*
*
OPCD CALL SOPC  SEARCH OPTAB FOR MATCH OF OPBUF
 LDA IFFLG  IF FLAG SET?
 ORA A
 JNZ OPCD1  YES-CHECK FOR IF OR ENDF PSEUDO-OPS
*
 LHLD ASPC  GET PC
 LDAX D  GET TYPE
 ANI 3  MASK FOR BYTE COUNT
 ADD L  ADD TO PC
 MOV L,A
 MVI A,0
 ADC H
 MOV H,A
 SHLD ASPC  STORE NEW PC
*
 LDA PASI  PASS 1?
 ORA A
 JNZ OPCD2  NO-CONTINUE
 LDAX D  GET TYPE/BYTE COUNT
 ANI 0DCH  IS IT A PSEUDO OP (TYPE=0)?
 RNZ .  NO-DON'T PROCCESS OPS IN PASS 1
*
OPCD2 LDAX D  GET TYPE
 ANI 0FCH  MASK OUT BYTE COUNT
 RRC .  ROTATE TO GET TABLE ADDRESS
 RRC .
 LXI H,OPTJT  ADD TO OP TYPE JUMP TABLE BASE
 ADD L
 MOV L,A
 INX D
 LDAX D  GET VALUE (BINARY OF OPCODE)
 STA TEMP  SAVE VALUE
 PCHL .  DO INDEXED JUMP TO TYPE HANDLERS
*
*
*   IF FLAG SET, CHECK FOR IF OR ENDF
*
OPCD1 LDAX D  GET TYPE
 ORA A
 JNZ IFLTS  NOT-PSEUDO, GO CHECK FOR IF LIST FLAG
 INX D
 LDAX D  GET OPCODE VALUE
 CPI IFCOD  IF PSEUDO OP?
 JZ IFPRC  YES
 CPI EFCOD  ENDF PSEUDO OP?
 JZ ENDIF  YES
 JMP IFLTS  NEITHER-CHECK FOR IF LIST FLAG
*
**********
*
*
*   SEARCH OPCODE TABLE
*   (OPBUF IS AT END OF OPTAB SO THAT IF)
*   (BAD OPCODE IS USED, WILL MATCH ON ITSELF)
*   (THIS SAVES TEST FOR END IN LOOP FOR SPEED)
*
SOPC LXI H,OPBUF  COPY ABUF INTO OPBUF
 LXI D,ABUF
 LXI B,ABUF+4  IS OPCOD LENGTH LESS THAN 4?
 LDAX B
 ORA A
 JZ SOPC4  YES-SKIP AHEAD
 POP PSW  NO-OPCODE ERROR,GET RID OR RET ADR
 JMP OERR
*
*
SOPC4 LDAX D
 ORA A
 JZ SOPC5  DONE COPY
 CALL MAP
 MOV M,A
 INX D
 INX H
 JMP SOPC4
*
*
SOPC5 MVI M,' '  ENDFILL OPBUF WITH BLANKS
 INX H
 MVI M,' '
 INX H
 MVI M,' '
 MVI A,57H  SET OPBUFS TYPE TO 57-OPCODE ERROR
 STA OPBUF+4  IN CASE IT IS FIRST MATCH
*
*   HASH
*
 LXI H,OPBUF
 MOV A,M
 INX H
 XRA M
 INX H
 XRA M
 INX H
 XRA M
 ANI 1FH
*
*   SET TO PROPER GROUP
*
 LXI D,OPHSH
 ADD A
 MOV L,A
 MVI H,0
 DAD D
 XCHG .
 LDAX D
 MOV L,A
 INX D
 LDAX D
 MOV H,A
*
*   START LINEAR SEARCH
*
 MVI B,4
SOPC1 LXI D,OPBUF
 MOV C,B
SOPC2 LDAX D
 CMP M
 JNZ SOPC3  NON-MATCH
 INX H
 INX D
 DCR C
 JNZ SOPC2
*   MATCH
 XCHG .
 RET .
*
*
*   NON-MATCH
*
SOPC3 MOV E,C  ADD OVER REMAINDER OF ENTRY
 INR E
 INR E
 MVI D,0
 DAD D
 JMP SOPC1  GO CHECK NEXT ENTRY
*
*
*   OPCODE HASH TABLE
*
OPHSH DW HASH0
 DW HASH1
 DW HASH2
 DW HASH3
 DW HASH4
 DW HASH5
 DW HASH6
 DW HASH7
 DW HASH8
 DW HASH9
 DW OPBUF  NO HASH TO HERE
 DW HASHB
 DW HASHC
 DW HASHD
 DW HASHE
 DW HASHF
 DW HAS10
 DW HAS11
 DW HAS12
 DW HAS13
 DW HAS14
 DW HAS15
 DW HAS16
 DW HAS17
 DW HAS18
 DW HAS19
 DW HAS1A
 DW OPBUF  NO HASH TO HERE
 DW HAS1C
 DW HAS1D
 DW HAS1E
 DW HAS1F   WHEW..THAT WAS BORING TO TYPE
*
*
*   OPCODE TYPE JUMP TABLE
*
OTJLN EQU 24  LENGTH OF OPTJT
BNDC2 EQU >$  256 BOUNDRY CHECK
BNDC3 EQU BNDC2+OTJLN-1
*
 IF <BNDC3  (WANT TO USE 8 BIT MATH)
 DS >0-$
 ENDF
*
OPTJT JMP PSEU
 JMP ASTO
 JMP TYP2
 JMP TYP3
 JMP TYP4
 JMP TYP5
 JMP TYP6
 JMP ERRO  NO MATCH TILL OPBUF FOUND
*
****************************************
*
*
*   OPCODE ERROR
*
OERR LXI B,3  LEAVE 3 BYTES FOR PATCH
 LHLD ASPC
 DAD B
 SHLD ASPC
 JMP ERRO
*
*
*   LABEL ERROR
*
LERR LXI B,3  LEAVE 3 BYTES FOR PATCH
 LHLD ASPC
 DAD B
 SHLD ASPC
 JMP ERRL
*
*
PSEU LXI H,ABUF+4  SET BUFFER ADDRESS
 MOV A,M  FETCH CHARACTER AFTER OPCODE
 ORA A  SHOULD BE A ZERO
 JNZ OERR
 LDAX D
 CPI 15
 JZ ENDIF
 CPI 14
 JZ IFPRC
 LDA IFFLG
 ORA A
 JNZ IFLTS  IGNORE IF IF FLAG SET
 LDA PASI  PASS INDICATOR
 ORA A
 JZ PSU1
 JMP PSU2
*
****************************************
*
*
* THIS ROUTINE IS USED TO PROCESS LABELS
*
* IT CHECKS WHETHER A LABEL IS IN THE SYMBOL TABLE OR NOT
* ON RETURN Z=1 MEANS A MATCH WAS FOUND AND H,L CONTAIN THE
* ASSOCIATED WITH THE LABEL. OTHERWISE D,E POINT TO THE NEX
* LOCATION IN THE TABLE. THE REGISTER NAMES A,B,C,D,E,H,L,M
* ARE PREDEFINED BY THE SYSTEM AND NEED NOT BE ENTERED BY T
* ON RETURN C=1 INDICATES A LABEL ERROR
*
SLAB MOV D,A  SAVE CHARACTER
 LDA IFFLG  IF FLAG SET?
 ORA A
 MOV A,D
 JNZ SLAB2  YES-JUST SKIM OVER LABLE AND RETURN
 CPI 'A'  CHECK FOR LEGAL CHARACTER
 RC .  RETURN IF ILLEGAL CHARACTER
 CPI 'z'+1  CHECK FOR ILLEGAL CHARACTER
 CMC
 RC .  ILLEGAL CHARACTER
 LXI D,ABUF
 CALL ALPS  PLACE SYMBOL IN BUFFER
 LXI H,ABUF  SET BUFFER ADDRESS
 LDA PASI  GET PASS INDICATOR
 CPI 2
 INR A  RESET ZERO FLAG
 RNC
 DCR B  CHECK IF ONE CHARACTER
 JNZ SLA1
*
* CHECK IF PREDEFINED REGISTER NAME
*
 MOV A,M  FETCH CHARACTER
 CALL MAP  UPSHIFT
 CPI 'M'+1
 JNC SLA1  NOT 'A'-'M'
 SUI 'A'  CONVERT INTO TABLE INDEX
 LXI H,RTAB
 ADD L  (ONLY NEED 8-BIT ADD, RTAB CROSSES NO BOUNDRIES)
 MOV L,A  INDEX INTO TABLE
*
 MOV A,M  GET VALUE FROM TABLE
 ORA A  IS IT -1?
 JM SLA1  YES-NOT REGISTER VALUE
 MOV L,A  NO-IS REGISTER VALUE
 MVI H,0  MOVE VALUE INTO HL
 XRA A  RESET CARRY, SET ZERO FLAGS
 RET
*
*
*  CHECK SYMBOL TABLE FOR LABEL
*
*  (LOOP NOT USED IN SRCH TO SAVE TIME)
*  (ABUF COPIED TO END TO SAVE TIME)
*  (IE-NO NEED TO CHECK FOR END IN LOOP)
*
SLA1 LXI D,ABUF  COPY ABUF TO END OF SYMTAB
 LHLD STEND
 MVI C,5
*
SLA2 LDAX D
 MOV M,A
 INX H
 INX D
 DCR C
 JNZ SLA2
*
 LDA PASI  SPECIAL SEARCH IN PASS 2
 CPI 1
 JNZ SLA22
*
 LDA ABUF  GET FIRST CHAR OF SYM
 CPI 'Z'+1  LOWER CASE?
 JC SLA21
 SUI 32  UPSHIFT
*
SLA21 SUI 65  REL TO ZERO
 MOV L,A
 MVI H,0
 DAD H  *2
 LXI D,HASHT  ADDR OF HASH TABLE
 DAD D  INDEX IN
 MOV A,M  GET ADDR OF A GROUP OF SYMBOLS
 INX H
 MOV H,M
 MOV L,A
 JMP SRCH
*
SLA22 LXI H,SYMAD  POINT TO START OF SYMTAB
 JMP SRCH  SEARCH THROUGH IT
*
*
SRCH0 DAD B  ADD TO NEXT ENTRY OF SYMTAB
SRCH LXI D,ABUF  POINT TO LABLE LOOKING FOR
 LDAX D
 CMP M
 JZ SRCH1  MATCH 1ST LETTER
 LXI B,LLAB+2
 JMP SRCH0
*
*
SRCH1 INX H
 INX D
 LDAX D
 CMP M
 JZ SRCH2  MATCH 2ND LETTER
 LXI B,LLAB+2-1
 JMP SRCH0
*
*
SRCH2 INX H
 INX D
 LDAX D
 CMP M
 JZ SRCH3  MATCH 3RD LETTER
 LXI B,LLAB+2-2
 JMP SRCH0
*
*
SRCH3 INX H
 INX D
 LDAX D
 CMP M
 JZ SRCH4  MATCH 4TH LETTERR
 LXI B,LLAB+2-3
 JMP SRCH0
*
*
SRCH4 INX H
 INX D
 LDAX D
 CMP M
 JZ SRCH5  MATCH 5TH LETTER
 LXI B,LLAB+2-4
 JMP SRCH0
*
*
SRCH5 LDA STEND+1  PAST END OF TABLE?
 CMP H
 JC NMTCH  YES
 JNZ MATCH
 LDA STEND
 CMP L
 JC NMTCH  YES
*
MATCH XCHG
 LHLD STEND  REMARK END OF SYMTAB WITH A ZERO
 MVI M,0
 INX D
 LDAX D  GET VALUE
 MOV H,A
 INX D
 LDAX D
 MOV L,A
 XRA A  SET ZERO (MATCH) FLAG
 RET
*
*
*   NO MATCH
*
NMTCH LHLD STEND  REMARK END OF SYMTAB WITH A ZERO
 MVI M,0
 XCHG .  SET DE TO POINT TO END OF SYMTAB
 XRA A  RESET CARRY FLAG (NO ERROR)
 INR A  RESET ZERO FLAG (NO MATCH)
 RET .
*
*
*  SCAN OVER LABEL AND IGNORE IT
*
SLAB2 CPI ' '+1  END OF LABEL?
 INX H
 MOV A,M
 JNC SLAB2   NOT YET
 DCX H  NOW
 SHLD PNTR
 CMC .  RESET CARRY (ERROR) FLAG
 RET .
*
*
****************************************
*
*
* THIS ROUTINE SCANS THE INPUT LINE AND PLACES THE OPCODES
* AND LABELS IN THE BUFFER. THE SCAN TERMINATES WHEN A
* CHARACTER OTHER THAN 0-9 OR A-Z IS FOUND
*
ALPS MVI B,0  SET COUNT
ALP1 STAX D  STORE CHARACTER IN BUFFER
 INR B  INCREMENT COUNT
 MOV A,B  FETCH COUNT
 CPI 34  MAXIMUM BUFFER SIZE
 RNC .  BUFFER FILLED
 INX D  INCREMENT BUFFER
 INX H  INCREMENT INPUT ADDRESS
 SHLD PNTR  SAVE LINE POINTER
 MOV A,M  FETCH CHARACTER
 CPI '0'  CHECK FOR LEGAL CHARACTERS
 RC
 CPI '9'+1
 JC ALP1
 CPI 'A'
 RC
 CPI 'z'+1
 JC ALP1
 RET
*
****************************************
*
* THIS ROUTINE IS USED TO SCAN THROUGH THE INPUT LINE TO
* FETCH THE VALUE OF THE OPERAND FIELD. ON RETURN THE VALUE
* OF THE OPERAND IS CONTAINED IN REGISTERS H,L.
*
ASBL CALL SBLK  GET FIRST ARGUMENT
ASCN LHLD PNTR  GET LINE POINTER
 XRA A
 STA GTLT
 MOV A,M  GET FIRST CHARACTER
 LXI H,0
 SHLD OPRD  INITIALIZE OPERAND
 INR L
 MOV H,A
 SHLD OPRI  INITIALIZE OPERAND INDICATOR
*
NXT1 LHLD PNTR  FETCH SCAN POINTER
 DCX H
 CALL ZBUF  CLEAR BUFFER
 STA SIGN  ZERO SIGN INDICATOR
*
NXT2 INX H  INCREMENT POINTER
 MOV A,M  FETCH NEXT CHARACTER
 CPI '<'
 JNZ NXT1A
 STA GTLT
 JMP NXT2
*
*
NXT1A CPI '>'
 JNZ NXT1B
 STA GTLT
 JMP NXT2
*
NXT1B CPI ' '+1
 JC SEND  JUMP IF CR OR BLANK
 CPI ','  FIELD SEPARATOR
 JZ SEND
*
*    CHECK FOR OPERATORS
*
 CPI '+'  CHECK FOR PLUS
 JZ NXT3
 INR B
 CPI '-'  CHECK FOR MINUS
 JZ NXT3
 INR B
 CPI '*'
 JZ NXT3
 INR B
 CPI '/'
 JNZ NXT4
*
NXT3 MOV A,B
 STA SIGN
 LDA OPRI  FETCH OPERAND INDICATOR
 CPI 2  CHECK FOR TWO OPERATORS
 JZ ERRS  SYNTAX ERROR
 MVI A,2
 STA OPRI  SET INDICATOR
 JMP NXT2
*
*
*   CHECK FOR OPERANDS
*
NXT4 MOV C,A  SAVE CHARACTER
 LDA OPRI  GET INDICATOR
 ORA A  CHECK FOR TWO OPERANDS
 JZ ERRS  SYNTAX ERROR
 MOV A,C
 CPI '$'  LC EXPRESSION
 JNZ ASC3
 INX H  INCREMENT POINTER
 SHLD PNTR  SAVE POINTER
 LHLD ASPC  FETCH LOCATION COUNTER
 JMP AVAL
*
*
*   CHECK FOR ASCII CHARACTERS
*
ASC3 CPI ''''  CHECK FOR SINGLE QUOTE
 JNZ ASC5  JUMP IF NOT QUOTE
 LXI D,0  GET A ZERO
 MVI C,3  CHARACTER COUNT
*
ASC4 INX H  INCREMENT POINTER
 SHLD PNTR  SAVE
 MOV A,M  FETCH NEXT CHARACTER
 CPI CR  IS IT A CR
 JZ ERRA  ARGUMENT ERROR
 CPI ''''  IS IT A QUOTE
 JNZ SSTR
 INX H  INCREMENT POINTER
 SHLD PNTR  SAVE
 MOV A,M  FETCH NEXT CHARACTER
 CPI '''' CHECK FOR 2 QUOTES IN A ROW
 JNZ AVAL+1  TERMINAL QUOTE
*
SSTR DCR C  CHECK COUNT
 JZ ERRA  TOO MANY CHARACTERS
 MOV D,E
 MOV E,A  SET CHARACTER IN BUFFER
 JMP ASC4
*
*
ASC5 CPI '0'  CHECK FOR NUMERIC
 JC ERRA  ILLEGAL CHARACTER
 CPI '9'+1
 JNC ALAB
 CALL NUMS  GET NUMERIC VALUE
 JC ERRA  ARGUMENT ERROR
*
AVAL XCHG
 LHLD OPRD
 XRA A  GET A ZERO
 STA OPRI  STORE IN OPERAND INDICATOR
 LDA SIGN  GET SIGN INDICATOR
 CPI 1
 JZ ASUB
 JNC AMULT
 DAD D  FORM RESULT
*
ASC7 SHLD OPRD  SAVE RESULT
 JMP NXT1
*
*
*  SUBTRACT
*
ASUB MOV A,L
 SUB E
 MOV L,A
 MOV A,H
 SBB D
 MOV H,A
 JMP ASC7
*
*
*  MULTIPLY
*
AMULT MOV B,D
 MOV C,E
 XCHG
 LXI H,0
 CPI 3
 JZ ADIV
 CALL MULT
 JMP ASC7
*
*
MULT MVI A,16
MULT1 DAD H
 XCHG
 DAD H
 XCHG
 JNC MULT2
 DAD B
MULT2 DCR A
 JNZ MULT1
 RET
*
*
*  DIVIDE
*
ADIV MOV A,B
 ORA C
 JZ ASC7  DIVIDE BY ZERO
 CALL DIV
 XCHG
 JMP ASC7
*
*
DIV MVI A,16  SET BIT COUNT
DIV1 STA SCNT
 DAD H  ROTATE BUFFER
 XCHG
 DAD H  ROTATE DIVIDEND
 XCHG
 JNC DIV2
 INX H
*
DIV2 MOV A,L
 SUB C
 MOV L,A
 MOV A,H
 SBB B
 MOV H,A
 INX D  ASSUMED 1 IN QUOTIENT
 JNC DIV3
 DAD B  RESTORE DIVIDEND
 DCX D
*
DIV3 LDA SCNT  GET BIT COUNT
 DCR A
 JNZ DIV1
 RET
*
*
ALAB CALL SLAB
 JZ AVAL
 JC ERRA  ILLEGAL SYMBOL
 LDA PASI
 CPI 2
 JC ERRU  UNDEFINED SYMBOL
*
 XCHG
 LHLD SYMSAV  ADDRESS OF NEXT SYMBOL
 MVI C,LLAB
 CALL SEAR  CHECK FOR REFERENCE
 JNZ SLA6
 LXI H,SCNT  GET LINE COUNT
 INR M
 LDA XLNSZ  COMPARE WITH MAX XTAB LINE SIZE
 DCR A
 CMP M  LINE FILLED
 JNC SLA4
 MVI M,1  INITIALIZE COUNT
 CALL SOUT  IF LINE FULL OUTPUT IT
 MVI C,LLAB+12
 CALL BLKO
*
SLA4 LXI H,IBUF-5
 MVI C,4
SLA5 MOV B,M
 CALL OUT8  OUTPUT LINE NUMBER
 INX H
 DCR C
 JNZ SLA5
 CALL BLK1
SLA6 XRA A  SET ZERO FLAG
 MVI H,0  SET SYMBOL VALUE
 JMP AVAL
*
*
* GET HERE WHEN TERMINATION CHARACTER IS FOUND. BLANK,COMMA
* CHECK FOR LEADING FIELD SEPARATOR
*
SEND LDA OPRI  FETCH OPERAND INDICATOR
 ORA A  SET FLAGS
 JNZ ERRS  SYNTAX ERROR
 LHLD OPRD
 LDA GTLT  GET GREATER LESS THAN FLAG
 CPI 3CH  IS IT GREATER THAN
 JNZ SEN0
 MOV L,H
 JMP SEN2
*
*
SEN0 CPI 3EH  IS IT LESS THAN
 JNZ SEN1
*
SEN2 MVI H,0  SET HIGH ORDER 0
SEN1 MOV A,H  GET HIGH ORDER BYTE
 LXI D,TEMP  SET ADDRESS
 ORA A
 RET
*
*
* GET A NUMERIC VALUE WHICH IS EIGHER HEXADECIMAL OR DECIMA
* ON RETURN CARRY SET INDICATES AN ERROR
*
NUMS CALL ALPS  GET NUMERIC
 DCX D
 LDAX D  GET LAST CHARACTER
 CALL MAP  MAP FROM LOWER TO UPPER CASE
 LXI B,ABUF  SET BUFFER ADDRESS
 CPI 'H'  IS IT HEXADECIMAL
 JZ NUM2
 CPI 'Q'  IS IT OCTAL
 JZ NUM3
 CPI 'O'  IS IT OCTAL
 JZ NUM3
 CPI 'B'  BINARY?
 JZ NUM6
 CPI 'D'  IS IT DECIMAL
 JNZ ADEC
*
 XRA A  GET A ZERO
 STAX D  CLEAR D FROM BUFFER
 JMP ADEC  CONVERT DECIMAL VALUE
*
*
NUM2 XRA A  GET A ZERO
 STAX D  CLEAR H FROM BUFFER
 JMP AHEX  CONVERT HEX
*
*
NUM3 XRA A
 STAX D
 JMP AOCT
*
*
NUM6 XRA A
 STAX D
 JMP ABIN
*
*
*   PROCESS REGISTER ERROR
*
ERRR MVI A,'R'  GET INDICATOR
 STA OBUF+18  SET IN OUTPUT BUFFER
 CALL UPERR  INCREMENT ERROR COUNT
 LXI H,0  GET A 0
 RET
*
*
*   PROCESS SYNTAX ERROR
*
ERRS MVI A,'S'  GET INDICATOR
 STA OBUF+18  STORE IN OUTPUT BUFFER
 LDA PASI
 ORA A
 JZ ERRS1
 CALL UPERR  INCREMENT ERROR COUNT
ERRS1 LXI H,0  GET A ZERO
 JMP SEN1
*
*
*  PROCESS UNDEFINED SYMBOL ERROR
*
ERRU MVI A,'U'  GET INDICATOR
 JMP ERRS+2
*
*  PROCESS VALUE ERROR
*
ERRV MVI A,'V'  GET INDICATOR
 JMP ERRR+2
*
*  PROCESS MISSING LABEL ERROR
*
ERRM MVI A,'M'  GET INDICATOR
 STA OBUF+18  STORE IN OUTPUT BUFFER
 CALL UPERR  INCREMENT ERROR COUNT
 JMP LOUT  DISPLAY ERROR
*
*  PROCESS ARGUMENT ERROR
*
ERRA MVI A,'A'  GET INDICATOR
 JMP ERRS+2
*
*
*  PROCESS OPCODE ERROR
*  STORE 3 BYTES OF ZERO IN OBJECT CODE TO PROVIDE FOR A PA
*
ERRO MVI A,'O'  GET INDICATOR
 STA OBUF+18  STORE IN OUTPUT BUFFER
 LDA PASI  FETCH PASS INDICATOR
 ORA A  WHICH PASS
 RZ .  IF PASS 1
 MVI C,3  NEED 3 BYTES
ERO1 XRA A  GET A ZERO
 CALL ASTO  PUT IN LISTING AND MEMORY
 DCR C
 JNZ ERO1
 CALL UPERR  INCREMENT ERROR COUNT
 RET
*
*   PROCESS LABEL ERROR
*
ERRL MVI A,'L'  GET INDICATOR
 JMP ERRO+2
*
*   PROCESS DUPLICATE LABEL ERROR
*
ERRD MVI A,'D'  GET ERROR INDICATOR
 STA OBUF+18  STORE IN OUTPUT BUFFER
 CALL LOUT  DISPLAY ERROR
 CALL UPERR  INCREMENT ERROR COUNT
 JMP OPC  PROCESS OPCODE
*
*
UPERR LDA PASI
 CPI 2
 RZ .  DON'T COUNT IF PASS 3
 LXI H,ERCNT
 INR M
 RET .
*
*******************
*
*
*   THIS ROUTINE IS USED TO FORMAT THE ASSEMBLY LISTING
*
FORMT LDA LFMT  CHECK TO SEE IF FORMATTING DESIRED
 ORA A
 RZ .  IF NOT-RETURN
 MVI C,0
 LXI H,IBUF  LINE ADDRESS
 MOV A,M  GET FIRST CHARACTER
 CPI '*'  COMMENT
 RZ
 CPI ';'  COMMENT
 RZ .
 MVI B,2
 CALL FRSUB  FORMAT LINE
 RC
 INR B  MORE FORMAT
 CALL FRSUB  FORMAT LINE
 RC
 MVI D,2
 JMP FRSUA
*
*
FRSUB MVI D,1
FRSUA MOV A,B
 ADD D
 MOV B,A
 LDA TERMW
 SUI 2
 JZ PDDER  ZERO IS RIGHT ON
 JNC BOVER
 DCR B
 JMP PDDER
*
*
BOVER MOV A,D  GET VALUE OF D
 RAL
 ADD B
 MOV B,A
PDDER MOV A,B
 ADI 5
 MOV B,A
*
FRSU0 MOV E,D
FRSU3 INR C  INCREMENT CHARACTER COUNT
 MOV A,M  GET NEXT CHARACTER
 CPI ' '
 RC .  RETURN IF CR
 INX H
 JNZ FRSU0
 DCR E
 JNZ FRSU3
*
FRSU1 INR C
 MOV A,M  GET NEXT CHARACTER
 CPI ' '  LOOK FOR NON BLANK
 RC
 INX H
 JZ FRSU1
 MOV A,C
 SUB B
 RNC
 DCX H
 DCX H
 MVI C,0
 MOV M,C  SET MOVE STOP
 MOV C,A
*
 MOV L,C
 MVI H,0FFH
 MVI C,0
 LXI D,IBUF+IBFLN  END OF BUFFER ADDRESS
 DAD D
 XCHG
 CALL RMOV  FORMAT LINE
 XCHG
FRSU2 INX H
 MVI M,' '  REPLACE STOP WITH A BLANK
 MOV A,L
 CMP E
 JNZ FRSU2
 INX H
 INX H
 MOV C,B
 RET
*
****************************************
*
*
*  GET FILE NAME/UNIT FOR COPY PSEUDO
*     OPEN FILE AND RETURN # IN A
*
NAME INX H
 LXI D,NBUF  TEMP NAME BUFFER
 XRA A
 STA FTEMP  CLEAR TEMP HOLDER
*
 MVI C,11  MAX CHR COUNT+1
NAMEB MOV A,M
 CPI ' '+1  CHK FOR BLNK / CR
 JC ZFIL  YES--ALSO END OF NAME
 INX H
 CALL NAMEC
 JZ ERR7  > 8 CHR IN NAME
 JMP NAMEB
*
*
NAMEC STAX D  PUT CHR IN NBUF
 DCR C  CHR COUNT
 RZ
 INX D
 RET
*
*
ZFIL XRA A  ZERO FILE NAME TO 11 CHARACTERS
ZFIL2 CALL NAMEC
 JNZ ZFIL2
*
 SHLD NAMWK  SAVE BUFR ADDRESS
 LXI D,NBUF
 CALL SAVNAME  PUT NAME IN TITLE
 LXI D,NBUF  POINT TO NAME
 LXI H,0   STATIC BUFFER
 CALL SYS  OPEN UP
 DB OPEOP
 CALL ERROP
 LHLD NAMWK  GET BUFR ADDRESS
 RET  .  WITH FILE NUMBER IN HAND
*
*
****************************************
*
*
*    THE FOLLOWING CODE IS USED TO ORDER THE SYMBOL TABLE
*    SO SEARCHING DURING PASS TWO WILL BE FASTER
*
ORDER LXI H,SYMAD  INIT SOME POINTERS
 SHLD STP  SYM TAB POINTER
 SHLD SPTR  SEARCH POINTER
 XCHG
 LXI H,HASHT
 SHLD HASP  HASH TABLE POINTER
 MVI C,26  LOOP 26 TIME TO INIT THE HASH TABLE
ORD01 MOV M,E  LOW
 INX H
 MOV M,D  THE HIGH
 INX H
 DCR C
 JNZ ORD01
 MVI A,'A'-1
 STA CCHR  CURRENT CHARACTER
*
*  LOOP HERE TO ORDER ON EVERY LETTER OF THE ALPHABET
*
ORD02 LDA CCHR  NEXT CHARACTER
 INR A
 STA CCHR
 CALL ORD1  DO A PASS FOR THE CURRENT CHARACTER
 LHLD SPTR  TEST FOR END OF SYMBOL TBALE
 XCHG
 LHLD STEND
 CALL HDCMP  HL-DE
 RZ .  END OF TABLE, ALL DONE
 LDA CCHR
 CPI 'Z'  HAVE WE DONE THEM ALL?
 RZ .  YES, ALL DONE
 JMP ORD02
*
*
*  THIS IS THE LOOP FOR EACH CHARACTER
*
ORD1 LHLD STP  SYM TAB PTR
 XCHG
 LHLD HASP  HASH TABLE POINTER
 MOV M,E  PLACE CURRENT STP IN HASH TABLE
 INX H
 MOV M,D
 INX H
 SHLD HASP  UPDATE HASH TABLE POINTER
*
*  LOOP HERE TO DO EACH ENTRY IN THE SYM TAB
*
ORD03 CALL ORD2  DO ONE ENTRY
 LHLD SPTR
 XCHG
 LHLD STEND
 CALL HDCMP  END OF SYM TAB?
 JNZ ORD03  NO, CONTINUE
*
*  DONE WITH THIS CURRENT CHARACTRER, RESET FOR NEXT SEARCH AND
*  RETURN
*
 LHLD STP  SET SPTR TO STP
 SHLD SPTR
 RET
*
*
*    THIS PART DOES THE PROCESSING FOR EACH ENTRY IN
*    THE SYM TAB
*
ORD2 LHLD SPTR  GET CHARACTER OF THIS ENTRY
 MOV A,M
 CPI 'Z'+1  LOWER CASE?
 JC ORD28
 SUI 32  UP SHIFT
ORD28 LXI H,CCHR
 CMP M  FOUND?
 JNZ ORD05  NO, SEARCH
*
*  MATCH FOUND
*
 LHLD STP
 MVI C,7
*
*  THIS LOOP EXCHANGES TWO SYM TAB ENTRIES
*
ORD04 MOV A,M
 LHLD SPTR
 MOV B,M
 MOV M,A
 INX H
 SHLD SPTR
 LHLD STP
 MOV M,B
 INX H
 SHLD STP
 DCR C  ALL 7 CHARACTERS
 JNZ ORD04
 RET .  DONE WITH THIS ONE
*
*  MATCH NOT FOUND
*
ORD05 LHLD SPTR
 LXI D,7
 DAD D
 SHLD SPTR  MOVE TO NEXT ENTRY
 RET
*
*
*  HL-DE COMPARE
*
HDCMP MOV A,H
 CMP D
 RNZ
 MOV A,L
 CMP E
 RET
*
*
*
****************************************
*
*        OUTPUT HEADER AT TOP OF PAGE
*
PGHEAD LXI H,PCNT  GET PAGE COUNT
 MOV A,M
 INR M  BUMP PAGE COUNT
 CALL DECOT  CONVERT TO ASCII DECIMAL
 STA PGMES+7  SAVE IT
 XCHG .
 SHLD PGMES+5
*
 CALL PHCLR  CLEAR HEADER BUFFER
 LXI D,FNMSG  COPY "FILE:" TO OUTPUT BUFFER
 CALL PHL  AT LEFT MARGIN
 LHLD NAMPTR  FOLLOW WITH THE FILE NAME
 LXI D,-9
 DAD D
 XCHG .
 CALL PHL2
 LXI D,TITLBUF  COPY TITLE INTO OUTPUT BUFFER
 CALL PHC  AT CENTER OF LINE
 INX D
 PUSH D  SAVE POINTER TO 2ND TITLE LINE
 LXI D,PGMES  COPY PAGE NUMBER INTO OUTPUT BUFFER
 CALL PHR  AT RIGHT MARGIN
 LXI D,HBUF  PRINT OUT OUTPUT BUFFER
 MOV A,C  GET FILE NUMBER
 CALL LINEOUT
*
 CALL PHCLR  CLEAR OUTPUT BUFFER
 LXI D,DNMSG  COPY "DISK:" TO OUTPUT BUFFER
 CALL PHL  AT LEFT MARGIN
 LHLD NAMPTR  FOLLOW BY THE DISK NAME
 LXI D,-18
 DAD D
 XCHG .
 CALL PHL2
 POP D  GET POINTER TO 2ND TITLE LINE
 CALL PHC  AT CENTER OF LINE
 LXI D,DATE  COPY DATE INTO OUTPUT BUFFER
 CALL PHR  AT RIGHT MARGIN
 LXI D,HBUF  PRINT OUT OUTPUT BUFFER
 MOV A,C  GET FILE NUMBER
 CALL LINEOUT
 LXI D,CRLF  FOLLOW WITH BLANK LINE
 MOV A,C
 CALL LINEOUT
*
 LDA PGCNT  BUMP LINE COUNT
 ADI 3
 STA PGCNT
 RET .
*
*
PHCLR  LXI D,HBUF+134  CLEAR OUTPUT BUFFER
 MVI B,134
 MVI A,' '
 JMP ZBU1
*
PHL LXI H,HBUF  COPY TO LEFT MARGIN OF OUTPUT BUFFER
 JMP MOVE
*
PHL2 LXI H,HBUF+7  COPY TO COLUMN 8 OF OUTPUT BUFFER
 JMP MOVE
*
PHC LXI H,HBUF+31  COPY TO CENTER OF OUTPUT BUFFER
 LDA TERMW  CENTER DEPENDS ON WIDTH OF TERMINAL
 CPI 2
 JC PHC1
 LXI H,HBUF+40
 JZ PHC1
 LXI H,HBUF+66
PHC1 PUSH D  COUNT NUMBER OF CHARACTERS
PHC2 LDAX D
 ORA A
 JZ PHC3
 INX D
 LDAX D
 ORA A
 JZ PHC3
 INX D
 DCX H
 JMP PHC2
PHC3 POP D
 JMP MOVE
*
PHR LXI H,HBUF+62  COPY TO RIGHT MARGIN OF OUTPUT BUFFER
 LDA TERMW
 CPI 2
 JC PHR1
 LXI H,HBUF+70
 JZ PHR1
 LXI H,HBUF+122
PHR1 CALL MOVE
 LXI D,CRLF  FOLLOW WITH CRLF
 CALL MOVE
 RET .
*
MOVE LDAX D  MOVE FROM AT DE TO AT HL
 ORA A  UNTILL A ZERO BYTE IS HIT
 RZ .
 MOV M,A
 INX D
 INX H
 JMP MOVE
*
*
LINEOUT PUSH B
 LXI B,255  OUTPUT LINE
 MVI L,0AH  UNTILL LINEFEED
 CALL SYS
 DB DWROP
 CALL ERR0
 POP B
 RET .
*
*         CONVERT 8 BIT NUMBER TO ASCII DECIMAL
*         NUMBER INPUT IN A,  ASCII OUPUT IN E,D,A.
*
DECOT PUSH B
 MOV L,A
 XRA A
 STA SWCH  NO CHRS YET
 MVI C,100
 CALL NCON
 MOV E,B
 MVI C,10
 CALL NCON
 MOV D,B
 MOV A,L
 ADI '0'
 POP B
 RET .
*
NCON MOV A,L
 MVI B,'0'
NXTCO SUB C
 JC OUTB
 INR B
 ORA A
 JNZ NXTCO
 JMP OUTIT
OUTB ADD C
OUTIT  MOV L,A
 MOV A,B
 CPI '0'
 JZ OUTN
 LDA SWCH
 INR A
 STA SWCH
OUTN LDA SWCH
 ORA A
 RNZ .
 MVI B,' '
 RET .
*
*
SAVNAME LHLD NAMPTR  SAVE FILE / DISK NAMES FOR HEADER
 MVI C,17  FIRST BLANK OUT
SAVN0 MVI M,' '
 INX H
 DCR C
 JNZ SAVN0
 MVI M,0
 LXI B,-9
 DAD B
 MVI M,0
 INX H
SAVN1 LDAX D
 ORA A
 JZ SAVN2
 CPI '/'
 JZ SAVN3
 MOV M,A
 INX D
 INX H
 JMP SAVN1
*
SAVN2 LHLD SYSGLO  GET DEFAULT UNIT NUMBER
 LXI D,GLUNI
 DAD D
 MOV A,M
 ADI '0'
 JMP SAVN4
*
SAVN3 INX D  GET UNIT NUMBER FROM AFTER NAME
 LDAX D
*
SAVN4 STA SGLONAME+9  GET DISK NAME FOR PAGE HEADER
 LXI D,SGLONAME
 LXI H,0
 CALL SYS  OPEN "SYSGLOBL"
 DB OPEOP
 CALL ERR0
*
 LXI B,DNAMP  SPACE FORWARD TO DISK NAME
 MVI D,1
 CALL SYS
 DB SPAOP
 CALL ERR0
*
 LXI B,8  READ DISK NAME
 LHLD NAMPTR  INTO SECOND LINE OF LEFT MARGIN
 XCHG .
 CALL SYS
 DB RBLOP
 CALL ERR0
*
 CALL SYS  CLOSE "SYSGLOBL"
 DB CLOOP
 CALL ERR0
 LHLD NAMPTR  BUMP NAME STACK POINTER
 LXI D,18
 DAD D
 SHLD NAMPTR
 RET .
*
*
HEADINIT LHLD SYSGLO  GET SYSTEM DATE FOR PAGE HEADER
 LXI D,GLDAT
 DAD D
 XCHG .
 CALL UNPACK  UNPACK DIGITS
 SHLD DATE
 CALL UNPACK
 SHLD DATE+3
 CALL UNPACK
 SHLD DATE+6
 RET .
*
UNPACK LDAX D  UNPACK BCD DIGITS
 ANI 0FH
 ADI '0'
 MOV H,A
 LDAX D
 RLC .
 RLC .
 RLC .
 RLC .
 ANI 0FH
 ADI '0'
 MOV L,A
 INX D
 RET .
*
****************************************
*
*
*   ARGUMENT SCANNER
*
GARGS POP H  GET RETURN ADDRESS
 SHLD RETAD  SAVE IT
*
 MVI A,PSOP  PSCAN-OPEN
 STA PSTYPE
 LXI H,INUM
 CALL GANAM  GET <IN-FILE>
 CZ ERR1  ERROR--NEED <IN-FILE>
 PUSH PSW  SAVE DELIMITER
 LXI D,PSBUF  COPY IN-FILE NAME FOR DEFAULT PAGE TITLE
 CALL SAVNAME  SAVE NAME FOR TITLE
 POP PSW
 CALL CKDLM  CHECK DELIMITER
*
 LXI H,LNUM
 CALL GANA0  GET <LIST-FILE>
 CALL CKDLM  CHECK DELIMITER
*
 CALL GASTI  SET TYPE AND BLKSZ IN CASE OF CREATE
 LXI H,BNUM
 CALL GANA0  GET <BIN-FILE>
 CALL CKDLM  CHECK DELIMITER
*
 CALL GASTL  SET TYPE AND BLKSZ IN CASE OF CREATE
 LXI H,ENUM
 CALL GANA0  GET <ERROR-FILE>
 CALL CKDLM  CHECK DELIMITER
*
 LXI H,SNUM
 CALL GANA0  GET <SYMBOL-FILE>
 CZ GARG6  IF NONE, CHECK FOR '='
 CALL CKDLM  CHECK DELIMTIER
 MVI A,PSONE
 CALL SCAN
 LXI H,PSBUF  PLACE IN PSBUF IN CASE OF ERROR
 MOV M,A
 INX H
 MVI M,0
 CALL MAP  MAP FROM LOWER TO UPPER CASE
 CPI 'S'  IF SOMETHING AFTER SFILE, MUST BE "S="
 CNZ ERR5
 MVI A,PSONE
 CALL SCAN
 LXI H,PSBUF  PLACE IN PSBUF IN CASE OF ERROR
 MOV M,A
 INX H
 MVI M,0
 CPI '='
 CZ GAOPS
 CALL ERR5  ERROR BAD SYNTAX
*
GARG6 CPI '='  WAS IT '='?
 RNZ .  NO
 LDA LNUM  YES-SET SNUM TO LNUM
 STA SNUM
 MVI A,PSONE
 CALL SCAN  GET NEXT INPUT CAHARCTER
 LXI H,PSBUF  PLACE IN PSBUF IN CASE OF ERROR
 MOV M,A
 INX H
 MVI M,0
 RET .
*
*
**********
*
*
GANA0 MVI A,PSCO  PSCAN-CREATE AND OPEN
 STA PSTYPE
GANAM PUSH H  SAVE FILE NUMBER STORAGE ADDRESS
GANA3 LDA PSTYPE  GET TYPE OF PSCAN WANTED
 CALL SCAN  PSCAN FOR FILE NAME
 PUSH PSW  SAVE FLAGS
 CPI '='  CHECK FOR "S="
 JNZ GANA1  NO-SKIP AHEAD
 LDA PSBUF
 CALL MAP  MAP FROM LOWER CASE TO UPPER CASE
 CPI 'S'  IS 'S' FIRST THING IN PSBUF?
 JZ GANA2  YES-GO GET OPTIONS
*
GANA1 POP PSW
 POP H  RESTORE FILE NUMBER STORAGE ADDRESS
 RZ .  IF NOTHING INPUTTED, RETURN
 JMP SAVFN  SAVE FILE NUMBER AT ADDRESS IN HL
*
*
*   "S=" INPUTTED, GET OPTIONS
*
GANA2 POP PSW
 CALL GAOPS
 JMP GANA3
*
*
*
SCAN LXI D,PSBUF
 CALL PSCAN
 PUSH PSW
 JNZ SCAN1  HIT DELIMITER RIGHT AWAY?
 STA PSBUF  YES-STORE AT PSBUF FOR USE IN ERROR MESSAGES
 MVI A,0
 STA PSBUF+1  FOLLOW WITH ZERO TO MARK END
*
SCAN1 POP PSW
 RNC .  RETURN IF NO ERROR
 MOV A,E
 ORA A
 CZ ERR5  IF ZERO--ERROR BAD SYNTAX
 CALL ERROR  ELSE, PTDOS ERROR
*
**********
*
* CHECK FILE NUMBER AND STORE AT ADDRESS IN HL
*
SAVFN PUSH PSW  SAVE DELIMITER
 MOV A,D
 ORA A
 CNZ ERR6  ERROR-BAD FILE NUMBER
 MOV A,E
 CPI 0FFH
 CZ ERR7  ERROR-BAD FILE NAME
 MOV M,A  SAVE FILE NUMBER
 POP PSW  RESTORE DELIMITER
 RET .
*
**********
*
* CHECK DELIMITER (IN ACC) FOR ',' ';' OR CR.  IF ','
* RETURN, IF ';' OR CR-PROCESS ARGS THEN JUMP TO RETAD
*
CKDLM CPI ','
 RZ .
 POP H  REMOVE 1ST RETURN ADDRESS
 CPI ';'
 JZ GAEND
 CPI CR
 JZ GAEND
 CALL ERR5  ERROR-BAD SYNTAX
*
**********
*
* GET <OPTIONS>
*
GAOPS MVI A,'+'
 STA OPSGN  RESET OPTION SIGN TO '+' AS DEFAULT
 MVI A,PSONE  PSCAN-ONE CHARACTER
 CALL SCAN  GET OPTION
 LXI H,PSBUF  PLACE IN PSBUF IN CASE OF ERROR
 MOV M,A
 INX H
 MVI M,0
 CPI '+'
 JZ OPTPL
 CPI '-'
 JZ OPTMN
 CPI ','  DONE WITH OPTIONS?
 RZ .
 CPI ';'  DONE WITH ALL ARGUMENTS?
 JZ GAEND
 CPI CR  DONE WITH ALL ARGUMENTS?
 JZ GAEND
 CPI '0'
 JZ OPTZE
 CPI '1'
 JZ OPTNM
 CPI '2'
 JZ OPTNM
 CPI '3'
 JZ OPTNM
*
GAOP2 CALL MAP  MAP FROM LOWER TO UPPER CASE
 LXI D,GALT-1  GET LOOKUP TABLE POINTER
 LXI H,GAFT-1  GET FLAG TABLE POINTER
 MOV B,A  SAVE CHARACTER SCANNED
*
GAOP3 INX D  MOVE POINTER
 INX H  MOVE POINTER
 LDAX D  GET TABLE ENTRY
 CPI 0  END OF TABLE?
 CZ ERR4  YES-ERROR-ILLEGAL OPTION
 CMP B  IS IT ONE WE WANT?
 JNZ GAOP3  NO-CONTINUE THROUGH TABLE
 LDA OPSGN  ELSE, FOUND MATCH-SO SAVE OPTION
 MOV M,A  SIGN IN IT'S FLAG TABLE ENTRY
 JMP GAOPS  GO FOR NEXT OPTION
*
*****
*
*
OPTMN MVI A,'-'  WAS '-', SO SET OPSGN
 STA OPSGN
OPTPL MVI A,PSONE  IF WAS '+' OPSGN ALREADY SET
 CALL SCAN  GET OPTION TO BE SET
 LXI H,PSBUF  PLACE IN PSBUF IN CASE OF ERROR
 MOV M,A
 INX H
 MVI M,0
 JMP GAOP2  GO FIND AND SET OPTION
*
*
OPTZE XRA A
 STA LFMT
 JMP GAOPS
*
*
OPTNM SBI '0'
 STA TERMW
 JMP GAOPS
*
*
GASTI MVI A,'.'  TYPE I.
 STA FTYP
 LXI H,256D  BLOCK SIZE = 256D
 SHLD FBLSZ
 RET .
*
*
GASTL MVI A,'.'+80H  TYPE .
 STA FTYP
 LXI H,4C0H  BLOCK SIZE = 4C0H
 SHLD FBLSZ
 RET .
*
*****
*   MAP LOWER CASE LETTERS TO UPPER CASE
*
MAP CPI 'a'
 RC
 CPI 'z'+1
 RNC
 SUI 'a'-'A'
 RET .
**********
*
*
* DONE WITH GETTING ARGUMENTS, PROCESS THEM
*
GAEND LDA AOFLG
 ORA A
 CZ CMPAO  IF A OPTION WAS NOT SPECIFIED CALC IT
 LDA LOFLG
 ORA A
 CZ CMPLO  IF L OPTION WAS NOT SPECIFIED CALC IT
*
 LXI D,0  COMPUTE WHERE TO READ INTO RLINE
 LDA LOFLG
 CPI '+'
 JNZ GAEN1
 LXI D,-5  IF THERE ARE LINE #, SUBTRACT 5
*
GAEN1 LDA AOFLG
 CPI '+'
 JNZ GAEN2
 DCX D  IF ALS8 FORMAT, SUBTRACT 1
*
GAEN2 LXI H,IBUF  SUBTRACTIONS ARE FROM IBUF
 DAD D
 SHLD RLINE
*  IF LNUM=ENUM, CHANGE ENUM TO 0FFH
 LDA LNUM
 LXI H,ENUM
 CMP M
 JNZ GAEN3  IF NOT EQUAL OK-SKIP AHEAD
 MVI M,0FFH  ELSE, SET ENUM TO 0FFH
*
GAEN3 LDA TERMW  GET OUTPUT WIDTH (1,2,OR 3)
 CPI 3
 JNZ GAEN4  IF NOT 3, LEAVE AS DEFAULT (4,12)
 MVI A,7  ELSE, SET TO WIDER VALUES
 STA SLNSZ  7 SYMBOLS PER LINE OF SYMTAB OUTPUT
 MVI A,21
 STA XLNSZ  21 ADDRESS PER LINE OF XREF OUTPUT
*
GAEN4 LDA POFLG  PAGNATION WANTED?
 CPI '+'
 CZ HEADINIT  YES-SET UP PAGE HEADER
*
 LHLD RETAD  GET RETURN ADDRESS
 PCHL .  RETURN
*
*
*****
*
*
*  COMPUTE FROM INUM IF ALS8 FORMAT OR NOT
*
CMPAO CALL CMPRD  READ IN FIRST FEW LINES
 MVI A,'+'
 STA CMFLG  SET FLAG SO CMPLO KNOWS LINES IN MEMORY
 STA AOFLG  ASSUME '+' TILL DISPROVEN
 LXI H,SYMA1+1-1  POINT TO BYTES READ
 MVI B,0
*
CMPA1 INX H
 MOV A,M
 DCR A
 JZ CMPA1  IGNORE 1'S
 MOV C,A
CMPA2 INX H
 MOV A,M
 DCR C
 JZ CMPA3
 CPI CR
 JZ CMPA4
 JMP CMPA2
CMPA3 CPI CR
 JZ CMPA1
*
CMPA4 XCHG .  CHECK TO SEE IF PAST END OF READ IN DATA
 LHLD RDCNT
 DAD D
 RC .  IF SO, THEN IS ALS8 FORMAT
 MVI A,'-'  ELSE, IS NOT ALS8 FORMAT
 STA AOFLG
 RET .
*
*****
*
*
* COMPUTE FROM INUM IF IT HAS LINE NUMBERS OR NOT
*
CMPLO LDA CMFLG  ARE 1ST FEW LINES IN MEMORY(FROM CMPAO)?
 ORA A
 JNZ CMPL1
 CALL CMPRD  IF NOT, READ THEM IN
*
CMPL1 MVI A,'+'
 STA LOFLG  ASSUME '+' TILL DISPROVEN
 LXI H,SYMA1+1-1  POINT TO BYTES READ
*
CMPL2 INX H
 MVI C,4  WILL CHECK 1ST 4 COLUMNS
 LDA AOFLG  IS IT ALS8 FORMAT?
 CPI '+'
 JNZ CMPL3  NO-CONTINUE
 MOV A,M  YES-CHECK FOR BYTE COUNT=1
 CPI 1
 JZ CMPL2  IS SO IGNORE THAT LINE
 INX H  SKIP OVER BYTE COUNT
*
CMPL3 MOV A,M
 CPI ' '+1  CHECK FOR INVALID NUMBER FIELD
 JC CMPL6  VALID
 CPI '0'
 JC CMPL5  NOT VALID
 CPI '9'+1
 JNC  CMPL5  NOT VALID
*
CMPL6 CPI CR
 JZ CMPL2
 INX H
 DCR C
 JNZ CMPL3
*
CMPL4 MOV A,M
 INX H
 CPI CR
 JNZ CMPL4  SKIP TILL CR
 JMP CMPL2  GO CHECK NEXT LINE
*
*
CMPL5  XCHG .
 LHLD RDCNT  CHECK TO SEE IF PAST END OF DATA READ
 DAD D
 RC .  YES-THEN IT HAS LINE NUMBERS
 MVI A,'-'  NO-IT DOESN'T HAVE LINE NUMBERS
 STA LOFLG
 RET
*
*****
*
*
* READ IN SOME LINES FROM INUM INTO SYMA1+1
*
CMPRD LDA INUM
 LXI B,2048
 LXI D,SYMA1+1  USE SYMBOL TABLE AS SCRATCH BUFFER
 CALL SYS  DO THE READ
 DB RBLOP
 CALL EOFTS
 MVI A,CR  PUT CR AT END TO MARK IT
 STAX D
*
 MOV A,E  CALCULATE -(ENDING ADDRESS) "RDCNR"
 CMA .  COMPLEMENT LOW BITS
 MOV L,A
 MOV A,D
 CMA .  COMPLEMENT HIGH BITS
 MOV H,A
 INX H  AND ADD ONE TO GET TWOS COMPLIMENT
 SHLD RDCNT
*
 LDA INUM
 MVI D,0
 CALL SYS  REWIND INUM
 DB SPAOP
 CALL ERR0
 XRA A
 STA EOFLG  CLEAR EOFLG,DON'T USE IT HERE
 RET .
*
*
*   END OF FILE ERROR TEST
*
EOFTS CPI EREOF
 JNZ ERR0  IF NOT EOF, THEN REAL ERROR
 MVI A,TRUE
 STA EOFLG  SET EOFLG AND RETURN
 RET .
*
*
****************************************
*
*   DONE--TIE UP LOOSE ENDS AND EXIT
*
DONE CALL ERROT  OUTPUT NUMBER OF ASSEMBLY ERRORS
 CALL LBCOT  OUTPUT NUMBER OF SYMBOLS DEFINED
 LDA INUM
 CALL CLOSE
 MVI A,-1
 STA XLIST
 LDA LNUM
 CALL EXCLUDE  ADD LNUM TO LIST OF FILES TO EOF AND CLOSE
 LDA BNUM
 CALL EXCLUDE
 LDA ENUM
 CALL EXCLUDE
 LDA SNUM
 CALL EXCLUDE
 CALL XEOF  EOF ALL OUTPUT FILES
 CALL XCLOSE  CLOSE ALL OUTPUT FILES
 CALL RERTRAP  RESTORE ERROR TRAPS
 CALL SYS
 DB RETOP
*
DONE1 CALL RESTOR
 CALL SYS
 DB RESOP
*
ERROT LDA ERCNT  OUTPUT # OF ASSEMBLY ERRORS
 ORA A
 JZ ERRO1
 CALL DECOT
 STA ERCMS+2
 XCHG .
 SHLD ERCMS
ERRO1 LXI D,ERCMS
 CALL PRINT
 RET .
*
LBCOT LXI H,LBCNT  OUTPUT # OF SYMBOLS DEFINED
 LXI D,LBCMS
 MVI C,3
 MVI B,0
LBCO1 MOV A,M
 CPI '0'
 JNZ LBCO2
 MOV A,B
 ORA A
 JZ LBCO3
 MVI A,'0'
 JMP LBCO2
LBCO3 DCR B
 MVI A,' '
LBCO2 STAX D
 INX H
 INX D
 INR B
 DCR C
 JNZ LBCO1
 MOV A,M
 STAX D
 LXI D,LBCMS
 CALL PRINT
 RET .
*
EOF CPI 0FFH  FILE OPEN?
 RZ .  NO-RETURN
 CALL SYS
 DB EOFOP
 CALL ERR0
 RET .
*
CLOSE CPI 0FFH
 RZ .
 CALL SYS
 DB CLOOP
 CALL ERR0
 RET .
*
CPYCL LDA CPYSS
 CPI 0FFH
 RZ .
 CALL CLOSE
 CALL CPYPO
 JMP CPYCL
*
*
EXCLUDE CPI 0FFH  MAKE LIST OF ALL OUTPUT FILE NUMBERS
 RZ .
 MOV B,A
 LXI H,XLIST
EXCL1 MOV A,M
 CPI -1  END OF LIST?
 JZ EXCL2  YES
 INX H
 CMP B  FILE NUMBER ALLREADY IN LIST?
 JNZ EXCL1  NOT YET-KEEP SEARCHING
 RET .  YES-DON'T PUT IT IN
EXCL2 MOV M,B  ADD FILE NUMBER TO END OF LIST
 INX H
 MVI M,-1
 RET .
*
XEOF LXI H,XLIST  EOF ALL FILE NUMBERS IN XLIST
XEOF1 MOV A,M
 CPI -1
 RZ .
 CALL EOF
 INX H
 JMP XEOF1
*
XCLOSE LXI H,XLIST  CLOSE ALL FILE NUMBERS IN XLIST
XCLO1 MOV A,M
 CPI -1
 RZ .
 CALL CLOSE
 INX H
 JMP XCLO1
*
****************************************
*
*   ERROR HANDLER
*
*   ERR0 IS FOR PTDOS ERRORS,OTHERS FOR ASSM ARG ERRORS
*
ERR0 STA ERCOD SAVE ERROR NUMBER
 CALL RESTOR  RESTORE SYSTEM
 POP H
 DCX H
 DCX H
 DCX H
 DCX H
 MOV A,M  GET COMMAND CODE (BYTE AFTER CALL SYS)
 STA CMCOD
 LXI H,-1
 MVI A,00H
 JMP ER2
*
*
 DB WBLOP
ERRWB CALL ERR0  WRITE BYTE ERROR
*
ERROP STA ERCOD  OPEN ERROR FROM NAME ROUTINE
 MVI A,OPEOP
 STA CMCOD
 LXI H,PSBUF  COPY NBUF TO PSBUF FOR ERR MESSAGE
 LXI D,NBUF
ERRP1 LDAX D
 MOV M,A
 INX H
 INX D
 ORA A
 JNZ ERRP1
 LXI H,-1  DON'T WANT 2ND LINE TO PRINT IN UTIL
 MVI A,80H  RETURN AFTER CALL TO UTIL
 JMP ER2
*
**********
*
ERR1 MVI A,ERNAX  NAME EXPECTED
 JMP ER
ERR4 MVI A,ERIOS  ILLEGAL OPTION SPECIFIER
 JMP ERROR
ERR5 MVI A,ERSYN  IMPROPER SYNTAX
 JMP ER
ERR6 MVI A,ERIFI  ILLEGAL FILE NUMBER
 JMP ERROR
ERR7 MVI A,ERINA  ILLEGAL FILE NAME
 JMP ERROR
ERR8 LXI D,MSG4  BAD ALS8 FILE STRUCTURE
 CALL PRINT
 JMP ER3
*
ER LXI H,PSBUF  THIS ENTRY DON'T WANT ARROW,BUF TO PRINT
 MVI M,' '  STORE BLANK AT PSBUF SO ARROW,BUF WON'T PRINT
*
ERROR LXI H,-1  THIS ENTRY DON'T WANT 2ND ERROR LINE
 STA ERCOD
 LXI D,MSG0  " ASSM "
 PUSH H
 CALL PRINT
 POP H
 MVI A,84H  RETURN AFTER CALL TO UTIL
*
ER2 CALL UTIL
 DB UXOP
 JMP ER3
CMCOD DB -1  COMMAND CODE NUMBER
ERCOD DB 0  ERROR CODE NUMBER
*
 LDA PSBUF  GET FIRST CHARACTER IN PSCAN BUFFER
 CPI ' '+1  IS IT A PRINTING CHARACTER?
 JC ER3  NO-DON'T PRINT ARROW,BUFFER
 LXI D,MSG3  POINT TO "->(PSCAN INPUT BUFFER)"
 MVI A,'-'
 STAX D
 INX D
 MVI A,'>'
 STAX D
 INX D
 MVI A,' '
 STAX D
 DCX D
 DCX D
 CALL PRINT
 MVI A,CR
 CALL CONOUT
 MVI A,LF
 CALL CONOUT
*
ER3 CALL RESTOR  RESTORE SYSTEM
 CALL SYS
 DB SREOP
*
**********
*
*   PRINT MESSAGE AT DE TO CONSOLE
*
PRINT LDAX D
 ORA A
 RZ .  MESSAGE IS TERMINATED WITH A ZERO BYTE
 CALL CONOUT
 INX D
 JMP PRINT
*
****************************************
*
*   RESTORE SYSTEM TO ORIGIONAL STATE AFTER ERROR
*
RESTOR LDA INUM  CLOSE <IN-FILE>
 CALL ECLOSE
 MVI A,-1
 STA INUM
 LDA LNUM  CLOSE <LIST-FILE>
 CALL ECLOSE
 MVI A,-1
 STA LNUM
 LDA BNUM  CLOSE <BIN-FILE>
 CALL ECLOSE
 MVI A,-1
 STA BNUM
 LDA ENUM  CLOSE <ERROR-FILE>
 CALL ECLOSE
 MVI A,-1
 STA ENUM
 LDA SNUM  CLOSE <SYMBOL-FILE>
 CALL ECLOSE
 MVI A,-1
 STA SNUM
 CALL ECPYCL  CLOSE ALL COPY FILES
 CALL RERTRAP  RESTORE ERROR TRAPS
 RET .
*
RERTRAP LHLD ERSWC  RESTORE ERROR TRAP WORDS
 XCHG .
 LHLD ERMPT
 MOV M,E
 INX H
 MOV M,D
 RET .
*
*
ECLOSE CPI 0FFH  IS IT OPEN?
 RZ .  NO-RETURN
 CALL SYS
 DB CLOOP
 NOP  IGNORE ERRORS
 NOP
 NOP
 RET .
*
*
ECPYCL LDA CPYSS  CLOSE ALL COPY FILES
 CPI 0FFH  DONE YET?
 RZ .  YES-ALL CLOSED
 CALL ECLOSE  CLOSE THIS ONE
 CALL CPYPO  POP THIS ONE FRMO STACK
 JMP ECPYCL  GO CLOSE NEXT ONE
*
****************************************
*
*
*        STORAGE AND TABLE AREA
*
* ARGUMENT OPTION LOOKUP TABLE(SAME ORDER AS GAFT,END W/0)
*
GALT DB 'A'
 DB 'L'
 DB '#'
 DB 'P'
 DB 'X'
 DB 'H'
 DB 0
*
* ARGUMENT OPTION FLAG TABLE (SAME ORDER AS GALT)
*
GAFT EQU $
AOFLG DB 0  A OPTION FLAG
LOFLG DB 0  L OPTION FLAG
NOFLG DB '-'  # OPTION FLAG
POFLG DB '-'  P OPTION FLAG
XOFLG DB '-'  X OPTION FLAG
HOFLG DB '+'  H OPTION FLAG
*
*                               0  NO ADDITIONAL SPACING
*                               1  72 COL. OUTPUT
*                               2  80 COL. OUTPUT(DEFAULT)
*                               3  132 COL. OUTPUT
*
OPSGN DB '+'  OPTION SIGN-USED TO HOLD WHAT WILL GO IN GAFT
*
LINO ASC "0000"  LINE NUMBERS GENERATED FOR # OPTION
PGCNT DB 1  COUNT OF LINES USED FOR PAGNATION
PCNT DB 1  COUNT OF PAGES PRINTED
SLNSZ DB 4  # OF SYMBOLS PER LINE OF SYMTAB LISTING
XLNSZ DB 12  # OF SYMBOLS PER LINE OF XREF LISTING
*
SGLONAME ASC "SYSGLOBL/ "
 DB 0
*
FTYP DB '.'+80H  INITIALLY TYPE .
FBLSZ DW 4C0H  INITIALLY BLKSZ = 4C0H
 DB 0  ATTRIBUTES: NONE
PSBUF DS 20  PSCAN BUFFER
 DB 0  SAFTY PSBUF END MARKER
MSG3 EQU PSBUF-3  WHERE PRINTING SHOULD BEGIN IN ERROR MSG
*
MSG0 ASC "ASSM"
 DB 0
MSG4 ASC " ASSM ERROR:  BAD ALS8 FILE STRUCTURE "
 DB CR
 DB LF
 DB 0
*
FNMSG ASC "File:"
 DB 0
DNMSG ASC "Disk:"
 DB 0
TITLBUF DB 0,0  TITLE BUFFER
 DS 80
PGMES ASC "Page    "
 DB 0
NAMSG DS 20*6  STACK OF NAMES FOR TITLE
NAMPTR DW NAMSG  POINTER TO CURRENT ONE
DATE ASC "  /  /  "
 DB 0
*
STMSG DB 0DH,0AH,0DH,0AH
 ASC "            ASSM 1.1 (MOD 0)    8080  Disk Assembler"
 DB 0DH,0AH
 ASC "      Copyright (C) 1977  Processor Technology"
 ASC " Corporation"
 DB 0DH,0AH,0
*
ERCMS ASC " No assembly errors.                  "
 DB 0
LBCMS ASC "     labels were defined."
 DB 0DH,0AH,0
*
CRLF DB 0DH,0AH,0  ASCII CARRIAGE RETURN, LINEFEED
*
PSTYPE DB 0  TYPE OF PSCAN
RETAD DW 0  RETURN ADDRESS STORAGE FOR GARGS
IFFLG DB 0  IF FLAG
ILFLG DB 0  IFFLAG LIST SUPPRESSION FLAG
TERMW DB 2  TERMINAL WIDTH
ASFLG DB 1  ASCII LISTING NORMALLY ON
SWCH DB 0  FLAG USED IN OTITLE
LFMT DB 1
DBCNT DB 5  COUNT OF DB VLAUES PER LINE
*
CPYSS DB 0FFH  COPY FILE STACK
 DB 0FFH
 DB 0FFH
 DB 0FFH
 DB 0FFH
CPYNN EQU $-CPYSS  NUMBER IN COPY STACK
*
INUM DB -1
LNUM DB -1
BNUM DB -1
ENUM DB +1  DEFAULT IS CONSOLE
SNUM DB -1
PASI DB 0
ALST DB 0
ERCNT DB 0  COUNT OF ASSEMBLY ERRORS
LBCNT ASC "0000"  COUNT OF SYMBOLS DEFINED
XQFLG DB 0
CMFLG DB 0  FLAG USED IN CMPLO
EOFLG DB 0  END OF FILE FLAG
*
*
*        SYSTEM PARAMETER AREA
*
CIUNT DS 1
CONIT DS 1
XQADR DS 2
ASPC DS 2
PNTR DS 2
TABA DS 2
OPRD DS 2
OIND DS 2
SCNT DS 1
SYMSAV DS 2
TEMP DS 1
OPRI DS 2
SIGN DS 1
GTLT DS 1
FTEMP DS 1
NAMWK DS 2  "NAME" WK AREA
BBUF DS 2
ERSWC DS 2
ERMPT DW 0  POINTER TO SYSGLO LEVEL 2 ERROR TRAP WORD
CHARFL DW 0  ADDRESS OF SYSGLO CHARACTER FLAG
 DS 2  JUST IN CASE
*
*
*    SYSTEM BUFFERS
*
BUFR DS 64
NBUF DS 10
 DS 25
AREA DS 18
ABUF DS 35
OBUF DS 22  START OF OUTPUT BUFFER
 DS 5
IBUF DS IBFLN  INPUT BUFFER
 DB CR  SAFTY IBUF STOP
RLINE DW IBUF  POINTER TO START OF IBUF
SBUF DS 132  BUFFER FOR SYMBOL TABLE
SBPTR DW SBUF  POINTER INTO SBUF
HBUF DS 134  BUFFER FOR PAGE HEADER
HCON DS 4  STORAGE USED IN BINH
LADDR DS 2
BCOUNT DS 2  IMAGE BLOCK BYTE COUNT
BADDR DS 2  IMAGE BLOCK LOADING ADDRESS
COBUF DS 100  BINARY OUTPUT BUFFER
RDCNT DW 0  -(READ COUNT) USED IN CMPRD
XLIST DS 7  LIST OF FILES TO EOF AND CLOSE (USED IN DONE)
*
****************************************
*
*
*          OPCODE TABLE
*
*    TABLE HAS FOLLOWING FORM: 'MNEMONIC'(FILL WITH BLANKS
*   TO 4 CHARACTERS), TYPE/SIZE (TYPE IS DISPLACEMENT
*   FROM OPTJT FOR THE PROPER JUMP SHIFTED LEFT TWO
*   PLACES IE: FOR A TYP4 JUMP IT WOULD BE 30H)(SIZE IS
*   THE NUMBER OF BYTES THE INSTRUCTION TAKES IE: THE
*   TYP4 INSTRUCTION ABOVE IS A 1 BYTE INSTRUCTION,
*   ORING THIS IN TO THE TYPE/SIZE BYTE GIVES 31H),
*   OBJECT CODE (THE BINARY PRODUCED FOR THAT MNEMONIC).
*    PSEUDO OPS HAVE TYPE 0H, AND THE OBJECT BYTE IS
*   THIER NUMBER TESTED IN PSU1 AND PSU2.
*    THE ENTRIES ARE ARANGED ACCORDING TO HOW THEY GET
*   MAPPED BY THE HASHING FUNCTION (XORING THE 4 ASCII
*   LETTERS OF THE MNEMONIC THEN MASKING TO 5 BITS)
*   IE: 'MVI ' GETS HASHED AS 12H SO IT GOES UNDER HAS12.
*    NEW PSEUDOS MAY BE PLACED AT THE END SINCE IT WILL
*   BE SEARCHED FOR UNTILL THE END OF THE TABLE IS REACHED.
*   (BUT PUT IT BEFORE OPBUF)
*
HASH0 ASC 'CC  '  SORCE CODE
 DB T6  TYPE/BYTE SIZE
 DB 0DCH  OBJECT CODE
*
HASH1 ASC 'EQU '
 DB T0
 DB EQCOD
 ASC 'DAD '
 DB T3
 DB 9
 ASC 'ADD '
 DB T4
 DB 128
 ASC 'RAR '
 DB T1
 DB 31
*
HASH2 ASC 'CALL'
 DB T6
 DB 205
 ASC 'DDB '
 DB T0
 DB DDCOD
 ASC 'RP  '
 DB T1
 DB 0F0H
*
HASH3 ASC 'RET '
 DB T1
 DB 201
 ASC 'XRI '
 DB T5
 DB 238
 ASC 'RRC '
 DB T1
 DB 15
*
HASH4 ASC 'SUB '
 DB T4
 DB 144
 ASC 'RES '
 DB T0
 DB RSCOD
 ASC 'DAA '
 DB T1
 DB 39
 ASC 'STC '
 DB T1
 DB 55
*
HASH5 ASC 'NLST'
 DB T0
 DB NLCOD
 ASC 'COPY'
 DB T0
 DB CPCOD
 ASC 'TITL'
 DB T0
 DB TICOD
*
HASH6 ASC 'DB  '
 DB T0
 DB DBCOD
 ASC 'STA '
 DB T6
 DB 50
 ASC 'RNZ '
 DB T1
 DB 0C0H
 ASC 'ANI '
 DB T5
 DB 230
 ASC 'ADC '
 DB T4
 DB 136
*
HASH7 ASC 'JNC '
 DB T6
 DB 0D2H
 ASC 'JM  '
 DB T6
 DB 0FAH
 ASC 'SPHL'
 DB T1
 DB 249
 ASC 'IN  '
 DB T5
 DB 219
 ASC 'RPE '
 DB T1
 DB 0E8H
*
HASH8 ASC 'RZ  '
 DB T1
 DB 0C8H
 ASC 'XTHL'
 DB T1
 DB 227
*
HASH9 ASC 'LDA '
 DB T6
 DB 58
 ASC 'JC  '
 DB T6
 DB 0DAH
 ASC 'ENDF'
 DB T0
 DB EFCOD
*
HASHB ASC 'XRA '
 DB T4
 DB 168
 ASC 'ASCZ'
 DB T0
 DB AZCOD
 ASC 'LST '
 DB T0
 DB LSCOD
 ASC 'ACI '
 DB T5
 DB 206
*
HASHC ASC 'LHLD'
 DB T6
 DB 42
 ASC 'ADI '
 DB T5
 DB 198
 ASC 'EI  '
 DB T1
 DB 251
 ASC 'XEQ '
 DB T0
 DB XQCOD
*
HASHD ASC 'CMC '
 DB T1
 DB 63
 ASC 'RPO '
 DB T1
 DB 0E0H
 ASC 'DI  '
 DB T1
 DB 243
*
HASHE ASC 'CNC '
 DB T6
 DB 0D4H
 ASC 'ANA '
 DB T4
 DB 160
 ASC 'CM  '
 DB T6
 DB 0FCH
 ASC 'OUT '
 DB T5
 DB 211
*
HASHF ASC 'POP '
 DB T3
 DB 193
 ASC 'IF  '
 DB T0
 DB IFCOD
 ASC 'CMA '
 DB T1
 DB 47
 ASC 'SUI '
 DB T5
 DB 214
 ASC 'END '
 DB T0
 DB ENCOD
*
HAS10 ASC 'JZ  '
 DB T6
 DB 0CAH
 ASC 'HLT '
 DB T1
 DB 118
 ASC 'IFLS'
 DB T0
 DB FLCOD
*
HAS11 ASC 'LDAX'
 DB T2
 DB 10
 ASC 'RC  '
 DB T1
 DB 0D8H
 ASC 'ASC '
 DB T0
 DB ASCOD
 ASC 'NOP '
 DB T1
 DB 0
*
HAS12 ASC 'MVI '
 DB T5
 DB 6
*
HAS13 ASC 'SHLD'
 DB T6
 DB 34
 ASC 'DW  '
 DB T0
 DB DWCOD
 ASC 'CP  '
 DB T6
 DB 0F4H
 ASC 'SBB '
 DB T4
 DB 152
 ASC 'PAGE'
 DB T0
 DB PGCOD
*
HAS14 ASC 'MOV '
 DB T4
 DB 64
 ASC 'XCHG'
 DB T1
 DB 235
 ASC 'ORI '
 DB T5
 DB 246
*
HAS15 ASC 'INR '
 DB T4
 DB 4
 ASC 'DCR '
 DB T4
 DB 5
 ASC 'JPO '
 DB T6
 DB 0E2H
 ASC 'RST '
 DB T4
 DB 199
*
HAS16 ASC 'CPE '
 DB T6
 DB 0ECH
*
HAS17 ASC 'JMP '
 DB T6
 DB 0C3H
 ASC 'DS  '
 DB T0
 DB DSCOD
 ASC 'CNZ '
 DB T6
 DB 0C4H
 ASC 'PCHL'
 DB T1
 DB 233
 ASC 'ASCF'
 DB T0
 DB AFCOD
*
HAS18 ASC 'SBI '
 DB T5
 DB 222
*
HAS19 ASC 'CZ  '
 DB T6
 DB 0CCH
*
HAS1A ASC 'CPI '
 DB T5
 DB 254
 ASC 'JP  '
 DB T6
 DB 0F2H
 ASC 'ORG '
 DB T0
 DB ORCOD
*
HAS1C ASC 'ORA '
 DB T4
 DB 176
 ASC 'CPO '
 DB T6
 DB 0E4H
*
HAS1D ASC 'LXI '
 DB T6
 DB 1
 ASC 'RLC '
 DB T1
 DB 7
*
HAS1E ASC 'JNZ '
 DB T6
 DB 0C2H
 ASC 'PUSH'
 DB T3
 DB 197
 ASC 'STAX'
 DB T2
 DB 2
 ASC 'CMP '
 DB T4
 DB 184
*
HAS1F ASC 'INX '
 DB T3
 DB 3
 ASC 'DCX '
 DB T3
 DB 11
 ASC 'RM  '
 DB T1
 DB 0F8H
 ASC 'RNC '
 DB T1
 DB 0D0H
 ASC 'JPE '
 DB T6
 DB 0EAH
 ASC 'RAL '
 DB T1
 DB 23
*
OPBUF DS 9
*
*   DEFINITION OF TYPES
*   BITS 7-2 ARE OPTJT OFFSETS
*   BITS 1-0 ARE # OF BYTES IN INSTRUCTION
*
T0 EQU 0
T1 EQU 0DH
T2 EQU 19H
T3 EQU 25H
T4 EQU 31H
T5 EQU 3EH
T6 EQU 4BH
*
DBCOD EQU -1
ORCOD EQU 0
EQCOD EQU 1
DSCOD EQU 2
RSCOD EQU 2
DWCOD EQU 3
ENCOD EQU 4
PGCOD EQU 5
LSCOD EQU 6
NLCOD EQU 7
ASCOD EQU 8
TICOD EQU 9
XQCOD EQU 10
AFCOD EQU 11
DDCOD EQU 12
CPCOD EQU 13
IFCOD EQU 14
EFCOD EQU 15
FLCOD EQU 16
AZCOD EQU 17
*
STP DS 2  STM TAB PTR FOR ORDERING
SPTR DS 2  SEARCH POINTER FOR ORDERING
HASP DS 2  HASH TABLE POINTER FOR ORDERING
CCHR DS 1  CURRENT CHARACTER FOR ORDERING
*
****************************************
*
*
*          HASH TABLE
*
HASHT DS 26*2
*
****************************************
*
*
*          REGISTER TABLE
*
RTBLN EQU 13  LENGTH OF RTAB
BNDC0 EQU >$  BOUNDRY CHECK (WANT TO USE 8 BIT MATH)
BNDC1 EQU BNDC0+RTBLN-1
 IF <BNDC1
 DS >0-$
 ENDF
*
RTAB DB 7  'A'
 DB 0  'B'
 DB 1  'C'
 DB 2  'D'
 DB 3  'E'
 DB -1
 DB -1
 DB 4  'H'
 DB -1
 DB -1
 DB -1
 DB 5  'L'
 DB 6  'M'   END OF TABLE
*
****************************************
*
*
*          SYMBOL TABLE
*
STEND DW SYMA1  POINTER TO END OF SYMTAB
SYMAD ASC 'PSW'
 DW 0
 DDB 6  VALUE OF PSW
 ASC 'psw'
 DW 0
 DDB 6
 ASC 'SP'
 DB 0
 DW 0
 DDB 6
 ASC 'sp'
 DB 0
 DW 0
 DDB 6
SYMA1 DB 0  START OF THIS SYMBOL TABLE
*
