github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-02-10 02:00:22 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
2915fa943b2ff6a0449cd3b7aae496eac645e2d6
erkyrath.infocom-zcode-terps/apple/xzip/main.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

375 lines
6.6 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 "--- MAIN LOOP ---"
PAGE
MLOOP: LDA #0
STA NARGS ; RESET # ARGUMENTS
LDA ZBEGIN+ZSCRIP+1 ; SET GAME FLAG ALSO
sta SCRIPTF ; SET SCRIPT FLAG ON
beq MLOOP0 ; check scripting flag
lda PSTAT ; CHECK IF PRINTER ALREADY INIT'D
bne MLOOP0
jsr PCHK ; NO, GO DO IT
; FASTPC - GET NEXT INSTRUCTION
MLOOP0:
LDY ZPCBNK ; THIS IS ANDREW'S CODE - AARRRGGGG!
STA RDBNK,Y
LDY ZPCL
LDA (ZPCPNT),Y
STA RDBNK+MAIN
INC ZPCL
BNE GOTIT1
JSR CRSZPC
GOTIT1: TAY
STA OPCODE ; SAVE IT HERE
IF 0
lda OPCODE
JSR DBG1
LDA #' '
JSR DBG2
LDA OPCODE
TAY
ENDIF
IF 0 ;DEBUG
LDA #0 ; BREAKPOINT #0
JSR DOBUG
LDA OPCODE
TAY
ENDIF
; DECODE AN OPCODE
BMI DC0 ; IF POSITIVE,
JMP OP2 ; IT'S A 2-OP
DC0: CMP #$B0
BCS DC1
JMP OP1 ; OR MAYBE A 1-OP
DC1: CMP #$C0
BCS OPEXT
JMP OP0 ; PERHAPS A 0-OP
; --------------
; HANDLE AN X-OP
; --------------
OPEXT: CMP #236 ; XCALL?
BNE OPX5
JMP OPXCLL ; YES, PROCESS SEPARATELY
OPX5: CMP #250 ; IXCALL
BNE OPX6
JMP OPXCLL
OPX6: JSR NEXTPC ; GRAB THE ARGUMENT ID BYTE
STA ABYTE ; HOLD IT HERE
LDX #0
STX ADEX ; INIT ARGUMENT INDEX
BEQ OPX1 ; JUMP TO TOP OF LOOP
OPX0: LDA ABYTE ; GET ARG BYTE
ASL A ; SHIFT NEXT 2 ARG BITS
ASL A ; INTO BITS 7 & 6
STA ABYTE ; HOLD FOR LATER
OPX1: AND #%11000000 ; MASK OUT GARBAGE BITS
BNE OPX2
JSR GETLNG ; 00 = LONG IMMEDIATE
JMP OPXNXT
OPX2: CMP #%01000000 ; IS IT A SHORT IMMEDIATE?
BNE OPX3 ; NO, KEEP GUESSING
JSR GETSHT ; 01 = SHORT IMMEDIATE
JMP OPXNXT
OPX3: CMP #%10000000 ; LAST TEST
BNE OPX4 ; 11 = NO MORE ARGUMENTS
JSR GETVAR ; 10 = VARIABLE
OPXNXT: LDX ADEX ; RETRIEVE ARGUMENT INDEX
LDA VALUE+LO ; GRAB LSB OF VALUE
STA ARG1+LO,X ; STORE IN ARGUMENT TABLE
LDA VALUE+HI ; GRAB MSB OF VALUE
STA ARG1+HI,X ; STORE THAT, TOO
INC NARGS ; UPDATE ARGUMENT COUNTER
INX
INX
STX ADEX ; UPDATE INDEX
CPX #8 ; DONE 4 ARGUMENTS YET?
BCC OPX0 ; NO, GET SOME MORE
; ALL X-OP ARGUMENTS READY
OPX4: LDA OPCODE ; IS THIS
CMP #$E0 ; AN EXTENDED 2-OP?
BCS DOXOP ; NO, IT'S A REAL X-OP
CMP #$C0 ; IS IT NEW OPCODE RANGE?
BCC ZEXTOP ; YES
JMP OP2EX ; ELSE TREAT IT LIKE A 2-OP
DOXOP: AND #%00011111 ; ISOLATE ID BITS
TAY
LDA OPTXL,Y
STA GOX+1+LO
LDA OPTXH,Y
STA GOX+1+HI
GOX: JSR $FFFF ;DUMMY
JMP MLOOP
; HANDLE EXTENDED OPCODE RANGE OPS
ZEXTOP: CMP #EXTLEN ; OUT OF RANGE?
BCS BADEXT
TAY ; OFFSET ALREADY CORRECT
LDA EXTOPL,Y
STA GOE+1+LO
LDA EXTOPH,Y
STA GOE+1+HI
GOE: JSR $FFFF ;DUMMY
JMP MLOOP
; *** ERROR #1 -- ILLEGAL X-OP ***
BADOPX: LDA #1
JMP ZERROR
; *** ERROR #16 -- ILLEGAL EXTENDED RANGE X-OP ***
BADEXT: LDA #16
JMP ZERROR
; HANDLE AN XCALL OPCODE
OPXCLL: JSR NEXTPC ; GET 2 MODE BYTES
STA ABYTE
JSR NEXTPC
STA BBYTE
LDA ABYTE ; ONE TO START WITH
LDX #0
STX ADEX ; INIT ARGUMENT INDEX
BEQ XCALL2 ; ALWAYS JUMP TO TOP OF LOOP
XCALL1: LDA ABYTE ; GET ARG BYTE
ASL A ; SHIFT NEXT 2 BITS
ASL A ; INTO BITS 7 & 6
STA ABYTE ; HOLD FOR LATER
XCALL2: AND #%11000000 ; MASK OUT GARBAGE
BNE XCALL3
JSR GETLNG ; 00 = LONG IMMEDIATE
JMP XCNXT
XCALL3: CMP #%01000000 ; SHORT IMMED?
BNE XCALL4 ; NO, TRY ANOTHER
JSR GETSHT ; 01 = SHORT IMMED.
JMP XCNXT
XCALL4: CMP #%10000000 ; LAST TEST
BNE OPX4 ; 11 = NO MORE ARGS
JSR GETVAR ; 10 = VARIABLE
XCNXT: LDX ADEX
LDA VALUE+LO
STA ARG1+LO,X
LDA VALUE+HI
STA ARG1+HI,X
INC NARGS
INX
INX
STX ADEX
CPX #16
BNE XCALL5
JMP OPX4 ; DONE, GO DO IT
XCALL5: CPX #8 ; DONE 1ST MODE BYTE?
BNE XCALL1 ; NOT QUITE YET
LDA BBYTE ; SET UP FOR NEXT
STA ABYTE ; MODE BYTE
JMP XCALL2 ; GO DO IT
; -------------
; HANDLE A 0-OP
; -------------
OP0: CMP #190 ; IS IT EXTOP OP
BEQ EXTOP ; YES
AND #%00001111 ; ISOLATE 0-OP ID BITS
TAY
LDA OPT0L,Y
STA GO0+1+LO
LDA OPT0H,Y
STA GO0+1+HI
GO0: JSR $FFFF ;DUMMY
JMP MLOOP
; *** ERROR #2 -- ILLEGAL 0-OP ***
BADOP0: LDA #2
JMP ZERROR
; THIS OPCODE TELLS THAT NEXT OP IS PART OF THE
; EXTENDED RANGE OF OPCODES, GET IT AND PROCESS IT
; (THEY ARE ALL XOPS)
EXTOP: JSR NEXTPC ; GO GET EXTENDED RANGE OP
STA OPCODE ; SAVE IT
IF 0
JSR DBG1
LDA #'!'
JSR DBG2
LDA OPCODE
TAY
ENDIF
JMP OPEXT ; AND HANDLE IT
; -------------
; HANDLE A 1-OP
; -------------
OP1: AND #%00110000 ; ISOLATE ARGUMENT BITS
BNE OP1A
;JSR GETLNG ; 00 = LONG IMMEDIATE
; FASTPC - GET HI OF ARG1
LDY ZPCBNK
STA RDBNK,Y
LDY ZPCL
LDA (ZPCPNT),Y
STA RDBNK+MAIN
INC ZPCL
BNE GOTIT2
JSR CRSZPC
GOTIT2: TAY
JMP OP1A1
OP1A: AND #%00100000 ; TEST AGAIN
BNE OP1B
;JSR GETSHT ; 01 = SHORT IMMEDIATE
OP1A1: STA ARG1+HI
; FASTPC - GET ARG1+LO
LDY ZPCBNK
STA RDBNK,Y
LDY ZPCL
LDA (ZPCPNT),Y
STA RDBNK+MAIN
INC ZPCL
BNE GOTIT3
JSR CRSZPC
GOTIT3: TAY
STA ARG1+LO
INC NARGS
JMP OP1EX1
OP1B: JSR GETVAR ; 10 = VARIABLE
OP1EX: JSR V2A1 ; MOVE [VALUE] TO [ARG1], UPDATE [NARGS]
OP1EX1: LDA OPCODE
AND #%00001111 ; ISOLATE 0-OP ID BITS
TAY
LDA OPT1L,Y
STA GO1+1+LO
LDA OPT1H,Y
STA GO1+1+HI
GO1: JSR $FFFF ;DUMMY
JMP MLOOP
; *** ERROR #3 -- ILLEGAL 1-OP ***
BADOP1: LDA #3
JMP ZERROR
; -------------
; HANDLE A 2-OP
; -------------
OP2: AND #%01000000 ; ISOLATE 1ST ARG BIT
BNE OP2A
;JSR GETSHT ; 0 = SHORT IMMEDIATE
STA ARG1+HI
; FASTPC -
LDY ZPCBNK
STA RDBNK,Y
LDY ZPCL
LDA (ZPCPNT),Y
STA RDBNK+MAIN
INC ZPCL
BNE GOTIT4
JSR CRSZPC
GOTIT4: TAY
STA ARG1+LO
INC NARGS
JMP OP2B1
OP2A: JSR GETVAR ; 1 = VARIABLE
OP2B: JSR V2A1 ; [VALUE] TO [ARG1], UPDATE [NARGS]
OP2B1: LDA OPCODE ; RESTORE OPCODE BYTE
AND #%00100000 ; ISOLATE 2ND ARG BIT
BNE OP2C
;JSR GETSHT ; 0 = SHORT IMMEDIATE
STA ARG2+HI
; FASTPC -
LDY ZPCBNK
STA RDBNK,Y
LDY ZPCL
LDA (ZPCPNT),Y
STA RDBNK+MAIN
INC ZPCL
BNE GOTIT5
JSR CRSZPC
GOTIT5: TAY
STA ARG2+LO
JMP OP2D1
OP2C: JSR GETVAR ; 1 = VARIABLE
OP2D: LDA VALUE+LO ; MOVE 2ND [VALUE]
STA ARG2+LO ; INTO [ARG2]
LDA VALUE+HI
STA ARG2+HI
OP2D1: INC NARGS ; UPDATE ARGUMENT COUNT
; EXECUTE A 2-OP OR EXTENDED 2-OP
OP2EX: LDA OPCODE
AND #%00011111 ; ISOLATE 0-OP ID BITS
TAY
LDA OPT2L,Y
STA GO2+1+LO
LDA OPT2H,Y
STA GO2+1+HI
GO2: JSR $FFFF ;DUMMY
JMP MLOOP
; *** ERROR #4 -- ILLEGAL 2-OP ****
BADOP2: LDA #4
JMP ZERROR
; --------------------------------------
; MOVE [VALUE] TO [ARG1], UPDATE [NARGS]
; --------------------------------------
V2A1: LDA VALUE+LO
STA ARG1+LO
LDA VALUE+HI
STA ARG1+HI
INC NARGS
RTS
END

Reference in New Issue View Git Blame Copy Permalink