mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-01-21 10:03:09 +00:00
1635 lines
42 KiB
Plaintext
1635 lines
42 KiB
Plaintext
|
|
* ---------------------------------------------------------------------------
|
|
* 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 * <ST ASSEMBLER>
|
|
|
|
*** 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
|
|
|