diff --git a/asm.jrt b/asm.jrt index 2284d2e..f52c87d 100755 --- a/asm.jrt +++ b/asm.jrt @@ -11,9 +11,8 @@ var opargs-remaining array oparg1 3 cells allot array oparg2 3 cells allot -: arg1 oparg1 current-oparg ! ; +: arg1 oparg1 current-oparg ! ; arg1 : arg2 oparg2 current-oparg ! ; -arg1 : swap-args current-oparg @ oparg1 = if arg2 else arg1 then ; : oparg-type ( -- type ) current-oparg @ ; @@ -36,14 +35,10 @@ arg1 ( ie. inc [bx] vs inc byte [bx]?? ) ( or do we just say incb? ) -: bytearg? ( -- f ) - current-oparg @ - arg1 oparg-reg? oparg-breg? and - arg2 oparg-reg? oparg-breg? and or - swap current-oparg ! ; -: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0= or ; +: bytearg? ( -- f ) oparg-breg? swap-args oparg-breg? or swap-args ; +: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0 = or ; -: operror ( err -- ) lastop @ wordname type s": " type type cr ; +: operror ( err -- ) lastop @ wordname type s" : " type type cr ; : oparg-complete! opargs-remaining @ dup if 1 - dup opargs-remaining ! @@ -53,17 +48,18 @@ arg1 : # oparg-imm! oparg-complete! ; : @[ 0 oparg-mem! ; -: @] -1 oparg-base ! oparg-complete ! ; +: @] -1 oparg-base ! oparg-complete! ; : unexpected-addr ( addr -- ) drop s" unexpected address" operror ; : @+ ( disp -- ) opargs-remaining @ if - oparg-type @ dup 0= if drop oparg-mem! oparg-complete! + oparg-type @ dup 0 = if drop oparg-mem! oparg-complete! else 3 = if oparg-val ! else unexpected-addr then then else unexpected-addr then ; : l: create target @ , does> @ @+ ; +: l@ [ ' ' , ] cell + @ ; : memreg create , does> @ oparg-base ! oparg-complete! ; 0 memreg bx+si] 1 memreg bx+di] 2 memreg bp+si] 3 memreg bp+di] @@ -100,27 +96,28 @@ arg1 0xf9 0op stc 0xfa 0op cli 0xfb 0op sti 0xfc 0op cld 0xfd 0op std 0xf5 0op cmc -: :op ( count -- ) , $DOCOLON , does> +: :op ( count -- ) create , $DOCOLON , ] does> dup @ dup start-op cell + op-encode ! ; : memarg>case ( -- 0|1|2 ) oparg-base @ dup -1 = if drop 1 ( D16 ) else - 6 = oparg-val @ 0= if 2 ( [bp]+0 ) else 0 ( standard ) then then ; + 6 = oparg-val @ 0 = and if 2 ( [bp]+0 ) else 0 ( standard ) then then ; : memarg>dispsize ( -- 0|1|2 ) memarg>case dup 1 = if drop 2 else 2 = if 1 else - oparg-val @ dup 0= if drop 0 else byteval? if 1 else 2 + oparg-val @ dup 0 = if drop 0 else byteval? if 1 else 2 then then then then ; : memarg>mod+rm ( -- mod rm ) memarg>case dup 1 = if drop 0 6 else 2 = if 2 6 else memarg>dispsize oparg-base @ then then ; : regarg>mod+rm ( -- mod rm ) 3 oparg-val @ ; -: modrm>t ( reg mod rm -- ) 0x03 & swap 0x02 & 6 << | swap 0x03 & 3 << | >t ; +: modrm>t ( reg mod rm -- ) 0x07 & swap 0x03 & 6 << | swap 0x07 & 3 << | >t ; : invalid-args s" invalid argument types" operror ; ( convention: words ending in * mean "will return if matched" ) -: disp>t memarg>dispsize dup 1= if drop >t else 2 = if w>t else drop then then ; +: disp>t oparg-val @ memarg>dispsize + dup 1 = if drop >t else 2 = if w>t else drop then then ; : imm?>t oparg-imm? if oparg-val @ dup byteval? if >t else w>t then then ; : >wreg+op* ( base -- ) @@ -149,8 +146,8 @@ arg1 1 :op inc 0x40 >wreg+op* 0 0xfe >byte-regreg* - 0 0xff >regreg* - 0 0xff >mem* + 0 0xff >regreg* + 0 0xff >mem* invalid-args ; 1 :op incb 0 0xfe >byte-regreg* diff --git a/defs.jrt b/defs.jrt index b899243..fc49a40 100755 --- a/defs.jrt +++ b/defs.jrt @@ -9,6 +9,7 @@ : 2swap ( a b c d -- c d a b ) >r >rot rot ; +: 2drop drop drop ; : negate 0 swap - ; : abs dup 0 < if negate then ; @@ -51,13 +52,12 @@ : yield rswap ; : done rdrop 0 >r rswap ; -: ;done ' done , ] ; immediate +: ;done ' done , [ ' [ , ] ; immediate : each [ ' begin , ] ' r@ , [ ' while , ] ; immediate : more ' yield , [ ' repeat , ] ' rdrop , ; immediate : break rswap rdrop :| yield done |; execute rswap ; : links begin yield @ dup not until drop ;done - : files findfile begin dup while yield nextfile repeat drop ;done : .files files each type s" " type more ; @@ -74,86 +74,13 @@ : intern create latest wordname , does> @ ; -: preserving ( cp 0 vars... -- ) - 0 >r begin dup while dup @ >r >r repeat drop - execute - begin r@ while lazy! latest codepointer swap redefine ; : dbg" [ ' s" , ] :| type bl .s cr |; expile ; immediate -( tasks ) -: mailbox 2 cells + ; -: task-ip task-user-size cells + ; -: task-sp task-user-size 1 + cells + ; -: task-rsp task-user-size 2 + cells + ; -: task-stack task-user-size 3 + cells + ; -: task-rstack task-stack stacksize cells + ; - -: .wordin ( ptr -- ) - latest links each - 2dup > if wordname type drop 0 break then - more dup if . else drop then ; userword - -: tasks.s - tasks links each - dup dup . .wordin s" : " type - dup task-sp @ over task-stack ( task stackLim stack ) - 2dup . . s" : " type - begin 2dup > while dup @ . cell + repeat - cr drop drop more ; userword - -: task.bt ( task -- ) - dup task-rsp @ swap task-rstack ( rstackLim rstack ) - begin 2dup > while dup @ dup . .wordin cr cell + repeat - drop drop ; userword - -: doactivate ( task ip -- ) - over task-ip ! - dup task-stack over task-sp ! - dup task-rstack over task-rsp ! - drop -; - -: activate - here 4 cells + lit - ' doactivate , - ' return , -; immediate - -: >task ( val task -- ) - task-sp >r r@ @ ! r@ @ cell + r> ! ; - -: try-send ( val task -- b ) - mailbox dup @ if drop drop 0 else ! 1 then ; - -: wait-send ( val task -- ) - mailbox - begin dup @ while suspend repeat ( wait for empty mailbox ) - ! ; - -: send ( val task -- ) try-send drop ; - -: receive ( -- val ) - running mailbox - begin dup @ not while suspend repeat ( wait for mail ) - dup @ 0 = over 9 <= and if [ key 0 lit ] + else 10 - [ key A lit ] then + emit ; +: .hex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ; diff --git a/main.c b/main.c index 32ab5bd..35b05b7 100755 --- a/main.c +++ b/main.c @@ -6,6 +6,6 @@ int main(int argc, char *argv[]) { f_interpreter(); fclose(IN_FILE); IN_FILE = stdin; - f_execcp( f_lookupcp("interpreter")); + f_execcp(f_lookupcp("interpreter")); return 0; } \ No newline at end of file diff --git a/minijort.exe b/minijort.exe index 598e13d..a23729f 100755 Binary files a/minijort.exe and b/minijort.exe differ diff --git a/minijort.prj b/minijort.prj index b52d00d..9025491 100755 Binary files a/minijort.prj and b/minijort.prj differ diff --git a/tinyjort.jrt b/tinyjort.jrt new file mode 100755 index 0000000..973bbd1 --- /dev/null +++ b/tinyjort.jrt @@ -0,0 +1,12 @@ +s" defs.jrt" loadfile +s" asm.jrt" loadfile + +here + +push ax +pop bx +inc @[ bx] + +here +:noname for i b@ .hex next ; execute +