PAGE * ---------------------------------------------------------------------------- * ARITHMETIC OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPADD * ---------------------- OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2 BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPSUB * ---------------------- OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1 BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPMUL * ---------------------- OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED) BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW * ---------------------- * OPDIV * ---------------------- * DIVIDE BY ZERO, MOD ZERO, & RANDOM ZERO GENERATE 68K HARDWARE TRAPS ... OPDIV EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS DIVS D1,D0 * DIVIDE OPR2 INTO OPR1 BRA PUTVAL * RETURN THE QUOTIENT, IGNORING REMAINDER * ---------------------- * OPMOD * ---------------------- OPMOD EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS DIVS D1,D0 * DIVIDE OPR2 INTO OPR1 SWAP D0 * GET REMAINDER BRA PUTVAL * RETURN IT * ---------------------- * OPRAND * ---------------------- OPRAND TST.W D7 * (GARBAGE FOR ST ASSEMBLER) IFEQ EZIP TST.W D0 * DISABLE RANDOMNESS NOW? BLT.S RANDX1 * YES BEQ.S RANDX2 * ZERO, RE-ENABLE RANDOMNESS TST.W RCYCLE(A6) * IS RANDOMNESS ALREADY DISABLED? BNE.S RANDX3 * YES ENDC * NORMAL RANDOMNESS, GENERATE A VALUE MOVE.W RSEED2(A6),D1 * GET BOTH SEEDS SWAP D1 MOVE.W RSEED1(A6),D1 MOVE.W D1,RSEED2(A6) * UPDATE LOW SEED SWAP D1 LSR.L #1,D1 * SHIFT BOTH RIGHT BY 1 BIT EOR.W D1,RSEED1(A6) * GENERATE OUTPUT & UPDATE HIGH SEED MOVE.W RSEED1(A6),D1 * GET NEW HIGH SEED ANDI.L #$00007FFF,D1 * CLEAR HIGH BIT TO PREVENT POSSIBLE OVERFLOW DIVU D0,D1 * DIVIDE ARG INTO RANDOM NUMBER SWAP D1 * GET REMAINDER ADDQ.W #1,D1 * MUST BE BETWEEN 1 AND N, INCLUSIVE MOVE.W D1,D0 BRA PUTVAL * RETURN THE VALUE IFEQ EZIP *** GENERATE A NON-RANDOM SEQUENCE HENCEFORTH RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT BRA.S RANDX4 * AND INITIALIZE COUNTER (SEQ BEGINS NEXT PASS) RANDX3 MOVE.W RCONST(A6),D0 * GENERATE NEXT VALUE IN SEQUENCE ADDQ.W #1,D0 CMP.W RCYCLE(A6),D0 * EXCEEDED THE UPPER LIMIT YET? BLE.S RANDX4 * NO MOVEQ #1,D0 * YES, RESTART THE SEQUENCE RANDX4 MOVE.W D0,RCONST(A6) * UPDATE COUNTER BRA PUTVAL * RETURN THE VALUE ENDC * ---------------------- * OPQLES * ---------------------- OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2? BLT PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQGRT * ---------------------- OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2? BGT PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PRECICATE FALSE * ---------------------- * OPBTST * ---------------------- * LOGICAL OPERATIONS OPBTST NOT.W D0 * TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1 AND.W D0,D1 BEQ PTRUE * SUCCESS IF OPR2 COMPLETELY CLEARED BRA PFALSE * ---------------------- * OPBOR * ---------------------- OPBOR OR.W D1,D0 * LOGICAL "OR" BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPBCOM * ---------------------- OPBCOM NOT.W D0 * LOGICAL COMPLEMENT BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPBAND * ---------------------- OPBAND AND.W D1,D0 * LOGICAL "AND" BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPSHIFT * ---------------------- OPSHIFT TST.W D1 * NEGATIVE? BLT.S SHFX1 * YES LSL.W D1,D0 * NO, LOGICAL LEFT SHIFT BRA PUTVAL SHFX1 NEG.W D1 LSR.W D1,D0 * LOGICAL RIGHT SHIFT BRA PUTVAL * ---------------------- * OPASHIFT * ---------------------- OPASHIFT TST.W D1 * NEGATIVE? BLT.S ASHFX1 * YES ASL.W D1,D0 * NO, ARITHMETIC LEFT SHIFT BRA PUTVAL ASHFX1 NEG.W D1 ASR.W D1,D0 * ARITHMETIC RIGHT SHIFT BRA PUTVAL * ---------------------- * OPQEUQ * ---------------------- * GENERAL PREDICATES OPQEQU NOP * TELL CALLER TO USE ARGBLK MOVE.W (A0)+,D1 * NUMBER OF OPERANDS MOVE.W (A0)+,D0 * OPR1 SUBQ.W #1,D1 QEQUX1 CMP.W (A0)+,D0 * IS NEXT OPR EQUAL TO OPR1? BEQ.S QEQUX2 * YES SUBQ.W #1,D1 * NO, BUT LOOP IF MORE OPERANDS BNE.S QEQUX1 BRA PFALSE * PREDICATE FALSE QEQUX2 BRA PTRUE * PREDICATE TRUE * ---------------------- * OPQZER * ---------------------- OPQZER TST.W D0 * IS OPR ZERO? BEQ PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE PAGE * ---------------------------------------------------------------------------- * OBJECT-RELATED PRIMITIVES * ---------------------------------------------------------------------------- * ---------------------- * OBJLOC * ---------------------- * GIVEN OBJECT NUMBER IN D0.W, RETURN OBJECT LOCATION IN A0 OBJLOC MULU #OLEN,D0 * CALCULATE OBJECT OFFSET MOVE.L OBJTAB(A6),A0 ADDA.L D0,A0 * INDEX INTO OBJECT TABLE ADDA.W #OPLEN-OLEN,A0 * SKIPPING OVER THE DEFAULT PROPERTY TABLE RTS * ---------------------- * FSTPRP * ---------------------- * GIVEN OBJECT LOCATION IN A0, RETURN POINTER TO FIRST PROPERTY IN A0 FSTPRP ADDA.W #PROP,A0 * POINT TO PROPERTY TABLE SLOT MOVEQ #0,D0 BSR GTAWRD * GET ITS LOCATION MOVE.L BUFFER(A6),A0 * ABSOLUTIZE THE LOCATION ADDA.L D0,A0 CLR.W D0 MOVE.B (A0)+,D0 * LENGTH OF SHORT DESCRIPTION IN WORDS ADD.W D0,D0 ADDA.W D0,A0 * ADJUST POINTER TO SKIP IT RTS * ---------------------- * NXTPRP * ---------------------- * GIVEN POINTER TO A PROPERTY ID IN A0, UPDATE IT TO POINT TO NEXT PROPERTY ID IFEQ EZIP NXTPRP MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2? BNE.S NXTPX4 * YES BTST #6,D0 * NO, PROPERTY LENGTH 2? BEQ.S NXTPX2 * NO, PROPERTY LENGTH IS 1 ADDQ.L #1,A0 NXTPX2 ADDQ.L #1,A0 * UPDATE POINTER RTS NXTPX4 MOVE.B (A0)+,D0 * GET (SECOND) PROPERTY LENGTH BYTE (LOW 6 BITS) ANDI.W #$003F,D0 * CLEAR OFF HIGH BITS ADDA.W D0,A0 * UPDATE POINTER RTS ENDC IFEQ CZIP NXTPRP CLR.W D0 MOVE.B (A0)+,D0 * GET PROPERTY ID BYTE ASR.W #5,D0 * EXTRACT PROPERTY LENGTH-1 (HIGH 3 BITS) ADDQ.W #1,D0 * ADJUST FOR EXTRA LENGTH BYTE ADDA.W D0,A0 * UPDATE POINTER RTS ENDC * ---------------------------------------------------------------------------- * OBJECT OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPMOVE * ---------------------- * MOVE (OBJ1 INTO OBJ2) OPMOVE MOVEM.W D1/D0,-(SP) * PROTECT OPERANDS FROM REMOVE CALL BSR OPREMO * REMOVE OBJ1 FROM WHEREVER IT IS MOVE.W 2(SP),D0 * OBJ2 BSR OBJLOC * FIND ITS LOCATION MOVE.L A0,A1 * SAVE IT MOVE.W (SP),D0 * OBJ1 BSR OBJLOC * FIND ITS LOCATION MOVEM.W (SP)+,D0/D1 * RESTORE THE OBJ NUMBERS IFEQ EZIP MOVE.W FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT MOVE.W D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT MOVE.W D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT ENDC IFEQ CZIP MOVE.B FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT MOVE.B D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT MOVE.B D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT ENDC RTS * ---------------------- * OPREMO * ---------------------- * REMOVE (OBJ FROM ITS PARENT) IFEQ EZIP OPREMO MOVE.W D0,D1 * SAVE OBJ BSR OBJLOC * FIND ITS LOCATION MOVE.L A0,A1 MOVE.W LOC(A1),D0 * GET ITS PARENT BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE BSR OBJLOC * FIND PARENT'S LOCATION MOVE.W FIRST(A0),D0 * GET PARENT'S FIRST CHILD CMP.W D0,D1 * IS IT OBJ? BNE.S REMOX1 * NO MOVE.W NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING BRA.S REMOX2 * AND EXIT REMOX1 BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING MOVE.W NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN CMP.W D0,D1 * IS IT OBJ? BNE.S REMOX1 * NO, CONTINUE SEARCH MOVE.W NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING REMOX2 CLR.W LOC(A1) * OBJ NOW HAS NO PARENT CLR.W NEXT(A1) * OR SIBLING REMOX3 RTS ENDC IFEQ CZIP OPREMO MOVE.W D0,D1 * SAVE OBJ BSR OBJLOC * FIND ITS LOCATION MOVE.L A0,A1 MOVE.B LOC(A1),D0 * GET ITS PARENT BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE BSR OBJLOC * FIND PARENT'S LOCATION MOVE.B FIRST(A0),D0 * GET PARENT'S FIRST CHILD CMP.B D0,D1 * IS IT OBJ? BNE.S REMOX1 * NO MOVE.B NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING BRA.S REMOX2 * AND EXIT REMOX1 ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING MOVE.B NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN CMP.B D0,D1 * IS IT OBJ? BNE.S REMOX1 * NO, CONTINUE SEARCH MOVE.B NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING REMOX2 CLR.B LOC(A1) * OBJ NOW HAS NO PARENT CLR.B NEXT(A1) * OR SIBLING REMOX3 RTS ENDC * ---------------------- * OPLOC * ---------------------- * LOC (RETURN CONTAINER OF OBJ) OPLOC BSR OBJLOC * FIND OBJ'S LOCATION IFEQ EZIP MOVE.W LOC(A0),D0 * GET PARENT ENDC IFEQ CZIP CLR.W D0 MOVE.B LOC(A0),D0 * GET PARENT, CLEARING UNUSED BYTE ENDC BRA PUTVAL * RETURN THE VALUE * ---------------------- * OPQFIR * ---------------------- * FIRST? (RETURN FIRST CHILD OF OBJ, FAIL IF NONE) OPQFIR BSR OBJLOC * FIND OBJ'S LOCATION IFEQ EZIP MOVE.W FIRST(A0),D0 * GET FIRST CHILD ENDC IFEQ CZIP CLR.W D0 MOVE.B FIRST(A0),D0 * GET FIRST CHILD, CLEARING UNUSED BYTE ENDC MOVE.W D0,-(SP) BSR PUTVAL * RETURN THE VALUE TST.W (SP)+ * NONZERO? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQNEX * ---------------------- * NEXT? (RETURN THE NEXT SIBLING OF OBJ, FAIL IF NONE) OPQNEX BSR OBJLOC * FIND OBJ'S LOCATION IFEQ EZIP MOVE.W NEXT(A0),D0 * GET SIBLING ENDC IFEQ CZIP CLR.W D0 MOVE.B NEXT(A0),D0 * GET SIBLING, CLEARING UNUSED BYTE ENDC MOVE.W D0,-(SP) BSR PUTVAL * RETURN THE VALUE TST.W (SP)+ * NONZERO? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPQIN * ---------------------- * IN? (IS OBJ1 CONTAINED IN OBJ2?) OPQIN BSR OBJLOC * FIND OBJ1'S LOCATION IFEQ EZIP CMP.W LOC(A0),D1 * IS OBJ1'S PARENT OBJ2? ENDC IFEQ CZIP CMP.B LOC(A0),D1 * IS OBJ1'S PARENT OBJ2? ENDC BEQ PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPGETP * ---------------------- * GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE) OPGETP BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S GETPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP GETPX1 BSR NXTPRP * POINT TO NEXT PROPERTY GETPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S GETPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BLT.S GETPX3 * IF LESS, NO SUCH PROPERTY, USE DEFAULT * (ASSUMIMG NO 2ND EZIP LENGTH BYTE EXISTS HERE) BTST #PLBIT,(A0)+ * GOT IT, EXAMINE (LOW MODE OR) LOWEST LEN BIT BNE.S GETPX4 * ONE MEANS WORD VALUE, OTHERWISE BYTE VALUE MOVE.B (A0),D0 * GET THE BYTE BRA BYTVAL * AND RETURN IT GETPX3 SUBQ.W #1,D1 * PROPERTY NOT FOUND, USE DEFAULT PROP TABLE ADD.W D1,D1 * WORD OFFSET MOVE.L OBJTAB(A6),A0 * GET BASE OF DEFAULT TABLE ADDA.W D1,A0 * POINT TO THE DEFAULT PROPERTY GETPX4 BSR GTAWRD * GET THE WORD VALUE BRA PUTVAL * AND RETURN IT * ---------------------- * OPPUTP * ---------------------- * PUTP (CHANGE VALUE OF SPECIFIED PROPERTY OF OBJ, ERROR IF BAD PROP NUMBER) OPPUTP BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S PUTPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP PUTPX1 BSR NXTPRP * POINT TO NEXT PROPERTY PUTPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S PUTPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S PUTPX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, FATAL ERROR LEA MSGPUP,A0 BRA FATAL * 'Non-existant put property' DATA MSGPUP DC.B 'Non-existant put property',0 TEXT * (ASSUMING NO 2ND EZIP LENGTH BYTE EXISTS HERE) PUTPX3 BTST #PLBIT,(A0)+ * EXAMINE (LOW MODE OR) LOWEST LENGTH BIT BNE.S PUTPX4 * ZERO MEANS BYTE VALUE, OTHERWISE WORD VALUE MOVE.B D2,(A0) * STORE THE NEW BYTE RTS PUTPX4 MOVE.W D2,D0 BRA PTAWRD * STORE THE NEW WORD * ---------------------- * OPNEXT * ---------------------- * NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROP IN OBJ) OPNEXT BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY TST.W D1 * WERE WE GIVEN ZERO AS PROP? BEQ.S NEXTX4 * YES, JUST RETURN FIRST PROPERTY NUMBER BRA.S NEXTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP NEXTX1 BSR NXTPRP * POINT TO NEXT PROPERTY NEXTX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S NEXTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S NEXTX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, FATAL ERROR LEA MSGNXP,A0 BRA FATAL * 'Non-existant next property' DATA MSGNXP DC.B 'Non-existant next property',0 TEXT NEXTX3 BSR NXTPRP * POINT TO NEXT PROPERTY NEXTX4 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER ANDI.W #PMASK,D0 * EXTRACT PROPERTY NUMBER BRA PUTVAL * AND RETURN IT * ---------------------- * FLGLOC * ---------------------- * PRIMITIVE TO LOCATE A FLAG BIT * GIVEN A POINTER TO FIRST FLAGS BYTE IN A0, TARGET FLAG NUMBER (0-47) IN D0 * RETURN POINTER TO TARGET FLAGS BYTE IN A0, TARGET BIT NUMBER (7-0) IN D0 FLGLOC MOVE.W D0,-(SP) LSR.W #3,D0 * EXTRACT BYTE OFFSET ADD.W D0,A0 * ADJUST FLAGS POINTER MOVE.W (SP)+,D0 NOT.W D0 * FIX THE 3 LOW-ORDER BITS ANDI.W #$0007,D0 * MASK OFF THE REST RTS * ADDQ.L #1,A0 * POINT TO NEXT FLAGS BYTE * SUBQ.W #8,D0 * WAS TARGET FLAG IN PREVIOUS BYTE? * BGE.S FLGLOC * NO * SUBQ.L #1,A0 * YES, POINT TO PREVIOUS FLAGS BYTE * NEG.W D0 * AND COMPUTE THE TARGET BIT NUMBER (7-0) * SUBQ.W #1,D0 * RTS * ---------------------- * OPQFSE * ---------------------- * FSET? (IS FLAG SET IN OBJ?) OPQFSE BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BTST D0,(A0) * IS THE SPECIFIED BIT SET? BNE PTRUE * YES, PREDICATE TRUE BRA PFALSE * NO, PREDICATE FALSE * ---------------------- * OPFSET * ---------------------- * FSET (SET A FLAG IN OBJ) OPFSET BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BSET D0,(A0) * SET THE SPECIFIED BIT RTS * ---------------------- * OPFCLE * ---------------------- * FCLEAR (CLEAR A FLAG IN OBJ) OPFCLE BSR OBJLOC * FIND OBJ'S LOCATION MOVE.W D1,D0 BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER BCLR D0,(A0) * CLEAR THE SPECIFIED BIT RTS PAGE * ---------------------------------------------------------------------------- * TABLE OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPGET * ---------------------- * GET (GET THE ITEM'TH WORD FROM TABLE) OPGET ASL.W #1,D1 * WORD OFFSET ADD.W D1,D0 * INDEX INTO TABLE BSR BSPLTB * SPLIT THE POINTER BSR GETWRD * GET THE WORD MOVE.W D2,D0 BRA PUTVAL * AND RETURN IT * ---------------------- * OPGETB * ---------------------- * GETB (GET THE ITEM'TH BYTE FROM TABLE) OPGETB ADD.W D1,D0 * INDEX INTO TABLE BSR BSPLTB * SPLIT THE POINTER BSR GETBYT * GET THE BYTE MOVE.W D2,D0 BRA BYTVAL * AND RETURN IT * ---------------------- * OPPUT * ---------------------- * NOTE: PROPERTY TABLE POINTERS IN THE NEXT FOUR ROUTINES NOW !MAY! * EXCEED 32K, SO SIGN-EXTENSIONS MUST BE AVOIDED. * A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER * PUT (REPLACE THE ITEM'TH WORD IN TABLE) OPPUT ASL.W #1,D1 * WORD OFFSET ADD.W D1,D0 * INDEX INTO TABLE ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD MOVE.L D0,A0 ADD.L BUFFER(A6),A0 * ABSOLUTIZE POINTER MOVE.W D2,D0 BRA PTAWRD * STORE THE WORD * ---------------------- * OPPUTB * ---------------------- * PUTB (REPLACE THE ITEM'TH BYTE IN TABLE) OPPUTB ADD.W D1,D0 * INDEX INTO TABLE ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD MOVE.L BUFFER(A6),A0 MOVE.B D2,0(A0,D0.L) * STORE THE BYTE RTS * ---------------------- * OPGTPT * ---------------------- * GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN OBJ, PROP) OPGTPT BSR OBJLOC * FIND OBJ'S LOCATION BSR FSTPRP * GET POINTER TO FIRST PROPERTY BRA.S GTPTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP GTPTX1 BSR NXTPRP * POINT TO NEXT PROPERTY GTPTX2 MOVE.B (A0),D0 * GET (FIRST) PROPERTY ID BYTE ANDI.W #PMASK,D0 * CLEAN OFF MODE/LENGTH BITS CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE BGT.S GTPTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE) BEQ.S GTPTX3 * IF EQUAL, GOT IT CLR.W D0 * OTHERWISE, RETURN ZERO FOR NO SUCH PROPERTY BRA.S GTPTX5 IFEQ EZIP GTPTX3 MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE BTST #7,D0 * IS THERE A SECOND LENGTH BYTE? BEQ.S GTPTX4 * NO ADDQ.L #1,A0 * YES, SKIP IT TOO ENDC IFEQ CZIP GTPTX3 ADDQ.L #1,A0 * POINT TO PROPERTY VALUE ENDC GTPTX4 MOVE.L A0,D0 SUB.L BUFFER(A6),D0 * RE-RELATIVIZE POINTER GTPTX5 BRA PUTVAL * AND RETURN IT * ---------------------- * OPPTSI * ---------------------- * PTSIZE (GIVEN POINTER TO PROPERTY TABLE, RETURN ITS SIZE) OPPTSI MOVE.L BUFFER(A6),A0 ANDI.L #$FFFF,D0 * MAKE THE TABLE PTR A LONGWORD ADDA.L D0,A0 * ABSOLUTIZE THE TABLE POINTER IFEQ EZIP MOVE.B -1(A0),D0 * GET MODE/ID BYTE OR LEN BYTE (EITHER WORKS!) BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2? BNE.S PTSIX4 * YES BTST #6,D0 * NO, PROPERTY LENGTH 2? BNE.S PTSIX2 * YES MOVEQ #1,D0 * NO, PROPERTY LENGTH IS 1 BRA PUTVAL * RETURN IT PTSIX2 MOVEQ #2,D0 BRA PUTVAL * RETURN IT PTSIX4 ANDI.W #PMASK,D0 * LENGTH IS LOW 6 BITS BRA PUTVAL * RETURN IT ENDC IFEQ CZIP CLR.W D0 MOVE.B -1(A0),D0 * GET THE PROP IDENTIFIER BYTE ASR.W #5,D0 * EXTRACT LENGTH BITS ADDQ.W #1,D0 * ADJUST TO ACTUAL LENGTH BRA PUTVAL * RETURN IT ENDC * ---------------------------------------------------------------------------- * BLOCK OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPINTBL * ---------------------- * INTBL? (SEARCH TABLE FOR A VALUE) OPINTBL NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * DEFAULT ARGBLK MOVE.W #4,(A1) * 4 ARGS MAX MOVE.W #128+2,ARG4(A1) * DEFAULT -- WORD SEARCH, RECORD LENGTH = 2 BSR SETDEF * SET UP DEFAULTS MOVE.L A0,A1 MOVE.W ARG4(A1),D3 ANDI.W #127,D3 * RECORD LENGTH ANDI.W #128,ARG4(A1) * SEARCH MODE BIT -- WORD 1, BYTE 0 BRA.S ITBX4 * >>> ZERO CHECK <<< ITBX1 MOVE.W ARG2(A1),D0 * RELATIVE BYTE ADDRESS OF TABLE BSR BSPLTB * SPLIT IT [D0,D1] TST.W ARG4(A1) * WORD SEARCH? BEQ.S ITBX2 * NO, BYTE BSR GETWRD CMP.W ARG1(A1),D2 * MATCH? BEQ.S ITBX5 * YES BRA.S ITBX3 ITBX2 BSR GETBYT CMP.B ARG1+1(A1),D2 * MATCH? BEQ.S ITBX5 * YES ITBX3 ADD.W D3,ARG2(A1) * NO, SKIP TO NEXT RECORD ITBX4 SUBQ.W #1,ARG3(A1) * ANY MORE RECORDS? BGE.S ITBX1 * YES, CONTINUE SEARCHING CLR.W D0 * FAILED, RETURN ZERO BSR PUTVAL BRA PFALSE * PREDICATE FALSE ITBX5 MOVE.W ARG2(A1),D0 * SUCCESS, RETURN THE RELATIVE POINTER BSR PUTVAL BRA PTRUE * PREDICATE TRUE * ---------------------- * OPCOPYT * ---------------------- * COPYT (COPY OR CLEAR A TABLE) OPCOPYT NOP * ASK FOR ARGBLK [JUST TO FREE UP REGS] MOVE.L A0,A2 MOVE.W ARG1(A2),D0 CMP.W ARG2(A2),D0 BEQ CPYTX8 * SAME, EXIT MOVE.W ARG3(A2),D1 * CHECK LENGTH: BEQ CPYTX8 * ZERO, EXIT BGT.S CPYTX1 * POSITIVE NEG.W ARG3(A2) * NEGATIVE, MAKE POSITIVE CPYTX1 TST.W ARG2(A2) * DEST BEQ.S CPYTX6 * IF ZERO, SPECIAL CASE TST.W D1 * WAS LEN NEG? BLT.S CPYTX4 * IF SO, DO /NOT/ CHECK FOR OVERLAP *** MOVE.W ARG1(A2),D0 * SRC CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"? BHI.S CPYTX4 * NO ADD.W ARG3(A2),D0 * MAYBE, SRC END (+1) CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"? BLS.S CPYTX4 * NO * "FORWARD OVERLAP" DOES EXIST, DO A REVERSE COPY CPYTX2 MOVE.W ARG2(A2),D0 * DEST ADD.W ARG3(A2),D0 * END (+1) BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] MOVE.L A0,A1 MOVE.W ARG1(A2),D3 * SRC ADD.W ARG3(A2),D3 * END (+1) CPYTX3 SUBQ.W #1,D3 * [PREDECREMENT] MOVE.W D3,D0 BSR BSPLTB * --> D0/D1 = BLK/OFF BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA MOVE.B D2,-(A1) * [PREDECREMENT] SUBQ.W #1,ARG3(A2) BNE.S CPYTX3 * LOOP [UNSIGNED TEST] RTS * DO A NORMAL COPY CPYTX4 MOVE.W ARG2(A2),D0 * DEST BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] MOVE.L A0,A1 MOVE.W ARG1(A2),D0 BSR BSPLTB * --> D0/D1 = BLK/OFF CPYTX5 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA MOVE.B D2,(A1)+ SUBQ.W #1,ARG3(A2) BNE.S CPYTX5 * LOOP [UNSIGNED TEST] RTS * NO DEST, JUST CLEAR THE SOURCE TABLE CPYTX6 MOVE.W ARG1(A2),D0 * SRC BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD] CPYTX7 CLR.B (A0)+ SUBQ.W #1,ARG3(A2) BNE.S CPYTX7 * LOOP [UNSIGNED TEST] CPYTX8 RTS * ---------------------- * OPPRNT * ---------------------- * PRINTT (DISPLAY A TABLE IN BLOCK FORMAT) OPPRNT NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * DEFAULT ARGBLK MOVE.W #3,(A1) * 3 ARGS MAX MOVE.W #1,ARG3(A1) * DEFAULT # LINES = 1 BSR SETDEF * SET UP DEFAULT MOVE.L A0,A2 TST.W ARG2(A2) BLE.S PRNTX3 * BAD COL COUNT, EXIT TST.W ARG3(A2) BLE.S PRNTX3 * BAD ROW COUNT, EXIT BSR PUTLIN * MAKE SURE BUFFER IS EMPTY MOVE.W _cur_column,A1 * REMEMBER INITIAL CURSOR COLUMN * 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 MOVE.W _w0font,-(SP) * YES MOVE.W _w1font,-(SP) MOVE.W #1,_w0font * MAKE SURE WE ARE USING ASCII (FONT 1)! MOVE.W #1,_w1font BSR PUTNEW * CR, SCROLL IF NEEDED [PUTCHR #13] MOVE.W (SP)+,_w1font * RESTORE PREVIOUS VALS MOVE.W (SP)+,_w0font MOVE.W A1,_cur_column * AND RESET COLUMN TO ORIGINAL VALUE MOVE.W ARG2(A2),D0 ADD.W D0,ARG1(A2) * START OF NEXT LINE BRA.S PRNTX1 * LOOP PRNTX3 RTS PAGE * ---------------------------------------------------------------------------- * VARIABLE OPERATIONS * ---------------------------------------------------------------------------- * ---------------------- * OPVALU * ---------------------- * VALUE (GET VALUE OF VARIABLE) OPVALU BSR GETVAR * GET THE VALUE BRA PUTVAL * AND RETURN IT * ---------------------- * OPSET * ---------------------- * SET (VAR TO VALUE) OPSET BRA PUTVAR * STORE THE VALUE * ---------------------- * OPPUSH * ---------------------- * PUSH (A VALUE ONTO THE GAME STACK) OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE RTS * ---------------------- * OPPOP * ---------------------- * POP (A VALUE OFF THE GAME STACK INTO VAR) OPPOP MOVE.W (A4)+,D1 * POP A VALUE BRA PUTVAR * AND STORE IT * ---------------------- * OPINC * ---------------------- * INC (INCREMENT VAR) OPINC MOVE.W D0,D1 * SAVE A COPY HERE BSR GETVAR * GET THE VARIABLE'S VALUE ADDQ.W #1,D0 * INCREMENT IT EXG D0,D1 * POSITION IT BRA PUTVAR * AND STORE THE NEW VALUE * ---------------------- * OPDEC * ---------------------- * DEC (DECREMENT VAR) OPDEC MOVE.W D0,D1 * SAVE A COPY HERE BSR GETVAR * GET THE VARIABLE'S VALUE SUBQ.W #1,D0 * DECREMENT IT EXG D0,D1 * POSITION IT BRA PUTVAR * AND STORE NEW VALUE * ---------------------- * OPQIGR * ---------------------- * IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL) OPQIGR MOVE.W D1,D2 * MOVE VAL HERE MOVE.W D0,D1 * COPY VAR HERE BSR GETVAR * GET THE VARIABLE'S VALUE ADDQ.W #1,D0 * INCREMENT IT EXG D0,D1 * POSITION IT CMP.W D2,D1 * NEW VALUE GREATER THAN VAL? BGT.S QIG2 * YES QIG1 BSR PUTVAR * NO, STORE THE NEW VALUE BRA PFALSE * AND RETURN PREDICATE FALSE QIG2 BSR PUTVAR * STORE THE NEW VALUE BRA PTRUE * AND RETURN PREDICATE TRUE * ---------------------- * OPQDLE * ---------------------- * DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL) OPQDLE MOVE.W D1,D2 * MOVE VAL HERE MOVE.W D0,D1 * COPY VAR HERE BSR GETVAR * GET THE VARIABLE'S VALUE SUBQ.W #1,D0 * DECREMENT IT EXG D0,D1 * POSITION IT CMP.W D2,D1 * NEW VALUE LESS THAN VAL? BLT.S QIG2 * YES BRA.S QIG1 * NO * --------------------------------------------------------------------------- * READ/INPUT OPERATIONS * --------------------------------------------------------------------------- * ------------------------------ * OPREAD * ------------------------------ * READ (A LINE OF INPUT AND MASTICATE IT) OPREAD NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX CLR.W ARG2(A1) * DEFAULT LEXV -- ZERO MEANS DON'T MOVE.W #-1,ARG3(A1) * DEFAULT TIMOUT INTERVAL -- NEG MEANS DON'T CLR.W ARG4(A1) * DEFAULT TIMOUT HANDLER FUNCTION BSR SETDEF * SET UP DEFAULTS ADDQ.L #2,A0 * SKIP COUNT SLOT MOVE.W (A0)+,D0 * INBUF MOVE.W (A0)+,D3 * [LEXV] MOVE.W (A0)+,TDELAY(A6) * [TIME] MOVE.W (A0)+,TFUNC(A6) * [HANDLER] BSR RELABS * ABSOLUTIZE THE INBUF PTR MOVE.L A0,A2 * KEEP IT HERE BSR TRESET * RESET THE TIMER, IF NEEDED IFEQ CZIP MOVEM.L D3/A2,-(SP) BSR OPUSL * UPDATE STATUS LINE MOVEM.L (SP)+,D3/A2 ENDC CLR.W LINES(A6) * RESET COUNTER (PREVENTS A SPURIOUS [MORE]) BSR PUTLIN1 * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT) *** GATHER AND LOWER-CASIFY THE INPUT LINE ... MOVE.L A2,A0 * START OF INPUT LINE BUFFER MOVEQ #0,D0 MOVE.B (A0)+,D0 * 1ST HEADER BYTE == MAX LENGTH MOVEQ #0,D1 MOVE.B (A0)+,D1 * 2ND HEADER BYTE == CURRENT LEN BSR READLN * GET IT MOVE.W D0,D2 * RETURN D0: TERM CHAR MOVE.L A0,D0 * RETURN A0: END OF ACTUAL INPUT (+1) MOVE.L A2,A0 ADDQ.L #2,A0 * START OF INPUT, SKIP HEADER SUB.L A0,D0 * NEW TOTAL LENGTH MOVE.B D0,1(A2) * STORE THE NEW LENGTH IN THE HEADER BSR LCASE * AND LOWER-CASIFY EVERYTHING *** TOKENIZE AND LOOKUP THE INPUT ... MOVE.W D3,D0 * LEXV ARG BEQ.S RDX4 * ZERO MEANS EXIT IMMEDIATELY BSR RELABS * ABSOLUTIZE MOVE.L A0,A3 MOVE.L VOCTAB(A6),A1 * OPREAD: USE "STANDARD" VOCAB TABLE MOVEQ #0,D1 * OPREAD: NO PRESERVE FLAG BSR LEX RDX4 MOVE.W D2,D0 BRA BYTVAL * RETURN THE TERM CHARACTER * ------------------------------ * OPLEX * ------------------------------ * TOKENIZE AND LOOKUP A LINE OF INPUT * (FIND EACH WORD, CONVERT IT TO ZWORD, AND STORE OFFSET INFO IN LEXV) OPLEX NOP * USE AN ARGUMENT BLOCK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX CLR.W ARG3(A1) * DEFAULT VOC TABLE (FLAG) CLR.W ARG4(A1) * DEFAULT PRESERVE FLAG = OFF BSR SETDEF * SET UP DEFAULTS MOVE.L A0,A1 * ARGBLK TST.W (A1)+ * SKIP ACTUAL ARG COUNT (NOT NEEDED) MOVE.W (A1)+,D0 * ARG1 == INBUF BSR RELABS * ABSOLUTIZE MOVE.L A0,A2 * AND PASS IT HERE MOVE.W (A1)+,D0 * ARG2 == LEXV BSR RELABS * ABSOLUTIZE MOVE.L A0,A3 * AND PASS IT HERE MOVE.L VOCTAB(A6),A0 * "STANDARD" VOCTAB MOVE.W (A1)+,D0 * USE A SPECIAL VOCTAB? BEQ.S LXX0 * NO BSR RELABS * YES, ABSOLUTIZE LXX0 EXG A0,A1 * PASS VOCTAB IN A1 MOVE.W (A0)+,D1 * AND PASS "PRESERVE" FLAG HERE * INTERNAL ENTRY POINT * GIVEN A1 -> VOCAB TABLE, A2 -> INBUF, A3 -> LEXV, D1 = PRESERVE FLAG LEX MOVE.L D2,-(SP) MOVE.L A1,A0 BSR INITLX * SETUP VOCAB VARS (FOR LOOKUP) MOVE.L A2,RDBOS(A6) * REMEMBER INPUT BUFFER BASE MOVEQ #0,D0 MOVE.B 1(A2),D0 * >> ACTUAL LEN OF INPUT << ADDQ.L #2,A2 * SKIP HEADER (MAX LEN, CUR LEN) ADD.L A2,D0 MOVE.L D0,RDEOS(A6) * REMEMBER END OF INPUT MOVE.L A3,RDRET(A6) * REMEMBER RETURN BUFFER BASE CLR.B 1(A3) * BUFFER INITIALLY EMPTY ADDQ.L #2,A3 * SKIP HEADER (MAX WORDS, NWORDS) * LOOP STARTS HERE, A2 -> CURRENT INBUF, A3 -> CURRENT LEXV LXX2 MOVE.L A2,A0 * CURRENT INPUT START MOVE.L RDEOS(A6),D0 SUB.L A2,D0 * CURRENT REMAINING LENGTH BEQ.S LXX8 * NOTHING, EXIT BSR ZWSTR * FIND NEXT WORD, AND CONVERT IT MOVE.L A0,A2 * RETURN: START OF CURRENT WORD MOVE.W D0,D2 * RETURN: LENGTH OF CURRENT WORD, OR ZERO BEQ.S LXX8 * NOTHING, EXIT *** BUILD THE LEX (RETURN) TABLE ... MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER MOVE.B (A0)+,D0 * MAX WORDS ALLOWED CMP.B (A0),D0 * ROOM FOR ANOTHER? BEQ.S LXX6 * NO, ERROR ADDQ.B #1,(A0) * INCREMENT FOUND-WORD COUNT LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE BSR LOOKUP * SEARCH VOCAB TABLE FOR IT, RETURN OFFSET TST.W D0 * WORD FOUND? BNE.S LXX3 * YES TST.W D1 * NO, PRESERVE OLD INFO? >> OFFSET ONLY << BNE.S LXX4 * YES LXX3 MOVE.L A3,A0 * CURRENT RETURN SLOT BSR PTAWRD * STORE THE OFFSET IN RETURN TABLE LXX4 MOVE.B D2,2(A3) * STORE WORD LENGTH IN RETURN TABLE MOVE.L A2,D0 SUB.L RDBOS(A6),D0 * CALCULATE STARTING BYTE OFFSET OF WORD MOVE.B D0,3(A3) * STORE IT TOO ADDQ.L #4,A3 * ADVANCE RETURN TABLE PTR ADDA.W D2,A2 * ADVANCE INPUT PTR BRA LXX2 * GO FOR THE NEXT WORD *** ERROR, RETURN BUFFER IS FULL, TELL USER, THEN EXIT LXX6 MOVE.L A2,A0 * START OF FLUSHED STRING MOVE.L RDEOS(A6),A1 * END (+1) BSR RDERR * ECHO IT IN ERROR MESSAGE LXX8 MOVE.L (SP)+,D2 * CLEAN UP AND EXIT RTS * ------------------------------ * OPZWSTR * ------------------------------ * IDENTIFY THE NEXT WORD (START/END), AND CONVERT IT TO A ZWORD OPZWSTR ADD.W D2,D0 * INPUT BUFFER: BASE + OFFSET BSR RELABS * ABSOLUTIZE IT MOVEQ #VCHARS,D0 * MAX LEN -- IGNORE 2ND ARG (SPEC ERROR) BSR ZWSTR * GO FOR IT * (IGNORE RETURNED INFO; WE'RE INTERESTED IN INITIAL WORD ONLY) MOVE.W D3,D0 * REQUESTED ZWORD BUFFER BSR RELABS * ABSOLUTIZE IT MOVE.L A0,A1 LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE MOVEQ #ZCHARS,D0 BRA COPYB * COPY ZWORD TO FINAL DEST, AND EXIT * INTERNAL ENTRY POINT * GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH (TOTAL) * RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO ZWSTR BSR FINDBK * FIND NEXT BREAK CHAR TST.W D0 BEQ.S ZWSX1 * EXIT IF NOTHING MOVEM.L D0-D1/A0-A1,-(SP) * SAVE RESULTS LEA RDWSTR(A6),A1 * TEMP STRING BUFFER MOVEQ #VCHARS,D1 * MAX LENGTH BSR COPYS * COPY FIRST WORD, MAKE ASCIZ LEA RDWSTR(A6),A1 LEA RDZSTR(A6),A0 * TEMP OUTPUT BUFFER BSR ZWORD * CONVERT STRING, LEAVE ZWORD IN BUFFER MOVEM.L (SP)+,D0-D1/A0-A1 * RESTORE RESULTS ZWSX1 RTS * ------------------------------ * OPINPUT * ------------------------------ * WAIT FOR A KEY (NO ECHO), HANDLE OPTIONAL TIMEOUTS OPINPUT NOP * USE ARGBLK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #3,(A1) * 3 ARGS MAX MOVE.W #-1,ARG2(A1) * DEFAULT TIMOUT INTERVAL -- "DON'T" CLR.W ARG3(A1) * DEFAULT TIMOUT HANDLER FUNCTION BSR SETDEF * SET UP DEFAULTS ADDQ.L #ARG2,A0 * SKIP COUNT AND DEVICE MOVE.W (A0)+,TDELAY(A6) * DELAY IN 1/10'S SECOND MOVE.W (A0)+,TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT BSR TRESET * RESET THE TIMER, IF NEEDED CLR.W LINES(A6) * RESET COUNTER, PREVENTS A SPURIOUS [MORE] TST.W VOBUFF(A6) * BUFFERED OUTPUT? BEQ.S INPX1 * NO BSR PUTLIN * YES, EMPTY THE BUFFER INPX1 BSR INPUT * GET KEY BRA BYTVAL * AND RETURN ITS VALUE * INTERNAL ENTRY POINT >> CALLED FROM OPREAD/READLN, TO HANDLE TIMEOUTS << * WAIT FOR A KEY, RETURN VALUE, OR ZERO (AFTER A TIME-OUT ABORT) INPUT INPX2 MOVEQ #1,D0 BSR SETUPI * SET UP FOR INPUT -- START OF LOOP INPX4 BSR GAMINT1 * CHECK FOR GAME INTERRUPT (SOUND, ETC) BSR ITTYIN * CHECK FOR A KEY << DON'T WAIT! >> TST.B D0 BNE.S INPX6 * GOT ONE, EXIT TST.W TDELAY(A6) * TIMOUTS IN EFFECT? BLT.S INPX4 * NO, JUST LOOP BSR TCHECK * TIME REMAINING BEFORE NEXT TIMEOUT TST.L D0 * HAS IT RUN OUT? BGT.S INPX4 * NO, LOOP BSR TNEXT * YES, UPDATE TIMER CLR.W D0 BSR SETUPI * END OF INPUT LOOP (FOR THE MOMENT...) MOVE.W TFUNC(A6),D0 * TIMEOUT FUNCTION BSR INCALL * CALL IT (INTERNALLY) TST.W D0 * RETURNS A BOOLEAN -- ABORT INPUT? BEQ.S INPX2 * NO CLR.W D0 BRA.S INPX8 * YES, RETURN A NULL CHAR INPX6 MOVE.W D0,-(SP) CLR.W D0 BSR SETUPI * END OF INPUT LOOP (NORMAL) MOVE.W (SP)+,D0 * RETURN THE INPUT RESULT INPX8 RTS * --------------------------------------------------------------------------- * READ/INPUT PRIMITIVES * --------------------------------------------------------------------------- * ------------------------------ * READLN * ------------------------------ * GATHER A LINE OF INPUT * GIVEN A0 -> INPUT BUFFER, D0 = MAX LENGTH, D1 = CURRENT LENGTH * RETURN A0 -> END OF ACTUAL INPUT (+1), D0 = TERM CHAR EOLCHR EQU $0D * CARRIAGE RETURN DELCH1 EQU $08 * BACKSPACE DELCH2 EQU $7F * ALSO ACCEPT "DELETE" READLN MOVEM.L D1-D4/A1-A3,-(SP) MOVE.W _cur_column,D3 * REMEMBER "REAL" STARTING POSITION MOVE.W _columns,D4 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 BSR INPUT * NO ECHO, HANDLE TIMEOUTS *** BSR TTYIN TST.B D0 * WAS THERE A TIME-OUT ABORT? BEQ.S RDLX10 * YES, BREAK CMPI.B #EOLCHR,D0 * STANDARD CARRIAGE-RETURN? 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 FUNCTION KEYS 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 TST.W D1 * "FUNCTION-KEY TCHARS" ACTIVE? BEQ.S RDLX6 * NO CMPI.B #127,D0 * LAST CHANCE TO BE A TERM CHAR BGT.S RDLX10 * YES! BREAK * NOT A TCHAR, CHECK FOR A BACKSPACE ... RDLX6 CMPI.B #DELCH1,D0 * BACKSPACE? BEQ.S RDLX8 * YES CMPI.B #DELCH2,D0 * DELETE? BEQ.S RDLX8 * YES *** NORMAL CHARACTER, HANDLE IT ... CMPA.L A3,A2 * BUFFER OVERFLOW? BCC.S RDLX9 * BHS * YES, IGNORE CHAR, JUST BEEP MOVE.B D0,(A2)+ * STORE CHAR BSR TTYOUT * AND ECHO IT BRA.S RDLX2 * HANDLE A BACKSPACE RDLX8 CMPA.L A1,A2 * BUFFER UNDERFLOW? BLS.S RDLX9 * YES, JUST BEEP SUBQ.L #1,A2 * NO, BACK UP BUFFER POINTER MOVEQ #DELCH1,D0 BSR TTYOUT * AND ECHO A BS BRA.S RDLX2 * ERROR, BUFFER TOO FULL/EMPTY -- DISCARD CHAR, DON'T ECHO RDLX9 MOVEQ #1,D0 * BEEP AT USER BSR DOSOUND BRA.S RDLX2 * AND KEEP WAITING *** DONE, HANDLE THE TERMINATING CHAR <<< DON'T STORE IN BUFFER >>> RDLX10 MOVE.W D0,D2 * SAVE TCHAR CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN? BNE.S RDLX12 * NO >>> SKIP THE ECHO? <<< BSR TTYOUT * YES, ECHO IT RDLX12 CMPA.L A3,A2 * ANY ROOM LEFT? BCC.S RDLX14 * BHS * NO (SIGH) CLR.B (A2) * INPUT SHOULD BE FOLLOWED BY A BREAK (ZWSTR) RDLX14 TST.W WIND1(A6) * ARE WE IN WINDOW 1? BNE.S RDLX20 * YES, IGNORE [MORE] COUNTER * ADJUST THE [MORE] COUNTER MOVE.L A2,D0 SUB.L A1,D0 * LENGTH OF INPUT ADD.W D3,D0 * TAKING INTO ACCOUNT INITIAL COLUMN CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN? BNE.S RDLX18 * NO RDLX16 ADDQ.W #1,LINES(A6) * ADJUST THE [MORE] COUNTER RDLX18 SUB.W D4,D0 * SCREEN WIDTH (40 - 80) BGE.S RDLX16 * ONCE FOR EACH ADDITIONAL SCREEN LINE * SCRIPT THE USER INPUT LINE (IF SCRIPTING IS ACTIVE) * AVOID PROBLEMS WITH BACKSPACES, BY WAITING UNTIL INPUT IS COMPLETE RDLX20 MOVEQ #0,D1 CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN? BNE.S RDLX22 * NO MOVEQ #1,D1 * YES, /DO/ ADD A CR RDLX22 MOVE.L A1,A0 * START OF LINE MOVE.L A2,D0 SUB.L A1,D0 * LENGTH BSR SCRINP MOVE.W D2,D0 * RETURN TERM CHAR MOVE.L A2,A0 * RETURN END-OF-INPUT (+1) POINTER MOVEM.L (SP)+,D1-D4/A1-A3 RTS * --------------------------- * LCASE * --------------------------- * LOWER-CASIFY A LINE OF INPUT, A0 -> INPUT, D0.W = LEN LCASE BRA.S LCSX3 LCSX1 CMPI.B #'A',(A0) * UPPERCASE CHAR? BLT.S LCSX2 * NO CMPI.B #'Z',(A0) * MAYBE? BGT.S LCSX2 * NO ADDI.B #32,(A0) * YES, LOWER-CASIFY IT LCSX2 ADDQ.L #1,A0 LCSX3 DBF D0,LCSX1 * ZERO CHECK << ENTRY POINT >> RTS * ------------------------------ * FINDBK * ------------------------------ * FIND THE NEXT BREAK CHARACTER * GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH * RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO FINDBK MOVEM.L D1/A1-A3,-(SP) MOVE.L A0,A2 ADDA.W D0,A2 * END OF INPUT (+1) CLR.W D1 * COUNT OF SIGNIFICANT CHARS FBX1 MOVE.L A0,A1 * REMEMBER START OF CURRENT WORD FBX2 CMPA.L A0,A2 * END OF INPUT STRING? BEQ.S FBX8 * YES MOVE.B (A0)+,D0 * NO, PICK UP NEXT CHAR MOVE.L RBRKS(A6),A3 * LIST OF READ-BREAK CHARACTERS CMPI.B #127,D0 * BUT IS THIS A FUNCTION KEY? BHI.S FBX6 * YES, CONSIDER IT A S.I. BREAK (?) FBX4 CMP.B (A3),D0 * SEARCH LIST FOR CHAR << XZIP: "NULL" TOO >> BEQ.S FBX6 * FOUND IT TST.B (A3)+ * END OF (ASCIZ) LIST? BNE FBX4 * NO, CONTINUE SEARCH ADDQ.W #1,D1 * YES, NOT A BREAK, BUMP COUNT BRA FBX2 *** BREAK CHAR FOUND ... FBX6 TST.W D1 * WORD READ /BEFORE/ THIS BREAK? BNE.S FBX8 * YES, GO FOR IT CMPA.L ESIBKS(A6),A3 * NO, BUT WAS THIS A SELF-INSERTING BREAK? BCC.S FBX1 * BHS * NO, JUST SKIP IT, LOOP FOR NEXT ADDQ.W #1,D1 * YES, BUMP COUNT AND GO FOR ZWORD *** CLEAN UP AND EXIT ... FBX8 MOVE.L A1,A0 * RETURN START OF CURRENT WORD MOVE.W D1,D0 * RETURN LENGTH OF CURRENT WORD MOVEM.L (SP)+,D1/A1-A3 RTS * ------------------------------ * RDERR * ------------------------------ * TOO MANY WORDS FOUND IN THE INPUT BUFFER, INFORM LOSER * A0 -> START OF EXCESS INPUT, A1 -> END OF INPUT (+1) RDERR MOVE.L A0,-(SP) * SAVE ARG HERE BSR PUTNEW LEA MSGIO1,A0 BSR OUTMSG0 * '[Too many words ... "' DATA MSGIO1 DC.B '[Too many words typed, discarding ',$22,0 TEXT 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 TEXT BSR PUTNEW * FINAL CR RTS * --------------------------- * INITLX * --------------------------- * INIT VOCABULARY VARS, GIVEN A VOCAB TABLE POINTER IN A0 * (CALLED AT BEGINNING OF EACH "LEX" CALL) INITLX MOVEM.L D1-D2/A1-A2,-(SP) CLR.W D0 MOVE.B (A0)+,D0 * THIS BYTE IS THE # OF SI BREAKS ADDA.W D0,A0 * SKIP THEM (READ DURING STARTUP ONLY) CLR.W D0 MOVE.B (A0)+,D0 * THIS BYTE IS THE LENGTH OF EACH VOCTAB ENTRY MOVE.W D0,VWLEN(A6) * SAVE IT MOVE.B (A0)+,D0 * THIS WORD IS # OF VOCTAB ENTRIES ASL.W #8,D0 MOVE.B (A0)+,D0 MOVE.L A0,VOCBEG(A6) * THIS IS BEGINNING OF ACTUAL VOCABULARY TST.W D0 * IF POSITIVE #, TABLE IS SORTED BGT.S INLX4 NEG.W D0 * OTHERWISE, NOT SORTED, POSITIVIZE COUNT CLR.W D1 * AND INDICATE UNSORTED TABLE BRA.S INLX6 * SORTED TABLE -- CALCULATE INITIAL OFFSET FOR BINARY SEARCH INLX4 MOVE.W D0,D2 MOVE.W VWLEN(A6),D1 * NUMBER OF BYTES PER VOCAB ENTRY ASR.W #1,D2 INLX5 ASL.W #1,D1 ASR.W #1,D2 BNE INLX5 MOVE.W D1,VWBOFF(A6) * SAVE INITIAL BINARY SEARCH OFFSET MOVEQ #1,D1 * INDICATE A SORTED TABLE INLX6 MOVE.W D0,VWORDS(A6) * SAVE COUNT MOVE.W D1,VWSORT(A6) * SAVE FLAG SUBQ.W #1,D0 MULS VWLEN(A6),D0 ADD.L VOCBEG(A6),D0 * CALCULATE POINTER TO LAST ENTRY MOVE.L D0,VOCEND(A6) * SAVE IT MOVEM.L (SP)+,D1-D2/A1-A2 RTS * ------------------------------ * LOOKUP * ------------------------------ * SEARCH (CURRENT) VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0 * RETURN ZWORD'S TABLE ADDR (RELATIVIZED) IN D0.W, NULL IF NOT FOUND LOOKUP MOVEM.L D1/A1-A3,-(SP) MOVE.L A0,A3 * SAVE POINTER TO GIVEN ZWORD HERE MOVE.L VOCBEG(A6),A2 * BEGINNING OF (CURRENT) VOCABULARY TABLE TST.W VWORDS(A6) * EMPTY TABLE? BEQ.S LKX14 * YES, RETURN ZERO TST.W VWSORT(A6) * SORTED TABLE? BNE.S LKX2 * YES LKX1 MOVE.L A2,A0 * NO, MUST DO LINEAR SEARCH MOVE.L A3,A1 BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD BEQ.S LKX12 * SAME, WE'VE FOUND IT ADDA.W VWLEN(A6),A2 * NEXT TABLE ITEM CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE? BLS LKX1 * NO BRA.S LKX14 * YES, WORD NOT FOUND, RETURN ZERO *** SORTED TABLE LKX2 MOVE.W VWBOFF(A6),D1 * INITIAL OFFSET FOR BINARY SEARCH ADDA.W D1,A2 * INITIAL POINTER INTO TABLE SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG, EXACT-POWER-OF-2 TABLE LKX4 ASR.W #1,D1 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE MOVE.L A2,A0 MOVE.L A3,A1 BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD BHI.S LKX8 * GREATER, MOVE DOWN BEQ.S LKX12 * SAME, WE'VE FOUND IT *** BCS.S LKX6 * (BLO) * LESS, MOVE UP LKX6 ADDA.W D1,A2 * TO MOVE UP, ADD OFFSET CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE? BLS.S LKX10 * NO MOVE.L VOCEND(A6),A2 * YES, POINT TO END OF TABLE BRA.S LKX10 LKX8 SUBA.W D1,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET LKX10 CMP.W VWLEN(A6),D1 * IS OFFSET RESOLUTION AT LEAST ONE WORD? BGE LKX4 * YES, CONTINUE LOOP BRA.S LKX14 * NO, WORD NOT FOUND *** DONE, WINNING VOCAB POINTER LEFT IN A2 LKX12 MOVE.L A2,D0 SUB.L BUFFER(A6),D0 * RELATIVIZE THE ZWORD'S VOCAB TABLE OFFSET BRA.S LKX16 LKX14 MOVEQ #0,D0 * WORD NOT FOUND, RETURN ZERO LKX16 MOVEM.L (SP)+,D1/A1-A3 RTS * ------------------------------ * VCOMP * ------------------------------ * COMPARE GIVEN ZWORD (A1) TO CURRENT TABLE ZWORD (A0) * RETURN WITH FLAGS VCOMP MOVEQ #ZCHARS-1,D0 * CHECK THREE WORDS VCPX1 CMPM.B (A1)+,(A0)+ DBNE D0,VCPX1 * TAKE BRANCH IF EQUAL RTS * UNROLL THE LOOP (RUNS A BIT FASTER) ** CMPM.B (A1)+,(A0)+ * CHECK FIRST WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** CMPM.B (A1)+,(A0)+ * CHECK SECOND WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** IFEQ EZIP ** CMPM.B (A1)+,(A0)+ * CHECK THIRD WORD ** BNE.S VCPX2 * DIFFERENT, EXIT ** CMPM.B (A1)+,(A0)+ ** BNE.S VCPX2 ** ENDC * VCPX2 RTS * OTHERWISE SAME, EXIT * ------------------------------ * TIMEOUT PRIMITIVES * ------------------------------ * NOTE: 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 A TIMEOUT ABORT OCCURS. * ---------------------- * TRESET * ---------------------- * RESET THE TIMEOUT CLOCK TRESET BSR TIME60 * GET BASE REFERENCE TIME, IN 60THS MOVE.L D0,TSNAP(A6) * STORE IT AND FALL THRU * ---------------------- * TNEXT * ---------------------- * UPDATE THE TIMEOUT CLOCK TNEXT MOVE.W TDELAY(A6),D0 MULU #6,D0 * DELAY IN 60THS ADD.L D0,TSNAP(A6) * COMPUTE NEXT TIMEOUT (EXPIRATION) MOMENT RTS * ---------------------- * TCHECK * ---------------------- * CHECK THE TIMEOUT CLOCK * RETURN FLAGS & TIME REMAINING (ZERO OR NEGATIVE IF NONE) TCHECK BSR TIME60 * GET CURRENT TIME (IN 60THS) SUB.L TSNAP(A6),D0 NEG.L D0 * TIME REMAINING, IN 60THS RTS * RETURN FLAGS PAGE * --------------------------------------------------------------------------- * I/O OPERATIONS -- OUTPUT * --------------------------------------------------------------------------- * ---------------------- * OPUSL * ---------------------- * OPUSL (UPDATE STATUS LINE) IFEQ EZIP OPUSL BRA OPERR * DEAD INSTRUCTION ENDC * ---------------------- * OPPRNC * ---------------------- * PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN) OPPRNC BRA PUTCHR * HANDLE IT * ---------------------- * OPPRNN * ---------------------- * PRINTN (PRINT A NUMBER, USING CURRENT CHARACTER OUTPUT FUNCTION) OPPRNN MOVE.W D0,D1 * NON-ZERO NUMBER? BNE.S PRNNX1 * YES MOVE.B #'0',D0 * ZERO, SPECIAL CASE BRA PUTCHR * PRINT A ZERO PRNNX1 BGT.S PRNNX2 * POSITIVE? MOVE.B #'-',D0 * NO, PRINT A MINUS SIGN BSR PUTCHR NEG.W D1 * AND MAKE NUMBER POSITIVE PRNNX2 CLR.W D2 * COUNT OF DIGITS ON STACK BRA.S PRNNX4 * START WITH GREATER-THAN-10 TEST PRNNX3 EXT.L D1 * CLEAR HIGH WORD FOR DIVISION DIVU #10,D1 * EXTRACT A DIGIT (THE REMAINDER) SWAP D1 MOVE.W D1,-(SP) * PUSH IT SWAP D1 ADDQ.W #1,D2 * BUMP COUNT PRNNX4 CMPI.W #10,D1 * ANY MORE DIGITS TO EXTRACT? BGE PRNNX3 * YES MOVE.W D1,D0 * NO, POSITION LAST (FIRST) DIGIT BRA.S PRNNX6 PRNNX5 MOVE.W (SP)+,D0 * POP NEXT DIGIT PRNNX6 ADDI.B #'0',D0 * ASCIIZE IT BSR PUTCHR * PRINT NEXT DIGIT SUBQ.W #1,D2 * ANY DIGITS LEFT ON STACK? BGE PRNNX5 * YES RTS * ---------------------- * OPPRIN * ---------------------- * PRINT (THE STRING POINTED TO) IFEQ EZIP OPPRIN BSR BSPLTQ * SPLIT THE BLOCK AND OFFSET (QUAD) ENDC IFEQ CZIP OPPRIN BSR BSPLIT * SPLIT THE BLOCK AND OFFSET (WORD) ENDC BRA PUTSTR * PRINT THE STRING * ---------------------- * OPPRNB * ---------------------- * PRINTB (THE STRING POINTED TO) OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE) BRA PUTSTR * PRINT THE STRING * ---------------------- * OPPRND * ---------------------- * PRINTD (PRINT OBJ'S SHORT DESCRIPTION) OPPRND BSR OBJLOC * FIND OBJECT'S LOCATION ADDA.W #PROP,A0 * PROPERTY TABLE POINTER (ZIP/EZIP) BSR GTAWRD * GET IT ADDQ.W #1,D0 * POINT TO SHORT DESCRIPTION STRING BSR BSPLTB * SPLIT THE POINTER BRA PUTSTR * AND PRINT THE STRING * ---------------------- * OPPRNI * ---------------------- * PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION) OPPRNI MOVE.W ZPC1(A6),D0 * GET POINTER TO STRING MOVE.W ZPC2(A6),D1 BSR PUTSTR * PRINT IT MOVE.W D0,ZPC1(A6) * AND UPDATE ZPC MOVE.W D1,ZPC2(A6) BRA NEWZPC * ---------------------- * OPPRNR * ---------------------- * PRINTR (PRINTI FOLLOWED BY RTRUE) OPPRNR BSR OPPRNI * DO A PRINTI BSR OPCRLF * A CRLF BRA OPRTRU * AND AN RTRUE * ---------------------- * OPCRLF * ---------------------- * CRLF (DO A NEWLINE) OPCRLF BRA PUTNEW * DO A NEWLINE * ---------------------- * OPSPLT * ---------------------- * SPLIT/UNSPLIT THE SCREEN OPSPLT MOVE.W D0,D1 BSR PUTLIN1 * EMPTY (& ZERO) BUFFER, IF NEEDED MOVE.W D1,D0 CMP.W _rows,D0 * MAKE SURE REQUEST IS VALID BLE.S SPLTX1 * OK MOVE.W _rows,D0 * TOO BIG, LIMIT TO FULL SCREEN SPLTX1 MOVE.W D0,_split_row * RESET SPLIT POINT * CLEAR WINDOW 1 (ZIP ONLY!) ... * CLEARING OF [GROWING] WINDOWS HAS BEEN REMOVED FROM EZIP SPEC CLR.W ROW1(A6) * INITIAL WINDOW 1 CURSOR POSITION (HOME) CLR.W COL1(A6) TST.W WIND1(A6) * WAS CURSOR IN SCREEN 0? BNE.S SPLTX3 * NO CMP.W _cur_row,D0 * YES, BUT IS IT STILL (POSITIONALLY)? BLE.S SPLTX3 * YES MOVE.W D0,_cur_row * NO, "PUSH IT DOWN" CLR.W _cur_column CMP.W _rows,D0 * BUT MAKE SURE NEW POSITION ISN'T OFF SCREEN BLT.S SPLTX3 * OK SUBQ.W #1,_cur_row * ILLEGAL, ADJUST IT (EVEN THO NOW IN W1!) SPLTX3 RTS * ---------------------- * OPSCRN * ---------------------- * MAKE OUTPUT FALL INTO SPECIFIED WINDOW OPSCRN MOVE.W D0,D1 BSR PUTLIN1 * EMPTY (& ZERO) BUFFER, IF NEEDED TST.W D1 * OUTPUT TO WINDOW 0? BEQ.S SCRNX1 * YES CMPI.W #1,D1 * OUTPUT TO WINDOW 1? BEQ.S SCRNX3 * YES RTS * INVALID ARG * MOVE CURSOR INTO WINDOW 0, RESTORE OLD CURSOR POSITION SCRNX1 TST.W WIND1(A6) * ALREADY IN WINDOW 0? BEQ.S SCRNX2 * YES BSR PUTLIN * FIRST DUMP BUFFER, IF NEEDED CLR.W WIND1(A6) CLR.W _wind1 * TELL 'C' THE CURRENT WINDOW TOO (SIGH) MOVE.W _cur_row,ROW1(A6) * SAVE WINDOW 1 POSITION MOVE.W _cur_column,COL1(A6) MOVE.W ROW0(A6),_cur_row * RESTORE WINDOW 0 POSITION MOVE.W COL0(A6),_cur_column SCRNX2 RTS * MOVE CURSOR INTO WINDOW 1, SAVE OLD CURSOR POSITION IF REQUIRED SCRNX3 TST.W WIND1(A6) * ALREADY IN WINDOW 1? BNE.S SCRNX4 * YES MOVE.W #1,WIND1(A6) MOVE.W #1,_wind1 MOVE.W _cur_row,ROW0(A6) * SAVE WINDOW 0 POSITION MOVE.W _cur_column,COL0(A6) MOVE.W ROW1(A6),_cur_row * RESTORE WINDOW 1 POSITION MOVE.W COL1(A6),_cur_column SCRNX4 RTS * ---------------------- * OPBUFO * ---------------------- * 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 BUFOX2 BSR PUTLIN * FIRST EMPTY THE CURRENT OUTPUT BUFFER CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING BUFOX3 RTS * ---------------------- * TABCHR * ---------------------- * TABLE OUTPUT FUNCTION --- PUT THE CHAR IN D0 IN THE DEFINED TABLE TABCHR MOVE.L TABPTR(A6),A0 * CURRENT POSITION IN TABLE MOVE.B D0,(A0)+ * STORE CHAR MOVE.L A0,TABPTR(A6) * UPDATE POINTER RTS * ---------------------- * OPDIRO * ---------------------- * REDIRECT OUTPUT (TABLE OR NORMAL) ACCORDING TO INT OPDIRO NOP * TELL CALLER TO USE ARGBLK MOVE.W ARG1(A0),D0 * VIRTUAL OUTPUT DEVICE -- NEGATIVE? BLT 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.S 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.S DIRX7 * UNKNOWN DEVICE, IGNORE REQUEST *** TURN SCREEN OUTPUT ON, OFF DIRX1 MOVE.W #1,VOCONS(A6) BRA.S DIRX7 DIRX2 BSR PUTLIN * BUT FIRST DUMP BUFFER, IF NEEDED CLR.W VOCONS(A6) BRA.S DIRX7 *** TURN SCRIPTING OUTPUT ON, OFF DIRX3 MOVE.L BUFFER(A6),A0 BSET #0,PFLAGS+1(A0) * SET PRELOAD FLAG FOR GAME'S USE MOVE.W #1,VOPRNT(A6) BRA.S DIRX7 DIRX4 MOVE.L BUFFER(A6),A0 BCLR #0,PFLAGS+1(A0) * CLEAR THE PRELOAD FLAG CLR.W VOPRNT(A6) BRA.S DIRX7 *** TURN TABLE ON, OFF DIRX5 MOVEQ #0,D0 MOVE.W ARG2(A0),D0 * GET RELATIVE TABLE POINTER ADD.L BUFFER(A6),D0 * ABSOLUTIZE MOVE.L D0,TABOUT(A6) * REMEMBER START OF TABLE ADDQ.L #2,D0 * SKIP LENGTH SLOT MOVE.L D0,TABPTR(A6) * FIRST CHAR WILL GO HERE MOVE.W #1,VOTABL(A6) * SET TABLE-OUTPUT FLAG BRA.S DIRX7 DIRX6 TST.W VOTABL(A6) * MAKE SURE A TABLE DOES EXIST BEQ.S DIRX7 * NO TABLE, IGNORE REQUEST CLR.W VOTABL(A6) * OK, TURN OFF TABLE-OUTPUT FLAG MOVE.L TABOUT(A6),A0 * COMPUTE LENGTH OF CURRENT TABLE CONTENTS MOVE.L TABPTR(A6),D0 SUB.L A0,D0 SUBQ.W #2,D0 * ADJUST FOR LENGTH SLOT BSR PTAWRD * AND STORE LENGTH IN LENGTH SLOT DIRX7 RTS * REDIRECT INPUT (NORMAL OR COMMAND FILE) ACCORDING TO INT * ---------------------- * OPDIRI * ---------------------- OPDIRI NOP * TELL CALLER TO USE ARGBLK *** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE -- NOT IMPLEMENTED RTS * ---------------------- * OPSOUND * ---------------------- * MAKE A SOUND * ARG1 = ID: 1=BEEP, 2=BOOP, 3+ ARE SPECIAL, 0=MRU * [ARG2] = ACTION: 1=INIT, [2=START], 3=STOP, 4=CLEANUP * [ARG3] = COUNT (HIBYTE): -1=INFINITE, [0=USE MIDI COUNT], 1-254=FINITE * VOL (LOBYTE): 0=MIN, 8=MAX, [-1=USE MIDI VOLUME] * [ARG4] = INTERRUPT FUNCTION OPSOUND NOP * REQUEST AN ARGBLK LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO MOVE.W #4,(A1) * 4 ARGS MAX MOVE.W #2,ARG2(A1) * DEFAULT ACTION = "START" MOVE.W #$00FF,ARG3(A1) * DEFAULT COUNT=0/VOL=-1 (USE MIDI DATA) CLR.W ARG4(A1) * DEFAULT INTERRUPT HANDLER = NONE BSR SETDEF * SET UP DEFAULTS MOVE.W ARG4(A0),SFUNC(A6) * SAVE INTERRUPT HERE MOVE.W ARG3(A0),D2 * COUNT/VOL MOVE.W D2,D3 EXT.W D2 * VOL (16 BITS) LSR.W #8,D3 * COUNT (16 BITS, UNLESS -1) CMPI.B #$FF,D3 * -1? BNE.S OPSDX1 EXT.W D3 * YES, MAKE 16 BITS OPSDX1 MOVE.W ARG2(A0),D1 * ACTION MOVE.W ARG1(A0),D0 * SOUND ID BRA DOSOUND * --------------------------------------------------------------------------- * MORE I/O OPERATIONS -- SCREEN HANDLING * --------------------------------------------------------------------------- * [Note that several of the following ops don't save registers across C calls. * Generally okay for OPx functions, but be careful about special regs like A4.] * ---------------------- * OPCLEAR * ---------------------- * CLEAR A WINDOW, OR ENTIRE SCREEN OPCLEAR MOVE.W D0,D1 BSR PUTLIN * FIRST DUMP BUFFER, IF NEEDED MOVE.W D1,D0 MOVE.W _cur_row,D2 * GET CURRENT CURSOR POSITION MOVE.W _cur_column,D3 SUBQ.W #1,D0 * WINDOW 1 ONLY? BEQ.S CLRX1 * YES ADDQ.W #1,D0 * WINDOW 0 ONLY? BEQ.S CLRX3 * YES ADDQ.W #1,D0 * ENTIRE SCREEN? BEQ.S CLRX2 * YES BRA.S CLRX5 * INVALID ARG, IGNORE IT CLRX1 CLR.W D0 * CLEAR WINDOW 1 MOVE.W _split_row,D1 TST.W WIND1(A6) * CURRENTLY IN WINDOW 1? BEQ.S CLRX4 * NO CLR.W D2 * YES, MOVE CURSOR TO TOP CORNER OF W1 CLR.W D3 BRA.S CLRX4 CLRX2 MOVEM.L D2-D3,-(SP) * CLEAR BOTH WINDOWS ... CLR.W D0 BSR OPSPLT * UNSPLIT THE SCREEN (IF NEEDED), FALL THRU MOVEM.L (SP)+,D2-D3 CLRX3 CLR.W LINES(A6) * >>> RESET THE W0 SCROLLING COUNTER <<< MOVE.W _split_row,D0 * CLEAR WINDOW 0 MOVE.W _rows,D1 TST.W WIND1(A6) * BUT CURRENTLY IN WINDOW 0? BNE.S CLRX4 * NO MOVE.W D0,D2 * YES, MOVE CURSOR TO TOP CORNER OF W0 MOVE.W _marg_left,D3 CMP.W D1,D2 * BUT MAKE SURE NOT OFF BOTTOM OF SCREEN! BLT.S CLRX4 MOVE.W D1,D2 SUBQ.W #1,D2 * DO THE CLEARING: FIRST ROW IN D0, LAST (+1) IN D1 CLRX4 MOVEM.L D2-D3,-(SP) * PRESERVE CURSOR REGS MOVE.L D1,-(SP) MOVE.L D0,-(SP) JSR _clear_lines * DO IT ADDQ.L #8,SP MOVEM.L (SP)+,D2-D3 MOVE.W D2,_cur_row * UPDATE CURSOR POSITION MOVE.W D3,_cur_column CLRX5 RTS * ---------------------- * OPERASE * ---------------------- * ERASE (CURRENT LINE, STARTING AT CURSOR) OPERASE SUBQ.W #1,D0 BNE.S ERASX1 * "IGNORE ARG IF NOT 1" BSR PUTLIN * FIRST DUMP BUFFER, IF NEEDED JSR _clear_eol ERASX1 RTS * ---------------------- * OPCURS * ---------------------- * SET CURSOR TO LINE INT1, COLUMN INT2 OPCURS MOVE.W D0,D2 * PROTECT THIS ARG BSR PUTLIN1 * EMPTY (& ZERO) BUFFER, IF NEEDED TST.W WIND1(A6) * CURRENTLY IN WINDOW 1? BNE.S CURSX1 * YES ADD.W _split_row,D2 * NO, MUST MAKE LINE RELATIVE TO WINDOW 0 CURSX1 SUBQ.W #1,D2 * MAKE LINE AND COLUMN ZERO-ORIGIN SUBQ.W #1,D1 MOVE.W D2,_cur_row * RESET THE GLOBALS MOVE.W D1,_cur_column RTS * ---------------------- * OPCURG * ---------------------- * GET CURSOR POSITION OPCURG BSR RELABS * TABLE FOR RETURN VALUES MOVE.L A0,A1 MOVE.W _cur_row,D0 ADDQ.W #1,D0 * LINE, MAKE ONE-ORIGIN 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 BSR PTAWRD * STORE AS Y VAL MOVE.W _cur_column,D0 ADDQ.W #1,D0 * COLUMN, MAKE ONE-ORIGIN MOVE.L A1,A0 ADDQ.L #2,A0 BRA PTAWRD * STORE AS X VAL * ---------------------- * OPATTR * ---------------------- * HIGHLIGHT (SET CHAR ATTRIBUTES) * [ ATARI ST ONLY: ITALICIZED OUTPUT REQUIRES EXTRA ROOM TO THE LEFT OF * THE FIRST CHARACTER, SO DISPLAY AN EXTRA SPACE. SEND IT THROUGH THE LINE * BUFFER HANDLER, TO ADJUST THE BUFFER'S CURRENT LENGTH TOO. * THE line_out ROUTINE HAS ADDITIONAL CODE TO AVOID DRAWING ITALICS * IN COLUMN 0. ] OPATTR CMPI.W #4,D0 * ENTERING ITALICS MODE? BNE.S ATTRX1 * NO TST.W VOCONS(A6) * SCREEN ON? BEQ.S ATTRX1 * NO MOVEQ #32,D0 * YES, PAD A SPACE BSR QDCHR * >>> TO SCREEN ONLY, NOT PRINTER ETC <<< MOVEQ #4,D0 * RESTORE MODE ATTRX1 MOVE.L D0,-(SP) BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD MODE) JSR _highlight * 1 INVERSE, 2 BOLD, 4 ITALIC (8 MONO) ADDQ.L #4,SP RTS * ---------------------- * OPFONT * ---------------------- OPFONT MOVE.W D0,D1 * NEW FONT NUMBER LEA _w1font,A1 TST.W WIND1(A6) * ARE WE IN WINDOW 1? BNE.S FONTX1 * YES LEA _w0font,A1 * NO, WINDOW 0 CMP.W (A1),D1 * >>> IS THE FONT REALLY CHANGING? <<< BEQ.S FONTX1 * NO, TAKE NO ACTION BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD FONT) FONTX1 MOVE.W (A1),D0 * RETURN OLD FONT NUMBER MOVE.W D1,(A1) * STORE NEW FONT NUMBER BRA PUTVAL * ---------------------- * OPCOLOR * ---------------------- OPCOLOR MOVE.W D0,D2 * PROTECT THIS ARG BSR PUTLIN * EMPTY THE LINE BUFFER EXT.L D1 MOVE.L D1,-(SP) * BACKGROUND EXT.L D2 MOVE.L D2,-(SP) * FOREGROUND JSR _op_color ADDQ.L #8,SP RTS * GET PICTURE INFO (SIZE) OPPICI EXG D0,D1 * TABLE OFFSET IN D0 BSR RELABS * ABSOLUTIZE MOVE.L A0,-(SP) EXT.L D1 * PICT ID MOVE.L D1,-(SP) JSR _op_picinf ADDQ.L #8,SP TST.W D0 BEQ PTRUE * ZERO MEANS OK BRA PFALSE * DISPLAY [OR CLEAR] A PICTURE OPDCLR MOVEQ #1,D3 * "CLEAR" FLAG ON BRA.S DISPX1 OPDISP MOVEQ #0,D3 * "CLEAR" FLAG OFF DISPX1 SUBQ.W #1,D1 * MAKE THE POSITIONS 0-ORIGIN SUBQ.W #1,D2 EXT.L D2 EXT.L D1 EXT.L D0 MOVE.L D3,-(SP) MOVE.L D2,-(SP) * Y POS MOVE.L D1,-(SP) * X POS MOVE.L D0,-(SP) * PICT ID (STILL 1-ORIGIN) JSR _op_display ADDA.W #16,SP RTS * SET MARGINS OPMARG MOVE.W D0,_marg_left * UPDATE DISPLAY VARS MOVE.W D1,_marg_right MOVE.L BUFFER(A6),A0 * ALSO UPDATE GAME VARS MOVE.W D0,PLMRG(A0) * (ST: 1 CHAR = 1 PIXEL UNIT) MOVE.W D1,PRMRG(A0) ** TST.W D0 ** BEQ.S MARGX1 MOVE.W D0,_cur_column * ADJUST CURSOR POSITION MARGX1 MOVE.W _columns,D2 SUB.W D0,D2 SUB.W D1,D2 * COMPUTE NEW LINE LENGTH MOVE.W D2,D0 MOVE.L DQUE(A6),A0 BRA SIZEQP * AND UPDATE WORD-WRAP PAGE * ---------------------------------------------------------------------------- * CONTROL OPERATIONS * ---------------------------------------------------------------------------- MAXLOCS EQU 15 * MAXIMUM LOCALS; VARS 16-255 ARE GLOBAL CVFLAG EQU $0100 * FLAG SET (HIGH BYTE) IF CALL RETURNS A VALUE * ---------------------- * OPICALL, ETC * ---------------------- * CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), NO RETURNED VALUE OPICAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP MOVE.W #1,(A0) * ONE ARG (THE FUNCTION) MOVE.W D0,ARG1(A0) OPICAL2 OPIXCAL OPICALL NOP * TELL CALLER TO USE ARGBLK MOVEQ #0,D3 * FLAG -- DON'T RETURN A VALUE BRA.S CALLX1 * ---------------------- * OPCALL, ETC * ---------------------- * CALL (A FUNCTION WITH OPTIONAL ARGUMENTS) OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP MOVE.W #1,(A0) * ONE ARG (THE FUNCTION) MOVE.W D0,ARG1(A0) OPCAL2 OPXCAL OPCALL NOP * TELL CALLER TO USE ARGBLK MOVE.W #CVFLAG,D3 * FLAG (HIGH BYTE) -- RETURN A VALUE *** COMMON ENTRY POINT, A0 -> ARGBLK, D3 (HIGH BYTE) = RETURN-VALUE FLAG CALLX1 MOVE.L A0,A2 MOVE.W (A2)+,D2 * ARG COUNT MOVE.W (A2)+,D0 * FUNCTION TO CALL -- IS IT ZERO? BNE.S CALLX2 * NO TST.W D3 * SPECIAL CASE -- RETURN A VALUE? BEQ.S CALLX9 * NO, JUST EXIT * CLR.W D0 * YES, RETURN A ZERO BRA PUTVAL *** BUILD A STACK FRAME, THEN UPDATE THE ZPC AND STATE VARS ... CALLX2 MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC MOVE.W ZPC2(A6),-(A4) MOVE.B NARGS+1(A6),D3 * SAVE OLD "OPTIONALS" COUNT ... MOVE.W D3,-(A4) * ALONG WITH /NEW/ RETURN FLAG * >>> old locs pointer (rel) now stacked as word, instead of long <<< * >>> new locs pointer now points to (pseudo) loc 0, instead of 1 <<< MOVE.L ZLOCS(A6),D1 * OLD LOCALS/FRAME POINTER SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT, IN CASE OF GAME SAVE MOVE.W D1,-(A4) * SAVE IT MOVE.L A4,ZLOCS(A6) * NEW LOCALS/FRAME POINTER SUBQ.W #1,D2 * NUMBER OF PARAMETERS ("OPTIONALS") MOVE.B D2,NARGS+1(A6) * REMEMBER IT (BYTE) BSR BSPLTQ * SPLIT THE FUNCTION POINTER (IN D0) MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC MOVE.W D1,ZPC2(A6) BSR NEWZPC * UPDATE ZPC STUFF *** GET FUNCTION HEADER BSR NXTBYT * TOTAL # DEFINED LOCALS MOVE.W D0,D1 CMPI.W #MAXLOCS,D1 * VALID? BLS.S CALLX3 LEA MSGCA1,A0 * TOO MANY LOCALS DEFINED BSR ZWARN * SHOW A WARNING MOVEQ #MAXLOCS,D1 * (CUT BACK -- CAN'T BE TOUCHED ANYWAY) CALLX3 CMP.W D2,D1 * VALID? BCC.S CALLX4 * BHS LEA MSGCA2,A0 * TOO MANY OPTIONALS SUPPLIED BSR ZWARN * SHOW A WARNING MOVE.W D1,D2 * (CUT BACK -- WON'T BE TOUCHED ANYWAY) CALLX4 SUB.W D2,D1 * THIS IS NUMBER OF "DEFAULT" VALUES BRA.S CALLX6 DATA MSGCA1 DC.B 'Bad loc num',0 MSGCA2 DC.B 'Bad optional num',0 TEXT *** BUILD & INITIALIZE A LOCALS FRAME ... CALLX5 MOVE.W (A2)+,-(A4) * POSITION THE OPTIONAL VALUES FIRST CALLX6 DBF D2,CALLX5 * ZERO CHECK -- ANY MORE? MOVEQ #0,D0 BRA.S CALLX8 CALLX7 MOVE.W D0,-(A4) * CLEAR THE REMAINING DEFAULT VALUES [XZIP] CALLX8 DBF D1,CALLX7 * ZERO CHECK -- ANY MORE? CALLX9 RTS * DONE * ---------------------- * OPASSN * ---------------------- * ASSIGNED? (A LOCAL AN OPTIONAL VALUE) OPASSN CMP.B NARGS+1(A6),D0 * WAS THIS LOCAL ASSIGNED A VALUE? BGT PFALSE * NO, VALUE DEFAULTED TO ZERO BRA PTRUE * YES * ---------------------- * OPRETU * ---------------------- * RETURN (FROM CURRENT FUNCTION CALL) OPRETU MOVE.L ZLOCS(A6),A4 * OLD TOP-OF-STACK MOVEQ #0,D1 MOVE.W (A4)+,D1 * RESTORE OLD LOCALS POINTER ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT MOVE.L D1,ZLOCS(A6) MOVE.W (A4)+,D2 * RESTORE RETURN FLAG, OPTS COUNT MOVE.B D2,NARGS+1(A6) MOVE.W (A4)+,ZPC2(A6) * RESTORE OLD ZPC MOVE.W (A4)+,ZPC1(A6) IFEQ EZIP BLT INRETU * SPECIAL INTERNAL CALL/RETURN, HANDLE IT ENDC MOVE.W D0,D1 * PROTECT VALUE (IF ANY -- XZIP) BSR NEWZPC * UPDATE ZPC STUFF MOVE.W D1,D0 ANDI.W #CVFLAG,D2 * WAS THIS A RETURN-VALUE CALL? (XZIP) BNE PUTVAL * YES, RETURN THE VALUE RTS * NO, JUST EXIT * ---------------------- * OPRTRU * ---------------------- * RTRUE OPRTRU MOVEQ #1,D0 * RETURN A "1" BRA.S OPRETU * ---------------------- * OPRFAL * ---------------------- * RFALSE OPRFAL CLR.W D0 * RETURN A "0" BRA.S OPRETU * ---------------------- * OPRSTA * ---------------------- * RSTACK (RETURN STACK) OPRSTA MOVE.W (A4)+,D0 * POP A VALUE BRA OPRETU * AND RETURN IT * ---------------------- * OPFSTA * ---------------------- * FSTACK (FLUSH A VALUE OFF THE STACK) *** DEAD -- XZIP * OPFSTA * ADDQ.L #2,A4 * FLUSH ONE WORD * RTS * ---------------------- * OPJUMP * ---------------------- * JUMP (TO A NEW LOCATION) OPJUMP SUBQ.W #2,D0 * ADJUST OFFSET ADD.W D0,ZPC2(A6) * ADD OFFSET TO CURRENT ZPC BRA NEWZPC * NORMALIZE IT & UPDATE ZPC STUFF * ---------------------- * OPNOOP * ---------------------- * NOOP (NO OPERATION) OPNOOP RTS * DO NOTHING * ---------------------- * OPCATCH * ---------------------- * CATCH OPCATCH MOVE.L ZLOCS(A6),D0 * THE CURRENT "FRAME POINTER" SUB.L STKBOT(A6),D0 * RELATIVIZE IT BRA PUTVAL * ---------------------- * OPTHROW * ---------------------- * THROW (NON-LOCAL RETURN) OPTHROW EXT.L D1 * A PREVIOUS FRAME PTR ADD.L STKBOT(A6),D1 * ABSOLUTIZE CMP.L ZLOCS(A6),D1 * VALID FRAME? BLT.S THRX1 * ERROR MOVE.L D1,ZLOCS(A6) * OK, FLUSH ANY INTERMEDIATE FRAMES BRA OPRETU * AND RETURN VAL (STILL IN D0) THRX1 CLR.W D0 LEA MSGTHR,A0 BRA FATAL DATA MSGTHR DC.B 'Bad Throw',0 TEXT * ---------------------- * INCALL * ---------------------- IFEQ EZIP * INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0 INCALL MOVEM.L D1-D7/A1-A3,-(SP) * SAVE EVERYTHING MOVE.W ZPC1(A6),-(SP) MOVE.W #-1,ZPC1(A6) * FAKE ZPC1, SIGNALS AN INTERNAL CALL/RETURN LEA ARGBLK(A6),A0 * SET UP ARGBLK FOR OPCALL MOVE.W D0,ARG1(A0) * FUNCTION TO CALL MOVE.W #1,(A0) * ONE ARG (FUNCTION ITSELF) BSR OPCALL * CALL THE TIMEOUT FUNCTION BRA NXTINS * GO EXECUTE IT * ---------------------- * INRETU * ---------------------- * JUMP BACK TO HERE UPON NEXT OPRETURN ... INRETU ADDQ.L #4,SP * CAREFUL -- FLUSH TOP RETURN ADDR (NXTINS) MOVE.W (SP)+,ZPC1(A6) * FIX THE ZPC MOVE.W D0,D1 BSR NEWZPC * RESTORE THE PROPER PAGE MOVE.W D1,D0 MOVEM.L (SP)+,D1-D7/A1-A3 RTS * RETURN TO ORIGINAL CALLER ENDC PAGE * ---------------------------------------------------------------------------- * GAME COMMANDS * ---------------------------------------------------------------------------- * ------------------------------ * PRIMITIVES FOR SAVE/RESTORE * ------------------------------ * SAVE STATE VARIABLES ON GAME STACK SAVSTA MOVE.W ZPC1(A6),-(A4) MOVE.W ZPC2(A6),-(A4) MOVE.L STKBOT(A6),A0 MOVE.L ZLOCS(A6),D0 * RELATIVIZE THIS ONE SUB.L A0,D0 MOVE.W D0,-(A4) MOVE.W ZORKID(A6),-(A4) MOVE.L A4,D0 SUB.L A0,D0 * RELATIVIZE GAME SP, TOO MOVE.W D0,(A0) * AND SAVE IT IN KNOWN LOCATION ADDA.W #8,A4 * RESET THE GAME SP RTS * RESTORE STATE VARIABLES FROM GAME STACK, RETURN ZORKID IN D0 AND FLAGS RESSTA MOVE.L STKBOT(A6),A0 MOVEQ #0,D0 MOVE.W (A0),D0 * RESTORE GAME SP FROM KNOWN LOCATION ADD.L A0,D0 * RE-ABSOLUTIZE IT MOVE.L D0,A4 MOVE.W (A4)+,-(SP) * GET THE SAVED ZORKID MOVEQ #0,D0 MOVE.W (A4)+,D0 * RESTORE OLD LOCALS POINTER ADD.L A0,D0 * RE-ABSOLUTIZE IT MOVE.L D0,ZLOCS(A6) MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF MOVE.W (A4)+,ZPC1(A6) MOVE.W (SP)+,D0 CMP.W ZORKID(A6),D0 * IS ID THE SAME AS OURS? RTS * (RETURN WITH FLAGS) * ---------------------- * OPISAV * ---------------------- * ISAVE (SAVE TO MEMORY BUFFER) OPISAV BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER BEQ SAVERR * ERROR, BUFFER DOESN'T EXIST MOVE.L STKBOT(A6),A0 MOVE.L D2,A1 MOVE.L #STKLEN,D0 BSR MOVMEM * SAVE THE STACK (FAST BLOCKMOVE) MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE MOVE.L D2,A1 ADDA.W #STKLEN,A1 * START WRITING AFTER STACK MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS BSR BLKBYT BSR MOVMEM * SAVE IMPURE DATA (FAST BLOCKMOVE) BRA SAVEOK * SUCCESS * ---------------------- * OPSAVE * ---------------------- PSNLEN EQU 32 * MAX LENGTH OF SUGGESTED NAME * SAVE (STATE OF GAME, OR SELECTED "PARTIAL" DATA) OPSAVE NOP TST.W (A0) * PARTIAL SAVE (ANY ARGS)? BEQ SVX2 * NO *** HANDLE A PARTIAL SAVE, A0 -> ARGBLK *** MOVE.L A0,A2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH BSR RELABS MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL MOVEQ #1,D0 * OPSAVE MOVEQ #1,D1 * PARTIAL BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE SVX14 * CANCELLED BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE) * WRITE SUGGESTED NAME TO FILE MOVEQ #0,D0 MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME MOVE.L A1,A0 * STARTS HERE (WITH LENGTH BYTE) BSR SFWRIT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE * WRITE DATA TO FILE MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE BSR RELABS * ABSOLUTIZE MOVEQ #PSNLEN,D0 * FILE OFFSET MOVEQ #0,D1 MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA BSR SFWRIT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE BSR DEFOLD * OK >>> BUT RESTORE "NORMAL" FILE NAMES <<< BRA SVX10 * AND CLEAN UP *** ENTER HERE FOR "STANDARD" SAVE *** SVX2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE MOVEQ #1,D0 * OPSAVE CLR.W D1 * STANDARD BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE SVX14 * CANCELLED BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE) * SAVE GAME STACK, THEN IMPURE PRELOAD BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK MOVE.L STKBOT(A6),A0 CLR.W D0 * THIS WILL BE BLOCK ZERO MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK BSR PTSBKS * WRITE IT OUT BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE MOVEQ #STKLEN/512,D0 * START WRITING AFTER STACK MOVE.W PURBOT(A6),D1 * NUMBER OF IMPURE BLOCKS BSR PTSBKS BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE * SAVE SUCCEEDED SVX10 BSR CLSSFL * SUCCESS, CLOSE THE FILE [NO ERRORS] BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES 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 BNE RESX12 * ERROR, CLOSE THE FILE BSR DEFOLD * OK >>> BUT RESTORE "NORMAL" FILE NAMES <<< BRA RESX10 * AND CLEAN UP *** ENTER HERE FOR "STANDARD" RESTORE *** RESX2 CLR.W D0 BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE * SKIP NEXT CALL IF DOING SPECIAL RESTORE DURING LAUNCH ... CLR.W D0 * RESTORE CLR.W D1 * STANDARD BSR GETSFL * GET A NAME FOR THE SAVE FILE BNE RESX13 * CANCELLED 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) MOVE.W PVERS1(A0),-(SP) * ALSO COLOR BIT MOVE.W PSCRWD(A0),-(SP) * AND SCREEN STUFF THAT SHOULDN'T CHANGE MOVE.W PHWRD(A0),-(SP) MOVE.W PVWRD(A0),-(SP) MOVE.W PFWRD(A0),-(SP) 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)+,PFWRD(A0) * BUT HANG ONTO SCREEN STUFF MOVE.W (SP)+,PVWRD(A0) MOVE.W (SP)+,PHWRD(A0) MOVE.W (SP)+,PSCRWD(A0) MOVE.W (SP)+,PVERS1(A0) * COLOR BIT MOVE.W (SP)+,PFLAGS(A0) * FLAGS (SCRIPT ETC) * RESTORE SUCCEEDED RESX10 BSR CLSSFL * CLOSE THE FILE BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * (1) MAKE SURE GAME DISK IS BACK IN DRIVE * A subtle bug was found in ZIP20 when certain calls that reset the game * state (the ZPC and stack) occurred during a timer interrupt. Since control * never returned to the code that caused the interrupt, the system (machine) * stack never got cleaned up. After several such calls it overflowed. * The questionable calls include (a successful) Restore or Irestore (Undo), * and Restart. The first two are handled here, the last elsewhere. RESTOK MOVE.L TOPSP(A6),SP * MAKE SURE THE SYSTEM STACK IS CLEAN PEA NXTINS * AND HACK IT SO WE WILL RETURN TO MAIN LOOP BSR NEWZPC * (2) GET THE PROPER ZPC PAGE MOVEQ #2,D0 * RETURN "RESTORE OK" BRA PUTVAL * SOMETHING WRONG, FAIL ... RESX12 BSR CLSSFL * CLOSE THE FILE RESX13 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES MOVEQ #1,D0 BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE RESERR CLR.W D0 * RETURN "RESTORE FAILED" BRA PUTVAL * FATAL ERROR: BAD ZORKID RESX14 MOVE.W D0,-(SP) BSR CLSSFL * CLOSE THE BAD FILE MOVE.W (SP)+,D0 * BAD VERSION ID RESX15 LEA MSGRE2,A0 BRA FATAL * 'Wrong save file version' DATA MSGRE2 DC.B 'Wrong save file version',0 TEXT * 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 TEXT * ---------------------- * OPRSTT * ---------------------- * RESTART (THE GAME) OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT CLR.W LINES(A6) * RESET THE [MORE] COUNTER TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN? BNE.S RSTTX1 * YES MOVEQ #1,D0 BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED) RSTTX1 JSR _clear_screen BRA RESTRT * SKIP MOST INITIALIZATIONS * ---------------------- * OPQUIT * ---------------------- * QUIT OPQUIT BRA FINISH * DIE PEACEFULLY * ---------------------- * OPVERI * ---------------------- * VERIFY (GAME FILE) OPVERI TST.W D7 * IFEQ CZIP * VERSION INFO FOR ZIP ONLY LEA MSGVER,A0 BSR OUTMSG0 * 'Atari ST interpreter version ' DATA MSGVER DC.B 'Atari ST interpreter version ',0 TEXT MOVE.W INTWRD,D0 * DISPLAY THE LETTER (LOW BYTE) BSR OPPRNC BSR OPCRLF ENDC TST.W SUBVER * DISPLAY SUB-VERSION ONLY IF NON-ZERO BEQ.S VERX0 LEA MSGVR2,A0 BSR OUTMSG0 * 'Sub-version ' DATA MSGVR2 DC.B 'Sub-version ',0 TEXT MOVE.W SUBVER,D0 * DISPLAY THE SUB-VERSION NUMBER BSR OPPRNN BSR OPCRLF VERX0 TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN? BNE.S VERX05 * YES MOVEQ #1,D0 BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED) VERX05 MOVE.L BUFFER(A6),A0 MOVE.W PLENTH(A0),D0 * GET LENGTH OF GAME FILE IFEQ EZIP BSR BSPLTQ ENDC IFEQ CZIP BSR BSPLIT ENDC MOVE.W D0,D4 * THIS IS FINAL BLOCK MOVE.W D1,D5 * FINAL BYTE CLR.W D0 * STARTING BLOCK NUMBER MOVEQ #64,D1 * STARTING BYTE NUMBER CLR.W D3 * CHECKSUM HERE MOVE.W ENDLOD(A6),-(SP) CLR.W ENDLOD(A6) * FORCE LOADING FROM DISK VERX1 BSR GETBYT * GET NEXT BYTE ADD.W D2,D3 * ADD IN TO CHECKSUM CMP.W D0,D4 * DONE YET? BNE VERX1 * NO CMP.W D1,D5 * MAYBE BNE VERX1 * NO MOVE.W (SP)+,ENDLOD(A6) * YES, RESTORE PROPER ENDLOD MOVE.L BUFFER(A6),A0 MOVE.W PCHKSM(A0),D0 * GET THE REAL CHECKSUM CMP.W D0,D3 BNE.S VERX2 * ERROR BRA PTRUE * SUCCESS VERX2 BRA PFALSE * FAILURE * ---------------------- * OPORIG * ---------------------- * ORIGINAL (NOT A COPY) GAME DISK? OPORIG BRA PTRUE * NO COPY-PROTECTION, SO ALWAYS TRUE PAGE * --------------------------------------------------------------------------- * MAIN LOOP, DISPATCHING * --------------------------------------------------------------------------- * OPERATORS WHICH ACCEPT A VARIABLE NUMBER OF ARGUMENTS (OPQEQU, OPCALL, ETC) * ARE IDENTIFIED BY AN INITIAL NOP. THEIR ARGUMENTS ARE PASSED IN AN ARGUMENT * BLOCK, WITH THE NUMBER OF ARGUMENTS AS THE FIRST ENTRY. ALL OTHER OPERATORS * RECEIVE THEIR ARGUMENTS IN REGISTERS. NOOP EQU $4E71 * MARKS ROUTINES WHICH TAKE OPTIONAL ARGS *** Alternate NXTINS dispatch mechanism. Would require that all entries in *** dispatch table (ZIPOPS) be relative to ZIPOPS. *** LEA ZIPOPS,A1 *** MOVE.W xxxOPS-ZIPOPS(A1,D0.W),D2 * GET THE OPx ROUTINE OFFSET *** JSR 0(A1,D2.W) * CALL THE OPERATOR ROUTINE *** BRA NXTINS * ---------------------- * NXTINS * ---------------------- NXTINS BSR GAMINT * CHECK FOR GAME INTERRUPT (SOUND, ETC) BSR NXTBYT * GET THE NEXT INSTRUCTION BYTE IFEQ DEBUG BSR DBTEST ENDC CMPI.B #$80,D0 * IS IT A 2 OP? BCS NXT2 * BLO * YES CMPI.B #$B0,D0 * IS IT A 1 OP? BCS NXT1 * BLO * YES CMPI.B #$C0,D0 * IS IT A 0 OP? BCC NXT4 * BHS * NO, MUST BE AN EXTENDED OP *** HANDLE A ZERO-OP NXT0 CMPI.B #190,D0 * SPECIAL "EXTOP" OPCODE? BEQ.S N0X1 * YES ANDI.W #$0F,D0 * 0 OP, EXTRACT OPERATOR CODE, "xxxx oooo" ADD.W D0,D0 * WORD OFFSET LEA ZEROPS,A1 MOVE.W 0(A1,D0.W),D2 * GET THE OPx ROUTINE OFFSET LEA ZBASE,A1 JSR 0(A1,D2.W) * CALL THE OPERATOR ROUTINE BRA NXTINS N0X1 BSR NXTBYT * NEXT BYTE IS SPECIAL "EXTOP" ANDI.W #$3F,D0 * EXTRACT OPERATOR CODE, "xxoo oooo" MOVEQ #64,D2 * MAXIMUM 2OPS/XOPS ADD.W D0,D2 * ADJUST OPCODE INTO "EXTOP" RANGE BRA NXT4A * THEN HANDLE AS AN XOP *** HANDLE A ONE-OP NXT1 MOVE.W D0,D2 * 1 OP, MAKE A COPY, "xxmm oooo" ANDI.W #$0F,D2 * EXTRACT OPERATOR CODE ADD.W D2,D2 * WORD OFFSET LSR.W #4,D0 * EXTRACT MODE BITS ANDI.W #3,D0 BSR GETARG * GET THE ARGUMENT LEA ONEOPS,A1 MOVE.W 0(A1,D2.W),D2 * GET THE OPx ROUTINE OFFSET LEA ZBASE,A1 JSR 0(A1,D2.W) * CALL THE OPERATOR ROUTINE BRA NXTINS *** HANDLE A TWO-OP NXT2 MOVE.W D0,D2 * 2 OP, MAKE A COPY, "xmmo oooo" MOVEQ #1,D0 * ASSUME FIRST ARG IS AN IMMEDIATE BTST #6,D2 * IS IT INSTEAD A VARIABLE? BEQ.S N2X1 * NO MOVEQ #2,D0 * YES, CHANGE MODE N2X1 BSR GETARG * GET THE FIRST ARG MOVE.W D0,D1 MOVEQ #1,D0 * ASSUME SECOND ARG IS AN IMMEDIATE BTST #5,D2 * IS IT INSTEAD A VAR? BEQ.S N2X2 * NO MOVEQ #2,D0 * YES, CHANGE MODE N2X2 BSR GETARG * GET THE SECOND ARG EXG D0,D1 * POSITION THE ARGS ANDI.W #$1F,D2 * EXTRACT OPERATOR CODE ADD.W D2,D2 * WORD OFFSET LEA TWOOPS,A1 MOVE.W 0(A1,D2.W),D2 * GET THE OPx ROUTINE OFFSET LEA ZBASE,A1 LEA 0(A1,D2.W),A1 * CALCULATE THE OPx ROUTINE ADDRESS CMPI.W #NOOP,(A1) * BUT DOES THE OPERATOR EXPECT AN ARGBLK? BNE.S N2X3 * NO LEA ARGBLK+6(A6),A0 * YES, MOVE ARGS TO ARGBLK MOVE.W D1,-(A0) MOVE.W D0,-(A0) MOVE.W #2,-(A0) * ALWAYS 2 ARGS N2X3 JSR (A1) * CALL THE OPERATOR ROUTINE BRA NXTINS *** HANDLE AN EXTENDED-OP ... NXT4 MOVE.W D0,D2 * EXTENDED OP, SAVE A COPY, "xxoo oooo" ANDI.W #$3F,D2 * EXTRACT OPERATOR CODE CMPI.B #236,D0 * IS THIS AN XCALL ($EC)? BEQ.S N4X1 * YES CMPI.B #250,D0 * IS THIS AN IXCALL ($FA)? BNE.S NXT4A * NO * GET THE 4 (OR 8) MODE SPECIFIERS, EXTRACT AND STACK THEM ... N4X1 MOVEQ #8,D3 * SPECIAL XOP, 8 MODE SPECIFIERS BSR NXTBYT * GET THE FIRST MODE BYTE, "aabb ccdd" MOVE.W D0,D1 BSR NXTBYT * GET THE SECOND MODE BYTE, "eeff gghh" MOVE.W D0,-(SP) * SAVE hh LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE gg LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE ff LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE ee MOVE.W D1,D0 BRA.S N4X2 * ENTRY POINT TO DECODE SPECIAL "EXTOP" * D2 = STRIPPED OPCODE (MAY BE 64+) NXT4A MOVEQ #4,D3 * 4 MODE SPECIFIERS BSR NXTBYT * GET THE MODE BYTE, "aabb ccdd" N4X2 MOVE.W D0,-(SP) * SAVE dd LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE cc LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE bb LSR.W #2,D0 MOVE.W D0,-(SP) * SAVE aa * DECODE ARGUMENTS, STORE IN ARGBLK CLR.W D4 * KEEP A COUNT OF ACTUAL ARGUMENTS LEA ARGBLK+2(A6),A1 * ARGUMENT BLOCK, SKIP OVER COUNT SLOT N4X3 MOVE.W (SP)+,D0 * POP NEXT MODE SPECIFIER ANDI.W #3,D0 * EXTRACT MODE BITS CMPI.W #3,D0 * ARE THERE ANY MORE ARGUMENTS? BEQ.S N4X4 * NO ADDQ.W #1,D4 * YES, COUNT THIS ONE BSR GETARG * DECODE AND FETCH IT MOVE.W D0,(A1)+ * STORE IT IN ARGUMENT BLOCK SUBQ.W #1,D3 * GO FOR MORE BNE N4X3 BRA.S N4X5 N4X4 SUBQ.W #1,D3 * NUMBER OF EXTRA MODE SPECIFIERS ADD.W D3,D3 ADDA.W D3,SP * FLUSH THEM N4X5 LEA ARGBLK(A6),A0 * PASS ARGBLK POINTER TO THE OPERATOR HERE ... MOVE.W D4,(A0) * STORE NUMBER OF ARGUMENTS * CALCULATE THE OPERATOR ROUTINE ADDRESS ADD.W D2,D2 * WORD OFFSET LEA EXTOPS,A1 MOVE.W 0(A1,D2.W),D2 * GET THE OPx ROUTINE OFFSET LEA ZBASE,A1 LEA 0(A1,D2.W),A1 * CALCULATE THE OPx ROUTINE ADDRESS CMPI.W #NOOP,(A1) * BUT DOES THE OPERATOR EXPECT AN ARGBLK? BEQ.S N4X6 * YES ADDQ.L #2,A0 * NO, PASS ARGS IN REGISTERS MOVE.W (A0)+,D0 MOVE.W (A0)+,D1 MOVE.W (A0)+,D2 MOVE.W (A0)+,D3 * MAXIMUM OF FOUR N4X6 JSR (A1) * CALL THE OPERATOR ROUTINE BRA NXTINS * ---------------------- * SETDEF * ---------------------- * SET UP DEFAULT ARGS IN ARGBLK[], USING VALUES FROM DEFBLK[] * CALLED BY INDIVIDUAL OPERATORS, SINCE DEFAULT COUNT/VALUES MAY VARY * CALLED AT BEGINNING OF OPS, SO NEED NOT SAVE REGISTERS * GIVEN A0 -> ARGBLK, A1 -> DEFBLK, (A1) = MAX ARGS, RETURN A0 -> ARGBLK SETDEF MOVE.L A0,A2 MOVE.W (A0)+,D0 * ACTUAL # ARGS PASSED (REQS PLUS OPTS) MOVE.W (A1)+,D1 * MAX # ARGS POSSIBLE SUB.W D0,D1 * DIFFERENCE IS # DEFAULTS TO SET BLE.S SDFX4 * NONE ADD.W D0,D0 * SKIP THIS MANY BYTES ADDA.W D0,A0 ADDA.W D0,A1 SDFX2 MOVE.W (A1)+,(A0)+ * COPY A DEFAULT VALUE SUBQ.W #1,D1 BNE.S SDFX2 SDFX4 MOVE.L A2,A0 * RETURN ARGBLK PTR INTACT RTS PAGE * --------------------------------------------------------------------------- * DISPATCH TABLES * --------------------------------------------------------------------------- * UNIMPLEMENTED OPCODES DISPATCH TO HERE ... OPERR CLR.W D0 LEA MSGBAD,A0 BRA FATAL * 'Bad operation' DATA MSGBAD DC.B 'Bad operation',0 TEXT DATA ZEROPS DC.W OPRTRU-ZBASE * 176 DC.W OPRFAL-ZBASE * 177 DC.W OPPRNI-ZBASE * 178 DC.W OPPRNR-ZBASE * 179 DC.W OPNOOP-ZBASE * 180 DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPRSTT-ZBASE * 183 DC.W OPRSTA-ZBASE * 184 DC.W OPCATCH-ZBASE * 185 XZIP DC.W OPQUIT-ZBASE * 186 DC.W OPCRLF-ZBASE * 187 DC.W OPUSL-ZBASE * 188 DC.W OPVERI-ZBASE * 189 DC.W OPERR-ZBASE * 190 XZIP ("EXTOP") DC.W OPORIG-ZBASE * 191 XZIP ONEOPS DC.W OPQZER-ZBASE * 128 DC.W OPQNEX-ZBASE * 129 DC.W OPQFIR-ZBASE * 130 DC.W OPLOC-ZBASE * 131 DC.W OPPTSI-ZBASE * 132 DC.W OPINC-ZBASE * 133 DC.W OPDEC-ZBASE * 134 DC.W OPPRNB-ZBASE * 135 DC.W OPCAL1-ZBASE * 136 EZIP DC.W OPREMO-ZBASE * 137 DC.W OPPRND-ZBASE * 138 DC.W OPRETU-ZBASE * 139 DC.W OPJUMP-ZBASE * 140 DC.W OPPRIN-ZBASE * 141 DC.W OPVALU-ZBASE * 142 DC.W OPICAL1-ZBASE * 143 XZIP TWOOPS: EXTOPS: DC.W OPERR-ZBASE * 0 (OR 192+0) DC.W OPQEQU-ZBASE * 1 DC.W OPQLES-ZBASE * 2 DC.W OPQGRT-ZBASE * 3 DC.W OPQDLE-ZBASE * 4 DC.W OPQIGR-ZBASE * 5 DC.W OPQIN-ZBASE * 6 DC.W OPBTST-ZBASE * 7 DC.W OPBOR-ZBASE * 8 DC.W OPBAND-ZBASE * 9 DC.W OPQFSE-ZBASE * 10 DC.W OPFSET-ZBASE * 11 DC.W OPFCLE-ZBASE * 12 DC.W OPSET-ZBASE * 13 DC.W OPMOVE-ZBASE * 14 DC.W OPGET-ZBASE * 15 DC.W OPGETB-ZBASE * 16 DC.W OPGETP-ZBASE * 17 DC.W OPGTPT-ZBASE * 18 DC.W OPNEXT-ZBASE * 19 DC.W OPADD-ZBASE * 20 DC.W OPSUB-ZBASE * 21 DC.W OPMUL-ZBASE * 22 DC.W OPDIV-ZBASE * 23 DC.W OPMOD-ZBASE * 24 DC.W OPCAL2-ZBASE * 25 EZIP DC.W OPICAL2-ZBASE * 26 XZIP DC.W OPCOLOR-ZBASE * 27 XZIP DC.W OPTHROW-ZBASE * 28 XZIP DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPCALL-ZBASE * 224 (192+32) DC.W OPPUT-ZBASE * 225 DC.W OPPUTB-ZBASE * 226 DC.W OPPUTP-ZBASE * 227 DC.W OPREAD-ZBASE * 228 DC.W OPPRNC-ZBASE * 229 DC.W OPPRNN-ZBASE * 230 DC.W OPRAND-ZBASE * 231 DC.W OPPUSH-ZBASE * 232 DC.W OPPOP-ZBASE * 233 DC.W OPSPLT-ZBASE * 234 DC.W OPSCRN-ZBASE * 235 DC.W OPXCAL-ZBASE * 236 EZIP DC.W OPCLEAR-ZBASE * 237 EZIP DC.W OPERASE-ZBASE * 238 EZIP DC.W OPCURS-ZBASE * 239 EZIP DC.W OPCURG-ZBASE * 240 XZIP DC.W OPATTR-ZBASE * 241 EZIP DC.W OPBUFO-ZBASE * 242 EZIP DC.W OPDIRO-ZBASE * 243 EZIP DC.W OPDIRI-ZBASE * 244 EZIP DC.W OPSOUND-ZBASE * 245 EZIP DC.W OPINPUT-ZBASE * 246 EZIP DC.W OPINTBL-ZBASE * 247 EZIP DC.W OPBCOM-ZBASE * 248 XZIP DC.W OPICALL-ZBASE * 249 XZIP DC.W OPIXCAL-ZBASE * 250 XZIP DC.W OPLEX-ZBASE * 251 XZIP DC.W OPZWSTR-ZBASE * 252 XZIP DC.W OPCOPYT-ZBASE * 253 XZIP DC.W OPPRNT-ZBASE * 254 XZIP DC.W OPASSN-ZBASE * 255 XZIP * "EXTOPS" (XZIP) DC.W OPSAVE-ZBASE * 256 (192+64) DC.W OPREST-ZBASE * 257 DC.W OPSHIFT-ZBASE * 258 XZIP DC.W OPASHIFT-ZBASE * 259 XZIP DC.W OPFONT-ZBASE * 260 XZIP DC.W OPDISP-ZBASE * 261 XZIP DC.W OPPICI-ZBASE * 262 XZIP DC.W OPDCLR-ZBASE * 263 XZIP DC.W OPMARG-ZBASE * 264 XZIP DC.W OPISAV-ZBASE * 265 XZIP DC.W OPIRES-ZBASE * 266 XZIP TEXT