2023-11-16 18:19:54 -05:00

443 lines
6.1 KiB
Plaintext

PAGE
SBTTL "--- 2-OPS ---"
; ---
; ADD
; ---
; RETURN [ARG1] + [ARG2]
GADD: LDA ARG1+LO
CLC
ADC ARG2+LO
TAX
LDA ARG1+HI
ADC ARG2+HI
JMP VEXIT
; ---
; SUB
; ---
; RETURN [ARG1] - [ARG2]
GSUB: LDA ARG1+LO
SEC
SBC ARG2+LO
TAX
LDA ARG1+HI
SBC ARG2+HI
JMP VEXIT
; ---
; MUL
; ---
; RETURN [ARG1] * [ARG2]
GMUL: JSR MINIT ; INIT LOOP AND TEMPS
GMLOOP: ROR MTEMP+HI
ROR MTEMP+LO
ROR ARG2+HI
ROR ARG2+LO
BCC GMNEXT
LDA ARG1+LO
CLC
ADC MTEMP+LO
STA MTEMP+LO
LDA ARG1+HI
ADC MTEMP+HI
STA MTEMP+HI
GMNEXT: DEX
BPL GMLOOP
LDX ARG2+LO ; [ARG2] CONTAINS PRODUCT
LDA ARG2+HI
JMP VEXIT
; ---
; DIV
; ---
; RETURN QUOTIENT OF [ARG1] / [ARG2]
GDIV: JSR DIVIDE
LDX QUOT+LO
LDA QUOT+HI
JMP VEXIT
; ---
; MOD
; ---
; RETURN REMAINDER OF [ARG1] / [ARG2]
GMOD: JSR DIVIDE
LDX REMAIN+LO
LDA REMAIN+HI
JMP VEXIT
; ---------------
; SIGNED DIVISION
; ---------------
; ENTRY: DIVIDEND IN [ARG1], DIVISOR IN [ARG2]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]
DIVIDE: LDA ARG1+HI ; SIGN OF THE DIVIDEND
STA RSIGN ; IS SIGN OF REMAINDER
EOR ARG2+HI ; SIGN OF QUOTIENT IS POSITIVE
STA QSIGN ; IF SIGNS OF TERMS ARE THE SAME
LDA ARG1+LO ; MOVE [ARG1] TO [QUOT]
STA QUOT+LO
LDA ARG1+HI ; IS DIVIDEND POSITIVE?
STA QUOT+HI
BPL ABSDIV ; YES, CONTINUE
JSR ABQUOT ; ELSE CALC ABSOLUTE VALUE
ABSDIV: LDA ARG2+LO ; MOVE [ARG2] TO [REMAIN]
STA REMAIN+LO
LDA ARG2+HI ; IS DIVISOR POSITIVE?
STA REMAIN+HI
BPL GODIV ; IF NOT,
JSR ABREM ; CALC ABSOLUTE VALUE
GODIV: JSR UDIV ; UNSIGNED DIVIDE
LDA QSIGN ; SHOULD QUOTIENT BE FLIPPED?
BPL RFLIP ; NO, CHECK REMAINDER
JSR ABQUOT ; ELSE FLIP QUOTIENT
RFLIP: LDA RSIGN ; FLIP REMAINDER?
BPL DIVEX ; NO, SCRAM
; OR FALL THROUGH ...
; ----------------
; CALC ABS(REMAIN)
; ----------------
ABREM: LDA #0
SEC
SBC REMAIN+LO
STA REMAIN+LO
LDA #0
SBC REMAIN+HI
STA REMAIN+HI
DIVEX: RTS
; --------------
; CALC ABS(QUOT)
; --------------
ABQUOT: LDA #0
SEC
SBC QUOT+LO
STA QUOT+LO
LDA #0
SBC QUOT+HI
STA QUOT+HI
RTS
; -----------------
; UNSIGNED DIVISION
; -----------------
; ENTRY: DIVIDEND IN [QUOT], DIVISOR IN [REMAIN]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]
UDIV: LDA REMAIN+LO
ORA REMAIN+HI
BEQ DIVERR ; CAN'T DIVIDE BY ZERO!
JSR MINIT ; INIT LOOP & TEMP REGISTER
UDLOOP: ROL QUOT+LO
ROL QUOT+HI
ROL MTEMP+LO
ROL MTEMP+HI
LDA MTEMP+LO
SEC
SBC REMAIN+LO
TAY
LDA MTEMP+HI
SBC REMAIN+HI
BCC UDNEXT
STY MTEMP+LO
STA MTEMP+HI
UDNEXT: DEX
BNE UDLOOP
ROL QUOT+LO ; SHIFT LAST CARRY
ROL QUOT+HI ; INTO QUOTIENT
LDA MTEMP+LO ; MOVE REMAINDER
STA REMAIN+LO ; INTO [REMAIN]
LDA MTEMP+HI
STA REMAIN+HI
RTS
; *** ERROR #8: DIVISION BY ZERO ***
DIVERR: LDA #8
JMP GERROR
; ---------
; MATH INIT
; ---------
MINIT: LDX #16 ; INIT BIT LOOP INDEX
LDA #0 ; CLEAR TEMP MATH REGISTER
STA MTEMP+LO
STA MTEMP+HI
CLC ; CLEAR FOR LOOPING
RTS
; ----
; BAND
; ----
; RETURN [ARG1] "AND" [ARG2]
GBAND: LDA ARG1+LO
AND ARG2+LO
TAX
LDA ARG1+HI
AND ARG2+HI
JMP VEXIT
; ----
; BIOR
; ----
; RETURN [ARG1] "OR" [ARG2]
GBIOR: LDA ARG1+LO
ORA ARG2+LO
TAX
LDA ARG1+HI
ORA ARG2+HI
JMP VEXIT
; ----
; BXOR
; ----
; RETURN [ARG1] "XOR" [ARG2]
GBXOR: LDA ARG1+LO
EOR ARG2+LO
TAX
LDA ARG1+HI
EOR ARG2+HI
JMP VEXIT
; -----
; BITS?
; -----
; IS EVERY "ON" BIT IN [ARG1] ALSO "ON" IN [ARG2]?
GBITSP: LDA ARG2+LO
AND ARG1+LO
CMP ARG2+LO
BNE PBAD
LDA ARG2+HI
AND ARG1+HI
CMP ARG2+HI
BNE PBAD
BEQ PGOOD
; ------
; EQUAL?
; ------
; DOES [ARG1] = [ARG2] (OR [ARG3] OR [ARG4])?
GEQP: DEC NARGS ; ZERO-ALIGN ARGUMENT COUNT
LDX ARG1+LO ; FETCH LSB AND
LDA ARG1+HI ; MSB OF [ARG1]
CPX ARG2+LO ; LSB OF [ARG2] MATCHED?
BNE EQP1 ; NO, TRY NEXT ARG
CMP ARG2+HI ; MSBS MATCH?
BEQ PGOOD ; HOORAY!
EQP1: DEC NARGS ; OUT OF ARGS YET?
BEQ PBAD ; IF SO, SCRAM
CPX ARG3+LO ; ELSE CHECK [ARG3]
BNE EQP2
CMP ARG3+HI
BEQ PGOOD
EQP2: DEC NARGS ; ANOTHER ARG?
BEQ PBAD ; NO, EXIT
CPX ARG4+LO ; ELSE CHECK [ARG4]
BNE PBAD
CMP ARG4+HI
BNE PBAD
PGOOD: JMP PREDS
PBAD: JMP PREDF
; -----
; LESS?
; -----
; IS [ARG1] < [ARG2]?
GLESSP: JSR A12VAL ; MOVE [ARG1] INTO [VALUE]
JMP DLS0
; ------
; DLESS?
; ------
; DECREMENT [ARG1]; SUCCEED IF < [ARG2]
GDLESP: JSR GDEC
DLS0: LDA ARG2+LO ; MOVE [ARG2]
STA I+LO ; INTO [I]
LDA ARG2+HI
STA I+HI
JMP COMPAR ; [ARG1]-1 IS ALREADY IN [VALUE]
; -----
; GRTR?
; -----
; IS [ARG1] > [ARG2]?
GGRTRP: LDA ARG1+LO ; MOVE [ARG1]
STA I+LO ; INTO [I]
LDA ARG1+HI
STA I+HI
JMP A2VAL
; ------
; IGRTR?
; ------
; INCREMENT [ARG1]; SUCCEED IF > [ARG2]
GIGRTP: JSR GINC
LDA VALUE+LO ; MOVE [ARG1]-1
STA I+LO ; INTO [I]
LDA VALUE+HI
STA I+HI
A2VAL: LDA ARG2+LO ; MOVE [ARG2]
STA VALUE+LO ; INTO [VALUE]
LDA ARG2+HI
STA VALUE+HI
COMPAR: JSR SCOMP ; SIGNED COMPARE
BCC PGOOD
BCS PBAD
; -------------------------------
; SIGNED COMPARE OF [VALUE] & [I]
; -------------------------------
SCOMP: LDA I+HI
EOR VALUE+HI
BPL SCMP
LDA I+HI
CMP VALUE+HI
RTS
SCMP: LDA VALUE+HI
CMP I+HI
BNE SCEX
LDA VALUE+LO
CMP I+LO
SCEX: RTS
; ---
; SET
; ---
; SET VARIABLE [ARG1] EQUAL TO [ARG2]
GSET: LDA ARG2+LO ; MOVE [ARG2]
STA VALUE ; INTO [VALUE]
LDA ARG2+HI
STA VALUE+HI
LDA ARG1+LO ; GET VARIABLE ID
JMP VARPUT ; AND SET THE VALUE
; ---
; GET
; ---
; RETURN ITEM [ARG2] IN WORD-TABLE [ARG1]
GGET: JSR CALCW ; V-ADDR OF WORD IN [VPC]
;***
LDA #00
STA VPC0
;***
JSR GETBYT ; GET MSB OF VALUE
DOGET: STA VALUE+HI
JSR GETBYT ; AND LSB
STA VALUE+LO
JMP PUTVAL
; ----
; GETB
; ----
; RETURN ITEM [ARG2] IN BYTE-TABLE [ARG1]
GGETB: JSR CALCB ; V-ADDR OF BYTE IN [VPC]
LDA #0 ; MSB WILL BE ZERO
BEQ DOGET
; --------------------
; CALC TABLE ADDRESSES
; --------------------
;CALCW: ASL ARG2+LO ; WORD-ALIGN TABLE INDEX
; ROL ARG2+HI
;
;***
CALCB: LSR ARG2+HI ; BYTE-ALIGN TABLE INDEX
ROR ARG2+LO
LDA #00
ROL A ; PUT CARRY IN A
STA VPC0
;***
;CALCB: LDA ARG2+LO ; CALC LSB OF V-ADDRESS
;***
CALCW: LDA ARG2+LO ; CALC LSB OF V-ADDRESS
CLC
ADC ARG1+LO
STA VPCL
LDA ARG2+HI ; ALSO CALC MSB
ADC ARG1+HI
STA VPCH
LDA #0
STA VPCFLG ; INVALIDATE [VPC]
RTS
END