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