* --------------------------------------------------------------------------- * 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 MOVE.L D0,D7 * >> QUICK & DIRTY DEBUGGING << IF DEBUG THEN BSR RUNDB ENDIF 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" SWAP D7 * >> #190 IN HIGH WORD << MOVE.W D0,D7 * >> QUICK & DIRTY DEBUGGING << 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 MOVE.W (A1),D0 CMPI.W #NOOP,D0 * ARGBLK EXPECTED? BEQ.S N4X6 * YES * THIS WORKS AS LONG AS NO ROUTINE EVER BEGINS WITH "ORI.B"! CMPI.W #4,D0 * ARGBLK EXPECTED /AND/ DEFAULTS DEFINED? BLS.S N4X5A * 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 BRA.S N4X6 N4X5A BSR SETDEF * GET DEFAULTS; ADVANCE A1 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, A1 -> END OF DEFBLK SETDEF MOVE.L A0,A2 MOVE.W (A0)+,D0 * ACTUAL # ARGS PASSED (REQS PLUS OPTS) MOVE.W (A1)+,D1 * MAX # ARGS POSSIBLE MOVE.L A1,A3 ADD.W D1,D1 ADDA.W D1,A3 * SAVE PTR TO END OF DEFBLK ADD.W D0,D0 SUB.W D0,D1 * DIFFERENCE IS # DEFAULTS TO SET (x2) BLE.S SDFX4 * NONE ADDA.W D0,A0 * SKIP OVER ACTUAL ARGS ADDA.W D0,A1 SDFX2 MOVE.W (A1)+,(A0)+ * COPY DEFAULT VALS SUBQ.W #2,D1 BNE.S SDFX2 SDFX4 MOVE.L A2,A0 * RETURN ARGBLK PTR INTACT MOVE.L A3,A1 * RETURN PTR PAST DEFBLK RTS * ------------------------------------------------------------------ * ZIP DEBUGGING * ------------------------------------------------------------------ * NOTE: THIS STUFF SHOULD BE INCLUDED ONLY DURING DEVELOPMENT IF DEBUG THEN * ---------------------- * INITDB * ---------------------- * INIT SOME DEBUGGING VARS INITDB LEA DBQUE(A6),A0 MOVE.L A0,DBQPTR(A6) * INIT PTR, BASE OF QUEUE ADDA.W #DBQLEN,A0 MOVE.L A0,DBQEND(A6) * INIT PTR, END OF QUEUE RTS * ---------------------- * RUNDB * ---------------------- * STORE THE CURRENT OPCODE IN THE INSTRUCTION HISTORY QUEUE * GIVEN D0.B = OPCODE, RETURN D0.B UNCHANGED (CAN TRASH OTHER REGS) * [NEEDS SOME WORK; NEVER SEES EXTENSION (256+) OPCODES] * [HOW ABOUT STORING AN ARGBLK TOO] RUNDB MOVE.L DBQPTR(A6),A1 MOVE.B D0,(A1)+ * STORE IT CMPA.L DBQEND(A6),A1 * PAST THE END? BLT.S RDBX1 * NO LEA DBQUE(A6),A1 * YES, WRAP AROUND TO BEGINNING RDBX1 MOVE.L A1,DBQPTR(A6) * UPDATE ROVING PTR * VIRTUAL BREAKPOINTS: HALT WHEN ONE OF THE FOLLOWING OCCURS: * () ZPC POINTS TO A GIVEN INSTRUCTION (NOT IMPLEMENTED) * () ZPC REACHES A GIVEN ADDRESS (NOT IMPLEMENTED) * () A GIVEN NUMBER OF INSTRUCTIONS HAVE BEEN EXECUTED MOVE.L DBITOT(A6),D1 * RUNNING TOTAL CMP.L DBIBRK(A6),D1 * REACHED REQUESTED TOTAL? BNE.S RDBX2 * NO * HANDLE BREAKPOINT * NOTE: AN AUTOMATIC BREAK OCCURS BEFORE THE ZERO'TH INSTRUCTION NOP * >>> SET MACHINE BP HERE <<< RDBX2 ADDQ.L #1,D1 MOVE.L D1,DBITOT(A6) * BUMP RUNNING TOTAL RTS ENDIF * END OF CONDITIONAL ASSEMBLY EJECT ; 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 CODE 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 OPHLIGHT-ZBASE * 241 EZIP [WAS OPATTR] 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 DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPWPOS-ZBASE * 272 YZIP DC.W OPWSIZ-ZBASE * 273 YZIP DC.W OPWATTR-ZBASE * 274 YZIP DC.W OPWGET-ZBASE * 275 YZIP DC.W OPSCROLL-ZBASE * 276 YZIP DC.W OPFSTA-ZBASE * 277 YZIP DC.W OPMSINFO-ZBASE * 278 YZIP DC.W OPMSLMT-ZBASE * 279 YZIP DC.W OPXPUSH-ZBASE * 280 YZIP DC.W OPWPUT-ZBASE * 281 YZIP DC.W OPPRNF-ZBASE * 282 YZIP DC.W OPMENU-ZBASE * 283 YZIP DC.W OPPICSET-ZBASE * 284 YZIP DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE DC.W OPERR-ZBASE CODE EJECT ; PAGE * ---------------------------------------------------------------------------- * STRING FUNCTIONS * ---------------------------------------------------------------------------- * ZSTR CHARACTER CONVERSION VECTOR DATA ZCHRS DC.B 'abcdefghijklmnopqrstuvwxyz' * CHAR SET 1 DC.B 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' * CHAR SET 2 DC.B ' 0123456789.,!?_#' * CHAR SET 3 DC.B $27,$22 * <'>,<"> DC.B '/\-:()' DC.B 0 * ASCIZ CODE * ---------------------- * PUTSTR * ---------------------- * OUTPUT A ZSTR, BLOCK-POINTER IN D0, BYTE-POINTER IN D1 * RETURN UPDATED POINTER PUTSTR MOVEM.L D2-D5,-(SP) CLR.W D4 * TEMP CS STARTS AT 0 CLR.W D5 * PERM CS STARTS AT 0 PSX1 BSR GETWRD * GET NEXT STRING WORD MOVEM.W D0-D2,-(SP) * SAVE POINTER & COPY OF STRING WORD MOVEQ #2,D3 * 3 BYTES IN WORD PSX2 MOVE.W D2,-(SP) * PUSH CURRENT BYTE ASR.W #5,D2 * SHIFT TO NEXT BYTE DBF D3,PSX2 * LOOP UNTIL DONE MOVEQ #2,D3 * RETRIEVE THE 3 BYTES ... PSX3 MOVE.W (SP)+,D2 * GET NEXT BYTE ANDI.W #$001F,D2 * CLEAR UNWANTED BITS TST.W D4 * IN WORD MODE? (NEGATIVE D4) BPL.S PSX4 * NO ADD.W D2,D2 * YES, CALCULATE WORD OFFSET MOVE.L WRDTAB(A6),A0 * GET WORD TABLE POINTER ADD.W WRDOFF(A6),D2 * USE PROPER 32 WORD BLOCK ADDA.W D2,A0 * INDEX INTO WORD TABLE BSR GTAWRD * GET A POINTER TO THE WORD ITSELF BSR BSPLIT * SPLIT IT BSR PUTSTR * AND PRINT IT BRA PSX15 * CONTINUE WHERE WE LEFT OFF WITH TEMP CS RESET PSX4 CMPI.W #3,D4 * CS 3 (ASCII MODE) SELECTED? BLT.S PSX6 * NO, NORMAL CS BGT.S PSX5 * NO, BUT WE'RE ALREADY IN ASCII MODE BSET #14,D4 * YES (MAKE D4 LARGE POSITIVE) MOVE.B D2,D4 * SAVE HIGH-ORDER ASCII BITS (2) HERE BRA.S PSX16 * AND GO GET NEXT BYTE PSX5 ANDI.W #$0003,D4 * EXTRACT PREVIOUSLY SAVED HIGH-ORDER BITS ASL.W #5,D4 * POSITION THEM OR.W D2,D4 * OR IN LOW-ORDER BITS MOVE.W D4,D0 BRA.S PSX14 * GO PRINT THE CHARACTER PSX6 CMPI.W #6,D2 * SPECIAL CODE (0 TO 5)? BLT.S PSX9 * YES, SPACE, WORD, OR SHIFT CMPI.W #2,D4 * MIGHT ALSO BE SPECIAL IF IN CS 2 BNE.S PSX8 * BUT WE'RE NOT CMPI.W #7,D2 * CS 2, SPECIAL CODE FOR CRLF? BEQ.S PSX7 * YES BGT.S PSX8 * NO, NOT ASCII MODE, EITHER? ADDQ.W #1,D4 * YES IT IS, SWITCH TO ASCII MODE (CS 3) BRA.S PSX16 * AND GO GET NEXT BYTE PSX7 BSR PUTNEW * CRLF REQUESTED, DO A NEWLINE BRA.S PSX15 PSX8 MOVE.W D4,D1 * NORMAL CHARACTER, GET CS MULU #26,D1 * CALCULATE OFFSET FOR THIS CS ADD.W D2,D1 * ADD IN CHARACTER OFFSET (+6) LEA ZCHRS,A0 MOVE.B -6(A0,D1.W),D0 * GET THE CHARACTER FROM CONVERSION VECTOR BRA.S PSX14 * GO PRINT IT PSX9 TST.W D2 * IS IT A SPACE? BNE.S PSX10 * NO MOVEQ #32,D0 * YES, GO PRINT A SPACE BRA.S PSX14 PSX10 CMPI.W #3,D2 * IS IT A WORD? BGT.S PSX11 * NO, MUST BE A SHIFT BSET #15,D4 * SWITCH TO WORD MODE (NEG D4) FOR NEXT BYTE SUBQ.W #1,D2 * CALCULATE WORD-TABLE BLOCK OFFSET ASL.W #6,D2 * 64 BYTES IN A BLOCK MOVE.W D2,WRDOFF(A6) * SAVE IT AND LOOP BRA.S PSX16 PSX11 SUBQ.W #3,D2 * CALCULATE NEW CS TST.W D4 * TEMPORARY SHIFT (FROM CS 0)? BNE.S PSX12 * NO MOVE.W D2,D4 * YES, JUST SAVE NEW TEMP CS BRA.S PSX16 PSX12 CMP.W D2,D4 * IS THIS THE CURRENT CS? BEQ.S PSX13 * YES, DO A PERM SHIFT TO IT CLR.W D4 * OTHERWISE, PERM SHIFT TO CS 0 PSX13 MOVE.W D4,D5 * TEMP AND PERM CS'S ARE THE SAME NOW BRA.S PSX16 PSX14 BSR PUTCHR * OUTPUT THE CHARACTER PSX15 MOVE.W D5,D4 * RESET TEMP CS TO PERM CS PSX16 DBF D3,PSX3 * LOOP FOR NEXT BYTE MOVEM.W (SP)+,D0-D2 * RESTORE POINTERS & ORIGINAL STRING WORD TST.W D2 * END-OF-STRING (HIGH BIT SET)? BPL PSX1 * NO, GO GET NEXT WORD MOVEM.L (SP)+,D2-D5 * YES, CLEAN UP & RETURN UPDATED POINTER RTS * ---------------------- * CHRCS * ---------------------- * [DEAD/MERGED WITH CHRBYT, TO SUPPORT CUSTOM PCHRSET'S] * GIVEN AN ASCII CHARACTER IN D0, RETURN THE CHARACTER SET # IN D0 *CHRCS *** TST.B D0 * IS THIS A NULL? [CALLER ENSURES IT'S NOT] *** BNE.S CHRCX1 * NO *** MOVEQ #3,D0 * YES, RETURN DUMMY CS NUMBER *** BRA.S CHRCX4 * *CHRCX1 CMPI.B #'a',D0 * LOWERCASE CHAR? * BLT.S CHRCX2 * NO * CMPI.B #'z',D0 * BGT.S CHRCX2 * NO * CLR.W D0 * YES, RETURN CS 0 * BRA.S CHRCX4 * *CHRCX2 CMPI.B #'A',D0 * UPPERCASE CHAR? * BLT.S CHRCX3 * NO * CMPI.B #'Z',D0 * BGT.S CHRCX3 * NO * MOVEQ #1,D0 * YES, RETURN CS 1 * BRA.S CHRCX4 * *CHRCX3 MOVEQ #2,D0 * OTHERWISE CALL IT CS 2 *CHRCX4 RTS * ---------------------- * CHRBYT * ---------------------- * GIVEN AN ASCII CHARACTER IN D0 * RETURN D0 HIGH = ZSTR BYTE VALUE (6 TO 31, OR 0), D0 LOW = ZCHARSET (0,1,2) CHRBYT MOVE.L D1,-(SP) LEA ZCHRS,A0 * POINT TO CONVERSION VECTOR CHRBX2 MOVE.B (A0)+,D1 * END OF VECTOR (NULL)? BEQ.S CHRBX8 * YES CMP.B D1,D0 * FOUND THE CHARACTER? BNE.S CHRBX2 * NO, LOOP MOVE.L A0,D0 * YES, CALCULATE OFFSET OF CHAR INTO VECTOR LEA ZCHRS,A0 SUB.L A0,D0 ADDQ.W #5,D0 * ADJUST OFFSET SO FIRST CHAR IS 6 MOVEQ #0,D1 * ASSUME CS0 CHRBX4 CMPI.W #32,D0 * IN BASE CODE RANGE (6-31)? BLT.S CHRBX9 * YES SUBI.W #26,D0 * SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE ADDQ.W #1,D1 * AND BUMP CS BRA CHRBX4 CHRBX8 CLR.W D0 * RETURN ZERO IF NOT FOUND MOVEQ #2,D1 * AND CALL IT CS2 (!) CHRBX9 SWAP D0 * RETURN ZCHAR IN HIGH WORD MOVE.W D1,D0 * AND CHARSET IN LOW MOVE.L (SP)+,D1 RTS * ---------------------- * ZWORD * ---------------------- * GIVEN UP TO 6 (EZIP 9) ASCIZ CHARACTERS, BUFFER POINTER IN A1, * CONVERT THEM TO A TWO (EZIP THREE) WORD ZSTR, BUFFER POINTER IN A0 PADCHR EQU 5 * ZSTR PADDING CHAR (SHIFT 2) ZWORD MOVEM.L D1-D2/A2,-(SP) MOVE.L A0,A2 MOVE.W #VCHARS,D2 * NUMBER OF PACKED CHARS IN A ZSTR (6 OR 9) ZWX1 CLR.W D1 MOVE.B (A1)+,D1 * GET NEXT CHARACTER, END-OF-STRING? BEQ.S ZWX4 * YES MOVE.W D1,D0 *** BSR CHRCS * FIND THE CS NUMBER FOR THIS CHAR BSR CHRBYT * FIND CS NUMBER & BYTE VAL TST.W D0 * CS 0? BEQ.S ZWX2 * YES ADDQ.W #3,D0 * NO, CALCULATE TEMP SHIFT BYTE MOVE.W D0,-(SP) * SAVE THE SHIFT BYTE SUBQ.W #1,D2 * REDUCE BYTE COUNT, DONE YET? BEQ.S ZWX6 * YES ZWX2 SWAP D0 *** MOVE.W D1,D0 *** BSR CHRBYT * FIND THE PROPER BYTE VALUE FOR THIS CHAR TST.W D0 * IN NORMAL CS'S? BNE.S ZWX3 * YES MOVEQ #6,D0 * NO, USE ASCII SHIFT MOVE.W D0,-(SP) SUBQ.W #1,D2 * DONE YET? BEQ.S ZWX6 * YES MOVE.W D1,D0 * NO, SAVE HIGH-ORDER ASCII BITS (3) ASR.W #5,D0 MOVE.W D0,-(SP) SUBQ.W #1,D2 * DONE YET? BEQ.S ZWX6 * YES MOVE.W D1,D0 * NO, SAVE LOW-ORDER ASCII BITS (5) ANDI.W #$001F,D0 ZWX3 MOVE.W D0,-(SP) * SAVE THIS BYTE SUBQ.W #1,D2 * AND LOOP UNTIL ZWORD FULL BNE ZWX1 BRA.S ZWX6 ZWX4 MOVE.W #PADCHR,-(SP) * END OF STRING, SAVE A PAD BYTE SUBQ.W #1,D2 * LOOP UNTIL ZSTR FULL BNE ZWX4 *** BUILD A ZSTR FROM THE SAVED BYTES ... ZWX6 MOVE.W #VCHARS*2,D2 * 6 OR 9 CHARS (WORDS) ON STACK MOVE.L SP,A0 * DON'T DISTURB SP YET (IN CASE OF INTERRUPTS) ADDA.W D2,A0 MOVE.W #VCHARS/3,D1 * 2 OR 3 TIMES THROUGH LOOP ZWX7 MOVE.W -(A0),D0 ASL.W #5,D0 OR.W -(A0),D0 ASL.W #5,D0 OR.W -(A0),D0 MOVE.W D0,(A2)+ * STORE A PACKED ZWORD IN RETURN BUFFER SUBQ.W #1,D1 BNE ZWX7 * GO FOR NEXT BSET #7,-2(A2) * SET HIGH-ORDER BIT IN LAST WORD OF ZWORD ADDA.W D2,SP * AND FLUSH THE STACK MOVEM.L (SP)+,D1-D2/A2 RTS EJECT ; PAGE *-------------------------------------------------------------------------- * GENERALIZED OUTPUT FOLDING ROUTINE *-------------------------------------------------------------------------- * ---------------------- * INITQP * ---------------------- * ALLOCATE AND INITIALIZE A QUEUE PARAMETER BLOCK, * D1 IS MAXIMUM SIZE OF BUFFER (IN BYTES), D2 IS INITIAL UNIT SIZE * A1 -> LINE OUTPUT FUNCTION, A2 -> UNIT SIZE FUNCTION * RETURN A0 -> PARAMETER BLOCK INITQP MOVEQ #QPLEN,D0 EXT.L D1 ADD.L D1,D0 * TOTAL SPACE TO ALLOCATE *** BSR GETMEM * GET IT BSR GETMEMC * GET IT & CLEAR IT (RETURN A0 -> PARAM BLK) MOVEQ #QPLEN,D0 ADD.L A0,D0 * LINE BUFFER STARTS HERE MOVE.L D0,BUFPTR(A0) MOVE.L D0,NXTPTR(A0) * ALSO CURRENT POINTER ADD.L D1,D0 MOVE.L D0,ENDPTR(A0) * (PHYSICALLY) ENDS HERE MOVE.L A1,OUTFUN(A0) * INITIALIZE LINE OUTPUT FUNCTION MOVE.L A2,SIZFUN(A0) * INITIALIZE CHAR SIZE FUNCTION *** CLR.W CURSIZ(A0) * ALWAYS EMPTY INITIALLY *** CLR.B DUMPED(A0) * THIS ONE IS SET ONLY BY PUTLIN *** CLR.B INUSE(A0) * [RE]-ENTRANCY FLAG MOVE.W D2,D0 * UNIT CAPACITY OF BUFFER ... [FALL THRU] * CHANGE THE LINE WRAP POINT, A0 -> PARAMETER BLOCK, DO = NEW LENGTH (UNITS) * RETURN A0 -> PARAMETER BLOCK SIZEQP *** IN THE FUTURE, IF EXTRA ROOM IS NEEDED FOR ITALICS, CALLER SHOULD *** (TEMPORARILY) INCREMENT CURSIZ. MUST LEAVE BUFSIZ AT MAX SO BUFFERING *** CAN WORK CORRECTLY IN SCREEN 1, IF USED. (For example, printing 80 *** inverse spaces to frame the status line.) *** SUBQ.W #XCHAR,D0 * >>> ALLOW FOR ATARI ITALICS HACK <<< *** >>> CANCEL THE ABOVE <<<. FOR MAC, SEVERAL CHARS (r, 4, ^, f) "KERN" *** TO RIGHT. LAST CHAR IN A LINE MUST NEVER KERN OUTSIDE WINDOW. *** (WHICH SUGGESTS ANOTHER POSSIBLE FIX: CHECK KERNING FOR EVERY LAST CHAR.) SUBQ.W #1,D0 * SEEMS TO BE 1 PIXEL MAX (GENEVA 9, 12) MOVE.W D0,BUFSIZ(A0) * STORE IT RTS * ---------------------- * QUECHR * ---------------------- * NOTE: THESE VALUES ARE OK FOR BOTH PROPORTIONAL (SCREEN) * AND MONO (SCRIPTING) FONTS TAB2SP EQU 4 * 4 SPACES AT START-OF-PARAGRAPH EOS2SP EQU 2 * 2 SPACES AT END-OF-SENTENCE * QUEUE THE CHAR IN D0 FOR OUTPUT, A0 -> QUEUE-PARAMETERS BLOCK QUECHR TST.B INUSE(A0) * ATTEMPT TO RE-ENTER? (E.G. CR INTERRUPT) BNE QCX10 * YES, NOT SUPPORTED, JUST EXIT MOVE.B #1,INUSE(A0) * "ENTER" * [ENTER HERE TO AVOID RE-ENTRANCY CHECK] QUECHR1 MOVEM.L D4/A1-A4,-(SP) MOVE.W D0,D4 * MOVE PARAMS TO A4/D4 MOVE.L A0,A4 * CHECK FOR SPECIAL FORMATTING CHARS CMPI.B #9,D4 * TAB? BEQ.S QCX0A * YES CMPI.B #11,D4 * END-OF-SENTENCE? BNE.S QCX1 * NO * HANDLE AN EOS MOVEQ #EOS2SP,D4 * GET EXPANDED SP COUNT MOVEQ #32,D0 MOVE.L SIZFUN(A4),A0 JSR (A0) * GET UNIT SIZE OF NEW CHAR MULS D4,D0 * CALC EXPANDED UNIT SIZE ADD.W CURSIZ(A4),D0 * [TAKING INTO ACCOUNT THE NEW STR] CMP.W BUFSIZ(A4),D0 * BUFFER (LOGICALLY) FULL YET? BGT QCX1C * YES, GO TO NEXT LINE [NO SPACES] * (SHOULD PROBABLY CHECK PHYSICAL ROOM ALSO) BRA.S QCX0B * NO, PRINT SPACES * HANDLE A TAB QCX0A MOVEQ #1,D4 TST.W CURSIZ(A4) * ARE WE AT START OF LINE? BNE.S QCX0B * NO, MAP TAB TO SINGLE SPACE MOVEQ #TAB2SP,D4 * YES, GET EXPANDED SP COUNT * RECURSIVELY PRINT SPACES, D4.W = COUNT QCX0B MOVEQ #32,D0 MOVE.L A4,A0 BSR QUECHR1 * PRINT ONE SP SUBQ.W #1,D4 BGT.S QCX0B * AND LOOP BRA QCX9 * DONE * [HANDLING OF NORMAL CHARS STARTS HERE] QCX1 MOVE.L SIZFUN(A4),A0 JSR (A0) * GET UNIT SIZE OF NEW CHAR SWAP D4 MOVE.W D0,D4 * AND SAVE IN D4-HIGH SWAP D4 * NOTE: FOR PROPORTIONAL FONTS, NEED /TWO/ FULLNESS TESTS HERE: * LOGICALLY FULL (UNITS) - WRAP WORDS, ADD CR * PHYSICALLY FULL (BYTES) - [OUGHT NOT TO ADD CR] *** MOVE.W CURSIZ(A4),D0 ADD.W CURSIZ(A4),D0 * [TAKING INTO ACCOUNT THE NEW CHAR] CMP.W BUFSIZ(A4),D0 * BUFFER (LOGICALLY) FULL YET? *** BGE.S QCX1B BGT.S QCX1B * YES MOVE.L NXTPTR(A4),A0 CMP.L ENDPTR(A4),A0 * BUFFER (PHYSICALLY) FULL YET? ("iiiii...") BLT QCX8 * NO QCX1B CMPI.B #32,D4 * YES, BUT DID A SPACE CAUSE OVERFLOW? BNE.S QCX2 * NO QCX1C MOVE.L NXTPTR(A4),D0 * YES, JUST PRINT THE WHOLE BUFFER MOVE.L BUFPTR(A4),A0 MOVE.L OUTFUN(A4),A3 JSR (A3) CLR.W CURSIZ(A4) * RESET LENGTH COUNTER MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CURRENT CHAR POINTER CLR.B DUMPED(A4) * STARTING A FRESH LINE BRA.S QCX9 * EXIT, IGNORING SPACE * FOLDING ROUTINE, SEARCH FOR MOST-RECENT SPACE ... QCX2 MOVE.L BUFPTR(A4),A1 * BEGINNING OF BUFFER MOVE.L NXTPTR(A4),A2 * END OF BUFFER (+1) BRA.S QCX2B * ALLOW FOR EMPTY [DUMPED] BUFFER QCX2A CMPI.B #32,-(A2) * SEARCH FOR SPACE BACKWARDS FROM END BEQ.S QCX4 * FOUND ONE QCX2B CMPA.L A1,A2 * REACHED BEGINNING OF BUFFER? BGT QCX2A * NOT YET * NO SPACES FOUND, DUMP WHOLE BUFFER ... QCX3 TST.B DUMPED(A4) * BUT WAS THIS BUFFER ALREADY PARTLY EMPTIED? BNE.S QCX5 * YES, CARRY EVERYTHING OVER TO NEXT LINE MOVE.L NXTPTR(A4),A2 * OTHERWISE, OUTPUT EVERYTHING BRA.S QCX5 * SPACE WAS FOUND, DUMP THE BUFFER (THROUGH SPACE) ... QCX4 MOVE.L A2,A0 * POINTER TO THE SPACE ADDQ.L #1,A2 * POINTER PAST THE SPACE CMPA.L A1,A0 * DEGENERATE CASE WITH SPACE AT BUFPTR? BEQ QCX3 * YES, OUTPUT WHOLE LINE QCX5 MOVE.L A2,D0 * LAST CHAR TO PRINT (+1) MOVE.L A1,A0 * START OF BUFFER MOVE.L OUTFUN(A4),A3 * GO DUMP IT, ADDING A CR JSR (A3) * SHIFT ANY REMAINING CHARS TO FRONT OF BUFFER ... CLR.W CURSIZ(A4) * ZERO THE UNIT COUNT CLR.B DUMPED(A4) * START WITH A FRESH BUFFER BRA.S QCX7 QCX6 MOVE.B (A2)+,D0 MOVE.B D0,(A1)+ * COPY NEXT CHAR TO BEGINNING OF BUF MOVE.L SIZFUN(A4),A0 * CHAR STILL IN D0 JSR (A0) ADD.W D0,CURSIZ(A4) * UPDATE THE UNIT COUNT QCX7 CMPA.L NXTPTR(A4),A2 * ANY MORE CHARS AFTER SPACE? BLT QCX6 * YES MOVE.L A1,NXTPTR(A4) * NO, STORE NEW CURRENT POINTER HERE * FINALLY, STORE THE NEW CHAR AND EXIT ... QCX8 MOVE.L NXTPTR(A4),A0 MOVE.B D4,(A0)+ * STORE THE NEW CHARACTER IN BUFFER MOVE.L A0,NXTPTR(A4) * AND UPDATE POINTER SWAP D4 * (UNIT SIZE SAVED IN D4-HIGH) ADD.W D4,CURSIZ(A4) * UPDATE COUNTER QCX9 CLR.B INUSE(A4) * "EXIT" MOVEM.L (SP)+,D4/A1-A4 QCX10 RTS *-------------------------------------------------------------------------- * MAIN OUTPUT HANDLER *-------------------------------------------------------------------------- * !ALL! OUTPUT GENERATED BY THE GAME (AND THE USER) SHOULD BE CHANNELED * THROUGH THE FOLLOWING TWO ROUTINES, WHICH REDIRECT IT APPROPRIATELY. * ---------------------- * PUTNEW * ---------------------- * OUTPUT A NEWLINE PUTNEW MOVEQ #13,D0 * JUST FALL THROUGH WITH A CR * ---------------------- * PUTCHR * ---------------------- * OUTPUT THE CHAR IN D0 (TO THE REQUESTED DEVICES) PUTCHR *** FOR YZIP, WE PASS TABS THROUGH ... * CMPI.B #9,D0 * TAB? (OLD ZORK BUG, DISPLAYS GARBAGE) * BNE.S PCX1 * MOVEQ #32,D0 * YES, MAP TO A SPACE * PCX1 NOP * *** STATUS LINE OUTPUT (ZIP INTERNAL FUNCTION ONLY) ... IF CZIP THEN TST.W VOSTAT(A6) * SPECIAL OUTPUT TO SL HANDLER? BNE PUTSL * YES (ABORT PUTCHR) ENDIF *** TABLE OUTPUT ... IF EZIP THEN TST.W VOTABL(A6) * TABLE OUTPUT? BNE TABCHR * YES (ABORT PUTCHR PER "DIROUT" SPEC) ENDIF MOVE.W D0,-(SP) * OTHERWISE, SAVE THE CHAR HERE *** SCRIPT (BEFORE SCREEN, SO "OPEN" ERROR DISPLAYS IN CORRECT SEQUENCE) IF EZIP THEN TST.W VOPRNT(A6) * [GLOBAL] SCRIPTING ACTIVE? ENDIF IF CZIP THEN BSR TSTSCR * CHECK FOR SCRIPTING REQUEST -- ACTIVE? ENDIF BEQ.S PCX2 * NO *** MOVEQ #WFSCRP,D0 * [CHECKED IN SCRCHR -- MOVE HERE INSTEAD?] *** BSR TSTWFLG * SCRIPTING ACTIVE IN /CURRENT/ WINDOW? *** BEQ.S PCX2 * NO MOVE.W (SP),D0 * SCRIPT THIS CHAR BSR SCRCHR *** SCREEN DISPLAY ... PCX2 TST.W VOCONS(A6) * CONSOLE OUTPUT ACTIVE? BEQ.S PCX3 * NO MOVE.W (SP),D0 * YES, DISPLAY THE CHAR BSR QDCHR *** FILE OUTPUT ... PCX3 * NOP * NOT IMPLEMENTED TST.W (SP)+ * FLUSH CHAR FROM STACK RTS *-------------------------------------------------------------------------- * TERMINAL DISPLAY FUNCTIONS *-------------------------------------------------------------------------- * ---------------------- * QDCHR * ---------------------- * QUEUE/DISPLAY THE CHAR IN D0 QDCHR TST.W VOBUFF(A6) * IS BUFFERING TURNED OFF? BEQ OUTCHR * YES, GO TO SCREEN (THIS HANDLES CR'S ALSO) CMPI.B #13,D0 * CR? BEQ NEWLIN * YES, DUMP THE BUFFER MOVE.L DQUE(A6),A0 * OTHERWISE, GO QUEUE IT BRA QUECHR * ---------------------- * NEWLIN * ---------------------- * GO TO NEW LINE, OUTPUTTING CURRENT BUFFER * (THIS ROUTINE NOW CALLED ONLY FROM THE PRECEEDING ROUTINE) NEWLIN MOVE.L A4,-(SP) MOVE.L DQUE(A6),A4 * SCREEN BUFFER * PREVENT RE-ENTRANCY [E.G. DURING A CR INTERRUPT] TST.B INUSE(A4) * ATTEMPT TO RE-ENTER? BNE.S NWLNX2 * YES, NOT SUPPORTED, JUST EXIT MOVE.B #1,INUSE(A4) * "ENTER" MOVE.L BUFPTR(A4),A0 * START OF LINE MOVE.L NXTPTR(A4),D0 * END OF CURRENT LINE BSR LINOUT * CHECK "MORE", OUTPUT LINE, ADD A CR MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CHARACTER POINTER CLR.W CURSIZ(A4) * RESET UNIT COUNT CLR.B DUMPED(A4) * NO OUTPUT ON NEW LINE YET CLR.B INUSE(A4) * "EXIT" NWLNX2 MOVE.L (SP)+,A4 RTS * ---------------------- * PUTLIN * ---------------------- * OUTPUT CURRENT BUFFER, WITHOUT A NEWLINE * (ASSUMES SOMETHING LIKE OPREAD WILL SUPPLY THE NEWLINE) PUTLIN1 MOVE.L DQUE(A6),A0 CLR.W CURSIZ(A0) * RESET UNIT COUNT (BUFFER EMPTY) * ENTER HERE IF BUFFERING WILL LATER RESUME FROM CURRENT POINT PUTLIN MOVE.L A4,-(SP) MOVE.L DQUE(A6),A4 * SCREEN BUFFER * CHECK FOR RE-ENTRANCY [E.G. DURING A CR INTERRUPT] TST.B INUSE(A4) * ATTEMPT TO RE-ENTER? BNE.S PTLNX2 * YES, NOT SUPPORTED, JUST EXIT MOVE.B #1,INUSE(A4) * "ENTER" MOVE.L BUFPTR(A4),A0 * START OF LINE MOVE.L NXTPTR(A4),D0 * END OF CURRENT LINE CMP.L A0,D0 BEQ.S PTLNX1 * SKIP IF EMPTY BSR BUFOUT * OUTPUT IT (NO CR, BUT DOES CHECK [MORE]) MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CHARACTER POINTER PTLNX1 MOVE.B #1,DUMPED(A4) * REMEMBER BUFFER IS PARTLY DUMPED CLR.B INUSE(A4) * "EXIT" PTLNX2 MOVE.L (SP)+,A4 RTS *-------------------------------------------------------------------------- * SCRIPT BUFFERING *-------------------------------------------------------------------------- * ---------------------- * SCRCHR * ---------------------- * /ALL/ SCRIPT OUTPUT IS CHANNELED THROUGH HERE * QUEUE THE CHAR IN D0 FOR SCRIPTING SCRCHR MOVEM.W D0,-(SP) MOVEQ #WFSCRP,D0 BSR TSTWFLG * SCRIPTING ACTIVE IN /CURRENT/ WINDOW? MOVEM.W (SP)+,D0 * [RESTORE CHAR, BUT DON'T DISTURB FLAGS] BNE.S SCRCX1 * YES RTS * NO, EXIT SCRCX1 CMPI.B #13,D0 * CR? BEQ.S SCRLIN * YES, DUMP SCRIPT BUFFER MOVE.L SQUE(A6),A0 * SCRIPTING PARAMETERS BLOCK BRA QUECHR * GO QUEUE CHAR * GOT A NEWLINE -- SCRIPT THE CURRENT BUFFER SCRLIN MOVE.L A4,-(SP) MOVE.L SQUE(A6),A4 * SCRIPTING PARAMETERS BLOCK MOVE.L BUFPTR(A4),A0 * START OF LINE MOVE.L NXTPTR(A4),D0 * END OF CURRENT LINE BSR SCROUT * OUTPUT LINE, ADD A CR ... MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CHARACTER POINTER CLR.W CURSIZ(A4) * RESET UNIT COUNT MOVE.L (SP)+,A4 RTS * ---------------------- * SCRINP * ---------------------- * OUTPUT A USER INPUT LINE TO THE TRANSCRIPT (IF SCRIPTING) * START IN A0, LENGTH IN D0, FLAG IN D1 (NONZERO) FOR CR SCRINP MOVEM.L A2/D2,-(SP) MOVE.L A0,A2 * PROTECT ARGS MOVE.W D0,D2 IF EZIP THEN TST.W VOPRNT(A6) * SCRIPTING? ENDIF IF CZIP THEN BSR TSTSCR * CHECK FOR SCRIPT REQUEST -- ACTIVE? ENDIF BEQ.S SCRIX3 * NO, EXIT TST.W D2 * LENGTH OF INPUT BEQ.S SCRIX2 * ZERO, JUST DO THE CR SCRIX1 MOVE.B (A2)+,D0 * SCRIPT NEXT CHAR BSR SCRCHR * (USE BUFFERING, SO WRAP IS CORRECT) SUBQ.W #1,D2 BNE.S SCRIX1 SCRIX2 TST.W D1 * CR REQUESTED? BEQ.S SCRIX3 * NO MOVEQ #13,D0 * YES, ADD THE CR BSR SCRCHR SCRIX3 MOVEM.L (SP)+,D2/A2 RTS * ---------------------- * SCRNAM * ---------------------- * ECHO THE SAVE/RESTORE FILENAME TO THE TRANSCRIPT (IF SCRIPTING) * (USER SELECTED IT THRU A SPECIAL DIALOG) SCRNAM MOVE.L D1,-(SP) LEA MSGSCN,A0 * 'File: ' BSR STRLEN * LEAVE LENGTH OF STRING IN D0 CLR.W D1 * NO CR YET BSR SCRINP DATA MSGSCN DC.B 'File: ',0 * (PHRASE OKAY FOR SAVE & RESTORE) CODE LEA filename,A0 * SIMPLE NAME (NO DISK/PATH SPEC) MOVEQ #0,D0 MOVE.B (A0)+,D0 * LENGTH [MAC PASCAL FORMAT] MOVEQ #1,D1 * END WITH CR BSR SCRINP MOVE.L (SP)+,D1 RTS EJECT ; PAGE * ---------------------------------------------------------------------------- * PAGING ROUTINES * ---------------------------------------------------------------------------- * ---------------------- * NEWZPC * ---------------------- * NORMALIZE ZPC & (IF NECESSARY) GET PROPER PAGE NEWZPC MOVE.W ZPC2(A6),D0 * LOW ORDER ZPC ASR.W #8,D0 * EXTRACT REQUIRED BLOCK ADJUSTMENT (+ OR -) ASR.W #1,D0 ADD.W D0,ZPC1(A6) * AND ADJUST HIGH ORDER ZPC ANDI.W #$01FF,ZPC2(A6) * NORMALIZE LOW ORDER ZPC * GET THE INDICATED PAGE MOVE.W ZPC1(A6),D0 CMP.W CURBLK(A6),D0 * HAS THE BLOCK CHANGED? BEQ.S NZX4 * NO, EXIT MOVE.W D0,CURBLK(A6) * YES, REMEMBER NEW BLOCK TST.L CURTAB(A6) * IS OLD PAGE PRELOADED? BEQ.S NZX2 * YES MOVE.L CURTAB(A6),A0 * NO, RESTORE CURRENT REF TIME FOR OLD PAGE MOVE.L RTIME(A6),2(A0) NZX2 CMP.W ENDLOD(A6),D0 * IS NEW PAGE PRELOADED? BLT.S NZX3 * YES BSR GETPAG * NO, GET THE NEW PAGE MOVE.L A0,CURPAG(A6) * REMEMBER NEW PAGE POINTER MOVE.L LPTAB(A6),A0 * GET NEW TABLE POINTER MOVE.L A0,CURTAB(A6) * SAVE THIS POINTER FOR LATER MOVEQ #-1,D0 MOVE.L D0,2(A0) * FAKE A HIGH RTIME TO PROTECT ZPC PAGE FOR US BRA.S NZX4 NZX3 BSR BLKBYT * CALCULATE PRELOAD PAGE ADDRESS ADD.L BUFFER(A6),D0 * ABSOLUTIZE MOVE.L D0,CURPAG(A6) * REMEMBER NEW PAGE POINTER CLR.L CURTAB(A6) * ZERO TABLE POINTER MEANS PAGE IS PRELOADED NZX4 RTS * ---------------------- * GETPAG * ---------------------- * GET THE PAGE WHOSE NUMBER IS IN D0, RETURN A POINTER TO IT IN A0 GETPAG CMP.W LPAGE(A6),D0 * IS THIS THE SAME PAGE AS LAST REFERENCED? BEQ.S GPX4 * YES, RETURN ITS LOCATION MOVE.W D0,LPAGE(A6) * SAVE NEW PAGE NUMBER ADDQ.L #1,RTIME(A6) * UPDATE REFERENCE COUNT MOVE.L PAGTAB(A6),A0 * PAGE INFORMATION TABLE GPX1 CMP.W (A0),D0 * SEARCH FOR DESIRED BLOCK BNE.S GPX3 * NOT IT CMP.W CURBLK(A6),D0 * FOUND IT, BUT IS IT THE CURRENT ZPC PAGE? BEQ.S GPX2 * YES, DON'T TOUCH REF TIME (PAGE IS PROTECTED) MOVE.L RTIME(A6),2(A0) * NO, UPDATE ITS REFERENCE TIME GPX2 MOVE.L A0,LPTAB(A6) * SAVE THE TABLE POINTER MOVE.L A0,D0 SUB.L PAGTAB(A6),D0 * BUFFER NUMBER x8 ASL.L #6,D0 * CALCULATE CORE ADDRESS OF PAGE ADD.L PAGES(A6),D0 MOVE.L D0,LPLOC(A6) * SAVE IT BRA.S GPX4 * AND RETURN IT GPX3 ADDQ.L #8,A0 * SKIP OVER REFERENCE TIME, ETC. CMPI.W #-1,(A0) * END OF TABLE? BNE GPX1 * NO, CONTINUE SEARCH * DESIRED PAGE NOT RESIDENT, MUST READ IT FROM DISK MOVE.L A1,-(SP) BSR FINDPG * FIND AN OLD PAGE MOVE.L A0,LPLOC(A6) * SAVE ITS PAGE POINTER MOVE.L A1,LPTAB(A6) * SAVE ITS PAGTAB POINTER MOVE.W LPAGE(A6),D0 * NEW PAGE NUMBER FOR GETBLK MOVE.W D0,(A1)+ * SAVE PAGE NUMBER IN FIRST SLOT MOVE.L RTIME(A6),(A1) * SAVE CURRENT REF TIME BSR GETBLK * GET THE BLOCK MOVE.L (SP)+,A1 * CLEAN UP GPX4 MOVE.L LPLOC(A6),A0 * RETURN THE PAGE POINTER RTS * ---------------------- * FINDPG * ---------------------- * FIND A GOOD (LRU) PAGE, RETURN PAGE POINTER IN A0 & PAGTAB POINTER IN A1 FINDPG MOVE.L PAGTAB(A6),A0 ADDQ.L #2,A0 * SKIP OVER FIRST PAGE NUMBER MOVEQ #-1,D0 * FAKE A BEST-CASE REFERENCE COUNT FDPGX1 CMP.L (A0),D0 * COMPARE PREV OLDEST REF TIME WITH THIS ONE BLS.S FDPGX2 * STILL THE OLDEST MOVE.L (A0),D0 * NEW OLDEST, SAVE THIS REFERENCE COUNT MOVE.L A0,A1 * AND PAGTAB LOCATION (+2) FDPGX2 ADDQ.L #6,A0 * SKIP OVER REF TIME, ETC. CMPI.W #-1,(A0)+ * END OF TABLE? BNE FDPGX1 * NO SUBQ.L #2,A1 * RETURN THE PAGTAB LOCATION HERE MOVE.L A1,D0 SUB.L PAGTAB(A6),D0 * BUFFER NUMBER x8 ASL.L #6,D0 * CALCULATE CORE ADDRESS OF PAGE ADD.L PAGES(A6),D0 MOVE.L D0,A0 * AND RETURN IT HERE RTS EJECT ; PAGE *-------------------------------------------------------------------------- * I/O (/NOT/ MACHINE DEPENDENT) *-------------------------------------------------------------------------- * ---------------------- * INCHR * ---------------------- * INPUT A CHAR AND ECHO IT, RETURN CHAR IN D0 *** DEAD, USE READLN *** * [CAREFUL WITH CR AND BACKSPACE] *INCHR BSR TTYIN * GET CHAR * TST.W VIECHO(A6) * IS ECHOING TURNED OFF? * BEQ.S INCHX1 * YES, JUST EXIT * * MOVE.W D0,-(SP) * BSR TTYOUT * ECHO CHAR * MOVE.W (SP)+,D0 *INCHX1 RTS * ---------------------- * CRCHECK * ---------------------- * XZIP: WE'RE ABOUT TO OUTPUT A CR; CHECK FOR A SPECIAL INTERRUPT * NOTE: DURING A CR INTERRUPT, THE GAME SHOULD NEVER TRY TO DO ANY OUTPUT. * THIS IS BECAUSE THE OUTPUT ROUTINES WE ARE /CURRENTLY/ INTERRUPTING ARE NOT * REENTRANT! NOTE THAT A GAME MIGHT DO SOMETHING THAT, IN MAC YZIP, * INDIRECTLY CAUSES OUTPUT BY FLUSHING THE BUFFER (SUCH AS READING THE CURSOR * POSITION). THE 'INUSE' FLAG TRIES TO FIX THIS. CRCHECK * XZIP: CHECK LOWCORE GLOBALS * [DEAD: PCRCNT WAS HERE FOR BACK COMPATIBILITY (YZIPTEST)] * [YZIP: LOWCORE SLOT NOW USED BY DIROUT/TWID] * MOVE.L BUFFER(A6),A0 * MOVE.L A0,D0 * VALID? (MIGHT BE AN INIT ERROR) * BEQ.S CRCHX9 * TST.W PCRCNT(A0) * CR COUNTER ACTIVE? * BEQ.S CRCHX2 * NO * SUBQ.W #1,PCRCNT(A0) * YES, DECREMENT IT; REACHED ZERO? * BNE.S CRCHX9 * NO * MOVE.W PCRFUNC(A0),D0 * YES: FUNCTION TO CALL * BRA.S CRCHX4 * YZIP: CHECK CURRENT WINDOW RECORD CRCHX2 MOVE.L CURWP(A6),A0 MOVE.L A0,D0 * VALID? (MIGHT BE AN INIT ERROR) BEQ.S CRCHX9 TST.W WCRCNT(A0) * CR COUNTER ACTIVE? BEQ.S CRCHX9 * NO SUBQ.W #1,WCRCNT(A0) * YES, DECREMENT IT; REACHED ZERO? BNE.S CRCHX9 * NO MOVE.W WCRINT(A0),D0 * YES: FUNCTION TO CALL * AN INTERRUPT IS REQUESTED; INTERNALLY CALL THE INTERRUPT FUNCTION. * Problem: register A4, dedicated to the game SP, is needed for this call * but is NOT currently valid. That's because some of the I/O handlers * "borrow" it, assuming that such an value would never be needed during I/O. * [Probably a good reason to avoid dedicating any other registers.] CRCHX4 MOVE.L A4,-(SP) MOVE.W VOBUFF(A6),-(SP) CLR.W VOBUFF(A6) * MAKE SURE BUFFERING OFF (NOT RE-ENTRANT!) MOVE.L STKBOT(A6),A4 * FAKE A SMALL GAME STACK ADDA.W #100,A4 * AT THE BOTTOM OF THE REAL ONE BSR INCALL * AND HANDLE THE INTERRUPT MOVE.W (SP)+,VOBUFF(A6) MOVE.L (SP)+,A4 CRCHX9 RTS * ---------------------- * NXTLIN * ---------------------- * CHECK FOR END-OF-PAGE CONDITION NXTLIN MOVEM.L D1-D3/A1,-(SP) MOVE.L CURWP(A6),A0 MOVE.W WYSIZE(A0),D0 * VERTICAL WINDOW SIZE (IN PIX) MOVEQ #0,D2 MOVE.B WFONTYX(A0),D2 * VERTICAL LINE SIZE (IN PIX) * ALGORITHM: IF (WSIZ-LSIZ) - LCNT < LSIZ THEN PAUSE, WRITE [MORE] *** SUBQ.W #1,D0 SUB.W D2,D0 * RESERVE ONE LINE FOR [MORE] ITSELF BLE.S NXTLX6 * DEGENERATE WINDOW (0+ LINES), DON'T PAUSE CMP.W D2,D0 BLT.S NXTLX6 * TINY WINDOW (1+ LINES), SKIP ALSO ("SHOGUN") MOVE.W WLCNT(A0),D1 MULU D2,D1 * CONVERT LINES -> PIX SUB.W D1,D0 CMP.W D2,D0 * PAGE FULL YET? BGE.S NXTLX6 * NO, EXIT *** MOVE.W _v_italic,-(SP) * SAVE ITALICS STATUS HERE *** TST.W (SP) * CURRENTLY IN ITALIC MODE? *** BEQ.S NXTLX1 * NO *** CLR.L -(SP) * YES, SWITCH TO NORMAL FOR [MORE] *** JSR _highlight * 0 NORMAL, 4 ITALIC *** ADDQ.L #4,SP *** NXTLX1 MOVEQ #0,D0 MOVEQ #0,D1 BSR SETMENU * MAKE SURE GAME MENUS DISABLED MOVEM.W D0-D1,-(SP) * REMEMBER OLD FLAGS BSR GETCURS1 * [DON'T TRY TO FLUSH BUFFER!] MOVEM.W D0-D1,-(SP) * REMEMBER INITIAL POSITION LEA MSGMOR,A0 * DISPLAY A PROMPT (NO CR) MOVEQ #6,D0 BSR MDPRINT * WRITE DIRECTLY TO SCREEN DATA MSGMOR DC.B '[MORE]',0 CODE MOVE.W MSWIND(A6),D3 * SAVE THIS TEMPORARILY MOVE.W #-1,MSWIND(A6) * ENSURE THAT MOUSECLICKS UNPAUSE US, TOO MOVE.L BUFFER(A6),A1 MOVE.W PLCTBL(A1),-(SP) CLR.W PLCTBL(A1) * BUT DON'T STORE MOUSECLICK COORDS! BSR TTYIN * WAIT FOR A KEY, NO ECHO MOVE.W (SP)+,PLCTBL(A1) MOVE.W D3,MSWIND(A6) * MOVEQ #6,D1 * PROMPT LENGTH *NXTLX2 MOVEQ #8,D0 * BSR TTYOUT * BACKUP CURSOR >> ASSUMES MONOFONT <<< * SUBQ.W #1,D1 * BNE.S NXTLX2 BSR GETCURS1 MOVE.W D1,D3 * "END-OF-MORE" COL [RELATIVE] MOVEM.W (SP)+,D0-D1 * BEGINNING COL SUB.W D1,D3 BSR SETCURS * RESTORE INITIAL POSITION * MOVEQ #-1,D1 MOVE.W D3,D1 * END - BEG = LEN MOVEQ #-1,D0 * FROM CURSOR ... BSR MDERASE * ERASE THE PROMPT MOVEM.W (SP)+,D0-D1 BSR SETMENU * RESTORE OLD FLAGS *** TST.W (SP) * FORMERLY IN ITALICS MODE? *** BEQ.S NXTLX4 * NO *** MOVEQ #4,D0 * YES, RESUME *** MOVE.L D0,-(SP) *** JSR _highlight * 0 NORMAL, 4 ITALIC *** ADDQ.L #4,SP *** NXTLX4 MOVE.L CURWP(A6),A0 *** MOVE.W D2,WLCNT(A0) * RESET COUNTER, ALLOWING ONE OVERLAP LINE MOVE.W #1,WLCNT(A0) NXTLX6 MOVEM.L (SP)+,D1-D3/A1 RTS * ---------------------- * BUFOUT * ---------------------- * OUTPUT THE LINE BUFFER, BEGINNING AND END IN A0, D0 * FIRST CHECK FOR END-OF-SCREEN CONDITION (UNLESS IN WINDOW 1) BUFOUT MOVEM.L D0/A0,-(SP) MOVEQ #WFSCRL,D0 BSR TSTWFLG * SCROLLING ACTIVE? BEQ.S BUFUX1 * NO, SKIP THE SCREEN CHECK BSR NXTLIN * YES, PAUSE FOR [MORE] IF NECESSARY BUFUX1 MOVEM.L (SP)+,D0/A0 SUB.L A0,D0 * CURRENT LENGTH OF BUFFER IN D0.W BLE.S BUFUX2 * EXIT IF NOTHING BSR MDPRINT * OTHERWISE, DISPLAY IT BUFUX2 RTS * ---------------------- * LINOUT * ---------------------- * OUTPUT THE LINE BUFFER THEN ADD A CR, BEGINNING AND END IN A0, D0 * ALSO UPDATE THE CUMULATIVE LINE COUNTER LINOUT BSR BUFOUT * DISPLAY IT MOVEQ #13,D0 BSR OUTCHR * AND TACK ON A CR MOVEQ #WFSCRL,D0 BSR TSTWFLG * SCROLLING ACTIVE? BEQ.S LINOX1 * NO MOVE.L CURWP(A6),A0 * YES, UPDATE THE [MORE] COUNTER *** MOVEQ #0,D0 *** MOVE.B WFONTYX(A0),D0 * VERTICAL LINE SIZE *** ADD.W D0,WLCNT(A0) ADDQ.W #1,WLCNT(A0) LINOX1 RTS * ---------------------- * OUTMSG, OUTMSG0 * ---------------------- * OUTPUT AN INTERPRETER MESSAGE (ASCIZ), POINTER IN A0 OUTMSG0 MOVE.L A1,-(SP) MOVE.L A0,A1 * STRING POINTER OUTMX1 CLR.W D0 MOVE.B (A1)+,D0 * GET NEXT CHAR, END OF STRING? BEQ.S OUTMX2 * YES BSR PUTCHR * NO, DISPLAY/QUEUE IT BRA OUTMX1 OUTMX2 TST.W VOBUFF(A6) * ARE WE BUFFERING OUTPUT? BEQ.S OUTMX3 * NO BSR PUTLIN * YES, EMPTY THE BUFFER NOW OUTMX3 MOVE.L (SP)+,A1 RTS * OUTPUT AN INTERPRETER MESSAGE, AND APPEND A CR OUTMSG MOVE.L A0,D0 * ANY MESSAGE? BEQ.S OUTMX9 * NO, JUST A CR BSR OUTMSG0 * YES, OUTPUT THE STRING OUTMX9 BRA PUTNEW * ---------------------- * ZWARN * ---------------------- * PRINT AN INTERPRETER WARNING, A0 -> MESSAGE ZWARN MOVE.L A0,-(SP) BSR PUTNEW * CR LEA MSGZWR,A0 BSR OUTMSG0 * MESSAGE HEADER DATA MSGZWR DC.B $2A,$2A,$2A * [***] DC.B ' Interpreter warning: ',0 CODE MOVE.L (SP)+,A0 * MESSAGE BRA OUTMSG * ---------------------- * FATAL * ---------------------- * PRINT AN INTERPRETER FATAL ERROR (HEADER, ID, MSG -- LAST TWO ARE OPTIONAL) * D0.W = ID, A0 -> STRING, ZERO MEANS NONE FATAL MOVE.L A0,A1 * [TRASHES THESE REGS, BUT DOESN'T MATTER] MOVE.W D0,D1 BSR PUTNEW * NEW LINE LEA MSGFTL,A0 * PRINT A STANDARD ERROR HEADER, NO CR BSR OUTMSG0 * 'Internal Error ' DATA MSGFTL DC.B 'Internal Error ',0 CODE TST.W D1 * GOT A NUMBER? BEQ.S FATLX1 * NO MOVE.B #'#',D0 * YES, PRINT A PREFIX BSR PUTCHR MOVE.W D1,D0 * PRINT THE ERROR NUMBER BSR OPPRNN FATLX1 BSR PUTNEW * ANOTHER CR MOVE.L A1,D0 * GOT A MESSAGE? BEQ.S FATLX2 MOVE.L A1,A0 * YES, DISPLAY IT BSR OUTMSG FATLX2 BRA FINISH * GO WAIT FOR FINAL KEY, AND EXIT * ---------------------- * FINISH * ---------------------- * CLEANUP 68K-BASED STUFF FINISH MOVEQ #0,D0 * LAST-USED SOUND ID MOVEQ #4,D1 * CLEANUP MOVEQ #-1,D2 * DEFAULT VOL MOVEQ #-1,D3 * DEFAULT REPEAT BSR DOSOUND * MAKE SURE IT'S OFF MOVEQ #0,D0 BSR SCRINIT * MAKE SURE SCRIPTING'S OFF TST.W INLAST(A6) * HAS THERE BEEN INPUT SINCE LAST OUTPUT? BNE FINIX3 * YES, JUST EXIT BSR PUTNEW * NO, MUST FIRST PAUSE FOR A PROMPT LEA MSGKEY,A0 BSR OUTMSG0 * 'Press any key to exit ' DATA MSGKEY DC.B 'Press any key to exit ',0 CODE MOVEQ #1,D0 * [ALWAYS SETUP AROUND ITTYIN] MOVEQ #0,D1 * SINGLE CHAR BSR SETUPI FINIX2 BSR ITTYIN * FIRST CHECK FOR ANY TYPED-AHEAD KEYS ... TST.B D0 * AND DISCARD THEM BNE FINIX2 * UNTIL NO MORE MOVEQ #0,D0 MOVEQ #0,D1 * SINGLE CHAR BSR SETUPI BSR TTYIN * THEN WAIT FOR ONE MORE FINIX3 BRA MDFINI