Files
erkyrath.infocom-zcode-terps/apple/xzip/subs.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

349 lines
7.4 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
STTL "--- OPCODE SUPPORT SUBROUTINES ---"
PAGE
; -----------------------
; FETCH A SHORT IMMEDIATE
; -----------------------
GETSHT: LDA #0 ; MSB IS ZERO
BEQ GETV ; FETCH LSB FROM Z-CODE
; ----------------------
; FETCH A LONG IMMEDIATE
; ----------------------
GETLNG: JSR NEXTPC ; GRAB MSB
GETV: STA VALUE+HI
JSR NEXTPC ; GRAB LSB
STA VALUE+LO
RTS
; ----------------
; FETCH A VARIABLE
; ----------------
; FROM INSIDE AN OPCODE (VARIABLE ID IN [A])
VARGET: TAX ; IF NON-ZERO,
BNE GETVR1 ; ACCESS A VARIABLE
JSR POPVAL ; ELSE PULL VAR OFF Z-STACK
JMP PSHVAL ; WITHOUT ALTERING STACK
; FROM THE MAIN LOOP (VARIABLE ID IN Z-CODE)
GETVAR: JSR NEXTPC ; GRAB VAR-TYPE BYTE
BEQ POPVAL ; VALUE IS ON Z-STACK
; IS VARIABLE LOCAL OR GLOBAL?
GETVR1: CMP #$10 ; IF LOW = 16,
BCS GETVRG ; IT'S GLOBAL
; HANDLE A LOCAL VARIABLE
GETVRL: ASL A ; WORD INDEX
TAX ; INTO THE [LOCALS] TABLE
LDA LOCALS-2+LO,X ; GRAB LSB
STA VALUE+LO
LDA LOCALS-2+HI,X ; AND MSB
STA VALUE+HI
RTS
; HANDLE A GLOBAL VARIABLE
GETVRG: JSR GVCALC ; GET ADDRESS OF GLOBAL INTO [I]
LDA (I),Y ; MSB OF GLOBAL ([Y] = 0)
STA VALUE+HI
INY ; = 1
LDA (I),Y ; LSB OF GLOBAL
STA VALUE+LO ; SAVE IT
RTS ; AND WE'RE DONE
; ----------------------------------
; POP Z-STACK INTO [VALUE] AND [X/A]
; ----------------------------------
; ZSTACK DOUBLED IN SIZE FOR EZIP
; SO THIS RTN ALL NEW
POPVAL: LDA ZSP+LO ; IF ZSP+LO IS 0
BNE POP1
STA ZSP+HI ; MUST DEC. HI (HI = 0 OR 1 ONLY)
POP1: DEC ZSP+LO ; THEN DEC ZSP LO
BNE POP2
ORA ZSP+HI ; LO + HI BOTH 0?
BEQ UNDER ; UNDERFLOW IF ZERO!
POP2: LDY ZSP+LO
LDA ZSP+HI
BEQ POP3 ; BOTTOM HALF OF ZSTACK
LDA ZSTKTL,Y ; GET VALUE FROM TOP HALF
STA VALUE+LO ; OF ZSTACK INTO VALUE & A,X
TAX
LDA ZSTKTH,Y
STA VALUE+HI
RTS
POP3: LDA ZSTKBL,Y ; GET VALUE FROM BOTTOM HALF
STA VALUE+LO ; OF ZSTACK INTO VALUE & A,X
TAX
LDA ZSTKBH,Y
STA VALUE+HI
RTS
; *** ERROR #5 -- Z-STACK UNDERFLOW ***
UNDER: LDA #5
JMP ZERROR
; -----------------------
; PUSH [VALUE] TO Z-STACK
; -----------------------
PSHVAL: LDX VALUE+LO
LDA VALUE+HI
; ---------------------
; PUSH [X/A] TO Z-STACK
; ---------------------
PUSHXA: PHA ; HOLD VALUE IN [A] A SEC.
LDY ZSP+LO
LDA ZSP+HI
BEQ PSHBOT ; ON BOTTOM HALF OF STACK
TXA
STA ZSTKTL,Y ; PUSH VALUE ONTO TOP HALF OF STACK
PLA
STA ZSTKTH,Y
JMP PSHUPD ; NOW UPDATE POINTER
PSHBOT: TXA ; PLACE VALUE ON ZSTACK
STA ZSTKBL,Y
PLA
STA ZSTKBH,Y
PSHUPD: INC ZSP+LO ; UPDATE ZSTACK POINTER
BNE PSHEX
LDA ZSP+LO
ORA ZSP+HI
BNE OVER ; OVERFLOW IF $200
INC ZSP+HI ; TO 1
PSHEX: RTS
; *** ERROR #6 -- Z-STACK OVERFLOW ***
OVER: LDA #6
JMP ZERROR
; --------------
; RETURN A VALUE
; --------------
; FROM WITHIN AN OPCODE (VARIABLE ID IN [A])
VARPUT: TAX ; IF ZERO,
BNE PUTVR1
; FLUSH TOP WORD OFF STACK
; AND REPLACE WITH [VALUE]
LDA ZSP+LO ; IF ZSP+LO =0
BNE VAR1 ; THEN HI =1 (GUARDED ELSEWHERE)
STA ZSP+HI ; DECREMENT HI (ONLY 0 OR 1)
VAR1: DEC ZSP+LO ; NOW DEC LOW BYTE
BNE PSHVAL
ORA ZSP+HI
BEQ UNDER ; ERROR IF [ZSP] BECAME ZERO!
BNE PSHVAL
; RETURN A ZERO
RET0: LDA #0
LDX #0
; RETURN WORD IN [A], [X] (LO,HI) (EZIP EXPANDED TO A WORD)
PUTBYT: STA VALUE+LO
; LDA #0
STX VALUE+HI ; CLEAR MSB
; RETURN [VALUE]
PUTVAL: JSR NEXTPC ; GET VARIABLE ID BYTE
BEQ PSHVAL ; [VALUE] GOES TO Z-STACK
; LOCAL OR GLOBAL VARIABLE?
PUTVR1: CMP #$10 ; IF LOW = 16,
BCS PUTVLG ; IT'S GLOBAL
; PUT A LOCAL VARIABLE
PUTVLL: ASL A ; WORD INDEX
TAX ; INTO THE [LOCALS] TABLE
LDA VALUE+LO ; GRAB LSB
STA LOCALS-2+LO,X ; SAVE IN LOCAL TABLE
LDA VALUE+HI ; DO SAME TO
STA LOCALS-2+HI,X ; MSB
RTS
; RETURN A GLOBAL VARIABLE
PUTVLG: JSR GVCALC
LDA VALUE+HI ; GET MSB
STA (I),Y ; STORE AS 1ST BYTE ([Y] = 0)
INY ; = 1
LDA VALUE+LO ; NOW GET LSB
STA (I),Y ; STORE AS 2ND BYTE
RTS
; -----------------------
; CALC GLOBAL WORD OFFSET
; -----------------------
; ENTRY: VAR-I BYTE (16-255) IN [A]
; EXIT: ABSOLUTE ADDRESS OF GLOBAL VAR IN [I]
; [Y] = 0 FOR INDEXING
GVCALC: SEC
SBC #$10 ; FORM A ZERO-ALIGNED INDEX
LDY #0 ; MAKE SURE MSB OF OFFSET AND [Y]
STY I+HI ; ARE CLEARED
ASL A ; MULTIPLY OFFSET BY 2
ROL I+HI ; TO WORD-ALIGN IT
CLC ; ADD OFFSET TO ADDR OF GLOBAL TABLE
ADC GLOBAL+LO ; TO FORM THE ABSOLUTE
STA I+LO ; ADDRESS OF THE
LDA I+HI ; DESIRED GLOBAL VARIABLE
ADC GLOBAL+HI ; STORE ADDRESS BACK IN [VAL]
STA I+HI ; AS A POINTER
WCEX: RTS
; ---------------
; PREDICATE FAILS
; ---------------
PREDF: JSR NEXTPC ; GET 1ST BRANCH BYTE
BPL PREDB ; DO BRANCH IF BIT 7 OFF
; -----------------------
; IGNORE PREDICATE BRANCH
; -----------------------
; ENTRY: 1ST BRANCH BYTE IN [A]
PREDNB: AND #%01000000 ; TEST BIT 6
BNE WCEX ; SHORT BRANCH IF SET
JMP NEXTPC ; ELSE SKIP OVER 2ND BRANCH BYTE
; ------------------
; PREDICATE SUCCEEDS
; ------------------
PREDS: JSR NEXTPC ; GET 1ST BRANCH BYTE
BPL PREDNB ; DON'T BRANCH IF BIT 7 CLEAR
; --------------------------
; PERFORM A PREDICATE BRANCH
; --------------------------
; ENTRY: 1ST PRED BYTE IN [A]
PREDB: TAX ; SAVE HERE
AND #%01000000 ; LONG OR SHORT BRANCH?
BEQ PREDLB ; LONG IF BIT 6 IS CLEAR
; HANDLE A SHORT BRANCH
TXA ; RESTORE PRED BYTE
AND #%00111111 ; FORM SHORT OFFSET
STA VALUE+LO ; USE AS LSB OF BRANCH OFFSET
LDA #0
STA VALUE+HI ; MSB OF OFFSET IS ZERO
BEQ PREDB7 ; DO THE BRANCH
; HANDLE A LONG BRANCH
PREDLB: TXA ; RESTORE 1ST PRED BYTE
AND #%00111111 ; FORM MSB OF OFFSET
TAX ; SAVE HERE FOR REFERENCE
AND #%00100000 ; CHECK SIGN OF 14-BIT VALUE
BEQ DOB2 ; POSITIVE IF ZERO, SO USE [X]
TXA ; ELSE RESTORE BYTE
ORA #%11100000 ; EXTEND THE SIGN BIT
TAX ; BACK HERE FOR STORAGE
DOB2: STX VALUE+HI
JSR NEXTPC ; FETCH LSB OF 14-BIT OFFSET
STA VALUE+LO
; BRANCH TO Z-ADDRESS IN [VALUE]
PREDB1: LDA VALUE+HI ; CHECK MSB OF OFFSET
BNE PREDB3 ; DO BRANCH IF NZ
PREDB7: LDA VALUE+LO ; IF LSB IS NON-ZERO,
BNE PREDB2 ; MAKE SURE IT ISN'T 1
JMP ZRFALS ; ELSE DO AN "RFALSE"
PREDB2: CMP #1 ; IF OFFSET = 1
BNE PREDB3
JMP ZRTRUE ; DO AN "RTRUE"
; ENTRY POINT FOR "JUMP"
PREDB3: LDA VALUE+LO ; SUBTRACT 2 FROM OFFSET
SEC ; IN [VALUE]
SBC #2
TAX ;SAVE LO BYTE
LDA VALUE+HI
SBC #0
STA I+LO ;MSB OF OFFSET = LSB OF [I]
LDY #0 ; CLEAR THE MSB
STY I+HI ; OF [I]
ASL A ; EXTEND THE SIGN OF OFFSET
ROL I+HI ; INTO MSB OF [I]
ASL A
ROL I+HI ; (EZIP)
TXA ; GET LSB OF OFFSET
ADC ZPCL ; ADD LOW 8 BITS OF ZPC
BCC PREDB5 ; IF OVERFLOWED,
INC I+LO ; UPDATE UPPER 9 BITS
BNE PREDB5
INC I+HI
PREDB5: STA ZPCL ; UPDATE ZPC
LDA I+LO ; IF UPPER 9 BITS ARE ZERO,
ORA I+HI ; NO NEED TO CHANGE PAGES
BEQ PREDB6
LDA I+LO ; ELSE CALC NEW UPPER BITS
CLC
ADC ZPCM
STA ZPCM
LDA I+HI
ADC ZPCH
AND #%00000011 ; USE ONLY BIT 0 (& 1 - EZIP)
STA ZPCH
JMP VLDZPC ;MAKE VALID
PREDB6:
; FALL THROUGH ...
; ----
; NOOP
; ----
ZNOOP: RTS
; ----------------------
; MOVE [ARG1] TO [VALUE]
; ----------------------
A12VAL: LDA ARG1+LO
STA VALUE+LO
LDA ARG1+HI
STA VALUE+HI
RTS
; -----------------------------------
; INDICATE STATUS LINE REFRESH NEEDED
; -----------------------------------
REFRSH: LDA ZBEGIN+ZSCRIP+1 ; PICK UP LOW BYTE OF FLAG WORD
ORA #%00000100 ; SET BIT 2
STA ZBEGIN+ZSCRIP+1 ; AND PUT IT BACK
RTS
END