User:Zzo38/Famicom Z-machine
From NESdev Wiki
Jump to navigationJump to search
This file contains a copy of the working in progress for the Famicom Z-machine interpreter program.
You are free to review it, question/comment, and even to modify it if you have improvements to make. It is placed here mainly in order to improve reviewing of the software, but you can use it for other purposes too.
The assembler in use is Unofficial MagicKit (a modified version of NESASM).
This program is being written by User:Zzo38, and is using the Famicom keyboard. Only uppercase is supported; any lowercase is converted to uppercase for display (the positions for lowercase letters in the pattern table contain uppercase). The keyboard decoder still returns lowercase, since that is what the Z-machine requires.
Due to overscan, the "MORE" prompt shall assume that the top and bottom two rows are not visible, and the scrolling routine shall blank out the bottom two rows (sixteen scanlines) of the screen to hide them on displays that would show the overscanned area anyways.
Unlike many Z-machine interpreters, this one supports permanent shifts even in version 3.
; Z-machine interpreter (Z-code versions 1 to 3) for Famicom ; version 0.0 ; Public domain inesmap 5 ; MMC5 or "User:Zzo38/Mapper D" inesmir 1 ; Horizontal arrangement inesprg 16 ; 256K (bank 0 to 15 for story file, 16 to 31 for interpreter) ineschr 1 ; 8K ; The C program will read, adjust the header, and then set asm macros, as follows: ; zver: Z-machine version number. ; bytswap: Defined for small endian, undefined for big endian ; endlod: Beginning of non-preloaded code (this program extends core to 64K for simplicity) ; purbot: Beginning of data to not enter into save file ; start: Location where execution begins ; vocab: Points to vocabulary table ; sibcnt: Number of self-inserting break characters ; voccnt: Number of entries in vocabulary table ; ventsiz: Entry size of vocabulary table ; object: Points to object table ; globals: Points to global variable table ; fwords: Points to fwords table ; plenth: Length of program in words ; pchksm: Checksum of all bytes xobject = object+62-9 ; Offset for object headers xglobal = global-32 ; Offset for global variables xvocab = vocab+sibcnt+4 ; Actual start of vocab ; Low RAM usage: ; $0xx = Miscellaneous variables ; $1xx = 6502 stack ; $2xx = Bits 7:0 of Z-machine data stack ; $3xx = Bits 15:8 of Z-machine data stack ; $4xx = Bits 7:0 of Z-machine call stack ; $5xx = Bits 15:8 of Z-machine call stack ; $6xx = Bit 16 of Z-machine call stack ; $7xx = Pointer to bottom of data stack for a routine zp outbuf ds 32 ; The output buffer r0 ds 1 r1 ds 1 r2 ds 1 r3 ds 1 op0l ds 1 ; First operand of an instruction op0h ds 1 op1l ds 1 op1h ds 1 op2l ds 1 op2h ds 1 op3l ds 1 op3h ds 1 argtyp ds 1 ; Storage of argument types (used for EQUAL? and CALL) cstkcnt ds 1 ; Count of entries on the call stack dstkcnt ds 1 ; Count of entries on the data stack cursx ds 1 ; Cursor X position readcnt ds 1 ; Number of characters input cursxin ds 1 ; Cursor X position at start of input line linecnt ds 1 ; Number of lines output before pausing (to implement "MORE") bufptr ds 1 ; Pointer into output buffer pcl ds 1 ; Low byte of program counter pcm ds 1 ; Mid byte of program counter pch ds 1 ; High byte of program counter vlub ds 4 ; Vocabulary look up buffer byth ds 1 ; High byte of value reading from memory (low byte is accum) mapad ds 2 ; Mapped address (second byte is zero) corel ds 1 coreh ds 1 idxl ds 1 idxh ds 1 outrdy ds 1 ; To set if output buffer is ready to display on the screen. linrdy ds 1 ; To set if ready to add a linefeed to output pshift ds 1 ; Permanent shift state (one of: $00, $20, $40) tshift ds 1 ; Temporary shift state ($60=high escape, $80=low escape, $A0=fwords) chroff ds 1 ; Partial character code or FWORDS index blinker ds 1 ; Cursor blink time curspal ds 1 ; Color of cursor keychar ds 1 ; Keyboard character to print scrolly ds 1 ; Scroll position ($00 to $E8) lladl ds 1 ; Low byte of address of last line ($00 to $E0) lladh ds 1 ; High byte of address of last line ($20 to $23) rambank = $5113 ; xxxx xxxx rombank = $5115 ; 1xxx xxx0 ; Mapping ROM address: ; Bank = ((A>>13)|128)&254 ; Address = (A&$3FFF)|$8000 ; Mapping RAM address: ; Bank = A>>13 ; Address = (A&$1FFF)|$6000 macro romsel lda #128|bank(\1)&254 sta rombank endmac macro bankcall ldy #128|bank(\1)&254 sty rombank jsr \1 endmac macro bankjump ldy #128|bank(\1)&254 sty rombank jmp \1 endmac code bank 16 org $8000 ; Alphabet table row 2 if zver=1 alpha2 db 32, 13, "*****0123456789.,!?_#'", 34, "/", 92, "<-:()" else alpha2 db " ******", 13, "0123456789.,!?_#'", 34, "/", 92, "-:()" endif ; Keyboard decoding table (lowercase is necessary) kbdt db "][", 13, 0, 0, 92, 15, 0 db ";:@", 0, "^-/_" db "klo", 0, "0p,." db "jui", 0, "89nm" db "hgy", 0, "67vb" db "drt", 0, "45cf" db "asw", 0, "3ezx" db 0, "q", 0, 0, "21", 0, 15 db 0, 0, 0, 12, 0, 8, 32, 0 ; Do the sending of output buffer sendout inc <outrdy ;TODO lda #0 sta <bufptr pla rti ; Send a line feed sendlf inc <linrdy lda #1 sta <cursx ;TODO pla rti ; Ready the output buffer for dumping to the screen ; And then, wait for the NMI routine to clear it outdump dec <outrdy outdum1 bit <outrdy bvs outdum1 outdum2 rts ; Ready to output a line feed ; Wait for NMI routine to clear the flag lfodump dec <outrdy lfdump dec <linrdy lfdump1 bit <linrdy bvs lfdump1 lfdump2 rts ; Print a character putchar cmp #0 beq lfdump2 ; outputting ASCII code 0 has no effect cmp #13 beq lfodump ; output the buffer and a line break cmp #32 beq endword ; output a word and a space ldx <cursx cpx #31 bcc putcha1 jsr lfdump putcha1 ldx <bufptr sta <outbuf,x inc <bufptr rts endword jsr outdump cpx #31 bcs lfdump bcc putcha1 ; Convert and print a Z-character putzch and #$1F tay ora <tshift tax lda #$BF pha lda zchlut,x pha rts bank 17 org $BE00 zchlut ; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ; 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 if zver=1 db zza2,zza2,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zza2,zza2,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zza2,zza2,zzt0,zzt1,zzp0,zzp1,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 endif if zver=2 db zza2,zzfw,zzt1,zzt2,zzp1,zzp2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zza2,zzfw,zzt2,zzt0,zzp2,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zza2,zzfw,zzt0,zzt1,zzp0,zzp1,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 endif if zver=3 db zza2,zzfw,zzfw,zzfw,zzt1,zzt2,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;0 db zza2,zzfw,zzfw,zzfw,zzp1,zzp0,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal,zzal ;1 db zza2,zzfw,zzfw,zzfw,zzp0,zzp2,zzes,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 db zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2,zza2 ;2 endif db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE db zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe,zzhe ;HIGH ESCAPE db zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle ;LOW ESCAPE db zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle,zzle ;LOW ESCAPE db zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs ;FWORDS db zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs,zzfs ;FWORDS ; Subroutines for dealing with specific Z-characters below org $BF01 ; Alphabet row 0 and 1 [11] zzal = *-1 lda <pshift sta <tshift tya clc adc #59 jmp putchar ; Alphabet row 2 (and spaces and carriage return) [10] zza2 = *-1 lda <pshift sta <tshift lda alpha2,y jmp putchar ; Escape character [5] zzes = *-1 lda #$60 sta <tshift rts ; High escape [17] zzhe = *-1 sty <chroff asl <chroff asl <chroff asl <chroff asl <chroff asl <chroff lda #$80 sta <tshift rts ; Low escape [10] zzle = *-1 lda <pshift sta <tshift tya ora <chroff jmp putchar ; Temporary shift to row 0 [5] zzt0 = *-1 lda #$00 sta <tshift rts ; Temporary shift to row 1 [5] zzt1 = *-1 lda #$20 sta <tshift rts ; Temporary shift to row 2 [5] zzt2 = *-1 lda #$40 sta <tshift rts ; Permament shift to row 0 [7] zzp0 = *-1 lda #$00 sta <tshift sta <pshift rts ; Permament shift to row 1 [7] zzp1 = *-1 lda #$20 sta <tshift sta <pshift rts ; Permament shift to row 2 [7] zzp2 = *-1 lda #$40 sta <tshift sta <pshift rts ; Start fwords [17] zzfw = *-1 sty <chroff asl <chroff asl <chroff asl <chroff asl <chroff asl <chroff lda #$A0 sta <tshift rts ; Print fwords [63] zzfs = *-1 tya ora <chroff sta <idxl lda #0 sta <idxh lda #low(fwords-64) sta <corel lda #high(fwords-64) sta <coreh lda <pshift pha lda <pch pha lda <pcm pha lda <pcl pha jsr mget asl a sta <pcl lda <byth rol a sta <pcm lda #0 rol a sta <pch jsr putstr pla sta <pcl pla sta <pcm pla sta <pch pla sta <pshift sta <tshift rts bank 18 org $8000 ; More reset initialization codes reset1 bit $2002 vblw1 bit $2002 bpl vblw1 dex inx vblw2 bit $2002 bpl vblw2 lda #0 sta <mapad+1 sta <outrdy ;TODO ; Instruction decoding table opccnt = 236 macro opcode org opctab+(\1) db high((\2)-1) ; Subtracting 1 so that RTS trick will be used org opctab+(\1)+opccnt db low((\2)-1) if (\1)<$20 opcode (\1)+$20, \2 opcode (\1)+$40, \2 opcode (\1)+$60, \2 opcode (\1)+$C0, \2 endif if ((\1)>$7F)&((\1)<$90) opcode (\1)+$10, \2 opcode (\1)+$20, \2 endif endmac opctab ds opccnt*2 opcode 1, z_equal opcode 2, z_less opcode 3, z_grtr opcode 4, z_dless opcode 5, z_igrtr opcode 6, z_in opcode 7, z_btst opcode 8, z_bor opcode 9, z_band opcode 10, z_ftst opcode 11, z_fset opcode 12, z_fclr opcode 13, z_set opcode 14, z_move opcode 15, z_get opcode 16, z_getb opcode 17, z_getp opcode 18, z_getpt opcode 19, z_nextp opcode 20, z_add opcode 21, z_sub opcode 22, z_mul opcode 23, z_div opcode 24, z_mod opcode 128, z_zero opcode 129, z_next opcode 130, z_first opcode 131, z_loc opcode 132, z_ptsiz opcode 133, z_inc opcode 134, z_dec opcode 135, z_prntb opcode 137, z_remov opcode 138, z_prntd opcode 139, z_ret opcode 140, z_jump opcode 141, z_print opcode 142, z_value opcode 143, z_bcom opcode 176, z_rtrue opcode 177, z_rfals opcode 178, z_prnti opcode 179, z_prntr opcode 180, z_noop opcode 181, z_save opcode 182, z_rstor opcode 183, z_rest opcode 184, z_rstac opcode 185, z_fstac opcode 186, z_quit opcode 187, z_crlf opcode 188, z_usl opcode 189, z_vrfy opcode 224, z_call opcode 225, z_put opcode 226, z_putb opcode 227, z_putp opcode 228, z_read opcode 229, z_prntc opcode 230, z_prntn opcode 231, z_randm opcode 232, z_push opcode 233, z_pop opcode 234, z_split opcode 235, z_scrn org opctab+(opccnt*2) bank 30 org $C000 ; Print a string putstr lda #0 sta <pshift sta <tshift putstr1 jsr pcgetw pha sta <r1 lda <byth lsr a ror <r1 lsr a ror <r1 bankcall putzch lda <r1 lsr a lsr a lsr a jsr putzch pla jsr putzch bit <byth bpl putstr1 rts ; Read a word from instruction pointer pcgetw jsr pcgetb sta <byth ; falls through ; Read a byte from instruction pointer, write to A ; (clobbers X, Y, and flags) pcgetb ldy <pcl ; To use later lda <pch bne pcgetbh ; In high memory; it is greater than 64K ; It is in core memory (always 64K in this program) lax <pcm and #$1F ora #$60 sta <mapad txa lsr a lsr a lsr a lsr a lsr a sta rambank lda [mapad],y jmp pcinc pcgetbh ; 0000 0001 xxyy yyyy zzzz zzzz -> bank=1000 1xx0, mem=10yy yyyy lax <pcm and #$3F ora #$80 sta <mapad txa lsr a lsr a lsr a lsr a lsr a and #$06 ora #$88 sta romback lda [mapad],y pcinc inc <pcl bne pcirts inc <pcm bne pcirts inc <pch pcirts rts ; Deal with reading a register (as VALUE) ; Register in A, result in <byth and A fetch cmp #16 bcc fetch1 ; Global variables sta <idxl lda #0 sta <idxh lda #low(xglobal) sta <corel lda #high(xglobal) sta <coreh jmp mget fetch1 cmp #0 bne fetch3 ldx <dstkcnt bne fetch2 fetch3 ; Local variables ldx <cstkcnt ldy $6FF,x sty <r3 adc <r3 ; Carry flag is already cleared tax fetch2 lda $1FF,x sta <byth lda $2FF,x rts ; Deal with store (uses A and <byth as value; instruction as dest) ; The value A will remain there once stored tostore pha jsr pcgetb cmp #0 bne dostore inc <dstkcnt ; 'dostore' uses A as the register number, the the value on the stack ; and <byth. It also omits pushing to the stack (cf. SET, INC, DEC) dostore cmp #16 bcc store1 ; Global variables sta <idxl lda #0 sta <idxh lda #low(xglobal) sta <corel lda #high(xglobal) sta <coreh jmp mput1 store1 cmp #0 bne store3 ldx <dstkcnt bne store2 ; <dstkcnt is known to be nonzero store3 ; Local variables ldx <cstkcnt ldy $6FF,x sty <r3 adc <r3 ; Carry flag is already cleared tax store2 pla sta $1FF,x lda <byth sta $2FF,x rts ; Implement GET/GETB ; <corel=low addr, <coreh=high addr ; <idxl=low index, <idxh=high index ; A=low data, <byth=high data mget asl <idxl rol <idxh jsr mgetb sta <byth inc <idxl bne mgetb inc <idxh mgetb lda <coreh clc adc <idxh tax and #$1F ora #$60 sta <mapad txa lsr a lsr a lsr a lsr a lsr a sta rambank ldy <corel clc adc <idxl lda [mapad],y rts ; Implment PUT/PUTB ; <corel=low addr, <coreh=high addr ; <idxl=low index, <idxh=high index ; A=low data, <byth=high data mput pha mput1 asl <idxl rol <idxh lda <byth jsr mgetb sta <byth inc <idxl bne mgetb inc <idxh pla mputb pha lda <coreh clc adc <idxh tax and #$1F ora #$60 sta <mapad txa lsr a lsr a lsr a lsr a lsr a sta rambank ldy <corel clc adc <idxl pla sta [mapad],y rts ; Figure out property table address of object A ; Store ressults to <coreh and <corel ptad sta <mapad lda #low(xobject+7) sta <corel lda #high(xobject+7) sta <coreh lda #0 sta <idxh sta <byth lda <op0l asl a rol <idxh asl a rol <idxh asl a rol <idxh adc <mapad sta <idxl ; Get high octet jsr mgetb pha ; Increment object header address inc <corel if low(xobject+7)=255 inc <coreh endif ; Get low octet jsr mgetb ; Store the results sta <corel pla sta <coreh rts ; Do the relative branching using offset in A and <op0h ; If the value is 0 or 1, it returns instead of jumps rjumppc ldx <op0h bne jumppc cmp #2 bcs jumppc stx <byth jmp return ; Same as above but won't check for returns ; (also, the continuation of the above) jumppc sta <r0 lda <op0h eor #$80 ; sign conversion sta <r1 sec lda <pcl sbc #$03 ; subtract one extra, since... sta <pcl lda <pcm sbc #$80 sta <pcm lda <pch sbc #$00 ; ...carry flag is now set (due to no borrowing)... sta <pch lda <pcl adc <r0 ; ...which causes the one extra to be added back sta <pcl lda <pcm adc <r1 sta <pcm lda <pch adc #$00 sta <pch jmp nxtinst ; Deal with branch ; Condition is true if zero flag is set branch php jsr pcgetb sta <r0 pla lsr a lsr a ror a eor <r0 bmi notjump ; condition flag does not match... bit <r0 bvs branch1 ; Long branch lda <r0 asl a asl a asl a php php ror a plp ror a plp ror a sta <op0h jsr pcgetb jmp rjumppc ; Short branch branch1 lda #0 sta <op0h lda <r0 and #$3F jmp rjumppc ; Not branching notjump bit <r0 bvs nxtinst jsr pcgetb jmp nxtinst ; Return from a subroutine return dec <dstkcnt ldy <dstkcnt ldx $700,y stx <cstkcnt ldx $400,y stx <pcl ldx $500,y stx <pcm ldx $600,y stx <pch jsr tostore ; fall through ; Next instruction operation nxtinst jsr pcgetb sta <r0 bit <r0 bmi nxtins1 ; 2OP form sta <r1 lsr <r1 asl a and #$80 ora <r1 and #$90 ora <r0 eor #$60 ora #$0F bne nxtins3 nxtins1 bvs nxtins2 ; 1OP or 0OP form rol a rol a ora #$3F bne nxtins3 ; EXT form nxtins2 jsr pcgetb ; Read operands and call function (using RTS trick) nxtins3 sta <argtyp eor #$FF sta <r1 ldx <r0 romsel opctab lda opctab,x ; high byte of address pha lda opctab+opccnt,x ; low byte of address pha ldx #op0l-2 stx <r2 jsr getopr jsr getopr jsr getopr ; fall through to read the fourth operand and RTS trick ; Subroutine to read one operand of an instruction getopr ldx <r2 inx inx stx <r2 bit <r1 bvs getopr1 ;bit0=0 bmi getopr2 ;bit1=0 ; [11] No operand getopr0 asl <r1 asl <r1 rts getopr1 bmi getopr3 ;bit1=0 ; [10] Variable jsr pcgetb tay jsr fetch cpy #0 ; popped from stack bne getopr4 dec <dstkcnt jmp getopr4 ; [01] Short immediate getopr2 jsr pcgetb ldx <r2 sta <0,x lda #0 sta <1,x beq getopr0 ; [00] Long immediate getopr3 jsr pcgetw getopr4 ldx <r2 sta <0,x lda <byth sta <1,x jmp getopr0 ; **************************************** ; Z-code instructions ; Set the zero flag for condition true, clear otherwise ; <byth and A store the value to store to memory ; [2] LESS? int1,int2 /PRED z_less lda <op0h eor #$80 ; do sign conversion sta <op0h lda <op1h eor #$80 cmp <op0h bne z1less lda <op0l cmp <op1l z1less lda #0 adc #0 ; convert carry flag clear to zero flag set jmp branch ; [3] GRTR? int1,int2 /PRED z_grtr lda <op1h eor #$80 ; do sign conversion sta <op1h lda <op0h eor #$80 cmp <op1h bne z1grtr lda <op1l cmp <op0l z1grtr lda #0 adc #0 ; convert carry flag clear to zero flag set jmp branch ; [6] IN? obj1,obj2 /PRED z_in lda #low(xobject+4) sta <corel lda #high(xobject+4) sta <coreh lda #0 sta <idxh lda <op0l asl a rol <idxh asl a rol <idxh asl a rol <idxh ; now carry flag is clear, have 8x value adc <op0l ; add the object number so you have 9x in total sta <idxl jsr mgetb cmp <op1l jmp branch ; [7] BTST data,mask /PRED z_btst lda <op0h and <op1h eor <op1h beq z1btst jmp branch z1btst lda <op0l and <op1l eor <op1l jmp branch ; [8] BOR int1,int2 /VAL z_bor lda <op0h ora <op1h sta <byth lda <op0l ora <op1l jsr tostore jmp nxtinst ; [9] BAND int1,int2 /VAL z_band lda <op0h and <op1h sta <byth lda <op0l and <op1l jsr tostore jmp nxtinst ; [13] SET var,value z_set lda <op1l pha lda <op1h sta <byth lda <op0l jsr dostore jmp nxtinst ; [15] GET table,item /VAL z_get lda <op0l sta <corel lda <op0h sta <coreh lda <op1l sta <idxl lda <op1h sta <idxh jsr mget jsr tostore jmp nxtinst ; [16] GETB table,item /VAL z_getb lda #0 sta <byth lda <op0l sta <corel lda <op0h sta <coreh lda <op1l sta <idxl lda <op1h sta <idxh jsr mgetb jsr tostore jmp nxtinst ; [20] ADD int1,int2 /VAL z_add clc lda <op0l adc <op1l pha lda <op0h adc <op1h sta <byth pla jsr tostore jmp nxtinst ; [21] SUB int1,int2 /VAL z_sub sec lda <op0l sbc <op1l pha lda <op0h sbc <op1h sta <byth pla jsr tostore jmp nxtinst ; [128] ZERO? value /PRED z_zero lda <op0l ora <op0h jmp branch ; [129] NEXT? obj /VAL/PRED z_next lda #low(xobject+5) sta <corel lda #high(xobject+5) sta <coreh lda #0 sta <idxh sta <byth lda <op0l asl a rol <idxh asl a rol <idxh asl a rol <idxh ; now carry flag is clear, have 8x value adc <op0l ; add the object number so you have 9x in total sta <idxl jsr mgetb jsr tostore clc sbc #0 ; make the zero flag *clear* if zero jmp branch ; [130] FIRST? obj /VAL/PRED z_first lda #low(xobject+6) sta <corel lda #high(xobject+6) sta <coreh lda #0 sta <idxh sta <byth lda <op0l asl a rol <idxh asl a rol <idxh asl a rol <idxh ; now carry flag is clear, have 8x value adc <op0l ; add the object number so you have 9x in total sta <idxl jsr mgetb jsr tostore clc sbc #0 jmp branch ; [131] LOC obj /VAL z_loc lda #low(xobject+4) sta <corel lda #high(xobject+4) sta <coreh lda #0 sta <idxh sta <byth lda <op0l asl a rol <idxh asl a rol <idxh asl a rol <idxh ; now carry flag is clear, have 8x value adc <op0l ; add the object number so you have 9x in total sta <idxl jsr mgetb jsr tostore jmp nxtinst ; [133] INC var z_inc lda <op0l jsr fetch sec adc #0 pha bcc zincdec inc <byth zincdec lda <op0l jsr dostore jmp nxtinst ; keep with next ; [134] DEC var z_dec lda <op0l jsr fetch clc sbc #0 pha bcs zincdec dec <byth ; does not affect the carry flag bcc zincdec ; [138] PRINTD obj z_prntd lda <op0l jsr ptad inc <coreh bne z1prntb inc <corel bne z1prntb ; keep with next ; [135] PRINTB ptr z_prntb lda <op0l sta <corel lda <op0h sta <coreh z1prntb ;TODO ; [139] RETURN value z_ret lda <op0h sta <byth lda <op0l jmp return ; [140] JUMP offset z_jump lda <op0l jmp jumppc ; [142] VALUE var /VAL z_value lda <op0l jsr fetch z1value jsr tostore jmp nxtinst ; keep with next ; [143] BCOM int /VAL z_bcom lda <op0h eor #$FF sta <byth lda <op0l eor #$FF jsr tostore jmp nxtinst ; [224] CALL fcn[,any1][,any2][,any3] /VAL z_call lda #0 cmp <op0l bne z1call sta <byth cmp <op0h beq z1value z1call ldx <cstkcnt lda <pcl sta $400,x lda <pcm sta $500,x lda <pch sta $600,x lda <dstkcnt sta $700,x inc <cstkcnt lsr <pch lda <op0l sta <pcl lda <op0h sta <pcm asl <pcl rol <pcm rol <pch ;TODO ; [179] PRINTR (str) z_prntr jsr putstr lda #13 bankcall putchar ; fall through ; [176] RTRUE z_rtrue lda #0 sta <byth lda #1 jmp return z_rfals ; [177] RFALSE lda #0 sta <byth jmp return ; [178] PRINTI (str) z_prnti jsr putstr jmp nxtinst ; [180] NOOP z_noop = nxtinst ; [181] SAVE /PRED z_save lda #1 ; clear the zero flag (SAVE/RESTORE aren't implemented) jmp branch ; [182] RESTORE /PRED z_rstor = z_save ; [184] RSTACK z_rstac lda #0 jsr fetch dec <dstkcnt jmp return ; [233] POP var z_pop ldx <dstkcnt jsr fetch2 pha lda <op0l jsr dostore ; fall through ; [185] FSTACK z_fstac dec <dstkcnt jmp nxtinst ; [225] PUT table,item,data z_put lda <op0l sta <corel lda <op0h sta <coreh lda <op1l sta <idxl lda <op1h sta <idxh lda <op2h sta <byth lda <op2l jsr mput jmp nxtinst ; [226] PUTB table,item,data z_putb lda <op0l sta <corel lda <op0h sta <coreh lda <op1l sta <idxl lda <op1h sta <idxh lda <op2l jsr mputb jmp nxtinst ; [187] CRLF z_crlf lda #13 bne z1prntc ; keep with next ; [229] PRINTC char z_prntc lda <op0l z1prntc bankcall putchar jmp nxtinst ; [232] PUSH value z_push inc <dstkcnt lda <op0l pha lda <op0h sta <byth lda #0 jsr dostore jmp nxtinst ; [234] SPLIT lines z_split = nxtinst ; [235] SCREEN window z_scrn = nxtinst ; **************************************** bank 31 org $FE00 ; Initialize CPU/APU/PPU at reset reset ldx #$40 stx $4017 ; Disable APU frame IRQ ldx #$FF txs inx stx $2000 stx $2001 stx $4010 ; Initialize MMC5 to act like User:Zzo38/Mapper_D stx $5101 stx $5200 stx $5204 inx stx $5100 stx $5102 inx stx $5103 lda #$50 sta $5105 ; Call other init code bankjump reset1 ; NMI routine nmi pha dec <blinker bne nmi1 bit $2002 lda #$3F sta $2006 lda #$23 sta <blinker sta $2006 lda <curspal eor <#$0F sta <curspal sta $2007 lda #0 sta $2005 lda <scrolly sta $2005 nmi1 bit <outrdy bvc nmi2 jmp sendout nmi2 bit <linrdy bvc nmi3 jmp sendlf nmi3 pla rti ; CHR ROM bank 32 incbin "chicago_oblique.chr" incbin "chicago_inverse.chr"
