{ 0 word drop 0 'nop } :: // { char " word 1 { swap { abort } if drop } } ::_ abort" { { bl word dup "" $= abort"comment extends after end of file" "*/" $= } until 0 'nop } :: /* // { bl word 1 2 ' (create) } "::" 1 (create) // { bl word 0 2 ' (create) } :: : // { bl word 2 2 ' (create) } :: :_ // { bl word 3 2 ' (create) } :: ::_ // { bl word 0 (create) } : create // { bl word (forget) } : forget { bl word 1 ' (forget) } :: [forget] { char " word 1 ' type } ::_ ." { char } word x>B 1 'nop } ::_ B{ { swap ({) over 2+ -roll swap (compile) (}) } : does { 1 'nop does create } : constant { 2 'nop does create } : 2constant { hole constant } : variable 10 constant ten { bl word 1 { find 0= abort"word not found" } } :: (') { bl word find not abort"-?" 0 swap } :: [compile] { bl word 1 { dup find { " -?" $+ abort } ifnot nip execute } } :: @' { bl word 1 { swap 1 'nop does swap 0 (create) } } :: =: { bl word 1 { -rot 2 'nop does swap 0 (create) } } :: 2=: { } : s>c { s>c hashB } : shash // to be more efficiently re-implemented in C++ in the future { dup 0< ' negate if } : abs { 2dup > ' swap if } : minmax { minmax drop } : min { minmax nip } : max "" constant <# ' $reverse : #> { swap 10 /mod char 0 + rot swap hold } : # { { # over 0<= } until } : #s { 0< { char - hold } if } : sign // { dup abs <# #s rot sign #> nip } : (.) // { (.) type } : ._ // { ._ space } : . { dup 10 < { 48 } { 55 } cond + } : Digit { dup 10 < { 48 } { 87 } cond + } : digit // x s b -- x' s' { rot swap /mod Digit rot swap hold } : B# { rot swap /mod digit rot swap hold } : b# { 16 B# } : X# { 16 b# } : x# // x s b -- 0 s' { -rot { 2 pick B# over 0<= } until rot drop } : B#s { -rot { 2 pick b# over 0<= } until rot drop } : b#s { 16 B#s } : X#s { 16 b#s } : x#s variable base { 10 base ! } : decimal { 16 base ! } : hex { 8 base ! } : octal { 2 base ! } : binary { base @ B# } : Base# { base @ b# } : base# { base @ B#s } : Base#s { base @ b#s } : base#s // x w -- s { over abs <# rot 1- ' X# swap times X#s rot sign #> nip } : (0X.) { over abs <# rot 1- ' x# swap times x#s rot sign #> nip } : (0x.) { (0X.) type } : 0X._ { 0X._ space } : 0X. { (0x.) type } : 0x._ { 0x._ space } : 0x. { bl (-trailing) } : -trailing { char 0 (-trailing) } : -trailing0 { char " word 1 ' $+ } ::_ +" { find 0<> dup ' nip if } : (def?) { bl word 1 ' (def?) } :: def? { bl word 1 { (def?) not } } :: undef? { def? ' skip-to-eof if } : skip-ifdef { bl word dup (def?) { drop skip-to-eof } { 'nop swap 0 (create) } cond } : library { bl word dup (def?) { 2drop skip-to-eof } { swap 1 'nop does swap 0 (create) } cond } : library-version { hole dup 1 'nop does swap 1 { context! } does bl word tuck 0 (create) +"-wordlist" 0 (create) } : namespace { context@ current! } : definitions { char ) word "$" swap $+ 1 { find 0= abort"undefined parameter" execute } } ::_ $( // b s -- ? { sbitrefs rot brembitrefs rot >= -rot <= and } : s-fits? // b s x -- ? { swap sbitrefs -rot + rot brembitrefs -rot <= -rot <= and } : s-fits-with? { 0 swap ! } : 0! { tuck @ + swap ! } : +! { tuck @ swap - swap ! } : -! { 1 swap +! } : 1+! { -1 swap +! } : 1-! { null swap ! } : null! { not 2 pick @ and xor swap ! } : ~! 0 tuple constant nil { 1 tuple } : single { 2 tuple } : pair { 3 tuple } : triple { 1 untuple } : unsingle { 2 untuple } : unpair { 3 untuple } : untriple { over tuple? { swap count = } { 2drop false } cond } : tuple-len? { 0 tuple-len? } : nil? { 1 tuple-len? } : single? { 2 tuple-len? } : pair? { 3 tuple-len? } : triple? { 0 [] } : first { 1 [] } : second { 2 [] } : third ' pair : cons ' unpair : uncons { 0 [] } : car { 1 [] } : cdr { cdr car } : cadr { cdr cdr } : cddr { cdr cdr car } : caddr { null ' cons rot times } : list { -rot pair swap ! } : 2! { @ unpair } : 2@ { true (atom) drop } : atom { bl word atom 1 'nop } ::_ ` { hole dup 1 { @ execute } does create } : recursive { 0 { 1+ dup 1 ' $() does over (.) "$" swap $+ 0 (create) } rot times drop } : :$1..n { 10 hold } : +cr { 9 hold } : +tab { "" swap { 0 word 2dup $cmp } { rot swap $+ +cr swap } while 2drop } : scan-until-word { 0 word -trailing scan-until-word 1 'nop } ::_ $<< { 0x40 runvmx } : runvmcode { 0x48 runvmx } : gasrunvmcode { 0xc8 runvmx } : gas2runvmcode { 0x43 runvmx } : runvmdict { 0x4b runvmx } : gasrunvmdict { 0xcb runvmx } : gas2runvmdict { 0x45 runvmx } : runvm { 0x4d runvmx } : gasrunvm { 0xcd runvmx } : gas2runvm { 0x55 runvmx } : runvmctx { 0x5d runvmx } : gasrunvmctx { 0xdd runvmx } : gas2runvmctx { 0x75 runvmx } : runvmctxact { 0x7d runvmx } : gasrunvmctxact { 0xfd runvmx } : gas2runvmctxact { 0x35 runvmx } : runvmctxactq { 0x3d runvmx } : gasrunvmctxactq