2023-11-16 18:19:54 -05:00

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