Files
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.2/CPM 2.2 SOURCE/AS5OPER.ASM
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

594 lines
10 KiB
NASM

TITLE 'ASM OPERAND SCAN MODULE'
; 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 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
;
;
; 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 STKO1
MVI M,0
CALL ERREX ;OPERATOR STACK OVERFLOW
STKO1: 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 IF 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 ;FOR 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 FOUND 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
;
OP7: ;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
CZ ERREX ;OPERAND ENCOUNTERED WITH UNARY OFF
XRA A
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