User:Zzo38/Famicom Z-machine: Difference between revisions

From NESdev Wiki
Jump to navigationJump to search
(opcode implementation status table)
No edit summary
Line 12: Line 12:


  <b>Opcode</b>    <b>Status</b>
  <b>Opcode</b>    <b>Status</b>
  EQUAL?      X
  EQUAL?      OK
  LESS?      OK
  LESS?      OK
  GRTR?      OK
  GRTR?      OK
  DLESS?      X
  DLESS?      OK
  IGRTR?      X
  IGRTR?      OK
  IN?        OK
  IN?        OK
  BTST        OK
  BTST        OK
  BOR        OK
  BOR        OK
  BAND        OK
  BAND        OK
  FSET?      X
  FSET?      OK
  FSET        X
  FSET        OK
  FCLEAR      X
  FCLEAR      OK
  SET        OK
  SET        OK
  MOVE        X
  MOVE        OK
  GET        OK
  GET        OK
  GETB        OK
  GETB        OK
Line 40: Line 40:
  FIRST?      OK
  FIRST?      OK
  LOC        OK
  LOC        OK
  PTSIZE      X
  PTSIZE      OK
  INC        OK
  INC        OK
  DEC        OK
  DEC        OK
  PRINTB      X
  PRINTB      OK
  REMOVE      X
  REMOVE      OK
  PRINTD      X
  PRINTD      OK
  RETURN      OK
  RETURN      OK
  JUMP        OK
  JUMP        OK
  PRINT      X
  PRINT      OK
  VALUE      OK
  VALUE      OK
  BCOM        OK
  BCOM        OK
Line 58: Line 58:
  SAVE        N/A
  SAVE        N/A
  RESTORE    N/A
  RESTORE    N/A
  RESTART    X
  RESTART    OK
  RSTACK      OK
  RSTACK      OK
  FSTACK      OK
  FSTACK      OK
  QUIT        X
  QUIT        OK
  CRLF        OK
  CRLF        OK
  USL        N/A
  USL        N/A
  VERIFY      X
  VERIFY      X
  CALL        P
  CALL        OK
  PUT        OK
  PUT        OK
  PUTB        OK
  PUTB        OK
Line 71: Line 71:
  READ        X
  READ        X
  PRINTC      OK
  PRINTC      OK
  PRINTN      X
  PRINTN      OK
  RANDOM      X
  RANDOM      X
  PUSH        OK
  PUSH        OK
Line 128: Line 128:
r2 ds 1
r2 ds 1
r3 ds 1
r3 ds 1
nr0 ds 1 ; Temporary registers for NMI routine
nr1 ds 1
nr2 ds 1
nr3 ds 1
op0l ds 1 ; First operand of an instruction
op0l ds 1 ; First operand of an instruction
op0h ds 1
op0h ds 1
Line 136: Line 140:
op3l ds 1
op3l ds 1
op3h ds 1
op3h ds 1
argtyp ds 1 ; Storage of argument types (used for EQUAL? and CALL)
argtyp ds 1 ; Argument types (inverted; used for EQUAL? and CALL)
cstkcnt ds 1 ; Count of entries on the call stack
cstkcnt ds 1 ; Count of entries on the call stack
dstkcnt ds 1 ; Count of entries on the data stack
dstkcnt ds 1 ; Count of entries on the data stack
Line 255: Line 259:
cmp #32
cmp #32
beq endword ; output a word and a space
beq endword ; output a word and a space
ldx <cursx
putcha0 ldx <cursx
cpx #31
cpx #31
bcc putcha1
bcc putcha1
Line 268: Line 272:
bcs lfdump
bcs lfdump
bcc putcha1
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
; Convert and print a Z-character
Line 281: Line 354:


bank 17
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
org $BE00


Line 326: Line 491:
clc
clc
adc #59
adc #59
jmp putchar
jmp putcha0


; Alphabet row 2 (and spaces and carriage return) [10]
; Alphabet row 2 (and spaces and carriage return) [10]
Line 558: Line 723:
bank 30
bank 30
org $C000
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
; Print a string
Line 689: Line 877:
store2 pla
store2 pla
sta $1FF,x
sta $1FF,x
lda <byth
ldy <byth
sta $2FF,x
sty $2FF,x
rts
rts


Line 763: Line 951:
; Store ressults to <coreh and <corel
; Store ressults to <coreh and <corel
ptad sta <mapad
ptad sta <mapad
lda #low(xobject+7)
object_address <mapad,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
; Get high octet
jsr mgetb
jsr mgetb
Line 794: Line 967:
sta <coreh
sta <coreh
rts
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


; Do the relative branching using offset in A and <op0h
; Do the relative branching using offset in A and <op0h
Line 918: Line 1,158:


; Read operands and call function (using RTS trick)
; Read operands and call function (using RTS trick)
nxtins3 sta <argtyp
nxtins3 eor #$FF
eor #$FF
sta <argtyp
sta <r1
sta <r1
ldx <r0
ldx <r0
Line 981: Line 1,221:
; Set the zero flag for condition true, clear otherwise
; Set the zero flag for condition true, clear otherwise
; <byth and A store the value to store to memory
; <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
; [2] LESS? int1,int2 /PRED
Line 995: Line 1,280:
adc #0 ; convert carry flag clear to zero flag set
adc #0 ; convert carry flag clear to zero flag set
jmp branch
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
; [3] GRTR? int1,int2 /PRED
Line 1,011: Line 1,311:


; [6] IN? obj1,obj2 /PRED
; [6] IN? obj1,obj2 /PRED
z_in lda #low(xobject+4)
z_in object_address <op0l,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
jsr mgetb
cmp <op1l
cmp <op1l
Line 1,057: Line 1,343:
and <op1l
and <op1l
jsr tostore
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
jmp nxtinst


Line 1,066: Line 1,377:
lda <op0l
lda <op0l
jsr dostore
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
jmp nxtinst


Line 1,126: Line 1,492:


; [129] NEXT? obj /VAL/PRED
; [129] NEXT? obj /VAL/PRED
z_next lda #low(xobject+5)
z_next object_address <op0l,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 mgetb
jsr tostore
jsr tostore
clc
tax
sbc #0 ; make the zero flag *clear* if zero
php
pla
and #$02 ; now zero flag is toggled
jmp branch
jmp branch


; [130] FIRST? obj /VAL/PRED
; [130] FIRST? obj /VAL/PRED
z_first lda #low(xobject+6)
z_first object_address <op0l,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 mgetb
jsr tostore
jsr tostore
clc
tax
sbc #0
php
pla
and #$02 ; now zero flag is toggled
jmp branch
jmp branch


; [131] LOC obj /VAL
; [131] LOC obj /VAL
z_loc lda #low(xobject+4)
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
sta <corel
lda #high(xobject+4)
lda <op0h
sta <coreh
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 mgetb
lsr a
lsr a
lsr a
lsr a
lsr a
sec
adc #0
jsr tostore
jsr tostore
jmp nxtinst
jmp nxtinst
Line 1,218: Line 1,562:
z_prntd lda <op0l
z_prntd lda <op0l
jsr ptad
jsr ptad
inc <coreh
inc <corel ; skip length byte
bne z1prntb
bne z1prntb
inc <corel
inc <coreh ; going past 64K is not allowed
bne z1prntb
bne z1prntb
; keep with next
; keep with next
Line 1,229: Line 1,573:
lda <op0h
lda <op0h
sta <coreh
sta <coreh
z1prntb ;TODO
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
; [139] RETURN value
Line 1,241: Line 1,604:
jmp jumppc
jmp jumppc


; [142] VALUE var /VAL
; [141] PRINT str
z_value lda <op0l
z_print lda <pcl
jsr fetch
pha
z1value jsr tostore
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
jmp nxtinst
; keep with next


; [143] BCOM int /VAL
; [143] BCOM int /VAL
Line 1,257: Line 1,638:
jmp nxtinst
jmp nxtinst


; [224] CALL fcn[,any1][,any2][,any3] /VAL
; [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
z_call lda #0
cmp <op0l
cmp <op0l
Line 1,272: Line 1,660:
sta $600,x
sta $600,x
lda <dstkcnt
lda <dstkcnt
sta <r2 ; remember bottom of local stack frame
sta $700,x
sta $700,x
inc <cstkcnt
inc <cstkcnt
Line 1,282: Line 1,671:
rol <pcm
rol <pcm
rol <pch
rol <pch
;TODO
; 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)
; [179] PRINTR (str)
Line 1,314: Line 1,739:
; [182] RESTORE /PRED
; [182] RESTORE /PRED
z_rstor = z_save
z_rstor = z_save
; [183] RESTART
z_rest = reset


; [184] RSTACK
; [184] RSTACK
Line 1,332: Line 1,760:
z_fstac dec <dstkcnt
z_fstac dec <dstkcnt
jmp nxtinst
jmp nxtinst
; [186] QUIT
z_quit jmp z_quit ; just wait forever for the player to push RESET


; [225] PUT table,item,data
; [225] PUT table,item,data
Line 1,370: Line 1,801:
z1prntc bankcall putchar
z1prntc bankcall putchar
jmp nxtinst
jmp nxtinst
; [230] PRINTN int
z_prntn bankjump printn


; [232] PUSH value
; [232] PUSH value

Revision as of 06:14, 7 December 2013

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        X
GETPT       X
NEXTP       X
ADD         OK
SUB         OK
MUL         X
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      X
CALL        OK
PUT         OK
PUTB        OK
PUTP        X
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
nr0	ds 1 ; Temporary registers for NMI routine
nr1	ds 1
nr2	ds 1
nr3	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
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
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
	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

	; 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 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
	ldy <byth
	sty $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
	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

	; 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

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

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

	; [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 #$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"