library TVM_Asm // simple TVM Assembler variable @atend 'nop @atend ! { `normal eq? not abort"must be terminated by }>" } : @normal? { @atend @ 1 { @atend ! @normal? } does @atend ! } : @pushatend { @pushatend { }> b> } : }>c { }>c s { @atend @ 2 { @atend ! rot b> ref, swap @endblk } does @atend ! = -rot <= and } : 2x<= { 2 pick brembitrefs 1- 2x<= } : @havebitrefs { @havebits not ' @| if } : @ensurebits { @havebitrefs not ' @| if } : @ensurebitrefs { rot over @ensurebits -rot u, } : @simpleuop { tuck sbitrefs @ensurebitrefs swap s, } : @addop { tuck bbitrefs @ensurebitrefs swap b+ } : @addopb ' @addopb : @inline { 1 ' @addop does create } : @Defop { 1 { } : si() // x mi ma -- ? { rot tuck >= -rot <= and } : @range { rot tuck < -rot > or } : @-range { @-range abort"Out of range" } : @rangechk { dup 0 < over 255 > or abort"Invalid stack register number" si() } : s() { si() constant } : @Sreg -2 @Sreg s(-2) -1 @Sreg s(-1) 0 @Sreg s0 1 @Sreg s1 2 @Sreg s2 3 @Sreg s3 4 @Sreg s4 5 @Sreg s5 6 @Sreg s6 7 @Sreg s7 8 @Sreg s8 9 @Sreg s9 10 @Sreg s10 11 @Sreg s11 12 @Sreg s12 13 @Sreg s13 14 @Sreg s14 15 @Sreg s15 { dup 0 < over 7 > or abort"Invalid control register number" } : c() { c() constant } : @Creg 0 @Creg c0 1 @Creg c1 2 @Creg c2 3 @Creg c3 4 @Creg c4 5 @Creg c5 7 @Creg c7 { abort"not a stack register" 12 i@+ s> } : @bigsridx { @bigsridx dup 16 >= over 0< or abort"stack register s0..s15 expected" } : @sridx { rot @bigsridx tuck < -rot tuck > rot or abort"stack register out of range" } : @sridxrange { swap @bigsridx + dup 16 >= over 0< or abort"stack register out of range" } : @sridx+ { swap 0xcc <> over 7 > or over 6 = or abort"not a control register c0..c5 or c7" } : @cridx { = { tuck 16 >= { = and { 15 and abort"integer too large" 8 + 2dup fits } until > 2- 5 u, -rot i, } cond } cond } cond @addopb } dup : PUSHINT : INT { = or abort"invalid slice padding" swap 1 1 u, 0 rot u, } : @scomplete { tuck sbitrefs swap 17 + swap @havebitrefs not { PUSHREFSLICE } { over sbitrefs 2dup 123 0 2x<= { drop tuck 4 + 3 >> swap x{8B} s, over 4 u, 3 roll s, -rot 3 << 4 + swap - @scomplete } { 2dup 1 >= swap 248 <= and { rot x{8C} s, swap 1- 2 u, over 7 + 3 >> tuck 5 u, 3 roll s, -rot 3 << 1 + swap - @scomplete } { rot x{8D} s, swap 3 u, over 2 + 3 >> tuck 7 u, 3 roll s, -rot 3 << 6 + swap - @scomplete } cond } cond } cond } dup : PUSHSLICE : SLICE { tuck bbitrefs swap 16 + dup 7 and 3 -roll swap @havebitrefs not rot or { swap b> PUSHREFCONT } { over bbitrefs 2dup 120 0 2x<= { drop swap x{9} s, swap 3 >> 4 u, swap b+ } { rot x{8F_} s, swap 2 u, swap 3 >> 7 u, swap b+ } cond } cond } dup : PUSHCONT : CONT { }> PUSHCONT } : }>CONT { { @normal? PUSHCONT } @doafter<{ } : CONT:<{ // arithmetic operations { 2 { rot dup 8 fits { nip > tuck 3 u, 3 roll s, -rot 3 << 2 + swap - @scomplete } { 2drop swap PUSHSLICE STSLICER } cond } cond } : STSLICECONST x{CF81} @Defop STZERO x{CF83} @Defop STONE // cell deserialization (CellSlice primitives) x{D0} @Defop CTOS x{D1} @Defop ENDS x{D2} @Defop(8u+1) LDI x{D3} @Defop(8u+1) LDU x{D4} @Defop LDREF x{D5} @Defop LDREFRTOS x{D6} @Defop(8u+1) LDSLICE x{D700} @Defop LDIX x{D701} @Defop LDUX x{D702} @Defop PLDIX x{D703} @Defop PLDUX x{D704} @Defop LDIXQ x{D705} @Defop LDUXQ x{D706} @Defop PLDIXQ x{D707} @Defop PLDUXQ x{D708} @Defop(8u+1) LDI_l x{D709} @Defop(8u+1) LDU_l x{D70A} @Defop(8u+1) PLDI x{D70B} @Defop(8u+1) PLDU x{D70C} @Defop(8u+1) LDIQ x{D70D} @Defop(8u+1) LDUQ x{D70E} @Defop(8u+1) PLDIQ x{D70F} @Defop(8u+1) PLDUQ { dup 31 and abort"argument must be a multiple of 32" 5 >> 1- > swap x{D72A_} s, over 7 u, 3 roll s, -rot 3 << 3 + swap - @scomplete } : SDBEGINS:imm { tuck sbitrefs abort"no references allowed in slice" dup 26 <= { drop > swap x{D72E_} s, over 7 u, 3 roll s, -rot 3 << 3 + swap - @scomplete } : SDBEGINSQ:imm { tuck sbitrefs abort"no references allowed in slice" dup 26 <= { drop PUSHCONT IF } : }>IF x{DF} @Defop IFNOT { }> PUSHCONT IFNOT } : }>IFNOT ' IFNOTRET : IF: ' IFRET : IFNOT: x{E0} @Defop IFJMP { }> PUSHCONT IFJMP } : }>IFJMP { { @normal? PUSHCONT IFJMP } @doafter<{ } : IFJMP:<{ x{E1} @Defop IFNOTJMP { }> PUSHCONT IFNOTJMP } : }>IFNOTJMP { { @normal? PUSHCONT IFNOTJMP } @doafter<{ } : IFNOTJMP:<{ x{E2} @Defop IFELSE { `else @endblk } : }>ELSE<{ { `else: @endblk } : }>ELSE: { PUSHCONT { @normal? PUSHCONT IFELSE } @doafter<{ } : @doifelse { 1 { swap @normal? -rot PUSHCONT swap PUSHCONT IFELSE } does @doafter<{ } : @doifnotelse { { dup `else eq? { drop @doifelse } { dup `else: eq? { drop PUSHCONT IFJMP } { @normal? PUSHCONT IF } cond } cond } @doafter<{ } : IF:<{ { { dup `else eq? { drop @doifnotelse } { dup `else: eq? { drop PUSHCONT IFNOTJMP } { @normal? PUSHCONT IFNOT } cond } cond } @doafter<{ } : IFNOT:<{ x{E300} @Defop(ref) IFREF x{E301} @Defop(ref) IFNOTREF x{E302} @Defop(ref) IFJMPREF x{E303} @Defop(ref) IFNOTJMPREF x{E304} @Defop CONDSEL x{E305} @Defop CONDSELCHK x{E308} @Defop IFRETALT x{E309} @Defop IFNOTRETALT { PUSHCONT REPEAT } : }>REPEAT { { @normal? PUSHCONT REPEAT } @doafter<{ } : REPEAT:<{ x{E5} dup @Defop REPEATEND @Defop REPEAT: x{E6} @Defop UNTIL { }> PUSHCONT UNTIL } : }>UNTIL { { @normal? PUSHCONT UNTIL } @doafter<{ } : UNTIL:<{ x{E7} dup @Defop UNTILEND @Defop UNTIL: x{E8} @Defop WHILE x{E9} @Defop WHILEEND { `do @endblk } : }>DO<{ { `do: @endblk } : }>DO: { PUSHCONT { @normal? PUSHCONT WHILE } @doafter<{ } : @dowhile { { dup `do eq? { drop @dowhile } { `do: eq? not abort"`}>DO<{` expected" PUSHCONT WHILEEND } cond } @doafter<{ } : WHILE:<{ x{EA} @Defop AGAIN { }> PUSHCONT AGAIN } : }>AGAIN { { @normal? PUSHCONT AGAIN } @doafter<{ } : AGAIN:<{ x{EB} dup @Defop AGAINEND @Defop AGAIN: // // continuation stack manipulation and continuation creation // { PUSHCONT ATEXIT } : }>ATEXIT { { @normal? PUSHCONT ATEXIT } @doafter<{ } : ATEXIT:<{ x{EDF4} @Defop ATEXITALT { }> PUSHCONT ATEXITALT } : }>ATEXITALT { { @normal? PUSHCONT ATEXITALT } @doafter<{ } : ATEXITALT:<{ x{EDF5} @Defop SETEXITALT { }> PUSHCONT SETEXITALT } : }>SETEXITALT { { @normal? PUSHCONT SETEXITALT } @doafter<{ } : SETEXITALT:<{ x{EDF6} @Defop THENRET x{EDF7} @Defop THENRETALT x{EDF8} @Defop INVERT x{EDF9} @Defop BOOLEVAL // x{EE} is BLESSARGS // // dictionary subroutine call/jump primitives { c3 PUSH EXECUTE } : CALLVAR { c3 PUSH JMPX } : JMPVAR { c3 PUSH } : PREPAREVAR { dup 14 ufits { dup 8 ufits { CATCH<{ { PUSHCONT { @normal? PUSHCONT TRY } @doafter<{ } : @trycatch { { `catch eq? not abort"`}>CATCH<{` expected" @trycatch } @doafter<{ } : TRY:<{ // // dictionary manipulation ' NULL : NEWDICT ' ISNULL : DICTEMPTY ' STSLICE : STDICTS x{F400} dup @Defop STDICT @Defop STOPTREF x{F401} dup @Defop SKIPDICT @Defop SKIPOPTREF x{F402} @Defop LDDICTS x{F403} @Defop PLDDICTS x{F404} dup @Defop LDDICT @Defop LDOPTREF x{F405} dup @Defop PLDDICT @Defop PLDOPTREF x{F406} @Defop LDDICTQ x{F407} @Defop PLDDICTQ x{F40A} @Defop DICTGET x{F40B} @Defop DICTGETREF x{F40C} @Defop DICTIGET x{F40D} @Defop DICTIGETREF x{F40E} @Defop DICTUGET x{F40F} @Defop DICTUGETREF x{F412} @Defop DICTSET x{F413} @Defop DICTSETREF x{F414} @Defop DICTISET x{F415} @Defop DICTISETREF x{F416} @Defop DICTUSET x{F417} @Defop DICTUSETREF x{F41A} @Defop DICTSETGET x{F41B} @Defop DICTSETGETREF x{F41C} @Defop DICTISETGET x{F41D} @Defop DICTISETGETREF x{F41E} @Defop DICTUSETGET x{F41F} @Defop DICTUSETGETREF x{F422} @Defop DICTREPLACE x{F423} @Defop DICTREPLACEREF x{F424} @Defop DICTIREPLACE x{F425} @Defop DICTIREPLACEREF x{F426} @Defop DICTUREPLACE x{F427} @Defop DICTUREPLACEREF x{F42A} @Defop DICTREPLACEGET x{F42B} @Defop DICTREPLACEGETREF x{F42C} @Defop DICTIREPLACEGET x{F42D} @Defop DICTIREPLACEGETREF x{F42E} @Defop DICTUREPLACEGET x{F42F} @Defop DICTUREPLACEGETREF x{F432} @Defop DICTADD x{F433} @Defop DICTADDREF x{F434} @Defop DICTIADD x{F435} @Defop DICTIADDREF x{F436} @Defop DICTUADD x{F437} @Defop DICTUADDREF x{F43A} @Defop DICTADDGET x{F43B} @Defop DICTADDGETREF x{F43C} @Defop DICTIADDGET x{F43D} @Defop DICTIADDGETREF x{F43E} @Defop DICTUADDGET x{F43F} @Defop DICTUADDGETREF x{F441} @Defop DICTSETB x{F442} @Defop DICTISETB x{F443} @Defop DICTUSETB x{F445} @Defop DICTSETGETB x{F446} @Defop DICTISETGETB x{F447} @Defop DICTUSETGETB x{F449} @Defop DICTREPLACEB x{F44A} @Defop DICTIREPLACEB x{F44B} @Defop DICTUREPLACEB x{F44D} @Defop DICTREPLACEGETB x{F44E} @Defop DICTIREPLACEGETB x{F44F} @Defop DICTUREPLACEGETB x{F451} @Defop DICTADDB x{F452} @Defop DICTIADDB x{F453} @Defop DICTUADDB x{F455} @Defop DICTADDGETB x{F456} @Defop DICTIADDGETB x{F457} @Defop DICTUADDGETB x{F459} @Defop DICTDEL x{F45A} @Defop DICTIDEL x{F45B} @Defop DICTUDEL x{F462} @Defop DICTDELGET x{F463} @Defop DICTDELGETREF x{F464} @Defop DICTIDELGET x{F465} @Defop DICTIDELGETREF x{F466} @Defop DICTUDELGET x{F467} @Defop DICTUDELGETREF x{F469} @Defop DICTGETOPTREF x{F46A} @Defop DICTIGETOPTREF x{F46B} @Defop DICTUGETOPTREF x{F46D} @Defop DICTSETGETOPTREF x{F46E} @Defop DICTISETGETOPTREF x{F46F} @Defop DICTUSETGETOPTREF x{F470} @Defop PFXDICTSET x{F471} @Defop PFXDICTREPLACE x{F472} @Defop PFXDICTADD x{F473} @Defop PFXDICTDEL x{F474} @Defop DICTGETNEXT x{F475} @Defop DICTGETNEXTEQ x{F476} @Defop DICTGETPREV x{F477} @Defop DICTGETPREVEQ x{F478} @Defop DICTIGETNEXT x{F479} @Defop DICTIGETNEXTEQ x{F47A} @Defop DICTIGETPREV x{F47B} @Defop DICTIGETPREVEQ x{F47C} @Defop DICTUGETNEXT x{F47D} @Defop DICTUGETNEXTEQ x{F47E} @Defop DICTUGETPREV x{F47F} @Defop DICTUGETPREVEQ x{F482} @Defop DICTMIN x{F483} @Defop DICTMINREF x{F484} @Defop DICTIMIN x{F485} @Defop DICTIMINREF x{F486} @Defop DICTUMIN x{F487} @Defop DICTUMINREF x{F48A} @Defop DICTMAX x{F48B} @Defop DICTMAXREF x{F48C} @Defop DICTIMAX x{F48D} @Defop DICTIMAXREF x{F48E} @Defop DICTUMAX x{F48F} @Defop DICTUMAXREF x{F492} @Defop DICTREMMIN x{F493} @Defop DICTREMMINREF x{F494} @Defop DICTIREMMIN x{F495} @Defop DICTIREMMINREF x{F496} @Defop DICTUREMMIN x{F497} @Defop DICTUREMMINREF x{F49A} @Defop DICTREMMAX x{F49B} @Defop DICTREMMAXREF x{F49C} @Defop DICTIREMMAX x{F49D} @Defop DICTIREMMAXREF x{F49E} @Defop DICTUREMMAX x{F49F} @Defop DICTUREMMAXREF x{F4A0} @Defop DICTIGETJMP x{F4A1} @Defop DICTUGETJMP x{F4A2} @Defop DICTIGETEXEC x{F4A3} @Defop DICTUGETEXEC { dup sbitrefs tuck 1 > swap 1 <> or abort"not a dictionary" swap 1 u@ over <> abort"not a dictionary" } : @chkdicts { dup null? tuck { abort"method redefined with different id" } { swap @declproc } cond } : DECLMETHOD "main" @proclistadd dictnew } : PROGRAM{ { dup sbits 1000 > { s>c } : }END> { }END> b> } : }END>c { }END>c s 0 constant recv_internal -1 constant recv_external -2 constant run_ticktock -3 constant split_prepare -4 constant split_install // ( c -- ) add vm library for later use with runvmcode { spec } : hash>libref // ( c -- c' ) { hash hash>libref } : >libref