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

From NESdev Wiki
Jump to navigationJump to search
No edit summary
No edit summary
 
(7 intermediate revisions by the same user not shown)
Line 5: Line 5:
The assembler in use is Unofficial MagicKit (a modified version of NESASM).
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.
This program is being written by [[User:Zzo38]], and is using the Famicom keyboard. It is not yet complete (and likely contains errors).


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.
__TOC__


Unlike many Z-machine interpreters, this one supports permanent shifts even in version 3.
== Main file ==
<pre>
; Famizork II
; Public domain


  <b>Opcode</b>    <b>Status</b>
debug = 1 ; change this to 1 to enable breakpoints 0 to disable
EQUAL?      OK
    ; set a breakpoint on opcode $1A in the debugger
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)


<!-- Please do not enable syntax highlighting for this program. -->
inesmap 380 ; Famizork II mapper
-----
ineschr 1 ; 8K CHR ROM
inesmir 3 ; horizontal arrangement with battery


<pre>
; Zero-page variables:
; Z-machine interpreter (Z-code versions 1 to 3) for Famicom
;  $02 = data stack pointer
; version 0.0
;  $03 = call stack pointer
; Public domain
;  $04 = temporary
;  $05 = temporary
;  $06 = temporary
;  $07 = temporary
;  $09 = current temporary shift state
;  $0A = current permanent shift state
;  $0B = saved permanent shift state
;  $0D = number of locals
;  $0E = bit16 of program counter
;  $10 = bit7-bit0 of program counter
;  $11 = low byte of first operand
;  $12 = low byte of second operand
;  $13 = low byte of third operand
;  $14 = low byte of fourth operand
;  $15 = temporary
;  $16 = low byte of text address if inside fword
;  $17 = low byte of packed word
;  $18 = temporary
;  $19 = low byte of packed word if inside fword
;  $20 = bit15-bit8 of program counter
;  $21 = high byte of first operand
;  $22 = high byte of second operand
;  $23 = high byte of third operand
;  $24 = high byte of fourth operand
;  $25 = temporary
;  $26 = high byte of text address if inside fword
;  $27 = high byte of packed word
;  $28 = temporary
;  $29 = high byte of packed word if inside fword
;  $30 = output buffer pointer
;  $31 = low byte of nametable address of cursor
;  $32 = high byte of nametable address of cursor
;  $33 = Y scroll amount
;  $34 = lines to output before <MORE>
;   $35 = saved high byte of return address for text unpacking
;  $36 = bit16 of current text address
;  $37 = bit16 of current text address if inside fword
;  $38-$39 = return address for text unpacking
;  $3A = current background color
;  $3B = current foreground color
;  $3C = remember if battery RAM is present (255=yes 0=no)
;  $3D = ARCFOUR "i" register
;  $3E = ARCFOUR "j" register
;  $40-$4F = low byte of locals
;   $50-$5F = high byte of locals
;   $E2-$FF = output buffer


inesmap 5 ; MMC5 or "User:Zzo38/Mapper D"
code
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:
datasp = $02
;  zver: Z-machine version number.
callsp = $03
;  bytswap: Defined for small endian, undefined for big endian
locall = $40
;  endlod: Beginning of non-preloaded code (this program extends core to 64K for simplicity)
localh = $50
;  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
dstackl = $200
xglobal = global-32 ; Offset for global variables
dstackh = $300
xvocab = vocab+sibcnt+4 ; Actual start of vocab


; Low RAM usage:
cstackl = $400
;  $0xx = Miscellaneous variables
cstackm = $480
;  $1xx = 6502 stack
cstackh = $500 ; bit4-bit1=number of locals, bit0=bit16 of PC
;   $2xx = Bits 7:0 of Z-machine data stack
cstackx = $580 ; data stack pointer
;  $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
arcfour = $600 ; use for random number generator
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
bank intbank+0,"Interpreter"
rombank = $5115 ; 1xxx xxx0
bank intbank+1,"Interpreter"
bank intbank+2,"Interpreter"
bank intbank+3,"Interpreter"


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


; Mapping RAM address:
macro breakpoint
;  Bank = A>>13
if debug
;  Address = (A&$1FFF)|$6000
db $1A ; unofficial NOP
endif
endm


macro romsel
macro breakpoint2
lda #128|bank(\1)&254
if debug
sta rombank
db $3A ; unofficial NOP
endmac
endif
endm


macro bankcall
macro make_digit_table
ldy #128|bank(\1)&254
macset 4,4,0
sty rombank
macgoto make_digit_table_0
jsr \1
endm
endmac


macro bankjump
macro make_digit_table_0
ldy #128|bank(\1)&254
db ((\4*\2)/\1)%10
sty rombank
macset 4,4,\4+1
jmp \1
macset 5,4,\4=\3
endmac
macgoto make_digit_table_\5
endm


code
macro make_digit_table_1
; Empty macro
endm


bank 16
globodd = global&1
org $8000


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


; Keyboard decoding table (lowercase is necessary)
macro make_global_table_0
kbdt db "][", 13, 0, 0, 92, 15, 0
db \1(global+\2+\2-32)
db ";:@", 0, "^-/_"
macset 2,4,\2+1
db "klo", 0, "0p,."
macset 3,4,\2=256
db "jui", 0, "89nm"
macgoto make_global_table_\3
db "hgy", 0, "67vb"
endm
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
macro make_global_table_1
sendout inc <outrdy
; Empty macro
;TODO
endm
lda #0
sta <bufptr
pla
rti


; Send a line feed
macro make_object_table
sendlf inc <linrdy
macset 2,4,0
lda #1
macgoto make_object_table_0
sta <cursx
endm
;TODO
pla
rti


; Ready the output buffer for dumping to the screen
macro make_object_table_0
; And then, wait for the NMI routine to clear it
db \1(object+(\2*9)+62-9)
outdump dec <outrdy
macset 2,4,\2+1
outdum1 bit <outrdy
macset 3,4,\2=256
bvs outdum1
macgoto make_object_table_\3
outdum2 rts
endm


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


; Print a character
instadl ds 256
putchar cmp #0
instadh ds 256
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
globadl ds 16
cpx #31
make_global_table low
bcs lfdump
globadh ds 16
bcc putcha1
make_global_table high


; Print a signed 16-bit integer (<op0h,<op0l), then nxtinst
objadl make_object_table low
printn lda <op0h
objadh make_object_table high
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
multabl ds 256 ; x*x/4
digpair tay
multabh ds 512 ; x*x/1024
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
digit0l make_digit_table 1,1,256
putzch and #$1F
digit1l make_digit_table 10,1,256
tay
digit2l make_digit_table 100,1,256
ora <tshift
digit0h make_digit_table 1,256,128
tax
digit1h make_digit_table 10,256,128
lda #$BF
digit2h make_digit_table 100,256,128
pha
digit3h make_digit_table 1000,256,128
lda zchlut,x
pha
rts


bank 17
bit1tab db  0,  1,  3,  3,  7,  7,  7,  7, 15, 15, 15, 15, 15, 15, 15, 15
db  31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31
db  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63
db  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63
db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255


; Myriads of 256 times value (up to 128 only)
zchad ds 256
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
ptsizt db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
org $B900
db 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
mod100 db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
db 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39
db 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
db 40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59
db 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5
db 60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79
db 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
db 80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99
db 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
db 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
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
flagad if smalend
org $BA00
db 1,1,1,1,1,1,1,1
ot256 db 0,56,12,68,24,80,36,92,48,4,60,16,72,28,84,40,96,52,8,64;
db 0,0,0,0,0,0,0,0
db 20,76,32,88,44,0,56,12,68,24,80,36,92,48,4,60,16,72,28,84;
db 3,3,3,3,3,3,3,3
db 40,96,52,8,64,20,76,32,88,44,0,56,12,68,24,80,36,92,48,4;
db 2,2,2,2,2,2,2,2
db 60,16,72,28,84,40,96,52,8,64,20,76,32,88,44,0,56,12,68,24;
else
db 80,36,92,48,4,60,16,72,28,84,40,96,52,8,64,20,76,32,88,44;
db 0,0,0,0,0,0,0,0
db 0,56,12,68,24,80,36,92,48,4,60,16,72,28,84,40,96,52,8,64;
db 1,1,1,1,1,1,1,1
db 20,76,32,88,44,0,56,12,68,24,80,36,92,48,4,60,16,72,28,84;
db 2,2,2,2,2,2,2,2
db 40,96,52,8,64,20,76,32,88,44,0,56,12,68,24,80,36,92,48,4;
db 3,3,3,3,3,3,3,3
db 60,16,72,28,84,40,96,52,8,64,20,76,32,88,44,0,56,12,68,24;
endif
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
fwordsl = *-32
org $BB00
ds 96
ht256 db 0,2,5,7,10,12,15,17,20,23,25,28,30,33,35,38,40,43,46,48;
fwordsh = *-32
db 51,53,56,58,61,64,66,69,71,74,76,79,81,84,87,89,92,94,97,99;
ds 96
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
flagbit db 128,64,32,16,8,4,2,1
org $BC00
db 128,64,32,16,8,4,2,1
divten db 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1
db 128,64,32,16,8,4,2,1
db 2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3
db 128,64,32,16,8,4,2,1
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
flagbic db 127,191,223,239,247,251,253,254
org $BD00
db 127,191,223,239,247,251,253,254
modten db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
db 127,191,223,239,247,251,253,254
db 0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9
db 127,191,223,239,247,251,253,254
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
digit4h make_digit_table 10000,256,128
org $BE00


zchlut ;     0    1    2    3    4    5    6    7    8    9  10  11  12  13  14  15
; Z-character-decoding assigning macro
;    16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
macro def_zchars
if zver=1
if \#=1
db zza2,zza2,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
macset 2,4,\1
db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
else
db zza2,zza2,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
macset 2,4,\2
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
endif
if zver=2
macset 1,4,\1
db zza2,zzfw,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
macset 3,4,*
db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
macset 4,4,?B
db zza2,zzfw,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
bank bank(zchad)
db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1
macgoto def_zchars_0
db zza2,zzfw,zzt0,zzt1,zzp0,zzp1,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
endm
db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2
 
macro def_zchars_0
macset 5,4,\1=\2
org zchad+\1
db low(\3-1)
if \3<$FE01
fail "Z-character routine out of range"
endif
endif
if zver=3
if \3>$FF00
db zza2,zzfw,zzfw,zzfw,zzt1,zzt2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0
fail "Z-character routine out of range"
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
endif
db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE
macset 1,4,\1+1
db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE
macgoto def_zchars_\5
db zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle ;LOW ESCAPE
endm
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
macro def_zchars_1
db zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs ;FWORDS
bank \4
org \3
endm


; Subroutines for dealing with specific Z-characters below
; Instruction assigning macro
org $BF01
macro def_inst
macset 2,4,*
macset 3,4,?B
bank bank(instadl)
org instadl+(\1)
db low(\2-1)
org instadh+(\1)
db high(\2-1)
bank \3
org \2
endm


; Alphabet row 0 and 1 [11]
macro def_inst_2op
zzal = *-1
def_inst (\1)+$00
lda <pshift
def_inst (\1)+$20
sta <tshift
def_inst (\1)+$40
tya
def_inst (\1)+$60
clc
def_inst (\1)+$C0
adc #59
endm
jmp putcha0


; Alphabet row 2 (and spaces and carriage return) [10]
macro def_inst_2op_eq
zza2 = *-1
def_inst (\1)+$00
lda <pshift
def_inst (\1)+$20
sta <tshift
def_inst (\1)+$40
lda alpha2,y
def_inst (\1)+$60
jmp putchar
endm


; Escape character [5]
macro def_inst_1op
zzes = *-1
def_inst (\1)+$00
lda #$60
def_inst (\1)+$10
sta <tshift
def_inst (\1)+$20
rts
endm


; High escape [17]
macro def_inst_0op
zzhe = *-1
def_inst (\1)+$00
sty <chroff
endm
asl <chroff
asl <chroff
asl <chroff
asl <chroff
asl <chroff
lda #$80
sta <tshift
rts


; Low escape [10]
macro def_inst_ext
zzle = *-1
def_inst (\1)+$00
lda <pshift
endm
sta <tshift
tya
ora <chroff
jmp putchar


; Temporary shift to row 0 [5]
; Fetch next byte of program
zzt0 = *-1
; Doesn't affect carry flag and overflow flag
lda #$00
macro fetch_pc
sta <tshift
inc $1010
rts
bne n\@
inc $1020
if large
bne n\@
inc <$0E
n\@ ld\1 <$0E
\2 $5803,\1
else
n\@ \2 $5803
endif
endm
; (Bytes of above: 17)
; (Cycles of above: 16 or 25 or 27)


; Temporary shift to row 1 [5]
; Initialization code
zzt1 = *-1
reset ldx #0
lda #$20
stx $2000
sta <tshift
stx $2001
rts
; Wait for frame
bit $2002
vwait1 bit $2002
bpl vwait1
txa
stx <$0E ; bit16 of program counter
stx <$0D ; number of locals
stx <$33 ; Y scroll amount
stx <$3C ; battery flag
dex
stx <$03 ; call stack pointer
ldy #27
sty <$34 ; lines before <MORE>
ldy #$0F
sty <$3A ; background
ldy #$20
sty <$3B ; foreground
ldy #low(start-1)
sty <$10
ldy #$E2
sty <$30 ; output buffer pointer
ldy #$61
sty <$31 ; low byte of cursor nametable address
ldy #$27
sty <$32 ; high byte of cursor nametable address
; Wait for frame
bit $2002
vwait2 bit $2002
bpl vwait2
; Clear the screen
tax
lda #32
sta $2006
ldx #9
stx $2006
reset1 sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
inx
bne reset1
; Initialize palette
lda #$FF
sta $2006
stx $2006
lda <$3A
sta $2007
sta $2007
ldy <$3B
sty $2007
sty $2007
sta $2007
sta $2007
sty $2007
sty $2007
sta $2007
sta $2007
sty $2007
sty $2007
sta $2007
sta $2007
sty $2007
sty $2007
; Check if F8 is pushed (erases save data)
ldx #5
stx $4016
dex
stx $4016
lda $4017
and #2
beq reset2
; Check battery
ldx #0
stx $1011
stx $1021
lda $5800
cmp #69
bne reset2
inc $1011
lda $5800
cmp #105
beq reset3
; No save file exists; try to create one
reset2 stx $1011
lda #69
sta $5800
inc $1011
lda #105
sta $5800
inc $1011
stx $5800
lda #$FF
sta $1022
; Initialize ARCFOUR table
reset2a txa
sta arcfour,x
sta $1012
sta $5800
inx
bne reset2a
; Copy header from ROM into RAM
stx $1021
reset2b stx $1011
lda $5805
sta $5803
inx
bne reset2b
; Copy ROM starting from PURBOT into RAM
lda #high(purbot)
sta $1021
lda #low(purbot)
sta $1011
reset2c lda $5805
sta $5803
inc $1011
bne reset2c
inc $1021
if large=0
if maxaddr<$FF00
lda <$21
cmp #high(maxaddr)+1
endif
endif
bne reset2c
; Check if save file still exists
stx $1011
stx $1021
lda $5800
cmp #69
bne zrest
inc $1011
lda $5800
cmp #105
beq reset3
jmp zrest
; Battery is OK
reset3 lda #255
sta <$3C
; Load and permute saved ARCFOUR table
sta $1021
ldy #0
reset3a sty $1011
lax $5800
sta arcfour,y
inx
stx $5800
iny
bne reset3a
; fall through


; Temporary shift to row 2 [5]
; *** RESTART
zzt2 = *-1
def_inst_0op 183
lda #$40
zrest ldx #0
sta <tshift
stx <$0E ; bit16 of program counter
rts
stx <$0D ; number of locals
stx $1021
dex
stx <$03 ; call stack pointer
; Load data from 64 to PURBOT from ROM into RAM
lda #64
sta $1011
zrest1 lda $5805
sta $5803
inc $1011
bne zrest1
inc $1021
if purbot<$FF00
lda <$21
cmp #high(purbot)+1
endif
bne zrest1
; Initialize program counter
lda #low(start-1)
sta <$10
lda #high(start-1)
sta $1020
jmp zcrlf


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


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


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


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


; Print fwords [63]
; Decode the next instruction
zzfs = *-1
; For EXT instructions, number of operands is in the X register
tya
nxtinst fetch_pc y,ldx
ora <chroff
lda instadh,x
sta <idxl
lda #0
sta <idxh
lda #low(fwords-64)
sta <corel
lda #high(fwords-64)
sta <coreh
lda <pshift
pha
pha
lda <pch
lda instadl,x
pha
pha
lda <pcm
txa
pha
bmi not2op
lda <pcl
 
pha
; It is 2OP
jsr mget
ldx #0
asl a
asl a
sta <pcl
sta <4
lda <byth
arr #$C0
rol a
fetch_pc y,lda
sta <pcm
bcc is2op1
lda #0
jsr varop0
rol a
fetch_pc y,lda
sta <pch
bvc is2op2
jsr putstr
jmp is2op3
pla
is2op1 stx <$21
sta <pcl
sta <$11
pla
bit <4
sta <pcm
fetch_pc y,lda
pla
bvc is2op3
sta <pch
is2op2 inx
pla
jmp varop0
sta <pshift
is2op3 stx <$22
sta <tshift
sta <$12
rts
rts


bank 18
; It isn't 2OP
org $8000
not2op cmp #192
bcc notext


; More reset initialization codes
; It is EXT
reset1 bit $2002
fetch_pc y,lda
vblw1 bit $2002
ldx #0
bpl vblw1
isext0 sec
dex
rol a
inx
bcs isext1
vblw2 bit $2002
bmi isext3
bpl vblw2
lda #0
sta <mapad+1
sta <outrdy
;TODO


; Instruction decoding table
; Long immediate
opccnt = 236
sta <4
 
fetch_pc y,lda
macro opcode
if smalend
org opctab+(\1)
sta <$11,x
db high((\2)-1) ; Subtracting 1 so that RTS trick will be used
else
org opctab+(\1)+opccnt
sta <$21,x
db low((\2)-1)
if (\1)<$20
opcode (\1)+$20, \2
opcode (\1)+$40, \2
opcode (\1)+$60, \2
opcode (\1)+$C0, \2
endif
endif
if ((\1)>$7F)&((\1)<$90)
fetch_pc y,lda
opcode (\1)+$10, \2
if smalend
opcode (\1)+$20, \2
sta <$21,x
else
sta <$11,x
endif
endif
endmac
inx
lda <4
sec
rol a
jmp isext0


opctab ds opccnt*2
; Variable or no more operands
opcode 1, z_equal
isext1 bpl isext2
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
; No more operands
org $C000
rts


; Macro for object address (35 bytes)
; Variable
macro object_address
isext2 sta <4
lda #low(xobject+\2)
jsr varop
sta <corel
inx
lda #high(xobject+\2)
lda <4
sta <coreh
sec
rol a
jmp isext0
 
; Short immediate
isext3 sta <4
lda #0
lda #0
sta <idxh
sta <$21,x
sta <byth
fetch_pc y,lda
lda \1
sta <$11,x
inx
lda <4
sec
rol a
jmp isext0
 
; It isn't EXT; it is 1OP or 0OP
notext asl a
asl a
asl a
rol <idxh
asl a
asl a
rol <idxh
bcs notext1
asl a
bpl notext2
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
; 1OP - short immediate
putstr lda #0
fetch_pc y,lda
sta <pshift
ldx #0
sta <tshift
stx <$21
putstr1 jsr pcgetw
sta <$11
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
rts


; Read a word from instruction pointer
notext1 bmi notext3
pcgetw jsr pcgetb
 
sta <byth
; 1OP - variable
; falls through
ldx #0
jmp varop
 
; 1OP - long immediate
notext2 fetch_pc y,lda
if smalend
sta <$11,x
else
sta <$21,x
endif
fetch_pc y,lda
if smalend
sta <$21,x
else
sta <$11,x
endif
; fall through
 
; 0OP
notext3 rts
 
zcall0 jmp val8


; Read a byte from instruction pointer, write to A
; *** CALL
; (clobbers X, Y, and flags)
def_inst_ext 224
pcgetb ldy <pcl ; To use later
stx <4
lda <pch
lax <$11
bne pcgetbh ; In high memory; it is greater than 64K
ora <$21
; It is in core memory (always 64K in this program)
beq zcall0 ; calling function zero
lax <pcm
; Save to call stack
and #$1F
inc <callsp
ora #$60
ldy <callsp
sta <mapad
lda <$10
stx <$10
sta cstackl,y
lda <$20
sta cstackm,y
lsr <$0E
lax <$0D
rol a
sta cstackh,y
lda <datasp
sta cstackx,y
; Save locals
txa
txa
lsr a
beq zcall2
lsr a
clc
lsr a
adc <datasp
lsr a
tay
lsr a
zcall1 lda <locall,x
sta rambank
sta dstackl,y
lda [mapad],y
lda <localh,x
jmp pcinc
sta dstackh,y
pcgetbh ; 0000 0001 xxyy yyyy zzzz zzzz -> bank=1000 1xx0, mem=10yy yyyy
dey
lax <pcm
dex
and #$3F
bne zcall1
ora #$80
lda <$0D
sta <mapad
adc <datasp
txa
sta <datasp
lsr a
; Read function header (number of locals)
lsr a
zcall2 asl $1010
lsr a
lda <$21
lsr a
rol a
lsr a
sta $1020
and #$06
rol <$0E
ora #$88
ldy <$0E
sta romback
lda $5803,y
lda [mapad],y
sta <$0D
pcinc inc <pcl
; Load initial values of locals
bne pcirts
beq zcall4
inc <pcm
; Load arguments
bne pcirts
ldx <4
inc <pch
dex
pcirts rts
beq zcall3
 
lda <$12
; Deal with reading a register (as VALUE)
sta <$41
; Register in A, result in <byth and A
lda <$22
fetch cmp #16
sta <$51
bcc fetch1
cpx #1
; Global variables
beq zcall2a
sta <idxl
lda <$13
sta <$42
lda <$23
sta <$52
cpx #2
beq zcall2a
lda <$14
sta <$43
lda <$24
sta <$53
zcall2a txa
asl a ; now clears carry flag
adc <$10
sta <$10
lda #0
lda #0
sta <idxh
adc <$20
lda #low(xglobal)
sta $1020
sta <corel
if large
lda #high(xglobal)
bcc zcall3
sta <coreh
inc <$0E
jmp mget
endif
fetch1 cmp #0
; Load default values
bne fetch3
zcall3 fetch_pc y,lda
ldx <dstkcnt
if smalend
bne fetch2
sta <locall+1,x
fetch3 ; Local variables
else
ldx <cstkcnt
sta <localh+1,x
ldy $6FF,x
endif
sty <r3
fetch_pc y,lda
adc <r3 ; Carry flag is already cleared
if smalend
tax
sta <localh+1,x
fetch2 lda $1FF,x
else
sta <byth
sta <locall+1,x
lda $2FF,x
endif
rts
inx
cpx <$0D
bne zcall3
zcall4 jmp nxtinst


; Deal with store (uses A and <byth as value; instruction as dest)
; *** RFALSE
; The value A will remain there once stored
def_inst_0op 177
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
lda #0
sta <idxh
; fall through
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
; Return a 8-bit value (from A)
; <corel=low addr, <coreh=high addr
ret8 pha
; <idxl=low index, <idxh=high index
ldy <callsp
; A=low data, <byth=high data
dec <callsp
mget asl <idxl
lda cstackx,y
rol <idxh
sta <datasp
jsr mgetb
lda cstackl,y
sta <byth
sta <$10
inc <idxl
lda cstackm,y
bne mgetb
sta $1020
inc <idxh
lda cstackh,y
mgetb lda <coreh
lsr a
clc
sta <$0D
adc <idxh
tax
tax
and #$1F
rol a
ora #$60
anc #1
sta <mapad
sta <$0E
; Restore locals
txa
txa
lsr a
beq ret8b
lsr a
adc <datasp
lsr a
tay
lsr a
ret8a lda dstackl,y
lsr a
sta <locall,x
sta rambank
lda dstackh,y
ldy <corel
sta <localh,x
clc
dey
adc <idxl
dex
lda [mapad],y
bne ret8a
rts
ret8b pla
; fall through


; Implment PUT/PUTB
; Value of instruction is 8-bits (from A)
; <corel=low addr, <coreh=high addr
val8 fetch_pc y,ldx
; <idxl=low index, <idxh=high index
bne val8a
; A=low data, <byth=high data
; Push to stack
mput pha
inc <datasp
mput1 asl <idxl
ldy <datasp
rol <idxh
sta dstackl,y
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
txa
lsr a
sta dstackh,y
lsr a
jmp nxtinst
lsr a
val8a cpx #16
lsr a
bcs val8b
lsr a
; Local variable
sta rambank
sta <locall,x
ldy <corel
lda #0
clc
sta <localh,x
adc <idxl
jmp nxtinst
pla
; Global variable
sta [mapad],y
val8b ldy globadl,x
sty $1014
ldy globadh,x
sty $1024
if smalend
sta $5801
else
ldy #0
sty $5801
endif
inc $1014
if globodd
bne val8c
inc $1024
endif
val8c if smalend
lda #0
endif
sta $5801
lda $1020
jmp nxtinst
 
; Read the variable using as an instruction operand
; X is operand number (0-3)
varop fetch_pc y,lda
varop0 bne varop1
; Pop from stack
ldy <datasp
dec <datasp
lda dstackl,y
sta <$11,x
lda dstackh,y
sta <$21,x
rts
varop1 cmp #16
bcs varop2
; Local variable
tay
lda locall,y
sta <$11,x
lda localh,y
sta <$21,x
rts
rts
 
; Global variable
; Figure out property table address of object A
varop2 tay
; Store ressults to <coreh and <corel
lda globadl,y
ptad sta <mapad
sta $1015
object_address <mapad,7
lda globadh,y
; Get high octet
sta $1025
jsr mgetb
lda $5801
pha
if smalend
; Increment object header address
sta <$11,x
inc <corel
else
if low(xobject+7)=255
sta <$21,x
inc <coreh
endif
inc $1015
if globodd
bne varop3
inc $1025
endif
varop3 lda $5801
if smalend
sta <$21,x
else
sta <$11,x
endif
endif
; Get low octet
lda $1020
jsr mgetb
; Store the results
sta <corel
pla
sta <coreh
rts
rts


; Flag address (<op0l is object, <op1l is flag, A is bit)
; *** RSTACK
flad object_address <op0l,0
def_inst_0op 184
lda <op1l
ldx <datasp
pha
lda dstackl,x
sta <$14
lda dstackh,x
jmp ret16
 
; *** RETURN
def_inst_1op 139
lda <$11
sta <$14
lda <$21
ret16 sta <$24
ldy <callsp
dec <callsp
lda cstackx,y
sta <datasp
lda cstackl,y
sta <$10
lda cstackm,y
sta $1020
lda cstackh,y
lsr a
lsr a
lsr a
sta <$0D
lsr a
sta <r0
lda <idxl
clc
adc <r0
sta <idxl
lda <idxh
adc #0
sta <idxh
pla
and #$07
beq flad2
tax
tax
lda #$80
rol a
flad1 lsr a
anc #1
sta <$0E
; Restore locals
txa
beq ret16b
adc <datasp
tay
ret16a lda dstackl,y
sta <locall,x
lda dstackh,y
sta <localh,x
dey
dex
dex
bne flad1
bne ret16a
flad2 rts
ret16b ; fall through


; Remove object (<op0l) from its current location
; Value of instruction is 16-bits (from $x4)
remobj object_address <op0l,4 ; obj.LOC
val16 lda <$14
jsr mgetb
fetch_pc y,ldx
beq flad2 ; rts if object is in nowhere
bne val16a
sta <r0
; Push to stack
; Remember and clear obj.NEXT
inc <datasp
inc <corel
ldy <datasp
if low(xobject+4)=255
sta dstackl,y
inc <coreh
lda <$24
sta dstackh,y
jmp nxtinst
val16a cpx #16
bcs val16b
; Local variable
sta <locall,x
lda <$24
sta <localh,x
jmp nxtinst
; Global variable
val16b ldy globadl,x
sty $1015
ldy globadh,x
sty $1025
if smalend
sta $5801
else
ldy <$24
sty $5801
endif
inc $1015
if globodd
bne val16c
inc $1025
endif
val16c if smalend
lda <$24
endif
endif
jsr mgetb
sta $5801
sta <r1
lda $1020
lda #0
jmp nxtinst
jsr mputb
 
; Is it the FIRST object?
; *** RTRUE
object_address <r0,6 ; obj.LOC.FIRST
def_inst_0op 176
jsr mgetb
lda #1
cmp <op0l
jmp ret8
bne remobj1
 
; Yes! Set its new FIRST to the old NEXT of the removed object.
; *** EQUAL? (EXT)
lda <r1
def_inst_ext 193
jmp mputb
lda <$11
; No! Where is it in the chain?
ldy <$21
remobj1 object_address <r1,5 ; r1.NEXT
cmp <$12
sta <r1
bne zequal1
cmp <op0l
cpy <$22
bne remobj1
beq tpredic
; Found it
zequal1 cpx #2
lda <idxl
beq fpredic
pha
cmp <$13
lda <idxh
bne zequal2
pha
cpy <$23
object_address <r1,5
beq tpredic
jsr mgetb
zequal2 cpx #3
beq fpredic
cmp <$14
bne fpredic
cmp <$24
beq tpredic
jmp fpredic
 
; *** GRTR?
def_inst_2op 3
lda <$12
cmp <$11
lda <$22
sbc <$21
bvc zgrtr1
and #128
jmp predic1
zgrtr1 bmi tpredic
jmp fpredic
 
; *** LESS?
def_inst_2op 2
lda <$11
cmp <$12
lda <$21
sbc <$22
bvc zgrtr1
and #128
jmp predic1
 
; *** EQUAL? (2OP)
def_inst_2op_eq 1
lda <$11
eor <$21
bne fpredic
lda <$12
eor <$22
beq predic1
jmp fpredic
 
; *** ZERO?
def_inst_1op 128
lda <$11
ora <$21
beq tpredic
; falls through
 
; Predicate handling
fpredic lda #128
jmp predic1
tpredic lda #0
predic1 fetch_pc x,eor
tax
tax
pla
arr #$C0
sta <idxh
bcs predic8
pla
 
sta <idxl
; If it should branch
txa
txa
jmp mputb
bvs predic3


; Do the relative branching using offset in A and <op0h
; Long offset
; If the value is 0 or 1, it returns instead of jumps
eor #$20
rjumppc ldx <op0h
anc #$3F
bne jumppc
adc #$E0
if large
bpl predic2
dec <$0E
endif
predic2 clc
adc <$20
sta $1020
if large
bcc predick
inc <$0E
endif
predick fetch_pc y,lax
jmp predic4
 
; Short offset
predic3 and #$3F
cmp #2
cmp #2
bcs jumppc
bcc predicq
stx <byth
predic4 sbc #2
jmp return
bcs predic5
if large
ldy <$20
dey
sty $1020
cpy #255
bne predic5
lsr <$0E
else
dec $1020
endif
predic5 sec
adc <$10
sta <$10
bcc predic9
inc $1020
if large
bne predic9
inc <$0E
endif
jmp nxtinst
 
; If should not branch
predic8 bvc predic9
inc <$10
bne predic9
inc $1020
if large
bne predic9
inc <$0E
endif
predic9 jmp nxtinst
 
predicq jmp ret8
 
; *** IGRTR?
def_inst_2op 5
ldx <$11
jsr xvalue
inc <$14
bne zigrtr2
inc <$24
zigrtr1 jsr xstore
lda <$14
cmp <$11
lda <$24
sbc <$21
bvc zigrtr2
and #128
jmp predic1
zigrtr2 bmi zigrtr3
jmp fpredic
zigrtr3 jmp tpredic
 
; *** DLESS?
def_inst_2op 4
ldx <$11
jsr xvalue
ldy <$14
dey
sty <$14
cpy #255
bne zdless1
dec <$24
zdless1 jsr xstore
lda <$11
cmp <$14
lda <$21
sbc <$24
bvc zigrtr2
and #128
jmp predic1


; Same as above but won't check for returns
; *** PTSIZE
; (also, the continuation of the above)
def_inst_1op 132
jumppc sta <r0
lda $1021
lda <op0h
ora #255
eor #$80 ; sign conversion
dcp $1011
sta <r1
bne zptsz1
sec
dec $1021
lda <pcl
zptsz1 ldx $5801
sbc #$03 ; subtract one extra, since...
lda ptsizt,x
sta <pcl
jmp val8
lda <pcm
 
sbc #$80
; *** PUT
sta <pcm
def_inst_ext 225
lda <pch
lda <$12
sbc #$00 ; ...carry flag is now set (due to no borrowing)...
asl a
sta <pch
rol <$22
lda <pcl
clc
adc <r0 ; ...which causes the one extra to be added back
adc <$11
sta <pcl
sta $1011
lda <pcm
lda <$22
adc <r1
adc <$21
sta <pcm
sta $1021
lda <pch
if smalend
adc #$00
lda <$13
sta <pch
else
lda <$23
endif
sta $5801
inc $1011
bne zput1
inc $1021
zput1 ds 0
if smalend
lda <$23
else
lda <$13
endif
sta $5801
bit $1020
jmp nxtinst
jmp nxtinst


; Deal with branch
; *** PUTB
; Condition is true if zero flag is set
def_inst_ext 226
branch php
lda <$12
jsr pcgetb
clc
sta <r0
adc <$11
pla
sta $1011
lsr a
lda <$22
lsr a
adc <$21
ror a
sta $1021
eor <r0
lda <$13
bmi notjump ; condition flag does not match...
sta $5801
bit <r0
bit $1020
bvs branch1
jmp nxtinst


; Long branch
; *** GET
lda <r0
def_inst_2op 15
lda <$12
asl a
asl a
asl a
rol <$22
asl a
clc
php
adc <$11
php
sta $1011
ror a
lda <$22
plp
adc <$21
ror a
sta $1021
plp
lda $5801
ror a
if smalend
sta <op0h
sta <$14
jsr pcgetb
else
jmp rjumppc
sta <$24
endif
inc $1011
bne zget1
inc $1021
zget1 ds 0
lda $5801
if smalend
sta <$24
else
sta <$14
endif
bit $1020
jmp val16
 
; *** GETB
def_inst_2op 16
lda <$12
clc
adc <$11
sta $1011
lda <$22
adc <$21
sta $1021
lda $5801
bit $1020
jmp val8
 
; *** ADD
def_inst_2op 20
clc
lda <$11
adc <$12
sta <$14
lda <$21
adc <$22
sta <$24
jmp val16
 
; *** SUB
def_inst_2op 21
sec
lda <$11
sbc <$12
sta <$14
lda <$21
sbc <$22
sta <$24
jmp val16
 
; *** BAND
def_inst_2op 9
lda <$11
and <$12
sta <$14
lda <$21
and <$22
sta <$24
jmp val16
 
; *** BOR
def_inst_2op 8
lda <$11
ora <$12
sta <$14
lda <$21
ora <$22
sta <$24
jmp val16


; Short branch
; *** BCOM
branch1 lda #0
def_inst_1op 143
sta <op0h
lda <$11
lda <r0
eor #$FF
and #$3F
sta <$14
jmp rjumppc
lda <$21
eor #$FF
sta <$24
jmp val16


; Not branching
; *** BTST
notjump bit <r0
def_inst_2op 7
bvs nxtinst
lda <$11
jsr pcgetb
and <$12
jmp nxtinst
eor <$12
sta <4
lda <$21
and <$22
eor <$22
ora <4
bne zbtst1
jmp predic1
zbtst1 jmp fpredic


; Return from a subroutine
; *** MUL
return dec <dstkcnt
def_inst_2op 22
ldy <dstkcnt
lax <$11
ldx $700,y
clc
stx <cstkcnt
adc <$12
ldx $400,y
bcc zmul1
stx <pcl
eor #255
ldx $500,y
adc #0
stx <pcm
zmul1 tay
ldx $600,y
txa
stx <pch
sec
jsr tostore
sbc <$12
; fall through
bcs zmul2
eor #255
adc #1
sec
zmul2 tax
lda multabl,y
sbc multabl,x
sta <$14
php
lda <$11
clc
adc <$12
tay
bcc zmul3
lda multabh+256,y
jmp zmul4
zmul3 lda multabh,y
zmul4 plp
sbc multabh,x
sta <$24
; low*high
lax <$11
clc
adc <$22
bcc zmul5
eor #255
adc #0
zmul5 tay
txa
sec
sbc <$22
bcs zmul6
eor #255
adc #1
sec
zmul6 tax
lda multabl,y
sbc multabl,x
clc
adc <$24
sta <$24
; high*low
lax <$21
clc
adc <$12
bcc zmul7
eor #255
adc #0
zmul7 tay
txa
sec
sbc <$12
bcs zmul8
eor #255
adc #1
sec
zmul8 tax
lda multabl,y
sbc multabl,x
clc
adc <$24
sta <$24
jmp val16


; Next instruction operation
; *** PUSH
nxtinst jsr pcgetb
def_inst_ext 232
sta <r0
inc <datasp
bit <r0
ldx <datasp
bmi nxtins1
lda <$11
sta dstackl,x
lda <$21
sta dstackh,x
jmp nxtinst


; 2OP form
; *** POP
sta <r1
def_inst_ext 233
lsr <r1
ldx <datasp
asl a
dec <datasp
and #$80
lda dstackl,x
ora <r1
sta <$12
and #$90
lda dstackh,x
ora <r0
sta <$22
eor #$60
ldx <$11
ora #$0F
jsr xstore
bne nxtins3
jmp nxtinst


nxtins1 bvs nxtins2
; *** FSTACK
def_inst_0op 185
dec <datasp
jmp nxtinst


; 1OP or 0OP form
; *** SET
rol a
def_inst_2op 13
rol a
lda <$12
ora #$3F
sta <$14
bne nxtins3
lda <$22
sta <$24
ldx <$11
jsr xstore
jmp nxtinst


; EXT form
; *** VALUE
nxtins2 jsr pcgetb
def_inst_1op 142
ldx <$11
jsr xvalue
jmp val16


; Read operands and call function (using RTS trick)
; *** INC
nxtins3 eor #$FF
def_inst_1op 133
sta <argtyp
ldx <$11
sta <r1
jsr xvalue
ldx <r0
inc <$14
romsel opctab
bne zinc1
lda opctab,x ; high byte of address
inc <$24
pha
zinc1 jsr xstore
lda opctab+opccnt,x ; low byte of address
jmp nxtinst
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
; *** DEC
getopr ldx <r2
def_inst_1op 134
inx
ldx <$11
inx
jsr xvalue
stx <r2
ldy <$14
bit <r1
dey
bvs getopr1 ;bit0=0
sty <$14
bmi getopr2 ;bit1=0
cpy #255
bne zinc1
dec <$24
jsr xstore
jmp nxtinst


; [11] No operand
; Store value from <$x4 into variable labeled X
getopr0 asl <r1
xstore lda <$14
asl <r1
cpx #0
bne xstore1
; Top of stack
ldy <datasp
sta dstackl,y
lda <$24
sta dstackh,y
rts
xstore1 cpx #16
bcs xstore2
; Local variable
sta <locall,x
lda <$24
sta <localh,x
rts
; Global variable
xstore2 ldy globadl,x
sty $1014
ldy globadh,x
sty $1024
if smalend
sta $5801
else
ldy <$24
sty $5801
endif
inc $1014
if globodd
bne xstore3
inc $1024
endif
xstore3 if smalend
lda <$24
endif
sta $5801
lda $1020
rts
rts


getopr1 bmi getopr3 ;bit1=0
; Read from variable labeled X into <$x4
xvalue txa
bne xvalue1
; Top of stack
ldy <datasp
lda dstackl,y
sta <$14
lda dstackh,y
sta <$24
rts
xvalue1 cpx #16
bcs xvalue2
; Local variable
lda <locall,x
sta <$14
lda <localh,x
sta <$24
rts
; Global vaiable
xvalue2 ldy globadl,x
sty $1015
ldy globadh,x
sty $1025
lda $5801
if smalend
sta <$14
else
sta <$24
endif
inc $1015
if globodd
bne xvalue3
inc $1025
endif
xvalue3 lda $5801
if smalend
sta <$24
else
sta <$14
endif
bit $1020
rts


; [10] Variable
; *** IN?
jsr pcgetb
def_inst_2op 6
tay
ldx <$11
jsr fetch
clc
cpy #0 ; popped from stack
lda objadl,x
bne getopr4
adc #4
dec <dstkcnt
sta $5010
jmp getopr4
lda objadh,x
adc #0
sta $5020
lda $5801
bit $1020
eor <$21
bne zin1
jmp predic1
zin1 jmp fpredic


; [01] Short immediate
; *** FSET?
getopr2 jsr pcgetb
def_inst_2op 10
ldx <r2
ldx <$11
sta <0,x
ldy <$12
lda #0
clc
sta <1,x
lda objadl,x
beq getopr0
adc flagad,y
sta $5010
lda objadh,x
adc #0
sta $5020
lda $5801
and flagbit,y
bne zfsetp1
bit $1020
jmp predic1
zfsetp1 jmp fpredic


; [00] Long immediate
; *** FSET
getopr3 jsr pcgetw
def_inst_2op 11
getopr4 ldx <r2
ldx <$11
sta <0,x
ldy <$12
lda <byth
clc
sta <1,x
lda objadl,x
jmp getopr0
adc flagad,y
sta $5010
lda objadh,x
adc #0
sta $5020
lda $5801
ora flagbit,y
sta $5801
bit $1020
jmp nxtinst


; *** FCLEAR
def_inst_2op 12
ldx <$11
ldy <$12
clc
lda objadl,x
adc flagad,y
sta $5010
lda objadh,x
adc #0
sta $5020
lda $5801
and flagbic,y
sta $5801
bit $1020
jmp nxtinst


; ****************************************
; *** LOC
def_inst_1op 131
ldx <$11
clc
lda objadl,x
adc #4
sta $5010
lda objadh,x
adc #0
sta $5020
lda $5801
bit $1020
jmp val8


; Z-code instructions
; *** FIRST?
; Set the zero flag for condition true, clear otherwise
def_inst_1op 130
; <byth and A store the value to store to memory
ldx <$11
clc
lda objadl,x
adc #6
sta $5010
lda objadh,x
adc #0
sta $5020
lda $5801
bit $1020
jmp valp


; [1] EQUAL? data,cmp1[,cmp2][,cmp3] /PRED
; *** NEXT?
z_equal lda <op0l
def_inst_1op 129
cmp <op1l
ldx <$11
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
clc
sbc #0
lda objadl,x
sta <op0l
adc #5
pha
sta $5010
bcs z1dless
lda objadh,x
dec <byth
adc #0
z1dless lda <byth
sta $5020
sta <op0h
lda $5801
lda <op0l
bit $1020
jsr dostore
; fall through
; fall through


; [2] LESS? int1,int2 /PRED
; Value of instruction is 8-bits (from A)
z_less lda <op0h
; Predicate is then if value is nonzero
eor #$80 ; do sign conversion
valp fetch_pc y,ldx
sta <op0h
bne valpa
lda <op1h
; Push to stack
eor #$80
inc <datasp
cmp <op0h
ldy <datasp
bne z1less
sta dstackl,y
lda <op0l
sta <4
cmp <op1l
txa
z1less lda #0
sta dstackh,y
adc #0 ; convert carry flag clear to zero flag set
lda <4
jmp branch
jmp valpd1
valpa cpx #16
bcs valpb
; Local variable
sta <locall,x
ldy #0
sty <localh,x
jmp valpd
; Global variable
valpb ldy globadl,x
sty $1014
ldy globadh,x
sty $1024
if smalend
sta $5801
else
ldy #0
sty $5801
endif
inc $1014
if globodd
bne valpc
inc $1024
endif
valpc if smalend
ldy #0
sty $5801
else
sta $5801
endif
bit $1020
valpd tax
valpd1 beq valpe
jmp fpredic
valpe jmp tpredic
 
; Macro to do one step of ARCFOUR
; Result is stored in accumulator
macro do_arcfour
inc <$3D
ldx <$3D
lda arcfour,x
pha
clc
adc <$3E
sta <$3E
tay
sta arcfour,y
pla
sta arcfour,x
clc
adc arcfour,y
tax
lda arcfour,x
endm


; [5] IGRTR? var,int /PRED
; *** RANDOM
z_dless lda <op0l
def_inst_ext 231
jsr fetch
ldx <$21
beq zrand1
lda bit1tab,x
sta <$23
lda #$FF
jmp zrand2
zrand1 ldx <$11
lda bit1tab,x
zrand2 sta <$13
zrand3 do_arcfour
and <$23
sta <$24
cmp <$21
beq zrand4 ; exactly equal
bcs zrand1 ; try again; out of range
jmp zrand5 ; low byte doesn't need to check
zrand4 do_arcfour
and <$13
cmp <$11
bcs zrand1 ; try again; out of range
adc #1
sta <$14
jmp zrand6
zrand5 do_arcfour
sec
sec
adc #0
adc #0
sta <op0l
sta <$14
pha
zrand6 lda #0
bcc z1dless
adc <$24
inc <byth
sta <$24
z1dless lda <byth
jmp val16
sta <op0h
 
lda <op0l
; *** JUMP
jsr dostore
def_inst_1op 140
; fall through
lda <$11
sec
sbc #2
tax
lda <$21
sbc #0
tay
bpl zjump1
dec <$0E
zjump1 txa
clc
adc <$10
sta <$10
tya
adc <$20
sta $1020
bcc zjump2
inc <$0E
zjump2 jmp nxtinst


; [3] GRTR? int1,int2 /PRED
; Macro to find a property, given object and property number
z_grtr lda <op1h
; Object in <$11, property in <$12, branch to \1 if found
eor #$80 ; do sign conversion
; If \1 is with # at front then assume always will be found
sta <op1h
; X contains property size only in high 3-bits if found
lda <op0h
; X contains property number if not found
eor #$80
; Output is $1014 and $1024 with address of property id
cmp <op1h
macro propfind
bne z1grtr
; Find the property table
lda <op1l
ldx <$11
cmp <op0l
clc
z1grtr lda #0
lda objadl,x
adc #0 ; convert carry flag clear to zero flag set
adc #7
jmp branch
sta $1015
lda objadh,x
adc #0
sta $1025
lda $5801
if smalend
sta <$14
else
sta <$24
endif
inc $1015
bne n\@a
inc $1025
n\@a lda $5801
if smalend
sta $1014
bit $1024
else
sta $1024
bit $1014
endif
; Skip the short description
lda $5801
sec
rol a
bcc n\@d
inc $1024
clc
n\@d adc <$14
sta $1014
bcc n\@b
inc $1024
; Find this property
n\@b lda $5081
if '\<1'!='#'
beq n\@c
endif
eor <$12
tax
and #$1F
if '\<1'='#'
beq n\@c
else
beq \1
endif
lda ptsizt,x
sec
adc <$14
sta $1014
bcc n\@b
inc $1024
jmp n\@b
n\@c ds 0
endm


; [6] IN? obj1,obj2 /PRED
; *** GETPT
z_in object_address <op0l,4
def_inst_2op 18
jsr mgetb
propfind zgetpt1
cmp <op1l
lda $1020
jmp branch
and #0
jmp val8
zgetpt1 lda $1020
inc <$14
bne zgetpt2
inc <$24
zgetpt2 jmp val16


; [7] BTST data,mask /PRED
; *** GETP
z_btst lda <op0h
def_inst_2op 17
and <op1h
propfind zgetp2
eor <op1h
; Use default value
beq z1btst
asl <$11
jmp branch
rol <$21 ;clears carry
z1btst lda <op0l
lda #low(object-2)
and <op1l
adc <$11
eor <op1l
sta $1015
jmp branch
lda #high(object-2)
adc <$21
sta $1025
lda $5801
if smalend
sta <$14
else
sta <$24
endif
inc $1015
if object&1
bne zgetp1
inc $1025
endif
zgetp1 lda $5801
if smalend
sta <$24
else
sta <$14
endif
bit $1020
jmp val16
; Use actual value
zgetp2 inc $1014
bne zgetp3
inc $1024
zgetp3 cpx #$20
bne zgetp5
; Long property
lda $5801
if smalend
sta <$14
else
sta <$24
endif
inc $1014
bne zgetp4
inc $1024
zgetp4 lda $5801
if smalend
sta <$14
else
sta <$24
endif
jmp val16
; Short property
zgetp5 lda $5801
bit $1020
jmp val8


; [8] BOR int1,int2 /VAL
; *** PUTP
z_bor lda <op0h
def_inst_ext 227
ora <op1h
propfind #
sta <byth
inc $1014
lda <op0l
bne zputp2
ora <op1l
inc $1024
jsr tostore
zputp2 cpx #$20
bne zputp4
; Long property
if smalend
lda <$13
else
lda <$23
endif
sta $5801
inc $1014
bne zputp3
inc $1024
zputp3 if smalend
lda <$23
else
lda <$13
endif
sta $5801
lda $1020
jmp nxtinst
; Short property
zputp4 lda <$13
sta $5801
lda $1020
jmp nxtinst
jmp nxtinst


; [9] BAND int1,int2 /VAL
; *** NEXTP
z_band lda <op0h
def_inst_2op 19
and <op1h
ldx <$11
sta <byth
bne znextp4
lda <op0l
; Find first property
and <op1l
clc
jsr tostore
lda objadl,x
adc #7
sta $1015
lda objadh,x
adc #0
sta $1025
lda $5801
if smalend
sta <$14
else
sta <$24
endif
inc $1015
bne znextp1
inc $1025
znextp1 lda $5801
if smalend
sta $1014
bit $1024
else
sta $1024
bit $1014
endif
; Skip the short description
lda $5801
sec
rol a
bcc znextp2
inc $1024
clc
znextp2 adc <$14
sta $1014
bcc znextp3
inc $1024
znextp3 lda $5801
and #$1F
bit $1020
jmp val8
znextp4 propfind #
lda ptsizt,x
sec
adc <$14
sta $1014
bcc znextp5
inc $1024
znextp5 lda $5801
bit $1020
and #$1F
jmp val8
 
; *** REMOVE
def_inst_1op 137
lda #0
sta <$12
; fall through
 
; *** MOVE
def_inst_2op 14
; Find the LOC of first object, see if need to remove
ldx <$11
clc
lda objadl,x
adc #4
sta $1013
lda objadh,x
adc #0
sta $1023
lda $5801
ldy <$12
sty $5801
tay
beq zmove2
; Look at the NEXT slot too
inc $1013
bne zmove1
inc $1023
zmove1 ldy $5801
ldx #0
stx $5801
; Find it in the FIRST-NEXT chain of the parent object
tax
lda objadl,x
adc #6
sta $1014
lda objadh,x
adc #0
sta $1024
lax $5801 ; not adjust carry flag
eor <$11
bne zmove3
; It is the first child object
; Let First(Parent)=Next(Child)
sty $5801
jmp zmove2
; It is not the first child object
zmove3 lda objadl,x
adc #5
sta $1014
lda objadh,x
adc #0
sta $1024
lax $5801
eor <$11
bne zmove3
; It is found
sty $5801
; Now insert the object into the new container (if nonzero)
zmove2 ldx <$12
beq zmove4
lda objadl,x
adc #6
sta $1014
lda objadh,x
adc #0
sta $1024
ldy $5801
stx $5801
bit $1013
bit $1023
sty $5801
zmove4 lda $1020
jmp nxtinst
jmp nxtinst


; [10] FSET? obj,flag /PRED
; Print a space
z_ftst jsr flad
space lda <$30
sta <r0
cmp #$E2
jsr mgetb
bne space1
eor #$FF
lda <$31
and <r0
and #$1F
jmp branch
bne space1
jsr bufout
lda <$31
and #$1F
bne space2
space1 inc <$31
space2 rts
 
; Output and clear the buffer
bufout lda <$31
anc #$1F
adc <$30
bcc bufout0
jsr addlin1
bufout0 ldx #0
lda <$32
ldy <$31
bufout1 bit $2002
bpl bufout1
stx $2001 ; render off
sta $2006
sty $2006
ldx #$E2
cpx <$30
beq bufout3
bufout2 lda <0,x
sta $2007
inx
cpx <$30
bne bufout2
bufout3 tya
anc #$1F
bne bufout4
; Blank the bottom row (just scrolled in)
lda <5
sta $2006
lda <4
sta $2006
lda #32
sta $2007 ;1
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;10
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;20
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;30
bufout4 lda #$F8
sta $2005
ldx <$33
stx $2005
anc #$08
sta $2001
sta $2000
lda <$30
sbc #$E1
clc
adc <$31
sta <$31
lda <$32
adc #0
sta <$32
lda #$E2
sta <$30
bufout5 rts


; [11] FSET obj,flag
; Skip to the next line
z_fset jsr flad
addline sec
sta <r0
addlin1 lda <$33
jsr mgetb
adc #7
ora <r0
sta <$33
jsr mputb
cmp #$F0
jmp nxtinst
bcc addlin2
anc #0
sta <$33
addlin2 lda <$31
and #$E0
adc #$20
sta <$31
lda <$32
adc #0
sta <$32
cmp #$27
bne addlin3
lda <$31
cmp #$C0
bne addlin3
lda #$24
sta <$32
lda #0
sta <$31
; Prepare address to blank out the line
addlin3 lax <$31
clc
adc #$40
sta <4
lda <$32
adc #0
sta <5
cmp #$27
bcc addlin4
cpx #$80
bcc addlin4
lda #$24
sax <4
sta <5
addlin4 dec <$34
bne addlin5
lda #27
sta <$34
jmp more
addlin5 rts


; [12] FCLEAR obj,flag
; Display the <MORE> prompt
z_fclr jsr flad
more ldx #0
lda <$32
ldy <$31
more1 bit $2002
bpl more1
stx $2001 ; render off
sta $2006
sty $2006
lda #'<'
sta $2007
lda #'M'
sta $2007
lda #'O'
sta $2007
lda #'R'
sta $2007
lda #'E'
sta $2007
lda #'>'
sta $2007
; Blank the bottom row (just scrolled in)
lda <5
sta $2006
lda <4
sta $2006
lda #32
sta $2007 ;1
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;10
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;20
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007 ;30
; Re-enable rendering
lda #$F8
sta $2005
ldx <$33
stx $2005
anc #$08
sta $2001
sta $2000
; Wait for keyboard not pushed
more2 ldx #5
stx $4016
dex
ldy #9
more3 stx $4016
lda $4017
ora #$E1
eor #$FF
eor #$FF
sta <r0
bne more2
jsr mgetb
lda #6
and <r0
sta $4016
jsr mputb
lda $4017
jmp nxtinst
ora #$E1
eor #$FF
bne more2
dey
bne more3
; Wait for space-bar pushed
ldx #5
lda #4
ldy #6
more4 stx $4016 ;reset
sta $4016 ;0/0
sty $4016 ;0/1
sta $4016 ;1/0
sty $4016 ;1/1
sta $4016 ;2/0
sty $4016 ;2/1
sta $4016 ;3/0
sty $4016 ;3/1
sta $4016 ;4/0
sty $4016 ;4/1
sta $4016 ;5/0
sty $4016 ;5/1
sta $4016 ;6/0
sty $4016 ;6/1
sta $4016 ;7/0
sty $4016 ;7/1
sta $4016 ;8/0
sty $4016 ;8/1
and $4017
bne more4
; Erase <MORE>
lda #0
sta $2001
lda <$32
sta $2006
lda <$31
sta $2006
lda #32
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
sta $2007
rts


; [13] SET var,value
; *** PRINTC
z_set lda <op1l
def_inst_ext 229
pha
lda <$11
lda <op1h
beq zprntc2
sta <byth
cmp #32
lda <op0l
beq zprntc1
jsr dostore
cmp #13
beq zcrlf
ldx <$30
beq zprntc2
sta <0,x
inc <$30
zprntc1 jmp nxtinst
zprntc2 jsr space
jmp nxtinst
jmp nxtinst


; [137] REMOVE obj
; *** CRLF
z_remov lda #0
def_inst_0op 187
sta <op1l
zcrlf jsr bufout
beq z_move
lda <$31
; keep with next
ora #$1F
sta <$31
zcrlf2 jmp nxtinst


; [14] MOVE object,container
; *** PRINTN
; Clear NEXT of object
def_inst_ext 230
z1move inc <corel
lda <$30
if low(xobject+4)=255
beq zcrlf2 ; ensure there is room in the buffer
inc <coreh
ldy <$11
endif
lax <$21
jsr mputb ; accumulator is already zero
anc #$FF
jmp nxtinst
bcc znum01
; Remove object from its current location
eor #$FF
z_move jsr remobj
sta <4
; Set LOC of object
ldx <$30
object_address <op0l,4
inc <$30
lda <op1l
lda #'-'
jsr mputb
sta <0,x
tax
tya
beq z1move
eor #$FF
; Remember object address
tay
lda <idxl
ldx <4
sta <r0
znum01 lda digit0l,y
lda <idxh
adc digit0h,x
sta <r1
pha
; Get FIRST of container
cmp #10
object_address <op1l,6
lda digit1l,y
jsr mgetb
adc digit1h,x
pha
pha
; Remember container address
cmp #10
lda <idxl
lda digit2l,y
adc digit2h,x
pha
pha
lda <idxh
cmp #10
lda #0
adc digit3h,x
pha
pha
; Set NEXT of object
cmp #10
lda <r0
lda #0
sta <idxl
adc digit4h,x
clc
ldx <$30
sbc #0 ; subtract one so it points to NEXT instead of FIRST
tay ; make the flag according to accumulator
lda <r1
beq znum02
sbc #0
; Five digits
sta <idxh
sta <0,x
pla
sta 1,x
pla
sta 2,x
pla
sta 3,x
pla
sta 4,x
txa
axs #-5
stx <$30
jmp nxtinst
znum02 pla
beq znum03
; Four digits
sta <0,x
pla
sta 1,x
pla
sta 2,x
pla
sta 3,x
txa
axs #-4
stx <$30
jmp nxtinst
znum03 pla
beq znum04
; Three digits
sta <0,x
pla
pla
jsr mputb
sta 1,x
; Set FIRST of container
pla
pla
sta <idxh
sta 2,x
txa
axs #-3
stx <$30
jmp nxtinst
znum04 pla
beq znum05
; Two digits
sta <0,x
inx
pla
pla
sta <idxl
sta <0,x
lda <op0l
inx
jsr mputb
stx <$30
jmp nxtinst
znum05 pla
; One digit
sta <0,x
inc <$30
jmp nxtinst
jmp nxtinst


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


; [16] GETB table,item /VAL
; *** PRINTR
z_getb lda #0
def_inst_0op 179
sta <byth
jsr textpc
lda <op0l
jsr bufout
sta <corel
lda <$31
lda <op0h
ora #$1F
sta <coreh
sta <$31
lda <op1l
lda #1
sta <idxl
jmp ret8
lda <op1h
 
sta <idxh
; *** PRINTB
jsr mgetb
def_inst_1op 135
jsr tostore
jsr textba
jmp nxtinst
jmp nxtinst


; [20] ADD int1,int2 /VAL
; *** PRINT
z_add clc
def_inst_1op 141
lda <op0l
asl <$11
adc <op1l
rol <$21
pha
lda #0
lda <op0h
rol a
adc <op1h
sta <$36
sta <byth
jsr textwa
pla
jsr tostore
jmp nxtinst
jmp nxtinst


; [21] SUB int1,int2 /VAL
; *** PRINTD
z_sub sec
def_inst_1op 138
lda <op0l
ldx <$11
sbc <op1l
clc
pha
lda objadl,x
lda <op0h
adc #7
sbc <op1h
sta $1012
sta <byth
lda objadh,x
pla
adc #0
jsr tostore
sta $1022
if smalend
lda $5801
else
ldy $5801
endif
inc $1012
bne zprntd1
inc $1022
zprntd1 if smalend
adc #1
sta <$11
lda $5801
else
lda $5801
adc #1
sta <$11
tya
endif
adc #0
sta <$21
jsr textba
jmp nxtinst
jmp nxtinst


; [128] ZERO? value /PRED
; *** VERIFY
z_zero lda <op0l
def_inst_0op 189
ora <op0h
jmp tpredic ; there is no disk, so just assume it is OK
jmp branch


; [129] NEXT? obj /VAL/PRED
; *** QUIT
z_next object_address <op0l,5
def_inst_0op 186
jsr mgetb
jsr bufout
jsr tostore
lda <$31
ora #$1F
sta <$31
jsr bufout
zquit jmp zquit
 
; *** READ
jsr bufout
;TODO
zread jmp zread
 
bank intbank+3
; Z-character decoding
; high 3-bits = state, low 5-bits = value
 
org $F100-12
; Text starting from program counter
textpc lda #0
sta <$38
sta <$27
ldx #$A0
stx <$09
stx <$0A
 
org $F100
lda <$27
bmi textpc1
lda #$F2
sta <$39
lda #$FE
pha
fetch_pc y,lda
if smalend
sta <$17
else
sta <$27
endif
if smalend
fetch_pc y,lda
sta <$27
else
fetch_pc y,ldx
stx <$17
endif
lsr a
lsr a
anc #31
ora <$09
tax
lda zchad,x
pha
textpc1 rts
 
org $F200
lda #$FE
pha
inc <$39
ldx <$17
stx <4
lda <$27
asl <4
rol a
asl <4
rol a
asl <4
rol a
anc #31
ora <$09
tax
tax
php
lda zchad,x
pla
pha
and #$02 ; now zero flag is toggled
rts
jmp branch


; [130] FIRST? obj /VAL/PRED
org $F300
z_first object_address <op0l,6
lda #$F1
jsr mgetb
sta <$39
jsr tostore
lda #$FE
pha
lda <$17
anc #31
ora <$09
tax
tax
php
lda zchad,x
pla
pha
and #$02 ; now zero flag is toggled
rts
jmp branch


; [131] LOC obj /VAL
org $F400-12
z_loc object_address <op0l,4
; Text from byte address
jsr mgetb
textba lda #0
jsr tostore
sta <$38
jmp nxtinst
sta <$27
ldx #$A0
stx <$09
stx <$0A


; [132] PTSIZE ptr /VAL
org $F400
z_ptsiz lda #$FF
lda <$27
sta <idxl
bmi textba1
sta <idxh
lda #$F5
lda <op0l
sta <$39
sta <corel
lda #$FE
lda <op0h
pha
sta <coreh
lda $1011
jsr mgetb
lda $1021
lda $5803
if smalend
sta <$17
else
sta <$27
endif
inc $1011
bne textba2
inc $1021
textba2 if smalend
lda $5803
sta <$27
else
ldx $5803
stx <$17
endif
inc $1011
bne textba3
inc $1021
textba3 lsr a
lsr a
lsr a
lsr a
anc #31
lsr a
ora <$09
lsr a
tax
lsr a
lda zchad,x
sec
pha
adc #0
rts
jsr tostore
textba1 bit $1020
jmp nxtinst
rts


; [133] INC var
org $F500
z_inc lda <op0l
lda #$FE
jsr fetch
pha
sec
inc <$39
adc #0
ldx <$17
stx <4
lda <$27
asl <4
rol a
asl <4
rol a
asl <4
rol a
anc #31
ora <$09
tax
lda zchad,x
pha
pha
bcc zincdec
rts
inc <byth
zincdec lda <op0l
jsr dostore
jmp nxtinst
; keep with next


; [134] DEC var
org $F600
z_dec lda <op0l
lda #$F4
jsr fetch
sta <$39
clc
lda #$FE
sbc #0
pha
lda <$17
anc #31
ora <$09
tax
lda zchad,x
pha
pha
bcs zincdec
rts
dec <byth ; does not affect the carry flag
bcc zincdec


; [138] PRINTD obj
org $F700-12
z_prntd lda <op0l
; Text from word address (aligned)
jsr ptad
textwa lda #0
inc <corel ; skip length byte
sta <$38
bne z1prntb
sta <$27
inc <coreh ; going past 64K is not allowed
ldx #$A0
bne z1prntb
stx <$09
; keep with next
stx <$0A


; [135] PRINTB ptr
org $F700
z_prntb lda <op0l
lda <$27
sta <corel
bmi textwa1
lda <op0h
lda #$F8
sta <coreh
sta <$39
z1prntb lda <pcl
lda #$FE
pha
pha
lda <pcm
lda $1011
lda $1021
ldy <$36
lda $5803,y
if smalend
sta <$17
else
sta <$27
endif
if smalend
inc $1011
lda $5803,y
sta <$27
else
ldx $5803,y
stx <$17
endif
inc $1011
bne textwa4
inc $1021
bne textwa4
inc <$36
textwa4 lsr a
lsr a
anc #31
ora <$09
tax
lda zchad,x
pha
pha
lda <pch
rts
textwa1 bit $1020
rts
 
org $F800
lda #$FE
pha
pha
lda #0
inc <$39
sta <pch
ldx <$17
lda <corel
stx <4
sta <pcl
lda <$27
lda <coreh
asl <4
sta <pcm
rol a
jsr putstr
asl <4
pla
rol a
sta <pch
asl <4
pla
rol a
sta <pcm
anc #31
pla
ora <$09
sta <pcl
tax
jmp nxtinst
lda zchad,x
pha
rts


; [139] RETURN value
org $F900
z_ret lda <op0h
lda #$F7
sta <byth
sta <$39
lda <op0l
lda #$FE
jmp return
pha
lda <$17
anc #31
ora <$09
tax
lda zchad,x
pha
rts


; [140] JUMP offset
org $FA00-20
z_jump lda <op0l
; Text from frequent word
jmp jumppc
textfw lda #0
sta <$38
sta <$29
lda <$0A
sta <$0B
ldx #$A0
stx <$09
stx <$0A
lda <$39
sta <$35


; [141] PRINT str
org $FA00
z_print lda <pcl
lda <$29
bmi textfw1
lda #$FB
sta <$39
lda #$FE
pha
pha
lda <pcm
ldy <$37
lda $5803,y
if smalend
sta <$19
else
sta <$29
endif
inc $1016
if smalend
lda $5803,y
sta <$29
else
ldx $5803,y
stx <$19
endif
inc $1016
bne textfw2
inc $1026
bne textfw2
inc <$37
textfw2 lsr a
lsr a
anc #31
ora <$09
tax
lda zchad,x
pha
pha
lda <pch
rts
textfw1 bit $1020
lda <$35
sta <$39
lda <$0B
sta <$0A
sta <$09
jmp [$38]
 
org $FB00
lda #$FE
pha
pha
lda #0
inc <$39
sta <pch
ldx <$19
lda <corel
stx <4
sta <pcl
lda <$29
lda <coreh
asl <4
sta <pcm
rol a
asl <pcl
asl <4
rol <pcm
rol a
rol <pch
asl <4
jsr putstr
rol a
pla
anc #31
sta <pch
ora <$09
pla
tax
sta <pcm
lda zchad,x
pla
pha
sta <pcl
rts
jmp nxtinst
 
org $FC00
lda #$FA
sta <$39
lda #$FE
pha
lda <$19
anc #31
ora <$09
tax
lda zchad,x
pha
rts


; [143] BCOM int /VAL
; States can be:
z_bcom lda <op0h
;  0  = Second step of ASCII escape
eor #$FF
;  1-3 = Fwords
sta <byth
;  4  = First step of ASCII escape
lda <op0l
;  5-7 = Shift states 0,1,2
eor #$FF
jsr tostore
jmp nxtinst


; [142] VALUE var /VAL
; These subroutines are entered with X set to the state.
z_value lda <op0l
; Also has carry flag cleared.
jsr fetch
org $FE01
z1value jsr tostore
jmp nxtinst
; keep with next


; [224] CALL fcn[,arg1][,arg2][,arg3] /VAL
; ** Emit a space
z_call lda #0
def_zchars $A0
cmp <op0l
def_zchars $C0
bne z1call
def_zchars $E0
sta <byth
zch32 jsr space
cmp <op0h
jmp [$38]
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)
; ** Second escape
z_prntr jsr putstr
def_zchars $00,$1F
lda #13
txa
bankcall putchar
ora <5
; fall through
beq zch1
cmp #32
beq zch32
cmp #13
beq zch13
ldx <$30
beq zch1
sta <0,x
inc <$30
lda <$0A
sta <$09
jmp [$38]


; [176] RTRUE
; ** First escape
z_rtrue lda #0
def_zchars $80,$9F
sta <byth
txa
lda #1
asl a
jmp return
asl a
asl a
asl a
asl a
sta <5
anc #0
sta <$09
jmp [$38]


z_rfals ; [177] RFALSE
; ** Frequent words
def_zchars $20,$7F
lda fwordsl,x
sta $1015
lda fwordsh,x
sta $1025
lda $5801
if smalend
asl a
sta <$16
else
sta <$26
lda #0
rol a
sta <$37
endif
inc $1015
bne zfw1
inc $1025
zfw1 lda $5801
if smalend
rol a
sta <$26
else
asl a
sta <$16
rol <$26
endif
lda #0
lda #0
sta <byth
adc #0
jmp return
sta <$37
jmp textfw
 
; ** Begin escape
def_zchars $E6
lda #$80
sta <$09
jmp [$38]
 
; ** Direct character code
def_zchars $A6,$BF
def_zchars $C6,$DF
def_zchars $E8,$FF
ldy <$30
beq zch1
stx <$E0,y
inc <$30
zch1 lda <$0A
sta <$09
jmp [$38]
 
; ** Emit a line break
def_zchars $E7
zch13 jsr bufout
lda <$31
ora #$1F
sta <$31
lda <$0A
sta <$09
jmp [$38]
 
; ** Begin frequent words state 0-31
def_zchars $A1
def_zchars $C1
def_zchars $E1
lda #$20
sta <$09
jmp [$38]


; [178] PRINTI (str)
; ** Begin frequent words state 32-63
z_prnti jsr putstr
def_zchars $A2
jmp nxtinst
def_zchars $C2
def_zchars $E2
lda #$40
sta <$09
jmp [$38]


; [180] NOOP
; ** Begin frequent words state 64-95
z_noop = nxtinst
def_zchars $A3
def_zchars $C3
def_zchars $E3
lda #$60
sta <$09
jmp [$38]


; [181] SAVE /PRED
; ** Temporary shift 1
z_save lda #1 ; clear the zero flag (SAVE/RESTORE aren't implemented)
def_zchars $A4
jmp branch
lda #$C0
sta <$09
jmp [$38]


; [182] RESTORE /PRED
; ** Temporary shift 2
z_rstor = z_save
def_zchars $A5
lda #$E0
sta <$09
jmp [$38]


; [183] RESTART
; ** Permanent shift 1 or 2
z_rest = reset
def_zchars $C4
def_zchars $E5
and #$F0
sta <$0A
jmp [$38]


; [184] RSTACK
; ** Permanent shift 0
z_rstac lda #0
def_zchars $C5
jsr fetch
def_zchars $E4
dec <dstkcnt
lda #$A0
jmp return
sta <$09
sta <$0A
jmp [$38]


; [233] POP var
; Reset vector
z_pop ldx <dstkcnt
bank intbank+3
jsr fetch2
org $FFFA
pha
dw 0,reset,0
lda <op0l
jsr dostore
; fall through


; [185] FSTACK
; Pattern tables
z_fstac dec <dstkcnt
bank intbank+4
jmp nxtinst
org $0000
incbin "pc.chr"


; [186] QUIT
; Cursor icon
z_quit jmp z_quit ; just wait forever for the player to push RESET
org $07F0
defchr $00000000, \
      $03030300, \
      $00303030, \
      $03030300, \
      $00303030, \
      $03030300, \
      $00303030, \
      $00000000


; [225] PUT table,item,data
; Postprocessor
z_put lda <op0l
emu
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
org $0000
z_putb lda <op0l
lda 0
sta <corel
sta $2012
lda <op0h
inc <1
sta <coreh
rts
lda <op1l
sta <idxl
lda <op1h
sta <idxh
lda <op2l
jsr mputb
jmp nxtinst


; [187] CRLF
org $0040
z_crlf lda #13
db "0123456789012345"
bne z1prntc
db "6789012345678901"
; keep with next


; [229] PRINTC char
org $0080
z_prntc lda <op0l
db "                                "  ; $80-$9F
z1prntc bankcall putchar
db "      abcdefghijklmnopqrstuvwxyz"  ; $A0-$BF
jmp nxtinst
db "      ABCDEFGHIJKLMNOPQRSTUVWXYZ"  ; $C0-$DF
db "      **0123456789.,!?_#'\"/\\-:()" ; $E0-$FF


; [230] PRINTN int
org $8000
z_prntn bankjump printn
cld


; [232] PUSH value
; Make duplicates of ASCII characters as Z-characters
z_push inc <dstkcnt
lda #1
lda <op0l
sta $200D
pha
lda <op0h
sta <byth
lda #0
lda #0
jsr dostore
sta $200E
jmp nxtinst
lda #8
sta $200F
ldx #$80
pp1 lda #4
sta <2
lda <0,x
asl a
rol <2
asl a
rol <2
asl a
rol <2
asl a
rol <2
sta <1
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
inx
bne pp1
 
; Make duplicate of digits for use with PRINTN
ldx #0
stx $200E
stx $200F
pp2 lda #4
sta <2
lda <$40,x
asl a
rol <2
asl a
rol <2
asl a
rol <2
asl a
rol <2
sta <1
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
jsr 0
inx
cpx #32
bne pp2
 
; Finished
hlt
 
org $FFFC
dw $8000
 
code
bank intbank+4
</pre>
 
== C program ==
This program is generating a stub file and story ROM for its use.
<pre>
/*
  This file is part of Famizork II and is in the public domain.
*/
 
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
 
static FILE*fp;
static int c;
static int d;
static int gamesize;
static char endian;
static unsigned char mem[0x20000];
static char buf[256];
 
#define OUTHEADER(x,y) fprintf(fp,"%s\t= %u\n",x,(mem[y*2+endian]<<8)|mem[y*2+1-endian])
 
int main(int argc,char**argv) {
  if(argc<2) return 1;
  fp=fopen(argv[1],"rb");
  fseek(fp,0,SEEK_END);
  gamesize=ftell(fp);
  if(gamesize>0x20000 || gamesize<0) return 1;
  fseek(fp,0,SEEK_SET);
  fread(mem,1,gamesize,fp);
  fclose(fp);
  if(*mem!=3) return 1;
  sprintf(buf,"%s.asm",argv[1]);
  fp=fopen(buf,"w");
  endian=mem[1]&1;
  mem[1]&=3;
  mem[1]|=16;
  c=(gamesize>0x10000?16:gamesize>0x8000?8:gamesize>0x4000?4:2);
  fprintf(fp,"\tnes2prgram 0,131072\n");
  fprintf(fp,"\tinesprg %d\n",(c>>1)+2);
  fprintf(fp,"intbank\t= %d\n",c);
  fprintf(fp,"smalend\t= %d\n",endian);
  fprintf(fp,"large\t= %d\n",gamesize>=0x10000);
  if(gamesize<0x10000) fprintf(fp,"maxaddr\t= %u\n",gamesize-1);
  OUTHEADER("start",3);
  OUTHEADER("vocab",4);
  OUTHEADER("object",5);
  OUTHEADER("global",6);
  OUTHEADER("purbot",7);
  OUTHEADER("fwords",12);
  fprintf(fp,"\tcode\n\tbank 0\n\tincbin \"%s.rom\"\n\tinclude \"famizork2.asm\"\n",argv[1]);
  fprintf(fp,"\n\tbank %d\n\torg fwordsl\n",c);
  d=(mem[24+endian]<<8)|mem[25-endian];
  for(c=0;c<192;c+=2) fprintf(fp,"\tdb %d\n",(d+c)&255);
  for(c=0;c<192;c+=2) fprintf(fp,"\tdb %d\n",((d+c)>>8)&255);
  fprintf(fp,"\torg multabl\n");
  for(c=0;c<255;c++) fprintf(fp,"\tdb %d\n",((c*c)>>2)&255);
  for(c=0;c<512;c++) fprintf(fp,"\tdb %d\n",((c*c)>>10)&255);
  fprintf(fp,"\tbank intbank+4\n");
  fclose(fp);
  sprintf(buf,"%s.rom",argv[1]);
  fp=fopen(buf,"wb");
  if(gamesize>0x10000) {
    fwrite(mem+0x10000,1,0x10000,fp);
    fwrite(mem,1,0x10000,fp);
  } else {
    fwrite(mem,1,gamesize,fp);
  }
  fclose(fp);
  return 0;
}
</pre>


; [234] SPLIT lines
== Explanation ==
z_split = nxtinst


; [235] SCREEN window
The explanation of the mapper is [[User:Zzo38/Mapper_I]].
z_scrn = nxtinst


; ****************************************
The pattern table is arranged in this way (although $7F is the cursor picture, not shown here):


0123456789012345
6789012345678901
  !"#$%&'()*+,-./
0123456789:;<=>?
@ABCDEFGHIJKLMNO
PQRSTUVWXYZ[\]^_
`abcdefghijklmno
pqrstuvwxyz{|}~
               
               
      abcdefghij
klmnopqrstuvwxyz
      ABCDEFGHIJ
KLMNOPQRSTUVWXYZ
      **01234567
89.,!?_#'"/\-:()


bank 31
As you can see there are many duplicates, in particular each digit occurs five times, except 0 and 1 which occur six times each. Many other characters also occur twice. These will improve the speed of the program, since it does not have to convert Z-characters and numbers into ASCII before displaying them.
org $FE00


; Initialize CPU/APU/PPU at reset
Many things are precomputed at compile-time in order to improve speed (also improves size of the interpreter):
reset ldx #$40
* The mode byte is set to indicate that the status bar is unavailable
stx $4017 ; Disable APU frame IRQ
* Address of objects, global variables, and frequent words table
ldx #$FF
* Starting address of execution of program
txs
* Endianness and various calculations related to it
inx
* The size of the story file, which can be used to determine needed ROM sizes and optimizing of the interpreter
stx $2000
* Self-inserting-breaks
stx $2001
* Stuff to optimize the vocabulary (not yet)
stx $4010
* Multiplication tables


; Initialize MMC5 to act like User:Zzo38/Mapper_D
A custom mapper is used, which bankswitches only one byte at a time. This makes much of the logic for addressing the story file much simpler than it otherwise would be. It also overlaps bankswitching registers with mirrors of the RAM internal to the console, and since they respond to multiple addresses, this means you can save the bankswitched value at the same time as bankswitching, that you can store multiple bank numbers at once (even though the mapper can only remember one at once), and that reading from the RAM mirrors will also bankswitch (allows you to restore a saved bankswitch in four cycles; with other mappers it is usually seven).
stx $5101
stx $5200
stx $5204
inx
stx $5100
stx $5102
inx
stx $5103
lda #$50
sta $5105


; Call other init code
There is an instruction decoding table, which is one table for all instructions and contains duplicates for the different forms of the instruction (such as EXT forms of 2OP instructions, the different variable/immediate combinations for 2OP, and the different operand types for 1OP). However, a different opcode is used when EQUAL? is encoded as EXT than as 2OP, in order to improve the speed in the 2OP case. The code can just use "jmp nxtinst" to begin decoding the next instruction; it doesn't use return from subroutine.
bankjump reset1


; NMI routine
Instruction decoding tables, as well as the Z-character decoding tables, both use the RTS trick, although in the case of Z-character decoding, the table contains only the low byte of the address since the code is small enough in this case.
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
Also it is using several stable unofficial opcodes.
bank 32
incbin "chicago_oblique.chr"
incbin "chicago_inverse.chr"
</pre>

Latest revision as of 09:31, 20 April 2016

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. It is not yet complete (and likely contains errors).

Main file

; Famizork II
; Public domain

debug	= 1  ; change this to 1 to enable breakpoints 0 to disable
	     ; set a breakpoint on opcode $1A in the debugger

	inesmap 380 ; Famizork II mapper
	ineschr 1 ; 8K CHR ROM
	inesmir 3 ; horizontal arrangement with battery

; Zero-page variables:
;   $02 = data stack pointer
;   $03 = call stack pointer
;   $04 = temporary
;   $05 = temporary
;   $06 = temporary
;   $07 = temporary
;   $09 = current temporary shift state
;   $0A = current permanent shift state
;   $0B = saved permanent shift state
;   $0D = number of locals
;   $0E = bit16 of program counter
;   $10 = bit7-bit0 of program counter
;   $11 = low byte of first operand
;   $12 = low byte of second operand
;   $13 = low byte of third operand
;   $14 = low byte of fourth operand
;   $15 = temporary
;   $16 = low byte of text address if inside fword
;   $17 = low byte of packed word
;   $18 = temporary
;   $19 = low byte of packed word if inside fword
;   $20 = bit15-bit8 of program counter
;   $21 = high byte of first operand
;   $22 = high byte of second operand
;   $23 = high byte of third operand
;   $24 = high byte of fourth operand
;   $25 = temporary
;   $26 = high byte of text address if inside fword
;   $27 = high byte of packed word
;   $28 = temporary
;   $29 = high byte of packed word if inside fword
;   $30 = output buffer pointer
;   $31 = low byte of nametable address of cursor
;   $32 = high byte of nametable address of cursor
;   $33 = Y scroll amount
;   $34 = lines to output before <MORE>
;   $35 = saved high byte of return address for text unpacking
;   $36 = bit16 of current text address
;   $37 = bit16 of current text address if inside fword
;   $38-$39 = return address for text unpacking
;   $3A = current background color
;   $3B = current foreground color
;   $3C = remember if battery RAM is present (255=yes 0=no)
;   $3D = ARCFOUR "i" register 
;   $3E = ARCFOUR "j" register
;   $40-$4F = low byte of locals
;   $50-$5F = high byte of locals
;   $E2-$FF = output buffer

	code

datasp	= $02
callsp	= $03
locall	= $40
localh	= $50

dstackl	= $200
dstackh	= $300

cstackl	= $400
cstackm	= $480
cstackh	= $500 ; bit4-bit1=number of locals, bit0=bit16 of PC
cstackx	= $580 ; data stack pointer

arcfour	= $600 ; use for random number generator

	bank intbank+0,"Interpreter"
	bank intbank+1,"Interpreter"
	bank intbank+2,"Interpreter"
	bank intbank+3,"Interpreter"

	bank intbank
	org $8000

	macro breakpoint
	if debug
	db $1A ; unofficial NOP
	endif
	endm

	macro breakpoint2
	if debug
	db $3A ; unofficial NOP
	endif
	endm

	macro make_digit_table
	macset 4,4,0
	macgoto make_digit_table_0
	endm

	macro make_digit_table_0
	db ((\4*\2)/\1)%10
	macset 4,4,\4+1
	macset 5,4,\4=\3
	macgoto make_digit_table_\5
	endm

	macro make_digit_table_1
	; Empty macro
	endm

globodd	= global&1

	macro make_global_table
	macset 2,4,16
	macgoto make_global_table_0
	endm

	macro make_global_table_0
	db \1(global+\2+\2-32)
	macset 2,4,\2+1
	macset 3,4,\2=256
	macgoto make_global_table_\3
	endm

	macro make_global_table_1
	; Empty macro
	endm

	macro make_object_table
	macset 2,4,0
	macgoto make_object_table_0
	endm

	macro make_object_table_0
	db \1(object+(\2*9)+62-9)
	macset 2,4,\2+1
	macset 3,4,\2=256
	macgoto make_object_table_\3
	endm

	macro make_object_table_1
	; Empty macro
	endm

instadl	ds 256
instadh	ds 256

globadl	ds 16
	make_global_table low
globadh	ds 16
	make_global_table high

objadl	make_object_table low
objadh	make_object_table high

multabl	ds 256 ; x*x/4
multabh	ds 512 ; x*x/1024

digit0l	make_digit_table 1,1,256
digit1l	make_digit_table 10,1,256
digit2l	make_digit_table 100,1,256
digit0h	make_digit_table 1,256,128
digit1h	make_digit_table 10,256,128
digit2h	make_digit_table 100,256,128
digit3h	make_digit_table 1000,256,128

bit1tab	db   0,  1,  3,  3,  7,  7,  7,  7, 15, 15, 15, 15, 15, 15, 15, 15
	db  31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31
	db  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63
	db  63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63
	db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
	db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
	db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
	db 127,127,127,127,127,127,127,127,127,127,127,127,127,127,127,127
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
	db 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255

zchad	ds 256

ptsizt	db 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
	db 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
	db 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
	db 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
	db 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5
	db 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	db 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
	db 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8

flagad	if smalend
	db 1,1,1,1,1,1,1,1
	db 0,0,0,0,0,0,0,0
	db 3,3,3,3,3,3,3,3
	db 2,2,2,2,2,2,2,2
	else
	db 0,0,0,0,0,0,0,0
	db 1,1,1,1,1,1,1,1
	db 2,2,2,2,2,2,2,2
	db 3,3,3,3,3,3,3,3
	endif

fwordsl	= *-32
	ds 96
fwordsh	= *-32
	ds 96

flagbit	db 128,64,32,16,8,4,2,1
	db 128,64,32,16,8,4,2,1
	db 128,64,32,16,8,4,2,1
	db 128,64,32,16,8,4,2,1

flagbic	db 127,191,223,239,247,251,253,254
	db 127,191,223,239,247,251,253,254
	db 127,191,223,239,247,251,253,254
	db 127,191,223,239,247,251,253,254

digit4h	make_digit_table 10000,256,128

	; Z-character-decoding assigning macro
	macro def_zchars
	if \#=1
	macset 2,4,\1
	else
	macset 2,4,\2
	endif
	macset 1,4,\1
	macset 3,4,*
	macset 4,4,?B
	bank bank(zchad)
	macgoto def_zchars_0
	endm

	macro def_zchars_0
	macset 5,4,\1=\2
	org zchad+\1
	db low(\3-1)
	if \3<$FE01
	fail "Z-character routine out of range"
	endif
	if \3>$FF00
	fail "Z-character routine out of range"
	endif
	macset 1,4,\1+1
	macgoto def_zchars_\5
	endm

	macro def_zchars_1
	bank \4
	org \3
	endm

	; Instruction assigning macro
	macro def_inst
	macset 2,4,*
	macset 3,4,?B
	bank bank(instadl)
	org instadl+(\1)
	db low(\2-1)
	org instadh+(\1)
	db high(\2-1)
	bank \3
	org \2
	endm

	macro def_inst_2op
	def_inst (\1)+$00
	def_inst (\1)+$20
	def_inst (\1)+$40
	def_inst (\1)+$60
	def_inst (\1)+$C0
	endm

	macro def_inst_2op_eq
	def_inst (\1)+$00
	def_inst (\1)+$20
	def_inst (\1)+$40
	def_inst (\1)+$60
	endm

	macro def_inst_1op
	def_inst (\1)+$00
	def_inst (\1)+$10
	def_inst (\1)+$20
	endm

	macro def_inst_0op
	def_inst (\1)+$00
	endm

	macro def_inst_ext
	def_inst (\1)+$00
	endm

	; Fetch next byte of program
	; Doesn't affect carry flag and overflow flag
	macro fetch_pc
	inc $1010
	bne n\@
	inc $1020
	if large
	bne n\@
	inc <$0E
n\@	ld\1 <$0E
	\2 $5803,\1
	else
n\@	\2 $5803
	endif
	endm
	; (Bytes of above: 17)
	; (Cycles of above: 16 or 25 or 27)

	; Initialization code
reset	ldx #0
	stx $2000
	stx $2001
	; Wait for frame
	bit $2002
vwait1	bit $2002
	bpl vwait1
	txa
	stx <$0E ; bit16 of program counter
	stx <$0D ; number of locals
	stx <$33 ; Y scroll amount
	stx <$3C ; battery flag
	dex
	stx <$03 ; call stack pointer
	ldy #27
	sty <$34 ; lines before <MORE>
	ldy #$0F
	sty <$3A ; background
	ldy #$20
	sty <$3B ; foreground
	ldy #low(start-1)
	sty <$10
	ldy #$E2
	sty <$30 ; output buffer pointer
	ldy #$61
	sty <$31 ; low byte of cursor nametable address
	ldy #$27
	sty <$32 ; high byte of cursor nametable address
	; Wait for frame
	bit $2002
vwait2	bit $2002
	bpl vwait2
	; Clear the screen
	tax
	lda #32
	sta $2006
	ldx #9
	stx $2006
reset1	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	inx
	bne reset1
	; Initialize palette
	lda #$FF
	sta $2006
	stx $2006
	lda <$3A
	sta $2007
	sta $2007
	ldy <$3B
	sty $2007
	sty $2007
	sta $2007
	sta $2007
	sty $2007
	sty $2007
	sta $2007
	sta $2007
	sty $2007
	sty $2007
	sta $2007
	sta $2007
	sty $2007
	sty $2007
	; Check if F8 is pushed (erases save data)
	ldx #5
	stx $4016
	dex
	stx $4016
	lda $4017
	and #2
	beq reset2
	; Check battery
	ldx #0
	stx $1011
	stx $1021
	lda $5800
	cmp #69
	bne reset2
	inc $1011
	lda $5800
	cmp #105
	beq reset3
	; No save file exists; try to create one
reset2	stx $1011
	lda #69
	sta $5800
	inc $1011
	lda #105
	sta $5800
	inc $1011
	stx $5800
	lda #$FF
	sta $1022
	; Initialize ARCFOUR table
reset2a	txa
	sta arcfour,x
	sta $1012
	sta $5800
	inx
	bne reset2a
	; Copy header from ROM into RAM
	stx $1021
reset2b	stx $1011
	lda $5805
	sta $5803
	inx
	bne reset2b
	; Copy ROM starting from PURBOT into RAM
	lda #high(purbot)
	sta $1021
	lda #low(purbot)
	sta $1011
reset2c	lda $5805
	sta $5803
	inc $1011
	bne reset2c
	inc $1021
	if large=0
	if maxaddr<$FF00
	lda <$21
	cmp #high(maxaddr)+1
	endif
	endif
	bne reset2c
	; Check if save file still exists
	stx $1011
	stx $1021
	lda $5800
	cmp #69
	bne zrest
	inc $1011
	lda $5800
	cmp #105
	beq reset3
	jmp zrest
	; Battery is OK
reset3	lda #255
	sta <$3C
	; Load and permute saved ARCFOUR table
	sta $1021
	ldy #0
reset3a	sty $1011
	lax $5800
	sta arcfour,y
	inx
	stx $5800
	iny
	bne reset3a
	; fall through

	; *** RESTART
	def_inst_0op 183
zrest	ldx #0
	stx <$0E ; bit16 of program counter
	stx <$0D ; number of locals
	stx $1021
	dex
	stx <$03 ; call stack pointer
	; Load data from 64 to PURBOT from ROM into RAM
	lda #64
	sta $1011
zrest1	lda $5805
	sta $5803
	inc $1011
	bne zrest1
	inc $1021
	if purbot<$FF00
	lda <$21
	cmp #high(purbot)+1
	endif
	bne zrest1
	; Initialize program counter
	lda #low(start-1)
	sta <$10
	lda #high(start-1)
	sta $1020
	jmp zcrlf

	; *** USL
	def_inst_0op 188
	; fall through

	; *** SPLIT
	def_inst_ext 234
	; fall through

	; *** SCREEN
	def_inst_ext 235
	; fall through

	; *** NOOP
	def_inst_0op 180
	; fall through

	; Decode the next instruction
	; For EXT instructions, number of operands is in the X register
nxtinst	fetch_pc y,ldx
	lda instadh,x
	pha
	lda instadl,x
	pha
	txa
	bmi not2op

	; It is 2OP
	ldx #0
	asl a
	sta <4
	arr #$C0
	fetch_pc y,lda
	bcc is2op1
	jsr varop0
	fetch_pc y,lda
	bvc is2op2
	jmp is2op3
is2op1	stx <$21
	sta <$11
	bit <4
	fetch_pc y,lda
	bvc is2op3
is2op2	inx
	jmp varop0
is2op3	stx <$22
	sta <$12
	rts

	; It isn't 2OP
not2op	cmp #192
	bcc notext

	; It is EXT
	fetch_pc y,lda
	ldx #0
isext0	sec
	rol a
	bcs isext1
	bmi isext3

	; Long immediate
	sta <4
	fetch_pc y,lda
	if smalend
	sta <$11,x
	else
	sta <$21,x
	endif
	fetch_pc y,lda
	if smalend
	sta <$21,x
	else
	sta <$11,x
	endif
	inx
	lda <4
	sec
	rol a
	jmp isext0

	; Variable or no more operands
isext1	bpl isext2

	; No more operands
	rts

	; Variable
isext2	sta <4
	jsr varop
	inx
	lda <4
	sec
	rol a
	jmp isext0

	; Short immediate
isext3	sta <4
	lda #0
	sta <$21,x
	fetch_pc y,lda
	sta <$11,x
	inx
	lda <4
	sec
	rol a
	jmp isext0

	; It isn't EXT; it is 1OP or 0OP
notext	asl a
	asl a
	asl a
	bcs notext1
	bpl notext2

	; 1OP - short immediate
	fetch_pc y,lda
	ldx #0
	stx <$21
	sta <$11
	rts

notext1	bmi notext3

	; 1OP - variable
	ldx #0
	jmp varop

	; 1OP - long immediate
notext2	fetch_pc y,lda
	if smalend
	sta <$11,x
	else
	sta <$21,x
	endif
	fetch_pc y,lda
	if smalend
	sta <$21,x
	else
	sta <$11,x
	endif
	; fall through

	; 0OP
notext3	rts

zcall0	jmp val8

	; *** CALL
	def_inst_ext 224
	stx <4
	lax <$11
	ora <$21
	beq zcall0 ; calling function zero
	; Save to call stack
	inc <callsp
	ldy <callsp
	lda <$10
	stx <$10
	sta cstackl,y
	lda <$20
	sta cstackm,y
	lsr <$0E
	lax <$0D
	rol a
	sta cstackh,y
	lda <datasp
	sta cstackx,y
	; Save locals
	txa
	beq zcall2
	clc
	adc <datasp
	tay
zcall1	lda <locall,x
	sta dstackl,y
	lda <localh,x
	sta dstackh,y
	dey
	dex
	bne zcall1
	lda <$0D
	adc <datasp
	sta <datasp
	; Read function header (number of locals)
zcall2	asl $1010
	lda <$21
	rol a
	sta $1020
	rol <$0E
	ldy <$0E
	lda $5803,y
	sta <$0D
	; Load initial values of locals
	beq zcall4
	; Load arguments
	ldx <4
	dex
	beq zcall3
	lda <$12
	sta <$41
	lda <$22
	sta <$51
	cpx #1
	beq zcall2a
	lda <$13
	sta <$42
	lda <$23
	sta <$52
	cpx #2
	beq zcall2a
	lda <$14
	sta <$43
	lda <$24
	sta <$53
zcall2a	txa
	asl a ; now clears carry flag
	adc <$10
	sta <$10
	lda #0
	adc <$20
	sta $1020
	if large
	bcc zcall3
	inc <$0E
	endif
	; Load default values
zcall3	fetch_pc y,lda
	if smalend
	sta <locall+1,x
	else
	sta <localh+1,x
	endif
	fetch_pc y,lda
	if smalend
	sta <localh+1,x
	else
	sta <locall+1,x
	endif
	inx
	cpx <$0D
	bne zcall3
zcall4	jmp nxtinst

	; *** RFALSE
	def_inst_0op 177
	lda #0
	; fall through

	; Return a 8-bit value (from A)
ret8	pha
	ldy <callsp
	dec <callsp
	lda cstackx,y
	sta <datasp
	lda cstackl,y
	sta <$10
	lda cstackm,y
	sta $1020
	lda cstackh,y
	lsr a
	sta <$0D
	tax
	rol a
	anc #1
	sta <$0E
	; Restore locals
	txa
	beq ret8b
	adc <datasp
	tay
ret8a	lda dstackl,y
	sta <locall,x
	lda dstackh,y
	sta <localh,x
	dey
	dex
	bne ret8a
ret8b	pla
	; fall through

	; Value of instruction is 8-bits (from A)
val8	fetch_pc y,ldx
	bne val8a
	; Push to stack
	inc <datasp
	ldy <datasp
	sta dstackl,y
	txa
	sta dstackh,y
	jmp nxtinst
val8a	cpx #16
	bcs val8b
	; Local variable
	sta <locall,x
	lda #0
	sta <localh,x
	jmp nxtinst
	; Global variable
val8b	ldy globadl,x
	sty $1014
	ldy globadh,x
	sty $1024
	if smalend
	sta $5801
	else
	ldy #0
	sty $5801
	endif
	inc $1014
	if globodd
	bne val8c
	inc $1024
	endif
val8c	if smalend
	lda #0
	endif
	sta $5801
	lda $1020
	jmp nxtinst

	; Read the variable using as an instruction operand
	; X is operand number (0-3)
varop	fetch_pc y,lda
varop0	bne varop1
	; Pop from stack
	ldy <datasp
	dec <datasp
	lda dstackl,y
	sta <$11,x
	lda dstackh,y
	sta <$21,x
	rts
varop1	cmp #16
	bcs varop2
	; Local variable
	tay
	lda locall,y
	sta <$11,x
	lda localh,y
	sta <$21,x
	rts
	; Global variable
varop2	tay
	lda globadl,y
	sta $1015
	lda globadh,y
	sta $1025
	lda $5801
	if smalend
	sta <$11,x
	else
	sta <$21,x
	endif
	inc $1015
	if globodd
	bne varop3
	inc $1025
	endif
varop3	lda $5801
	if smalend
	sta <$21,x
	else
	sta <$11,x
	endif
	lda $1020
	rts

	; *** RSTACK
	def_inst_0op 184
	ldx <datasp
	lda dstackl,x
	sta <$14
	lda dstackh,x
	jmp ret16

	; *** RETURN
	def_inst_1op 139
	lda <$11
	sta <$14
	lda <$21
ret16	sta <$24
	ldy <callsp
	dec <callsp
	lda cstackx,y
	sta <datasp
	lda cstackl,y
	sta <$10
	lda cstackm,y
	sta $1020
	lda cstackh,y
	lsr a
	sta <$0D
	tax
	rol a
	anc #1
	sta <$0E
	; Restore locals
	txa
	beq ret16b
	adc <datasp
	tay
ret16a	lda dstackl,y
	sta <locall,x
	lda dstackh,y
	sta <localh,x
	dey
	dex
	bne ret16a
ret16b	; fall through

	; Value of instruction is 16-bits (from $x4)
val16	lda <$14
	fetch_pc y,ldx
	bne val16a
	; Push to stack
	inc <datasp
	ldy <datasp
	sta dstackl,y
	lda <$24
	sta dstackh,y
	jmp nxtinst
val16a	cpx #16
	bcs val16b
	; Local variable
	sta <locall,x
	lda <$24
	sta <localh,x
	jmp nxtinst
	; Global variable
val16b	ldy globadl,x
	sty $1015
	ldy globadh,x
	sty $1025
	if smalend
	sta $5801
	else
	ldy <$24
	sty $5801
	endif
	inc $1015
	if globodd
	bne val16c
	inc $1025
	endif
val16c	if smalend
	lda <$24
	endif
	sta $5801
	lda $1020
	jmp nxtinst

	; *** RTRUE
	def_inst_0op 176
	lda #1
	jmp ret8

	; *** EQUAL? (EXT)
	def_inst_ext 193
	lda <$11
	ldy <$21
	cmp <$12
	bne zequal1
	cpy <$22
	beq tpredic
zequal1	cpx #2
	beq fpredic
	cmp <$13
	bne zequal2
	cpy <$23
	beq tpredic
zequal2	cpx #3
	beq fpredic
	cmp <$14
	bne fpredic
	cmp <$24
	beq tpredic
	jmp fpredic

	; *** GRTR?
	def_inst_2op 3
	lda <$12
	cmp <$11
	lda <$22
	sbc <$21
	bvc zgrtr1
	and #128
	jmp predic1
zgrtr1	bmi tpredic
	jmp fpredic

	; *** LESS?
	def_inst_2op 2
	lda <$11
	cmp <$12
	lda <$21
	sbc <$22
	bvc zgrtr1
	and #128
	jmp predic1

	; *** EQUAL? (2OP)
	def_inst_2op_eq 1
	lda <$11
	eor <$21
	bne fpredic
	lda <$12
	eor <$22
	beq predic1
	jmp fpredic

	; *** ZERO?
	def_inst_1op 128
	lda <$11
	ora <$21
	beq tpredic
	; falls through

	; Predicate handling
fpredic	lda #128
	jmp predic1
tpredic	lda #0
predic1	fetch_pc x,eor
	tax
	arr #$C0
	bcs predic8

	; If it should branch
	txa
	bvs predic3

	; Long offset
	eor #$20
	anc #$3F
	adc #$E0
	if large
	bpl predic2
	dec <$0E
	endif
predic2	clc
	adc <$20
	sta $1020
	if large
	bcc predick
	inc <$0E
	endif
predick	fetch_pc y,lax
	jmp predic4

	; Short offset
predic3	and #$3F
	cmp #2
	bcc predicq
predic4	sbc #2
	bcs predic5
	if large
	ldy <$20
	dey
	sty $1020
	cpy #255
	bne predic5
	lsr <$0E
	else
	dec $1020
	endif
predic5	sec
	adc <$10
	sta <$10
	bcc predic9
	inc $1020
	if large
	bne predic9
	inc <$0E
	endif
	jmp nxtinst

	; If should not branch
predic8	bvc predic9
	inc <$10
	bne predic9
	inc $1020
	if large
	bne predic9
	inc <$0E
	endif
predic9	jmp nxtinst

predicq	jmp ret8

	; *** IGRTR?
	def_inst_2op 5
	ldx <$11
	jsr xvalue
	inc <$14
	bne zigrtr2
	inc <$24
zigrtr1	jsr xstore
	lda <$14
	cmp <$11
	lda <$24
	sbc <$21
	bvc zigrtr2
	and #128
	jmp predic1
zigrtr2	bmi zigrtr3
	jmp fpredic
zigrtr3	jmp tpredic

	; *** DLESS?
	def_inst_2op 4
	ldx <$11
	jsr xvalue
	ldy <$14
	dey
	sty <$14
	cpy #255
	bne zdless1
	dec <$24
zdless1	jsr xstore
	lda <$11
	cmp <$14
	lda <$21
	sbc <$24
	bvc zigrtr2
	and #128
	jmp predic1

	; *** PTSIZE
	def_inst_1op 132
	lda $1021
	ora #255
	dcp $1011
	bne zptsz1
	dec $1021
zptsz1	ldx $5801
	lda ptsizt,x
	jmp val8

	; *** PUT
	def_inst_ext 225
	lda <$12
	asl a
	rol <$22
	clc
	adc <$11
	sta $1011
	lda <$22
	adc <$21
	sta $1021
	if smalend
	lda <$13
	else
	lda <$23
	endif
	sta $5801
	inc $1011
	bne zput1
	inc $1021
zput1	ds 0
	if smalend
	lda <$23
	else
	lda <$13
	endif
	sta $5801
	bit $1020
	jmp nxtinst

	; *** PUTB
	def_inst_ext 226
	lda <$12
	clc
	adc <$11
	sta $1011
	lda <$22
	adc <$21
	sta $1021
	lda <$13
	sta $5801
	bit $1020
	jmp nxtinst

	; *** GET
	def_inst_2op 15
	lda <$12
	asl a
	rol <$22
	clc
	adc <$11
	sta $1011
	lda <$22
	adc <$21
	sta $1021
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1011
	bne zget1
	inc $1021
zget1	ds 0
	lda $5801
	if smalend
	sta <$24
	else
	sta <$14
	endif
	bit $1020
	jmp val16

	; *** GETB
	def_inst_2op 16
	lda <$12
	clc
	adc <$11
	sta $1011
	lda <$22
	adc <$21
	sta $1021
	lda $5801
	bit $1020
	jmp val8

	; *** ADD
	def_inst_2op 20
	clc
	lda <$11
	adc <$12
	sta <$14
	lda <$21
	adc <$22
	sta <$24
	jmp val16

	; *** SUB
	def_inst_2op 21
	sec
	lda <$11
	sbc <$12
	sta <$14
	lda <$21
	sbc <$22
	sta <$24
	jmp val16

	; *** BAND
	def_inst_2op 9
	lda <$11
	and <$12
	sta <$14
	lda <$21
	and <$22
	sta <$24
	jmp val16

	; *** BOR
	def_inst_2op 8
	lda <$11
	ora <$12
	sta <$14
	lda <$21
	ora <$22
	sta <$24
	jmp val16

	; *** BCOM
	def_inst_1op 143
	lda <$11
	eor #$FF
	sta <$14
	lda <$21
	eor #$FF
	sta <$24
	jmp val16

	; *** BTST
	def_inst_2op 7
	lda <$11
	and <$12
	eor <$12
	sta <4
	lda <$21
	and <$22
	eor <$22
	ora <4
	bne zbtst1
	jmp predic1
zbtst1	jmp fpredic

	; *** MUL
	def_inst_2op 22
	lax <$11
	clc
	adc <$12
	bcc zmul1
	eor #255
	adc #0
zmul1	tay
	txa
	sec
	sbc <$12
	bcs zmul2
	eor #255
	adc #1
	sec
zmul2	tax
	lda multabl,y
	sbc multabl,x
	sta <$14
	php
	lda <$11
	clc
	adc <$12
	tay
	bcc zmul3
	lda multabh+256,y
	jmp zmul4
zmul3	lda multabh,y
zmul4	plp
	sbc multabh,x
	sta <$24
	; low*high
	lax <$11
	clc
	adc <$22
	bcc zmul5
	eor #255
	adc #0
zmul5	tay
	txa
	sec
	sbc <$22
	bcs zmul6
	eor #255
	adc #1
	sec
zmul6	tax
	lda multabl,y
	sbc multabl,x
	clc
	adc <$24
	sta <$24
	; high*low
	lax <$21
	clc
	adc <$12
	bcc zmul7
	eor #255
	adc #0
zmul7	tay
	txa
	sec
	sbc <$12
	bcs zmul8
	eor #255
	adc #1
	sec
zmul8	tax
	lda multabl,y
	sbc multabl,x
	clc
	adc <$24
	sta <$24
	jmp val16

	; *** PUSH
	def_inst_ext 232
	inc <datasp
	ldx <datasp
	lda <$11
	sta dstackl,x
	lda <$21
	sta dstackh,x
	jmp nxtinst

	; *** POP
	def_inst_ext 233
	ldx <datasp
	dec <datasp
	lda dstackl,x
	sta <$12
	lda dstackh,x
	sta <$22
	ldx <$11
	jsr xstore
	jmp nxtinst

	; *** FSTACK
	def_inst_0op 185
	dec <datasp
	jmp nxtinst

	; *** SET
	def_inst_2op 13
	lda <$12
	sta <$14
	lda <$22
	sta <$24
	ldx <$11
	jsr xstore
	jmp nxtinst

	; *** VALUE
	def_inst_1op 142
	ldx <$11
	jsr xvalue
	jmp val16

	; *** INC
	def_inst_1op 133
	ldx <$11
	jsr xvalue
	inc <$14
	bne zinc1
	inc <$24
zinc1	jsr xstore
	jmp nxtinst

	; *** DEC
	def_inst_1op 134
	ldx <$11
	jsr xvalue
	ldy <$14
	dey
	sty <$14
	cpy #255
	bne zinc1
	dec <$24
	jsr xstore
	jmp nxtinst

	; Store value from <$x4 into variable labeled X
xstore	lda <$14
	cpx #0
	bne xstore1
	; Top of stack
	ldy <datasp
	sta dstackl,y
	lda <$24
	sta dstackh,y
	rts
xstore1	cpx #16
	bcs xstore2
	; Local variable
	sta <locall,x
	lda <$24
	sta <localh,x
	rts
	; Global variable
xstore2	ldy globadl,x
	sty $1014
	ldy globadh,x
	sty $1024
	if smalend
	sta $5801
	else
	ldy <$24
	sty $5801
	endif
	inc $1014
	if globodd
	bne xstore3
	inc $1024
	endif
xstore3	if smalend
	lda <$24
	endif
	sta $5801
	lda $1020
	rts

	; Read from variable labeled X into <$x4
xvalue	txa
	bne xvalue1
	; Top of stack
	ldy <datasp
	lda dstackl,y
	sta <$14
	lda dstackh,y
	sta <$24
	rts
xvalue1	cpx #16
	bcs xvalue2
	; Local variable
	lda <locall,x
	sta <$14
	lda <localh,x
	sta <$24
	rts
	; Global vaiable
xvalue2	ldy globadl,x
	sty $1015
	ldy globadh,x
	sty $1025
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1015
	if globodd
	bne xvalue3
	inc $1025
	endif
xvalue3	lda $5801
	if smalend
	sta <$24
	else
	sta <$14
	endif
	bit $1020
	rts

	; *** IN?
	def_inst_2op 6
	ldx <$11
	clc
	lda objadl,x
	adc #4
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	bit $1020
	eor <$21
	bne zin1
	jmp predic1
zin1	jmp fpredic

	; *** FSET?
	def_inst_2op 10
	ldx <$11
	ldy <$12
	clc
	lda objadl,x
	adc flagad,y
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	and flagbit,y
	bne zfsetp1
	bit $1020
	jmp predic1
zfsetp1	jmp fpredic

	; *** FSET
	def_inst_2op 11
	ldx <$11
	ldy <$12
	clc
	lda objadl,x
	adc flagad,y
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	ora flagbit,y
	sta $5801
	bit $1020
	jmp nxtinst

	; *** FCLEAR
	def_inst_2op 12
	ldx <$11
	ldy <$12
	clc
	lda objadl,x
	adc flagad,y
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	and flagbic,y
	sta $5801
	bit $1020
	jmp nxtinst

	; *** LOC
	def_inst_1op 131
	ldx <$11
	clc
	lda objadl,x
	adc #4
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	bit $1020
	jmp val8

	; *** FIRST?
	def_inst_1op 130
	ldx <$11
	clc
	lda objadl,x
	adc #6
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	bit $1020
	jmp valp

	; *** NEXT?
	def_inst_1op 129
	ldx <$11
	clc
	lda objadl,x
	adc #5
	sta $5010
	lda objadh,x
	adc #0
	sta $5020
	lda $5801
	bit $1020
	; fall through

	; Value of instruction is 8-bits (from A)
	; Predicate is then if value is nonzero
valp	fetch_pc y,ldx
	bne valpa
	; Push to stack
	inc <datasp
	ldy <datasp
	sta dstackl,y
	sta <4
	txa
	sta dstackh,y
	lda <4
	jmp valpd1
valpa	cpx #16
	bcs valpb
	; Local variable
	sta <locall,x
	ldy #0
	sty <localh,x
	jmp valpd
	; Global variable
valpb	ldy globadl,x
	sty $1014
	ldy globadh,x
	sty $1024
	if smalend
	sta $5801
	else
	ldy #0
	sty $5801
	endif
	inc $1014
	if globodd
	bne valpc
	inc $1024
	endif
valpc	if smalend
	ldy #0
	sty $5801
	else
	sta $5801
	endif
	bit $1020
valpd	tax
valpd1	beq valpe
	jmp fpredic
valpe	jmp tpredic

	; Macro to do one step of ARCFOUR
	; Result is stored in accumulator
	macro do_arcfour
	inc <$3D
	ldx <$3D
	lda arcfour,x
	pha
	clc
	adc <$3E
	sta <$3E
	tay
	sta arcfour,y
	pla
	sta arcfour,x
	clc
	adc arcfour,y
	tax
	lda arcfour,x
	endm

	; *** RANDOM
	def_inst_ext 231
	ldx <$21
	beq zrand1
	lda bit1tab,x
	sta <$23
	lda #$FF
	jmp zrand2
zrand1	ldx <$11
	lda bit1tab,x
zrand2	sta <$13
zrand3	do_arcfour
	and <$23
	sta <$24
	cmp <$21
	beq zrand4 ; exactly equal
	bcs zrand1 ; try again; out of range
	jmp zrand5 ; low byte doesn't need to check
zrand4	do_arcfour
	and <$13
	cmp <$11
	bcs zrand1 ; try again; out of range
	adc #1
	sta <$14
	jmp zrand6
zrand5	do_arcfour
	sec
	adc #0
	sta <$14
zrand6	lda #0
	adc <$24
	sta <$24
	jmp val16

	; *** JUMP
	def_inst_1op 140
	lda <$11
	sec
	sbc #2
	tax
	lda <$21
	sbc #0
	tay
	bpl zjump1
	dec <$0E
zjump1	txa
	clc
	adc <$10
	sta <$10
	tya
	adc <$20
	sta $1020
	bcc zjump2
	inc <$0E
zjump2	jmp nxtinst

	; Macro to find a property, given object and property number
	; Object in <$11, property in <$12, branch to \1 if found
	; If \1 is with # at front then assume always will be found
	; X contains property size only in high 3-bits if found
	; X contains property number if not found
	; Output is $1014 and $1024 with address of property id
	macro propfind
	; Find the property table
	ldx <$11
	clc
	lda objadl,x
	adc #7
	sta $1015
	lda objadh,x
	adc #0
	sta $1025
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1015
	bne n\@a
	inc $1025
n\@a	lda $5801
	if smalend
	sta $1014
	bit $1024
	else
	sta $1024
	bit $1014
	endif
	; Skip the short description
	lda $5801
	sec
	rol a
	bcc n\@d
	inc $1024
	clc
n\@d	adc <$14
	sta $1014
	bcc n\@b
	inc $1024
	; Find this property
n\@b	lda $5081
	if '\<1'!='#'
	beq n\@c
	endif
	eor <$12
	tax
	and #$1F
	if '\<1'='#'
	beq n\@c
	else
	beq \1
	endif
	lda ptsizt,x
	sec
	adc <$14
	sta $1014
	bcc n\@b
	inc $1024
	jmp n\@b
n\@c	ds 0
	endm

	; *** GETPT
	def_inst_2op 18
	propfind zgetpt1
	lda $1020
	and #0
	jmp val8
zgetpt1	lda $1020
	inc <$14
	bne zgetpt2
	inc <$24
zgetpt2	jmp val16	

	; *** GETP
	def_inst_2op 17
	propfind zgetp2
	; Use default value
	asl <$11
	rol <$21 ;clears carry
	lda #low(object-2)
	adc <$11
	sta $1015
	lda #high(object-2)
	adc <$21
	sta $1025
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1015
	if object&1
	bne zgetp1
	inc $1025
	endif
zgetp1	lda $5801
	if smalend
	sta <$24
	else
	sta <$14
	endif
	bit $1020
	jmp val16
	; Use actual value
zgetp2	inc $1014
	bne zgetp3
	inc $1024
zgetp3	cpx #$20
	bne zgetp5
	; Long property
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1014
	bne zgetp4
	inc $1024
zgetp4	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	jmp val16
	; Short property
zgetp5	lda $5801
	bit $1020
	jmp val8

	; *** PUTP
	def_inst_ext 227
	propfind #
	inc $1014
	bne zputp2
	inc $1024
zputp2	cpx #$20
	bne zputp4
	; Long property
	if smalend
	lda <$13
	else
	lda <$23
	endif
	sta $5801
	inc $1014
	bne zputp3
	inc $1024
zputp3	if smalend
	lda <$23
	else
	lda <$13
	endif
	sta $5801
	lda $1020
	jmp nxtinst
	; Short property
zputp4	lda <$13
	sta $5801
	lda $1020
	jmp nxtinst

	; *** NEXTP
	def_inst_2op 19
	ldx <$11
	bne znextp4
	; Find first property
	clc
	lda objadl,x
	adc #7
	sta $1015
	lda objadh,x
	adc #0
	sta $1025
	lda $5801
	if smalend
	sta <$14
	else
	sta <$24
	endif
	inc $1015
	bne znextp1
	inc $1025
znextp1	lda $5801
	if smalend
	sta $1014
	bit $1024
	else
	sta $1024
	bit $1014
	endif
	; Skip the short description
	lda $5801
	sec
	rol a
	bcc znextp2
	inc $1024
	clc
znextp2	adc <$14
	sta $1014
	bcc znextp3
	inc $1024
znextp3	lda $5801
	and #$1F
	bit $1020
	jmp val8
znextp4	propfind #
	lda ptsizt,x
	sec
	adc <$14
	sta $1014
	bcc znextp5
	inc $1024
znextp5	lda $5801
	bit $1020
	and #$1F
	jmp val8

	; *** REMOVE
	def_inst_1op 137
	lda #0
	sta <$12
	; fall through

	; *** MOVE
	def_inst_2op 14
	; Find the LOC of first object, see if need to remove
	ldx <$11
	clc
	lda objadl,x
	adc #4
	sta $1013
	lda objadh,x
	adc #0
	sta $1023
	lda $5801
	ldy <$12
	sty $5801
	tay
	beq zmove2
	; Look at the NEXT slot too
	inc $1013
	bne zmove1
	inc $1023
zmove1	ldy $5801
	ldx #0
	stx $5801
	; Find it in the FIRST-NEXT chain of the parent object
	tax
	lda objadl,x
	adc #6
	sta $1014
	lda objadh,x
	adc #0
	sta $1024
	lax $5801 ; not adjust carry flag
	eor <$11
	bne zmove3
	; It is the first child object
	; Let First(Parent)=Next(Child)
	sty $5801
	jmp zmove2
	; It is not the first child object
zmove3	lda objadl,x
	adc #5
	sta $1014
	lda objadh,x
	adc #0
	sta $1024
	lax $5801
	eor <$11
	bne zmove3
	; It is found
	sty $5801
	; Now insert the object into the new container (if nonzero)
zmove2	ldx <$12
	beq zmove4
	lda objadl,x
	adc #6
	sta $1014
	lda objadh,x
	adc #0
	sta $1024
	ldy $5801
	stx $5801
	bit $1013
	bit $1023
	sty $5801
zmove4	lda $1020
	jmp nxtinst

	; Print a space
space	lda <$30
	cmp #$E2
	bne space1
	lda <$31
	and #$1F
	bne space1
	jsr bufout
	lda <$31
	and #$1F
	bne space2
space1	inc <$31
space2	rts

	; Output and clear the buffer
bufout	lda <$31
	anc #$1F
	adc <$30
	bcc bufout0
	jsr addlin1
bufout0	ldx #0
	lda <$32
	ldy <$31
bufout1	bit $2002
	bpl bufout1
	stx $2001 ; render off
	sta $2006
	sty $2006
	ldx #$E2
	cpx <$30
	beq bufout3
bufout2	lda <0,x
	sta $2007
	inx
	cpx <$30
	bne bufout2
bufout3	tya
	anc #$1F
	bne bufout4
	; Blank the bottom row (just scrolled in)
	lda <5
	sta $2006
	lda <4
	sta $2006
	lda #32
	sta $2007 ;1
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;10
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;20
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;30
bufout4	lda #$F8
	sta $2005
	ldx <$33
	stx $2005
	anc #$08
	sta $2001
	sta $2000
	lda <$30
	sbc #$E1
	clc
	adc <$31
	sta <$31
	lda <$32
	adc #0
	sta <$32
	lda #$E2
	sta <$30
bufout5	rts

	; Skip to the next line
addline	sec
addlin1	lda <$33
	adc #7
	sta <$33
	cmp #$F0
	bcc addlin2
	anc #0
	sta <$33
addlin2	lda <$31
	and #$E0
	adc #$20
	sta <$31
	lda <$32
	adc #0
	sta <$32
	cmp #$27
	bne addlin3
	lda <$31
	cmp #$C0
	bne addlin3
	lda #$24
	sta <$32
	lda #0
	sta <$31
	; Prepare address to blank out the line
addlin3	lax <$31
	clc
	adc #$40
	sta <4
	lda <$32
	adc #0
	sta <5
	cmp #$27
	bcc addlin4
	cpx #$80
	bcc addlin4
	lda #$24
	sax <4
	sta <5
addlin4	dec <$34
	bne addlin5
	lda #27
	sta <$34
	jmp more
addlin5	rts

	; Display the <MORE> prompt
more	ldx #0
	lda <$32
	ldy <$31
more1	bit $2002
	bpl more1
	stx $2001 ; render off
	sta $2006
	sty $2006
	lda #'<'
	sta $2007
	lda #'M'
	sta $2007
	lda #'O'
	sta $2007
	lda #'R'
	sta $2007
	lda #'E'
	sta $2007
	lda #'>'
	sta $2007
	; Blank the bottom row (just scrolled in)
	lda <5
	sta $2006
	lda <4
	sta $2006
	lda #32
	sta $2007 ;1
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;10
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;20
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007 ;30
	; Re-enable rendering
	lda #$F8
	sta $2005
	ldx <$33
	stx $2005
	anc #$08
	sta $2001
	sta $2000
	; Wait for keyboard not pushed
more2	ldx #5
	stx $4016
	dex
	ldy #9
more3	stx $4016
	lda $4017
	ora #$E1
	eor #$FF
	bne more2
	lda #6
	sta $4016
	lda $4017
	ora #$E1
	eor #$FF
	bne more2
	dey
	bne more3
	; Wait for space-bar pushed
	ldx #5
	lda #4
	ldy #6
more4	stx $4016 ;reset
	sta $4016 ;0/0
	sty $4016 ;0/1
	sta $4016 ;1/0
	sty $4016 ;1/1
	sta $4016 ;2/0
	sty $4016 ;2/1
	sta $4016 ;3/0
	sty $4016 ;3/1
	sta $4016 ;4/0
	sty $4016 ;4/1
	sta $4016 ;5/0
	sty $4016 ;5/1
	sta $4016 ;6/0
	sty $4016 ;6/1
	sta $4016 ;7/0
	sty $4016 ;7/1
	sta $4016 ;8/0
	sty $4016 ;8/1
	and $4017
	bne more4
	; Erase <MORE>
	lda #0
	sta $2001
	lda <$32
	sta $2006
	lda <$31
	sta $2006
	lda #32
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	sta $2007
	rts

	; *** PRINTC
	def_inst_ext 229
	lda <$11
	beq zprntc2
	cmp #32
	beq zprntc1
	cmp #13
	beq zcrlf
	ldx <$30
	beq zprntc2
	sta <0,x
	inc <$30
zprntc1	jmp nxtinst
zprntc2	jsr space
	jmp nxtinst

	; *** CRLF
	def_inst_0op 187
zcrlf	jsr bufout
	lda <$31
	ora #$1F
	sta <$31
zcrlf2	jmp nxtinst

	; *** PRINTN
	def_inst_ext 230
	lda <$30
	beq zcrlf2 ; ensure there is room in the buffer
	ldy <$11
	lax <$21
	anc #$FF
	bcc znum01
	eor #$FF
	sta <4
	ldx <$30
	inc <$30
	lda #'-'
	sta <0,x
	tya
	eor #$FF
	tay
	ldx <4
znum01	lda digit0l,y
	adc digit0h,x
	pha
	cmp #10
	lda digit1l,y
	adc digit1h,x
	pha
	cmp #10
	lda digit2l,y
	adc digit2h,x
	pha
	cmp #10
	lda #0
	adc digit3h,x
	pha
	cmp #10
	lda #0
	adc digit4h,x
	ldx <$30
	tay ; make the flag according to accumulator
	beq znum02
	; Five digits
	sta <0,x
	pla
	sta 1,x
	pla
	sta 2,x
	pla
	sta 3,x
	pla
	sta 4,x
	txa
	axs #-5
	stx <$30
	jmp nxtinst
znum02	pla
	beq znum03
	; Four digits
	sta <0,x
	pla
	sta 1,x
	pla
	sta 2,x
	pla
	sta 3,x
	txa
	axs #-4
	stx <$30
	jmp nxtinst
znum03	pla
	beq znum04
	; Three digits
	sta <0,x
	pla
	sta 1,x
	pla
	sta 2,x
	txa
	axs #-3
	stx <$30
	jmp nxtinst
znum04	pla
	beq znum05
	; Two digits
	sta <0,x
	inx
	pla
	sta <0,x
	inx
	stx <$30
	jmp nxtinst
znum05	pla
	; One digit
	sta <0,x
	inc <$30
	jmp nxtinst

	; *** PRINTI
	def_inst_0op 178
	jsr textpc
	jmp nxtinst

	; *** PRINTR
	def_inst_0op 179
	jsr textpc
	jsr bufout
	lda <$31
	ora #$1F
	sta <$31
	lda #1
	jmp ret8

	; *** PRINTB
	def_inst_1op 135
	jsr textba
	jmp nxtinst

	; *** PRINT
	def_inst_1op 141
	asl <$11
	rol <$21
	lda #0
	rol a
	sta <$36
	jsr textwa
	jmp nxtinst

	; *** PRINTD
	def_inst_1op 138
	ldx <$11
	clc
	lda objadl,x
	adc #7
	sta $1012
	lda objadh,x
	adc #0
	sta $1022
	if smalend
	lda $5801
	else
	ldy $5801
	endif
	inc $1012
	bne zprntd1
	inc $1022
zprntd1	if smalend
	adc #1
	sta <$11
	lda $5801
	else
	lda $5801
	adc #1
	sta <$11
	tya
	endif
	adc #0
	sta <$21
	jsr textba
	jmp nxtinst

	; *** VERIFY
	def_inst_0op 189
	jmp tpredic ; there is no disk, so just assume it is OK

	; *** QUIT
	def_inst_0op 186
	jsr bufout
	lda <$31
	ora #$1F
	sta <$31
	jsr bufout
zquit	jmp zquit

	; *** READ
	jsr bufout
	;TODO
zread	jmp zread

	bank intbank+3
	; Z-character decoding
	; high 3-bits = state, low 5-bits = value

	org $F100-12
	; Text starting from program counter
textpc	lda #0
	sta <$38
	sta <$27
	ldx #$A0
	stx <$09
	stx <$0A

	org $F100
	lda <$27
	bmi textpc1
	lda #$F2
	sta <$39
	lda #$FE
	pha
	fetch_pc y,lda
	if smalend
	sta <$17
	else
	sta <$27
	endif
	if smalend
	fetch_pc y,lda
	sta <$27
	else
	fetch_pc y,ldx
	stx <$17
	endif
	lsr a
	lsr a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
textpc1	rts

	org $F200
	lda #$FE
	pha
	inc <$39
	ldx <$17
	stx <4
	lda <$27
	asl <4
	rol a
	asl <4
	rol a
	asl <4
	rol a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $F300
	lda #$F1
	sta <$39
	lda #$FE
	pha
	lda <$17
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $F400-12
	; Text from byte address
textba	lda #0
	sta <$38
	sta <$27
	ldx #$A0
	stx <$09
	stx <$0A

	org $F400
	lda <$27
	bmi textba1
	lda #$F5
	sta <$39
	lda #$FE
	pha
	lda $1011
	lda $1021
	lda $5803
	if smalend
	sta <$17
	else
	sta <$27
	endif
	inc $1011
	bne textba2
	inc $1021
textba2	if smalend
	lda $5803
	sta <$27
	else
	ldx $5803
	stx <$17
	endif
	inc $1011
	bne textba3
	inc $1021
textba3	lsr a
	lsr a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts
textba1	bit $1020
	rts

	org $F500
	lda #$FE
	pha
	inc <$39
	ldx <$17
	stx <4
	lda <$27
	asl <4
	rol a
	asl <4
	rol a
	asl <4
	rol a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $F600
	lda #$F4
	sta <$39
	lda #$FE
	pha
	lda <$17
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $F700-12
	; Text from word address (aligned)
textwa	lda #0
	sta <$38
	sta <$27
	ldx #$A0
	stx <$09
	stx <$0A

	org $F700
	lda <$27
	bmi textwa1
	lda #$F8
	sta <$39
	lda #$FE
	pha
	lda $1011
	lda $1021
	ldy <$36
	lda $5803,y
	if smalend
	sta <$17
	else
	sta <$27
	endif
	if smalend
	inc $1011
	lda $5803,y
	sta <$27
	else
	ldx $5803,y
	stx <$17
	endif
	inc $1011
	bne textwa4
	inc $1021
	bne textwa4
	inc <$36
textwa4	lsr a
	lsr a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts
textwa1	bit $1020
	rts

	org $F800
	lda #$FE
	pha
	inc <$39
	ldx <$17
	stx <4
	lda <$27
	asl <4
	rol a
	asl <4
	rol a
	asl <4
	rol a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $F900
	lda #$F7
	sta <$39
	lda #$FE
	pha
	lda <$17
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $FA00-20
	; Text from frequent word
textfw	lda #0
	sta <$38
	sta <$29
	lda <$0A
	sta <$0B
	ldx #$A0
	stx <$09
	stx <$0A
	lda <$39
	sta <$35

	org $FA00
	lda <$29
	bmi textfw1
	lda #$FB
	sta <$39
	lda #$FE
	pha
	ldy <$37
	lda $5803,y
	if smalend
	sta <$19
	else
	sta <$29
	endif
	inc $1016
	if smalend
	lda $5803,y
	sta <$29
	else
	ldx $5803,y
	stx <$19
	endif
	inc $1016
	bne textfw2
	inc $1026
	bne textfw2
	inc <$37
textfw2	lsr a
	lsr a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts
textfw1	bit $1020
	lda <$35
	sta <$39
	lda <$0B
	sta <$0A
	sta <$09
	jmp [$38]

	org $FB00
	lda #$FE
	pha
	inc <$39
	ldx <$19
	stx <4
	lda <$29
	asl <4
	rol a
	asl <4
	rol a
	asl <4
	rol a
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	org $FC00
	lda #$FA
	sta <$39
	lda #$FE
	pha
	lda <$19
	anc #31
	ora <$09
	tax
	lda zchad,x
	pha
	rts

	; States can be:
	;   0   = Second step of ASCII escape
	;   1-3 = Fwords
	;   4   = First step of ASCII escape
	;   5-7 = Shift states 0,1,2

	; These subroutines are entered with X set to the state.
	; Also has carry flag cleared.
	org $FE01

	; ** Emit a space
	def_zchars $A0
	def_zchars $C0
	def_zchars $E0
zch32	jsr space
	jmp [$38]

	; ** Second escape
	def_zchars $00,$1F
	txa
	ora <5
	beq zch1
	cmp #32
	beq zch32
	cmp #13
	beq zch13
	ldx <$30
	beq zch1
	sta <0,x
	inc <$30
	lda <$0A
	sta <$09
	jmp [$38]

	; ** First escape
	def_zchars $80,$9F
	txa
	asl a
	asl a
	asl a
	asl a
	asl a
	sta <5
	anc #0
	sta <$09
	jmp [$38]

	; ** Frequent words
	def_zchars $20,$7F
	lda fwordsl,x
	sta $1015
	lda fwordsh,x
	sta $1025
	lda $5801
	if smalend
	asl a
	sta <$16
	else
	sta <$26
	lda #0
	rol a
	sta <$37
	endif
	inc $1015
	bne zfw1
	inc $1025
zfw1	lda $5801
	if smalend
	rol a
	sta <$26
	else
	asl a
	sta <$16
	rol <$26
	endif
	lda #0
	adc #0
	sta <$37
	jmp textfw

	; ** Begin escape
	def_zchars $E6
	lda #$80
	sta <$09
	jmp [$38]

	; ** Direct character code
	def_zchars $A6,$BF
	def_zchars $C6,$DF
	def_zchars $E8,$FF
	ldy <$30
	beq zch1
	stx <$E0,y
	inc <$30
zch1	lda <$0A
	sta <$09
	jmp [$38]

	; ** Emit a line break
	def_zchars $E7
zch13	jsr bufout
	lda <$31
	ora #$1F
	sta <$31
	lda <$0A
	sta <$09
	jmp [$38]

	; ** Begin frequent words state 0-31
	def_zchars $A1
	def_zchars $C1
	def_zchars $E1
	lda #$20
	sta <$09
	jmp [$38]

	; ** Begin frequent words state 32-63
	def_zchars $A2
	def_zchars $C2
	def_zchars $E2
	lda #$40
	sta <$09
	jmp [$38]

	; ** Begin frequent words state 64-95
	def_zchars $A3
	def_zchars $C3
	def_zchars $E3
	lda #$60
	sta <$09
	jmp [$38]

	; ** Temporary shift 1
	def_zchars $A4
	lda #$C0
	sta <$09
	jmp [$38]

	; ** Temporary shift 2
	def_zchars $A5
	lda #$E0
	sta <$09
	jmp [$38]

	; ** Permanent shift 1 or 2
	def_zchars $C4
	def_zchars $E5
	and #$F0
	sta <$0A
	jmp [$38]

	; ** Permanent shift 0
	def_zchars $C5
	def_zchars $E4
	lda #$A0
	sta <$09
	sta <$0A
	jmp [$38]

	; Reset vector
	bank intbank+3
	org $FFFA
	dw 0,reset,0

	; Pattern tables
	bank intbank+4
	org $0000
	incbin "pc.chr"

	; Cursor icon
	org $07F0
	defchr $00000000, \
	       $03030300, \
	       $00303030, \
	       $03030300, \
	       $00303030, \
	       $03030300, \
	       $00303030, \
	       $00000000

	; Postprocessor
	emu

	org $0000
	lda 0
	sta $2012
	inc <1
	rts

	org $0040
	db "0123456789012345"
	db "6789012345678901"

	org $0080
	db "                                "   ; $80-$9F
	db "      abcdefghijklmnopqrstuvwxyz"   ; $A0-$BF
	db "      ABCDEFGHIJKLMNOPQRSTUVWXYZ"   ; $C0-$DF
	db "      **0123456789.,!?_#'\"/\\-:()" ; $E0-$FF

	org $8000
	cld

	; Make duplicates of ASCII characters as Z-characters
	lda #1
	sta $200D
	lda #0
	sta $200E
	lda #8
	sta $200F
	ldx #$80
pp1	lda #4
	sta <2
	lda <0,x
	asl a
	rol <2
	asl a
	rol <2
	asl a
	rol <2
	asl a
	rol <2
	sta <1
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	inx
	bne pp1

	; Make duplicate of digits for use with PRINTN
	ldx #0
	stx $200E
	stx $200F
pp2	lda #4
	sta <2
	lda <$40,x
	asl a
	rol <2
	asl a
	rol <2
	asl a
	rol <2
	asl a
	rol <2
	sta <1
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	jsr 0
	inx
	cpx #32
	bne pp2

	; Finished
	hlt

	org $FFFC
	dw $8000

	code
	bank intbank+4

C program

This program is generating a stub file and story ROM for its use. 

/*
  This file is part of Famizork II and is in the public domain.
*/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

static FILE*fp;
static int c;
static int d;
static int gamesize;
static char endian;
static unsigned char mem[0x20000];
static char buf[256];

#define OUTHEADER(x,y) fprintf(fp,"%s\t= %u\n",x,(mem[y*2+endian]<<8)|mem[y*2+1-endian])

int main(int argc,char**argv) {
  if(argc<2) return 1;
  fp=fopen(argv[1],"rb");
  fseek(fp,0,SEEK_END);
  gamesize=ftell(fp);
  if(gamesize>0x20000 || gamesize<0) return 1;
  fseek(fp,0,SEEK_SET);
  fread(mem,1,gamesize,fp);
  fclose(fp);
  if(*mem!=3) return 1;
  sprintf(buf,"%s.asm",argv[1]);
  fp=fopen(buf,"w");
  endian=mem[1]&1;
  mem[1]&=3;
  mem[1]|=16;
  c=(gamesize>0x10000?16:gamesize>0x8000?8:gamesize>0x4000?4:2);
  fprintf(fp,"\tnes2prgram 0,131072\n");
  fprintf(fp,"\tinesprg %d\n",(c>>1)+2);
  fprintf(fp,"intbank\t= %d\n",c);
  fprintf(fp,"smalend\t= %d\n",endian);
  fprintf(fp,"large\t= %d\n",gamesize>=0x10000);
  if(gamesize<0x10000) fprintf(fp,"maxaddr\t= %u\n",gamesize-1);
  OUTHEADER("start",3);
  OUTHEADER("vocab",4);
  OUTHEADER("object",5);
  OUTHEADER("global",6);
  OUTHEADER("purbot",7);
  OUTHEADER("fwords",12);
  fprintf(fp,"\tcode\n\tbank 0\n\tincbin \"%s.rom\"\n\tinclude \"famizork2.asm\"\n",argv[1]);
  fprintf(fp,"\n\tbank %d\n\torg fwordsl\n",c);
  d=(mem[24+endian]<<8)|mem[25-endian];
  for(c=0;c<192;c+=2) fprintf(fp,"\tdb %d\n",(d+c)&255);
  for(c=0;c<192;c+=2) fprintf(fp,"\tdb %d\n",((d+c)>>8)&255);
  fprintf(fp,"\torg multabl\n");
  for(c=0;c<255;c++) fprintf(fp,"\tdb %d\n",((c*c)>>2)&255);
  for(c=0;c<512;c++) fprintf(fp,"\tdb %d\n",((c*c)>>10)&255);
  fprintf(fp,"\tbank intbank+4\n");
  fclose(fp);
  sprintf(buf,"%s.rom",argv[1]);
  fp=fopen(buf,"wb");
  if(gamesize>0x10000) {
    fwrite(mem+0x10000,1,0x10000,fp);
    fwrite(mem,1,0x10000,fp);
  } else {
    fwrite(mem,1,gamesize,fp);
  }
  fclose(fp);
  return 0;
}

Explanation

The explanation of the mapper is User:Zzo38/Mapper_I.

The pattern table is arranged in this way (although $7F is the cursor picture, not shown here): 

0123456789012345
6789012345678901
 !"#$%&'()*+,-./
0123456789:;<=>?
@ABCDEFGHIJKLMNO
PQRSTUVWXYZ[\]^_
`abcdefghijklmno
pqrstuvwxyz{|}~
                
                
      abcdefghij
klmnopqrstuvwxyz
      ABCDEFGHIJ
KLMNOPQRSTUVWXYZ
      **01234567
89.,!?_#'"/\-:()

As you can see there are many duplicates, in particular each digit occurs five times, except 0 and 1 which occur six times each. Many other characters also occur twice. These will improve the speed of the program, since it does not have to convert Z-characters and numbers into ASCII before displaying them.

Many things are precomputed at compile-time in order to improve speed (also improves size of the interpreter):

  • The mode byte is set to indicate that the status bar is unavailable
  • Address of objects, global variables, and frequent words table
  • Starting address of execution of program
  • Endianness and various calculations related to it
  • The size of the story file, which can be used to determine needed ROM sizes and optimizing of the interpreter
  • Self-inserting-breaks
  • Stuff to optimize the vocabulary (not yet)
  • Multiplication tables

A custom mapper is used, which bankswitches only one byte at a time. This makes much of the logic for addressing the story file much simpler than it otherwise would be. It also overlaps bankswitching registers with mirrors of the RAM internal to the console, and since they respond to multiple addresses, this means you can save the bankswitched value at the same time as bankswitching, that you can store multiple bank numbers at once (even though the mapper can only remember one at once), and that reading from the RAM mirrors will also bankswitch (allows you to restore a saved bankswitch in four cycles; with other mappers it is usually seven).

There is an instruction decoding table, which is one table for all instructions and contains duplicates for the different forms of the instruction (such as EXT forms of 2OP instructions, the different variable/immediate combinations for 2OP, and the different operand types for 1OP). However, a different opcode is used when EQUAL? is encoded as EXT than as 2OP, in order to improve the speed in the 2OP case. The code can just use "jmp nxtinst" to begin decoding the next instruction; it doesn't use return from subroutine.

Instruction decoding tables, as well as the Z-character decoding tables, both use the RTS trick, although in the case of Z-character decoding, the table contains only the low byte of the address since the code is small enough in this case.

Also it is using several stable unofficial opcodes.

Retrieved from "https://www.nesdev.org/w/index.php?title=User:Zzo38/Famicom_Z-machine&oldid=16925"