github.com/erkyrath.infocom-zcode-terps
1
0
Fork 0
mirror of https://github.com/erkyrath/infocom-zcode-terps.git synced 2026-01-11 23:43:24 +00:00
Code Issues Packages Projects Releases Wiki Activity
erkyrath.infocom-zcode-terps/amiga/ax4.asm
Andrew Plotkin b642da811e Initial commit.
2023-11-16 18:19:54 -05:00

1503 lines
34 KiB
NASM
Raw Permalink Blame History

PAGE
* ----------------------------------------------------------------------
* MACHINE DEPENDENT ROUTINES -- AMIGA XZIP
* ----------------------------------------------------------------------
* SET THE SPLIT SIZE, D0 = LINES IN TOP SCREEN (0 IF UNSPLIT)
SETSPLT MOVE.W D0,_split_row
RTS
* RETURN D0 = SPLIT SIZE
GETSPLT MOVE.W _split_row,D0
RTS
* SET THE ACTIVE SCREEN, D0 = NEW VALUE (0 OR 1)
SETSCRN MOVE.W D0,_wind1
RTS
* RETURN D0 = CURRENTLY ACTIVE GAME SCREEN, PLUS FLAGS
GETSCRN MOVE.W _wind1,D0
RTS
* SET CURSOR POSITION ("IN SCREEN 1 ONLY" - SPEC)
* GIVEN D0.W = ROW, D1.W = COL (-1 MEANS DON'T CHANGE)
SETCURS
*** TST.W D0 * USE OLD VAL?
*** BLT.S SCURX1 * YES
*** TST.W D1 * MAYBE?
*** BGE.S SCURX2 * NO
*** SCURX1
*** MOVEM.W D0-D1,-(SP)
*** BSR GETCURS * AMIGA: MUST FIRST UPDATE OLD CURSOR VALS
*** MOVEM.W (SP)+,D0-D1
SCURX2 SUBQ.W #1,D0 * >> GIVEN 1-ORIGIN <<
BLT.S SCURX3
MOVE.W D0,_cur_row * >> STORE 0-ORIGIN <<
SCURX3 SUBQ.W #1,D1
BLT.S SCURX4
MOVE.W D1,_cur_column
SCURX4
*** SAVEREGS
*** JSR _write_cursor_pos
*** RESTREGS
RTS
* RETURN CURSOR POSITION ("IN SCREEN 1 ONLY" - SPEC)
* RETURN D0.W = ROW, D1.W = COL
GETCURS
*** SAVEREGS
*** JSR _read_cursor_pos
*** RESTREGS
MOVE.W _cur_row,D0 * >> STORED AS 0-ORIGIN <<
ADDQ.W #1,D0 * >> RETURN AS 1-ORIGIN <<
MOVE.W _cur_column,D1
ADDQ.W #1,D1
RTS
* GET FULL-SCREEN DIMENSIONS, RETURN D0.W = ROWS, D1.W = COLS
MAXSCRN MOVE.W _rows,D0
MOVE.W _columns,D1
RTS
* SET THE LEFT AND RIGHT MARGINS
* D0.W = LEFT, D1.W = RIGHT (DEFAULTS ARE BOTH 0)
SETMARG MOVE.W D0,_marg_left
MOVE.W D1,_marg_right
RTS
* RETURN THE LEFT AND RIGHT MARGINS
GETMARG MOVE.W _marg_left,D0
MOVE.W _marg_right,D1
RTS
* SET AN "UNDO-SUPPORTED" FLAG FOR PASCAL
SETUNDO RTS * [AMIGA: NOT USED]
* SET FONT (IN CURRENT WINDOW), D0.W = ID [MAC: "IN ALL WINDOWS" ]
ALTCHR EQU 128 * HACK IN HiLight FOR ALT CHARSET
STDCHR EQU 0 * REVERT TO NORMAL (PLAIN)
SETFONT CMPI.W #3,D0 * ALT CHARSET?
BNE.S SFNTX1
MOVE.W #ALTCHR,D0 * YES
BRA MDATTR
SFNTX1 MOVEQ #STDCHR,D0 * ANYTHING ELSE MEANS NORMAL
BRA MDATTR
* RETURN FONT (IN CURRENT WINDOW), D0.W = ID
GETFONT MOVEQ #-1,D0
BSR MDATTR
ANDI.W #ALTCHR,D0 * IN ALT CHARSET?
BNE.S GFNTX1 * YES
MOVEQ #1,D0 * ANYTHING ELSE MEANS NORMAL FONT
RTS
GFNTX1 MOVEQ #3,D0
RTS
* CLEAR FROM CURSOR TO END OF CURRENT LINE
MDERASE SAVEREGS
JSR _erase_eol
RESTREGS
RTS
* CLEAR SEVERAL LINES
* GIVEN D0.W = FIRST (1-ORIGIN), D1.W = LAST (INCLUSIVE)
MDCLEAR SAVEREGS
MOVE.L D1,-(SP) * >> MAKE LAST+1, 0-ORIGIN <<
SUBQ.W #1,D0 * >> MAKE 0-ORIGIN <<
MOVE.L D0,-(SP)
JSR _clear_lines
FLUSH 8
RESTREGS
RTS
* SET/GET SCREEN COLORS
* GIVEN D0.W = FORE, D1.W = BACK (ZERO = NO CHANGE)
* RETURN D0.W = DEFBACK/DEFFORE, D1.W = COLOR/MONO FLAG
MDCOLOR SAVEREGS
RESWORD
MOVE.L D1,-(SP)
MOVE.L D0,-(SP)
JSR _set_color
FLUSH 8
POPWORD
RESTREGS
MOVE.W _color,D1
RTS
* SET THE HIGHLIGHT ATTRIBUTES, ARGBIT(S) IN D0.W
* IF D0 = -1, JUST RETURN OLD ATTRIBUTES >> AMIGA: NOT IMPLEMENTED <<
MDATTR SAVEREGS
RESWORD
MOVE.L D0,-(SP)
JSR _highlight
FLUSH 4
POPWORD * OLD ATTRIBUTES
RESTREGS
RTS
* LOOKUP PICTURE SIZE INFO
* GIVEN D0.W = ID, A0 -> TABLE FOR RESULTS (WIDTH, HEIGHT)
* IF ID = 0, RETURN MAX ID IN TABLE WORD 0
* IF ID IS IN ERROR, RETURN FLAGS NEGATIVE, ELSE ZERO
PICINF MOVEQ #-1,D0 * [MAC: NOT IMPLEMENTED]
RTS
** MOVE.L A1,A0
** BSR PTAWRD * STORE WIDTH (OR MAX ID)
** TST.W D2 * WAS REQUEST FOR MAX ID ONLY?
** BEQ.S OPICX1 * YES
** MOVE.L A1,A0
** ADDQ.L #2,A0
** MOVE.W D1,D0
** BSR PTAWRD * STORE HEIGHT
* DISPLAY [OR CLEAR] A PICTURE
* D0.W = ID (1-ORIG), D1,D2 = XPOS,YPOS (1-ORIG), D3 = FLAG, SET TO CLEAR
PICDISP RTS
* IF A TITLE SCREEN WAS DRAWN, WAIT FOR A KEY. DON'T ERASE SCREEN, LET
* GAME. (OTHERWISE MAY CAUSE A FLASH AS GAME SETS UP ITS SCREEN COLORS.)
* COME HERE AFTER GAME HAS BEEN LOADED BUT BEFORE STARTING.
ENDTITLE
RTS
* ----------------------
* GERCHR
* ----------------------
* GIVEN A CHAR IN D0, CHECK IF IT'S AN XZIP (EXTENSION) GERMAN CHAR
* IF SO, CONVERT THE BYTE TO ITS NATIVE KEYCODE, IF ANY
GERCHR TST.B D0 * HIGH BIT SET?
BGE.S GERCX4 * NO, CAN'T BE AN GERMAN CHAR (EXIT)
MOVE.W D0,-(SP) * SAVE CHAR HERE
BSR GETFONT
SUBQ.W #1,D0 * CURRENTLY IN FONT 1 (NORMAL)?
BNE.S GERCX3 * NO, CAN'T BE A GERMAN CHAR (EXIT)
MOVE.W (SP),D0 * (COPY FROM STACK)
SAVEREGS
RESWORD
CLR.L -(SP) * CONVERT /TO/ NATIVE
MOVE.L D0,-(SP)
JSR _german_convert
FLUSH 8
POPWORD
RESTREGS
TST.B D0 * WAS IT GERMAN?
BEQ.S GERCX3 * NO
MOVE.W D0,(SP) * YES, REPLACE OLD VALUE
GERCX3 MOVE.W (SP)+,D0 * RETURN CHAR
GERCX4 RTS
* ----------------------
* SYSIN1
* ----------------------
* MISC SYSTEM INITIALIZATION
SYSIN1 BSR OPNGAM
BNE.S SYSX1 * ERROR
RTS * OK
SYSX1 LEA MSGOPN,A0
BRA FATAL * 'Story file open error.'
SECTION ZDATA
MSGOPN DC.B 'Story file open error.',0
SECTION ZCODE
* ----------------------
* GETM, GETMEM
* ----------------------
* ALLOCATE MEMORY, NUMBER OF BYTES REQUESTED IN D0.L, RETURN POINTER IN A0
* (GETMEM TRAPS ERRORS, GETM DOESN'T)
GETM SAVEREGS
BTST #0,D0 * ODD REQUEST?
BEQ.S GETMX1 * NO
ADDQ.L #1,D0 * YES, ROUND UP (FIXES ST GEMDOS-48 BUG)
GETMX1 RESLONG
MOVE.L D0,-(SP) * REQUEST
JSR _c_getmem
FLUSH 4
POPLONG
MOVE.L D0,A0 * RESULT, ZERO IF ERROR
RESTREGS
RTS
* ALLOCATE MEMORY AS ABOVE, AND CHECK FOR ERROR
GETMEM BSR GETM
MOVE.L A0,D0 * GOT IT?
BEQ.S MEMERROR * ZERO MEANS FAILURE
RTS
MEMERROR
CLR.W D0
LEA MSGME1,A0
BRA FATAL * 'Memory block allocation error'
SECTION ZDATA
MSGME1 DC.B 'Memory block allocation error',0
SECTION ZCODE
* ----------------------
* MEMAVAIL
* ----------------------
* INQUIRE AVAILABLE MEMORY
* GIVEN D0.L = MAX GAME LEN + OVERHEAD (BYTES)
* RETURN D0.L = NUMBER OF BYTES AVAILABLE (MAY BE FUDGED)
MEMSYS EQU 0 *** 40*512 * SYS OVERHEAD [moved to high-level]
MEMGAM EQU 280*1024 * XZIP GAME MAX (256 + PAGTAB + MISC)
MEMAVAIL
SAVEREGS
RESLONG
MOVE.L #MEMGAM,D0 * CRUDE UPPER LIMIT, PRELOAD+PAGES
MOVE.L D0,-(SP)
JSR _c_maxmem
FLUSH 4
POPLONG
** SUB.L #MEMSYS,D0
RESTREGS
RTS
* ----------------------
* GTSEED
* ----------------------
* RETURN A RANDOM NUMBER SEED IN D0, DIFFERENT EACH COLDSTART
GTSEED SAVEREGS
RESLONG
JSR _random_seed
POPLONG
RESTREGS
RTS
* ----------------------
* TIME60
* ----------------------
* ELAPSED TIME (IN 60THS SECOND) SINCE SYSTEM STARTUP
TIME60 MOVEQ #0,D0
RTS
* ----------------------
* CHSIZ
* ----------------------
* GIVEN AN ASCII CHAR, RETURN ITS UNIT WIDTH (IN CURRENT FONT)
CHSIZ MOVEQ #1,D0 * [MAC: ALWAYS ONE, FOR NOW]
RTS
* ----------------------
* DOSOUND
* ----------------------
* AMIGA: ADJUST ARGS
* VOLUME: 0-64, -1=USE MIDI VOL
* COUNT: 0=INFINITE, 1-254=FINITE, -1=USE MIDI COUNT
DOSOUND TST.W D2
BLT.S DOSDX1
ASL.W #3,D2 * MAP 0-8 TO 0-64
DOSDX1 TST.W D3
BGT.S DOSDX2 * IF 1-254, JUST PASS ALONG
ADDQ.W #1,D3 * MAP -1 TO 0
BEQ.S DOSDX2
MOVEQ #-1,D3 * MAP 0 TO -1
DOSDX2 SAVEREGS
MOVE.L D3,-(SP) * COUNT
MOVE.L D2,-(SP) * VOLUME
MOVE.L D1,-(SP) * ACTION
MOVE.L D0,-(SP) * ID
JSR _md_sound
FLUSH 16
RESTREGS
RTS
* ----------------------
* GAMINT, GAMINT1
* ----------------------
* PERIODICALLY CHECK FOR GAME INTERRUPTS
* NOTE: BECAUSE THE INTERPRETER AS A WHOLE IS /NOT/ RE-ENTRANT, THIS
* ROUTINE CHOULD BE CALLED ONLY FROM THE TOP OF THE MAIN LOOP (NXTINS), AND
* (PERHAPS) FROM OPREAD/OPINPUT (SO SOUNDS CAN CHAIN BETWEEN MOVES).
* BUT IT SHOULD /NOT/ BE CALLED FROM ITTYIN, SINCE THAT IS ALSO CALLED
* FROM [MORE], AND THE INTERPRETER STATE IS UNDEFINED.
SKPCNT EQU 50 * 2500 ops/sec (max) ==> 50 ints/sec (max)
* ENTRY POINT FROM MAIN LOOP
* To avoid cutting into interpreter performance too much, we keep a
* simple counter, and only occasionally perform the (somewhat costlier)
* check for a sound interrupt.
GAMINT SUBQ.W #1,SCOUNT(A6) * TIME FOR A SOUND CHECK?
BLE.S GAMIX1
RTS * NO, QUICK EXIT
GAMIX1 MOVE.W #SKPCNT,SCOUNT(A6) * YES, RESET COUNTER AND FALL THRU
* ENTRY POINT FROM INPUT-WAIT LOOP
* While awaiting Amiga input, we awaken only 10 times/sec anyway, so check
* for sound every time. Might actually prefer it be a bit more frequent.
* Note: called from OPREAD/OPINPUT; probably safe to call interrupt function
* as long as it doesn't itself call OPREAD/OPINPUT.
GAMINT1 SAVEREGS
* (could check first for valid SFUNC(A6), skip end-check if none,
* but then end event would hang around unreported ...)
RESWORD
JSR _end_sound * END-OF-SOUND CHECK
POPWORD * NON-ZERO IF END DETECTED
BEQ.S GAMIX3
MOVE.W SFUNC(A6),D0 * SOUND-INTERRUPT FUNCTION ("START NEXT")
BEQ.S GAMIX3 * NONE
BSR INCALL * CALL IT (INTERNALLY)
*** TST.W D0 * (NO RETURN VAL)
GAMIX3
*** JSR _int_key * TYPE-AHEAD CHECK (here or from real int?)
RESTREGS
RTS
* ----------------------
* FINISH
* ----------------------
* RESTART THE SYSTEM (RETURN TO THE DESKTOP)
FINISH MOVEQ #0,D0 * LAST-USED SOUND ID
MOVEQ #4,D1 * CLEANUP
MOVEQ #-1,D2 * (DEF VOL)
MOVEQ #-2,D3 * (DEF REPEAT)
BSR DOSOUND * MAKE SURE IT'S GONE
MOVEQ #0,D0
BSR SCRINIT * MAKE SURE SCRIPTING'S OFF
TST.W INLAST(A6) * HAS THERE BEEN INPUT SINCE LAST OUTPUT?
BNE FINIX3 * YES, JUST EXIT
BSR PUTNEW * NO, MUST FIRST PAUSE FOR A PROMPT
LEA MSGKEY,A0
BSR OUTMSG0 * 'Press any key to exit '
SECTION ZDATA
MSGKEY DC.B 'Press any key to exit ',0
SECTION ZCODE
** AMIGA: MUST SKIP THIS WHILE NO NULL-KEYS
** MOVEQ #1,D0 * [ALWAYS SETUP AROUND ITTYIN]
** MOVEQ #0,D1 * SINGLE CHAR
** BSR SETUPI
**FINIX2 BSR ITTYIN * FIRST CHECK FOR ANY TYPED-AHEAD KEYS ...
** TST.B D0 * AND DISCARD THEM
** BNE FINIX2 * UNTIL NO MORE
** MOVEQ #0,D0
** MOVEQ #0,D1 * SINGLE CHAR
** BSR SETUPI
BSR TTYIN * THEN WAIT FOR ONE MORE
FINIX3 BSR CLSGAM * CLOSE GAME FILE
UNLK A6 * FLUSH THE ZIP'S STACK FRAME
RTS * RETURN TO ORIGINAL CALLER
PAGE
* -----------------------------------------------
* SCREEN/KEY I/O
* -----------------------------------------------
* ----------------------
* SETUPI
* ----------------------
* MUST "BRACKET" CALLS TO TTYIN OR INCHR WITH CALLS TO HERE
* ACTIVATES/DEACTIVATES BLINKING CURSOR AND MENU COMMAND-STRINGS
* D0.W = 1 TO BEGIN CURSOR, 0 TO END
* D1.W = 1 IF STRING INPUT, 0 IF SINGLE-CHAR INPUT
SETUPI TST.W D0 * STARTING INPUT?
BEQ.S SETUX1 * NO, ENDING
MOVE.W #1,INLAST(A6) * SET INPUT FLAG
CLR.W LINES(A6) * RESET THE [MORE] COUNTER
SETUX1 SAVEREGS
EXT.L D1
MOVE.L D1,-(SP)
EXT.L D0
MOVE.L D0,-(SP) * [PASCAL: MOVE.B FOR BOOLS]
JSR _setup_input
FLUSH 8
RESTREGS
RTS
* ----------------------
* INCHR
* ----------------------
* INPUT A CHAR AND ECHO IT, RETURN CHAR IN D0 *** DEAD, USE READLN ***
* [CAREFUL WITH CR AND BACKSPACE]
INCHR BSR TTYIN * GET CHAR
TST.W VIECHO(A6) * IS ECHOING TURNED OFF?
BEQ.S INCHX1 * YES, JUST EXIT
MOVE.W D0,-(SP)
BSR TTYOUT * ECHO CHAR
MOVE.W (SP)+,D0
INCHX1 RTS
* ----------------------
* TTYIN, ITTYIN
* ----------------------
* INPUT A SINGLE CHAR (XZIP: or mouse clicks), NO ECHO
* IF NONE AVAILABLE, RETURN A ZERO IMMEDIATELY
ITTYIN SAVEREGS
RESWORD
JSR _event_in
POPWORD
RESTREGS
ANDI.W #$00FF,D0
BEQ.S ITTYX3 * [AMIGA:] NULL EVENTS ARE FOR TIMING
CMPI.B #253,D0 * MOUSE BUTTON CLICK? (SINGLE OR DOUBLE)
BEQ.S ITTYX6 * YES
CMPI.B #254,D0
BEQ.S ITTYX6 * YES
CMPI.B #127,D0 * [ALL: MAP 'DEL' TO 'BS']
BNE.S ITTYX1
MOVEQ #8,D0
ITTYX1 CMPI.B #3,D0 * [MAC: MAP 'ENTER' TO 'RETURN']
BNE.S ITTYX2
MOVEQ #13,D0
ITTYX2 CMPI.B #13,D0 * CR,BS ARE ONLY VALID CONTROL CHARS
BEQ.S ITTYX3
CMPI.B #8,D0
BEQ.S ITTYX3
CMPI.B #31,D0 * DISCARD OTHERS (TAB, CLR, ETC)
BLS ITTYIN * (LOOP BACK FOR ANOTHER)
ITTYX3 RTS * RETURN CHAR OR FKEY
* HERE AFTER MOUSE EVENT, STORE POSITION IN GLOBALS
ITTYX6 MOVE.W D0,-(SP) * SAVE MOUSE CODE (SINGLE OR DOUBLE)
*** ["BZ" ISN'T SETTING THE MOUSE BIT; DEPEND FOR NOW ON LOWCORE ERR-CHECK]
*** MOVE.L BUFFER(A6),A0
*** MOVE.W PFLAGS(A0),D0
*** BTST #FMOUS,D0 * BUT DOES GAME USE MOUSE?
*** BEQ.S ITTYX8 * NO
MOVEQ #PMLOCX,D0 * LOWCORE-EXTENSION VAR FOR MOUSE XPOS
BSR LOWCORE * GET ITS ADDR
BEQ.S ITTYX8 * ERROR (TABLE UNDEFINED, OR TOO SMALL)
MOVE.W _xmouse,D0
** ADDQ.W #1,D0 * (MAKE 1-ORIGIN)
BSR PTAWRD * STORE MOUSE X POSITION
MOVEQ #PMLOCY,D0
BSR LOWCORE
BEQ.S ITTYX8 * ERROR
MOVE.W _ymouse,D0
** ADDQ.W #1,D0 * (MAKE 1-ORIGIN)
BSR PTAWRD * STORE MOUSE Y POSITION
BRA.S ITTYX9
ITTYX8 CLR.W (SP) * ERROR, DISCARD MOUSE EVENT
ITTYX9 MOVE.W (SP)+,D0 * RETURN MOUSE CODE
RTS
* ENTER HERE TO LOOP UNTIL A CHAR IS AVAILABLE
TTYIN MOVEM.L D1-D2,-(SP)
MOVEQ #1,D0 * SET UP FOR INPUT
MOVEQ #0,D1 * SINGLE CHAR
BSR SETUPI
TTYX1 BSR ITTYIN
TST.B D0
BEQ.S TTYX1 * IF NONE, KEEP WAITING
MOVE.W D0,D2
MOVEQ #0,D0 * FINISHED INPUT
MOVEQ #0,D1 * SINGLE CHAR
BSR SETUPI
MOVE.W D2,D0 * RETURN THE CHAR
MOVEM.L (SP)+,D1-D2
RTS
* ----------------------
* OUTCHR
* ----------------------
* OUTPUT THE CHAR (OR CR) IN D0.B (SCROLLING IF NECESSARY)
OUTCHR CMPI.B #13,D0 * [DON'T PAUSE AT FINISH JUST FOR CR'S]
BEQ.S TTYOUT
CLR.W INLAST(A6) * CURRENT I/O IS OUTPUT
TTYOUT SAVEREGS
MOVEQ #0,D1
MOVE.B D0,D1 * CLEAR HIGH BYTE
CMPI.B #13,D1 * IS THIS A CR?
BNE.S TTYOX1
BSR CRCHECK * YES, CHECK FOR POSSIBLE INTERRUPT (XZIP)
TTYOX1 MOVE.L D1,-(SP)
JSR _char_out
FLUSH 4
RESTREGS
RTS
* ----------------------
* CRCHECK
* ----------------------
* XZIP: WE'RE ABOUT TO OUTPUT A CARRIAGE RETURN; CHECK FOR A SPECIAL INTERRUPT
CRCHECK MOVE.L BUFFER(A6),A0
MOVE.L A0,D0 * CHECK IF VALID (MAY BE HERE AFTER INIT ERROR)
BEQ.S CRCHX6
TST.W PCRCNT(A0) * CR COUNTER ACTIVE?
BEQ.S CRCHX6 * NO
SUBQ.W #1,PCRCNT(A0) * YES, DECREMENT IT; REACHED ZERO?
BNE.S CRCHX6 * NO
* AN INTERRUPT IS REQUESTED; INTERNALLY CALL THE INTERRUPT FUNCTION.
* Problem: register A4, dedicated to the game SP, is needed for this call
* but is NOT currently valid. That's because some of the I/O handlers
* "borrow" it, assuming that such an value would never be needed during I/O.
* Is this a good reason to avoid dedicating any other registers?
MOVE.L A4,-(SP)
MOVE.L STKBOT(A6),A4 * FAKE A SMALL GAME STACK
ADDA.W #100,A4 * AT THE BOTTOM OF THE REAL ONE
MOVE.W PCRFUNC(A0),D0
BSR INCALL * AND HANDLE THE INTERRUPT
MOVE.L (SP)+,A4
CRCHX6 RTS
* ----------------------
* NXTLIN
* ----------------------
* CHECK FOR END-OF-PAGE CONDITION
NXTLIN MOVEM.L D1-D2,-(SP)
BSR MAXSCRN
MOVE.W D0,D1 * TOTAL LINES
BSR GETSPLT
SUB.W D0,D1 * LINES AVAILABLE FOR SCROLLING
SUBQ.W #1,D1 * ALLOW ONE LINE FOR [MORE] ITSELF
BLE.S NXTLX6 * DEGENERATE CASE, DON'T PAUSE
CMP.W LINES(A6),D1 * PAGE FULL YET?
BGT.S NXTLX6 * NO, EXIT
IFEQ CZIP
BSR OPUSL * UPDATE STATUS LINE NOW
ENDC
*** MOVE.W _v_italic,-(SP) * SAVE ITALICS STATUS HERE
*** TST.W (SP) * CURRENTLY IN ITALIC MODE?
*** BEQ.S NXTLX1 * NO
*** CLR.L -(SP) * YES, SWITCH TO NORMAL FOR [MORE]
*** JSR _highlight * 0 NORMAL, 4 ITALIC
*** ADDQ.L #4,SP
NXTLX1 LEA MSGMOR,A0 * DISPLAY A PROMPT (NO CR)
MOVEQ #6,D0
BSR PRINT * WRITE DIRECTLY TO SCREEN
SECTION ZDATA
MSGMOR DC.B '[MORE]',0
SECTION ZCODE
BSR TTYIN * AND WAIT FOR A KEY, NO ECHO
MOVEQ #6,D1 * PROMPT LENGTH
NXTLX2 MOVEQ #8,D0
BSR TTYOUT * BACKUP CURSOR
SUBQ.W #1,D1
BNE.S NXTLX2
*** TST.W (SP) * FORMERLY IN ITALICS MODE?
*** BEQ.S NXTLX4 * NO
*** MOVEQ #4,D0 * YES, RESUME
*** MOVE.L D0,-(SP)
*** JSR _highlight * 0 NORMAL, 4 ITALIC
*** ADDQ.L #4,SP
NXTLX4 MOVE.W #1,LINES(A6) * RESET COUNTER, ALLOWING ONE OVERLAP LINE
NXTLX6 MOVEM.L (SP)+,D1-D2
RTS
* ----------------------
* PRINT
* ----------------------
* OUTPUT A STRING, POINTER IN A0, LENGTH IN D0.W
PRINT CLR.W INLAST(A6) * CURRENT I/O IS OUTPUT
TST.W D0
BEQ.S PRINTX1 * SKIP OUT IF NULL
SAVEREGS
MOVE.L D0,-(SP) * AND LENGTH
MOVE.L A0,-(SP) * PASS THE STRING POINTER
JSR _line_out
FLUSH 8
RESTREGS
PRINTX1 RTS
* ----------------------
* BUFOUT
* ----------------------
* OUTPUT THE LINE BUFFER, BEGINNING AND END IN A0, D0
* FIRST CHECK FOR END-OF-SCREEN CONDITION (UNLESS IN WINDOW 1)
BUFOUT MOVEM.L D0/A0,-(SP)
BSR GETSCRN * IN WINDOW 1?
BNE.S BUFUX1 * YES, SKIP THE SCREEN CHECK
BSR NXTLIN * PAUSE FOR [MORE] IF NECESSARY
BUFUX1 MOVEM.L (SP)+,D0/A0
SUB.L A0,D0 * CURRENT LENGTH OF BUFFER IN D0.W
BLE.S BUFUX2 * EXIT IF NOTHING
BSR PRINT * OTHERWISE, DISPLAY IT
BUFUX2 RTS
* ----------------------
* LINOUT
* ----------------------
* OUTPUT THE LINE BUFFER THEN ADD A CR, BEGINNING AND END IN A0, D0
* ALSO UPDATE THE CUMULATIVE LINE COUNTER
LINOUT BSR BUFOUT * DISPLAY IT
MOVEQ #13,D0
BSR OUTCHR * AND TACK ON A CR
BSR GETSCRN * IN WINDOW 1?
BNE.S LINOX1 * YES, IGNORE COUNTER
ADDQ.W #1,LINES(A6) * OTHERWISE UPDATE THE [MORE] COUNTER
LINOX1 RTS
PAGE
*----------------------------------------------------------------------------
* ZIP MESSAGES
*----------------------------------------------------------------------------
* ----------------------
* OUTMSG
* ----------------------
* OUTPUT AN ASCIZ MESSAGE, POINTER IN A0
OUTMSG0 MOVE.L A1,-(SP)
MOVE.L A0,A1 * STRING POINTER
OUTMX1 CLR.W D0
MOVE.B (A1)+,D0 * GET NEXT CHAR, END OF STRING?
BEQ.S OUTMX2 * YES
BSR PUTCHR * NO, DISPLAY/QUEUE IT
BRA OUTMX1
OUTMX2 TST.W VOBUFF(A6) * ARE WE BUFFERING OUTPUT?
BEQ.S OUTMX3 * NO
BSR PUTLIN * YES, EMPTY THE BUFFER NOW
OUTMX3 MOVE.L (SP)+,A1
RTS
* OUTPUT AN ASCIZ MESSAGE, POINTER IN A0 (NULL IF NONE)
* THEN APPEND A CR
OUTMSG MOVE.L A0,D0 * ANY MESSAGE?
BEQ.S OUTMX9 * NO, JUST A CR
BSR OUTMSG0 * YES, OUTPUT THE STRING
OUTMX9 BRA PUTNEW
* ----------------------
* ZWARN
* ----------------------
* PRINT AN INTERPRETER WARNING, A0 -> MESSAGE
ZWARN MOVE.L A0,-(SP)
BSR PUTNEW * CR
LEA MSGZWR,A0
BSR OUTMSG0 * MESSAGE HEADER
SECTION ZDATA
MSGZWR DC.B $2A,$2A,$2A * [***]
DC.B ' Interpreter warning: ',0
SECTION ZCODE
MOVE.L (SP)+,A0 * MESSAGE
BRA OUTMSG
* ----------------------
* FATAL
* ----------------------
* PRINT A FATAL ERROR HEADER, CODE NUMBER AND MESSAGE (LAST TWO ARE OPTIONALS)
* ERROR CODE IN D0.W, STRING IN A0, ZERO MEANS NONE
FATAL MOVE.L A0,A1 * [TRASHES THESE REGS, BUT DOESN'T MATTER]
MOVE.W D0,D1
BSR PUTNEW * NEW LINE
LEA MSGFTL,A0 * PRINT A STANDARD ERROR HEADER, NO CR
BSR OUTMSG0 * 'Internal Error '
SECTION ZDATA
MSGFTL DC.B 'Internal Error ',0
SECTION ZCODE
TST.W D1 * GOT A NUMBER?
BEQ.S FATLX1 * NO
MOVE.B #'#',D0 * YES, PRINT A PREFIX
BSR PUTCHR
MOVE.W D1,D0 * PRINT THE ERROR NUMBER
BSR OPPRNN
FATLX1 BSR PUTNEW * ANOTHER CR
MOVE.L A1,D0 * GOT A MESSAGE?
BEQ.S FATLX2
MOVE.L A1,A0 * YES, DISPLAY IT
BSR OUTMSG
FATLX2 BRA FINISH * WAIT FOR FINAL KEY, AND EXIT
* --------------------------------------------------------------
* SCRIPTING STUFF
* --------------------------------------------------------------
* ----------------------
* SCRINIT
* ----------------------
* OPEN/CLOSE SCRIPTING DEVICE (D0.W SET FOR OPEN)
* RETURN ACTIVE/INACTIVE STATUS FLAG
SCRINIT SAVEREGS
RESWORD
EXT.L D0 * 1 FOR OPEN, ZERO FOR CLOSE
MOVE.L D0,-(SP)
JSR _script_open
FLUSH 4
POPWORD * STATUS (ERRCODE WOULD BE BETTER ...)
RESTREGS
RTS
* ----------------------
* SCRERR
* ----------------------
* SCRIPT ERROR HANDLER
* WANT TO TERMINATE SCRIPTING ATTEMPTS (UNTIL NEXT SCRIPT COMMAND)
* DE-ACTIVATE PRINTER, ADJUST ZIP INTERNAL VARIABLES
SCRERR SAVEREGS
CLR.W D0 * ZERO FOR CLOSE
BSR SCRINIT * DEACTIVATE THE DEVICE
MOVE.L BUFFER(A6),A0
BCLR #FSCRI,PFLAGS+1(A0) * FORCE SCRIPT BIT OFF (ZIP + EZIP)
IFEQ EZIP
CLR.W VOPRNT(A6) * TURN OFF EZIP'S FLAG
ENDC
LEA MSGPRR,A0
BSR OUTMSG
BSR PUTNEW
SECTION ZDATA
MSGPRR DC.B '[Printer not ready, scripting halted]',0
SECTION ZCODE
RESTREGS
RTS
* ----------------------
* SCROUT
* ----------------------
* SCRIPT OUT A LINE, START IN A0, END IN D0, THEN TACK ON A CR/LF
SCROUT SAVEREGS
SUB.L A0,D0 * LENGTH OF STRING
MOVE.L D0,-(SP)
MOVE.L A0,-(SP)
JSR _script_line
FLUSH 8
TST.W D0 * ERROR?
BEQ.S SCOTX1 * NO
BSR SCRERR * YES, CLEAN UP AND DEACTIVATE
SCOTX1 RESTREGS
RTS
* --------------------------------------------------------------
* *** PURE HACKERY ***
* --------------------------------------------------------------
* THIS ROUTINE EXISTS TO ALLOW MACINTOSH USERS TO LAUNCH DIRECTLY INTO
* A SAVED GAME (BY DOUBLE-CLICKING IT), SKIPPING THE NORMAL GAME
* OPENING. IT CAN FUNCTION AT MOST ONCE.
* WE USED TO FORCE A "VERSION" DISPLAY (BY FAKING INPUT). THIS PREVENTED
* AN OPENING SCREEN THAT (IN SOME ZIP GAMES) SAID NOTHING BUT "OK". BUT
* SOME LATER GAMES PRINT LENGTHY DESCS, AND A "VERSION" LOOKS BAD.
SYSIN2
** MOVE.L APPARM(A6),D0 * GET THE "FINDER PARAMETERS" HANDLE
** BEQ.S SS2X1 * EXIT IF BEEN HERE ALREADY (HANDLE IS NULL)
** CLR.L APPARM(A6) * MARK HANDLE, SO THIS CODE ONLY RUNS ONCE!
**
** MOVE.L D0,A0
** MOVE.L (A0),A0 * EXTRACT THE POINTER
** TST.W 2(A0) * WAS ZIP LAUNCHED VIA A SAVED GAME?
** BEQ.S SS2X1 * NO, NORMAL LAUNCH, JUST MARK THE HANDLE
** BSR FNDRSF * COPY FINDER INFO INTO SF REPLY RECORD
** MOVE.L BUFFER(A6),A0
** BSET #FSTAT,PFLAGS+1(A0) * REQUEST STATUS LINE BE REDRAWN
* WARNING: HACKING (FOR TIMEOUTS) IN RES1 MEANS THAT CONTROL MAY NEVER
* RETURN HERE (IT JUMPS TO DISPATCH). DON'T ADD CODE BEYOND THIS POINT!.
** BSR RES1 * DO A SPECIAL RESTORE, SKIPPING NORMAL DIALOG
SS2X1 RTS
* GIVEN A0 -> "FINDER PARAMETERS BLOCK" (AS FROM GetAppParm),
* COPY THE SAVED GAME INFO (NAME AND VOL) INTO OUR RESTORE VARS
* (USE ONLY FIRST GAME, IF MORE THAN ONE IS INDICATED)
FNDRSF
** MOVEM.L D1/A1-A2,-(SP)
** MOVE.L A0,A2 * PARAMS PTR HERE
** LEA 12(A2),A0 * COPY FILE NAME
** LEA filename,A1
** MOVEQ #1,D0 * ALLOW FOR LENGTH BYTE
** ADD.B (A0),D0 * IN FIRST BYTE [MAC PASCAL]
** MOVEQ #64,D1 * MAX LEN (OF filename)
** BSR COPYS
** MOVE.W 4(A2),filevol * AND COPY VOLUME REFNUM
** MOVEM.L (SP)+,D1/A1-A2
RTS
PAGE
* ---------------------------------------------------------------------------
* DISK I/O ROUTINES
* ---------------------------------------------------------------------------
* GENERAL CONVENTION FOR DISK ROUTINE RESULTS:
* IF ROUTINE SUCCEEDS, RETURN WITH FLAGS INDICATING "ZERO"
* OTHERWISE, CALLER TRAPS ERRORS WITH A CONDITIONAL BRANCH ("BNE.S ERROR")
* OPEN THE GAME FILE, STORE REFNUM, RETURN FLAGS
* (THIS ROUTINE CALLED DURING INIT *AND* DURING SAVE/RESTORE)
OPNGAM SAVEREGS
JSR _open_game * OPEN THE GAME FILE, LEAVE REFNUM
TST.L D0 * RETURN ZERO FLAG FOR OKAY, ELSE ERROR
OPNGX1 RESTREGS
RTS
* CLOSE THE GAME FILE, RETURN FLAGS
CLSGAM SAVEREGS
JSR _close_game * CLOSE THE GAME FILE
TST.L D0 * RETURN THE RESULT CODE
RESTREGS
RTS
* ----------------------
* GETBLK
* ----------------------
* GET A GAME FILE BLOCK, BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0
GETBLK MOVEM.L D1,-(SP)
MOVEQ #1,D1 * ONE BLOCK
BSR GTBLKS
MOVEM.L (SP)+,D1 * (DOESN'T ALTER FLAGS)
RTS
* GET A SERIES OF GAME FILE BLOCKS
* FIRST BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0, TOTAL BLOCKS IN D1
GTBLKS SAVEREGS
BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
RESWORD
MOVE.L A0,-(SP) * BUFFER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.L _game_ref,D0 * [OK TO TRASH D0 NOW]
MOVE.L D0,-(SP)
JSR _read_file
FLUSH 16
POPWORD * ERROR ON READ?
BNE.S GTBKX2 * YES, FAIL
GTBKX1 RESTREGS
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 * 'Story file read error.'
SECTION ZDATA
MSGREA DC.B 'Story file read error.',0
SECTION ZCODE
PAGE
* --------------------------------------------------------------------------
* SAVE/RESTORE -- DISK I/O ROUTINES
* --------------------------------------------------------------------------
* ----------------------
* DKSWAP
* ----------------------
* PRELIMINARY DIALOG FOR SAVE/RESTORE
* PROMPT USER TO SWAP DISKS AND IDENTIFY DRIVE BEING USED
* RETURN LETTER IN D0, ZERO FOR DEFAULT
* >>> THIS FUNCTION NOW HANDLED WITHIN FILE-SELECT CALL <<<
* ----------------------
* DUPNAM
* ----------------------
* DUPLICATE NAME CHECK/DIALOG (FOR SAVES ONLY)
* CHECK FOR FILENAME CONFLICT, IF SO, PROMPT USER FOR INSTRUCTIONS
* RETURN ZERO TO PROCEED NORMALLY, OTHERWISE ABORT
DUPNAM
SAVEREGS
RESWORD
JSR _exist_file
POPWORD
MOVE.W D0,D1 * RESULT
BEQ.S DUPX3 * ZERO MEANS NONE
DUPX1 LEA MSGDUP,A0
BSR OUTMSG0 * PROMPT, DON'T ADD A CR
SECTION ZDATA
MSGDUP DC.B 'You are about to write over an existing file. '
DC.B 'Proceed? (Y/N) ',0
SECTION ZCODE
BSR TTYIN * GET A CHAR
CLR.W D1 * ASSUME A NORMAL SAVE
CMPI.B #'Y',D0 * PROCEED?
BEQ.S DUPX2 * YES
CMPI.B #'y',D0
BEQ.S DUPX2 * YES
MOVEQ #1,D1 * NO, ABORT (ANY KEY BESIDES 'Y')
MOVE.B #'N',D0
DUPX2 BSR PUTCHR
BSR PUTNEW * FOLLOW WITH A CR
DUPX3 MOVE.W D1,D0 * RETURN FLAGS FOR RESULT
RESTREGS
RTS
* ----------------------
* GETSFL
* ----------------------
* POLL USER FOR A FILE NAME, DRIVE, DIRECTORY, ETC (LEAVE IN GLOBAL)
* GIVEN:
* D0.W = SET IF SAVE, 0 IF RESTORE,
* D1.W = SET IF PARTIAL, 0 IF NORMAL,
* A0 -> XZIP "SUGGESTED" NAME (BYTE 0 IS LEN)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
GETSFL MOVEM.L D2-D3/A1,-(SP)
MOVE.W D0,D2 * REPOSITION THESE VALS
MOVE.W D1,D3
TST.W D3
BEQ.S GTSFX2 * IF NORMAL, NO SPECIAL NAME
MOVEQ #0,D0 * IF PARTIAL, SUGGEST SPECIAL NAME TO USER
*** MOVEQ #1,D0
MOVE.B (A0)+,D0 * SRC: LTABLE FORMAT (1ST BYTE IS LEN)
*** ADD.B (A0),D0
MOVEQ #12+1,D1 * MAX LEN (FOR GENERIC ST/PC DOS)
LEA _savename,A1 * DEST: 'C' FORMAT (ASCIZ)
BSR COPYS
GTSFX2 SAVEREGS
RESWORD
MOVE.L D2,-(SP) * SAVE/RESTORE
MOVE.L D3,-(SP) * NORMAL/PARTIAL [PASCAL: PASS BOOL @ODD ADDR]
JSR _file_select
FLUSH 8
POPWORD
RESTREGS
MOVE.W D0,D1 * FSEL RESULT, NON-ZERO IF CANCEL OR ERROR
BNE.S GTSFX8
LEA _savename,A0 * SIMPLE NAME (NO DISK/PATH SPEC)
BSR STRLEN * FIND LEN ('C' FORMAT)
BSR SCRNAM * ECHO NAME TO TRANSCRIPT
TST.W D2 * WAS THIS A SAVE?
BEQ.S GTSFX8 * NO
BSR DUPNAM * YES, CHECK FOR DUPLICATE FILENAME
MOVE.W D0,D1 * NON-ZERO IF USER SAYS ABORT
GTSFX8 MOVEM.L (SP)+,D2-D3/A1
TST.W D1 * FINAL RESULT, RETURN FLAGS
RTS
* ----------------------
* NEWSFL
* ----------------------
* CREATE (IF NECESSARY) AND OPEN A SAVE FILE, USING GLOBAL FILENAME
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
NEWSFL SAVEREGS
RESWORD
JSR _create_file
POPWORD
RESTREGS
BEQ.S NEWSX2 * ZERO MEANS NO ERROR
* CMPI.W #-44,D0 * ST: DISK IS WRITE-PROTECTED? (SAY SO)
* CMPI.W #-48,D0 * ST: NAME EXISTS ALREADY? (IGNORE)
MOVE.W D0,-(SP)
BSR WPRCHK * IF WRITE-PROTECT ERROR, INFORM USER
MOVE.W (SP)+,D0
NEWSX2 RTS * RETURN FLAGS
* ----------------------
* OPNSFL
* ----------------------
* OPEN A (RESTORE) FILE, USING GLOBAL FILENAME, LEAVE CHANNEL IN GLOBAL
* RETURN WITH FLAGS, ZERO IF NO ERROR
OPNSFL SAVEREGS
RESWORD
JSR _open_file
POPWORD * ZERO MEANS NO ERROR
RESTREGS
RTS
* ----------------------
* GTSBKS, SFREAD
* ----------------------
* GET A SERIES OF SAVE FILE BLOCKS
* FIRST BLOCK NUMBER IN D0, # OF BLOCKS IN D1, CORE TARGET LOCATION IN A0
* RETURN WITH FLAGS, NONZERO IF ERROR
GTSBKS BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
* RETURN FLAGS, >> ALSO D1 = ACTUAL BYTES READ <<
SFREAD SAVEREGS
RESWORD
MOVE.L A0,-(SP) * BUFFER POINTER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.L _save_ref,D0
MOVE.L D0,-(SP)
JSR _read_file
FLUSH 16
POPWORD
RESTREGS
MOVE.L _actlen,D1
TST.W D0 * NONZERO MEANS ERROR
RTS
* ----------------------
* PTSBKS, SFWRIT
* ----------------------
* WRITE A SERIES OF SAVE FILE BLOCKS,
* FIRST BLOCK OFFSET IN D0, NUMBER OF BLOCKS IN D1, CORE LOCATION IN A0,
* RETURN WITH FLAGS, NONZERO IF ERROR
PTSBKS BSR BLKBYT * CONVERT BLOCKS TO BYTES
EXG D1,D0
BSR BLKBYT
EXG D1,D0
* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
* RETURN FLAGS, >> ALSO D1 = ACTUAL BYTES READ <<
SFWRIT SAVEREGS
RESWORD
MOVE.L A0,-(SP) * BUFFER POINTER
MOVE.L D1,-(SP) * LENGTH IN BYTES
MOVE.L D0,-(SP) * OFFSET IN BYTES
MOVE.L _save_ref,D0
MOVE.L D0,-(SP)
JSR _write_file
FLUSH 16
POPWORD
RESTREGS
MOVE.W D0,D1 * ANY ERROR?
BEQ.S PTSBX2 * NO
CMPI.W #999,D0 * Amiga: DISK-FULL ERROR?
BEQ.S PTSBX1 * YES, INFORM USER
BSR WPRCHK * ALSO CHECK FOR WRITE-PROTECT ERROR
BRA.S PTSBX2
PTSBX1 LEA MSGFUL,A0
BSR OUTMSG * 'Not enough room on disk.'
SECTION ZDATA
MSGFUL DC.B 'Not enough room on disk.',0
SECTION ZCODE
PTSBX2 MOVE.W D1,D0
MOVE.L _actlen,D1 * COUNT
TST.W D0 * FLAGS, NONZERO MEANS ERROR
RTS
* ----------------------
* WPRCHK
* ----------------------
* CHECK FOR DISK WRITE-PROTECT ERROR, GIVEN D0 = RESULT CODE
* (MAY BE CALLED DURING FILE CREATE /OR/ FILE WRITE)
WPRCHK
CMPI.W #13,D0 * Amiga: WRITE-PROTECT ERROR?
BNE.S WPRCX1
LEA MSGWPR,A0 * INFORM USER
BSR OUTMSG * 'Disk is write-protected.'
WPRCX1 RTS
SECTION ZDATA
MSGWPR DC.B 'Disk is write-protected.',0
SECTION ZCODE
* ----------------------
* CLSSFL
* ----------------------
* CLOSE A SAVE FILE, CHANNEL IN GLOBAL
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
CLSSFL SAVEREGS
RESWORD
JSR _close_file
POPWORD * NON-ZERO IF ERROR
RESTREGS
RTS
* ----------------------
* DELSFL
* ----------------------
* DELETE A BAD SAVE FILE, MUST HAVE BEEN ALREADY CLOSED (OR NOT OPENED)
* RETURN WITH FLAGS SET, ZERO IF NO ERROR
DELSFL SAVEREGS
RESWORD
JSR _delete_file
POPWORD * NON-ZERO IF ERROR
RESTREGS
RTS
* ----------------------
* DEFOLD
* ----------------------
DEFOLD CLR.W D0 * RETRIEVE PREVIOUS DEFAULT NAMES
BRA DEFNX1
DEFNEW MOVEQ #1,D0 * UPDATE PREVIOUS DEFAULT NAMES
DEFNX1 SAVEREGS
MOVE.L D0,-(SP) * [PASCAL: PASS BOOL @ODD ADDR]
JSR _new_default * (COPIES SOME GLOBAL STRINGS)
FLUSH 4
RESTREGS
RTS
* ----------------------
* CHKDSK, CHKDSK1
* ----------------------
* [MAC: THIS CALL ISN'T NEEDED, SINCE THE OS DOES A GOOD JOB OF KEEPING
* TRACK OF WHEN THE GAME DISK HAS BEEN EJECTED, AND ASKING FOR IT WHEN
* NECESSARY.]
CHKDSK
CHKDSK1
RTS
* ASSOCIATE AN ICON WITH A NEWLY-CREATED SAVE FILE
MAKEICON
SAVEREGS
JSR _make_icon_file
TST.W D0 * IF NON-ZERO, SHOW ERROR MSG
BEQ.S MAKIX1
LEA MSGMKI,A0 * (NON-FATAL, SAVE IS STILL GOOD)
BSR OUTMSG
SECTION ZDATA
MSGMKI DC.B '[No icon]',0 * TERSE (SINCE MAY BE DELIBERATE)
SECTION ZCODE
MAKIX1 RESTREGS
RTS
* MAX FILENAME LENGTH (ACTUALLY *+5, ALLOWING FOR ".Info" FILE)
FNAMELEN EQU 48 * 'C' BUFFER IS 64-80
* ALTERNATE FILE-SELECTION ROUTINE (AMIGA -- IGNORES THE STACK PARAMETERS)
_file_select
SAVEREGS
LEA MSGIN1,A0 * PROMPT FOR A FILENAME
BSR OUTMSG
LEA MSGIN2,A0
BSR OUTMSG0
LEA _saveback,A0 * ALREADY ASCIZ
BSR OUTMSG0
LEA MSGIN3,A0
BSR OUTMSG0
BSR PUTLIN * MUST FLUSH BUFFER
SECTION ZDATA
MSGIN1 DC.B 'Enter a file name.',0
MSGIN2 DC.B '(Default is "',0
MSGIN3 DC.B '") >',0
SECTION ZCODE
* [READLN]
* [GIVEN A0 -> INPUT BUFFER, D0 = MAX LENGTH, D1 = CURRENT LENGTH]
* [RETURN A0 -> END OF ACTUAL INPUT (+1), D0 = TERM CHAR]
LEA _savename,A1 * STORE HERE
MOVE.L A1,A0
MOVEQ #FNAMELEN,D0 * MAX LENGTH OF NAME
CLR.W D1 * BUFFER IS CURRENTLY EMPTY
BSR READLN * COLLECT A RESPONSE
CMPA.L A0,A1 * ANYTHING?
BEQ.S FSELX1 * ZERO, MEANS USE DEFAULT
CLR.B (A0) * MAKE THE STRING ASCIZ
BRA.S FSELX2
FSELX1 CLR.L -(SP) * COPY _saveback TO _savename
JSR _new_default
FLUSH 4
FSELX2 JSR _drive_default * PREFIX WITH DEFAULT DRIVE (IF NONE GIVEN)
RESTREGS
CLR.W D0 * (ALWAYS) RETURN ZERO FOR OKAY
RTS
PAGE
* ----------------------------------------------------------------------------
* 68000 CALLS FROM C (XDEFS REQUIRED)
* ----------------------------------------------------------------------------
SECTION ZDATA
ZVARS DC.L 0 * CORRECT A6 STORED HERE, MUST RESTORE IF NEEDED
SECTION ZCODE
* PROCEDURE OutBufLen (charCount: INTEGER) -- ADJUST MAC FOLDING
* RESET ENDBUF (WHEN NEXT EMPTIED, TO PREVENT BUGS)
* OUTBUFLEN
* MOVE.L ZVARS,A0 * GET ZIP'S VALUE OF A6
* MOVE.W 4(SP),CURSIZ
* MOVE.L D0,MACBUF(A0)
* RTS
* ----------------------------------------------------------------------------
* FAST MEMORY ROUTINES
* USED FOR ST SCROLLING, ALSO FOR ISAVE/IRESTORE
* ----------------------------------------------------------------------------
* THIS ROUTINE PERFORMS A FAST BLOCKMOVE. ASSUMPTIONS ARE:
* () COPY MUST BE FROM HIGH TO LOW MEMORY IF IT OVERLAPS ("SCROLL UP")
* () MAX LENGTH IS 256K (32K x 16), DUE TO USE OF "DBxx"
MMSRC EQU 8+0 * 8 = 4 (REG) + 4 (RTS)
MMDEST EQU 8+4
MMLEN EQU 8+8
_mov_mem
MOVE.L A1,-(SP)
MOVE.L MMSRC(SP),A0
MOVE.L MMDEST(SP),A1
MOVE.L MMLEN(SP),D0
BEQ.S MMX0 * ZERO LENGTH, EXIT
BSR MOVMEM
MMX0 MOVE.L (SP)+,A1
RTS
* ALTERNATE ENTRY POINT (FOR 68K USERS), JUST TAKES ARGS IN REGS
* A0 -> SOURCE, A1 -> DEST, D0.L = LENGTH
MOVMEM MOVE.L D1,-(SP)
MOVE.W A0,D1 * CHECK FOR ODD-ALIGNED SRC ADDRESS
ANDI.W #1,D1
BNE.S MMX3 * IF SO, MUST USE SLOWER CODE
MOVE.W A1,D1 * CHECK DEST ADDRESS, TOO
ANDI.W #1,D1
BNE.S MMX3
MOVE.L D0,D1
ASR.L #4,D1 * DIVIDE BY 16: QUOTIENT HERE
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 MAX 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 MAX COUNT)
MMX5 MOVE.L (SP)+,D1 * DONE
RTS
CMSRC EQU 12+0 * 12 = 8 (REGS) + 4 (RTS)
CMLEN EQU 12+4
_clr_mem
MOVEM.L D1/A1,-(SP)
MOVE.L CMLEN(SP),D0
BEQ.S CMX5 * ZERO, EXIT
MOVE.L CMSRC(SP),A0
MOVE.W A0,D1 * CHECK FOR ODD SRC ADDRESS
ANDI.W #1,D1
BNE.S CMX3
MOVE.L D0,D1
ASR.L #4,D1 * DIVIDE BY 16: QUOTIENT
BRA.S CMX2 * ENTER LOOP AT DBRA
* PHASE 1 "CLEAR" -- MAXIMIZE SPEED
CMX1 CLR.L (A0)+ * CLEAR 16 BYTES ("UNROLL" FOUR ITERATIONS)
CLR.L (A0)+
CLR.L (A0)+
CLR.L (A0)+
CMX2 DBRA D1,CMX1 * LOOP (32K IS MAXIMUM COUNT)
ANDI.L #$0F,D0 * DIVIDE BY 16: REMAINDER
BEQ.S CMX5 * FALL THROUGH IF ANYTHING LEFT
* PHASE 2 "CLEAR" -- HANDLE EXTRA BYTES OR ODD CASES
CMX3 CLR.B (A0)+ * CLEAR ONE BYTE
SUBQ.L #1,D0
BNE.S CMX3 * LOOP (NO MAXIMUM COUNT)
CMX5 MOVEM.L (SP)+,D1/A1
RTS
Reference in New Issue View Git Blame Copy Permalink