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 * 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 * * 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 * * TELL CALLER TO USE ARGBLK OPXCAL NOP * * 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 * 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 * *** 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