.TITLE	ZINTER
	.IDENT	/V1.3/
; ++
; This is a Z-machine instruction interpreter.
; (c) 2000 by Johnny Billquist
;
; History:
;
;	00-07-19	BQT	Initial coding started.
; Y1.0	00-08-26 21:00	BQT	First release.
; V1.1	00-09-16 12:00	BQT	Added ABORT function. Make this more official.
; V1.2	00-12-30 04:00	BQT	Added a save of SP at start.
; V1.3	05-02-20 23:45	BQT	Improved speed.
; --
	.INCLUDE	/ZMAC/

	.PSECT	DATA,D,RW
;
ARGSZ=8.				; Number of possible arguments
ARGC::	.WORD	0			; Argument count.
ARGS::	.BLKW	ARGSZ			; Argument list.
ARGSE:
;
INSTR::	.WORD	0			; Current instruction.
;
SAVSP::	.WORD	0			; Saved SP.
;
	.PSECT	CONST,D,RO
;
DECOD1:	.WORD	ARGSS			; First step of instr. decode.
	.WORD	ARGSS			; Find out argument types...
	.WORD	ARGSV
	.WORD	ARGSV
	.WORD	ARGVS
	.WORD	ARGVS
	.WORD	ARGVV
	.WORD	ARGVV
	.WORD	ARGL
	.WORD	ARGS1
	.WORD	ARGV
	.WORD	DO0OP
	.WORD	ARGV2
	.WORD	ARGV2
	.WORD	ARGVAR
	.WORD	ARGVAR
;
	.PSECT	CODE,I,RO
;
; V6 return from main routine.
;
RETTOP::
	.MSG	<"Return from top level illegal.">
	JMP	ABORT
;
; Start running interpreter.
;
ZRUN::
;
	MOV	SP,SAVSP		; Save code SP.
	MOV	STKTOP,R5		; Setup game SP.
	.GETWB	#6			; Get start PC.
	MOV	R0,ZPC+2
	CLR	ZPC
	CMP	ZVER,#6			; Version = 6?
	BNE	FETCH			; No.
	MOV	#1,R3			; No. This is a call function.
	MOV	#ARGS,R2		; Point at argument list.
	MOV	R0,(R2)			; Save address as argument.
	MOV	#R.TOP,-(R5)		; Save continuation routine.
	CALL	DOCALL			; Start with a call.
;
; The main program loop.
;
; This code decodes instructions, arguments, and then dispatches
; to the correct code to handle that function. It is the functions
; that jump back to FETCH: to start the next instruction.
;
; Important!
;  All instructions are called with the following:
;	R5 - Game stackpointer. Must be kept, but some might push things
;	R4 - Game framepointer. Must be kept.
;	R3 - Argument count. May be discarded.
;	R2 - Argument array pointer. May be discarded.
;
; Also, the current game PC is in ZPC,,ZPC+2
;
; The most important functions to know about:
;	VARVAL - Get variable value
;		In: R0 - Variable number
;		Out: R1 - Variabel value
;
;	RESULT - Store a result from an instruction
;		In: R0 - Value to store
;
;	STOREV - Store a value in a variable
;		In: R0 - Variable number
;		    R1 - Value
;
;	ABORT - Abort game
;
;	BFALSE - Branch instruction for which the test was false
;	BTRUE - Branch instruction for which the test was true
;
; Other things, such as operating on the game stack, and performing calls
; is left out of here. Look at the code for something using the specific
; pieces of the system that is needed for inspiration.
;

	.ENABL	LSB
FETCH::
	MOV	#ARGS,R2		; Point at start of argument list.
	CLR	R3			; R3 is argc.
	.IF NE DBUG
	MOV	ZPC,FZPC
	MOV	ZPC+2,FZPC+2
	.ENDC
	.DBG	#D.TRC,<"Addr: %P,,%P.">,ZPC,ZPC+2
	.GETIB				; Get next instruction.
	.DBG	#D.DEC,<"Instr: %O.">,R0
	MOV	R0,INSTR		; Save it.
	ASH	#-3,R0			; Get four high bits of instr.
	BIC	#1,R0			; And clear low bit.
					; R0 is now high nybble * 2.
	JMP	@DECOD1(R0)		; First step in decoding:
					; Process arguments.
;
; Different argument types for instructions...
;
ARGSS:	CALL	GETSA			; Small,Small
	CALL	GETSA
	BR	DO2OP			; Do 2OP instr.
ARGSV:	CALL	GETSA			; Small,Var
	CALL	GETVA
	BR	DO2OP			; Do 2OP instr.
ARGVS:	CALL	GETVA			; Var,Small
	CALL	GETSA
	BR	DO2OP			; Do 2OP instr.
ARGVV:	CALL	GETVA			; Var,Var
	CALL	GETVA
	BR	DO2OP			; Do 2OP instr.
ARGL:	CALL	GETLA			; Large
	BR	DO1OP			; Do 1OP instr.
ARGS1:	CALL	GETSA			; Small
	BR	DO1OP			; Do 1OP instr.
ARGV:	CALL	GETVA			; Var
	BR	DO1OP			; Do 1OP instr.
;
ARGV2:	MOV	#DO2OP,-(SP)		; Variable 2OP instr.
	BR	GETVAR
ARGVAR::				; Variable instr.
	MOV	#DOVAR,-(SP)
	.DSABL	LSB
;
; Process a variable number of arguments.
;
GETVAR:	.GETIB	R1			; Get argument mask.
	SWAB	R1			; In high byte.
	BIS	#377,R1			; Set low bits.
	CMP	INSTR,#236.		; Is instruction 8 arguments?
	BEQ	5$			; Yes.
	CMP	INSTR,#250.
	BNE	10$			; No. Do simple.
5$:	.GETIB				; Get next mask.
	BIC	#377,R1			; Clear low byte.
	BIS	R0,R1			; Set correct args.
;
; Process up to eight arguments...
;
10$:	ASHC	#2,R0			; Shift stuff.
	BIS	#3,R1			; And mark up end.
	BIC	#^C3,R0			; Drop all but significant bits.
	ASL	R0			; Multiply type by 2.
	ADD	R0,PC			; Branch to correct routine to handle.
	BR	20$			; Large constant.
	BR	30$			; Small constant.
	BR	40$			; Variable.
	RETURN				; End of args.
20$:	CALL	GETLA			; Large constant.
	BR	10$
30$:	CALL	GETSA			; Small constant.
	BR	10$
40$:	CALL	GETVA			; Variable.
	BR	10$
;
; Get large argument.
;
GETLA:	.GETIW	(R2)+			; Get word.
	INC	R3
	RETURN
;
; Get small argument.
;
GETSA:	.GETIB	(R2)+			; Get byte.
	INC	R3
	RETURN
;
; Get variable argument.
;
GETVA:	MOV	R0,-(SP)		; Save R0.
	MOV	R1,-(SP)
	INC	R3			; We got one more argument.
	.GETIB				; Get variable.
	CALL	VARVAL			; Get variable value.
	MOV	R1,(R2)+		; Save value.
	MOV	(SP)+,R1
	MOV	(SP)+,R0		; Restore R0.
	RETURN				; Done.
;
; Function to handle each specific instruction type.
;
DO2OP:	MOV	INSTR,R0		; Restore instruction.
	BIC	#^C37,R0		; Get specific instr.
	MOV	OP2FP,R1		; And table with pointers.
	JMP	DISPAT
;
DO1OP:	MOV	INSTR,R0		; Get instruction.
	BIC	#^C17,R0		; Mask out argument.
	MOV	OP1FP,R1		; Table to handlers.
	JMP	DISPAT
;
DO0OP:	MOV	INSTR,R0		; Get instruction.
	BIC	#^C17,R0		; Mask out stuff.
	MOV	OP0FP,R1		; Table to handlers.
	JMP	DISPAT
;
DOVAR:	MOV	INSTR,R0		; Get instruction.
	BIC	#^C37,R0		; Mask out stuff.
	MOV	OPVFP,R1		; Table to handlers.
;
; Dispatch routine.
;
	.ENABL	LSB
DISPAT:	MOV	#ARGS,R2		; Point at args.
	MOV	R3,ARGC			; Save argument count.
	.DBG	#D.DEC,<"Argc: %D (%P,%P,%P).">,R3,(R2),2(R2),4(R2)
	ASL	R0			; Multiply instruction # by 2.
	ADD	R1,R0			; Point to dispatch address in table.
EXECUT::
	CALL	@(R0)			; Jump to instruction handler.
	JMP	FETCH
	.DSABL	LSB
;
; Extended opcode.
;
; At this point, R2 should point at argument buffer, and R3 should be 0.
;
	.ENABL	LSB
EXTEND::
	.INSTR	"extended",#0
	.GETIB				; Get next byte.
	.DBG	#D.DEC,<"Instr: %O.">,R0
	MOV	R0,INSTR
	CALL	GETVAR			; Get arguments.
	MOV	#ARGS,R2
	MOV	R3,ARGC
	.DBG	#D.DEC,<"Argc: %D (%P,%P,%P).">,R3,(R2),2(R2),4(R2)
	MOV	INSTR,R0		; Get instruction again.
	ASL	R0			; Multiply by 2.
	CALLR	@EOPTAB(R0)		; Call correct function.
	.DSABL	LSB
;
; VARVAL - Get value of variable.
;
; In: R0 - Variable.
;
; Out: R1 - Value.
;
	.ENABL	LSB
VARVAL::
	MOV	R0,-(SP)		; Save registers.
	CALL	VARADR			; Get variable address.
	BCS	10$			; "local" address?
	.GETWB	R0,R1			; No. Game address. Read word.
	BR	100$			; Done.
;
10$:	TST	R0			; Stack?
	BEQ	20$			; Yes.
	MOV	(R0),R1			; No. Read local var.
	BR	100$			; Done.
;
20$:	MOV	(R5)+,R1		; POP stack.
	.DBG	#D.STK,<"Popping stack. Stack is %P. Value is %D.">,R5,R1
100$:	MOV	(SP)+,R0		; Restore variable.
	.DBG	#D.VAR,<"Reading variable %D. Value is %D.">,R0,R1
	RETURN				; Done.
;
; VARADR - Get the address of a variable.
;
; In: R0 - Variable number.
; Out: CC -> R0 - Address in game for variable.
;      CS -> R0 - Address in interpreter memory for variable.
;            If R0 is zero, we're talking about the stack.
;
VARADR:	ASL	R0			; Make variable numbers into offset.
	BEQ	41$			; Top of stack.
	CMP	R0,#32.			; Local variables?
	BLO	42$			; Yup.
	ADD	ZVAR,R0			; Global variables.
	RETURN				; Done.
42$:	ADD	R4,R0			; Add frame pointer.
41$:	SEC				; Indicate location.
	RETURN				; Done.
;
; RESULT is a function to call if the instruction should store
; a value.
;
; In: R0 - Value to store.
;
	.ENABL	LSB
RESULT::
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R0,R1			; Save value.
	.GETIB				; Get variable number.
	BR	1$
;
; STOREV - Store a value in a variable.
;
; In: R0 - Variable
;     R1 - Value.
;
STOREV::
	MOV	R0,-(SP)
	MOV	R1,-(SP)
1$:	.DBG	#D.VAR,<"Storing %D in variable %D.">,R1,R0
	CALL	VARADR			; Get address of variable.
	BCS	10$			; Local stuff.
	.PUTWB	R0,R1			; Global variable. Write it.
	BR	30$
;
10$:	TST	R0			; Stack?
	BEQ	20$			; Yes.
	.DBG	#D.LOC,<"Saving to local var. %P. FP = %P. S = %O.">,R0,R4,(R4)
	MOV	R1,(R0)			; No. Local var. Save value.
	BR	30$
;
20$:	.DBG	#D.STK,<"Pushing on stack. SP = %P. Value is %D.">,R5,R1
	MOV	R1,-(R5)		; Stack. Push value.
30$:	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
	.DSABL	LSB
;
; ABORT - Abort a game.
;
; This will reset the screen, and quit.
;
ABORT::	CALL	SCRRES		; Reset screen.
	CALL	PRSTOP		; Stop scripting.
	JMP	ZEXIT		; Exit.
;
; ISHOW - Show instruction
;
	.IF GT,DBUG
	.SAVE
	.PSECT	DATA,D,RW
INAM::	.WORD	0
ZADDR:	.BLKB	12
ARGBLK:	.WORD	ZADDR
	.BLKW	20
IFMT:	.ASCII	/%I - %I(/
FMTST2:	.BLKB	20
	.RESTORE
;
ISHOW::	CALL	$SAVAL
	MOV	FZPC,R0
	MOV	#ZADDR,R1
	CALL	100$
	MOV	FZPC+2,R0
	CALL	100$
	CLRB	(R1)
	MOV	#ARGBLK+2,R0
	MOV	#FMTST2,R1
	MOV	INAM,(R0)+
	TST	R3
	BEQ	20$
10$:	MOV	(R2)+,(R0)+
	MOVB	#'%,(R1)+
	MOVB	#'D,(R1)+
	MOVB	#',,(R1)+
	SOB	R3,10$
	DEC	R1
20$:	MOVB	#'),(R1)+
	CLRB	(R1)
	MOV	#BUF,R0
	MOV	#IFMT,R1
	MOV	#ARGBLK,R2
	CALL	$EDMSG
	MOV	#BUF,R1
	CALLR	ZMSG
;
100$:	JSR	R5,$SAVRG
	MOV	R0,R5
	SWAB	R5
	CALL	110$
	MOV	R0,R5
;
110$:	MOV	R5,R4
	ASH	#-4,R4
	CALL	120$
	MOV	R5,R4
;
120$:	BIC	#^C17,R4
	CMP	R4,#10.
	BLO	130$
	ADD	#7,R4
130$:	ADD	#'0,R4
	MOVB	R4,(R1)+
	RETURN
;
	.ENDC
;
	.END