『第
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 ]
|
