.TITLE	ZIO
	.IDENT	/V1.20/
; ++
; This is the Z-machine routines for I/O instructions.
; (c) 2000 by Johnny Billquist
;
; History:
;
;	00-07-19	BQT	Initial coding started.
; Y1.0	00-08-26 21:00	BQT	First release.
; Y1.1	00-08-29 02:00	BQT	Fixed bug in scan table.
;				It is a branching instruction!
;				Fixed bug in TKNIZE. The buffer address
;				should be to physical mem, not virtual!
; Y1.2	00-09-05 01:00	BQT	Added timeout functionality.
; Y1.3	00-09-06 03:00	BQT	Added SAVE/RESTORE and RESTART opcode.
; Y1.4	00-09-06 20:00	BQT	Added handling of terminating chars in input,
;				and Latin-1.
; Y1.5	00-09-07 15:15	BQT	Bugfix in GETCHR. When Latin-1 input was added
;				timeout return broke.
; Y1.6	00-09-07 16:00	BQT	Changed code to detect if screen was modified
;				during GETSTR (through timer calls).
; Y1.7	00-09-15 02:00	BQT	Don't echo a newline if input line wasn't
;				terminated by a CR. Bugfix in DOSAVE and DOREST
;				which didn't call INPINI/INPEND. Added VT200
;				special keys for function keys, based on what
;				they do in Beyond Zork.
; V1.8	00-09-22 01:00	BQT	Added timeout capability to GETCH2.
; V1.9	00-10-07 21:00	BQT	Added newline output when restart.
; V1.10	00-11-07 14:00	BQT	Moved SETCOL to ZSCREE.MAC.
; V1.11	00-12-29 03:00	BQT	Changed semantics of CHARNE so that timeout
;				gave carry set. This meant we had to change
;				GETCHR do that timeout will return -1/-2.
; V1.12	00-12-30 04:30	BQT	Changed restart and restore to also restore
;				stack pointer to initial game value.
;				Bugfix: V4 and later restore should not
;				reset screens.
; V1.13	01-02-26 13:30	BQT	Added parameters to save/restore in V5.
; V1.14 03-09-02 00:00	BQT	Added some junk info in saved game format.
; V1.15	05-03-01 14:00	BQT	Changed restart to re-initialize screen.
; V1.16	05-05-24 16:00	BQT	Changed echo of input to use SCRECH instead
;				of SCRCHR (which gobbles spaces on wrap).
; V1.17 05-07-26 01:00	BQT	Bugfix in GET1. If no function pointer exist,
;				don't call DOCALL at all. In the case of calls
;				outside of game scope, the thing will barf
;				if calling DOCALL/FETCH.
;				(Typically in <Press ENTER> at startup)
; V1.18	05-10-25 01:00	BQT	Added new Latin1 <-> ZSCII conversion.
; V1.19	07-11-06 21:30	BQT	Bugfix. DOREST did a reset screen always.
;				Also, cleaned up restore routines.
; V1.20	08-09-04 16:30	BQT	Changed INPINI call. Moved most INPINI/INPEND
;				to STRGET
; --
	.INCLUDE	/ZMAC/
;
	.PSECT	DATA,D,RW
;
BLK:	.WORD	0
;
FPTR::	.WORD	0			; Function pointer for input interrupt
TMO::	.WORD	0			; Timeout value for input interrupt
;
NLFLG:	.WORD	0
;
FNAML==40
FNAM::	.BLKB	FNAML
;
	.PSECT	TEXT,D,RO
;
DELSTR:	.ASCIZ	<8.>" "<8.>		; Delete string.
CRSTR:	.ASCIZ	<13.><10.>		; CR string.
;
SAVNAM:	.ASCIZ	/Save to file: /
RESNAM:	.ASCIZ	/Restore from file: /
BADFMT:	.ASCIZ	/Save file don't match game./<15><12>
BADSAV:	.ASCIZ	/File isn't a ZEMU save file./<15><12>
;
ESCTAB:	.ASCIZ	/p/		; KP0	; Different esc sequences, and the code
	.BYTE	145.			; they correspond to.
	.ASCIZ	/q/		; KP1
	.BYTE	146.
	.ASCIZ	/r/		; KP2
	.BYTE	147.
	.ASCIZ	/s/		; KP3
	.BYTE	148.
	.ASCIZ	/t/		; KP4
	.BYTE	149.
	.ASCIZ	/u/		; KP5
	.BYTE	150.
	.ASCIZ	/v/		; KP6
	.BYTE	151.
	.ASCIZ	/w/		; KP7
	.BYTE	152.
	.ASCIZ	/x/		; KP8
	.BYTE	153.
	.ASCIZ	/y/		; KP9
	.BYTE	154.
	.ASCIZ	/A/		; Up
	.BYTE	129.
	.ASCIZ	/B/		; Down
	.BYTE	130.
	.ASCIZ	/D/		; Left
	.BYTE	131.
	.ASCIZ	/C/		; Right
	.BYTE	132.
				; F1		(LOOK AROUND)
	.ASCIZ	/P/		; (PF1)
	.BYTE	133.
	.ASCIZ	/6~/		; (Next screen)
	.BYTE	133.
				; F2		(INVENTORY)
	.ASCIZ	/Q/		; (PF2)
	.BYTE	134.
	.ASCIZ	/1~/		; (Find)
	.BYTE	134.
				; F3		(STATUS)
	.ASCIZ	/R/		; (PF3)
	.BYTE	135.
	.ASCIZ	/28~/		; (Help)
	.BYTE	135.
				; F4		(EXAMINE)
	.ASCIZ	/S/		; (PF4)
	.BYTE	136.
	.ASCIZ	/4~/		; (Select)
	.BYTE	136.
				; F5		(TAKE ...)
	.ASCIZ	/m/		; (KP-)
	.BYTE	137.
	.ASCIZ	/2~/		; (Insert here)
	.BYTE	137.
	.ASCIZ	/15~/		; (F5)
	.BYTE	137.
				; F6		(DROP ...)
	.ASCIZ	/17~/		; (F6)
	.BYTE	138.
	.ASCIZ	/3~/		; (Remove)
	.BYTE	138.
				; F7		(ATTACK MONSTER)
	.ASCIZ	/18~/		; (F7)
	.BYTE	139.
	.ASCIZ	/29~/		; (Do)
	.BYTE	139.
				; F8		(AGAIN)
	.ASCIZ	/19~/		; (F8)
	.BYTE	140.
	.ASCIZ	/5~/		; (Previous screen)
	.BYTE	140.
				; F9		(UNDO)
	.ASCIZ	/20~/		; (F9)
	.BYTE	141.
				; F10		(OOPS ...)
	.ASCIZ	/21~/		; (F10)
	.BYTE	142.
	.ASCIZ	/23~/		; F11
	.BYTE	143.
	.ASCIZ	/24~/		; F12
	.BYTE	144.
	.BYTE	0,0		; End of table.
;
LCTAB:	.BYTE	0,1,2,3,4,5,6,7,10,11,12,13,14,15,16,17
	.BYTE	20,21,22,23,24,25,26,27,30,31,32,33,34,35,36,37
	.BYTE	40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57
	.BYTE	60,61,62,63,64,65,66,67,70,71,72,73,74,75,76,77
	.BYTE	100,141,142,143,144,145,146,147,150,151,152,153,154,155,156,157
	.BYTE	160,161,162,163,164,165,166,167,170,171,172,133,134,135,136,137
	.BYTE	140,141,142,143,144,145,146,147,150,151,152,153,154,155,156,157
	.BYTE	160,161,162,163,164,165,166,167,170,171,172,173,174,175,176,177
	.BYTE	200,201,202,203,204,205,206,207,210,211,212,213,214,215,216,217
	.BYTE	220,221,222,223,224,225,226,227,230,231,232,233,234,235,233,234
	.BYTE	235,241,242,243,244,245,246,244,245,251,252,253,254,255,256,251
	.BYTE	252,253,254,255,256,265,266,267,270,271,265,266,267,270,271,277
	.BYTE	300,301,302,303,277,300,301,302,303,311,311,313,313,315,316,317
	.BYTE	315,316,317,323,323,325,325,327,330,327,330,333,334,334,336,337
	.BYTE	340,341,342,343,344,345,346,347,350,351,352,353,354,355,356,357
	.BYTE	360,361,362,363,364,365,366,367,370,371,372,373,374,375,376,377
;
	.PSECT	CODE,I,RO
;
; CVTLC - Convert ZSCII to lowercase.
;
; In: R1 - Character
;
; Out: R1 - Character
;
CVTLC:	BIC	#^C377,R1
	MOVB	LCTAB(R1),R1
	BIC	#^C377,R1
	RETURN
;
; GETCH2 - Get one character.
;
; In: R3 - Timeout value.
; Out: R3 - ZSCII character read.
;
; -2 means timeout abort (read, when plying game).
; -1 means timeout.
;
GETCH2::
	MOV	R3,TMO
	CALL	INPINI
	CALL	GETCHR
	CALL	INPEND
	RETURN
;
; GETCHR - Get one character, with translation for special keys.
;
; Out: R3 - ZSCII character.
;
; -2 means timeout abort (read, when playing game).
; -1 means timeout.
;
GETCHR:
	CALL	RESLIN			; Reset line count.
	MOV	R0,-(SP)		; Save registers.
	MOV	R1,-(SP)
	CALL	GET1			; Get character.
1$:	CMPB	R0,#33			; ESC?
	BEQ	10$			; Yes. Possible special handling.
	CMPB	R0,#233			; CSI?
	BEQ	10$			; Yes.
	CMPB	R0,#217			; SS3?
	BEQ	10$			; Yes.
2$:	MOV	R0,R1			; Timeout?
	BMI	9$			; Yes.
	CALL	CL2Z			; No. Convert to ZSCII.
9$:	MOV	R1,R3
	MOV	(SP)+,R1
	MOV	(SP)+,R0		; Restore registers.
	RETURN
;
; We received an ESC. If this is a VT52, or VT100 and better, we can do
; some tricks now...
;
10$:	CMP	SCRTYP,#VT52		; VT52?
	BEQ	100$			; Yes.
	CMP	SCRTYP,#VT100		; VT100 or better?
	BLO	2$			; No.
;
; VT100 or better handling.
;
200$:	MOV	#ESCBF,R3		; Set up pointer to buffer for saves.
	BIT	#200,R0			; Was it 8-bit ctrl?
	BNE	210$			; Yes.
	CALL	GET1			; No. Read next.
	CMPB	R0,#'[			; CSI?
	BEQ	210$			; Yes.
	CMPB	R0,#'O			; SS3?
	BEQ	210$			; Yes.
	BR	1$			; Uh? What was this?
;
; We now have the first parts of an ESC sequence. Now we'll read until
; we get a letter.
;
210$:	CALL	GET1			; Read...
	MOV	R0,R1			; Perhaps timeout...
	BMI	9$			; Yes...
	MOVB	R1,(R3)+		; No. Save char in buffer.
	CMPB	R1,#100			; Termination?
	BLT	210$			; No.
	CLRB	(R3)			; Okay. Now we have it all.
	BR	1000$
;
; VT52 ESC handling...
;
100$:	MOV	#ESCBF,R3		; Place to save next characters...
110$:	CALL	GET1			; Get one more char.
	MOV	R0,R1			; Timeout?
	BMI	9$			; Yes.
	MOVB	R1,(R3)			; No. Save char.
	CMPB	R1,#'?			; Was it a '?'
	BEQ	110$			; Yes. Go again.
	CLRB	1(R3)			; No. Mark end.
;
; We'll now try to find a matching entry to what we read in a table.
;
1000$:	MOV	#ESCTAB,R0
1010$:	MOV	#ESCBF,R3		; Next entry. Point at string.
1020$:	TSTB	(R0)			; End of entry?
	BEQ	1030$			; Yes. We might be done.
	CMPB	(R0)+,(R3)+		; Compare strings.
	BEQ	1020$			; Equal. Continue.
1025$:	TSTB	(R0)+			; Not equal. Find next entry.
	BNE	1025$
1027$:	TSTB	(R0)+			; End of entry. Any more entries?
	BNE	1010$			; Yes. Continue.
	MOV	#33,R3			; No match. Give ESC back.
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
1030$:	CMPB	(R0)+,(R3)+		; End of our string too?
	BNE	1027$			; No. Do next entry.
	CLR	R3
	BISB	(R0),R3			; Get result.
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; GET1 - Read one character.
;
; Out: R0 - Character.
;
; This routine also handles timeouts.
; If the underlying read function returns with carry set, that means we should
; call the routine whose address are in FPTR. If that routine then
; returns 1, GET1 should abort, and will return -2, otherwise
; we'll return -1 to indicate that we had a timeout, and *might*
; want to do some extra handling.
;
	.ENABL	LSB
GET1:	MOV	R1,-(SP)		; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	CALL	CHARNE			; Read character.
	BCC	100$			; No timeout.
	MOV	#ARGS,R2		; Yes. Setup call.
	MOV	FPTR,(R2)
	BEQ	10$			; No function, skip things below.
	MOV	#1,R3
	MOV	#R.INT,-(R5)		; Return handler.
	CALL	DOCALL			; Perform call.
	JMP	FETCH			; And start executing.
;
; I/O "interrupt" return.
;
IOINT::
	TST	(SP)+			; Drop return to fetch.
	TST	R0			; Check result.
	BEQ	10$			; False means return -1.
	MOV	#-2,R0
	BR	100$
10$:	MOV	#-1,R0
100$:	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RETURN
	.DSABL	LSB
;
; ISPRIN - Is character printable?
;
; In: R3 - Character.
;
; Out: Carry set if character is printable.
;
ISPRIN:	CMPB	R3,#40
	BLO	10$
	CMPB	R3,#177
	BLO	20$
	CMPB	R3,#155.
	BLO	10$
	CMPB	R3,#251.
	BLO	20$
;
10$:	CLC
20$:	RETURN
;
; GETSTR - Get a string from the user.
;
; In: R0 - Address where to place next char.
;     R1 - Address of start of buffer.
;     R2 - Free space left in buffer.
;
; Out: R0 - updated.
;      R1 - Terminating character.
;
GETSTR::
	CALL	INPINI			; Initiate input processing.
	MOV	R3,-(SP)		; Save registers.
10$:	CALL	RESMOD			; Clear screen flag.
	CLR	NLFLG
11$:	CALL	GETCHR			; Read a character.
	CMP	R3,#-2			; Timeout?
	BEQ	999$			; Yes. Finish.
	TST	R3
	BPL	12$			; No. Reread?
;
; We had a timeout. Maybe we should redisplay input here...
;
	CALL	ISMOD			; Did something got printed?
	BCC	11$			; No.
	CLRB	(R0)			; Yes. Mark end of buffer.
	MOV	R0,-(SP)		; Save pointer.
	MOV	R1,R0			; Get start of buffer.
	CALL	SCRTXT			; Output text.
	MOV	(SP)+,R0		; Restore pointer.
	BR	10$
;
; We got a normal character. Let's handle it.
;
12$:	CMPB	R3,#13.			; CR?
	BEQ	100$			; Yes. Finish.
	MOV	R4,-(SP)		; Save R4.
	MOV	ZTCPTR,R4		; Check other terminators.
	BEQ	129$			; None exist.
120$:	TSTB	(R4)			; End of table?
	BEQ	129$			; Yes.
	CMPB	R3,(R4)+		; No. Is it a match?
	BNE	120$			; No. Loop.
	MOV	(SP)+,R4		; Yes. Restore R4.
	BR	111$			; No. Loop.
129$:	MOV	(SP)+,R4		; Restore R4.
	CMPB	R3,#127.		; DEL?
	BEQ	90$			; Yes.
	CMPB	R3,#8.
	BEQ	90$
	CMPB	R3,#25			; ^U?
	BEQ	80$			; Yes.
	TST	R2			; Any space left?
	BEQ	10$			; No. Go again.
	CALL	ISPRIN			; Printable?
	BCC	10$			; No.
	MOVB	R3,(R0)+		; Yes. Save char.
	MOV	R1,-(SP)		; Save R1.
	MOV	R3,R1
	CALL	CZ2L			; Convert to Latin-1.
	CALL	SCRECH			; echo character.
	MOV	(SP)+,R1		; Restore R1.
	DEC	R2			; Update values.
	BR	10$
;
; ^U
;
80$:	MOV	R0,R3			; Get size in R3.
	SUB	R1,R3
	BEQ	10$			; Nothing to delete...
	MOV	#DELSTR,R0		; Point at delete string.
	ADD	R3,R2			; Number of additional characters in buf
81$:	CALL	SCRTXT			; Output delete string.
	SOB	R3,81$			; Repeat.
	MOV	R1,R0			; Set pointer.
	BR	10$			; Done.
;
; Delete...
;
90$:	CMP	R0,R1			; Are we at start?
	BEQ	10$			; Yes. Go again.
	DEC	R0			; No. Back up.
	INC	R2
	MOV	R0,-(SP)		; Save registers.
	MOV	#DELSTR,R0		; Output delete sequence.
	CALL	SCRTXT
	MOV	(SP)+,R0		; Restore registers.
	BR	10$
;
; End of line came.
;
100$:	MOV	R0,-(SP)
	MOV	#CRSTR,R0		; Now output a newline.
	CALL	SCRTXT
	CALL	FLUSH
	CALL	INPEND			; Input done.
	MOV	(SP)+,R0
	INC	NLFLG
111$:	MOV	R3,-(SP)		; Save terminating char.
	MOV	R0,-(SP)		; Save final pointer.
	SUB	R1,R0			; Get length.
	BEQ	102$
	MOV	R1,R3			; Get pointer in R3.
101$:	MOVB	(R3),R1			; Convert all chars to lowercase.
	CALL	PRNCHR
	CALL	CVTLC
	MOVB	R1,(R3)+
	SOB	R0,101$
102$:	TST	NLFLG
	BEQ	103$
	MOV	#13.,R1
	CALL	PRNCHR
103$:	MOV	(SP)+,R0		; Restore end pointer.
	MOV	(SP)+,R1		; Get terminating char.
	MOV	(SP)+,R3
	RETURN
;
999$:	MOV	R1,R0			; Set pointer to start.
	CLR	R1			; Terminating char is nul.
	MOV	(SP)+,R3
	RETURN
;
; 1OP:135 7 print_addr byte-address-of-string
;
	.ENABL	LSB
PADDR::	.INSTR	"print_addr",#1
	MOV	(R2),R3			; Get address.
	CLR	R2
	BR	PSTR
	.DSABL	LSB
;
; 1OP:141 D print_paddr packed-address-of-string
;
	.ENABL	LSB
PRPADR::
	.INSTR	"print_paddr",#1
	MOV	(R2),R1			; Get packed address.
	CALL	@PPACK			; Calculate address.
	MOV	R1,R3			; Move answer into R2,R3
	MOV	R0,R2
	.DSABL	LSB
;
; Print a string from an address given in R2,R3
;
PSTR:	CLR	-(SP)			; Make room on stack for word.
	CALL	ATRAN			; Translate address.
	MOVB	(R0),1(SP)		; Save high byte.
	INC	R3			; Next address.
	BNE	20$
	INC	R2
20$:	CALL	ATRAN			; Translate address.
	MOVB	(R0),(SP)
	MOV	(SP)+,R1		; Put together both bytes.
	INC	R3			; Next address.
	BNE	30$
	INC	R2
30$:	CALL	PUTZW			; Output packed text word.
	TST	R1			; Check if end of string.
	BPL	PSTR			; No.
	RETURN
;
; 1OP:138 A print_obj object
;
	.ENABL	LSB
PROBJ::	.INSTR	"print_obj",#1
	MOV	(R2),R0			; Get object number.
	CALLR	OBJTXT			; Get object text.
	.DSABL	LSB
;
; 0OP:178 2 print
;
	.ENABL	LSB
PRINT::	.INSTR	"print",#0
10$:	.GETIW	R1				; Get word.
	CALL	PUTZW				; Output it.
	TST	R1				; repeat until last word.
	BPL	10$
	RETURN
	.DSABL	LSB
;
; 0OP:179 3 print_ret
;
	.ENABL	LSB
PRINTR::
	.INSTR	"print_ret",#0
	CALL	PRINT				; Easy... :-)
	CALL	NEWLIN
	CALLR	RTRUE
	.DSABL	LSB
;
; 0OP:181 5 1 save ?(label)
;
	.ENABL	LSB
SAVE1::	.INSTR	"save(1)",#0
	CALL	DOSAVE
	TST	R0
	BNE	10$
	JMP	BFALSE		; Failed.
10$:	JMP	BTRUE		; Ok!
	.DSABL	LSB
;
; 0OP:182 6 1 restore ?(label)
;
	.ENABL	LSB
REST1::	.INSTR	"restore(1)",#0
	CALL	DOREST
	TST	R0
	BNE	10$
	JMP	BFALSE			; Failure.
10$:	MOV	SAVSP,SP		; Setup stack pointer.
	MOV	#FETCH,-(SP)		; Push a return address.
	MOV	#1,R3			; Clear top window.
	MOV	#ARGS,R2
	MOV	#-1,(R2)
	CALLR	ERWIN
	JMP	BTRUE			; Success in new context.
	.DSABL	LSB
;
; Perform a game save.
;
; Out: R0 - Result of save.
;		0 - Fail.
;		1 - Success.
;
DOSAVE:	MOV	ZEROP,R3
	MOV	20(R3),-(SP)
	BICB	#1,21(R3)
	MOV	#SAVNAM,R0		; Output prompt.
	CALL	SCRTXT
	CLR	TMO			; No timeout.
	MOV	#FNAM,R0		; Read filename.
	MOV	R0,R1
	MOV	#FNAML-1,R2
	CALL	GETSTR			; Get string.
	CLRB	(R0)			; Terminate file name.
	MOV	R0,R1
	MOV	#FNAM,R0		; Get pointer to file name.
	SUB	R0,R1			; Get length of file name.
	MOV	#-1,R2			; Indicate that we want a new file.
	CALL	SAVOPN			; Create save file.
	BCC	1$
	JMP	1000$
;
; We now have a save file open.
;
; Let's put down the data we want to save.
; First is identification and game state.
;
1$:	MOV	#IOBUF,R0		; Data to write.
	MOV	#"ZE,(R0)+		; Identifier.
	MOV	#"MU,(R0)+
	MOV	ZVER,(R0)+		; Game version.
	MOV	ZDICT,(R0)+		; Dictionary.
	MOV	ZOBJ,(R0)+		; Object table.
	MOV	ZVAR,(R0)+		; Variables.
	MOV	WRLIM,(R0)+		; Write limit.
	MOV	ZPC,(R0)+		; PC
	MOV	ZPC+2,(R0)+
	MOV	STKTOP,(R0)		; Stack size.
	SUB	R5,(R0)+
	MOV	STKTOP,(R0)		; Frame pointer.
	SUB	R4,(R0)+
	MOV	GAMID,(R0)+		; Save junk game info.
	MOV	GAMID+2,(R0)+
	MOV	GAMID+4,(R0)+
	MOV	#IOBUF,R0		; Point at buffer.
	CALL	SAVBLK			; Save block.
;
; Next is game stack.
;
	MOV	STKTOP,R3		; Get top of stack.
	MOV	#IOBUF,R0		; Block pointer.
	MOV	#1000/2,R1		; Length of block in words.
	BR	20$
10$:	MOV	-(R3),(R0)+		; Save word.
	DEC	R1			; Full block?
	BNE	20$			; No.
	MOV	#IOBUF,R0		; Yes...
	MOV	#1000/2,R1
	CALL	SAVBLK			; Write out block.
20$:	CMP	R3,R5			; Stack done?
	BNE	10$			; No.
;
; Now we have to save all the differences from the original gamefile.
;
SOFF=2					; Start offset to check from.
	MOV	#IOBUF,R0
	MOV	#1000/4,R1
	CALL	SAVBLK			; Save last piece of stack.
	MOV	R4,-(SP)		; Save registers.
	MOV	R5,-(SP)
	CLR	BLK			; R2 shall hold block number.
	MOV	ZEROP,R3		; R3 points at current data.
	ADD	#SOFF,R3
	MOV	WRLIM,R4		; R4 counts off data to check.
	SUB	#SOFF,R4
	ASR	R4			; Count should be in words.
	MOV	#IOBUF2,R5		; Point at buffer for original data.
	.BLK	R5,BLK			; Read one block.
	ADD	#SOFF,R5
	MOV	#<1000-SOFF>/2,R2	; Number of words per block.
;
; Here we have the following:
; R0 points to write buffer
; R1 holds doublewords left before write buffer is full.
; R2 holds words left in read buffer.
; R3 points at game memory we're currently checking.
; R4 holds the number of words of game memory left to check.
; R5 points at read buffer.
;
110$:	CMP	(R3),(R5)+		; Data change?
	BEQ	120$			; No.
	MOV	R3,(R0)			; Yes. Save address.
	SUB	ZEROP,(R0)+
	MOV	(R3),(R0)+		; Save data.
	DEC	R1			; Left in this buffer.
	BNE	120$			; Buffer not full.
	MOV	#IOBUF,R0		; Buffer full.
	MOV	#1000/4,R1
	CALL	SAVBLK			; Write out buffer.
120$:	ADD	#2,R3			; Next address.
	DEC	R4
	BEQ	130$			; End of dynamic memory.
	SOB	R2,110$			; Next word in block.
	INC	BLK			; Next block.
	MOV	#IOBUF2,R5		; Point at buffer for original data.
	.BLK	R5,BLK			; Read one block.
	MOV	#1000/2,R2		; Number of words per block.
	BR	110$			; Loop until all is done.
;
130$:	CLR	(R0)
	MOV	#IOBUF,R0		; Buffer full.
	CALL	SAVBLK			; Write out buffer.
;
; All changes have been written. Now we're done.
;
	MOV	(SP)+,R5		; Restore registers.
	MOV	(SP)+,R4
	MOV	#1,R0			; Success.
	CALL	SAVCLO
	BR	1010$
;
1000$:	CLR	R0
1010$:	MOV	ZEROP,R3
	MOV	(SP)+,20(R3)
	RETURN
;
; DOREST - Do the actual game restore.
;
; Out: R0 - Result
;		0 - Fail.
;		2 - Success.
;
DOREST:	MOV	ZEROP,R3
	MOV	20(R3),-(SP)
	BICB	#1,21(R3)
	MOV	#RESNAM,R0		; Output prompt.
	CALL	SCRTXT
	CLR	TMO			; No timeout.
	MOV	#FNAM,R0		; Read filename.
	MOV	R0,R1
	MOV	#FNAML-1,R2
	CALL	GETSTR
	CLRB	(R0)			; Terminate filename.
	MOV	R0,R1
	MOV	#FNAM,R0		; Get pointer to file name.
	SUB	R0,R1			; Get length of file name.
	CALL	RESOPN			; Open save file.
	BCS	1000$			; Fail.
;
; We now have a retore file open...
;
; Start by checking the data we want to restore.
;
	MOV	#IOBUF,R0		; Buffer to read to.
	CALL	RESBLK			; Restore block.
	CMP	#"ZE,(R0)+		; Check contents.
	BNE	998$
	CMP	#"MU,(R0)+
	BNE	998$
	CMP	ZVER,(R0)+		; A save file. Our game?
	BNE	999$
	CMP	ZDICT,(R0)+
	BNE	999$
	CMP	ZOBJ,(R0)+
	BNE	999$
	CMP	ZVAR,(R0)+
	BNE	999$
	CMP	WRLIM,(R0)+
	BNE	999$
	MOV	(R0)+,ZPC		; Save file feels good. Let's use it.
	MOV	(R0)+,ZPC+2
	MOV	(R0)+,R3		; Get stack size.
	MOV	STKTOP,R4
	SUB	(R0)+,R4		; Get frame pointer.
;
; Now restore stack.
;
	MOV	STKTOP,R5		; Stack pointer.
	ASR	R3			; Get stack size in words.
	MOV	#IOBUF,R0		; Get stack...
	MOV	#1000/2,R1
	CALL	RESBLK			; Read block.
20$:	MOV	(R0)+,-(R5)		; Push value.
	DEC	R1			; Count block.
	BNE	30$			; Block not finished.
	MOV	#IOBUF,R0
	MOV	#1000/2,R1
	CALL	RESBLK
30$:	SOB	R3,20$			; Repeat until whole stack done.
;
; Now do the game area.
;
	CALL	DYNINI			; Reset game area.
	CALL	VARINI
90$:	MOV	#IOBUF,R0		; Point at I/O buffer.
	MOV	#1000/4,R1		; Size of block.
	CALL	RESBLK
100$:	MOV	(R0)+,R2		; Point at word.
	BEQ	110$			; Final marker...
	ADD	ZEROP,R2
	MOV	(R0)+,(R2)		; Restore data.
	SOB	R1,100$			; Repeat for whole block.
	BR	90$			; Next block.
;
; All done.
;
110$:	CALL	SCRVAR			; Setup screen variables.
	MOV	#2,R0
	CALL	RESCLO
	BR	1010$
;
998$:	MOV	#BADSAV,R0
	BR	9990$		
;
999$:	MOV	#BADFMT,R0
9990$:	CALL	SCRTXT
	CALL	RESCLO
1000$:	CLR	R0
1010$:	MOV	ZEROP,R3
	MOV	(SP)+,20(R3)
	RETURN
;
; 0OP:183 7 1 restart
;
	.ENABL	LSB
RSTART::
	.INSTR	"restart",#0
	CALL	DYNINI			; Reinitiate dynamic memory.
	CALL	VARINI			; Setup variables.
	CALL	SCRINI			; Initiate screen.
	MOV	SAVSP,SP		; Reset SP.
	JMP	ZRUN			; Start running.
	.DSABL	LSB
;
; 0OP:187 B new_line
;
	.ENABL	LSB
NEWLIN::
	.INSTR	"new_line",#0
	MOVB	#13.,R1
	CALL	PUTCHR
	MOVB	#10.,R1
	CALLR	PUTCHR
	.DSABL	LSB
;
; 0OP:188 C 3 show_status
;
	.ENABL	LSB
SHOSTS::
	.INSTR	"show_status",#0
	CALLR	SCRSTS
	.DSABL	LSB
;
; 0OP:181 5 4 save -> (result)
;
	.ENABL	LSB
SAVE4::	.INSTR	"save(4)",#0
	CALL	DOSAVE
	CALLR	RESULT
	.DSABL	LSB
;
; 0OP:182 5 4 restore -> (result)
;
	.ENABL	LSB
REST4::	.INSTR	"restore(4)",#0
	CALL	DOREST
	TST	R0
	BEQ	10$
	MOV	SAVSP,SP		; Setup stack pointer.
	MOV	#FETCH,-(SP)		; Push return address.
10$:	CALLR	RESULT
	.DSABL	LSB
;
; VAR:228 4 1 sread text parse
;
	.ENABL	LSB
SREAD1::
	.INSTR	"sread(1)",#2
	CMP	ZVER,#3			; Version 3?
	BNE	1$			; No.
	CALL	SCRSTS			; Show status.
	MOV	#ARGS,R2
1$:	CLR	TMO			; No timeout.
	MOV	(R2),R3			; Get argument.
	CLR	R2
	CALL	ATRAN			; Translate address.
	MOV	R0,-(SP)		; Save address.
	MOVB	(R0)+,R2		; Get allowed length.
	BIC	#^C377,R2
	DEC	R2
	MOV	R0,R1			; And start of buffer pointer.
	MOV	R1,-(SP)		; Save string pointer.
	CALL	GETSTR			; Get string.
	CLRB	(R0)			; Set end byte.
	MOV	(SP)+,R1		; Get string pointer.
	MOV	(SP)+,R0		; Restore start pointer.
;
; Now we have a nul-terminated string.
;
; R0 holds the start of buffer, while R1 points at the string.
;
	MOV	R4,-(SP)		; Save game frame pointer.
	MOV	ARGS+2,R3		; Parse address.
	MOV	ZDICT,R2		; Get dictionary.
	CLR	R4			; Flags...
	CALL	PARSE			; Parse string.
	MOV	(SP)+,R4		; Restore frame pointer.
	RETURN
	.DSABL	LSB
;
; VAR:229 5 print_char output-character-code
;
	.ENABL	LSB
PCHAR::	.INSTR	"print_char",#1
	MOV	(R2),R1
	CALLR	PUTCHR
	.DSABL	LSB
;
; VAR:230 6 print_num value
;
	.ENABL	LSB
PNUM::	.INSTR	"print_num",#1
	MOV	(R2),R0
	CALLR	NUMTXT
	.DSABL	LSB
;
; VAR:245 15 5/3 sound_effect number effect volume routine
;
	.ENABL	LSB
SOUND::	.INSTR	"sound_effect"
	CMP	(R2),#2
	BLOS	10$
	.MSG	<"Special sound effects are not supported.">
	JMP	BADFUN
;
; The only sound effect we have is the BEL.
;
10$:	MOV	#7,R1
	CALLR	SCRCHR
	.DSABL	LSB
;
; VAR:228 4 sread text parse time routine
;
; Read in V4. Works almost like V1-V3, but we can have
; additional parameters...
;
	.ENABL	LSB
SREAD4::
	.INSTR	"sread(4)"
	CMP	R3,#4			; 4 args?
	BEQ	1$			; Yup.
	CLR	6(R2)			; No. Clear function pointer.
	CMP	R3,#3			; 3 args?
	BEQ	1$			; Yup.
	CLR	4(R2)			; No. Clear timeout.
	CMP	R3,#2			; 2 args?
	BEQ	1$			; Yup.
	JMP	BADFUN			; No. Bad function.
1$:	MOV	(R2)+,R3		; Get argument.
	MOV	(R2)+,-(SP)		; Parse buffer.
	MOV	(R2)+,TMO		; Timeout.
	MOV	(R2),FPTR		; Function pointer.
	CLR	R2
	CALL	ATRAN			; Translate address.
	MOV	R0,-(SP)		; Save address.
	MOVB	(R0)+,R2		; Get allowed length.
	BIC	#^C377,R2
	DEC	R2
	MOV	R0,R1			; And start of buffer pointer.
	MOV	R1,-(SP)		; Save string pointer.
	CALL	GETSTR			; Get string.
	CLRB	(R0)			; Set end byte.
	MOV	(SP)+,R1		; Get string pointer.
	MOV	(SP)+,R0		; Restore start pointer.
;
; Now we have a nul-terminated string.
;
; R0 holds the start of buffer, while R1 points at the string.
;
	MOV	(SP)+,R3		; Parse address.
	MOV	ZDICT,R2		; Get dictionary.
	MOV	R4,-(SP)		; Save frame pointer.
	CLR	R4			; Flags.
	CALL	PARSE			; Parse string.
	MOV	(SP)+,R4		; Restore frame pointer.
	RETURN
	.DSABL	LSB
;
; VAR:246 16 4 read_char 1 time routine -> (result)
;
	.ENABL	LSB
RCHAR::	.INSTR	"read_char"
	CMP	R3,#3			; 3 args?
	BEQ	1$			; Yes.
	CLR	4(R2)			; No. Clear function pointer.
	CMP	R3,#2			; 2 args?
	BEQ	1$			; Yes.
	CLR	2(R2)			; No. Clear timeout.
	CMP	R3,#1			; 1 arg?
	BEQ	1$			; Yes.
	JMP	BADFUN			; Bad function.
1$:	TST	(R2)+			; Skip first param.
	MOV	(R2)+,TMO		; Timeout.
	MOV	(R2),FPTR
	CALL	INPINI
10$:	CALL	GETCHR
	CMP	R3,#-1			; Check result...
	BEQ	10$			; If negative; go again.
	CALL	INPEND
	MOV	R3,R0
	CALLR	RESULT
	.DSABL	LSB
;
; VAR:247 17 4 scan_table x table len form -> (result)
;
; Scan a table for a specified value. Return address of value,
; if found.
;
	.ENABL	LSB
SCANT::	.INSTR	"scan_table"
	CMP	R3,#4			; 4 args?
	BEQ	10$			; Yes.
	MOV	#202,6(R2)		; No. Default arg 4 (82h)
	CMP	R3,#3			; 3 args?
	BEQ	10$			; Yes.
	JMP	BADFUN			; Baaaad.
10$:	MOV	2(R2),R0		; Address of table.
	MOV	6(R2),R1		; Get form.
	BIT	#200,R1			; Word values? (80h)
	BEQ	100$			; No. Byte values.
	BIC	#200,R1			; Clear flag. (80h)
20$:	.GETWB	R0,R3			; Read value.
	CMP	R3,(R2)			; Match?
	BEQ	200$			; Yes.
	ADD	R1,R0			; No. Next entry.
	DEC	4(R2)			; Count entries.
	BNE	20$			; And repeat.
	BR	190$			; Done.
100$:	.GETBB	R0,R3			; Get value.
	CMPB	R3,(R2)			; Match?
	BEQ	200$			; Yes.
	ADD	R1,R0			; No. Next entry.
	DEC	4(R2)			; Count entries.
	BNE	100$			; Until done.
190$:	CLR	R0			; Nothing found. Clear result.
200$:	CALL	RESULT
	TST	R0
	BEQ	210$
	JMP	BTRUE
210$:	JMP	BFALSE
	.DSABL	LSB
;
; VAR:228 5 aread text parse time routine -> (result)
; Read a line from user in V5 and later.
;
	.ENABL	LSB
AREAD::	.INSTR	"aread"
	CMP	R3,#4			; 4 arguments?
	BEQ	1$			; Yes.
	CLR	6(R2)			; No. Clear routine pointer.
	CMP	R3,#3			; 3 arguments?
	BEQ	1$			; Yes.
	CLR	4(R2)			; No. Clear timeout.
	CMP	R3,#2			; 2 arguments?
	BEQ	1$			; Yes.
	CLR	2(R2)			; No. Clear parse buffer.
	CMP	R3,#1			; 1 argument?
	BEQ	1$			; Yes.
	JMP	BADFUN			; Can't deal with it.
1$:	MOV	(R2)+,R3		; Get address of buffer.
	CLR	-(SP)			; Make room on stack.
	MOV	(R2)+,-(SP)		; Parse buffer.
	MOV	(R2)+,TMO		; Timeout
	MOV	(R2),FPTR
	CLR	R2
	CALL	ATRAN
	MOV	R0,-(SP)		; Save physical address.
	MOVB	(R0)+,R2		; Get max length.
	BIC	#^C377,R2
	MOV	R0,R1
	MOVB	(R1)+,R0		; Get current length.
	BIC	#^C377,R0
	ADD	R1,R0			; Point where to place next char.
	MOV	R1,-(SP)		; Save address of start of input.
	CALL	GETSTR
	CLRB	(R0)			; Put in a nul char here (even if
					; std says no)
	SUB	(SP)+,R0		; Calculate actual length read.
	MOV	R0,R2			; Save length in R2.
	MOV	(SP)+,R0		; Restore pointer to buffer.
	MOVB	R2,1(R0)		; Save length read.
	MOV	R1,2(SP)		; Save terminating char.
	MOV	R0,R1			; Let R1 point at start of input string.
	ADD	#2,R1
;
; Now we have a nul-terminated string.
;
	MOV	(SP)+,R3		; Parse address.
	BEQ	20$
	MOV	R4,-(SP)		; Save frame pointer.
	MOV	ZDICT,R2		; Get dictionary.
	CLR	R4			; Flags.
	CALL	PARSE			; Parse string.
	MOV	(SP)+,R4
20$:	MOV	(SP)+,R0		; Get terminating char.
	CALLR	RESULT
	.DSABL	LSB
;
; VAR:251 1B 5 tokenise text parse dictionary flag
;
	.ENABL	LSB
TKNIZE::
	.INSTR	"tokenize"
	CMP	R3,#4			; 4 args?
	BEQ	1$
	CLR	6(R2)			; No. Default flag.
	CMP	R3,#3			; 3 args?
	BEQ	1$
	CLR	4(R2)			; No. Default dictionary.
	CMP	R3,#2			; 2 args?
	BEQ	1$
	JMP	BADFUN			; No. Baaaad.
1$:	MOV	(R2),R3			; Start of buffer.
	CLR	R2			; We need to find physical address.
	CALL	ATRAN
	MOV	R0,R1			; Start of string...
	INC	R1
	MOVB	(R1)+,R3		; Get length of string.
	ADD	R1,R3			; Find end of string.
	CLRB	(R3)			; Put end marker there.
	MOV	ARGS+2,R3		; Parse buffer.
	MOV	ARGS+4,R2		; Dictionary.
	BNE	10$			; We have one.
	MOV	ZDICT,R2		; None present. Get default.
10$:	MOV	R4,-(SP)		; Save frame pointer.
	MOV	ARGS+6,R4		; Flags.
	CALL	PARSE			; Do the parsing.
	MOV	(SP)+,R4
	RETURN
	.DSABL	LSB
;
; VAR:252 1C 5 encode_text zscii-text length from coded-text
;
	.ENABL	LSB
ENCTXT::
	.INSTR	"encode_text",#4
	JMP	BADFUN
	.DSABL	LSB
;
; EXT:0 0 5 save table bytes name -> (result)
;
	.ENABL	LSB
SAVE2::	.INSTR	"save(5)"
	TST	R3
	BNE	10$
	CALL	DOSAVE
	CALLR	RESULT
;
; Do a save file.
;
10$:	CALL	FLUSH		; Flush buffer before we work on it.
	MOV	(R2)+,-(SP)	; Save address.
	ADD	ZEROP,(SP)	; Adjust address.
	MOV	(R2)+,-(SP)	; Save bytecount.
	MOV	(R2)+,R2	; Get filename pointer.
	ADD	ZEROP,R2	; Adjust it.
	MOV	#FNAM,R0	; Destination pointer for filename.
	MOV	#FNAML-1,R1	; Max filename length.
	MOV	R1,-(SP)	; Save that.
	CLR	R3		; Get filename length...
	BISB	(R2)+,R3
20$:	MOVB	(R2)+,(R0)+	; Copy byte.
	DEC	R1		; Check if exceeded total length.
	BEQ	30$		; If so, we stop here.
	SOB	R3,20$		; If not, continue copy until all is copied.
30$:	CLRB	(R0)		; Set a NUL-terminator.
	SUB	R1,(SP)		; Calculate actual length of filename.
	MOV	(SP)+,R1
	MOV	#FNAM,R0
	CLR	R2		; Indicate that it's okay to reuse old file.
	CALL	SAVOPN		; Open file.
	BCS	100$
	MOV	(SP)+,R3	; Get source length.
	MOV	(SP)+,R2	; Get source address.
	MOV	#IOBUF,R0	; Destination address.
	MOV	#512.,R1	; Destination length.
40$:	MOVB	(R2)+,(R0)+	; Copy byte.
	DEC	R3		; Count bytes...
	BEQ	50$		; Done?
	SOB	R1,40$		; Nope. Do whole block.
	MOV	#IOBUF,R0
	MOV	#512.,R1
	CALL	SAVBLK		; Save block.
	BR	40$
;
; All has been written, except the last block...
;
50$:	MOV	#IOBUF,R0
	CALL	SAVBLK
	CALL	SAVCLO
	MOV	ARGS+2,R0	; Get byte count.
	CALLR	RESULT
100$:	ADD	#4,SP		; Drop stack.
	CLR	R0
	CALLR	RESULT
	.DSABL	LSB
;
; EXT:1 1 5 restore table bytes name -> (result)
;
	.ENABL	LSB
REST2::	.INSTR	"restore(5)"
	TST	R3
	BNE	20$
	CALL	DOREST
	TST	R0
	BEQ	10$
	MOV	SAVSP,SP		; Restore stack pointer.
	MOV	#FETCH,-(SP)		; Save return address.
10$:	CALLR	RESULT
;
; Do a read file.
;
20$:	CALL	FLUSH		; Flush the buffer before we use it.
	MOV	(R2)+,-(SP)	; Save address.
	ADD	ZEROP,(SP)	; Adjust address.
	MOV	(R2)+,-(SP)	; Save bytecount.
	MOV	(R2)+,R2	; Get filename pointer.
	ADD	ZEROP,R2	; Adjust it.
	MOV	#FNAM,R0	; Destination pointer for filename.
	MOV	#FNAML-1,R1	; Max filename length.
	MOV	R1,-(SP)	; Save that.
	CLR	R3		; Get filename length...
	BISB	(R2)+,R3
25$:	MOVB	(R2)+,(R0)+	; Copy byte.
	DEC	R1		; Check if exceeded total length.
	BEQ	30$		; If so, we stop here.
	SOB	R3,25$		; If not, continue copy until all is copied.
30$:	CLRB	(R0)		; Set a NUL-terminator.
	SUB	R1,(SP)		; Calculate actual length of filename.
	MOV	(SP)+,R1
	MOV	#FNAM,R0
	CALL	RESOPN		; Open file.
	BCS	100$
	MOV	(SP)+,R3	; Get dst length.
	MOV	(SP)+,R2	; Get dst address.
40$:	MOV	#IOBUF,R0	; Source address.
	MOV	#512.,R1	; Source length.
	CALL	RESBLK		; Read block.
45$:	MOVB	(R0)+,(R2)+	; Copy byte.
	DEC	R3		; Count bytes...
	BEQ	50$		; Done?
	SOB	R1,45$		; Nope. Do whole block.
	BR	40$		; Next block.
;
; All has been read.
;
50$:	CALL	RESCLO
	MOV	ARGS+2,R0	; Get byte count.
	CALLR	RESULT
100$:	ADD	#4,SP		; Drop stack.
	CLR	R0
	CALLR	RESULT
	.DSABL	LSB
;
; EXT:9 9 5 save_undo -> (result)
; We don't support UNDO for now. Return -1.
;
	.ENABL	LSB
SUNDO::	.INSTR	"save_undo",#0
	MOV	#-1,R0
	CALLR	RESULT
	.DSABL	LSB
;
; EXT:10 A 5 restore_undo -> (result)
; We don't support UNDO for now. Return 0.
;
	.ENABL	LSB
RUNDO::	.INSTR	"restore_undo",#0
	CLR	R0
	CALLR	RESULT
	.DSABL	LSB
;
	.END