Files
erkyrath.infocom-zcode-terps/amiga/zip1.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

1050 lines
28 KiB
NASM

SECTION ZCODE,CODE * DEFINE TWO SEGMENTS
NOP
SECTION ZDATA,DATA
DC.W 0
SECTION ZCODE * AND START IN CODE SEGMENT
* ___________________________________________________________________________
*
* Z-LANGUAGE INTERPRETER FOR COMMODORE AMIGA
*
* INFOCOM, INC. COMPANY CONFIDENTIAL -- NOT FOR DISTRIBUTION
* ___________________________________________________________________________
*
* WRITTEN BY: Duncan Blanchard
*
* MODIFICATION HISTORY:
*
* 18 OCT 85 ZIP A FROZEN
* 29 OCT 85 FILE_SELECT LIMITS SAVE NAME TO 25 CHARS
* 29 OCT 85 SCRERR DISPLAYS A PRINTER ERROR MESSAGE UPON FAILURE
* ZIP B FROZEN
* EZIP A FROZEN
* 10 FEB 86 CHANGED PUT, PUTB, PTSIZE (PURE PRELOAD > 32K)
* 10 APR 86 CHANGED PUTCHR (SPECIAL HANDLING FOR TABLE OUTPUT)
* 07 MAY 86 CHANGED NXTLIN/BUFOUT/LINOUT. BUFOUT CALLS NXTLIN
* SO [MORE] IS TIMED CORRECTLY DURING BOLDFACE, ETC
* CHANGED OPREAD, ONLY OVERFLOW WORDS ARE FLUSHED
* 08 MAY 86 FIXED QUECHR (QCX2A), ALLOW FOR EMPTY [DUMPED] BUFFER
* EZIP B FROZEN
* 01 JUL 87 EXPANDED OPSOUND
* 22 JUL 87 ADDED UNHIDE [SCREEN] TO RDLINE, FOR ALERTBOX BUG
* SCRIPTING FIX, ETC, IN AMIGAZIP
* EZIP C FROZEN
* 26 AUG 87 ADDED VOLUME ARG TO OPSOUND
* ZIP C FROZEN
* ---------------------------------------------------------------------------
* 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
* ---------------------------------------------------------------------------
* 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 ARGBLOCK (COUNT IS AT 0)
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
* ---------------------------------------------------------------------------
* EXTERNALS
* ---------------------------------------------------------------------------
* 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 _savename
XREF _saveback
** XREF _ms_tick
** XREF _ms_total
** XREF _otim_addr
XREF _temp_channel
XREF _temp_memory
* EXTERNALLY DEFINED ROUTINES
XREF _line_out * VOID line_out (STRPTR, LEN)
XREF _char_out * VOID char_out (CHAR)
XREF _char_in * CHAR char_in ()
XREF _show_status * VOID show_status (str1, len1, str2, len2)
XREF _show_more
XREF _highlight
XREF _clear_screen
XREF _clear_lines
XREF _clear_eol
* CALL THESE ROUTINES WHENEVER THE KERNEL ACCESSES THE CURRENT ROW/COLUMN
* (ENSURES CO-ORDINATION WITH THE CONSOLE DEVICE CURSOR FUNCTIONS)
XREF _read_cursor_pos
XREF _write_cursor_pos
XREF _exist_file
XREF _create_file
XREF _open_file
XREF _close_file
XREF _delete_file
XREF _read_file
XREF _write_file
XREF _open_game * LONG open_game ()
XREF _close_game * LONG close_game (refnum)
*** XREF _file_select * MOVED INTO 68K FOR NOW
XREF _new_default
XREF _drive_default
XREF _make_icon_file
XREF _c_getmem
XREF _c_maxmem
XREF _script_open
XREF _script_line
XREF _random_seed
XREF _window_resized
XREF _md_sound
XREF _unhide_screen
* EXTERNALLY REFERENCED ROUTINES
XDEF _START
XDEF _trap1
XDEF _trap2
XDEF _trap13
XDEF _trap14
* ---------------------------------------------------------------------------
* 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
MAXGAM EQU PAGTOT-4 * LARGEST POSS. PRELOAD (BYTES, ROUNDED UP)
MINGAM EQU MAXGAM-4 * SMALLEST POSS. PRELOAD
TOPSP EQU MINGAM-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 RANDOM, OTHERWISE SEQUENCE LIMIT
RCOUNT EQU RCYCLE-2 * CURRENT POSITION IN SEQUENCE
BUFFER EQU RCOUNT-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 TABLE-OUTPUT BUFFER (EZIP)
TABPTR EQU TABOUT-4 * POINTS TO NEXT POSITION IN TABLE
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 4 BYTES)
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 * OPTIONAL TIMOUT FUNCTION (EZIP), ZERO IF NONE
TDELAY EQU TIMOUT-2 * DELAY BEFORE TIMEOUT
TFUNC EQU 0 * (((DEAD)))
TBEGIN EQU TDELAY-4 * REFERENCE TIMEBASE FOR PENDING TIMEOUT
***
WIND1 EQU TBEGIN-2 * NON-ZERO IF CURRENTLY 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 * SCREEN 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-4 * REF NUMBER OF OPENED GAME FILE
SAVFIL EQU GAMFIL-4 * 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 (RELATIVE BYTE POINTER)
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)
SECTION ZDATA
IFEQ EZIP
INTWRD DC.B 4 * MACHINE ID FOR COMMODORE AMIGA
DC.B 'C' * EZIP INTERPRETER VERSION
SUBVER DC.W 0 * INTRPRETER SUB-VERSION, ZERO TO DISABLE
ENDC
IFEQ CZIP
INTWRD DC.B 0 * (UNUSED)
DC.B 'C' * INTERPRETER VERSION
SUBVER DC.W 0 * INTRPRETER SUB-VERSION, ZERO TO DISABLE
ENDC
* INITIAL SET OF READ BREAK CHARS -- SPACE, TAB, CR, <.>, <,>, <?>
IRBRKS DC.W $2009,$0D2E,$2C3F,0 * ASCIZ
SECTION ZCODE
* ---------------------------------------------------------------------------
_START 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.S STRX1
MOVE.L SP,TOPSP(A6) * SAVE THE SP FOR RESTARTS
LEA ZVARS,A0
MOVE.L A6,(A0) * KEEP A COPY OF A6 IN A KNOWN PLACE
* Careful about error msgs before all buffers are initialized.
* For example, a call to TSTSCR (via PUTCHR) before the preload data is
* read into BUFFER would access an invalid pointer.
* Send any output directly to screen (VOBUFF off), until QUECHR stuff set up.
MOVE.W #1,VOCONS(A6) * CONSOLE OUTPUT NORMALLY ACTIVE
MOVE.W #1,VIECHO(A6) * INPUT IS NORMALLY ECHOED
* Avoid the TSTSCR bug by pretending we're in window 1 (never scripts).
MOVE.W #1,WIND1(A6) * IN WINDOW 1 UNTIL PRELOAD COMPLETED
BSR SYSINI * OPEN THE GAME FILE
IFEQ EZIP
MOVE.W _columns,D0
CMPI.W #80-1,D0 * 80 COLUMNS MINIMUM, LESS FUDGE (AMIGA)
BGE STRX2 * OK
LEA MSG80C,A0 * NOT ENOUGH, INFORM USER AND QUIT
BSR OUTMSG
BRA FINISH
SECTION ZDATA
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
SECTION ZCODE
ENDC
*** READ GAME BLOCK 0 INTO A TEMP STACK BUFFER
STRX2 SUBA.W #512,SP * CREATE A TEMP BUFFER
MOVE.L SP,A4 * SAVE POINTER HERE FOR NOW
MOVE.L A4,A0
CLR.W D0 * BLOCK 0
BSR GETBLK * GET IT
*** CHECK MACHINE VERSION NUMBER
CMPI.B #ZMVERS,(A4) * PROPER Z-MACHINE VERSION?
BEQ.S STRX4 * YES
STRX3 CLR.W D0 * SOMETHING WRONG, DIE
LEA MSGZMV,A0
BRA FATAL * 'Wrong Z-machine'
SECTION ZDATA
MSGZMV DC.B 'Wrong Z-machine version',0
SECTION ZCODE
STRX4 MOVE.W PZRKID(A4),ZORKID(A6) * UNIQUE GAME ID, CHECKED BY "RESTORE"
IFEQ CZIP
BTST #0,PVERS2(A4) * PROPER BYTE-SWAP MODE?
BNE STRX3 * NO, FAIL
CLR.W TIMEMD(A6) * ASSUME SCORE-MODE FOR STATUS LINE
BTST #1,PVERS2(A4) * TIME MODE REQUESTED?
BEQ.S STRX6 * NO
ADDQ.W #1,TIMEMD(A6) * YES, SET TIME-MODE FLAG
ENDC
*** DETERMINE OUR MEMORY REQUIREMENTS
STRX6 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
BSR ROUNDUP
MOVE.L D0,MAXGAM(A6)
MOVEQ #0,D0
MOVE.W PENDLD(A4),D0 * "NORMAL" LENGTH OF PRELOAD (BYTES)
BSR ROUNDUP
MOVE.L D0,MINGAM(A6)
*** INQUIRE FREE MEMORY (AMIGA -- SUPPLY OUR MAXIMUM REQUIREMENT ...)
MOVE.L MAXGAM(A6),D0
ADD.L #STKLEN+1024+512,D0 * PLUS ZSTACK, 2 PAGES, MISC
BSR MEMAVAIL * DETERMINE HOW MUCH FREE MEMORY EXISTS
MOVE.L D0,D7 * SAVE THE NUMBER HERE
* THE FOUR POSSIBLE MEMORY SITUATIONS ...
*
* (1) MEMAVAIL exceeds PLENTH. Preload the entire game, and create
* two page buffers (minimum needed for $VER).
*
* (2) MEMAVAIL exceeds ENDLOD by at least (say) 40 pages. Preload through
* ENDLOD, and create as many page buffers as possible.
*
* (3) MEMAVAIL barely exceeds ENDLOD. In this situation, performance
* degrades sharply. To free up some memory, preload only through the
* beginning of the vocabulary table, and create as many page buffers
* as possible.
*
* (4) MEMAVAIL does not exceed ENDLOD. Life is tough.
*
CMP.L MAXGAM(A6),D7 * ENOUGH ROOM TO PRELOAD ENTIRE GAME?
BGE.S LOAD2C * YES
MOVE.L D7,D0
SUBI.L #40*512,D0 * ALLOW ABOUT 40 PAGES OVERHEAD
CMP.L MINGAM(A6),D0 * ENOUGH ROOM FOR A "COMFORTABLE FIT"?
BGE.S LOAD2B * YES
CMP.L MINGAM(A6),D7 * ENOUGH ROOM FOR A "TIGHT FIT"?
BGE.S LOAD2A * YES
BRA MEMERR * NO, FAIL
* PATCH MINGAM(A6) SO THAT VOCAB TABLE IS NOT PRELOADED
LOAD2A MOVEQ #0,D0
MOVE.W PVOCTB(A4),D0 * START OF VOCAB TABLE
ADD.L #64,D0 * BUT, BE CAREFUL TO INCLUDE THE VOCTAB HEADER
BSR ROUNDUP
MOVE.L D0,MINGAM(A6) * AND FALL THROUGH ...
* GIVEN MINGAM, SET ENDLOD AND MAXIMIZE PAGTOT
LOAD2B MOVE.L MINGAM(A6),D0
BSR BYTBLK
MOVE.W D0,ENDLOD(A6) * LENGTH OF PRELOAD (IN BLOCKS)
MOVE.L D7,D0
SUB.L MINGAM(A6),D0 * MEMORY REMAINING AFTER PRELOAD
DIVU #512+8,D0 * PAGES AVAIL (ALLOW 8 BYTES PER TABLE ENTRY)
CMPI.W #2,D0
BGE.S LOAD2X
MOVEQ #2,D0 * ENSURE THAT WE HAVE AT LEAST TWO
LOAD2X MOVE.W D0,PAGTOT(A6) * SAVE FOR LATER
BRA.S LOAD3
* GIVEN MAXGAM, SET ENDLOD AND MINIMIZE PAGTOT
LOAD2C MOVE.L MAXGAM(A6),D0
BSR BYTBLK * LENGTH OF GAME FILE (IN BLOCKS)
MOVE.W D0,ENDLOD(A6) * PRELOAD EVERYTHING
MOVE.W #2,PAGTOT(A6) * TWO PAGES ONLY (FOR $VERIFY)
*** GIVEN ENDLOD, ALLOCATE SOME MEMORY AND DO THE PRELOAD
LOAD3
IFEQ DEBUG
MOVE.W ENDLOD(A6),D0
BSR OPPRNN * SHOW PRELOAD
MOVE.B #'/',D0
BSR PUTCHR
MOVE.W PAGTOT(A6),D0 * SHOW PAGE COUNT
BSR OPPRNN
BSR PUTNEW
ENDC
MOVE.W ENDLOD(A6),D0 * SPACE NEEDED FOR PRELOAD (IN BLOCKS)
BSR BLKBYT * CONVERT TO BYTES
BSR GETMEM
MOVE.L A0,BUFFER(A6) * KEEP POINTER HERE
MOVE.W ENDLOD(A6),D1 * NUMBER OF BLOCKS TO PRELOAD
CLR.W D0 * STARTING WITH BLOCK 0
BSR GTBLKS * READ THEM IN
MOVE.L BUFFER(A6),A4 * USE PRELOAD BUFFER FOR REMAINING INITS
ADDA.W #512,SP * FLUSH THE TEMP BUFFER
CLR.W WIND1(A6) * RESTORE NORMAL VALUE (FOR PUTCHR/TSTSCR)
* ------------------------------------------------------------------------
*** INITIALIZE MAJOR TABLE POINTERS
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 (CONST FOR NOW)
MAXLEN EQU 256 * MAX LENGTH OF LINE BUFFER
MOVE.W #MAXLEN,D1
MOVE.W _columns,D2 * CURRENT WIDTH OF SCREEN DISPLAY
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
MOVE.W #1,VOBUFF(A6) * OKAY NOW TO BEGIN BUFFERING OUTPUT
*** 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.S 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.S 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
SUBA.L BUFFER(A6),A1 * RELATIVIZE NEXT TWO POINTERS
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.S 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)
BRA.S 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 USER FLAGS
START1 MOVE.L TOPSP(A6),SP * RE-INITIALIZE 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 * NO SOUND (AMIGA)
ORI.B #16+8+4+2+1,PVERS2(A2) * CURSOR/HIGHLIGHTS/SPLIT
LEA INTWRD,A0
MOVE.B (A0)+,PINTWD(A2) * STORE THE MACHINE ID
MOVE.B (A0),PINTWD+1(A2) * AND THE INTERPRETER VERSION
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 * NO STATUS LINE INITIALLY
BSR EZERR * CHECK OBJTAB ALIGNMENT
ENDC
IFEQ CZIP
BSET #5,PVERS2(A2) * SPLIT-SCREEN IS AVAILABLE
MOVE.W #1,_split_row * ALLOW FOR ONE 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 FIRST PAGE TO EXECUTE
BSR BOOTSV * 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.S EZERX1 * NO, FAIL
RTS
EZERX1 CLR.W D0
LEA MSGEZR,A0
BRA FATAL * 'OBJTAB alignment error'
SECTION ZDATA
MSGEZR DC.B 'OBJTAB alignment error',0
SECTION ZCODE
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 BSR ROUNDUP
LSR.L #8,D0
LSR.L #1,D0 * EXTRACT BLOCK NUMBER
RTS
* GIVEN A BYTE COUNT IN D0.L, ROUND UP TO NEAREST MULTIPLE OF 512
ROUNDUP
MOVE.W D0,-(SP)
ANDI.W #$01FF,(SP)+ * ARE THERE ANY FRACTIONAL BYTES?
BEQ.S RDUP1 * NO
ANDI.W #$FE00,D0 * YES, REMOVE THE FRACTIONAL BYTES
ADDI.L #$0200,D0 * AND ROUND UP
RDUP1 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.S 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.S 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.S 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.S 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.S NXTWRD * 0 MEANT LONG IMMEDIATE
BEQ.S NXTBYT * 1 MEANT SHORT IMMEDIATE
BSR NXTBYT * 2 MEANT VARIABLE, GET THE VAR
TST.W D0 * STACK?
BNE.S 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.S GETV1 * NO
MOVE.W (A4),D0 * YES, GET TOP-OF-STACK (DON'T POP)
RTS
GETV1 CMPI.W #16,D0 * LOCAL?
BGE.S 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.S PUTVX1 * NO
MOVE.W D1,(A4) * YES, UPDATE TOP-OF-STACK (DON'T PUSH)
RTS
PUTVX1 CMPI.W #16,D0 * LOCAL?
BGE.S 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.S 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.S 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.S PTRUX1 * NO, LEAVE FLAG ALONE
ADDQ.W #1,D1 * YES, INCREMENT FLAG
PTRUX1 BCLR #6,D0 * ONE-BYTE JUMP OFFSET?
BNE.S 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.S PTRUX3 * NO
ORI.W #$C000,D0 * YES, MAKE 16-BIT NUMBER NEGATIVE
PTRUX3 SUBQ.W #1,D1 * TEST FLAG
BEQ.S PTRUX6 * WAS 1, THAT MEANS DO NOTHING
TST.W D0 * ZERO JUMP?
BNE.S PTRUX4 * NO
BRA OPRFAL * YES, THAT MEANS DO AN RFALSE
PTRUX4 SUBQ.W #1,D0 * ONE JUMP?
BNE.S 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
BSR BLKCHK * CHECK FOR VALID BLOCK
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
BSR BLKCHK * CHECK FOR VALID BLOCK
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
BSR BLKCHK * CHECK FOR VALID BLOCK
ENDC
RTS
IFEQ DEBUG
BLKCHK
* CMP.W MAXLOD(A6),D0 * VALID BLOCK NUMBER?
* BCC BLKERR * BHS * NO, FAIL
RTS
BLKERR LEA MSGBLK,A0
BRA FATAL * 'Block range error'
SECTION ZDATA
MSGBLK DC.B 'Block range error',0
SECTION ZCODE
ENDC