mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-02-08 01:01:24 +00:00
5005 lines
126 KiB
ArmAsm
5005 lines
126 KiB
ArmAsm
TEXT
|
|
|
|
* ___________________________________________________________________________
|
|
*
|
|
* Z-LANGUAGE INTERPRETER FOR ATARI ST
|
|
*
|
|
* INFOCOM, INC. COMPANY CONFIDENTIAL -- NOT FOR DISTRIBUTION
|
|
* ___________________________________________________________________________
|
|
*
|
|
|
|
* WRITTEN BY: Duncan Blanchard
|
|
*
|
|
* MODIFICATION HISTORY:
|
|
*
|
|
* 02 AUG 85 ZIP A FROZEN
|
|
* 09 AUG 85 CLSGAM CHECKS WHETHER GAME FILE WAS OPENED
|
|
* 09 AUG 85 REBUILT OBJECT FILE WITH NEW LIBRARIES,
|
|
* INCREASED MACHINE STACK TO 2K (IN ZIPSTART)
|
|
* 09 AUG 85 ZIP B FROZEN
|
|
* EZIP A FROZEN
|
|
* 10 FEB 86 PURE PRELOAD MAY EXCEED 32K (PUT, PUTB, PTSIZE)
|
|
* OPSPLT (EZIP) NO LONGER CLEARS SCREEN
|
|
* 10 APR 86 CHANGED PUTCHR (SPECIAL HANDLING FOR TABLE OUTPUT)
|
|
* ADDED SCRNAM, SCRIPTS SAVE/RESTORE FILENAMES
|
|
* 18 APR 86 CHANGED NXTLIN/BUFOUT/LINOUT. BUFOUT CALLS NXTLIN
|
|
* SO [MORE] IS TIMED CORRECTLY DURING BOLDFACE, ETC
|
|
* CHANGED OPATTR AND DQUE INIT, FOR ITALICS HACK
|
|
* FIXED GETMEM, PREVENTS ST BUG WITH ODD MEM REQUEST
|
|
* 08 MAY 86 FIXED QUECHR (QCX2A), ALLOW FOR EMPTY [DUMPED] BUFFER
|
|
* CHANGED OPREAD, ONLY OVERFLOW WORDS ARE FLUSHED
|
|
* 13 MAY 86 LINES(A6) NOW NORMALLY RESET TO ZERO, UPDATED INCHR
|
|
* OPINPUT CHECKS VOBUFF(A6)
|
|
* OPSPLIT CHECKS MAXIMUM SIZE OF split_row
|
|
* NXTLIN TURNS OFF HIGHLIGHTING BEFORE PRINTING [MORE]
|
|
* COMBINED READLN AND INCHR
|
|
* EZIP B FROZEN
|
|
*
|
|
* 02 FEB 87 MODIFIED TO ASSEMBLE/LINK USING LATTICE PRODUCTS
|
|
*
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* REGISTER CONVENTIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* GENERALLY, SINGLE ARGUMENTS ARE PASSED IN D0 OR A0. SINGLE VALUES ARE
|
|
* LIKEWISE RETURNED IN D0 OR A0. IN ANY CASE, THESE ARE SCRATCH REGISTERS
|
|
* AND NEED NOT BE PRESERVED. ALL OTHER REGISTERS, EXCEPT WHERE OTHERWISE
|
|
* SPECIFIED, MUST BE PRESERVED ACROSS EACH SUBROUTINE CALL. NOTE THAT
|
|
* TOP-LEVEL ROUTINES, OPx ROUTINES, ARE EXCLUDED FROM THIS RESTRICTION.
|
|
|
|
* DEDICATED REGISTERS:
|
|
* A7 = SYSTEM SP
|
|
* A6 = FRAME POINTER FOR ZIP VARIABLES *** STATIC ***
|
|
* A5 = unused in this version
|
|
* A4 = VIRTUAL SP
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* ASSEMBLY FLAGS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
EZIP EQU 0 * ASSEMBLES EZIP CODE WHEN CLEAR
|
|
CZIP EQU -1 * ASSEMBLES CLASSIC ZIP CODE WHEN CLEAR
|
|
DEBUG EQU -1 * ASSEMBLES DEBUGGING CODE WHEN CLEAR
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* INDEXING BASE FOR THE DISPATCH TABLE
|
|
* ---------------------------------------------------------------------------
|
|
|
|
ZBASE NOP
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* GENERAL MACRO DEFINITIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* MACRO ZERO
|
|
* MOVEQ #0,%1 * CLEAR A REGISTER QUICKLY (BOTH WORDS)
|
|
* ENDM
|
|
|
|
* MACRO SOB * SUBTRACT ONE AND BRANCH IF NOT ZERO
|
|
* SUBQ.W #1,%1
|
|
* BNE %2
|
|
* ENDM
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* GENERAL EQUATES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
ARG1 EQU 2 * ARGUMENT OFFSETS IN ARGUMENT BLOCK
|
|
ARG2 EQU 4
|
|
ARG3 EQU 6
|
|
ARG4 EQU 8
|
|
|
|
IFEQ EZIP
|
|
|
|
VCHARS EQU 9 * MAX CHARS IN AN EZIP VOCAB WORD
|
|
|
|
OPLEN EQU 63*2 * OBJECT PROPERTY DEFAULT TABLE LENGTH
|
|
OLEN EQU 14 * OBJECT LENGTH
|
|
|
|
LOC EQU 6 * PARENT
|
|
NEXT EQU 8 * NEXT SIBLING
|
|
FIRST EQU 10 * FIRST CHILD
|
|
PROP EQU 12 * PROPERTY TABLE POINTER
|
|
|
|
PMASK EQU $003F * PROPERTY NUMBER IS LOW 6 BITS (OF FIRST ID BYTE)
|
|
PLBIT EQU 6 * PROPERTY LENGTH BIT (IF LENGTH IS TWO OR ONE)
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
VCHARS EQU 6 * MAX CHARS IN A ZIP VOCAB WORD
|
|
|
|
OPLEN EQU 31*2 * OBJECT PROPERTY DEFAULT TABLE LENGTH
|
|
OLEN EQU 9 * OBJECT LENGTH
|
|
|
|
LOC EQU 4 * PARENT
|
|
NEXT EQU 5 * NEXT SIBLING
|
|
FIRST EQU 6 * FIRST CHILD
|
|
PROP EQU 7 * PROPERTY TABLE POINTER
|
|
|
|
PMASK EQU $001F * PROPERTY NUMBER IS LOW 5 BITS (OF SINGLE ID BYTE)
|
|
PLBIT EQU 5 * PROPERTY LENGTH BIT (LOWEST OF 3 LENGTH BITS)
|
|
|
|
ENDC
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* EXTERNALLY DEFINED VARIABLES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
XREF _columns * TOTAL COLUMNS IN DISPLAY
|
|
XREF _cur_column * 0 .. COLUMNS -1
|
|
XREF _rows * TOTAL ROWS IN DISPLAY
|
|
XREF _cur_row * 0 .. ROWS -1
|
|
XREF _split_row * FIRST ROW IN SCROLLING WINDOW
|
|
|
|
XREF _clear_eol
|
|
XREF _clear_lines
|
|
XREF _clear_screen
|
|
XREF _highlight
|
|
XREF _v_italic
|
|
|
|
XREF _curs_addr
|
|
XREF _ms_tick
|
|
XREF _ms_total
|
|
XREF _otim_addr
|
|
|
|
XREF _zalloc
|
|
XREF _filename
|
|
XREF _fullname
|
|
XREF _file_select
|
|
XREF _new_default
|
|
|
|
XREF _open_game * LONG open_game ()
|
|
XREF _close_game * LONG close_game (refnum)
|
|
XREF _create_file
|
|
XREF _open_file
|
|
XREF _read_file
|
|
XREF _write_file
|
|
XREF _close_file
|
|
XREF _delete_file
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* ZIP VARIABLES - INDEXED OFF A6
|
|
* ---------------------------------------------------------------------------
|
|
|
|
ZORKID EQU 0-2 * UNIQUE GAME AND VERSION ID
|
|
TIMEMD EQU ZORKID-2 * HOURS/MINUTES MODE FLAG
|
|
ENDLOD EQU TIMEMD-2 * END OF PRELOAD (FIRST PAGED BLOCK NUMBER)
|
|
PURBOT EQU ENDLOD-2 * END OF IMPURE (FIRST PURE BLOCK NUMBER)
|
|
|
|
VOCTAB EQU PURBOT-4 * VOCABULARY TABLE POINTER
|
|
OBJTAB EQU VOCTAB-4 * OBJECT TABLE POINTER
|
|
GLOTAB EQU OBJTAB-4 * GLOBAL TABLE POINTER
|
|
WRDTAB EQU GLOTAB-4 * FREQUENT WORD TABLE POINTER
|
|
|
|
RBRKS EQU WRDTAB-4 * POINTER TO STRING OF READ-BREAK CHARS
|
|
ESIBKS EQU RBRKS-4 * END OF SELF-INSERTING BREAK CHARS (+1)
|
|
|
|
VWLEN EQU ESIBKS-2 * NUMBER OF BYTES IN A VOCAB WORD ENTRY
|
|
VWORDS EQU VWLEN-2 * NUMBER OF VOCABULARY WORDS
|
|
VOCBEG EQU VWORDS-4 * POINTER TO FIRST VOCAB WORD
|
|
VOCEND EQU VOCBEG-4 * POINTER TO LAST VOCAB WORD
|
|
|
|
PAGTAB EQU VOCEND-4 * POINTER TO PAGE INFORMATION TABLE
|
|
PAGES EQU PAGTAB-4 * POINTER TO START OF PAGE BUFFERS
|
|
|
|
PAGTOT EQU PAGES-2 * NUMBER OF PAGE BUFFERS
|
|
MAXLOD EQU PAGTOT-2 * TOTAL BLOCKS IN GAME
|
|
|
|
TOPSP EQU MAXLOD-4 * TOP OF SYSTEM STACK
|
|
STKBOT EQU TOPSP-4 * BOTTOM OF GAME STACK
|
|
|
|
ZPC1 EQU STKBOT-2 * ZORK PC, BLOCK POINTER (RELATIVE ADDRESS)
|
|
ZPC2 EQU ZPC1-2 * ZORK PC, BYTE POINTER
|
|
ZLOCS EQU ZPC2-4 * POINTER TO LOCALS (ABSOLUTE ADDRESS)
|
|
|
|
RSEED1 EQU ZLOCS-2 * RANDOM NUMBER SEED, HIGH WORD
|
|
RSEED2 EQU RSEED1-2 * LOW WORD
|
|
RCYCLE EQU RSEED2-2 * ZERO MEANS NORMAL, OTHERWISE TOP OF SEQUENCE
|
|
RCONST EQU RCYCLE-2 * CURRENT PLACE IN SEQUENCE
|
|
|
|
BUFFER EQU RCONST-4 * START OF PRELOADED GAME CODE
|
|
ARGBLK EQU BUFFER-18 * 8 ARGS MAX FOR EZIP, PLUS COUNT
|
|
|
|
***
|
|
|
|
RDWSTR EQU ARGBLK-10 * ASCIZ STRING BUFFER (9 CHARS MAX FOR EZIP)
|
|
RDZSTR EQU RDWSTR-6 * ZSTR BUFFER (3 WORDS MAX FOR EZIP)
|
|
|
|
RDBOS EQU RDZSTR-4 * BEGINNING OF INPUT STRING BUFFER
|
|
RDEOS EQU RDBOS-4 * END OF INPUT STRING BUFFER (+1)
|
|
RDRET EQU RDEOS-4 * RETURN TABLE
|
|
|
|
RDNWDS EQU RDRET-2 * NUMBER (BYTE) OF WORDS ACTUALLY READ
|
|
RDBOW EQU RDNWDS-4 * BEGINNING OF CURRENT INPUT WORD
|
|
WRDOFF EQU RDBOW-2 * OFFSET INTO WORD TABLE FOR CURRENT SET
|
|
|
|
* VIRTUAL I/O DEVICES
|
|
|
|
VOCONS EQU WRDOFF-2 * SET FOR SCREEN OUTPUT
|
|
VOPRNT EQU VOCONS-2 * SET FOR SCRIPTING
|
|
VOSTAT EQU VOPRNT-2 * SET FOR STATUS LINE OUTPUT
|
|
VOTABL EQU VOSTAT-2 * SET FOR TABLE OUTPUT
|
|
VOFILE EQU VOTABL-2 * SET FOR FILE OUTPUT
|
|
|
|
VIKEYB EQU VOFILE-2 * SET FOR KEYBOARD INPUT
|
|
VIFILE EQU VIKEYB-2 * SET FOR FILE INPUT
|
|
|
|
VOBUFF EQU VIFILE-2 * SET IF OUTPUT TO SCREEN IS BUFFERED
|
|
VIECHO EQU VOBUFF-2 * SET IF INPUT IS ECHOED
|
|
|
|
DQUE EQU VIECHO-4 * DISPLAY QUE PARAMETER BLOCK
|
|
SQUE EQU DQUE-4 * SCRIPT QUE PARAMETER BLOCK
|
|
|
|
TABOUT EQU SQUE-4 * POINTS TO CURRENT TABLE OUTPUT BUFFER (EZIP)
|
|
TABPTR EQU TABOUT-4 * POINTS TO NEXT TABLE POSITION
|
|
|
|
CURPAG EQU TABPTR-4 * CURRENT PAGE (WHERE ZPC IS) POINTER
|
|
CURBLK EQU CURPAG-2 * CURRENT BLOCK, USUALLY SAME AS ZPC1
|
|
CURTAB EQU CURBLK-4 * CURRENT PAGE TABLE POINTER
|
|
|
|
RTIME EQU CURTAB-4 * REFERENCE TIME, NOW USES 2 WORDS
|
|
LPAGE EQU RTIME-2 * LAST REFERENCED PAGE NUMBER
|
|
LPLOC EQU LPAGE-4 * AND ITS CORE LOCATION
|
|
LPTAB EQU LPLOC-4 * AND ITS TABLE POINTER
|
|
|
|
TIMOUT EQU LPTAB-2 * NONZERO IF OPTIONAL TIMEOUTS ARE IN EFFECT
|
|
TDELAY EQU TIMOUT-2 * DELAY BEFORE TIMEOUT
|
|
TFUNC EQU TDELAY-2 * FUNCTION TO CALL UPON TIMEOUT
|
|
TBEGIN EQU TFUNC-4 * REFERENCE TIME FOR NEXT TIMEOUT
|
|
|
|
***
|
|
|
|
WIND1 EQU TBEGIN-2 * NON-ZERO IF IN WINDOW 1
|
|
OLDWX EQU WIND1-2 * X-CURSOR IN WINDOW 0 BEFORE SPLIT
|
|
OLDWY EQU OLDWX-2 * Y-CURSOR IN WINDOW 0 BEFORE SPLIT
|
|
|
|
LINES EQU OLDWY-2 * LINES DISPLAYED SINCE LAST INPUT
|
|
INLAST EQU LINES-2 * INPUT SETS IT, OUTPUT CLEARS IT, QUIT CHECKS
|
|
CHRTOT EQU INLAST-2 * TOTAL CHARS INPUT SO FAR DURING OPREAD
|
|
|
|
FONT EQU CHRTOT-2 * NONZERO WHEN USING SPECIAL (MONOSPACED) FONT
|
|
MACBUF EQU FONT-4 * NEW VALUE FOR ENDBUF WHEN FONTSIZE CHANGES
|
|
|
|
SLPTR EQU MACBUF-4 * CURRENT POSITION WITHIN STATUS LINE BUFFER
|
|
LOCPTR EQU SLPTR-4 * START OF STATUS LOCATION STRING
|
|
SCOPTR EQU LOCPTR-4 * START OF STATUS SCORE STRING
|
|
|
|
APPARM EQU SCOPTR-4 * HANDLE TO APPLICATION PARAMETERS
|
|
SHOWVE EQU APPARM-4 * POINTER TO "VERSION" STRING, ZERO IF NONE
|
|
|
|
GAMFIL EQU SHOWVE-2 * REF NUMBER OF OPENED GAME FILE
|
|
SAVFIL EQU GAMFIL-2 * REF NUMBER OF OPENED SAVE FILE
|
|
|
|
***
|
|
|
|
DBZPC1 EQU SAVFIL-2 * HALT WHEN ZPC REACHES THIS ADDRESS
|
|
DBZPC2 EQU DBZPC1-2
|
|
DBINST EQU DBZPC2-2 * HALT WHEN NEXT INSTRUCTION HAS THIS VALUE
|
|
|
|
DBTOT1 EQU DBINST-4 * TOTAL EXECUTION COUNT
|
|
DBTOT2 EQU DBTOT1-4 * DESIRED EXECUTION COUNT
|
|
|
|
***
|
|
|
|
ZVLEN EQU 0-DBTOT2 * TOTAL LENGTH OF ZIP'S VARIABLES FRAME
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* ZIP DEBUGGING -- FOR DEVELOPEMENT ONLY
|
|
* ---------------------------------------------------------------------------
|
|
|
|
IFEQ DEBUG
|
|
|
|
* GO UNTIL ONE OF THE FOLLOWING CONDITIONS OCCURS:
|
|
* () ZPC REACHES A GIVEN ADDRESS
|
|
* () ZPC POINTS TO A GIVEN INSTRUCTION
|
|
* () A GIVEN NUMBER OF INSTRUCTIONS ARE EXECUTED
|
|
|
|
DBTEST RTS
|
|
|
|
ENDC * END OF CONDITIONAL ASSEMBLY
|
|
|
|
|
|
PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* INITIALIZATIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
PVERS1 EQU 0 * ZVERSION VERSION BYTE
|
|
PVERS2 EQU 1 * ZVERSION MODE BYTE
|
|
PZRKID EQU 2 * ZORK ID
|
|
PENDLD EQU 4 * ENDLOD (BYTE OFFSET)
|
|
PSTART EQU 6 * START
|
|
PVOCTB EQU 8 * VOCTAB
|
|
POBJTB EQU 10 * OBJTAB
|
|
PGLOTB EQU 12 * GLOTAB
|
|
PPURBT EQU 14 * PURBOT
|
|
PFLAGS EQU 16 * USER FLAGS WORD
|
|
PSERNM EQU 18 * SERIAL NUMBER (6 BYTES)
|
|
PWRDTB EQU 24 * WRDTAB
|
|
PLENTH EQU 26 * LENGTH (EZIP QUADS, ZIP WORDS)
|
|
PCHKSM EQU 28 * CHECKSUM (ALL BYTES STARTING WITH BYTE 64)
|
|
|
|
PINTWD EQU 30 * INTERPRETER ID/VERSION
|
|
PSCRWD EQU 32 * SCREEN SIZE, ROWS/COLUMNS
|
|
|
|
IFEQ EZIP
|
|
ZMVERS EQU 4 * EZIP Z-MACHINE VERSION NUMBER
|
|
STKLEN EQU 512*2 * LENGTH OF GAME STACK (MULTIPLE OF 512)
|
|
ENDC
|
|
IFEQ CZIP
|
|
ZMVERS EQU 3 * CLASSIC Z-MACHINE VERSION NUMBER
|
|
STKLEN EQU 512*1 * LENGTH OF GAME STACK
|
|
ENDC
|
|
|
|
* MICRO'S ID CODE, ZIP'S VERSION LETTER (SEE ALSO OPVERI)
|
|
|
|
DATA
|
|
IFEQ EZIP
|
|
INTWRD DC.B 5 * MACHINE ID FOR ATARI ST
|
|
DC.B 'B' * INTERPRETER VERSION
|
|
SUBVER DC.W 0 * INTRPRETER SUB-VERSION, ZERO TO DISABLE
|
|
ENDC
|
|
IFEQ CZIP
|
|
INTWRD DC.B 0 * (UNUSED)
|
|
DC.B 'B' * INTERPRETER VERSION
|
|
SUBVER DC.W 0 * INTRPRETER SUB-VERSION, ZERO TO DISABLE
|
|
ENDC
|
|
TEXT
|
|
|
|
* INITIAL SET OF READ BREAK CHARS -- SPACE, TAB, CR, <.>, <,>, <?>
|
|
|
|
DATA
|
|
IRBRKS DC.W $2009,$0D2E,$2C3F,0 * ASCIZ
|
|
TEXT
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
XDEF _ZSTART
|
|
|
|
_ZSTART LINK A6,#-ZVLEN * CREATE A FRAME FOR ZIP VARIABLES
|
|
MOVE.L A6,A0 * TOP OF FRAME
|
|
|
|
MOVE.W #ZVLEN/2,D0
|
|
STRX1 CLR.W -(A0) * ALL INITIAL VALUES ARE ZERO
|
|
SUBQ.W #1,D0
|
|
BNE STRX1
|
|
|
|
MOVE.L SP,TOPSP(A6) * SAVE THE SP FOR RESTARTS
|
|
LEA ZVARS,A0
|
|
MOVE.L A6,(A0) * COPY A6 FOR EXTERNAL CALLS INTO ZIP ROUTINES
|
|
|
|
*** careful about error msgs before screen & buffers are initialized ...
|
|
|
|
MOVE.W #1,VOCONS(A6) * OUTPUT ERRORS TO SCREEN FOR NOW (NO BUFFER)
|
|
MOVE.W #1,VIECHO(A6) * INPUT IS NORMALLY ECHOED
|
|
|
|
MOVE.W #1,WIND1(A6) * AVOID PUTCHR/SCRIPTING BUG DURING INIT
|
|
BSR SYSIN1 * OPEN GAME FILE, WINDOW, ETC
|
|
|
|
*** READ GAME BLOCK 0 INTO A TEMP STACK BUFFER ...
|
|
|
|
SUBA.W #512,SP * CREATE THE BUFFER
|
|
MOVE.L SP,A4 * SAVE POINTER HERE FOR NOW
|
|
|
|
MOVE.L A4,A0
|
|
CLR.W D0 * BLOCK 0
|
|
BSR GETBLK * GET IT
|
|
|
|
*** CHECK FOR ID CODE ...
|
|
|
|
CMPI.B #ZMVERS,(A4) * PROPER Z-MACHINE VERSION?
|
|
BEQ.B STRX4 * YES
|
|
|
|
STRX2 CLR.W D0 * SOMETHING WRONG, DIE
|
|
LEA MSGZMV,A0
|
|
BRA FATAL * 'Wrong Z-machine'
|
|
DATA
|
|
MSGZMV DC.B 'Wrong Z-machine version',0
|
|
TEXT
|
|
|
|
*** CHECK MEMORY, SET ENDLOD & PAGTOT, DO PRELOAD
|
|
|
|
STRX4 BSR MEMAVAIL * DETERMINE HOW MUCH FREE MEMORY EXISTS
|
|
MOVE.L D0,D7 * REMEMBER THE AMOUNT
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W PLENTH(A4),D0 * LENGTH OF GAME FILE (WORDS OR QUADS)
|
|
ADD.L D0,D0
|
|
IFEQ EZIP
|
|
ADD.L D0,D0 * BYTES
|
|
ENDC
|
|
|
|
IFEQ DEBUG
|
|
MOVE.L D0,D1
|
|
BSR BYTBLK * TOTAL BLOCKS IN GAME FILE
|
|
MOVE.W D0,MAXLOD(A6) * SAVE FOR DEBUGGING
|
|
MOVE.L D1,D0
|
|
ENDC
|
|
|
|
CMP.L D7,D0 * ENOUGH ROOM TO PRELOAD ENTIRE GAME?
|
|
BLT.B LOAD1 * YES
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W PENDLD(A4),D0 * LENGTH OF PRELOAD SEGMENT (BYTES)
|
|
CMP.L D7,D0 * ENOUGH ROOM FOR IT?
|
|
BLT.B LOAD2 * YES
|
|
|
|
BRA MEMERR * NO, FAIL
|
|
|
|
* WE HAVE MEGA-MEMORY, PRELOAD EVERYTHING ...
|
|
|
|
LOAD1 BSR BYTBLK * LENGTH OF GAME FILE (IN BLOCKS)
|
|
MOVE.W D0,ENDLOD(A6) * MAXIMIZE THE PRELOAD
|
|
|
|
MOVE.W #2,PAGTOT(A6) * MINIMIZE THE PAGING SPACE (FOR $VERIFY)
|
|
BRA.B LOAD3
|
|
|
|
* WE HAVE LIMITED MEMORY, PRELOAD ONLY WHAT'S NEEDED
|
|
|
|
LOAD2 SUB.L D0,D7 * FIRST DETERMINE MEMORY LEFT AFTER PRELOAD
|
|
BSR BYTBLK
|
|
MOVE.W D0,ENDLOD(A6) * LENGTH OF PRELOAD (IN BLOCKS)
|
|
|
|
DIVU #512+8,D7 * PAGES AVAIL (ALLOW 8 BYTES PER TABLE ENTRY)
|
|
CMPI.W #2,D7
|
|
BGE.B LOADX1
|
|
MOVEQ #2,D7 * MUST HAVE AT LEAST TWO (FOR $VERIFY)
|
|
LOADX1 MOVE.W D7,PAGTOT(A6) * MAXIMIZE THE PAGING SPACE
|
|
|
|
LOAD3 MOVE.W ENDLOD(A6),D0 * SPACE NEEDED FOR PRELOAD, IN BLOCKS
|
|
BSR BLKBYT * CONVERT TO BYTES
|
|
BSR GETMEM * GET IT
|
|
|
|
MOVE.L A0,BUFFER(A6) * SAVE POINTER
|
|
MOVE.L A0,A4 * ALSO HERE FOR REMAINING INIT
|
|
|
|
MOVE.W ENDLOD(A6),D1 * NUMBER OF BLOCKS TO PRELOAD
|
|
CLR.W D0 * STARTING WITH BLOCK 0
|
|
BSR GTBLKS * READ THEM IN
|
|
|
|
CLR.W WIND1(A6) * RESTORE NORMAL VALUE
|
|
|
|
* ------------------------------------------------------------------------
|
|
|
|
MOVE.W PZRKID(A4),ZORKID(A6) * UNIQUE GAME ID, CHECKED BY "RESTORE"
|
|
|
|
IFEQ CZIP
|
|
BTST #0,PVERS2(A4) * PROPER BYTE-SWAP MODE?
|
|
BNE.B STRX2 * NO, FAIL
|
|
|
|
CLR.W TIMEMD(A6) * ASSUME SCORE-MODE FOR STATUS LINE
|
|
BTST #1,PVERS2(A4) * TIME MODE REQUESTED?
|
|
BEQ.B STRX6 * NO
|
|
ADDQ.W #1,TIMEMD(A6) * YES, SET TIME-MODE FLAG
|
|
ENDC
|
|
|
|
*** INITIALIZE MAJOR TABLE POINTERS
|
|
|
|
STRX6 MOVEQ #0,D0
|
|
MOVE.W PVOCTB(A4),D0 * RELATIVE VOCAB TABLE POINTER
|
|
ADD.L A4,D0 * ABSOLUTIZE IT
|
|
MOVE.L D0,VOCTAB(A6) * AND SAVE IT
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W POBJTB(A4),D0 * RELATIVE OBJECT TABLE POINTER
|
|
ADD.L A4,D0
|
|
MOVE.L D0,OBJTAB(A6)
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W PGLOTB(A4),D0 * RELATIVE GLOBAL TABLE POINTER
|
|
ADD.L A4,D0
|
|
MOVE.L D0,GLOTAB(A6)
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W PWRDTB(A4),D0 * RELATIVE WORD TABLE POINTER
|
|
ADD.L A4,D0
|
|
MOVE.L D0,WRDTAB(A6)
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W PPURBT(A4),D0 * GET PURBOT BYTE POINTER
|
|
BSR BYTBLK * ROUND UP TO NEXT BLOCK BOUNDARY
|
|
MOVE.W D0,PURBOT(A6) * AND SAVE IT
|
|
|
|
*** ALLOCATE MEMORY FOR Z STACK
|
|
|
|
MOVE.L #STKLEN,D0
|
|
BSR GETMEM
|
|
MOVE.L A0,STKBOT(A6) * THIS WILL BE BOTTOM OF GAME STACK
|
|
|
|
*** INITIALIZE LINE BUFFER, SCRIPT BUFFER
|
|
|
|
SCRLEN EQU 80 * LENGTH OF SCRIPT BUFFER (FIXED FOR NOW)
|
|
MAXLEN EQU 256 * MAX LENGTH OF LINE BUFFER
|
|
|
|
* *** MOVE.W #MAXLEN,D1 * ALLOW FOR A RE-SIZEABLE WINDOW
|
|
MOVE.W _columns,D1 * SIZE OF ATARI SCREEN DISPLAY (40 OR 80)
|
|
MOVE.W D1,D2
|
|
IFEQ EZIP
|
|
SUBQ.W #1,D2 * >>> ALLOW FOR ATARI ITALICS HACK <<<
|
|
ENDC
|
|
LEA LINOUT,A1 * SCREEN DISPLAY FUNCTION
|
|
LEA CHSIZ,A2
|
|
|
|
BSR INITQP * SET UP DISPLAY QUEUE STUFF
|
|
MOVE.L A0,DQUE(A6) * SAVE BLOCK POINTER
|
|
|
|
MOVE.W #SCRLEN,D1 * SCRIPTING SIZE, NEVER CHANGES
|
|
MOVE.W D1,D2
|
|
LEA SCROUT,A1 * SCRIPTING DISPLAY FUNCTION
|
|
LEA CHSIZ,A2
|
|
|
|
BSR INITQP * SET UP SCRIPT QUEUE STUFF
|
|
MOVE.L A0,SQUE(A6) * SAVE THIS POINTER TOO
|
|
|
|
* AND SET UP MACBUF?
|
|
|
|
*** ALLOCATE MEMORY FOR BREAK-CHAR TABLE, INIT VOCABULARY VARS
|
|
|
|
MOVE.L #64,D0 * MAX BREAK CHARS
|
|
BSR GETMEM
|
|
MOVE.L A0,RBRKS(A6) * THIS WILL BE START OF SI BREAK CHARS
|
|
|
|
MOVE.L VOCTAB(A6),A1
|
|
CLR.W D0
|
|
MOVE.B (A1)+,D0 * FIRST BYTE OF VOCTAB IS # OF SI BREAK CHARS
|
|
STRX10 MOVE.B (A1)+,(A0)+ * TRANSFER THEM
|
|
SUBQ.W #1,D0
|
|
BNE STRX10
|
|
|
|
MOVE.L A0,ESIBKS(A6) * REMEMBER END OF SI BREAKS
|
|
LEA IRBRKS,A2 * THESE ARE THE NORMAL BREAK CHARS
|
|
STRX12 MOVE.B (A2)+,(A0)+ * TRANSFER THEM TOO
|
|
BNE STRX12 * ASCIZ
|
|
|
|
CLR.W D0
|
|
MOVE.B (A1)+,D0 * THIS BYTE IS THE LENGTH OF EACH VOCTAB ENTRY
|
|
MOVE.W D0,VWLEN(A6) * SAVE IT
|
|
|
|
MOVE.B (A1)+,D0 * THIS WORD IS THE NUMBER OF VOCTAB ENTRIES
|
|
ASL.W #8,D0
|
|
MOVE.B (A1)+,D0
|
|
MOVE.W D0,VWORDS(A6) * SAVE IT
|
|
|
|
MOVE.L A1,VOCBEG(A6) * THIS IS BEGINNING OF ACTUAL VOCABULARY
|
|
SUBQ.W #1,D0 * CALCULATE POINTER TO LAST VOCAB ENTRY
|
|
MULU VWLEN(A6),D0
|
|
ADDA.L D0,A1
|
|
MOVE.L A1,VOCEND(A6) * AND SAVE IT
|
|
|
|
*** ALLOCATE MEMORY FOR PAGE TABLE & BUFFERS
|
|
|
|
MOVE.W PAGTOT(A6),D0 * PREVIOUSLY CALCULATED NUMBER OF PAGE BUFFERS
|
|
MULU #8,D0 * 8-BYTE TABLE ENTRY FOR EACH PAGE
|
|
ADDQ.L #2,D0 * ALLOW FOR THE END MARK
|
|
BSR GETMEM
|
|
MOVE.L A0,PAGTAB(A6) * THIS WILL BE START OF PAGE TABLE
|
|
|
|
MOVE.W PAGTOT(A6),D0 * PREVIOUSLY CALCULATED NUMBER OF PAGE BUFFERS
|
|
MULU #512,D0 * 512 BYTES EACH
|
|
BSR GETMEM
|
|
MOVE.L A0,PAGES(A6) * PAGES THEMSELVES WILL START HERE
|
|
|
|
*** INITIALIZE THE PAGE TABLE
|
|
|
|
MOVE.W PAGTOT(A6),D0 * PREVIOUSLY CALCULATED NUMBER OF PAGE BUFFERS
|
|
MOVE.L PAGTAB(A6),A0
|
|
|
|
STRX16 MOVE.W #-2,(A0)+ * BLOCK (NO BLOCK "$FFFE")
|
|
CLR.L (A0)+ * REF TIME IS ZERO
|
|
CLR.W (A0)+ * THIS SLOT UNUSED (BUT 8 BYTES SPEEDS CALCS)
|
|
SUBQ.W #1,D0
|
|
BNE STRX16
|
|
MOVE.W #-1,(A0) * MARK THE END OF THE TABLE (NO BLOCK "$FFFF")
|
|
|
|
MOVE.W #-1,CURBLK(A6) * MUST INIT THESE PAGING VARS TOO!
|
|
MOVE.W #-1,LPAGE(A6)
|
|
|
|
* ETCETERA ...
|
|
|
|
BSR GTSEED * INITIALIZE THE RANDOM NUMBER SEEDS
|
|
MOVE.W D0,RSEED1(A6)
|
|
SWAP D0
|
|
MOVE.W D0,RSEED2(A6) * PUT HIGH WORD HERE (RELATIVELY CONSTANT)
|
|
|
|
MOVE.W #1,VOBUFF(A6) * BEGIN BUFFERING OUTPUT
|
|
|
|
IFEQ EZIP
|
|
MOVE.W _columns,D0
|
|
CMPI.W #80,D0 * EZIP REQUIRES 80 COLUMNS MINIMUM
|
|
BGE STRX20 * OK
|
|
|
|
LEA MSG80C,A0 * NOT ENOUGH, INFORM USER AND QUIT
|
|
BSR OUTMSG
|
|
BRA FINISH
|
|
|
|
DATA
|
|
MSG80C DC.B 'Your screen resolution is too low to continue. '
|
|
DC.B 'You must increase the resolution before starting the story.'
|
|
DC.B 0
|
|
TEXT
|
|
ENDC
|
|
|
|
STRX20 BRA.B START1
|
|
|
|
* RESTART EXECUTION HERE
|
|
|
|
RESTRT MOVE.L BUFFER(A6),A0
|
|
MOVE.W PFLAGS(A0),-(SP) * PRESERVE THE USER FLAGS (SCRIPT ETC)
|
|
|
|
CLR.W D0 * REREAD ALL OF THE IMPURE STUFF
|
|
MOVE.W PURBOT(A6),D1
|
|
BSR GTBLKS
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W (SP)+,PFLAGS(A0) * RESTORE FLAGS
|
|
|
|
START1 MOVE.L TOPSP(A6),SP * RESET SYSTEM STACK POINTER
|
|
|
|
MOVE.L DQUE(A6),A0
|
|
MOVE.L BUFPTR(A0),NXTPTR(A0) * INITIALIZE OUTPUT BUFFER POINTER
|
|
|
|
MOVE.L STKBOT(A6),A4
|
|
ADDA.W #STKLEN,A4 * INITIALIZE GAME STACK POINTER
|
|
|
|
MOVE.L A4,ZLOCS(A6) * INITIALIZE POINTER TO LOCALS
|
|
SUBQ.L #2,ZLOCS(A6) * IF ANY, THEY WOULD START AT FIRST SLOT
|
|
|
|
MOVE.L BUFFER(A6),A2
|
|
|
|
IFEQ EZIP
|
|
*** ORI.B #32,PVERS2(A2) * SOUND IS AVAILABLE
|
|
ORI.B #16+8+4+2+1,PVERS2(A2) * CURSOR, HIGHLIGHTS, SPLIT SCREEN
|
|
|
|
MOVE.W INTWRD,PINTWD(A2) * SET INTERPRETER ID/VERSION WORD
|
|
|
|
MOVE.W _rows,D0
|
|
MOVE.W _columns,D1
|
|
ASL.W #8,D0 * ROWS IN HIGH BYTE, COLUMNS IN LOW
|
|
MOVE.B D1,D0
|
|
MOVE.W D0,PSCRWD(A2) * SET SCREEN-PARAMETERS WORD
|
|
|
|
CLR.W RCYCLE(A6) * ALWAYS RESTART WITH NORMAL RANDOMNESS
|
|
|
|
CLR.W _split_row
|
|
BSR EZERR * CHECK OBJTAB ALIGNMENT
|
|
ENDC
|
|
IFEQ CZIP
|
|
BSET #5,PVERS2(A2) * SPLIT-SCREEN IS AVAILABLE
|
|
MOVE.W #1,_split_row * ALLOW FOR STATUS LINE
|
|
ENDC
|
|
|
|
MOVE.W PSTART(A2),D0 * GET STARTING LOCATION
|
|
BSR BSPLTB * SPLIT BLOCK AND BYTE POINTERS
|
|
|
|
MOVE.W D0,ZPC1(A6) * INITIALIZE THE ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BSR NEWZPC * GET THE PAGE TO EXECUTE
|
|
|
|
BSR SYSIN2 * MAC -- BUT LOAD A SAVED GAME IF REQUESTED
|
|
BRA NXTINS * TALLY HO
|
|
|
|
IFEQ EZIP
|
|
|
|
* MAKE SURE OBJ TABLE IS WORD ALIGNED FOR EZIP
|
|
|
|
EZERR MOVE.L BUFFER(A6),A0
|
|
MOVE.W POBJTB(A0),D0 * OBJECT TABLE BASE
|
|
BTST #0,D0 * WORD ALIGNED?
|
|
BNE EZERX1 * NO, FAIL
|
|
RTS
|
|
|
|
EZERX1 CLR.W D0
|
|
LEA MSGEZR,A0
|
|
BRA FATAL * 'OBJTAB alignment error'
|
|
|
|
DATA
|
|
MSGEZR DC.B 'OBJTAB alignment error',0
|
|
TEXT
|
|
|
|
ENDC
|
|
|
|
PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* LOW LEVEL FUNCTIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* GIVEN A ZIP BLOCK COUNT IN D0.W, RETURN A BYTE COUNT IN D0.L
|
|
|
|
BLKBYT EXT.L D0 * CLEAR HIGH WORD
|
|
SWAP D0
|
|
LSR.L #7,D0 * x512
|
|
RTS
|
|
|
|
* GIVEN A BYTE COUNT IN D0.L, RETURN A ZIP BLOCK COUNT IN D0.W, ROUNDING UP
|
|
|
|
BYTBLK MOVE.W D0,-(SP) * SAVE LOW WORD
|
|
LSR.L #8,D0
|
|
LSR.L #1,D0 * EXTRACT BLOCK NUMBER
|
|
|
|
ANDI.W #$01FF,(SP)+ * EXACT MULTIPLE OF 512?
|
|
BEQ.B BYTBX1 * YES
|
|
ADDQ.W #1,D0 * NO, ROUND UP TO NEXT BLOCK
|
|
BYTBX1 RTS
|
|
|
|
* GET CORE WORD, ABSOLUTE POINTER IN A0, RETURN THE WORD IN D0, UPDATE POINTER
|
|
|
|
GTAWRD
|
|
MOVE.B (A0)+,D0 * GET HIGH-ORDER BYTE, ADVANCE A0
|
|
ASL.W #8,D0 * POSITION IT
|
|
MOVE.B (A0)+,D0 * GET LOW-ORDER BYTE, ADVANCE A0
|
|
RTS
|
|
|
|
* UPDATE CORE WORD, ABSOLUTE POINTER IN A0, NEW VALUE IN D0
|
|
|
|
PTAWRD
|
|
MOVE.B D0,1(A0) * STORE LOW-ORDER BYTE
|
|
ASR.W #8,D0
|
|
MOVE.B D0,(A0) * STORE HIGH-ORDER BYTE
|
|
RTS
|
|
|
|
* GET A BYTE FROM GAME, BLOCK-POINTER IN D0, BYTE-POINTER IN D1, RESULT IN D2
|
|
* UPDATE D0 AND D1 TO REFLECT BYTE GOTTEN
|
|
|
|
GETBYT MOVE.W D0,-(SP)
|
|
CMP.W ENDLOD(A6),D0 * IS THIS A PRELOADED LOCATION?
|
|
BGE.B GETBX1 * NO
|
|
|
|
BSR BLKBYT * YES, RECONSTRUCT POINTER (MAY EXCEED 32K)
|
|
OR.W D1,D0
|
|
|
|
CLR.W D2 * CLEAR THE UNWANTED HIGH BYTE
|
|
MOVE.L BUFFER(A6),A0 * ABSOLUTE POINTER
|
|
MOVE.B 0(A0,D0.L),D2 * GET THE DESIRED BYTE
|
|
BRA.B GETBX2
|
|
|
|
GETBX1 BSR GETPAG * FIND THE PROPER PAGE (POINTER RETURNED IN A0)
|
|
CLR.W D2 * CLEAR THE UNWANTED HIGH BYTE
|
|
MOVE.B 0(A0,D1.W),D2 * GET THE DESIRED BYTE
|
|
|
|
GETBX2 MOVE.W (SP)+,D0
|
|
ADDQ.W #1,D1 * UPDATE BYTE-POINTER
|
|
CMPI.W #512,D1 * END OF PAGE?
|
|
BNE.B GETBX3 * NO, DONE
|
|
|
|
CLR.W D1 * YES, CLEAR BYTE-POINTER
|
|
ADDQ.W #1,D0 * AND UPDATE BLOCK-POINTER
|
|
GETBX3 RTS
|
|
|
|
* GET A WORD FROM GAME, BLOCK-POINTER IN D0, BYTE-POINTER IN D1, RESULT IN D2
|
|
|
|
GETWRD BSR GETBYT * GET HIGH-ORDER BYTE
|
|
ASL.W #8,D2 * POSITION IT
|
|
MOVE.W D2,-(SP) * SAVE IT
|
|
|
|
BSR GETBYT * GET LOW-ORDER BYTE
|
|
OR.W (SP)+,D2 * OR IN THE OTHER BYTE
|
|
RTS
|
|
|
|
* GET THE NEXT BYTE, RETURN IT IN D0
|
|
|
|
NXTBYT MOVE.L CURPAG(A6),A0 * INDEX INTO CURRENT PAGE
|
|
ADDA.W ZPC2(A6),A0
|
|
CLR.W D0 * CLEAR HIGH REGISTER AND
|
|
MOVE.B (A0),D0 * GET THE NEXT BYTE
|
|
|
|
ADDQ.W #1,ZPC2(A6) * UPDATE PC
|
|
CMPI.W #512,ZPC2(A6) * END OF PAGE?
|
|
BLT.B NXTBX1 * NO
|
|
|
|
MOVE.W D0,-(SP)
|
|
BSR NEWZPC * YES, UPDATE PAGE
|
|
MOVE.W (SP)+,D0
|
|
NXTBX1 RTS * AND RETURN
|
|
|
|
* GET THE NEXT WORD, RETURN IT IN D0
|
|
|
|
NXTWRD BSR NXTBYT * GET HIGH-ORDER BYTE
|
|
ASL.W #8,D0 * SHIFT TO PROPER POSITION
|
|
MOVE.W D0,-(SP) * SAVE IT
|
|
|
|
BSR NXTBYT * GET LOW-ORDER BYTE
|
|
OR.W (SP)+,D0 * OR IN THE OTHER BYTE
|
|
RTS
|
|
|
|
* GET AN ARGUMENT GIVEN ITS TYPE IN D0
|
|
|
|
GETARG SUBQ.W #1,D0 * EXAMINE ARGUMENT
|
|
BLT.B NXTWRD * 0 MEANT LONG IMMEDIATE
|
|
BEQ.B NXTBYT * 1 MEANT SHORT IMMEDIATE
|
|
|
|
BSR NXTBYT * 2 MEANT VARIABLE, GET THE VAR
|
|
TST.W D0 * STACK?
|
|
BNE.B GETV1 * NO, JUST GET THE VAR'S VALUE
|
|
MOVE.W (A4)+,D0 * YES, POP THE STACK
|
|
RTS
|
|
|
|
* GET VALUE OF A VARIABLE, VAR IN D0, VALUE RETURNED IN D0
|
|
|
|
GETVAR TST.W D0 * STACK?
|
|
BNE.B GETV1 * NO
|
|
MOVE.W (A4),D0 * YES, GET TOP-OF-STACK (DON'T POP)
|
|
RTS
|
|
|
|
GETV1 CMPI.W #16,D0 * LOCAL?
|
|
BGE.B GETVX2 * NO
|
|
MOVE.L ZLOCS(A6),A0 * YES, POINT TO PROPER STACK ELEMENT
|
|
SUBQ.W #1,D0 * ADJUST FOR NULL VAR
|
|
ADD.W D0,D0
|
|
SUBA.W D0,A0 * LOCALS BUILD DOWN
|
|
MOVE.W (A0),D0 * GET IT
|
|
RTS
|
|
|
|
GETVX2 SUB.W #16,D0 * GLOBAL, ADJUST FOR LOCALS
|
|
MOVE.L GLOTAB(A6),A0 * POINT TO PROPER GLOBAL TABLE ELEMENT
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A0
|
|
BRA GTAWRD * GET IT AND RETURN
|
|
|
|
* UPDATE VALUE OF A VARIABLE, VAR IN D0, NEW VALUE IN D1
|
|
|
|
PUTVAR TST.W D0 * STACK?
|
|
BNE.B PUTVX1 * NO
|
|
MOVE.W D1,(A4) * YES, UPDATE TOP-OF-STACK (DON'T PUSH)
|
|
RTS
|
|
|
|
PUTVX1 CMPI.W #16,D0 * LOCAL?
|
|
BGE.B PUTVX2 * NO
|
|
MOVE.L ZLOCS(A6),A0 * YES, POINT TO PROPER STACK ELEMENT
|
|
SUBQ.W #1,D0 * ADJUST FOR NULL VAR
|
|
ADD.W D0,D0
|
|
SUBA.W D0,A0 * LOCALS BUILD DOWN
|
|
MOVE.W D1,(A0) * UPDATE IT
|
|
RTS
|
|
|
|
PUTVX2 SUB.W #16,D0 * GLOBAL, ADJUST FOR LOCALS
|
|
MOVE.L GLOTAB(A6),A0 * POINT TO PROPER GLOBAL TABLE ELEMENT
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A0
|
|
MOVE.W D1,D0
|
|
BRA PTAWRD * UPDATE IT AND RETURN
|
|
|
|
* RETURN VAL IN D0 TO LOCATION SPECIFIED BY NEXTBYTE
|
|
* DESTROYS D1, BUT IS USUALLY CALLED AT END OF TOP-LEVEL FUNCTION
|
|
|
|
BYTVAL ANDI.W #$00FF,D0 * ENTER HERE TO CLEAR HIGH BYTE
|
|
PUTVAL MOVE.W D0,D1 * NORMAL ENTRY
|
|
BSR NXTBYT * GET VAR TO USE
|
|
TST.W D0 * STACK?
|
|
BNE.B PUTVAR * NO, GO STORE VALUE
|
|
MOVE.W D1,-(A4) * YES, PUSH ONTO STACK
|
|
RTS
|
|
|
|
* PREDICATE HANDLERS TRUE AND FALSE
|
|
* DESTROYS REGISTERS, BUT ARE ONLY CALLED FROM END OF TOP-LEVEL FUNCTIONS
|
|
|
|
PFALSE CLR.W D1 * PREDICATE WAS FALSE, CLEAR FLAG
|
|
BRA.B PTRUE1
|
|
|
|
PTRUE MOVEQ #1,D1 * PREDICATE WAS TRUE, SET FLAG
|
|
PTRUE1 BSR NXTBYT * GET FIRST (OR ONLY) PREDICATE JUMP BYTE
|
|
BCLR #7,D0 * NORMAL POLARITY PREDICATE?
|
|
BEQ.B PTRUX1 * NO, LEAVE FLAG ALONE
|
|
ADDQ.W #1,D1 * YES, INCREMENT FLAG
|
|
|
|
PTRUX1 BCLR #6,D0 * ONE-BYTE JUMP OFFSET?
|
|
BNE.B PTRUX3 * YES
|
|
|
|
ASL.W #8,D0 * NO, TWO-BYTE, POSITION HIGH-ORDER OFFSET BYTE
|
|
MOVE.W D0,D2
|
|
BSR NXTBYT * GET LOW-ORDER BYTE
|
|
OR.W D2,D0 * OR IN HIGH-ORDER BITS
|
|
BTST #13,D0 * IS NUMBER NEGATIVE (14-BIT 2'S COMP NUMBER)?
|
|
BEQ.B PTRUX3 * NO
|
|
ORI.W #$C000,D0 * YES, MAKE 16-BIT NUMBER NEGATIVE
|
|
|
|
PTRUX3 SUBQ.W #1,D1 * TEST FLAG
|
|
BEQ.B PTRUX6 * WAS 1, THAT MEANS DO NOTHING
|
|
TST.W D0 * ZERO JUMP?
|
|
BNE.B PTRUX4 * NO
|
|
BRA OPRFAL * YES, THAT MEANS DO AN RFALSE
|
|
|
|
PTRUX4 SUBQ.W #1,D0 * ONE JUMP?
|
|
BNE.B PTRUX5 * NO
|
|
BRA OPRTRU * YES, THAT MEANS DO AN RTRUE
|
|
|
|
PTRUX5 SUBQ.W #1,D0 * ADJUST OFFSET
|
|
ADD.W D0,ZPC2(A6) * ADD TO PC
|
|
BRA NEWZPC * AND UPDATE ZPC STUFF
|
|
PTRUX6 RTS
|
|
|
|
* SPLIT BYTE-POINTER IN D0.W (16 BIT UNSIGNED)
|
|
* INTO BLOCK NUMBER IN D0 & BYTE OFFSET IN D1
|
|
|
|
BSPLTB MOVE.W D0,D1
|
|
LSR.W #8,D0 * EXTRACT THE 7 BLOCK BITS (64K RANGE)
|
|
LSR.W #1,D0
|
|
ANDI.W #$01FF,D1 * EXTRACT THE 9 OFFSET BITS (0-511)
|
|
IFEQ DEBUG
|
|
CMP.W MAXLOD(A6),D0 * VALID BLOCK NUMBER?
|
|
BCC BLKERR * BHS * NO, FAIL
|
|
ENDC
|
|
RTS
|
|
|
|
* SPLIT WORD-POINTER IN D0.W (16 BIT UNSIGNED)
|
|
* INTO BLOCK NUMBER IN D0 & BYTE OFFSET IN D1
|
|
|
|
BSPLIT MOVE.W D0,D1
|
|
LSR.W #8,D0 * EXTRACT THE 8 BLOCK BITS (128K RANGE)
|
|
ANDI.W #$00FF,D1 * EXTRACT THE 8 OFFSET BITS (0-255)
|
|
ADD.W D1,D1 * CONVERT OFFSET TO BYTES
|
|
IFEQ DEBUG
|
|
CMP.W MAXLOD(A6),D0 * VALID BLOCK NUMBER?
|
|
BCC BLKERR * BHS * NO, FAIL
|
|
ENDC
|
|
RTS
|
|
|
|
* SPLIT QUAD-POINTER IN D0.W (16 BIT UNSIGNED)
|
|
* INTO BLOCK NUMBER IN D0 & BYTE OFFSET IN D1 -- EZIP ONLY
|
|
|
|
BSPLTQ MOVE.W D0,D1
|
|
LSR.W #7,D0 * EXTRACT THE 9 BLOCK BITS (256K RANGE)
|
|
ANDI.W #$007F,D1 * EXTRACT THE 7 OFFSET BITS (0-127)
|
|
ADD.W D1,D1 * CONVERT OFFSET TO BYTES
|
|
ADD.W D1,D1
|
|
IFEQ DEBUG
|
|
CMP.W MAXLOD(A6),D0 * VALID BLOCK NUMBER?
|
|
BCC BLKERR * BHS * NO, FAIL
|
|
ENDC
|
|
RTS
|
|
|
|
IFEQ DEBUG
|
|
BLKERR LEA MSGBLK,A0
|
|
BRA FATAL * 'Block range error'
|
|
|
|
DATA
|
|
MSGBLK DC.B 'Block range error',0
|
|
TEXT
|
|
|
|
ENDC
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* ARITHMETIC OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED)
|
|
BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW
|
|
|
|
* DIVIDE BY ZERO, MOD ZERO, & RANDOM ZERO GENERATE 68K HARDWARE TRAPS ...
|
|
|
|
OPDIV EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
BRA PUTVAL * RETURN THE QUOTIENT, IGNORING REMAINDER
|
|
|
|
OPMOD EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
SWAP D0 * GET REMAINDER
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
OPRAND TST.W D7 * (GARBAGE FOR ST ASSEMBLER)
|
|
|
|
IFEQ EZIP
|
|
TST.W D0 * DISABLE RANDOMNESS NOW?
|
|
BLT RANDX1 * YES
|
|
BEQ RANDX2 * ZERO, RE-ENABLE RANDOMNESS
|
|
|
|
TST.W RCYCLE(A6) * IS RANDOMNESS ALREADY DISABLED?
|
|
BNE RANDX3 * YES
|
|
ENDC
|
|
|
|
* NORMAL RANDOMNESS, GENERATE A VALUE
|
|
|
|
MOVE.W RSEED2(A6),D1 * GET BOTH SEEDS
|
|
SWAP D1
|
|
MOVE.W RSEED1(A6),D1
|
|
MOVE.W D1,RSEED2(A6) * UPDATE LOW SEED
|
|
SWAP D1
|
|
|
|
LSR.L #1,D1 * SHIFT BOTH RIGHT BY 1 BIT
|
|
EOR.W D1,RSEED1(A6) * GENERATE OUTPUT & UPDATE HIGH SEED
|
|
MOVE.W RSEED1(A6),D1 * GET NEW HIGH SEED
|
|
|
|
ANDI.L #$00007FFF,D1 * CLEAR HIGH BIT TO PREVENT POSSIBLE OVERFLOW
|
|
DIVU D0,D1 * DIVIDE ARG INTO RANDOM NUMBER
|
|
SWAP D1 * GET REMAINDER
|
|
ADDQ.W #1,D1 * MUST BE BETWEEN 1 AND N, INCLUSIVE
|
|
MOVE.W D1,D0
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
IFEQ EZIP
|
|
|
|
*** GENERATE A NON-RANDOM SEQUENCE HENCEFORTH
|
|
|
|
RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE
|
|
RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT
|
|
BRA.B RANDX4 * AND INITIALIZE COUNTER (SEQ BEGINS NEXT PASS)
|
|
|
|
RANDX3 MOVE.W RCONST(A6),D0 * GENERATE NEXT VALUE IN SEQUENCE
|
|
ADDQ.W #1,D0
|
|
CMP.W RCYCLE(A6),D0 * EXCEEDED THE UPPER LIMIT YET?
|
|
BLE.B RANDX4 * NO
|
|
MOVEQ #1,D0 * YES, RESTART THE SEQUENCE
|
|
|
|
RANDX4 MOVE.W D0,RCONST(A6) * UPDATE COUNTER
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
ENDC
|
|
|
|
OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2?
|
|
BLT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2?
|
|
BGT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PRECICATE FALSE
|
|
|
|
|
|
* LOGICAL OPERATIONS
|
|
|
|
OPBTST NOT.W D0 * TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1
|
|
AND.W D0,D1
|
|
BEQ PTRUE * SUCCESS IF OPR2 COMPLETELY CLEARED
|
|
BRA PFALSE
|
|
|
|
OPBOR OR.W D1,D0 * LOGICAL "OR"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
OPBCOM NOT.W D0 * LOGICAL COMPLEMENT
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
OPBAND AND.W D1,D0 * LOGICAL "AND"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
|
|
* GENERAL PREDICATES
|
|
|
|
OPQEQU NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W (A0)+,D1 * NUMBER OF OPERANDS
|
|
MOVE.W (A0)+,D0 * OPR1
|
|
SUBQ.W #1,D1
|
|
|
|
QEQUX1 CMP.W (A0)+,D0 * IS NEXT OPR EQUAL TO OPR1?
|
|
BEQ.B QEQUX2 * YES
|
|
SUBQ.W #1,D1 * NO, BUT LOOP IF MORE OPERANDS
|
|
BNE QEQUX1
|
|
|
|
BRA PFALSE * PREDICATE FALSE
|
|
QEQUX2 BRA PTRUE * PREDICATE TRUE
|
|
|
|
|
|
OPQZER TST.W D0 * IS OPR ZERO?
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT-RELATED PRIMITIVES
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* GIVEN OBJECT NUMBER IN D0.W, RETURN OBJECT LOCATION IN A0
|
|
|
|
OBJLOC MULU #OLEN,D0 * CALCULATE OBJECT OFFSET
|
|
MOVE.L OBJTAB(A6),A0
|
|
ADDA.L D0,A0 * INDEX INTO OBJECT TABLE
|
|
ADDA.W #OPLEN-OLEN,A0 * SKIPPING OVER THE DEFAULT PROPERTY TABLE
|
|
RTS
|
|
|
|
* GIVEN OBJECT LOCATION IN A0, RETURN POINTER TO FIRST PROPERTY IN A0
|
|
|
|
FSTPRP ADDA.W #PROP,A0 * POINT TO PROPERTY TABLE SLOT
|
|
MOVEQ #0,D0
|
|
BSR GTAWRD * GET ITS LOCATION
|
|
MOVE.L BUFFER(A6),A0 * ABSOLUTIZE THE LOCATION
|
|
ADDA.L D0,A0
|
|
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * LENGTH OF SHORT DESCRIPTION IN WORDS
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A0 * ADJUST POINTER TO SKIP IT
|
|
RTS
|
|
|
|
* GIVEN POINTER TO A PROPERTY ID IN A0, UPDATE IT TO POINT TO NEXT PROPERTY ID
|
|
|
|
IFEQ EZIP
|
|
|
|
NXTPRP MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.B NXTPX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BEQ.B NXTPX2 * NO, PROPERTY LENGTH IS 1
|
|
ADDQ.L #1,A0
|
|
NXTPX2 ADDQ.L #1,A0 * UPDATE POINTER
|
|
RTS
|
|
|
|
NXTPX4 MOVE.B (A0)+,D0 * GET (SECOND) PROPERTY LENGTH BYTE (LOW 6 BITS)
|
|
ANDI.W #$003F,D0 * CLEAR OFF HIGH BITS
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
NXTPRP CLR.W D0
|
|
MOVE.B (A0)+,D0 * GET PROPERTY ID BYTE
|
|
ASR.W #5,D0 * EXTRACT PROPERTY LENGTH-1 (HIGH 3 BITS)
|
|
ADDQ.W #1,D0 * ADJUST FOR EXTRA LENGTH BYTE
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDC
|
|
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* MOVE (OBJ1 INTO OBJ2)
|
|
|
|
OPMOVE MOVEM.W D1/D0,-(SP) * PROTECT OPERANDS FROM REMOVE CALL
|
|
BSR OPREMO * REMOVE OBJ1 FROM WHEREVER IT IS
|
|
|
|
MOVE.W 2(SP),D0 * OBJ2
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1 * SAVE IT
|
|
MOVE.W (SP),D0 * OBJ1
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
|
|
MOVEM.W (SP)+,D0/D1 * RESTORE THE OBJ NUMBERS
|
|
|
|
IFEQ EZIP
|
|
MOVE.W FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.W D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.W D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDC
|
|
IFEQ CZIP
|
|
MOVE.B FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.B D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.B D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDC
|
|
RTS
|
|
|
|
* REMOVE (OBJ FROM ITS PARENT)
|
|
|
|
IFEQ EZIP
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.W LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.B REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.W FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.B REMOX1 * NO
|
|
|
|
MOVE.W NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.B REMOX2 * AND EXIT
|
|
|
|
REMOX1 BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.W NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.B REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.W NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.W LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.W NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.B LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.B REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.B FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.B REMOX1 * NO
|
|
|
|
MOVE.B NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.B REMOX2 * AND EXIT
|
|
|
|
REMOX1 ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.B NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.B REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.B NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.B LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.B NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
ENDC
|
|
|
|
* LOC (RETURN CONTAINER OF OBJ)
|
|
|
|
OPLOC BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W LOC(A0),D0 * GET PARENT
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B LOC(A0),D0 * GET PARENT, CLEARING UNUSED BYTE
|
|
ENDC
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* FIRST? (RETURN FIRST CHILD OF OBJ, FAIL IF NONE)
|
|
|
|
OPQFIR BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W FIRST(A0),D0 * GET FIRST CHILD
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B FIRST(A0),D0 * GET FIRST CHILD, CLEARING UNUSED BYTE
|
|
ENDC
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* NEXT? (RETURN THE NEXT SIBLING OF OBJ, FAIL IF NONE)
|
|
|
|
OPQNEX BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
MOVE.W NEXT(A0),D0 * GET SIBLING
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B NEXT(A0),D0 * GET SIBLING, CLEARING UNUSED BYTE
|
|
ENDC
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* IN? (IS OBJ1 CONTAINED IN OBJ2?)
|
|
|
|
OPQIN BSR OBJLOC * FIND OBJ1'S LOCATION
|
|
|
|
IFEQ EZIP
|
|
CMP.W LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDC
|
|
IFEQ CZIP
|
|
CMP.B LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDC
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
|
|
|
|
OPGETP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.B GETPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GETPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GETPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.B GETPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BLT.B GETPX3 * IF LESS, NO SUCH PROPERTY, USE DEFAULT
|
|
|
|
* *** ASSUME NO 2ND EZIP LENGTH BYTE EXISTS HERE! ***
|
|
|
|
BTST #PLBIT,(A0)+ * GOT IT, EXAMINE (LOW MODE OR) LOWEST LEN BIT
|
|
BNE.B GETPX4 * ONE MEANS WORD VALUE, OTHERWISE BYTE VALUE
|
|
|
|
MOVE.B (A0),D0 * GET THE BYTE
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
GETPX3 SUBQ.W #1,D1 * PROPERTY NOT FOUND, USE DEFAULT PROP TABLE
|
|
ADD.W D1,D1 * WORD OFFSET
|
|
MOVE.L OBJTAB(A6),A0 * GET BASE OF DEFAULT TABLE
|
|
ADDA.W D1,A0 * POINT TO THE DEFAULT PROPERTY
|
|
|
|
GETPX4 BSR GTAWRD * GET THE WORD VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* PUTP (CHANGE VALUE OF SPECIFIED PROPERTY OF OBJ, ERROR IF BAD PROP NUMBER)
|
|
|
|
OPPUTP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.B PUTPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
PUTPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
PUTPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.B PUTPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.B PUTPX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGPUP,A0
|
|
BRA FATAL * 'Non-existant put property'
|
|
|
|
DATA
|
|
MSGPUP DC.B 'Non-existant put property',0
|
|
TEXT
|
|
|
|
* *** ASSUME NO 2ND EZIP LENGTH BYTE EXISTS HERE! ***
|
|
|
|
PUTPX3 BTST #PLBIT,(A0)+ * EXAMINE (LOW MODE OR) LOWEST LENGTH BIT
|
|
BNE.B PUTPX4 * ZERO MEANS BYTE VALUE, OTHERWISE WORD VALUE
|
|
|
|
MOVE.B D2,(A0) * STORE THE NEW BYTE
|
|
RTS
|
|
|
|
PUTPX4 MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE NEW WORD
|
|
|
|
* NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROP IN OBJ)
|
|
|
|
OPNEXT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
TST.W D1 * WERE WE GIVEN ZERO AS PROP?
|
|
BEQ.B NEXTX4 * YES, JUST RETURN FIRST PROPERTY NUMBER
|
|
BRA.B NEXTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
NEXTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.B NEXTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.B NEXTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGNXP,A0
|
|
BRA FATAL * 'Non-existant next property'
|
|
|
|
DATA
|
|
MSGNXP DC.B 'Non-existant next property',0
|
|
TEXT
|
|
|
|
NEXTX3 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX4 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * EXTRACT PROPERTY NUMBER
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* -----------------------------------------------------------------------------
|
|
* PRIMITIVE TO LOCATE A FLAG BIT
|
|
* -----------------------------------------------------------------------------
|
|
|
|
* GIVEN A POINTER TO FIRST FLAGS BYTE IN A0, TARGET FLAG NUMBER (0-47) IN D0
|
|
* RETURN POINTER TO TARGET FLAGS BYTE IN A0, TARGET BIT NUMBER (7-0) IN D0
|
|
|
|
FLGLOC MOVE.W D0,-(SP)
|
|
LSR.W #3,D0 * EXTRACT BYTE OFFSET
|
|
ADD.W D0,A0 * ADJUST FLAGS POINTER
|
|
|
|
MOVE.W (SP)+,D0
|
|
NOT.W D0 * FIX THE 3 LOW-ORDER BITS
|
|
ANDI.W #$0007,D0 * MASK OFF THE REST
|
|
RTS
|
|
|
|
* ADDQ.L #1,A0 * POINT TO NEXT FLAGS BYTE
|
|
* SUBQ.W #8,D0 * WAS TARGET FLAG IN PREVIOUS BYTE?
|
|
* BGE.B FLGLOC * NO
|
|
|
|
* SUBQ.L #1,A0 * YES, POINT TO PREVIOUS FLAGS BYTE
|
|
* NEG.W D0 * AND COMPUTE THE TARGET BIT NUMBER (7-0)
|
|
* SUBQ.W #1,D0
|
|
* RTS
|
|
|
|
* FSET? (IS FLAG SET IN OBJ?)
|
|
|
|
OPQFSE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BTST D0,(A0) * IS THE SPECIFIED BIT SET?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* FSET (SET A FLAG IN OBJ)
|
|
|
|
OPFSET BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BSET D0,(A0) * SET THE SPECIFIED BIT
|
|
RTS
|
|
|
|
* FCLEAR (CLEAR A FLAG IN OBJ)
|
|
|
|
OPFCLE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BCLR D0,(A0) * CLEAR THE SPECIFIED BIT
|
|
RTS
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* TABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* GET (GET THE ITEM'TH WORD FROM TABLE)
|
|
|
|
OPGET ASL.W #1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETWRD * GET THE WORD
|
|
MOVE.W D2,D0
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* GETB (GET THE ITEM'TH BYTE FROM TABLE)
|
|
|
|
OPGETB ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETBYT * GET THE BYTE
|
|
MOVE.W D2,D0
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
|
|
* NOTE: PROPERTY TABLE POINTERS IN THE NEXT FOUR ROUTINES NOW !MAY!
|
|
* EXCEED 32K, SO SIGN-EXTENSIONS MUST BE AVOIDED.
|
|
|
|
* A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER
|
|
|
|
* PUT (REPLACE THE ITEM'TH WORD IN TABLE)
|
|
|
|
OPPUT ASL.W #1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L D0,A0
|
|
ADD.L BUFFER(A6),A0 * ABSOLUTIZE POINTER
|
|
MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE WORD
|
|
|
|
* PUTB (REPLACE THE ITEM'TH BYTE IN TABLE)
|
|
|
|
OPPUTB ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.B D2,0(A0,D0.L) * STORE THE BYTE
|
|
RTS
|
|
|
|
* GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN OBJ, PROP)
|
|
|
|
OPGTPT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.B GTPTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GTPTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GTPTX2 MOVE.B (A0),D0 * GET (FIRST) PROPERTY ID BYTE
|
|
ANDI.W #PMASK,D0 * CLEAN OFF MODE/LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.B GTPTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.B GTPTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, RETURN ZERO FOR NO SUCH PROPERTY
|
|
BRA.B GTPTX5
|
|
|
|
IFEQ EZIP
|
|
GTPTX3 MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * IS THERE A SECOND LENGTH BYTE?
|
|
BEQ.B GTPTX4 * NO
|
|
ADDQ.L #1,A0 * YES, SKIP IT TOO
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
GTPTX3 ADDQ.L #1,A0 * POINT TO PROPERTY VALUE
|
|
ENDC
|
|
|
|
GTPTX4 MOVE.L A0,D0
|
|
SUB.L BUFFER(A6),D0 * RE-RELATIVIZE POINTER
|
|
GTPTX5 BRA PUTVAL * AND RETURN IT
|
|
|
|
* PTSIZE (GIVEN POINTER TO PROPERTY TABLE, RETURN ITS SIZE)
|
|
|
|
OPPTSI MOVE.L BUFFER(A6),A0
|
|
ANDI.L #$FFFF,D0 * MAKE THE TABLE PTR A LONGWORD
|
|
ADDA.L D0,A0 * ABSOLUTIZE THE TABLE POINTER
|
|
|
|
IFEQ EZIP
|
|
MOVE.B -1(A0),D0 * GET MODE/ID BYTE OR LEN BYTE (EITHER WORKS!)
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.B PTSIX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BNE.B PTSIX2 * YES
|
|
MOVEQ #1,D0 * NO, PROPERTY LENGTH IS 1
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX2 MOVEQ #2,D0
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX4 ANDI.W #PMASK,D0 * LENGTH IS LOW 6 BITS
|
|
BRA PUTVAL * RETURN IT
|
|
ENDC
|
|
IFEQ CZIP
|
|
CLR.W D0
|
|
MOVE.B -1(A0),D0 * GET THE PROP IDENTIFIER BYTE
|
|
ASR.W #5,D0 * EXTRACT LENGTH BITS
|
|
ADDQ.W #1,D0 * ADJUST TO ACTUAL LENGTH
|
|
BRA PUTVAL * RETURN IT
|
|
ENDC
|
|
|
|
IFEQ EZIP
|
|
|
|
* INTBL? (IS ANY IN TABLE OF LENGTH INT?)
|
|
|
|
OPINTBL NOP * USE ARGBLOCK
|
|
MOVE.W ARG2(A0),D0 * RELATIVE BYTE ADDRESS OF TABLE
|
|
BSR BSPLTB * SPLIT IT
|
|
MOVE.W ARG1(A0),D3 * VALUE TO SEARCH FOR (WORD)
|
|
MOVE.W ARG3(A0),D4 * LENGTH OF TABLE (WORDS)
|
|
|
|
ITBX1 BSR GETWRD * GET NEXT TABLE ITEM IN D2
|
|
CMP.W D2,D3 * MATCH?
|
|
BEQ ITBX2 * YES
|
|
SUBQ.W #1,D4 * END OF TABLE?
|
|
BGT ITBX1 * NO, CONTINUE SEARCH
|
|
|
|
CLR.W D0 * FAILED, RETURN ZERO
|
|
BSR PUTVAL
|
|
BRA PFALSE * PREDICATE FALSE
|
|
|
|
ITBX2 ASL.W #8,D0 * SUCCESS, UNSPLIT THE POINTER
|
|
ASL.W #1,D0
|
|
ADD.W D1,D0
|
|
SUBQ.W #2,D0 * BACK UP TWO BYTES, SINCE GETWRD ADVANCES
|
|
BSR PUTVAL * RETURN THE RELATIVE POINTER
|
|
BRA PTRUE * PREDICATE TRUE
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
OPINTBL BRA OPERR * THIS FUNCTION UNDEFINED IN ZIP
|
|
ENDC
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* VARIABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* VALUE (GET VALUE OF VARIABLE)
|
|
|
|
OPVALU BSR GETVAR * GET THE VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* SET (VAR TO VALUE)
|
|
|
|
OPSET BRA PUTVAR * STORE THE VALUE
|
|
|
|
* PUSH (A VALUE ONTO THE GAME STACK)
|
|
|
|
OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE
|
|
RTS
|
|
|
|
* POP (A VALUE OFF THE GAME STACK INTO VAR)
|
|
|
|
OPPOP MOVE.W (A4)+,D1 * POP A VALUE
|
|
BRA PUTVAR * AND STORE IT
|
|
|
|
* INC (INCREMENT VAR)
|
|
|
|
OPINC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE THE NEW VALUE
|
|
|
|
* DEC (DECREMENT VAR)
|
|
|
|
OPDEC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE NEW VALUE
|
|
|
|
* IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
|
|
|
|
OPQIGR MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE GREATER THAN VAL?
|
|
BGT.B QIG2 * YES
|
|
QIG1 BSR PUTVAR * NO, STORE THE NEW VALUE
|
|
BRA PFALSE * AND RETURN PREDICATE FALSE
|
|
|
|
QIG2 BSR PUTVAR * STORE THE NEW VALUE
|
|
BRA PTRUE * AND RETURN PREDICATE TRUE
|
|
|
|
* DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
|
|
|
|
OPQDLE MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE LESS THAN VAL?
|
|
BLT.B QIG2 * YES
|
|
BRA.B QIG1 * NO
|
|
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* I/O OPERATIONS -- INPUT
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* READ (A LINE OF INPUT AND TOKENIZE IT)
|
|
|
|
OPREAD NOP * USE AN ARGUMENT BLOCK
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W ARG1(A0),D0 * INPUT BUFFER POINTER
|
|
ADD.L BUFFER(A6),D0 * ABSOLUTIZE IT
|
|
MOVE.L D0,RDBOS(A6) * SAVE IT
|
|
|
|
MOVEQ #0,D1
|
|
MOVE.W ARG2(A0),D1 * RETURN BUFFER POINTER
|
|
ADD.L BUFFER(A6),D1 * ABSOLUTIZE IT
|
|
MOVE.L D1,RDRET(A6) * SAVE IT
|
|
|
|
IFEQ CZIP
|
|
BSR OPUSL * UPDATE STATUS LINE
|
|
ENDC
|
|
|
|
*** GATHER THE INPUT LINE ...
|
|
|
|
CLR.W LINES(A6) * RESET COUNTER, PREVENTS A SPURIOUS [MORE]
|
|
BSR PUTLIN * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT)
|
|
|
|
CLR.W D0
|
|
MOVE.L RDBOS(A6),A0 * START OF INPUT LINE BUFFER
|
|
MOVE.B (A0)+,D0 * BUFFER LENGTH, STORED IN FIRST BYTE
|
|
BSR READLN
|
|
MOVE.L A0,RDEOS(A6) * END OF USER INPUT
|
|
|
|
*** LOWER-CASIFY THE INPUT LINE ...
|
|
|
|
MOVE.L RDBOS(A6),A1 * START OF INPUT BUFFER
|
|
ADDQ.L #1,A1 * SKIP LENGTH BYTE
|
|
BRA.B RDX1B
|
|
|
|
RDX1A MOVE.B (A1),D0
|
|
BSR LCASE
|
|
MOVE.B D0,(A1)+
|
|
|
|
RDX1B CMPA.L RDEOS(A6),A1 * END OF INPUT?
|
|
BLT.B RDX1A * NOT YET
|
|
|
|
*** WORDIFY THE INPUT LINE ...
|
|
|
|
MOVE.L A4,-(SP) * SAVE THE GAME SP
|
|
MOVE.L RDBOS(A6),A2
|
|
ADDQ.L #1,A2 * START OF INPUT BUFFER, SKIP LENGTH BYTE
|
|
|
|
MOVE.L RDRET(A6),A4
|
|
ADDQ.L #2,A4 * RETURN BUFFER, SKIP MAX WORDS AND NWORDS
|
|
CLR.B RDNWDS(A6) * NO WORDS FOUND INITIALLY
|
|
|
|
RDX1 LEA RDWSTR(A6),A3 * HERE FOR NEXT WORD, POINT TO EMPTY BUFFER
|
|
MOVE.L A2,RDBOW(A6) * BEGINNING OF NEXT WORD
|
|
|
|
RDX2 CMPA.L RDEOS(A6),A2 * END OF INPUT STRING?
|
|
BNE.B RDX3 * NO
|
|
LEA RDWSTR(A6),A0 * YES, GET WORD STRING POINTER
|
|
CMPA.L A3,A0 * WAS A WORD FOUND?
|
|
BEQ RDX10 * NO, WE'RE DONE
|
|
BRA.B RDX8 * YES, MUST STILL LOOKUP WORD
|
|
|
|
RDX3 MOVE.B (A2)+,D0 * GET NEXT CHAR FROM INPUT BUFFER
|
|
MOVE.L RBRKS(A6),A1 * POINTER, LIST OF READ-BREAK CHARACTERS
|
|
|
|
RDX4 CMP.B (A1)+,D0 * SEARCH LIST FOR THIS ONE
|
|
BEQ.B RDX5 * FOUND IT
|
|
TST.B (A1) * END OF LIST?
|
|
BNE RDX4 * NO, CONTINUE SEARCH
|
|
|
|
LEA RDWSTR(A6),A0 * IT'S NOT A BREAK CHAR
|
|
ADDA.W #VCHARS,A0 * END OF WORD STRING BUFFER (ZIP OR EZIP)
|
|
CMPA.L A0,A3 * FULL YET?
|
|
BEQ RDX2 * YES, FLUSH CHAR & LOOP UNTIL BREAK IS FOUND
|
|
MOVE.B D0,(A3)+ * NO, TACK THIS CHAR ONTO STRING
|
|
BRA RDX2 * AND LOOP FOR NEXT
|
|
|
|
*** BREAK CHAR FOUND ...
|
|
|
|
RDX5 LEA RDWSTR(A6),A0
|
|
CMPA.L A3,A0 * WORD READ BEFORE THIS BREAK?
|
|
BNE.B RDX7 * YES, GO FOR IT
|
|
CMPA.L ESIBKS(A6),A1 * NO, BUT WAS THIS A SELF-INSERTING BREAK?
|
|
BHI.B RDX1 * NO, GO FOR NEXT WORD
|
|
|
|
MOVE.B D0,(A3)+ * YES, STORE THE BREAK IN WORD STRING
|
|
BRA.B RDX8 * AND GO FOR THE ZWORD
|
|
|
|
RDX7 SUBQ.L #1,A2 * UNREAD TERMINATING BREAK IN CASE IT WAS SI
|
|
RDX8 ADDQ.B #1,RDNWDS(A6) * INCREMENT FOUND WORD COUNT
|
|
MOVE.B RDNWDS(A6),D0 * GET NEW COUNT
|
|
|
|
MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER (1ST BYTE MAX WORDS)
|
|
CMP.B (A0),D0 * FOUND WORD COUNT GREATER THAN MAX ALLOWED?
|
|
BLE.B RDX9 * NO
|
|
|
|
BSR PUTNEW * YES, INFORM LOSER
|
|
LEA MSGIO1,A0
|
|
BSR OUTMSG0 * '[Too many words ... "'
|
|
|
|
DATA
|
|
MSGIO1 DC.B '[Too many words typed, discarding ',$22,0
|
|
TEXT
|
|
|
|
MOVE.L RDEOS(A6),A1 * END OF INPUT STRING (+1)
|
|
MOVE.B (A1),-(SP) * SAVE THIS BYTE TO BE SAFE
|
|
CLR.B (A1) * MAKE STRING ASCIZ
|
|
|
|
MOVE.L RDBOW(A6),A0 * START OF FLUSHED WORD/STRING
|
|
BSR OUTMSG0 * ECHO IT
|
|
MOVE.B (SP)+,(A1) * RESTORE LAST BYTE
|
|
|
|
LEA MSGIO2,A0
|
|
BSR OUTMSG * '."]'
|
|
|
|
DATA
|
|
MSGIO2 DC.B '.',$22,']',0
|
|
TEXT
|
|
|
|
BSR PUTNEW
|
|
SUBQ.B #1,RDNWDS(A6) * THE LATEST WORD IS FLUSHED
|
|
BRA RDX10 * AND WE'RE DONE
|
|
|
|
*** BUILD THE ZWORD TABLE ...
|
|
|
|
RDX9 MOVE.L A2,D0 * CALCULATE NUMBER OF CHARS IN CURRENT WORD
|
|
SUB.L RDBOW(A6),D0
|
|
MOVE.B D0,2(A4) * STORE THE NUMBER IN RETURN TABLE
|
|
|
|
MOVE.L RDBOW(A6),D0 * CALCULATE BYTE OFFSET OF BEGINNING OF WORD
|
|
SUB.L RDBOS(A6),D0
|
|
MOVE.B D0,3(A4) * STORE THAT NUMBER TOO
|
|
|
|
CLR.B (A3) * MAKE WORD STRING ASCIZ
|
|
LEA RDWSTR(A6),A1
|
|
LEA RDZSTR(A6),A0
|
|
BSR ZWORD * AND CONVERT TO (2 OR 3 WORD) ZWORD
|
|
|
|
LEA RDZSTR(A6),A0
|
|
BSR LOOKUP * SEARCH VOCAB TABLE FOR ZWORD, RETURN OFFSET
|
|
|
|
MOVE.L A4,A0 * CURRENT RETURN TABLE SLOT
|
|
BSR PTAWRD * STORE THE OFFSET
|
|
ADDQ.L #4,A4 * UPDATE THE TABLE POINTER FOR NEXT WORD
|
|
BRA RDX1 * GO FOR IT
|
|
|
|
RDX10 MOVE.L RDRET(A6),A0 * DONE, GET RETURN TABLE POINTER
|
|
MOVE.B RDNWDS(A6),1(A0) * STORE THE NUMBER OF WORDS FOUND
|
|
|
|
MOVE.L (SP)+,A4 * RESTORE THE GAME SP
|
|
RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* READ PRIMITIVES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* LOWER-CASIFY THE CHAR IN D0
|
|
|
|
LCASE CMPI.B #'A',D0 * UPPERCASE CHAR?
|
|
BLT.B LCX1 * NO
|
|
CMPI.B #'Z',D0
|
|
BGT.B LCX1 * NO
|
|
ADDI.B #32,D0 * YES, LOWER-CASIFY IT
|
|
LCX1 RTS
|
|
|
|
|
|
* GATHER A LINE OF INPUT, INPUT BUFFER IN A0, MAX LENGTH IN D0
|
|
* RETURN INPUT END POINTER (+1) IN A0
|
|
|
|
EOLCHR EQU $0D * CARRIAGE RETURN
|
|
DELCHR EQU $08 * BACKSPACE
|
|
|
|
READLN MOVEM.L D1-D2/A1-A3,-(SP)
|
|
MOVE.W _cur_column,D2 * REMEMBER FOR LINES(A6) UPDATE
|
|
|
|
MOVE.L A0,A1 * START OF BUFFER IN A1
|
|
MOVE.L A1,A2 * KEEP CURRENT BUFFER POINTER IN A2
|
|
MOVE.L A2,A3
|
|
ADDA.W D0,A3 * END OF BUFFER (+1) IN A3
|
|
|
|
RDLX1 BSR TTYIN * INPUT A CHARACTER (NO ECHO)
|
|
CMPI.B #EOLCHR,D0 * END OF LINE?
|
|
BEQ.B RDLX7 * YES
|
|
CMPI.B #DELCHR,D0 * BACKSPACE?
|
|
BEQ.B RDLX3 * YES
|
|
|
|
* HANDLE A NORMAL CHARACTER
|
|
|
|
CMPA.L A3,A2 * BUFFER OVERFLOW?
|
|
BEQ.B RDLX5 * YES, IGNORE CHAR AND BEEP
|
|
|
|
MOVE.B D0,(A2)+ * STORE CHAR
|
|
BSR TTYOUT * AND ECHO CHAR
|
|
BRA.B RDLX1
|
|
|
|
* HANDLE A BACKSPACE
|
|
|
|
RDLX3 CMPA.L A1,A2 * BUFFER UNDERFLOW?
|
|
BEQ.B RDLX5 * YES, BEEP
|
|
|
|
SUBQ.L #1,A2 * BACK UP BUFFER POINTER
|
|
BSR TTYOUT * AND ECHO THE BS
|
|
BRA.B RDLX1
|
|
|
|
* BUFFER TOO FULL/EMPTY, BEEP AT USER (DON'T ECHO!)
|
|
|
|
RDLX5 BSR BEEP
|
|
BRA.B RDLX1 * WAIT FOR A VALID CHAR
|
|
|
|
* HANDLE A (FINAL) CR
|
|
|
|
RDLX7 BSR TTYOUT * ECHO THE CR
|
|
|
|
TST.W WIND1(A6) * ARE WE IN WINDOW 1?
|
|
BNE.B RDLX9 * YES, IGNORE COUNTER
|
|
|
|
* COUNT LINES FOR [MORE] *** INACCURATE WITHOUT D2, INITIAL _cur_column ***
|
|
|
|
MOVE.L A2,D0
|
|
SUB.L A1,D0 * LENGTH OF INPUT
|
|
ADD.W D2,D0 * AND TAKE INTO ACCOUNT INITIAL COLUMN
|
|
|
|
RDLX8 ADDQ.W #1,LINES(A6) * UPDATE THE [MORE] COUNTER
|
|
SUB.W _columns,D0 * [40 OR 80]
|
|
BGE.B RDLX8 * ONCE FOR EACH ACTUAL SCREEN LINE
|
|
|
|
* SCRIPT (IF SCRIPTING) THE USER INPUT LINE
|
|
* (CALLED AFTER INPUT IS COMPLETE, TO AVOID PROBLEMS WITH BACKSPACES)
|
|
|
|
RDLX9 MOVE.L A1,A0 * START OF LINE
|
|
MOVE.L A2,D0
|
|
SUB.L A1,D0 * LENGTH
|
|
MOVEQ #1,D1 * DO ADD A CR
|
|
BSR SCRINP
|
|
|
|
MOVE.L A2,A0 * RETURN POINTER TO END OF INPUT (+1)
|
|
MOVEM.L (SP)+,D1-D2/A1-A3
|
|
RTS
|
|
|
|
|
|
* SEARCH VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0
|
|
* RETURN ZWORD'S TABLE OFFSET (RELATIVIZED) IN D0.W, NULL IF NOT FOUND
|
|
|
|
LOOKUP MOVEM.L D1/A1-A2,-(SP)
|
|
|
|
MOVE.W VWORDS(A6),D0 * NUMBER OF VOCABULARY WORDS
|
|
MOVE.W VWLEN(A6),D1 * NUMBER OF BYTES PER VOCAB ENTRY
|
|
|
|
ASR.W #1,D0
|
|
LKX2 ASL.W #1,D1 * CALCULATE INITIAL OFFSET FOR BINARY SEARCH
|
|
ASR.W #1,D0
|
|
BNE LKX2
|
|
|
|
MOVE.L A0,A1 * POINTER TO GIVEN ZWORD
|
|
MOVE.L VOCBEG(A6),A2 * BEGINNING OF VOCAB WORD TABLE
|
|
ADDA.W D1,A2 * ADD INITIAL OFFSET
|
|
SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG FOR EXACT-POWER-OF-2 TABLE
|
|
|
|
LKX4 ASR.W #1,D1 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
|
|
MOVE.L A2,A0
|
|
|
|
BSR GTAWRD * GET FIRST WORD OF CURRENT ZWORD
|
|
CMP.W (A1),D0 * COMPARE IT TO DESIRED ONE
|
|
BCS.B LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
|
|
BHI.B LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
|
|
|
|
BSR GTAWRD * SAME, GET SECOND WORD
|
|
CMP.W 2(A1),D0 * COMPARE IT TO DESIRED ONE
|
|
BCS.B LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
|
|
BHI.B LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
|
|
|
|
IFEQ EZIP
|
|
BSR GTAWRD * SAME, GET THIRD WORD
|
|
CMP.W 4(A1),D0 * COMPARE IT TO DESIRED ONE
|
|
BCS.B LKX6 * BLO * LESS, WE'LL HAVE TO MOVE UP
|
|
BHI.B LKX8 * GREATER, WE'LL HAVE TO MOVE DOWN
|
|
ENDC
|
|
MOVE.L A2,D0 * SAME, WE'VE FOUND IT
|
|
SUB.L BUFFER(A6),D0 * RELATIVIZE THE ZWORD'S VOCAB TABLE OFFSET
|
|
BRA.B LKX12 * AND RETURN IT
|
|
|
|
LKX6 ADDA.W D1,A2 * TO MOVE UP, ADD OFFSET
|
|
CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE?
|
|
BLS.B LKX10 * NO
|
|
MOVE.L VOCEND(A6),A2 * YES, POINT TO END OF TABLE
|
|
BRA.B LKX10
|
|
|
|
LKX8 SUBA.W D1,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET
|
|
LKX10 CMP.W VWLEN(A6),D1 * IS OFFSET RESOLUTION AT LEAST ONE WORD?
|
|
BGE LKX4 * YES, CONTINUE LOOP
|
|
CLR.W D0 * NO, WORD NOT FOUND, RETURN ZERO
|
|
|
|
LKX12 MOVEM.L (SP)+,D1/A1-A2
|
|
RTS
|
|
|
|
|
|
PAGE
|
|
|
|
IFEQ EZIP
|
|
OPUSL BRA OPERR * NOT AN INSTRUCTION
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* STATUS LINE EQUATES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
MOVVAR EQU 18 * NUMBER-OF-MOVES GLOBAL
|
|
SCRVAR EQU 17 * SCORE VARIABLE
|
|
RMVAR EQU 16 * CURRENT ROOM VARIABLE
|
|
|
|
DATA
|
|
ZSCORE DC.B 'Score: ',0
|
|
ZTIME DC.B 'Time: ',0
|
|
TEXT
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* STATUS LINE PRIMITIVES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* STATUS LINE OUTPUT FUNCTION -- QUEUE THE CHARACTER IN D0
|
|
* (CALLED THROUGH OPPRND AND OPPRNN)
|
|
|
|
PUTSL MOVE.L SLPTR(A6),A0 * GET CURRENT SL POSITION
|
|
MOVE.B D0,(A0)+ * QUEUE THE CHAR
|
|
MOVE.L A0,SLPTR(A6) * UPDATE CURRENT SL POSITION
|
|
RTS
|
|
|
|
* GIVEN A ASCIZ POINTER IN A1, QUEUE THE STRING IN THE STATUS LINE
|
|
|
|
QSTR1 BSR PUTSL * QUEUE A CHAR
|
|
QSTR MOVE.B (A1)+,D0 * GET NEXT CHARACTER, END OF STRING?
|
|
BNE.B QSTR1 * NO
|
|
RTS
|
|
|
|
* USL (UPDATE STATUS LINE) (DESTROYS REGISTERS)
|
|
|
|
OPUSL MOVE.W #1,VOSTAT(A6) * SWITCH ALL OUTPUT TO STATUS LINE
|
|
|
|
SUBA.W #256,SP * CREATE A TEMP BUFFER FOR SL
|
|
MOVE.L SP,LOCPTR(A6) * LOCATION STRING STARTS HERE
|
|
MOVE.L SP,SLPTR(A6) * INIT OUTPUT POINTER
|
|
|
|
MOVE.B #' ',D0
|
|
BSR PUTSL * INDENT BY ONE SPACE
|
|
|
|
MOVEQ #RMVAR,D0
|
|
BSR GETVAR * GET CURRENT ROOM
|
|
BSR OPPRND * QUEUE ITS SHORT DESCRIPTION
|
|
|
|
* QUEUE THE SCORE/TIME STRING ...
|
|
|
|
MOVE.L SLPTR(A6),SCOPTR(A6) * SCORE STRING STARTS HERE
|
|
|
|
TST.W TIMEMD(A6) * ARE WE IN TIME MODE?
|
|
BNE.B USLX2 * YES
|
|
|
|
LEA ZSCORE,A1 * NO, SCORE MODE
|
|
BSR QSTR * QUEUE "SCORE"
|
|
MOVEQ #SCRVAR,D0
|
|
BSR GETVAR * GET THE SCORE
|
|
BSR OPPRNN * AND QUEUE IT
|
|
|
|
MOVE.B #'/',D0
|
|
BSR PUTSL * QUEUE A SEPARATOR (/)
|
|
|
|
MOVEQ #MOVVAR,D0
|
|
BSR GETVAR * GET THE NUMBER OF MOVES
|
|
BSR OPPRNN * AND QUEUE IT
|
|
BRA.B USLX6
|
|
|
|
USLX2 LEA ZTIME,A1
|
|
BSR QSTR * QUEUE "TIME"
|
|
|
|
MOVEQ #SCRVAR,D0
|
|
BSR GETVAR * GET HOUR
|
|
MOVE.B #'a',D2 * ASSUME AM
|
|
CMPI.W #12,D0 * PM?
|
|
BLT.B USLX4 * NO
|
|
BEQ.B USLX3 * YES, BUT 12 PM IS SPECIAL
|
|
SUBI.W #12,D0 * CONVERT TO 12-HOUR TIME
|
|
|
|
USLX3 MOVE.B #'p',D2 * CHANGE OUR EARLIER ASSUMPTION TO PM
|
|
USLX4 TST.W D0 * BUT 00 SHOULD BE 12 AM
|
|
BNE.B USLX5
|
|
MOVEQ #12,D0
|
|
USLX5 MOVE.W D2,-(SP) * PROTECT AM/PM INDICATOR
|
|
BSR OPPRNN * QUEUE THE HOUR
|
|
MOVE.B #':',D0
|
|
BSR PUTSL * QUEUE A SEPARATOR (:)
|
|
MOVEQ #MOVVAR,D0
|
|
BSR GETVAR * GET MINUTES
|
|
EXT.L D0
|
|
DIVU #10,D0 * OUTPUT MINUTES IN TWO DIGITS
|
|
MOVE.L D0,-(SP) * SAVE SECOND DIGIT (REMAINDER)
|
|
ADDI.B #'0',D0
|
|
BSR PUTSL * QUEUE FIRST DIGIT (QUOTIENT)
|
|
MOVE.L (SP)+,D0
|
|
SWAP D0 * RESTORE SECOND DIGIT
|
|
ADDI.B #'0',D0
|
|
BSR PUTSL * QUEUE SECOND DIGIT
|
|
MOVEQ #32,D0
|
|
BSR PUTSL * SPACE
|
|
MOVE.W (SP)+,D0
|
|
BSR PUTSL * AM OR PM
|
|
MOVE.B #'m',D0
|
|
BSR PUTSL
|
|
|
|
USLX6 MOVE.B #' ',D0
|
|
BSR PUTSL * END SCORE/TIME WITH ONE BLANK SPACE
|
|
|
|
*** DISPLAY THE STRINGS, POINTERS IN A0-A1, LENGTHS IN D0-D1
|
|
|
|
MOVE.L LOCPTR(A6),A0
|
|
MOVE.L SCOPTR(A6),A1
|
|
MOVE.L A1,D0
|
|
MOVE.L SLPTR(A6),D1
|
|
|
|
SUB.L A0,D0 * LENGTH OF LOCATION STRING
|
|
SUB.L A1,D1 * LENGTH OF SCORE STRING
|
|
BSR STLINE * GO DIRECTLY TO SCREEN DISPLAY
|
|
|
|
ADDA.W #256,SP * FLUSH THE TEMP BUFFER
|
|
CLR.W VOSTAT(A6) * TURN OFF STATUS LINE OUTPUT
|
|
RTS
|
|
|
|
ENDC
|
|
|
|
|
|
PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* I/O OPERATIONS -- OUTPUT
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
|
|
|
|
OPPRNC BRA PUTCHR * HANDLE IT
|
|
|
|
* PRINTN (PRINT A NUMBER, USING CURRENT CHARACTER OUTPUT FUNCTION)
|
|
|
|
OPPRNN MOVE.W D0,D1 * NON-ZERO NUMBER?
|
|
BNE.B PRNNX1 * YES
|
|
MOVE.B #'0',D0 * ZERO, SPECIAL CASE
|
|
BRA PUTCHR * PRINT A ZERO
|
|
|
|
PRNNX1 BGT.B PRNNX2 * POSITIVE?
|
|
MOVE.B #'-',D0 * NO, PRINT A MINUS SIGN
|
|
BSR PUTCHR
|
|
NEG.W D1 * AND MAKE NUMBER POSITIVE
|
|
|
|
PRNNX2 CLR.W D2 * COUNT OF DIGITS ON STACK
|
|
BRA.B PRNNX4 * START WITH GREATER-THAN-10 TEST
|
|
|
|
PRNNX3 EXT.L D1 * CLEAR HIGH WORD FOR DIVISION
|
|
DIVU #10,D1 * EXTRACT A DIGIT (THE REMAINDER)
|
|
SWAP D1
|
|
MOVE.W D1,-(SP) * PUSH IT
|
|
SWAP D1
|
|
ADDQ.W #1,D2 * BUMP COUNT
|
|
|
|
PRNNX4 CMPI.W #10,D1 * ANY MORE DIGITS TO EXTRACT?
|
|
BGE PRNNX3 * YES
|
|
MOVE.W D1,D0 * NO, POSITION LAST (FIRST) DIGIT
|
|
BRA.B PRNNX6
|
|
|
|
PRNNX5 MOVE.W (SP)+,D0 * POP NEXT DIGIT
|
|
PRNNX6 ADDI.B #'0',D0 * ASCIIZE IT
|
|
BSR PUTCHR * PRINT NEXT DIGIT
|
|
SUBQ.W #1,D2 * ANY DIGITS LEFT ON STACK?
|
|
BGE PRNNX5 * YES
|
|
RTS
|
|
|
|
* PRINT (THE STRING POINTED TO)
|
|
|
|
IFEQ EZIP
|
|
OPPRIN BSR BSPLTQ * SPLIT THE BLOCK AND OFFSET (QUAD)
|
|
ENDC
|
|
IFEQ CZIP
|
|
OPPRIN BSR BSPLIT * SPLIT THE BLOCK AND OFFSET (WORD)
|
|
ENDC
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* PRINTB (THE STRING POINTED TO)
|
|
|
|
OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE)
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
|
|
|
|
OPPRND BSR OBJLOC * FIND OBJECT'S LOCATION
|
|
ADDA.W #PROP,A0 * PROPERTY TABLE POINTER (ZIP/EZIP)
|
|
BSR GTAWRD * GET IT
|
|
|
|
ADDQ.W #1,D0 * POINT TO SHORT DESCRIPTION STRING
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BRA PUTSTR * AND PRINT THE STRING
|
|
|
|
* PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
|
|
|
|
OPPRNI MOVE.W ZPC1(A6),D0 * GET POINTER TO STRING
|
|
MOVE.W ZPC2(A6),D1
|
|
BSR PUTSTR * PRINT IT
|
|
MOVE.W D0,ZPC1(A6) * AND UPDATE ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BRA NEWZPC
|
|
|
|
* PRINTR (PRINTI FOLLOWED BY RTRUE)
|
|
|
|
OPPRNR BSR OPPRNI * DO A PRINTI
|
|
BSR OPCRLF * A CRLF
|
|
BRA OPRTRU * AND AN RTRUE
|
|
|
|
* CRLF (DO A NEWLINE)
|
|
|
|
OPCRLF BRA PUTNEW * DO A NEWLINE
|
|
|
|
|
|
PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* MORE ZIP I/O
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* SPLIT/UNSPLIT THE SCREEN
|
|
|
|
OPSPLT TST.W D7 * <FOR ST ASSEMBLER>
|
|
|
|
IFEQ CZIP
|
|
ADDQ.W #1,D0 * ALLOW SPACE FOR STATUS LINE
|
|
ENDC
|
|
|
|
CMP.W _rows,D0 * MAKE SURE REQUEST IS POSSIBLE
|
|
BLE.B SPLTX1 * OK
|
|
MOVE.W _rows,D0 * TOO BIG, LIMIT IT TO FULL SCREEN
|
|
SPLTX1 MOVE.W D0,_split_row * RESET SPLIT POINT
|
|
|
|
* ALWAYS CLEAR WINDOW 1 (ZIP ONLY!)
|
|
* CLEARING OF [GROWING] WINDOWS HAS BEEN REMOVED FROM EZIP SPEC ...
|
|
|
|
IFEQ CZIP
|
|
MOVE.L D0,-(SP) * LAST ROW TO CLEAR (+1)
|
|
MOVEQ #1,D1
|
|
MOVE.L D1,-(SP) * FIRST ROW, ALLOW FOR STATUS LINE
|
|
JSR _clear_lines
|
|
ADDQ.W #8,SP * FLUSH STACK
|
|
ENDC
|
|
|
|
RTS
|
|
|
|
* MAKE OUTPUT FALL INTO SPECIFIED WINDOW
|
|
|
|
OPSCRN TST.W D0 * OUTPUT TO WINDOW 0?
|
|
BEQ SCRNX1 * YES
|
|
CMPI.W #1,D0 * OUTPUT TO WINDOW 1?
|
|
BEQ SCRNX3 * YES
|
|
RTS * INVALID ARG, DO NOTHING
|
|
|
|
* MOVE CURSOR INTO WINDOW 0, RESTORE OLD CURSOR POSITION
|
|
|
|
SCRNX1 TST.W WIND1(A6) * ALREADY IN WINDOW 0?
|
|
BEQ SCRNX2 * YES
|
|
|
|
CLR.W WIND1(A6) * NO
|
|
MOVE.W OLDWY(A6),_cur_row * RESTORE OLD ROW
|
|
MOVE.W OLDWX(A6),_cur_column * RESTORE OLD COLUMN
|
|
|
|
SCRNX2 RTS
|
|
|
|
* MOVE CURSOR INTO WINDOW 1, SAVE OLD CURSOR POSITION IF REQUIRED
|
|
|
|
SCRNX3 TST.W WIND1(A6) * ALREADY IN WINDOW 1?
|
|
BNE SCRNX4 * YES
|
|
|
|
MOVE.W #1,WIND1(A6)
|
|
MOVE.W _cur_row,OLDWY(A6) * REMEMBER OLD ROW
|
|
MOVE.W _cur_column,OLDWX(A6) * REMEMBER OLD COLUMN
|
|
|
|
SCRNX4 CLR.W _cur_row
|
|
CLR.W _cur_column
|
|
|
|
IFEQ CZIP
|
|
ADD.W #1,_cur_row * ALLOW ROOM FOR STATUS LINE
|
|
ENDC
|
|
RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* TIMEOUT PRIMITIVES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* RESET THE TIMEOUT COUNTER
|
|
|
|
TRESET BSR TIME60 * GET A REFERENCE TIME (IN 60THS)
|
|
MOVE.L D0,TBEGIN(A6) * SAVE IT
|
|
RTS
|
|
|
|
* RETURN THE TIME REMAINING BEFORE NEXT TIMEOUT (ZERO/NEGATIVE IF NONE)
|
|
|
|
TCHECK BSR TIME60 * YES, GET CURRENT TIME (IN 60THS)
|
|
SUB.L TBEGIN(A6),D0 * THIS IS CURRENT DELAY
|
|
DIVU #6,D0 * SWITCH TO 10THS
|
|
SUB.W TDELAY(A6),D0 * CALCULATE THE TIME REMAINING
|
|
NEG.W D0
|
|
RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* EZIP I/O
|
|
* ---------------------------------------------------------------------------
|
|
|
|
IFEQ EZIP
|
|
|
|
* SET BUFFERING OF OUTPUT ACCORDING TO INT
|
|
|
|
OPBUFO SUBQ.W #1,D0 * NORMAL BUFFERING?
|
|
BEQ BUFOX1 * YES
|
|
ADDQ.W #1,D0 * NO BUFFERING, OUTPUT DIRECTLY TO SCREEN?
|
|
BEQ BUFOX2 * YES
|
|
BRA BUFOX3 * ELSE DO NOTHING
|
|
|
|
BUFOX1 MOVE.W #1,VOBUFF(A6) * TURN ON BUFFERING
|
|
BRA BUFOX3
|
|
BUFOX2 BSR PUTLIN1 * FIRST EMPTY THE CURRENT OUTPUT BUFFER
|
|
CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING
|
|
BUFOX3 RTS
|
|
|
|
|
|
* TABLE OUTPUT FUNCTION --- PUT THE CHAR IN D0 IN THE DEFINED TABLE
|
|
|
|
TABCHR MOVE.L TABPTR(A6),A0 * CURRENT POSITION IN TABLE
|
|
MOVE.B D0,(A0)+ * STORE CHAR
|
|
MOVE.L A0,TABPTR(A6) * UPDATE POINTER
|
|
RTS
|
|
|
|
* REDIRECT OUTPUT (TABLE OR NORMAL) ACCORDING TO INT
|
|
|
|
OPDIRO NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W ARG1(A0),D0 * VIRTUAL OUTPUT DEVICE -- NEGATIVE?
|
|
BLT DIRX0 * YES, MEANS TURN IT OFF
|
|
|
|
SUBQ.W #1,D0 * TURN ON SCREEN?
|
|
BEQ DIRX1 * YES
|
|
SUBQ.W #1,D0 * TURN ON PRINTER?
|
|
BEQ DIRX3 * YES
|
|
SUBQ.W #1,D0 * TURN ON TABLE?
|
|
BEQ DIRX5 * YES
|
|
BRA DIRX7 * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
DIRX0 ADDQ.W #1,D0 * TURN OFF SCREEN?
|
|
BEQ DIRX2 * YES
|
|
ADDQ.W #1,D0 * TURN OFF PRINTER?
|
|
BEQ DIRX4 * YES
|
|
ADDQ.W #1,D0 * TURN OFF TABLE?
|
|
BEQ DIRX6 * YES
|
|
BRA DIRX7 * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
*** TURN SCREEN OUTPUT ON, OFF
|
|
|
|
DIRX1 MOVE.W #1,VOCONS(A6)
|
|
BRA DIRX7
|
|
DIRX2 CLR.W VOCONS(A6)
|
|
BRA DIRX7
|
|
|
|
*** TURN SCRIPTING OUTPUT ON, OFF
|
|
|
|
DIRX3 MOVE.L BUFFER(A6),A0
|
|
BSET #0,PFLAGS+1(A0) * SET PRELOAD FLAG FOR GAME'S USE
|
|
|
|
MOVE.W #1,VOPRNT(A6)
|
|
BRA DIRX7
|
|
|
|
DIRX4 MOVE.L BUFFER(A6),A0
|
|
BCLR #0,PFLAGS+1(A0) * CLEAR THE PRELOAD FLAG
|
|
|
|
CLR.W VOPRNT(A6)
|
|
BRA DIRX7
|
|
|
|
*** TURN TABLE ON, OFF
|
|
|
|
DIRX5 MOVEQ #0,D0
|
|
MOVE.W ARG2(A0),D0 * GET RELATIVE TABLE POINTER
|
|
ADD.L BUFFER(A6),D0 * ABSOLUTIZE
|
|
MOVE.L D0,TABOUT(A6) * REMEMBER START OF TABLE
|
|
|
|
ADDQ.L #2,D0 * SKIP LENGTH SLOT
|
|
MOVE.L D0,TABPTR(A6) * FIRST CHAR WILL GO HERE
|
|
|
|
MOVE.W #1,VOTABL(A6) * SET TABLE-OUTPUT FLAG
|
|
BRA DIRX7
|
|
|
|
DIRX6 TST.W VOTABL(A6) * MAKE SURE A TABLE DOES EXIST
|
|
BEQ DIRX7 * NO TABLE, IGNORE REQUEST
|
|
CLR.W VOTABL(A6) * OK, TURN OFF TABLE-OUTPUT FLAG
|
|
|
|
MOVE.L TABOUT(A6),A0 * COMPUTE LENGTH OF CURRENT TABLE CONTENTS
|
|
MOVE.L TABPTR(A6),D0
|
|
SUB.L A0,D0
|
|
SUBQ.W #2,D0 * ADJUST FOR LENGTH SLOT
|
|
BSR PTAWRD * AND STORE LENGTH IN LENGTH SLOT
|
|
|
|
DIRX7 RTS
|
|
|
|
* REDIRECT INPUT (NORMAL OR COMMAND FILE) ACCORDING TO INT
|
|
|
|
OPDIRI NOP * TELL CALLER TO USE ARGBLK
|
|
|
|
*** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE
|
|
|
|
RTS
|
|
|
|
* MAKE A SOUND
|
|
|
|
OPSOUND
|
|
*** MOVE.W D0,-(SP) * BEEP OR BOOP
|
|
|
|
RTS
|
|
|
|
* INPUT (AN ASCII KEY, WITHOUT ECHO)
|
|
|
|
OPINPUT NOP * TELL CALLER TO USE ARGBLK
|
|
CLR.W LINES(A6) * RESET COUNTER, PREVENTS A SPURIOUS [MORE]
|
|
TST.W VOBUFF(A6) * BUFFERED OUTPUT?
|
|
BEQ.B INPTX0 * NO
|
|
BSR PUTLIN * YES, EMPTY THE BUFFER
|
|
|
|
INPTX0 TST.W D7 * <ST ASSEMBLER>
|
|
* CLR.W TIMOUT(A6) * ASSUME NO TIMEOUTS
|
|
* CMPI.W #3,(A0) * ARE OPTIONAL TIMEOUTS IN EFFECT?
|
|
* BNE.B INPTX1 * NO
|
|
|
|
* MOVE.W #1,TIMOUT(A6)
|
|
* MOVE.W ARG2(A0),TDELAY(A6) * DELAY IN 10THS OF A SECOND
|
|
* MOVE.W ARG3(A0),TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT
|
|
* BSR TRESET * RESET THE TIMER
|
|
|
|
|
|
* MAIN LOOP STARTS HERE ...
|
|
|
|
INPTX1 BSR TTYIN * WAIT FOR A KEY
|
|
|
|
|
|
* TST.B D0
|
|
* BNE.B INPTX2 * GOT SOMETHING, EXIT
|
|
|
|
* TST.W TIMOUT(A6) * TIMOUTS IN EFFECT?
|
|
* BEQ.B INPTX1 * NO
|
|
|
|
* BSR TCHECK * GET TIME REMAINING BEFORE NEXT TIMEOUT
|
|
* TST.W D0 * HAS IT RUN OUT?
|
|
* BGT.B INPTX1 * NO
|
|
* BSR TRESET * YES, RESET TIMER
|
|
|
|
* MOVE.W TFUNC(A6),D0 * CALL THE TIMEOUT FUNCTION
|
|
* BSR INCALL
|
|
* TST.W D0 * RETURNED VALUE -- ABORT INPUT?
|
|
* BEQ.B INPTX1 * NO, CONTINUE WAITING
|
|
|
|
INPTX2 BRA PUTVAL * RETURN ASCII VALUE
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* CLEAR A WINDOW, OR ENTIRE SCREEN
|
|
|
|
OPCLEAR SUBQ.W #1,D0 * WINDOW 1 ONLY?
|
|
BEQ CLRX1 * YES
|
|
ADDQ.W #1,D0 * WINDOW 0 ONLY?
|
|
BEQ CLRX2 * YES
|
|
|
|
ADDQ.W #1,D0 * ENTIRE SCREEN?
|
|
BEQ CLRX3 * YES
|
|
BRA CLRX5 * INVALID ARG, IGNORE IT
|
|
|
|
CLRX1 CLR.W D0 * CLEAR WINDOW 1
|
|
MOVE.W _split_row,D1
|
|
BRA CLRX4
|
|
|
|
CLRX2 MOVE.W _split_row,D0 * CLEAR WINDOW 0
|
|
MOVE.W _rows,D1
|
|
BRA CLRX4
|
|
|
|
CLRX3 CLR.W D0
|
|
BSR OPSPLT * FIRST UNSPLIT THE SCREEN (IF NEEDED)
|
|
CLR.W D0
|
|
MOVE.W _rows,D1 * CLEAR ENTIRE SCREEN
|
|
|
|
* FIRST ROW TO CLEAR IN D0, LAST (+1) IN D1
|
|
|
|
CLRX4 MOVE.L D1,-(SP)
|
|
MOVE.L D0,-(SP)
|
|
JSR _clear_lines * DO IT
|
|
ADDQ.L #8,SP
|
|
|
|
* NEXT LINES FIX THE OPENING "PRISM" SCREEN ...
|
|
|
|
CLR.W _cur_column * RESET CURSOR TO "INITIAL"
|
|
MOVE.W _rows,_cur_row
|
|
SUBQ.W #1,_cur_row * cur_row in (0 .. rows-1)
|
|
CLRX5 RTS
|
|
|
|
* ERASE (CURRENT LINE, STARTING AT CURSOR)
|
|
|
|
OPERASE SUBQ.W #1,D0
|
|
BNE ERASX1 * IGNORE ARG IF NOT 1
|
|
JSR _clear_eol
|
|
ERASX1 RTS
|
|
|
|
* SET CURSOR TO LINE INT1, COLUMN INT2
|
|
|
|
OPCURS TST.W WIND1(A6) * CURRENTLY IN WINDOW 1?
|
|
BNE CURSX1 * YES
|
|
ADD.W _split_row,D0 * NO, MUST MAKE LINE RELATIVE TO WINDOW 0
|
|
|
|
CURSX1 SUBQ.W #1,D0 * MAKE LINE AND COLUMN ZERO-ORIGIN
|
|
SUBQ.W #1,D1
|
|
MOVE.W D0,_cur_row * RESET THE GLOBALS
|
|
MOVE.W D1,_cur_column
|
|
RTS
|
|
|
|
* GET CURSOR POSITION
|
|
|
|
OPCURG BRA OPERR *** NOT CURRENTLY A DEFINED OPERATION ***
|
|
|
|
MOVE.W _cur_row,D0 * SET THE GLOBALS
|
|
MOVE.W _cur_column,D1
|
|
|
|
ADDQ.W #1,D0 * MAKE LINE AND COLUMN ONE-ORIGIN
|
|
ADDQ.W #1,D1
|
|
|
|
TST.W WIND1(A6) * CURRENTLY IN WINDOW 1?
|
|
BNE CURGX1 * YES
|
|
SUB.W _split_row,D0 * NO, MUST MAKE LINE RELATIVE TO WINDOW 0
|
|
|
|
CURGX1 ASL.W #8,D0 * RETURN LINE IN HIGH BYTE, COLUMN IN LOW (?)
|
|
MOVE.B D1,D0
|
|
BRA PUTVAL
|
|
|
|
* HIGHLIGHT (SET CHAR ATTRIBUTES)
|
|
|
|
* [ ATARI ST ONLY: ITALICIZED OUTPUT REQUIRES EXTRA ROOM TO THE LEFT OF
|
|
* THE FIRST CHARACTER, SO DISPLAY AN EXTRA SPACE. SEND IT THROUGH THE LINE
|
|
* BUFFER HANDLER, TO ADJUST THE BUFFER'S CURRENT LENGTH TOO.
|
|
|
|
* THE line_out ROUTINE HAS ADDITIONAL CODE TO AVOID DRAWING ITALICS
|
|
* IN COLUMN 0. ]
|
|
|
|
OPATTR CMPI.W #4,D0 * ENTERING ITALICS MODE?
|
|
BNE.B ATTRX1 * NO
|
|
|
|
TST.W VOCONS(A6) * SCREEN ON?
|
|
BEQ.B ATTRX1 * NO
|
|
|
|
MOVEQ #32,D0 * YES, PAD A SPACE
|
|
BSR QDCHR * >>> TO SCREEN ONLY, NOT PRINTER ETC <<<
|
|
MOVEQ #4,D0 * RESTORE MODE
|
|
|
|
ATTRX1 MOVE.L D0,-(SP)
|
|
BSR PUTLIN1 * EMPTY THE LINE BUFFER (IN OLD MODE)
|
|
|
|
JSR _highlight * 1 INVERSE, 2 BOLD, 4 ITALIC
|
|
ADDQ.L #4,SP
|
|
RTS
|
|
|
|
ENDC
|
|
IFEQ CZIP * THESE FUNCTIONS ARE UNDEFINED IN ZIP
|
|
|
|
OPCLEAR BRA OPERR
|
|
OPERASE BRA OPERR
|
|
|
|
OPCURS BRA OPERR
|
|
OPCURG BRA OPERR
|
|
OPATTR BRA OPERR
|
|
|
|
OPBUFO BRA OPERR
|
|
OPDIRO BRA OPERR
|
|
OPDIRI BRA OPERR
|
|
|
|
OPSOUND BRA OPERR
|
|
OPINPUT BRA OPERR
|
|
|
|
ENDC
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* CONTROL OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS)
|
|
|
|
IFEQ EZIP
|
|
|
|
OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR THIS ONE
|
|
MOVE.W #1,(A0) * ONE ARG
|
|
MOVE.W D0,ARG1(A0)
|
|
|
|
OPCAL2 NOP * <ST ASSEMBLER> * TELL CALLER TO USE ARGBLK
|
|
OPXCAL NOP * <ST ASSEMBLER> * TELL CALLER TO USE ARGBLK
|
|
OPCALL NOP * TELL CALLER TO USE ARGBLK
|
|
|
|
ENDC
|
|
IFEQ CZIP
|
|
|
|
OPCAL1 BRA OPERR * FIRST THREE ARE UNDEFINED IN ZIP
|
|
OPCAL2 BRA OPERR
|
|
OPXCAL BRA OPERR
|
|
|
|
OPCALL NOP * TELL CALLER TO USE ARGBLK
|
|
ENDC
|
|
|
|
* POINTER TO ARGBLK IS IN A0 ...
|
|
|
|
MOVE.W (A0)+,D2
|
|
MOVE.W (A0)+,D0 * FUNCTION TO CALL -- IS IT ZERO?
|
|
BNE.B CALLX1 * NO
|
|
|
|
CLR.W D0 * YES, SIMPLY RETURN A ZERO
|
|
BRA PUTVAL
|
|
|
|
*** BUILD A STACK FRAME, THEN UPDATE THE ZPC ...
|
|
|
|
CALLX1 MOVE.L A0,A1
|
|
SUBQ.W #1,D2 * THIS IS NUMBER OF OPTIONAL LOCALS
|
|
|
|
MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
|
|
* (The relativized locs pointer ought to be stacked as a word instead of
|
|
* a long. Changing now would make previous saved games incompatible.)
|
|
|
|
MOVE.L ZLOCS(A6),D1 * SAVE OLD LOCALS POINTER
|
|
SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT IN CASE OF SAVE
|
|
MOVE.L D1,-(A4)
|
|
IFEQ EZIP
|
|
BSR BSPLTQ * SPLIT THE FUNCTION POINTER
|
|
ENDC
|
|
IFEQ CZIP
|
|
BSR BSPLIT * SPLIT THE FUNCTION POINTER
|
|
ENDC
|
|
MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
|
|
* (The new locs pointer ought to point to pseudo-loc 0, not 1. Ditto above.)
|
|
|
|
MOVE.L A4,ZLOCS(A6) * LOCALS WILL START AT NEXT STACK SLOT
|
|
SUBQ.L #2,ZLOCS(A6) * POINT TO LOCAL 1, IF ANY
|
|
|
|
*** CREATE SPACE FOR & INITIALIZE THE LOCALS ...
|
|
|
|
BSR NXTBYT * GET ACTUAL NUMBER OF DEFINED LOCALS
|
|
MOVE.W D0,D1
|
|
BEQ.B CALLX4 * EXIT IF NONE
|
|
|
|
CALLX2 BSR NXTWRD * GET THE NEXT LOCAL DEFAULT VALUE
|
|
SUBQ.W #1,D2 * BUT ARE THERE ANY MORE OPTIONAL VALUES?
|
|
BLT.B CALLX3 * NO, USE THE DEFAULT
|
|
MOVE.W (A1)+,D0 * OTHERWISE USE THE OPTIONAL
|
|
|
|
CALLX3 MOVE.W D0,-(A4) * CREATE LOCAL SPACE & INITIALIZE IT
|
|
SUBQ.W #1,D1 * ANY MORE LOCALS?
|
|
BGT.B CALLX2 * YES, LOOP
|
|
CALLX4 RTS
|
|
|
|
* RETURN (FROM CURRENT FUNCTION CALL)
|
|
|
|
OPRETU MOVE.L ZLOCS(A6),A4 * RESTORE OLD TOP OF STACK
|
|
ADDQ.L #2,A4
|
|
|
|
MOVE.L (A4)+,D1 * RESTORE OLD LOCALS POINTER
|
|
ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT
|
|
MOVE.L D1,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OLD ZPC
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
IFEQ EZIP
|
|
BLT INRETU * SPECIAL INTERNAL CALL/RETURN, HANDLE IT
|
|
ENDC
|
|
MOVE.W D0,D1 * PROTECT VALUE
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
MOVE.W D1,D0
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* RTRUE
|
|
|
|
OPRTRU MOVEQ #1,D0 * RETURN A "1"
|
|
BRA.B OPRETU
|
|
|
|
* RFALSE
|
|
|
|
OPRFAL CLR.W D0 * RETURN A "0"
|
|
BRA.B OPRETU
|
|
|
|
* JUMP (TO A NEW LOCATION)
|
|
|
|
OPJUMP SUBQ.W #2,D0 * ADJUST OFFSET
|
|
ADD.W D0,ZPC2(A6) * ADD OFFSET TO CURRENT ZPC
|
|
BRA NEWZPC * NORMALIZE IT & UPDATE ZPC STUFF
|
|
|
|
* RSTACK (RETURN STACK)
|
|
|
|
OPRSTA MOVE.W (A4)+,D0 * POP A VALUE
|
|
BRA OPRETU * AND RETURN IT
|
|
|
|
* FSTACK (FLUSH A VALUE OFF THE STACK)
|
|
|
|
OPFSTA ADDQ.L #2,A4 * FLUSH ONE WORD
|
|
RTS
|
|
|
|
* NOOP (NO OPERATION)
|
|
|
|
OPNOOP RTS * DO NOTHING
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
IFEQ EZIP
|
|
|
|
* INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0
|
|
|
|
INCALL MOVEM.L D1-D7/A1-A3,-(SP)
|
|
|
|
MOVE.W ZPC1(A6),-(SP)
|
|
MOVE.W #-1,ZPC1(A6) * FAKE ZPC1, SIGNALS AN INTERNAL CALL/RETURN
|
|
|
|
LEA ARGBLK(A6),A0 * SET UP ARGBLK FOR OPCALL
|
|
MOVE.W D0,ARG1(A0) * FUNCTION TO CALL
|
|
MOVE.W #1,(A0) * ONE ARG
|
|
|
|
BSR OPCALL * CALL THE TIMEOUT FUNCTION
|
|
BRA NXTINS * GO EXECUTE IT
|
|
|
|
* JUMP BACK TO HERE UPON NEXT OPRETURN ...
|
|
|
|
INRETU ADDQ.L #4,SP * CAREFUL -- FLUSH TOP RETURN ADDR (NXTINS)
|
|
MOVE.W (SP)+,ZPC1(A6) * FIX THE ZPC
|
|
|
|
MOVE.W D0,D1
|
|
BSR NEWZPC * RESTORE THE PROPER PAGE
|
|
MOVE.W D1,D0
|
|
|
|
MOVEM.L (SP)+,D1-D7/A1-A3
|
|
RTS * RETURN TO ORIGINAL CALLER
|
|
ENDC
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* GAME COMMANDS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* SAVE (THE CURRENT STATE OF THE GAME)
|
|
|
|
OPSAVE CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE.B SVX4 * CANCELLED
|
|
|
|
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
|
|
BNE.B SVX4 * ERROR, JUST EXIT (NEED NOT DELETE)
|
|
|
|
* SUCCESS, SAVE STATE VARIABLES ON GAME STACK ...
|
|
|
|
MOVE.W ZPC1(A6),-(A4)
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
MOVE.L ZLOCS(A6),-(A4)
|
|
|
|
MOVE.L STKBOT(A6),D0
|
|
SUB.L D0,(A4) * RELATIVIZE THIS ONE
|
|
MOVE.W ZORKID(A6),-(A4)
|
|
|
|
MOVE.L D0,A0
|
|
MOVE.L A4,(A0) * SAVE GAME SP IN KNOWN LOCATION
|
|
SUB.L D0,(A0) * RELATIVIZE IT TOO
|
|
|
|
MOVE.L STKBOT(A6),A0
|
|
CLR.W D0 * THIS WILL BE BLOCK ZERO
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
BSR PTSBKS * WRITE IT OUT
|
|
BNE.B SVX2 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
ADDA.W #10,A4 * RESET THE STACK POINTER
|
|
MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE
|
|
|
|
MOVEQ #STKLEN/512,D0 * START WRITING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * NUMBER OF IMPURE BLOCKS
|
|
BSR PTSBKS
|
|
BNE.B SVX2 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
BSR CLSSFL * SUCCESS, CLOSE THE FILE
|
|
BNE.B SVX3 * ERROR, DELETE IT AND FAIL
|
|
|
|
SVX1 BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
IFEQ EZIP
|
|
MOVEQ #1,D0 * RETURN "SAVE OK"
|
|
BRA PUTVAL
|
|
ENDC
|
|
IFEQ CZIP
|
|
BRA PTRUE * RETURN PREDICATE TRUE
|
|
ENDC
|
|
|
|
* SAVE FAILED FOR SOME REASON, HANDLE IT ...
|
|
|
|
SVX2 BSR CLSSFL * CLOSE THE BAD FILE
|
|
SVX3 BSR DELSFL * DELETE THE BAD FILE FROM THE DIRECTORY
|
|
|
|
SVX4 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
IFEQ EZIP
|
|
CLR.W D0 * RETURN "SAVE FAILED"
|
|
BRA PUTVAL
|
|
ENDC
|
|
IFEQ CZIP
|
|
BRA PFALSE * RETURN PREDICATE FALSE
|
|
ENDC
|
|
|
|
|
|
* RESTORE (A PREVIOUSLY SAVED GAME STATE)
|
|
|
|
OPREST CLR.W D0
|
|
BSR CHKDSK * FIRST CHECK FOR PRESENCE OF GAME DISK
|
|
|
|
* SKIP NEXT CALL IF DOING SPECIAL RESTORE DURING LAUNCH ...
|
|
|
|
BSR GETRFL * GET NAME OF A RESTORE FILE
|
|
BNE RESX1 * CANCELLED
|
|
|
|
BSR OPNSFL * OPEN THE FILE
|
|
BNE RESX1 * ERROR
|
|
|
|
CLR.W D0 * FIRST READ IN STACK
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
MOVE.L STKBOT(A6),A0 * PUT IT HERE
|
|
BSR GTSBKS
|
|
BNE.B RESX3 * DIE IF DISK ERROR
|
|
|
|
MOVE.L STKBOT(A6),A0
|
|
MOVE.L (A0),A4 * RESTORE GAME SP
|
|
ADD.L A0,A4 * RE-ABSOLUTIZE IT
|
|
|
|
MOVE.W (A4)+,D0 * GET THE SAVED ZORKID
|
|
CMP.W ZORKID(A6),D0 * IS IT THE SAME AS OURS?
|
|
BNE.B RESX2 * NO, DIE
|
|
|
|
MOVE.L (A4)+,D0 * YES, RESTORE OLD LOCALS POINTER
|
|
ADD.L STKBOT(A6),D0 * RE-ABSOLUTIZE THIS ONE
|
|
MOVE.L D0,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PFLAGS(A0),-(SP) * BUT PRESERVE THE FLAGS (SCRIPT ETC)
|
|
|
|
MOVEQ #STKLEN/512,D0 * READ IMPURE STUFF STARTING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * LENGTH OF IMPURE STUFF
|
|
BSR GTSBKS
|
|
BNE.B RESX3 * DIE IF DISK ERROR
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W (SP)+,PFLAGS(A0) * RESTORE THE OLD FLAGS
|
|
BSR CLSSFL * CLOSE THE FILE
|
|
|
|
BSR NEWZPC * THEN GET THE PROPER ZPC PAGE
|
|
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
IFEQ EZIP
|
|
MOVEQ #2,D0 * RETURN "RESTORE OK"
|
|
BRA PUTVAL
|
|
ENDC
|
|
IFEQ CZIP
|
|
BRA PTRUE * RETURN PREDICATE TRUE
|
|
ENDC
|
|
|
|
* SOMETHING WRONG, FAIL ...
|
|
|
|
RESX1 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
IFEQ EZIP
|
|
CLR.W D0 * RETURN "RESTORE FAILED"
|
|
BRA PUTVAL
|
|
ENDC
|
|
IFEQ CZIP
|
|
BRA PFALSE * RETURN PREDICATE FALSE
|
|
ENDC
|
|
|
|
* FATAL ERROR, DIE ...
|
|
|
|
RESX2 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE
|
|
|
|
MOVE.W (SP)+,D0 * BAD VERSION ID
|
|
LEA MSGRE2,A0
|
|
BRA FATAL * 'Wrong save file version'
|
|
|
|
DATA
|
|
MSGRE2 DC.B 'Wrong save file version',0
|
|
TEXT
|
|
|
|
RESX3 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE AND DIE
|
|
|
|
MOVE.W (SP)+,D0 * ERROR CODE
|
|
LEA MSGRE1,A0
|
|
BRA FATAL * 'Save file read error'
|
|
|
|
DATA
|
|
MSGRE1 DC.B 'Save file read error',0
|
|
TEXT
|
|
|
|
* RESTART (THE GAME)
|
|
|
|
OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT
|
|
CLR.W LINES(A6) * RESET THE [MORE] COUNTER
|
|
|
|
JSR _clear_screen
|
|
BRA RESTRT * SKIP INITIALIZATIONS AND FILE OPENING
|
|
|
|
* QUIT
|
|
|
|
OPQUIT BRA FINISH * DIE PEACEFULLY
|
|
|
|
* VERIFY (GAME FILE)
|
|
|
|
OPVERI TST.W D7 * <ST ASSEMBLER>
|
|
|
|
IFEQ CZIP * VERSION INFO FOR ZIP ONLY
|
|
LEA MSGVER,A0
|
|
BSR OUTMSG0 * 'Atari ST interpreter version '
|
|
DATA
|
|
MSGVER DC.B 'Atari ST interpreter version ',0
|
|
TEXT
|
|
|
|
MOVE.W INTWRD,D0 * DISPLAY THE LETTER (LOW BYTE)
|
|
BSR OPPRNC
|
|
BSR OPCRLF
|
|
ENDC
|
|
|
|
TST.W SUBVER * DISPLAY SUB-VERSION ONLY IF NON-ZERO
|
|
BEQ VERX0
|
|
|
|
LEA MSGVR2,A0
|
|
BSR OUTMSG0 * 'Sub-version '
|
|
DATA
|
|
MSGVR2 DC.B 'Sub-version ',0
|
|
TEXT
|
|
|
|
MOVE.W SUBVER,D0 * DISPLAY THE SUB-VERSION NUMBER
|
|
BSR OPPRNN
|
|
BSR OPCRLF
|
|
|
|
VERX0 MOVE.L BUFFER(A6),A0
|
|
MOVE.W PLENTH(A0),D0 * GET LENGTH OF GAME FILE
|
|
|
|
IFEQ EZIP
|
|
BSR BSPLTQ
|
|
ENDC
|
|
IFEQ CZIP
|
|
BSR BSPLIT
|
|
ENDC
|
|
MOVE.W D0,D4 * THIS IS FINAL BLOCK
|
|
MOVE.W D1,D5 * FINAL BYTE
|
|
|
|
CLR.W D0 * STARTING BLOCK NUMBER
|
|
MOVEQ #64,D1 * STARTING BYTE NUMBER
|
|
CLR.W D3 * CHECKSUM HERE
|
|
MOVE.W ENDLOD(A6),-(SP)
|
|
CLR.W ENDLOD(A6) * FORCE LOADING FROM DISK
|
|
|
|
VERX1 BSR GETBYT * GET NEXT BYTE
|
|
ADD.W D2,D3 * ADD IN TO CHECKSUM
|
|
CMP.W D0,D4 * DONE YET?
|
|
BNE VERX1 * NO
|
|
CMP.W D1,D5 * MAYBE
|
|
BNE VERX1 * NO
|
|
|
|
MOVE.W (SP)+,ENDLOD(A6) * YES, RESTORE PROPER ENDLOD
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PCHKSM(A0),D0 * GET THE REAL CHECKSUM
|
|
CMP.W D0,D3
|
|
BNE.B VERX2 * ERROR
|
|
|
|
BRA PTRUE * SUCCESS
|
|
VERX2 BRA PFALSE * FAILURE
|
|
|
|
|
|
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
|
|
|
|
*** 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 BSR NXTBYT * GET THE OPERATION BYTE
|
|
|
|
IFEQ DEBUG
|
|
BSR DBTEST
|
|
ENDC
|
|
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
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
NXT0 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
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
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
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
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.B 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.B 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.B 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
|
|
|
|
* ---------------------------------------------------------------------------
|
|
|
|
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.B 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.B 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.B 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.B 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
|
|
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?
|
|
BEQ.B 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 JSR (A1) * CALL THE OPERATOR ROUTINE
|
|
BRA NXTINS
|
|
|
|
|
|
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
|
|
TEXT
|
|
|
|
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 OPSAVE-ZBASE * 181
|
|
DC.W OPREST-ZBASE * 182
|
|
DC.W OPRSTT-ZBASE * 183
|
|
DC.W OPRSTA-ZBASE * 184
|
|
DC.W OPFSTA-ZBASE * 185
|
|
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
|
|
DC.W OPERR-ZBASE * 191
|
|
|
|
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 OPBCOM-ZBASE * 143
|
|
|
|
TWOOPS:
|
|
EXTOPS: DC.W OPERR-ZBASE * 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 OPERR-ZBASE * 26
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
|
|
DC.W OPCALL-ZBASE * 224
|
|
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 EZIP
|
|
DC.W OPATTR-ZBASE * 241 EZIP
|
|
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 OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE * 250
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE
|
|
DC.W OPERR-ZBASE * 255
|
|
TEXT
|
|
|
|
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.W $2722 * <'>,<">
|
|
DC.B '/\-:()'
|
|
DC.W 0 * ASCIZ
|
|
TEXT
|
|
|
|
* 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.B 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.B PSX6 * NO, NORMAL CS
|
|
BGT.B 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.B 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.B PSX14 * GO PRINT THE CHARACTER
|
|
|
|
PSX6 CMPI.W #6,D2 * SPECIAL CODE (0 TO 5)?
|
|
BLT.B PSX9 * YES, SPACE, WORD, OR SHIFT
|
|
CMPI.W #2,D4 * MIGHT ALSO BE SPECIAL IF IN CS 2
|
|
BNE.B PSX8 * BUT WE'RE NOT
|
|
|
|
CMPI.W #7,D2 * CS 2, SPECIAL CODE FOR CRLF?
|
|
BEQ.B PSX7 * YES
|
|
BGT.B PSX8 * NO, NOT ASCII MODE, EITHER?
|
|
ADDQ.W #1,D4 * YES IT IS, SWITCH TO ASCII MODE (CS 3)
|
|
BRA.B PSX16 * AND GO GET NEXT BYTE
|
|
PSX7 BSR PUTNEW * CRLF REQUESTED, DO A NEWLINE
|
|
BRA.B 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.B PSX14 * GO PRINT IT
|
|
|
|
PSX9 TST.W D2 * IS IT A SPACE?
|
|
BNE.B PSX10 * NO
|
|
MOVEQ #32,D0 * YES, GO PRINT A SPACE
|
|
BRA.B PSX14
|
|
|
|
PSX10 CMPI.W #3,D2 * IS IT A WORD?
|
|
BGT.B 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.B PSX16
|
|
|
|
PSX11 SUBQ.W #3,D2 * CALCULATE NEW CS
|
|
TST.W D4 * TEMPORARY SHIFT (FROM CS 0)?
|
|
BNE.B PSX12 * NO
|
|
MOVE.W D2,D4 * YES, JUST SAVE NEW TEMP CS
|
|
BRA.B PSX16
|
|
|
|
PSX12 CMP.W D2,D4 * IS THIS THE CURRENT CS?
|
|
BEQ.B 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.B 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.B CHRCX1 * NO
|
|
MOVEQ #3,D0 * YES, RETURN DUMMY CS NUMBER
|
|
BRA.B CHRCX4
|
|
|
|
CHRCX1 CMPI.B #'a',D0 * LOWERCASE CHAR?
|
|
BLT.B CHRCX2 * NO
|
|
CMPI.B #'z',D0
|
|
BGT.B CHRCX2 * NO
|
|
CLR.W D0 * YES, RETURN CS 0
|
|
BRA.B CHRCX4
|
|
|
|
CHRCX2 CMPI.B #'A',D0 * UPPERCASE CHAR?
|
|
BLT.B CHRCX3 * NO
|
|
CMPI.B #'Z',D0
|
|
BGT.B CHRCX3 * NO
|
|
MOVEQ #1,D0 * YES, RETURN CS 1
|
|
BRA.B 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.B CHRBX2 * YES
|
|
TST.B (A0) * END OF STRING?
|
|
BNE CHRBX1 * NO, CONTINUE SEARCH
|
|
CLR.W D0 * YES, RETURN ZERO FOR FAILURE
|
|
BRA.B 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.B CHRBX4 * YES
|
|
SUBI.W #26,D0 * SUBTRACT MULTIPLES OF 26 UNTIL BASE CODE
|
|
BRA 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.B ZWX4 * YES
|
|
|
|
MOVE.W D1,D0
|
|
BSR CHRCS * FIND THE CS NUMBER FOR THIS CHAR
|
|
TST.W D0 * CS 0?
|
|
BEQ.B 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.B 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.B ZWX3 * YES
|
|
|
|
MOVEQ #6,D0 * NO, USE ASCII SHIFT
|
|
MOVE.W D0,-(SP)
|
|
SUBQ.W #1,D2 * DONE YET?
|
|
BEQ.B 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.B 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.B 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)
|
|
|
|
|
|
* 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.B 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.B 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.B QCX2A * ALLOW FOR EMPTY [DUMPED] BUFFER
|
|
|
|
QCX2 CMPI.B #32,-(A2) * SEARCH FOR SPACE BACKWARDS FROM END
|
|
BEQ.B 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 QCX5 * YES, CARRY EVERYTHING OVER TO NEXT LINE
|
|
|
|
MOVE.L NXTPTR(A4),A2 * OTHERWISE, OUTPUT EVERYTHING
|
|
BRA 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 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.
|
|
|
|
|
|
* 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 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)
|
|
|
|
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 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 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
|
|
|
|
|
|
* INPUT A CHARACTER FROM TERMINAL *** DEAD ***
|
|
|
|
*** GETCHR BRA INCHR * JUST GET IT
|
|
|
|
|
|
*--------------------------------------------------------------------------
|
|
* SCRIPT BUFFERING
|
|
*--------------------------------------------------------------------------
|
|
|
|
* QUEUE THE CHAR IN D0 FOR SCRIPTING
|
|
|
|
SCRCHR CMPI.B #13,D0 * CR?
|
|
BEQ 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
|
|
|
|
* 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.B SCRIX3 * NO, EXIT
|
|
|
|
TST.W D2 * LENGTH OF INPUT
|
|
BEQ.B 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.B SCRIX1
|
|
|
|
SCRIX2 TST.W D1 * CR REQUESTED?
|
|
BEQ SCRIX3 * NO
|
|
MOVEQ #13,D0 * YES, ADD THE CR
|
|
BSR SCRCHR
|
|
|
|
SCRIX3 MOVEM.L (SP)+,D2/A2
|
|
RTS
|
|
|
|
* 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
|
|
|
|
* 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.B 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
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* 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.B NZX4 * NO, EXIT
|
|
MOVE.W D0,CURBLK(A6) * YES, REMEMBER NEW BLOCK
|
|
|
|
TST.L CURTAB(A6) * IS OLD PAGE PRELOADED?
|
|
BEQ.B 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.B 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.B 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.B 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.B GPX3 * NOT IT
|
|
|
|
CMP.W CURBLK(A6),D0 * FOUND IT, BUT IS IT THE CURRENT ZPC PAGE?
|
|
BEQ.B 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.B 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
|
|
|
|
* 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.B 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
|
|
* ----------------------------------------------------------------------
|
|
|
|
* MISC SYSTEM INITIALIZATION
|
|
|
|
SYSIN1
|
|
LEA _curs_interrupt,A0 * SET UP OUR CURSOR TIMER
|
|
MOVE.L A0,_curs_addr
|
|
|
|
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
|
|
|
|
* ALLOCATE SOME MEMORY (NON-RELOCATABLE), NUMBER OF BYTES REQUESTED IN D0.L
|
|
* RETURN POINTER IN A0
|
|
|
|
* ON THE ATARI ST, GEMDOS-48 CRASHES IF THE REQUEST IS ODD. GETMEM THEREFORE
|
|
* FIRST ROUNDS UP ANY ODD REQUESTS.
|
|
|
|
GETMEM MOVEM.L D1-D7/A1-A5,-(SP)
|
|
BTST #0,D0 * WORD ALIGNED?
|
|
BEQ.B GETMX1 * YES
|
|
ADDQ.L #1,D0 * NO, ROUND UP TO AN EVEN REQUEST
|
|
|
|
GETMX1 MOVE.L D0,-(SP) * BYTES NEEDED
|
|
JSR _zalloc
|
|
* MOVE.W #$48,-(SP) * MALLOC (GEMDOS)
|
|
* TRAP #1
|
|
ADDA.W #4,SP * FLUSH STACK
|
|
|
|
TST.L D0 * GOT IT?
|
|
BEQ MEMERR * NO
|
|
MOVE.L D0,A0 * YES, RETURN POINTER
|
|
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
MEMERR CLR.W D0
|
|
LEA MSGME1,A0
|
|
BRA FATAL * 'Not enough memory'
|
|
|
|
DATA
|
|
MSGME1 DC.B 'Not enough memory',0
|
|
TEXT
|
|
|
|
* DETERMINE AVAILABLE MEMORY, RETURN NUMBER OF BYTES AVAILABLE IN D0.L
|
|
|
|
MEMSYS EQU 20*512 * FUDGE FACTOR FOR RUNTIME 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 * ADJUST FOR SYSTEM RUNTIME NEEDS
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
* 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
|
|
|
|
* TIME (IN 60THS SECOND) SINCE SYSTEM STARTUP
|
|
|
|
TIME60 CLR.L D0
|
|
RTS
|
|
|
|
* GIVEN AN ASCII CHAR, RETURN ITS UNIT WIDTH (IN CURRENT FONT)
|
|
|
|
CHSIZ MOVEQ #1,D0 *** ALWAYS ONE, FOR NOW
|
|
RTS
|
|
|
|
* BEEP SOUND *** NO AUDIO IN ORIGINAL ST HARDWARE ***
|
|
|
|
BEEP RTS
|
|
|
|
* MOVEM.L D1-D7/A1-A5,-(SP)
|
|
* JSR _flip_video * (LOOKS BAD)
|
|
* JSR _flip_video
|
|
* MOVEM.L (SP)+,D1-D7/A1-A5
|
|
|
|
* RESTART THE SYSTEM (RETURN TO THE DESKTOP)
|
|
|
|
FINISH TST.W GAMFIL(A6) * GAME OPEN?
|
|
BEQ FINIX1 * NO
|
|
BSR CLSGAM * YES, CLOSE THE GAME FILE
|
|
BEQ 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
|
|
* -----------------------------------------------
|
|
|
|
XREF _show_status * VOID show_status (str1, len1, str2, len2)
|
|
XREF _char_in * CHAR char_in ()
|
|
XREF _char_out * VOID char_out (CHAR)
|
|
XREF _line_out * VOID line_out (STRPTR, LEN)
|
|
|
|
* CALLS TO TTYIN OR INCHR SHOULD BE BRACKETED BY CALLS TO SETUP_INPUT
|
|
* IT SHOWS/HIDES THE INPUT CURSOR AND DOES OTHER STUFF
|
|
* D0 = 1 FOR BEGIN, 0 FOR END
|
|
|
|
SETUPI
|
|
RTS
|
|
|
|
* OUTPUT THE STATUS LINE, STRINGS IN A0-A1, LENGTHS IN D0-D1
|
|
|
|
STLINE MOVEM.L D2-D7/A2-A5,-(SP)
|
|
|
|
MOVE.L D1,-(SP) * LEN2, STR2
|
|
MOVE.L A1,-(SP)
|
|
MOVE.L D0,-(SP) * LEN1, STR1
|
|
MOVE.L A0,-(SP)
|
|
JSR _show_status
|
|
|
|
ADDA.W #16,SP * FLUSH ARGS
|
|
MOVEM.L (SP)+,D2-D7/A2-A5
|
|
RTS
|
|
|
|
* 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.B INCHX1 * YES, JUST EXIT
|
|
|
|
MOVE.W D0,-(SP)
|
|
BSR TTYOUT * ECHO CHAR
|
|
MOVE.W (SP)+,D0
|
|
INCHX1 RTS
|
|
|
|
* INPUT A SINGLE CHAR, NO ECHO (NULL MEANS EDIT OPERATION)
|
|
|
|
TTYIN MOVE.W #1,INLAST(A6) * CURRENT I/O IS INPUT
|
|
CLR.W LINES(A6) * RESET THE [MORE] COUNTER
|
|
|
|
MOVEM.L D1-D7/A1-A5,-(SP)
|
|
TTYX1 JSR _char_in
|
|
ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
|
|
CMPI.B #$0D,D0 * PASS ALONG THE STANDARD CONTROL CHARS
|
|
BEQ TTYX2
|
|
CMPI.B #$08,D0
|
|
BEQ TTYX2
|
|
|
|
CMPI.B #$20,D0 * FILTER OUT AND IGNORE OTHER CONTROL CHARS
|
|
BLT TTYX1
|
|
CMPI.B #$7F,D0
|
|
BGT TTYX1
|
|
|
|
BLT TTYX2
|
|
MOVEQ #8,D0 * MAP "DELETE" TO "BACKSPACE"
|
|
|
|
TTYX2 MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
* 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)
|
|
ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
|
|
MOVE.L D0,-(SP)
|
|
JSR _char_out
|
|
ADDQ.W #4,SP
|
|
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
|
|
* 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 NXTLX2 * DEGENERATE CASE, DON'T PAUSE
|
|
|
|
CMP.W LINES(A6),D0 * PAGE FULL YET?
|
|
BNE 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.B 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.B 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
|
|
|
|
* 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
|
|
|
|
* 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
|
|
|
|
* 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
|
|
*----------------------------------------------------------------------------
|
|
|
|
* 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.B OUTMX2 * YES
|
|
|
|
BSR PUTCHR * NO, DISPLAY/QUEUE IT
|
|
BRA OUTMX1
|
|
|
|
OUTMX2 TST.W VOBUFF(A6) * ARE WE BUFFERING OUTPUT?
|
|
BEQ OUTMX3 * NO
|
|
BSR PUTLIN1 * 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 OUTMX9 * NO, JUST A CR
|
|
BSR OUTMSG0 * YES, OUTPUT THE STRING
|
|
OUTMX9 BRA PUTNEW
|
|
|
|
* 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)
|
|
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.B 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.B FATLX2 * NO
|
|
|
|
MOVE.L D0,A0 * YES, DISPLAY THE STRING
|
|
BSR OUTMSG
|
|
FATLX2 BRA FINISH * GO WAIT FOR A FINAL KEY
|
|
|
|
* --------------------------------------------------------------
|
|
* SCRIPTING STUFF
|
|
* --------------------------------------------------------------
|
|
|
|
IFEQ CZIP
|
|
|
|
* TEST THE SCRIPT BIT, RETURN WITH FLAGS (NON-ZERO IF ACTIVE)
|
|
|
|
TSTSCR MOVE.L BUFFER(A6),A0
|
|
BTST #0,PFLAGS+1(A0) * SCRIPTING REQUESTED?
|
|
RTS * RETURN WITH FLAGS
|
|
ENDC
|
|
|
|
* 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
|
|
|
|
* 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
|
|
|
|
* 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
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* 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
|
|
MOVE.L D0,-(SP)
|
|
JSR _close_game * CLOSE THE GAME FILE
|
|
ADDQ.W #4,SP
|
|
|
|
CLR.W GAMFIL(A6) * ALWAYS ZERO WHEN FILE NOT OPEN
|
|
TST.L D0 * RETURN THE RESULT CODE
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
* 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 FILE DISK I/O ROUTINES
|
|
* --------------------------------------------------------------------------
|
|
|
|
* PRELIMINARY DIALOG FOR SAVE/RESTORE
|
|
* PROMPT USER TO SWAP DISKS AND IDENTIFY DRIVE BEING USED
|
|
* RETURN LETTER IN D0, ZERO FOR DEFAULT
|
|
|
|
DKSWAP MOVE.W D1,-(SP)
|
|
CLR.W D1 * DRIVE SELECTED, ASSUME DEFAULT
|
|
|
|
LEA MSGDKS,A0
|
|
BSR OUTMSG0 * PROMPT, DON'T ADD A CR
|
|
|
|
DATA
|
|
MSGDKS DC.B 'Insert your SAVE disk in any drive,'
|
|
DC.B ' then enter the letter of the drive: ',0
|
|
TEXT
|
|
|
|
DKSX1 BSR TTYIN * GET A CHAR
|
|
CMPI.B #13,D0 * USE THE DEFAULT?
|
|
BEQ DKSX3 * YES
|
|
|
|
CMPI.B #$60,D0 * UPPERCASE?
|
|
BLT DKSX2 * YES
|
|
SUBI.B #$20,D0 * NO, MAKE IT UPPERCASE
|
|
|
|
DKSX2 CMPI.B #'A',D0 * VALID DRIVE LETTER?
|
|
BLT DKSX1 * NO
|
|
CMPI.B #'Z',D0
|
|
BGT DKSX1 * NO
|
|
|
|
MOVE.W D0,D1 * YES, SAVE IT AND ECHO IT
|
|
BSR PUTCHR
|
|
DKSX3 BSR PUTNEW * FOLLOW WITH A CR
|
|
|
|
MOVE.W D1,D0 * RETURN THE DRIVE LETTER
|
|
MOVE.W (SP)+,D1
|
|
RTS
|
|
|
|
|
|
* DUPLICATE NAME DIALOG (SAVE ONLY)
|
|
* CHECK FOR FILENAME CONFLICT, IF SO, PROMPT USER FOR INSTRUCTIONS
|
|
* RETURN ZERO TO PROCEED NORMALLY, OTHERWISE ABORT
|
|
|
|
FNATTR EQU $16 * SEARCH INCLUDES HIDDEN, SYSTEM, SUBDIRECS
|
|
|
|
DUPNAM MOVEM.L D1-D7/A1-A5,-(SP)
|
|
|
|
MOVE.W #FNATTR,-(SP)
|
|
PEA _fullname * FILE TO SEARCH FOR
|
|
MOVE.W #$4E,-(SP) * DOS SEARCH FUNCTION
|
|
TRAP #1
|
|
|
|
ADDA.W #8,SP
|
|
TST.L D0 * RESULT
|
|
BEQ DUPX1 * ZERO MEANS CONFLICT
|
|
CLR.W D1 * OTHERWISE PROCEED NORMALLY
|
|
BRA DUPX3
|
|
|
|
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 DUPX2 * YES
|
|
CMPI.B #'y',D0
|
|
BEQ 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
|
|
|
|
* GET A FILE NAME UNDER WHICH TO SAVE A GAME, LEAVE NAME IN GLOBAL
|
|
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
|
|
|
|
GETSFL MOVEM.L D1-D7/A1-A5,-(SP)
|
|
* BSR DKSWAP * PROMPT FOR ID OF SAVE DISK
|
|
* MOVE.L D0,-(SP)
|
|
CLR.L -(SP) * *** ALWAYS USE DEFAULT ***
|
|
|
|
MOVEQ #1,D0 * SAVE, NOT RESTORE
|
|
MOVE.L D0,-(SP)
|
|
JSR _file_select
|
|
ADDQ.L #8,SP
|
|
|
|
MOVE.W D0,D1 * NON-ZERO IF CANCEL OR ERROR
|
|
BNE.B GTSFX1
|
|
BSR SCRNAM * IF OK, OUTPUT FILENAME TO SCRIPT
|
|
|
|
BSR DUPNAM * CHECK FOR DUPLICATE FILENAME
|
|
MOVE.W D0,D1 * NON-ZERO IF USER ABORTED
|
|
|
|
GTSFX1 TST.W D1 * RETURN FLAGS
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
|
|
* 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 NEWSX1 * NEGATIVE MEANS ERROR
|
|
|
|
MOVE.W D0,SAVFIL(A6) * OTHERWISE, SAVE CHANNEL NUMBER
|
|
CLR.W D0
|
|
BRA 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
|
|
|
|
|
|
* 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 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 SAVFIL(A6),D0
|
|
MOVE.L D0,-(SP)
|
|
JSR _write_file
|
|
ADDA.W #16,SP * FLUSH STACK
|
|
|
|
MOVE.L D0,-(SP) * ERROR?
|
|
BEQ PTSBX2 * NO
|
|
BGT PTSBX1 * YES, POSITIVE RESULT MEANS DISK FULL
|
|
|
|
BSR WPRCHK * IF WRITE-PROTECT ERROR, INFORM USER
|
|
BRA 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
|
|
|
|
|
|
* CHECK FOR DISK WRITE-PROTECT ERROR (DURING FILE CREATE AND/OR WRITE)
|
|
|
|
WPRCHK CMPI.W #-13,D0 * ERROR BECAUSE DISK IS WRITE-PROTECTED?
|
|
BNE 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
|
|
|
|
|
|
* 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
|
|
|
|
|
|
* 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
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* *** RESTORE FILE ROUTINES ***
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* GET A FILE NAME FROM WHICH TO RESTORE AN OLD SAVE FILE, LEAVE NAME IN GLOBAL
|
|
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
|
|
|
|
GETRFL MOVEM.L D1-D7/A1-A5,-(SP)
|
|
* BSR DKSWAP * PROMPT FOR LETTER OF SAVE DRIVE
|
|
* MOVE.L D0,-(SP)
|
|
CLR.L -(SP) * *** ALWAYS USE DEFAULT ***
|
|
|
|
CLR.L -(SP) * RESTORE, NOT SAVE
|
|
JSR _file_select
|
|
ADDQ.L #8,SP
|
|
|
|
MOVE.W D0,D1 * NON-ZERO IF CANCEL OR ERROR
|
|
BNE.B GTRFX1
|
|
BSR SCRNAM * IF OK, OUTPUT FILENAME TO SCRIPT
|
|
|
|
GTRFX1 TST.W D1 * RETURN WITH FLAGS
|
|
MOVEM.L (SP)+,D1-D7/A1-A5
|
|
RTS
|
|
|
|
|
|
* OPEN AN OLD SAVE 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
|
|
|
|
|
|
* 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 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 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
|
|
|
|
|
|
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
|
|
|
|
|
|
* CHECK FOR GAME DISK IN DEFAULT DRIVE BEFORE/AFTER SAVE/RESTORE
|
|
* CLOSE GAME FILE BEFORE, RE-OPEN IT AFTER
|
|
|
|
CHKDSK MOVEM.L D1/A1,-(SP)
|
|
MOVE.W D0,D1 * ZERO MEANS BEFORE
|
|
|
|
CHKDX1 TST.W D1 * STARTING THE SAVE/RESTORE?
|
|
BNE CHKDX2 * NO, ENDING
|
|
|
|
BSR CLSGAM
|
|
BEQ CHKDX4 * OK, FILE CLOSED, PROCEED
|
|
BRA CHKDX3 * ERROR
|
|
|
|
CHKDX2 BSR OPNGAM
|
|
BEQ 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 CHKDX1 * TRY AGAIN
|
|
|
|
CHKDX4 MOVEM.L (SP)+,D1/A1
|
|
RTS
|
|
|
|
|
|
PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* 68000 CALLS FROM C (XDEFS ARE REQUIRED)
|
|
* ----------------------------------------------------------------------------
|
|
|
|
XDEF _curs_interrupt
|
|
|
|
* INTERRUPT COMES HERE WHILE WAITING FOR KEY
|
|
* SHOW A CURSOR THEN CHAIN INTO NEXT INTERRUPT PROCESS
|
|
|
|
_curs_interrupt
|
|
|
|
* MOVEM.L D0-D7/A0-A6,-(SP) * PRESERVE ALL REGS
|
|
* JSR _blink_cursor
|
|
* MOVEM.L (SP)+,D0-D7/A0-A6
|
|
|
|
MOVE.W D0,-(SP)
|
|
MOVE.W _ms_tick,D0
|
|
ADD.W D0,_ms_total * ADVANCE OUR TIMER
|
|
MOVE.W (SP)+,D0
|
|
|
|
MOVE.L _otim_addr,-(SP)
|
|
RTS * JUMP DIRECTLY TO NEXT PROCESS
|
|
|
|
|
|
DATA
|
|
RTADDR DC.L 0
|
|
TEXT
|
|
|
|
XDEF _trap1
|
|
XDEF _trap2
|
|
XDEF _trap13
|
|
XDEF _trap14
|
|
|
|
_trap1 MOVE.L (SP)+,RTADDR * SAVE RETURN ADDR
|
|
TRAP #1 * MAKE A GEMDOS CALL (ARGS ON STACK)
|
|
MOVE.L RTADDR,-(SP)
|
|
RTS
|
|
|
|
_trap2 MOVE.L (SP)+,RTADDR * SAVE RETURN ADDR
|
|
TRAP #2
|
|
MOVE.L RTADDR,-(SP)
|
|
RTS
|
|
|
|
_trap13 MOVE.L (SP)+,RTADDR * SAVE RETURN ADDR
|
|
TRAP #13
|
|
MOVE.L RTADDR,-(SP)
|
|
RTS
|
|
|
|
_trap14 MOVE.L (SP)+,RTADDR * SAVE RETURN ADDR
|
|
TRAP #14
|
|
MOVE.L RTADDR,-(SP)
|
|
RTS
|
|
|
|
|
|
DATA
|
|
ZVARS DC.L 0 * CORRECT A6 IS STORED HERE
|
|
TEXT
|
|
|
|
* OPUSL1 NOP
|
|
|
|
* IFEQ CZIP
|
|
* MOVEM.L D3-D7/A2-A6,-(SP) * PRESERVE PASCAL'S REGISTERS
|
|
* MOVE.L ZVARS,A6 * SET UP ZIP'S VALUE OF A6
|
|
* BSR OPUSL
|
|
* MOVEM.L (SP)+,D3-D7/A2-A6
|
|
* ENDC
|
|
* RTS
|
|
|
|
|
|
* PROCEDURE OUTBUFLEN (charCount: INTEGER) -- adjust folding
|
|
|
|
* THIS WILL 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 12+0
|
|
MMDEST EQU 12+4
|
|
MMLEN EQU 12+8
|
|
|
|
_mov_mem
|
|
MOVEM.L D1/A1,-(SP)
|
|
MOVE.L MMLEN(SP),D0
|
|
BEQ.S MMX5 * ZERO, EXIT
|
|
MOVE.L MMSRC(SP),A0
|
|
MOVE.L MMDEST(SP),A1
|
|
|
|
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 MOVEM.L (SP)+,D1/A1
|
|
RTS
|
|
|
|
|
|
CMSRC EQU 12+0
|
|
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
|
|
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* END OF PROGRAM
|
|
* ----------------------------------------------------------------------------
|
|
|
|
END
|