User:Zzo38/Famicom Z-machine

This file contains a copy of the working in progress for the Famicom Z-machine interpreter program.

You are free to review it, question/comment, and even to modify it if you have improvements to make. It is placed here mainly in order to improve reviewing of the software, but you can use it for other purposes too.

The assembler in use is Unofficial MagicKit (a modified version of NESASM).

This program is being written by User:Zzo38, and is using the Famicom keyboard. Only uppercase is supported; any lowercase is converted to uppercase for display (the positions for lowercase letters in the pattern table contain uppercase). The keyboard decoder still returns lowercase, since that is what the Z-machine requires.

Due to overscan, the "MORE" prompt shall assume that the top and bottom two rows are not visible, and the scrolling routine shall blank out the bottom two rows (sixteen scanlines) of the screen to hide them on displays that would show the overscanned area anyways.

Unlike many Z-machine interpreters, this one supports permanent shifts even in version 3.

Opcode    Status
EQUAL?      OK
LESS?       OK
GRTR?       OK
DLESS?      OK
IGRTR?      OK
IN?         OK
BTST        OK
BOR         OK
BAND        OK
FSET?       OK
FSET        OK
FCLEAR      OK
SET         OK
MOVE        OK
GET         OK
GETB        OK
GETP        OK
GETPT       OK
NEXTP       OK
ADD         OK
SUB         OK
MUL         OK
DIV         X
MOD         X
ZERO?       OK
NEXT?       OK
FIRST?      OK
LOC         OK
PTSIZE      OK
INC         OK
DEC         OK
PRINTB      OK
REMOVE      OK
PRINTD      OK
RETURN      OK
JUMP        OK
PRINT       OK
VALUE       OK
BCOM        OK
RTRUE       OK
RFALSE      OK
PRINTI      OK
PRINTR      OK
NOOP        OK
SAVE        N/A
RESTORE     N/A
RESTART     OK
RSTACK      OK
FSTACK      OK
QUIT        OK
CRLF        OK
USL         N/A
VERIFY      OK
CALL        OK
PUT         OK
PUTB        OK
PUTP        OK
READ        X
PRINTC      OK
PRINTN      OK
RANDOM      X
PUSH        OK
POP         OK
SPLIT       N/A
SCREEN      N/A

(OK = implemented (but may contain errors), X = not implemented, P = partially implemented, N/A = no intention to implement in this version)

---

; Z-machine interpreter (Z-code versions 1 to 3) for Famicom
; version 0.0
; Public domain

	inesmap 5 ; MMC5 or "User:Zzo38/Mapper D"
	inesmir 1 ; Horizontal arrangement
	inesprg 16 ; 256K (bank 0 to 15 for story file, 16 to 31 for interpreter)
	ineschr 1 ; 8K

; The C program will read, adjust the header, and then set asm macros, as follows:
;   zver: Z-machine version number.
;   bytswap: Defined for small endian, undefined for big endian
;   endlod: Beginning of non-preloaded code (this program extends core to 64K for simplicity)
;   purbot: Beginning of data to not enter into save file
;   start: Location where execution begins
;   vocab: Points to vocabulary table
;   sibcnt: Number of self-inserting break characters
;   voccnt: Number of entries in vocabulary table
;   ventsiz: Entry size of vocabulary table
;   object: Points to object table
;   globals: Points to global variable table
;   fwords: Points to fwords table
;   plenth: Length of program in words
;   pchksm: Checksum of all bytes

xobject	= object+62-9 ; Offset for object headers
xglobal	= global-32 ; Offset for global variables
xvocab	= vocab+sibcnt+4 ; Actual start of vocab

; Low RAM usage:
;   $0xx = Miscellaneous variables
;   $1xx = 6502 stack
;   $2xx = Bits 7:0 of Z-machine data stack
;   $3xx = Bits 15:8 of Z-machine data stack
;   $4xx = Bits 7:0 of Z-machine call stack
;   $5xx = Bits 15:8 of Z-machine call stack
;   $6xx = Bit 16 of Z-machine call stack
;   $7xx = Pointer to bottom of data stack for a routine

	zp
outbuf	ds 32 ; The output buffer
r0	ds 1
r1	ds 1
r2	ds 1
r3	ds 1
r4	ds 1
r5	ds 1
r6	ds 1
r7	ds 1
op0l	ds 1 ; First operand of an instruction
op0h	ds 1
op1l	ds 1
op1h	ds 1
op2l	ds 1
op2h	ds 1
op3l	ds 1
op3h	ds 1
argtyp	ds 1 ; Argument types (inverted; used for EQUAL? and CALL)
cstkcnt	ds 1 ; Count of entries on the call stack
dstkcnt	ds 1 ; Count of entries on the data stack
cursx	ds 1 ; Cursor X position
readcnt	ds 1 ; Number of characters input
cursxin	ds 1 ; Cursor X position at start of input line
linecnt	ds 1 ; Number of lines output before pausing (to implement "MORE")
bufptr	ds 1 ; Pointer into output buffer
pcl	ds 1 ; Low byte of program counter
pcm	ds 1 ; Mid byte of program counter
pch	ds 1 ; High byte of program counter
vlub	ds 4 ; Vocabulary look up buffer
byth	ds 1 ; High byte of value reading from memory (low byte is accum)
mapad	ds 2 ; Mapped address (second byte is zero)
corel	ds 1
coreh	ds 1
idxl	ds 1
idxh	ds 1
outrdy	ds 1 ; To set if output buffer is ready to display on the screen.
linrdy	ds 1 ; To set if ready to add a linefeed to output
pshift	ds 1 ; Permanent shift state (one of: $00, $20, $40)
tshift	ds 1 ; Temporary shift state ($60=high escape, $80=low escape, $A0=fwords)
chroff	ds 1 ; Partial character code or FWORDS index
blinker	ds 1 ; Cursor blink time
curspal	ds 1 ; Color of cursor
keychar	ds 1 ; Keyboard character to print
scrolly	ds 1 ; Scroll position ($00 to $E8)
lladl	ds 1 ; Low byte of address of last line ($00 to $E0)
lladh	ds 1 ; High byte of address of last line ($20 to $23)

rambank	= $5113 ; xxxx xxxx
rombank	= $5115 ; 1xxx xxx0

; Mapping ROM address:
;   Bank = ((A>>13)|128)&254
;   Address = (A&$3FFF)|$8000

; Mapping RAM address:
;   Bank = A>>13
;   Address = (A&$1FFF)|$6000

	macro romsel
	lda #128|bank(\1)&254
	sta rombank
	endmac

	macro bankcall
	ldy #128|bank(\1)&254
	sty rombank
	jsr \1
	endmac

	macro bankjump
	ldy #128|bank(\1)&254
	sty rombank
	jmp \1
	endmac

	code

	bank 16
	org $8000

	; Alphabet table row 2
	if zver=1
alpha2	db 32, 13, "*****0123456789.,!?_#'", 34, "/", 92, "<-:()"
	else
alpha2	db " ******", 13, "0123456789.,!?_#'", 34, "/", 92, "-:()"
	endif

	; Keyboard decoding table (lowercase is necessary)
kbdt	db "][", 13, 0, 0, 92, 15, 0
	db ";:@", 0, "^-/_"
	db "klo", 0, "0p,."
	db "jui", 0, "89nm"
	db "hgy", 0, "67vb"
	db "drt", 0, "45cf"
	db "asw", 0, "3ezx"
	db 0, "q", 0, 0, "21", 0, 15
	db 0, 0, 0, 12, 0, 8, 32, 0

	; Do the sending of output buffer (not using <r0 <r1)
sendout	inc <outrdy
	;TODO
	lda #0
	sta <bufptr
	pla
	rti

	; Send a line feed (not using <r0 <r1)
sendlf	inc <linrdy
	lda #1
	sta <cursx

	; Blank out the next line
	lda #$08
	sta <r2
	lda <scrolly
	asl a
	rol <r2
	asl a
	rol <r2
	ldx <r2
	stx $2006
	sta $2006
	lda #32
	tax
sendlf1	sta $2007
	dex
	bne sendlf1

	; Advance scroll position and line position
	lda <scrolly
	clc
	adc #$08
	cmp #$F0
	bne sendlf2
	lda #$00
sendlf2	sta <scrolly
	;TODO

	; Check if [MORE] prompt should be displayed
	;TODO

	; Return from NMI
	pla
	rti

	; Ready the output buffer for dumping to the screen
	; And then, wait for the NMI routine to clear it
outdump	dec <outrdy
outdum1	bit <outrdy
	bvs outdum1
outdum2	rts

	; Ready to output a line feed
	; Wait for NMI routine to clear the flag
lfodump	dec <outrdy
lfdump	dec <linrdy
lfdump1	bit <linrdy
	bvs lfdump1
lfdump2	rts

	; Print a character
putchar	cmp #0
	beq lfdump2 ; outputting ASCII code 0 has no effect
	cmp #13
	beq lfodump ; output the buffer and a line break
	cmp #32
	beq endword ; output a word and a space
putcha0	ldx <cursx
	cpx #31
	bcc putcha1
	jsr lfdump
putcha1	ldx <bufptr
	sta <outbuf,x
	inc <bufptr
	rts

endword	jsr outdump
	cpx #31
	bcs lfdump
	bcc putcha1

	; Print a signed 16-bit integer (<op0h,<op0l), then nxtinst
printn	lda <op0h
	bit #$80
	beq printn1
	; Negative number
	lda #45
	jsr putcha0
	; Bitwise complement and increment
	lda <op0h
	eor #$FF
	tax
	lda <op0l
	eor #$FF
	clc
	adc #1
	sta <op0l
	txa
	adc #0
	sta <op0h
	; Print a positive number (0 to 32768)
	; ones_tens (r0): ot256[H]+mod100[L]
	; hund_thou (r1): ht256[H]+divten[divten[L]]+divten[divten[ones_tens]]
	; myriads (A): myr256[H]+divten[divten[hund_thou]]
printn1	ldx <op0h
	lda ot256,x
	ldy <op0l
	clc
	adc mod100,y
	sta <r0
	lda ht256,x
	ldx divten,y
	adc divten,x
	ldy <r0
	ldx divten,y
	adc divten,x
	sta <r1
	tax
	ldy divten,x
	lda divten,y
	ldx <op0h
	adc myr256,x
	; Use the carry flag to indicate printing leading zeros or not
	jsr digpair
	lda <r1
	jsr digpair
	lda <r0
	jsr digpair
	bcs printn2
	; The value is zero
	lda #$30
	jsr putchar
printn2	jmp nxtinst

	; Print a pair of digits
digpair	tay
	lda divten,y
	bne digpai1
	bcc digpai2
digpai1	ora #$30
	jsr putcha0
	sec
digpai2	lda modten,y
	bne digpai3
	bcc digpai4
digpai3	ora #$30
	jsr putcha0
	sec
digpai4	rts

	; Convert and print a Z-character
putzch	and #$1F
	tay
	ora <tshift
	tax
	lda #$BF
	pha
	lda zchlut,x
	pha
	rts

	bank 17

	; Myriads of 256 times value (up to 128 only)
	org $B87F
myr256	db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;
	db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;
	db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1;
	db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2;
	db 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2;
	db 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3;
	db 3,3,3,3,3,3,3,3,3

	; Modulo by one hundred
	org $B900
mod100	db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
	db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39
	db 40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59
	db 60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79
	db 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99
	db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
	db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39
	db 40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59
	db 60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79
	db 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99
	db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
	db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39
	db 40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55

	; Ones and tens of 256 times value
	org $BA00
ot256	db 0,56,12,68,24,80,36,92,48,4,60,16,72,28,84,40,96,52,8,64;
	db 20,76,32,88,44,0,56,12,68,24,80,36,92,48,4,60,16,72,28,84;
	db 40,96,52,8,64,20,76,32,88,44,0,56,12,68,24,80,36,92,48,4;
	db 60,16,72,28,84,40,96,52,8,64,20,76,32,88,44,0,56,12,68,24;
	db 80,36,92,48,4,60,16,72,28,84,40,96,52,8,64,20,76,32,88,44;
	db 0,56,12,68,24,80,36,92,48,4,60,16,72,28,84,40,96,52,8,64;
	db 20,76,32,88,44,0,56,12,68,24,80,36,92,48,4,60,16,72,28,84;
	db 40,96,52,8,64,20,76,32,88,44,0,56,12,68,24,80,36,92,48,4;
	db 60,16,72,28,84,40,96,52,8,64,20,76,32,88,44,0,56,12,68,24;
	db 80,36,92,48,4,60,16,72,28,84,40,96,52,8,64,20,76,32,88,44;
	db 0,56,12,68,24,80,36,92,48,4,60,16,72,28,84,40,96,52,8,64;
	db 20,76,32,88,44,0,56,12,68,24,80,36,92,48,4,60,16,72,28,84;
	db 40,96,52,8,64,20,76,32,88,44,0,56,12,68,24,80

	; Hundreds and thousands of 256 times value
	org $BB00
ht256	db 0,2,5,7,10,12,15,17,20,23,25,28,30,33,35,38,40,43,46,48;
	db 51,53,56,58,61,64,66,69,71,74,76,79,81,84,87,89,92,94,97,99;
	db 2,4,7,10,12,15,17,20,22,25,28,30,33,35,38,40,43,45,48,51;
	db 53,56,58,61,63,66,68,71,74,76,79,81,84,86,89,92,94,97,99,2;
	db 4,7,9,12,15,17,20,22,25,27,30,32,35,38,40,43,45,48,50,53;
	db 56,58,61,63,66,68,71,73,76,79,81,84,86,89,91,94,96,99,2,4;
	db 7,9,12,14,17,20,22,25,27,30,32,35,37,40,43,45,48,50,53,55;
	db 58,60,63,66,68,71,73,76,78,81,84,86,89,91,94,96,99,1,4,7;
	db 9,12,14,17,19,22,24,27,30,32,35,37,40,42,45,48,50,53,55,58;
	db 60,63,65,68,71,73,76,78,81,83,86,88,91,94,96,99,1,4,6,9;
	db 12,14,17,19,22,24,27,29,32,35,37,40,42,45,47,50,52,55,58,60;
	db 63,65,68,70,73,76,78,81,83,86,88,91,93,96,99,1,4,6,9,11;
	db 14,16,19,22,24,27,29,32,34,37,40,42,45,47,50,52

	; Divide by ten
	org $BC00
divten	db 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1
	db 2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3
	db 4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5
	db 6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7
	db 8,8,8,8,8,8,8,8,8,8,9,9,9,9,9,9,9,9,9,9
	db 10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11
	db 12,12,12,12,12,12,12,12,12,12,13,13,13,13,13,13,13,13,13,13
	db 14,14,14,14,14,14,14,14,14,14,15,15,15,15,15,15,15,15,15,15
	db 16,16,16,16,16,16,16,16,16,16,17,17,17,17,17,17,17,17,17,17
	db 18,18,18,18,18,18,18,18,18,18,19,19,19,19,19,19,19,19,19,19
	db 20,20,20,20,20,20,20,20,20,20,21,21,21,21,21,21,21,21,21,21
	db 22,22,22,22,22,22,22,22,22,22,23,23,23,23,23,23,23,23,23,23
	db 24,24,24,24,24,24,24,24,24,24,25,25,25,25,25,25

	; Modulo by ten
	org $BD00
modten	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9 ;100
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9 ;200
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
	db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5 ;256

	; Z-character jump tables
	org $BE00

zchlut	;     0    1    2    3    4    5    6    7    8    9   10   11   12   13   14   15
	;    16   17   18   19   20   21   22   23   24   25   26   27   28   29   30   31
	if zver=1
	db zza2,zza2,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zza2,zza2,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zza2,zza2,zzt0,zzt1,zzp0,zzp1,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	endif
	if zver=2
	db zza2,zzfw,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zza2,zzfw,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zza2,zzfw,zzt0,zzt1,zzp0,zzp1,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	endif
	if zver=3
	db zza2,zzfw,zzfw,zzfw,zzt1,zzt2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
	db zza2,zzfw,zzfw,zzfw,zzp1,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
	db zza2,zzfw,zzfw,zzfw,zzp0,zzp2,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
	endif
	db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE
	db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE
	db zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle ;LOW ESCAPE
	db zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle ;LOW ESCAPE
	db zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs ;FWORDS
	db zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs ;FWORDS

	; Subroutines for dealing with specific Z-characters below
	org $BF01

	; Alphabet row 0 and 1 [11]
zzal	= *-1
	lda <pshift
	sta <tshift
	tya
	clc
	adc #59
	jmp putcha0

	; Alphabet row 2 (and spaces and carriage return) [10]
zza2	= *-1
	lda <pshift
	sta <tshift
	lda alpha2,y
	jmp putchar

	; Escape character [5]
zzes	= *-1
	lda #$60
	sta <tshift
	rts

	; High escape [17]
zzhe	= *-1
	sty <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	lda #$80
	sta <tshift
	rts

	; Low escape [10]
zzle	= *-1
	lda <pshift
	sta <tshift
	tya
	ora <chroff
	jmp putchar

	; Temporary shift to row 0 [5]
zzt0	= *-1
	lda #$00
	sta <tshift
	rts

	; Temporary shift to row 1 [5]
zzt1	= *-1
	lda #$20
	sta <tshift
	rts

	; Temporary shift to row 2 [5]
zzt2	= *-1
	lda #$40
	sta <tshift
	rts

	; Permament shift to row 0 [7]
zzp0	= *-1
	lda #$00
	sta <tshift
	sta <pshift
	rts

	; Permament shift to row 1 [7]
zzp1	= *-1
	lda #$20
	sta <tshift
	sta <pshift
	rts

	; Permament shift to row 2 [7]
zzp2	= *-1
	lda #$40
	sta <tshift
	sta <pshift
	rts

	; Start fwords [17]
zzfw	= *-1
	sty <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	asl <chroff
	lda #$A0
	sta <tshift
	rts

	; Print fwords [63]
zzfs	= *-1
	tya
	ora <chroff
	sta <idxl
	lda #0
	sta <idxh
	lda #low(fwords-64)
	sta <corel
	lda #high(fwords-64)
	sta <coreh
	lda <pshift
	pha
	lda <pch
	pha
	lda <pcm
	pha
	lda <pcl
	pha
	jsr mget
	asl a
	sta <pcl
	lda <byth
	rol a
	sta <pcm
	lda #0
	rol a
	sta <pch
	jsr putstr
	pla
	sta <pcl
	pla
	sta <pcm
	pla
	sta <pch
	pla
	sta <pshift
	sta <tshift
	rts

	bank 18
	org $8000

	; More reset initialization codes
reset1	bit $2002
vblw1	bit $2002
	bpl vblw1
	dex
	inx
vblw2	bit $2002
	bpl vblw2
	; Zero some variables
	lda #0
	sta <mapad+1
	sta <outrdy
	sta <linrdy
	sta <cursx
	sta <bufptr
	sta <pch
	sta <blinker
	sta <keychar
	sta <lladl
	sta <cstkcnt
	sta <dstkcnt
	; Fill up the palette
	ldx #$3F
	stx $2006
	sta $2006
	stx $2007
	stx $2007
	sta $2007
	stx <curspal
	; Clear CIRAM
	ldy #$20
	sty <lladh
	sty $2006
	sta $2006
	tax
reset2	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;16
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;32
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;48
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;64
	inx
	bne reset2
	; Initialize variables
	lda #low(start)
	sta <pcl
	lda #high(start)
	sta <pcm
	lda #(8*27)
	sta <scrolly
	lda #25
	sta <linecnt
	; Begin program
	jmp nxtinst

	; Instruction decoding table
opccnt	= 236

	macro opcode
	org opctab+(\1)
	db high((\2)-1) ; Subtracting 1 so that RTS trick will be used
	org opctab+(\1)+opccnt
	db low((\2)-1)
	if (\1)<$20
	opcode (\1)+$20, \2
	opcode (\1)+$40, \2
	opcode (\1)+$60, \2
	opcode (\1)+$C0, \2
	endif
	if ((\1)>$7F)&((\1)<$90)
	opcode (\1)+$10, \2
	opcode (\1)+$20, \2
	endif
	endmac

opctab	ds opccnt*2
	opcode 1, z_equal
	opcode 2, z_less
	opcode 3, z_grtr
	opcode 4, z_dless
	opcode 5, z_igrtr
	opcode 6, z_in
	opcode 7, z_btst
	opcode 8, z_bor
	opcode 9, z_band
	opcode 10, z_ftst
	opcode 11, z_fset
	opcode 12, z_fclr
	opcode 13, z_set
	opcode 14, z_move
	opcode 15, z_get
	opcode 16, z_getb
	opcode 17, z_getp
	opcode 18, z_getpt
	opcode 19, z_nextp
	opcode 20, z_add
	opcode 21, z_sub
	opcode 22, z_mul
	opcode 23, z_div
	opcode 24, z_mod
	opcode 128, z_zero
	opcode 129, z_next
	opcode 130, z_first
	opcode 131, z_loc
	opcode 132, z_ptsiz
	opcode 133, z_inc
	opcode 134, z_dec
	opcode 135, z_prntb
	opcode 137, z_remov
	opcode 138, z_prntd
	opcode 139, z_ret
	opcode 140, z_jump
	opcode 141, z_print
	opcode 142, z_value
	opcode 143, z_bcom
	opcode 176, z_rtrue
	opcode 177, z_rfals
	opcode 178, z_prnti
	opcode 179, z_prntr
	opcode 180, z_noop
	opcode 181, z_save
	opcode 182, z_rstor
	opcode 183, z_rest
	opcode 184, z_rstac
	opcode 185, z_fstac
	opcode 186, z_quit
	opcode 187, z_crlf
	opcode 188, z_usl
	opcode 189, z_vrfy
	opcode 224, z_call
	opcode 225, z_put
	opcode 226, z_putb
	opcode 227, z_putp
	opcode 228, z_read
	opcode 229, z_prntc
	opcode 230, z_prntn
	opcode 231, z_randm
	opcode 232, z_push
	opcode 233, z_pop
	opcode 234, z_split
	opcode 235, z_scrn
	org opctab+(opccnt*2)

	; Multiply <op0h,<op0l by <op1h,<op1l
	; [...W ...X ...Y ...Z]
multipl	;

	; Z*Z
	lda <op1l
	and #$0F
	sta <r0
	lda <op0l
	asl a
	asl a
	asl a
	asl a
	sta <r3 ; used later
	ora <r0
	tax
	lda multab,x
	sta <r1

	; Y*Z
	lda <op0l
	and #$F0
	sta <r4 ; used later
	ora <r0
	tax
	lda multabl,x
	clc
	adc <r1
	sta <r1
	lda multabr,x
	adc #0
	sta <byth

	; X*Z
	lda <op0h
	asl a
	asl a
	asl a
	asl a
	ora <r0
	tax
	lda multab,x
	clc
	adc <byth
	sta <byth

	; W*Z
	lda <op0h
	and #$F0
	ora <r0
	tax
	lda multabl,x
	clc
	adc <byth
	sta <byth

	; Z*Y
	lda <op1l
	and #$F0
	sta <r0
	lda <op0l
	and #$0F
	ora <r0
	tax
	lda multabl,x
	clc
	adc <r1
	sta <r1
	lda multabr,x
	adc <byth
	sta <byth

	; Y*Y
	lda <op0l
	lsr a
	lsr a
	lsr a
	lsr a
	ora <r0
	tax
	lda multab,x
	clc
	adc <byth
	sta <byth

	; X*Y
	lda <op0h
	and #$0F
	ora <r0
	tax
	lda multabl,x
	clc
	adc <byth
	sta <byth

	; Z*X
	lda <op1h
	and #$0F
	sta <r0
	ora <r3
	tax
	lda multab,x
	clc
	adc <byth
	sta <byth

	; Y*X
	lda <r0
	ora <r4
	tax
	lda multabl,x
	clc
	adc <byth
	sta <byth

	; Z*W
	lda <op0l
	and #$0F
	sta <r0
	lda <op1h
	and #$F0
	ora <r0
	tax
	lda multabl,x
	clc
	adc <byth
	sta <byth

	; Finished multiplication
	lda <r1
	jsr tostore
	jmp nxtinst

	bank 19

	org $BD00
	; Muliplication table shifted right
	;   0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F
multabr	db $0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0  ; 0
	db $0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0  ; 1
	db $0,$0,$0,$0,$0,$0,$0,$0,$1,$1,$1,$1,$1,$1,$1,$1  ; 2
	db $0,$0,$0,$0,$0,$0,$1,$1,$1,$1,$1,$2,$2,$2,$2,$2  ; 3
	db $0,$0,$0,$0,$1,$1,$1,$1,$2,$2,$2,$2,$3,$3,$3,$3  ; 4
	db $0,$0,$0,$0,$1,$1,$1,$2,$2,$2,$3,$3,$3,$4,$4,$4  ; 5
	db $0,$0,$0,$1,$1,$1,$2,$2,$3,$3,$3,$4,$4,$4,$5,$5  ; 6
	db $0,$0,$0,$1,$1,$2,$2,$3,$3,$3,$4,$4,$5,$5,$6,$6  ; 7
	db $0,$0,$1,$1,$2,$2,$3,$3,$4,$4,$5,$5,$6,$6,$7,$7  ; 8
	db $0,$0,$1,$1,$2,$2,$3,$3,$4,$5,$5,$6,$6,$7,$7,$8  ; 9
	db $0,$0,$1,$1,$2,$3,$3,$4,$5,$5,$6,$6,$7,$8,$8,$9  ; A
	db $0,$0,$1,$2,$2,$3,$4,$4,$5,$6,$6,$7,$8,$8,$9,$A  ; B
	db $0,$0,$1,$2,$3,$3,$4,$5,$6,$6,$7,$8,$9,$9,$A,$B  ; C
	db $0,$0,$1,$2,$3,$4,$4,$5,$6,$7,$8,$8,$9,$A,$B,$C  ; D
	db $0,$0,$1,$2,$3,$4,$5,$6,$7,$7,$8,$9,$A,$B,$C,$D  ; E
	db $0,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$A,$B,$C,$D,$E  ; F

	org $BE00
	; Multiplication table shifted left
	;   0   1   2   3   4   5   6   7   8   9   A   B   C   D   E   F
multabl	db $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00  ; 0
	db $00,$10,$20,$30,$40,$50,$60,$70,$80,$90,$A0,$B0,$C0,$D0,$E0,$F0  ; 1
	db $00,$20,$40,$60,$80,$A0,$C0,$E0,$00,$20,$40,$60,$80,$A0,$C0,$E0  ; 2
	db $00,$30,$60,$90,$C0,$F0,$20,$50,$80,$B0,$E0,$10,$40,$70,$A0,$D0  ; 3
	db $00,$40,$80,$C0,$00,$40,$80,$C0,$00,$40,$80,$C0,$00,$40,$80,$C0  ; 4
	db $00,$50,$A0,$F0,$40,$90,$E0,$30,$80,$D0,$20,$70,$C0,$10,$60,$B0  ; 5
	db $00,$60,$C0,$20,$80,$E0,$40,$A0,$00,$60,$C0,$20,$80,$E0,$40,$A0  ; 6
	db $00,$70,$E0,$50,$C0,$30,$A0,$10,$80,$F0,$60,$D0,$40,$B0,$20,$90  ; 7
	db $00,$80,$00,$80,$00,$80,$00,$80,$00,$80,$00,$80,$00,$80,$00,$80  ; 8
	db $00,$90,$20,$B0,$40,$D0,$60,$F0,$80,$10,$A0,$30,$C0,$50,$E0,$70  ; 9
	db $00,$A0,$40,$E0,$80,$20,$C0,$60,$00,$A0,$40,$E0,$80,$20,$C0,$60  ; A
	db $00,$B0,$60,$10,$C0,$70,$20,$D0,$80,$30,$E0,$90,$40,$F0,$A0,$50  ; B
	db $00,$C0,$80,$40,$00,$C0,$80,$40,$00,$C0,$80,$40,$00,$C0,$80,$40  ; C
	db $00,$D0,$A0,$70,$40,$10,$E0,$B0,$80,$50,$20,$F0,$C0,$90,$60,$30  ; D
	db $00,$E0,$C0,$A0,$80,$60,$40,$20,$00,$E0,$C0,$A0,$80,$60,$40,$20  ; E
	db $00,$F0,$E0,$D0,$C0,$B0,$A0,$90,$80,$70,$60,$50,$40,$30,$20,$10  ; F

	org $BF00
	; Multiplication 16x16 table
	;   0   1   2   3   4   5   6   7   8   9   A   B   C   D   E   F
multab	db $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00  ; 0
	db $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F  ; 1
	db $00,$02,$04,$06,$08,$0A,$0C,$0E,$10,$12,$14,$16,$18,$1A,$1C,$1E  ; 2
	db $00,$03,$06,$09,$0C,$0F,$12,$15,$18,$1B,$1E,$21,$24,$27,$2A,$2D  ; 3
	db $00,$04,$08,$0C,$10,$14,$18,$1C,$20,$24,$28,$2C,$30,$34,$38,$3C  ; 4
	db $00,$05,$0A,$0F,$14,$19,$1E,$23,$28,$2D,$32,$37,$3C,$41,$46,$4B  ; 5
	db $00,$06,$0C,$12,$18,$1E,$24,$2A,$30,$36,$3C,$42,$48,$4E,$54,$5A  ; 6
	db $00,$07,$0E,$15,$1C,$23,$2A,$31,$38,$3F,$46,$4D,$54,$5B,$62,$69  ; 7
	db $00,$08,$10,$18,$20,$28,$30,$38,$40,$48,$50,$58,$60,$68,$70,$78  ; 8
	db $00,$09,$12,$1B,$24,$2D,$36,$3F,$48,$51,$5A,$63,$6C,$75,$7E,$87  ; 9
	db $00,$0A,$14,$1E,$28,$32,$3C,$46,$50,$5A,$64,$6E,$78,$82,$8C,$96  ; A
	db $00,$0B,$16,$21,$2C,$37,$42,$4D,$58,$63,$6E,$79,$84,$8F,$9A,$A5  ; B
	db $00,$0C,$18,$24,$30,$3C,$48,$54,$60,$6C,$78,$84,$90,$9C,$A8,$B4  ; C
	db $00,$0D,$1A,$27,$34,$41,$4E,$5B,$68,$75,$82,$8F,$9C,$A9,$B6,$C3  ; D
	db $00,$0E,$1C,$2A,$38,$46,$54,$62,$70,$7E,$8C,$9A,$A8,$B6,$C4,$D2  ; E
	db $00,$0F,$1E,$2D,$3C,$4B,$5A,$69,$78,$87,$96,$A5,$B4,$C3,$D2,$E1  ; F

	bank 30
	org $C000

	; Macro for object address (35 bytes)
	macro object_address
	lda #low(xobject+\2)
	sta <corel
	lda #high(xobject+\2)
	sta <coreh
	lda #0
	sta <idxh
	sta <byth
	lda \1
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh ; now carry flag is clear, have 8x value
	adc \1 ; add the object number so you have 9x in total
	sta <idxl
	lda <idxh
	adc #0 ; carry out if applicable
	sta <idxh
	endmac

	; Print a string
putstr	lda #0
	sta <pshift
	sta <tshift
putstr1	jsr pcgetw
	pha
	sta <r1
	lda <byth
	lsr a
	ror <r1
	lsr a
	ror <r1
	bankcall putzch
	lda <r1
	lsr a
	lsr a
	lsr a
	jsr putzch
	pla
	jsr putzch
	bit <byth
	bpl putstr1
	rts

	; Read a word from instruction pointer
pcgetw	jsr pcgetb
	sta <byth
	; falls through

	; Read a byte from instruction pointer, write to A
	; (clobbers X, Y, and flags)
pcgetb	ldy <pcl ; To use later
	lda <pch
	bne pcgetbh ; In high memory; it is greater than 64K
	; It is in core memory (always 64K in this program)
	lax <pcm
	and #$1F
	ora #$60
	sta <mapad
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sta rambank
	lda [mapad],y
	jmp pcinc
pcgetbh	; 0000 0001 xxyy yyyy zzzz zzzz -> bank=1000 1xx0, mem=10yy yyyy
	lax <pcm
	and #$3F
	ora #$80
	sta <mapad
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	and #$06
	ora #$88
	sta rombank
	lda [mapad],y
pcinc	inc <pcl
	bne pcirts
	inc <pcm
	bne pcirts
	inc <pch
pcirts	rts

	; Deal with reading a register (as VALUE)
	; Register in A, result in <byth and A
fetch	cmp #16
	bcc fetch1
	; Global variables
	sta <idxl
	lda #0
	sta <idxh
	lda #low(xglobal)
	sta <corel
	lda #high(xglobal)
	sta <coreh
	jmp mget
fetch1	cmp #0
	bne fetch3
	ldx <dstkcnt
	bne fetch2
fetch3	; Local variables
	ldx <cstkcnt
	ldy $6FF,x
	sty <r3
	adc <r3 ; Carry flag is already cleared
	tax
fetch2	lda $1FF,x
	sta <byth
	lda $2FF,x
	rts

	; Deal with store (uses A and <byth as value; instruction as dest)
	; The value A will remain there once stored
tostore	pha
	jsr pcgetb
	cmp #0
	bne dostore
	inc <dstkcnt
	; 'dostore' uses A as the register number, the the value on the stack
	; and <byth. It also omits pushing to the stack (cf. SET, INC, DEC)
dostore	cmp #16
	bcc store1
	; Global variables
	sta <idxl
	lda #0
	sta <idxh
	lda #low(xglobal)
	sta <corel
	lda #high(xglobal)
	sta <coreh
	jmp mput1
store1	cmp #0
	bne store3
	ldx <dstkcnt
	bne store2 ; <dstkcnt is known to be nonzero
store3	; Local variables
	ldx <cstkcnt
	ldy $6FF,x
	sty <r3
	adc <r3 ; Carry flag is already cleared
	tax
store2	pla
	sta $1FF,x
	ldy <byth
	sty $2FF,x
	rts

	; Calculate the current RAM bank and offset given <core* and <idx*
	macro memory_address
	lda <corel
	clc
	adc <idxl
	tay
	lda <coreh
	adc <idxh
	tax
	and #$1F
	ora #$60
	sta <mapad
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sta rambank
	endmac

	; Implement GET/GETB
	; <corel=low addr, <coreh=high addr
	; <idxl=low index, <idxh=high index
	; A=low data, <byth=high data
mget	asl <idxl
	rol <idxh
	jsr mgetb
	sta <byth
	inc <idxl
	bne mgetb
	inc <idxh
mgetb	memory_address
	lda [mapad],y
	rts

	; Implment PUT/PUTB
	; <corel=low addr, <coreh=high addr
	; <idxl=low index, <idxh=high index
	; A=low data, <byth=high data
mput	pha
mput1	asl <idxl
	rol <idxh
	lda <byth
	jsr mputb
	sta <byth
	inc <idxl
	bne mputb
	inc <idxh
	pla
mputb	pha
	memory_address
	pla
	sta [mapad],y
	rts

	; Figure out property table address of object A
	; Store ressults to <coreh and <corel
ptad	sta <mapad
	object_address <mapad,7
	; Get high octet
	jsr mgetb
	pha
	; Increment object header address
	inc <corel
	if low(xobject+7)=255
	inc <coreh
	endif
	; Get low octet
	jsr mgetb
	; Store the results
	sta <corel
	pla
	sta <coreh
	rts

	; Flag address (<op0l is object, <op1l is flag, A is bit)
flad	object_address <op0l,0
	lda <op1l
	pha
	lsr a
	lsr a
	lsr a
	sta <r0
	lda <idxl
	clc
	adc <r0
	sta <idxl
	lda <idxh
	adc #0
	sta <idxh
	pla
	and #$07
	beq flad2
	tax
	lda #$80
flad1	lsr a
	dex
	bne flad1
flad2	rts

	; Remove object (<op0l) from its current location
remobj	object_address <op0l,4 ; obj.LOC
	jsr mgetb
	beq flad2 ; rts if object is in nowhere
	sta <r0
	; Remember and clear obj.NEXT
	inc <corel
	if low(xobject+4)=255
	inc <coreh
	endif
	jsr mgetb
	sta <r1
	lda #0
	jsr mputb
	; Is it the FIRST object?
	object_address <r0,6 ; obj.LOC.FIRST
	jsr mgetb
	cmp <op0l
	bne remobj1
	; Yes! Set its new FIRST to the old NEXT of the removed object.
	lda <r1
	jmp mputb
	; No! Where is it in the chain?
remobj1	object_address <r1,5 ; r1.NEXT
	sta <r1
	cmp <op0l
	bne remobj1
	; Found it
	lda <idxl
	pha
	lda <idxh
	pha
	object_address <r1,5
	jsr mgetb
	tax
	pla
	sta <idxh
	pla
	sta <idxl
	txa
	jmp mputb

	; Find a property address (<coreh and <corel) and size (A)
	; Object is <op0l and property number is <op1l
pfind	lda <op0l
	jsr ptad
	lda #0
	sta <idxh
	sta <idxl
	; Skip the short description string
	jsr mgetb
	sec
	rol a
	bcc pfind1
	inc <coreh
	clc
pfind1	adc <corel
	sta <corel
	bcc pfind2
	inc <coreh
	; Skip all properties until the one is found
pfind2	jsr mgetb
	beq pfind3
	tax
	and #$1F
	cmp <op1l
	beq pfind4
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sec
	adc <corel
	sta <corel
	lda <coreh
	adc #0 ; won't pass 64K
	sta <coreh
	bcc pfind2
	; Not found
pfind3	sta <coreh
	sta <corel
	rts
	; Found
pfind4	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	clc
	adc #1
	rts

	; Do the relative branching using offset in A and <op0h
	; If the value is 0 or 1, it returns instead of jumps
rjumppc	ldx <op0h
	bne jumppc
	cmp #2
	bcs jumppc
	stx <byth
	jmp return

	; Same as above but won't check for returns
	; (also, the continuation of the above)
jumppc	sta <r0
	lda <op0h
	eor #$80 ; sign conversion
	sta <r1
	sec
	lda <pcl
	sbc #$03 ; subtract one extra, since...
	sta <pcl
	lda <pcm
	sbc #$80
	sta <pcm
	lda <pch
	sbc #$00 ; ...carry flag is now set (due to no borrowing)...
	sta <pch
	lda <pcl
	adc <r0 ; ...which causes the one extra to be added back
	sta <pcl
	lda <pcm
	adc <r1
	sta <pcm
	lda <pch
	adc #$00
	sta <pch
	jmp nxtinst

	; Deal with branch
	; Condition is true if zero flag is set
branch	php
	jsr pcgetb
	sta <r0
	pla
	lsr a
	lsr a
	ror a
	eor <r0
	bmi notjump ; condition flag does not match...
	bit <r0
	bvs branch1

	; Long branch
	lda <r0
	asl a
	asl a
	asl a
	php
	php
	ror a
	plp
	ror a
	plp
	ror a
	sta <op0h
	jsr pcgetb
	jmp rjumppc

	; Short branch
branch1	lda #0
	sta <op0h
	lda <r0
	and #$3F
	jmp rjumppc

	; Not branching
notjump	bit <r0
	bvs nxtinst
	jsr pcgetb
	jmp nxtinst

	; Return from a subroutine
return	dec <dstkcnt
	ldy <dstkcnt
	ldx $700,y
	stx <cstkcnt
	ldx $400,y
	stx <pcl
	ldx $500,y
	stx <pcm
	ldx $600,y
	stx <pch
	jsr tostore
	; fall through

	; Next instruction operation
nxtinst	jsr pcgetb
	sta <r0
	bit <r0
	bmi nxtins1

	; 2OP form
	sta <r1
	lsr <r1
	asl a
	and #$80
	ora <r1
	and #$90
	ora <r0
	eor #$60
	ora #$0F
	bne nxtins3

nxtins1	bvs nxtins2

	; 1OP or 0OP form
	rol a
	rol a
	ora #$3F
	bne nxtins3

	; EXT form
nxtins2	jsr pcgetb

	; Read operands and call function (using RTS trick)
nxtins3	eor #$FF
	sta <argtyp
	sta <r1
	ldx <r0
	romsel opctab
	lda opctab,x ; high byte of address
	pha
	lda opctab+opccnt,x ; low byte of address
	pha
	ldx #op0l-2
	stx <r2
	jsr getopr
	jsr getopr
	jsr getopr
	; fall through to read the fourth operand and RTS trick

	; Subroutine to read one operand of an instruction
getopr	ldx <r2
	inx
	inx
	stx <r2
	bit <r1
	bvs getopr1 ;bit0=0
	bmi getopr2 ;bit1=0

	; [11] No operand
getopr0	asl <r1
	asl <r1
	rts

getopr1	bmi getopr3 ;bit1=0

	; [10] Variable
	jsr pcgetb
	tay
	jsr fetch
	cpy #0 ; popped from stack
	bne getopr4
	dec <dstkcnt
	jmp getopr4

	; [01] Short immediate
getopr2	jsr pcgetb
	ldx <r2
	sta <0,x
	lda #0
	sta <1,x
	beq getopr0

	; [00] Long immediate
getopr3	jsr pcgetw
getopr4	ldx <r2
	sta <0,x
	lda <byth
	sta <1,x
	jmp getopr0


	; ****************************************

	; Z-code instructions
	; Set the zero flag for condition true, clear otherwise
	; <byth and A store the value to store to memory

	; [1] EQUAL? data,cmp1[,cmp2][,cmp3] /PRED
z_equal	lda <op0l
	cmp <op1l
	bne z1equal
	lda <op0h
	cmp <op1h
	bne z1equal
z0equal	jmp branch
z1equal	lda #$0F
	bit <argtyp
	beq z9equal
	lda <op0l
	cmp <op2l
	bne z2equal
	lda <op0h
	cmp <op2h
	bne z2equal
	jmp branch
z2equal	lda #$03
	bit <argtyp
	beq z9equal
	lda <op0l
	cmp <op3l
	bne z0equal
	lda <op0h
	cmp <op3h
	jmp branch
z9equal	asl a
	jmp branch

	; [4] DLESS? var,int /PRED
z_dless	lda <op0l
	jsr fetch
	clc
	sbc #0
	sta <op0l
	pha
	bcs z1dless
	dec <byth
z1dless	lda <byth
	sta <op0h
	lda <op0l
	jsr dostore
	; fall through

	; [2] LESS? int1,int2 /PRED
z_less	lda <op0h
	eor #$80 ; do sign conversion
	sta <op0h
	lda <op1h
	eor #$80
	cmp <op0h
	bne z1less
	lda <op0l
	cmp <op1l
z1less	lda #0
	adc #0 ; convert carry flag clear to zero flag set
	jmp branch

	; [5] IGRTR? var,int /PRED
z_dless	lda <op0l
	jsr fetch
	sec
	adc #0
	sta <op0l
	pha
	bcc z1dless
	inc <byth
z1dless	lda <byth
	sta <op0h
	lda <op0l
	jsr dostore
	; fall through

	; [3] GRTR? int1,int2 /PRED
z_grtr	lda <op1h
	eor #$80 ; do sign conversion
	sta <op1h
	lda <op0h
	eor #$80
	cmp <op1h
	bne z1grtr
	lda <op1l
	cmp <op0l
z1grtr	lda #0
	adc #0 ; convert carry flag clear to zero flag set
	jmp branch

	; [6] IN? obj1,obj2 /PRED
z_in	object_address <op0l,4
	jsr mgetb
	cmp <op1l
	jmp branch

	; [7] BTST data,mask /PRED
z_btst	lda <op0h
	and <op1h
	eor <op1h
	beq z1btst
	jmp branch
z1btst	lda <op0l
	and <op1l
	eor <op1l
	jmp branch

	; [8] BOR int1,int2 /VAL
z_bor	lda <op0h
	ora <op1h
	sta <byth
	lda <op0l
	ora <op1l
	jsr tostore
	jmp nxtinst

	; [9] BAND int1,int2 /VAL
z_band	lda <op0h
	and <op1h
	sta <byth
	lda <op0l
	and <op1l
	jsr tostore
	jmp nxtinst

	; [10] FSET? obj,flag /PRED
z_ftst	jsr flad
	sta <r0
	jsr mgetb
	eor #$FF
	and <r0
	jmp branch

	; [11] FSET obj,flag
z_fset	jsr flad
	sta <r0
	jsr mgetb
	ora <r0
	jsr mputb
	jmp nxtinst

	; [12] FCLEAR obj,flag
z_fclr	jsr flad
	eor #$FF
	sta <r0
	jsr mgetb
	and <r0
	jsr mputb
	jmp nxtinst

	; [13] SET var,value
z_set	lda <op1l
	pha
	lda <op1h
	sta <byth
	lda <op0l
	jsr dostore
	jmp nxtinst

	; [137] REMOVE obj
z_remov	lda #0
	sta <op1l
	beq z_move
	; keep with next

	; [14] MOVE object,container
	; Clear NEXT of object
z1move	inc <corel
	if low(xobject+4)=255
	inc <coreh
	endif
	jsr mputb ; accumulator is already zero
	jmp nxtinst
	; Remove object from its current location
z_move	jsr remobj
	; Set LOC of object
	object_address <op0l,4
	lda <op1l
	jsr mputb
	tax
	beq z1move
	; Remember object address
	lda <idxl
	sta <r0
	lda <idxh
	sta <r1
	; Get FIRST of container
	object_address <op1l,6
	jsr mgetb
	pha
	; Remember container address
	lda <idxl
	pha
	lda <idxh
	pha
	; Set NEXT of object
	lda <r0
	sta <idxl
	clc
	sbc #0 ; subtract one so it points to NEXT instead of FIRST
	lda <r1
	sbc #0
	sta <idxh
	pla
	jsr mputb
	; Set FIRST of container
	pla
	sta <idxh
	pla
	sta <idxl
	lda <op0l
	jsr mputb
	jmp nxtinst

	; [15] GET table,item /VAL
z_get	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
	lda <op1l
	sta <idxl
	lda <op1h
	sta <idxh
	jsr mget
	jsr tostore
	jmp nxtinst

	; [16] GETB table,item /VAL
z_getb	lda #0
	sta <byth
	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
	lda <op1l
	sta <idxl
	lda <op1h
	sta <idxh
	jsr mgetb
	jsr tostore
	jmp nxtinst

	; [17] GETP obj,prop /VAL
z_getp	jsr pfind
	beq z1getp
	inc <idxl
	lsr a
	bcc z2getp
	; Byte
	jsr mgetb
	jsr tostore
	jmp nxtinst
	; Use default value
z1getp	lda #high(object-2)
	sta <coreh
	lda #low(object-2)
	sta <corel
	lda <op1l
	sta <idxl
	; Word
z2getp	jsr mget
	jsr tostore
	jmp nxtinst

	; [18] GETPT obj,prop /VAL
z_getpt	jsr pfind
	lda <coreh
	sta <byth
	lda <corel
	jsr tostore
	jmp nxtinst

	; [19] NEXTP obj,prop /VAL
z_nextp	lda <op1l
	beq z1nextp
	jsr pfind
	adc #1
	sta <idxl
	jsr mgetb
	jmp z2nextp
	; Request first property
z1nextp	lda <op0l
	jsr ptad
	jsr mgetb
	sta <idxl
	lda #0
	sta <idxh
	jsr mget
z2nextp	and #$1F
	ldx #0
	stx <byth
	jsr tostore
	jmp nxtinst

	; [20] ADD int1,int2 /VAL
z_add	clc
	lda <op0l
	adc <op1l
	pha
	lda <op0h
	adc <op1h
	sta <byth
	pla
	jsr tostore
	jmp nxtinst

	; [21] SUB int1,int2 /VAL
z_sub	sec
	lda <op0l
	sbc <op1l
	pha
	lda <op0h
	sbc <op1h
	sta <byth
	pla
	jsr tostore
	jmp nxtinst

	; [22] MUL int1,int2 /VAL
z_mul	bankjump multipl

	; [128] ZERO? value /PRED
z_zero	lda <op0l
	ora <op0h
	jmp branch

	; [129] NEXT? obj /VAL/PRED
z_next	object_address <op0l,5
	jsr mgetb
	jsr tostore
	tax
	php
	pla
	and #$02 ; now zero flag is toggled
	jmp branch

	; [130] FIRST? obj /VAL/PRED
z_first	object_address <op0l,6
	jsr mgetb
	jsr tostore
	tax
	php
	pla
	and #$02 ; now zero flag is toggled
	jmp branch

	; [131] LOC obj /VAL
z_loc	object_address <op0l,4
	jsr mgetb
	jsr tostore
	jmp nxtinst

	; [132] PTSIZE ptr /VAL
z_ptsiz	lda #$FF
	sta <idxl
	sta <idxh
	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
	jsr mgetb
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sec
	adc #0
	jsr tostore
	jmp nxtinst

	; [133] INC var
z_inc	lda <op0l
	jsr fetch
	sec
	adc #0
	pha
	bcc zincdec
	inc <byth
zincdec	lda <op0l
	jsr dostore
	jmp nxtinst
	; keep with next

	; [134] DEC var
z_dec	lda <op0l
	jsr fetch
	clc
	sbc #0
	pha
	bcs zincdec
	dec <byth ; does not affect the carry flag
	bcc zincdec

	; [138] PRINTD obj
z_prntd	lda <op0l
	jsr ptad
	inc <corel ; skip length byte
	bne z1prntb
	inc <coreh ; going past 64K is not allowed
	bne z1prntb
	; keep with next

	; [135] PRINTB ptr
z_prntb	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
z1prntb	lda <pcl
	pha
	lda <pcm
	pha
	lda <pch
	pha
	lda #0
	sta <pch
	lda <corel
	sta <pcl
	lda <coreh
	sta <pcm
	jsr putstr
	pla
	sta <pch
	pla
	sta <pcm
	pla
	sta <pcl
	jmp nxtinst

	; [139] RETURN value
z_ret	lda <op0h
	sta <byth
	lda <op0l
	jmp return

	; [140] JUMP offset
z_jump	lda <op0l
	jmp jumppc

	; [141] PRINT str
z_print	lda <pcl
	pha
	lda <pcm
	pha
	lda <pch
	pha
	lda #0
	sta <pch
	lda <corel
	sta <pcl
	lda <coreh
	sta <pcm
	asl <pcl
	rol <pcm
	rol <pch
	jsr putstr
	pla
	sta <pch
	pla
	sta <pcm
	pla
	sta <pcl
	jmp nxtinst

	; [143] BCOM int /VAL
z_bcom	lda <op0h
	eor #$FF
	sta <byth
	lda <op0l
	eor #$FF
	jsr tostore
	jmp nxtinst

	; [142] VALUE var /VAL
z_value	lda <op0l
	jsr fetch
z1value	jsr tostore
	jmp nxtinst
	; keep with next

	; [224] CALL fcn[,arg1][,arg2][,arg3] /VAL
z_call	lda #0
	cmp <op0l
	bne z1call
	sta <byth
	cmp <op0h
	beq z1value
z1call	ldx <cstkcnt
	lda <pcl
	sta $400,x
	lda <pcm
	sta $500,x
	lda <pch
	sta $600,x
	lda <dstkcnt
	sta <r2 ; remember bottom of local stack frame
	sta $700,x
	inc <cstkcnt
	lsr <pch
	lda <op0l
	sta <pcl
	lda <op0h
	sta <pcm
	asl <pcl
	rol <pcm
	rol <pch
	; Read values of local variables
	jsr pcgetb
	sta <r3
z2call	lda <r3
	beq z3call
	dec <r3
	jsr pcgetw
	ldy <dstkcnt
	sta $200,y
	lda <byth
	sta $300,y
	inc <dstkcnt
	bne z2call
	; Rewrite values of local variables by arguments
z3call	lda #$3F
	bit <argtyp
	beq z9call
	ldx <r2
	lda <op1l
	sta $200,x
	lda <op1h
	sta $300,x
	lda #$0F
	bit <argtyp
	beq z9call
	lda <op2l
	sta $201,x
	lda <op2h
	sta $301,x
	lda #$03
	bit <argtyp
	beq z9call
	lda <op3l
	sta $202,x
	lda <op3h
	sta $302,x
z9call	jmp nxtinst

	; [179] PRINTR (str)
z_prntr	jsr putstr
	lda #13
	bankcall putchar
	; fall through

	; [176] RTRUE
z_rtrue	lda #0
	sta <byth
	lda #1
	jmp return

z_rfals	; [177] RFALSE
	lda #0
	sta <byth
	jmp return

	; [178] PRINTI (str)
z_prnti	jsr putstr
	jmp nxtinst

	; [180] NOOP
z_noop	= nxtinst

	; [181] SAVE /PRED
z_save	lda #1 ; clear the zero flag (SAVE/RESTORE aren't implemented)
	jmp branch

	; [182] RESTORE /PRED
z_rstor	= z_save

	; [183] RESTART
z_rest	= reset

	; [184] RSTACK
z_rstac	lda #0
	jsr fetch
	dec <dstkcnt
	jmp return

	; [189] VERIFY /PRED
z_vrfy	lda #0 ; just fake it for now
	jmp branch

	; [233] POP var
z_pop	ldx <dstkcnt
	jsr fetch2
	pha
	lda <op0l
	jsr dostore
	; fall through

	; [185] FSTACK
z_fstac	dec <dstkcnt
	jmp nxtinst

	; [186] QUIT
z_quit	jmp z_quit ; just wait forever for the player to push RESET

	; [225] PUT table,item,data
z_put	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
	lda <op1l
	sta <idxl
	lda <op1h
	sta <idxh
	lda <op2h
	sta <byth
	lda <op2l
	jsr mput
	jmp nxtinst

	; [226] PUTB table,item,data
z_putb	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
	lda <op1l
	sta <idxl
	lda <op1h
	sta <idxh
	lda <op2l
	jsr mputb
	jmp nxtinst

	; [227] PUTP obj,prop,value
z_putp	jsr pfind
	inc <idxl
	lsr a
	lda <op2h
	sta <byth
	lda <op2l
	bcc z1putp
	; Byte
	jsr mputb
	jmp nxtinst
	; Word
z1getp	jsr mput
	jmp nxtinst

	; [187] CRLF
z_crlf	lda #13
	bne z1prntc
	; keep with next

	; [229] PRINTC char
z_prntc	lda <op0l
z1prntc	bankcall putchar
	jmp nxtinst

	; [230] PRINTN int
z_prntn	bankjump printn

	; [232] PUSH value
z_push	inc <dstkcnt
	lda <op0l
	pha
	lda <op0h
	sta <byth
	lda #0
	jsr dostore
	jmp nxtinst

	; [234] SPLIT lines
z_split	= nxtinst

	; [235] SCREEN window
z_scrn	= nxtinst

	; ****************************************


	bank 31
	org $FE00

	; Initialize CPU/APU/PPU at reset
reset	ldx #$40
	stx $4017 ; Disable APU frame IRQ
	ldx #$FF
	txs
	inx
	stx $2000
	stx $2001
	stx $4010

	; Initialize MMC5 to act like User:Zzo38/Mapper_D
	stx $5101
	stx $5200
	stx $5204
	inx
	stx $5100
	stx $5102
	inx
	stx $5103
	lda #$44 ; horizontal arrangement
	sta $5105

	; Copy ROM to RAM
	ldx #0
	stx rambank
	ldy #0
	sty <r1
	sty <r3
	lda #$5F
	sta <r0
	lda #$80
	sta <r4
	jsr rrcp16
	jsr rrcp16
	jsr rrcp16
	jsr rrcp16

	; Call other init code
	bankjump reset1

	; Copy 16K of ROM to RAM
rrcp16	lda #$7F
	sta <r2
	jsr rrcopy
	; fall through

	; Copy 8K of ROM to RAM
rrcopy	lda <r4
	and #$80
	sta rombank
	inc <r4
rrcopy1	inc <r0
	inc <r2
rrcopy2	lda [r2],y
	sta [r0],y
	iny
	bne rrcopy2
	lda <r0
	and #$1F
	ora #$60
	sta <r0
	lda <r2
	and #$1F
	eor #$1F
	bne rrcopy1
	lda <r2
	inx
	stx rambank
	rts

	; NMI routine
nmi	pha
	dec <blinker
	bne nmi1
	bit $2002
	lda #$3F
	sta $2006
	lda #$23
	sta <blinker
	sta $2006
	lda <curspal
	eor #$0F
	sta <curspal
	sta $2007
	lda #0
	sta $2005
	lda <scrolly
	sta $2005
	pla
	rti
nmi1	bit <outrdy
	bvc nmi2
	jmp sendout ; the correct bank is already selected
nmi2	bit <linrdy
	bvc nmi3
	jmp sendlf
nmi3	pla
	rti

	; CHR ROM
	bank 32
	incbin "chicago_oblique.chr"
	incbin "chicago_inverse.chr"