.TITLE	ZMEM
	.IDENT	/V1.13/
; ++
; This is the virtual memory handler.
; (c) 2000, 2003 by Johnny Billquist
;
; History:
;
;	00-08-01	BQT	Initial coding started.
; Y1.0	00-08-26 21:00	BQT	First release.
; Y1.1	00-09-08 02:00	BQT	Added initializing of random number.
; Y1.2	00-09-14 11:30	BQT	Bugfix. The error message in BADVER didn't
;				extract the game version number correctly.
; V1.3	00-09-16 12:00	BQT	Changed all ZEXIT to ABORT.
;				Make it more officially done.
; V1.4	00-09-20 22:00	BQT	Added check for silly small screen width values.
; V1.5	00-09-22 01:00	BQT	Added timeout of 3s. to game start warnings.
; V1.6	01-02-16 16:45	BQT	Improved sanity check of games before trying
;				to run them.
; V1.7	01-03-04 03:30	BQT	Added initializing of memory cells to indicate
;				that we adhere to standard 1.0
; V1.8	01-03-04 04:30	BQT	Changed initialization of flg2 to truly reflect
;				font 3 capability.
; V1.9	03-01-23 02:30	BQT	Added special RSX mode.
; V1.10	03-08-14 20:00	BQT	Changed interface to OS routines to allow
;				for different page sizes, and different
;				memory models.
; V1.11	05-02-21 01:30	BQT	Added V6/V7 address translation.
; V1.12 05-02-22 11:00	BQT	Moved all screen stuff to ZSCREE.MAC.
; V1.13	05-07-26 01:00	BQT	Bugfix in cache output. Tell correct number
;				of pages acquired, and correct call to GETCH2.
; --
	.INCLUDE	/ZMAC/

	.PSECT	RECORD,RW,D,GBL,ABS,OVR
;	.ASECT
	.=0
R.NEXT:	.BLKW	1			; Link to next entry.
R.REF:	.BLKW	1			; Reference ID.
R.ADDR:	.BLKW	2			; Physical base.
R.BASE:	.BLKW	1			; Virtual address.
R.SIZE=.
R.MAX=10.

	.PSECT	DATA,D,RW
;
ZEROP::	.WORD	0			; Here we'll get a pointer to
					; where zero page is in physical mem.
DYNHI::	.WORD	512.			; Initial dynamic high address
					; is just after zero page.
WRLIM::	.WORD	0			; Initial limit for writable mem.
CACHE::	.WORD	0			; Linked list header for cache.
R.BLK::	.BLKB	R.MAX*R.SIZE		; The record cache.
R.LEN::	.WORD	0			; The size of a record.
;
INTERP::.WORD	DIID			; Interpreter number (Default mainframe)
;
CLIM::	.WORD	DCSIZE			; Limit on how much cache to allocate.
DBGFLG::.WORD	0			; Debugging flag.
;
ZPC::	.WORD	0			; The emulator PC.
	.WORD	0
;
	.IF NE,DBUG
ZBRK::	.WORD	0,0			; Address in zmachine where to do BPT.
FZPC::	.WORD	0,0			; Address of last fetch.
	.ENDC
;
ZVER::	.WORD	0			; Game version.
ZFLG1::	.WORD	0			; Flag 1.
ZFLG2::	.WORD	0			; Flag 2.
ZDICT::	.WORD	0			; Dictionary address.
ZOBJ::	.WORD	0			; Object table address.
ZVAR::	.WORD	0			; Global variables address.
ZABBR::	.WORD	0			; Abbreviations address.
ZTCPTR::.WORD	0			; Address of terminating char list.
;
OBJLEN::.WORD	0			; Length of an object.
OBJOFF::.WORD	0			; Offset to start of objects.
;
APACK::	.WORD	0			; Pointer to function to calculate
					; packed address.
PPACK::	.WORD	0			; Pointer to function to calculate
					; text packed address.
NXTPRO:: .WORD	0			; Pointer to function to get prop adr.
DORO::	.WORD	0			; Pointer to function to remove obj.
DOIO::	.WORD	0			; Pointer to function to insert obj.
;
STKTOP:: .WORD	0			; Pointer to game stack top.
;
PATAB:	.WORD	PADDR1			; Version 1.
	.WORD	PADDR1			; V2
	.WORD	PADDR1			; V3
	.WORD	PADDR4			; V4
	.WORD	PADDR4			; V5
	.WORD	PADDR6			; V6
	.WORD	PADDR6			; V7
	.WORD	PADDR8			; V8

PPTAB:	.WORD	PADDR1			; V1
	.WORD	PADDR1			; V2
	.WORD	PADDR1			; V3
	.WORD	PADDR4			; V4
	.WORD	PADDR4			; V5
	.WORD	PADRP6			; V6
	.WORD	PADRP6			; V7
	.WORD	PADDR8			; V8

	.PSECT	CODE,I,RO
;
; MEMINI - Initialize the memory system.
;
	.ENABL	LSB
MEMINI::
;
; Start by allocating a game stack.
;
	MOV	#GAMSTK,R5		; Size of game stack.
	.ALLOC	R5
	BCC	1$
	JMP	NODYN
1$:	ADD	R0,R5			; Point at top of stack.
	MOV	R5,STKTOP		; Save stack top.
;
; Now we need to read in zeropage.
;
	.ALLOC				; Get a page of memory.
	BCC	2$
	JMP	NODYN
2$:	MOV	R0,ZEROP		; Save a pointer to zero page.
	.BLK	R0,#0			; Read zeropage into it.
;
; Try to verify that is really is a game file.
;
	TSTB	@ZEROP			; First byte should not be zero.
	BNE	9$
	JMP	NOGAM
9$:	CMPB	@ZEROP,#8.		; Even possible value?
	BLOS	999$			; Yes.
	JMP	NOGAM
999$:	CMPB	@ZEROP,#MAXVER		; And <= MAXVER.
	BLOS	99$
	JMP	BADVER
99$:
;
; Now we need to calculate the end of dynamic memory.
;
	.GETWB	#16			; Get end of dynamic mem. (Eh)
	MOV	R0,WRLIM		; Save writable limit.
;
; Now read out important values.
;
	.GETBB	#0
	MOV	R0,ZVER
	.GETBB	#1
	MOV	R0,ZFLG1
	.GETWB	#20			; (10h)
	MOV	R0,ZFLG2
	.GETWB	#10			; (8h)
	MOV	R0,ZDICT
	.GETWB	#12			; (Ah)
	MOV	R0,ZOBJ
	.GETWB	#14			; (Ch)
	SUB	#32.,R0			; Make address biased for local vars.
	MOV	R0,ZVAR
	.GETWB	#30			; (18h)
	MOV	R0,ZABBR
;
; Then we shall set some values according to this interpreter.
; 
	CMP	ZVER,#3			; Version 3 or less game?
	BHI	10$			; No.
; <V4...
	MOV	#9.,OBJLEN		; Length of object.
	MOV	#62.,OBJOFF		; Offset to start of objects.
	MOV	#PCV1,NXTPRO
	MOV	#DORO3,DORO
	MOV	#DOIO3,DOIO
	MOV	#4,ZWLEN
	BR	20$			; Go on.
; >V3...
10$:	MOV	#14.,OBJLEN		; Length of objects.
	MOV	#126.,OBJOFF		; Offset to start of objects.
	MOV	#PCV4,NXTPRO
	MOV	#DORO4,DORO
	MOV	#DOIO4,DOIO
	MOV	#6,ZWLEN
20$:	CALL	ZOPINI			; Initiate optab.
;
; Setup ASCII table.
;
	MOV	#DECCH1,DECCHR		; Set old decode mode.
	MOV	#ASCV1,ASCPTR		; Set old table.
	CMP	ZVER,#1			; Version 1?
	BEQ	90$			; Yes.
	MOV	#DECCH2,DECCHR		; No. Set middle decode mode.
	MOV	#ASCV2,ASCPTR		; Set new table.
	CMP	ZVER,#2			; Version 2?
	BEQ	90$			; Yes.
	MOV	#DECCH3,DECCHR		; No. Set new decode model.
	CMP	ZVER,#4			; Version 4 or less?
	BLE	90$			; Yes.
	.GETWB	#64			; No. Get table pointer. (34h)
	BEQ	80$			; Zero means use standard table.
	ADD	ZEROP,R0		; We have a pointer. Point at physical.
	MOV	R0,ASCPTR
80$:	.GETWB	#56			; Terminating char tbl ptr. (2Eh)
	BEQ	90$
	ADD	ZEROP,R0
	MOV	R0,ZTCPTR
90$:	MOV	DECCHR,DECPTR
;
; Setup address unpacking functions.
;
	MOV	ZVER,R0			; Get game version.
	DEC	R0			; zero-bias.
	ASL	R0			; *2.
	MOV	PATAB(R0),APACK		; Set up packed address trans.
	MOV	PPTAB(R0),PPACK
;
	CALL	GETRND
	MOV	R0,SEED
;
; Now we'll allocate all the memory we need.
;
	MOV	WRLIM,R1
	ADD	#777,R1			; Round off to block.
	BIC	#777,R1
	MOV	R1,DYNHI		; Save end of dynamic memory.
	SUB	#1000,R1		; Find out how much more we need to
	.ALLOC	R1			; allocate, and allocate that.
	BCC	40$
	JMP	NODYN
;
; Now initiate dynamic memory.
;
40$:	CALL	DYNINI
;
; Finally, allocate cache.
;
	CALLR	CHEINI
	.DSABL	LSB
;
; DYNINI - Setup game dynamic memory from file.
;
DYNINI::
	MOV	ZEROP,R0
	CLR	R1
	MOV	DYNHI,R2
20$:	MOV	R2,R3
	BPL	30$
	MOV	#<77*1000>,R3
30$:	.BLK	R0,R1,R3		; The read in dynamic memory.
	SUB	R3,R2			; Count off...
	BEQ	40$			; Done.
	ADD	R3,R0			; Not done. Step forward.
	ADD	#77,R1
	BR	20$
;
40$:	RETURN				; Done.
;
; VARINI - Initialize game variables.
;
VARINI::
	.PUTBB	#1,ZFLG1		; Setup flags.
	.PUTWB	#20,ZFLG2		; (10h)
	.PUTWB	#62,#400		; STD version. (1.0) (32h,100h)
;
	CMP	ZVER,#3			; <V3?
	BLOS	10$			; Yes. Don't setup much...
	.PUTBB	#36,INTERP		; Interpreter number. (1Eh)
	.PUTBB	#37,#INTVER		; Version... (1Fh)
;
10$:	RETURN
;
; CHEINI - Cache init
;
	.ENABL	LSB
CHEINI::
	CALL	CHESIZ			; Get record size.
	MOV	R0,R.LEN		; Save it.
	MOV	#CACHE,R5		; Where to write previous link.
	MOV	#R.BLK,R4		; New block.
	MOV	#R.MAX,R3		; Count blocks.
10$:	CALL	CHEALL			; Allocate cache block.
	BCS	20$			; Done.
	MOV	R4,(R5)			; Save next-pointer.
	MOV	R4,R5			; Set new current.
	ADD	#R.SIZE,R4		; And move ahead.
	MOV	R0,R.REF(R5)		; Save reference id.
	MOV	R1,R.BASE(R5)		; Save base address.
	MOV	#-1,R.ADDR(R5)		; At start we place an invalid virtual
	CLR	R.ADDR+2(R5)		; address to fail all lookups.
	SOB	R3,10$			; Loop.
20$:	SUB	#R.MAX,R3		; Check how many blocks we got.
	NEG	R3
	BEQ	NOMEM			; None... Bad...
;
; We have some blocks. Let's proceed.
;
	CLR	(R5)			; Terminate list.
	TST	DBGFLG
	.ENABL	LSB
	BEQ	120$
	.DBG	#D.CACH,<"Got %D pages for cache.">,R3
	BR	100$
;
; Done?
;
120$:	CMP	R3,#1
	BLOS	LOMEM
;	CMP	R3,#R.MAX
;	BNE	LO2MEM
	RETURN
;
NODYN:	.MSG	<"We didn't get memory for dynamic data. Aborting...">
	JMP	ABORT
NOMEM:	.MSG	<"We didn't get any pages for cache. Aborting...">
	JMP	ABORT
BADVER:	MOVB	@ZEROP,R0
	.MSG	<"ZEMU only supports V1-V%D games. This looks like V%D.">,#MAXVER,R0
	JMP	ABORT
NOGAM:	.MSG	<"This don't look like a Z-machine game at all.">
	JMP	ABORT
;
LOMEM:	.MSG	<"We have *very* little cache. The gaming will suffer.">
;	BR	100$
;
;LO2MEM: .MSG <"We are not fully stocked on cache. Expect high disk activity.">
CHEDON:
100$:	.MSG <"Press <Enter> to continue.">
	MOV	#100.,R3
	CLR	FPTR
	CALL	GETCH2
	CLR	R3
	CLC
	RETURN
	.DSABL	LSB
;
; GETIB - Get next byte from instruction stream.
;
; Autoincrements PC.
;
; Returns byte in (SP).
;
	.ENABL	LSB
ZGETIB::
	MOV	(SP),-(SP)			; Create space on stack.
	MOV	R0,-(SP)			; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	ZPC+2,R3			; Get PC.
	MOV	ZPC,R2
	.BRK	R2,R3
	CALL	ATRAN				; Translate address.
	.DBG	#D.MEM,<"Reading from %P,,%P yields %B.">,ZPC,ZPC+2,R0
	INC	ZPC+2				; Bump PC.
	BNE	10$
	INC	ZPC
10$:	MOVB	(R0),10(SP)			; Get byte.
	CLRB	11(SP)
	MOV	(SP)+,R3			; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN					; Done.
	.DSABL	LSB
;
; GETBB - Get data byte by byte address.
;
; In:  2(SP) - Address
; Out: 2(SP) - Data
;
	.ENABL	LSB
ZGETBB::
	MOV	R0,-(SP)			; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	10(SP),R3			; Get address.
	CLR	R2				; Clear high part.
GCOMB:	CALL	ATRAN				; Translate address.
	.DBG	#D.MEM,<".GETBB from address %P yields %B.">,R3,R0
	MOVB	(R0),10(SP)			; Get data.
	CLRB	11(SP)
	MOV	(SP)+,R3			; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN					; Done.
	.DSABL	LSB
;
; GETWB - Get data word by byte address.
;
	.ENABL	LSB
ZGETWB::
	MOV	R0,-(SP)			; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	10(SP),R3			; Get address.
	CLR	R2
GCOMW:	CALL	ATRAN				; High byte.
	MOVB	(R0),11(SP)
	INC	R3				; Low byte.
	BNE	10$
	INC	R2
10$:	CALL	ATRAN
	MOVB	(R0),10(SP)
	.DBG	#D.MEM,<".GETWB from address %P,,%P-1 yields %P.">,R2,R3,22(SP)
	MOV	(SP)+,R3			; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN					; Done.
	.DSABL	LSB
;
; GETBW - Get data byte by word address.
;
; In:  R0 - Address
; Out: R0 - Data
;
ZGETBW::
	MOV	R0,-(SP)			; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	10(SP),R3			; Get address.
	CLR	R2
	ASHC	#1,R2				; Multiply address by 2.
	BR	GCOMB				; And get byte.
;
; GETWW - Get data word by word address.
;
ZGETWW::
	MOV	R0,-(SP)			; Save registers.
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	10(SP),R3			; Get address.
	CLR	R2
	ASHC	#1,R2				; Multiply address by 2.
	BR	GCOMW				; and get word.
;
; PUTBB - Put data at address.
;
; In: 2(SP) - Byte
;     4(SP) - Address
;
; Out: Elements removed from stack.
;
	.ENABL	LSB
ZPUTBB::
	MOV	R0,-(SP)			; Save registers.
	MOV	6(SP),R0			; Get address.
	MOV	2(SP),6(SP)			; Move return address.
	CMP	R0,WRLIM			; Over limit?
	BHIS	10$				; Yes.
	.DBG	#D.MEM!D.MRF,<".PUTBB writes %P to %P.">,16(SP),R0
	ADD	ZEROP,R0			; No. Get address.
	MOVB	4(SP),(R0)			; Write data.
	MOV	(SP)+,R0			; Restore R0.
	ADD	#4,SP					; Clean up stack.
	RETURN					; Done.
10$:	.MSG	<"Write over limit. Addr = %P. Limit = %P.">,R0,WRLIM
	JMP	ABORT
	.DSABL	LSB
;
; PUTWB - Put word at byte address.
;
; In: 2(SP) - Byte
;     4(SP) - Address
;
	.ENABL	LSB
ZPUTWB::
	MOV	R0,-(SP)			; Save registers.
	MOV	6(SP),R0			; Get address.
	MOV	2(SP),6(SP)			; Move return address.
	CMP	R0,WRLIM			; Over limit?
	BHIS	10$				; Yep.
	.DBG	#D.MEM!D.MRF,<".PUTWB writes %P to %P.">,16(SP),R0
	ADD	ZEROP,R0			; No. Get correct address.
	MOVB	5(SP),(R0)+			; Write data.
	MOVB	4(SP),(R0)
	MOV	(SP)+,R0			; Restore registers.
	ADD	#4,SP				; Clean up stack.
	RETURN					; Done.
10$:	.MSG	<"Write over limit. Addr = %P. Limit = %P.">,R0,WRLIM
	JMP	ABORT
	.DSABL	LSB
;
; PUTBW - Put byte at word address.
;
; In: 2(SP) - Byte
;     4(SP) - Address
;
	.ENABL	LSB
ZPUTBW::
	MOV	R0,-(SP)			; Save registers.
	MOV	6(SP),R0			; Get address.
	MOV	2(SP),6(SP)			; Save return address.
	ASL	R0				; Multiply address.
	BCS	10$				; Error.
	CMP	R0,WRLIM			; Too high?
	BHIS	20$				; Yes.
	.DBG	#D.MEM,<".PUTBW writes %P to %P.">,16(SP),R0
	ADD	ZEROP,R0			; No. Get physical address.
	MOVB	4(SP),(R0)			; Save byte.
	MOV	(SP)+,R0			; Restore registers.
	ADD	#4,SP				; Clean up stack.
	RETURN					; Done.
10$:	.MSG	<"Write error. High address. 1,,%P. Limit = %P.">,R0,WRLIM
	JMP	ABORT
20$:	.MSG	<"Write error. High address. 0,,%P. Limit - %P.">,R0,WRLIM
	JMP	ABORT
	.DSABL	LSB
;
; PUTWW - Put word at word address.
;
; In: 2(SP) - Byte
;     4(SP) - Address
;
	.ENABL	LSB
ZPUTWW::
	MOV	R0,-(SP)			; Save registers.
	MOV	6(SP),R0			; Get address.
	MOV	2(SP),6(SP)			; Move return address.
	ASL	R0				; Multiply address.
	BCS	10$				; Error...
	CMP	R0,WRLIM			; Address too high?
	BHIS	20$				; Yes.
	.DBG	#D.MEM,<".PUTWW writes %P to %P.">,16(SP),R0
	ADD	ZEROP,R0			; No. Get physical address.
	MOVB	5(SP),(R0)+			; Save word.
	MOVB	4(SP),(R0)
	MOV	(SP)+,R0			; Restore registers.
	ADD	#4,SP				; Clean up stack.
	RETURN					; Done.
10$:	.MSG	<"Write error. High address. 1,,%P. Limit = %P.">,R0,WRLIM
	JMP	ABORT
20$:	.MSG	<"Write error. High address. 0,,%P. Limit = %P.">,R0,WRLIM
	JMP	ABORT
	.DSABL	LSB
;
; ATRAN - Address translation.
;
; In:  R2,R3 - Address
; Out: R0    - Translated address.
;
	.ENABL	LSB
ATRAN::	TST	R2
	BNE	10$
	CMP	R3,DYNHI
	BHIS	10$
	MOV	R3,R0
	ADD	ZEROP,R0
	RETURN
;
; The address is somewhere in dynamic memory.
;
10$:	JSR	R5,.SAVR1		; Save R1-R5
	MOV	#CACHE,R5		; Point at start of list.
11$:	MOV	(R5),R4			; Point at next record.
	MOV	R2,R1			; Move requested address to R1,,R0
	MOV	R3,R0			; (note reverse order or regs)
	SUB	R.ADDR+2(R4),R0		; Calculate difference.
	SBC	R1
	SUB	R.ADDR(R4),R1
	BNE	13$			; Not in range. Try next...
	CMP	R0,R.LEN
	BLO	20$			; In range. We found it!
13$:	TST	(R4)			; Not in range. Do any more exist?
	BEQ	14$			; No.
	MOV	R4,R5			; Yes. Move on.
	BR	11$
;
; Record not found. We need to replace.
;
14$:	MOV	R.REF(R4),R0		; Get our reference.
	CALL	CHEUPD			; Cache update.
	MOV	R2,R.ADDR(R4)		; Save new virtual base.
	MOV	R3,R.ADDR+2(R4)
;
; Now we have a good record in (R4), while R5 points at previous in list.
; Let's link the new in.
;
20$:	MOV	(R4),(R5)		; Transfer link.
	MOV	CACHE,(R4)		; Put entry first in list.
	MOV	R4,CACHE
	ADD	R.BASE(R4),R0		; Add base and we're done.
	RETURN
	.DSABL	LSB
;
; Packed address translations...
;
; In: R1 - Address.
;
; Out: R0,R1 - Address.
;
PADDR1:	CLR	R0
	ASHC	#1,R0
	RETURN
;
PADDR4:	CLR	R0
	ASHC	#2,R0
	RETURN
;
PADDR6:	CLR	R0		; Clear high word
	ASHC	#2,R0		; P * 4
	MOV	R0,-(SP)	; Save P
	MOV	R1,-(SP)
	MOV	ZEROP,R1	; Get R_O
	MOV	50(R1),R1	; (28h)
	SWAB	R1
	CLR	R0		; Calculate R_O * 8
	ASHC	#3,R0
	ADD	(SP)+,R1	; Add P to R_O
	ADC	R0
	ADD	(SP)+,R0
	RETURN			; Done
;
PADRP6:	CLR	R0		; Clear high word
	ASHC	#2,R0		; P * 4
	MOV	R0,-(SP)	; Save P
	MOV	R1,-(SP)
	MOV	ZEROP,R1	; Get S_O
	MOV	52(R1),R1	; (2Ah)
	SWAB	R1
	CLR	R0		; Calculate S_O * 8
	ASHC	#3,R0
	ADD	(SP)+,R1	; Add P to S_O
	ADC	R0
	ADD	(SP)+,R0
	RETURN			; Done
;
PADDR8:	CLR	R0
	ASHC	#3,R0
	RETURN
;
	.END