' ***************************************** ' * PNut Interpreter * ' * Version 0.1 12/10/2004 * ' * (C) 2004 Parallax, Inc. * ' ***************************************** DAT org 0 ChipInterpreter 000 05 00 FC A0 x mov x,#$1F0-pbase 'entry, load initial parameters 001 F0 03 BC A0 y mov y,par 002 02 02 FC 80 a add y,#2 003 01 D6 BF 04 t1 rdword pbase,y 004 00 07 FC 80 t2 add t1,#$100 'inc d lsb 005 00 07 FC 80 op add t1,#$100 006 02 00 FC E4 op2 djnz x,#a 007 01 D2 FF 0C adr cogid id 'set id ' +--------------------------------------------------------------------------+ ' ¦ Main loop ¦ ' +--------------------------------------------------------------------------+ 008 00 00 FC A0 loop mov x,#0 'reset x 009 EE 0B BC 00 rdbyte op,pcurr 'get opcode 00A 01 DC FF 80 add pcurr,#1 00B 40 0A 7C 85 cmp op,#$40 wc 'upper? 00C EE 00 4C 5C if_nc jmp #upper 00D 05 06 BC A0 mov t1,op 'jump to handler 00E 04 06 FC 20 ror t1,#4 00F 1A 06 FC 80 add t1,#jumps 010 03 26 BC 50 movs :jump,t1 011 02 06 FC 24 rol t1,#2 012 03 06 FC 2C shl t1,#3 013 1A 08 BC A0 :jump mov t2,jumps 014 03 08 BC 28 shr t2,t1 015 FF 08 FC 60 and t2,#$FF 016 04 32 BC 50 movs getret,t2 017 01 0A 7C 62 getflags test op,#%01 wz 018 02 0A 7C 61 getc test op,#%10 wc 019 00 00 7C 5C getret ret 01A 1E 2B 3E 46 jumps byte j0,j1,j2,j3 01B 4A 62 73 73 byte j4,j5,j6,j7 01C 91 9A A1 A1 byte j8,j9,jA,jB 01D B4 C4 CF D6 byte jC,jD,jE,jF ' +--------------------------------------------------------------------------+ ' ¦ $00..03 Drop anchor ¦ ' +--------------------------------------------------------------------------+ 01E EB 0B BC 68 j0 or op,pbase 'add pbase into flags 01F EF 0B 3C 04 wrword op,dcurr 'push return pbase (and flags) 020 02 DE FF 80 add dcurr,#2 021 EF D9 3F 04 wrword vbase,dcurr 'push return vbase 022 02 DE FF 80 add dcurr,#2 023 EF DB 3F 04 wrword dbase,dcurr 'push return dbase 024 02 DE FF 80 add dcurr,#2 025 EF D5 3F 04 wrword dcall,dcurr 'push dcall (later used for pcurr) 026 EF D5 BF A0 mov dcall,dcurr 'set new dcall 027 02 DE FF 80 add dcurr,#2 028 58 01 7C 5C jmp #push 'init 'result' to 0 ' +--------------------------------------------------------------------------+ ' ¦ $04 jmp ¦ ' ¦ $05 call sub ¦ ' ¦ $06 call obj.sub ¦ ' ¦ $07 call obj[].sub ¦ ' +--------------------------------------------------------------------------+ 029 00 D6 BF 80 callobj add pbase,x 'set relative obj bases 02A 01 D8 BF 81 add vbase,y wc '(c=0, z=0 still) 02B 3F 00 48 5C j1 if_nc_and_z jmp #jmpadr 'entry, jmp? 02C DC BD D3 5C if_c_and_nz call #popx 'pop index 02D EE 03 BC 00 rdbyte y,pcurr 'get obj/sub byte 02E 01 DC FF 80 add pcurr,#1 02F 00 02 90 80 if_c_and_nz add y,x 'add any obj index 030 02 02 FC 2C shl y,#2 'lookup words from table 031 EB 03 BC 80 add y,pbase 032 01 02 BC 08 rdlong y,y 033 01 00 BC A0 mov x,y 'get low word 034 10 02 FC 28 shr y,#16 'get high word 035 29 00 70 5E if_c jmp #callobj wz 'obj[].sub? (z=0) 036 EA DB BF A0 mov dbase,dcall 'get new dcall 037 EA D5 BF 04 rdword dcall,dcall 'set old dcall 038 ED DD 3F 04 wrword pcurr,dbase 'set return pcurr 039 02 DA FF 80 add dbase,#2 'set call dbase 03A 01 DE BF 80 add dcurr,y 'set call dcurr 03B EB DD 8F A0 spcurr if_nc mov pcurr,pbase 'set call pcurr (c=0) 03C 00 DC 8F 80 if_nc add pcurr,x 03D 08 00 7C 5C jmp #loop ' +--------------------------------------------------------------------------+ ' ¦ $08 tjz - push if nz ¦ ' ¦ $09 djnz - push if nz ¦ ' ¦ $0A jz ¦ ' ¦ $0B jnz ¦ ' +--------------------------------------------------------------------------+ 03E DC BD FF 5C j2 call #popx 'pop count/boolean 03F CD 33 FC 5C jmpadr jmpret getret,#getadrs 'get sign-extended address 040 01 00 C4 84 if_nc_and_nz sub x,#1 'if djnz, decrement 041 01 00 7C 85 cmp x,#1 wc 'determine branch 042 06 DC A7 80 apcurr if_c_eq_z add pcurr,op2 'branch? 043 09 0A FC 72 muxc op,#%00001001 wz 'if tjz/djnz and not 0, push, else loop 044 58 01 68 5C pushz if_z jmp #push 'if z, push result 045 08 00 54 5C if_nz jmp #loop 'if nz, loop ' +--------------------------------------------------------------------------+ ' ¦ $0C casedone ¦ ' ¦ $0D value case ¦ ' ¦ $0E range case ¦ ' ¦ $0F lookdone ¦ ' +--------------------------------------------------------------------------+ 046 5F 00 48 5C j3 if_nc_and_z jmp #cased 'if casedone, pop target+address, jump 047 0C DE D3 84 if_c_and_nz sub dcurr,#12 'if lookdone, pop target+address+index 048 58 01 50 5C if_c_and_nz jmp #push '..and push zero 049 CD 33 FC 5E jmpret getret,#getadrs wz 'case, get sign-extended address (c=same, z=0) ' +--------------------------------------------------------------------------+ ' ¦ $10 value lookup ¦ ' ¦ $11 value lookdown ¦ ' ¦ $12 range lookup ¦ ' ¦ $13 range lookdown ¦ ' +--------------------------------------------------------------------------+ 04A DA BD CF 5C j4 if_nc call #popyx 'if value, pop value and target 04B 01 04 8C A0 if_nc mov a,y 'x = target, y..a = range 04C D8 BD F3 5C if_c call #popayx 'if range, pop range values and target 04D 08 DE FF 84 sub dcurr,#8 'pop index into t1 (underneath address) 04E EF 07 BC 08 rdlong t1,dcurr 04F 01 04 3C C1 cmps a,y wc 'reverse range? 050 00 08 BC B0 negc t2,x 'set t2 for in-range.. 051 03 08 8C 98 if_nc sumz t2,t1 'forward lookup: -t1 + x + y 052 03 08 B0 80 if_c add t2,t1 'forward lookdown: t1 + x - y 053 01 08 8C 9C if_nc sumnz t2,y 'reverse lookup: t1 - x + y 054 01 08 B0 80 if_c add t2,y 'reverse lookdown: t1 - x + y 055 DF C9 FF 5C call #range 'check if x in range y..a according to c 056 03 00 28 85 if_z cmp x,t1 wc 'if lookup, c=0 if index within range 057 02 06 BC 80 add t1,a 'on first compare, t1 = index 058 01 06 BC 84 sub t1,y 'on second compare, t1 = index+a-y 059 00 06 08 85 if_z_and_nc cmp t1,x wc 05A 04 06 8C A0 if_nc mov t1,t2 'if in range, t1 = t2 05B 01 06 F0 80 if_c add t1,#1 'if out of range, t1 = index+a-y+1 05C 04 0A 7C 62 test op,#%100 wz 'look or case? 05D EF 07 28 08 if_z wrlong t1,dcurr 'if look, update index 05E 0C DE FF 80 add dcurr,#12 'unpop index+address+target 05F DA BD CB 5C cased if_z_and_nc call #popyx 'if look true or casedone, pop target and address 060 3B 00 68 5C if_z jmp #spcurr 'if look true or casedone, branch or loop 061 42 00 7C 5C jmp #apcurr 'case, branch if true ' +--------------------------------------------------------------------------+ ' ¦ $14 pop ¦ ' ¦ $15 run ¦ ' ¦ $16 STRSIZE(string) ¦ ' ¦ $17 STRCOMP(stringa,stringb) ¦ ' +--------------------------------------------------------------------------+ 062 DC BD EB 5C j5 if_z call #popx 'if pop/strsize, pop count/string 063 00 DE 8B 84 if_nc_and_z sub dcurr,x 'if pop, subtract count from dcurr 064 EE D1 87 A0 if_nc_and_nz mov lsb,pcurr 'if run, save pcurr and set to $FFFC 065 38 DD 87 A0 if_nc_and_nz mov pcurr,maskpar 066 08 00 4C 5C if_nc jmp #loop 'if pop/run, loop 067 DA BD D7 5C if_nz call #popyx 'if strcomp, pop stringa/stringb 068 00 04 BC A0 mov a,x 'stringa/string in a, stringb in y 069 01 00 FC A4 neg x,#1 'init !count in x 06A 02 06 BC 00 :loop rdbyte t1,a 'measure/compare string(s) 06B 01 04 FC 80 add a,#1 06C CD 06 68 EC if_z tjz t1,#notx 'if strsize and 0, return count (c=1) 06D 01 08 94 00 if_nz rdbyte t2,y 06E 01 02 D4 80 if_nz add y,#1 06F 04 06 94 6C if_nz xor t1,t2 070 2C 07 54 E8 if_nz tjnz t1,#mtst2 'if strcomp and mismatch, return false (z=0) 071 2C 09 54 EE if_nz tjz t2,#mtst2 wz 'if strcomp and 0, return true (z=1) 072 6A 00 FC E4 djnz x,#:loop 'loop - never falls through ' +--------------------------------------------------------------------------+ ' ¦ $18 BYTEFILL(start,value,count) ¦ ' ¦ $19 WORDFILL(start,value,count) ¦ ' ¦ $1A LONGFILL(start,value,count) ¦ ' ¦ ¦ ' +--------------------------------------------------------------------------+ ' +--------------------------------------------------------------------------+ ' ¦ $1C BYTEMOVE(to,from,count) ¦ ' ¦ $1D WORDMOVE(to,from,count) ¦ ' ¦ $1E LONGMOVE(to,from,count) ¦ ' ¦ ¦ ' +--------------------------------------------------------------------------+ j6 073 D8 BD FF 5C j7 call #popayx 'fill/move/wait, pop parameters 074 8C 00 50 5C if_c_and_nz jmp #waitpin 'waitpeq/waitpne? 075 08 04 7C EC tjz a,#loop 'if count=0, done 076 04 0A 7C 63 test op,#%100 wc,wz 'fill or move? 077 03 0A FC 60 and op,#%11 'isolate size bits 078 01 06 A8 A0 if_z mov t1,y 'if fill, set value 079 00 02 14 85 if_nz cmp y,x wc 'if upward move, modify pointers 07A 02 08 90 A0 if_nz_and_c mov t2,a 07B 01 08 D0 84 if_nz_and_c sub t2,#1 07C 05 08 90 2C if_nz_and_c shl t2,op 07D 04 02 90 80 if_nz_and_c add y,t2 07E 04 00 90 80 if_nz_and_c add x,t2 07F 01 08 FC B0 negc t2,#1 'set inc/dec 080 05 08 BC 2C shl t2,op 081 03 0A FC 2C shl op,#3 'set word size 082 05 10 BD 58 movi fill,op 083 01 0A FC 68 or op,#%000000_001 084 05 0C BD 58 movi move,op 085 FF FF 00 00 maskword long $0000FFFF 'nop/constant 086 01 06 94 08 move if_nz rdlong t1,y 'move/fill loop 087 04 02 94 80 if_nz add y,t2 088 00 06 3C 08 fill wrlong t1,x 089 04 00 BC 80 add x,t2 08A 86 04 FC E4 djnz a,#move 08B 08 00 7C 5C jmp #loop ' +--------------------------------------------------------------------------+ ' ¦ $1B WAITPEQ(data,mask,port) ¦ ' ¦ $1F WAITPNE(data,mask,port) ¦ ' +--------------------------------------------------------------------------+ 08C 01 04 7C 61 waitpin test a,#1 wc 08D 04 0A 7C 62 test op,#%100 wz 08E 01 00 28 F0 if_z waitpeq x,y 'waitpeq 08F 01 00 14 F4 if_nz waitpne x,y 'waitpne 090 08 00 7C 5C jmp #loop ' +--------------------------------------------------------------------------+ ' ¦ $20 CLKSET(mode,freq) ¦ ' ¦ $21 COGSTOP(id) ¦ ' ¦ $22 LOCKRET(id) ¦ ' ¦ $23 WAITCNT(count) ¦ ' +--------------------------------------------------------------------------+ 091 DA BD CB 5C j8 if_nc_and_z call #popyx 'clkset 092 00 00 48 0C if_nc_and_z clkset x 093 00 02 48 08 if_nc_and_z wrlong y,#$0000 094 04 00 48 00 if_nc_and_z wrbyte x,#$0004 095 DC BD F7 5C if_c_or_nz call #popx 'pop parameter 096 03 00 44 0C if_nc_and_nz cogstop x 'cogstop 097 05 00 60 0C if_c_and_z lockret x 'lockret 098 00 00 D0 F8 if_c_and_nz waitcnt x,#0 'waitcnt 099 08 00 7C 5C jmp #loop ' +--------------------------------------------------------------------------+ ' ¦ $24 SPR[nibble] ¦ ' ¦ $25 SPR[nibble] ¦ ' ¦ $26 SPR[nibble] ¦ ' ¦ $27 WAITVID(colors,pixels) ¦ ' +--------------------------------------------------------------------------+ 09A DA BD D3 5C j9 if_c_and_nz call #popyx 'waitvid 09B 01 00 10 FC if_c_and_nz waitvid x,y 09C 08 00 50 5C if_c_and_nz jmp #loop 09D DC BD FF 5C call #popx 'spr 09E 10 00 FC 68 or x,#$10 09F 10 00 7C 63 test x,#$10 wc,wz 'c=1, z=0 0A0 DA 00 7C 5C jmp #regindex ' +--------------------------------------------------------------------------+ ' ¦ $28/$2C COGINIT(id,ptr,par) ¦ ' ¦ $29/$2D LOCKNEW ¦ ' ¦ $2A/$2E LOCKSET(id) ¦ ' ¦ $2B/$2F LOCKCLR(id) ¦ ' +--------------------------------------------------------------------------+ jA 0A1 AE 00 70 5C jB if_c jmp #:lock 'lockclr/lockset? 0A2 D8 BD EB 5C if_z call #popayx 'coginit, pop parameters 0A3 38 05 A8 60 if_z and a,maskpar 'assemble fields 0A4 10 04 E8 2C if_z shl a,#16 0A5 38 03 A8 60 if_z and y,maskpar 0A6 02 02 E8 2C if_z shl y,#2 0A7 02 02 A8 68 if_z or y,a 0A8 08 00 E8 4C if_z max x,#8 0A9 01 00 A8 68 if_z or x,y 0AA 02 00 E8 0D if_z coginit x wc,wr 0AB 04 00 D4 0D if_nz locknew x wc 'locknew 0AC 01 00 F0 A4 if_c neg x,#1 '-1 if c, else 0..7 0AD B2 00 7C 5C jmp #:push 0AE DC BD FF 5C :lock call #popx 'lockclr/lockset, pop id 0AF 06 00 68 0D if_z lockset x wc 'clr/set lock 0B0 07 00 54 0D if_nz lockclr x wc 0B1 E5 01 BC 70 muxc x,masklong '-1 if c, else 0 0B2 04 0A 7C 62 :push test op,#%100 wz 'push result? 0B3 44 00 7C 5C jmp #pushz ' +--------------------------------------------------------------------------+ ' ¦ $30 ABORT ¦ ' ¦ $31 ABORT value ¦ ' ¦ $32 RETURN ¦ ' ¦ $33 RETURN value ¦ ' +--------------------------------------------------------------------------+ 0B4 ED 01 A8 08 jC if_z rdlong x,dbase 'if no value, get 'result' 0B5 DC BD D7 5C if_nz call #popx 'if value, pop result 0B6 ED DF BF A0 :loop mov dcurr,dbase 'restore dcurr 0B7 02 DE FF 84 sub dcurr,#2 'pop pcurr 0B8 EF DD BF 04 rdword pcurr,dcurr 0B9 02 DE FF 84 sub dcurr,#2 'pop dbase 0BA EF DB BF 04 rdword dbase,dcurr 0BB 02 DE FF 84 sub dcurr,#2 'pop vbase 0BC EF D9 BF 04 rdword vbase,dcurr 0BD 02 DE FF 84 sub dcurr,#2 'pop pbase (and flags) 0BE EF D7 BF 04 rdword pbase,dcurr 0BF 02 D6 4F 61 if_nc test pbase,#%10 wc 'if abort and !try, return again 0C0 B6 00 4C 5C if_nc jmp #:loop 0C1 01 D6 7F 62 test pbase,#%01 wz 'get push flag 0C2 38 D7 BF 60 and pbase,maskpar 'trim pbase 0C3 44 00 7C 5C jmp #pushz 'push 'result'? ' +--------------------------------------------------------------------------+ ' ¦ $34 push constant -1 ¦ ' ¦ $35 push constant 0 ¦ ' ¦ $36 push constant 1 ¦ ' ¦ $37 push constant -idsssss i=invert, d=decrement, x = #2< ¦ ' ¦ $3D register[bit] op ¦ ' ¦ $3E register[bit..bit] op ¦ ' ¦ $3F register op ¦ ' +--------------------------------------------------------------------------+ 0D6 EE 01 BC 00 jF rdbyte x,pcurr 'register, get reg+op byte 0D7 01 DC FF 80 add pcurr,#1 0D8 00 0A BC A0 mov op,x 'justify op (sets type to register) 0D9 05 0A FC 28 shr op,#5 0DA E0 01 FC 68 regindex or x,#$1E0 'install register 0DB 00 82 BF 50 movs writef,x 0DC 00 86 BF 54 movd writer,x 0DD 00 90 BF 50 movs readr,x 0DE 79 01 50 5C if_c_and_nz jmp #mrop 'register? 0DF DC BD CF 5C if_nc call #popx 'register bit? 0E0 00 02 8C A0 if_nc mov y,x 0E1 DA BD F3 5C if_c call #popyx 'register range? 0E2 1F 00 FC 60 and x,#$1F 'trim bit/range 0E3 1F 02 FC 60 and y,#$1F 0E4 00 0E BC A0 mov adr,x 'get -bitcount into adr 0E5 01 0E BC 85 sub adr,y wc 'c=1 if reverse 0E6 07 0E BC AC absneg adr,adr 0E7 01 0E FC 84 sub adr,#1 0E8 01 D0 8F A0 if_nc mov lsb,y 'get lowest bit into lsb 0E9 00 D0 B3 A0 if_c mov lsb,x 0EA E7 7F BF 74 muxnc writev,maskwr 'clear/set reverse 0EB E7 97 BF 74 muxnc readv,maskwr 0EC 0C 0A FC 68 or op,#%1100 'set bit mode 0ED 79 01 7C 5C jmp #mrop ' +--------------------------------------------------------------------------+ ' ¦ Upper ¦ ' +--------------------------------------------------------------------------+ 0EE 80 0A 7C 85 upper cmp op,#$80 wc 'varop? 0EF 5D 01 70 5C if_c jmp #varop 'c=1 0F0 E0 0A 7C 85 cmp op,#$E0 wc 'memop? 0F1 62 01 70 5C if_c jmp #memop 0F2 05 04 BC A2 mov a,op wz 'mathop follows (z=0) ' +--------------------------------------------------------------------------+ ' ¦ $E0..FF Math operation (z = swap binary arguments) ¦ ' +--------------------------------------------------------------------------+ 0F3 1F 04 FC 60 mathop and a,#%11111 'limit for mbol and mcod 0F4 02 B8 BE 20 ror mathops,a 'unary or binary? 0F5 02 B8 BE 25 rol mathops,a wc 0F6 DC BD CF 5C if_nc call #popx 'pop unary argument 0F7 DA BD F3 5C if_c call #popyx 'pop binary arguments 0F8 01 00 AC 6C if_nc_or_z xor x,y 'if unary or swap, swap x and y 0F9 00 02 AC 6C if_nc_or_z xor y,x 0FA 01 00 AC 6C if_nc_or_z xor x,y 0FB 00 06 FC A0 mov t1,#0 0FC 10 04 7C 62 test a,#%10000 wz 'jmp to operation 0FD 3B 01 4C 5C if_nc jmp #muny 0FE 2E 01 68 5C if_z jmp #mcod 0FF 08 04 7C 61 test a,#%01000 wc 100 27 01 70 5C if_c jmp #mtst 101 04 04 7C 61 test a,#%00100 wc 'boolean and/or? 102 00 00 4C 86 if_nc cmp x,#0 wz 103 E5 01 8C 7C if_nc muxnz x,masklong 104 00 02 4C 86 if_nc cmp y,#0 wz 105 E5 03 8C 7C if_nc muxnz y,masklong 106 35 01 4C 5C if_nc jmp #mcod2 107 20 08 FC A0 mov t2,#32 'multiply/divide 108 00 00 BC A9 abs x,x wc 109 0C 04 FC 70 muxc a,#%01100 10A 01 02 BC AB abs y,y wc,wz 10B 04 04 F0 6C if_c xor a,#%00100 10C 02 04 7C 61 test a,#%00010 wc 10D 1A 01 50 5C if_c_and_nz jmp #mdiv 'if divide and y=0, do multiply so result=0 10E 01 00 FC 29 shr x,#1 wc 'multiply 10F 01 06 B0 81 mmul if_c add t1,y wc 110 01 06 FC 31 rcr t1,#1 wc 111 01 00 FC 31 rcr x,#1 wc 112 0F 09 FC E4 djnz t2,#mmul 113 04 04 7C 62 test a,#%00100 wz 114 03 06 94 A4 if_nz neg t1,t1 115 00 00 94 A6 if_nz neg x,x wz 116 01 06 D4 84 if_nz sub t1,#1 117 01 04 7C 62 test a,#%00001 wz 118 03 00 94 A0 if_nz mov x,t1 119 58 01 7C 5C jmp #push 11A 01 02 FC 2B mdiv shr y,#1 wc,wz 'divide 11B 01 06 FC 30 rcr t1,#1 11C 1A 09 D4 E4 if_nz djnz t2,#mdiv 11D 03 00 BC E1 mdiv2 cmpsub x,t1 wc 11E 01 02 FC 34 rcl y,#1 11F 01 06 FC 28 shr t1,#1 120 1D 09 FC E4 djnz t2,#mdiv2 121 08 04 7C 61 test a,#%01000 wc 122 00 00 BC B0 negc x,x 123 04 04 7C 61 test a,#%00100 wc 124 01 04 7C 62 test a,#%00001 wz 125 01 00 A8 B0 if_z negc x,y 126 58 01 7C 5C jmp #push 127 01 00 3C C3 mtst cmps x,y wc,wz 'tests 128 04 00 E8 A0 if_z mov x,#%100 'equal? 129 02 00 D4 A0 if_nz mov x,#%010 'above? 12A 01 00 F0 A0 if_c mov x,#%001 'below? 12B 02 00 BC 66 andn x,a wz 12C E5 01 BC 78 mtst2 muxz x,masklong 12D 58 01 7C 5C jmp #push 12E 0F 04 7C 86 mcod cmp a,#%01111 wz 'instruction-equivalents 12F 01 02 A8 A4 if_z neg y,y 130 02 06 BC A0 mov t1,a 131 0C 06 FC 60 and t1,#%001100 132 03 04 BC 80 add a,t1 133 1A 04 7C 85 cmp a,#%011010 wc 134 14 04 CC 84 if_nc sub a,#%010100 135 03 04 FC 2C mcod2 shl a,#3 136 41 04 FC 80 add a,#%001000_001 137 02 72 BE 58 movi mcod3,a 138 FC FF 00 00 maskpar long $0000FFFC 'nop/constant 139 01 00 BC 20 mcod3 ror x,y '(modifying) 13A 58 01 7C 5C jmp #push 13B 08 04 7C 61 muny test a,#%01000 wc 'unaries 13C 42 01 54 5C if_nz jmp #muny2 13D 01 04 7C 62 test a,#%00001 wz 13E 01 00 8C A4 if_nc neg x,y 'neg 13F 01 00 C4 84 if_nc_and_nz sub x,#1 'bitwise not 140 01 00 B0 A8 if_c abs x,y 'abs 141 58 01 7C 5C jmp #push 142 02 04 7C 62 muny2 test a,#%00010 wz 143 4A 01 70 5C if_c jmp #muny3 144 20 00 E8 A0 if_z mov x,#32 'encode 145 01 02 E8 2D mncd if_z shl y,#1 wc 146 45 01 C8 E4 if_z_and_nc djnz x,#mncd 147 01 00 D4 A0 if_nz mov x,#1 'decode 148 01 00 94 2C if_nz shl x,y 149 58 01 7C 5C jmp #push 14A 00 00 FC A0 muny3 mov x,#0 'square root 14B 10 08 E8 A0 if_z mov t2,#16 14C 01 02 E8 2D msqr if_z shl y,#1 wc 14D 01 06 E8 34 if_z rcl t1,#1 14E 01 02 E8 2D if_z shl y,#1 wc 14F 01 06 E8 34 if_z rcl t1,#1 150 02 00 E8 2C if_z shl x,#2 151 01 00 E8 68 if_z or x,#1 152 00 06 A8 E1 if_z cmpsub t1,x wc 153 02 00 E8 28 if_z shr x,#2 154 01 00 E8 34 if_z rcl x,#1 155 4C 09 E8 E4 if_z djnz t2,#msqr 156 01 00 14 85 if_nz cmp x,y wc 'boolean not 157 E5 01 94 74 if_nz muxnc x,masklong 158 EF 01 3C 08 push wrlong x,dcurr 'push result 159 04 DE FF 80 add dcurr,#4 15A 40 0C 7C 61 test op2,#%01000000 wc 'mathop? 15B 08 00 7C 5C pushret jmp #loop 15C 9F FE 7A BF mathops long %1_01111110_11110101_11111101_0011111 ' +--------------------------------------------------------------------------+ ' ¦ $40..7F Variable operation (c=1) ¦ ' +--------------------------------------------------------------------------+ 15D 02 02 FC A0 varop mov y,#%10 'set long 15E 05 0E BC A0 mov adr,op 'isolate offset 15F 1C 0E FC 60 and adr,#%011100 160 20 0A 7C 62 test op,#%100000 wz 'get vbase/dbase 161 72 01 7C 5C jmp #memopb 'add base (c=1) ' +--------------------------------------------------------------------------+ ' ¦ $80-DF Memory operation ¦ ' +--------------------------------------------------------------------------+ 162 05 02 BC A0 memop mov y,op 'set size 163 05 02 FC 28 shr y,#5 164 03 02 FC 60 and y,#%11 165 10 0A 7C 61 test op,#%0010000 wc 'index? 166 DC BD F3 5C if_c call #popx 'yes, pop and scale 167 01 00 B0 2C if_c shl x,y 168 08 0A 7C 61 test op,#%0001000 wc 'get base mode 169 04 0A 7C 62 test op,#%0000100 wz 16A 04 DE CB 84 if_nc_and_z sub dcurr,#4 'if no base, pop address 16B EF 0F 88 08 if_nc_and_z rdlong adr,dcurr 16C 51 A4 F7 58 if_c_or_nz movi sarshr,#%001010_001 'if base, get zero-extended address 16D CE 33 F4 5C if_c_or_nz jmpret getret,#getadrz 16E 08 0A 7C 61 test op,#%0001000 wc 'restore c 16F 06 0E B4 A0 if_c_or_nz mov adr,op2 170 00 0E BC 80 add adr,x 'add any index 171 EB 0F 84 80 if_nc_and_nz add adr,pbase 'if pbase, add 172 EC 0F A0 80 memopb if_c_and_z add adr,vbase 'if vbase, add 173 ED 0F 90 80 if_c_and_nz add adr,dbase 'if dbase, add 174 03 02 FC 2C shl y,#3 'set read/write by size 175 01 70 BF 58 movi writem,y 176 01 02 FC 68 or y,#%000000_001 177 01 8C BF 58 movi readm,y 178 03 0A FC 60 and op,#%0011 'set type to memory (followed by mrop) ' +--------------------------------------------------------------------------+ ' ¦ Memory/register operation ¦ ' +--------------------------------------------------------------------------+ 179 17 32 FC 5C mrop jmpret getret,#getflags 'get op flags 17A C5 01 48 5C if_nc_and_z jmp #read 'read? 17B DC BD C7 5C if_nc_and_nz call #popx 'write? 17C B7 01 44 5C if_nc_and_nz jmp #write 17D 07 00 90 A0 if_c_and_nz mov x,adr 'address? 17E 85 00 90 60 if_c_and_nz and x,maskword 17F 58 01 50 5C if_c_and_nz jmp #push ' +--------------------------------------------------------------------------+ ' ¦ Assignment ¦ ' +--------------------------------------------------------------------------+ 180 D3 33 FC 5C jmpret getret,#getop2 'assign, get assignment (c=1) 181 7E 0C 7C 62 test op2,#%01111110 wz 'write? (w/push) 182 DC BD EB 5C if_z call #popx 183 B4 01 68 5C if_z jmp #:keep 184 C5 B7 FE 5C jmpret pushret,#read 'modifier or mathop, read var (c=1 if mathop) 185 20 0C 7C 62 test op2,#%00100000 wz 186 06 04 B0 A0 if_c mov a,op2 'mathop? set op, z=swap args 187 F3 B6 F2 5C if_c jmpret pushret,#mathop 'do math (c=1) 188 04 DE FF 84 sub dcurr,#4 'unpop var/result (in any case) 189 B4 01 70 5C if_c jmp #:keep 'if mathop, write 18A 10 0C 7C 61 test op2,#%00010000 wc 18B AB 01 54 5C if_nz jmp #:incdec 18C 04 0C 7C 62 test op2,#%00000100 wz 18D A4 01 70 5C if_c jmp #:sxcs 18E 08 0C 7C 61 test op2,#%00001000 wc 18F 9B 01 70 5C if_c jmp #:rnd 190 03 BA FF 54 movd popxr,#t1 'repeat-var loop? 191 D8 BD FF 5C call #popayx 'pop data (a=to, y=from, t1=step) 192 00 BA FF 54 movd popxr,#x 193 04 DE EB 80 if_z add dcurr,#4 'if step default, unpop step 194 01 06 E8 A0 if_z mov t1,#1 'if step default, set step to 1 195 CD 33 FC 5C jmpret getret,#getadrs 'get address 196 01 04 3C C1 cmps a,y wc 'reverse range? 197 03 00 BC 90 sumc x,t1 'add/sub step to/from var 198 DF C9 FF 5C call #range 'check if x in range y..a according to c 199 06 DC 8F 80 if_nc add pcurr,op2 'if in range, branch 19A B6 01 7C 5C jmp #:restore 19B 01 00 FC 48 :rnd min x,#1 '?var/var? 19C 20 02 FC A0 mov y,#32 19D 17 04 FC A0 mov a,#%10111 19E 01 04 D4 20 if_nz ror a,#1 19F 02 00 3C 61 :rndlp test x,a wc 1A0 01 00 E8 30 if_z rcr x,#1 1A1 01 00 D4 34 if_nz rcl x,#1 1A2 9F 03 FC E5 djnz y,#:rndlp wc 'c=0 1A3 B3 01 7C 5C jmp #:stack 1A4 08 0C 7C 61 :sxcs test op2,#%00001000 wc 1A5 18 00 C8 2C if_nc_and_z shl x,#24 '~var/~~var 1A6 18 00 C8 38 if_nc_and_z sar x,#24 1A7 10 00 C4 2C if_nc_and_nz shl x,#16 1A8 10 00 C4 38 if_nc_and_nz sar x,#16 1A9 E5 01 B0 7C if_c muxnz x,masklong 'var~/var~~ 1AA B3 01 7C 5C jmp #:stack 1AB 01 00 FC 90 :incdec sumc x,#1 '++var/var++/--var/var-- 1AC 04 0C 7C 61 test op2,#%00000100 wc 'mask result by size 1AD 02 0C 7C 62 test op2,#%00000010 wz 1AE 07 00 88 3C if_nc_and_z rev x,adr 1AF 07 00 88 3C if_nc_and_z rev x,adr 1B0 FF 00 C4 60 if_nc_and_nz and x,#$FF 1B1 85 00 A0 60 if_c_and_z and x,maskword 1B2 08 0C 7C 61 test op2,#%00001000 wc 'pre-inc/dec or post-inc/dec? 1B3 EF 01 0C 08 :stack if_nc wrlong x,dcurr 'if not var~/var~~/var++/var--, write stack 1B4 80 0C 7C 61 :keep test op2,#%10000000 wc 'keep value on stack? 1B5 04 DE F3 80 if_c add dcurr,#4 '(followed by write) 1B6 08 B6 FE 50 :restore movs pushret,#loop 'restore pushret, followed by write ' +--------------------------------------------------------------------------+ ' ¦ Write memory/register ¦ ' +--------------------------------------------------------------------------+ 1B7 0C 0A 7C 63 write test op,#%1100 wc,wz 'get type into flags 1B8 07 00 28 08 writem if_z wrlong x,adr 'memory? 1B9 08 00 68 5C if_z jmp #loop 1BA 01 04 CC A4 if_nc neg a,#1 'register field? 1BB 07 04 8C 3C if_nc rev a,adr 1BC E8 05 8C 2C if_nc shl a,lsb 1BD E5 05 8C 6C if_nc xor a,masklong 1BE 07 00 8C 3C if_nc rev x,adr 1BF 07 00 8C 3C writev if_nc rev x,adr 1C0 E8 01 8C 2C if_nc shl x,lsb 1C1 FF 05 8C 60 writef if_nc and a,$1FF 1C2 02 00 8C 68 if_nc or x,a 1C3 00 FE BF A0 writer mov $1FF,x 'register 1C4 08 00 7C 5C jmp #loop ' +--------------------------------------------------------------------------+ ' ¦ Read memory/register ¦ ' +--------------------------------------------------------------------------+ 1C5 0C 0A 7C 63 read test op,#%1100 wc,wz 'get type into flags 1C6 07 00 A8 08 readm if_z rdlong x,adr 'memory? 1C7 58 01 68 5C if_z jmp #push 1C8 FF 01 BC A0 readr mov x,$1FF 'register 1C9 E8 01 8C 28 if_nc shr x,lsb 'register field? 1CA 07 00 8C 3C if_nc rev x,adr 1CB 07 00 8C 3C readv if_nc rev x,adr 1CC 58 01 7C 5C jmp #push ' +--------------------------------------------------------------------------+ ' ¦ Get address ¦ ' +--------------------------------------------------------------------------+ 1CD 71 A4 FF 58 getadrs movi sarshr,#%001110_001 'set sign-extended 1CE EE 0D BC 00 getadrz rdbyte op2,pcurr 'get first byte 1CF 01 DC FF 80 add pcurr,#1 1D0 80 0C 7C 61 test op2,#$80 wc 'if bit7 set, another byte 1D1 19 0C FC 2C shl op2,#25 'sign/zero-extend from bit6 1D2 19 0C FC 38 sarshr sar op2,#25 'sar for jX / shr for memop 1D3 EE 09 B0 00 getop2 if_c rdbyte t2,pcurr 'if another byte, get second byte and shift in 1D4 01 DC F3 80 if_c add pcurr,#1 1D5 08 0C F0 2C if_c shl op2,#8 1D6 04 0C B0 68 if_c or op2,t2 1D7 18 00 7C 5C jmp #getc 'restore c for jX ' +--------------------------------------------------------------------------+ ' ¦ Pops ¦ ' +--------------------------------------------------------------------------+ 1D8 04 DE FF 84 popayx sub dcurr,#4 1D9 EF 05 BC 08 rdlong a,dcurr 1DA 04 DE FF 84 popyx sub dcurr,#4 1DB EF 03 BC 08 rdlong y,dcurr 1DC 04 DE FF 84 popx sub dcurr,#4 1DD EF 01 BC 08 popxr rdlong x,dcurr popx_ret popyx_ret 1DE 00 00 7C 5C popayx_ret ret ' +--------------------------------------------------------------------------+ ' ¦ Check range ¦ ' ¦ must be preceded by: cmps a,y wc ¦ ' +--------------------------------------------------------------------------+ 1DF 01 04 B0 6C range if_c xor a,y 'if reverse range, swap range values 1E0 02 02 B0 6C if_c xor y,a 1E1 01 04 B0 6C if_c xor a,y 1E2 01 00 3C C1 cmps x,y wc 'c=0 if x within range 1E3 00 04 0C C1 if_nc cmps a,x wc 1E4 00 00 7C 5C range_ret ret ' +--------------------------------------------------------------------------+ ' ¦ Constants ¦ ' +--------------------------------------------------------------------------+ 1E5 FF FF FF FF masklong long $FFFFFFFF '(temporarily used by runner code) 1E6 00 00 00 80 masktop long $80000000 '(temporarily used by runner code) 1E7 00 00 80 00 maskwr long $00800000 '(temporarily used by runner code) ' +--------------------------------------------------------------------------+ ' ¦ Variables ¦ ' +--------------------------------------------------------------------------+ 1E8 lsb res 1 1E9 id res 1 1EA dcall res 1 1EB pbase res 1 1EC vbase res 1 1ED dbase res 1 1EE pcurr res 1 1EF dcurr res 1 ' +--------------------------------------------------------------------------+ ' ¦ Registers ¦ ' +--------------------------------------------------------------------------+ 1F0 PAR 1F1 CNT 1F2 INA 1F3 INB 1F4 OUTA 1F5 OUTB 1F6 DIRA 1F7 DIRB 1F8 CTRA 1F9 CTRB 1FA FRQA 1FB FRQB 1FC PHSA 1FD PHSB 1FE VCFG 1FF VSCL