diff --git a/crypto/fift/lib/Asm.fif b/crypto/fift/lib/Asm.fif index 92ceab6db..644a03e78 100644 --- a/crypto/fift/lib/Asm.fif +++ b/crypto/fift/lib/Asm.fif @@ -4,6 +4,22 @@ namespace Asm Asm definitions "0.4.5" constant asm-fif-version +32 constant @marksize + +variable @alldebugmarks +variable @debugmarks +variable @currentdebugmarks + +// markid offset +{ over @debugmarks @ @marksize udict@ { ref@ } { dictnew } cond // markid offset markiddict + udict! { abort"could not set debug mark" } ifnot // markid markiddict + udict! { abort"could not set debug mark" } ifnot @debugmarks ! } : @adddebugmark +{ over bbits @adddebugmark } : DEBUGMARK + +32 constant @zcount +{ u@?+ { swap abort"first bits are not zeroes" } if } : @cut-zeroes + variable @atend variable @was-split false @was-split ! @@ -15,8 +31,22 @@ false @was-split ! { false @was-split ! `normal @endblk } : }> { }> b> } : }>c { }>c s -{ @atend @ 2 { true @was-split ! @atend ! rot b> ref, swap @endblk } does @atend ! udict! { abort"could not add subbed debug marks" } ifnot true } + dictforeach drop // dictmapb cutdebugmarks + ref, true } dictmap -rot } ifnot // cutdebugmarks isnottoplevel cutcodes + -rot // cutcodes cutdebugmarks isnottoplevel + u@ // tldebugmarksb cutcodehash + @alldebugmarks @ 256 b>udict! { abort"could not add to all debug marks" } ifnot @alldebugmarks ! } : @handledebugmarks +{ @atend @ @debugmarks @ 3 { true @was-split ! @debugmarks @ @currentdebugmarks ! @debugmarks ! @atend ! rot dup @handledebugmarks b> ref, swap @endblk } does @atend ! dictnew @debugmarks ! = -rot <= and } : 2x<= @@ -299,11 +329,26 @@ x{8A} @Defop(ref) PUSHREFCONT bbitrefs rot bbitrefs pair+ swap 32 + swap @havebitrefs nip } cond } : @two-cont-fit? +// initoffset fromhash +{ @alldebugmarks @ 256 udict@ { // initoffset tldebugmarks + 1 i@+ swap drop ref@? { // initoffset debugmarks + @marksize { // initoffset markid offsetsdicts + ref@ 10 { // initoffset markid offset emptys + drop 2 pick + // initoffset markid addedoffset + over swap @adddebugmark true } + dictforeach // initoffset markid true + swap drop } + dictforeach } + if } + if // initoffset true + 2drop +} : @readddebugmarks +{ over bbits over b> hashu @readddebugmarks } : @pushcontreadd { 2dup @cont-fits? not { b> PUSHREFCONT } { swap 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 + { drop swap x{9} s, swap 3 >> 4 u, swap @pushcontreadd b+ } + { rot x{8F_} s, swap 2 u, swap 3 >> 7 u, swap @pushcontreadd b+ } cond } cond } dup : PUSHCONT : CONT { }> PUSHCONT } : }>CONT @@ -1058,7 +1103,7 @@ x{EDFB} @Defop SAMEALTSAVE // // inline support { dup sbits - { @addop } + { dup shash 256 B>u@ -rot dup sbits -rot @addop dup bbits rot - rot @readddebugmarks } { dup srefs // { ref@ CALLREF } @@ -1481,7 +1526,6 @@ variable @gvarcnt variable @parent-state variable asm-mode 1 asm-mode ! 19 constant @procdictkeylen -32 constant @zcount { pair @proclist @ cons @proclist ! } : @proclistadd { @procinfo @ @procdictkeylen idict@ { 16 i@ } { 0 } cond } : @procinfo@ { idict! @@ -1534,7 +1578,6 @@ Fift-wordlist dup @oldcurrent ! @oldctx ! { -1000 @def-proc } : PROCINLINE { @procdict @ @procdictkeylen idict@ abort"procedure already defined" } : @fail-ifdef -{ u@?+ { swap abort"first bits are not zeroes" } if } : @cut-zeroes { over @fail-ifdef 2 { rot @normal? rot b> b> } : }END>c { }END>c s +{ }END>c @alldebugmarks @ } : }END>cd + 0 constant recv_internal -1 constant recv_external -2 constant run_ticktock