中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net  论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
« [1] [2] [3] [4] [5] [6] »
作者:
标题: 汇编语言 上一主题 | 下一主题
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 61 楼』:  CM\P汇编

;       COMMON DATA FOR CP/M ASSEMBLER MODULE
                ORG                100H
                ENDA        EQU 20F0H                ;END OF ASSEMBLER PROGRAM
                BDOS        EQU 5H                        ;ENTRY TO DOS, USED TO COMPUTE END MEMORY
                LXI                SP, ENDMOD
                LHLD        BDOS+1
                SHLD        SYMAX                        ;COMPUTE END OF MEMORY
                JMP                ENDMOD
;
;                PRINT BUFFER AND PRINT BUFFER POINTER
                PBMAX        EQU 120                        ;MAX PRINT BUFFER
PBUFF:
                DS                PBMAX
PBP:
                DS                1                                ;PRINT BUFFER POINTER
;
;                SCANNER PARAMETERS
TOKEN:
                DS                1                                ;CURRENT TOKEN
VALUE:
                DS                2                                ;BINARY VALUE FOR NUMBERS
ACCLEN:
                DS                1                                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;LENGTH OF ACCUMULATOR
ACCUM:
                DS                ACMAX                        ;ACCUMULATOR (MUST FOLLOW ACCLEN)
;
;                OPERAND EXPRESSION EVALUATOR PARAMETERS
EVALUE:
                DS                2                                ;VALUE OF EXPRESSION AFTER EVALUATION
;
;                SYMBOL TABLE MODULE PARAMETERS
SYTOP:
                DW      ENDA                     ;FIRST LOCATION AVAILABLE FOR SYMBOL TABLE
SYMAX:
                DS                2                                ;LAST AVAILABLE LOCATION FOR SYMBOL TABLE
;
;                MISCELLANEOUS DATA AREAS
PASS:
                DS                1                                ;PASS # 0,1
FPC:
                DS                2                                ;FILL ADDRESS FOR NEXT HEX RECORD
ASPC:
                DS                2                                ;ASSEMBLER'S PSEUDO PC
SYBAS:
                DW                ENDA                        ;SYMBOL TABLE BASE
SYADR:
                DS                2                                ;CURRENT SYMBOL BASE
                ENDMOD        EQU ($ AND 0FF00H)+100H
                END


;                I/O MODULE FOR CP/M ASSEMBLER
;
                ORG                206H
                BOOT        EQU SOCH                ;REBOOT LOCATION
                                                                ;I/O MODULE ENTRY POINTS
                JMP                INIT                        ;INITIALIZE, START ASSEMBLER
                JMP                SETUP                        ;FILE SETUP
                JMP                GNC                                ;GET NEXT CHARACTER
                JMP                PNC                                ;PUT NEXT OUTPUT CHARACTER
                JMP                PNB                                ;PUT NEXT HEX BYTE
                JMP                PCHAR                        ;PRINT CONSOLE CHARACTER
                JMP                PCON                        ;PRINT CONSOLE BUFFER TO CRLF
                JMP                WOBUFF                        ;WRITE OUTBUFFER
                JMP                PERR                        ;PLACE ERROR CHARACTER INTO PBUFF
                JMP                DHEX                        ;PLACE HEX BYTE INTO OUTPUT BUFFER
                JMP                EOR                                ;END OF ASSEMBLY
;                DATA FOR I/O MODULE
BPC:
                DS                2                                ;BASE PC FOR CURRENT HEX RECORD
DBL:
                DS                1                                ;HEX BUFFER LENGTH
DBUFF:
                DS                16                                ;HEX BUFFER
;
;                DISK NAMES
                CDISK        DS 1                        ;CURRENTLY SELECTED DISK
                ADISK        DS 1                        ;.ASM DISK
PDISK:
                DS                1                                ;.PRN DISK
HDISK:
                DS                1                                ;.HEX DISK
;
;
;                COMMON EQUATES
                QBMAX        EQU 120                        ;MAX PRINT SIZE
                QBUFF        EQU 10CH                ;PRINT BUFFER
                QBP                EQU QBUFF+QBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU QBP+1                ;CURRENT TOKEN USER SCAN
                VALUE        EQU TOKEN+l                ;VALUE OF NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX.ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;PILL ADDRESS FOR DHEX ROUTINE
                ASPC        EQU FPC+2                ;ASSEMBLER'S PSEUDO PC
;
                CR                EQU 0DH                        ;CARRIAGE RETURN
                LF                EQU 0AH                        ;LINE FEED
                EOF                EQU 1AH                        ;END OF FILE MARK
;
;
;                DOS ENTRY POINTS
                BDOS        EQU 5H                        ;DOS ENTRY POINT
                READC        EQU 1                        ;READ CONSOLE DEVICE
                WRITC        EQU 2                        ;WRITE CONSOLE DEVICE
                REDYC        EQU 11                        ;CONSOLE CHARACTER READY
                SELECT        EQU 14                        ;SELECT DISK SPECIFIED BY REGISTER E
                OPENF        EQU 15                        ;OPEN FILE
                CLOSF        EQU 16                        ;CLOSE FILE
                DELEF        EQU 19                        ;DELETE FILE
                READF        EQU 20                        ;READ FILE
                WRITF        EQU 21                        ;WRITE FILE
                MAKEF        EQU 22                        ;MAKE A FILE
                CSEL        EQU 25                        ;RETURN CURRENTLY SELECTED DISK
                SETDM        EQU 26                        ;SET DMA ADDRESS
;
;                FILE AND BUFFERING PARAMETERS
                NSB                EQU 8                        ;NUMBER OF SOURCE BUFFERS
                NPB                EQU 6                        ;NUMBER OF PRINT BUFFERS
                NHB                EQU 6                        ;NUMBER OF HEX BUFFERS
;
                SSIZE        EQU NSB*128
                PSIZE        EQU NPB*128
                ESIZE        EQU NHB*128
;
;                FILE CONTROL BLOCKS
SCB:
                DS                9                                ;FILE NAME
                DB                'ASM'                        ;FILE TYPE
SCBR:
                DS                1                                ;REEL NUMBER (ZEROED IN SETUP)
                DS                19                                ;MISC AND DISK MAP
SCBCR:
                DS                1                                ;CURRENT RECORD (ZEROED IN SETUP)
;
PCB:
                DS                9
                DB                'PRN', 0
                DS                19
                DB                0                                ;RECORD TO WRITE NEXT
;
HCB:
                DS                9
                DB                'HEX', 0
                DS                19
                DB                0
;
;                POINTERS AND BUFFERS
SBP:
                DW                SSIZE                        ;NEXT CHARACTER POSITION TO READ
SBUFF:
                DS                SSIZE
;
PBP:
                DW                0
PBUFF:
                DS                PSIZE
;
HBP:
                DW                0
HBUFF:
                DS                HSIZE
                FCB                EQU SCH                        ;FILE CONTROL BLOCK ADDRESS
                FNM                EQU 1                        ;POSITION OF FILE NAME
                FLN                EQU 9                        ;FILE NAME LENGTH
                DUFF        EQU 80H                        ;INPUT DISK BUFFER ADDRESS
;
SEL:                                                        ;SELECT DISK IN REG-A
                LXI                H, CDISK
                CMP                M                                ;SAME?
                RZ
                MOV                M, A                        ;CHANGE CURRENT DISK
                MOV                E, A
                MVI                C, SELECT
                CALL        BDOS
                RET
;
SCNP:                                                        ;SCAN THE NEXT PARAMETER
                INX                H
                MOV                A, M
                CPI                ' '
                JZ                SCNP0
                SBI                'A'                                ;NORMALIZE
                RET
SCNP0:
                LDA                CDISK
                RET
;
PCON:                                                        ;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
                MOV                A, M
                CALL        PCHAR
                MOV                A, M
                INX                H
                CPI                CR
                JNZ                PCON
                MVI                A, LF
                CALL        PCHAR
                RET
;
FNAME:                                                        ;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
                LXI                D, FCB
                MVI                B, FLN
FNAM0:
                LDAX        D                                ;GET NEXT FILE CHARACTER
                CPI                '?'
                JZ                FNERR                        ;FILE NAME ERROR
                MOV                M, A                        ;STORE TO FILE CNTRL BLOCK
                INX                H
                INX                D
                DCR                B
                JNZ                FNAM0                        ;FOR NEXT CHARACTER
                RET
;
INIT:                                                        ;SET UP STACK AND FILES, START ASSEMBLER
                LXI                H                                ;TITL
                CALL        PCON
                JMP                SET0
;
OPEN:                                                        ;OPEN FILE ADDRESSED BY D,E
                MVI                C                                ;OPENF
                CALL        BDOS
                CPI                255
                RNZ
                                                                ;OPEN ERROR
                LXI                H, ERROP
                CALL        PCON
                JMP                BOOT
;
CLOSE:                                                        ;CLOSE FILE ADDRESSED BY D,E
                MVI                C, CLOSF
                CALL        BDOS
                CPI                255
                RNZ                                                ;CLOSE OK
                LXI                H, ERRCL
                CALL        PCON
                JMP                BOOT
;
DELETE:                                                        ;DELETE FILE' ADDRESSED BY D,E
                MVI                C, DELEF
                JMP                BDOS
;
MAKE:                                                        ;MAKE FILE ADDRESSED BY D,E
                MVI                C, MAKEF
                CALL        BDOS
                CPI                255
                RNZ
                                                                ;MAKE ERROR
                LXI                H, ERRMA
                CALL        PCON
                JMP                BOOT
;
SELA:
                LDA                ADISK
                CALL        SEL
                RET
;
NPR:                                                        ;RETURN ZERO FLAG IF NO PRINT FILE
                LDA                PDISK
                CPI                'Z'-'A'
                RZ
                CPI                'X'-'A'                        ;CONSOLE:
                RET
;
SELP:
                LDA                PDISK
                CALL        SEL
                RET
;
SELH:
                LDA                HDISK
                CALL        SEL
                RET
;
SET0:                                                        ;SET UP FILES FOR INPUT AND OUTPUT
                LDA                FCB                                ;GET FIRST CHARACTER
                CPI                                                ;MAY HAVE FORGOTTEN NAME
                JZ                FNERR                        ;FILE NAME ERROR
                MVI                C, CSEL                        ;CURRENT DISK?
                CALL        BDOS                        ;GET IT TO REG
                STA                CDISK
;
;                SCAN PARAMETERS
                LXI                H, FCB+FLN-1
                CALL        SCNP
                STA                ADISK
                CALL        SCNP
                STA                HDISK
                CALL        SCNP
                STA                PDISK
;
                LXI                H, SCB                        ;ADDRESS SOURCE FILE CONTROL BLOCK
                CALL        FNAME                        ;FILE NAME OBTAINED FROM DEFAULT FCB
;
                CALL        NPR                                ;Z OR X?
                JZ                NOPR
                LXI                H, PCB                        ;ADDRESS PRINT FILE CONTROL BLOCK
                PUSH        H                                ;SAVE A COPY FOR OPEN
                PUSH        H                                ;SAVE A COPY FOR DELETE
                CALL        FNAME                        ;FILL PCB
                CALL        SELP
                POP                D                                ;FCB ADDRESS
                CALL        DELETE
                POP                D                                ;FCB ADDRESS?
                CALL        MAKE
;
NOPR:                                                        ;TEST FOR HEX FILE
                LDA                HDISK
                CPI                'Z'-'A'
                JZ                NOHEX
                LXI                H, HCB
                PUSH        H
                PUSH        H
                CALL        FNAME
                CALL        SELH
                POP                D
                CALL        DELETE
                POP                D
                CALL        MAKE
;
;                FILES SET UP, CALL ASSEMBLER
NOHEX:
                JMP                ENDMOD
;
SETUP:                                                        ;SETUP INPUT FILE FOR SOURCE PROGRAM
                LXI                H, SSIZE
                SHLD        SBP                                ;CAUSE IMMEDIATE READ
                XRA                A                                ;ZERO  VALUE
                STA                SCBR                        ;CLEAR REEL NUMBER
                STA                SCBCR                        ;CLEAR CURRENT RECORD
                STA                DBL                                ;CLEAR HEX BUFFER LENGTH
                CALL        SELA
                LXI                D, SCB
                CALL        OPEN
;
                RET
;
FNERR:                                                        ;FILE NAME ERROR
                LXI                H, ERRFN
                CALL        PCON
                JMP                BOOT
;
;
GCOMP:                                                        ;COMPARE D,E AGAINS H,L
                MOV                A, D
                CMP                H
                RNZ
                MOV                A, E
                CMP                L
                RET
;
GNC:                                                        ;GET NEXT CHARACTER FROM SOURCE BUFFER
                PUSH        B
                PUSH        D
                PUSH        H                                ;ENVIRONMENT SAVED
                LHLD        SBP
                LXI                D                                ;SSIZE
                CALL        GCOMP
                JNZ                GNC2
;
                                                                ;READ ANOTHER BUFFER
                CALL        SELA
                LXI                H, 0
                SHLD        SBP
                MVI                B, NSB                        ;NUMBER OF SOURCE BUFFERS
                LXI                H, SBUFF
GNC0:                                                        ;READ 128 BYTES
                PUSH        B                                ;SAVE COUNT
                PUSH        H                                ;SAVE BUFFER ADDRESS
                MVI                C, READF
                LXI                D, SCB
                CALL        BDOS                        ;PERFORM THE READ
                POP                H                                ;RESTORE BUFFER ADDRESS
                POP                B                                ;RESTORE BUFFER COUNT
                ORA                A                                ;SET FLAGS
                MVI                C, 128
                JNZ                GNC1
                                                                ;NORMAL READ OCCURRED
                LXI                D, BUFF                        ;SOURCE BUFFER ADDRESS
                MVI                C, 128
MOV0:
                LDAX        D                                ;GET CHARACTER
                MOV                M, A                        ;STORE CHARACTER
                INX                D
                INX                H
                DCR                C
                JNZ                MOV0
                                                                ;BUFFER LOADED, TRY NEXT BUFFER
;
                DCR                B
                JNZ                GNC0
                JMP                GNC2
;
GNCl:                                                        ;EOF OR ERROR
                CPI                3                                ;ALLOW 0,1,2
                JNC                FRERR                        ;FILE READ ERROR
GNCE:
                MVI                M, EOF                        ;STORE'AND END OF FILE CHARACTER
                INX                H
                DCR                C
                JNZ                GNCE                        ;FILL CURRENT BUFFER WITH EOF'S
;
GNC2:                                                        ;GET CHARACTER TO ACCUMULATOR AND RETURN
                LXI                D, SBUFF
                LHLD        SBP
                PUSH        H                                ;SAVE CURRENT SBP
                INX                H                                ;READY FOR NEXT READ
                SHLD        SBP
                POP                H                                ;RESTORE PREVIOUS SBP
                DAD                D                                ;ABSOLUTE ADDRESS OF CHARACTER
                MOV                A, M                        ;GET IT
                POP                H
                POP                D
                POP                B
                RET
;
FRERR:
                LXI                H, ERRFR
                CALL        PCON                        ;PRINT READ ERROR MESSAGE
                JMP                BOOT
;
PNC:                                                        ;SAME AT PNCF, BUT ENVIRONMENT IS SAVED FIRST
                PUSH        B
                                                                ;CHECK FOR CONSOLE OUTPUT /'NO OUTPUT
                MOV                B, A                        ;SAVE CHARACTER
                LDA                PDISK                        ;Z  OR  X?
                CPI                'Z'-'A'                        ;Z NO OUTPUT
                JZ                PNRET
;
                CPI                'X'-'A'
                MOV                A, B                        ;RECOVER CHAR FOR CON OUT
                JNZ                PNGO
                CALL        PCHAR
                JMP                PNRET
;
                                                                ;NOT X OR Z, SO PRINT IT
PNGO:
                PUSH        D
                PUSH        H
                CALL        PNCF
                POP                H
                POP                D
PNRET:
                POP                B
                RET
;
PNCF:                                                        ;PRINT NEXT CHARACTER
                LHLD        PBP
                XCHG
                LXI                H, PBUFF
                DAD                D
                MOV                M, A                        ;CHARACTER STORED AT PBP IN PBUFF
                XCHG                                        ;PBP TO H,L
                INX                H                                ;POINT TO NEXT CHARACTER
                SHLD        PBP                                ;REPLACE IT
                XCHG
                LXI                H, PSIZE
                CALL        GCOMP                        ;AT END OF BUFFER?
                RNZ                                                ;RETURN IF NOT
;
                                                                ;OVERFLOW, WRITE BUFFER
                CALL        SELP
                LXI                H, 0
                SHLD        PSP
                LXI                H, PBUFF
                LXI                D, PCB                        ;D,E ADDRESS FILE CONTROL BLOCK
                MVI                B, NPS                        ;NUMBER OF BUFFERS TO B
;       (DROP THROUGH TO WBUFF)
;
WBUFF:                                                        ;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
;         CHECK FOR EOF'S
                MOV                A, M
                CPI                EOF
                RZ                                                ;DON'T DO THE WRITE
;
                PUSH        B                                ;SAVE NUMBER OF BUFFERS
                PUSH        D                                ;SAVE FCB ADDRESS
                MVI                C, 128                        ;READY FOR MOVE
                LXI                D, BUFF
WBUF0:                                                        ;MOVE TO BUFFER
                MOV                A, M                        ;GET CHARACTER
                STAX        D                                ;PUT CHARACTER
                INX                H
                INX                D
                DCR                C
                JNZ                WBUF0
;
                                                                ;WRITE   BUFFER
                POP                D                                ;RECOVER FCB ADDRESS
                PUSH        D                                ;SAVE IT AGAIN FOR LATER
                PUSH        H                                ;SAVE BUFFER ADDRESS
                MVI                C, WRITF                ;DOS WRITE FUNCTION
                CALL        BDOS
                POP                H                                ;RECOVER BUFFER ADDRESS
                POP                D                                ;RECOVER FCB ADDRESS
                POP                B                                ;RECOVER BUFFER COUNT
                ORA                A                                ;SET ERROR RETURN FLAGS
                JNZ                FWERR
;
                                                                ;WRITE    OX
                DCR                B
                RZ                                                ;RETURN IF NO' MORE BUFFERS TO WRITE
                JMP                WBUFF
;
FWERR:                                                        ;ERROR IN WRITE
                LXI                H, ERRFW
                CALL        PCON                        ;ERROR MESSAGE OUT
                JMP                EORC                        ;TO CLOSE AND REBOOT
;
;
PNB:                                                        ;PUT NEXT HEX BYTE
                PUSH        B
                PUSH        D
                PUSH        H
                CALL        PNBF
                POP                H
                POP                D
                POP                B
                RET
;
PNBF:                                                        ;PUT NEXT BYTE
;       (SIMILAR TO THE PNCF SUBROUTINE)
                LHLD        HBP
                XCHG
                LXI                H, HBUFF
                DAD                D
                MOV                M, A                        ;CHARACTER STORED AT HBP IN HBUFF
                XCHG
                INX                H                                ;HBP INCREMENTED
                SHLD        HBP
                XCHG                                        ;BACK TO D,E
                LXI                H, HSIZE
                CALL        GCOMP                        ;EQUAL?
                RNZ
;
                                                                ;OVERFLOW, WRITE BUFFERS
                CALL        SEDH
                LXI                H, D
                SHLD        HBP
                LXI                H, HBUFF
                LXI                D, HCB                        ;FILE CONTROL BLOCK FOR HEX FILE
                MVI                B, NHB
                JMP                WBUFF                        ;WRITE BUFFERS
;
PCHAR:                                                        ;PRINT CHARACTER IN REGISTER A
                PUSH        B
                PUSH        D
                PUSH        H
                MVI                C, WRITC
                MOV                E, A
                CALL        BDOS
                POP                H
                POP                D
                POP                B
                RET
;
WOCHAR:                                                        ;WRITE CHARACTER IN REG-A WITH REFLECT AT CONSOLE IF EB
                MOV                C, A                        ;SAVE THE CHAR
                CALL        PNC                                ;PRINT CHAR
                LDA                QBUFF
                CPI
                RZ
                                                                ;ERROR        IN LINE
                LDA                PDISK
                CPI                'X'-'A'
                RZ                                                ;ALREADY PRINTED IF 'X'
;
                MOV                A, C                        ;RECOVER CHARACTER
                CALL        PCHAR                        ;PRINT IT
                RET
;
WOBUFF:                                                        ;WRITE THE OUTPUT BUFFER TO THE PRINT FILE
                LDA                QBP                                ;GET CHARACTER COUNT
                LXI                H, QBUFF                ;BASE OF BUFFER
WOB0:
                ORA                A                                ;ZER0 COUNT?
                JZ                WOBE
                                                                ;NOT END, SAVE COUNT AND GET CHARACTER
                MOV                B, A                        ;SAVE COUNT
                MOV                A, M
                CALL        WOCHAR                        ;WRITE CHARACTER
                INX                H                                ;ADDRESS NEXT CHARACTER OF BUFFER
                MOV                A, B                        ;GET COUNT
                DCR                A
                JMP                WOB0
;
WOBE:                                                        ;END OF PRINT - ZERO QBP
                STA                QBP
                                                                ;FOLLOW BY CR LF
                MVI                A, CR
                CALL        WOCHAR
                MVI                A, LF
                CALL        WOCHAR
                LXI                H, QBUFF
                MVI                A, QBMAX                ;READY TO BLANK OUT
WOB2:
                MVI                M,' '
                INX                H
                DCR                A
                JNZ                WOB2
                RET
;
;
PERR:                                                        ;FILL QBUFF ERROR MESSAGE POSITION
                MOV                B, A                        ;SAVE CHARACTER
                LXI                H, QBUFF
                MOV                A, M
                CPI                ' '
                RNZ                                                ;DON'T CHANGE IT IF ALREADY SET
                MOV                M, B                        ;STORE ERROR CHARACTER
                RET
;

EOR:                                                        ;END OF ASSEMBLER
                CALL        NPR                                ;Z OR A?
                JZ                EOPR
                                                                ;FILL OUTPUT FILES WITH EOF'S
EOR2:
                LHLD        PBP
                MOV                A, L
                ORA                H                                ;VALUE ZERO?
                JZ                EOPR
                MVI                A, EOF                        ;CTL-Z IS END OF FILE
                CALL        PNC                                ;PUT ENDFILES IN PRINT BUFFER
                JMP                EOR2                        ;EVENTUALLY BUFFER IS WRITTEN
;
EOPR:                                                        ;END 0F PRINT PILE, CHECK HEX
                LDA                HDISK
                CPI                'Z'-'A'
                JZ                EORC
EOR0:                                                        ;WRITE TERMINATING RECORD INTO HEX FILE
                LDA                DBL                                ;MAY BE ZERO ALREADY
                ORA                A
                CNZ                WHEX                        ;WRITE HEX BUFFER IF NOT ZERO
                LHLD        FPC                                ;GET CURRENT FPC AS LAST ADDRESS
                SHLD        BPC                                ;RECORD LENGTH ZERO, BASE ADDRESS 0000
                CALL        WHEX                        ;WRlTE HEX BUFFER
;
                                                                ;NOW CLEAR OUTPUT BUFFER FOR HEX FILE
EOR1:
                LHLD        HBP
                MOV                A, L
                ORA                H
                JZ                EORC
                MVI                A, EOF
                CALL        PNB
                JMP                EOR1
;
;                CLOSE FILES AND TERMINATE
EORC:
                CALL        NPR
                JZ                EORPC
                CALL        SELP
                LXI                D, PCB
                CALL        CLOSE
EORPC:
                LDA                HDISK
                CPI                'Z'-'A'
                JZ                EORHC
                CALL        SELH
                LXI                D, HCB
                CALL        CLOSE
;
EORHC:
                LXI                H, ENDA
                CALL        PCON
                JMP                BOOT
;
TITL:
                DB                'CP/M ASSEMBLER - VER 1.0', CR
ERROP:
                DB                'NO SOURCE FILE PRESENT', CR
ERRMA:
                DB                'NO DIRECTORY SPACE', CR
ERRFN:
                DB                'SOURCE FILE NAME ERROR', CR
ERRFR:
                DB                'SOURCE FILE READ ERROR', CR
ERRFW:
                DB                'OUTPUT FILE WRITE ERROR', CR
ERRCL:
                DB                'CANNOT CLOSE FILES', CR
PENDA:
                DB                'END OF ASSEMBLY', CR
;
DHEX:                                                        ;DATA TO HEX BUFFER (BYTE IN REG-A)
                PUSH        B
                MOV                B, A                        ;HOLD CHARACTER FOR 'Z' TEST
                LDA                HDISK
                CPI                'Z'-'A'
                MOV                A, B                        ;RECOVER CHARACTER
                JZ                DHRET
                PUSH        D                                ;ENVIRONMENT SAVED
                PUSH        PSW                                ;SAVE DATA BYTE
                LXI                H, DBL                        ;CURRENT LENGTH
                MOV                A, M                        ;TO ACCUM
                ORA                A                                ;ZERO?
                JZ                DHEX3
;
                                                                ;LENGTH        NOT ZERO, MAY BE FULL BUFFER
                CPI                16
                JC                DHEX1                        ;BR IF LESS THAN 16 BYTES
                                                                ;BUFFER FULL, DUMP IT
                CALL        WHEX                        ;DBL = 0 UPON RETURN
                JMP                DHEX3                        ;SET BPC AND DATA BYTE
;
DHEX1:                                                        ;PARTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
                LHLD        FPC
                XCHG
                LHLD        BPC                                ;BASE PC IN H,L
                MOV                C, A                        ;CURRENT LENGTH OF BUFFER
                MVI                B, 0                        ;IS IN B,C
                DAD                B                                ;BPC+DBL TO H,L
                MOV                A, E                        ;READY FOR COMPARE
                CMP                L                                ;EQUAL?
                JNZ                DHEX2                        ;BR IF NOT
                MOV                A, D                        ;CHECK HO BYTE
                CMP                H
                JZ                DHEX4                        ;BR IF SAME ADDRESS
;
DHEX2:                                                        ;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
                CALL        WHEX
DHEX3:                                                        ;SET NEW BASE
                LHLD        FPC
                SHLD        BPC
;
DHEX4:                                                        ;STORE DATA BYTE AND INC DBL
                LXI                H, DBL
                MOV                E, M                        ;LENGTH TO REG-E
                INR                M                                ;DBL=DBL+1
                MVI                D, 0                        ;HIGH ORDER ZERO FOR DOUBLE ADD
                LXI                H, DBUFF
                DAD                D                                ;DBUFF+DBL TO H,L
                POP                PSW                                ;RESTORE DATA BYTE
                MOV                M, A                        ;INTO DATA BUFFER
                POP                D
DHRET:
                POP                B                                ;ENVIRONMENT RESTORED
                RET
;
WRC:                                                        ;WRITE CHARACTER WITH CHECK SUM IN D
                PUSH        PSW
                RRC
                RRC
                RRC
                RRC
                ANI                0FH
                CALL        HEXC                        ;OUTPUT HEX CHARACTER
                POP                PSW                                ;RESTORE BYTE
                PUSH        PSW                                ;SAVE A VERSION
                ANI                0FH
                CALL        HEXC                        ;WRITE LOW NIBBLE
                POP                PSW                                ;RESTORE BYTE
                ADD                D                                ;COMPUTE CHECKSUM
                MOV                D, A                        ;SAVE CS
                RET
;
HEXC:                                                        ;WRITE CHARACTER
                ADI                90H
                DAA
                ACI                40H
                DAA
                JMP                PNB                                ;PUT BYTE
;
WHEX:                                                        ;WRITE CURRENT HEX BUFFER
                MVI     A, ':'                        ;RECORD HEADER
                CALL        PNB                                ;PUT BYTE
                LXI                H, DBL                        ;RECORD LENGTH ADDRESS
                MOV                E, M                        ;LENGTH TO REG-E
                XRA                A                                ;ZERO TO REG-A
                MOV                D, A                        ;CLEAR CHECKSUM
                MOV                M, A                        ;LENGTH IS ZEROED FOR NEXT WRITE
                LHLD        BPC                                ;BASE ADDRESS FOR RECORD
                MOV                A, E                        ;LENGTH TO A
                CALL        WRC                                ;WRITE HEX VALUE
                MOV                A, H                        ;HIGH ORDER BASE ADDR
                CALL        WRC                                ;WRITE HO BYTE
                MOV                A, L                        ;LOW ORDER BASE ADDR
                CALL        WRC                                ;WRITE LO BYTE
                XRA                A                                ;ZERO TO A
                CALL        WRC                                ;WRITE RECORD TYPE 00
                MOV                A, E                        ;CHECK FOR LENGTH 0
                ORA                A
                JZ                WHEX1
;
                                                                ;NON - ZERO, WRITE DATA BYTES
                LXI                H, DBUFF
WHEX0:
                MOV                A, M                        ;GET BYTE
                INX                H
                CALL        WRC                                ;WRITE DATA BYTE
                DCR                E                                ;END OF BUFFER?
                JNZ                WHEX0
;
                                                                ;END OF DATA BYTES, WRITE CHECK SUM
WHEX1:
                XRA                A
                SUB                D                                ;COMPUTE CHECKSUM
                CALL        WRC
;
                                                                ;SEND CRLF AT END OF RECORD
                MVI                A, CR
                CALL        PNB
                MVI                A, LF
                CALL        PNB
                RET
;
;
;
                ENDMOD        EQU ($ AND 0FFE0H)+20H
                END
                ORG                1100H
                JMP                ENDMOD                        ;END OF THIS MODULE
                JMP                INITS                        ;INITIALIZE THE SCANNER
                JMP                SCAN                        ;CALL THE SCANNER
;
;
;                ENTRY POINTS IN I/O MODULE
                IOMOD        EQU 200H
                GNCF        EQU IOMOD+6H
                WOBUFF        EQU IOMOD+15H
                PERR        EQU IOMOD+18H
;
LASTC:
                DS                1                                ;LAST CHAR SCANNED
NEXTC:
                DS                1                                ;LOOK AHEAD CHAR
STYPE:
                DS                1                                ;RADIX INDICATOR
;
;                COMMON EQUATES
                PBMAX        EQU 120                        ;MAX PRINT SIZE
                PBUFF        EQU 10CH                ;PRINT BUFFER
                PBP                EQU PBUFF+PBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU PEP+1                ;CURRENT TOKEN UDER SCAN
                VALUE        EQU TOKEN+1                ;VALUE OF NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;FILL ADDRESS FOR NEXT HEX BYTE
                ASPC        EQU FPC+2                ;ASSEMBLER'S PSEUDO PC
;
;                GLOBAL EQUATES
                IDEN        EQU 1 IDENTIFIER
                NUMB        EQU 2                        ;NUMBER
                STRNG        EQU 3                        ;STRING
                SPECL        EQU 4                        ;SPECIAL CHARACTER
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL
;
                BINV        EQU 2
                OCTV        EQU 8
                DECV        EQU 10
                HEXV        EQU 16
                CR                EQU 0DH
                LF                EQU 0AH
                EOF                EQU 1AH
                TAB                EQU 09H                        ;TAB CHARACTER
;
;
;                UTILITY SUBROUTINES
GNC:                                                        ;GET NEXT CHARACTER AND ECHO TO PRINT FILE
                CALL        GNCF
                PUSH        PSW
                CPI                CR
                JZ                GNC0
                CPI                LF                                ;IF LF THEN DUMP CURRENT BUFFER
                JZ                GNC0
;
;NOT A CR OR LF, PLACE INTO BUFFER IF THERE IS ENOUGH ROOM
                LDA                PBP
                CPI                PBMAX
                JNC                GNC0
                                                                ;ENOUGH ROOM, PLACE INTO BUFFER
                MOV                E, A
                MVI                D, 0                        ;DOUBLE PRECISION PBP IN D,E
                INR                A
                STA                PBP                                ;INCREMENTED PBP IN MEMORY
                LXI                H, PBUFF
                DAD                D                                ;PBUFF(PBP)
                POP                PSW
                MOV                M, A                        ;PBUFF(PBP) - CHAR
                RET
GNC0:                                                        ;CHAR NOT PLACED INTO BUFFER
                POP                PSW
                RET
;
INITS:                                                        ;INITIALIZE THE'SCANNER
                CALL        ZERO
                STA                NEXTC                        ;CLEAR NEXT CHARACTER
                STA                PBP
                MVI                A, LF                        ;SET LAST CHAR TO LF
                STA                LASTC
                CALL        WOBUFF                        ;CLEAR BUFFER
                MVI                A, 16                        ;START OF PRINT LINE
                STA                PBP
                RET
;
ZERO:
                XRA                A
                STA                ACCLEN
                STA                STYPE
                RET
;
SAVER:                                                        ;STORE THE NEXT CHARACTER INTO THE ACCUMULATOR AND UPDATE ACCLEN
                LXI                H, ACCLEN
                MOV                A, M
                CPI                ACMAX
                JC                SAV1                        ;JUMP IF NOT UP TO LAST POSITION
                MVI                M, 0
                CALL        ERRO
SAV1:
                MOV                E, M                        ;D,E WILL HOLD INDEX
                MVI                D, 0
                INR                M                                ;ACCLEN INCREMENTED
                INX                H                                ;ADDRESS ACCUMULATOR
                DAD                D                                ;ADD INDEX TO ACCUMULATOR
                LDA                NEXTC                        ;GET CHARACTER
                MOV                M, A                        ;INTO ACCUMULATOR
                RET
;
TDOLL:                                                        ;TEST FOR DOLLAR SIGN, ASSUMING H,L ADDRESS NEXTC
                MOV                A, M
                CPI                '$'
                RNZ
                XRA                A                                ;TO GET A ZERO
                MOV                M, A                        ;CLEARS NEXTC
                RET                                                ;WITH ZERO FLAG SET
;
NUMERIC:                                                ;CHECK NEXTC FOR NUMERIC, RETURN ZERO FLAG IF NOT NUMERIC
                LDA                NEXTC
                SUI                '0'
                CPI                10
                                                                ;CARRY RESET IF NUMERIC
                RAL
                ANI                1B                                ;ZERO IF NOT NUMERIC
                RET
;
HEX:                                                        ;RETURN ZERO FLAG IF NEXTC IS NOT HEXADECIMAL
                CALL        NUMERIC
                RNZ                                                ;RETURNS IF 0-9
                LDA                NEXTC
                SUI                'A'
                CPI                6
                                                                ;CARRY SET IF OUT OF RANGE
                RAL
                ANI                1B
                RET
;
LETTER:                                                        ;RETURN ZERO FLAG IF NEXTC IS NOT A LETTER
                LDA                NEXTC
                SUI                'A'
                CPI                26
                RAL
                ANI                1B
                RET
;
ALNUM:                                                        ;RETURN ZERO FLAG IF NOT ALPHANUMERIC
                CALL        LETTER
                RNZ
                CALL        NUMERIC
                RET
;
TRANS:                                                        ;TRANSLATE TO UPPER CASE
                LDA                NEXTC
                CPI                'A' OR 1100000B        ;LOWER CASE A
                RC                                                ;CARRY IF LESS THAN LOWER A
                CPI                ('Z' OR 1100000B)+1        ;LOWER CASE Z
                RNC                                                ;NO CARRY IF GREATER THAN LOWER
                ANI                10111110                ;CONVERT TO UPPER CASE
                STA                NEXTC
                RET
;
GNCN:                                                        ;GET CHARACTER AND STORE TO NEXTC
                CALL        GNC
                STA                NEXTC
                CALL        TRANS                        ;TRANSLATE TO UPPER CASE
                RET
;
EOLT:                                                        ;END OF LINE TEST FOR COMMENT SCAN
                CPI                CR
                RZ
                CPI                EOF
                RZ
                CPI     '!'
                RET
;
SCAN:                                                        ;FIND NEXT TOKEN IN INPUT STREAM
                XRA                A
                STA                TOKEN
                CALL        ZERO
;
;                DEBLANK
DEBL:
                LDA                NEXTC
                CPI                TAB                                ;TAB CHARACTER TREATED AS BLANK OUTSIDE STRING
                JZ                DEB0
                CPI                ';'                        ;MAY BE A COMMENT
                JZ                DEB1                        ;DEBLANK THROUGH COMMENT
                CPI                '*'                                ;PROCESSOR'TECH COMMENT
                JNZ                DEB2                        ;NOT *
                LDA                LASTC
                CPI                LF                                ;LAST LINE FEED?
                JNZ                DEB2                        ;NOT LF*
                                                                ;COMMENT FOUND, REMOVE IT
DEB1:
                CALL        GNCN
                CALL        EOLT                        ;CR, EOF, OR !
                JZ                FINDL                        ;HANDLE END OF LINE
                JMP                DEB1                        ;OTHERWISE CONTINUE SCAN
DEB2:
                ORI                ' '                                ;MAY BE ZERO
                CPI                ' '
                JNZ                FINDL
DEB0:
                CALL        GNCN                        ;GET NEXT AND STORE'TO NEXTC
                JMP                DEBL
;
;                LINE DEBLANKED, FIND TOKEN TYPE
FINDL:                                                        ;LOOK FOR LETTER, DECIMAL DIGIT, OR STRING QUOTE
                CALL        LETTER
                JZ                FIND0
                MVI                A, IDEN
                JMP                STOKEN
;
FIND0:
                CALL        NUMERIC
                JZ                FIND1
                MVI                A, NUMB
                JMP                STOKEN
;
FIND1:
                LDA                NEXTC
                CPI                ''''
                JNZ                FIND2
                XRA                A
                STA                NEXTC                        ;D0N'T STORE THE QUOTE
                MVI                A, STRNG
                JMP                STOKEN
;
FIND2:                                                        ;ASSUME IT IS A SPECIAL CHARACTER
                CPI                LF                                ;IF LF THEN DUMP THE BUFFER
                JNZ                FIND3
                                                                ;LF FOUND
                LDA                PASS
                ORA                A
                CNZ                WOBUFF
                LXI                H, PBUFF                ;CLEAR ERROR CHAR ON BOTH PASSES
                MVI                M, ' '
                MVI                A, 16
                STA                PBP                                ;START NEW LINE
FIND3:
                MVI                A, SPECL
;
STOKEN:
                STA                TOKEN
;
;
;                LOOP WHILE CURRENT ITEM IS ACCUMULATING
SCTOK:
                LDA                NEXTC
                STA                LASTC                        ;SAVE LAST CHARACTER
                ORA                A
                CNZ                SAVER                        ;STORE CHARACTER INTO ACCUM IF NOT ZERO
                CALL        GNCN                        ;GET NEXT TO NEXTC
                LDA                TOKEN
                CPI                SPECL
                RZ                                                ;RETURN IF SPECIAL CHARACTER
                CPI                STRNG
                CNZ                TRANS                        ;TRANSLATE TO UPPER CASE IF NOT IN STRING
                LXI                H, NEXTC
                LDA                TOKEN
;
                CPI                IDEN
                JNZ                SCT2
;
                                                                ;ACCUMULATING AN IDENTIFIER
                CALL        TDOLL                        ;$?
                JZ                SCTOK                        ;IF SO, SKIP IT
                CALL        ALNUM                        ;ALPHA NUMERIC?
                RZ                                                ;RETURN IF END
                                                                ;NOT END OF THE IDENTIFIER
                JMP                SCTOK
;
SCT2:                                                        ;NOT SPECIAL OR IDENT, CHECK NUMBER
                CPI                NUMB
                JNZ                SCT3
;
                                                                ;ACCUMULATING A NUMBER, CHECK FOR $
                CALL        TDOLL
                JZ                SCTOK                        ;SKIP IF FOUND
                CALL        HEX                                ;HEX CHARACTER?
                JNZ                SCTOK                        ;STORE IT IF FOUND
                                                                ;END OF NUMBER, LOOK FOR RADIX INDICATOR
;
                LDA                NEXTC
                CPI                'O'                                ;OCTAL INDICATOR
                JZ                NOCT
                CPI                'O'                                ;OCTAL INDICATOR
                JNZ                NUM2
;
NOCT:                                                        ;OCTAL
                MVI                A, OCTV
                JMP                SSTYP
NUM2:
                CPI                'H'
                JNZ                NUM3
                MVI                A, HEXV
SSTYP:
                STA                STYPE
                XRA                A
                STA                NEXTC                        ;CLEARS THE LOOKAHEAD CHARACTER
                JMP                NCON
;
;                RADIX MUST COME FROM ACCUM
NUM3:
                LDA                LASTC
                CPI                'B'
                JNZ                NUM4
                MVI                A, BINV
                JMP                SSTY1
;
NUM4:
                CPI                'D'
                MVI                A, DECV
                JNZ                SSTY2
SSTY1:
                LXI                H, ACCLEN
                DCR                M                                ;ACCLEN DECREMENTED TO REMOVE RADIX INDICATOR
SSTY2:
                STA                STYPE
;
NCON:                                                        ;NUMERIC CONVERSION OCCURS HERE
                LXI                H, 0
                SHLD        VALUE                        ;VALUE ACCUMULATES BINARY EQUIVALENT
                LXI                H, ACCLEN
                MOV                C, M                        ;C=ACCLEN
                INX                H                                ;ADDRESSES ACCUM
CLOP:                                                        ;NEXT DIGIT IS PROCESSED HERE
                MOV                A, M
                INX                H                                ;READY FOR NEXT LOOP
                CPI                'A'
                JNC                CLOP1                        ;NOT HEX A-F
                SUI                '0'                                ;NORMALIZE
                JMP                CLOP2
;
CLOP1:                                                        ;HEX A-F            H
                SUI                'A'-10
CLOP2:                                                        ;CHECK SIZE AGAINST RADIX
                PUSH        H                                ;SAVE ACCUM ADDR
                PUSH        B                                ;SAVE CURRENT POSITION
                MOV                C, A
                LXI                H, STYPE
                CMP                M
                CNC                ERRV                        ;VALUE ERROR IF DIGIT>=RADIX
                MVI                B, 0                        ;DOUBLE PRECISION DIGIT
                MOV                A, M                        ;RADIX TO ACCUMULATOR
                LHLD        VALUE
                XCHG                                        ;VALUE TO D,E - ACCUMULATE RESULT IN H,L
                LXI                H, 0                        ;ZERO ACCUMULATOR
CLOP3:                                                        ;LOOP UNTIL RADIX GOES TO ZERO
                ORA                A
                JZ                CLOP4
                RAR                                                ;TEST LSB
                JNC                TTWO                        ;SKIP SUMMING OPERATION IF LSB=0
                DAD                D                                ;ADD IN VALUE
TTWO:                                                        ;MULTIPLY VALUE    * 2 FOR SHL OPERATION
                XCHG
                DAD                H
                XCHG
                JMP                CLOP3
;
;
CLOP4:                                                        ;END OF NUMBER CONVERSION
                DAD                B                                ;DIGIT ADDED IN
                SHLD        VALUE
                POP                B
                POP                H
                DCR                C                                ;MORE DIGITS?
                JNZ                CLOP
                RET                                                ;DONE WITH THE NUMBER
;
SCT3:                                                        ;MUST BE A STRING
                LDA                NEXTC
                CPI                CR                                ;END OF LINE?
                JZ                ERRO                        ;AND RETURN
                CPI
                JNZ                SCTOK
                CALL        GNCN
                CPI                ''''
                RNZ                                                ;RETURN IF SINGLE QUOTE ENCOUNTERED
                JMP                SCTOK                        ;OTHERWISE TREAT AS ONE QUOTE
;
;                END OF SCANNER
;
;                ERROR MESSAGE ROUTINES
ERRV:                                                        ;'V' VALUE ERROR
                PUSH        PSW
                MVI                A, 'V'
                JMP                ERR
;
ERRO:                                                        ;'O' OVERFLOW ERROR
                PUSH        PSW
                MVI                A, 'O'
                JMP                ERR
;
ERR:                                                        ;PRINT ERROR MESSAGE
                PUSH        B
                PUSH        H
                CALL        PERR
                POP                H
                POP                B
                POP                PSW
                RET
;
ENDMOD:
                EQU                ($ AND 0FF00H) + 100H
                END

;                SYMBOL TABLE MANIPULATION MODULE
;
                ORG                1340H
                IOMOD        EQU 200H                ;IO MODULE ENTRY POINT
                PCON        EQU IOMOD+12H
                EOR                EQU IOMOD+1EH
;
;
;                ENTRY POINTS TO SYMBOL TABLE MODULE
                JMP                ENDMOD
                JMP                INISY
                JMP                LOOKUP
                JMP                FOUND
                JMP                ENTER
                JMP                SETTY
                JMP                GETTY
                JMP                SETVAL
                JMP                GETVAL
;
;                COMMON EQUATES
                PBMAX        EQU 120                        ;MAX PRINT SIZE
                PBUFF        EQU 10CH                ;PRINT BUFFER
                PBP                EQU PBUFF+PBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU PBP+1                ;CURRENT TOKEN UDER SCAN
                VALUE        EQU TOKEN+1                ;VALUE OF NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;FILL ADDRESS FOR NEXT HEX BYTE
                ASPC        EQU FPC+2                ;ASSEMBLER'S PSEUDO PC
                SYBAS        EQU ASPC+2                ;BASE OF SYMBOL TABLE
                SYADR        EQU SYBAS+2                ;CURRENT SYMBOL BEING ACCESSED
;
;                GLOBAL EQUATES
                IDEN        EQU 1                        ;IDENTIFIER
                NUMB        EQU 2                        ;NUMBER
                STRNG        EQU 3                        ;STRING
                SPECL        EQU 4                        ;SPECIAL CHARACTER
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL
;
                CR                EQU 0DH
;                DATA AREAS
                                                                ;SYMBOL TABLE BEGINS AT THE END OF THIS MODULE
                FIXD        EQU 5                        ;5 BYTES OVERHEAD WITH EACH SYMBOL ENTRY
                                                                ;2BY COLLISION, 1BY TYPE/LEN, 2BY VALUE
                HSIZE        EQU 128                        ;HASH TABLE SIZE
                HMASK        EQU HSIZE-1                ;HASH  MASK  FOR CODING
HASHT:
                DS                HSIZE*2                        ;HASH TABLE
HASHC:
                DS                1                                ;HASH CODE AFTER CALL ON LOOKUP
;
;                SYMBOL TABLE ENTRY FORMAT IS
;       -----------------
;       : HIGH VAL BYTE :
;            -----------------
;       : LOW  VAL BYTE :
;            -----------------
;       : CHARACTER H   :
;            -----------------
;            :   ...         :
;                -----------------                                  :
;       : CHARACTER 1   :
;                -----------------
;       : TYPE   ; LENG :
;                -----------------
;       : HIGH COLLISION:
;                -----------------
;                SYADR*   : LOW COLLISION :
;                -----------------
;
;                WHERE THE LOW/HIGH COLLISION FIELD ADDRESSES ANOTHER ENTRY WITH
;                THE SAME HASH CODE (OR ZERO IF THE END OF CHAIN), TYPE DESCRIBES
;                THE ENTRY TYPE (GIVEN BELOW), LENG IS THE NUMBER OF CHARACTERS IN
;                THE SYMBOL PRINTNAME -1 (I.E., LENG=0 IS A SINGLE CHARACTER PRINT-
;                NAME, WHILE LENG=15 INDICATES A 16 CHARACTER NAME). CHARACTER 1
;                THROUGH N GIVE THE PRINTNAME CHARACTERS IN ASCII UPPER CASE (ALL
;                LOWER CASE NAMES ARE TRANSLATED ON INPUT), AND THE LOW/HIGH VALUE
;                GIVE THE PARTICULAR ADDRESS OR CONSTANT VALUE ASSOCIATED WITH THE
;                NAME. THE REPRESENTATION OF MACROS DIFFERS IN THE FIELDS WHICH
;                FOLLOW THE VALUE FIELD (MACROS ARE NOT CURRENTLY IMPLEMENTED).
;
;        THE TYPE FIELD CONSISTS OF FOUR BITS WHICH ARE ASSIGNED AS
;                FOLLOWS:
;
;                 0000     UNDEFINED SYMBOL
;                 0001     LOCAL   LABELLED PROGRAM
;                 0010     LOCAL   LABELLED DATA
;                 0011     (UNUSED)
;                 0100             EQUATE
;                 0101             SET
;                 0110             MACRO
;                 0111             (UNUSED)
;
;                 1000             (UNUSED)
;                 1001     EXTERN  LABELLED PROGRAM
;                 1010     EXTERN  LABELLED DATA
;                 1011             REFERENCE TO MODULE
;                 1100             (UNUSED)
;                 1101     GLOBAL  UNDEFINED SYMBOL
;                 1110     GLOBAL  LABELLED PROGRAM
;                 1111             (UNUSED)
;
;                TYPE DEFINITIONS
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL ATTRIBUTE
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL ATTRIBUTE
;
;
INISY:                                                        ;INITIALIZE THE SYMBOL TABLE
                LXI                H, HASHT                ;ZERO THE HASH TABLE
                MVI                B, HSIZE
                XRA                A                                ;CLEAR ACCUM
INIO:
                MOV                M, A
                INX                H
                MOV                M, A                        ;CLEAR DOUBLE WORD
                INX                H
                DCR                B
                JNZ                INIO

                                                                ;SET SYMBOL TABLE POINTERS
                LXI                H, 0
                SHLD        SYADR
;
                RET
;
CHASH:                                                        ;COMPUTE HASH CODE FOR CURRENT ACCUMULATOR
                LXI                H, ACCLEN
                MOV                B, M                        ;GET ACCUM LENGTH
                XRA                A                                ;CLEAR ACCUMULATOR
CH0:
                INX                H                                ;MOVE TO FIRST/NEXT CHARACTER POSITION
                ADD                M                                ;ADD WITH OVERFLOW
                DCR                B
                JNZ                CH0
                ANI                HMASK                        ;MASK BITS FOR MODULO HZISE
                STA                HASHC                        ;FILL HASHC WITH RESULT
                RET
;
SETLN:                                                        ;SET THE LENGTH FIELD OF THE CURRENT SYMBOL
                MOV                B, A                        ;SAVE LENGTH IN B
                LHLD        SYADR
                INX                H
                INX                H
                MOV                A, M                        ;GET TYPE/LENGTH FIELD
                ANI                0F0H                        ;MASK OUT TYPE FIELD
                ORA                B                                ;MASK IN  LENGTH
                MOV                M, A
                RET
;
GETLN:                                                        ;GET THE LENGTH FIELD TO REG-A
                LHLD        SYADR
                INX                H
                INX                H
                MOV                A, M
                ANI                0FH
                INR                A                                ;LENGTH IS STORED AS VALUE - 1
                RET
;
FOUND:                                                        ;FOUND RETURNS TRUE IF SYADR IS NOT ZERO (TRUE IS NZ FLAG HERE)
                LHLD        SYADR
                MOV                A, L
                ORA                H
                RET
;
LOOKUP:                                                        ;LOOK FOR SYMBOL IN ACCUMULATOR
                CALL        CHASH                        ;COMPUTE HASH CODE
                                                                ;NORMALIZE IDENTIFIER TO 16 CHARACTERS
                LXI                H, ACCLEN
                MOV                A, M
                CPI                17
                JC                LENOK
                MVI                M, 16
LENOK:
                                                                ;LOOK FOR SYMBOL THROUGH HASH TABLE
                LXI                H, HASHC
                MOV                E, M
                MVI                D, 0                        ;DOUBLE HASH CODE IN D,E
                LXI                H, HASHT                ;BASE OF HASH TABLE
                DAD                D
                DAD                D                                ;HASHT(HASHC)
                MOV                E, M                        ;LOW ORDER ADDRESS
                INX                H
                MOV                H, M
                MOV                L, E                        ;HEADER TO LIST OF SYMBOLS IS IN H,L
LOOK0:
                SHLD        SYADR
                CALL        FOUND
                RZ                                                ;RETURN IF SYADR BECOMES ZERO
;
                                                                ;OTHERWISE EXAMINE CHARACTER STRING FOR MATCH
                CALL        GETLN                        ;GET LENGTH TO REG-A
                LXI                H, ACCLEN
                CMP                M
                JNZ                LCOMP
;
                                                                ;LENGTH MATCH, TRY TO MATCH CHARACTERS
                MOV                B, A                        ;STRING LENGTH IN B
                INX                H                                ;HL ADDRESSES ACCUM
                XCHG                                        ;TO D,E
                LHLD        SYADR
                INX                H
                INX                H
                INX                H                                ;ADDRESSES CHARACTERS
LOOK1:
                LDAX        D                                ;NEXT CHARACTER FROM ACCUM
                CMP                M                                ;NEXT CHARACTER IN SYMBOL TABLE
                JNZ                LCOMP
                                                                ;CHARACTER MATCHED, INCREMENT TO NEXT
                INX                D
                INX                H
                DCR                B
                JNZ                LOOK1
;
                                                                ;COMPLETE MATCH AT CURRENT SYMBOL, SYADR IS SET
                RET
;
LCOMP:                                                        ;NOT FOUND, MOVE SYADR DOWN ONE COLLISION ADDRESS
                LHLD        SYADR
                MOV                E, M
                INX                H
                MOV                D, M                        ;COLLISION ADDRESS IN D,E
                XCHG
                JMP                LOOK0
;
;
ENTER:                                                        ;ENTER SYMBOL IN ACCUMULATOR
                                                                ;ENSURE THERE IS ENOUGH SPACE IN THE TABLE
                LXI                H                                ;ACCLEN
                MOV                E, M
                MVI                D, 0                        ;DOUBLE PRECISION ACCLEN IN D,E
                LHLD        SYTOP
                SHLD        SYADR                        ;NEXT SYMBOL LOCATION
                DAD                D                                ;SYTOP+ACCLEN
                LXI                D, FIXD                        ;FIXED DATA/SYMBOL
                DAD                D                                ;HL HAS NEXT TABLE LOCATION FOR SYMBOL
                XCHG                                        ;NEW SYTOP IN D,E
                LHLD        SYMAX                        ;MAXIMUM SYMTOP VALUE
                MOV                A, E
                SUB                L                                ;COMPUTE 16-BIT DIFFERENCE
                MOV                A, D
                SBB                H
                XCHG                                        ;NLW SYTOP IN H,L
                JNC                OVERER                        ;OVERFLOW IN TABLE
;
                                                                ;OTHERWISE NO ERROR
                SHLD        SYTOP                        ;SET NEW TABLE TOP
                LHLD        SYADR                        ;SET COLLISION FIELD
                XCHG                                        ;CURRENT SYMBOL ADDRESS TO D,E
                LXI                H, HASHC                ;HASH CODE FOR CURRENT SYMBOL TO H,L
                MOV                C, M                        ;LOW BYTE
                MVI                B, 0                        ;DOUBLE PRECISION VALUE IN B,C
                LXI                H, HASHT                ;BASE OF HASH TABLE
                DAD                B
                DAD                B                                ;HASHT(HASHC) IN H,L
                                                                ;D,E ADDRESSES CURRENT SYMBOL - CHANGE LINKS
                MOV                C, M                        ;LOW ORDER OLD HEADER
                INX                H
                MOV                B, M                        ;HIGH ORDER OLD HEADER
                MOV                M, D                        ;HIGH ORDER NEW HEADER TO HASH TABLE
                DCX                H
                MOV                M, E                        ;LCW ORDER NEW HEADER TO HASH TABLE
                XCHG                                        ;H,L HOLDS SYMBOL TABLE ADDRESS
                MOV                M, C                        ;LOW ORDER OLD HEADER TO COLLISION FIELD
                INX                H
                MOV                M, B                        ;HIGH ORDER OLD HEADER TO COLLISION FIELD
;
                                                                ;HASH CHAIN NOW REPAIRED FOR THIS ENTRY, COPY THE PRINTNAME
                LXI                D, ACCLEN
                LDAX        D                                ;GET SYMBOL LENGTH
                CPI                17                                ;LARGER THAN 16 SYMBOLS?
                JC                ENT1
                MVI                A, 16                        ;TRUNCATE TO 16 CHARACTERS
                                                                ;COPY LENGTH FIELD, FOLLOWED BY PRINTNAME CHARACTERS
ENT1:
                MOV                B, A                        ;COPY LENGTH TO B
                DCR                A                                ;1-16 CHANGED TO 0-15
                INX                H                                ;FOLLOWING COLLISION FIELD
                MOV                M, A                        ;STORE LENGTH WITH UNDEFINED TYPE (0000)
ENT2:
                INX                H
                INX                D
                LDAX        D
                MOV                M, A                        ;STORE NEXT CHARACTER OF PRINTNAME
                DCR                B                                ;LENGTH=LENGTH-1
                JNZ                ENT2                        ;FOR ANOTHER CHARACTER
;
                                                                ;PRINTNAME COPIED, ZERO THE VALUE FIELD
                XRA                A                                ;ZERO A
                INX                H                                ;LOW ORDER VALUE
                MOV                M, A
                INX                H
                MOV                M, A                        ;HIGH ORDER VALUE
                RET
;
OVERER:                                                        ;OVERFLOW IN SYMBOL TABLE
                LXI                H, ERRO
                CALL        PCON
                JMP                EOR                                ;END OF EXEQUTION
ERRO:
                DB                'SYMBOL TABLE OVERFLOW', CR
;
SETTY:                                                        ;SET CURRENT SYMBOL TYPE TO VALUE IN REG-A
                RAL
                RAL
                RAL
                RAL
                ANI                0F0H                        ;TYPE MOVED TO HIGH ORDER 4-BITS
                MOV                B, A                        ;SAVE IT IN B
                LHLD        SYADR                        ;BASE OF SYMBOL TO ACCESS
                INX                H
                INX                H                                ;ADDRESS OF TYPE/LENGTH FIELD
                MOV                A, M                        ;GET IT AND MASK
                ANI                0FH                                ;LEAVE LENGTH
                ORA                B                                ;MASK IN TYPE
                MOV                M, A                        ;STORE IT
                RET
;
GETTY:                                                        ;RETURN THE TYPE OF THE VALUE IN CURRENT SYMBOL
                LHLD        SYADR
                INX                H
                INX                H
                MOV                A, M
                RAR
                RAR
                RAR
                RAR
                ANI                0FH                                ;TYPE MOVED TO LOW 4-BITS OF REG-A
                RET
;
VALADR:                                                        ;GET VALUE FIELD ADDRESS FOR CURRENT SYMBOL
                CALL        GETLN                        ;PRINTNAME LENGTH TO ACCUM
                LHLD        SYADR                        ;BASE ADDRESS
                MOV                E, A
                MVI                D, 0
                DAD                D                                ;BASE(LEN)
                INX                H
                INX                H                                ;FOR COLLISION FIELD
                INX                H                                ;FOR TYPE/LEN FIELD
                RET                                                ;WITH H,L ADDRESSING VALUE FIELD
;
SETVAL:                                                        ;SET THE VALUE FIELD OF THE CURRENT SYMBOL
                                                                ;VALUE IS SENT IN H,L
                PUSH        H                                ;SAVE VALUE TO SET
                CALL        VALADR
                POP                D                                ;POP VALUE TO SET, HL HAS ADDRESS TO FILL
                MOV                M, E
                INX                H
                MOV                M, D                        ;FIELD SET
                RET
;
GETVAL:                                                        ;GET THE VALUE FIELD OF THE CURRENT SYMBOL TO H,L
                CALL        VALADR                         ;ADDRESS OF VALUE FIELD TO H, L
                MOV                E, M
                INX                H
                MOV                D, M
                XCHG
                RET
;
                ENDMOD        EQU ($ AND 0FFE0H) + 20H
                END
                ORG                15A0H
                JMP                ENDMOD                        ;TO NEXT MODULE
                JMP                BSEAR
                JMP                BGET
;
;                COMMON EQUATES
                PBMAX        EQU 120                        ;MAX PRINT SIZE
                PBUFF        EQU 10CH                ;PRINT BUFFER
                PBP                EQU PBUFF+PBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU PBP+1                ;CURRENT TOKEN UDER SCAN
                VALUE        EQU TOKEN+1                ;VALUE OR NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;FILL ADDRESS FOR NEXT HEX BYTE
                ASPC        EQU FPC+2                ;ASSEMBLER'S PSEUDO PC
;
;                GLOBAL EQUATES
                IDEN        EQU 1                        ;IDENTIFIER
                NUMB        EQU 2                        ;NUMBER
                STRNG        EQU 3                        ;STRING
                SPECL        EQU 4                        ;SPECIAL CHARACTER
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL
;
;
                CR                EQU 0DH                        ;CARRIAGB RETURN
;
;
;                TABLE DEFINITIONS
;
;                TYPES
                XBASE        EQU 0                        ;START OF OPERATORS
;       01 THROUGH 015 DENOTE OPERATIONS
                RT                EQU 16
                PT                EQU RT+1                ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
                OBASE        EQU PT+1
                01                EQU OBASE+1                ;SIMPLE
                02                EQU OBASE+2                ;LXI
                03                EQU OBASE+3                ;DAD
                04                EQU OBASE+4                ;PUSH/POP
                05                EQU OBASE+5                ;JMP/CALL
                06                EQU OBASE+6                ;MOV
                07                EQU OBASE+7                ;MVI
                08                EQU OBASE+8                ;ACC IMMEDIATE
                09                EQU OBASE+9                ;LDAX/STAX
                010                EQU OBASE+10        ;LHLD/SHLD/LDA/STA
                011                EQU OBASE+11        ;ACCUM REGISTER
                012                EQU OBASE+12        ;INC/DEC
                013                EQU OBASE+13        ;INX/DCX
                014                EQU OBASE+14        ;RST
                015                EQU OBASE+15        ;IN/OUT
;
;                X1 THROUGH X15 DENOTE OPERATORS
                X1                EQU XBASE                ;*
                X2                EQU XBASE+1                ;/
                X3                EQU XBASE+2                ;MOD
                X4                EQU XBASE+3                ;SHL
                X5                EQU XBASE+4                ;SHR
                X6                EQU XBASE+5                ;+
                X7                EQU XBASE+6                ;-
                X8                EQU XBASF+7                ;UNARY -
                X9                EQU XBASE+8                ;NOT
                X10                EQU XBASF+9                ;AND
                X11                EQU XBASE+10        ;OR
                X12                EQU XBASE+11        ;XOR
                X13                EQU XBASE+12        ;(
                X14                EQU XBASE+13        ;)
                X15                EQU XBASE+14        ;,
                X16                EQU XBASE+15        ;CR
;
;
;
;
;                RESERVED WORD TABLES
;
;                BASE ADDRESS VECTOR FOR CHARACTERS
CINX:
                DW                CHAR1                        ;LENGTH   1 BASE
                DW                CHAR2                        ;LENGTH   2 BASE
                DW                CHAR3                        ;LENGTH   3 BASE
                DW                CHAR4                        ;LENGTH   4 BASE
                DW                CHARS                        ;LENGTH   5 BASE
                DW                CHAR6                        ;LENGTH   6 BASE
;
                CMAX        EQU ($-CINX)/2-1        ;LARGEST STRING TO MATCH
;
CLEN:                                                        ;LENGTH VECTOR GIVES THE NUMBER OF ITEMS IN EACH TABLE
                DB                CHAR2-CHAR1
                DB                (CHAR3-CHAR2)/2
                DB                (CHAR4-CHAR3)/3
                DB                (CHAR5-CHAR4)/4
                DB                (CHAR6-CHAR5)/5
;
TVINX:                                                        ;TABLE OF TYPE,VALUE PAIRS FOR EACH RESERVED SYMBOL
                DW                TV1
                DW                TV2
                DW                TV3
                DW                TV4
                DW                TV5
;
;                CHARACTER VECTORS FOR 1,2,3,4, AND 5 CHARACTER NAMES
CHAR1:
                DB                CR, '()*'
                DB                '+'
                DB                ', -/A'
                DB                'BCDE'
                DB                'HLM'
;
CHAR2:
                DB                'DBDIDSDW'
                DB                'EIIFINOR'
                DB                'SP'
;
CHAR3:
                DB                'ACIADCADDADI'
                DB                'ANAANDANICMA'
                DB                'CMCCMPCPIDAA'
                DB                'DADDCRDCXEND'
                DB                'EQUHLTINRINX'
                DB                'JMPLDALXIMOD'
                DB                'MOVMVINOPNOT'
                DB                'ORACRGORIOUT'
                DB                'POPPSWRALRAR'
                DB                'RETRLCRRCRST'
                DB                'SBBSBISETSHL'
                DB                'SHRSTASTCSUB'
                DB                'SUIXORXRAXRI'
;
CHAR4:
                DB                'CALLENDMLDAXLHLDPCHL'
                DB                'PUSHSHLDSPHLSTAX'
                DB                'XCHGXTHL'
;
CHAR5:
                DB                'ENDIFMACROTITLE'
;
CHAR6:                                                        ;END OF CHARACTER VECTOR
;
TV1:                                                                ;TYPE,VALUE PAIRS FOR CHAR1 VECTOR
                DB                X16, 10, X13, 20         ;CR (
                DB                X14, 30, X1, 80                ;)
                DB                X6, 70                                ;+
                DB                X15, 10, X7, 70                ;, -
                DB                X2, 80, RT, 7                ;/ A
                DB                RT, 0, RT, 1                ;B C
                DB                RT, 2, RT, 3                ;D E
                DB                RT, 4, RT, 5                ;H L
                DB                RT, 6                                ;M
;
TV2:                                                                ;TYPE,VALUE PAIRS FOR CHAR2 VECTOR
                DB                PT, 1, 01, 0F3H                ;DB DI
                DB                PT, 2, PT, 3                ;DS DW
                DB                01, 0FBH, PT, 8                ;EI IP
                DB                015, 0DBH, X11, 40        ;IN OR
                DB                RT, 6                                ;SP
;
;
TV3:                                                                ;TYPE,VALUE PAIRS FOR CHAR3 VECTOR
                DB                08, 0CEH, 011, 88H        ;ACI  ADC
                DB                011, 80H, 08, 0C6H        ;ADD  ADI
                DB                011, 0A0H, X10, 50        ;ANA  AND
                DB                08, 0E6H, 01, 2FB        ;ANI  CMA
                DB                01, 3FH, 011, 0B8H        ;CMC  CMP
                DB                03, 0FEH, 01, 27H        ;CPI  DAA
                DB                03, 09H, 012, 05H        ;DAD  DCR
                DB                013, 0BH, PT, 4                ;DCX  END
                DB                PT, 7, 01, 76H                ;EQU  HLT
                DB                012, 04H, 013, 03H        ;INR  INX
                DB                05, 0C3H, 010, 3AH        ;JMP  LDA
                DB                02, 01H, X3, 80                ;LXI  MOD
                DB                06, 40H, 07, 06H        ;MOV  MVI
                DB                01, 00H, X9, 60                ;NOP  NOT
                DB                011, 0B0H, PT, 10        ;ORA  ORG
                DB                08, 0F6H, 015, 0D3H        ;ORI  OUT
                DB                04, 0C1H, RT, 6                ;POP  PSW
                DB                01, 17H, 01, 1FH        ;RAL  RAR
                DB                01, 0C9H, 01, 07H        ;PET  RLC
                DB                01, 0FH, 014, 0C7H        ;RRC  RST
                DB                011, 098H, 03, 0DEH        ;SSB  SBI
                DB                PT, 11, X4, 80                ;SET  SHL
                DB                X5, 80, 010, 32H        ;STA  STC
                DB                01, 37H, 011, 90H        ;STC  SUB
                DB                08, 0D6H, X12, 40        ;SUl  XOR
                DB                011, 0A8H, OS, 0EEH        ;XRA  XRI
;
;
TV4:                                                                ;TYPE,VALUE PAIRS FOR CHAR4 VECTOR
                DB                05, 0CDH                        ;CALL
                DB                PT, 6, 09, 0AH                ;ENDM   LDAX
                DB                010, 02AH, 01, 0E9H        ;LHLD   PCHL
                DB                04, 0C5H, 010, 22H        ;PUSH   SHLD
                DB                01, 0F9H, 09, 02H        ;SPHL   STAX
                DB                01, 0EBH, 01, 0E3H        ;XCHG   XTHL
;
TV5:                                                    ;TYPE,VALUE PAIRS FOR CHAR5 VECTOR
                DB                PT, 5, PT, 9        ;ENDIF MACRO
                DB                PT, 12                        ;TITLE
;
SUFTAS:                                                        ;TABLE OF SUFFIXES FOR J C AND R OPERATIONS
                DB                'NZZ NCC POPEP M'
;
BSEAR:        ;BINARY SEARCH MNEMONIC TABLE
;                INPUT: UR = UPPER BOUND OF TABLE (I.E., TABLE LENGTH-1)
;                SR = SIZE OF EACH TABLE ELEMENT
;                H,L ADDRESS BASE OF TABLE TO SEARCH
;                OUTPUT: ZERO FLAG INDICATES MATCH WAS FOUND, IN WHICH CASE
;                THE ACCUMULATOR CONTAINS AN INDEX TO THE ELEMENT
;                NOT ZERO FLAG INDICATES NO MATCH FOUND IN TABLE
;
                UR                EQU B                        ;UPPER SOUND REGISTER
                LR                EQU C                        ;LOWER BOUND REGISTER
                SR                EQU D                        ;SIZE REGISTER
                MR                EQU E                        ;MIDDLE POINTER REGISTER
                SP1                EQU B                        ;SIZE PRIME, USED IN COMPUTING MIDDLE FOSITON
                SP1P        EQU C                        ;ANOTHER COPY OF SIZE PRIME
                KR                EQU H                        ;K
;
                MVI                MR, 255                        ;MARK M <> OLD M
                INR                UR                                ;U=U+1
                MVI                LR, 0                        ;L = 0
;
;                COMPUTE M' = (U+L)/2
NEXT:
                XRA                A
                MOV                A, UR                        ;CY=0, A=U
                ADD                LR                                ;(U+L)
                RAR                                                ;(U+L)/2
                CMP                MR                                ;SAME AS LAST TIME THROUGH?
                JZ                NMATCH                        ;JUMP IF = TO  NO MATCH
;
                                                                ;MORE ELEMENTS TO SCAN
                MOV                MR, A                        ;NEW MIDDLE VALUE
                PUSH        H                                ;SAVE A COPY OF THE BASE ADDRESS
                PUSH        D                                ;SAVE S,M
                PUSH        B                                ;SAVE U,L
                PUSH        H                                ;SAVE ANOTHER COPY OF THE BASE ADDRESS
                MOV                SP1, SR                        ;S'= S
                MOV                SP1P, SP1                ;S** = S*
                DCR                A                                ;ACCLEN-1
                MOV                E, A
                MVI                D, 0                        ;DOUBLE ACCLEN-1 TO D,E
                PUSH        D                                ;SAVE A COPY FOR LATER
                CPI                CMAX                        ;TOO LONG?
                JNC                NGET                        ;NOT IN RANGE IF CARRY
                LXI                H, CLEN                        ;LENGTH VECTOR
                DAD                D
                MOV                UR, M                        ;FILL UPPER BOUND FROM MEMORY
                LXI                H, CINX
                DAD                D
                DAD                D                                ;BASE ADDRESS TO H,L
                MOV                D, M
                INX                H
                MOV                H, M
                MOV                L, D                        ;NOW IN H,L
                MOV                SR, C                        ;FILL THE SIZE REGISTER
                CALL        BSEAR                        ;PERFORM THE BINARY SEARCH
                JNZ                SCASE                        ;ZERO IF FOUND
                POP                D                                ;RESTORE INDEX
                LXI                H, TVINX
                DAD                D
                DAD                D                                ;ADDRESSING PROPER TV ELEMENT
                MOV                E, M
                INX                H
                MOV                D, M
                                                                ;D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
                MOV                L, A
                MVI                H, 0
                DAD                H                                ;DOUBLED
                DAD                D                                ;INDEXED
                MOV                A, M                        ;TYPE TO ACC
                INX                H
                MOV                B, M                        ;VALUE TO B
                RET                                                ;TYPE IN ACC, VALUE IN B
;
SCASE:                                                        ;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
                POP                D                                ;RESTORE INDEX
                CALL        PREFIX
                RNZ                                                ;NOT FOUND AS PREFIX J C OR R IF NOT ZERO FLAG
                PUSH        B                                ;SAVE VALUE AND TYPE
                CALL        SUFFIX                        ;ZERO IF SUFFIX MATCHED
                MOV                A, B                        ;READY FOR MASK IF ZERO FLAG
                POP                B                                ;RECALL VALUE AND TYPE
                RNZ                                                ;RETURN IF NOT ZERO FLAG SET
                                                                ;MASK IN THE PROPER BITS AND RETURN
                ORA                A                                ;CLEAR CARRY
                RAL
                RAL
                RAL
                ORA                B                                ;VALUE SET TO JNZ ...
                MOV                B, A                        ;REPLACE
                MOV                A, C                        ;RETURN WITH TYPE IN REGISTER A
                CMP                A                                ;CLEAR THE ZERO FLAG
                RET
;
NGET:                                                        ;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
                POP                D                                ;GET THE ELEMENT BACK
                XRA                A                                ;CLEAR
                INR                A                                ;ZERO FLAG RESET
                RET
;
;
                ENDMOD        EQU ($ AND 0FFE0H) + 20H        ;NEXT MODULE ADDRESS
                END
                DCR                A                                ;ACCLEN-l
                MOV                E, A
                MVI                D, 0                        ;DOUBLE ACCLEN-1 TO D,E
                PUSH        D                                ;SAVE A COPY FOR LATER
                CPI                CMAX                        ;TOO LONG?
                JNC                NGET                        ;NOT IN RANGE IF CARRY
                LXI                H, CLEN                        ;LENGTH VECTOR
                DAD                D
                MOV                UR, M                        ;FILL UPPER BOUND FROM MEMORY
                LXI                H, CINX
                DAD                D
                DAD                D                                ;BASE ADDRESS TO H,L
                MOV                D, M
                INX                H
                MOV                H, M
                MOV                L, D                        ;NOW IN H,L
                MOV                SR, C                        ;FILL THE SIZE REGISTER
                CALL        BSEAR                        ;PERFORM THE BINARY SEARCH
                JNZ                SCASE                        ;ZERO IF FOUND
                POP                D                                ;RESTORE INDEX
                LXI                H, TVINX
                DAD                D
                DAD                D                                ;ADDRESSING PROPER TV ELEMENT
                MOV                E, M
                INX                H
                MOV                D, M
                                                                ;D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
                MOV                L, A
                MVI                H, 0
                DAD                H                                ;DOUBLED
                DAD                D                                ;INDEXED
                MOV                A, M                        ;TYPE TO ACC
                INX                H
                MOV                B, H                        ;VALUE TO B
                RET                                                ;TYPE IN ACC, VALUE IN B
;
SCASE:                                                        ;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
                POP                D                                ;RESTORE INDEX
                CALL        PREFIX
                RNZ                                                ;NOT FOUND AS PREFIX J C OR R   IF NOT ZERO FLAG
                PUSH        B                                ;SAVE VALUE AND TYPE
                CALL        SUFFIX                        ;ZERO IF SUFFIX MATCHED
                MOV                A, B                        ;READY FOR MASK IF ZERO FLAG
                POP                B                                ;RECALL VALUE AND TYPE
                RNZ                                                ;RETURN IF NOT ZERO FLAG SET
                                                                ;MASK IN THE PROPER BITS AND RETURN
                ORA                A                                ;CLEAR CARRY
                RAL
                RAL
                RAL
                ORA                B                                ;VALUE SET TO JNZ ...
                MOV                B, A                        ;REPLACE
                MOV                A, C                        ;RETURN WITH TYPE IN REGISTER A
                CMP                A                                ;CLEAR THE ZERO FLAG
                RET
;
NGET:                                                        ;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
                POP                D                                ;GET THE ELEMENT BACK
                XRA                A                                ;CLEAR
                INR                A                                ;ZERO FLAG RESET
                RET
;
;
                ENDMOD        EQU ($ AND 0FFE0H) + 20H        ;NEXT MODULE ADDRESS
                END
                                                                ;OPERAND   SCAN MODULE
                ORG                1860H
;
;                EXTERNALS
                IOMOD        EQU 200H                ;I/O MODULE
                SCMOD        EQU 1100H                ;SCANNER MODULE
                SYMOD        EQU 1340H                ;SYMBOL TABLE MODULE
                BMOD        EQU 15A0H                ;BINARY SEARCH MODULE
;
;
                PERR        EQU IOMOD+18H
                SCAN        EQU SCMOD+6H        ;SCANNER ENTRY POINT
                CR                EQU 0DH                        ;CARRIAGE RETURN
;
                LOOKUP        EQU SYMOD+6H        ;LOOKUP
                FOUND        EQU LOOKUP+3        ;FOUND SYMBOL IF ZERO FLAG NOT SET
                ENTER        EQU FOUND+3                ;ENTER SYMBOL
                SETTY        EQU ENTER+3                ;SET TYPE FIELD
                GETTY        EQU SETTY+3                ;SET TYPE FIELD
                SETVAL        EQU GETTY+3                ;SET VALUE FIELD
                GETVAL        EQU SETVAL+3        ;GET VALUE FIELD
;
                BSEAR        EQU BMOD+3                ;BINARY SEARCH ROUTINE
                BGET        EQU BSEAR+3                ;GET VALUES WITH SEARCH
;
;                COMMON EQUATES
                PBMAX        EQU 120                        ;MAX PRINT SIZE
                PBUFF        EQU 10CH                ;PRINT BUFFER
                PBP                EQU PBUFF+PBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU PBP+1                ;CURRENT TOKEN UDER SCAN
                VALUE        EQU TOKEN+1                ;VALUE OF NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;FILL ADDRESS FOR NEXT HEX BYTE
                ASPC        EQU PPC+2                ;ASSEMBLER'S PSEUDO PC
;
;                GLOBAL EQUATES
                IDEN        EQU 1                        ;IDENTIFIER
                NUMB        EQU 2                        ;NUMBER
                STRNG        EQU 3                        ;STRING
                SPECL        EQU 4                        ;SPECIAL CHARACTER
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL
;
;
;                TABLE DEFINITIONS
                XBASE        EQU 0                        ;START OF OPERATORS
                OPER        EQU 15                        ;LAST OPERATOR
                RT                EQU 16
                PT                EQU RT+1                ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
                OBASE        EQU PT+1
;
                PLUS        EQU 5
                MINUS        EQU 6
                NOTF        EQU 8                        ;NOT
                LPAR        EQU 12
                RPAR        EQU 13
                OSMAX        EQU 10
                VSMAX        EQU 8*2
;
;
;                BEGINNING OF MODULE
                JMP                ENDMOD                        ;PAST THIS MODULE
                JMP                OPAND                        ;SCAN OPERAND FIELD
                JMP                MULF                        ;MULTIPLY FUNCTION
                JMP                DIVE                        ;DIVIDE FUNCTION
UNARY:
                DS                1                                ;TRUE IF NEXT OPERATOR IS UNARY
OPERV:
                DS                OSMAX                        ;OPERATOR STACK
HIERV:
                DS                OSMAX                        ;OPERATOR PRIORITY
VSTACK:
                DS                VSMAX                        ;VALUE STACK
OSP:
                DS                1                                ;OPERATOR STACK POINTER
VSP:
                DS                1                                ;VALUE STACK POINTER
;
;
;
STKV:                                                        ;PLACE CURRENT H,L VALUE AT TOP OF VSTACK
                XCHG                                        ;HOLD VALUE IN D,E
                LXI                H, VSP
                MOV                A, M
                CPI                VSMAX
                JC                STKV0
                CALL        ERREX                        ;OVERFLOW IN EXPRESSION
                MVI                M, 0                        ;VSP=0
STKV0:
                MOV                A, M                        ;GET VSP
                INR                M                                ;VSP=VSP+1
                INR                M                                ;VSP=VSP+2
                MOV                C, A                        ;SAVE VSP
                MVI                B, 0                        ;DOUBLE VSP
                LXI                H, VSTACK
                DAD                B
                MOV                M, E                        ;LOW BYTE
                INX                H
                MOV                M, D                        ;HIGH BYTE
                RET
;
STKO:                                                        ;STACK OPERATOR (REG-A) AND PRIORITY (REG-B)
                PUSH        PSW                                ;SAVE IT
                LXI                H, OSP
                MOV                A, M
                CPI                OSMAX
                JC                STK01
                MVI                M, 0
                CALL        ERREX                        ;OPERATOR STACK OVERFLOW
STK01:
                MOV                E, M                        ;GET OSP
                MVI                D, 0
                INR                M                                ;OSP=OSP+1
                POP                PSW                                ;RECALL OPERATOR
                LXI                H, OPERV
                DAD                D                                ;OPERV(OSP)
                MOV                M, A                        ;OPERV(OSP)=OPERATOR
                LXI                H, HIERV
                DAD                D
                MOV                M, B                        ;HIERV(OSP)=PRIORITY
                RET
;
LODV1:                                                  ;LOAD TOP ELEMENT FROM VSTACK TO H,L
                LXI                H, VSP
                MOV                A, M
                ORA                A
                JNZ                LODOK
                CALL        ERREX                        ;UNDERFLOW
                LXI                H, 0
                RET
;
LODOK:
                DCR                M
                DCR                M                                ;VSP=VSP-2
                MOV                C, M                        ;LOW BYTE
                MVI                B, 0
                LXI                H, VSTACK
                DAD                B                                ;VSTACK(VSP)
                MOV                C, M                        ;GET LOW BYTE
                INX                H
                MOV                H, M
                MOV                L, C
                RET
;
LODV2:                                                        ;LOAD TOP TWO ELEMENTS DE HOLDS TOP, HL HOLDS TOP-1
                CALL        LODV1
                XCHG
                CALL        LODV1
                RET
;
APPLY:                                                        ;APPLY OPERATOR IN REG-A TO TOP OF STACK
                MOV                L, A
                MVI                H, 0
                DAD                H                                ;OPERATOR NUMBER*2
                LXI                D, OPTAB
                DAD                D                                ;INDEXED OPTAB
                MOV                E, M                        ;LOW ADDRESS
                INX                H
                MOV                H, M                        ;HIGH ADDRESS
                MOV                L, E
                PCHL                                        ;SET PC AND GO TO SUBROUTINE
;
OPTAB:
                DW                MULOP
                DW                DIVOP
                DW                MODOP
                DW                SHLOP
                DW                SHROP
                DW                ADDOP
                DW                SUBOP
                DW                NEGOP
                DW                NOTOP
                DW                ANDOP
                DW                OROP
                DW                XOROP
                DW                ERREX                        ;(
;
;                SPECIFIC HANDLERS FOLLOW
SHFT:                                                        ;SET UP OPERANDS FOR SHIFT L AND R
                CALL        LODV2
                MOV                A, D                        ;ENSURE 0-15
                ORA                A
                JNZ                SHERR
                MOV                A, E
                CPI                17
                RC                                                ;RETURN IP 0-16 SHIFT
SHERR:
                CALL        ERREX
                MVI                A, 16
                RET
;
NEGF:                                                        ;COMPUTE 0-H,L TO H,L
                XRA                A
                SUB                L
                MOV                L, A
                MVI                A, 0
                SBB                H
                MOV                H, A
                RET
;
DIVF:
                CALL        LODV2
DIVE:                                                        ;(EXTERNAL ENTRY FROM MAIN PROGRAM)
                XCHG                                        ;SWAP D,E WITH H,L FOR DIVIDE FUNCTION
                                                                ;COMPUTE X/Y WHERE X IS IN D,E AND Y IS IN H,L
                                                                ;THE VALUE OF X/Y APPEARS IN D,E AND X MOD Y IS IN H,L
;
                SHLD        DTEMP                        ;SAVE X IN TEMPORARY
                LXI                H, BNUM                        ;STORE BIT COUNT
                MVI                M, 11H
                LXI                B, 0                        ;INTIALIZE RESULT
                PUSH        B
                XRA                A                                ;CLEAR FLAGS
DLOOP:
                MOV                A, E                        ;GET LOW Y BYTE
                RAL
                MOV                E, A
                MOV                A, D
                RAL
                MOV                D, A
                DCR                M                                ;DECREMENT BIT COUNT
                POP                H                                ;RESTORE TEMP RESULT
                RZ                                                ;ZERO BIT COUNT MEANS ALL DONE
                MVI                A, 0                        ;ADD IN CARRY
                ACI                0                                ;CARRY
                DAD                H                                ;SHIFT TEMP RESULT LEFT ONE BIT
                MOV                B, H                        ;COPY HA AND L TO A A ND C
                ADD                L
                LHLD        DTEMP                        ;GET ADDRESS OF X
                SUB                L                                ;SUBTRACT FROM TEMPORARY RESULT
                MOV                C, A
                MOV                A, B
                SBB                H
                MOV                B, A
                PUSH        B                                ;SAVE TEMP RESULT IN STACK
                JNC                DSKIP                        ;NO BORROW FROM SUBTRACT
                DAD                B                                ;ADD X BACK IN
                XTHL                                        ;REPLACE TEMP RESULT ON STACK
DSKIP:
                LXI                H, BNUM                        ;RESTORE H,L
                CMC
                JMP                DLOOP                        ;REPEAT LOOP STEPS
;
DTEMP:
                DS                2
BNUM:
                DS                1
;
MULF:                                                        ;MULTIPLY D,E BY H,L AND REPLACE H,L WITH RESULT
                MOV                B, H
                MOV                C, L                        ;COPY OF 1ST VALUE TO B,C FOR SHIFT AND ADD
                LXI                H, 0                        ;H,L IS THE ACCUMULATOR
MUL0:
                XRA                A
                MOV                A, B                        ;CARRY IS CLEARED
                RAR
                MOV                B, A
                MOV                A, C
                RAR
                MOV                C, A
                JC                MUL1                        ;SKIP THIS ADD IF LSB IS ZERO
                ORA                B
                RZ                                                ;RETURN WITH H,L
                JMP                MUL2                        ;SKIP ADD
MUL1:
                DAD                D                                ;ADD CURRENT VALUE OF D
MUL2:
                XCHG                                        ;READY FOR *2
                DAD                H
                XCHG
                JMP                MUL0
;
MULOP:                                                        ;MULTIPLY D,E BY H,L
                CALL        LODV2
                CALL        MULF
                JMP                ENDOP
;
DIVOP:                                                        ;DIVIDE H,L BY D,E
                CALL        DIVF
                XCHG                                        ;RESULT TO H,L
                JMP                ENDOP
;
MODOP:
                CALL        DIVF
                JMP                ENDOP
;
SHLOP:
                CALL        SHFT                        ;CHECK VALUES
SHL0:
                ORA                A                                ;DONE?
                JZ                ENDOP
                DAD                H                                ;HL=HL*2
                DCR                A
                JMP                SHL0
;
SHROP:
                CALL        SHFT
SHR0:
                ORA                A                                ;DONE?
                JZ                ENDOP
                PUSH        PSW                                ;SAVE CURRENT COUNT
                XRA                A
                MOV                A, H
                RAR
                MOV                H, A
                MOV                A, L
                RAR
                MOV                L, A
                POP                PSW
                DCR                A
                JMP                SHR0
;
ADDOP:
                CALL        LODV2
ADD0:
                DAD                D
                JMP                ENDOP
;
SUBOP:
                CALL        LODV2
                XCHG                                        ;TREAT AS HL+(-DE)
                CALL        NEGF                        ;0-HL
                JMP                ADD0
;
NEGOP:
                CALL        LODV1
NEG0:
                CALL        NEGF                        ;COMPUTE 0-HL
                JMP                ENDOP
;
NOTOP:
                CALL        LODV1
                INX                H                                ;65536-HL - 65535-(HL+1)
                JMP                NEG0
;
ANDOP:
                CALL        LODV2
                MOV                A, D
                ANA                H
                MOV                H, A
                MOV                A, E
                ANA                L
                MOV                L, A
                JMP                ENDOP
;
OROP:
                CALL        LODV2
                MOV                A, D
                ORA                H
                MOV                H, A
                MOV                A, E
                ORA                L
                MOV                L, A
                JMP                ENDOP
;
XOROP:
                CALL        LODV2
                MOV                A, D
                XRA                H
                MOV                H, A
                MOV                A, E
                XRA                L
                MOV                L, A
;
ENDOP:
                JMP                STKV
;
;
;
ENDEXP:                                                        ;RETURNS ZERO FLAG IF SYMBOL IS CR, :, OR .
                LDA                TOKEN
                CPI                SPECL
                RNZ                                                ;NOT END IF NOT SPECIAL
;
                LDA                ACCUM
                CPI                CR
                RZ
                CPI                ';'
                RZ
                CPI                ','
                RZ
                CPI                '|'
                RET
;
OPAND:                                                        ;SCAN THE OPERAND FIELD OF AN INSTRUCTION
;        (NOT A DB WITH FIRST TOKEN STRING > 2 OR 0)
                XRA                A
                STA                OSP                                ;ZERO OPERATOR STACK POINTER
                STA                VSP
                DCR                A                                ;255
                STA                UNARY
                LXI                H, 0
                SHLD        EVALUE
;
OP0:                                                        ;ARRIVE HERE WITH NEXT ITEM ALREADY SCANNED
                CALL        ENDEXP                        ;DONE?
                JNZ                OP1
                                                                ;EMPTY THE OPERATOR STACK
EMPOP:
                LXI                H, OSP
                MOV                A, M                        ;GET THE OSP AND CHECK FOR EMPTY
                ORA                A
                JZ                CHKVAL                        ;JUMP IF EMPTY
                DCR                M                                ;POP ELEMENT
                MOV                E, A                        ;COPY FOR DOUBLE ADD
                DCR                E
                MVI                D, 0
                LXI                H, OPERV
                DAD                D                                ;INDEXED - OPERV(OSP)
                MOV                A, M                        ;GET OPERATOR
                CALL        APPLY                        ;APPLY OPERATOR
                JMP                EMPOP
;
CHKVAL:
                LDA                VSP                                ;MUST HAVE ONE ELEMENT IT THE STACK
                CPI                2
                CNZ                ERREX
                LDA                PBUFF
                CPI                ' '
                RNZ                                                ;EVALUE REMAINS AT ZERO
                LHLD        VSTACK                        ;GET DOUBLE BYTE IN STACK
                SHLD        EVALUE
                RET
;
OP1:                                                        ;MORE TO SCAN
                LDA                PBUFF
                CPI                ' '
                JNZ                GETOP
                LDA                TOKEN
                CPI                STRNG                        ;IS THIS A STRING?
                JNZ                OP3
;
                                                                ;STRING - CONVERT TO DOUBLE PRECISION
                LDA                ACCLEN
                ORA                A
                CZ                ERREX                        ;ERROR IF LENGTH=0
                CPI                3
                CNC                ERREX                        ;ERROR IF LENGTH>2
                MVI                D, 0
                LXI                H, ACCUM
                MOV                E, M                        ;LSBYTE
                INX                H
                DCR                A                                ;A HAS THE LENGTH
                JZ                OP2                                ;ONE OR TWO BYTES
                MOV                D, M                        ;FILL HIGH ORDER
OP2:
                XCHG                                        ;VALUE TO H,L
                JMP                STNUM                        ;STORE TO STACK
;
OP3:                                                        ;NOT A STRING, CHECK FOR NUMBER
                CPI                NUMB
                JNZ                OP4
                LHLD        VALUE                        ;NUMERIC VALUE
                JMP                STNUM
;
OP4:                                                        ;NOT STRING OR NUMBER, MUST BE ID OR SPECL
                CALL        BGET                        ;BINARY SEARCH, GET ATTRIBUTES
                JNZ                OP6                                ;MATCH?
                                                                ;YES, MAY BE OPERATOR
                CPI                OPER+1
                JNC                OP5
                                                                ;OPERATOR ENCOUNTERED MS NIBBLE OF B IS PRIORITY NUMBER LS NIBBLE
                                                                ;IS THE OPERATOR
                                                                ;ACC HAS THE OPERATOR NUMBER, B HAS PRIORITY
                CPI                LPAR                        ;(?
                MOV                C, A                        ;SAVE COPY OF OPERATOR NUMBER
                LDA                UNARY
                JNZ                OPER1                        ;JUMP IF NOT A (
;       ( ENCOUNTERED, UNARY MUST BE TRUE
                ORA                A
                CZ                ERREX
                MVI                A, 0FFH
                STA                UNARY                        ;UNARY IS SET TRUE
                MOV                A, C                        ;RECOVER OPERATOR
                JMP                OPER4                        ;CALLS STKO AND SETS UNARY TO TRUE
;
;
OPER1:                                                        ;NOT A LEFT PAREN
                ORA                A
                JNZ                OPER6                        ;MUST BE + OR - SINCE UNARY IS SET
;
                                                                ;UNARY NOT SET, MUST BE BINARY OPERATOR
OPER2:                                                        ;COMPARE HIERARCHY OF TOS
                PUSH        B                                ;SAVE PRIORITY AND OPERATOR NUMBER
                LDA                OSP
                ORA                A
                JZ                OPER3                        ;NO MORE OPERATORS IN STACK
                MOV                E, A                        ;OSP TO E
                DCR                E                                ;OSP-1
                MVI                D, 0
                LXI                H, HIERV
                DAD                D                                ;HL ADDRESSES TOP OF OPERATOR STACK
                MOV                A, M                        ;PRIORITY OF TOP OPERATOR
                CMP                B                                ;CURRENT GREATER?
                JC                OPER3                        ;JUMP IF SO
                                                                ;APPLY TOP OPERATOR TO VALUE STACK
                LXI                H, OSP
                MOV                M, E                        ;OSP-OSP-1
                LXI                H, OPERV
                DAD                D
                MOV                A, M                        ;OPERATOR NUMBER TO ACC
                CALL        APPLY
                POP                B                                ;RESTORE OPERATOR NUMBER AND PRIORITY
                JMP                OPER2                        ;FOR ANOTHER TEST
;
OPER3:                                                        ;ARRIVE HERE WHEN OPERATOR IS STACKED
                                                                ;CHECK FOR RIGHT PAREN BALANCE
                POP                B                                ;OPERATOR NUMBER IN C, PRIORITY IN B
                MOV                A, C
                CPI                RPAR
                JNZ                OPER4                        ;JUMP IF NOT A RIGHT PAREN
;
                                                                ;RIGHT PAREN FOUND, STACK MUST CONTAIN LEFT PAREN TO DELETE
                LXI                H, OSP
                MOV                A, M
                ORA                A                                ;ZERO?
                JZ                LPERR                        ;PAREN ERROR IF SO
                DCR                A                                ;OSP-1
                MOV                M, A                        ;STORED TO MEMORY
                MOV                E, A
                MVI                D, 0
                LXI                H, OPERV
                DAD                D
                MOV                A, M                        ;TOP OPERATOR IN REG-A
                CPI                LPAR
                JZ                NLERR                        ;JMP IF NO ERROR - PARENS BALANCE
LPERR:
                CALL        ERREX
NLERR:                                                        ;ERROR REPORTING COMPLETE
                XRA                A
                JMP                OPER5                        ;TO CLEAR UNARY FLAG
;
OPER4:                                                        ;ORDINARY OPERATOR
                CALL        STKO
                MVI                A, 0FFH                        ;TO SET UNARY FLAG
OPER5:
                STA                UNARY
                JMP                GETOP                        ;FOP ANOTHER ELEMENT
;
OPER6:                                                        ;UNARY SET, MUST BE + OR -
                MOV                A, C                        ;RECALL OPERATOR
                CPI                PLUS
                JZ                GETOP                        ;IGNORE UNARY PLUS
                CPI                MINUS
                JNZ                CHKNOT
                INR                A                                ;CHANGE TO UNARY  MINUS
                MOV                C, A
                JMP                OPER2
CHKNOT:                                                        ;UNARY  NOT SYMBOL?
                CPI                NOTF
                CNZ                ERREX
                JMP                OPER2
;
OP5:                                                        ;ELEMENT FOUND IN TABLE, NOT AN OPERATOR
                CPI                PT                                ;PSEUDO OPERATOR?
                CZ                ERREX                        ;ERROR IF SO
                MOV                L, B                        ;GET LOW VALUE TO L
                MVI                H, 0                        ;ZERO HIGH ORDER BYTE
                JMP                STNUM                        ;STORE IT
;
OP6:                                                        ;NOT POUND IN TABLE SCAN, $?
                LDA                TOKEN
                CPI                SPECL
                JNZ                OP7
                LDA                ACCUM
                CPI                '$'
                JZ                CURPC                        ;USE CURRENT PC
                CALL        ERREX
                LXI                H, 0
                JMP                STNUM
CURPC:
                LHLD        ASPC                        ;GET CURRENT PC
                JMP                STNUM
:
0P7:                                                        ;NOT $, LOOK IT UP
                CALL        LOOKUP
                CALL        FOUND
                JNZ                FIDENT
                                                                ;NOT FOUND IN SYMBOL TABLE, ENTER IF PASS 1
                MVI                A, 'P'
                CALL        PERR
                CALL        ENTER                        ;ENTER SYMBOL WITH ZERO TYPE FIELD
                JMP                FIDE0
FIDENT:
                CALL        GETTY                        ;TYPE TO H,L
                ANI                111B
                MVI                A, 'U'
                CZ                PERR
;
FIDE0:
                CALL        GETVAL                        ;VALUE TO H,L
;
STNUM:                                                        ;STORE H,L TO VALUE STACK
                LDA                UNARY
                ORA                A                                ;UNARY OPERATION SET
                XRA                ARREX                        ;OPERAND ENCOUNTERED WITH UNARY OFF
                STA                UNARY                        ;SET TO OFF
                CALL        STKV                        ;STACK THE VALUE
;
GETOP:
                CALL        SCAN
                JMP                OP0
;
ERREX:                                                        ;PUT 'E' ERROR IN OUTPUT BUFFER
                PUSH        H
                MVI                A, 'E'
                CALL        PERR
                POP                H
                RET
;
                ENDMOD        EQU ($ AND 0FFE0H) + 20H        ;NEXT HALF PAGE
                END
;                CP/M RESIDENT ASSEMBLER MAIN PROGRAM

;                COPYRIGHT (C) 1976
;                 GARY A.   KILDALL
;
                ORG                1BA0H
;                MODULE ENTRY POINTS
                IOMOD        EQU 200H                ;IO MODULE
                SCMOD        EQU 1100H                ;SCANNER MODULE
                SYMOD        EQU 1340H                ;SYMBOL TABLE MODULE
                BMOD        EQU 15A0H                ;BINARY SEARCH MODULE
                OPMOD        EQU 1860H                ;OPERAND SCAN MODULE
;
                SETUP        EQU IOMOD+3H        ;FILE SETUP FOR EACH PASS
                PCON        EQU IOMOD+12H        ;WRITE CONSOLE BUFFER TO CR
                WOBUFF        EQU IOMOD+15H        ;WRITE PRINT BUFFER AND REINITIALIZE
                PERR        EQU IOMOD+18H        ;WRITE ERROR CHARACTER TO PRINT BUFFER
                DHEX        EQU IOMOD+1BH        ;SEND HEX CHARACTER TO MACHINE CODE FILE
                EOR                EQU IOMOD+1EH        ;END OF PROCESSING, CLOSE FILES AND TERMINATE
;
                INITS        EQU SCMOD+3H        ;INITIALIZE SCANNER MODULE
                SCAN        EQU SCMOD+6H        ;SCAN NEXT TOKEN
;
                INISY        EQU SYMOD+3H        ;INITIALIZE SYMBOL TABLE
                LOOKUP        EQU SYMOD+6H        ;LOOKUP SYMBOL IN ACCUMULATOR
                FOUND        EQU SYMOD+9H        ;FOUND IF NZ FLAG
                ENTER        EQU SYMOD+0CH        ;ENTER SYMBOL IN ACCUMULATOR
                SETTY        EQU SYMOD+0FH        ;SET TYPE FIELD
                GETTY        EQU SYMOD+12H        ;GET TYPE FIELD
                SETVAL        EQU SYMOD+15H        ;SET VALUE FIELD
                GETVAL        EQU SYMOD+18H        ;GET VALUE FIELD
;
                BGET        EQU BMOD+6H                ;BINARY SEARCH AND GET TYPE/VALUE PAIR
;
                OPAND        EQU OPMOD+3H        ;GET OPERAND VALUE TO 'EVALUE'
                MULF        EQU OPMOD+6H        ;MULT D,E BY H,L TO H,L
                DIVF        EQU OPMOD+9H        ;DIVIDE HL BY DE, RESULT TO DE
;
;
;                COMMON EQUATES
                PBMAX        EQU 120                        ;MAX PRINT SIZE
                PBUFF        EQU 10CH                ;PRINT BUFFER
                PBP                EQU PBUFF+PBMAX        ;PRINT BUFFER POINTER
;
                TOKEN        EQU PBP+1                ;CURRENT TOKEN UDER SCAN
                VALUE        EQU TOKEN+1                ;VALUE OF NUMBER IN BINARY
                ACCLEN        EQU VALUE+2                ;ACCUMULATOR LENGTH
                ACMAX        EQU 64                        ;MAX ACCUMULATOR LENGTH
                ACCUM        EQU ACCLEN+1
;
                EVALUE        EQU ACCUM+ACMAX        ;VALUE FROM EXPRESSION ANALYSIS
;
                SYTOP        EQU EVALUE+2        ;CURRENT SYMBOL TOP
                SYMAX        EQU SYTOP+2                ;MAX ADDRESS+1
;
                PASS        EQU SYMAX+2                ;CURRENT PASS NUMBER
                FPC                EQU PASS+1                ;FILL ADDRESS FOR NEXT HEX BYTE
                ASPC        EQU FPC+2                ;ASSEMBLER'S PSEUDO PC
                SVBAS        EQU ASPC+2                ;BASE OF SYMBOL TABLE
                SYADR        EQU SYBAS+2                ;CURRENT SYMBOL ADDRESS
;
;                GLOBAL EQUATES
                IDEN        EQU 1                        ;IDENTIFIER
                NUMB        EQU 2                        ;NUMBER
                STRNG        EQU 3                        ;STRING
                SPECL        EQU 4                        ;SPECIAL CHARACTER
;
                PLABT        EQU 0001B                ;PROGRAM LABEL
                DLABT        EQU 0010B                ;DATA LABEL
                EQUT        EQU 0100B                ;EQUATE
                SETT        EQU 0101B                ;SET
                MACT        EQU 0110B                ;MACRO
;
                EXTT        EQU 1000B                ;EXTERNAL
                REFT        EQU 1011B                ;REFER
                GLBT        EQU 1100B                ;GLOBAL
;
                CR                EQU 0DH                        ;CARRIAGE RETURN
                LF                EQU 0AH                        ;LINE FEED
                EOF                EQU 1AH                        ;END OF FILE
                NBMAX        EQU 16                        ;STARTING POSITION OF PRINT LINE
;
;
                RT                EQU 16                        ;REGISTER TYPE
                PT                EQU RT+1                ;PSEUDO OPERATION
                PENDIF        EQU 5                        ;PSEUDO OPERATOR 'ENDIF'
                OBASE        EQU PT+1
                O1                EQU OBASE+1                ;FIRST OPERATOR
                O15                EQU OBASE+15        ;LAST OPERATOR
;
;                MAIN STATEMENT PROCESSING LOOP
                XRA                A
                STA                PASS                        ;SET TO PASS 0 INITIALLY
                CALL        INISY                        ;INITIALIZE THE SYMBOL TABLE
RESTART:                                                ;PASS LOOP GOES FROM 0 TO 1
                CALL        INITS                        ;INITIALIZE THE SCANNER
                CALL        SETUP                        ;SET UP THE INPUT FILE
                LXI                H, 0
                SHLD        SYLAB                        ;ASSUME NO STARTING LABEL
                SHLD        FPC
                SHLD        ASPC
                SHLD        EPC                                ;END PC
;
SCNEXT:                                                        ;SCAN THE NEXT INPUT ITEM
                CALL        SCAN
SCN0:
                LDA                TOKEN
                CPI                NUMB                        ;SKIP LEADING NUMBERS FROM LINE EDITORS
                JZ                SCNEXT
                CPI                SPECL                        ;MAY BE PROCESSOR TECH'S COMMENT
                JNZ                SCN1
                                                                ;SPECIAL CHARACTER, CHECK FOR *
                LDA                ACCUM
                CPI                '*'
                JNZ                CHEND                        ;END OF LINE IF NOT *
;       * FOUND, NO PRECEDING LABEL ALLOWED
                CALL        SETLA
                JNZ                STERR                        ;ERROR IF LABEL
                JMP                CHEN1                        ;SCAN THE COMMENT OTHERWISE
;
SCN1:                                                        ;NOT NUMBER OR SPECIAL CHARACTER, CHECK FOR IDENTIFIER
                CPI                IDEN
                JNZ                STERR                        ;ERROR IF NOT
;
                                                                ;IDENTIFIER FOUND, MAY BE LABEL, OPCODE, OR MACRO
                CALL        BGET                        ;BINARY SEARCH FIXED DATA
                JZ                CHKPT                        ;CHECK FOR PSEUDO OR REAL OPERATOR
;
                                                                ;BINARY SEARCH WAS UNSUCCESSFUL, CHECK FOR MACRO
                CALL        LOOKUP
                CALL        FOUND
                JNZ                LFOUN                        ;NZ FLAG SET IF FOUND
;
                                                                ;NOT FOUND, ENTER IT
                CALL        ENTER                        ;THIS MUST BE PASS
                LDA                PASS
                ORA                A
                CNZ                ERRP                        ;PHASE ERROR IF NOT
                JMP                SETSY                        ;SET SYLAB
;
                                                                ;ITEM WAS FOUND, CHECK FOR MACRO
LFOUN:
                CALL        GETTY
                CPI                MACT
                JNZ                SETSY
;
                                                                ;MACRO DEFINITION FOUND, EXPAND MACRO
                CALL        ERRN                        ;NOT CURRENTLY IMPLEMENTED
                JMP                CHEN1                        ;SCANS TO END OF CURRENT LINE
;
SETSY:                                                        ;LABEL FOUND - IS IT THE ONLY ONE?
                LHLD        SYLAB
                MOV                A, L
                ORA                H
                CNZ                ERRL                        ;LABEL ERROR IF NOT
                LHLD        SYADR                        ;ADDRESS OF SYMBOL
                SHLD        SYLAB                        ;MARK AS LABEL FOUND
;
                                                                ;LABEL FOUND, SCAN OPTIONAL ':'
                CALL        SCAN
                LDA                TOKEN
                CPI                SPECL
                JNZ                SCN0                        ;SKIP NEXT SCAN IF NOT SPECIAL
                LDA                ACCUM
                CPI                ':'
                JNZ                SCN0
                JMP                SCNEXT                        ;TO IGNORE ':'
;
                                                                ;BINARY SEARCH FOUND SYMBOL, CHECK FOR PSEUDO OR REAL OP
CHKPT:
                CPI                PT                                ;PSEUDO OPCODE?
                JNZ                CHKOT
;
                                                                ;PSEUDO OPCODE FOUND, BRANCH TO CASES
                MOV                E, B                        ;B HAS PARTICULAR OPERATOR NUMBER
                MVI                D, 0                        ;DOUBLE PRECISION VALUE TO D,E
                DCX                D                                ;BIASED BY +1
                LXI                H, PTTAB                ;BASE OF JUMP TABLE
                DAD                D
                DAD                D
                MOV                E, M
                INX                H
                MOV                H, M
                MOV                L, E
                PCHL                                        ;JUMP INTO TABLE
;
PTTAB:                                                        ;PSEUDO OPCODE JUMP TABLE
                DW                SDB                                ;DB
                DW                SDS                                ;DS
                DW                SDW                                ;DW
                DW                SEND                        ;END
                DW                SENDIF                        ;ENDIF
                DW                SENDM                        ;ENDM
                DW                SEQU                        ;EQU
                DW                SIF                                ;IF
                DW                SMACRO                        ;MACRO
                DW                SORG                        ;ORG
                DW                SSET                        ;SET
                DW                STITLE                        ;TITLE
;
SDB:
                CALL        FILAB                        ;SET LABEL FOR THIS LINE TO ASPC
SDB0:
                CALL        SCAN                        ;PAST DB TO NEXT ITEM
                LDA                TOKEN                        ;LOOK FOR LONG STRING
                CPI                STRNG
                JNZ                SDBC                        ;SKIP IF NOT STRING
                LDA                ACCLEN
                DCR                A                                ;LENGTH 1 STRING?
                JZ                SDBC
                                                                ;LENGTH 0,2,... STRING
                MOV                B, A
                INR                B
                INR                B                                ;BECOMES 1,3,... FOR 0,2,... LENGTHS
                LXI                H, ACCUM                ;ADDRESS CHARACTERS IN STRING
SDB1:
                DCR                B                                ;COUNT DOWN TO ZERO
                JZ                SDB2                        ;SCAN DELIMITER AT END OF STRING
                PUSH        B                                ;SAVE COUNT
                MOV                B, M                        ;GET CHARACTER
                INX                H
                PUSH        H                                ;SAVE ACCUM POINTER
                CALL        FILHB                        ;SEND TO HEX FILE
                POP                H
                POP                B
                JMP                SDB1
SDB2:
                CALL        SCAN                        ;TO THE DELIMITER
                JMP                SDB3
;
                                                                ;NOT A LONG STRING
SDBC:
                CALL        OPAND                        ;COMPUTE OPERAND
                LHLD        EVALUE                        ;VALUE TO H,L
                MOV                A, H
                ORA                A                                ;HIGH ORDER MUST BE ZERO
                CNZ                ERBD                        ;DATA ERROR
                MOV                B, L                        ;GET LOW BYTE
                CALL        FILHB
SDB3:                                                        ;END OF ITEM - UPDATE ASPC
                CALL        SETAS                        ;SET ASPC TO FPC
                CALL        DELIM
                CPI                ','
                JZ                SDB0                        ;FOR ANOTHER ITEM
                JMP                CHEND                        ;CHECK END OF LINE SYNTAX
;
SDS:
                CALL        FILAB                        ;HANDLE LABEL IF IT OCCURRED
                CALL        PADD                        ;PRINT ADDRESS
                CALL        EXP16                        ;SCAN AND GET 16BIT OPERAND
                XCHG                                        ;TO D,E
                LHLD        ASPC                        ;CURRENT PSEUDO PC
                DAD                D                                ;+EXPRESSION
                SHLD        ASPC
                SHLD        FPC                                ;NEXT TO FILL
                JMP                CHEND
;
SDW:
                CALL        FILAB                        ;HANDLE OPTIONAL LABEL
SDW0:
                CALL        EXP16                        ;GET 16BIT OPERAND
                PUSH        H                                ;SAVE A COPY
                MOV                B, L                        ;LOW BYTE FIRST
                CALL        FILHB                        ;SEND LOW BYTE
                POP                H                                ;RECLAIM A COPY
                MOV                B, H                        ;HIGH BYTE NEXT
                CALL        FILHB                        ;SEND HIGH BYTE
                CALL        SETAS                        ;SET ASPC=FPC
                CALL        DELIM                        ;CHECK DELIMITER SYNTAX
                CPI                ','
                JZ                SDW0                        ;GET MORE DATA
                JMP                CHEND
;
SEND:
                CALL        FILAB
                CALL        PADD                        ;WRITE LAST LOC
                LDA                PBUFF
                CPI                ' '
                JNZ                CHEND
                CALL        EXP16                        ;GET EXPRESSION IF IT'S THERE
                LDA                PBUFF
                CPI                ' '
                JNZ                SEND0
                SHLD        EPC                                ;EXPRESSION FOUND, STORE IT FOR LATER
SEND0:
                MVI                A, ' '
                STA                PBUFF                        ;CLEAR ERROR, IF IT OCCURRED
                CALL        SCAN                        ;CLEAR CR
                LDA                TOKEN
                CPI                SPECL
                JNZ                STERR
                LDA                ACCUM
                CPI                LF
                JNZ                STERR
                JMP                ENDAS                        ;END OF ASSEMBLER
;
SENDIF:
                JMP                POEND
;
SENDM:
                CALL        ERRN
                JMP                POEND
;
SEQU:
                CALL        SETLA
                JZ                STERR                        ;MUST BE A LABEL
                LHLD        ASPC                        ;HOLD TEMP ASPC
                PUSH        H                                ;IN STACK
                CALL        EXP16                        ;GET 16BIT OPERAND
                SHLD        ASPC                        ;VALUE OF EXPRESSION
                CALL        FI LAB
                CALL        PADDR                        ;COMPUTED VALUE
                LXI                H, PBUFF+6                ;SPACE AFTER VALUE
                MVI                M, '='
                POP                H                                ;REAL ASPC
                SHLD        ASPC                        ;CHANGE BACK
                JMP                CHEND
;
SIF:
                CALL        FILAB                        ;IN CASE OF LABEL
                CALL        EXP16                        ;GET IF EXPRESSION
                LDA                PBUFF
                CPI                ' '
                JNZ                CHEND                        ;SKIP IF ERROR
                MOV                A, L                        ;GET LSB
                RAR
                JC                CHEND                        ;TRUE IF CARRY BIT SET
;
                                                                ;SKIP TO EOF OR ENDIF
SIF0:
                CALL        SCAN
                LDA                TOKEN
                CPI                SPECL
                JNZ                SIF1
                LDA                ACCUM
                CPI                EOF
                MVI                A, 'B'                        ;BALANCE ERROR
                CZ                PERR
                JZ                ENDAS
                JMP                SIF0                        ;FOR ANOTHER
SIF1:                                                        ;NOT A SPECIAL CHARACTER
                CPI                IDEN
                JNZ                SIF0                        ;NOT AN IDENTIFIER
                CALL        BGET                        ;LOOK FOR ENDIF
                JNZ                SIF0                        ;NOT FOUND
                CPI                PT                                ;PSEUDO OP?
                JNZ                SIF0
                MOV                A, B                        ;GET OPERATOR NUMBER
                CPI                PENDIF                        ;ENDIF?
                JNZ                SIF0                        ;GET ANOTHER TOKEN
                JMP                POEND                        ;OK, CHECK END OF LINE
;
SMACRO:
                CALL        ERRN
                JMP                CHEND
;
SORG:
                CALL        EXP16
                LDA                PBUFF
                CPI                ' '
                JNZ                CHEND                        ;SKIP ORG IF ERROR
                SHLD        ASPC                        ;CHANGE PC
                SHLD        FPC                                ;CHANGE NEXT TO HIT
                CALL        FILAB                        ;IN CASE OF LABEU
                CALL        PADD
                JMP                CHEND
;
SSET:
                CALL        SETLA
                JZ                STERR                        ;MUST BE LABELLED1)
;
                CALL        GETTY
                CPI                SETT
                CNZ                ERRL                        ;LABEL ERROR
                MVI                A, SETT
                CALL        SETTY                        ;REPLACE TYPE WITH 'SET'
                CALL        EXP16                        ;GET THE EXPRESSION
                PUSH        H                                ;SAVE IT
                CALL        SFTLA                        ;RE-ADDRESS LABEL
                POP                H                                ;RECLAIM IT
                CALL        SETVAL
                LXI                H, 0
                SHLD        SYLAB                        ;PREVENT LABEL PROCESSING
                JMP                CHEND
;
;
STITLE:
                CALL        ERRN                        ;NOT IMPLEMENTED
;
POEND:                                                        ;PSEUDO OPERATOR END - SCAN TO NEXT TOKEN
                CALL        SCAN
                JMP                CHEND
;
                                                                ;NOT A PSEUDO OPCODE, CHECK FOR REAL OPCODE
CHKOT:
                SUI                01                                ;BASE OF OPCODES
                CPI                015                                ;PAST LAST OPCODE?
                JNC                STERR                        ;STATEMENT ERROR IF SO
;
                                                                ;FOUND OPCODE, COMPUTE INDEX INTO TABLE AND JUMP TO CASE
                MOV                E, A
                MVI                D, 0
                LXI                H, OPTAB
                DAD                D
                DAD                D
                MOV                E, M
                INX                H
                MOV                H, M
                MOV                L, E
                PCHL                                        ;JUMP TO CASE
;
OPTAB:                                                        ;OPCODE CATEGORIES
                DW                SSIMP                        ;SIMPLE
                DW                SLXI                        ;LXI
                DW                SDAD                        ;DAD
                DW                SPUSH                        ;PUSH/POP
                DW                SJMP                        ;JMP/CALL
                DW                SMOV                        ;MOV
                DW                SMVI                        ;MVI
                DW                SACCI                        ;ACCUM IMMEDIATE
                DW                SLDAX                        ;LDAX/STAX
                DW                SLHLD                        ;LHLD/SHLD/LDA/STA
                DW                SACCR                        ;ACCUM-REGISTER
                DW                SINC                        ;INC/DCR
                DW                SINX                        ;INX/DCX
                DW                SRST                        ;RESTART
                DW                SIN                                ;IN/OUT
;
SSIMP:                                                        ;SIMPLE OPERATION CODES
                CALL        FILHB                        ;SEND HEX VALUE TO MACHINE CODE FILE
                CALL        SCAN                        ;TO NEXT TOKEN
                JMP                INCPC
;
SLXI:                                                        ;LXI H,16B
                CALL        SHDREG                        ;SCAN DOUBLE PRECISION REGISTER
                CALL        CHCOM                        ;CHECK FOR COMMA FOLLOWING REGISTER
                CALL        SETADR                        ;SCAN AND EMIT DOUBLE PRECISION OPERAND
                JMP                INCPC
;
SDAD:                                                        ;DAD B
                CALL        SHDREG                        ;SCAN AND EMIT DOUBLE PRECISION REGISTER
                JMP                INCPC
;
SPUSH:                                                        ;PUSH B  POP D
                CALL        SHREG                        ;SCAN SINGLE PRECISION REGISTER TO A
                CPI                111000B                        ;MAY BE PSW
                JZ                SPU0
                                                                ;NOT PSW, MUST BE B,D, OR H
                ANI                0010000B                ;LOW BIT MUST BE 0
                CNZ                ERRR                        ;REGISTER ERROR IF NOT
SPU0:
                MOV                A, C                        ;RECALL REGISTER AND MASK IN CASE OF ERROR
                ANI                110000B
                ORA                B                                ;MASK IN OPCODE FOR PUSH OR POP
                JMP                FILINC                        ;FILL HEX VALUE AND INCREMENT PC
;
SJMP:                                                        ;JMP 16B/ CALL 16B
                CALL        FILHB                        ;EMIT JMP  OR CALL OPCODE
                CALL        SETADR                        ;EMIT 16BIT OPERAND
                JMP                INCPC
;
SMOV:                                                        ;MOV A,B
                CALL        SHREG
                ORA                B                                ;MASK IN OPCODE
                MOV                B, A                        ;SAVE IN B TEMPORARILY
                CALL        CHCOM                        ;MUST BE COMMA SEPARATOR
                CALL        EXP3                        ;VALUE MUST BE 0-7
                ORA                B                                ;MASK IN OPCODE    CPM VERSION
                JMP                FILINC
;
SMVI:                                                        ;MVI A,8B
                CALL        SHREG
                ORA                B                                ;MASK IN OPCODE
                CALL        FILHEX                        ;EMIT OPCODE
                CALL        CHCOM                        ;SCAN COMMA
                CALL        SETBYTE                        ;EMIT 8BIT VALUE
                JMP                INCPC
;
SACCI:                                                        ;ADI 8B
                CALL        FILHB                        ;EMIT IMMEDIATE OPCODE
                CALL        SETBYTE                        ;EMIT 8BIT OPERAND
                JMP                INCPC
;
SLDAX:                                                        ;LDAX B/STAX D
                CALL        SHREG
                ANI                101000B                        ;MUST BE B OR D
                CNZ                ERRR                        ;REGISTER ERROR IF NOT
                MOV                A, C                        ;RECOVER REGISTER NUMBER
                ANI                010000B                        ;CHANGE TO B OR D IF ERROR
                ORA                B                                ;MASK IN OPCODE
                JMP                FILING                        ;EMIT OPCODE
;
SLHLD:                                                        ;LHLD 16B/ SHLD 16B/ LDA 16B/ STA 16B
                CALL        FILHB                        ;EMIT OPCODE
                CALL        SETADR                        ;EMIT OPERAND
                JMP                INCPC
;
SACCR:                                                        ;ADD B
                CALL        EXP3                        ;RIGHT ADJUSTED 3BIT VALUE FOR REGISTER
                ORA                B                                ;MASK IN OPCODE
                JMP                FILINC
;
SINC:                                                        ;INR B/DCR D
                CALL        SHREG                        ;GET REGISTER
                ORA                B
                JMP                FILINC
;
SINX:                                                        ;INX H/DCX B
                CALL        SHREG
                ANI                001000B                        ;MUST BE B D M OR SP
                CNZ                ERRR                        ;REGISTER ERROR IF NOT
                MOV                A, C                        ;RECOVER REGISTER
                ANI                110000B                        ;IN CASE 0F ERROR
                ORA                B                                ;MASK IN OPCODE
                JMP                FILINC
;
SRST:                                                        ;RESTART 4
                CALL        SHREG                        ;VALUE IS 0-7
                ORA                B                                ;OPCODE MASKED
                JMP                FILINC
;
SIN:                                                        ;IN 8B/0UT 8B
                CALL        FILHB                        ;EMIT OPCODE
                CALL        SETBYTE                        ;EMIT 8BIT OPERAND
                JMP                INCPC
;
FILINC:                                                        ;FILL HEX VALUE FROM A, BEFORE INCREMENTING PC
                CALL        FILHEX
;
INCPC:                                                        ;CHANGE ASSEMBLER'S PSEUDO PROGRAM COUNTER
                CALL        FILAB                        ;SET ANY LABELS WHICH OCCUR ON THE LINE
                CALL        SETAS                        ;ASPC=FPC
                JMP                CHEND                        ;END OP LINE SCAN
;
;
                                                                ;UTILITY SUBROUTINES FOR OPERATION CODES
;
DELIM:                                                        ;CHECK DELIMITER SYNTAX FOR D^TA STATEMENTS
                LDA                TOKEN
                CPI                SPECL
                CNZ                ERRD
                LDA                ACCUM
                CPI                ','
                RZ
                CPI                ';'
                RZ
                CPI                CR
                CNZ                ERRD
                RET
;
EXP16:                                                        ;GET 16BIT VALUE TO H,L
                PUSH        B
                CALL        SCAN                        ;START SCANNING OPERAND FIELD
                CALL        OPAND
                LHLD        EVALUE                        ;VALUE TO H,L
                POP                B
                RET
;
EXP8:                                                        ;GET 8BIT VALUE TO REG A
                CALL        EXP16
                MOV                A, H
                ORA                A
                CNZ                ERRV                        ;VALUE ERROR IF HIGH BYTE NOT ZERO
                MOV                A, L
                RET
;
EXP3:                                                        ;GET 3BIT VALUE TO REG A
                CALL        EXP8
                CPI                8
                CNC                ERRV                        ;VALUE ERROR IF >=8
                ANI                111B                        ;REDUCE IF ERROR OCCURS
                RET
;
SHREG:                                                        ;GET 3BIT VALUE AND SHIFT LEFT BY
                CALL        EXP3
                RAL
                RAL
                RAL
                ANI                111000B
                MOV                C, A                        ;COPY TO C
                RET
;
SHDREG:                                                        ;GET DOUBLE REGISTER TO A
                CALL        SHREG
                ANI                001000B                        ;CHECK FOR A,C,E, OR L
                CNZ                ERRR                        ;REGISTER ERROR
                MOV                A, C                        ;RECOVER REGISTER
                ANI                110000B                        ;FIX IT IF ERROR OCCURRED
                ORA                B                                ;MASK OPCODE
                JMP                FILHEX                        ;EMIT IT
;
SETBYTE:                                                ;EMIT 16BIT OPERAND
                CALL        EXP8
                JMP                FILHEX
;
SETADR:                                                        ;EMIT 16BIT OPERAND
                CALL        EXP16
                JMP                FILADR
;
CHCOM:                                                        ;CHECK FOR COMMA FOLLOWING EXPRESSION
                PUSH        PSW
                PUSH        B
                LDA                TOKEN
                CPI                SPECL
                JNZ                COMER
                                                                ;SPECIAL CHARACTER, CHECK FOR COMMA
                LDA                ACCUM
                CPI                ','
                JZ                COMRET                        ;RETURN IF COMMA FOUND
COMER:                                                        ;COMMA ERROR
                MVI                A, 'C'
                CALL        PERR
COMRET:
                POP                B
                POP                PSW
                RET
;
CHEND:                                                        ;END OF LINE CHECK
                CALL        FILAB                        ;IN CASE OF A LABEL
                LDA                TOKEN
                CPI                SPECL
                JNZ                STERR                        ;MUST BE A SPECIAL CHARACTER
                LDA                ACCUM
                CPI                CR                                ;CARRIAGE RETURN
                JNZ                CHEN0
                                                                ;CARRIAGE RETURN FOUND, SCAN PICKS UP LF AND PUSHES LINE
                CALL        SCAN
                JMP                SCNEXT
;
CHEN0:                                                        ;NOT CR, CHECK FOR COMMENT
                CPI                ':'
                JNZ                CHEN2
                CALL        FILAB                        ;IN CASE LABELLED EMPTY LINE
                                                                ;CLEAR COMMENT TO END OF LINE
CHEN1:
                CALL        SCAN
                LDA                TOKEN
                CPI                SPECL
                JNZ                CHEN1
                LDA                ACCUM
                CPI                LF
                JZ                SCNEXT
                CPI                EOF
                JZ                ENDAS                        ;END 0F ASSEMBLY IF EOF
                CPI                '!'
                JZ                SCNEXT                        ;LOGICAL END OF LINE
                JMP                CHEN1                        ;NONE OF THE ABOVE
;
                                                                ;NOT CR OP LF. MAY BE LOGICAL END OF LINE
CHEN2:
                CPI                '!'
                JZ                SCNEXT
                CPI                EOF
                JZ                ENDAS
;
                                                                ;STATEMENT ERROR IN OPERAND FIELD
STERR:
                MVI                A, 'S'
                CALL        PERR
                JMP                CHEN1                        ;TO DUMP LINE
;
DIFF:                                                        ;COMPUTE DE-HL TO HL
                MOV                A, E
                SUB                L
                MOV                L, A
                MOV                A, D
                SBB                H
                MOV                H, A
                RET
;
ENDAS:                                                        ;END OF ASSEMBLY FOR THIS PASS
                LXI                H, PASS
                MOV                A, M
                INR                M                                ;PASS NUMBER INCREMENTED
                ORA                A
                JZ                RESTART
                CALL        SCAN                        ;TO CLEAR LAST LINE FEED
                CALL        PADD                        ;WRITE LAST ADDRESS
                LXI                H, PBUFF+5
                MVI                M, CR                        ;SET TO CR FOR END OF MESSAGE
                LXI                H, PBUFF+1
                CALL        PCON                        ;PRINT LAST ADDRESS
;
                                                                ;COMPUTE REMAINING SPACE
                LHLD        SYTOP
                XCHG
                LHLD        SYBAS
                CALL        DIFF                        ;DIFFERENCE TO H,L
                PUSH        H                                ;SYTOP-SYBAS TO STACK
                LHLD        SYMAX
                XCHG
                LHLD        SYBAS
                CALL        DIFF                        ;SYMAX-SYBAS TO H,L
                MOV                E, H
                MVI                D, 0                        ;DIVIDED BY 256
                POP                H                                ;SYTOP-SYBAS TO H,L
                CALL        DIVF                        ;RESULT TO DE
                XCHG
                CALL        PADDR                        ;PRINT H,L TO PBUFF
                LXI                H, PBUFF+5                ;MESSAGE
                LXI                D, EMSG                        ;END MESSAGE
ENDA0:
                LDAX        D
                ORA                A                                ;ZERO?
                JZ                ENDA1
                MOV                M, A
                INX                H
                INX                D
                JMP                ENDA0
;
EMSG:
                DB                'H USE FACTOR', CR, 0
;
ENDA1:
                LXI                H, PBUFF+2                ;BEGINNING OF RATIO
                CALL        PCON
                LHLD        EPC
                SHLD        FPC                                ;END PROGRAM COUNTER
                JMP                EOR
;
;                UTILITY SUBROUTINES
COMDH:                                                        ;COMPARE D,E WITH H,L FOR EQUALITY (NZ FLAG IF NOT EQUAL)
                MOV                A, D
                CMP                H
                RNZ
                MOV                A, E
                CMP                L
                RET
;
SETAS:                                                        ;ASPC=FPC
                LHLD        PPC
                SHLD        ASPC
                RET
;
SETLA:                                                        ;SYADR-SYLAB, FOLLOWED BY CHECK FOR ZERO
                LHLD        SYLAB
                SHLD        SYADR
                CALL        FOUND
                RET
:
FILAB:                                                        ;FILL LABEL VALUE WITH CURRENT ASPC, IF LABEL FOUND
                CALL        SETLA
                RZ                                                ;RETURN IF NO LABEL DETECTED
;
                                                                ;LABEL FOUND, MUST BE DEFINED ON PASS-1
                LXI                H, 0
                SHLD        SYLAB                        ;TO MARK NEXT STATEMENT WITH NO LABEL
                LDA                PASS
                ORA                A
                JNZ                FIL1
;
                                                                ;PASS 0
                CALL        GETTY
                PUSH        PSW                                ;SAVE A COPY OF TYPE
                ANI                111B                        ;CHECK FOR UNDEFINED
                CNZ                ERRL                        ;LABEL ERROR
                POP                PSW                                ;RESTORE TYPE
                ORI                PLABT                        ;SET TO LABEL TYPE
                CALL        SETTY                        ;SET TYPE FIELD
                LHLD        ASPC                        ;GET CURRENT PC
                CALL        SETVAL                        ;PLACE INTO VALUE FIELD
                RET
;
FIL1:                                                        ;CHECK FOR DEFINED VALUE
                CALL        GETTY
                ANI                111B
                CZ                ERRP                        ;PHASE ERROR
                                                                ;GET VALUE AND COMPARE WITH ASPC
                CALL        GETVAL                        ;TO H,L
                XCHG
                LHLD        ASPC
                CALL        COMDH
                CNZ                ERRP                        ;PHASE ERROR IF NOT THE SAME
                RET
;
FILHEX:                                                        ;WRITE HEX BYTE IN REGISTER A TO MACHINE CODE FILE IF PASS
                MOV                B, A
FILHB:
                LDA                PASS
                ORA                A
                MOV                A, B
                JZ                FILHI
;
                                                                ;PASS - 1, WRITE HEX AND PRINT DATA
                PUSH        B                                ;SAVE A COPY
                CALL        DHEX                        ;INTO MACHINE CODE FILE
                                                                ;MAY BE COMPLETELY EMPTY LINE, SO CHECK ADDRESS
                LDA                PBUFF+1
                CPI                ' '
                LHLD        ASPC
                CZ                PADDR                        ;PRINT ADDRESS FIELD
;
                LDA                NBP
                CPI                NBMAX                        ;TRUNCATE CODE IF TOO MUCH ON THIS LINE
                POP                B                                ;RECALL HEX DIGIT
                JNC                FILHI
                                                                ;ROOM FOR DIGIT ON THIS LINE
                MOV                A, B
                CALL        WHEXB                        ;WRITE HEX BYTE TO PRINT LINE
FILHI:
                LHLD        FPC
                INX                H
                SHLD        FPC                                ;READY FOR NEXT BYTE
                RET
;
FILADR:                                                        ;EMIT DOUBLE PRECISION VALUE FROM H,L
                PUSH        H                                ;SAVE A COPY
                MOV                B, L
                CALL        FILHB                        ;LOW BYTE EMITTED
                POP                H                                ;RECOVER A COPY OF H,L
                MOV                B, H
                JMP                FILHB                        ;EMIT HIGH BYTE AND RETURN
;
                                                                ;UTILITY FUNCTIONS FOR PRINTING HEX ADDRESSES AND DATA
CHEX:                                                        ;CONVERT TO HEX
                ADI                '0'
                CPI                '0'+10
                RC
                ADI                'A'-'0'-10
                RET
;
WHEXN:                                                        ;WRITE HEX NIBBLE
                CALL        CHEX                        ;CONVERT TO ASCII FROM HEX
                LXI                H, NBP
                MOV                E, M                        ;NEXT POSITION TO PRINT
                MVI                D, 0                        ;DOUBLE PRECISION
                INR                M                                ;NBP=NBP+1
                LXI                H, PBUFF
                DAD                D
                MOV                M, A                        ;STORE IN PRINT BUFFER
                RET
;
WHEXB:                                                        ;WRITE HEX BYTE TO PRINT BUFFER
                PUSH        PSW
                RAR
                RAR
                RAR
                RAR
                ANI                0FH                                ;HIGH ORDER NIBBLE NORMALIZE IN A
                CALL        WHEXN                        ;WRITE IT
                POP                PSW
                ANI                0FH
                JMP                WHEXN                        ;WRITE AND RETURN
;
PADD:
                LHLD        ASPC
PADDR:                                                        ;PRINT ADDRESS FIELD OF PRINT LINE FROM H,L
                XCHG
                LXI                H, NBP                        ;INITIALIZE NEXT TO FILL
                PUSH        D                                ;SAVE A COPY OF NBP 'S' ADDRESS
                MOV                A, D                        ;PRINT HIGH BYTE
                PUSH        D                                ;SAVE A COPY
                CALL        WHEXB
                POP                D
                MOV                A, E
                CALL        WHEXB
                POP                H                                ;ADDRESSING NBP
                INR                M                                ;SKIP A SPACE AFTER ADDRESS FIELD
                RET
;
ERRR:                                                        ;EMIT REGISTER ERROR
                PUSH        PSW
                PUSH        B
                MVI                A, 'R'
                CALL        PERR
                POP                B
                POP                PSW
                RET
;
ERRV:                                                        ;EMIT VALUE ERROR
                PUSH        PSW
                PUSH        H
                MVI                A, 'V'
                CALL        PERR
                POP                H
                POP                PSW
                RET
;
ERRD:
                PUSH        PSW
                MVI                A, 'D'                        ;DATA ERROR
                JMP                ERR
;
ERRP:
                PUSH        PSW
                MVI                A, 'P'
                JMP                ERR
;
ERRL:
                PUSH        PSW
                MVI                A, 'L'                        ;LABEL ERROR
                JMP                ERR
;
ERRN:
                PUSH        PSW
                MVI                A, 'N'                        ;NOT IMPLEMENTED
;
ERR:
                CALL        PERR
                POP                PSW
                RET
;
SYLAB:
                DS                2                                ;ADDRESS OF LINE LABEL
EPC:
                DS                2                                ;END PC VALUE
NBP:
                DS                1                                ;NEXT BYTE POSITION TO WRITE FOR MACHINE CODE
                END

[ Last edited by zzz19760225 on 2018-1-1 at 08:11 ]



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:55
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 62 楼』:  

DEBUG.EXE指令说明
DEBUG   [执行文件名]   [执行该文件的外带参数]   
a   [sta]   编写汇编语言程序的指令,sta为启始地址   
c   sta   end   sta2     比较两个储存单元,sta为第一储存单元的启始地址,而end为第一储存单元结束地址,sta2为第二储存单元的启始地址   
c   sta   lnn   sta2   比较两储存单元,sta为第一储存单元启始地址,而nn为欲比较的长度大小,sta2为第二储存单元启始地址   
d   [sta]   [end]     显示某指定范围储存单元至屏幕(sta:启始、end:结束)   
d   [sta]   [lnn]     显示某指范围块储存单元至屏幕(sta:启始、nn:长度)   
e   [sta]     修改储存单元中某一个byte的资料,sta为地址   
e   [sta]   [data]     修改储存单元中某一个byte的资料,data为新资料   
g   [end]   执行程序,直至结束地址(end)或程序结束时   
g=sta   [end]   执行从启始(sta)直至结束(end)或程序结束时   
r   [reg]     显示所有存储器内容或修改某指定存储器(reg)值   
t   [num]     单步执行,num指定一次执行几步(预设1)   
t=sta   [num]   单步执行,从sta起始,num指定执行几步(预设1)   
n   filename   为目前正在编辑或除错的文件命名   
w   [sta]     储存文件,写入cx个bytes的资料至n指定的文件名   
w   sta   dri   sec   num     将sta资料写入dri磁盘的第sec磁区共写num个磁区   
l   [sta]     载入文件,读出n指定文件,档名的资料至sta地址中   
l   sta   dri   sec   num   读出dri磁盘的第sec磁区的资料至sta共读num个磁区   
q     离开debug,返回DOS   
u   [sta]   [end]     反汇编,从sta至end   
u   [sta]   [lnn]     反汇编,从sta,共反汇编nn个bytes   
m   sta   end   sta2   将第一储存单元的数据搬至第二储存单元中   
m   sta   lnn   sta2     将第一储存单元的数据搬至第二储存单元中   
f   sta   end   data     将一段资料(data)存入某指定的储存单元区   
f   sta   lnn   data     将nn个bytes的资料存入某指定的储存单元区   
s   sta   end   data     搜寻data资料在指定地址内,data不限长度   
s   sta   lnn   data   搜寻data资料在指定地址内,data不限长度   
h   data   data2     计算两个资料的和与差并显示在屏幕上   
i   inport   由输入埠输入并显示一个byte   
o   outport   由输出埠输出一个byte值

[ Last edited by zzz19760225 on 2017-11-29 at 00:45 ]



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:55
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 63 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:56
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 64 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:57
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 65 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:58
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 66 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:59
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 67 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 19:59
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 68 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:00
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 69 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:01
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 70 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:06
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 71 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:07
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 72 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:08
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 73 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:09
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 74 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:10
查看资料  发短消息 网志   编辑帖子  回复  引用回复
zzz19760225
超级版主




积分 3673
发帖 2020
注册 2016-2-1
状态 离线
『第 75 楼』:  

1



1<词>,2[句],3/段\,4{节},5(章)。
2016-6-26 20:12
查看资料  发短消息 网志   编辑帖子  回复  引用回复
« [1] [2] [3] [4] [5] [6] »
请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: