Files
erkyrath.infocom-zcode-terps/st/stx3.s
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

1943 lines
47 KiB
ArmAsm

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.W 0 * ASCIZ
TEXT
* ----------------------
* 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
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
* ----------------------
* CHRCS
* ----------------------
* 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
* ----------------------
* CHRBYT
* ----------------------
* 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 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 CHRBX3
CHRBX4 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
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 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 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)
* ----------------------
* 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 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.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 PUTLIN1
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 SUBQ.W #1,D0 * >>> ALLOW FOR ATARI ITALICS HACK <<<
MOVE.W D0,BUFSIZ(A0) * STORE IT
RTS
* ----------------------
* QUECHR
* ----------------------
* 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 QCXX * OVERFULL (DEQUE THE LAST CHAR AND REENTER)
* HACK: IF WE'RE OUTPUTTING TO WINDOW 1, AVOID WRAPPING -- ESPECIALLY ON
* THE ST (SINCE WRAP WIDTH IS REDUCED A BIT BECAUSE OF ITALICS, 80-COLUMN
* REVERSE-VIDEO-BACKGROUND STATUS/HINT LINES WERE GETTING CLIPPED).
* [OUGHT INSTEAD TO SPLIT 'OUTFUN' FROM 'RETFUN', ADJUST LINOUT, ETC.]
TST.W WIND1(A6) * IN UPPER WINDOW?
BEQ.S QCX0 * NO
CMPA.L DQUE(A6),A4 * (MAKE CERTAIN THIS IS SCREEN OUTPUT)
BNE.S QCX0 * NO
BSR PUTLIN1 * YES, DUMP/RESET BUFFER, NO CR
BRA QCX8 * STORE CHAR AND EXIT
QCX0 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 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
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.
* ----------------------
* 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 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) ...
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, SO "OPEN" ERROR DISPLAYS IN CORRECT SEQUENCE)
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
*--------------------------------------------------------------------------
* ----------------------
* 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
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
* ----------------------
* PUTLIN, PUTLIN1
* ----------------------
* 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
MOVE.L BUFPTR(A4),A0 * START OF LINE
MOVE.L NXTPTR(A4),D0 * END OF CURRENT LINE
BSR BUFOUT * OUTPUT IT (NO CR, BUT DOES CHECK [MORE])
MOVE.L BUFPTR(A4),NXTPTR(A4) * RESET CHARACTER POINTER
MOVE.B #1,DUMPED(A4) * REMEMBER BUFFER IS PARTLY DUMPED
MOVE.L (SP)+,A4
RTS
*--------------------------------------------------------------------------
* SCRIPT BUFFERING
*--------------------------------------------------------------------------
* ----------------------
* SCRCHR
* ----------------------
* /ALL/ SCRIPT OUTPUT IS CHANNELED THROUGH HERE
* QUEUE THE CHAR IN D0 FOR SCRIPTING (UNLESS SCREEN 1 IS ACTIVE; IF SO,
* TEMPORARILY SUPPRESS SCRIPTING)
SCRCHR TST.W WIND1(A6) * BUT ARE WE IN WINDOW 1?
BEQ.S SCRCX1 * NO
RTS * YES, AVOID SCRIPTING
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
* ----------------------
* SCRLIN
* ----------------------
* 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
* ----------------------
* 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
IFEQ EZIP
TST.W VOPRNT(A6) * SCRIPTING?
ENDC
IFEQ CZIP
BSR TSTSCR * CHECK FOR SCRIPT REQUEST -- ACTIVE?
ENDC
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
* ----------------------
* OUTPUT THE SAVE/RESTORE FILENAME TO THE TRANSCRIPT (IF SCRIPTING)
* (USER SELECTED THE NAME VIA A SPECIAL DIALOG)
SCRNAM MOVE.L D1,-(SP)
LEA MSGSCN,A0 * 'File is '
BSR STRLEN * LEAVE LENGTH OF STRING IN D0
CLR.W D1 * NO CR YET
BSR SCRINP
DATA
MSGSCN DC.B 'File is ',0
TEXT
LEA _filename,A0 * NO PATHSPEC, TYPE IS ALWAYS '.SAV'
BSR STRLEN * LEAVE LENGTH OF STRING IN D0
MOVEQ #1,D1 * END WITH CR
BSR SCRINP
MOVE.L (SP)+,D1
RTS
* ----------------------
* STRLEN
* ----------------------
* FIND LENGTH OF AN ASCIZ STRING, POINTER IN A0
* RETURN POINTER IN A0 AND LENGTH IN D0
STRLEN MOVE.L A1,-(SP)
MOVE.L A0,A1
STRLX1 TST.B (A1)+ * SEARCH FOR NULL
BNE.S STRLX1
TST.B -(A1) * FOUND IT, BACKUP TO THE NULL
MOVE.L A1,D0
SUB.L A0,D0 * RETURN LENGTH
MOVE.L (SP)+,A1
RTS
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
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
* ----------------------
* 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
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 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
PAGE
* ----------------------------------------------------------------------
* MACHINE-DEPENDENT ROUTINES
* ----------------------------------------------------------------------
* ----------------------
* SYSIN1
* ----------------------
* MISC SYSTEM INITIALIZATION
SYSIN1
BSR OPNGAM * OPEN THE GAME FILE, SET UP GAMFIL(A6)
BNE SYSX1 * ERROR
RTS * OK
SYSX1 LEA MSGOPN,A0 * ERROR CODE IN D0
BRA FATAL * 'Story file open error'
DATA
MSGOPN DC.B 'Story file open error',0
TEXT
* ----------------------
* GETM, GETMEM
* ----------------------
* ALLOCATE MEMORY, NUMBER OF BYTES REQUESTED IN D0.L, RETURN POINTER IN A0
* (GETMEM TRAPS ERRORS, GETM DOESN'T)
* ON THE ATARI ST, GEMDOS(48) CRASHES IF THE REQUEST IS ODD. THEREFORE,
* GETMEM FIRST ROUNDS UP ANY ODD REQUESTS.
GETM MOVEM.L D1-D7/A1-A5,-(SP)
BTST #0,D0 * WORD ALIGNED?
BEQ.S GETMX1 * YES
ADDQ.L #1,D0 * NO, ROUND UP TO AN EVEN REQUEST
GETMX1 MOVE.L D0,-(SP) * BYTES REQUESTED
JSR _zalloc * >>> THIS IS NOW OUR ALLOCATOR
* MOVE.W #$48,-(SP) * MALLOC (GEMDOS)
* TRAP #1
ADDA.W #4,SP * FLUSH STACK
MOVE.L D0,A0 * LEAVE RESULT IN A0
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
GETMEM BSR GETM * LIKE ABOVE BUT CHECK FOR ERROR
MOVE.L A0,D0 * GOT IT?
BEQ.S MEMERR * ZERO MEANS FAILURE
RTS
MEMERR CLR.W D0
LEA MSGME1,A0
BRA FATAL * 'Not enough memory'
DATA
MSGME1 DC.B 'Not enough memory',0
TEXT
* ----------------------
* MEMAVAIL
* ----------------------
* DETERMINE AVAILABLE MEMORY, RETURN NUMBER OF BYTES AVAILABLE IN D0.L
MEMSYS EQU 20*512 * ALLOW FOR OS RUNTIME + ZIP OVERHEAD
MEMAVAIL
MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.L #-1,-(SP) * INQUIRE MAXIMUM AVAIL MEMORY
JSR _zalloc
* MOVE.W #$48,-(SP) * MALLOC (GEMDOS)
* TRAP #1
ADDA.W #4,SP * FLUSH STACK
SUB.L #MEMSYS,D0 * "FUDGE FACTOR"
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* GTSEED
* ----------------------
* RETURN A RANDOM NUMBER SEED IN D0, DIFFERENT EACH COLDSTART
GTSEED MOVE.W #17,-(SP) * ATARI RANDOM FUNCTION
TRAP #14
ADDQ.L #2,SP * FLUSH STACK
RTS
* ----------------------
* TIME60
* ----------------------
* TIME (IN 60THS SECOND) SINCE SYSTEM STARTUP (APPROXIMATE)
TIME60 MOVEM.L D1-D7/A1-A5,-(SP)
JSR _time200 * GET TIME IN 200THS, CONVERT APPROXIMATELY
MOVE.L D0,D1
LSL.L #2,D0
ADD.L D1,D0 * MULT BY 5
LSR.L #4,D0 * DIV BY 16
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* CHSIZ
* ----------------------
* GIVEN AN ASCII CHAR, RETURN ITS UNIT WIDTH (IN CURRENT FONT)
CHSIZ MOVEQ #1,D0 *** ALWAYS ONE, FOR NOW
RTS
* ----------------------
* FINISH
* ----------------------
* RESTART THE SYSTEM (RETURN TO THE DESKTOP)
FINISH MOVEQ #0,D0 * LRU SOUND
MOVEQ #4,D1 * CLEANUP
MOVEQ #-1,D2
MOVEQ #-1,D3
BSR DOSOUND * MAKE SURE IT'S OFF
TST.W GAMFIL(A6) * GAME OPEN?
BEQ.S FINIX1 * NO
BSR CLSGAM * YES, CLOSE THE GAME FILE
* BEQ.S FINIX1 * OK IF ZERO
* LEA MSGCLS,A0 * ERROR, INFORM USER
* BSR OUTMSG * 'Story file close error'
* DATA
* MSGCLS DC.B 'Story file close error',0
* TEXT
* ENTER HERE IF GAME FILE FAILED TO OPEN ...
FINIX1 TST.W INLAST(A6) * HAS THERE BEEN INPUT SINCE LAST OUTPUT?
BNE FINIX2 * YES, JUST EXIT
BSR PUTNEW * NO, MUST FIRST PAUSE FOR A PROMPT
LEA MSGKEY,A0
BSR OUTMSG0 * 'Strike any key to exit '
DATA
MSGKEY DC.B 'Strike any key to exit ',0
TEXT
* OUGHT TO FLUSH ANY TYPED-AHEAD KEYS, THEN ...
BSR TTYIN * WAIT FOR A KEY
FINIX2 UNLK A6 * FLUSH THE ZIP'S STACK FRAME
RTS * RETURN TO ORIGINAL CALLER
PAGE
* -----------------------------------------------
* SCREEN/KEY I/O
* -----------------------------------------------
* ----------------------
* SETUPI
* ----------------------
* MUST "BRACKET" CALLS TO TTYIN OR INCHR WITH A CALL TO THIS ROUTINE,
* TO ACTIVATE/DEACTIVATE THE INPUT CURSOR
* D0.W = 1 TO BEGIN, 0 TO END
SETUPI MOVEM.L D1-D7/A1-A5,-(SP)
TST.W D0
BEQ.S SETUX1
MOVE.W #1,INLAST(A6) * CURRENT I/O IS INPUT
CLR.W LINES(A6) * RESET THE [MORE] COUNTER
SETUX1 EXT.L D0
MOVE.L D0,-(SP)
JSR _do_input
ADDQ.W #4,SP
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* 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
* ----------------------
* TTYIN
* ----------------------
* INPUT A SINGLE CHAR (XZIP: or mouse clicks), NO ECHO
* IF NONE AVAILABLE, RETURN A ZERO
ITTYIN MOVEM.L D1-D7/A1-A5,-(SP)
JSR _event_in
ANDI.W #$00FF,D0
CMPI.W #253,D0 * MOUSE BUTTON CLICK? (SINGLE OR DOUBLE)
BLT.S ITTYX2 * NO
MOVE.W D0,D1
MOVEQ #PMLOCX,D0 * LOW CORE EXTENSION VAR -- MOUSE POSITION
BSR LOWCORE * CALCULATE ADDR
BEQ.S ITTYX1 * ERROR (TABLE UNDEFINED, OR NOT BIG ENOUGH)
MOVE.W _xmouse,D0
ADDQ.W #1,D0 * 1-ORIGIN
BSR PTAWRD * STORE MOUSE X POSITION
MOVEQ #PMLOCY,D0
BSR LOWCORE
BEQ.S ITTYX1
MOVE.W _ymouse,D0
ADDQ.W #1,D0 * 1-ORIGIN
BSR PTAWRD * STORE MOUSE Y POSITION
BRA.S ITTYX1A
ITTYX1 CLR.W D1 * ERROR, DISCARD MOUSE CODE
ITTYX1A MOVE.W D1,D0 * RETURN CHAR IN D0
ITTYX2 MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* >>> ENTER HERE TO LOOP UNTIL A CHAR IS AVAILABLE <<<
TTYIN MOVEQ #1,D0
BSR SETUPI * SET UP FOR INPUT
TTYX1 BSR ITTYIN
TST.B D0
BEQ.S TTYX1 * IF NONE, KEEP WAITING
MOVE.W D0,-(SP)
CLR.W D0
BSR SETUPI * FINISHED INPUT
MOVE.W (SP)+,D0 * RETURN THE CHAR
RTS
* ----------------------
* OUTCHR
* ----------------------
* OUTPUT THE CHAR (OR CR) IN D0.B (SCROLLING IF NECESSARY)
OUTCHR CLR.W INLAST(A6) * CURRENT I/O IS OUTPUT
TTYOUT MOVEM.L D1-D7/A1-A5,-(SP)
MOVEQ #0,D1
MOVE.B D0,D1 * CLEAR HIGH BYTE
CMPI.B #13,D1 * IS THIS A CR?
BNE.S TTYOX1
BSR CRCHECK * YES, CHECK FOR POSSIBLE INTERRUPT (XZIP)
TTYOX1 MOVE.L D1,-(SP)
JSR _char_out
ADDQ.W #4,SP
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* CRCHECK
* ----------------------
* XZIP: WE'RE ABOUT TO OUTPUT A CARRIAGE RETURN; CHECK FOR A SPECIAL INTERRUPT
CRCHECK MOVE.L BUFFER(A6),A0
MOVE.L A0,D0 * CHECK IF VALID (MAY BE HERE AFTER INIT ERROR)
BEQ.S CRCHX6
TST.W PCRCNT(A0) * CR COUNTER ACTIVE?
BEQ.S CRCHX6 * NO
SUBQ.W #1,PCRCNT(A0) * YES, DECREMENT IT; REACHED ZERO?
BNE.S CRCHX6 * NO
* 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.
* Is this a good reason to avoid dedicating other registers?
MOVE.L A4,-(SP)
MOVE.L STKBOT(A6),A4 * FAKE A SMALL GAME STACK
ADDA.W #100,A4 * AT THE BOTTOM OF THE REAL ONE
MOVE.W PCRFUNC(A0),D0
BSR INCALL * AND HANDLE THE INTERRUPT
MOVE.L (SP)+,A4
CRCHX6 RTS
* ----------------------
* NXTLIN
* ----------------------
* CHECK FOR END-OF-PAGE CONDITION
NXTLIN MOVE.W _rows,D0
SUB.W _split_row,D0 * LINES AVAILABLE FOR DISPLAY
SUBQ.W #1,D0 * ALLOW ONE LINE FOR [MORE] MESSAGE
BEQ.S NXTLX2 * DEGENERATE CASE, DON'T PAUSE
CMP.W LINES(A6),D0 * PAGE FULL YET?
BNE.S NXTLX2 * NO, EXIT
MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.W _v_italic,-(SP) * SAVE ITALICS STATUS HERE
IFEQ CZIP
BSR OPUSL * UPDATE STATUS LINE NOW
ENDC
TST.W (SP) * CURRENTLY IN ITALIC MODE?
BEQ.S NXTLX0 * NO
CLR.L -(SP) * YES, SWITCH TO NORMAL FOR [MORE]
JSR _highlight * 0 NORMAL, 4 ITALIC
ADDQ.L #4,SP
NXTLX0 LEA MSGMOR,A0 * DISPLAY MORE MESSAGE (NO CR)
MOVEQ #6,D0
BSR PRINT * WRITE DIRECTLY TO SCREEN
DATA
MSGMOR DC.B '[MORE]',0
TEXT
BSR TTYIN * WAIT FOR A KEY, NO ECHO
SUBQ.W #6,_cur_column * BACKUP CURSOR
LEA MSGNOM,A0 * ERASE MORE MESSAGE (NO CR)
MOVEQ #6,D0
BSR PRINT * WRITE DIRECTLY TO SCREEN
DATA
MSGNOM DC.B ' ',0
TEXT
SUBQ.W #6,_cur_column * BACKUP CURSOR
TST.W (SP) * FORMERLY IN ITALICS MODE?
BEQ.S NXTLX1 * NO
MOVEQ #4,D0 * YES, RESUME
MOVE.L D0,-(SP)
JSR _highlight * 0 NORMAL, 4 ITALIC
ADDQ.L #4,SP
NXTLX1 MOVE.W #1,LINES(A6) * RESET COUNTER, ALLOWING ONE OVERLAP LINE
TST.W (SP)+ * CLEAN UP STACK
MOVEM.L (SP)+,D1-D7/A1-A5
NXTLX2 RTS
* ----------------------
* PRINT
* ----------------------
* OUTPUT A STRING, POINTER IN A0, LENGTH IN D0.W
PRINT CLR.W INLAST(A6) * CURRENT I/O IS OUTPUT
MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.L D0,-(SP) * POINTER
MOVE.L A0,-(SP) * LENGTH IN BYTES
JSR _line_out
ADDQ.W #8,SP * FLUSH STACK
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* BUFOUT
* ----------------------
* OUTPUT THE LINE BUFFER, BEGINNING AND END IN A0, D0
* FIRST CHECK FOR END-OF-SCREEN CONDITION (UNLESS IN WINDOW 1)
BUFOUT TST.W WIND1(A6) * IN WINDOW 1?
BNE BUFUX1 * YES, SKIP THE SCREEN CHECK
MOVEM.L D0/A0,-(SP)
BSR NXTLIN * PAUSE FOR [MORE] IF NECESSARY
MOVEM.L (SP)+,D0/A0
BUFUX1 SUB.L A0,D0 * CURRENT LENGTH OF BUFFER IN D0.W
BLE BUFUX2 * EXIT IF ZERO
BSR PRINT * 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
TST.W WIND1(A6) * IN WINDOW 1?
BNE LINOX1 * YES, IGNORE COUNTER
ADDQ.W #1,LINES(A6) * OTHERWISE UPDATE THE [MORE] COUNTER
LINOX1 RTS
PAGE
*----------------------------------------------------------------------------
* ZIP MESSAGES
*----------------------------------------------------------------------------
* ----------------------
* OUTMSG
* ----------------------
* OUTPUT AN ASCIZ MESSAGE, POINTER IN A0
OUTMSG0 MOVEM.L A1-A2,-(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
OUTMX3 MOVEM.L (SP)+,A1-A2
RTS
* OUTPUT AN ASCIZ MESSAGE, POINTER IN A0 (NULL IF NONE)
* THEN 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
TEXT
MOVE.L (SP)+,A0 * THE MESSAGE
BSR OUTMSG
RTS
* ----------------------
* FATAL
* ----------------------
* PRINT A FATAL ERROR HEADER, CODE NUMBER AND MESSAGE (LAST TWO ARE OPTIONALS)
* ERROR CODE IN D0, STRING IN A0, ZERO MEANS NONE
FATAL MOVE.L A0,-(SP)
MOVE.W D0,-(SP)
JSR _end_title * ST: FIRST CLEAN UP AFTER ANY BOOT SCREEN
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
TEXT
MOVE.W (SP)+,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
MOVE.L (SP)+,D0 * GOT A MESSAGE?
BEQ.S FATLX2 * NO
MOVE.L D0,A0 * YES, DISPLAY THE STRING
BSR OUTMSG
FATLX2 BRA FINISH * GO WAIT FOR A FINAL KEY
* --------------------------------------------------------------
* SCRIPTING STUFF
* --------------------------------------------------------------
* ----------------------
* SCRCHK
* ----------------------
* TEST STATUS OF SCRIPTING DEVICE, RETURN FLAGS (ZERO IF NOT READY)
SCRCHK MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.W #$11,-(SP)
TRAP #1 * CALL THE PRINTER STATUS FUNCTION
ADDQ.L #2,SP
TST.L D0 * -1 MEANS PRINTER READY, 0 UNAVAILABLE
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* SCRONE
* ----------------------
* SCRIPT THE CHAR IN D0.W
* *** CALLED ONLY FROM SCROUT, PRESERVES ONLY D1/A1 ***
SCRONE MOVEM.L D1/A1,-(SP)
MOVE.W D0,-(SP) * FIRST SET UP STACK
MOVE.W #5,-(SP)
SONEX1 BSR SCRCHK * SEE IF PRINTER IS READY
BEQ SONEX1 * NO, WAIT
TRAP #1 * YES, CALL THE PRINTER OUTPUT FUNCTION
ADDQ.L #4,SP
MOVEM.L (SP)+,D1/A1
RTS
* ----------------------
* SCROUT
* ----------------------
* SCRIPT OUT A LINE, START IN A0, END IN D0, THEN TACK ON A CR/LF
SCROUT MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.L A0,A1 * PRESERVE ARGS
MOVE.L D0,D1
* BSR SCRCHK * SEE IF PRINTER IS READY
* BEQ SCROX3 * NO, JUST EXIT
SUB.L A1,D1 * LENGTH OF STRING
BLE SCROX2 * ZERO, JUST DO THE CR
SCROX1 MOVE.B (A1)+,D0 * NEXT CHAR
ANDI.W #$7F,D0 * MAKE SURE HIGH BITS ARE ZEROED
BSR SCRONE
SUBQ.W #1,D1 * ANY MORE CHARS?
BGT SCROX1 * YES
SCROX2 MOVE.W #13,D0 * CR
BSR SCRONE
MOVE.W #10,D0 * LF
BSR SCRONE
SCROX3 MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* --------------------------------------------------------------
* *** PURE HACKERY ***
* --------------------------------------------------------------
* THE FOLLOWING ROUTINES EXIST TO ALLOW MACINTOSH USERS TO RESTORE A SAVED GAME
* FROM THE DESKTOP (FINDER) LEVEL, SKIPPING THE NORMAL GAME OPENING. THESE
* ROUTINES WILL FUNCTION AT MOST ONE TIME, AS THE GAME BOOTS.
* RESTORE A SAVE FILE CHOSEN FROM THE FINDER
SYSIN2
RTS
* FORCE A DISPLAY OF THE VERSION INFORMATION (IGNORE IF SHOWVE IS NULL)
* RETURN THE "VERSION" STRING IN D0 (ONE CHAR AT A TIME), CR WHEN DONE
* THE STRING IS RETURNED THRU INCHR AND PRETENDS TO BE KEYBOARD INPUT
SHOWTX
RTS * RETURN WITH FLAGS SET CORRECTLY
* DELETE CHARS (THE PROMPT ">") FROM THE OUTPUT BUFFER, IF NECESSARY
* THIS IS CALLED JUST BEFORE FAKING THE "VERSION" COMMAND
DELPRO
RTS
PAGE
* ---------------------------------------------------------------------------
* DISK I/O ROUTINES
* ---------------------------------------------------------------------------
* ----------------------
* OPNGAM
* ----------------------
* OPEN THE GAME FILE, STORE REFNUM, RETURN FLAGS
OPNGAM MOVEM.L D1-D7/A1-A5,-(SP)
JSR _open_game * OPEN THE GAME FILE
TST.L D0 * RETRIEVE THE GAME FILE REF NUMBER
BLT OPNGX1 * ERROR IF NEGATIVE
MOVE.W D0,GAMFIL(A6) * SUCCESS, SAVE IT
CLR.W D0 * RETURN FLAGS, ZERO FOR OK
OPNGX1 MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* CLOSE THE GAME FILE, RETURN FLAGS
CLSGAM MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.W GAMFIL(A6),D0
BEQ.S CLSGX1 * IF ALREADY CLOSED, EXIT
MOVE.L D0,-(SP)
JSR _close_game
ADDQ.W #4,SP
CLR.W GAMFIL(A6) * ALWAYS ZERO WHEN FILE NOT OPEN
CLSGX1 TST.L D0 * RETURN THE RESULT CODE
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* GETBLK
* ----------------------
* GET A GAME FILE BLOCK, BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0
GETBLK MOVEM.L D1,-(SP)
MOVEQ #1,D1 * ONE BLOCK
BSR GTBLKS
MOVEM.L (SP)+,D1 * (MOVEM DOES NOT ALTER FLAGS)
RTS
* GET A SERIES OF GAME FILE BLOCKS
* FIRST BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0, NUMBER OF BLOCKS IN D1
GTBLKS MOVEM.L D2-D7/A1-A5,-(SP)
BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
MOVE.L A0,-(SP) * BUFFER POINTER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.W GAMFIL(A6),D0
MOVE.L D0,-(SP)
JSR _read_file
ADDA.W #16,SP * FLUSH STACK
TST.L D0 * ERROR ON READ?
BNE GTBKX2 * YES, FAIL
GTBKX1 MOVEM.L (SP)+,D2-D7/A1-A5
RTS
* TST.W DSKERR(A6) * BUT WERE WE ASKED TO RETURN WITH FLAGS?
* BNE GTBKX1 * YES
GTBKX2 LEA MSGREA,A0 * ERROR CODE IN D0
BRA FATAL * 'Game file read error'
DATA
MSGREA DC.B 'Story file read error',0
TEXT
PAGE
* --------------------------------------------------------------------------
* SAVE/RESTORE -- DISK I/O ROUTINES
* --------------------------------------------------------------------------
* ----------------------
* DKSWAP
* ----------------------
* PRELIMINARY DIALOG FOR SAVE/RESTORE
* PROMPT USER TO SWAP DISKS AND IDENTIFY DRIVE BEING USED
* RETURN LETTER IN D0, ZERO FOR DEFAULT
* >>> THIS FUNCTION NOW HANDLED WITHIN FILE-SELECT CALL <<<
* ----------------------
* DUPNAM
* ----------------------
* DUPLICATE NAME CHECK/DIALOG (FOR SAVES ONLY)
* CHECK FOR FILENAME CONFLICT, IF SO, PROMPT USER FOR INSTRUCTIONS
* RETURN ZERO TO PROCEED NORMALLY, OTHERWISE ABORT
DUPNAM MOVEM.L D1-D7/A1-A5,-(SP)
JSR _exist_file
MOVE.W D0,D1 * RESULT
BEQ.S DUPX3 * ZERO MEANS NO PROBLEM
DUPX1 LEA MSGDUP,A0
BSR OUTMSG0 * PROMPT, DON'T ADD A CR
DATA
MSGDUP DC.B 'You are about to write over an existing file. '
DC.B 'Proceed? (Y/N) ',0
TEXT
BSR TTYIN * GET A CHAR
CLR.W D1 * ASSUME A NORMAL SAVE
CMPI.B #'Y',D0 * PROCEED?
BEQ.S DUPX2 * YES
CMPI.B #'y',D0
BEQ.S DUPX2 * YES
MOVEQ #1,D1 * NO, ABORT (ANY KEY BESIDES 'Y')
MOVE.B #'N',D0
DUPX2 BSR PUTCHR
BSR PUTNEW * FOLLOW WITH A CR
DUPX3 MOVE.W D1,D0 * RETURN FLAGS FOR RESULT
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* GETSFL
* ----------------------
* POLL USER FOR A FILE NAME, DRIVE, DIRECTORY, ETC (LEAVE IN GLOBAL)
* GIVEN:
* D0.W = SET IF SAVE, 0 IF RESTORE,
* D1.W = SET IF PARTIAL, 0 IF NORMAL,
* A0 -> XZIP "SUGGESTED" NAME, IF ANY (BYTE 0 = LEN)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
GETSFL MOVEM.L D1-D7/A1-A5,-(SP)
EXT.L D0
MOVE.L D0,-(SP) * SAVE/RESTORE
EXT.L D1
MOVE.L D1,-(SP) * NORMAL/PARTIAL
BEQ.S GTSFX2 * IF NORMAL, NO XZIP NAME
CLR.W D0
MOVE.B (A0)+,D0 * NAME, LEN
LEA _filename,A1
MOVEQ #12,D1 * ST: MAX LEN
BSR COPYS * SUGGEST THIS NAME TO USER
GTSFX2 JSR _file_select * _file_select (partial, save)
TST.L (SP)+
MOVE.L (SP)+,D2 * RETRIEVE SAVE FLAG & FLUSH STACK
MOVE.W D0,D1 * FSEL RESULT, NON-ZERO IF CANCEL OR ERROR
BNE.S GTSFX8
BSR SCRNAM * IF OK, OUTPUT FILENAME TO TRANSCRIPT
TST.W D2 * IS THIS A SAVE?
BEQ.S GTSFX8 * NO
BSR DUPNAM * YES, CHECK FOR DUPLICATE FILENAME
MOVE.W D0,D1 * NON-ZERO IF USER SAYS ABORT
GTSFX8 TST.W D1 * RETURN FLAGS
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* NEWSFL
* ----------------------
* CREATE (IF NECESSARY) AND OPEN A SAVE FILE, USING GLOBAL FILENAME
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
NEWSFL MOVEM.L D1-D7/A1-A5,-(SP)
JSR _create_file
TST.L D0
BLT.S NEWSX1 * NEGATIVE MEANS ERROR
MOVE.W D0,SAVFIL(A6) * OTHERWISE, SAVE CHANNEL NUMBER
CLR.W D0
BRA.S NEWSX2
* CMPI.W #-44,D0 * ERROR, DISK IS WRITE-PROTECTED? (SAY SO)
* CMPI.W #-48,D0 * ERROR, NAME EXISTS ALREADY? (IGNORE)
NEWSX1 MOVE.L D0,-(SP)
BSR WPRCHK * IF WRITE-PROTECT ERROR, INFORM USER
MOVE.L (SP)+,D0
NEWSX2 MOVEM.L (SP)+,D1-D7/A1-A5
RTS * RETURN FLAGS
* ----------------------
* OPNSFL
* ----------------------
* OPEN A (RESTORE) FILE, USING GLOBAL FILENAME, LEAVE CHANNEL IN SAVFIL(A6)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
OPNSFL MOVEM.L D1-D7/A1-A5,-(SP)
JSR _open_file
TST.L D0
BLT OPNSX1 * NEGATIVE MEANS ERROR
MOVE.W D0,SAVFIL(A6) * OTHERWISE, SAVE CHANNEL
CLR.W D0 * RETURN ZERO FLAGS
OPNSX1 MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* GTSBKS, SFREAD
* ----------------------
* GET A SERIES OF SAVE FILE BLOCKS
* FIRST BLOCK NUMBER IN D0, # OF BLOCKS IN D1, CORE TARGET LOCATION IN A0
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
GTSBKS BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
SFREAD MOVEM.L D2-D7/A1-A5,-(SP)
MOVE.L A0,-(SP) * BUFFER POINTER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.W SAVFIL(A6),D0
MOVE.L D0,-(SP)
JSR _read_file
ADDA.W #16,SP * FLUSH STACK
TST.L D0 * ZERO MEANS NO ERROR
MOVEM.L (SP)+,D2-D7/A1-A5
RTS
* ----------------------
* PTSBKS, SFWRIT
* ----------------------
* WRITE A SERIES OF SAVE FILE BLOCKS,
* FIRST BLOCK OFFSET IN D0, NUMBER OF BLOCKS IN D1, CORE LOCATION IN A0,
* FILE REF NUMBER IN SAVFIL(A6)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
PTSBKS BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
SFWRIT MOVEM.L D2-D7/A1-A5,-(SP)
MOVE.L A0,-(SP) * BUFFER POINTER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.W SAVFIL(A6),D0
MOVE.L D0,-(SP)
JSR _write_file
ADDA.W #16,SP * FLUSH STACK
MOVE.L D0,-(SP) * ERROR?
BEQ.S PTSBX2 * NO
BGT.S PTSBX1 * YES, POSITIVE RESULT MEANS DISK FULL
BSR WPRCHK * IF WRITE-PROTECT ERROR, INFORM USER
BRA.S PTSBX2
PTSBX1 LEA MSGFUL,A0
BSR OUTMSG * 'Not enough room on disk'
DATA
MSGFUL DC.B 'Not enough room on disk',0
TEXT
PTSBX2 MOVE.L (SP)+,D0 * RETURN FLAGS
MOVEM.L (SP)+,D2-D7/A1-A5
RTS
* ----------------------
* WPRCHK
* ----------------------
* CHECK FOR DISK WRITE-PROTECT ERROR (DURING FILE CREATE AND/OR WRITE)
WPRCHK CMPI.W #-13,D0 * ERROR BECAUSE DISK IS WRITE-PROTECTED?
BNE.S WPRCX1 * NO
LEA MSGWPR,A0 * YES, INFORM USER
BSR OUTMSG * 'Disk is write-protected'
WPRCX1 RTS
DATA
MSGWPR DC.B 'Disk is write-protected',0
TEXT
* ----------------------
* CLSSFL
* ----------------------
* CLOSE A SAVE FILE, CHANNEL IN SAVFIL(A6)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
CLSSFL MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.W SAVFIL(A6),D0
MOVE.L D0,-(SP)
JSR _close_file
ADDQ.W #4,SP
TST.L D0 * NON-ZERO IF ERROR
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* DELSFL
* ----------------------
* DELETE A BAD SAVE FILE, MUST HAVE BEEN ALREADY CLOSED (OR NOT OPENED)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
DELSFL MOVEM.L D1-D7/A1-A5,-(SP)
JSR _delete_file
TST.L D0 * NON-ZERO IF ERROR
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* DEFOLD
* ----------------------
DEFOLD CLR.W D0 * RETRIEVE PREVIOUS DEFAULT NAMES
BRA DEFNX1
DEFNEW MOVEQ #1,D0 * UPDATE PREVIOUS DEFAULT NAMES
DEFNX1 MOVEM.L D1-D7/A1-A5,-(SP)
MOVE.L D0,-(SP)
JSR _new_default * (COPIES SOME GLOBAL STRINGS)
ADDQ.L #4,SP
MOVEM.L (SP)+,D1-D7/A1-A5
RTS
* ----------------------
* CHKDSK
* ----------------------
* CHECK FOR GAME DISK IN DEFAULT DRIVE.
* IF THE GAME ISN'T PRELOADED, A PAGING CRASH IS PREVENTED BY CLOSING AND
* OPENING THE GAME FILE AROUND /EVERY/ SAVE OR RESTORE.
* D0 = 0 TO CLOSE FILE, 1 TO OPEN FILE
*
* IF THE GAME IS FULLY PRELOADED, THE FILE (IF OPEN) IS MERELY CLOSED
* BEFOREHAND. IT WILL BE OPENED AGAIN ONLY UPON DEMAND ($VER OR RESTART).
* THIS NICELY PREVENTS THE TEDIOUS DISK SHUFFLING OTHERWISE REQUIRED OF
* USERS WITH ONLY ONE DRIVE.
*
* [CLOSING IT PREVENTS A NASTY CRASH THAT CAN OCCUR DURING A LATER ATTEMPT.
* IF THE GAME DISK IS REMOVED WITHOUT BEING CLOSED, AND A SAVE OR RESTORE IS
* COMPLETED USING SOME OTHER DISK, THE OS SEEMS TO FORGET THAT THE "ONLINE
* VOLUME" GOT CHANGED.]
CHKDSK TST.W MAXFLG(A6) * IS ENTIRE GAME FILE IN MEMORY?
BEQ.S CHKDSK1 * NO
TST.W D0 * YES, THIS CALL TO "OPEN" GAME FILE?
BNE.S CHKDX5 * YES, JUST EXIT
* ENTER HERE TO FORCE THE "OPEN" (e.g. DURING RESTART AND $VER)
CHKDSK1 MOVEM.L D1/A1,-(SP)
MOVE.W D0,D1 * ZERO MEANS BEFORE
CHKDX1 TST.W D1 * STARTING THE SAVE/RESTORE?
BNE.S CHKDX2 * NO, ENDING
BSR CLSGAM
BEQ.S CHKDX4 * OK, FILE CLOSED, PROCEED
BRA.S CHKDX3 * ERROR
CHKDX2 BSR OPNGAM
BEQ.S CHKDX4 * OK IF IT OPENS, CARRY ON
CHKDX3 LEA MSGNOD,A0 * FAILED, ASK FOR GAME DISK
BSR OUTMSG0 * PROMPT (DON'T ADD A CR)
DATA
MSGNOD DC.B 'Insert the story disk and strike any key to continue ',0
TEXT
BSR TTYIN * WAIT FOR A KEY
BSR PUTNEW * GO TO NEXT LINE
BRA.S CHKDX1 * TRY AGAIN
CHKDX4 MOVEM.L (SP)+,D1/A1
CHKDX5 RTS
PAGE
* ----------------------------------------------------------------------------
* 68000 CALLS FROM C (XDEFS ARE REQUIRED)
* ----------------------------------------------------------------------------
DATA
ZVARS DC.L 0 * CORRECT A6 STORED HERE, MUST RESTORE IF NEEDED
TEXT
* PROCEDURE OUTBUFLEN (charCount: INTEGER) -- adjust Mac folding
* RESET ENDBUF (WHEN NEXT EMPTIED, TO PREVENT BUGS)
* OUTBUFLEN
* MOVE.L ZVARS,A0 * GET ZIP'S VALUE OF A6
* MOVE.W 4(SP),CURSIZ
* MOVE.L D0,MACBUF(A0)
* RTS
* ----------------------------------------------------------------------------
* SCROLLING ROUTINES FOR ATARI ST, OPTIMIZED
* ----------------------------------------------------------------------------
XDEF _mov_mem * (char *p1, *p2; LONG len)
XDEF _clr_mem * (char *p1; LONG len)
* THIS ROUTINE PERFORMS A FAST BLOCKMOVE. ASSUMPTIONS ARE:
* () COPY MUST BE FROM HIGH TO LOW MEMORY IF IT OVERLAPS ("SCROLL UP")
* () MAX LENGTH IS 256K (32K x 16), DUE TO USE OF "DBxx"
MMSRC EQU 8+0 * 8 = 4 (REG) + 4 (RTS)
MMDEST EQU 8+4
MMLEN EQU 8+8
_mov_mem
MOVE.L A1,-(SP)
MOVE.L MMSRC(SP),A0
MOVE.L MMDEST(SP),A1
MOVE.L MMLEN(SP),D0
BEQ.S MMX0 * ZERO LENGTH, EXIT
BSR MOVMEM
MMX0 MOVE.L (SP)+,A1
RTS
* ALTERNATE ENTRY POINT (FOR 68K), TAKES ARGS IN REGS
MOVMEM MOVE.L D1,-(SP)
MOVE.W A0,D1 * CHECK FOR ODD SRC ADDRESS
ANDI.W #1,D1
BNE.S MMX3
MOVE.W A1,D1 * CHECK FOR ODD DEST ADDRESS
ANDI.W #1,D1
BNE.S MMX3
MOVE.L D0,D1
ASR.L #4,D1 * DIVIDE BY 16: QUOTIENT
BRA.S MMX2 * ENTER LOOP AT DBRA
* PHASE 1 COPY -- MAXIMIZE SPEED
MMX1 MOVE.L (A0)+,(A1)+ * COPY 16 BYTES ("UNROLL" FOUR ITERATIONS)
MOVE.L (A0)+,(A1)+
MOVE.L (A0)+,(A1)+
MOVE.L (A0)+,(A1)+
MMX2 DBRA D1,MMX1 * LOOP (32K IS MAXIMUM COUNT)
ANDI.L #$0F,D0 * DIVIDE BY 16: REMAINDER
BEQ.S MMX5 * FALL THROUGH IF ANYTHING LEFT
* PHASE 2 COPY -- HANDLE EXTRA BYTES OR ODD CASES
MMX3 MOVE.B (A0)+,(A1)+ * COPY ONE BYTE
SUBQ.L #1,D0
BNE.S MMX3 * LOOP (NO MAXIMUM COUNT)
MMX5 MOVE.L (SP)+,D1 * DONE
RTS
CMSRC EQU 12+0 * 12 = 8 (REGS) + 4 (RTS)
CMLEN EQU 12+4
_clr_mem
MOVEM.L D1/A1,-(SP)
MOVE.L CMLEN(SP),D0
BEQ.S CMX5 * ZERO, EXIT
MOVE.L CMSRC(SP),A0
MOVE.W A0,D1 * CHECK FOR ODD SRC ADDRESS
ANDI.W #1,D1
BNE.S CMX3
MOVE.L D0,D1
ASR.L #4,D1 * DIVIDE BY 16: QUOTIENT
BRA.S CMX2 * ENTER LOOP AT DBRA
* PHASE 1 "CLEAR" -- MAXIMIZE SPEED
CMX1 CLR.L (A0)+ * CLEAR 16 BYTES ("UNROLL" FOUR ITERATIONS)
CLR.L (A0)+
CLR.L (A0)+
CLR.L (A0)+
CMX2 DBRA D1,CMX1 * LOOP (32K IS MAXIMUM COUNT)
ANDI.L #$0F,D0 * DIVIDE BY 16: REMAINDER
BEQ.S CMX5 * FALL THROUGH IF ANYTHING LEFT
* PHASE 2 "CLEAR" -- HANDLE EXTRA BYTES OR ODD CASES
CMX3 CLR.B (A0)+ * CLEAR ONE BYTE
SUBQ.L #1,D0
BNE.S CMX3 * LOOP (NO MAXIMUM COUNT)
CMX5 MOVEM.L (SP)+,D1/A1
RTS