EJECT ; PAGE * ---------------------------------------------------------------------------- * ARITHMETIC OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPADD * ---------------------- OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2 BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPSUB * ---------------------- OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1 BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPMUL * ---------------------- OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED) BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW * ---------------------- * OPDIV * ---------------------- * DIVIDE BY ZERO AND MOD ZERO ARE CAUGHT, AVOIDING CONFUSING HARDWARE TRAPS OPDIV TST.W D1 BEQ.S ODIVX1 * TRAP DIVIDE-BY-ZERO EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS DIVS D1,D0 * DIVIDE OPR2 INTO OPR1 BRA PUTVAL * RETURN THE QUOTIENT, IGNORING REMAINDER ODIVX1 * CLR.W D0 LEA MSGODV,A0 BRA FATAL DATA MSGODV DC.B 'Bad DIV',0 CODE * ---------------------- * OPMOD * ---------------------- OPMOD TST.W D1 BEQ.S OMODX1 * TRAP DIVIDE-BY-ZERO EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS DIVS D1,D0 * DIVIDE OPR2 INTO OPR1 SWAP D0 * GET REMAINDER BRA PUTVAL * RETURN IT OMODX1 * CLR.W D0 LEA MSGOMD,A0 BRA FATAL DATA MSGOMD DC.B 'Bad MOD',0 CODE * ---------------------- * OPRAND * ---------------------- OPRAND TST.W D7 * [GARBAGE FOR ST ASSEMBLER] IF EZIP THEN TST.W D0 * DISABLE RANDOMNESS NOW? BLT.S RANDX1 * YES BEQ.S RANDX2 * ZERO, RE-ENABLE RANDOMNESS TST.W RCYCLE(A6) * IS RANDOMNESS ALREADY DISABLED? BNE.S RANDX3 * YES ENDIF * NORMAL RANDOMNESS, GENERATE A VALUE MOVE.W RSEED2(A6),D1 * GET BOTH SEEDS SWAP D1 MOVE.W RSEED1(A6),D1 MOVE.W D1,RSEED2(A6) * UPDATE LOW SEED SWAP D1 LSR.L #1,D1 * SHIFT BOTH RIGHT BY 1 BIT EOR.W D1,RSEED1(A6) * GENERATE OUTPUT & UPDATE HIGH SEED MOVE.W RSEED1(A6),D1 * GET NEW HIGH SEED ANDI.L #$00007FFF,D1 * CLEAR HIGH BIT TO PREVENT POSSIBLE OVERFLOW DIVU D0,D1 * DIVIDE ARG INTO RANDOM NUMBER SWAP D1 * GET REMAINDER ADDQ.W #1,D1 * MUST BE BETWEEN 1 AND N, INCLUSIVE MOVE.W D1,D0 BRA PUTVAL * RETURN THE VALUE IF EZIP THEN *** GENERATE A NON-RANDOM SEQUENCE HENCEFORTH RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT BRA.S RANDX4 * AND INITIALIZE COUNTER (SEQ BEGINS NEXT PASS) RANDX3 MOVE.W RCONST(A6),D0 * GENERATE NEXT VALUE IN SEQUENCE ADDQ.W #1,D0 CMP.W RCYCLE(A6),D0 * EXCEEDED THE UPPER LIMIT YET? BLE.S RANDX4 * NO MOVEQ #1,D0 * YES, RESTART THE SEQUENCE RANDX4 MOVE.W D0,RCONST(A6) * UPDATE COUNTER BRA PUTVAL * RETURN THE VALUE ENDIF * ---------------------- * OPQLES * ---------------------- OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2? BLT PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQGRT * ---------------------- OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2? BGT PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PRECICATE FALSE * ---------------------- * OPBTST * ---------------------- * LOGICAL OPERATIONS OPBTST NOT.W D0 * TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1 AND.W D0,D1 BEQ PTRUE * SUCCESS IF OPR2 COMPLETELY CLEARED BRA PFALSE * ---------------------- * OPBOR * ---------------------- OPBOR OR.W D1,D0 * LOGICAL "OR" BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPBCOM * ---------------------- OPBCOM NOT.W D0 * LOGICAL COMPLEMENT BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPBAND * ---------------------- OPBAND AND.W D1,D0 * LOGICAL "AND" BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPSHIFT * ---------------------- OPSHIFT TST.W D1 * NEGATIVE? BLT.S SHFX1 * YES LSL.W D1,D0 * NO, LOGICAL LEFT SHIFT BRA PUTVAL SHFX1 NEG.W D1 LSR.W D1,D0 * LOGICAL RIGHT SHIFT BRA PUTVAL * ---------------------- * OPASHIFT * ---------------------- OPASHIFT TST.W D1 * NEGATIVE? BLT.S ASHFX1 * YES ASL.W D1,D0 * NO, ARITHMETIC LEFT SHIFT BRA PUTVAL ASHFX1 NEG.W D1 ASR.W D1,D0 * ARITHMETIC RIGHT SHIFT BRA PUTVAL * ---------------------- * OPQEUQ * ---------------------- * GENERAL PREDICATES OPQEQU NOP * TELL CALLER TO USE ARGBLK MOVE.W (A0)+,D1 * NUMBER OF OPERANDS MOVE.W (A0)+,D0 * OPR1 SUBQ.W #1,D1 QEQUX1 CMP.W (A0)+,D0 * IS NEXT OPR EQUAL TO OPR1? BEQ.S QEQUX2 * YES SUBQ.W #1,D1 * NO, BUT LOOP IF MORE OPERANDS BNE.S QEQUX1 BRA PFALSE * PREDICATE FALSE QEQUX2 BRA PTRUE * PREDICATE TRUE * ---------------------- * OPQZER * ---------------------- OPQZER TST.W D0 * IS OPR ZERO? BEQ PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE EJECT ; PAGE * ---------------------------------------------------------------------------- * OBJECT-RELATED PRIMITIVES * ---------------------------------------------------------------------------- * ---------------------- * OBJLOC * ---------------------- * GIVEN OBJECT NUMBER IN D0.W, RETURN OBJECT LOCATION IN A0 OBJLOC MULU #OLEN,D0 * CALCULATE OBJECT OFFSET MOVE.L OBJTAB(A6),A0 ADDA.L D0,A0 * INDEX INTO OBJECT TABLE ADDA.W #OPLEN-OLEN,A0 * SKIPPING OVER THE DEFAULT PROPERTY TABLE RTS * ---------------------- * FSTPRP * ---------------------- * GIVEN OBJECT LOCATION IN A0, RETURN POINTER TO FIRST PROPERTY IN A0 FSTPRP ADDA.W #PROP,A0 * POINT TO PROPERTY TABLE SLOT MOVEQ #0,D0 BSR GTAWRD * GET ITS LOCATION MOVE.L BUFFER(A6),A0 * ABSOLUTIZE THE LOCATION ADDA.L D0,A0 CLR.W D0 MOVE.B (A0)+,D0 * LENGTH OF SHORT DESCRIPTION IN WORDS ADD.W D0,D0 ADDA.W D0,A0 * ADJUST POINTER TO SKIP IT RTS * ---------------------- * NXTPRP * ---------------------- * GIVEN POINTER TO A PROPERTY ID IN A0, UPDATE IT TO POINT TO NEXT PROPERTY ID IF EZIP THEN 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 ENDIF IF CZIP THEN 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 ENDIF * ---------------------------------------------------------------------------- * OBJECT OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPMOVE * ---------------------- * MOVE (OBJ1 INTO OBJ2) OPMOVE MOVEM.W D1/D0,-(SP) * PROTECT OPERANDS FROM REMOVE CALL BSR OPREMO * REMOVE OBJ1 FROM WHEREVER IT IS MOVE.W 2(SP),D0 * OBJ2 BSR OBJLOC * FIND ITS LOCATION MOVE.L A0,A1 * SAVE IT MOVE.W (SP),D0 * OBJ1 BSR OBJLOC * FIND ITS LOCATION MOVEM.W (SP)+,D0/D1 * RESTORE THE OBJ NUMBERS IF EZIP THEN 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 ENDIF IF CZIP THEN 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 ENDIF RTS * ---------------------- * OPREMO * ---------------------- * REMOVE (OBJ FROM ITS PARENT) IF EZIP THEN 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 ENDIF IF CZIP THEN 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 ENDIF * ---------------------- * OPLOC * ---------------------- * LOC (RETURN CONTAINER OF OBJ) OPLOC BSR OBJLOC * FIND OBJ'S LOCATION IF EZIP THEN MOVE.W LOC(A0),D0 * GET PARENT ENDIF IF CZIP THEN CLR.W D0 MOVE.B LOC(A0),D0 * GET PARENT, CLEARING UNUSED BYTE ENDIF BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPQFIR * ---------------------- * FIRST? (RETURN FIRST CHILD OF OBJ, FAIL IF NONE) OPQFIR BSR OBJLOC * FIND OBJ'S LOCATION IF EZIP THEN MOVE.W FIRST(A0),D0 * GET FIRST CHILD ENDIF IF CZIP THEN CLR.W D0 MOVE.B FIRST(A0),D0 * GET FIRST CHILD, CLEARING UNUSED BYTE ENDIF MOVE.W D0,-(SP) BSR PUTVAL * RETURN THE VALUE TST.W (SP)+ * NONZERO? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQNEX * ---------------------- * NEXT? (RETURN THE NEXT SIBLING OF OBJ, FAIL IF NONE) OPQNEX BSR OBJLOC * FIND OBJ'S LOCATION IF EZIP THEN MOVE.W NEXT(A0),D0 * GET SIBLING ENDIF IF CZIP THEN CLR.W D0 MOVE.B NEXT(A0),D0 * GET SIBLING, CLEARING UNUSED BYTE ENDIF MOVE.W D0,-(SP) BSR PUTVAL * RETURN THE VALUE TST.W (SP)+ * NONZERO? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQIN * ---------------------- * IN? (IS OBJ1 CONTAINED IN OBJ2?) OPQIN BSR OBJLOC * FIND OBJ1'S LOCATION IF EZIP THEN CMP.W LOC(A0),D1 * IS OBJ1'S PARENT OBJ2? ENDIF IF CZIP THEN CMP.B LOC(A0),D1 * IS OBJ1'S PARENT OBJ2? ENDIF BEQ PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPGETP * ---------------------- * GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE) OPGETP BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S GETPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP GETPX1 BSR NXTPRP * POINT TO NEXT PROPERTY GETPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S GETPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BLT.S GETPX3 * IF LESS, NO SUCH PROPERTY, USE DEFAULT * (ASSUMIMG NO 2ND EZIP LENGTH BYTE EXISTS HERE) BTST #PLBIT,(A0)+ * GOT IT, EXAMINE (LOW MODE OR) LOWEST LEN BIT BNE.S GETPX4 * ONE MEANS WORD VALUE, OTHERWISE BYTE VALUE MOVE.B (A0),D0 * GET THE BYTE BRA BYTVAL * AND RETURN IT GETPX3 SUBQ.W #1,D1 * PROPERTY NOT FOUND, USE DEFAULT PROP TABLE ADD.W D1,D1 * WORD OFFSET MOVE.L OBJTAB(A6),A0 * GET BASE OF DEFAULT TABLE ADDA.W D1,A0 * POINT TO THE DEFAULT PROPERTY GETPX4 BSR GTAWRD * GET THE WORD VALUE BRA PUTVAL * AND RETURN IT * ---------------------- * OPPUTP * ---------------------- * PUTP (CHANGE VALUE OF SPECIFIED PROPERTY OF OBJ, ERROR IF BAD PROP NUMBER) OPPUTP BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S PUTPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP PUTPX1 BSR NXTPRP * POINT TO NEXT PROPERTY PUTPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S PUTPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S PUTPX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, FATAL ERROR LEA MSGPUP,A0 BRA FATAL * 'Non-existent put property' DATA MSGPUP DC.B 'Non-existent put property',0 CODE * (ASSUMING NO 2ND EZIP LENGTH BYTE EXISTS HERE) PUTPX3 BTST #PLBIT,(A0)+ * EXAMINE (LOW MODE OR) LOWEST LENGTH BIT BNE.S PUTPX4 * ZERO MEANS BYTE VALUE, OTHERWISE WORD VALUE MOVE.B D2,(A0) * STORE THE NEW BYTE RTS PUTPX4 MOVE.W D2,D0 BRA PTAWRD * STORE THE NEW WORD * ---------------------- * OPNEXT * ---------------------- * NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROP IN OBJ) OPNEXT BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY TST.W D1 * WERE WE GIVEN ZERO AS PROP? BEQ.S NEXTX4 * YES, JUST RETURN FIRST PROPERTY NUMBER BRA.S NEXTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP NEXTX1 BSR NXTPRP * POINT TO NEXT PROPERTY NEXTX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S NEXTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S NEXTX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, FATAL ERROR LEA MSGNXP,A0 BRA FATAL * 'Non-existent next property' DATA MSGNXP DC.B 'Non-existent next property',0 CODE NEXTX3 BSR NXTPRP * POINT TO NEXT PROPERTY NEXTX4 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * EXTRACT PROPERTY NUMBER BRA PUTVAL * AND RETURN IT * ---------------------- * FLGLOC * ---------------------- * PRIMITIVE TO LOCATE A FLAG BIT * GIVEN A POINTER TO FIRST FLAGS BYTE IN A0, TARGET FLAG NUMBER (0-47) IN D0 * RETURN POINTER TO TARGET FLAGS BYTE IN A0, TARGET BIT NUMBER (7-0) IN D0 FLGLOC MOVE.W D0,-(SP) LSR.W #3,D0 * EXTRACT BYTE OFFSET ADD.W D0,A0 * ADJUST FLAGS POINTER MOVE.W (SP)+,D0 NOT.W D0 * FIX THE 3 LOW-ORDER BITS ANDI.W #$0007,D0 * MASK OFF THE REST RTS * ADDQ.L #1,A0 * POINT TO NEXT FLAGS BYTE * SUBQ.W #8,D0 * WAS TARGET FLAG IN PREVIOUS BYTE? * BGE.S FLGLOC * NO * SUBQ.L #1,A0 * YES, POINT TO PREVIOUS FLAGS BYTE * NEG.W D0 * AND COMPUTE THE TARGET BIT NUMBER (7-0) * SUBQ.W #1,D0 * RTS * ---------------------- * OPQFSE * ---------------------- * FSET? (IS FLAG SET IN OBJ?) OPQFSE BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BTST D0,(A0) * IS THE SPECIFIED BIT SET? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPFSET * ---------------------- * FSET (SET A FLAG IN OBJ) OPFSET BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BSET D0,(A0) * SET THE SPECIFIED BIT RTS * ---------------------- * OPFCLE * ---------------------- * FCLEAR (CLEAR A FLAG IN OBJ) OPFCLE BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BCLR D0,(A0) * CLEAR THE SPECIFIED BIT RTS EJECT ; PAGE * ---------------------------------------------------------------------------- * TABLE OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPGET * ---------------------- * GET (GET THE ITEM'TH WORD FROM TABLE) OPGET ADD.W D1,D1 * WORD OFFSET ADD.W D1,D0 * INDEX INTO TABLE BSR BSPLTB * SPLIT THE POINTER BSR GETWRD * GET THE WORD MOVE.W D2,D0 BRA PUTVAL * AND RETURN IT * ---------------------- * OPGETB * ---------------------- * GETB (GET THE ITEM'TH BYTE FROM TABLE) OPGETB ADD.W D1,D0 * INDEX INTO TABLE BSR BSPLTB * SPLIT THE POINTER BSR GETBYT * GET THE BYTE MOVE.W D2,D0 BRA BYTVAL * AND RETURN IT * ---------------------- * OPPUT * ---------------------- * NOTE: PROPERTY TABLE POINTERS IN THE NEXT FOUR ROUTINES NOW /MAY/ * EXCEED 32K, SO SIGN-EXTENSION MUST BE AVOIDED. * A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER * PUT (REPLACE THE ITEM'TH WORD IN TABLE) OPPUT ADD.W D1,D1 * WORD OFFSET ADD.W D1,D0 * INDEX INTO TABLE ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD MOVE.L BUFFER(A6),A0 ADD.L D0,A0 * ABSOLUTIZE POINTER MOVE.W D2,D0 BRA PTAWRD * STORE THE WORD * (THIS FAILS IF OFFSET EVER NEG) *** EXT.L D1 * ZERO THE HIGH WORD *** ADD.W D1,D1 * WORD OFFSET *** ADD.W D0,D1 * INDEX INTO TABLE * ---------------------- * OPPUTB * ---------------------- * PUTB (REPLACE THE ITEM'TH BYTE IN TABLE) OPPUTB ADD.W D1,D0 * INDEX INTO TABLE ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD MOVE.L BUFFER(A6),A0 MOVE.B D2,0(A0,D0.L) * STORE THE BYTE RTS * ---------------------- * OPGTPT * ---------------------- * GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN OBJ, PROP) OPGTPT BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S GTPTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP GTPTX1 BSR NXTPRP * POINT TO NEXT PROPERTY GTPTX2 MOVE.B (A0),D0 * GET (FIRST) PROPERTY ID BYTE ANDI.W #PMASK,D0 * CLEAN OFF MODE/LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S GTPTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S GTPTX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, RETURN ZERO FOR NO SUCH PROPERTY BRA.S GTPTX5 IF EZIP THEN 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 ENDIF IF CZIP THEN GTPTX3 ADDQ.L #1,A0 * POINT TO PROPERTY VALUE ENDIF GTPTX4 MOVE.L A0,D0 SUB.L BUFFER(A6),D0 * RE-RELATIVIZE POINTER GTPTX5 BRA PUTVAL * AND RETURN IT * ---------------------- * OPPTSI * ---------------------- * PTSIZE (GIVEN POINTER TO PROPERTY TABLE, RETURN ITS SIZE) OPPTSI MOVE.L BUFFER(A6),A0 ANDI.L #$FFFF,D0 * MAKE THE TABLE PTR A LONGWORD ADDA.L D0,A0 * ABSOLUTIZE THE TABLE POINTER IF EZIP THEN 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 ENDIF IF CZIP THEN 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 ENDIF * ---------------------------------------------------------------------------- * BLOCK OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPINTBL * ---------------------- * INTBL? (SEARCH TABLE FOR A VALUE) OPINTBL NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * DEFAULT ARGBLK MOVE.W #4,(A1) * 4 ARGS MAX MOVE.W #128+2,ARG4(A1) * DEFAULT -- WORD SEARCH, RECORD LENGTH = 2 BSR SETDEF * SET UP DEFAULTS MOVE.L A0,A1 MOVE.W ARG4(A1),D3 ANDI.W #127,D3 * RECORD LENGTH ANDI.W #128,ARG4(A1) * SEARCH MODE BIT -- WORD 1, BYTE 0 BRA.S ITBX4 * >>> ZERO CHECK <<< ITBX1 MOVE.W ARG2(A1),D0 * RELATIVE BYTE ADDRESS OF TABLE BSR BSPLTB * SPLIT IT [D0,D1] TST.W ARG4(A1) * WORD SEARCH? BEQ.S ITBX2 * NO, BYTE BSR GETWRD CMP.W ARG1(A1),D2 * MATCH? BEQ.S ITBX5 * YES BRA.S ITBX3 ITBX2 BSR GETBYT CMP.B ARG1+1(A1),D2 * MATCH? BEQ.S ITBX5 * YES ITBX3 ADD.W D3,ARG2(A1) * NO, SKIP TO NEXT RECORD ITBX4 SUBQ.W #1,ARG3(A1) * ANY MORE RECORDS? BGE.S ITBX1 * YES, CONTINUE SEARCHING CLR.W D0 * FAILED, RETURN ZERO BSR PUTVAL BRA PFALSE * PREDICATE FALSE ITBX5 MOVE.W ARG2(A1),D0 * SUCCESS, RETURN THE RELATIVE POINTER BSR PUTVAL BRA PTRUE * PREDICATE TRUE * ---------------------- * OPCOPYT * ---------------------- * COPYT (COPY OR CLEAR A TABLE) OPCOPYT NOP * ASK FOR ARGBLK [JUST TO FREE UP REGS] MOVE.L A0,A2 MOVE.W ARG1(A2),D0 CMP.W ARG2(A2),D0 BEQ CPYTX8 * SAME, EXIT MOVE.W ARG3(A2),D1 * CHECK LENGTH: BEQ CPYTX8 * ZERO, EXIT BGT.S CPYTX1 * POSITIVE NEG.W ARG3(A2) * NEGATIVE, MAKE POSITIVE CPYTX1 TST.W ARG2(A2) * DEST BEQ.S CPYTX6 * IF ZERO, SPECIAL CASE TST.W D1 * WAS LEN NEG? BLT.S CPYTX4 * IF SO, DO /NOT/ CHECK FOR OVERLAP *** MOVE.W ARG1(A2),D0 * SRC CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"? BHI.S CPYTX4 * NO ADD.W ARG3(A2),D0 * MAYBE, SRC END (+1) CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"? BLS.S CPYTX4 * NO * "FORWARD OVERLAP" DOES EXIST, DO A REVERSE COPY CPYTX2 MOVE.W ARG2(A2),D0 * DEST ADD.W ARG3(A2),D0 * END (+1) BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] MOVE.L A0,A1 MOVE.W ARG1(A2),D3 * SRC ADD.W ARG3(A2),D3 * END (+1) CPYTX3 SUBQ.W #1,D3 * [PREDECREMENT] MOVE.W D3,D0 BSR BSPLTB * --> D0/D1 = BLK/OFF BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA MOVE.B D2,-(A1) * [PREDECREMENT] SUBQ.W #1,ARG3(A2) BNE.S CPYTX3 * LOOP [UNSIGNED TEST] RTS * DO A NORMAL COPY CPYTX4 MOVE.W ARG2(A2),D0 * DEST BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] MOVE.L A0,A1 MOVE.W ARG1(A2),D0 BSR BSPLTB * --> D0/D1 = BLK/OFF CPYTX5 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA MOVE.B D2,(A1)+ SUBQ.W #1,ARG3(A2) BNE.S CPYTX5 * LOOP [UNSIGNED TEST] RTS * NO DEST, JUST CLEAR THE SOURCE TABLE CPYTX6 MOVE.W ARG1(A2),D0 * SRC BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] CPYTX7 CLR.B (A0)+ SUBQ.W #1,ARG3(A2) BNE.S CPYTX7 * LOOP [UNSIGNED TEST] CPYTX8 RTS * ---------------------- * OPPRNT * ---------------------- * PRINTT (DISPLAY A TABLE IN BLOCK FORMAT) OPPRNT NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * DEFAULT ARGBLK MOVE.W #3,(A1) * 3 ARGS MAX MOVE.W #1,ARG3(A1) * DEFAULT # LINES = 1 BSR SETDEF * SET UP DEFAULT MOVE.L A0,A2 TST.W ARG2(A2) BLE.S PRNTX3 * BAD COL COUNT, EXIT TST.W ARG3(A2) BLE.S PRNTX3 * BAD ROW COUNT, EXIT BSR PUTLIN * MAKE SURE BUFFER IS EMPTY BSR GETCURS MOVE.W D1,A1 * INITIAL CURSOR COLUMN -- SAVE HERE * WE NOW USE VIRTUAL MEMORY CALLS TO FETCH TABLE DATA PRNTX1 MOVE.W ARG2(A2),D3 * COLS PER ROW MOVE.W ARG1(A2),D0 * TABLE BASE / START OF CURRENT ROW BSR BSPLTB * --> D0/D1 = BLK/OFF PRNTX2 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = CHAR EXG D0,D2 BSR PUTCHR * QUEUE/SCRIPT CHAR, ETC EXG D0,D2 SUBQ.W #1,D3 * ANY MORE COLS IN THIS ROW? BGT.S PRNTX2 * YES, LOOP * BEFORE, WE SAVED THE CURRENT FONT AND ENABLED FONT1, TO BE SURE THE CR * WAS CORRECTLY INTERPRETED. BUT (IN OTHER CONTEXTS) IT STILL GOT * MISINTERPRETED. NOWADAYS, #13 ALWAYS MEANS CR, REGARDLESS OF CONTEXT * (SEE CharOut). A BETTER SOLUTION WILL REQUIRE SOME STICKY RETHINKING. SUBQ.W #1,ARG3(A2) * ANY MORE ROWS IN TABLE? BEQ.S PRNTX3 * NO, DONE BSR PUTNEW * YES, CR, SCROLL IF NEEDED [PUTCHR #13] MOVEQ #-1,D0 * KEEP CURRENT ROW MOVE.W A1,D1 * BUT RESET COLUMN TO ORIGINAL VALUE BSR SETCURS MOVE.W ARG2(A2),D0 ADD.W D0,ARG1(A2) * START OF NEXT LINE BRA.S PRNTX1 * LOOP PRNTX3 RTS * ---------------------- * OPPRNF * ---------------------- * DISPLAY A FORMATTED TABLE (AS FROM 3-ARG DIROUT) * >> for now, no formatting (EXCEPT CR'S), just spit it out << OPPRNF MOVEQ #0,D1 MOVE.W D0,D1 * TABLE MOVE.L BUFFER(A6),A0 ADD.L D1,A0 BSR GTAWRD * GET LENGTH, ADVANCE PTR MOVE.L A0,A1 MOVE.W D0,D1 BEQ.S PRNFX2 * ZERO, EXIT PRNFX1 MOVE.B (A1)+,D0 BSR PUTCHR SUBQ.W #1,D1 BGT.S PRNFX1 PRNFX2 RTS EJECT ; PAGE * ---------------------------------------------------------------------------- * VARIABLE OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPVALU * ---------------------- * VALUE (GET VALUE OF VARIABLE) OPVALU BSR GETVAR * GET THE VALUE BRA PUTVAL * AND RETURN IT * ---------------------- * OPSET * ---------------------- * SET (VAR TO VALUE) OPSET BRA PUTVAR * STORE THE VALUE * ---------------------- * OPPUSH * ---------------------- * PUSH (A VALUE ONTO THE GAME STACK) OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE RTS * ---------------------- * OPXPUSH * ---------------------- * PUSH (A VALUE ONTO A 'USER STACK') OPXPUSH EXG D0,D1 * SAVE VALUE IN D1 BSR RELABS * GET A0 -> LTABLE BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0 TST.W D0 BLE.S XPSHX2 * NO MORE SPACE SUBQ.W #1,D0 MOVE.L A0,A1 ADDA.W D0,A1 ADDA.W D0,A1 * A1 -> FREE SLOT SUBQ.W #2,A0 BSR PTAWRD * UPDATE LENGTH SLOT MOVE.L A1,A0 MOVE.W D1,D0 BSR PTAWRD * AND STORE VALUE BRA PTRUE * PREDICATE TRUE XPSHX2 BRA PFALSE * PREDICATE FALSE * ---------------------- * OPPOP * ---------------------- * POP (A VALUE FROM A STACK, AND RETURN IT [NO LONGER PUTVAR - YZIP] ) OPPOP NOP * REQUEST AN ARGBLK TST.W (A0) * STACK SUPPLIED? BNE.S PPOPX2 * YES MOVE.W (A4)+,D0 * NO, POP VAL FROM GAME STACK BRA.S PPOPX4 PPOPX2 MOVE.W ARG1(A0),D0 BSR RELABS * GET A0 -> LTABLE BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0 MOVE.L A0,A1 ADDA.W D0,A1 ADDA.W D0,A1 * A1 -> LATEST ITEM ON STACK SUBQ.W #2,A0 ADDQ.W #1,D0 BSR PTAWRD * UPDATE LENGTH SLOT MOVE.L A1,A0 BSR GTAWRD * AND GET VALUE PPOPX4 BRA PUTVAL * RETURN IT * ---------------------- * OPINC * ---------------------- * INC (INCREMENT VAR) OPINC MOVE.W D0,D1 * SAVE A COPY HERE BSR GETVAR * GET THE VARIABLE'S VALUE ADDQ.W #1,D0 * INCREMENT IT EXG D0,D1 * POSITION IT BRA PUTVAR * AND STORE THE NEW VALUE * ---------------------- * OPDEC * ---------------------- * DEC (DECREMENT VAR) OPDEC MOVE.W D0,D1 * SAVE A COPY HERE BSR GETVAR * GET THE VARIABLE'S VALUE SUBQ.W #1,D0 * DECREMENT IT EXG D0,D1 * POSITION IT BRA PUTVAR * AND STORE NEW VALUE * ---------------------- * OPQIGR * ---------------------- * IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL) OPQIGR MOVE.W D1,D2 * MOVE VAL HERE MOVE.W D0,D1 * COPY VAR HERE BSR GETVAR * GET THE VARIABLE'S VALUE ADDQ.W #1,D0 * INCREMENT IT EXG D0,D1 * POSITION IT CMP.W D2,D1 * NEW VALUE GREATER THAN VAL? BGT.S QIG2 * YES QIG1 BSR PUTVAR * NO, STORE THE NEW VALUE BRA PFALSE * AND RETURN PREDICATE FALSE QIG2 BSR PUTVAR * STORE THE NEW VALUE BRA PTRUE * AND RETURN PREDICATE TRUE * ---------------------- * OPQDLE * ---------------------- * DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL) OPQDLE MOVE.W D1,D2 * MOVE VAL HERE MOVE.W D0,D1 * COPY VAR HERE BSR GETVAR * GET THE VARIABLE'S VALUE SUBQ.W #1,D0 * DECREMENT IT EXG D0,D1 * POSITION IT CMP.W D2,D1 * NEW VALUE LESS THAN VAL? BLT.S QIG2 * YES BRA.S QIG1 * NO * --------------------------------------------------------------------------- * READ/INPUT OPERATIONS * --------------------------------------------------------------------------- * 6/88 -- REGISTER D3 IS BEING TRASHED; TRY TO PINPOINT IT IF D3BUG THEN D3CHK * [IF BEING CALLED OUTSIDE OF OPREAD, FIRST CHECK THAT "LAST OP WAS OPREAD"] CMP.L #$1111EEEE,D6 BNE.S D3X9 CMP.W D3,D7 * [CORRECT VAL SAVED IN D7] BEQ.S D3X9 DATA MSGD3C DC.B 'D3 munged in READ',0 CODE MOVEM.L D0/A0,-(SP) * SPECIAL ROUTINE: SAVE /ALL/ REGS LEA MSGD3C,A0 BSR ZWARN * SHOW A WARNING BSR TTYIN * PAUSE FOR DEBUGGING MOVEM.L (SP)+,D0/A0 MOVE.W D7,D3 * "FIX IT UP" D3X9 RTS ENDIF * ------------------------------ * OPREAD * ------------------------------ * READ (A LINE OF INPUT AND MASTICATE IT) OPREAD NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX CLR.W ARG2(A1) * DEFAULT LEXV -- ZERO MEANS DON'T MOVE.W #-1,ARG3(A1) * DEFAULT TIMOUT INTERVAL -- NEG MEANS DON'T CLR.W ARG4(A1) * DEFAULT TIMOUT HANDLER FUNCTION BSR SETDEF * SET UP DEFAULTS ADDQ.L #2,A0 * SKIP COUNT SLOT MOVE.W (A0)+,D0 * INBUF MOVE.W (A0)+,D3 * [LEXV] IF D3BUG THEN MOVE.W D3,D7 MOVE.L #$1111EEEE,D6 * MARK D6 ENDIF MOVE.W (A0)+,TWAIT(A6) * [TIME] MOVE.W (A0)+,TFUNC(A6) * [HANDLER] BSR RELABS * ABSOLUTIZE THE INBUF PTR MOVE.L A0,A2 * KEEP IT HERE BSR TRESET * RESET THE TIMER, IF NEEDED IF CZIP THEN MOVEM.L D3/A2,-(SP) BSR OPUSL * UPDATE STATUS LINE MOVEM.L (SP)+,D3/A2 ENDIF MOVE.L CURWP(A6),A0 CLR.W WLCNT(A0) * RESET COUNTER (PREVENTS A SPURIOUS [MORE]) BSR PUTLIN1 * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT) IF D3BUG THEN BSR D3CHK ENDIF *** GATHER AND LOWER-CASIFY THE INPUT LINE ... MOVE.L A2,A0 * START OF INPUT LINE BUFFER MOVEQ #0,D0 MOVE.B (A0)+,D0 * 1ST HEADER BYTE == MAX LENGTH MOVEQ #0,D1 MOVE.B (A0)+,D1 * 2ND HEADER BYTE == CURRENT LEN BSR READLN * GET IT IF D3BUG THEN BSR D3CHK MOVEQ #0,D6 * UNMARK D6 ENDIF MOVE.W D0,D2 * RETURN D0: TERM CHAR MOVE.L A0,D0 * RETURN A0: END OF ACTUAL INPUT (+1) MOVE.L A2,A0 ADDQ.L #2,A0 * START OF INPUT, SKIP HEADER SUB.L A0,D0 * NEW TOTAL LENGTH MOVE.B D0,1(A2) * STORE THE NEW LENGTH IN THE HEADER BSR LCASE * AND LOWER-CASIFY EVERYTHING *** TOKENIZE AND LOOKUP THE INPUT ... MOVE.W D3,D0 * LEXV ARG BEQ.S RDX4 * ZERO MEANS EXIT IMMEDIATELY BSR RELABS * ABSOLUTIZE MOVE.L A0,A3 MOVE.L VOCTAB(A6),A1 * OPREAD: USE "STANDARD" VOCAB TABLE MOVEQ #0,D1 * OPREAD: NO PRESERVE FLAG BSR LEX RDX4 MOVE.W D2,D0 BRA BYTVAL * RETURN THE TERM CHARACTER * ------------------------------ * OPLEX * ------------------------------ * TOKENIZE AND LOOKUP A LINE OF INPUT * (FIND EACH WORD, CONVERT IT TO ZWORD, AND STORE OFFSET INFO IN LEXV) OPLEX NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX CLR.W ARG3(A1) * DEFAULT VOC TABLE (FLAG) CLR.W ARG4(A1) * DEFAULT PRESERVE FLAG = OFF BSR SETDEF * SET UP DEFAULTS MOVE.L A0,A1 * ARGBLK TST.W (A1)+ * SKIP ACTUAL ARG COUNT (NOT NEEDED) MOVE.W (A1)+,D0 * ARG1 == INBUF BSR RELABS * ABSOLUTIZE MOVE.L A0,A2 * AND PASS IT HERE MOVE.W (A1)+,D0 * ARG2 == LEXV BSR RELABS * ABSOLUTIZE MOVE.L A0,A3 * AND PASS IT HERE MOVE.L VOCTAB(A6),A0 * "STANDARD" VOCTAB MOVE.W (A1)+,D0 * USE A SPECIAL VOCTAB? BEQ.S LXX0 * NO BSR RELABS * YES, ABSOLUTIZE LXX0 EXG A0,A1 * PASS VOCTAB IN A1 MOVE.W (A0)+,D1 * AND PASS "PRESERVE" FLAG HERE * INTERNAL ENTRY POINT * GIVEN A1 -> VOCAB TABLE, A2 -> INBUF, A3 -> LEXV, D1 = PRESERVE FLAG LEX MOVE.L D2,-(SP) MOVE.L A1,A0 BSR INITLX * SETUP VOCAB VARS (FOR LOOKUP) MOVE.L A2,RDBOS(A6) * REMEMBER INPUT BUFFER BASE MOVEQ #0,D0 MOVE.B 1(A2),D0 * >> ACTUAL LEN OF INPUT << ADDQ.L #2,A2 * SKIP HEADER (MAX LEN, CUR LEN) ADD.L A2,D0 MOVE.L D0,RDEOS(A6) * REMEMBER END OF INPUT MOVE.L A3,RDRET(A6) * REMEMBER RETURN BUFFER BASE CLR.B 1(A3) * BUFFER INITIALLY EMPTY ADDQ.L #2,A3 * SKIP HEADER (MAX WORDS, NWORDS) * LOOP STARTS HERE, A2 -> CURRENT INBUF, A3 -> CURRENT LEXV LXX2 MOVE.L A2,A0 * CURRENT INPUT START MOVE.L RDEOS(A6),D0 SUB.L A2,D0 * CURRENT REMAINING LENGTH BEQ.S LXX8 * NOTHING, EXIT BSR ZWSTR * FIND NEXT WORD, AND CONVERT IT MOVE.L A0,A2 * RETURN: START OF CURRENT WORD MOVE.W D0,D2 * RETURN: LENGTH OF CURRENT WORD, OR ZERO BEQ.S LXX8 * NOTHING, EXIT *** BUILD THE LEX (RETURN) TABLE ... MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER MOVE.B (A0)+,D0 * MAX WORDS ALLOWED CMP.B (A0),D0 * ROOM FOR ANOTHER? BEQ.S LXX6 * NO, ERROR ADDQ.B #1,(A0) * INCREMENT FOUND-WORD COUNT LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE BSR LOOKUP * SEARCH VOCAB TABLE FOR IT, RETURN OFFSET TST.W D0 * WORD FOUND? BNE.S LXX3 * YES TST.W D1 * NO, PRESERVE OLD INFO? >> OFFSET ONLY << BNE.S LXX4 * YES LXX3 MOVE.L A3,A0 * CURRENT RETURN SLOT BSR PTAWRD * STORE THE OFFSET IN RETURN TABLE LXX4 MOVE.B D2,2(A3) * STORE WORD LENGTH IN RETURN TABLE MOVE.L A2,D0 SUB.L RDBOS(A6),D0 * CALCULATE STARTING BYTE OFFSET OF WORD MOVE.B D0,3(A3) * STORE IT TOO ADDQ.L #4,A3 * ADVANCE RETURN TABLE PTR ADDA.W D2,A2 * ADVANCE INPUT PTR BRA LXX2 * GO FOR THE NEXT WORD *** ERROR, RETURN BUFFER IS FULL, TELL USER, THEN EXIT LXX6 MOVE.L A2,A0 * START OF FLUSHED STRING MOVE.L RDEOS(A6),A1 * END (+1) BSR RDERR * ECHO IT IN ERROR MESSAGE LXX8 MOVE.L (SP)+,D2 * CLEAN UP AND EXIT RTS * ------------------------------ * OPZWSTR * ------------------------------ * IDENTIFY THE NEXT WORD (START/END), AND CONVERT IT TO A ZWORD OPZWSTR ADD.W D2,D0 * INPUT BUFFER: BASE + OFFSET BSR RELABS * ABSOLUTIZE IT MOVEQ #VCHARS,D0 * MAX LEN -- IGNORE 2ND ARG (SPEC ERROR) BSR ZWSTR * GO FOR IT * (IGNORE RETURNED INFO; WE'RE INTERESTED IN INITIAL WORD ONLY) MOVE.W D3,D0 * REQUESTED ZWORD BUFFER BSR RELABS * ABSOLUTIZE IT MOVE.L A0,A1 LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE MOVEQ #ZCHARS,D0 BRA COPYB * COPY ZWORD TO FINAL DEST, AND EXIT * INTERNAL ENTRY POINT * GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH (TOTAL) * RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO ZWSTR BSR FINDBK * FIND NEXT BREAK CHAR TST.W D0 BEQ.S ZWSX1 * EXIT IF NOTHING MOVEM.L D0-D1/A0-A1,-(SP) * SAVE RESULTS LEA RDWSTR(A6),A1 * TEMP STRING BUFFER MOVEQ #VCHARS,D1 * MAX LENGTH BSR COPYS * COPY FIRST WORD, MAKE ASCIZ LEA RDWSTR(A6),A1 LEA RDZSTR(A6),A0 * TEMP OUTPUT BUFFER BSR ZWORD * CONVERT STRING, LEAVE ZWORD IN BUFFER MOVEM.L (SP)+,D0-D1/A0-A1 * RESTORE RESULTS ZWSX1 RTS * ------------------------------ * OPINPUT * ------------------------------ * WAIT FOR A KEY (NO ECHO), HANDLE OPTIONAL TIMEOUTS OPINPUT NOP * USE ARGBLK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #3,(A1) * 3 ARGS MAX MOVE.W #-1,ARG2(A1) * DEFAULT TIMOUT INTERVAL -- "DON'T" CLR.W ARG3(A1) * DEFAULT TIMOUT HANDLER FUNCTION BSR SETDEF * SET UP DEFAULTS ADDQ.L #ARG2,A0 * SKIP COUNT AND DEVICE MOVE.W (A0)+,TWAIT(A6) * DELAY IN 1/10'S SECOND MOVE.W (A0)+,TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT BSR TRESET * RESET THE TIMER, IF NEEDED MOVE.L CURWP(A6),A0 CLR.W WLCNT(A0) * RESET COUNTER, PREVENTS A SPURIOUS [MORE] TST.W VOBUFF(A6) * BUFFERED OUTPUT? BEQ.S INPX1 * NO BSR PUTLIN * YES, EMPTY THE BUFFER INPX1 MOVEQ #0,D0 * SINGLE CHAR [SUPPRESS MENU CMD-STRINGS] BSR INPUT * GET KEY CMPI.B #1,D0 * CONTINUE AFTER TIMEOUT? BEQ.S INPX1 * YES BRA BYTVAL * OTHERWISE, RETURN KEY * INTERNAL ENTRY POINT >> CALLED ALSO FROM READLN; HANDLES TIMEOUTS << * GIVEN D0.W = LINE-INPUT FLAG (ZERO IF SINGLE-CHAR INPUT) * WAIT FOR A KEY, RETURN D0.B = VALUE * IN CASE OF A TIMEOUT, RETURN D0.B = 0 (ABORT) OR 1 (KEEP WAITING) * IF WAITING, RETURN D0 (HI WORD) = NONZERO TO REDRAW INPUT LINE INPUT MOVEM.L D1-D2,-(SP) MOVE.W D0,D2 * SAVE FLAG HERE MOVEQ #1,D0 * START OF INPUT MOVE.W D2,D1 * CHAR/LINE BSR SETUPI INPX4 BSR GAMINT1 * CHECK FOR GAME INTERRUPT (SOUND, ETC) BSR ITTYIN * CHECK FOR A KEY << DON'T WAIT! >> TST.B D0 * GOT ONE? BEQ.S INPX6 * NOTHING YET MOVE.W D0,-(SP) CLR.W D0 * END OF INPUT MOVE.W D2,D1 * CHAR/LINE BSR SETUPI MOVE.W (SP)+,D0 BRA.S INPX8 * EXIT WITH KEY INPX6 TST.W TWAIT(A6) * TIMOUTS IN EFFECT? BLT.S INPX4 * NO, JUST LOOP BSR TCHECK * TIME (10'S) REMAINING BEFORE NEXT TIMEOUT TST.W D0 * HAS IT RUN OUT? BGT.S INPX4 * NO, CONTINUE LOOP BSR TNEXT * YES: UPDATE TIMER CLR.W D0 * END OF INPUT (FOR THE MOMENT...) MOVE.W D2,D1 * CHAR/LINE BSR SETUPI BSR GETCURS MOVE.W D1,D2 * REMEMBER CURRENT CURSOR POS (COLUMN) MOVE.W TFUNC(A6),D0 * TIMEOUT FUNCTION BSR INCALL * CALL IT (INTERNALLY) TST.W D0 * IT RETURNS A BOOLEAN -- ABORT INPUT? BNE.S INPX7 * YES BSR GETCURS SUB.W D2,D1 * DID CURSOR POS (COLUMN) CHANGE? MOVE.W D1,D0 * ZERO IF NO SWAP D0 * RETURN THIS FLAG IN HIGH WORD MOVE.W #1,D0 * 1 MEANS KEEP WAITING BRA.S INPX8 INPX7 MOVEQ #0,D0 * NULL CHAR MEANS ABORT INPUT INPX8 MOVEM.L (SP)+,D1-D2 RTS * ---------------------- * OPMSINFO * ---------------------- * GET MOUSE STATUS OPMSINFO BSR RELABS MOVE.L A0,A1 * RETURN VALS IN TABLE BSR GETMOUSE MOVE.L A1,A0 BSR PTAWRD * STORE YPOS MOVE.W D1,D0 BSR PTAWRD * STORE XPOS MOVE.W D2,D0 BSR PTAWRD * STORE BUTTON STATUS MOVE.W D3,D0 BRA PTAWRD * STORE MENU/ITEM CODE * ---------------------- * OPMSLMT * ---------------------- * SET MOUSE LIMITS (WINDOW) OPMSLMT MOVE.W D0,MSWIND(A6) * UPDATE MOUSE-LIMIT WINDOW ... RTS * --------------------------------------------------------------------------- * READ/INPUT PRIMITIVES * --------------------------------------------------------------------------- * ------------------------------ * READLN * ------------------------------ * GATHER A LINE OF INPUT * GIVEN A0 -> INPUT BUFFER, D0 = MAX LENGTH, D1 = CURRENT LENGTH * RETURN A0 -> END OF ACTUAL INPUT (+1), D0 = TERM CHAR EOLCHR EQU $0D * CARRIAGE RETURN DELCH1 EQU $08 * BACKSPACE DELCH2 EQU $7F * ALSO ACCEPT "DELETE" READLN MOVEM.L D1-D2/A1-A3,-(SP) MOVE.L A0,A1 * A1 -> START MOVE.L A0,A2 ADDA.W D1,A2 * A2 -> CURRENT POSITION (MAY BE FULL) MOVE.L A0,A3 ADDA.W D0,A3 * A3 -> END (+1) RDLX1 MOVE.L BUFFER(A6),A0 MOVE.W PTCHARS(A0),D0 * TABLE OF TERMINATING CHARS BSR RELABS * ABSOLUTIZE MOVE.L A0,D2 * KEEP PTR HERE *** WAIT FOR A KEY, CHECK FOR A TCHAR ... RDLX2 MOVEQ #1,D0 * LINE INPUT [ALLOW MENU CMD-STRINGS] BSR INPUT * NO ECHO, HANDLE TIMEOUTS IF D3BUG THEN BSR D3CHK ENDIF *** BSR TTYIN TST.B D0 * WAS THERE A TIME-OUT AND AN ABORT? BEQ.S RDLX10 * YES, BREAK CMPI.B #1,D0 * WAS THERE A TIME-OUT WITHOUT AN ABORT? BEQ.S RDLX9A * YES, DO INPUT-ECHO HACK CMPI.B #EOLCHR,D0 * CR? BEQ.S RDLX10 * YES, BREAK MOVE.L D2,A0 * TCHARS TABLE MOVEQ #0,D1 * FLAG FOR "FUNCTION-KEY TCHARS" RDLX4 CMPI.B #255,(A0) * CONSIDER ALL FKEYS TO BE TCHARS? BNE.S RDLX5 * NO MOVEQ #1,D1 * YES, SET FLAG RDLX5 CMP.B (A0),D0 * CHECK TABLE FOR THIS CHAR BEQ.S RDLX10 * >> FOUND IT, BREAK << TST.B (A0)+ * END OF TABLE? BNE RDLX4 * NO, CONTINUE SEARCH * LAST CHANCE TO BE A TCHAR ... CMPI.B #127,D0 * SPECIAL CASE: IS THIS CHAR AN FKEY? BLS.S RDLX6 * NO TST.W D1 * YES: "FUNCTION-KEY TCHARS" ACTIVE? BNE.S RDLX10 * YES, BREAK BRA.S RDLX9 * RDLX2 * NO >> REJECT KEY << * NOT A TCHAR, CHECK FOR A BACKSPACE ... RDLX6 CMPI.B #DELCH1,D0 * BACKSPACE? BEQ.S RDLX8 * YES CMPI.B #DELCH2,D0 * DELETE? BEQ.S RDLX8 * YES *** NORMAL CHARACTER, HANDLE IT ... CMPA.L A3,A2 * BUFFER OVERFLOW? BCC.S RDLX9 * BHS * YES, IGNORE CHAR, JUST BEEP MOVE.B D0,(A2)+ * STORE CHAR BSR TTYOUT * AND ECHO IT BRA.S RDLX2 * HANDLE A BACKSPACE RDLX8 CMPA.L A1,A2 * BUFFER UNDERFLOW? BLS.S RDLX9 * YES, JUST BEEP SUBQ.L #1,A2 * NO, BACK UP BUFFER POINTER MOVE.B (A2),D0 * (PASS PREVIOUS CHAR IN HIGH BYTE) LSL.W #8,D0 MOVE.B #DELCH1,D0 BSR TTYOUT * AND ECHO A BS BRA RDLX2 * ERROR, BEEP -- BUFFER TOO FULL/EMPTY. DISCARD CHAR, NO ECHO. RDLX9 *** MOVEQ #1,D0 *** BSR DOSOUND BSR ZBEEP * BEEP AT USER IF D3BUG THEN BSR D3CHK ENDIF BRA RDLX2 * AND KEEP WAITING * TIMEOUT OCCURRED (NO ABORT) * RE-ECHO ENTIRE INPUT LINE, BUT ONLY IF GAME WROTE AFTER THE OLD ONE * WE ASSUME GAME PRINTED A FRESH CR, AND A PROMPT (>) IF NEEDED * >> MAJOR KLUDGE, DEAD IN YZIP << RDLX9A ** SWAP D0 * "REDRAW" FLAG IS IN HIGH HALF OF REGISTER ** TST.W D0 * DID CURSOR POSITION CHANGE DURING TIMEOUT? ** BEQ RDLX2 * NO, DON'T REDRAW ** MOVE.L A1,-(SP) * SAVE START PTR ** BRA.S RDLX9C ** X9B MOVE.B (A1)+,D0 ** BSR TTYOUT * ECHO ONE-AT-A-TIME, SO WILL WRAP IF NEEDED ** X9C CMPA.L A2,A1 * ANY MORE? ** BLT.S RDLX9B * YES ** MOVE.L (SP)+,A1 BRA RDLX2 * START WAITING AGAIN *** DONE, HANDLE THE TERMINATING CHAR <<< DON'T STORE IN BUFFER >>> RDLX10 MOVE.W D0,D2 * SAVE TCHAR CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN? BNE.S RDLX12 * NO >>> SKIP THE ECHO? <<< BSR TTYOUT * YES, ECHO IT RDLX12 CMPA.L A3,A2 * ANY ROOM LEFT? BCC.S RDLX14 * BHS * NO (SIGH) CLR.B (A2) * INPUT SHOULD BE FOLLOWED BY A BREAK (ZWSTR) * ADJUST THE [MORE] COUNTER AFTER MULTI-LINE INPUT * (DEAD; WAS VERY KLUDGY. NOW ADJUST FOR 1 LINE MAX) RDLX14 CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN? BNE.S RDLX20 * NO RDLX16 MOVE.L CURWP(A6),A0 *** MOVEQ #0,D0 *** MOVE.B WFONTYX(A0),D0 * VERTICAL LINE SIZE *** ADD.W D0,WLCNT(A0) * BUMP THE [MORE] COUNTER ADDQ.W #1,WLCNT(A0) * SCRIPT THE USER INPUT LINE (IF SCRIPTING IS ACTIVE) * AVOID PROBLEMS WITH BACKSPACES, BY WAITING UNTIL INPUT IS COMPLETE * [DEAD -- YZIP] RDLX20 * MOVEQ #0,D1 *** CMPI.B #EOLCHR,D2 * BUT WAS THE CHAR A RETURN? *** BNE.S RDLX22 * NO, AVOID SCRIPTING [XZIP] *** MOVEQ #1,D1 * YES, (AND ADD A CR) *** MOVE.L A1,A0 * START OF LINE *** MOVE.L A2,D0 *** SUB.L A1,D0 * LENGTH *** BSR SCRINP RDLX22 MOVE.W D2,D0 * RETURN TERM CHAR MOVE.L A2,A0 * RETURN END-OF-INPUT (+1) POINTER MOVEM.L (SP)+,D1-D2/A1-A3 RTS * --------------------------- * LCASE * --------------------------- * LOWER-CASIFY A LINE OF INPUT, A0 -> INPUT, D0.W = LEN LCASE BRA.S LCSX3 LCSX1 CMPI.B #'A',(A0) * UPPERCASE CHAR? BLT.S LCSX2 * NO CMPI.B #'Z',(A0) * MAYBE? BGT.S LCSX2 * NO ADDI.B #32,(A0) * YES, LOWER-CASIFY IT LCSX2 ADDQ.L #1,A0 LCSX3 DBF D0,LCSX1 * ZERO CHECK << ENTRY POINT >> RTS * ------------------------------ * FINDBK * ------------------------------ * FIND THE NEXT BREAK CHARACTER * GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH * RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO FINDBK MOVEM.L D1/A1-A3,-(SP) MOVE.L A0,A2 ADDA.W D0,A2 * END OF INPUT (+1) CLR.W D1 * COUNT OF SIGNIFICANT CHARS FBX1 MOVE.L A0,A1 * REMEMBER START OF CURRENT WORD FBX2 CMPA.L A0,A2 * END OF INPUT STRING? BEQ.S FBX8 * YES MOVE.B (A0)+,D0 * NO, PICK UP NEXT CHAR MOVE.L RBRKS(A6),A3 * LIST OF READ-BREAK CHARACTERS CMPI.B #127,D0 * BUT IS THIS A FUNCTION KEY? BHI.S FBX6 * YES, CONSIDER IT A S.I. BREAK (?) FBX4 CMP.B (A3),D0 * SEARCH LIST FOR CHAR << XZIP: "NULL" TOO >> BEQ.S FBX6 * FOUND IT TST.B (A3)+ * END OF (ASCIZ) LIST? BNE FBX4 * NO, CONTINUE SEARCH ADDQ.W #1,D1 * YES, NOT A BREAK, BUMP COUNT BRA FBX2 *** BREAK CHAR FOUND ... FBX6 TST.W D1 * WORD READ /BEFORE/ THIS BREAK? BNE.S FBX8 * YES, GO FOR IT CMPA.L ESIBKS(A6),A3 * NO, BUT WAS THIS A SELF-INSERTING BREAK? BCC.S FBX1 * BHS * NO, JUST SKIP IT, LOOP FOR NEXT ADDQ.W #1,D1 * YES, BUMP COUNT AND GO FOR ZWORD *** CLEAN UP AND EXIT ... FBX8 MOVE.L A1,A0 * RETURN START OF CURRENT WORD MOVE.W D1,D0 * RETURN LENGTH OF CURRENT WORD MOVEM.L (SP)+,D1/A1-A3 RTS * ------------------------------ * RDERR * ------------------------------ * TOO MANY WORDS FOUND IN THE INPUT BUFFER, INFORM LOSER * A0 -> START OF EXCESS INPUT, A1 -> END OF INPUT (+1) RDERR MOVE.L A0,-(SP) * SAVE ARG HERE BSR PUTNEW LEA MSGIO1,A0 BSR OUTMSG0 * '[Too many words ... "' DATA MSGIO1 DC.B '[Too many words typed, discarding ',$22,0 CODE MOVE.L (SP)+,A0 * START OF FLUSHED WORD/STRING MOVE.B (A1),-(SP) * SAVE TERMINAL BYTE, TO BE SAFE CLR.B (A1) * MAKE STRING ASCIZ BSR OUTMSG0 * ECHO IT MOVE.B (SP)+,(A1) * RESTORE THIS BYTE LEA MSGIO2,A0 BSR OUTMSG * '."]' DATA MSGIO2 DC.B '.',$22,']',0 CODE BSR PUTNEW * FINAL CR RTS * --------------------------- * INITLX * --------------------------- * INIT VOCABULARY VARS, GIVEN A VOCAB TABLE POINTER IN A0 * (CALLED AT BEGINNING OF EACH "LEX" CALL) INITLX MOVEM.L D1-D2/A1-A2,-(SP) CLR.W D0 MOVE.B (A0)+,D0 * THIS BYTE IS THE # OF SI BREAKS ADDA.W D0,A0 * SKIP THEM (READ DURING STARTUP ONLY) CLR.W D0 MOVE.B (A0)+,D0 * THIS BYTE IS THE LENGTH OF EACH VOCTAB ENTRY MOVE.W D0,VWLEN(A6) * SAVE IT MOVE.B (A0)+,D0 * THIS WORD IS # OF VOCTAB ENTRIES ASL.W #8,D0 MOVE.B (A0)+,D0 MOVE.L A0,VOCBEG(A6) * THIS IS BEGINNING OF ACTUAL VOCABULARY TST.W D0 * IF POSITIVE #, TABLE IS SORTED BGT.S INLX4 NEG.W D0 * OTHERWISE, NOT SORTED, POSITIVIZE COUNT CLR.W D1 * AND INDICATE UNSORTED TABLE BRA.S INLX6 * SORTED TABLE -- CALCULATE INITIAL OFFSET FOR BINARY SEARCH INLX4 MOVE.W D0,D2 MOVE.W VWLEN(A6),D1 * NUMBER OF BYTES PER VOCAB ENTRY ASR.W #1,D2 INLX5 ASL.W #1,D1 ASR.W #1,D2 BNE INLX5 MOVE.W D1,VWBOFF(A6) * SAVE INITIAL BINARY SEARCH OFFSET MOVEQ #1,D1 * INDICATE A SORTED TABLE INLX6 MOVE.W D0,VWORDS(A6) * SAVE COUNT MOVE.W D1,VWSORT(A6) * SAVE FLAG SUBQ.W #1,D0 MULS VWLEN(A6),D0 ADD.L VOCBEG(A6),D0 * CALCULATE POINTER TO LAST ENTRY MOVE.L D0,VOCEND(A6) * SAVE IT MOVEM.L (SP)+,D1-D2/A1-A2 RTS * ------------------------------ * LOOKUP * ------------------------------ * SEARCH (CURRENT) VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0 * RETURN ZWORD'S TABLE ADDR (RELATIVIZED) IN D0.W, NULL IF NOT FOUND LOOKUP MOVEM.L D1/A1-A3,-(SP) MOVE.L A0,A3 * SAVE POINTER TO GIVEN ZWORD HERE MOVE.L VOCBEG(A6),A2 * BEGINNING OF (CURRENT) VOCABULARY TABLE TST.W VWORDS(A6) * EMPTY TABLE? BEQ.S LKX14 * YES, RETURN ZERO TST.W VWSORT(A6) * SORTED TABLE? BNE.S LKX2 * YES LKX1 MOVE.L A2,A0 * NO, MUST DO LINEAR SEARCH MOVE.L A3,A1 BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD BEQ.S LKX12 * SAME, WE'VE FOUND IT ADDA.W VWLEN(A6),A2 * NEXT TABLE ITEM CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE? BLS LKX1 * NO BRA.S LKX14 * YES, WORD NOT FOUND, RETURN ZERO *** SORTED TABLE LKX2 MOVE.W VWBOFF(A6),D1 * INITIAL OFFSET FOR BINARY SEARCH ADDA.W D1,A2 * INITIAL POINTER INTO TABLE SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG, EXACT-POWER-OF-2 TABLE LKX4 ASR.W #1,D1 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE MOVE.L A2,A0 MOVE.L A3,A1 BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD BHI.S LKX8 * GREATER, MOVE DOWN BEQ.S LKX12 * SAME, WE'VE FOUND IT *** BCS.S LKX6 * (BLO) * LESS, MOVE UP LKX6 ADDA.W D1,A2 * TO MOVE UP, ADD OFFSET CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE? BLS.S LKX10 * NO MOVE.L VOCEND(A6),A2 * YES, POINT TO END OF TABLE BRA.S LKX10 LKX8 SUBA.W D1,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET LKX10 CMP.W VWLEN(A6),D1 * IS OFFSET RESOLUTION AT LEAST ONE WORD? BGE LKX4 * YES, CONTINUE LOOP BRA.S LKX14 * NO, WORD NOT FOUND *** DONE, WINNING VOCAB POINTER LEFT IN A2 LKX12 MOVE.L A2,D0 SUB.L BUFFER(A6),D0 * RELATIVIZE THE ZWORD'S VOCAB TABLE OFFSET BRA.S LKX16 LKX14 MOVEQ #0,D0 * WORD NOT FOUND, RETURN ZERO LKX16 MOVEM.L (SP)+,D1/A1-A3 RTS * ------------------------------ * VCOMP * ------------------------------ * COMPARE GIVEN ZWORD (A1) TO CURRENT TABLE ZWORD (A0) * RETURN WITH FLAGS VCOMP MOVEQ #ZCHARS-1,D0 * CHECK THREE WORDS VCPX1 CMPM.B (A1)+,(A0)+ DBNE D0,VCPX1 * TAKE BRANCH IF EQUAL RTS * UNROLL THE LOOP (RUNS A BIT FASTER) ** CMPM.B (A1)+,(A0)+ * CHECK FIRST WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** CMPM.B (A1)+,(A0)+ * CHECK SECOND WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** IF EZIP THEN ** CMPM.B (A1)+,(A0)+ * CHECK THIRD WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** ENDIF * VCPX2 RTS * OTHERWISE SAME, EXIT * ------------------------------ * TIMEOUT PRIMITIVES * ------------------------------ * NOTE: THIS TIMEOUT IMPLEMENTATION USES A SIMPLE "BUSY LOOP" RATHER THAN * A REAL CPU INTERRUPT. THIS IS OK FOR SOME MACHINES BUT WOULD NOT BE GOOD * FOR MULTITASKING ONES. IF AN INTERRUPT IS USED, ONE PROBLEM TO THINK * ABOUT: THE LOW-LEVEL INPUT FUNCTION (TTYIN) MUST BE CANCEL-ABLE WHEN THE * TIMEOUT ABORT OCCURS. * * THE TIMEOUT COUNTDOWN MECHANISM HAS CHANGED A BIT; IT NOW FUNCTIONS ONLY * WHEN THE BUSY LOOP IS RUNNING. IT'S SUSPENDED IF THE LOOP STOPS FOR * MORE THAT 1/10 SEC (E.G. WHEN A DESK ACCESSORY IS UP, OR A MENU IS PULLED * DOWN. OTHERWISE, A TIMEOUT COULD OCCUR IN THE BACKGROUND, AND A NOXIOUS * EVENT COULD SPILL OUT THE MOMENT THE GAME IS SWITCHED BACK IN.) * * << WARNING: >> BE CAREFUL ABOUT REDUCING THE POLLING FREQUENCY, AS FOR * MULTIFINDER. MUST LOOP AT LEAST EVERY 1/10 SEC FOR US TO WORK CORRECTLY. * ---------------------- * TRESET, TNEXT * ---------------------- * RESET THE TIMEOUT COUNTDOWN VARS TRESET TST.W TWAIT(A6) * BUT ARE TIMOUTS IN EFFECT? BLT.S TNEX1 * NO, EXIT BSR TIME60 MOVE.L D0,TCLOCK(A6) * INITIAL REFERENCE TIME (IN 60THS) TNEXT MOVE.W TWAIT(A6),TCOUNT(A6) * TOTAL DELAY (IN 10THS) TNEX1 RTS * ---------------------- * TCHECK * ---------------------- * UPDATE THE TIMEOUT CLOCK & COUNTER, * RETURN TIME REMAINING (ZERO IF NONE) & FLAGS TCHECK BSR TIME60 * CURRENT TIME (IN 60THS) SUB.L TCLOCK(A6),D0 * ELAPSED TIME, SINCE LAST CHECK CMPI.L #12,D0 BGE.S TCHX2 * ET >= 2/10, RESET CLOCK, DON'T TOUCH COUNTER SUBQ.L #6,D0 BLT.S TCHX3 * ET < 1/10, DO NOTHING SUBQ.W #1,TCOUNT(A6) * 1/10 <= ET < 2/10, UPDATE CLOCK & COUNTER MOVEQ #6,D0 TCHX2 ADD.L D0,TCLOCK(A6) TCHX3 MOVE.W TCOUNT(A6),D0 * RETURN COUNTER/FLAGS RTS EJECT ; PAGE * --------------------------------------------------------------------------- * I/O OPERATIONS -- OUTPUT * --------------------------------------------------------------------------- * ---------------------- * OPUSL * ---------------------- * OPUSL (UPDATE STATUS LINE) IF EZIP THEN OPUSL BRA OPERR * DEAD INSTRUCTION ENDIF * ---------------------- * OPPRNC * ---------------------- * PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN) OPPRNC BRA PUTCHR * HANDLE IT * ---------------------- * OPPRNN * ---------------------- * PRINTN (PRINT A NUMBER, USING CURRENT CHARACTER OUTPUT FUNCTION) OPPRNN MOVE.W D0,D1 * NON-ZERO NUMBER? BNE.S PRNNX1 * YES MOVE.B #'0',D0 * ZERO, SPECIAL CASE BRA PUTCHR * PRINT A ZERO PRNNX1 BGT.S PRNNX2 * POSITIVE? MOVE.B #'-',D0 * NO, PRINT A MINUS SIGN BSR PUTCHR NEG.W D1 * AND MAKE NUMBER POSITIVE PRNNX2 CLR.W D2 * COUNT OF DIGITS ON STACK BRA.S PRNNX4 * START WITH GREATER-THAN-10 TEST PRNNX3 EXT.L D1 * CLEAR HIGH WORD FOR DIVISION DIVU #10,D1 * EXTRACT A DIGIT (THE REMAINDER) SWAP D1 MOVE.W D1,-(SP) * PUSH IT SWAP D1 ADDQ.W #1,D2 * BUMP COUNT PRNNX4 CMPI.W #10,D1 * ANY MORE DIGITS TO EXTRACT? BGE PRNNX3 * YES MOVE.W D1,D0 * NO, POSITION LAST (FIRST) DIGIT BRA.S PRNNX6 PRNNX5 MOVE.W (SP)+,D0 * POP NEXT DIGIT PRNNX6 ADDI.B #'0',D0 * ASCIIZE IT BSR PUTCHR * PRINT NEXT DIGIT SUBQ.W #1,D2 * ANY DIGITS LEFT ON STACK? BGE PRNNX5 * YES RTS * ---------------------- * OPPRIN * ---------------------- * PRINT (THE STRING POINTED TO) OPPRIN MOVEQ #0,D1 * ZERO HIGH WORD MOVE.W D0,D1 * QUAD PTR MOVE.L QSOFF(A6),D0 * QUAD STRING OFFSET BSR BSPLTQ2 * SPLIT THE BLOCK AND OFFSET BRA PUTSTR * PRINT THE STRING * ---------------------- * OPPRNB * ---------------------- * PRINTB (THE STRING POINTED TO) OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE) BRA PUTSTR * PRINT THE STRING * ---------------------- * OPPRND * ---------------------- * PRINTD (PRINT OBJ'S SHORT DESCRIPTION) OPPRND BSR OBJLOC * FIND OBJECT'S LOCATION ADDA.W #PROP,A0 * PROPERTY TABLE POINTER (ZIP/EZIP) BSR GTAWRD * GET IT ADDQ.W #1,D0 * POINT TO SHORT DESCRIPTION STRING BSR BSPLTB * SPLIT THE POINTER BRA PUTSTR * AND PRINT THE STRING * ---------------------- * OPPRNI * ---------------------- * PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION) OPPRNI MOVE.W ZPC1(A6),D0 * GET POINTER TO STRING MOVE.W ZPC2(A6),D1 BSR PUTSTR * PRINT IT MOVE.W D0,ZPC1(A6) * AND UPDATE ZPC MOVE.W D1,ZPC2(A6) BRA NEWZPC * ---------------------- * OPPRNR * ---------------------- * PRINTR (PRINTI FOLLOWED BY RTRUE) OPPRNR BSR OPPRNI * DO A PRINTI BSR.S OPCRLF * A CRLF BRA OPRTRU * AND AN RTRUE * ---------------------- * OPCRLF * ---------------------- * CRLF (DO A NEWLINE) OPCRLF BRA PUTNEW * DO A NEWLINE * ------------------------------------------------------------------ * WINDOW-RELATED PRIMITIVES * ------------------------------------------------------------------ * ---------------------- * MAPCW * ---------------------- * GIVEN D0.W = WINDOW ID, CHECK IF -3; IF SO, SUBSTITUTE CURRENT ID MAPCW CMPI.W #-3,D0 BNE.S MPWDX1 MOVE.W CURWIND(A6),D0 MPWDX1 RTS * ---------------------- * CALCWP * ---------------------- * GIVEN D0.W = WINDOW ID, RETURN A0 -> THE CORRESPONDING RECORD CALCWP TST.W D0 * VALID WINDOW ID? BLT.S CLWPX2 * NO/MAYBE CMPI.W #MAXWIND,D0 BGE.S CLWPX2 * NO ADD.W D0,D0 ADD.W D0,D0 * OFFSET x4 LEA WBLOCKP(A6),A0 MOVE.L 0(A0,D0.W),A0 * GET PTR TO NEW WINDOW RECORD RTS CLWPX2 ADDQ.W #3,D0 * ID = -3 NOW MEANS USE CURRENT WP BEQ.S CLWPX3 DATA MSGWID DC.B 'Bad WID',0 CODE LEA MSGWID,A0 BSR ZWARN * FOR -1, ETC, SHOW WARNING (& RETURN CURRENT) CLWPX3 MOVE.L CURWP(A6),A0 * RETURN CURRENT WP RTS * ---------------------- * WBOUNDS * ---------------------- * GIVEN D0.W = ALTERNATE ID * SET POSITION/SIZE OF THE DISPLAY WINDOW (TEMPORARY, e.g. FOR SCROLL/CLEAR) WBOUNDS MOVEM.L D1-D3/A1,-(SP) BSR CALCWP MOVE.L A0,A1 MOVE.W WYPOS(A1),D0 MOVE.W WXPOS(A1),D1 MOVE.W WYSIZE(A1),D2 MOVE.W WXSIZE(A1),D3 BSR NEWBOUNDS * ALSO, TEMPOARILY ADJUST THE (BACKGROUND) COLOR * [SHOULD THIS WHOLE ROUTINE BE REPLACED BY A CALL TO OPSCRN?] MOVE.W WCOLOR(A1),D0 MOVE.W D0,D1 ANDI.W #$00FF,D0 * FORE EXT.W D0 * [IN CASE IT'S -1] ASR.W #8,D1 * BACK BSR MDCOLOR * SET COLORS TOO MOVEM.L (SP)+,D1-D3/A1 RTS * ---------------------- * TSTWFLG * ---------------------- * TEST A BIT IN THE CURRENT WINDOW ATTRIBUTES WORD (SCROLL, SCRIPT, ETC), * GIVEN D0.W = BIT NUMBER, RETURN FLAGS [MAKE THIS A MACRO?] TSTWFLG MOVE.L CURWP(A6),A0 AND.W WATTR(A0),D0 * INDICATED BIT ON? RTS * ------------------------------------------------------------------ * WINDOW OPERATIONS * ------------------------------------------------------------------ * ---------------------- * OPSCRN * ---------------------- * MAKE OUTPUT FALL INTO SPECIFIED WINDOW, D0.W = ID * (OPSCRN MAY BE CALLED INTERNALLY, BY OPSPLT) OPSCRN BSR MAPCW * D0.W -> NORMAL ID CMP.W CURWIND(A6),D0 BEQ SCRNX9 * SAME, EXIT MOVE.W D0,D2 * SAVE ARG *** BSR PUTLIN1 BSR PUTLIN * EMPTY BUFFER IF NEEDED (KEEPING CURSIZ) * SAVE CURRENT CURSOR POS IN CURRENT WINDOW REC BSR GETCURS * GET CURSOR POS [1-ORIGIN] MOVE.L CURWP(A6),A1 MOVE.W D0,WYCURS(A1) * AND STORE IT MOVE.W D1,WXCURS(A1) * BUFFER "FULLNESS" INFO NOW /IS/ PRESERVED ACROSS WINDOWS MOVE.L DQUE(A6),A2 MOVE.W CURSIZ(A2),WCSIZ(A1) * SAVE CURRENT BUFFER "FULLNESS" * SWITCH WINDOWS (ALL OTHER PARAMS SHOULD BE VALID!) MOVE.W D2,CURWIND(A6) * STORE NEW WINDOW ID MOVE.W D2,D0 BSR CALCWP MOVE.L A0,CURWP(A6) * AND NEW RECORD POINTER MOVE.L A0,A1 * SET UP NEW BUFFER "FULLNESS" INFO ["BUFSIZ" IS SET ELSEWHERE] MOVE.W WCSIZ(A1),CURSIZ(A2) * SET UP NEW WINDOW POS/SIZE, CURSOR POS, ETC MOVE.W WLMARG(A1),D0 MOVE.W WRMARG(A1),D1 BSR SETMARG MOVE.W WYPOS(A1),D0 MOVE.W WXPOS(A1),D1 MOVE.W WYSIZE(A1),D2 MOVE.W WXSIZE(A1),D3 BSR SETBOUNDS * [MUST CALL /AFTER/ SETMARG] MOVE.W WYCURS(A1),D0 * 1-ORIGIN MOVE.W WXCURS(A1),D1 BSR SETCURS * [MUST CALL /AFTER/ SETBOUNDS] MOVE.W WFONTID(A1),D0 *** MOVE.W WFONTXY(A1),D1 * [NOT HANDLED] BSR SETFONT MOVE.W WHLIGHT(A1),D0 BSR SETHL MOVE.W WATTR(A1),D0 BSR SETATTR MOVE.W WCOLOR(A1),D0 MOVE.W D0,D1 ANDI.W #$00FF,D0 * FORE EXT.W D0 * [IN CASE IT'S -1] ASR.W #8,D1 * BACK BSR MDCOLOR * UPDATE COLORS [/AFTER/ SETCURS, FOR ID = -1] SCRNX9 RTS * ---------------------- * OPSPLT * ---------------------- * SPLIT THE SCREEN BETWEEN THE FIRST TWO WINDOWS (FOR BACKWARD COMPATIBILITY) * GIVEN D0 = LINES IN WINDOW 1 (UPPER) OPSPLT MOVE.W D0,D2 * SAVE SPLIT COUNT HERE BSR PUTLIN1 * EMPTY (&ZERO) BUFFER IF NEEDED * CHECK FOR VALID ARG BSR MAXSCRN * GET TOTAL ROWS CMP.W D0,D2 BLE.S SPLTX1 MOVE.W D0,D2 * CAN'T HAVE MORE THAN FULL SCREEN *** BSR ZWARN * READ CURRENT CURSOR POS INTO CURRENT WINDOW REC (ALL OTHER PARAMS SHOULD BE * VALID!) (THIS /NOT/ DONE IN OPSCRN, IF CURRENT WINDOW IS W0) SPLTX1 BSR GETCURS * GET Wx CURSOR POS [1-ORIGIN] MOVE.L CURWP(A6),A1 MOVE.W D0,WYCURS(A1) * AND STORE IT MOVE.W D1,WXCURS(A1) MOVE.W D2,-(SP) * PROTECT REG(S) ACROSS OPx CALL MOVEQ #0,D0 * MAKE SURE WE'RE IN W0 BSR OPSCRN MOVE.W (SP)+,D2 * GET RECORD POINTERS FOR FIRST TWO WINDOWS MOVE.L CURWP(A6),A2 * WINDOW 0 MOVEQ #1,D0 BSR CALCWP MOVE.L A0,A1 * WINDOW 1 * SET NEW POSITIONS/SIZES MOVE.W #1,D0 MOVE.W D0,WYPOS(A1) MOVE.W D2,WYSIZE(A1) MOVE.W D0,WYCURS(A1) * "HOME THE W1 CURSOR" MOVE.W D0,WXCURS(A1) ADD.W D2,D0 MOVE.W WYPOS(A2),D1 * OLD W0 POSITION MOVE.W D0,WYPOS(A2) SUB.W D0,D1 ADD.W WYSIZE(A2),D1 * "ADJUST SIZE SO W0 BOTTOM DOESN'T MOVE" BGE.S SPLTX2 MOVEQ #0,D1 SPLTX2 MOVE.W D1,WYSIZE(A2) *** MOVE.W D2,D0 *** BSR SETSPLT * [FOR BACKWARD COMPATIBILITY] MOVE.W WYPOS(A2),D0 MOVE.W WXPOS(A2),D1 MOVE.W WYSIZE(A2),D2 MOVE.W WXSIZE(A2),D3 BSR NEWBOUNDS * ADJUST BOUNDS, /DON'T/ ADJUST CURSOR BSR GETCURS * GET NEW >>RELATIVE<< W0 CURSOR POS MOVE.W D0,WYCURS(A2) * AND STORE IT MOVE.W D1,WXCURS(A2) BSR SETCURS * FORCE IT INBOUNDS, IF NEEDED SPLTX5 RTS * ---------------------- * OPWPOS * ---------------------- OPWPOS BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,D3 * SAVE HERE BSR CALCWP MOVE.L A0,A3 * CHECK FOR VALID POSITION (SIZE NOT TAKEN INTO ACCOUNT HERE) MOVE.L BUFFER(A6),A0 CMP.W PVWRD(A0),D1 BHI.S WPOSX1 * OUT OF BOUNDS CMP.W PHWRD(A0),D2 BLS.S WPOSX2 * OK DATA MSGWPS DC.B 'Bad WINPOS',0 CODE WPOSX1 LEA MSGWPS,A0 BSR ZWARN * SHOW A WARNING WPOSX2 MOVE.W D1,WYPOS(A3) * STORE NEW COORDS (1-ORIGIN) MOVE.W D2,WXPOS(A3) CMP.W CURWIND(A6),D3 * THIS THE CURRENT ACTIVE WINDOW? BNE.S WPOSX9 * NO MOVE.W D1,D0 * YES, UPDATE SCREEN MOVE.W D2,D1 MOVE.W WYSIZE(A3),D2 MOVE.W WXSIZE(A3),D3 BSR SETBOUNDS WPOSX9 RTS * ---------------------- * OPWSIZ * ---------------------- OPWSIZ BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,D3 * SAVE HERE BSR CALCWP MOVE.L A0,A3 MOVE.W D1,WYSIZE(A3) * STORE NEW SIZE MOVE.W D2,WXSIZE(A3) * DON'T TOUCH [MORE] COUNTER (WILL BE COMPARED WITH /NEW/ WYSIZE) *** CLR.W WLCNT(A3) CMP.W CURWIND(A6),D3 * THIS THE CURRENT ACTIVE WINDOW? BNE.S WSIZX3 * NO MOVE.W D2,D3 * YES, UPDATE SCREEN MOVE.W D1,D2 MOVE.W WYPOS(A3),D0 MOVE.W WXPOS(A3),D1 BSR SETBOUNDS WSIZX3 RTS * ---------------------- * OPWATTR * ---------------------- OPWATTR DC.W 3 * DEFAULT ARGBLK DC.W SKIP,SKIP,0 * DEFAULT OP = "MOVE" MOVE.L A0,A1 MOVE.W ARG1(A1),D0 * WINDOW ID BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,ARG1(A1) * SAVE BSR CALCWP MOVE.L A0,A2 MOVE.W ARG2(A1),D1 * ARG BITS MOVE.W WATTR(A2),D0 * CURRENT BITS MOVE.W ARG3(A1),D2 * BITWISE OP: BEQ.S WATTX1 * "MOVE" SUBQ.W #1,D2 BEQ.S WATTX2 * "SET" SUBQ.W #1,D2 BEQ.S WATTX3 * "CLEAR" SUBQ.W #1,D2 BEQ.S WATTX4 * "COMP" *** BSR ZWARN BRA.S WATTX6 * NOT A VALID OP WATTX1 MOVE.W D1,D0 BRA.S WATTX5 WATTX2 OR.W D1,D0 BRA.S WATTX5 WATTX3 AND.W D0,D1 * FLIP ONLY THE GIVEN BITS THAT ARE "ON" WATTX4 EOR.W D1,D0 * FLIP ALL GIVEN BITS WATTX5 MOVE.W D0,WATTR(A2) * STORE BITS MOVE.W D0,D1 MOVE.W ARG1(A1),D0 * WINDOW ID CMP.W CURWIND(A6),D0 * THIS THE CURRENT ACTIVE WINDOW? BNE.S WATTX6 * NO BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED MOVE.W D1,D0 BSR SETATTR WATTX6 RTS * ---------------------- * OPCURS * ---------------------- * SET CURSOR TO ROW/COLUMN OPCURS NOP * REQUEST AN ARGBLK CMPI.W #2,(A0) BGT.S OPCSX1 MOVE.W CURWIND(A6),ARG3(A0) * USE CURRENT WINDOW OPCSX1 MOVE.L A0,A1 MOVE.W ARG3(A1),D0 * WINDOW ID BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,ARG3(A1) * SAVE BSR CALCWP MOVE.L A0,A2 MOVE.W ARG1(A1),D0 * ROW MOVE.W ARG2(A1),D1 * COL CMPI.W #1,D0 * ROW: OUT OF BOUNDS? BGE.S OPCSX2 MOVE.W #1,D0 * YES, MOVE WITHIN BOUNDS OPCSX2 CMP.W WYSIZE(A2),D0 BLE.S OPCSX3 MOVE.W WYSIZE(A2),D0 OPCSX3 MOVE.W D0,WYCURS(A2) CMPI.W #1,D1 * COL: OUT OF BOUNDS? BGE.S OPCSX4 MOVE.W #1,D1 * YES, MOVE WITHIN BOUNDS OPCSX4 CMP.W WXSIZE(A2),D1 BLE.S OPCSX5 MOVE.W WXSIZE(A2),D1 OPCSX5 MOVE.W D1,WXCURS(A2) MOVE.W D0,D2 * PROTECT ARG MOVE.W ARG3(A1),D0 CMP.W CURWIND(A6),D0 * THIS THE CURRENT ACTIVE WINDOW? BNE.S OPCSX6 * NO BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED MOVE.W D2,D0 BSR SETCURS * D0 = ROW, D1 = COL OPCSX6 RTS * ---------------------- * OPCURG * ---------------------- * GET CURSOR POSITION [1-ORIGIN] [ALWAYS CURRENT WINDOW] OPCURG * MOVE.W D0,-(SP) * BSR PUTLIN * [DONE BY GETCURS] * MOVE.W (SP)+,D0 BSR RELABS * TABLE FOR RETURN VALUES MOVE.L A0,A1 BSR GETCURS MOVE.L A1,A0 BSR PTAWRD * STORE ROW MOVE.L A1,A0 ADDQ.L #2,A0 MOVE.W D1,D0 BRA PTAWRD * STORE COLUMN * ---------------------- * OPWGET, OPWPUT * ---------------------- * [REPLACEMENT ROUTINES, PER NEWEST YZIP SPEC] * WINGET window,field > VAL OPWGET NOP MOVE.L A0,A1 * ARGBLK MOVE.W ARG1(A1),D0 * ID BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,ARG1(A1) CMP.W CURWIND(A6),D0 * FROM THE CURRENT WINDOW? BNE.S OPG2X2 * NO * [SHOULD GET CURSOR POS /ONLY/ IF THAT'S WHAT IS NEEDED -- * WANT TO AVOID FLUSHING BUFFER DURING POSSIBLE CR INTERRUPTS] BSR GETCURS * YES, FIRST GET CURSOR POS MOVE.L CURWP(A6),A0 MOVE.W D0,WYCURS(A0) * AND UPDATE WREC, IN CASE NEEDED MOVE.W D1,WXCURS(A0) OPG2X2 BSR.S WGTWPT * CALC FIELD PTR MOVE.L A0,D0 * ERROR? BEQ.S OPG2X9 * RETURN ZERO MOVE.W (A0),D0 OPG2X9 BRA PUTVAL * RETURN THE VAL * WINPUT window,field,val OPWPUT NOP MOVE.L A0,A1 * ARGBLK BSR.S WGTWPT * CALC FIELD PTR MOVE.L A0,D0 * ERROR? BEQ.S OPP2X9 * EXIT * CHECK FOR WRITE TO "ILLEGAL" FIELD [GIVE A WARNING BUT ALLOW IT] MOVE.W ARG3(A1),(A0) * STORE THE VAL IN WREC MOVE.W ARG2(A1),D0 * WORD OFFSET AGAIN ADD.W D0,D0 * BYTES CMPI.W #WCRINT,D0 * THESE ARE THE ONLY LEGAL FIELDS BEQ.S OPP2X9 CMPI.W #WCRCNT,D0 BEQ.S OPP2X9 CMPI.W #WLCNT,D0 BEQ.S OPP2X9 LEA MSGWPT,A0 BSR ZWARN * SHOW A WARNING DATA MSGWPT DC.B 'Bad wRec Write',0 CODE OPP2X9 RTS * COMMON ROUTINE TO INDEX INTO A WINDOW REC * GIVEN A1 -> ARGBLK, ARG1 = WINDOW ID, ARG2 = FIELD * RETURN A0 -> FIELD, OR NULL IF ERR WGTWPT MOVE.W ARG1(A1),D0 BSR CALCWP * A0 -> WREC MOVE.W ARG2(A1),D0 * WORD OFFSET (IN WREC) ADD.W D0,D0 * BYTES * CHECK BOUNDS BLT.S WGWPX9 * NEG, ERROR CMPI.W #WBLKLEN,D0 BGE.S WGWPX9 * TOO BIG, ERROR ADDA.W D0,A0 * RETURN FIELD PTR RTS WGWPX9 LEA MSGWGP,A0 BSR ZWARN * SHOW A WARNING SUB.L A0,A0 * RETURN NULL PTR RTS DATA MSGWGP DC.B 'Bad wRec field',0 CODE *** DEAD ROUTINES IF CZIP THEN _OPWGET DC.W 3 * DEFAULT ARGBLK DC.W SKIP,SKIP,0 * DEFAULT OFFSET = 0 MOVE.L A0,A2 * A2 -> ARGBLK MOVE.W ARG1(A2),D0 CMP.W CURWIND(A6),D0 * FROM THE CURRENT WINDOW? BNE.S OPWGX1 * NO BSR GETCURS * YES, FIRST GET CURSOR POS MOVE.L CURWP(A6),A0 MOVE.W D0,WYCURS(A0) * AND STORE IT MOVE.W D1,WXCURS(A0) BRA.S OPWGX2 OPWGX1 BSR CALCWP OPWGX2 MOVE.L A0,A1 * A1 -> WREC MOVE.W ARG3(A2),D0 * OFFSET (IN WREC) BLT.S OPWGX9 * EXIT MOVEQ #WBLKLEN/2,D1 SUB.W D0,D1 * D1 = MAX #ITEMS (WORDS) TO COPY BLE.S OPWGX9 * EXIT ADD.W D0,D0 ADDA.W D0,A1 MOVE.W ARG2(A2),D0 BSR RELABS * A0 -> LTABLE BSR GTAWRD * (ADVANCE PTR) MOVE.W D0,D2 * D2 = MAX TABLE LEN (WORDS) BLE.S OPWGX9 * EXIT CMP.W D1,D2 BLE.S OPWGX4 * USE SMALLER OF TWO MOVE.W D1,D2 OPWGX4 MOVE.W (A1)+,D0 BSR PTAWRD * COPY A WORD, ADVANCE PTR SUBQ.W #1,D2 BGT.S OPWGX4 * LOOP OPWGX9 RTS _OPWPUT DC.W 3 * DEFAULT ARGBLK DC.W SKIP,SKIP,0 * DEFAULT OFFSET = 0 MOVE.L A0,A2 * A2 -> ARGBLK MOVE.W ARG1(A2),D0 BSR CALCWP MOVE.L A0,A3 * A3 -> WREC MOVEQ #WBLKLEN,D0 SUB.W D0,SP * MAKE SPACE FOR A TEMPORARY WREC MOVE.L SP,A1 OPWPX2 MOVE.W (A0)+,(A1)+ * COPY CONTENTS SUBQ.W #2,D0 BNE.S OPWPX2 MOVE.L SP,A1 * A1 -> TEMPORARY WREC MOVE.W ARG3(A2),D0 * OFFSET (IN WREC) BLT.S OPWPX9 * EXIT MOVEQ #WBLKLEN/2,D1 SUB.W D0,D1 * D1 = MAX #ITEMS (WORDS) TO COPY BLE.S OPWPX9 * EXIT ADD.W D0,D0 ADDA.W D0,A1 MOVE.W ARG2(A2),D0 BSR RELABS * A0 -> LTABLE BSR GTAWRD * (ADVANCE PTR) MOVE.W D0,D2 * D2 = MAX TABLE LEN (WORDS) BLE.S OPWPX9 * EXIT CMP.W D1,D2 BLE.S OPWPX4 * USE SMALLER OF TWO MOVE.W D1,D2 OPWPX4 BSR GTAWRD * PICKUP A WORD, ADVANCE PTR MOVE.W D0,(A1)+ * COPY TO (TEMPORARY) WREC SUBQ.W #1,D2 BGT.S OPWPX4 * LOOP * FINALLY, UPDATE THE ACTUAL WREC * THE CR FUNCTION/COUNT SLOTS ARE THE ONLY "LEGALLY WRITABLE" ONES MOVE.L SP,A1 * A1 -> TEMPORARY WREC MOVE.W WCRINT(A1),WCRINT(A3) MOVE.W WCRCNT(A1),WCRCNT(A3) OPWPX9 MOVEQ #WBLKLEN,D0 ADD.W D0,SP * CLEANUP STACK RTS ENDIF * ---------------------- * OPSCROLL * ---------------------- OPSCROLL DC.W 2 * DEFAULT ARGBLK DC.W SKIP,1 * DEFAULT DISTANCE = 1 UP MOVE.L A0,A2 * A2 -> ARGBLK BSR PUTLIN * FIRST EMPTY BUFFER, IF NEEDED MOVE.W ARG1(A2),D0 BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,ARG1(A2) * SAVE MOVE.W CURWIND(A6),D2 * SAVE ORIGINAL VALUE CMP.W D0,D2 * SAME? BEQ.S ROLLX1 * YES, JUST DO THE SCROLL BSR WBOUNDS * OTHERWISE, TEMPORARILY RESET WINDOW BOUNDS BSR ROLLX1 * >> CALL AS SUBR << MOVE.W D2,D0 * THEN RESTORE THEM BRA WBOUNDS * AND EXIT ROLLX1 MOVE.W ARG2(A2),D0 BRA MDSCROLL * ---------------------- * OPCLEAR * ---------------------- * CLEAR A WINDOW, OR ENTIRE SCREEN OPCLEAR BSR MAPCW * D0.W -> NORMAL ID MOVE.W D0,D2 BSR PUTLIN * EMPTY (IF NEEDED) BUFFER TST.W D2 * ID NEGATIVE? BLT.S OCLRX6 * YES, HANDLE SPECIALLY MOVE.W CURWIND(A6),D3 CMP.W D3,D2 * IN CURRENT WINDOW? BEQ.S OCLRX1 * YES MOVE.W D2,D0 BSR WBOUNDS * OTHERWISE, TEMPORARILY RESET WINDOW BOUNDS BSR OCLRX2 * >> CALL AS SUBR << MOVE.W D3,D0 * RESTORE CURRENT BOUNDS BRA WBOUNDS * AND EXIT OCLRX1 BSR PUTLIN1 * EMPTY (IF NEEDED) >> & ZERO << BUFFER OCLRX2 MOVEQ #0,D0 BSR MDCLEAR * CLEAR TARGET WINDOW (VISIBLY) * MOVE.W D2,xx BRA OCLRX8 * HOME CURSOR * HANDLE NEGATIVE ARGS: OCLRX6 MOVE.W #1,INLAST(A6) * "DON'T PAUSE UPON EXIT IF SCREEN CLEARED" MOVEQ #-1,D0 BSR MDCLEAR * CLEAR ENTIRE SCREEN CMPI.W #-1,D2 * ALSO SPLIT SCREEN, HOME CURSOR? BNE.S OCLRX9 * NO, EXIT * MOVE.L XX,-(SP) * PROTECT REG(S) ACROSS OPx CALL MOVEQ #0,D0 BSR OPSPLT * DO A SPLIT-0 * MOVE.L (SP)+,XX MOVE.W CURWIND(A6),D2 * GIVEN D2.W = TARGET WINDOW * HOME CURSOR, RESET LINE COUNT AND WRAP COUNT OCLRX8 MOVE.W D2,D0 BSR CALCWP * GET TARGET WREC MOVEQ #1,D0 MOVE.W D0,WYCURS(A0) * HOME CURSOR IN TARGET WINDOW MOVEQ #1,D1 ADD.W WLMARG(A0),D1 MOVE.W D1,WXCURS(A0) CLR.W WLCNT(A0) * RESET THE 'MORE' COUNTER CLR.W WCSIZ(A0) * RESET THE 'FULLNESS' COUNTER ALSO CMP.W CURWIND(A6),D2 * IN CURRENT WINDOW? BNE.S OCLRX9 BSR SETCURS * YES: UPDATE SCREEN CURSOR OCLRX9 RTS * ---------------------- * OPERASE * ---------------------- * ERASE (CURRENT LINE, CURSOR TO EOL /OR/ TO GIVEN WIDTH) OPERASE MOVE.W D0,D1 * WIDTH TO ERASE BSR PUTLIN * EMPTY BUFFER, IF NEEDED CMPI.W #1,D1 * ARG BLT.S ERAX2 * <1 MEANS ERROR, EXIT BGT.S ERAX1 * >1 MEANS IT'S A PIXEL COUNT MOVEQ #-1,D1 * =1 MEANS ERASE TO EOL ERAX1 MOVEQ #-1,D0 * (ALWAYS START AT CURSOR) BSR MDERASE ERAX2 RTS * ---------------------- * OPHLIGHT [WAS OPATTR] * ---------------------- * HIGHLIGHT (SET DISPLAY MODE FOR SUBSEQUENT OUTPUT) * D0.W = 0 PLAIN, 1 INVERSE, 2 BOLD, 4 ITALIC (8 MONO) OPHLIGHT MOVE.L CURWP(A6),A0 * [ALWAYS IN CURRENT WINDOW] MOVE.W D0,WHLIGHT(A0) * STORE NEW MODE MOVE.W D0,D1 BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD MODE) MOVE.W D1,D0 BRA SETHL *** BRA MDATTR * ---------------------- * OPFONT * ---------------------- OPFONT NOP * REQUEST AN ARGBLK MOVE.L A0,A1 CMPI.W #1,(A1) * WINDOW ID SUPPLIED? BGT.S FONTX2 MOVE.L CURWP(A6),A0 * NO, USE DEFAULT BRA.S FONTX4 FONTX2 MOVE.W ARG2(A1),D0 * YES, GET PTR BSR CALCWP FONTX4 MOVE.W ARG1(A1),D1 * NEW FONT ID MOVE.W WFONTID(A0),D2 * OLD FONT ID CMP.W D2,D1 * >>> IS THE FONT REALLY CHANGING? <<< BEQ.S FONTX9 * NO, EXIT (WITHOUT EMPTYING BUFFER!) MOVE.W D1,WFONTID(A0) * STORE NEW FONT ID CMP.L CURWP(A6),A0 * WORKING WITH THE CURRENT WINDOW? BNE.S FONTX9 * NO, DONE BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD FONT) MOVE.W D1,D0 BSR SETFONT * UPDATE SCREEN FONT FONTX9 MOVE.W D2,D0 BRA PUTVAL * RETURN OLD FONT ID * ---------------------- * OPCOLOR * ---------------------- OPCOLOR NOP * REQUEST AN ARGBLK MOVE.L A0,A1 CMPI.W #2,(A1) * WINDOW ID SUPPLIED? BGT.S COLRX2 MOVE.L CURWP(A6),A0 * NO, USE DEFAULT BRA.S COLRX4 COLRX2 MOVE.W ARG3(A1),D0 * YES, GET PTR BSR CALCWP * if fore/back id = 0 (no change), don't touch slot in window record ... COLRX4 MOVE.B ARG2+1(A1),D0 * BACK BEQ.S COLRX6 MOVE.B D0,WCOLOR(A0) * STORE NEW BACK (HI BYTE) COLRX6 MOVE.B ARG1+1(A1),D0 * FORE BEQ.S COLRX8 MOVE.B D0,WCOLOR+1(A0) * STORE NEW FORE COLRX8 CMP.L CURWP(A6),A0 * WORKING WITH THE CURRENT WINDOW? BNE.S COLRX9 * NO, DONE BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD COLOR) MOVE.W ARG1(A1),D0 * FORE MOVE.W ARG2(A1),D1 * BACK BSR MDCOLOR * UPDATE SCREEN COLORS COLRX9 RTS * ---------------------- * OPMARG * ---------------------- * SET MARGINS OPMARG NOP * REQUEST AN ARGBLK MOVE.L A0,A1 CMPI.W #2,(A1) * WINDOW ID SUPPLIED? BGT.S MARGX2 MOVE.L CURWP(A6),A0 * NO, USE DEFAULT BRA.S MARGX4 MARGX2 MOVE.W ARG3(A1),D0 * YES, GET PTR BSR CALCWP MARGX4 MOVE.L A0,A2 MOVE.W ARG1(A1),D2 MOVE.W D2,WLMARG(A2) MOVE.W ARG2(A1),D3 MOVE.W D3,WRMARG(A2) MOVEQ #1,D1 ADD.W D2,D1 MOVE.W D1,WXCURS(A2) * MOVE CURSOR TO LEFT MARGIN CMP.L CURWP(A6),A2 * WORKING WITH THE CURRENT WINDOW? BNE.S MARGX9 * NO *** NOTE: CR-INTERRUPT ROUTINES COMMONLY CALL OPMARG (TO FLOW AROUND PICTURES), *** IN WHICH CASE WE SHOULD /NOT/ EMPTY THE BUFFER, BUT ALLOW IT TO WRAP. *** [MOREOVER, PUTLIN/QUECHR IS /NOT/ RE-ENTRANT -- GARBAGE IS DISPLAYED] *** IN OTHER CASES, THE GAME SHOULD ITSELF ENSURE THAT THE BUFFER IS EMPTY. *** BSR PUTLIN * EMPTY THE LINE BUFFER MOVE.W D2,D0 MOVE.W D3,D1 BSR SETMARG * UPDATE DISPLAY VARS MOVEQ #-1,D0 * [DON'T CHANGE ROW] MOVEQ #1,D1 ADD.W D2,D1 BSR SETCURS * MOVE CURSOR TO LEFT MARGIN MARGX9 RTS * --------------------------------------------------------------------------- * MORE I/O OPERATIONS * --------------------------------------------------------------------------- * ---------------------- * OPBUFO * ---------------------- * SET BUFFERING OF OUTPUT ACCORDING TO INT OPBUFO *** RTS * [SEMI-OBSOLETE OP; SLOWS DRAWING ON MAC] SUBQ.W #1,D0 * NORMAL BUFFERING? BEQ.S BUFOX1 * YES ADDQ.W #1,D0 * NO BUFFERING, OUTPUT DIRECTLY TO SCREEN? BEQ.S BUFOX2 * YES BRA.S BUFOX3 * ELSE DO NOTHING BUFOX1 MOVE.W #1,VOBUFF(A6) * TURN ON BUFFERING BRA.S BUFOX3 BUFOX2 * DATA * MSGBFO DC.B 'BUFOUT off',0 * CODE * LEA MSGBFO,A0 * BSR ZWARN * SHOW A WARNING BSR PUTLIN * FIRST EMPTY THE CURRENT OUTPUT BUFFER CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING BUFOX3 RTS * ---------------------- * TABCHR * ---------------------- * TABLE OUTPUT FUNCTION --- PUT THE CHAR IN D0 IN THE DEFINED TABLE TABCHR MOVE.L TABPTR(A6),A0 * CURRENT POSITION IN TABLE MOVE.B D0,(A0)+ * STORE CHAR MOVE.L A0,TABPTR(A6) * UPDATE POINTER BSR DCHSIZ * GET PIXEL WIDTH MOVE.L BUFFER(A6),A0 ADD.W D0,PTWID(A0) * UPDATE COUNTER RTS * ---------------------- * OPDIRO * ---------------------- * REDIRECT OUTPUT (TABLE OR NORMAL) ACCORDING TO INT OPDIRO NOP * TELL CALLER TO USE ARGBLK MOVE.W ARG1(A0),D0 * VIRTUAL OUTPUT DEVICE -- NEGATIVE? BLT.S DIRX0 * YES, MEANS TURN IT OFF SUBQ.W #1,D0 * TURN ON SCREEN? BEQ.S DIRX1 * YES SUBQ.W #1,D0 * TURN ON PRINTER? BEQ.S DIRX3 * YES SUBQ.W #1,D0 * TURN ON TABLE? BEQ.S DIRX5 * YES RTS * UNKNOWN DEVICE, IGNORE REQUEST DIRX0 ADDQ.W #1,D0 * TURN OFF SCREEN? BEQ.S DIRX2 * YES ADDQ.W #1,D0 * TURN OFF PRINTER? BEQ.S DIRX4 * YES ADDQ.W #1,D0 * TURN OFF TABLE? BEQ.S DIRX6 * YES RTS * UNKNOWN DEVICE, IGNORE REQUEST *** TURN SCREEN OUTPUT ON, OFF DIRX1 MOVE.W #1,VOCONS(A6) BRA DIRX7 DIRX2 BSR PUTLIN * BUT FIRST DUMP BUFFER, IF NEEDED CLR.W VOCONS(A6) BRA DIRX7 *** TURN SCRIPTING OUTPUT ON, OFF DIRX3 TST.W VOPRNT(A6) * ALREADY ON? BNE.S DIRX7 * YES MOVE.W #1,D0 MOVE.W D0,VOPRNT(A6) BSR SCRINIT * OPEN SCRIPT CHANNEL (IF NEEDED) MOVE.L BUFFER(A6),A0 BSET #FSCRI,PFLAGS+1(A0) * SET PRELOAD FLAG, FOR GAME'S USE BRA.S DIRX7 DIRX4 TST.W VOPRNT(A6) * ALREADY OFF? BEQ.S DIRX7 * YES MOVEQ #0,D0 MOVE.W D0,VOPRNT(A6) BSR SCRINIT * CLOSE SCRIPT CHANNEL (IF NEEDED) MOVE.L BUFFER(A6),A0 BCLR #FSCRI,PFLAGS+1(A0) * CLEAR THE PRELOAD FLAG BRA.S DIRX7 *** TURN TABLE ON, OFF DIRX5 MOVE.L BUFFER(A6),A1 MOVEQ #0,D0 MOVE.W ARG2(A0),D0 * GET RELATIVE TABLE POINTER ADD.L A1,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 CLR.W PTWID(A1) * RESET PIXEL COUNT MOVE.W #1,VOTABL(A6) * SET TABLE-OUTPUT FLAG BRA.S DIRX7 DIRX6 TST.W VOTABL(A6) * MAKE SURE A TABLE DOES EXIST BEQ.S DIRX7 * NO TABLE, IGNORE REQUEST CLR.W VOTABL(A6) * OK, TURN OFF TABLE-OUTPUT FLAG MOVE.L TABOUT(A6),A0 * COMPUTE LENGTH OF CURRENT TABLE CONTENTS MOVE.L TABPTR(A6),D0 SUB.L A0,D0 SUBQ.W #2,D0 * ADJUST FOR LENGTH SLOT BSR PTAWRD * AND STORE LENGTH IN LENGTH SLOT DIRX7 RTS * REDIRECT INPUT (NORMAL OR COMMAND FILE) ACCORDING TO INT * ---------------------- * OPDIRI * ---------------------- OPDIRI NOP * TELL CALLER TO USE ARGBLK *** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE -- NOT IMPLEMENTED RTS * ---------------------- * OPSOUND * ---------------------- * MAKE A SOUND * ARG1 = ID: 1=BEEP, 2=BOOP, 3+ ARE SPECIAL, 0=MRU * [ARG2] = ACTION: 1=INIT, [2=START], 3=STOP, 4=CLEANUP * [ARG3] = COUNT (HIBYTE): -1=INFINITE, [0=USE MIDI COUNT], 1-254=FINITE * VOL (LOBYTE): 0=MIN, 8=MAX, [-1=USE MIDI VOLUME] * [ARG4] = INTERRUPT FUNCTION OPSOUND NOP * REQUEST AN ARGBLK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX MOVE.W #2,ARG2(A1) * DEFAULT ACTION = "START" MOVE.W #$00FF,ARG3(A1) * DEFAULT COUNT=0/VOL=-1 (USE MIDI DATA) CLR.W ARG4(A1) * DEFAULT INTERRUPT HANDLER = NONE BSR SETDEF * SET UP DEFAULTS MOVE.W ARG4(A0),SFUNC(A6) * SAVE INTERRUPT HERE MOVE.W ARG3(A0),D2 * COUNT/VOL MOVE.W D2,D3 EXT.W D2 * VOL (16 BITS) LSR.W #8,D3 * COUNT (16 BITS, UNLESS -1) CMPI.B #$FF,D3 * -1? BNE.S OPSDX1 EXT.W D3 * YES, MAKE 16 BITS OPSDX1 MOVE.W ARG2(A0),D1 * ACTION MOVE.W ARG1(A0),D0 * SOUND ID BRA DOSOUND * ---------------------- * OPPICI * ---------------------- * GET PICTURE INFO (SIZE) OPPICI SUBQ.L #4,SP * TEMP TABLE, 2 WORDS, >> EVEN-ALIGNED << MOVE.L SP,A0 BSR PICINF * GET SIZE INFO, STORE IN TABLE EXG D1,D0 * GIVEN TABLE (MAY BE ODD) BSR RELABS MOVE.W (SP)+,D0 BSR PTAWRD * COPY INFO TO GIVEN TABLE MOVE.W (SP)+,D0 BSR PTAWRD TST.W D1 * PICINF RESULT BLT.S OPICX1 * NEG RESULT MEANS ERROR BRA PTRUE OPICX1 BRA PFALSE * ---------------------- * OPDISP, OPDCLR * ---------------------- * DISPLAY [OR CLEAR] A PICTURE OPDISP DC.W 3 * DEFAULT ARGBLK DC.W SKIP,-99,-99 * NEG POSITION MEANS READ PALETTE STUFF ONLY MOVEQ #0,D3 * "CLEAR" FLAG OFF BRA.S DISPX1 OPDCLR DC.W 3 * DEFAULT ARGBLK DC.W SKIP,-99,-99 MOVEQ #1,D3 * "CLEAR" FLAG ON DISPX1 MOVE.W ARG1(A0),D0 MOVE.W ARG2(A0),D1 MOVE.W ARG3(A0),D2 BRA PICDISP * ---------------------- * OPMENU * ---------------------- OPMENU BRA PFALSE * [NOT IMPLEMENTED] * ---------------------- * OPPICSET * ---------------------- PSMAX EQU 256 * CONVENIENT MAX ITEM COUNT * PRELOAD A PICTURE SET, D0.W = TABLE LOC * THINGS TO PONDER: * - THE TABLE IS NOT GUARANTEED TO BE WORD ALIGNED (DESIRABLE ON 68K MICROS), * OR EVEN TO BE IN PRELOAD. THEREFORE, WE CREATE TEMP SPACE ON THE STACK * AND COPY THE TABLE, ONE WORD AT A TIME. * - THE TABLE LENGTH ISN'T KNOWN AHEAD OF TIME (AN LTABLE WOULD BE CONVENIENT * HERE). RATHER THAT SCANNING THE TABLE TWICE, WE JUST DEFINE A COMFORTABLE * MAXIMUM (ANY ITEMS BEYOND THE MAX WILL JUST BE IGNORED). OPPICSET TST.W D0 BEQ.S PCSTX9 * "0 = UNLOAD OLD PICSET" -- A NOOP FOR US BSR BSPLTB * SPLIT THE BYTE POINTER SUBA.W #PSMAX*2,SP * CREATE TEMP SPACE (BYTES) MOVE.L SP,A2 * BASE MOVEQ #0,D3 PCSTX2 BSR GETWRD * UPDATE D0/D1, RESULT IN D2 MOVE.W D2,(A2)+ * COPY ONE ITEM BEQ.S PCSTX4 * ZERO MEANS END OF TABLE ADDQ.W #1,D3 * RUNNING COUNT OF ITEMS CMPI.W #PSMAX,D3 * ROOM FOR MORE? BLT.S PCSTX2 * YES *** BSR ZWARN PCSTX4 MOVE.L SP,A0 MOVE.W D3,D0 BSR PICSET * A0 -> TABLE, D0.W = COUNT ADDA.W #PSMAX*2,SP * FLUSH STACK PCSTX9 RTS EJECT ; PAGE * ---------------------------------------------------------------------------- * CONTROL OPERATIONS * ---------------------------------------------------------------------------- MAXLOCS EQU 15 * MAXIMUM LOCALS; VARS 16-255 ARE GLOBAL CVFLAG EQU $0100 * FLAG SET (HIGH BYTE) IF CALL RETURNS A VALUE * ---------------------- * OPICALL, ETC * ---------------------- * CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), NO RETURNED VALUE OPICAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP MOVE.W #1,(A0) * ONE ARG (THE FUNCTION) MOVE.W D0,ARG1(A0) OPICAL2 OPIXCAL OPICALL NOP * TELL CALLER TO USE ARGBLK MOVEQ #0,D3 * FLAG -- DON'T RETURN A VALUE BRA.S CALLX1 * ---------------------- * OPCALL, ETC * ---------------------- * CALL (A FUNCTION WITH OPTIONAL ARGUMENTS) OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP MOVE.W #1,(A0) * ONE ARG (THE FUNCTION) MOVE.W D0,ARG1(A0) OPCAL2 OPXCAL OPCALL NOP * TELL CALLER TO USE ARGBLK MOVE.W #CVFLAG,D3 * FLAG (HIGH BYTE) -- RETURN A VALUE *** COMMON ENTRY POINT, A0 -> ARGBLK, D3 (HIGH BYTE) = RETURN-VALUE FLAG CALLX1 MOVE.L A0,A2 MOVE.W (A2)+,D2 * ARG COUNT MOVE.W (A2)+,D0 * FUNCTION TO CALL -- IS IT ZERO? BNE.S CALLX2 * NO TST.W D3 * SPECIAL CASE -- RETURN A VALUE? BEQ.S CALLX9 * NO, JUST EXIT * CLR.W D0 * YES, RETURN A ZERO BRA PUTVAL *** BUILD A STACK FRAME, THEN UPDATE THE ZPC AND STATE VARS ... CALLX2 MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC MOVE.W ZPC2(A6),-(A4) MOVE.B NARGS+1(A6),D3 * SAVE OLD "OPTIONALS" COUNT ... MOVE.W D3,-(A4) * ALONG WITH /NEW/ RETURN FLAG * >>> old locs pointer (rel) now stacked as word, instead of long <<< * >>> new locs pointer now points to (pseudo) loc 0, instead of 1 <<< MOVE.L ZLOCS(A6),D1 * OLD LOCALS/FRAME POINTER SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT, IN CASE OF GAME SAVE MOVE.W D1,-(A4) * SAVE IT MOVE.L A4,ZLOCS(A6) * NEW LOCALS/FRAME POINTER SUBQ.W #1,D2 * NUMBER OF PARAMETERS ("OPTIONALS") MOVE.B D2,NARGS+1(A6) * REMEMBER IT (BYTE) MOVEQ #0,D1 * ZERO HIGH WORD MOVE.W D0,D1 * QUAD PTR MOVE.L QFOFF(A6),D0 * QUAD FUNCTION OFFSET BSR BSPLTQ2 * SPLIT THE BLOCK AND OFFSET MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC MOVE.W D1,ZPC2(A6) BSR NEWZPC * UPDATE ZPC STUFF *** GET FUNCTION HEADER BSR NXTBYT * TOTAL # DEFINED LOCALS MOVE.W D0,D1 CMPI.W #MAXLOCS,D1 * VALID? BLS.S CALLX3 LEA MSGCA1,A0 * TOO MANY LOCALS DEFINED BSR ZWARN * SHOW A WARNING MOVEQ #MAXLOCS,D1 * (CUT BACK -- CAN'T BE TOUCHED ANYWAY) CALLX3 CMP.W D2,D1 * VALID? BCC.S CALLX4 * BHS LEA MSGCA2,A0 * TOO MANY OPTIONALS SUPPLIED BSR ZWARN * SHOW A WARNING MOVE.W D1,D2 * (CUT BACK -- WON'T BE TOUCHED ANYWAY) CALLX4 SUB.W D2,D1 * THIS IS NUMBER OF "DEFAULT" VALUES BRA.S CALLX6 DATA MSGCA1 DC.B 'Bad loc num',0 MSGCA2 DC.B 'Bad optional num',0 CODE *** BUILD & INITIALIZE A LOCALS FRAME ... CALLX5 MOVE.W (A2)+,-(A4) * POSITION THE OPTIONAL VALUES FIRST CALLX6 DBF D2,CALLX5 * ZERO CHECK -- ANY MORE? MOVEQ #0,D0 BRA.S CALLX8 CALLX7 MOVE.W D0,-(A4) * CLEAR THE REMAINING DEFAULT VALUES [XZIP] CALLX8 DBF D1,CALLX7 * ZERO CHECK -- ANY MORE? CALLX9 RTS * DONE * ---------------------- * OPASSN * ---------------------- * ASSIGNED? (A LOCAL AN OPTIONAL VALUE) OPASSN CMP.B NARGS+1(A6),D0 * WAS THIS LOCAL ASSIGNED A VALUE? BGT PFALSE * NO, VALUE DEFAULTED TO ZERO BRA PTRUE * YES * ---------------------- * OPRETU * ---------------------- * RETURN (FROM CURRENT FUNCTION CALL) OPRETU MOVE.L ZLOCS(A6),A4 * OLD TOP-OF-STACK MOVEQ #0,D1 MOVE.W (A4)+,D1 * RESTORE OLD LOCALS POINTER ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT MOVE.L D1,ZLOCS(A6) MOVE.W (A4)+,D2 * RESTORE RETURN FLAG, OPTS COUNT MOVE.B D2,NARGS+1(A6) MOVE.W (A4)+,ZPC2(A6) * RESTORE OLD ZPC MOVE.W (A4)+,ZPC1(A6) IF EZIP THEN BLT INRETU * SPECIAL INTERNAL CALL/RETURN, HANDLE IT ENDIF MOVE.W D0,D1 * PROTECT VALUE (IF ANY -- XZIP) BSR NEWZPC * UPDATE ZPC STUFF MOVE.W D1,D0 ANDI.W #CVFLAG,D2 * WAS THIS A RETURN-VALUE CALL? (XZIP) BNE PUTVAL * YES, RETURN THE VALUE RTS * NO, JUST EXIT * ---------------------- * OPRTRU * ---------------------- * RTRUE OPRTRU MOVEQ #1,D0 * RETURN A "1" BRA.S OPRETU * ---------------------- * OPRFAL * ---------------------- * RFALSE OPRFAL CLR.W D0 * RETURN A "0" BRA.S OPRETU * ---------------------- * OPRSTA * ---------------------- * RSTACK (RETURN STACK) OPRSTA MOVE.W (A4)+,D0 * POP A VALUE BRA OPRETU * AND RETURN IT * ---------------------- * OPFSTA * ---------------------- * FSTACK (FLUSH 'N' ELEMENTS OFF A STACK) *** REVIVED FOR YZIP OPFSTA NOP * REQUEST AN ARGBLK MOVE.W ARG1(A0),D1 * #ITEMS TO FLUSH CMPI.W #1,(A0) * STACK SUPPLIED? BGT.S FSTAX2 * YES ADD.W D1,D1 ADDA.W D1,A4 * NO, ADJUST GAME STACK BRA.S FSTAX4 FSTAX2 MOVE.W ARG2(A0),D0 BSR RELABS * GET A0 -> LTABLE BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0 SUBQ.W #2,A0 ADD.W D1,D0 BSR PTAWRD * UPDATE LENGTH SLOT FSTAX4 RTS * ---------------------- * OPJUMP * ---------------------- * JUMP (TO A NEW LOCATION) OPJUMP SUBQ.W #2,D0 * ADJUST OFFSET ADD.W D0,ZPC2(A6) * ADD OFFSET TO CURRENT ZPC BRA NEWZPC * NORMALIZE IT & UPDATE ZPC STUFF * ---------------------- * OPNOOP * ---------------------- * NOOP (NO OPERATION) OPNOOP RTS * DO NOTHING * ---------------------- * OPCATCH * ---------------------- * CATCH OPCATCH MOVE.L ZLOCS(A6),D0 * THE CURRENT "FRAME POINTER" SUB.L STKBOT(A6),D0 * RELATIVIZE IT BRA PUTVAL * ---------------------- * OPTHROW * ---------------------- * THROW (NON-LOCAL RETURN) OPTHROW EXT.L D1 * A PREVIOUS FRAME PTR ADD.L STKBOT(A6),D1 * ABSOLUTIZE CMP.L ZLOCS(A6),D1 * VALID FRAME? BLT.S THRX1 * ERROR MOVE.L D1,ZLOCS(A6) * OK, FLUSH ANY INTERMEDIATE FRAMES BRA OPRETU * AND RETURN VAL (STILL IN D0) THRX1 CLR.W D0 LEA MSGTHR,A0 BRA FATAL DATA MSGTHR DC.B 'Bad Throw',0 CODE * ---------------------- * INCALL * ---------------------- IF EZIP THEN * INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0 INCALL MOVEM.L D1-D7/A1-A3,-(SP) * SAVE EVERYTHING MOVE.W ZPC1(A6),-(SP) MOVE.W #-1,ZPC1(A6) * FAKE ZPC1, SIGNALS AN INTERNAL CALL/RETURN LEA ARGBLK(A6),A0 * SET UP ARGBLK FOR OPCALL MOVE.W D0,ARG1(A0) * FUNCTION TO CALL MOVE.W #1,(A0) * ONE ARG (FUNCTION ITSELF) BSR OPCALL * CALL THE TIMEOUT FUNCTION BRA NXTINS * GO EXECUTE IT * ---------------------- * INRETU * ---------------------- * JUMP BACK TO HERE UPON NEXT OPRETURN ... INRETU ADDQ.L #4,SP * CAREFUL -- FLUSH TOP RETURN ADDR (NXTINS) MOVE.W (SP)+,ZPC1(A6) * FIX THE ZPC MOVE.W D0,D1 BSR NEWZPC * RESTORE THE PROPER PAGE MOVE.W D1,D0 MOVEM.L (SP)+,D1-D7/A1-A3 RTS * RETURN TO ORIGINAL CALLER ENDIF EJECT ; PAGE * ---------------------------------------------------------------------------- * GAME COMMANDS * ---------------------------------------------------------------------------- * ------------------------------ * PRIMITIVES FOR SAVE/RESTORE * ------------------------------ * SAVE STATE VARIABLES ON GAME STACK SAVSTA MOVE.W ZPC1(A6),-(A4) MOVE.W ZPC2(A6),-(A4) MOVE.L STKBOT(A6),A0 MOVE.L ZLOCS(A6),D0 * RELATIVIZE THIS ONE SUB.L A0,D0 MOVE.W D0,-(A4) MOVE.W ZORKID(A6),-(A4) MOVE.L A4,D0 SUB.L A0,D0 * RELATIVIZE GAME SP, TOO MOVE.W D0,(A0) * AND SAVE IT IN KNOWN LOCATION ADDA.W #8,A4 * RESET THE GAME SP RTS * RESTORE STATE VARIABLES FROM GAME STACK, RETURN ZORKID IN D0 AND FLAGS RESSTA MOVE.L STKBOT(A6),A0 MOVEQ #0,D0 MOVE.W (A0),D0 * RESTORE GAME SP FROM KNOWN LOCATION ADD.L A0,D0 * RE-ABSOLUTIZE IT MOVE.L D0,A4 MOVE.W (A4)+,-(SP) * GET THE SAVED ZORKID MOVEQ #0,D0 MOVE.W (A4)+,D0 * RESTORE OLD LOCALS POINTER ADD.L A0,D0 * RE-ABSOLUTIZE IT MOVE.L D0,ZLOCS(A6) MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF MOVE.W (A4)+,ZPC1(A6) MOVE.W (SP)+,D0 CMP.W ZORKID(A6),D0 * IS ID THE SAME AS OURS? RTS * (RETURN WITH FLAGS) * ---------------------- * OPISAV * ---------------------- * ISAVE (SAVE TO MEMORY BUFFER) OPISAV BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER BEQ SAVERR * ERROR, BUFFER DOESN'T EXIST MOVE.L STKBOT(A6),A0 MOVE.L D2,A1 MOVE.L #STKLEN,D0 BSR MOVMEM * SAVE THE STACK (FAST BLOCKMOVE) MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE MOVE.L D2,A1 ADDA.W #STKLEN,A1 * START WRITING AFTER STACK MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS BSR BLKBYT BSR MOVMEM * SAVE IMPURE DATA (FAST BLOCKMOVE) BRA SAVEOK * SUCCESS * ---------------------- * OPSAVE * ---------------------- PSNLEN EQU 32 * MAX LENGTH OF SUGGESTED NAME * SAVE (STATE OF GAME, OR SELECTED "PARTIAL" DATA) OPSAVE NOP TST.W (A0) * PARTIAL SAVE (ANY ARGS)? BEQ SVX2 * NO *** HANDLE A PARTIAL SAVE, A0 -> ARGBLK *** MOVE.L A0,A2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH BSR RELABS MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL MOVEQ #1,D0 * OPSAVE MOVEQ #1,D1 * PARTIAL BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE SVX14 * CANCELLED BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE) * WRITE SUGGESTED NAME TO FILE MOVEQ #0,D0 MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME MOVE.L A1,A0 * STARTS HERE (WITH LENGTH BYTE) BSR SFWRIT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE * WRITE DATA TO FILE MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE BSR RELABS * ABSOLUTIZE MOVEQ #PSNLEN,D0 * FILE OFFSET MOVEQ #0,D1 MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA BSR SFWRIT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE BSR DEFOLD * OK >>> BUT RESTORE "NORMAL" FILE NAMES <<< BRA SVX10 * AND CLEAN UP *** ENTER HERE FOR "STANDARD" SAVE *** SVX2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE MOVEQ #1,D0 * OPSAVE CLR.W D1 * STANDARD BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE SVX14 * CANCELLED BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE) * SAVE GAME STACK, THEN IMPURE PRELOAD BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK MOVE.L STKBOT(A6),A0 CLR.W D0 * THIS WILL BE BLOCK ZERO MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK BSR PTSBKS * WRITE IT OUT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE MOVEQ #STKLEN/512,D0 * START WRITING AFTER STACK MOVE.W PURBOT(A6),D1 * NUMBER OF IMPURE BLOCKS BSR PTSBKS BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE * SAVE SUCCEEDED SVX10 BSR CLSSFL * SUCCESS, CLOSE THE FILE [NO ERRORS] BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE SAVEOK MOVEQ #1,D0 * RETURN "SAVE OK" BRA PUTVAL * SAVE FAILED FOR SOME REASON ... SVX12 BSR CLSSFL * CLOSE THE BAD FILE BSR DELSFL * AND DELETE THE BAD FILE FROM THE DIRECTORY SVX14 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE SAVERR CLR.W D0 * RETURN "SAVE FAILED" BRA PUTVAL * ---------------------- * OPIRES * ---------------------- * IRESTORE (RESTORE FROM MEMORY BUFFER) OPIRES MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER BEQ RESERR * ERROR, BUFFER DOESN'T EXIST MOVE.L D2,A0 TST.W (A0) BEQ RESERR * ERROR, NO PREVIOUS ISAVE! MOVE.L STKBOT(A6),A1 MOVE.L #STKLEN,D0 BSR MOVMEM * RESTORE THE GAME STACK (FAST BLOCKMOVE) BSR RESSTA * UNSTACK THE OLD STATE INFO BNE RESX15 * ERROR, WRONG ZORKID MOVE.L D2,A0 ADDA.W #STKLEN,A0 * START READING AFTER STACK MOVE.L BUFFER(A6),A1 * BEGINNING OF IMPURE STUFF IN CORE MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS BSR BLKBYT BSR MOVMEM * RESTORE IMPURE DATA (FAST BLOCKMOVE) BRA RESTOK * SUCCESS * ---------------------- * OPREST * ---------------------- * RESTORE (STATE OF GAME, OR SELECTED "PARTIAL" DATA) OPREST NOP TST.W (A0) * PARTIAL RESTORE (ANY ARGS)? BEQ RESX2 * NO *** HANDLE A PARTIAL RESTORE, A0 -> ARGBLK *** MOVE.L A0,A2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH BSR RELABS MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL MOVEQ #0,D0 * RESTORE MOVEQ #1,D1 * PARTIAL BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE RESX13 * CANCELLED BSR OPNSFL * OPEN THE FILE BNE RESX13 * ERROR * READ (PREVIOUS) SUGGESTED NAME FROM FILE, & CHECK FOR A MATCH MOVEQ #0,D0 MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME MOVE.L STKBOT(A6),A0 * (GRAB TEMP BUFFER AT BASE OF ZSTACK) BSR SFREAD BNE RESX12 * ERROR, CLOSE THE FILE (NOT FATAL) MOVE.L A1,A0 * CURRENT NAME STARTS HERE (WITH LENGTH BYTE) MOVE.L STKBOT(A6),A1 MOVEQ #1,D0 * COUNT LENGTH BYTE ADD.B (A0),D0 BSR COMPS * COMPARE THE STRINGS BNE RESX12 * DIFFERENT, ERROR, CLOSE THE FILE * READ DATA FROM FILE MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE BSR RELABS * ABSOLUTIZE MOVEQ #PSNLEN,D0 * FILE OFFSET MOVEQ #0,D1 MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA BSR SFREAD * [RETURNS ACTUAL BYTES READ IN D1] BNE RESX12 * ERROR, CLOSE THE FILE BSR DEFOLD * >>> RESTORE "NON-PARTIAL" FILE NAMES <<< BSR CLSSFL * CLOSE THE FILE MOVEQ #1,D0 BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE *** [SYSTEM STACK HACKING AND CALL TO NEWZPC NOT NEEDED AFTER PARTIAL OP] MOVE.W D1,D0 * RETURN "ACTUAL BYTES READ" BRA PUTVAL *** ENTER HERE FOR "STANDARD" RESTORE *** RESX2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE CLR.W D0 * RESTORE CLR.W D1 * STANDARD BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE RESX13 * CANCELLED *** ENTER HERE IF DOING SPECIAL RESTORE DURING LAUNCH *** RES1 BSR OPNSFL * OPEN THE FILE BNE RESX13 * ERROR CLR.W D0 * FIRST READ IN STACK MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK MOVE.L STKBOT(A6),A0 * PUT IT HERE BSR GTSBKS BNE RESX16 * DIE IF DISK ERROR BSR RESSTA * UNSTACK THE OLD STATE INFO BNE RESX14 * ERROR, WRONG ZORKID MOVE.L BUFFER(A6),A0 MOVE.W PFLAGS(A0),-(SP) * PRESERVE THE FLAGS (SCRIPT ETC) MOVEQ #STKLEN/512,D0 * READ IMPURE STUFF STARTING AFTER STACK MOVE.W PURBOT(A6),D1 * LENGTH OF IMPURE STUFF BSR GTSBKS BNE RESX16 * DIE IF DISK ERROR MOVE.L BUFFER(A6),A0 MOVE.W (SP)+,PFLAGS(A0) * RESTORE THE OLD FLAGS * RESTORE SUCCEEDED RESX10 BSR CLSSFL * CLOSE THE FILE BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * (1) MAKE SURE GAME DISK IS BACK IN DRIVE BSR INITDISP * UPDATE TTY-SPECIFIC LOWCORE (IF NEEDED) * A subtle bug was found in ZIP20 when certain calls that reset the game * state (the ZPC and stack) occurred during a timer interrupt. Since control * never returned to the code that caused the interrupt, the system (machine) * stack never got cleaned up. After several such calls it overflowed. * The questionable calls include (a successful) Restore or Irestore (Undo), * and Restart. The first two are handled here, the last elsewhere. RESTOK MOVE.L TOPSP(A6),SP * MAKE SURE THE SYSTEM STACK IS CLEAN PEA NXTINS * AND HACK IT SO WE WILL RETURN TO MAIN LOOP BSR NEWZPC * (2) GET THE PROPER ZPC PAGE MOVEQ #2,D0 * RETURN "RESTORE OK" BRA PUTVAL * SOMETHING WRONG, FAIL ... RESX12 BSR CLSSFL * CLOSE THE FILE RESX13 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE RESERR CLR.W D0 * RETURN "RESTORE FAILED" BRA PUTVAL * FATAL ERROR: BAD ZORKID RESX14 MOVE.W D0,-(SP) BSR CLSSFL * CLOSE THE BAD FILE MOVE.W (SP)+,D0 * BAD VERSION ID RESX15 LEA MSGRE2,A0 BRA FATAL * 'Wrong save file version' DATA MSGRE2 DC.B 'Wrong save file version',0 CODE * FATAL ERROR: RESTORE READ ERROR RESX16 MOVE.W D0,-(SP) BSR CLSSFL * CLOSE THE BAD FILE AND DIE MOVE.W (SP)+,D0 * ERROR CODE LEA MSGRE1,A0 BRA FATAL * 'Save file read error' DATA MSGRE1 DC.B 'Save file read error',0 CODE * ---------------------- * OPRSTT * ---------------------- * RESTART (THE GAME) OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT MOVE.L CURWP(A6),A0 CLR.W WLCNT(A0) * RESET COUNTER TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN? BNE.S RSTTX1 * YES MOVEQ #1,D0 BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED) RSTTX1 MOVEQ #-1,D0 BSR OPCLEAR * CLEAR (AND UNSPLIT) SCREEN BRA RESTRT * SKIP MOST INITIALIZATIONS * ---------------------- * OPQUIT * ---------------------- * QUIT OPQUIT BRA FINISH * DIE PEACEFULLY * ---------------------- * OPVERI * ---------------------- * VERIFY (GAME FILE) OPVERI IF CZIP THEN * VERSION INFO FOR ZIP ONLY LEA MSGVER,A0 BSR OUTMSG0 * 'Macintosh interpreter version ' DATA MSGVER DC.B 'Macintosh interpreter version ',0 CODE MOVE.W INTWRD,D0 * DISPLAY THE LETTER (LOW BYTE) BSR OPPRNC BSR OPCRLF TST.W SUBVER * DISPLAY SUB-VERSION ONLY IF NON-ZERO BEQ.S VERX0 LEA MSGVR2,A0 BSR OUTMSG0 * 'Sub-version ' DATA MSGVR2 DC.B 'Sub-version ',0 CODE MOVE.W SUBVER,D0 * DISPLAY THE SUB-VERSION NUMBER BSR OPPRNN BSR OPCRLF ENDIF VERX0 TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN? BNE.S VERX0A * YES MOVEQ #1,D0 BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED) VERX0A MOVE.L BUFFER(A6),A0 MOVEQ #0,D0 MOVE.W PLENTH(A0),D0 * LENGTH OF GAME FILE (QUADS OR OCTS) MOVE.W PFOFF(A0),D1 * IS THIS IS A MOBY GAME? ADD.W PSOFF(A0),D1 BEQ.S VERX0B * IF BOTH ZERO, NO ADD.L D0,D0 * YES, LENGTH WAS OCTS, MAKE QUADS VERX0B MOVEQ #0,D1 * [NULL 2ND ARG] BSR BSPLTQ2 * SPLIT INTO BLOCK AND OFFSET MOVE.W D0,D4 * THIS IS FINAL BLOCK MOVE.W D1,D5 * FINAL BYTE CLR.W D0 * STARTING BLOCK NUMBER MOVEQ #64,D1 * STARTING BYTE NUMBER CLR.W D3 * CHECKSUM HERE MOVE.W ENDLOD(A6),-(SP) CLR.W ENDLOD(A6) * FORCE LOADING FROM DISK VERX1 BSR GETBYT * GET NEXT BYTE ADD.W D2,D3 * ADD IN TO CHECKSUM CMP.W D0,D4 * DONE YET? BNE VERX1 * NO CMP.W D1,D5 * MAYBE BNE VERX1 * NO MOVE.W (SP)+,ENDLOD(A6) * YES, RESTORE PROPER ENDLOD MOVE.L BUFFER(A6),A0 MOVE.W PCHKSM(A0),D0 * GET THE REAL CHECKSUM CMP.W D0,D3 BNE.S VERX2 * ERROR BRA PTRUE * SUCCESS VERX2 BRA PFALSE * FAILURE * ---------------------- * OPORIG * ---------------------- * ORIGINAL (NOT A COPY) GAME DISK? OPORIG BRA PTRUE * NO COPY-PROTECTION, SO ALWAYS TRUE