github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-01-11 23:43:24 +00:00
Code Issues Packages Projects Releases Wiki Activity
erkyrath.infocom-zcode-terps/amiga/zip2.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

2026 lines
51 KiB
NASM
Raw Permalink Blame History

PAGE
* ----------------------------------------------------------------------------
* ARITHMETIC OPERATIONS
* ----------------------------------------------------------------------------
OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2
BRA PUTVAL * RETURN THE VALUE
OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1
BRA PUTVAL * RETURN THE VALUE
OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED)
BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW
* DIVIDE BY ZERO, MOD ZERO, & RANDOM ZERO GENERATE 68K ERROR 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 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
IFEQ EZIP
TST.W D0 * DISABLE RANDOMNESS NOW?
BLT 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 RANDOM 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) * UPDATE HIGH SEED
MOVE.W RSEED1(A6),D1 * THIS IS THE RANDOM VALUE
BRA RANDX4
IFEQ EZIP
* RANDOMNESS DISABLED, GENERATE A CYCLIC VALUE
RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE
RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT (ZERO FOR NORMAL)
MOVE.W D0,RCOUNT(A6) * INITIALIZE COUNTER (SEQ BEGINS NEXT PASS)
MOVEQ #1,D0
BRA.S RANDX5 * ALWAYS RETURN A ONE (IGNORED?)
RANDX3 ADDQ.W #1,RCOUNT(A6) * GENERATE NEXT VALUE IN SEQUENCE (0 TO N-1)
MOVE.W RCOUNT(A6),D1
CMP.W RCYCLE(A6),D1 * EXCEEDED THE UPPER LIMIT YET?
BLT.S RANDX4 * NO
CLR.W D1 * YES, RESTART THE SEQUENCE
MOVE.W D1,RCOUNT(A6)
ENDC
* TRANSFORM RANDOM VALUE TO REQUESTED RANGE, AND RETURN IT
RANDX4 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
RANDX5 BRA PUTVAL * RETURN THE VALUE
OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2?
BLT PTRUE * YES, PREDICATE TRUE
BRA PFALSE * NO, PREDICATE FALSE
OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2?
BGT PTRUE * YES, PREDICATE TRUE
BRA PFALSE * NO, PRECICATE FALSE
* 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 OR.W D1,D0 * LOGICAL "OR"
BRA PUTVAL * RETURN THE VALUE
OPBCOM NOT.W D0 * LOGICAL COMPLEMENT
BRA PUTVAL * RETURN THE VALUE
OPBAND AND.W D1,D0 * LOGICAL "AND"
BRA PUTVAL * RETURN THE VALUE
* 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 TST.W D0 * IS OPR ZERO?
BEQ PTRUE * YES, PREDICATE TRUE
BRA PFALSE * NO, PREDICATE FALSE
PAGE
* ----------------------------------------------------------------------------
* OBJECT-RELATED PRIMITIVES
* ----------------------------------------------------------------------------
* 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
* 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
* 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
* ----------------------------------------------------------------------------
* 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
* 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
* 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
* 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
* 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
* 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
* 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
* *** ASSUME 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
* 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
* *** ASSUME 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
* 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
* -----------------------------------------------------------------------------
* 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
* 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
* 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
* 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
* ----------------------------------------------------------------------------
* GET (GET THE ITEM'TH WORD FROM TABLE)
* BECAUSE WE ARE NOT NECESSARILY LOOKING AT PRELOADED STUFF, WE SPLIT
* THE POINTER AND GO THROUGH PAGING
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
* 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
* PUT (REPLACE THE ITEM'TH WORD IN TABLE)
* BY DEFINITION, PUT CAN AFFECT ONLY PRELOADED AND IMPURE DATA
* A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER, AND !MAY!
* IN SOME CASES EXCEED 32K.
OPPUT ASL.W #1,D1 * WORD OFFSET
ADD.W D1,D0 * INDEX INTO TABLE
ANDI.L #$FFFF,D0 * ZERO THE HIGH WORD
MOVE.L D0,A0
ADD.L BUFFER(A6),A0 * ABSOLUTIZE POINTER
MOVE.W D2,D0
BRA PTAWRD * STORE THE WORD
* 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
* 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
* 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
IFEQ EZIP
* INTBL? (IS ANY IN TABLE OF LENGTH INT?)
OPINTBL NOP * USE ARGBLOCK
MOVE.W ARG2(A0),D0 * RELATIVE BYTE ADDRESS OF TABLE
BSR BSPLTB * SPLIT IT
MOVE.W ARG1(A0),D3 * VALUE TO SEARCH FOR (WORD)
MOVE.W ARG3(A0),D4 * LENGTH OF TABLE (WORDS)
ITBX1 BSR GETWRD * GET NEXT TABLE ITEM IN D2
CMP.W D2,D3 * MATCH?
BEQ.S ITBX2 * YES
SUBQ.W #1,D4 * END OF TABLE?
BGT ITBX1 * NO, CONTINUE SEARCH
CLR.W D0 * FAILED, RETURN ZERO
BSR PUTVAL
BRA PFALSE * PREDICATE FALSE
ITBX2 ASL.W #8,D0 * SUCCESS, UNSPLIT THE POINTER
ASL.W #1,D0
ADD.W D1,D0
SUBQ.W #2,D0 * BACK UP TWO BYTES, SINCE GETWRD ADVANCES
BSR PUTVAL * RETURN THE RELATIVE POINTER
BRA PTRUE * PREDICATE TRUE
ENDC
IFEQ CZIP
OPINTBL BRA OPERR * THIS FUNCTION UNDEFINED IN ZIP
ENDC
PAGE
* ----------------------------------------------------------------------------
* VARIABLE OPERATIONS
* ----------------------------------------------------------------------------
* VALUE (GET VALUE OF VARIABLE)
OPVALU BSR GETVAR * GET THE VALUE
BRA PUTVAL * AND RETURN IT
* SET (VAR TO VALUE)
OPSET BRA PUTVAR * STORE THE VALUE
* PUSH (A VALUE ONTO THE GAME STACK)
OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE
RTS
* POP (A VALUE OFF THE GAME STACK INTO VAR)
OPPOP MOVE.W (A4)+,D1 * POP A VALUE
BRA PUTVAR * AND STORE IT
* 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
* 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
* 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
* 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
* ---------------------------------------------------------------------------
* I/O OPERATIONS -- INPUT
* ---------------------------------------------------------------------------
* READ (A LINE OF INPUT AND TOKENIZE IT)
OPREAD NOP * USE AN ARGUMENT BLOCK
MOVEQ #0,D0
MOVE.W ARG1(A0),D0 * INPUT BUFFER POINTER
ADD.L BUFFER(A6),D0 * ABSOLUTIZE IT
MOVE.L D0,RDBOS(A6) * SAVE IT
MOVEQ #0,D1
MOVE.W ARG2(A0),D1 * RETURN BUFFER POINTER
ADD.L BUFFER(A6),D1 * ABSOLUTIZE IT
MOVE.L D1,RDRET(A6) * SAVE IT
IFEQ CZIP
BSR OPUSL * UPDATE STATUS LINE
ENDC
*** GATHER THE INPUT LINE ...
** JSR RESETMORE * PREVENT AN UNNEEDED **MORE**
IFEQ DEBUG
MOVE.L DBTOT1(A6),D0 * TOTAL PAGE FAULTS
BSR OPPRNN * SHOW USER (LOW WORD ONLY)
MOVE.B #'>',D0
BSR OPPRNC
ENDC
MOVE.W #1,LINES(A6) * RESET COUNTER, PREVENTS A DEGENERATE [MORE]
BSR PUTLIN * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT)
MOVE.L RDBOS(A6),A0 * BEGINNING OF INPUT LINE BUFFER
CLR.W D0
MOVE.B (A0)+,D0 * BUFFER LENGTH (MAX CHARACTERS TO GET)
* LIMIT USER INPUT TO ONE LINE MAX (TO AVOID SCROLLING THE STATUS LINE)
MOVE.W _columns,D1
SUBQ.W #1,D1 * ALLOW FOR PROMPT (>) IN FIRST COLUMN
CMP.W D0,D1 * LESS THAN BUFFER SIZE?
BGE.S RDX0 * NO
MOVE.W D1,D0 * YES, USE THE SMALLER VALUE
RDX0 MOVEQ #1,D1 * REQUEST LOWER-CASE CONVERSIONS
MOVE.L A0,-(SP)
BSR RDLINE
MOVE.L (SP)+,A0
ADDA.W D0,A0 * END OF CURRENT INPUT LINE
MOVE.L A0,RDEOS(A6) * SAVE IT
*** WORDIFY THE INPUT LINE ...
MOVE.L A4,-(SP) * SAVE THE GAME SP
MOVE.L RDBOS(A6),A2
ADDQ.L #1,A2 * START OF INPUT BUFFER, SKIP LENGTH BYTE
MOVE.L RDRET(A6),A4
ADDQ.L #2,A4 * RETURN BUFFER, SKIP MAX WORDS AND NWORDS
CLR.B RDNWDS(A6) * NO WORDS FOUND INITIALLY
RDX1 LEA RDWSTR(A6),A3 * HERE FOR NEXT WORD, POINT TO EMPTY BUFFER
MOVE.L A2,RDBOW(A6) * BEGINNING OF NEXT WORD
RDX2 CMPA.L RDEOS(A6),A2 * END OF INPUT STRING?
BNE.S RDX3 * NO
LEA RDWSTR(A6),A0 * YES, GET WORD STRING POINTER
CMPA.L A3,A0 * WAS A WORD FOUND?
BEQ RDX10 * NO, WE'RE DONE
BRA.S RDX8 * YES, MUST STILL LOOKUP WORD
RDX3 MOVE.B (A2)+,D0 * GET NEXT CHAR FROM INPUT BUFFER
MOVE.L RBRKS(A6),A1 * POINTER, LIST OF READ-BREAK CHARACTERS
RDX4 CMP.B (A1)+,D0 * SEARCH LIST FOR THIS ONE
BEQ.S RDX5 * FOUND IT
TST.B (A1) * END OF LIST?
BNE.S RDX4 * NO, CONTINUE SEARCH
LEA RDWSTR(A6),A0 * IT'S NOT A BREAK CHAR
ADDA.W #VCHARS,A0 * END OF WORD STRING BUFFER (ZIP OR EZIP)
CMPA.L A0,A3 * FULL YET?
BEQ.S RDX2 * YES, FLUSH CHAR & LOOP UNTIL BREAK IS FOUND
MOVE.B D0,(A3)+ * NO, TACK THIS CHAR ONTO STRING
BRA.S RDX2 * AND LOOP FOR NEXT
*** BREAK CHAR FOUND ...
RDX5 LEA RDWSTR(A6),A0
CMPA.L A3,A0 * WORD READ BEFORE THIS BREAK?
BNE.S RDX7 * YES, GO FOR IT
CMPA.L ESIBKS(A6),A1 * NO, BUT WAS THIS A SELF-INSERTING BREAK?
BHI.S RDX1 * NO, GO FOR NEXT WORD
MOVE.B D0,(A3)+ * YES, STORE THE BREAK IN WORD STRING
BRA.S RDX8 * AND GO FOR THE ZWORD
RDX7 SUBQ.L #1,A2 * UNREAD TERMINATING BREAK IN CASE IT WAS SI
RDX8 ADDQ.B #1,RDNWDS(A6) * INCREMENT FOUND WORD COUNT
MOVE.B RDNWDS(A6),D0 * GET NEW COUNT
MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER (1ST BYTE MAX WORDS)
CMP.B (A0),D0 * FOUND WORD COUNT GREATER THAN MAX ALLOWED?
BLE.S RDX9 * NO
BSR PUTNEW * YES, INFORM LOSER
LEA MSGIO1,A0
BSR OUTMSG0 * '[Too many words ...'
SECTION ZDATA
MSGIO1 DC.B '[Too many words typed, discarding "',0
SECTION ZCODE
MOVE.L RDEOS(A6),A1 * END OF INPUT STRING (+1)
MOVE.B (A1),-(SP) * SAVE THIS BYTE TO BE SAFE
CLR.B (A1) * MAKE STRING ASCIZ
MOVE.L RDBOW(A6),A0 * START OF FLUSHED WORD/STRING
BSR OUTMSG0 * ECHO IT
MOVE.B (SP)+,(A1) * RESTORE LAST BYTE
LEA MSGIO2,A0
BSR OUTMSG * '."]'
SECTION ZDATA
MSGIO2 DC.B '."]',0
SECTION ZCODE
BSR PUTNEW
SUBQ.B #1,RDNWDS(A6) * THE LATEST WORD IS FLUSHED
BRA RDX10 * AND WE'RE DONE
*** BUILD THE ZWORD TABLE ...
RDX9 MOVE.L A2,D0 * CALCULATE NUMBER OF CHARS IN CURRENT WORD
SUB.L RDBOW(A6),D0
MOVE.B D0,2(A4) * STORE THE NUMBER IN RETURN TABLE
MOVE.L RDBOW(A6),D0 * CALCULATE BYTE OFFSET OF BEGINNING OF WORD
SUB.L RDBOS(A6),D0
MOVE.B D0,3(A4) * STORE THAT NUMBER TOO
CLR.B (A3) * MAKE WORD STRING ASCIZ
LEA RDWSTR(A6),A1
LEA RDZSTR(A6),A0
BSR ZWORD * AND CONVERT TO (2 OR 3 WORD) ZWORD
LEA RDZSTR(A6),A0
BSR LOOKUP * SEARCH VOCAB TABLE FOR ZWORD, RETURN OFFSET
MOVE.L A4,A0 * CURRENT RETURN TABLE SLOT
BSR PTAWRD * STORE THE OFFSET
ADDQ.L #4,A4 * UPDATE THE TABLE POINTER FOR NEXT WORD
BRA RDX1 * GO FOR IT
RDX10 MOVE.L RDRET(A6),A0 * DONE, GET RETURN TABLE POINTER
MOVE.B RDNWDS(A6),1(A0) * STORE THE NUMBER OF WORDS FOUND
MOVE.L (SP)+,A4 * RESTORE THE GAME SP
RTS
* ---------------------------------------------------------------------------
* READ PRIMITIVES
* ---------------------------------------------------------------------------
* GATHER A LINE OF INPUT, BUFFER IN A0, BUFFER LENGTH IN D0
* IF D1 IS NON-ZERO, CONVERT ALL UPPERCASE LETTERS TO LOWER CASE
* RETURN LENGTH OF INPUT IN D0
EOLCHR EQU $0D * CARRIAGE RETURN IS END-OF-LINE
DELCHR EQU $08 * BACKSPACE IS DELETE
RDLINE MOVEM.L A1-A3,-(SP)
CLR.W CHRTOT(A6) * INIT COUNT OF CHARS READ (FOR BACKSPACE)
MOVE.L A0,A1 * START OF BUFFER IN A1
MOVE.L A1,A2 * KEEP CURRENT BUFFER POINTER IN A2
MOVE.L A2,A3
ADDA.W D0,A3 * END OF BUFFER (+1) IN A3
BSR UNHIDE * AMIGA: MAKE SURE GAME-SCREEN IS IN FRONT
RDLX1 BSR GETCHR * INPUT A CHARACTER
RDLX2 CMPI.B #EOLCHR,D0 * END OF LINE?
BEQ.S RDLX6 * YES
CMPI.B #DELCHR,D0 * BACKSPACE?
BNE.S RDLX3 * NO, NORMAL CHAR
CMPA.L A1,A2 * YES, ANYTHING TO DELETE?
BEQ RDLX1 * NO, JUST LOOP
SUBQ.L #1,A2 * YES, BACK UP BUFFER POINTER
SUBQ.W #1,CHRTOT(A6) * AND DECREASE COUNTER
BRA.S RDLX1
RDLX3 MOVE.B D0,(A2)+ * STORE CHAR
ADDQ.W #1,CHRTOT(A6) * AND BUMP CHAR COUNTER
CMPA.L A3,A2 * BUFFER FULL YET?
BLT RDLX1 * NO, LOOP UNTIL EOL
* BUFFER FULL, WAIT FOR CR OR BS ...
CLR.W VIECHO(A6) * TURN OFF ECHO TEMPORARILY
RDLX4 BSR GETCHR * GET A CHAR
CMPI.B #EOLCHR,D0 * END OF LINE?
BEQ.S RDLX5 * YES
CMPI.B #DELCHR,D0 * BACKSPACE?
BEQ.S RDLX5 * YES
MOVEQ #2,D0 * BOOP AT USER
BSR DOSOUND
BRA.S RDLX4 * REJECT EVERYTHING ELSE, JUST WAIT
RDLX5 MOVE.W D0,-(SP)
BSR TTYOUT * GOT CR OR BACKSPACE, NOW ECHO IT
MOVE.W (SP)+,D0
MOVE.W #1,VIECHO(A6) * RESTORE NORMAL ECHO
BRA RDLX2 * AND HANDLE THE CHAR
* END OF INPUT, SCRIPT IT ** THEN ** CHECK FOR LOWER CASE
RDLX6 MOVE.L A1,A0 * SCRIPT THE INPUT LINE IF REQUIRED
MOVE.L A2,D0
BSR SCRINP
BSR RESIZE * CHECK IF WINDOW SIZE WAS CHANGED
TST.W D1 * WERE LOWER-CASE CONVERSIONS REQUESTED?
BEQ.S RDLX9 * NO
MOVE.L A1,A0 * YES, BUFFER STARTS HERE
RDLX7 CMPA.L A2,A0 * ANY MORE CHARS IN BUFFER?
BGE.S RDLX9 * NO
MOVE.B (A0),D0 * YES, GET NEXT
CMPI.B #'A',D0 * UPPERCASE CHAR?
BLT.S RDLX8 * NO
CMPI.B #'Z',D0
BGT.S RDLX8 * NO
ADDI.B #32,D0 * YES, LOWERCASIFY IT
RDLX8 MOVE.B D0,(A0)+ * STORE AND ADVANCE
BRA.S RDLX7
RDLX9 MOVE.L A2,D0
SUB.L A1,D0 * RETURN LENGTH OF INPUT
MOVEM.L (SP)+,A1-A3
RTS
* SEARCH VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0
* RETURN ZWORD'S TABLE OFFSET (RELATIVIZED) IN D0.W, NULL IF NOT FOUND
* NEW APPROACH: USE PAGING CALLS, SO THAT VOCAB TABLE MAY BE NON-PRELOADED
* VOCBEG(A6) AND VOCEND(A6) ARE NOW RELATIVE POINTERS
LOOKUP MOVEM.L D1-D3/A1-A2,-(SP)
MOVE.L A0,A1 * SAVE POINTER TO GIVEN ZWORD HERE
MOVE.W VWORDS(A6),D0 * NUMBER OF VOCABULARY WORDS
MOVE.W VWLEN(A6),D3 * NUMBER OF BYTES PER VOCAB ENTRY
ASR.W #1,D0
LKX2 ASL.W #1,D3 * CALCULATE INITIAL OFFSET FOR BINARY SEARCH
ASR.W #1,D0
BNE.S LKX2
MOVE.L VOCBEG(A6),A2 * (RELATIVE) BEGINNING OF VOCAB WORD TABLE
ADDA.W D3,A2 * ADD INITIAL OFFSET
SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG FOR EXACT-POWER-OF-2 TABLE
LKX4 ASR.W #1,D3 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
MOVE.W A2,D0
BSR BSPLTB * COMPUTE BLOCK AND BYTE OFFSET IN D0/D1
BSR GETWRD * GET FIRST WORD FROM VOCAB TABLE IN D2
CMP.W (A1),D2 * COMPARE IT TO DESIRED ONE
BCS.S LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
BHI.S LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
BSR GETWRD * SAME, GET SECOND WORD
CMP.W 2(A1),D2 * COMPARE IT TO DESIRED ONE
BCS.S LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
BHI.S LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
IFEQ EZIP
BSR GETWRD * SAME, GET THIRD WORD
CMP.W 4(A1),D2 * COMPARE IT TO DESIRED ONE
BCS.S LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
BHI.S LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
ENDC
MOVE.W A2,D0 * SAME, WE'VE FOUND IT, RETURN IT
BRA.S LKX12
LKX6 ADDA.W D3,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 D3,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET
LKX10 CMP.W VWLEN(A6),D3 * IS OFFSET RESOLUTION AT LEAST ONE WORD?
BGE LKX4 * YES, CONTINUE LOOP
CLR.W D0 * NO, WORD NOT FOUND, SO RETURN ZERO
LKX12 MOVEM.L (SP)+,D1-D3/A1-A2
RTS
PAGE
IFEQ EZIP
OPUSL BRA OPERR * NOT AN INSTRUCTION
ENDC
IFEQ CZIP
* ---------------------------------------------------------------------------
* STATUS LINE EQUATES
* ---------------------------------------------------------------------------
MOVVAR EQU 18 * NUMBER-OF-MOVES GLOBAL
SCRVAR EQU 17 * SCORE VARIABLE
RMVAR EQU 16 * CURRENT ROOM VARIABLE
SECTION ZDATA
ZSCORE DC.B 'Score: ',0
ZTIME DC.B 'Time: ',0
SECTION ZCODE
* ---------------------------------------------------------------------------
* STATUS LINE PRIMITIVES
* ---------------------------------------------------------------------------
* STATUS LINE OUTPUT FUNCTION -- QUEUE THE CHARACTER IN D0
* (CALLED THROUGH OPPRND AND OPPRNN)
PUTSL MOVE.L SLPTR(A6),A0 * GET CURRENT SL POSITION
MOVE.B D0,(A0)+ * QUEUE THE CHAR
MOVE.L A0,SLPTR(A6) * UPDATE CURRENT SL POSITION
RTS
* GIVEN A ASCIZ POINTER IN A1, QUEUE THE STRING IN THE STATUS LINE
QSTR1 BSR PUTSL * QUEUE A CHAR
QSTR MOVE.B (A1)+,D0 * GET NEXT CHARACTER, END OF STRING?
BNE.S QSTR1 * NO
RTS
* USL (UPDATE STATUS LINE) (DESTROYS REGISTERS)
OPUSL MOVE.W #1,VOSTAT(A6) * SWITCH ALL OUTPUT TO STATUS LINE
SUBA.W #256,SP * CREATE A TEMP BUFFER FOR SL
MOVE.L SP,LOCPTR(A6) * LOCATION STRING STARTS HERE
MOVE.L SP,SLPTR(A6) * INIT OUTPUT POINTER
MOVE.B #' ',D0
BSR PUTSL * INDENT BY ONE SPACE
MOVEQ #RMVAR,D0
BSR GETVAR * GET CURRENT ROOM
BSR OPPRND * QUEUE ITS SHORT DESCRIPTION
* QUEUE THE SCORE/TIME STRING ...
MOVE.L SLPTR(A6),SCOPTR(A6) * SCORE STRING STARTS HERE
TST.W TIMEMD(A6) * ARE WE IN TIME MODE?
BNE.S USLX2 * YES
LEA ZSCORE,A1 * NO, SCORE MODE
BSR QSTR * QUEUE "SCORE"
MOVEQ #SCRVAR,D0
BSR GETVAR * GET THE SCORE
BSR OPPRNN * AND QUEUE IT
MOVE.B #'/',D0
BSR PUTSL * QUEUE A SEPARATOR (/)
MOVEQ #MOVVAR,D0
BSR GETVAR * GET THE NUMBER OF MOVES
BSR OPPRNN * AND QUEUE IT
BRA.S USLX6
USLX2 LEA ZTIME,A1
BSR QSTR * QUEUE "TIME"
MOVEQ #SCRVAR,D0
BSR GETVAR * GET HOUR
MOVE.B #'a',D2 * ASSUME AM
CMPI.W #12,D0 * PM?
BLT.S USLX4 * NO
BEQ.S USLX3 * YES, BUT 12 PM IS SPECIAL
SUBI.W #12,D0 * CONVERT TO 12-HOUR TIME
USLX3 MOVE.B #'p',D2 * CHANGE OUR EARLIER ASSUMPTION TO PM
USLX4 TST.W D0 * BUT 00 SHOULD BE 12 AM
BNE.S USLX5
MOVEQ #12,D0
USLX5 MOVE.W D2,-(SP) * PROTECT AM/PM INDICATOR
BSR OPPRNN * QUEUE THE HOUR
MOVE.B #':',D0
BSR PUTSL * QUEUE A SEPARATOR (:)
MOVEQ #MOVVAR,D0
BSR GETVAR * GET MINUTES
EXT.L D0
DIVU #10,D0 * OUTPUT MINUTES IN TWO DIGITS
MOVE.L D0,-(SP) * SAVE SECOND DIGIT (REMAINDER)
ADDI.B #'0',D0
BSR PUTSL * QUEUE FIRST DIGIT (QUOTIENT)
MOVE.L (SP)+,D0
SWAP D0 * RESTORE SECOND DIGIT
ADDI.B #'0',D0
BSR PUTSL * QUEUE SECOND DIGIT
MOVEQ #32,D0
BSR PUTSL * SPACE
MOVE.W (SP)+,D0
BSR PUTSL * AM OR PM
MOVE.B #'m',D0
BSR PUTSL
USLX6 MOVE.B #' ',D0
BSR PUTSL * END SCORE/TIME WITH ONE BLANK SPACE
*** DISPLAY THE STRINGS, POINTERS IN A0-A1, LENGTHS IN D0-D1
MOVE.L LOCPTR(A6),A0
MOVE.L SCOPTR(A6),A1
MOVE.L A1,D0
MOVE.L SLPTR(A6),D1
SUB.L A0,D0 * LENGTH OF LOCATION STRING
SUB.L A1,D1 * LENGTH OF SCORE STRING
BSR STLINE * GO DIRECTLY TO SCREEN DISPLAY
ADDA.W #256,SP * FLUSH THE TEMP BUFFER
CLR.W VOSTAT(A6) * TURN OFF STATUS LINE OUTPUT
RTS
ENDC
PAGE
* ---------------------------------------------------------------------------
* I/O OPERATIONS -- OUTPUT
* ---------------------------------------------------------------------------
* PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
OPPRNC BRA PUTCHR * HANDLE IT
* 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
* 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
* PRINTB (THE STRING POINTED TO)
OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE)
BRA PUTSTR * PRINT THE STRING
* 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
* 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
* PRINTR (PRINTI FOLLOWED BY RTRUE)
OPPRNR BSR OPPRNI * DO A PRINTI
BSR OPCRLF * A CRLF
BRA OPRTRU * AND AN RTRUE
* CRLF (DO A NEWLINE)
OPCRLF BRA PUTNEW * DO A NEWLINE
PAGE
* ---------------------------------------------------------------------------
* MORE ZIP I/O
* ---------------------------------------------------------------------------
* SPLIT/UNSPLIT THE SCREEN
OPSPLT
IFEQ CZIP
ADDQ.W #1,D0 * ALLOW ROOM FOR STATUS LINE
ENDC
* MOVE.W _split_row,D1 * GET OLD VALUE
MOVE.W D0,_split_row * RESET SPLIT POINT
* *** AUTO-CLEARING FUNCTION HAS BEEN REMOVED FROM EZIP SPEC ...
* CMP.W D1,D0 * IS WINDOW 1 GROWING?
* BLE SPLTX1 * NO, DO NOT CLEAR
IFEQ CZIP
* ALWAYS CLEAR WINDOW 1 (ZIP ONLY!)
MOVE.L D0,-(SP) * LAST ROW TO CLEAR (+1)
MOVEQ #1,D1
MOVE.L D1,-(SP) * FIRST ROW, ALLOW FOR STATUS LINE
JSR _clear_lines
ADDQ.W #8,SP * FLUSH STACK (4 ACTUAL)
ENDC
SPLTX1 RTS
* MAKE OUTPUT FALL INTO SPECIFIED WINDOW
OPSCRN TST.W D0 * OUTPUT TO WINDOW 0?
BEQ.S SCRNX1 * YES
CMPI.W #1,D0 * OUTPUT TO WINDOW 1?
BEQ.S SCRNX2 * YES
BRA.S SCRNX5 * INVALID ARG, DO NOTHING
* MOVE CURSOR INTO WINDOW 0, RESTORE OLD CURSOR POSITION
SCRNX1 TST.W WIND1(A6) * ALREADY IN WINDOW 0?
BEQ.S SCRNX5 * YES, DO NOTHING
CLR.W WIND1(A6) * NO
MOVE.W OLDWY(A6),D0 * ROW TO RESTORE
MOVE.W OLDWX(A6),D1 * COLUMN TO RESTORE
BRA.S SCRNX4
* MOVE CURSOR INTO WINDOW 1, SAVE OLD CURSOR POSITION IF REQUIRED
SCRNX2 TST.W WIND1(A6) * ALREADY IN WINDOW 1?
BNE.S SCRNX3 * YES
MOVE.W #1,WIND1(A6) * NO, MUST SAVE OLD POSITION
BSR GETCUR
MOVE.W D0,OLDWY(A6) * REMEMBER OLD ROW
MOVE.W D1,OLDWX(A6) * REMEMBER OLD COLUMN
SCRNX3 CLR.W D0 * MOVE CURSOR TO TOP LEFT
CLR.W D1
IFEQ CZIP
ADD.W #1,D0 * ALLOW FOR STATUS LINE
ENDC
SCRNX4 BSR SETCUR * UPDATE CURSOR POSITION
SCRNX5 RTS
* ---------------------------------------------------------------------------
* TIMEOUT PRIMITIVES
* ---------------------------------------------------------------------------
* RESET THE TIMEOUT COUNTER
TRESET BSR TIME60 * GET A REFERENCE TIME (IN 60THS)
MOVE.L D0,TBEGIN(A6) * SAVE IT
RTS
* RETURN THE TIME REMAINING BEFORE NEXT TIMEOUT (ZERO/NEGATIVE IF NONE)
TCHECK BSR TIME60 * YES, GET CURRENT TIME (IN 60THS)
SUB.L TBEGIN(A6),D0 * THIS IS CURRENT DELAY
DIVU #6,D0 * SWITCH TO 10THS
SUB.W TDELAY(A6),D0 * CALCULATE THE TIME REMAINING
NEG.W D0
RTS
* ---------------------------------------------------------------------------
* EZIP I/O
* ---------------------------------------------------------------------------
IFEQ EZIP
* SET BUFFERING OF OUTPUT ACCORDING TO INT
OPBUFO 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
* NOTE: IF OUTPUT IS GOING INTO MAIN WINDOW (WINDOW 0), MUST EMPTY THE
* BUFFER WITHOUT CHANGING THE BUFFER COUNTER.
* IF OUTPUT IS GOING INTO THE SPLIT SCREEN (WINDOW 1), ** NO ** BUFFER
* ACTIVITY (EMPTYING OR ADDING, SEE ALSO QUECHR) SHOULD CHANGE THE COUNTER.
BUFOX2
* TST.W WIND1(A6) * ARE WE IN WINDOW 1? *** DEAD, SEE QUECHR
* BEQ.S BUFX2A * NO
* BSR PUTLIN * YES, FIRST EMPTY THE CURRENT OUTPUT BUFFER
* BRA.S BUFX2B * (AND ** DO ** RESET THE COUNTER)
BUFX2A BSR PUTLIN1 * FIRST EMPTY THE CURRENT OUTPUT BUFFER
BUFX2B CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING
BUFOX3 RTS
* 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
* 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 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.S DIRX5 * YES
BRA DIRX7 * 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.S DIRX6 * YES
BRA DIRX7 * UNKNOWN DEVICE, IGNORE REQUEST
*** TURN SCREEN OUTPUT ON, OFF
DIRX1 MOVE.W #1,VOCONS(A6)
BRA DIRX7
DIRX2 CLR.W VOCONS(A6)
BRA DIRX7
*** TURN SCRIPTING OUTPUT ON, OFF
DIRX3 MOVE.W #1,VOPRNT(A6)
MOVE.L BUFFER(A6),A0
BSET #0,PFLAGS+1(A0) * SET THIS FLAG (ZIP/EZIP) FOR GAME'S USE
BSR TSTSCR * ACTIVATE THE PRINTER (USES GAME FLAG)
BRA DIRX7
DIRX4 CLR.W VOPRNT(A6)
MOVE.L BUFFER(A6),A0
BCLR #0,PFLAGS+1(A0) * CLEAR THIS FLAG (ZIP/EZIP) FOR GAME'S USE
BSR TSTSCR * DE-ACTIVATE THE PRINTER (USES GAME FLAG)
BRA 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 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 NOP * TELL CALLER TO USE ARGBLK
*** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE
RTS
* INPUT (AN ASCII KEY, WITHOUT ECHO)
OPINPUT NOP * TELL CALLER TO USE ARGBLK
BSR PUTLIN * EMPTY THE BUFFER
* CLR.W TIMOUT(A6) * ASSUME NO TIMEOUTS
* CMPI.W #3,(A0) * ARE OPTIONAL TIMEOUTS IN EFFECT?
* BNE.S INPTX1 * NO
* MOVE.W #1,TIMOUT(A6)
* MOVE.W ARG2(A0),TDELAY(A6) * DELAY IN 10THS OF A SECOND
* MOVE.W ARG3(A0),TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT
* BSR TRESET * RESET THE TIMER
* MAIN LOOP STARTS HERE ...
INPTX1 BSR TTYIN * WAIT FOR A KEY
* TST.B D0
* BNE.S INPTX2 * GOT SOMETHING, EXIT
* TST.W TIMOUT(A6) * TIMOUTS IN EFFECT?
* BEQ.S INPTX1 * NO
* BSR TCHECK * GET TIME REMAINING BEFORE NEXT TIMEOUT
* TST.W D0 * HAS IT RUN OUT?
* BGT.S INPTX1 * NO
* BSR TRESET * YES, RESET TIMER
* MOVE.W TFUNC(A6),D0 * CALL THE TIMEOUT FUNCTION
* BSR INCALL
* TST.W D0 * RETURNED VALUE -- ABORT INPUT?
* BEQ.S INPTX1 * NO, CONTINUE WAITING
INPTX2 BRA PUTVAL * RETURN ASCII VALUE
* ---------------------------------------------------------------------------
* CLEAR A WINDOW, OR ENTIRE SCREEN
OPCLEAR SUBQ.W #1,D0 * WINDOW 1 ONLY?
BEQ.S CLRX2 * YES
ADDQ.W #1,D0 * WINDOW 0 ONLY?
BEQ.S CLRX1 * YES
ADDQ.W #1,D0 * ENTIRE SCREEN?
BNE.S CLRX4 * INVALID ARG, DO NOTHING
CLR.W D0 * YES,
BSR OPSPLT * FIRST UNSPLIT THE SCREEN (IF NEEDED)
*** ERROR OCCURS IN OPENING AMFV SCREEN, IF CURSOR NOT RESET ...
CLRX1 MOVE.W _rows,D0
SUBQ.W #1,D0 * cur_row in (0 .. rows-1)
CLR.W D1
BSR SETCUR * RESET CURSOR TO "NORMAL" POSITION
MOVE.W _split_row,D0 * CLEAR WINDOW 0
MOVE.W _rows,D1
BRA.S CLRX3
*** MOVE CURSOR TO "TOPLEFT" POSITION? (NOT IN SPEC)
CLRX2 CLR.W D0 * CLEAR WINDOW 1
MOVE.W _split_row,D1
* FIRST ROW TO CLEAR IN D0, LAST (+1) IN D1
CLRX3 MOVE.L D1,-(SP)
MOVE.L D0,-(SP)
JSR _clear_lines * DO IT
ADDQ.W #8,SP * FLUSH STACK (4 ACTUAL)
CLRX4 RTS
* ERASE (CURRENT LINE, STARTING AT CURSOR)
OPERASE SUBQ.W #1,D0
BNE.S ERASX1 * IGNORE ARG IF NOT 1
JSR _clear_eol
ERASX1 RTS
* SET CURSOR TO LINE INT1, COLUMN INT2
OPCURS TST.W WIND1(A6) * CURRENTLY IN WINDOW 1?
BNE.S CURSX1 * YES
ADD.W _split_row,D0 * NO, MUST MAKE LINE RELATIVE TO WINDOW 0
CURSX1 SUBQ.W #1,D0 * MAKE LINE AND COLUMN ZERO-ORIGIN
SUBQ.W #1,D1
MOVE.W D0,_cur_row * RESET THE GLOBALS
MOVE.W D1,_cur_column
MOVEM.L A4-A6,-(SP) * (THE ONLY VULNERABLE REGS)
JSR _write_cursor_pos
MOVEM.L (SP)+,A4-A6
RTS
* GET CURSOR POSITION
OPCURG BRA OPERR
*** THIS IS NOT CURRENTLY A DEFINED OPERATION ***
* MOVEM.L A4-A6,-(SP)
* JSR _read_cursor_pos
* MOVEM.L (SP)+,A4-A6
* MOVE.W _cur_row,D0 * GET THE GLOBALS
* MOVE.W _cur_column,D1
* ADDQ.W #1,D0 * MAKE LINE AND COLUMN ONE-ORIGIN
* ADDQ.W #1,D1
* TST.W WIND1(A6) * CURRENTLY IN WINDOW 1?
* BNE.S CURGX1 * YES
* SUB.W _split_row,D0 * NO, MUST MAKE LINE RELATIVE TO WINDOW 0
*CURGX1 ASL.W #8,D0 * RETURN LINE IN HIGH BYTE, COLUMN IN LOW (?)
* MOVE.B D1,D0
* BRA PUTVAL
* HIGHLIGHT (SET CHAR ATTRIBUTES)
OPATTR MOVE.L D0,-(SP)
BSR PUTLIN1 * MUST FIRST DUMP THE LINE BUFFER
JSR _highlight * 1 INVERSE, 2 BOLD, 4 ITALIC
ADDQ.W #4,SP * FLUSH STACK (2 ACTUAL)
RTS
ENDC
IFEQ CZIP * THESE FUNCTIONS ARE UNDEFINED IN ZIP
OPCLEAR BRA OPERR
OPERASE BRA OPERR
OPCURS BRA OPERR
OPCURG BRA OPERR
OPATTR BRA OPERR
OPBUFO BRA OPERR
OPDIRO BRA OPERR
OPDIRI BRA OPERR
OPINPUT BRA OPERR
ENDC
* MAKE A SOUND (NOW IN ZIP TOO)
* ARG1 = ID: 1=BEEP, 2=BOOP, 3+ ARE SPECIAL, 0=MRU
* [ARG2] = ACTION: 1=INIT, [2=START], 3=STOP, 4=CLEANUP
* [ARG3] = VOLUME: 0=MIN, 8=MAX, [-1=USE MIDI VOLUME]
OPSOUND NOP * REQUEST AN ARGBLK
MOVE.W ARG1(A0),D0 * SOUND ID
MOVEQ #2,D1 * DEFAULT ACTION = START
CMPI.W #2,(A0)
BLT.S SOUNX1
MOVE.W ARG2(A0),D1 * GIVEN ACTION
SOUNX1 MOVEQ #-1,D2 * DEFAULT VOL = MIDI VOL
CMPI.W #3,(A0)
BLT.S SOUNX2
MOVE.W ARG3(A0),D2 * GIVEN VOLUME
SOUNX2 BRA DOSOUND
PAGE
* ----------------------------------------------------------------------------
* CONTROL OPERATIONS
* ----------------------------------------------------------------------------
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS)
IFEQ EZIP
OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR THIS ONE
MOVE.W #1,(A0) * ONE ARG
MOVE.W D0,ARG1(A0)
OPCAL2 NOP * TELL CALLER TO USE ARGBLK
OPXCAL NOP * TELL CALLER TO USE ARGBLK
OPCALL NOP * TELL CALLER TO USE ARGBLK
ENDC
IFEQ CZIP
OPCAL1 BRA OPERR * FIRST THREE ARE UNDEFINED IN ZIP
OPCAL2 BRA OPERR
OPXCAL BRA OPERR
OPCALL NOP * TELL CALLER TO USE ARGBLK
ENDC
* POINTER TO ARGBLK IS IN A0 ...
MOVE.W (A0)+,D2
MOVE.W (A0)+,D0 * FUNCTION TO CALL -- IS IT ZERO?
BNE.S CALLX1 * NO
CLR.W D0 * YES, SIMPLY RETURN A ZERO
BRA PUTVAL
*** BUILD A STACK FRAME, THEN UPDATE THE ZPC ...
CALLX1 MOVE.L A0,A1
SUBQ.W #1,D2 * THIS IS NUMBER OF OPTIONAL LOCALS
MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC
MOVE.W ZPC2(A6),-(A4)
* (The relativized locs pointer ought to be stacked as a word instead of
* a long. Changing now would make previous saved games incompatible.)
MOVE.L ZLOCS(A6),D1 * SAVE OLD LOCALS POINTER
SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT IN CASE OF SAVE
MOVE.L D1,-(A4)
IFEQ EZIP
BSR BSPLTQ * SPLIT THE FUNCTION POINTER
ENDC
IFEQ CZIP
BSR BSPLIT * SPLIT THE FUNCTION POINTER
ENDC
MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC
MOVE.W D1,ZPC2(A6)
BSR NEWZPC * UPDATE ZPC STUFF
* (The new locs pointer ought to point to pseudo-loc 0, not 1. Ditto above.)
MOVE.L A4,ZLOCS(A6) * LOCALS WILL START AT NEXT STACK SLOT
SUBQ.L #2,ZLOCS(A6) * POINT TO LOCAL 1, IF ANY
*** CREATE SPACE FOR & INITIALIZE THE LOCALS ...
BSR NXTBYT * GET ACTUAL NUMBER OF DEFINED LOCALS
MOVE.W D0,D1
BEQ.S CALLX4 * EXIT IF NONE
CALLX2 BSR NXTWRD * GET THE NEXT LOCAL DEFAULT VALUE
SUBQ.W #1,D2 * BUT ARE THERE ANY MORE OPTIONAL VALUES?
BLT.S CALLX3 * NO, USE THE DEFAULT
MOVE.W (A1)+,D0 * OTHERWISE USE THE OPTIONAL
CALLX3 MOVE.W D0,-(A4) * CREATE LOCAL SPACE & INITIALIZE IT
SUBQ.W #1,D1 * ANY MORE LOCALS?
BGT.S CALLX2 * YES, LOOP
CALLX4 RTS
* RETURN (FROM CURRENT FUNCTION CALL)
OPRETU MOVE.L ZLOCS(A6),A4 * RESTORE OLD TOP OF STACK
ADDQ.L #2,A4
MOVE.L (A4)+,D1 * RESTORE OLD LOCALS POINTER
ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT
MOVE.L D1,ZLOCS(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
BSR NEWZPC * UPDATE ZPC STUFF
MOVE.W D1,D0
BRA PUTVAL * RETURN THE VALUE
* RTRUE
OPRTRU MOVEQ #1,D0 * RETURN A "1"
BRA.S OPRETU
* RFALSE
OPRFAL CLR.W D0 * RETURN A "0"
BRA.S OPRETU
* 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
* RSTACK (RETURN STACK)
OPRSTA MOVE.W (A4)+,D0 * POP A VALUE
BRA OPRETU * AND RETURN IT
* FSTACK (FLUSH A VALUE OFF THE STACK)
OPFSTA ADDQ.L #2,A4 * FLUSH ONE WORD
RTS
* NOOP (NO OPERATION)
OPNOOP RTS * DO NOTHING
* ---------------------------------------------------------------------------
IFEQ EZIP
* INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0
INCALL MOVEM.L D1-D7/A1-A3,-(SP)
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
BSR OPCALL * CALL THE TIMEOUT FUNCTION
BRA NXTINS * GO EXECUTE IT
* JUMP BACK TO HERE UPON NEXT OPRETURN ...
INRETU ADDQ.W #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
* ----------------------------------------------------------------------------
* SAVE (THE CURRENT STATE OF THE GAME)
OPSAVE CLR.W D0
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
BSR GETSFL * GET A NAME FOR THE SAVE FILE
BNE.S SVX4 * CANCELLED
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
BNE.S SVX4 * ERROR, JUST EXIT (NEED NOT DELETE)
* SUCCESS, SAVE STATE VARIABLES ON GAME STACK ...
MOVE.W ZPC1(A6),-(A4)
MOVE.W ZPC2(A6),-(A4)
MOVE.L ZLOCS(A6),-(A4)
MOVE.L STKBOT(A6),D0
SUB.L D0,(A4) * RELATIVIZE THIS ONE
MOVE.W ZORKID(A6),-(A4)
MOVE.L D0,A0
MOVE.L A4,(A0) * SAVE GAME SP IN KNOWN LOCATION
SUB.L D0,(A0) * RELATIVIZE IT TOO
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.S SVX2 * ERROR, CLOSE AND DELETE THE FILE
ADDA.W #10,A4 * RESET THE STACK POINTER
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.S SVX2 * ERROR, CLOSE AND DELETE THE FILE
BSR CLSSFL * SUCCESS, CLOSE THE FILE
BNE.S SVX3 * ERROR, DELETE IT AND FAIL
SVX1 BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
MOVEQ #1,D0
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
BSR MAKEICON * ATTACH AN ICON TO THIS FILE
IFEQ EZIP
MOVEQ #1,D0 * RETURN "SAVE OK"
BRA PUTVAL
ENDC
IFEQ CZIP
BRA PTRUE * RETURN PREDICATE TRUE
ENDC
* SAVE FAILED FOR SOME REASON, HANDLE IT ...
SVX2 BSR CLSSFL * CLOSE THE BAD FILE
SVX3 BSR DELSFL * DELETE THE BAD FILE FROM THE DIRECTORY
SVX4 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
MOVEQ #1,D0
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
IFEQ EZIP
CLR.W D0 * RETURN "SAVE FAILED"
BRA PUTVAL
ENDC
IFEQ CZIP
BRA PFALSE * RETURN PREDICATE FALSE
ENDC
* RESTORE (A PREVIOUSLY SAVED GAME STATE)
OPREST CLR.W D0
BSR CHKDSK * FIRST CHECK FOR PRESENCE OF GAME DISK
* SKIP NEXT CALL IF DOING SPECIAL RESTORE DURING LAUNCH ...
BSR GETRFL * GET NAME OF A RESTORE FILE
BNE RESX1 * CANCELLED
BSR OPNSFL * OPEN THE FILE
BNE RESX1 * 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 RESX3 * DIE IF DISK ERROR
MOVE.L STKBOT(A6),A0
MOVE.L (A0),A4 * RESTORE GAME SP
ADD.L A0,A4 * RE-ABSOLUTIZE IT
MOVE.W (A4)+,D0 * GET THE SAVED ZORKID
CMP.W ZORKID(A6),D0 * IS IT THE SAME AS OURS?
BNE.S RESX2 * NO, DIE
MOVE.L (A4)+,D0 * YES, RESTORE OLD LOCALS POINTER
ADD.L STKBOT(A6),D0 * RE-ABSOLUTIZE THIS ONE
MOVE.L D0,ZLOCS(A6)
MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF
MOVE.W (A4)+,ZPC1(A6)
MOVE.L BUFFER(A6),A0
MOVE.W PFLAGS(A0),-(SP) * BUT 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.S RESX3 * DIE IF DISK ERROR
MOVE.L BUFFER(A6),A0
MOVE.W (SP)+,PFLAGS(A0) * RESTORE THE OLD FLAGS
BSR CLSSFL * CLOSE THE FILE
BSR NEWZPC * THEN GET THE PROPER ZPC PAGE
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
MOVEQ #1,D0
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
IFEQ EZIP
MOVEQ #2,D0 * RETURN "RESTORE OK"
BRA PUTVAL
ENDC
IFEQ CZIP
BRA PTRUE * RETURN PREDICATE TRUE
ENDC
* SOMETHING WRONG, FAIL ...
RESX1 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
MOVEQ #1,D0
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
IFEQ EZIP
CLR.W D0 * RETURN "RESTORE FAILED"
BRA PUTVAL
ENDC
IFEQ CZIP
BRA PFALSE * RETURN PREDICATE FALSE
ENDC
* FATAL ERROR, DIE ...
RESX2 MOVE.W D0,-(SP)
BSR CLSSFL * CLOSE THE BAD FILE
MOVE.W (SP)+,D0 * BAD VERSION ID
LEA MSGRE2,A0
BRA FATAL * 'Wrong save file version'
SECTION ZDATA
MSGRE2 DC.B 'Wrong save file version',0
SECTION ZCODE
RESX3 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
* RESTART (THE GAME)
OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT
CLR.W LINES(A6) * RESET LINE COUNTER
JSR _clear_screen
BRA RESTRT * SKIP INITIALIZATIONS AND FILE OPENING
* QUIT
OPQUIT BRA FINISH * DIE PEACEFULLY
* VERIFY (GAME FILE)
OPVERI
IFEQ CZIP * VERSION INFO FOR ZIP ONLY
LEA MSGVER,A0
BSR OUTMSG0 * 'Amiga interpreter version '
SECTION ZDATA
MSGVER DC.B 'Amiga interpreter version ',0
SECTION ZCODE
LEA INTWRD,A0
MOVE.B 1(A0),D0 * DISPLAY THE LETTER (LOW BYTE)
BSR OPPRNC
BSR OPCRLF
ENDC
LEA SUBVER,A0
TST.W (A0) * 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 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.S VERX1 * NO
CMP.W D1,D5 * MAYBE
BNE.S 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
Reference in New Issue View Git Blame Copy Permalink