Oakland CPM Archive/oakcpm.iso/cpmug/cpmug018.ark/PROCSELF.ASM

Assembly Source File | 1985-02-10 | 46KB | 1,984 lines

;
;    THIS IS THE PROCESSOR TECHNOLOGY SELF CONTAINED SYSTEM
;      (ALSO CALLED SOFTWARE PACKAGE NO. 1)
;
; THIS ROUTINE INITILALIZES THE FILE AREA FOR SUBSEQUENT PROCESSING
;
    ORG    100H
INITA:
    MVI    A,3
    OUT    20Q
    MVI    A,21Q
    OUT    20Q        ;SET UP ACIA
    LXI    H,FILE0
    MVI    C,MAXFIL*FELEN
    XRA    A
INIT2:    MOV    M,A
    INX    H
    DCR    C
    JNZ    INIT2
;
; THIS IS THE STARTING POINT OF THE SELF CONTAINED SYSTEM ONCE
; THE SYSTEM HAS BEEN INITIALIZED.  COMMANDS ARE READ FROM THE USER,
; EXECUTED, AND CONTROL RETURNS BACK TO THIS POINT TO READ ANOTHER
; USER COMMAND.
;
SYS8:    LXI    SP,AREA+18
    CALL    READ        ;READ INPUT LINE
    INX    H
    MOV    A,M        ;FETCH FIRST CHARACTER
    CPI    '9'+1        ;COMMAND OR LINE NUMBER
    JC    LINE        ;JUMP IF LINE FOR FILE
    CALL    VALC        ;GET COMMAND VALUES
    CALL    COMM        ;CHECK LEGAL COMMANDS
EOR:    CALL    CRLF        ;GET HERE WHEN ROUTINE IS DONE
    JMP    SYS8
;
;
; THIS ROUTINE READS IN A LINE FROM THE TTY AND PLACES IT IN AN
; INPUT BUFFER
; THE FOLLOWING ARE SPECIAL CHARACTERS
;     CR    - TERMINATES READ ROUTINE
;     LF    - NOT RECOGNIZED BY ROUTINE
; CONTROL X - DELETE CURRENT LINE
; DEL       - DELETE CHARACTER
; ALL DISPLAYABLE CHARACTERS BETWEEN BLANK-Z AND THE ABOVE
; ARE RECOGNIZED BY THE READ ROUTINE.  ALL OTHERS ARE SKIPPED
; THE ROUTINE WILL NOT ACCEPT MORE CHARACTERS THAN THE INPUT
; BUFFER WILL HOLD.
;
READ:    LXI    H,IBUF        ;SET INPUT BUFFER ADDRESS
    SHLD    ADDS        ;SAVE ADDRESS
    MVI    E,2        ;INITIALIZE CHAR COUNT
NEXT:    CALL    IN8        ;READ A LINE
    MOV    A,B
    CPI    24        ;CHECK FOR CONTROL X
    JNZ    CR
    CALL    CRLF        ;OUTPUT A CRLF
    JMP    READ
CR:    CPI    ASCR        ;GET AN ASCII CR
    JNZ    DEL
    MOV    A,L
    CPI    IBUF AND 0FFH
    JZ    READ
    MVI    M,ASCR        ;PLACE CR AT END OF LINE
    INX    H
    MVI    M,1        ;PLACE OEF INDICATOR IN LINE
    INX    H
    MVI    A,IBUF+83
    CALL    CLER        ;CLEAR REMAINING BUFFER
    LXI    H,IBUF-1
    MOV    M,E        ;SAVE CHAR COUNT
    RET
DEL:    CPI    127        ;CHECK FOR DELETE CHAR
    JNZ    CHAR
    MVI    A,IBUF
    CMP    L        ;IS THIS FIRST CHAR
    JZ    NEXT
    DCX    H        ;DECR POINTER
    DCR    E        ;DECR COUNT
BSPA:    MVI    B,5FH
    CALL    OUT8
    JMP    NEXT
CHAR:    CPI    ' '        ;CHECK FOR LEGAL CHAR
    JC    NEXT
    CPI    'Z'+1
    JNC    NEXT
    MOV    B,A
    CALL    OUT8        ;ECHO CHAR
    MOV    M,A
    MVI    A,IBUF+81
    CMP    L        ;CHECK FOR END OF LINE
    JZ    BSPA
    INX    H
    INR    E        ;INCR CHAR COUNT
    JMP    NEXT
;
;
; THIS ROUTINE IS USED TO BLANK OUT A PORTION OF MEMORY
;
CLER:    CMP    L
    RZ
    MVI    M,' '
    INX    H
    JMP    CLER
;
; THIS ROUTINE IS USED TO READ BYTE OF DATA FROM THE UART
;
IN8:
    IN    20Q        ;GET STATUS
    RRC        ;MOVE INTO CARRY
    JNC    IN8
    IN    21Q        ;GET THE DATA
    ANI    7FH        ;MASK OFF PARITY BIT
    MOV    B,A
    RET
;
; THIS ROUTINE OUTPUTS A BYTE OF DATA TO THE UART
;
OUT8:
    IN    20Q        ;GET STATUS
    RRC
    RRC
    JNC    OUT8
OK:    MOV    A,B
    OUT    21Q        ;SEND OUT THE DATA
    RET
;
;  THIS ROUTINE WILL OUTPUT A CARRIAGE RETURN AND LINE FEED
; FOLLOWED BY TWO DELETE CHARACTERS WHICH PROVIDE TIME FOR A
; PRINT HEAD TO RETURN
;
CRLF:    MVI    B,13        ;CR
    CALL    OUT8
LF:    MVI    B,10        ;LF
    CALL    OUT8
    MVI    B,127
    CALL    OUT8
    CALL    OUT8
    RET
;
; THIS ROUTINE JUMPS TO A LOCATION IN MEMORY GIVEN BY THE
; INPUT COMMAND
;
EXEC:    CALL    VCHK        ;CHECK FOR PARAMETER
    CALL    CRLF
    LHLD    BBUF        ;FETCH ADDRESS
    PCHL        ;JUMP TO PROGRAM
;
; THIS ROUTINES CHECKS THE INPUT COMMAND AGAINST ALL LEGAL COMMANDS
; STORED IN A TABLE.  IF A LEGAL COMMAND IS FOUND A JUMP IS
; MADE TO THAT ROUTINE; OTHERWISE AN ERROR MESSAGE IS OUTPUT
; TO THE USER
;
COMM:    LXI    D,CTAB        ;COMMAND TABLE ADDRESS
    MVI    B,NCOM        ;NUMBER OF COMMANDS
    MVI    A,4        ;LENGTH OF COMMAND
    STA    NCHR        ;SAVE
    CALL    COMS        ;SEARCH TABLE
    JNZ    WHAT        ;JUMP IF ILLEGAL COMMAND
    PCHL        ;JUMP TO ROUTINE
;
; THIS ROUTINE CHECKS IF A BASE CHARACTER STRING IS EQUAL TO
; ANY OF THE STRINGS CONTAINED IN A TABLE POINTED TO BY
; D,E.  THE LENGTH OF THE STRINGS ARE <256.  ON RETURN IF THE
; ZERO FLAG IS SET A MATCH WAS FOUND; IF THE ZERO FLAG IS CLEAR,
; NO MATCH WAS FOUND.  REGISTER B CONTAINS THE NUMBER OF
; STRINGS TO COMPARE.
; THE TABLE CONSISTS OF ANY NUMBER OF CHARS, WITH 2 BYTES CONTAINING
; VALUES ASSOCIATED WITH IT.  IT CAN BE USED TO SEARCH THROUGH
; A COMMAND TABLE OR SYMBOL TABLE.
; ON RETURN D,E POINT TO THE LAST BYTE ASSOCIATED WITH THE CHARACTER
; STRING IF A MATCH WAS FOUND.  IF NO MATCH WAS FOUND, D,E POINT TO
; THE NEXT LOCATION AFTER THE END OF THE TABLE.
;
COMS:    LHLD    ADDS        ;FETCH COMPARE ADDRESS
    LDA    NCHR        ;GET LENGTH OF STRING
    MOV    C,A
    CALL    SEAR        ;COMPARE STRINGS
    LDAX    D
    MOV    L,A
    INX    D
    LDAX    D        ;FETCH VALUE
    MOV    H,A
    RZ
    INX    D        ;SET TO NEXT STRING
    DCR    B        ;DECR COUNT
    JNZ    COMS
    INR    B        ;CLEAR ZERO FLAG
    RET
;
; THIS ROUTINE CHECKS IF TWO CHARACTER STRINGS CONTAINED IN MEMORY
; ARE EQUAL.  THE STRINGS ARE POINTED TO BY H,L AND D,E.
; ON RETURN, THE ZERO FLAG SET INDICATES A MATCH. REGISTER C
; INDICATES THE LENGTH OF THE STRINGS.  ON RETURN, THE POINTERS
; POINT TO THE NEXT ADDRESS AFTER THE CHARACTER STRINGS
;
SEAR:    LDAX    D        ;FETCH CHAR
    CMP    M        ;COMPARE STRINGS
    JNZ    INCA
    INX    H
    INX    D
    DCR    C        ;DECR CHAR COUNT
    JNZ    SEAR
    RET
INCA:    INX    D
    DCR    C
    JNZ    INCA
    INR    C        ;CLEAR ZERO FLAG
    RET
;
; THIS ROUTINE ZEROS OUT A BUFFER IN MEMORY WHICH IS THEN
; USED BY OTHER SCANNING ROUTINES
;
ZBUF:    XRA    A        ;GET A ZERO
    LXI    D,ABUF+12        ;BUFFER ADDRESS
    MVI    B,12        ;BUFFER LENGTH
ZBU1:    DCX    D        ;DECR ADDR
    STAX    D        ;ZERO BUFFER
    DCR    B
    JNZ    ZBU1
    RET
;
; THIS ROUTINE CALLS ETRA TO OBTAIN THE INPUT PARAMETER VALUES
; AND CALLS AN ERROR ROUTINE IF AN ERROR OCCURS
;
VALC:    CALL    ETRA        ;GET INPUT PARAMETERS
    JC    WHAT        ;JUMP IF ERROR
    RET
;
; THIS ROUTINE EXTRACTS THE VALUES ASSOCIATED WITH A COMMAND
; FROM THE INPUT STREAM AND PLACES THEM IN THE ASCII BUFFER (ABUF)
; IT ALSO CALLS A ROUTINE TO CONVERT THE ASCII HEXADECIMAL TO BINARY
; AND STORES THEM IN THE BINARY BUFFER (BBUF)
; ON RETURN, CARRY SET INDICATES AN ERROR IN INPUT PARAMETERS
;
ETRA:    LXI    H,0        ;GET A ZERO
    SHLD    BBUF+2        ;ZERO VALUE
    SHLD    FBUF        ;SET NO FILE NAME
    CALL    ZBUF        ;ZERO BUFFER
    LXI    H,IBUF-1        ;INPUT BUFFER ADDRESS
VAL1:    INX    H
    MOV    A,M        ;FETCH INPUT CHAR
    CPI    ' '        ;LOOK FOR FIRST BLANK
    CMC
    RNC
    JNZ    VAL1        ;JUMP IF NO BLANK
    SHLD    PNTR        ;SAVE POINTER
    CALL    SBLK        ;SCAN TO FIRST PARAMETER
    CMC
    RNC        ;RETURN IF CR
    CPI    '/'
    JNZ    VAL5        ;NO FILE NAME
    LXI    D,FBUF        ;NAME FOLLOWS PUT IN FBUF
    MVI    C,NMLEN
VAL2:    INX    H
    MOV    A,M
    CPI    '/'
    JZ    VAL3
    DCR    C
    JM    WHAT
    STAX    D        ;STORE FILE NAME
    NOP
    INX    D
    JMP    VAL2
VAL3:    MVI    A,' '        ;GET AN ASCII SPACE
VAL4:    DCR    C
    JM    DONE
    STAX    D        ;FILL IN WITH SPACES
    INX    D
    JMP    VAL4
DONE:    CALL    SBL2
    CMC
    RNC
VAL5:    LXI    D,ABUF
    CALL    ALPS        ;PLACE PARAMETER IN BUFFER
    MOV    A,B        ;GET DIGIT COUNT
    CPI    5        ;CHECK NUMBER OF DIGITS
    CMC
    RC        ;RETURN IF TOO MANY DIGITS
    LXI    B,ABUF
    CALL    AHEX        ;CONVERT VALUE
    RC        ;ILLEGAL CHAR
    SHLD    BBUF        ;SAVE IN BINARY BUFFER
    LXI    H,ABUF
    CALL    NORM        ;NORMALIZE ASCII VALUE
    CALL    SBLK        ;SCAN TO NEXT PARAMETER
    CMC
    RNC        ;RETURN IF CR
    LXI    D,ABUF+4
    CALL    ALPS        ;PLACR PARAMETER IN BUFFER
    MOV    A,B
    CPI    5        ;CHECK NUMBER OF DIGITS
    CMC
    RC        ;RETURN IF TOO MANY DIGITS
    LXI    B,ABUF+4
    CALL    AHEX        ;CONVERT VALUE
    RC        ;ILLEGAL CHAR
    SHLD    BBUF+2        ;SAVE IN BINARY BUFFER
    LXI    H,ABUF+4
    CALL    NORM        ;NORMALIZE ASCII VALUE
    ORA    A        ;CLEAR CARRY
    RET
;
; THIS ROUTINE FETCHES DIGITS FROM THE BUFFER ADDRESSED BY
; REGISTERS B,C AND CONVERST THE ASCII DECIMAL DIGITS INTO
; BINARY.  UP TO A 16 BIT VALUE CAN BE CONVERTED.  THE SCAN
; STOPS WHEN A BINARY ZERO IS FOUND IN THE BUFFER
;
ADEC:    LXI    H,0        ;GET A 16 BIT ZERO
ADE1:    LDAX    B        ;FETCH ASCII DIGIT
    ORA    A        ;SET ZERO FLAG
    RZ        ;RETURN IF FINISHED
    MOV    D,H        ;SAVE CURRENT VALUE
    MOV    E,L        ;SAVE CURRENT VALUE
    DAD    H        ;TIMES TWO
    DAD    H        ;TIMES TWO
    DAD    D        ;ADD IN ORIGINAL VALUE
    DAD    H        ;TIMES TWO
    SUI    '0'        ;ASCII BIAS
    CPI    10        ;CHECK FOR LEGAL VALUE
    CMC
    RC        ;RETURN IF ERROR
    MOV    E,A
    MVI    D,0
    DAD    D        ;ADD IN NEXT DIGIT
    INX    B        ;INCREMENT POINTER
    JMP    ADE1
;
; THIS ROUTINE FETCHES DIGITS FROM THE BUFFER ADDRESSED BY
; REGISTERS B,C AND CONVERTS THE ASCII HEXADECIMAL DIGITS INTO
; BINARY.  UP TO A 16 BIT VALUE CAN BE CONVERTED.  THE SCAN STOPS
; WHEN A BINARY ZERO IS FOUND IN THE BUFFER
;
AHEX:    LXI    H,0        ;GET A 16 BIT ZERO
AHE1:    LDAX    B        ;FETCH ASCII DIGIT
    ORA    A
    RZ        ;RETURN IF ZERO
    DAD    H        ;LEFT SHIFT
    DAD    H
    DAD    H
    DAD    H
    CALL    AHS1        ;CONVERT TO BINARY
    CPI    10H        ;CHECK FOR LEGAL VALUE
    CMC
    RC        ;RETURN IF ERROR
    ADD    L
    MOV    L,A
    INX    B        ;INCR POINTER
    JMP    AHE1
;
; THIS ROUTINE CONVERTS ASCII HEX DIGITS INTO BINARY
;
AHS1:    SUI    '0'        ;ASCII BIAS
    CPI    10        ;DIGIT 0-10
    RC
    SUI    7        ;ALPHA BIAS
    RET
;
; THIS ROUTINE CONVERTS A BINARY VALUE TO ASCII HEXADECIMAL
; AND OUTPUTS THE CHARACTERS TO THE TTY
;
HOUT:    CALL    BINH        ;CONVERT VALUE
    LXI    H,HCON        ;CONVERSION AREA
CHOT:    MOV    B,M        ;FETCH OUTPUT CHARACTER
    CALL    OUT8        ;OUTPUT CHAR
    INX    H
    MOV    B,M        ;FETCH CHAR
    CALL    OUT8        ;OUTPUT CHAR
    RET
;
; THIS ROUTINE DOES THE SAME AS ABOVE BUT OUTPUTS A BLANK
; AFTER THE LAST CHAR
;
HOTB:    CALL    HOUT        ;CONVERT AND OUTPUT
    CALL    BLK1        ;OUTPUT A BLANK
    RET
;
; THIS ROUTINE CONVERTS A BINARY VALUE TO ASCII DECIMAL
; DIGITS AND OUTPUTS THE CHARACTERS TO THE TTY
;
DOUT:    CALL    BIND        ;CONVERT VALUE
    CALL    HOUT+3        ;OUTPUT VALUE (2 DIGITS)
    INX    H
    MOV    B,M        ;GET LAST DIGIT
    CALL    OUT8        ;OUTPUT
    RET
;
; THIS ROUTINE OUTPUTS A BLANK
;
BLK1:    MVI    B,' '
    CALL    OUT8
    RET
;
; THIS ROUTINE IS USED BY OTHER ROUTINES TO INCREMENT THE
; STARTING ADDRESS IN A COMMAND AND COMPARE IT WITH THE FINAL
; ADDRESS IN THE COMMAND.  ON RETURN THE CARRY FLAG SET
; INDICATES THAT THE FINAL ADDRESS HAS BEEN REACHED
;
ACHK:    LHLD    BBUF        ;FETCH START ADDRESS
    LDA    BBUF+3        ;STOP ADDRESS (HIGH)
    CMP    H        ;COMPARE
    JNZ    ACH1
    LDA    BBUF+2        ;STOP ADDRESS (LOW)
    CMP    L        ;COMPARE
    JNZ    ACH1
    STC        ;SET CARRY IF EQUAL
ACH1:    INX    H        ;INCREMENT START ADDRESS
    SHLD    BBUF        ;STORE START ADDRESS
    RET
;
; THIS ROUTINE OUTPUTS CHARACTERS FROM A CHARACTER STRING UNTIL
; A CARRIAGE RETURN IS FOUND
;
SCRN:    MOV    B,M        ;FETCH CHAR
    MVI    A,13        ;CARRIAGE RETURN
    CMP    B        ;CHAR = CR
    RZ
    CALL    OUT8        ;OUTPUT CHAR
    INX    H        ;INCREMENT ADDRESS
    JMP    SCRN
;
; THIS ROUTINE CONVERTS THE BINARY VALUE IN REG A INTO
; ASCII HEXADECIMAL DIGITS AND STORES THEM IN MEMORY
;
BINH:    LXI    H,HCON        ;CONVERSION ADDRESS
    MOV    B,A        ;SAVE VALUE
    RAR
    RAR
    RAR
    RAR
    CALL    BIN1
    MOV    M,A
    INX    H
    MOV    A,B
    CALL    BIN1        ;CONVERT TO ASCII
    MOV    M,A
    RET
;
; THIS ROUTINE CONVERTS A VALUE TO HEXADECIMAL
;
BIN1:    ANI    0FH        ;LOW FOUR DIGITS
    ADI    '0'        ;MODIFY FOR ASCII
    CPI    '0'+10        ;DIGIT 0-9
    RC
    ADI    7        ;MODIFY FOR A-F
    RET
;
; THIS ROUTINE CONVERTS THE BINARY VALUE IN THE A REG
; TO ASCII DECIMAL DIGITS AND STORES THEM IN MEMORY
;
BIND:    LXI    H,HCON        ;CONVERSION ADDRESS
    MVI    B,100
    CALL    BID1        ;CONVERT HUNDREDS DIGIT
    MVI    B,10
    CALL    BID1        ;CONVERT TENS DIGIT
    ADI    '0'        ;GET UNITS DIGIT
    MOV    M,A        ;STORE IN MEMORY
    RET
;
; THIS ROUTINE CONVERTS A VALUE TO DECIMAL
;
BID1:    MVI    M,'0'-1        ;INITIALIZE DIGIT COUNT
    INR    M
    SUB    B        ;CHECK DIGIT
    JNC    BID1+2
    ADD    B        ;RESTORE VALUE
    INX    H
    RET
;
; LEGAL COMMAND TABLE
;
CTAB:    DB    'DUMP'        ;DUMP COMMAND
    DW    DUMP
    DB    'EXEC'
    DW    EXEC
    DB    'ENTR'
    DW    ENTR
    DB    'FILE'
    DW    FILE
    DB    'LIST'
    DW    LIST
    DB    'DELT'
    DW    DELL
    DB    'ASSM'
    DW    ASSM
    DB    'PAGE'
    DW    PAGE
    DB    'PROM'
    DW    PROM
    DB    'CUST'
    DW    0E000H
;
; THIS ROUTINE CHECKS IF ANY PARAMETERS WERE ENTERED
; WITH THE COMMAND; IF NOT, AN ERROR MESSAGE IS ISSUED
;
VCHK:    LDA    ABUF        ;FETCH PARAMETER BYTE
    ORA    A        ;SET FLAGS
    JZ    WHAT        ;NO PARAMETER
    RET
;
; THIS ROUTINE DUMPS THE CONTENTS OF MEMORY FROM
; THE START TO FINAL ADDRESSES GIVEN IN THE COMMAND
;
DUMP:    CALL    VCHK        ;CHECK FOR PARAMETERS
    MVI    A,16        ;LOCATIONS PER LINE
    STA    SCNT        ;DUMP COUNTER
DUMS:    CALL    CRLF        ;START NEW LINE
    LDA    BBUF+1        ;FETCH ADDRESS
    CALL    HOUT        ;OUTPUT ADDRESS
    LDA    BBUF
    CALL    HOTB        ;OUTPUT ADDRESS
    LDA    SCNT        ;FETCH LINE COUNTER
DUM1:    STA    DCNT
    LHLD    BBUF        ;FETCH MEMORY ADDRESS
    MOV    A,L        ;GET LOW ORDER ADDRESS
    OUT    PADO        ;SET PROM ADDRESS
    MOV    A,H
    CPI    0EFH
    MOV    A,M
    JNZ    DUM2
    IN    PDAI        ;READ PROM DATA
DUM2:    CALL    HOTB        ;OUTPUT VALUE
    CALL    ACHK        ;CHECK ADDRESS
    RC        ;RETURN IF FINISHED
    LDA    DCNT        ;FETCH COUNTER
    DCR    A        ;DECR COUNTER
    JNZ    DUM1
    JMP    DUMS
;
; THIS ROUTINE WILL MOVE 1 PAGE (256 BYTES) FROM 1ST ADDRESS GIVEN
; IN COMMAND TO 2ND ADDRESS IN COMMAND
;
PAGE:    CALL    VCHK        ;CHECK FOR PARAMETER
    LDA    ABUF+4        ;FETCH 2ND PARAMETER
    ORA    A        ;DOES 2ND PARAMETER EXIST?
    JZ    WHAT
    LHLD    BBUF        ;FETCH MOVE FROM ADDRESS
    XCHG
    LHLD    BBUF+2        ;FETCH MOVE TO ADDRESS
    MVI    B,0        ;SET COUNTER
PAG1:    MOV    A,E
    OUT    PADO        ;SET PROM ADDRESS
    MOV    A,D
    CPI    0FFH        ;CHECK FOR PROM ADDRESS
    LDAX    D        ;GET DATA
    JNZ    PAG2
    IN    PDAI        ;READ PROM DATA
PAG2:    MOV    M,A
    INX    H
    INX    D
    DCR    B        ;DECR COUNT
    JNZ    PAG1
    RET
;
; THIS ROUTINE INITIALIZES THE BEGINNING OF FILE ADDRESS
; AND END OF FILE ADDRESS AS WELL AS THE FILE AREA
; WHEN THE FILE COMMAND IS USED
;
FILE:    CALL    CRLF
        ;CHECK FOR FILE PARAMETERS
    LDA    FBUF
    ORA    A
    JZ    FOUT        ;NO GO LIST
    CALL    FSEA        ;LOOK UP FILE
    XCHG        ;PNTR IN DE
    JNZ    TEST        ;IF FOUND
        ;NO ENTRY
    LDA    ABUF        ;CHECK FOR PARAM
    ORA    A
    JZ    WHA1        ;NO?? - GIVE EM HELL
        ;CHECK FOR ROOM IN DIRECTORY
    LDA    FEF
    ORA    A
    JNZ    ROOM
    LXI    H,EMES1
    JMP    MESS
        ;ENTRY FOUND ARE THESE PARAMETERS
TEST:    LDA    ABUF
    ORA    A
    JZ    SWAPS
    LHLD    BBUF
    MOV    A,H
    ORA    L
    JZ    SWAPS
    LXI    H,EMES2        ;NO-NO    CAN'T DO
    JMP    MESS
        ;MOVE FILE NAME TO BLOCK POINTED TO BY FREAD
ROOM:    LHLD    FREAD
    XCHG        ;DIRECT POINTER IN D,E
    LXI    H,FBUF        ;FILE NAME POINTER IN H,L
    PUSH    D
    MVI    C,NMLEN        ;NAME LENGTH COUNT
MOV23:    MOV    A,M
    STAX    D
    INX    D
    INX    H
    DCR    C        ;TEST COUNT
    JNZ    MOV23
    POP    D        ;RESTORE ENTRY PTR, MAKE CURRENT
        ;MAKE FILE POINTED TO BY D,E CURRENT
SWAPS:    LXI    H,FILE0
    MVI    C,FELEN        ;ENTRY LENGTH
SWAP:    LDAX    D
    MOV    B,M
    MOV    M,A
    MOV    A,B
    STAX    D
    INX    D        ;BUMP POINTERS
    INX    H
    DCR    C        ;TEST COUNT
    JNZ    SWAP
        ;CHECK FOR 2ND PARAMETER, => INITIALIZE NEW
    LDA    ABUF
    ORA    A
    JZ    FOOT        ;NO SECOND PARAMETER
        ;PROCESS SECOND PARAMETER
    LHLD    BBUF        ;GET ADDRESS
    SHLD    BOFP        ;SET BEGIN
    SHLD    EOFP        ;SET END
    MOV    A,L        ;IS ADDRESS ZERO?
    ORA    H
    JZ    FIL35        ;YES
FIL30:    MVI    M,1        ;NON-ZERO - SET EOF
FIL35:    XRA    A
    STA    MAXL        ;AND MAX LINE #
    JMP    FOOT        ;OUTPUT PARAMETERS
FOUT:    LDA    IBUF+4
    CPI    'S'        ;IS COMMAND FILES
    MVI    C,MAXFIL
    JZ    FOUL
FOOT:    MVI    C,1
        ;OUTPUT THE # OF ENTRIES IN C
FOUL:    LXI    H,FILE0
    MOV    A,C
FINE:    STA    FOCNT        ;SAVE COUNT
    PUSH    H
    LXI    D,NMLEN
    DAD    D
    MOV    A,M
    ORA    A
    JNZ    FOOD        ;NON-ZERO, OK TO OUTPUT
    INX    H
    ADD    M
    INX    H
    JNZ    FOOD
    INX    SP
    INX    SP
    INX    H
    INX    H
    JMP    FEET
        ;HAVE AN ENTRY TO OUTPUT
FOOD:    POP    H        ;PTR
    MVI    C,NMLEN
FAST:    MOV    B,M        ;LOAD CHAR TO B
    CALL    OUT8        ;OUTPUT
    DCR    C
    INX    H
    JNZ    FAST        ;DO THE REST
        ;NOW OUTPUT BEGIN-END PTRS
    CALL    FOOL        ;OUTPUT BEGIN
    CALL    FOOL        ;OUTPUT END
    CALL    CRLF        ;AND CR
        ;TEST COUNT, H,L POINTS PAST EOFP
FEET:    LXI    D,FELEN-NMLEN-4
    DAD    D        ;MOVE TO NEXT ENTRY
    LDA    FOCNT
    DCR    A        ;TEST COUNT
    JNZ    FINE        ;MORE TO DO
    RET
        ;OUTPUT NUMBER POINTED TO BY H,L
        ;ON RET, H,L POINT 2 WORDS LATER
FOOL:    CALL    BLK1        ;SPACE
    INX    H
    MOV    A,M
    DCX    H
    PUSH    H
    CALL    HOUT        ;OUTPUT
    POP    H
    MOV    A,M
    INX    H
    INX    H
    PUSH    H
    CALL    HOTB        ;OUTPUT
    POP    H        ;RESTORE H,L
    RET
;
; SEARCH THE FILE DIRECTORY FOR THE FILE
; WHOSE NAME IS IN FBUF.
; RETURN IF FOUND, ZERO IS OFF, H,L POINT TO
; ENTRY WHILE SEARCHING.  ON ENTRY FOUND WITH ADDR
; ZERO, SET FEF TO > 0 AND FREAD TO THE ADDR OF ENTRY
;
FSEA:    XRA    A
    STA    FEF        ;CLAIM NO FREE ENTRIES
    MVI    B,MAXFIL        ;COUNT OF ENTRIES
    LXI    D,FILE0        ;TABLE ADDRESS
FSE10:    LXI    H,FBUF
    MVI    C,NMLEN
    CALL    SEAR        ;TEST STRINGS
    PUSH    PSW        ;SAVE FLAG
    PUSH    D
    LDAX    D        ;GET BOFP
    ORA    A        ;EMPTY ENTRY?
    JNZ    FSE20
    INX    D        ;TEST OTHER WORD
    LDAX    D
    ORA    A
    JNZ    FSE20        ;NOPE-GO TEST FOR MATCH
    XCHG        ;H,L GET MIDDLE OF FREE ENTRY
    LXI    D,-NMLEN-1
    DAD    D        ;MOVE TO BEGINNING
    SHLD    FREAD        ;SAVE ADDR
    MOV    A,D
    STA    FEF        ;SET FREE ENTRY FOUND
    POP    H        ;RESTORE INTERIM POINTER
    POP    PSW        ;UNJUNK STACK
; MOVE TO NEXT ENTRY
FSE15:    LXI    D,FELEN-NMLEN
    DAD    D
    XCHG        ;NEXT ENTRY ADDR IN DE
    DCR    B        ;TEST COUNT
    RZ        ;DONE?
    JMP    FSE10        ;TRY NEXT
; ENTRY WASN'T FREE, TEST FOR MATCH
FSE20:    POP    H
    POP    PSW
    JNZ    FSE15        ;IF ZERO CLEAR, NO MATCH
; ENTRY FOUND
    LXI    D,-NMLEN        ;BACKUP
    DAD    D        ;H,L POINTS TO ENTRY
    MOV    A,D
    ORA    A        ;CLEAR ZERO
    RET        ;THAT'S ALL
;
; OUTPUT ERROR MESSAGE FOR ILLEGAL COMMAND
;
WHAT:    CALL    CRLF        ;OUTPUT CRLF
WHA1:    LXI    H,EMES        ;MESSAGE ADDRESS
MESS:    CALL    SCRN
    JMP    EOR
;
EMES:    DB    'WHAT?',13
EMES1:    DB    'FULL',13
EMES2:    DB    'NO NO',13
;
; CALL ROUTINE TO ENTER DATA INTO MEMORY
; AND CHECK FOR ERROR ON RETURN
;
; THIS ROUTINE IS USED TO ENTER DATA VALUES INTO MEMORY.
; EACH VALUE IS ONE BYTE AND IS WRITTEN IN HEXADECIMAL
; VALUES GREATER THAN 255 WILL CAUSE CARRY TO BE SET
; AND RETURN MADE TO CALLING PROGRAM
;
ENTR:    CALL    VCHK        ;CHECK FOR PARAMETERS
    CALL    ENTS
    JC    WHAT
    CALL    CRLF
    RET
;
EEND    EQU    '/'        ;TERMINATION CHAR
ENTS:    CALL    CRLF
    CALL    READ        ;READ INPUT DATA
    LXI    H,IBUF        ;SET LINE POINTER
    SHLD    PNTR        ;SAVE POINTER
ENT1:    CALL    ZBUF        ;CLEAR BUFFER
    CALL    SBLK        ;SCAN TO FIRST VALUE
    JC    ENTS        ;JUMP IF CR FOUND
    CPI    EEND
    RZ        ;CARRY IS ZERO
    CALL    ALPS        ;PLACE VALUE IN BUFFER
    MOV    A,B        ;GET DIGIT COUNT
    CPI    3        ;CHECK NUMBER OF DIGITS
    CMC
    RC        ;RETURN IF MORE THAN 2 DIGITS
    LXI    B,ABUF        ;CONVERSION ADDRESS
    CALL    AHEX        ;CONVERT VALUE
    RC        ;ERROR IN HEX CHARACTER
    MOV    A,L
    LHLD    BBUF        ;FETCH MEMORY ADDRESS
    MOV    M,A        ;PUT IN MEMORY
    CALL    ACH1        ;INCREMENT MEMORY LOCATION
    JMP    ENT1
;
; THIS ROUTINE IS USED TO ENTER LINES INTO THE FILE
; AREA.  THE LINE NUMBER IS FIRST CHECKED TO SEE IF IT IS
; A VALID NUMBER (0000-9999). NEXT IT IS CHECKED TO SEE IF IT IS
; GREATER THAN THE MAXIMUM CURRENT LINE NUMBER.  IF IT IS, THE NEW
; LINE IS INSERTED AT THE END OF THE CURRENT FILE AND THE MAXIMUM
; LINE NUMBER IS UPDATED AS WELL AS THE END OF FILE POSITION
; LINE NUMBERS THAT ALREADY EXIST ARE INSERTED INTO THE FILE AREA
; AT THE APPROPRIATE PLACE AND ANY EXTRA CHARACTERS IN THE OLD
; LINE ARE DELETED
;
LINE:    MVI    C,4        ;NO OF DIGITS TO CHECK
    LXI    H,IBUF-1        ;INITIALIZE ADDRESS
LICK:    INX    H
    MOV    A,M        ;FETCH LINE DIGIT
    CPI    '0'        ;CHECK FOR VALID NUMBER
    JC    WHAT
    CPI    '9'+1
    JNC    WHAT
    DCR    C
    JNZ    LICK
    SHLD    ADDS        ;FIND ADDRESS
    LXI    D,MAXL+3        ;SET ADDRESS
    CALL    COM0
    JNC    INSR
; GET HERE IF NEW LINE IS GREATER THAN MAXIMUM CURRENT LINE #
    INX    H
    CALL    LODM        ;GET NEW LINE NUMBER
    LXI    H,MAXL+3
    CALL    STOM        ;MAKE IT MAXIMUM LINE NUMBER
    LXI    D,IBUF-1
    LHLD    EOFP        ;END OF FILE POSITION
    MVI    C,1
    CALL    LMOV        ;PLACE LINE IN FILE
SEOF:    MVI    M,1        ;END OF FILE INDICATOR
    SHLD    EOFP        ;END OF FILE ADDRESS
    JMP    EOR
; GET HERE IF NEW LINE MUST BE INSERTED INTO ALREADY EXISTING
; FILE AREA
INSR:    CALL    FIN1        ;FIND LINE IN FILE
    MVI    C,2
    JZ    EQUL
    DCR    C        ;NEW LN NOT EQUAL TO SOME OLD LINE
EQUL:    MOV    B,M
    DCX    H
    MVI    M,2        ;MOVE LINE INDICATOR
    SHLD    INSP        ;INSERT LINE POSITION
    LDA    IBUF-1        ;NEW LINE COUNT
    DCR    C
    JZ    LT        ;NEW LINE NOT = OLD LINE
    SUB    B        ;COUNT DIFFERENCE
    JZ    ZERO        ;LINE LENGTHS EQUAL
    JC    GT
; GET HERE IF NO OF CHARS IN OLD LINE > NO OF CHARS IN NEW LINE
; OR NEW LINE NUMBER WAS NOT EQUAL TO SOME OLD LINE NUMBER
LT:    LHLD    EOFP        ;END OF FILE ADDRESS
    MOV    D,H
    MOV    E,L
    CALL    ADR        ;MOVE TO ADDRESS
    SHLD    EOFP        ;NEW END OF FILE ADDRESS
    MVI    C,2
    CALL    RMOV        ;OPEN UP FILE AREA
    JMP    ZERO
; GET HERE IF NO OF CHARS IN OLD LINE < NO OF CHARS IN NEW LINE
GT:    CMA
    INR    A        ;COUNT DIFFERENCE
    MOV    D,H
    MOV    E,L
    CALL    ADR
    XCHG
    CALL    LMOV        ;DELETE EXCESS CHARS IN FILE
    MVI    M,1        ;EOF INDICATOR
    SHLD    EOFP        ;EOF ADDRESS
; GET HERE TO INSERT CURRENT LINE INTO FILE AREA
ZERO:    LHLD    INSP        ;INSERT ADDRESS
    MVI    M,ASCR
    INX    H
    LXI    D,IBUF-1        ;NEW LINE ADDRESS
    MVI    C,1        ;CHECK VALUE
    CALL    LMOV        ;PLACE LINE IN FILE
    JMP    EOR
;
; THIS ROUTINE IS USED TO FIND A LINE IN THE FILE AREA
; WHICH IS GREATER THAN OR EQUAL TO THE CURRENT LINE NUMBER
;
FIND:    LXI    H,ABUF+3        ;BUFFER ADDRESS
    SHLD    ADDS        ;SAVE ADDRESS
FIN1:    LHLD    BOFP        ;BEGIN FILE ADDRESS
FI1:    CALL    EO1        ;CHECK FOR END OF FILE
    XCHG
    LHLD    ADDS        ;FETCH FIND ADDRESS
    XCHG
    MVI    A,4
    CALL    ADR        ;LINE ADDRESS
    CALL    COM0        ;COMPARE LINE NUMBER
    RC
    RZ
FI2:    MOV    A,M
    CALL    ADR        ;NEXT LINE ADDRESS
    JMP    FI1
;
; THIS ROUTINE CHECKS IF THE CURRENT ADDRESS
; IS THE END OF FILE
;
EOF:    INX    H
EO1:    MVI    A,1        ;EOF INDICATOR
    CMP    M
    RNZ
    JMP    EOR
;
; THIS ROUTINE IS USED TO ADD A VALUE TO AN ADDRESS
; CONTAINED IN REGISTER H,L
;
ADR:    ADD    L
    MOV    L,A
    RNC
    INR    H
    RET
;
; THIS ROUTINE WILL MOVE CHARACTER STRINGS FROM ONE LOCATION
; OF MEMORY TO ANOTHER
; CHARACTERS ARE MOVED FROM LOCATION ADDRESSED BY D,E TO LOCATION
; ADDRESSED BY H,L.  ADDITIONAL CHARACTERS ARE MOVED BY
; INCREMENTING MEMORY UNTIL THE CHARACTER IN REGISTER C IS FETCHED
;
LMOV:    LDAX    D        ;FETCH CHAR
    INX    D
    CMP    C        ;TERMINATION CHAR
    RZ
    MOV    M,A
    INX    H
    JMP    LMOV
;
; THIS ROUTINE IS SIMILAR TO THE ABOVE EXCEPT THAT THE CHARACTER
; ADDRESS IS DECREMENTED AFTER EACH FETCH AND STORE
;
RMOV:    LDAX    D        ;FETCH CHAR
    DCX    D
    CMP    C        ;TERMINATION CHAR
    RZ
    MOV    M,A        ;STORE CHAR
    DCX    H        ;DECR STORE ADDRESS
    JMP    RMOV
;
; THIS ROUTINE IS USED TO LOAD FOUR CHARACTERS FROM
; MEMORY INTO REGISTERS
;
LODM:    MOV    B,M        ;FETCH CHAR
    INX    H
    MOV    C,M
    INX    H
    MOV    D,M
    INX    H
    MOV    E,M
    RET
;
; THIS ROUTINE STORES FOUR CHARACTERS FROM REGISTERS INTO MEMORY
;
STOM:    MOV    M,E
    DCX    H
    MOV    M,D
    DCX    H
    MOV    M,C
    DCX    H
    MOV    M,B
    RET
;
; THIS ROUTINE IS USED TO COMPARE TWO CHARACTER STRINGS
; OF LENGTH 4.  ON RETURN ZERO FLAG SET MEANS BOTH
; STRINGS ARE EQUAL.  CARRY FLAG = 0 MEANS STRING ADDRESSED
; BY D,E WAS GREATER THAN OR EQUAL TO CHARACTER STRING
; ADDRESSED BY H,L
;
COM0:    MVI    B,1        ;EQUAL COUNTER
    MVI    C,4        ;STRING LENGTH
    ORA    A        ;CLEAR CARRY
CO1:    LDAX    D        ;FETCH CHARACTER
    SBB    M        ;COMPARE CHAR
    JZ    CO2
    INR    B        ;INCREMENT EQUAL COUNTER
CO2:    DCX    D
    DCX    H
    DCR    C
    JNZ    CO1
    DCR    B
    RET
;
; THIS ROUTINE IS SIMILAR TO THE ABOVE EXCEPT ON RETURN, CARRY = 0
; MEANS THAT THE CHAR STRING ADDRESSED BY D,E IS STRICTLY GREATER
; THAN STRING ADDRESSED BY H,L
;
COM1:    MVI    C,4        ;STRING LENGTH
    LDAX    D        ;FETCH CHAR
    SUI    1
    JMP    CO1+1
;
; THIS ROUTINE WILL TAKE ASCII CHARS AND ADD ANY
; NECESSARY ASCII ZEROES SO THE RESULT IS A 4 CHARACTER
; ASCII VALUE
;
NORM:    CALL    LODM        ;LOAD ZEROES
    XRA    A
    CMP    B
    RZ
NOR1:    CMP    E
    CNZ    STOM        ;STORE VALUES
    RNZ
    MOV    E,D
    MOV    D,C
    MOV    C,B
    MVI    B,'0'
    JMP    NOR1
;
; THIS ROUTINE IS USED TO LIST THE CONTENTS OF THE FILE
; AREA STARTING AT THE LINE NUMBER GIVEN IN THE COMMAND
;
LIST:    CALL    CRLF
    CALL    FIND        ;FIND STARTING LINE
    INX    H
LIS1:    CALL    SCRN        ;OUTPUT LINE
    CALL    CRLF
    CALL    EOF        ;END OF FILE
    IN    SWCH        ;READ SWITCHES
    ANI    80H
    RNZ
    INX    H
    JMP    LIS1
;
; THIS ROUTINE IS USED TO PROGRAM A 1702A PROM
;
PROM:    CALL    VCHK        ;CHECK FOR PARAMETER
PRO1:    CALL    CRLF
    LDA    BBUF        ;GET ADDRESS (LOW)
    CALL    HOTB        ;OUTPUT ADDRESS
    MVI    D,3        ;NUMBER OF ATTEMPTS
    LHLD    BBUF        ;GET ADDRESS
PRO2:    MOV    A,L
    OUT    PADO
    MOV    A,M        ;GET DATA
    OUT    PDAO        ;OUTPUT TO PROM
    MVI    A,2
    OUT    PCTO        ;ENABLE PROGRAMMER
    CALL    DLAY        ;500 MSEC DELAY
    XRA    A
    OUT    PCTO        ;DISABLE PROGRAMMER
    IN    PDAI        ;READ DATA
    CMP    M        ;COMPARE DATA
    JZ    PRO3
    MVI    B,'?'
    CALL    OUT8
    DCR    D        ;NUMBER OF ATTEMPTS
    JNZ    PRO2        ;TRY AGAIN
    RET
PRO3:    CALL    ACHK        ;FINAL ADDRESS
    RC        ;RETURN IF FINISHED
    JMP    PRO1        ;NEXT LOCATION
;
DLAY:    MVI    E,150
DLA1:    XRA    A        ;GET A ZERO (256)
DLA2:    DCR    A
    JNZ    DLA2
    DCR    E
    JNZ    DLA1
    RET
;
; THIS ROUTINE IS UDED TO DELAETE LINES FROM THE FILE AREA
; THE REMAINING FILE AREA IS THEN MOVED IN MEMORY SO THAT
; THERE IS NO EXCESS SPACE IN MEMORY
;
DELL:    CALL    VCHK        ;CHECK FOR PARAMETER
    CALL    FIND        ;FIND LINE IN FILE AREA
    SHLD    DELP        ;SAVE DELETE POSITION
    LXI    H,ABUF+7
    MOV    A,M        ;CHECK FOR 2ND PARAMETER
    ORA    A        ;SET FLAGS
    JNZ    DEL1
    LXI    H,ABUF+3        ;USE FIRST PARAMETER
DEL1:    SHLD    ADDS        ;SAVE FIND ADDRESS
    XCHG
    LXI    H,MAXL+3
    CALL    COM0        ;COMPARE LINE NO
    LHLD    DELP        ;LOAD DELETE POSITION
    JC    NOVR
; GET HERE IF DELETION INVOLVES END OF FILE
    SHLD    EOFP        ;CHANGE EOF POSITION
    MVI    M,1        ;SET EOF INDICATOR
    XCHG
    LHLD    BOFP        ;GET BEGIN FILE ADDRESS
    XCHG
    MVI    B,13        ;SET SCAN SWITCH
    DCX    H        ;DECREMENT FILE ADDRESS
DEL2:    MOV    A,L        ;CHECK FOR BOF
    SUB    E
    MOV    A,H
    SBB    D
    MVI    A,ASCR        ;LOOK FOR CR
    JC    DEL4
    DCR    B
    DCX    H
    CMP    M        ;FIND NEW MAX LINE NO
    JNZ    DEL2
    DCX    H
    MOV    A,L
    SUB    E
    MOV    A,H
    SBB    D
    JC    DEL5
    CMP    M        ;END OF PREVIOUS LINE
    INX    H
    INX    H
    JZ    DEL3
    INX    H
DEL3:    CALL    LODM        ;LOAD NEW MAX LINE NO
    LXI    H,MAXL+3        ;SET ADDRESS
    CALL    STOM        ;STORE NEW MAX LINE NO
    RET
DEL4:    CMP    B        ;CHECK SWITCH
DEL5:    XCHG
    JNZ    DEL3-1
    STA    MAXL        ;MAKE MAX LINE NO A SMALL NUMBER
    RET
; GET HERE IF DELETION IS IN MIDDLE OF FILE AREA
NOVR:    CALL    FI1        ;FIND END OF FILE AREA
    CZ    FI2        ;NEXT LINE IF THIS LINE NO IS EQUAL
NOV1:    XCHG
    LHLD    DELP        ;CHAR MOVE TO POSITION
    MVI    C,1        ;MOVE TERMINATION
    CALL    LMOV        ;COMPACT FILE AREA
    SHLD    EOFP        ;SET EOF POSITION
    MVI    M,1        ;SET EOF INDICATOR
    RET
;
; STARTING HERE IS THE SELF ASSEMBLER PROGRAM
; THIS PROGRAM ASSEMBLES PROGRAMS WHICH ARE
; IN THE FILE AREA
;
ASSM:    CALL    VCHK        ;CHECK FOR PARAMETER
    LDA    ABUF+4        ;GET 2ND PARAMETER
    ORA    A        ;CHECK FOR PARAMETERS
    JNZ    ASM4
    LHLD    BBUF        ;FETCH 1ST PARAMETER
    SHLD    BBUF+2        ;STORE INTO 2ND PARAMETER
ASM4:    LDA    IBUF+4        ;FETCH INPUT CHAR
    CPI    'E'        ;ERROR ONLY INDICATOR
    JNZ    ASM5
    XRA    A        ;SET FOR ONLY ERRORS
ASM5:    STA    AERR        ;SET ERROR SWITCH
    XRA    A        ;GET A ZERO
    STA    NOLA        ;INITIALIZE LABEL COUNT
ASM3:    STA    PASI        ;SET PASS INDICATOR
    LHLD    BBUF        ;FETCH ORIGIN
    SHLD    ASPC        ;INITIALIZE PC
    LHLD    BOFP        ;GET START OF FILE
    SHLD    APNT        ;SAVE ADDRESS
ASM1:    LHLD    APNT        ;FETCH LINE POINTER
    LXI    SP,AREA+18
    MOV    A,M        ;FETCH CHAR
    CPI    1        ;END OF FILE
    JZ    EASS        ;JUMP IF END OF FILE
    XCHG
    INX    D        ;INCREMENT ADDRESS
    LXI    H,OBUF        ;BLANK START ADDRESS
    MVI    A,IBUF-5        ;BLANK END ADDRESS
    CALL    CLER        ;BLANK OUT BUFFER
    MVI    C,ASCR        ;STOP CHAR
    CALL    LMOV        ;MOVE LINE INTO BUFFER
    MOV    M,C        ;PLACE CR IN BUFFER
    XCHG
    SHLD    APNT        ;SAVE ADDRESS
    LDA    PASI        ;FETCH PASS INDICATOR
    ORA    A        ;SET FLAGS
    JNZ    ASM2        ;JUMP IF PASS 2
    CALL    PAS1
    JMP    ASM1
ASM2:    CALL    PAS2
    LXI    H,OBUF        ;OUTPUT BUFFER ADDRESS
    CALL    AOUT        ;OUTPUT LINE
    JMP    ASM1
;
; THIS ROUTINE IS USED TO OUTPUT THE LISTING FOR AN ASSEMBLY
; IT CHECKS WHETHER ALL LINES ARE PRINTED OR ONLY THOSE
; WITH ERRORS DEPENDING UPON THE ERROR SWITCH
;
AOUT:    LDA    AERR        ;FETCH ERROR SWITCH
    ORA    A        ;SET FLAGS
    JNZ    AOU1        ;OUTPUT ALL LINES
AOU2:    LDA    OBUF+18        ;FETCH ERROR INDICATOR
    CPI    ' '        ;CHECK FOR AN ERROR
    RZ        ;RETURN IF NO ERROR
AOU1:    LXI    H,OBUF        ;OUTPUT BUFFER ADDRESS
    CALL    CRLF
    CALL    SCRN        ;OUTPUT LINE
    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 CHAR
    CPI    ' '        ;CHECK FOR A BLANK
    JZ    OPC        ;JUMP IF NO LABEL
    CPI    ';'        ;CHECK FOR COMMENT
    RZ        ;RETURN IF COMMENT
;
; PROCESS LABEL
;
    CALL    SLAB        ;GET AND CHECK LABEL
    JC    OP5        ;ERROR IN LABEL
    JZ    ERRD        ;DUPLICATE LABEL
    CALL    LCHK        ;CHECK CHAR AFTER LABEL
    JNZ    OP5        ;ERROR IF NO BLANK
    MVI    C,LLAB        ;LENGTH OF LABELS
    LXI    H,ABUF        ;SET BUFFER ADDRESS
MLAB:    MOV    A,M        ;FETCH NEXT CHAR
    STAX    D        ;STORE IN SYMBOL TABLE
    INX    D
    INX    H
    DCR    C        ;DECR COUNT
    JNZ    MLAB
    XCHG
    SHLD    TABA        ;SAVE TABLE ADDRESS FOR EQU
    LDA    ASPC        ;FETCH PC (LOW)
    MOV    M,A        ;STORE IN TABLE
    INX    H
    LDA    ASPC+1        ;FETCH PC (HIGH)
    MOV    M,A        ;STORE IN TABLE
    LXI    H,NOLA
    INR    M        ;INCR NUMBER OF LABELS
;
; PROCESS OPCODE
;
OPC:    CALL    ZBUF        ;ZERO WORKING BUFFER
    CALL    SBLK        ;SCAN TO OPCODE
    JC    OERR        ;FOUND CARRIAGE RETURN
    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
;
; THIS ROUTINE CHECKS THE CHAR AFTER A LABEL FOR A BLANK
; OR A COLON
;
LCHK:    LHLD    PNTR
    MOV    A,M        ;GET CHAR 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        ;SET FLAGS
    JZ    ORG1        ;ORG OPCODE
    JM    DAT1        ;DATA STATEMENT
    JPO    EQU1        ;EQU OP
    CPI    5
    JC    RES1        ;RES OPCODE
    JNZ    EASS        ;JUMP IF END
; DO DW PSEUDO OP
ACO1:    MVI    C,2        ;2 BYTE INSTRUCTION
    XRA    A        ;GET A ZERO
    JMP    OCN1        ;ADD VALUE TO PROGRAM COUNTER
; DO ORG PSEUDO OP
ORG1:    CALL    ASCN        ;GET OPERAND
    LDA    OBUF+18        ;FETCH ERROR INDICATOR
    CPI    ' '        ;CHECK FOR AN ERROR
    RNZ        ;IF ERROR DON'T CHANGE PC
    SHLD    ASPC        ;STORE NEW ORIGIN
    LDA    IBUF        ;GET FIRST CHAR
    CPI    ' '        ;CHECK FOR LABEL
    RZ        ;NO LABEL
    JMP    EQUS        ;CHANGE LABEL VALUE
; DO EQU PSEUDO OP
EQU1:    CALL    ASCN        ;GET OPERAND
    LDA    IBUF        ;FETCH 1ST CHAR
    CPI    ' '        ;CHECK FOR LABEL
    JZ    ERRM        ;MISSING LABEL
EQUS:    XCHG
    LHLD    TABA        ;SYMBOL TABLE ADDRESS
    MOV    M,E        ;STORE LABEL VALUE
    INX    H
    MOV    M,D
    JMP    AOU2        ;OUTPUT IF ERROR
; DO DS PSEUDO OP
RES1:    CALL    ASCN        ;GET OPERAND
    MOV    B,H
    MOV    C,L
    JMP    RES21        ;ADD VALUE TO PROGRAM COUNTER
; DO DB PSEUDO OP
DAT1:    JMP    DAT1X
;
; PERFORM PASS 2 OF THE ASSEMBLER
;
PAS2:    LXI    H,OBUF        ;SET OUTPUT BUFFER ADDRESS
    LDA    ASPC+1        ;FETCH PC (HIGH)
    CALL    BINH+3        ;CONVERT FOR OUTPUT
    INX    H
    LDA    ASPC        ;FETCH PC(LOW)
    CALL    BINH+3        ;CONVERT FOR OUTPUT
    SHLD    OIND        ;SAVE OUTPUT ADDRESS
    CALL    ZBUF        ;CLEAR BUFFER
    LXI    H,IBUF        ;INITIALIZE LINE POINTER
PABL:    SHLD    PNTR        ;SAVE POINTER
    MOV    A,M        ;FETCH FIRST CHAR
    CPI    ' '        ;CHECK FOR LABEL
    JZ    OPC        ;GET OPCODE
    CPI    ';'        ;CHECK FOR COMMENT
    RZ        ;RETURN IF COMMENT
    CALL    SLAB        ;SCAN OFF LABEL
    JC    ERRL        ;ERROR IN LABEL
    CALL    LCHK        ;CHECK FOR A BLANK OR COLON
    JNZ    ERRL        ;ERROR IF NOT A BLANK
    JMP    OPC
;
; PROCESS PSEUDO OPS FOR PASS 2
;
PSU2:    LDAX    D
    ORA    A        ;SET FLAGS
    JZ    ORG2        ;ORG OPCODE
    JM    DAT2        ;DATA OPCODE
    RPO        ;RETURN IF EQU
    CPI    5
    JC    RES2        ;RES OPCODE
    JNZ    EASS        ;END OPCODE
; DO DW PSEUDO OP
ACO2:    CALL    TYS6        ;GET VALUE
    JMP    ACO1
; DO DS PSEUDO OP
RES2:    CALL    ASBL        ;GET OPERAND
    MOV    B,H
    MOV    C,L
    LHLD    BBUF+2        ;FETCH STORAGE COUNTER
    DAD    B        ;ADD VALUE
    SHLD    BBUF+2        ;GET A ZERO
RES21:    XRA    A
    JMP    OCN2
; DO DB PSEUDO OP
DAT2:    CALL    TYS5        ;GET OPERAND
DAT1X:    XRA    A        ;GET A ZERO
    MVI    C,1        ;BYTE COUNT
    JMP    OCN1
; DO ORG PSEUDO OP
ORG2:    CALL    ASBL        ;GET NEW ORIGIN
    LDA    OBUF+18        ;GET ERROR INDICATOR
    CPI    ' '        ;CHECK FOR AN ERROR
    RNZ
    XCHG
    LHLD    ASPC        ;FETCH PC
    XCHG
    SHLD    ASPC        ;STORE NEW PC
    MOV    A,L
    SUB    E        ;FORM DIFFERENCE OF ORIGINS
    MOV    E,A
    MOV    A,H
    SBB    D
    MOV    D,A
    LHLD    BBUF+2        ;FETCH STORAGE POINTER
    DAD    D        ;MODIFY
    SHLD    BBUF+2        ;SAVE
    RET
;
; PROCESS 1 BYTE INSTRUCTIONS WITHOUT OPERANDS
;
TYP1:    CALL    ASTO        ;STORE VALUE IN MEMORY
    RET
;
; PROCESS STAX AND LDAX
;
TYP2:    CALL    ASBL        ;FETCH OPERAND
    CNZ    ERRR        ;ILLEGAL REGISTER
    MOV    A,L        ;GET LOW ORDER OPERAND
    ORA    A
    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    TYP1
;
; PROCESS ACCUMULATOR, INR,DCR,MOV,RST INSTRUCTION
;
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 MOV INSTRUCTION
    JZ    TY41
    CPI    199
    MOV    A,L
    JZ    TY31        ;RST INST
    JM    TY32        ;ACCUMULATOR INST
    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        ;INCR 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:    CPI    6        ;CHECK FOR MVI INST
    CZ    TY56
    CALL    ASTO        ;STORE OBJECT CODE BYTE
TYS5:    CALL    ASBL        ;GET IMMEDIATE ARGUMENT
    INR    A
    CPI    2        ;CHECK OPERAND FOR RANGE
    CNC    ERRV        ;OPERAND OUT OF RANGE
    MOV    A,L
    JMP    TYP1
;
; FETCH 1ST ARGUMENT FOR MVI AND LXI INSTRUCTIONS
;
TY56:    CALL    ASBL        ;FETCH ARG
    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
    MOV    A,M        ;FETCH CHARACTER
    CPI    ','        ;CHECK FOR COMMA
    INX    H        ;INCR POINTER
    SHLD    PNTR
    JNZ    ERRS        ;SYNTAX ERROR IN NO COMMA
    MOV    A,E        ;GET OBJECT BYTE
    RET
;
; PROCESS 3 BYTE INSTRUCTIONS
; LXI IS A SPECIAL CASE
;
TYP6:    CPI    1        ;CHECK FOR LXI
    JNZ    TY6        ;JUMP IF NOT LXI
    CALL    TY56        ;GET REGISTER
    ANI    8        ;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    ASBL        ;FETCH OPERAND
    MOV    A,L
    MOV    D,H
    CALL    ASTO        ;STORE 2ND BYTE
    MOV    A,D
    JMP    TYP1
    RET
;
; THIS ROUTINE IS USED TO STORE OBJECT CODE PRODUCED
; BY THE ASSEMBLER DURING PASS 2 INTO MEMORY
;
ASTO:    LHLD    BBUF+2        ;FETCH STORAGE ADDRESS
    MOV    M,A        ;STORE OBJECT BYTE
    INX    H
    SHLD    BBUF+2
    LHLD    OIND        ;FETCH OUTPUT ADDRESS
    INX    H
    INX    H
    CALL    BINH+3        ;CONVERT OBJECT BYTE
    SHLD    OIND
    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 ASSEMBLY TERMINATES IF FINISHED.
;
EASS:    LDA    PASI        ;FETCH PASS INDICATOR
    ORA    A        ;SET FLAGS
    JNZ    EOR        ;JUMP IF FINISHED
    CALL    CRLF
    MVI    A,1        ;PASS INDICATOR FOR PASS 2
    JMP    ASM3        ;DO 2ND PASS
;
; 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 CHARACTER
;
SBLK:    LHLD    PNTR        ;FETCH ADDRESS
SBL1:    MOV    A,M        ;FETCH CHAR
    CPI    ' '        ;CHECK FOR A BLANK
    RNZ        ;RETURN IF NOT BLANK
SBL2:    INX    H
    SHLD    PNTR        ;SAVE POINTER
    JMP    SBL1
;
; THIS ROUTINE IS USED TO CHECK THE CONDITION CODE MNEMONICS
; FOR CONDITIONAL JUMPS, CALLS, AND RETURN.
;
COND:    LXI    H,ABUF+1
    SHLD    ADDS
    MVI    B,2        ;2 CHARACTERS
    CALL    COPC
    RET
;
; THE FOLLOWING IS THE OPCODE TABLE
;
OTAB:    DB    'ORG',0,0
    DB    'EQU',0,1
    DB    'DB',0,0,-1
    DB    'DS',0,0,3
    DB    'DW',0,0,5
    DB    'END',0,6,0
    DB    'HLT',76H
    DB    'RLC',7
    DB    'RRC',0FH
    DB    'RAL',17H
    DB    'RAR',1FH
    DB    'RET',0C9H
    DB    'CMA',2FH
    DB    'STC',37H
    DB    'DAA',27H
    DB    'CMC',3FH
    DB    'EI',0,0FBH
    DB    'DI',0,0F3H
    DB    'NOP',0,0
    DB    'XCHG',0EBH
    DB    'XTHL',0E3H
    DB    'SPHL',0F9H
    DB    'PCHL',0E9H,0
    DB    'STAX',2
    DB    'LDAX',0AH,0
    DB    'PUSH',0C5H
    DB    'POP',0,0C1H
    DB    'INX',0,3
    DB    'DCX',0,0BH
    DB    'DAD',0,9,0
    DB    'INR',4
    DB    'DCR',5
    DB    'MOV',40H
    DB    'ADD',80H
    DB    'ADC',88H
    DB    'SUB',90H
    DB    'SBB',98H
    DB    'ANA',0A0H
    DB    'XRA',0A8H
    DB    'ORA',0B0H
    DB    'CMP',0B8H
    DB    'RST',0C7H,0
    DB    'ADI',0C6H
    DB    'ACI',0CEH
    DB    'SUI',0D6H
    DB    'SBI',0DEH
    DB    'ANI',0E6H
    DB    'XRI',0EEH
    DB    'ORI',0F6H
    DB    'CPI',0FEH
    DB    'IN',0,0DBH
    DB    'OUT',0D3H
    DB    'MVI',6,0
    DB    'JMP',0,0C3H
    DB    'CALL',0CDH
    DB    'LXI',0,1
    DB    'LDA',0,3AH
    DB    'STA',0,32H
    DB    'SHLD',22H
    DB    'LHLD',2AH,0
; CONDITION CODE TABLE
    DB    'NZ',0
    DB    'Z',0,8
    DB    'NC',10H
    DB    'C',0,18H
    DB    'PO',20H
    DB    'PE',28H
    DB    'P',0,30H
    DB    'M',0,38H,0
;
; THIS ROUTINE IS USED TO CHECK A GIVEN OPCODE AGAINST TO LEGAL
; OPCODES CONTAINED IN THE OPCODE TABLE
;
COPC:    LHLD    ADDS
    LDAX    D        ;FETCH CHAR
    ORA    A
    JZ    COP1        ;JUMP IF TERMINATION CHAR
    MOV    C,B
    CALL    SEAR        ;COMPARE STRINGS
    LDAX    D
    RZ        ;RETURN IF MATCH
    INX    D        ;NEXT STRING
    JMP    COPC        ;CONTINUE SEARCH
COP1:    INR    A        ;CLEAR ZERO FLAG
    INX    D        ;INCR ADDRESS
    RET
;
; THIS ROUTINE CHACKS 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
; PASS 2
;
OPCD:    LXI    H,ABUF        ;SET ADDRESS
    SHLD    ADDS
    LXI    D,OTAB        ;OPCODE TABLE ADDRESS
    MVI    B,4        ;CHAR COUNT
    CALL    COPC        ;CHECK OPCODES
    JZ    PSEU        ;JUMP IF A PSEUDO OP
    DCR    B        ;3 CHAR OPCODES
    CALL    COPC
    JZ    OP1
    INR    B        ;4 CHAR OPCODES
    CALL    COPC
OP1:    LXI    H,TYP1        ;TYPE 1 INST
OP2:    MVI    C,1        ;1 BYTE INST
    JZ    OCNT
;
OPC2:    CALL    COPC        ;CHECK FOR STAX, LDAX
    LXI    H,TYP2
    JZ    OP2
    CALL    COPC        ;CHECK FOR PUSH,POP,INX,DCX,DAD
    LXI    H,TYP3
    JZ    OP2
    DCR    B        ;3 CHAR OPCODES
    CALL    COPC        ;ACCUMULATOR INST'S,INR,DCR,MOV,RST
    LXI    H,TYP4
    JZ    OP2
OPC3:    CALL    COPC        ;IMMEDIATE INSTRUCTIONS
    LXI    H,TYP5
    MVI    C,2        ;2 BYTE INSTRUCTIONS
    JZ    OCNT
    INR    B        ;4 CHAR OPCODES
    CALL    COPC        ;JMP,CALL,LXI,LDA,STA,LHLD,SHLD OPCODES
    JZ    OP4
    CALL    COND        ;CONDITIONAL INSTRUCTIONS
    JNZ    OERR        ;ILLEGAL OPCODE
    ADI    0C0H        ;ADD BASE VALUE OF RETURN
    MOV    D,A
    MVI    B,3        ;3 CHAR OPCODES
    LDA    ABUF        ;FETCH FIRST CHAR
    MOV    C,A        ;SAVE CHAR
    CPI    'R'        ;CONDITIONAL RETURN
    MOV    A,D
    JZ    OP1
    MOV    A,C
    INR    D        ;FORM CONDITIONAL JUMP
    INR    D
    CPI    'J'        ;CONDITIONAL JUMP
    JZ    OPAD
    CPI    'C'        ;CONDITIONAL CALL
    JNZ    OERR        ;ILLEGAL OPCODE
    INR    D        ;FORM CONDITIONAL CALL
    INR    D
OPAD:    MOV    A,D        ;GET OPCODE
OP4:    LXI    H,TYP6
OP5:    MVI    C,3        ;3 BYTE INSTRUCTION
OCNT:    STA    TEMP        ;SAVE OPCODE
; CHECK FOR OPCODE ONLY CONTAINING THE CORRECT NUMBER OF CHARACTERS
; THUS, SAY, ADDQ WOULD GIVE AN ERROR
    MVI    A,ABUF        ;LOAD BUFFER ADDRESS
    ADD    B        ;ADD LENGTH OF OPCODE
    MOV    E,A
    MVI    A,ABUF SHR 8        ;LOAD BUFFER ADDRESS
    ACI    0        ;GET HIGH ORDER PART
    MOV    D,A
    LDAX    D        ;FETCH CHAR AFTER OPCODE
    ORA    A        ;IS SHOULD BE ZERO
    JNZ    OERR        ;OPCODE ERROR
    LDA    PASI        ;FETCH PASS INDICATOR
OCN1:    MVI    B,0
    XCHG
OCN2:    LHLD    ASPC        ;FETCH PROGRAM COUNTER
    DAD    B        ;ADD IN BYTE COUNT
    SHLD    ASPC        ;STORE PC
    ORA    A        ;WHICH PASS
    RZ        ;RETURN IF PASS 1
    LDA    TEMP        ;FETCH OPCODE
    XCHG
    PCHL
;
OERR:    LXI    H,ERRO        ;SET ERROR ADDRESS
    MVI    C,3        ;LEAVE 3 BYTES FOR PATCH
    JMP    OCN1-3
;
PSEU:    LXI    H,ABUF+4        ;SET BUFFER ADDRESS
    MOV    A,M        ;FETCH CHAR AFTER OPCODE
    ORA    A        ;SHOULD BE A ZERO
    JNZ    OERR
    LDA    PASI        ;FETCH 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 VALUE
; ASSOCIATED WITH THE LABEL.  OTHERWISE D,E POINT TO THE NEXT AVAILABLE
; 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 THE USER
; ON RETURN C=1 INDICATES A LABEL ERROR
;
SLAB:    CPI    'A'        ;CHECK FOR LEGAL CHAR
    RC        ;RETURN IF ILLEGAL CHAR
    CPI    'Z'+1
    CMC
    RC        ;RETURN IF ILLEGAL CHAR
    CALL    ALPS        ;PLACE SYMBOL IN BUFFER
    LXI    H,ABUF        ;SET BUFFER ADDRESS
    SHLD    ADDS        ;SAVE ADDRESS
    DCR    B        ;CHECK IF ONE CHAR
    JNZ    SLA1
; CHECK IF PREDEFINED REGISTER NAME
    INR    B        ;SET B=1
    LXI    D,RTAB        ;REGISTER TABLE ADDRESS
    CALL    COPC        ;CHECK NAME OF REGISTER
    JNZ    SLA1        ;NOT A PREDEFINED REGISTER
    MOV    L,A
    MVI    H,0        ;SET VALUE (HIGH)
    JMP    SLA2
SLA1:    LDA    NOLA        ;FETCH SYMBOL COUNT
    MOV    B,A
    LXI    D,SYMT        ;SET SYMBOL TABLE ADDRESS
    ORA    A        ;ARE THERE ANY LABELS
    JZ    SLA3        ;JUMP IF NO LABELS
    MVI    A,LLAB        ;FETCH LENGTH OF TABLE
    STA    NCHR
    CALL    COMS        ;CHECK TABLE
SLA2:    STC
    CMC        ;CLEAR CARRY
    RET
SLA3:    INR    A        ;CLEAR ZERO FLAG
    ORA    A        ;CLEAR CARRY
    RET
;
; PREDEFINE REGISTER VALUES IN THIS TABLE
;
RTAB:    DB    'A',7
    DB    'B',0
    DB    'C',1
    DB    'D',2
    DB    'E',3
    DB    'H',4
    DB    'L',5
    DB    'M',6
    DB    0        ;END OF TABLE INDICATOR
;
; 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 CHAR IN BUFFER
    INR    B        ;INCR COUNT
    MOV    A,B        ;FETCH COUNT
    CPI    11        ;MAX BUFFER SIZE
    RNC        ;RETURN IF BUFFER FILLED
    INX    D        ;INCR BUFFER
    INX    H        ;INCR INPUT ADDRESS
    SHLD    PNTR        ;SAVE LINE POINTER
    MOV    A,M        ;FETCH CHAR
    CPI    '0'        ;CHECK FOR LEGAL CHAR
    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:    LXI    H,0        ;GET A ZERO
    SHLD    OPRD        ;INITIALIZE OPERAND
    INR    H
    SHLD    OPRI-1        ;INITIALIZE OPERAND INDICATOR
NXT1:    LHLD    PNTR        ;FETCH SCAN POINTER
    DCX    H
    CALL    ZBUF        ;CLEAR BUFFER
    STA    SIGN        ;ZERO SIGN INDICATOR
NXT2:    INX    H        ;INCR POINTER
    MOV    A,M        ;FETCH NEXT CHAR
    CPI    ' '+1
    JC    SEND        ;JUMP IF CR OR BLANK
    CPI    ','        ;FIELD SEPARATOR
    JZ    SEND
; CHECK FOR OPERATORS
    CPI    '+'        ;CHECK FOR PLUS
    JZ    ASCI
    CPI    '-'        ;CHECK FOR MINUS
    JNZ    ASC2
    STA    SIGN
ASCI:    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
ASC2:    MOV    C,A        ;SAVE CHAR
    LDA    OPRI        ;GET INDICATOR
    ORA    A        ;CHECK FOR TWO OPERANDS
    JZ    ERRS        ;SYNTAX ERROR
    MOV    A,C
    CPI    '$'        ;LC EXPRESSION
    JNZ    ASC3
    INX    H
    SHLD    PNTR        ;SAVE POINTER
    LHLD    ASPC        ;FETCH LOCATION COUNTER
    JMP    AVAL
; CHECK FOR ASCII CHARS
ASC3:    CPI    2 TABLE END ADDRESS
ASPC:    DS    2        ;ASSEMBLER PROGRAM COUNTER
PASI:    DS    1        ;PASS INDICATOR
NCHR:    DS    1        ;LENGTH OF STRING FOR COMPARE
PNTR:    DS    2        ;LINE POINTER STORAGE
NOLA:    DS    1        ;NUMBER OF LABELS
SIGN:    DS    1        ;SIGN STORAGE FOR SCAN
OPRD:    DS    2        ;OPERAND STORAGE
OPRI:    DS    1        ;OPERAND FOUND INDICATOR
TEMP:    DS    1
APNT    EQU    INSP        ;ASSEMBLER LINE POINTER
AERR    EQU    SCNT        ;ASSEMBLER ERROR PRINT SWITCH
OIND:    DS    2        ;OUTPUT ADDRESS
LLAB    EQU    5        ;LENGTH OF LABELS
AREA:    DS    18
OBUF:    DS    25        ;OUTPUT BUFFER AREA
    DS    5:    CPI    '0'        ;CHECK FOR NUMERIC
    JC    ERRA        ;ILLEGAL CHAR
    CPI    '9'+1
    JNC    ALAB
    CALL    NUMS        ;GET NUMERIC VALUE
    JC    ERRA        ;ARGUMENT ERROR
AVAL:    XCHG
    LHLD    OPRD        ;FETCH OPERAND
    XRA    A        ;GET A ZERO
    STA    OPRI        ;STORE IN OPERAND INDICATOR
    LDA    SIGN        ;GET SIGN INDICATOR
    ORA    A        ;SET FLAGS
    JNZ    ASUB
    DAD    D        ;FORM RESULT
ASC7:    SHLD    OPRD        ;SAVE RESULT
    JMP    NXT1
ASUB:    MOV    A,L
    SUB    E
    MOV    L,A
    MOV    A,H
    SBB    D
    MOV    H,A
    JMP    ASC7
ALAB:    CALL    SLAB
    JZ    AVAL
    JC    ERRA        ;ILLEGAL SYMBOL
    JMP    ERRU        ;UNDEFINEσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσR ADDRESS
    CPI    'H'        ;IS IT HEX
    JZ    NUM2
    CPI    'D'        ;IS IT DECIMAL
    JNZ    NUM1
    XRA    A        ;GET A ZERO
    STAX    D        ;CLEAR D FROM BUFFER
NUM1:    CALL    ADEC        ;CONVERT DECIMAL VALUE
    RET
NUM2:    XRA    A
    STAX    D        ;CLEAR H FROM BUFFER
    CALL    AHEX        ;CONVERT HEX
    RET
; PROCESS REGISTER ERROR
ERRR:    MVI    A,'R'        ;GET INDICATOR
    LXI    H,0
    STA    OBUF+18        ;SET IN OUTPUT BUFFER
    RET
; PROCESS SYNTAX ERROR
ERRS:    MVI    A,'S'
    STA    OBUF+18
    LXI    H,0
    RET
; PROCESS UNDEFINED SYMBOL ERROR
ERRU:    MVI    A,'U'
    JMP    ERRS+2
; PROCESS VALUE ERROR
ERRV:    MVI    A,'V'
    JMP    ERRR+2
; PROCESS MISSING LABEL ERROR
ERRM:    MVI    A,'M'
    STA    OBUF+18
    CALL    AOU1
    RET
; PROCESS ARGUMENT ERROR
ERRA:    MVI    A,'A'
    JMP    ERRS+2
; PROCESS OPCODE ERROR
; STORE 3 BYTES OF ZERO IN OBJECT CODE TO PROVIDE FOR PATCH
ERRO:    MVI    A,'O'
    STA    OBUF+18
    LDA    PASI        ;FETCH PASS INDICATOR
    ORA    A
    RZ        ;RETURN 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
    RET
; PROCESS LABEL ERROR
ERRL:    MVI    A,'L'
    JMP    ERRO+2
; PROCESS DUPLICATE LABEL ERROR
ERRD:    MVI    A,'D'
    STA    OBUF+18
    CALL    AOUT
    JMP    OPC
;
;
; DEFINE INPUT AND OUTPUT PORTS
;
USTA    EQU    0        ;UART STATUS
UDAI    EQU    1        ;DATA IN
UDAO    EQU    1        ;DATA OUT
PDAI    EQU    6        ;PROM DATA IN
PADO    EQU    7        ;PROM ADDRESS OUT
PDAO    EQU    8        ;PROM DATA OUT
PCTO    EQU    9        ;PROM CONTROL OUT
SWCH    EQU    0FFH
;
; FILE AREA PARAMETERS
;
MAXFIL    EQU    6        ;MAX # OF FILES
NMLEN    EQU    5        ;NAME LENGTH
FELEN    EQU    NMLEN+8        ;DIRECTORY ENTRY LENGTH
FILE0:    DS    NMLEN
BOFP:    DS    2
EOFP:    DS    2
MAXL:    DS    4
FILTB:    DS    (MAXFIL-1)*FELEN
INSP:    DS    2        ;INSERT LINE POSITION
DELP    EQU    INSP        ;DELETE LINE POSITION
ASCR    EQU    13        ;ASCII CARRIAGE RETURN VALUE
HCON:    DS    2
ADDS    EQU    HCON        ;FIND ADDRESS
FBUF:    DS    NMLEN        ;FILE NAME BUFFER
FREAD:    DS    2        ;FREE ADDRESS IN DIRECTORY
FEF:    DS    1        ;FREE ENTRY FOUND FLAG
FOCNT    EQU    FEF        ;OUTPUT COUNTER
ABUF:    DS    12        ;ASCII BUFFER
BBUF:    DS    4        ;BINARY BUFFER
SCNT:    DS    1
DCNT:    DS    1        ;DUMP ROUTINE COUNTER
NCOM    EQU    10        ;NUMBER OF COMMANDS
TABA:    DS    2        ;SYMBOL TABLE END ADDRESS
ASPC:    DS    2        ;ASSEMBLER PROGRAM COUNTER
PASI:    DS    1        ;PASS INDICATOR
NCHR:    DS    1        ;LENGTH OF STRING FOR COMPARE
PNTR:    DS    2        ;LINE POINTER STORAGE
NOLA:    DS    1        ;NUMBER OF LABELS
SIGN:    DS    1        ;SIGN STORAGE FOR SCAN
OPRD:    DS    2        ;OPERAND STORAGE
OPRI:    DS    1        ;OPERAND FOUND INDICATOR
TEMP:    DS    1
APNT    EQU    INSP        ;ASSEMBLER LINE POINTER
AERR    EQU    SCNT        ;ASSEMBLER ERROR PRINT SWITCH
OIND:    DS    2        ;OUTPUT ADDRESS
LLAB    EQU    5        ;LENGTH OF LABELS
AREA:    DS    18
OBUF:    DS    25        ;OUTPUT BUFFER AREA
    DS    5
IBUF:    DS    83
SYMT    EQU    $        ;START OF SYMBOL TABLE
    END