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.

---

; 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
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 ; Storage of argument types (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
sendout	inc <outrdy
	;TODO
	lda #0
	sta <bufptr
	pla
	rti

	; Send a line feed
sendlf	inc <linrdy
	lda #1
	sta <cursx
	;TODO
	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
	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

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

	bank 17
	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 putchar

	; 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
	lda #0
	sta <mapad+1
	sta <outrdy
	;TODO

	; 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)

	bank 30
	org $C000

	; 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 romback
	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
	lda <byth
	sta $2FF,x
	rts

	; 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	lda <coreh
	clc
	adc <idxh
	tax
	and #$1F
	ora #$60
	sta <mapad
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sta rambank
	ldy <corel
	clc
	adc <idxl
	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 mgetb
	sta <byth
	inc <idxl
	bne mgetb
	inc <idxh
	pla
mputb	pha
	lda <coreh
	clc
	adc <idxh
	tax
	and #$1F
	ora #$60
	sta <mapad
	txa
	lsr a
	lsr a
	lsr a
	lsr a
	lsr a
	sta rambank
	ldy <corel
	clc
	adc <idxl
	pla
	sta [mapad],y
	rts

	; Figure out property table address of object A
	; Store ressults to <coreh and <corel
ptad	sta <mapad
	lda #low(xobject+7)
	sta <corel
	lda #high(xobject+7)
	sta <coreh
	lda #0
	sta <idxh
	sta <byth
	lda <op0l
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh
	adc <mapad
	sta <idxl
	; 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

	; 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	sta <argtyp
	eor #$FF
	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

	; [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

	; [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	lda #low(xobject+4)
	sta <corel
	lda #high(xobject+4)
	sta <coreh
	lda #0
	sta <idxh
	lda <op0l
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh ; now carry flag is clear, have 8x value
	adc <op0l ; add the object number so you have 9x in total
	sta <idxl
	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

	; [13] SET var,value
z_set	lda <op1l
	pha
	lda <op1h
	sta <byth
	lda <op0l
	jsr dostore
	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

	; [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

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

	; [129] NEXT? obj /VAL/PRED
z_next	lda #low(xobject+5)
	sta <corel
	lda #high(xobject+5)
	sta <coreh
	lda #0
	sta <idxh
	sta <byth
	lda <op0l
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh ; now carry flag is clear, have 8x value
	adc <op0l ; add the object number so you have 9x in total
	sta <idxl
	jsr mgetb
	jsr tostore
	clc
	sbc #0 ; make the zero flag *clear* if zero
	jmp branch

	; [130] FIRST? obj /VAL/PRED
z_first	lda #low(xobject+6)
	sta <corel
	lda #high(xobject+6)
	sta <coreh
	lda #0
	sta <idxh
	sta <byth
	lda <op0l
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh ; now carry flag is clear, have 8x value
	adc <op0l ; add the object number so you have 9x in total
	sta <idxl
	jsr mgetb
	jsr tostore
	clc
	sbc #0
	jmp branch

	; [131] LOC obj /VAL
z_loc	lda #low(xobject+4)
	sta <corel
	lda #high(xobject+4)
	sta <coreh
	lda #0
	sta <idxh
	sta <byth
	lda <op0l
	asl a
	rol <idxh
	asl a
	rol <idxh
	asl a
	rol <idxh ; now carry flag is clear, have 8x value
	adc <op0l ; add the object number so you have 9x in total
	sta <idxl
	jsr mgetb
	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 <coreh
	bne z1prntb
	inc <corel
	bne z1prntb
	; keep with next

	; [135] PRINTB ptr
z_prntb	lda <op0l
	sta <corel
	lda <op0h
	sta <coreh
z1prntb	;TODO

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

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

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

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

	; [224] CALL fcn[,any1][,any2][,any3] /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 $700,x
	inc <cstkcnt
	lsr <pch
	lda <op0l
	sta <pcl
	lda <op0h
	sta <pcm
	asl <pcl
	rol <pcm
	rol <pch
	;TODO

	; [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

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

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

	; [185] FSTACK
z_fstac	dec <dstkcnt
	jmp nxtinst

	; [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

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

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

	; [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 #$50
	sta $5105

	; Call other init code
	bankjump reset1

	; 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
nmi1	bit <outrdy
	bvc nmi2
	jmp sendout
nmi2	bit <linrdy
	bvc nmi3
	jmp sendlf
nmi3	pla
	rti

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