mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-02-08 01:01:24 +00:00
3070 lines
75 KiB
NASM
3070 lines
75 KiB
NASM
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* ARITHMETIC OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPADD
|
|
* ----------------------
|
|
|
|
OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPSUB
|
|
* ----------------------
|
|
|
|
OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPMUL
|
|
* ----------------------
|
|
|
|
OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED)
|
|
BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW
|
|
|
|
* ----------------------
|
|
* OPDIV
|
|
* ----------------------
|
|
|
|
* DIVIDE BY ZERO, MOD ZERO, & RANDOM ZERO GENERATE 68K HARDWARE TRAPS ...
|
|
|
|
OPDIV EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
BRA PUTVAL * RETURN THE QUOTIENT, IGNORING REMAINDER
|
|
|
|
* ----------------------
|
|
* OPMOD
|
|
* ----------------------
|
|
|
|
OPMOD EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
SWAP D0 * GET REMAINDER
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
* ----------------------
|
|
* OPRAND
|
|
* ----------------------
|
|
|
|
OPRAND TST.W D7 * (GARBAGE FOR ST ASSEMBLER)
|
|
|
|
IFEQ EZIP
|
|
TST.W D0 * DISABLE RANDOMNESS NOW?
|
|
BLT.S RANDX1 * YES
|
|
BEQ.S RANDX2 * ZERO, RE-ENABLE RANDOMNESS
|
|
|
|
TST.W RCYCLE(A6) * IS RANDOMNESS ALREADY DISABLED?
|
|
BNE.S RANDX3 * YES
|
|
ENDC
|
|
|
|
* NORMAL RANDOMNESS, GENERATE A VALUE
|
|
|
|
MOVE.W RSEED2(A6),D1 * GET BOTH SEEDS
|
|
SWAP D1
|
|
MOVE.W RSEED1(A6),D1
|
|
MOVE.W D1,RSEED2(A6) * UPDATE LOW SEED
|
|
SWAP D1
|
|
|
|
LSR.L #1,D1 * SHIFT BOTH RIGHT BY 1 BIT
|
|
EOR.W D1,RSEED1(A6) * GENERATE OUTPUT & UPDATE HIGH SEED
|
|
MOVE.W RSEED1(A6),D1 * GET NEW HIGH SEED
|
|
|
|
ANDI.L #$00007FFF,D1 * CLEAR HIGH BIT TO PREVENT POSSIBLE OVERFLOW
|
|
DIVU D0,D1 * DIVIDE ARG INTO RANDOM NUMBER
|
|
SWAP D1 * GET REMAINDER
|
|
ADDQ.W #1,D1 * MUST BE BETWEEN 1 AND N, INCLUSIVE
|
|
MOVE.W D1,D0
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
IFEQ EZIP
|
|
|
|
*** GENERATE A NON-RANDOM SEQUENCE HENCEFORTH
|
|
|
|
RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE
|
|
RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT
|
|
BRA.S RANDX4 * AND INITIALIZE COUNTER (SEQ BEGINS NEXT PASS)
|
|
|
|
RANDX3 MOVE.W RCONST(A6),D0 * GENERATE NEXT VALUE IN SEQUENCE
|
|
ADDQ.W #1,D0
|
|
CMP.W RCYCLE(A6),D0 * EXCEEDED THE UPPER LIMIT YET?
|
|
BLE.S RANDX4 * NO
|
|
MOVEQ #1,D0 * YES, RESTART THE SEQUENCE
|
|
|
|
RANDX4 MOVE.W D0,RCONST(A6) * UPDATE COUNTER
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
ENDC
|
|
|
|
* ----------------------
|
|
* OPQLES
|
|
* ----------------------
|
|
|
|
OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2?
|
|
BLT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQGRT
|
|
* ----------------------
|
|
|
|
OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2?
|
|
BGT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PRECICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPBTST
|
|
* ----------------------
|
|
|
|
* LOGICAL OPERATIONS
|
|
|
|
OPBTST NOT.W D0 * TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1
|
|
AND.W D0,D1
|
|
BEQ PTRUE * SUCCESS IF OPR2 COMPLETELY CLEARED
|
|
BRA PFALSE
|
|
|
|
* ----------------------
|
|
* OPBOR
|
|
* ----------------------
|
|
|
|
OPBOR OR.W D1,D0 * LOGICAL "OR"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPBCOM
|
|
* ----------------------
|
|
|
|
OPBCOM NOT.W D0 * LOGICAL COMPLEMENT
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPBAND
|
|
* ----------------------
|
|
|
|
OPBAND AND.W D1,D0 * LOGICAL "AND"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPSHIFT
|
|
* ----------------------
|
|
|
|
OPSHIFT
|
|
TST.W D1 * NEGATIVE?
|
|
BLT.S SHFX1 * YES
|
|
LSL.W D1,D0 * NO, LOGICAL LEFT SHIFT
|
|
BRA PUTVAL
|
|
SHFX1 NEG.W D1
|
|
LSR.W D1,D0 * LOGICAL RIGHT SHIFT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPASHIFT
|
|
* ----------------------
|
|
|
|
OPASHIFT
|
|
TST.W D1 * NEGATIVE?
|
|
BLT.S ASHFX1 * YES
|
|
ASL.W D1,D0 * NO, ARITHMETIC LEFT SHIFT
|
|
BRA PUTVAL
|
|
ASHFX1 NEG.W D1
|
|
ASR.W D1,D0 * ARITHMETIC RIGHT SHIFT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPQEUQ
|
|
* ----------------------
|
|
|
|
* GENERAL PREDICATES
|
|
|
|
OPQEQU NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W (A0)+,D1 * NUMBER OF OPERANDS
|
|
MOVE.W (A0)+,D0 * OPR1
|
|
SUBQ.W #1,D1
|
|
|
|
QEQUX1 CMP.W (A0)+,D0 * IS NEXT OPR EQUAL TO OPR1?
|
|
BEQ.S QEQUX2 * YES
|
|
SUBQ.W #1,D1 * NO, BUT LOOP IF MORE OPERANDS
|
|
BNE.S QEQUX1
|
|
|
|
BRA PFALSE * PREDICATE FALSE
|
|
QEQUX2 BRA PTRUE * PREDICATE TRUE
|
|
|
|
|
|
* ----------------------
|
|
* OPQZER
|
|
* ----------------------
|
|
|
|
OPQZER TST.W D0 * IS OPR ZERO?
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT-RELATED PRIMITIVES
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OBJLOC
|
|
* ----------------------
|
|
|
|
* GIVEN OBJECT NUMBER IN D0.W, RETURN OBJECT LOCATION IN A0
|
|
|
|
OBJLOC MULU #OLEN,D0 * CALCULATE OBJECT OFFSET
|
|
MOVE.L OBJTAB(A6),A0
|
|
ADDA.L D0,A0 * INDEX INTO OBJECT TABLE
|
|
ADDA.W #OPLEN-OLEN,A0 * SKIPPING OVER THE DEFAULT PROPERTY TABLE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* FSTPRP
|
|
* ----------------------
|
|
|
|
* GIVEN OBJECT LOCATION IN A0, RETURN POINTER TO FIRST PROPERTY IN A0
|
|
|
|
FSTPRP ADDA.W #PROP,A0 * POINT TO PROPERTY TABLE SLOT
|
|
MOVEQ #0,D0
|
|
BSR GTAWRD * GET ITS LOCATION
|
|
MOVE.L BUFFER(A6),A0 * ABSOLUTIZE THE LOCATION
|
|
ADDA.L D0,A0
|
|
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * LENGTH OF SHORT DESCRIPTION IN WORDS
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A0 * ADJUST POINTER TO SKIP IT
|
|
RTS
|
|
|
|
* ----------------------
|
|
* NXTPRP
|
|
* ----------------------
|
|
|
|
* GIVEN POINTER TO A PROPERTY ID IN A0, UPDATE IT TO POINT TO NEXT PROPERTY ID
|
|
|
|
IFEQ EZIP
|
|
|
|
NXTPRP MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.S NXTPX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BEQ.S NXTPX2 * NO, PROPERTY LENGTH IS 1
|
|
ADDQ.L #1,A0
|
|
NXTPX2 ADDQ.L #1,A0 * UPDATE POINTER
|
|
RTS
|
|
|
|
NXTPX4 MOVE.B (A0)+,D0 * GET (SECOND) PROPERTY LENGTH BYTE (LOW 6 BITS)
|
|
ANDI.W #$003F,D0 * CLEAR OFF HIGH BITS
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
NXTPRP CLR.W D0
|
|
MOVE.B (A0)+,D0 * GET PROPERTY ID BYTE
|
|
ASR.W #5,D0 * EXTRACT PROPERTY LENGTH-1 (HIGH 3 BITS)
|
|
ADDQ.W #1,D0 * ADJUST FOR EXTRA LENGTH BYTE
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDC
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPMOVE
|
|
* ----------------------
|
|
|
|
* MOVE (OBJ1 INTO OBJ2)
|
|
|
|
OPMOVE MOVEM.W D1/D0,-(SP) * PROTECT OPERANDS FROM REMOVE CALL
|
|
BSR OPREMO * REMOVE OBJ1 FROM WHEREVER IT IS
|
|
|
|
MOVE.W 2(SP),D0 * OBJ2
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1 * SAVE IT
|
|
MOVE.W (SP),D0 * OBJ1
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
|
|
MOVEM.W (SP)+,D0/D1 * RESTORE THE OBJ NUMBERS
|
|
|
|
IFEQ EZIP
|
|
MOVE.W FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.W D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.W D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDC
|
|
IFEQ CZIP
|
|
MOVE.B FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.B D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.B D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDC
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPREMO
|
|
* ----------------------
|
|
|
|
* REMOVE (OBJ FROM ITS PARENT)
|
|
|
|
IFEQ EZIP
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.W LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.W FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO
|
|
|
|
MOVE.W NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.S REMOX2 * AND EXIT
|
|
|
|
REMOX1 BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.W NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.W NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.W LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.W NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.B LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.B FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO
|
|
|
|
MOVE.B NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.S REMOX2 * AND EXIT
|
|
|
|
REMOX1 ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.B NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.B NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.B LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.B NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
ENDC
|
|
|
|
* ----------------------
|
|
* OPLOC
|
|
* ----------------------
|
|
|
|
* LOC (RETURN CONTAINER OF OBJ)
|
|
|
|
OPLOC BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W LOC(A0),D0 * GET PARENT
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B LOC(A0),D0 * GET PARENT, CLEARING UNUSED BYTE
|
|
ENDC
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPQFIR
|
|
* ----------------------
|
|
|
|
* FIRST? (RETURN FIRST CHILD OF OBJ, FAIL IF NONE)
|
|
|
|
OPQFIR BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W FIRST(A0),D0 * GET FIRST CHILD
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B FIRST(A0),D0 * GET FIRST CHILD, CLEARING UNUSED BYTE
|
|
ENDC
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQNEX
|
|
* ----------------------
|
|
|
|
* NEXT? (RETURN THE NEXT SIBLING OF OBJ, FAIL IF NONE)
|
|
|
|
OPQNEX BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W NEXT(A0),D0 * GET SIBLING
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B NEXT(A0),D0 * GET SIBLING, CLEARING UNUSED BYTE
|
|
ENDC
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQIN
|
|
* ----------------------
|
|
|
|
* IN? (IS OBJ1 CONTAINED IN OBJ2?)
|
|
|
|
OPQIN BSR OBJLOC * FIND OBJ1'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
CMP.W LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDC
|
|
IFEQ CZIP
|
|
CMP.B LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDC
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPGETP
|
|
* ----------------------
|
|
|
|
* GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
|
|
|
|
OPGETP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S GETPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GETPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GETPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S GETPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BLT.S GETPX3 * IF LESS, NO SUCH PROPERTY, USE DEFAULT
|
|
|
|
* (ASSUMIMG NO 2ND EZIP LENGTH BYTE EXISTS HERE)
|
|
|
|
BTST #PLBIT,(A0)+ * GOT IT, EXAMINE (LOW MODE OR) LOWEST LEN BIT
|
|
BNE.S GETPX4 * ONE MEANS WORD VALUE, OTHERWISE BYTE VALUE
|
|
|
|
MOVE.B (A0),D0 * GET THE BYTE
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
GETPX3 SUBQ.W #1,D1 * PROPERTY NOT FOUND, USE DEFAULT PROP TABLE
|
|
ADD.W D1,D1 * WORD OFFSET
|
|
MOVE.L OBJTAB(A6),A0 * GET BASE OF DEFAULT TABLE
|
|
ADDA.W D1,A0 * POINT TO THE DEFAULT PROPERTY
|
|
|
|
GETPX4 BSR GTAWRD * GET THE WORD VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPUTP
|
|
* ----------------------
|
|
|
|
* PUTP (CHANGE VALUE OF SPECIFIED PROPERTY OF OBJ, ERROR IF BAD PROP NUMBER)
|
|
|
|
OPPUTP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S PUTPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
PUTPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
PUTPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S PUTPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S PUTPX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGPUP,A0
|
|
BRA FATAL * 'Non-existant put property'
|
|
|
|
SECTION ZDATA
|
|
MSGPUP DC.B 'Non-existant put property',0
|
|
SECTION ZCODE
|
|
|
|
* (ASSUMING NO 2ND EZIP LENGTH BYTE EXISTS HERE)
|
|
|
|
PUTPX3 BTST #PLBIT,(A0)+ * EXAMINE (LOW MODE OR) LOWEST LENGTH BIT
|
|
BNE.S PUTPX4 * ZERO MEANS BYTE VALUE, OTHERWISE WORD VALUE
|
|
|
|
MOVE.B D2,(A0) * STORE THE NEW BYTE
|
|
RTS
|
|
|
|
PUTPX4 MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE NEW WORD
|
|
|
|
* ----------------------
|
|
* OPNEXT
|
|
* ----------------------
|
|
|
|
* NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROP IN OBJ)
|
|
|
|
OPNEXT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
TST.W D1 * WERE WE GIVEN ZERO AS PROP?
|
|
BEQ.S NEXTX4 * YES, JUST RETURN FIRST PROPERTY NUMBER
|
|
BRA.S NEXTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
NEXTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S NEXTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S NEXTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGNXP,A0
|
|
BRA FATAL * 'Non-existant next property'
|
|
|
|
SECTION ZDATA
|
|
MSGNXP DC.B 'Non-existant next property',0
|
|
SECTION ZCODE
|
|
|
|
NEXTX3 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX4 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * EXTRACT PROPERTY NUMBER
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* FLGLOC
|
|
* ----------------------
|
|
|
|
* PRIMITIVE TO LOCATE A FLAG BIT
|
|
* GIVEN A POINTER TO FIRST FLAGS BYTE IN A0, TARGET FLAG NUMBER (0-47) IN D0
|
|
* RETURN POINTER TO TARGET FLAGS BYTE IN A0, TARGET BIT NUMBER (7-0) IN D0
|
|
|
|
FLGLOC MOVE.W D0,-(SP)
|
|
LSR.W #3,D0 * EXTRACT BYTE OFFSET
|
|
ADD.W D0,A0 * ADJUST FLAGS POINTER
|
|
|
|
MOVE.W (SP)+,D0
|
|
NOT.W D0 * FIX THE 3 LOW-ORDER BITS
|
|
ANDI.W #$0007,D0 * MASK OFF THE REST
|
|
RTS
|
|
|
|
* ADDQ.L #1,A0 * POINT TO NEXT FLAGS BYTE
|
|
* SUBQ.W #8,D0 * WAS TARGET FLAG IN PREVIOUS BYTE?
|
|
* BGE.S FLGLOC * NO
|
|
* SUBQ.L #1,A0 * YES, POINT TO PREVIOUS FLAGS BYTE
|
|
* NEG.W D0 * AND COMPUTE THE TARGET BIT NUMBER (7-0)
|
|
* SUBQ.W #1,D0
|
|
* RTS
|
|
|
|
* ----------------------
|
|
* OPQFSE
|
|
* ----------------------
|
|
|
|
* FSET? (IS FLAG SET IN OBJ?)
|
|
|
|
OPQFSE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BTST D0,(A0) * IS THE SPECIFIED BIT SET?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPFSET
|
|
* ----------------------
|
|
|
|
* FSET (SET A FLAG IN OBJ)
|
|
|
|
OPFSET BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BSET D0,(A0) * SET THE SPECIFIED BIT
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPFCLE
|
|
* ----------------------
|
|
|
|
* FCLEAR (CLEAR A FLAG IN OBJ)
|
|
|
|
OPFCLE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BCLR D0,(A0) * CLEAR THE SPECIFIED BIT
|
|
RTS
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* TABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPGET
|
|
* ----------------------
|
|
|
|
* GET (GET THE ITEM'TH WORD FROM TABLE)
|
|
|
|
OPGET ASL.W #1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETWRD * GET THE WORD
|
|
MOVE.W D2,D0
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPGETB
|
|
* ----------------------
|
|
|
|
* GETB (GET THE ITEM'TH BYTE FROM TABLE)
|
|
|
|
OPGETB ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETBYT * GET THE BYTE
|
|
MOVE.W D2,D0
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPUT
|
|
* ----------------------
|
|
|
|
* NOTE: PROPERTY TABLE POINTERS IN THE NEXT FOUR ROUTINES NOW !MAY!
|
|
* EXCEED 32K, SO SIGN-EXTENSIONS MUST BE AVOIDED.
|
|
|
|
* A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER
|
|
|
|
* PUT (REPLACE THE ITEM'TH WORD IN TABLE)
|
|
|
|
OPPUT ASL.W #1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L D0,A0
|
|
ADD.L BUFFER(A6),A0 * ABSOLUTIZE POINTER
|
|
MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE WORD
|
|
|
|
* ----------------------
|
|
* OPPUTB
|
|
* ----------------------
|
|
|
|
* PUTB (REPLACE THE ITEM'TH BYTE IN TABLE)
|
|
|
|
OPPUTB ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.B D2,0(A0,D0.L) * STORE THE BYTE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPGTPT
|
|
* ----------------------
|
|
|
|
* GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN OBJ, PROP)
|
|
|
|
OPGTPT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S GTPTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GTPTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GTPTX2 MOVE.B (A0),D0 * GET (FIRST) PROPERTY ID BYTE
|
|
ANDI.W #PMASK,D0 * CLEAN OFF MODE/LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S GTPTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S GTPTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, RETURN ZERO FOR NO SUCH PROPERTY
|
|
BRA.S GTPTX5
|
|
|
|
IFEQ EZIP
|
|
GTPTX3 MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * IS THERE A SECOND LENGTH BYTE?
|
|
BEQ.S GTPTX4 * NO
|
|
ADDQ.L #1,A0 * YES, SKIP IT TOO
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
GTPTX3 ADDQ.L #1,A0 * POINT TO PROPERTY VALUE
|
|
ENDC
|
|
|
|
GTPTX4 MOVE.L A0,D0
|
|
SUB.L BUFFER(A6),D0 * RE-RELATIVIZE POINTER
|
|
GTPTX5 BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPTSI
|
|
* ----------------------
|
|
|
|
* PTSIZE (GIVEN POINTER TO PROPERTY TABLE, RETURN ITS SIZE)
|
|
|
|
OPPTSI MOVE.L BUFFER(A6),A0
|
|
ANDI.L #$FFFF,D0 * MAKE THE TABLE PTR A LONGWORD
|
|
ADDA.L D0,A0 * ABSOLUTIZE THE TABLE POINTER
|
|
|
|
IFEQ EZIP
|
|
MOVE.B -1(A0),D0 * GET MODE/ID BYTE OR LEN BYTE (EITHER WORKS!)
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.S PTSIX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BNE.S PTSIX2 * YES
|
|
MOVEQ #1,D0 * NO, PROPERTY LENGTH IS 1
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX2 MOVEQ #2,D0
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX4 ANDI.W #PMASK,D0 * LENGTH IS LOW 6 BITS
|
|
BRA PUTVAL * RETURN IT
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B -1(A0),D0 * GET THE PROP IDENTIFIER BYTE
|
|
ASR.W #5,D0 * EXTRACT LENGTH BITS
|
|
ADDQ.W #1,D0 * ADJUST TO ACTUAL LENGTH
|
|
BRA PUTVAL * RETURN IT
|
|
ENDC
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* BLOCK OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPINTBL
|
|
* ----------------------
|
|
|
|
* INTBL? (SEARCH TABLE FOR A VALUE)
|
|
|
|
OPINTBL NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * DEFAULT ARGBLK
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
MOVE.W #128+2,ARG4(A1) * DEFAULT -- WORD SEARCH, RECORD LENGTH = 2
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.L A0,A1
|
|
MOVE.W ARG4(A1),D3
|
|
ANDI.W #127,D3 * RECORD LENGTH
|
|
ANDI.W #128,ARG4(A1) * SEARCH MODE BIT -- WORD 1, BYTE 0
|
|
BRA.S ITBX4 * >>> ZERO CHECK <<<
|
|
|
|
ITBX1 MOVE.W ARG2(A1),D0 * RELATIVE BYTE ADDRESS OF TABLE
|
|
BSR BSPLTB * SPLIT IT [D0,D1]
|
|
TST.W ARG4(A1) * WORD SEARCH?
|
|
BEQ.S ITBX2 * NO, BYTE
|
|
BSR GETWRD
|
|
CMP.W ARG1(A1),D2 * MATCH?
|
|
BEQ.S ITBX5 * YES
|
|
BRA.S ITBX3
|
|
ITBX2 BSR GETBYT
|
|
CMP.B ARG1+1(A1),D2 * MATCH?
|
|
BEQ.S ITBX5 * YES
|
|
|
|
ITBX3 ADD.W D3,ARG2(A1) * NO, SKIP TO NEXT RECORD
|
|
ITBX4 SUBQ.W #1,ARG3(A1) * ANY MORE RECORDS?
|
|
BGE.S ITBX1 * YES, CONTINUE SEARCHING
|
|
|
|
CLR.W D0 * FAILED, RETURN ZERO
|
|
BSR PUTVAL
|
|
BRA PFALSE * PREDICATE FALSE
|
|
|
|
ITBX5 MOVE.W ARG2(A1),D0 * SUCCESS, RETURN THE RELATIVE POINTER
|
|
BSR PUTVAL
|
|
BRA PTRUE * PREDICATE TRUE
|
|
|
|
* ----------------------
|
|
* OPCOPYT
|
|
* ----------------------
|
|
|
|
* COPYT (COPY OR CLEAR A TABLE)
|
|
|
|
OPCOPYT NOP * ASK FOR ARGBLK [JUST TO FREE UP REGS]
|
|
MOVE.L A0,A2
|
|
|
|
MOVE.W ARG1(A2),D0
|
|
CMP.W ARG2(A2),D0
|
|
BEQ CPYTX8 * SAME, EXIT
|
|
|
|
MOVE.W ARG3(A2),D1 * CHECK LENGTH:
|
|
BEQ CPYTX8 * ZERO, EXIT
|
|
BGT.S CPYTX1 * POSITIVE
|
|
NEG.W ARG3(A2) * NEGATIVE, MAKE POSITIVE
|
|
|
|
CPYTX1 TST.W ARG2(A2) * DEST
|
|
BEQ.S CPYTX6 * IF ZERO, SPECIAL CASE
|
|
TST.W D1 * WAS LEN NEG?
|
|
BLT.S CPYTX4 * IF SO, DO /NOT/ CHECK FOR OVERLAP
|
|
|
|
*** MOVE.W ARG1(A2),D0 * SRC
|
|
CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"?
|
|
BHI.S CPYTX4 * NO
|
|
|
|
ADD.W ARG3(A2),D0 * MAYBE, SRC END (+1)
|
|
CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"?
|
|
BLS.S CPYTX4 * NO
|
|
|
|
* "FORWARD OVERLAP" DOES EXIST, DO A REVERSE COPY
|
|
|
|
CPYTX2 MOVE.W ARG2(A2),D0 * DEST
|
|
ADD.W ARG3(A2),D0 * END (+1)
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
MOVE.L A0,A1
|
|
|
|
MOVE.W ARG1(A2),D3 * SRC
|
|
ADD.W ARG3(A2),D3 * END (+1)
|
|
|
|
CPYTX3 SUBQ.W #1,D3 * [PREDECREMENT]
|
|
MOVE.W D3,D0
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA
|
|
MOVE.B D2,-(A1) * [PREDECREMENT]
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX3 * LOOP [UNSIGNED TEST]
|
|
RTS
|
|
|
|
* DO A NORMAL COPY
|
|
|
|
CPYTX4 MOVE.W ARG2(A2),D0 * DEST
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
MOVE.L A0,A1
|
|
|
|
MOVE.W ARG1(A2),D0
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
CPYTX5 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA
|
|
MOVE.B D2,(A1)+
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX5 * LOOP [UNSIGNED TEST]
|
|
RTS
|
|
|
|
* NO DEST, JUST CLEAR THE SOURCE TABLE
|
|
|
|
CPYTX6 MOVE.W ARG1(A2),D0 * SRC
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
CPYTX7 CLR.B (A0)+
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX7 * LOOP [UNSIGNED TEST]
|
|
CPYTX8 RTS
|
|
|
|
* ----------------------
|
|
* OPPRNT
|
|
* ----------------------
|
|
|
|
* PRINTT (DISPLAY A TABLE IN BLOCK FORMAT)
|
|
|
|
OPPRNT NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * DEFAULT ARGBLK
|
|
MOVE.W #3,(A1) * 3 ARGS MAX
|
|
MOVE.W #1,ARG3(A1) * DEFAULT # LINES = 1
|
|
BSR SETDEF * SET UP DEFAULT
|
|
MOVE.L A0,A2
|
|
|
|
TST.W ARG2(A2)
|
|
BLE.S PRNTX3 * BAD COL COUNT, EXIT
|
|
TST.W ARG3(A2)
|
|
BLE.S PRNTX3 * BAD ROW COUNT, EXIT
|
|
|
|
BSR PUTLIN * MAKE SURE BUFFER IS EMPTY
|
|
BSR GETCURS
|
|
MOVE.W D1,A1 * INITIAL CURSOR COLUMN -- SAVE HERE
|
|
|
|
* WE NOW USE VIRTUAL MEMORY CALLS TO FETCH TABLE DATA
|
|
|
|
PRNTX1 MOVE.W ARG2(A2),D3 * COLS PER ROW
|
|
MOVE.W ARG1(A2),D0 * TABLE BASE / START OF CURRENT ROW
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
PRNTX2 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = CHAR
|
|
EXG D0,D2
|
|
BSR PUTCHR * QUEUE/SCRIPT CHAR, ETC
|
|
EXG D0,D2
|
|
|
|
SUBQ.W #1,D3 * ANY MORE COLS IN THIS ROW?
|
|
BGT.S PRNTX2 * YES, LOOP
|
|
|
|
* BEFORE, WE SAVED THE CURRENT FONT AND ENABLED FONT1, TO BE SURE THE CR
|
|
* WAS CORRECTLY INTERPRETED. BUT (IN OTHER CONTEXTS) IT STILL GOT
|
|
* MISINTERPRETED. NOWADAYS, #13 ALWAYS MEANS CR, REGARDLESS OF CONTEXT
|
|
* (SEE CharOut). A BETTER SOLUTION WILL REQUIRE SOME STICKY RETHINKING.
|
|
|
|
SUBQ.W #1,ARG3(A2) * ANY MORE ROWS IN TABLE?
|
|
BEQ.S PRNTX3 * NO, DONE
|
|
BSR PUTNEW * YES, CR, SCROLL IF NEEDED [PUTCHR #13]
|
|
|
|
MOVEQ #-1,D0 * KEEP CURRENT ROW
|
|
MOVE.W A1,D1 * BUT RESET COLUMN TO ORIGINAL VALUE
|
|
BSR SETCURS
|
|
|
|
MOVE.W ARG2(A2),D0
|
|
ADD.W D0,ARG1(A2) * START OF NEXT LINE
|
|
BRA.S PRNTX1 * LOOP
|
|
PRNTX3 RTS
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* VARIABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPVALU
|
|
* ----------------------
|
|
|
|
* VALUE (GET VALUE OF VARIABLE)
|
|
|
|
OPVALU BSR GETVAR * GET THE VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPSET
|
|
* ----------------------
|
|
|
|
* SET (VAR TO VALUE)
|
|
|
|
OPSET BRA PUTVAR * STORE THE VALUE
|
|
|
|
* ----------------------
|
|
* OPPUSH
|
|
* ----------------------
|
|
|
|
* PUSH (A VALUE ONTO THE GAME STACK)
|
|
|
|
OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPPOP
|
|
* ----------------------
|
|
|
|
* POP (A VALUE OFF THE GAME STACK INTO VAR)
|
|
|
|
OPPOP MOVE.W (A4)+,D1 * POP A VALUE
|
|
BRA PUTVAR * AND STORE IT
|
|
|
|
* ----------------------
|
|
* OPINC
|
|
* ----------------------
|
|
|
|
* INC (INCREMENT VAR)
|
|
|
|
OPINC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE THE NEW VALUE
|
|
|
|
* ----------------------
|
|
* OPDEC
|
|
* ----------------------
|
|
|
|
* DEC (DECREMENT VAR)
|
|
|
|
OPDEC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE NEW VALUE
|
|
|
|
* ----------------------
|
|
* OPQIGR
|
|
* ----------------------
|
|
|
|
* IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
|
|
|
|
OPQIGR MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE GREATER THAN VAL?
|
|
BGT.S QIG2 * YES
|
|
QIG1 BSR PUTVAR * NO, STORE THE NEW VALUE
|
|
BRA PFALSE * AND RETURN PREDICATE FALSE
|
|
|
|
QIG2 BSR PUTVAR * STORE THE NEW VALUE
|
|
BRA PTRUE * AND RETURN PREDICATE TRUE
|
|
|
|
* ----------------------
|
|
* OPQDLE
|
|
* ----------------------
|
|
|
|
* DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
|
|
|
|
OPQDLE MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE LESS THAN VAL?
|
|
BLT.S QIG2 * YES
|
|
BRA.S QIG1 * NO
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* READ/INPUT OPERATIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ------------------------------
|
|
* OPREAD
|
|
* ------------------------------
|
|
|
|
* READ (A LINE OF INPUT AND MASTICATE IT)
|
|
|
|
OPREAD NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
CLR.W ARG2(A1) * DEFAULT LEXV -- ZERO MEANS DON'T
|
|
MOVE.W #-1,ARG3(A1) * DEFAULT TIMOUT INTERVAL -- NEG MEANS DON'T
|
|
CLR.W ARG4(A1) * DEFAULT TIMOUT HANDLER FUNCTION
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
ADDQ.L #2,A0 * SKIP COUNT SLOT
|
|
MOVE.W (A0)+,D0 * INBUF
|
|
MOVE.W (A0)+,D3 * [LEXV]
|
|
MOVE.W (A0)+,TWAIT(A6) * [TIME]
|
|
MOVE.W (A0)+,TFUNC(A6) * [HANDLER]
|
|
|
|
BSR RELABS * ABSOLUTIZE THE INBUF PTR
|
|
MOVE.L A0,A2 * KEEP IT HERE
|
|
BSR TRESET * RESET THE TIMER, IF NEEDED
|
|
|
|
IFEQ CZIP
|
|
MOVEM.L D3/A2,-(SP)
|
|
BSR OPUSL * UPDATE STATUS LINE
|
|
MOVEM.L (SP)+,D3/A2
|
|
ENDC
|
|
|
|
CLR.W LINES(A6) * RESET COUNTER (PREVENTS A SPURIOUS [MORE])
|
|
BSR PUTLIN1 * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT)
|
|
|
|
*** GATHER AND LOWER-CASIFY THE INPUT LINE ...
|
|
|
|
MOVE.L A2,A0 * START OF INPUT LINE BUFFER
|
|
MOVEQ #0,D0
|
|
MOVE.B (A0)+,D0 * 1ST HEADER BYTE == MAX LENGTH
|
|
MOVEQ #0,D1
|
|
MOVE.B (A0)+,D1 * 2ND HEADER BYTE == CURRENT LEN
|
|
BSR READLN * GET IT
|
|
|
|
MOVE.W D0,D2 * RETURN D0: TERM CHAR
|
|
MOVE.L A0,D0 * RETURN A0: END OF ACTUAL INPUT (+1)
|
|
MOVE.L A2,A0
|
|
ADDQ.L #2,A0 * START OF INPUT, SKIP HEADER
|
|
|
|
SUB.L A0,D0 * NEW TOTAL LENGTH
|
|
MOVE.B D0,1(A2) * STORE THE NEW LENGTH IN THE HEADER
|
|
BSR LCASE * AND LOWER-CASIFY EVERYTHING
|
|
|
|
*** TOKENIZE AND LOOKUP THE INPUT ...
|
|
|
|
MOVE.W D3,D0 * LEXV ARG
|
|
BEQ.S RDX4 * ZERO MEANS EXIT IMMEDIATELY
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A3
|
|
|
|
MOVE.L VOCTAB(A6),A1 * OPREAD: USE "STANDARD" VOCAB TABLE
|
|
MOVEQ #0,D1 * OPREAD: NO PRESERVE FLAG
|
|
BSR LEX
|
|
|
|
RDX4 MOVE.W D2,D0
|
|
BRA BYTVAL * RETURN THE TERM CHARACTER
|
|
|
|
* ------------------------------
|
|
* OPLEX
|
|
* ------------------------------
|
|
|
|
* TOKENIZE AND LOOKUP A LINE OF INPUT
|
|
* (FIND EACH WORD, CONVERT IT TO ZWORD, AND STORE OFFSET INFO IN LEXV)
|
|
|
|
OPLEX NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
CLR.W ARG3(A1) * DEFAULT VOC TABLE (FLAG)
|
|
CLR.W ARG4(A1) * DEFAULT PRESERVE FLAG = OFF
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.L A0,A1 * ARGBLK
|
|
TST.W (A1)+ * SKIP ACTUAL ARG COUNT (NOT NEEDED)
|
|
MOVE.W (A1)+,D0 * ARG1 == INBUF
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A2 * AND PASS IT HERE
|
|
MOVE.W (A1)+,D0 * ARG2 == LEXV
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A3 * AND PASS IT HERE
|
|
|
|
MOVE.L VOCTAB(A6),A0 * "STANDARD" VOCTAB
|
|
MOVE.W (A1)+,D0 * USE A SPECIAL VOCTAB?
|
|
BEQ.S LXX0 * NO
|
|
BSR RELABS * YES, ABSOLUTIZE
|
|
LXX0 EXG A0,A1 * PASS VOCTAB IN A1
|
|
MOVE.W (A0)+,D1 * AND PASS "PRESERVE" FLAG HERE
|
|
|
|
* INTERNAL ENTRY POINT
|
|
* GIVEN A1 -> VOCAB TABLE, A2 -> INBUF, A3 -> LEXV, D1 = PRESERVE FLAG
|
|
|
|
LEX MOVE.L D2,-(SP)
|
|
MOVE.L A1,A0
|
|
BSR INITLX * SETUP VOCAB VARS (FOR LOOKUP)
|
|
|
|
MOVE.L A2,RDBOS(A6) * REMEMBER INPUT BUFFER BASE
|
|
MOVEQ #0,D0
|
|
MOVE.B 1(A2),D0 * >> ACTUAL LEN OF INPUT <<
|
|
ADDQ.L #2,A2 * SKIP HEADER (MAX LEN, CUR LEN)
|
|
ADD.L A2,D0
|
|
MOVE.L D0,RDEOS(A6) * REMEMBER END OF INPUT
|
|
|
|
MOVE.L A3,RDRET(A6) * REMEMBER RETURN BUFFER BASE
|
|
CLR.B 1(A3) * BUFFER INITIALLY EMPTY
|
|
ADDQ.L #2,A3 * SKIP HEADER (MAX WORDS, NWORDS)
|
|
|
|
* LOOP STARTS HERE, A2 -> CURRENT INBUF, A3 -> CURRENT LEXV
|
|
|
|
LXX2 MOVE.L A2,A0 * CURRENT INPUT START
|
|
MOVE.L RDEOS(A6),D0
|
|
SUB.L A2,D0 * CURRENT REMAINING LENGTH
|
|
BEQ.S LXX8 * NOTHING, EXIT
|
|
BSR ZWSTR * FIND NEXT WORD, AND CONVERT IT
|
|
|
|
MOVE.L A0,A2 * RETURN: START OF CURRENT WORD
|
|
MOVE.W D0,D2 * RETURN: LENGTH OF CURRENT WORD, OR ZERO
|
|
BEQ.S LXX8 * NOTHING, EXIT
|
|
|
|
*** BUILD THE LEX (RETURN) TABLE ...
|
|
|
|
MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER
|
|
MOVE.B (A0)+,D0 * MAX WORDS ALLOWED
|
|
CMP.B (A0),D0 * ROOM FOR ANOTHER?
|
|
BEQ.S LXX6 * NO, ERROR
|
|
ADDQ.B #1,(A0) * INCREMENT FOUND-WORD COUNT
|
|
|
|
LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE
|
|
BSR LOOKUP * SEARCH VOCAB TABLE FOR IT, RETURN OFFSET
|
|
TST.W D0 * WORD FOUND?
|
|
BNE.S LXX3 * YES
|
|
TST.W D1 * NO, PRESERVE OLD INFO? >> OFFSET ONLY <<
|
|
BNE.S LXX4 * YES
|
|
|
|
LXX3 MOVE.L A3,A0 * CURRENT RETURN SLOT
|
|
BSR PTAWRD * STORE THE OFFSET IN RETURN TABLE
|
|
|
|
LXX4 MOVE.B D2,2(A3) * STORE WORD LENGTH IN RETURN TABLE
|
|
MOVE.L A2,D0
|
|
SUB.L RDBOS(A6),D0 * CALCULATE STARTING BYTE OFFSET OF WORD
|
|
MOVE.B D0,3(A3) * STORE IT TOO
|
|
|
|
ADDQ.L #4,A3 * ADVANCE RETURN TABLE PTR
|
|
ADDA.W D2,A2 * ADVANCE INPUT PTR
|
|
BRA LXX2 * GO FOR THE NEXT WORD
|
|
|
|
*** ERROR, RETURN BUFFER IS FULL, TELL USER, THEN EXIT
|
|
|
|
LXX6 MOVE.L A2,A0 * START OF FLUSHED STRING
|
|
MOVE.L RDEOS(A6),A1 * END (+1)
|
|
BSR RDERR * ECHO IT IN ERROR MESSAGE
|
|
|
|
LXX8 MOVE.L (SP)+,D2 * CLEAN UP AND EXIT
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* OPZWSTR
|
|
* ------------------------------
|
|
|
|
* IDENTIFY THE NEXT WORD (START/END), AND CONVERT IT TO A ZWORD
|
|
|
|
OPZWSTR
|
|
ADD.W D2,D0 * INPUT BUFFER: BASE + OFFSET
|
|
BSR RELABS * ABSOLUTIZE IT
|
|
MOVEQ #VCHARS,D0 * MAX LEN -- IGNORE 2ND ARG (SPEC ERROR)
|
|
BSR ZWSTR * GO FOR IT
|
|
|
|
* (IGNORE RETURNED INFO; WE'RE INTERESTED IN INITIAL WORD ONLY)
|
|
|
|
MOVE.W D3,D0 * REQUESTED ZWORD BUFFER
|
|
BSR RELABS * ABSOLUTIZE IT
|
|
MOVE.L A0,A1
|
|
LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE
|
|
MOVEQ #ZCHARS,D0
|
|
BRA COPYB * COPY ZWORD TO FINAL DEST, AND EXIT
|
|
|
|
* INTERNAL ENTRY POINT
|
|
* GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH (TOTAL)
|
|
* RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO
|
|
|
|
ZWSTR BSR FINDBK * FIND NEXT BREAK CHAR
|
|
TST.W D0
|
|
BEQ.S ZWSX1 * EXIT IF NOTHING
|
|
|
|
MOVEM.L D0-D1/A0-A1,-(SP) * SAVE RESULTS
|
|
LEA RDWSTR(A6),A1 * TEMP STRING BUFFER
|
|
MOVEQ #VCHARS,D1 * MAX LENGTH
|
|
BSR COPYS * COPY FIRST WORD, MAKE ASCIZ
|
|
|
|
LEA RDWSTR(A6),A1
|
|
LEA RDZSTR(A6),A0 * TEMP OUTPUT BUFFER
|
|
BSR ZWORD * CONVERT STRING, LEAVE ZWORD IN BUFFER
|
|
MOVEM.L (SP)+,D0-D1/A0-A1 * RESTORE RESULTS
|
|
ZWSX1 RTS
|
|
|
|
* ------------------------------
|
|
* OPINPUT
|
|
* ------------------------------
|
|
|
|
* WAIT FOR A KEY (NO ECHO), HANDLE OPTIONAL TIMEOUTS
|
|
|
|
OPINPUT NOP * USE ARGBLK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #3,(A1) * 3 ARGS MAX
|
|
MOVE.W #-1,ARG2(A1) * DEFAULT TIMOUT INTERVAL -- "DON'T"
|
|
CLR.W ARG3(A1) * DEFAULT TIMOUT HANDLER FUNCTION
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
ADDQ.L #ARG2,A0 * SKIP COUNT AND DEVICE
|
|
MOVE.W (A0)+,TWAIT(A6) * DELAY IN 1/10'S SECOND
|
|
MOVE.W (A0)+,TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT
|
|
BSR TRESET * RESET THE TIMER, IF NEEDED
|
|
|
|
CLR.W LINES(A6) * RESET COUNTER, PREVENTS A SPURIOUS [MORE]
|
|
TST.W VOBUFF(A6) * BUFFERED OUTPUT?
|
|
BEQ.S INPX1 * NO
|
|
BSR PUTLIN * YES, EMPTY THE BUFFER
|
|
|
|
INPX1 MOVEQ #0,D0 * SINGLE CHAR [SUPPRESS MENU CMD-STRINGS]
|
|
BSR INPUT * GET KEY
|
|
CMPI.B #1,D0 * CONTINUE AFTER TIMEOUT?
|
|
BEQ.S INPX1 * YES
|
|
BRA BYTVAL * OTHERWISE, RETURN KEY
|
|
|
|
* INTERNAL ENTRY POINT >> CALLED ALSO FROM READLN; HANDLES TIMEOUTS <<
|
|
* GIVEN D0.W = LINE-INPUT FLAG (ZERO IF SINGLE-CHAR INPUT)
|
|
* WAIT FOR A KEY, RETURN D0.B = VALUE
|
|
* IN CASE OF A TIMEOUT, RETURN D0.B = 0 (ABORT) OR 1 (KEEP WAITING)
|
|
* IF WAITING, RETURN D0 (HI WORD) = NONZERO TO REDRAW INPUT LINE
|
|
|
|
INPUT MOVEM.L D1-D2,-(SP)
|
|
MOVE.W D0,D2 * SAVE FLAG HERE
|
|
MOVEQ #1,D0 * START OF INPUT
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
|
|
INPX4 BSR GAMINT1 * CHECK FOR GAME INTERRUPT (SOUND, ETC)
|
|
|
|
BSR ITTYIN * CHECK FOR A KEY << DON'T WAIT! >>
|
|
TST.B D0 * GOT ONE?
|
|
BEQ.S INPX6 * NOTHING YET
|
|
|
|
MOVE.W D0,-(SP)
|
|
CLR.W D0 * END OF INPUT
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
MOVE.W (SP)+,D0
|
|
BRA.S INPX8 * EXIT WITH KEY
|
|
|
|
INPX6 TST.W TWAIT(A6) * TIMOUTS IN EFFECT?
|
|
BLT.S INPX4 * NO, JUST LOOP
|
|
BSR TCHECK * TIME (10'S) REMAINING BEFORE NEXT TIMEOUT
|
|
TST.W D0 * HAS IT RUN OUT?
|
|
BGT.S INPX4 * NO, CONTINUE LOOP
|
|
|
|
BSR TNEXT * YES: UPDATE TIMER
|
|
CLR.W D0 * END OF INPUT (FOR THE MOMENT...)
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
|
|
BSR GETCURS
|
|
MOVE.W D1,D2 * REMEMBER CURRENT CURSOR POS (COLUMN)
|
|
|
|
MOVE.W TFUNC(A6),D0 * TIMEOUT FUNCTION
|
|
BSR INCALL * CALL IT (INTERNALLY)
|
|
TST.W D0 * IT RETURNS A BOOLEAN -- ABORT INPUT?
|
|
BNE.S INPX7 * YES
|
|
|
|
BSR PUTLIN * [XZIPTEST:] DUMP ANY NEW OUTPUT
|
|
BSR GETCURS
|
|
SUB.W D2,D1 * DID CURSOR POS (COLUMN) CHANGE?
|
|
MOVE.W D1,D0 * ZERO IF NO
|
|
SWAP D0 * RETURN THIS FLAG IN HIGH WORD
|
|
MOVE.W #1,D0 * 1 MEANS KEEP WAITING
|
|
BRA.S INPX8
|
|
|
|
INPX7 MOVEQ #0,D0 * NULL CHAR MEANS ABORT INPUT
|
|
INPX8 MOVEM.L (SP)+,D1-D2
|
|
RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* READ/INPUT PRIMITIVES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ------------------------------
|
|
* READLN
|
|
* ------------------------------
|
|
|
|
* GATHER A LINE OF INPUT
|
|
* GIVEN A0 -> INPUT BUFFER, D0 = MAX LENGTH, D1 = CURRENT LENGTH
|
|
* RETURN A0 -> END OF ACTUAL INPUT (+1), D0 = TERM CHAR
|
|
|
|
EOLCHR EQU $0D * CARRIAGE RETURN
|
|
DELCH1 EQU $08 * BACKSPACE
|
|
DELCH2 EQU $7F * ALSO ACCEPT "DELETE"
|
|
|
|
READLN MOVEM.L D1-D4/A1-A3,-(SP)
|
|
MOVE.L A0,A1 * A1 -> START
|
|
MOVE.L A0,A2
|
|
ADDA.W D1,A2 * A2 -> CURRENT POSITION (MAY BE FULL)
|
|
MOVE.L A0,A3
|
|
ADDA.W D0,A3 * A3 -> END (+1)
|
|
|
|
BSR GETCURS
|
|
MOVE.W D1,D3 * REMEMBER "REAL" START POS (COLUMN)
|
|
BSR MAXSCRN
|
|
MOVE.W D1,D4 * AND MAX LINE LEN
|
|
|
|
RDLX1 MOVE.L BUFFER(A6),A0
|
|
MOVE.W PTCHARS(A0),D0 * TABLE OF TERMINATING CHARS
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,D2 * KEEP PTR HERE
|
|
|
|
*** WAIT FOR A KEY, CHECK FOR A TCHAR ...
|
|
|
|
RDLX2 MOVEQ #1,D0 * LINE INPUT [ALLOW MENU CMD-STRINGS]
|
|
BSR INPUT * NO ECHO, HANDLE TIMEOUTS
|
|
*** BSR TTYIN
|
|
TST.B D0 * WAS THERE A TIME-OUT AND AN ABORT?
|
|
BEQ.S RDLX10 * YES, BREAK
|
|
CMPI.B #1,D0 * WAS THERE A TIME-OUT WITHOUT AN ABORT?
|
|
BEQ.S RDLX9A * YES, DO INPUT-ECHO HACK
|
|
CMPI.B #EOLCHR,D0 * CR?
|
|
BEQ.S RDLX10 * YES, BREAK
|
|
|
|
MOVE.L D2,A0 * TCHARS TABLE
|
|
MOVEQ #0,D1 * FLAG FOR "FUNCTION-KEY TCHARS"
|
|
RDLX4 CMPI.B #255,(A0) * CONSIDER ALL FKEYS TO BE TCHARS?
|
|
BNE.S RDLX5 * NO
|
|
MOVEQ #1,D1 * YES, SET FLAG
|
|
RDLX5 CMP.B (A0),D0 * CHECK TABLE FOR THIS CHAR
|
|
BEQ.S RDLX10 * >> FOUND IT, BREAK <<
|
|
TST.B (A0)+ * END OF TABLE?
|
|
BNE RDLX4 * NO, CONTINUE SEARCH
|
|
|
|
* LAST CHANCE TO BE A TCHAR ...
|
|
|
|
CMPI.B #127,D0 * SPECIAL CASE: IS THIS CHAR AN FKEY?
|
|
BLS.S RDLX6 * NO
|
|
|
|
TST.W D1 * YES: "FUNCTION-KEY TCHARS" ACTIVE?
|
|
BNE.S RDLX10 * YES, BREAK
|
|
BRA.S RDLX9 * RDLX2 * NO >> REJECT KEY <<
|
|
|
|
* NOT A TCHAR, CHECK FOR A BACKSPACE ...
|
|
|
|
RDLX6 CMPI.B #DELCH1,D0 * BACKSPACE?
|
|
BEQ.S RDLX8 * YES
|
|
CMPI.B #DELCH2,D0 * DELETE?
|
|
BEQ.S RDLX8 * YES
|
|
|
|
*** NORMAL CHARACTER, HANDLE IT ...
|
|
|
|
CMPA.L A3,A2 * BUFFER OVERFLOW?
|
|
BCC.S RDLX9 * BHS * YES, IGNORE CHAR, JUST BEEP
|
|
|
|
MOVE.B D0,(A2)+ * STORE CHAR
|
|
BSR TTYOUT * AND ECHO IT
|
|
BRA.S RDLX2
|
|
|
|
* HANDLE A BACKSPACE
|
|
|
|
RDLX8 CMPA.L A1,A2 * BUFFER UNDERFLOW?
|
|
BLS.S RDLX9 * YES, JUST BEEP
|
|
SUBQ.L #1,A2 * NO, BACK UP BUFFER POINTER
|
|
MOVEQ #DELCH1,D0
|
|
BSR TTYOUT * AND ECHO A BS
|
|
BRA RDLX2
|
|
|
|
* ERROR, BEEP -- BUFFER TOO FULL/EMPTY. DISCARD CHAR, NO ECHO.
|
|
|
|
RDLX9 MOVEQ #1,D0
|
|
BSR DOSOUND * BEEP AT USER
|
|
BRA RDLX2 * AND KEEP WAITING
|
|
|
|
* TIMEOUT OCCURRED (NO ABORT)
|
|
* RE-ECHO ENTIRE INPUT LINE, BUT ONLY IF GAME WROTE AFTER THE OLD ONE
|
|
* WE ASSUME GAME PRINTED A FRESH CR, AND A PROMPT (>) IF NEEDED
|
|
|
|
RDLX9A SWAP D0 * "REDRAW" FLAG IS IN HIGH HALF OF REGISTER
|
|
TST.W D0 * DID CURSOR POSITION CHANGE DURING TIMEOUT?
|
|
BEQ RDLX2 * NO, DON'T REDRAW
|
|
|
|
MOVE.L A1,-(SP) * SAVE START PTR
|
|
BRA.S RDLX9C
|
|
RDLX9B MOVE.B (A1)+,D0
|
|
BSR TTYOUT * ECHO ONE-AT-A-TIME, SO WILL WRAP IF NEEDED
|
|
RDLX9C CMPA.L A2,A1 * ANY MORE?
|
|
BLT.S RDLX9B * YES
|
|
MOVE.L (SP)+,A1
|
|
BRA RDLX2 * START WAITING AGAIN
|
|
|
|
*** DONE, HANDLE THE TERMINATING CHAR <<< DON'T STORE IN BUFFER >>>
|
|
|
|
RDLX10 MOVE.W D0,D2 * SAVE TCHAR
|
|
CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN?
|
|
BNE.S RDLX12 * NO >>> SKIP THE ECHO? <<<
|
|
BSR TTYOUT * YES, ECHO IT
|
|
|
|
RDLX12 CMPA.L A3,A2 * ANY ROOM LEFT?
|
|
BCC.S RDLX14 * BHS * NO (SIGH)
|
|
CLR.B (A2) * INPUT SHOULD BE FOLLOWED BY A BREAK (ZWSTR)
|
|
|
|
RDLX14 BSR GETSCRN * ARE WE IN WINDOW 1?
|
|
BNE.S RDLX20 * YES, IGNORE [MORE] COUNTER
|
|
|
|
* ADJUST THE [MORE] COUNTER
|
|
|
|
MOVE.L A2,D0
|
|
SUB.L A1,D0 * LENGTH OF INPUT
|
|
ADD.W D3,D0 * TAKING INTO ACCOUNT INITIAL COLUMN
|
|
|
|
CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN?
|
|
BNE.S RDLX18 * NO
|
|
RDLX16 ADDQ.W #1,LINES(A6) * ADJUST THE [MORE] COUNTER
|
|
RDLX18 SUB.W D4,D0 * SCREEN WIDTH (40-80)
|
|
BGE.S RDLX16 * ONCE FOR EACH ADDITIONAL SCREEN LINE
|
|
|
|
* SCRIPT THE USER INPUT LINE (IF SCRIPTING IS ACTIVE)
|
|
* AVOID PROBLEMS WITH BACKSPACES, BY WAITING UNTIL INPUT IS COMPLETE
|
|
|
|
RDLX20
|
|
* MOVEQ #0,D1
|
|
CMPI.B #EOLCHR,D2 * BUT WAS THE CHAR A RETURN?
|
|
BNE.S RDLX22 * NO, AVOID SCRIPTING [XZIP]
|
|
MOVEQ #1,D1 * YES, (AND ADD A CR)
|
|
|
|
MOVE.L A1,A0 * START OF LINE
|
|
MOVE.L A2,D0
|
|
SUB.L A1,D0 * LENGTH
|
|
BSR SCRINP
|
|
|
|
RDLX22 MOVE.W D2,D0 * RETURN TERM CHAR
|
|
MOVE.L A2,A0 * RETURN END-OF-INPUT (+1) POINTER
|
|
MOVEM.L (SP)+,D1-D4/A1-A3
|
|
RTS
|
|
|
|
* ---------------------------
|
|
* LCASE
|
|
* ---------------------------
|
|
|
|
* LOWER-CASIFY A LINE OF INPUT, A0 -> INPUT, D0.W = LEN
|
|
|
|
LCASE BRA.S LCSX3
|
|
LCSX1 CMPI.B #'A',(A0) * UPPERCASE CHAR?
|
|
BLT.S LCSX2 * NO
|
|
CMPI.B #'Z',(A0) * MAYBE?
|
|
BGT.S LCSX2 * NO
|
|
ADDI.B #32,(A0) * YES, LOWER-CASIFY IT
|
|
LCSX2 ADDQ.L #1,A0
|
|
LCSX3 DBF D0,LCSX1 * ZERO CHECK << ENTRY POINT >>
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* FINDBK
|
|
* ------------------------------
|
|
|
|
* FIND THE NEXT BREAK CHARACTER
|
|
* GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH
|
|
* RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO
|
|
|
|
FINDBK MOVEM.L D1/A1-A3,-(SP)
|
|
MOVE.L A0,A2
|
|
ADDA.W D0,A2 * END OF INPUT (+1)
|
|
CLR.W D1 * COUNT OF SIGNIFICANT CHARS
|
|
|
|
FBX1 MOVE.L A0,A1 * REMEMBER START OF CURRENT WORD
|
|
FBX2 CMPA.L A0,A2 * END OF INPUT STRING?
|
|
BEQ.S FBX8 * YES
|
|
MOVE.B (A0)+,D0 * NO, PICK UP NEXT CHAR
|
|
|
|
MOVE.L RBRKS(A6),A3 * LIST OF READ-BREAK CHARACTERS
|
|
CMPI.B #127,D0 * BUT IS THIS A FUNCTION KEY?
|
|
BHI.S FBX6 * YES, CONSIDER IT A S.I. BREAK (?)
|
|
FBX4 CMP.B (A3),D0 * SEARCH LIST FOR CHAR << XZIP: "NULL" TOO >>
|
|
BEQ.S FBX6 * FOUND IT
|
|
TST.B (A3)+ * END OF (ASCIZ) LIST?
|
|
BNE FBX4 * NO, CONTINUE SEARCH
|
|
ADDQ.W #1,D1 * YES, NOT A BREAK, BUMP COUNT
|
|
BRA FBX2
|
|
|
|
*** BREAK CHAR FOUND ...
|
|
|
|
FBX6 TST.W D1 * WORD READ /BEFORE/ THIS BREAK?
|
|
BNE.S FBX8 * YES, GO FOR IT
|
|
CMPA.L ESIBKS(A6),A3 * NO, BUT WAS THIS A SELF-INSERTING BREAK?
|
|
BCC.S FBX1 * BHS * NO, JUST SKIP IT, LOOP FOR NEXT
|
|
ADDQ.W #1,D1 * YES, BUMP COUNT AND GO FOR ZWORD
|
|
|
|
*** CLEAN UP AND EXIT ...
|
|
|
|
FBX8 MOVE.L A1,A0 * RETURN START OF CURRENT WORD
|
|
MOVE.W D1,D0 * RETURN LENGTH OF CURRENT WORD
|
|
MOVEM.L (SP)+,D1/A1-A3
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* RDERR
|
|
* ------------------------------
|
|
|
|
* TOO MANY WORDS FOUND IN THE INPUT BUFFER, INFORM LOSER
|
|
* A0 -> START OF EXCESS INPUT, A1 -> END OF INPUT (+1)
|
|
|
|
RDERR MOVE.L A0,-(SP) * SAVE ARG HERE
|
|
BSR PUTNEW
|
|
LEA MSGIO1,A0
|
|
BSR OUTMSG0 * '[Too many words ... "'
|
|
SECTION ZDATA
|
|
MSGIO1 DC.B '[Too many words typed, discarding ',$22,0
|
|
SECTION ZCODE
|
|
|
|
MOVE.L (SP)+,A0 * START OF FLUSHED WORD/STRING
|
|
MOVE.B (A1),-(SP) * SAVE TERMINAL BYTE, TO BE SAFE
|
|
CLR.B (A1) * MAKE STRING ASCIZ
|
|
BSR OUTMSG0 * ECHO IT
|
|
MOVE.B (SP)+,(A1) * RESTORE THIS BYTE
|
|
|
|
LEA MSGIO2,A0
|
|
BSR OUTMSG * '."]'
|
|
SECTION ZDATA
|
|
MSGIO2 DC.B '.',$22,']',0
|
|
SECTION ZCODE
|
|
|
|
BSR PUTNEW * FINAL CR
|
|
RTS
|
|
|
|
* ---------------------------
|
|
* INITLX
|
|
* ---------------------------
|
|
|
|
* INIT VOCABULARY VARS, GIVEN A VOCAB TABLE POINTER IN A0
|
|
* (CALLED AT BEGINNING OF EACH "LEX" CALL)
|
|
|
|
INITLX MOVEM.L D1-D2/A1-A2,-(SP)
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * THIS BYTE IS THE # OF SI BREAKS
|
|
ADDA.W D0,A0 * SKIP THEM (READ DURING STARTUP ONLY)
|
|
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * THIS BYTE IS THE LENGTH OF EACH VOCTAB ENTRY
|
|
MOVE.W D0,VWLEN(A6) * SAVE IT
|
|
|
|
MOVE.B (A0)+,D0 * THIS WORD IS # OF VOCTAB ENTRIES
|
|
ASL.W #8,D0
|
|
MOVE.B (A0)+,D0
|
|
MOVE.L A0,VOCBEG(A6) * THIS IS BEGINNING OF ACTUAL VOCABULARY
|
|
|
|
TST.W D0 * IF POSITIVE #, TABLE IS SORTED
|
|
BGT.S INLX4
|
|
NEG.W D0 * OTHERWISE, NOT SORTED, POSITIVIZE COUNT
|
|
CLR.W D1 * AND INDICATE UNSORTED TABLE
|
|
BRA.S INLX6
|
|
|
|
* SORTED TABLE -- CALCULATE INITIAL OFFSET FOR BINARY SEARCH
|
|
|
|
INLX4 MOVE.W D0,D2
|
|
MOVE.W VWLEN(A6),D1 * NUMBER OF BYTES PER VOCAB ENTRY
|
|
ASR.W #1,D2
|
|
INLX5 ASL.W #1,D1
|
|
ASR.W #1,D2
|
|
BNE INLX5
|
|
MOVE.W D1,VWBOFF(A6) * SAVE INITIAL BINARY SEARCH OFFSET
|
|
|
|
MOVEQ #1,D1 * INDICATE A SORTED TABLE
|
|
INLX6 MOVE.W D0,VWORDS(A6) * SAVE COUNT
|
|
MOVE.W D1,VWSORT(A6) * SAVE FLAG
|
|
|
|
SUBQ.W #1,D0
|
|
MULS VWLEN(A6),D0
|
|
ADD.L VOCBEG(A6),D0 * CALCULATE POINTER TO LAST ENTRY
|
|
MOVE.L D0,VOCEND(A6) * SAVE IT
|
|
|
|
MOVEM.L (SP)+,D1-D2/A1-A2
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* LOOKUP
|
|
* ------------------------------
|
|
|
|
* SEARCH (CURRENT) VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0
|
|
* RETURN ZWORD'S TABLE ADDR (RELATIVIZED) IN D0.W, NULL IF NOT FOUND
|
|
|
|
LOOKUP MOVEM.L D1/A1-A3,-(SP)
|
|
MOVE.L A0,A3 * SAVE POINTER TO GIVEN ZWORD HERE
|
|
MOVE.L VOCBEG(A6),A2 * BEGINNING OF (CURRENT) VOCABULARY TABLE
|
|
|
|
TST.W VWORDS(A6) * EMPTY TABLE?
|
|
BEQ.S LKX14 * YES, RETURN ZERO
|
|
TST.W VWSORT(A6) * SORTED TABLE?
|
|
BNE.S LKX2 * YES
|
|
|
|
LKX1 MOVE.L A2,A0 * NO, MUST DO LINEAR SEARCH
|
|
MOVE.L A3,A1
|
|
BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD
|
|
BEQ.S LKX12 * SAME, WE'VE FOUND IT
|
|
|
|
ADDA.W VWLEN(A6),A2 * NEXT TABLE ITEM
|
|
CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE?
|
|
BLS LKX1 * NO
|
|
BRA.S LKX14 * YES, WORD NOT FOUND, RETURN ZERO
|
|
|
|
*** SORTED TABLE
|
|
|
|
LKX2 MOVE.W VWBOFF(A6),D1 * INITIAL OFFSET FOR BINARY SEARCH
|
|
ADDA.W D1,A2 * INITIAL POINTER INTO TABLE
|
|
SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG, EXACT-POWER-OF-2 TABLE
|
|
|
|
LKX4 ASR.W #1,D1 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
|
|
MOVE.L A2,A0
|
|
MOVE.L A3,A1
|
|
BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD
|
|
BHI.S LKX8 * GREATER, MOVE DOWN
|
|
BEQ.S LKX12 * SAME, WE'VE FOUND IT
|
|
*** BCS.S LKX6 * (BLO) * LESS, MOVE UP
|
|
|
|
LKX6 ADDA.W D1,A2 * TO MOVE UP, ADD OFFSET
|
|
CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE?
|
|
BLS.S LKX10 * NO
|
|
MOVE.L VOCEND(A6),A2 * YES, POINT TO END OF TABLE
|
|
BRA.S LKX10
|
|
LKX8 SUBA.W D1,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET
|
|
|
|
LKX10 CMP.W VWLEN(A6),D1 * IS OFFSET RESOLUTION AT LEAST ONE WORD?
|
|
BGE LKX4 * YES, CONTINUE LOOP
|
|
BRA.S LKX14 * NO, WORD NOT FOUND
|
|
|
|
*** DONE, WINNING VOCAB POINTER LEFT IN A2
|
|
|
|
LKX12 MOVE.L A2,D0
|
|
SUB.L BUFFER(A6),D0 * RELATIVIZE THE ZWORD'S VOCAB TABLE OFFSET
|
|
BRA.S LKX16
|
|
|
|
LKX14 MOVEQ #0,D0 * WORD NOT FOUND, RETURN ZERO
|
|
LKX16 MOVEM.L (SP)+,D1/A1-A3
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* VCOMP
|
|
* ------------------------------
|
|
|
|
* COMPARE GIVEN ZWORD (A1) TO CURRENT TABLE ZWORD (A0)
|
|
* RETURN WITH FLAGS
|
|
|
|
VCOMP MOVEQ #ZCHARS-1,D0 * CHECK THREE WORDS
|
|
VCPX1 CMPM.B (A1)+,(A0)+
|
|
DBNE D0,VCPX1 * TAKE BRANCH IF EQUAL
|
|
RTS
|
|
|
|
* UNROLL THE LOOP (RUNS A BIT FASTER)
|
|
|
|
** CMPM.B (A1)+,(A0)+ * CHECK FIRST WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
|
|
** CMPM.B (A1)+,(A0)+ * CHECK SECOND WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
|
|
** IFEQ EZIP
|
|
** CMPM.B (A1)+,(A0)+ * CHECK THIRD WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
** ENDC
|
|
|
|
* VCPX2 RTS * OTHERWISE SAME, EXIT
|
|
|
|
|
|
* ------------------------------
|
|
* TIMEOUT PRIMITIVES
|
|
* ------------------------------
|
|
|
|
* NOTE: FOR THE AMIGA, INSTEAD OF A SIMPLE "BUSY LOOP," THIS TIMEOUT
|
|
* IMPLEMENTATION EXPECTS THE KEY-CHECKING ROUTINE TO SLEEP WHEN NOTHING
|
|
* IS HAPPENING, WAKING ONLY EVERY 1/10 SEC TO RETURN A NULL EVENT.
|
|
|
|
* ----------------------
|
|
* TRESET, TNEXT
|
|
* ----------------------
|
|
|
|
* RESET THE TIMEOUT COUNTDOWN VARS
|
|
|
|
TRESET TST.W TWAIT(A6) * BUT ARE TIMOUTS IN EFFECT?
|
|
BLT.S TNEX1 * NO, EXIT
|
|
|
|
*** BSR TIME60
|
|
*** MOVE.L D0,TCLOCK(A6) * INITIAL REFERENCE TIME (IN 60THS)
|
|
|
|
TNEXT MOVE.W TWAIT(A6),TCOUNT(A6) * TOTAL DELAY (IN 10THS)
|
|
TNEX1 RTS
|
|
|
|
* ----------------------
|
|
* TCHECK
|
|
* ----------------------
|
|
|
|
* UPDATE THE TIMEOUT COUNTER [AMIGA: BUT IGNORE CLOCK]
|
|
* RETURN TIME REMAINING (ZERO IF NONE) & FLAGS
|
|
|
|
* THE TIMEOUT COUNTDOWN MECHANISM IS CHANGED A BIT; IT NOW FUNCTIONS ONLY
|
|
* WHEN THE BUSY LOOP IS RUNNING. IT'S SUSPENDED IF THE LOOP STOPS FOR
|
|
* MORE THAT 1/10 SEC (E.G. WHEN A DESK ACCESSORY IS UP, OR A MENU IS PULLED
|
|
* DOWN. OTHERWISE, A TIMEOUT COULD OCCUR IN THE BACKGROUND, AND A NOXIOUS
|
|
* EVENT COULD SPILL OUT THE MOMENT THE GAME IS SWITCHED BACK IN.)
|
|
|
|
TCHECK
|
|
*** BSR TIME60 * CURRENT TIME (IN 60THS)
|
|
*** SUB.L TCLOCK(A6),D0 * ELAPSED TIME, SINCE LAST CHECK
|
|
*** CMPI.L #12,D0
|
|
*** BGE.S TCHX2 * ET >= 2/10, RESET CLOCK, DON'T TOUCH COUNTER
|
|
*** SUBQ.L #6,D0
|
|
*** BLT.S TCHX3 * ET < 1/10, DO NOTHING
|
|
|
|
SUBQ.W #1,TCOUNT(A6) * 1/10 <= ET < 2/10, UPDATE CLOCK & COUNTER
|
|
*** MOVEQ #6,D0
|
|
*** TCHX2 ADD.L D0,TCLOCK(A6)
|
|
|
|
TCHX3 MOVE.W TCOUNT(A6),D0 * RETURN COUNTER/FLAGS
|
|
RTS
|
|
|
|
|
|
PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* I/O OPERATIONS -- OUTPUT
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPUSL
|
|
* ----------------------
|
|
|
|
* OPUSL (UPDATE STATUS LINE)
|
|
|
|
IFEQ EZIP
|
|
OPUSL BRA OPERR * DEAD INSTRUCTION
|
|
ENDC
|
|
|
|
* ----------------------
|
|
* OPPRNC
|
|
* ----------------------
|
|
|
|
* PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
|
|
|
|
OPPRNC BRA PUTCHR * HANDLE IT
|
|
|
|
* ----------------------
|
|
* OPPRNN
|
|
* ----------------------
|
|
|
|
* PRINTN (PRINT A NUMBER, USING CURRENT CHARACTER OUTPUT FUNCTION)
|
|
|
|
OPPRNN MOVE.W D0,D1 * NON-ZERO NUMBER?
|
|
BNE.S PRNNX1 * YES
|
|
MOVE.B #'0',D0 * ZERO, SPECIAL CASE
|
|
BRA PUTCHR * PRINT A ZERO
|
|
|
|
PRNNX1 BGT.S PRNNX2 * POSITIVE?
|
|
MOVE.B #'-',D0 * NO, PRINT A MINUS SIGN
|
|
BSR PUTCHR
|
|
NEG.W D1 * AND MAKE NUMBER POSITIVE
|
|
|
|
PRNNX2 CLR.W D2 * COUNT OF DIGITS ON STACK
|
|
BRA.S PRNNX4 * START WITH GREATER-THAN-10 TEST
|
|
|
|
PRNNX3 EXT.L D1 * CLEAR HIGH WORD FOR DIVISION
|
|
DIVU #10,D1 * EXTRACT A DIGIT (THE REMAINDER)
|
|
SWAP D1
|
|
MOVE.W D1,-(SP) * PUSH IT
|
|
SWAP D1
|
|
ADDQ.W #1,D2 * BUMP COUNT
|
|
|
|
PRNNX4 CMPI.W #10,D1 * ANY MORE DIGITS TO EXTRACT?
|
|
BGE PRNNX3 * YES
|
|
MOVE.W D1,D0 * NO, POSITION LAST (FIRST) DIGIT
|
|
BRA.S PRNNX6
|
|
|
|
PRNNX5 MOVE.W (SP)+,D0 * POP NEXT DIGIT
|
|
PRNNX6 ADDI.B #'0',D0 * ASCIIZE IT
|
|
BSR PUTCHR * PRINT NEXT DIGIT
|
|
SUBQ.W #1,D2 * ANY DIGITS LEFT ON STACK?
|
|
BGE PRNNX5 * YES
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPPRIN
|
|
* ----------------------
|
|
|
|
* PRINT (THE STRING POINTED TO)
|
|
|
|
IFEQ EZIP
|
|
OPPRIN BSR BSPLTQ * SPLIT THE BLOCK AND OFFSET (QUAD)
|
|
ENDC
|
|
IFEQ CZIP
|
|
OPPRIN BSR BSPLIT * SPLIT THE BLOCK AND OFFSET (WORD)
|
|
ENDC
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRNB
|
|
* ----------------------
|
|
|
|
* PRINTB (THE STRING POINTED TO)
|
|
|
|
OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE)
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRND
|
|
* ----------------------
|
|
|
|
* PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
|
|
|
|
OPPRND BSR OBJLOC * FIND OBJECT'S LOCATION
|
|
ADDA.W #PROP,A0 * PROPERTY TABLE POINTER (ZIP/EZIP)
|
|
BSR GTAWRD * GET IT
|
|
|
|
ADDQ.W #1,D0 * POINT TO SHORT DESCRIPTION STRING
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BRA PUTSTR * AND PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRNI
|
|
* ----------------------
|
|
|
|
* PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
|
|
|
|
OPPRNI MOVE.W ZPC1(A6),D0 * GET POINTER TO STRING
|
|
MOVE.W ZPC2(A6),D1
|
|
BSR PUTSTR * PRINT IT
|
|
MOVE.W D0,ZPC1(A6) * AND UPDATE ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BRA NEWZPC
|
|
|
|
* ----------------------
|
|
* OPPRNR
|
|
* ----------------------
|
|
|
|
* PRINTR (PRINTI FOLLOWED BY RTRUE)
|
|
|
|
OPPRNR BSR OPPRNI * DO A PRINTI
|
|
BSR OPCRLF * A CRLF
|
|
BRA OPRTRU * AND AN RTRUE
|
|
|
|
* ----------------------
|
|
* OPCRLF
|
|
* ----------------------
|
|
|
|
* CRLF (DO A NEWLINE)
|
|
|
|
OPCRLF BRA PUTNEW * DO A NEWLINE
|
|
|
|
|
|
* ----------------------
|
|
* OPSPLT
|
|
* ----------------------
|
|
|
|
* SPLIT THE SCREEN INTO TWO PARTS, SCREEN 0 (BOTTOM) AND 1 (TOP)
|
|
* GIVEN D0 = LINES IN TOP PART
|
|
|
|
OPSPLT MOVE.W D0,D2 * SAVE SPLIT COUNT HERE
|
|
BSR PUTLIN1 * EMPTY (&ZERO) BUFFER IF NEEDED
|
|
|
|
BSR MAXSCRN
|
|
MOVE.W D0,D3 * SAVE TOTAL ROWS HERE
|
|
CMP.W D3,D2
|
|
BLE.S SPLTX1
|
|
MOVE.W D3,D2 * CAN'T TAKE MORE THAN FULL SCREEN
|
|
|
|
SPLTX1 TST.W D2 * IS THE COUNT ZERO?
|
|
BNE.S SPLTX2
|
|
MOVEQ #0,D0 * YES, "AUTO-REVERT" TO SCREEN 0
|
|
BSR SETSCRN
|
|
|
|
SPLTX2 MOVE.W D2,D0
|
|
BSR SETSPLT * REMEMBER NEW SIZE
|
|
BSR GETSCRN * CURENTLY IN SCREEN 1 (TOP)?
|
|
BEQ.S SPLTX3 * NO
|
|
|
|
MOVEQ #1,D0 * YES, HOME THE CURSOR IMMEDIATELY
|
|
MOVEQ #1,D1
|
|
BSR SETCURS
|
|
BRA.S SPLTX5 * DONE
|
|
|
|
* MAKE SURE THE CURSOR WILL BE HOMED UPON NEXT (FIRST) SWITCH TO SCREEN 1
|
|
|
|
SPLTX3 MOVEQ #1,D0 * (THESE VARS ARE 1-ORIGIN TOO)
|
|
MOVE.W D0,ROW1(A6)
|
|
MOVE.W D0,COL1(A6)
|
|
|
|
* Cursor is logically in Screen 0, but may need to "push it down" to keep
|
|
* it physically in Screen 0. (But make sure it's not off screen!)
|
|
|
|
BSR GETCURS * (ROW, 1-ORIGIN)
|
|
CMP.W D2,D0 * DID SCREEN 1 "OVERGROW" US?
|
|
BGT.S SPLTX5 * NO, DONE
|
|
|
|
ADDQ.W #1,D2 * YES, MOVE TO TOP OF W0 (1-ORIGIN)
|
|
CMP.W D3,D2 * BUT OFF BOTTOM? (W0 = ENTIRE SCREEN)
|
|
BLE.S SPLTX4 * NO
|
|
SUBQ.W #1,D2 * YES, BACKUP (EVEN THO NOW IN WINDOW 1)
|
|
|
|
SPLTX4 MOVE.W D2,D0
|
|
MOVEQ #1,D1
|
|
BSR SETCURS * "PUSH DOWN" THE CURSOR
|
|
SPLTX5 RTS
|
|
|
|
* ----------------------
|
|
* OPSCRN
|
|
* ----------------------
|
|
|
|
* MAKE OUTPUT FALL INTO SPECIFIED WINDOW
|
|
|
|
OPSCRN MOVE.W D0,D1 * SAVE ARG
|
|
BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED
|
|
|
|
TST.W D1 * WINDOW 0 (BOTTOM)?
|
|
BEQ.S SCRNX1 * YES
|
|
SUBQ.W #1,D1 * WINDOW 1?
|
|
BEQ.S SCRNX3 * YES
|
|
BRA.S SCRNX5 * "IGNORE OTHER ARGS"
|
|
|
|
* SWITCH TO WINDOW 0
|
|
|
|
SCRNX1 BSR GETSCRN * BUT ALREADY IN W0?
|
|
BEQ.S SCRNX5 * YES, DONE
|
|
|
|
* "SAVE W1 CURSOR POS, RESTORE OLD W0 CURSOR POS"
|
|
|
|
BSR GETCURS * GET W1 CURSOR POS [1-ORIGIN]
|
|
MOVE.W D0,ROW1(A6) * AND STORE IT
|
|
MOVE.W D1,COL1(A6)
|
|
|
|
MOVEQ #0,D0 * SWITCH TO WINDOW 0
|
|
BSR SETSCRN
|
|
|
|
MOVE.W ROW0(A6),D0
|
|
MOVE.W COL0(A6),D1
|
|
BSR SETCURS * RESTORE FORMER POS [1-ORIGIN]
|
|
BRA.S SCRNX5 * DONE
|
|
|
|
* SWITCH TO WINDOW 1
|
|
|
|
SCRNX3 BSR GETSPLT * BUT HAS THE SCREEN BEEN SPLIT?
|
|
TST.W D0
|
|
BEQ.S SCRNX5 * NO, ERROR, SKIP OUT
|
|
|
|
BSR GETSCRN * YES, BUT ALREADY IN W1?
|
|
BNE.S SCRNX5 * YES, DONE
|
|
|
|
* "SAVE W0 CURSOR POS, RESTORE OLD W1 CURSOR POS"
|
|
|
|
BSR GETCURS * GET W0 CURSOR POS [1-ORIGIN]
|
|
MOVE.W D0,ROW0(A6) * AND STORE IT
|
|
MOVE.W D1,COL0(A6)
|
|
|
|
MOVEQ #1,D0 * SWITCH TO WINDOW 1
|
|
BSR SETSCRN
|
|
|
|
MOVE.W ROW1(A6),D0 * [THESE NOW INITED IN OPSPLIT]
|
|
MOVE.W COL1(A6),D1
|
|
BSR SETCURS * RESTORE FORMER POS [1-ORIGIN]
|
|
SCRNX5 RTS
|
|
|
|
* ----------------------
|
|
* OPBUFO
|
|
* ----------------------
|
|
|
|
* SET BUFFERING OF OUTPUT ACCORDING TO INT
|
|
|
|
* >>> OBSOLETE OP -- AMIGA XZIP RUNS /MUCH/ FASTER WITHOUT IT <<<
|
|
|
|
OPBUFO RTS
|
|
|
|
SUBQ.W #1,D0 * NORMAL BUFFERING?
|
|
BEQ.S BUFOX1 * YES
|
|
ADDQ.W #1,D0 * NO BUFFERING, OUTPUT DIRECTLY TO SCREEN?
|
|
BEQ.S BUFOX2 * YES
|
|
BRA.S BUFOX3 * ELSE DO NOTHING
|
|
|
|
BUFOX1 MOVE.W #1,VOBUFF(A6) * TURN ON BUFFERING
|
|
BRA.S BUFOX3
|
|
BUFOX2 BSR PUTLIN * FIRST EMPTY THE CURRENT OUTPUT BUFFER
|
|
CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING
|
|
BUFOX3 RTS
|
|
|
|
|
|
* ----------------------
|
|
* TABCHR
|
|
* ----------------------
|
|
|
|
* TABLE OUTPUT FUNCTION --- PUT THE CHAR IN D0 IN THE DEFINED TABLE
|
|
|
|
TABCHR MOVE.L TABPTR(A6),A0 * CURRENT POSITION IN TABLE
|
|
MOVE.B D0,(A0)+ * STORE CHAR
|
|
MOVE.L A0,TABPTR(A6) * UPDATE POINTER
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPDIRO
|
|
* ----------------------
|
|
|
|
* REDIRECT OUTPUT (TABLE OR NORMAL) ACCORDING TO INT
|
|
|
|
OPDIRO NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W ARG1(A0),D0 * VIRTUAL OUTPUT DEVICE -- NEGATIVE?
|
|
BLT.S DIRX0 * YES, MEANS TURN IT OFF
|
|
|
|
SUBQ.W #1,D0 * TURN ON SCREEN?
|
|
BEQ.S DIRX1 * YES
|
|
SUBQ.W #1,D0 * TURN ON PRINTER?
|
|
BEQ.S DIRX3 * YES
|
|
SUBQ.W #1,D0 * TURN ON TABLE?
|
|
BEQ DIRX5 * YES
|
|
RTS * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
DIRX0 ADDQ.W #1,D0 * TURN OFF SCREEN?
|
|
BEQ.S DIRX2 * YES
|
|
ADDQ.W #1,D0 * TURN OFF PRINTER?
|
|
BEQ.S DIRX4 * YES
|
|
ADDQ.W #1,D0 * TURN OFF TABLE?
|
|
BEQ DIRX6 * YES
|
|
RTS * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
*** TURN SCREEN OUTPUT ON, OFF
|
|
|
|
DIRX1 MOVE.W #1,VOCONS(A6)
|
|
BRA DIRX7
|
|
DIRX2 BSR PUTLIN * BUT FIRST DUMP BUFFER, IF NEEDED
|
|
CLR.W VOCONS(A6)
|
|
BRA DIRX7
|
|
|
|
*** TURN SCRIPTING OUTPUT ON, OFF
|
|
|
|
DIRX3 TST.W VOPRNT(A6) * ALREADY ON?
|
|
BNE.S DIRX7 * YES
|
|
|
|
MOVE.W #1,D0
|
|
MOVE.W D0,VOPRNT(A6)
|
|
BSR SCRINIT * OPEN SCRIPT CHANNEL (IF NEEDED)
|
|
TST.W D0
|
|
BEQ.S DIRX3A * ERROR
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
BSET #0,PFLAGS+1(A0) * SET PRELOAD FLAG FOR GAME'S USE
|
|
BRA.S DIRX7
|
|
DIRX3A BSR SCRERR * UNDO EVERYTHING, SHOW MESSAGE
|
|
BRA.S DIRX7
|
|
|
|
DIRX4 TST.W VOPRNT(A6) * ALREADY OFF?
|
|
BEQ.S DIRX7 * YES
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W D0,VOPRNT(A6)
|
|
BSR SCRINIT * CLOSE SCRIPT CHANNEL (IF NEEDED)
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
BCLR #0,PFLAGS+1(A0) * CLEAR THE PRELOAD FLAG
|
|
BRA.S DIRX7
|
|
|
|
*** TURN TABLE ON, OFF
|
|
|
|
DIRX5 MOVEQ #0,D0
|
|
MOVE.W ARG2(A0),D0 * GET RELATIVE TABLE POINTER
|
|
ADD.L BUFFER(A6),D0 * ABSOLUTIZE
|
|
MOVE.L D0,TABOUT(A6) * REMEMBER START OF TABLE
|
|
|
|
ADDQ.L #2,D0 * SKIP LENGTH SLOT
|
|
MOVE.L D0,TABPTR(A6) * FIRST CHAR WILL GO HERE
|
|
|
|
MOVE.W #1,VOTABL(A6) * SET TABLE-OUTPUT FLAG
|
|
BRA.S DIRX7
|
|
|
|
DIRX6 TST.W VOTABL(A6) * MAKE SURE A TABLE DOES EXIST
|
|
BEQ.S DIRX7 * NO TABLE, IGNORE REQUEST
|
|
CLR.W VOTABL(A6) * OK, TURN OFF TABLE-OUTPUT FLAG
|
|
|
|
MOVE.L TABOUT(A6),A0 * COMPUTE LENGTH OF CURRENT TABLE CONTENTS
|
|
MOVE.L TABPTR(A6),D0
|
|
SUB.L A0,D0
|
|
SUBQ.W #2,D0 * ADJUST FOR LENGTH SLOT
|
|
BSR PTAWRD * AND STORE LENGTH IN LENGTH SLOT
|
|
|
|
DIRX7 RTS
|
|
|
|
* REDIRECT INPUT (NORMAL OR COMMAND FILE) ACCORDING TO INT
|
|
|
|
* ----------------------
|
|
* OPDIRI
|
|
* ----------------------
|
|
|
|
OPDIRI NOP * TELL CALLER TO USE ARGBLK
|
|
*** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE -- NOT IMPLEMENTED
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPSOUND
|
|
* ----------------------
|
|
|
|
* MAKE A SOUND
|
|
* ARG1 = ID: 1=BEEP, 2=BOOP, 3+ ARE SPECIAL, 0=MRU
|
|
* [ARG2] = ACTION: 1=INIT, [2=START], 3=STOP, 4=CLEANUP
|
|
* [ARG3] = COUNT (HIBYTE): -1=INFINITE, [0=USE MIDI COUNT], 1-254=FINITE
|
|
* VOL (LOBYTE): 0=MIN, 8=MAX, [-1=USE MIDI VOLUME]
|
|
* [ARG4] = INTERRUPT FUNCTION
|
|
|
|
OPSOUND NOP * REQUEST AN ARGBLK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
MOVE.W #2,ARG2(A1) * DEFAULT ACTION = "START"
|
|
MOVE.W #$00FF,ARG3(A1) * DEFAULT COUNT=0/VOL=-1 (USE MIDI DATA)
|
|
CLR.W ARG4(A1) * DEFAULT INTERRUPT HANDLER = NONE
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.W ARG4(A0),SFUNC(A6) * SAVE INTERRUPT HERE
|
|
MOVE.W ARG3(A0),D2 * COUNT/VOL
|
|
MOVE.W D2,D3
|
|
EXT.W D2 * VOL (16 BITS)
|
|
LSR.W #8,D3 * COUNT (16 BITS, UNLESS -1)
|
|
CMPI.B #$FF,D3 * -1?
|
|
BNE.S OPSDX1
|
|
EXT.W D3 * YES, MAKE 16 BITS
|
|
|
|
OPSDX1 MOVE.W ARG2(A0),D1 * ACTION
|
|
MOVE.W ARG1(A0),D0 * SOUND ID
|
|
BRA DOSOUND
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* MORE I/O OPERATIONS -- SCREEN HANDLING
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPCLEAR
|
|
* ----------------------
|
|
|
|
* CLEAR A WINDOW, OR ENTIRE SCREEN
|
|
|
|
OPCLEAR MOVE.W D0,D1
|
|
BSR PUTLIN * FIRST EMPTY BUFFER, IF NEEDED
|
|
|
|
ADDQ.W #1,D1 * ENTIRE SCREEN?
|
|
BEQ.S CLRX1 * YES
|
|
SUBQ.W #1,D1 * WINDOW 0 ONLY?
|
|
BEQ.S CLRX2 * YES
|
|
SUBQ.W #1,D1 * WINDOW 1 ONLY?
|
|
BEQ.S CLRX3 * YES
|
|
BRA.S CLRX9 * INVALID ARG, IGNORE IT
|
|
|
|
CLRX1 CLR.W D0
|
|
BSR SETSPLT * UNSPLIT THE SCREEN, FALL THRU
|
|
|
|
* WINDOW 0 (BOTTOM)
|
|
|
|
CLRX2 BSR MAXSCRN
|
|
MOVE.W D0,D1 * LAST ROW OF WINDOW 0 (INCLUSIVE)
|
|
BSR GETSPLT
|
|
ADDQ.W #1,D0 * FIRST ROW (1-ORIGIN)
|
|
BSR MDCLEAR * CLEAR THEM
|
|
|
|
BSR GETSCRN * IN WINDOW 0 CURRENTLY?
|
|
BNE.S CLRX9 * NO
|
|
BSR MAXSCRN
|
|
MOVE.W D0,D2 * YES, GET MAX ROWS
|
|
|
|
BSR GETMARG
|
|
MOVE.W D0,D1
|
|
ADDQ.W #1,D1 * FIRST COL (1-ORIGIN)
|
|
BSR GETSPLT
|
|
ADDQ.W #1,D0 * FIRST ROW (1-ORIGIN)
|
|
|
|
CMP.W D2,D0 * BUT MAKE SURE NOT OFF BOTTOM OF SCREEN!
|
|
BLE.S CLRX2A
|
|
MOVE.W D2,D0 * WE ARE, FUDGE IT
|
|
CLRX2A BSR SETCURS
|
|
|
|
CLR.W LINES(A6) * RESET THE COUNTER FOR SCROLLING
|
|
BRA.S CLRX9
|
|
|
|
* WINDOW 1 (TOP)
|
|
|
|
CLRX3 BSR GETSPLT
|
|
MOVE.W D0,D1 * LAST ROW OF WINDOW 1 (INCLUSIVE)
|
|
MOVEQ #1,D0 * FIRST ROW (1-ORIGIN)
|
|
BSR MDCLEAR * CLEAR THEM
|
|
|
|
BSR GETSCRN * IN WINDOW 1 CURRENTLY?
|
|
BEQ.S CLRX9 * NO
|
|
|
|
BSR GETMARG
|
|
MOVE.W D0,D1
|
|
ADDQ.W #1,D1 * FIRST COL (1-ORIGIN)
|
|
MOVEQ #1,D0 * FIRST ROW (1-ORIGIN)
|
|
BSR SETCURS
|
|
CLRX9 RTS
|
|
|
|
* ----------------------
|
|
* OPERASE
|
|
* ----------------------
|
|
|
|
* ERASE (CURRENT LINE, STARTING AT CURSOR)
|
|
|
|
OPERASE SUBQ.W #1,D0
|
|
BNE.S ERAX1 * "IGNORE ARG IF NOT 1"
|
|
BSR PUTLIN * EMPTY BUFFER, IF NEEDED
|
|
BSR MDERASE
|
|
ERAX1 RTS
|
|
|
|
* ----------------------
|
|
* OPCURS
|
|
* ----------------------
|
|
|
|
* SET CURSOR TO LINE INT1, COLUMN INT2 [ARGS ARE 1-ORIGIN]
|
|
|
|
OPCURS MOVE.W D0,D2 * PROTECT ARG
|
|
BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED
|
|
MOVE.W D2,D0
|
|
BRA SETCURS * D0 = ROW, D1 = COL
|
|
|
|
* ----------------------
|
|
* OPCURG
|
|
* ----------------------
|
|
|
|
* GET CURSOR POSITION [1-ORIGIN]
|
|
|
|
OPCURG BSR RELABS * TABLE FOR RETURN VALUES
|
|
MOVE.L A0,A1
|
|
BSR GETCURS
|
|
MOVE.L A1,A0
|
|
BSR PTAWRD * STORE ROW
|
|
MOVE.L A1,A0
|
|
ADDQ.L #2,A0
|
|
MOVE.W D1,D0
|
|
BRA PTAWRD * STORE COLUMN
|
|
|
|
* ----------------------
|
|
* OPATTR
|
|
* ----------------------
|
|
|
|
* HIGHLIGHT (SET CHAR ATTRIBUTES)
|
|
|
|
OPATTR MOVE.L D0,D1
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD MODE)
|
|
|
|
MOVE.W D1,D0
|
|
BRA MDATTR * 1 INVERSE, 2 BOLD, 4 ITALIC (8 MONO)
|
|
|
|
* ----------------------
|
|
* OPFONT
|
|
* ----------------------
|
|
|
|
OPFONT MOVE.W D0,D1 * NEW FONT NUMBER
|
|
BSR GETFONT * OLD FONT NUMBER (IN CURRENT WINDOW)
|
|
MOVE.W D0,D2
|
|
CMP.W D1,D2 * >>> IS THE FONT REALLY CHANGING? <<<
|
|
BEQ.S FONTX2 * NO, DON'T EMPTY BUFFER
|
|
|
|
*?* BSR GETSCRN * BUT ARE WE IN WINDOW 1?
|
|
*?* BNE.S FONTX1 * YES
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD FONT)
|
|
|
|
FONTX1 MOVE.W D1,D0
|
|
BSR SETFONT * SET NEW FONT NUMBER
|
|
FONTX2 MOVE.W D2,D0
|
|
BRA PUTVAL * RETURN OLD FONT NUMBER
|
|
|
|
* ----------------------
|
|
* OPCOLOR
|
|
* ----------------------
|
|
|
|
OPCOLOR MOVE.W D0,D2 * PROTECT THIS ARG
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER
|
|
MOVE.W D2,D0
|
|
BRA MDCOLOR
|
|
|
|
* ----------------------
|
|
* OPPICI
|
|
* ----------------------
|
|
|
|
* GET PICTURE INFO (SIZE)
|
|
|
|
OPPICI EXG D0,D1 * TABLE OFFSET
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.W D1,D0 * PICTURE ID
|
|
BSR PICINF * GET SIZE INFO, STORE IN TABLE
|
|
BLT.S OPICX1 * NEG RESULT MEANS ERROR
|
|
BRA PTRUE
|
|
OPICX1 BRA PFALSE
|
|
|
|
* ----------------------
|
|
* OPDISP, OPDCLR
|
|
* ----------------------
|
|
|
|
* DISPLAY [OR CLEAR] A PICTURE
|
|
|
|
OPDCLR MOVEQ #1,D3 * "CLEAR" FLAG ON
|
|
BRA.S DISPX1
|
|
|
|
OPDISP MOVEQ #0,D3 * "CLEAR" FLAG OFF
|
|
DISPX1 BRA PICDISP
|
|
|
|
* ----------------------
|
|
* OPMARG
|
|
* ----------------------
|
|
|
|
* SET MARGINS
|
|
|
|
OPMARG MOVE.W D0,D2 * SAVE ARGS
|
|
MOVE.W D1,D3
|
|
BSR SETMARG * UPDATE DISPLAY VARS
|
|
|
|
MOVE.L BUFFER(A6),A0 * UPDATE GAME VARS
|
|
MOVE.W D2,PLMRG(A0) * (MAC: 1 CHAR = 1 PIXEL UNIT)
|
|
MOVE.W D3,PRMRG(A0)
|
|
|
|
MOVEQ #-1,D0 * [DON'T CHANGE ROW]
|
|
MOVE.W D2,D1 * SET COLUMN TO NEW LEFT MARGIN
|
|
ADDQ.W #1,D1 * [1-ORIGIN]
|
|
BSR SETCURS
|
|
|
|
BSR MAXSCRN
|
|
MOVE.W D1,D0 * MAX COLUMNS
|
|
SUB.W D2,D0
|
|
SUB.W D3,D0 * COMPUTE NEW LINE LENGTH
|
|
MOVE.L DQUE(A6),A0
|
|
BRA SIZEQP * AND UPDATE WORD-WRAP
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* CONTROL OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
MAXLOCS EQU 15 * MAXIMUM LOCALS; VARS 16-255 ARE GLOBAL
|
|
CVFLAG EQU $0100 * FLAG SET (HIGH BYTE) IF CALL RETURNS A VALUE
|
|
|
|
* ----------------------
|
|
* OPICALL, ETC
|
|
* ----------------------
|
|
|
|
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), NO RETURNED VALUE
|
|
|
|
OPICAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP
|
|
MOVE.W #1,(A0) * ONE ARG (THE FUNCTION)
|
|
MOVE.W D0,ARG1(A0)
|
|
|
|
OPICAL2
|
|
OPIXCAL
|
|
OPICALL NOP * TELL CALLER TO USE ARGBLK
|
|
MOVEQ #0,D3 * FLAG -- DON'T RETURN A VALUE
|
|
BRA.S CALLX1
|
|
|
|
* ----------------------
|
|
* OPCALL, ETC
|
|
* ----------------------
|
|
|
|
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS)
|
|
|
|
OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP
|
|
MOVE.W #1,(A0) * ONE ARG (THE FUNCTION)
|
|
MOVE.W D0,ARG1(A0)
|
|
|
|
OPCAL2
|
|
OPXCAL
|
|
OPCALL NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W #CVFLAG,D3 * FLAG (HIGH BYTE) -- RETURN A VALUE
|
|
|
|
*** COMMON ENTRY POINT, A0 -> ARGBLK, D3 (HIGH BYTE) = RETURN-VALUE FLAG
|
|
|
|
CALLX1 MOVE.L A0,A2
|
|
MOVE.W (A2)+,D2 * ARG COUNT
|
|
MOVE.W (A2)+,D0 * FUNCTION TO CALL -- IS IT ZERO?
|
|
BNE.S CALLX2 * NO
|
|
|
|
TST.W D3 * SPECIAL CASE -- RETURN A VALUE?
|
|
BEQ.S CALLX9 * NO, JUST EXIT
|
|
* CLR.W D0 * YES, RETURN A ZERO
|
|
BRA PUTVAL
|
|
|
|
*** BUILD A STACK FRAME, THEN UPDATE THE ZPC AND STATE VARS ...
|
|
|
|
CALLX2 MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
MOVE.B NARGS+1(A6),D3 * SAVE OLD "OPTIONALS" COUNT ...
|
|
MOVE.W D3,-(A4) * ALONG WITH /NEW/ RETURN FLAG
|
|
|
|
* >>> old locs pointer (rel) now stacked as word, instead of long <<<
|
|
* >>> new locs pointer now points to (pseudo) loc 0, instead of 1 <<<
|
|
|
|
MOVE.L ZLOCS(A6),D1 * OLD LOCALS/FRAME POINTER
|
|
SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT, IN CASE OF GAME SAVE
|
|
MOVE.W D1,-(A4) * SAVE IT
|
|
MOVE.L A4,ZLOCS(A6) * NEW LOCALS/FRAME POINTER
|
|
|
|
SUBQ.W #1,D2 * NUMBER OF PARAMETERS ("OPTIONALS")
|
|
MOVE.B D2,NARGS+1(A6) * REMEMBER IT (BYTE)
|
|
|
|
BSR BSPLTQ * SPLIT THE FUNCTION POINTER (IN D0)
|
|
MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
|
|
*** GET FUNCTION HEADER
|
|
|
|
BSR NXTBYT * TOTAL # DEFINED LOCALS
|
|
MOVE.W D0,D1
|
|
CMPI.W #MAXLOCS,D1 * VALID?
|
|
BLS.S CALLX3
|
|
LEA MSGCA1,A0 * TOO MANY LOCALS DEFINED
|
|
BSR ZWARN * SHOW A WARNING
|
|
MOVEQ #MAXLOCS,D1 * (CUT BACK -- CAN'T BE TOUCHED ANYWAY)
|
|
|
|
CALLX3 CMP.W D2,D1 * VALID?
|
|
BCC.S CALLX4 * BHS
|
|
LEA MSGCA2,A0 * TOO MANY OPTIONALS SUPPLIED
|
|
BSR ZWARN * SHOW A WARNING
|
|
MOVE.W D1,D2 * (CUT BACK -- WON'T BE TOUCHED ANYWAY)
|
|
|
|
CALLX4 SUB.W D2,D1 * THIS IS NUMBER OF "DEFAULT" VALUES
|
|
BRA.S CALLX6
|
|
|
|
SECTION ZDATA
|
|
MSGCA1 DC.B 'Bad loc num',0
|
|
MSGCA2 DC.B 'Bad optional num',0
|
|
SECTION ZCODE
|
|
|
|
*** BUILD & INITIALIZE A LOCALS FRAME ...
|
|
|
|
CALLX5 MOVE.W (A2)+,-(A4) * POSITION THE OPTIONAL VALUES FIRST
|
|
CALLX6 DBF D2,CALLX5 * ZERO CHECK -- ANY MORE?
|
|
MOVEQ #0,D0
|
|
BRA.S CALLX8
|
|
|
|
CALLX7 MOVE.W D0,-(A4) * CLEAR THE REMAINING DEFAULT VALUES [XZIP]
|
|
CALLX8 DBF D1,CALLX7 * ZERO CHECK -- ANY MORE?
|
|
CALLX9 RTS * DONE
|
|
|
|
* ----------------------
|
|
* OPASSN
|
|
* ----------------------
|
|
|
|
* ASSIGNED? (A LOCAL AN OPTIONAL VALUE)
|
|
|
|
OPASSN CMP.B NARGS+1(A6),D0 * WAS THIS LOCAL ASSIGNED A VALUE?
|
|
BGT PFALSE * NO, VALUE DEFAULTED TO ZERO
|
|
BRA PTRUE * YES
|
|
|
|
* ----------------------
|
|
* OPRETU
|
|
* ----------------------
|
|
|
|
* RETURN (FROM CURRENT FUNCTION CALL)
|
|
|
|
OPRETU MOVE.L ZLOCS(A6),A4 * OLD TOP-OF-STACK
|
|
MOVEQ #0,D1
|
|
MOVE.W (A4)+,D1 * RESTORE OLD LOCALS POINTER
|
|
ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT
|
|
MOVE.L D1,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,D2 * RESTORE RETURN FLAG, OPTS COUNT
|
|
MOVE.B D2,NARGS+1(A6)
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OLD ZPC
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
IFEQ EZIP
|
|
BLT INRETU * SPECIAL INTERNAL CALL/RETURN, HANDLE IT
|
|
ENDC
|
|
MOVE.W D0,D1 * PROTECT VALUE (IF ANY -- XZIP)
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
MOVE.W D1,D0
|
|
|
|
ANDI.W #CVFLAG,D2 * WAS THIS A RETURN-VALUE CALL? (XZIP)
|
|
BNE PUTVAL * YES, RETURN THE VALUE
|
|
RTS * NO, JUST EXIT
|
|
|
|
* ----------------------
|
|
* OPRTRU
|
|
* ----------------------
|
|
|
|
* RTRUE
|
|
|
|
OPRTRU MOVEQ #1,D0 * RETURN A "1"
|
|
BRA.S OPRETU
|
|
|
|
* ----------------------
|
|
* OPRFAL
|
|
* ----------------------
|
|
|
|
* RFALSE
|
|
|
|
OPRFAL CLR.W D0 * RETURN A "0"
|
|
BRA.S OPRETU
|
|
|
|
* ----------------------
|
|
* OPRSTA
|
|
* ----------------------
|
|
|
|
* RSTACK (RETURN STACK)
|
|
|
|
OPRSTA MOVE.W (A4)+,D0 * POP A VALUE
|
|
BRA OPRETU * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPFSTA
|
|
* ----------------------
|
|
|
|
* FSTACK (FLUSH A VALUE OFF THE STACK) *** DEAD -- XZIP
|
|
|
|
* OPFSTA
|
|
* ADDQ.L #2,A4 * FLUSH ONE WORD
|
|
* RTS
|
|
|
|
* ----------------------
|
|
* OPJUMP
|
|
* ----------------------
|
|
|
|
* JUMP (TO A NEW LOCATION)
|
|
|
|
OPJUMP SUBQ.W #2,D0 * ADJUST OFFSET
|
|
ADD.W D0,ZPC2(A6) * ADD OFFSET TO CURRENT ZPC
|
|
BRA NEWZPC * NORMALIZE IT & UPDATE ZPC STUFF
|
|
|
|
* ----------------------
|
|
* OPNOOP
|
|
* ----------------------
|
|
|
|
* NOOP (NO OPERATION)
|
|
|
|
OPNOOP RTS * DO NOTHING
|
|
|
|
* ----------------------
|
|
* OPCATCH
|
|
* ----------------------
|
|
|
|
* CATCH
|
|
|
|
OPCATCH MOVE.L ZLOCS(A6),D0 * THE CURRENT "FRAME POINTER"
|
|
SUB.L STKBOT(A6),D0 * RELATIVIZE IT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPTHROW
|
|
* ----------------------
|
|
|
|
* THROW (NON-LOCAL RETURN)
|
|
|
|
OPTHROW EXT.L D1 * A PREVIOUS FRAME PTR
|
|
ADD.L STKBOT(A6),D1 * ABSOLUTIZE
|
|
CMP.L ZLOCS(A6),D1 * VALID FRAME?
|
|
BLT.S THRX1 * ERROR
|
|
MOVE.L D1,ZLOCS(A6) * OK, FLUSH ANY INTERMEDIATE FRAMES
|
|
BRA OPRETU * AND RETURN VAL (STILL IN D0)
|
|
|
|
THRX1 CLR.W D0
|
|
LEA MSGTHR,A0
|
|
BRA FATAL
|
|
SECTION ZDATA
|
|
MSGTHR DC.B 'Bad Throw',0
|
|
SECTION ZCODE
|
|
|
|
* ----------------------
|
|
* INCALL
|
|
* ----------------------
|
|
|
|
IFEQ EZIP
|
|
|
|
* INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0
|
|
|
|
INCALL MOVEM.L D1-D7/A1-A3,-(SP) * SAVE EVERYTHING
|
|
|
|
MOVE.W ZPC1(A6),-(SP)
|
|
MOVE.W #-1,ZPC1(A6) * FAKE ZPC1, SIGNALS AN INTERNAL CALL/RETURN
|
|
|
|
LEA ARGBLK(A6),A0 * SET UP ARGBLK FOR OPCALL
|
|
MOVE.W D0,ARG1(A0) * FUNCTION TO CALL
|
|
MOVE.W #1,(A0) * ONE ARG (FUNCTION ITSELF)
|
|
|
|
BSR OPCALL * CALL THE TIMEOUT FUNCTION
|
|
BRA NXTINS * GO EXECUTE IT
|
|
|
|
* ----------------------
|
|
* INRETU
|
|
* ----------------------
|
|
|
|
* JUMP BACK TO HERE UPON NEXT OPRETURN ...
|
|
|
|
INRETU ADDQ.L #4,SP * CAREFUL -- FLUSH TOP RETURN ADDR (NXTINS)
|
|
MOVE.W (SP)+,ZPC1(A6) * FIX THE ZPC
|
|
|
|
MOVE.W D0,D1
|
|
BSR NEWZPC * RESTORE THE PROPER PAGE
|
|
MOVE.W D1,D0
|
|
|
|
MOVEM.L (SP)+,D1-D7/A1-A3
|
|
RTS * RETURN TO ORIGINAL CALLER
|
|
ENDC
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* GAME COMMANDS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ------------------------------
|
|
* PRIMITIVES FOR SAVE/RESTORE
|
|
* ------------------------------
|
|
|
|
* SAVE STATE VARIABLES ON GAME STACK
|
|
|
|
SAVSTA MOVE.W ZPC1(A6),-(A4)
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
|
|
MOVE.L STKBOT(A6),A0
|
|
MOVE.L ZLOCS(A6),D0 * RELATIVIZE THIS ONE
|
|
SUB.L A0,D0
|
|
MOVE.W D0,-(A4)
|
|
MOVE.W ZORKID(A6),-(A4)
|
|
|
|
MOVE.L A4,D0
|
|
SUB.L A0,D0 * RELATIVIZE GAME SP, TOO
|
|
MOVE.W D0,(A0) * AND SAVE IT IN KNOWN LOCATION
|
|
ADDA.W #8,A4 * RESET THE GAME SP
|
|
RTS
|
|
|
|
* RESTORE STATE VARIABLES FROM GAME STACK, RETURN ZORKID IN D0 AND FLAGS
|
|
|
|
RESSTA MOVE.L STKBOT(A6),A0
|
|
MOVEQ #0,D0
|
|
MOVE.W (A0),D0 * RESTORE GAME SP FROM KNOWN LOCATION
|
|
ADD.L A0,D0 * RE-ABSOLUTIZE IT
|
|
MOVE.L D0,A4
|
|
|
|
MOVE.W (A4)+,-(SP) * GET THE SAVED ZORKID
|
|
MOVEQ #0,D0
|
|
MOVE.W (A4)+,D0 * RESTORE OLD LOCALS POINTER
|
|
ADD.L A0,D0 * RE-ABSOLUTIZE IT
|
|
MOVE.L D0,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
|
|
MOVE.W (SP)+,D0
|
|
CMP.W ZORKID(A6),D0 * IS ID THE SAME AS OURS?
|
|
RTS * (RETURN WITH FLAGS)
|
|
|
|
* ----------------------
|
|
* OPISAV
|
|
* ----------------------
|
|
|
|
* ISAVE (SAVE TO MEMORY BUFFER)
|
|
|
|
OPISAV BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK
|
|
MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER
|
|
BEQ SAVERR * ERROR, BUFFER DOESN'T EXIST
|
|
MOVE.L STKBOT(A6),A0
|
|
MOVE.L D2,A1
|
|
MOVE.L #STKLEN,D0
|
|
BSR MOVMEM * SAVE THE STACK (FAST BLOCKMOVE)
|
|
|
|
MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVE.L D2,A1
|
|
ADDA.W #STKLEN,A1 * START WRITING AFTER STACK
|
|
MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS
|
|
BSR BLKBYT
|
|
BSR MOVMEM * SAVE IMPURE DATA (FAST BLOCKMOVE)
|
|
BRA SAVEOK * SUCCESS
|
|
|
|
* ----------------------
|
|
* OPSAVE
|
|
* ----------------------
|
|
|
|
PSNLEN EQU 32 * MAX LENGTH OF SUGGESTED NAME
|
|
|
|
* SAVE (STATE OF GAME, OR SELECTED "PARTIAL" DATA)
|
|
|
|
OPSAVE NOP
|
|
TST.W (A0) * PARTIAL SAVE (ANY ARGS)?
|
|
BEQ SVX2 * NO
|
|
|
|
*** HANDLE A PARTIAL SAVE, A0 -> ARGBLK ***
|
|
|
|
MOVE.L A0,A2
|
|
CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH
|
|
BSR RELABS
|
|
MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL
|
|
MOVEQ #1,D0 * OPSAVE
|
|
MOVEQ #1,D1 * PARTIAL
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE SVX14 * CANCELLED
|
|
|
|
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
|
|
BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE)
|
|
|
|
* WRITE SUGGESTED NAME TO FILE
|
|
|
|
MOVEQ #0,D0
|
|
MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME
|
|
MOVE.L A1,A0 * STARTS HERE (WITH LENGTH BYTE)
|
|
BSR SFWRIT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
* WRITE DATA TO FILE
|
|
|
|
MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVEQ #PSNLEN,D0 * FILE OFFSET
|
|
MOVEQ #0,D1
|
|
MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA
|
|
BSR SFWRIT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
BSR DEFOLD * OK >>> BUT RESTORE "NORMAL" FILE NAMES <<<
|
|
BRA SVX10 * AND CLEAN UP
|
|
|
|
*** ENTER HERE FOR "STANDARD" SAVE ***
|
|
|
|
SVX2 CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVEQ #1,D0 * OPSAVE
|
|
CLR.W D1 * STANDARD
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE SVX14 * CANCELLED
|
|
|
|
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
|
|
BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE)
|
|
|
|
* SAVE GAME STACK, THEN IMPURE PRELOAD
|
|
|
|
BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK
|
|
MOVE.L STKBOT(A6),A0
|
|
CLR.W D0 * THIS WILL BE BLOCK ZERO
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
BSR PTSBKS * WRITE IT OUT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVEQ #STKLEN/512,D0 * START WRITING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * NUMBER OF IMPURE BLOCKS
|
|
BSR PTSBKS
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
* SAVE SUCCEEDED
|
|
|
|
SVX10 BSR CLSSFL * SUCCESS, CLOSE THE FILE [NO ERRORS]
|
|
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
BSR MAKEICON * [AMIGA: ATTACH AN ICON TO THIS FILE]
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
SAVEOK MOVEQ #1,D0 * RETURN "SAVE OK"
|
|
BRA PUTVAL
|
|
|
|
* SAVE FAILED FOR SOME REASON ...
|
|
|
|
SVX12 BSR CLSSFL * CLOSE THE BAD FILE
|
|
BSR DELSFL * AND DELETE THE BAD FILE FROM THE DIRECTORY
|
|
|
|
SVX14 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
SAVERR CLR.W D0 * RETURN "SAVE FAILED"
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPIRES
|
|
* ----------------------
|
|
|
|
* IRESTORE (RESTORE FROM MEMORY BUFFER)
|
|
|
|
OPIRES MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER
|
|
BEQ RESERR * ERROR, BUFFER DOESN'T EXIST
|
|
MOVE.L D2,A0
|
|
TST.W (A0)
|
|
BEQ RESERR * ERROR, NO PREVIOUS ISAVE!
|
|
MOVE.L STKBOT(A6),A1
|
|
MOVE.L #STKLEN,D0
|
|
BSR MOVMEM * RESTORE THE GAME STACK (FAST BLOCKMOVE)
|
|
|
|
BSR RESSTA * UNSTACK THE OLD STATE INFO
|
|
BNE RESX15 * ERROR, WRONG ZORKID
|
|
|
|
MOVE.L D2,A0
|
|
ADDA.W #STKLEN,A0 * START READING AFTER STACK
|
|
MOVE.L BUFFER(A6),A1 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS
|
|
BSR BLKBYT
|
|
BSR MOVMEM * RESTORE IMPURE DATA (FAST BLOCKMOVE)
|
|
BRA RESTOK * SUCCESS
|
|
|
|
* ----------------------
|
|
* OPREST
|
|
* ----------------------
|
|
|
|
* RESTORE (STATE OF GAME, OR SELECTED "PARTIAL" DATA)
|
|
|
|
OPREST NOP
|
|
TST.W (A0) * PARTIAL RESTORE (ANY ARGS)?
|
|
BEQ RESX2 * NO
|
|
|
|
*** HANDLE A PARTIAL RESTORE, A0 -> ARGBLK ***
|
|
|
|
MOVE.L A0,A2
|
|
CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH
|
|
BSR RELABS
|
|
MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL
|
|
MOVEQ #0,D0 * RESTORE
|
|
MOVEQ #1,D1 * PARTIAL
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE RESX13 * CANCELLED
|
|
|
|
BSR OPNSFL * OPEN THE FILE
|
|
BNE RESX13 * ERROR
|
|
|
|
* READ (PREVIOUS) SUGGESTED NAME FROM FILE, & CHECK FOR A MATCH
|
|
|
|
MOVEQ #0,D0
|
|
MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME
|
|
MOVE.L STKBOT(A6),A0 * (GRAB TEMP BUFFER AT BASE OF ZSTACK)
|
|
BSR SFREAD
|
|
BNE RESX12 * ERROR, CLOSE THE FILE (NOT FATAL)
|
|
|
|
MOVE.L A1,A0 * CURRENT NAME STARTS HERE (WITH LENGTH BYTE)
|
|
MOVE.L STKBOT(A6),A1
|
|
MOVEQ #1,D0 * COUNT LENGTH BYTE
|
|
ADD.B (A0),D0
|
|
BSR COMPS * COMPARE THE STRINGS
|
|
BNE RESX12 * DIFFERENT, ERROR, CLOSE THE FILE
|
|
|
|
* READ DATA FROM FILE
|
|
|
|
MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVEQ #PSNLEN,D0 * FILE OFFSET
|
|
MOVEQ #0,D1
|
|
MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA
|
|
BSR SFREAD * [RETURNS ACTUAL BYTES READ IN D1]
|
|
BNE RESX12 * ERROR, CLOSE THE FILE
|
|
|
|
BSR DEFOLD * >>> RESTORE "NON-PARTIAL" FILE NAMES <<<
|
|
BSR CLSSFL * CLOSE THE FILE
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
*** [SYSTEM STACK HACKING AND CALL TO NEWZPC NOT NEEDED AFTER PARTIAL OP]
|
|
|
|
MOVE.W D1,D0 * RETURN "ACTUAL BYTES READ"
|
|
BRA PUTVAL
|
|
|
|
*** ENTER HERE FOR "STANDARD" RESTORE ***
|
|
|
|
RESX2 CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
CLR.W D0 * RESTORE
|
|
CLR.W D1 * STANDARD
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE RESX13 * CANCELLED
|
|
|
|
*** ENTER HERE IF DOING SPECIAL RESTORE DURING LAUNCH ***
|
|
|
|
RES1 BSR OPNSFL * OPEN THE FILE
|
|
BNE RESX13 * ERROR
|
|
|
|
CLR.W D0 * FIRST READ IN STACK
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
MOVE.L STKBOT(A6),A0 * PUT IT HERE
|
|
BSR GTSBKS
|
|
BNE RESX16 * DIE IF DISK ERROR
|
|
|
|
BSR RESSTA * UNSTACK THE OLD STATE INFO
|
|
BNE RESX14 * ERROR, WRONG ZORKID
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PFLAGS(A0),-(SP) * PRESERVE THE FLAGS (SCRIPT ETC)
|
|
|
|
MOVEQ #STKLEN/512,D0 * READ IMPURE STUFF STARTING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * LENGTH OF IMPURE STUFF
|
|
BSR GTSBKS
|
|
BNE RESX16 * DIE IF DISK ERROR
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W (SP)+,PFLAGS(A0) * RESTORE THE OLD FLAGS
|
|
|
|
* RESTORE SUCCEEDED
|
|
|
|
RESX10 BSR CLSSFL * CLOSE THE FILE
|
|
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * (1) MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
* A subtle bug was found in ZIP20 when certain calls that reset the game
|
|
* state (the ZPC and stack) occurred during a timer interrupt. Since control
|
|
* never returned to the code that caused the interrupt, the system (machine)
|
|
* stack never got cleaned up. After several such calls it overflowed.
|
|
|
|
* The questionable calls include (a successful) Restore or Irestore (Undo),
|
|
* and Restart. The first two are handled here, the last elsewhere.
|
|
|
|
RESTOK MOVE.L TOPSP(A6),SP * MAKE SURE THE SYSTEM STACK IS CLEAN
|
|
PEA NXTINS * AND HACK IT SO WE WILL RETURN TO MAIN LOOP
|
|
|
|
BSR NEWZPC * (2) GET THE PROPER ZPC PAGE
|
|
MOVEQ #2,D0 * RETURN "RESTORE OK"
|
|
BRA PUTVAL
|
|
|
|
* SOMETHING WRONG, FAIL ...
|
|
|
|
RESX12 BSR CLSSFL * CLOSE THE FILE
|
|
RESX13 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
RESERR CLR.W D0 * RETURN "RESTORE FAILED"
|
|
BRA PUTVAL
|
|
|
|
* FATAL ERROR: BAD ZORKID
|
|
|
|
RESX14 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE
|
|
MOVE.W (SP)+,D0 * BAD VERSION ID
|
|
|
|
RESX15 LEA MSGRE2,A0
|
|
BRA FATAL * 'Wrong save file version'
|
|
SECTION ZDATA
|
|
MSGRE2 DC.B 'Wrong save file version',0
|
|
SECTION ZCODE
|
|
|
|
* FATAL ERROR: RESTORE READ ERROR
|
|
|
|
RESX16 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE AND DIE
|
|
MOVE.W (SP)+,D0 * ERROR CODE
|
|
|
|
LEA MSGRE1,A0
|
|
BRA FATAL * 'Save file read error'
|
|
SECTION ZDATA
|
|
MSGRE1 DC.B 'Save file read error',0
|
|
SECTION ZCODE
|
|
|
|
* ----------------------
|
|
* OPRSTT
|
|
* ----------------------
|
|
|
|
* RESTART (THE GAME)
|
|
|
|
OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT
|
|
CLR.W LINES(A6) * RESET THE [MORE] COUNTER
|
|
|
|
TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN?
|
|
BNE.S RSTTX1 * YES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED)
|
|
|
|
RSTTX1 MOVEQ #-1,D0
|
|
BSR OPCLEAR * CLEAR (AND UNSPLIT) SCREEN
|
|
BRA RESTRT * SKIP MOST INITIALIZATIONS
|
|
|
|
* ----------------------
|
|
* OPQUIT
|
|
* ----------------------
|
|
|
|
* QUIT
|
|
|
|
OPQUIT BRA FINISH * DIE PEACEFULLY
|
|
|
|
* ----------------------
|
|
* OPVERI
|
|
* ----------------------
|
|
|
|
* VERIFY (GAME FILE)
|
|
|
|
OPVERI
|
|
IFEQ CZIP * VERSION INFO FOR ZIP ONLY
|
|
LEA MSGVER,A0
|
|
BSR OUTMSG0 * 'Macintosh interpreter version '
|
|
SECTION ZDATA
|
|
MSGVER DC.B 'Macintosh interpreter version ',0
|
|
SECTION ZCODE
|
|
|
|
MOVE.W INTWRD,D0 * DISPLAY THE LETTER (LOW BYTE)
|
|
BSR OPPRNC
|
|
BSR OPCRLF
|
|
ENDC
|
|
|
|
TST.W SUBVER * DISPLAY SUB-VERSION ONLY IF NON-ZERO
|
|
BEQ.S VERX0
|
|
|
|
LEA MSGVR2,A0
|
|
BSR OUTMSG0 * 'Sub-version '
|
|
SECTION ZDATA
|
|
MSGVR2 DC.B 'Sub-version ',0
|
|
SECTION ZCODE
|
|
|
|
MOVE.W SUBVER,D0 * DISPLAY THE SUB-VERSION NUMBER
|
|
BSR OPPRNN
|
|
BSR OPCRLF
|
|
|
|
VERX0 TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN?
|
|
BNE.S VERX05 * YES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED)
|
|
|
|
VERX05 MOVE.L BUFFER(A6),A0
|
|
MOVE.W PLENTH(A0),D0 * GET LENGTH OF GAME FILE
|
|
|
|
IFEQ EZIP
|
|
BSR BSPLTQ
|
|
ENDC
|
|
IFEQ CZIP
|
|
BSR BSPLIT
|
|
ENDC
|
|
MOVE.W D0,D4 * THIS IS FINAL BLOCK
|
|
MOVE.W D1,D5 * FINAL BYTE
|
|
|
|
CLR.W D0 * STARTING BLOCK NUMBER
|
|
MOVEQ #64,D1 * STARTING BYTE NUMBER
|
|
CLR.W D3 * CHECKSUM HERE
|
|
MOVE.W ENDLOD(A6),-(SP)
|
|
CLR.W ENDLOD(A6) * FORCE LOADING FROM DISK
|
|
|
|
VERX1 BSR GETBYT * GET NEXT BYTE
|
|
ADD.W D2,D3 * ADD IN TO CHECKSUM
|
|
CMP.W D0,D4 * DONE YET?
|
|
BNE VERX1 * NO
|
|
CMP.W D1,D5 * MAYBE
|
|
BNE VERX1 * NO
|
|
|
|
MOVE.W (SP)+,ENDLOD(A6) * YES, RESTORE PROPER ENDLOD
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PCHKSM(A0),D0 * GET THE REAL CHECKSUM
|
|
CMP.W D0,D3
|
|
BNE.S VERX2 * ERROR
|
|
|
|
BRA PTRUE * SUCCESS
|
|
VERX2 BRA PFALSE * FAILURE
|
|
|
|
* ----------------------
|
|
* OPORIG
|
|
* ----------------------
|
|
|
|
* ORIGINAL (NOT A COPY) GAME DISK?
|
|
|
|
OPORIG BRA PTRUE * <Mac> NO COPY-PROTECTION, SO ALWAYS TRUE
|
|
|