github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-01-11 23:43:24 +00:00
Code Issues Packages Projects Releases Wiki Activity
erkyrath.infocom-zcode-terps/amiga/zip3.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

979 lines
26 KiB
NASM
Raw Permalink Blame History

PAGE
* ---------------------------------------------------------------------------
* ZIP MAIN INSTRUCTION-FETCH CYCLE
* ---------------------------------------------------------------------------
* 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
NXTINS BSR NXTBYT * GET THE OPERATION BYTE
IFEQ DEBUG
BSR DBTEST
ENDC
CMPI.B #$80,D0 * IS IT A 2 OP?
BCS.S NXT2 * BLO * YES
CMPI.B #$B0,D0 * IS IT A 1 OP?
BCS.S NXT1 * BLO * YES
CMPI.B #$C0,D0 * IS IT A 0 OP?
BCC NXT4 * BHS * NO, MUST BE AN EXTENDED OP
* ---------------------------------------------------------------------------
NXT0 ANDI.W #$0F,D0 * 0 OP, EXTRACT OPERATOR CODE, "xxxx oooo"
ADD.W D0,D0 * WORD OFFSET
LEA ZEROPS,A1
ADDA.W 0(A1,D0.W),A1 * CALCULATE THE OPERATOR ROUTINE ADDRESS
PEA NXTINS * LEAVE RETURN ADDRESS ON STACK
JMP (A1) * CALL THE OPERATOR ROUTINE
* ---------------------------------------------------------------------------
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
ADDA.W 0(A1,D2.W),A1 * CALCULATE THE OPERATOR ROUTINE ADDRESS
PEA NXTINS * LEAVE RETURN ADDRESS ON STACK
JMP (A1) * CALL THE OPERATOR ROUTINE
* ---------------------------------------------------------------------------
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
ADDA.W 0(A1,D2.W),A1 * CALCULATE THE OPERATOR 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 PEA NXTINS * LEAVE RETURN ADDRESS ON STACK
JMP (A1) * CALL THE OPERATOR ROUTINE
* ---------------------------------------------------------------------------
NXT4 MOVE.W D0,D2 * EXTENDED OP, SAVE A COPY, "xxoo oooo"
*** GET THE 4 (OR 8) MODE SPECIFIERS, EXTRACT AND STACK THEM ...
IFEQ EZIP
CMPI.B #$EC,D0 * IS THIS AN XCALL (236)?
BNE.S N4X1 * NO
MOVEQ #8,D3 * YES, 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
ENDC
N4X1 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.S 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
ANDI.W #$3F,D2 * EXTRACT OPERATOR CODE
ADD.W D2,D2 * WORD OFFSET
LEA EXTOPS,A1
ADDA.W 0(A1,D2.W),A1 * CALCULATE THE OPERATOR 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 PEA NXTINS * LEAVE RETURN ADDRESS ON STACK
JMP (A1) * CALL THE OPERATOR ROUTINE
PAGE
* ---------------------------------------------------------------------------
* DISPATCH TABLES
* ---------------------------------------------------------------------------
* UNIMPLEMENTED OPCODES DISPATCH TO HERE ...
OPERR CLR.W D0 * (MAY BE GARBAGE)
LEA MSGBAD,A0
BRA FATAL * 'Bad operation'
SECTION ZDATA
MSGBAD DC.B 'Bad operation',0
SECTION ZCODE
* FOLLOWING MUST BE IN CODE SECTION, DUE TO OFFSET COMPUTATIONS ...
ZEROPS DC.W OPRTRU-ZEROPS * 176
DC.W OPRFAL-ZEROPS * 177
DC.W OPPRNI-ZEROPS * 178
DC.W OPPRNR-ZEROPS * 179
DC.W OPNOOP-ZEROPS * 180
DC.W OPSAVE-ZEROPS * 181
DC.W OPREST-ZEROPS * 182
DC.W OPRSTT-ZEROPS * 183
DC.W OPRSTA-ZEROPS * 184
DC.W OPFSTA-ZEROPS * 185
DC.W OPQUIT-ZEROPS * 186
DC.W OPCRLF-ZEROPS * 187
DC.W OPUSL-ZEROPS * 188
DC.W OPVERI-ZEROPS * 189
DC.W OPERR-ZEROPS * 190
DC.W OPERR-ZEROPS * 191
ONEOPS DC.W OPQZER-ONEOPS * 128
DC.W OPQNEX-ONEOPS * 129
DC.W OPQFIR-ONEOPS * 130
DC.W OPLOC-ONEOPS * 131
DC.W OPPTSI-ONEOPS * 132
DC.W OPINC-ONEOPS * 133
DC.W OPDEC-ONEOPS * 134
DC.W OPPRNB-ONEOPS * 135
DC.W OPCAL1-ONEOPS * 136 EZIP
DC.W OPREMO-ONEOPS * 137
DC.W OPPRND-ONEOPS * 138
DC.W OPRETU-ONEOPS * 139
DC.W OPJUMP-ONEOPS * 140
DC.W OPPRIN-ONEOPS * 141
DC.W OPVALU-ONEOPS * 142
DC.W OPBCOM-ONEOPS * 143
TWOOPS:
EXTOPS: DC.W OPERR-EXTOPS * 0
DC.W OPQEQU-EXTOPS * 1
DC.W OPQLES-EXTOPS * 2
DC.W OPQGRT-EXTOPS * 3
DC.W OPQDLE-EXTOPS * 4
DC.W OPQIGR-EXTOPS * 5
DC.W OPQIN-EXTOPS * 6
DC.W OPBTST-EXTOPS * 7
DC.W OPBOR-EXTOPS * 8
DC.W OPBAND-EXTOPS * 9
DC.W OPQFSE-EXTOPS * 10
DC.W OPFSET-EXTOPS * 11
DC.W OPFCLE-EXTOPS * 12
DC.W OPSET-EXTOPS * 13
DC.W OPMOVE-EXTOPS * 14
DC.W OPGET-EXTOPS * 15
DC.W OPGETB-EXTOPS * 16
DC.W OPGETP-EXTOPS * 17
DC.W OPGTPT-EXTOPS * 18
DC.W OPNEXT-EXTOPS * 19
DC.W OPADD-EXTOPS * 20
DC.W OPSUB-EXTOPS * 21
DC.W OPMUL-EXTOPS * 22
DC.W OPDIV-EXTOPS * 23
DC.W OPMOD-EXTOPS * 24
DC.W OPCAL2-EXTOPS * 25 EZIP
DC.W OPERR-EXTOPS * 26
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPCALL-EXTOPS * 224
DC.W OPPUT-EXTOPS * 225
DC.W OPPUTB-EXTOPS * 226
DC.W OPPUTP-EXTOPS * 227
DC.W OPREAD-EXTOPS * 228
DC.W OPPRNC-EXTOPS * 229
DC.W OPPRNN-EXTOPS * 230
DC.W OPRAND-EXTOPS * 231
DC.W OPPUSH-EXTOPS * 232
DC.W OPPOP-EXTOPS * 233
DC.W OPSPLT-EXTOPS * 234
DC.W OPSCRN-EXTOPS * 235
DC.W OPXCAL-EXTOPS * 236 EZIP
DC.W OPCLEAR-EXTOPS * 237 EZIP
DC.W OPERASE-EXTOPS * 238 EZIP
DC.W OPCURS-EXTOPS * 239 EZIP
DC.W OPCURG-EXTOPS * 240 EZIP
DC.W OPATTR-EXTOPS * 241 EZIP
DC.W OPBUFO-EXTOPS * 242 EZIP
DC.W OPDIRO-EXTOPS * 243 EZIP
DC.W OPDIRI-EXTOPS * 244 EZIP
DC.W OPSOUND-EXTOPS * 245 EZIP
DC.W OPINPUT-EXTOPS * 246 EZIP
DC.W OPINTBL-EXTOPS * 247 EZIP
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS * 250
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS
DC.W OPERR-EXTOPS * 255
PAGE
* ----------------------------------------------------------------------------
* STRING FUNCTIONS
* ----------------------------------------------------------------------------
* ZSTR CHARACTER CONVERSION VECTOR
SECTION ZDATA
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
SECTION ZCODE
* 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
ASL.W #1,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
* GIVEN AN ASCII CHARACTER IN D0, RETURN THE CHARACTER SET # IN D0
CHRCS TST.B D0 * IS THIS A NULL?
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
* GIVEN AN ASCII CHARACTER IN D0, RETURN ZSTR BYTE VALUE IN D0 (6 TO 31, OR 0)
CHRBYT LEA ZCHRS,A0 * POINT TO CONVERSION VECTOR
CHRBX1 CMP.B (A0)+,D0 * FOUND THE CHARACTER?
BEQ.S CHRBX2 * YES
TST.B (A0) * END OF STRING?
BNE.S CHRBX1 * NO, CONTINUE SEARCH
CLR.W D0 * YES, RETURN ZERO FOR FAILURE
BRA.S CHRBX4
CHRBX2 MOVE.L A0,D0 * CALCULATE OFFSET OF CHAR INTO VECTOR
LEA ZCHRS,A0
SUB.L A0,D0
ADDQ.W #5,D0 * ADJUST OFFSET SO FIRST CHAR IS 6
CHRBX3 CMPI.W #32,D0 * IN BASE CODE RANGE (6-31)?
BLT.S CHRBX4 * YES
SUBI.W #26,D0 * SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE
BRA.S CHRBX3
CHRBX4 RTS
* 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
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 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.S 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.S ZWX7 * GO FOR NEXT
BSET #7,-2(A2) * SET HIGH-ORDER BIT IN LAST ZWORD
ADDA.W D2,SP * AND FLUSH THE STACK
MOVEM.L (SP)+,D1-D2/A2
RTS
PAGE
*--------------------------------------------------------------------------
* GENERALIZED OUTPUT FOLDING ROUTINE
*--------------------------------------------------------------------------
* THE QUECHR ROUTINE IS CALLED WITH A POINTER TO A STRUCTURE CONTAINING
* THE VARIABLES BELOW. THIS ARRANGEMENT ALLOWS FOR THE EXISTANCE OF MORE THAN
* ONE STRUCTURE, USEFUL IF DISPLAYED TEXT AND SCRIPTED TEXT ARE TO FOLD AT
* DIFFERENT POINTS.
* THE STRUCTURE IDENTIFIES TWO ACTION ROUTINES. THE OUTPUT FUNCTION
* DUMPS THE BUFFER WHEN IT BECOMES FULL. THE SIZE FUNCTION ALLOWS FOR THE
* HANDLING OF PROPORTIONALLY SPACED TEXT.
* THE LAST TWO VARIABLES ARE CURRENTLY IGNORED, BUT MIGHT BE USEFUL
* FOR IMPLEMENTING RECALCULATION OF THE FOLD POINTS FOR A PARAGRAPH OF TEXT,
* AS WHEN A WINDOW CHANGES SIZE.
* DATA STRUCTURE FOR QUEUE-PARAMETERS BLOCK
BUFPTR EQU 0 * START OF BUFFER
BUFSIZ EQU 4 * MAXIMUM UNITS IN BUFFER
NXTPTR EQU 6 * CURRENT POSITION WITHIN BUFFER
CURSIZ EQU 10 * CURRENT UNITS IN BUFFER
SIZFUN EQU 12 * GIVEN A CHAR, RETURNS UNIT SIZE
OUTFUN EQU 16 * GIVEN BUFPTR & ENDPTR, DUMPS BUFFER, ADDS CR
RETFUN EQU 20 * (UNUSED -- THIS SHOULD ADD THE CR)
DUMPED EQU 24 * WAS BUFFER EMPTIED (WITHOUT CR) BEFORE FULL?
AUTOCR EQU 25 * APPEND A CR TO EACH BUFFER DUMP? *** YES
KEEPSP EQU 26 * DON'T DISCARD TRAILING SPACE? *** NO
QPLEN EQU 28 * LENGTH OF BLOCK (ALWAYS EVEN)
* ALLOCATE AND INITIALIZE A QUEUE PARAMETER BLOCK,
* D1 IS MAXIMUM SIZE OF BUFFER (IN BYTES), D2 IS INITIAL UNIT SIZE
* A1 POINTS TO LINE OUTPUT FUNCTION, A2 POINTS TO UNIT SIZE FUNCTION
* RETURN BLOCK POINTER IN A0
INITQP MOVE.W D1,D0
ADD.W #QPLEN,D0 * TOTAL SPACE TO ALLOCATE
EXT.L D0
BSR GETMEM * GET IT
MOVE.L A0,D0 * PARAMETERS BLOCK WILL START HERE
ADD.L #QPLEN,D0
MOVE.L D0,BUFPTR(A0) * LINE BUFFER STARTS HERE
MOVE.L D0,NXTPTR(A0) * ALSO CURRENT POINTER
MOVE.W D2,BUFSIZ(A0) * UNIT CAPACITY OF BUFFER
CLR.W CURSIZ(A0) * ALWAYS EMPTY INITIALLY
MOVE.L A1,OUTFUN(A0) * INITIALIZE LINE OUTPUT FUNCTION
MOVE.L A2,SIZFUN(A0) * INITIALIZE CHAR SIZE FUNCTION
CLR.B DUMPED(A0) * THIS ONE IS SET ONLY BY PUTLIN
RTS * RETURN THE POINTER IN A0
* QUEUE THE CHAR IN D0 FOR OUTPUT, A0 POINTS TO QUEUE-PARAMETERS BLOCK
QUECHR MOVEM.L D4/A1-A4,-(SP)
MOVE.W D0,D4
MOVE.L A0,A4
MOVE.W CURSIZ(A4),D0
CMP.W BUFSIZ(A4),D0 * BUFFER FULL YET?
BLT QCX8 * NO
*** BGT QCX0 * OVERFULL (DEQUE THE LAST CHAR AND REENTER)
CMPI.B #32,D4 * YES, BUT DID A SPACE CAUSE OVERFLOW?
BNE.S QCX1 * NO
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 ...
QCX1 MOVE.L BUFPTR(A4),A1 * BEGINNING OF BUFFER
MOVE.L NXTPTR(A4),A2 * END OF BUFFER (+1)
BRA.S QCX2A * ALLOW FOR EMPTY [DUMPED] BUFFER
QCX2 CMPI.B #32,-(A2) * SEARCH FOR SPACE BACKWARDS FROM END
BEQ.S QCX4 * FOUND ONE
QCX2A CMPA.L A1,A2 * REACHED BEGINNING OF BUFFER?
BGT QCX2 * 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.S 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
TST.W WIND1(A6) * BUT IF WE'RE IN SPLIT SCREEN,
BNE.S QCX9 * DON'T TOUCH COUNTER (SEE ALSO OPBUFO)
MOVE.W D4,D0
MOVE.L SIZFUN(A4),A0
JSR (A0) * GET UNIT SIZE OF NEW CHAR
ADD.W D0,CURSIZ(A4) * AND UPDATE COUNTER
QCX9 MOVEM.L (SP)+,D4/A1-A4
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.
* OUTPUT A NEWLINE
PUTNEW MOVEQ #13,D0 * JUST FALL THROUGH WITH A CR
* OUTPUT THE CHAR IN D0 (TO THE REQUESTED DEVICES)
PUTCHR CMPI.B #9,D0 * TAB? (OLD ZORK BUG, DISPLAYS GARBAGE)
BNE.S PCX1
MOVEQ #32,D0 * YES, MAP TO A SPACE
PCX1
*** STATUS LINE OUTPUT (ZIP INTERNAL FUNCTION ONLY) ...
IFEQ CZIP
TST.W VOSTAT(A6) * SPECIAL OUTPUT TO SL HANDLER?
BNE PUTSL * YES (ABORT PUTCHR)
ENDC
*** TABLE OUTPUT ...
IFEQ EZIP
TST.W VOTABL(A6) * TABLE OUTPUT?
BNE TABCHR * YES (ABORT PUTCHR PER "DIROUT" SPEC)
ENDC
MOVE.W D0,-(SP) * OTHERWISE, SAVE THE CHAR HERE
*** SCRIPT (BEFORE SCREEN, TO PERMIT ERROR HANDLING) ...
TST.W WIND1(A6) * BUT ARE WE IN WINDOW 1?
BNE.S PCX2 * YES, TEMPORARILY AVOID SCRIPTING
IFEQ EZIP
TST.W VOPRNT(A6) * SCRIPTING ACTIVE?
ENDC
IFEQ CZIP
BSR TSTSCR * CHECK FOR SCRIPTING REQUEST -- ACTIVE?
ENDC
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
*--------------------------------------------------------------------------
* 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.S NEWLIN * YES, DUMP THE BUFFER
MOVE.L DQUE(A6),A0 * OTHERWISE, GO QUEUE IT
BRA QUECHR
* 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
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
MOVE.L (SP)+,A4
RTS
* OUTPUT CURRENT BUFFER, WITHOUT A NEWLINE
* (ASSUMES SOMETHING LIKE OPREAD WILL SUPPLY THE NEWLINE)
PUTLIN MOVE.L DQUE(A6),A0
CLR.W CURSIZ(A0) * RESET UNIT COUNT (BUFFER EMPTY)
* ENTER HERE IF BUFFERING WILL LATER RESUME FROM CURRENT POINT
PUTLIN1 MOVE.L A4,-(SP)
MOVE.L DQUE(A6),A4 * SCREEN BUFFER
MOVE.L BUFPTR(A4),A0 * START OF LINE
MOVE.L NXTPTR(A4),D0 * END OF CURRENT LINE
BSR BUFOUT * OUTPUT IT (NO "MORE", NO CR)
MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CHARACTER POINTER
MOVE.B #1,DUMPED(A4) * REMEMBER BUFFER IS PARTLY DUMPED
MOVE.L (SP)+,A4
RTS
* INPUT A CHARACTER FROM TERMINAL
GETCHR BRA INCHR * JUST GET IT
*--------------------------------------------------------------------------
* SCRIPT BUFFERING
*--------------------------------------------------------------------------
* QUEUE THE CHAR IN D0 FOR SCRIPTING
SCRCHR CMPI.B #13,D0 * CR?
BEQ.S SCRLIN * YES, GO DUMP SCRIPT BUFFER
MOVE.L SQUE(A6),A0 * SCRIPTING PARAMETERS BLOCK
BRA QUECHR * GO QUEUE IT
* SCRIPT A NEWLINE, OUTPUTTING CURRENT SCRIPT 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
* SCRIPT THE USER INPUT LINE, START IN A0, END IN D0
* (WAIT UNTIL USER INPUT IS FINISHED TO AVOID PROBLEMS WITH BACKSPACES)
SCRINP MOVEM.L A1/D1,-(SP)
MOVE.L A0,A1 * PROTECT ARGS
MOVE.L D0,D1
IFEQ EZIP
TST.W VOPRNT(A6) * SCRIPTING?
ENDC
IFEQ CZIP
BSR TSTSCR * CHECK FOR SCRIPT REQUEST -- ACTIVE?
ENDC
BEQ.S SCRIX3 * NO, EXIT
SUB.L A1,D1 * LENGTH OF INPUT -- ANYTHING?
BEQ.S SCRIX2 * NO, JUST DO THE CR
SCRIX1 MOVE.B (A1)+,D0 * SCRIPT NEXT CHAR
BSR SCRCHR * (GO THRU BUFFER SO WRAPPING IS CORRECT)
SUBQ.W #1,D1
BGT SCRIX1
SCRIX2 MOVEQ #13,D0 * ALWAYS END WITH A CR
BSR SCRCHR
SCRIX3 MOVEM.L (SP)+,D1/A1
RTS
PAGE
* ----------------------------------------------------------------------------
* PAGING ROUTINES
* ----------------------------------------------------------------------------
* 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
MOVE.L #-1,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
* 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.S 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
IFEQ DEBUG
ADDQ.L #1,DBTOT1(A6) * TOTAL PAGE FAULTS
ENDC
GPX4 MOVE.L LPLOC(A6),A0 * RETURN THE PAGE POINTER
RTS
* 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
MOVE.L #-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.S 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
Reference in New Issue View Git Blame Copy Permalink