by [ name | topic | voc ] [ glos | files | xref ] [ notation | dpans94 | syscalls ] [ bot | top ]
Text formatted for the lynx html-browser and for plain text printing, 132 chars/line|
re "Nomina" in system description file <a-4th-design.inc>, for abbreviations and special terms. Words marked "(k)" or, where "Vocabulary" column empty, are not accessible by Name. Name Stack( in -- out) (note) Asm Label Vocabulary
task ( -- ) forth last word of kernel wordlists, a {noop}=> within? ( x1 x2 x3 -- x4 f ) forth x4 := x2 and tf if x2 <= x1 < x3, whether signed or unsigned, if out of range ret x4 signed adjusted to the nearest bound and ff.=> within ( x1 x2 x3 -- flg ) (a:c) forth ( test low high -- flag ) tf if x2 <= x1 < x3, signed or unsigned. - ANS-word=> uwithin? ( x1 x2 x3 -- x4 f ) forth x2 <= x1 < x3, signed or unsigned, x4:=x1 anf tf if in range if out of range ret x4 unsigned adjusted to the nearest bound.=> umin ( n1 n2 -- n3 ) forth ret the smaller of two unsigned single integers=> umax ( u1 u2 -- u3 ) forth ret the larger of two unsigned single integers=> uc< ( c1 c2 -- flg ) 'ucless' forth tf if unsigned l.s.bytes c1 < c2=> u< ( u1 u2 -- flg ) (m,13) 'uless' forth tf if unsigned u1 < u2=> u> ( u1 u2 -- flg ) (m,13) 'ugreater' forth tf if unsigned u1 > u2=> true= ( flg -- flg ) (m,9) 'tequ' forth test ans-4th true flag = -1=> true= ( flg -- flg ) (m,9) 'tequ' fig test fig-4th true flag = 1=> sgn ( n1 -- -1|0|1 ) (m,11) forth signum of n1=> negate ( n1 -- n2 ) forth 2-s complement sing @tos minus ( n1 -- n2 ) (fg)(m,2) 'negate' forth 2-s complement sing @tos=> negate ( n1 -- n2 ) forth 2-s complement sing @tos minus ( n1 -- n2 ) (fg)(m,2) 'negate' forth 2-s complement sing @tos=> min ( n1 n2 -- n3 ) forth ret the smaller of two signed single integers=> max ( n1 n2 -- n3 ) forth ret the larger of two signed single integers=> > ( n1 n2 -- flg ) (m,17) 'greater' forth tf if signed n1 < n2=> < ( n1 n2 -- flg ) (m,15) 'less' forth tf if signed n1 < n2=> >/ ( n1 n2 -- flg ) (m,17) 'nlt' forth tf if signed n1 greater or equal n2.=> \< ( n1 n2 -- flg ) (m,15) 'ngt' forth tf if signed n1 less or equal n2.=> <> ( u1 u2 -- flg ) (a:cx) 'nequal' ans tf if u1 not equal to u2 =/= ( u1 u2 -- flg ) (e)(m,11) 'nequal' forth tf if u1 not equal to u2; (e)flags from u2-u1.=> <> ( u1 u2 -- flg ) (a:cx) 'nequal' ans tf if u1 not equal to u2 =/= ( u1 u2 -- flg ) (e)(m,11) 'nequal' forth tf if u1 not equal to u2; (e)flags from u2-u1.=> = ( u1 u2 -- flg ) (e)(m,12) 'equal' forth tf if u1 = u2; (e)flags from u2-u1.=> ?0= ( n1 -- n1 flg ) (m,8) 'zeqq' forth tf if n1 = 0=> 1or ( n -- 0 ) (m,5) 'dgt' hidden { drop 1 }=> 0and ( n -- 0 ) (m,5) 'dng' hidden { drop 0 }=> 0< ( n1 -- flg ) (m,3) 'zless' forth tf if n1 -ve=> 0<> ( u1 -- flg ) (a) 'zneq' ans 0=/= ( u1 -- flg ) (m,9) 'zneq' forth tf if u1 non-zero=> 0<> ( u1 -- flg ) (a) 'zneq' ans 0=/= ( u1 -- flg ) (m,9) 'zneq' forth tf if u1 non-zero=> 0= ( n1 -- flg ) (m,8) 'zeq' forth tf if n1 = 0=> 0> ( n1 -- flg ) (m,5) 'zgreat' forth tf if n1 +ve and non-zero=> xor ( u1 u2 -- u3 ) (m,6) 'xxor' forth bitwise <xor> u1 w/ u2=> shift ( x1 n -- x2 ) forth 32 > n > 0 : {lshift}, -32 < n < 0 {rshift}; x2 := 0 if |n| > 31.=> rshifta ( n1 u -- n2 ) (e)(a)(m,9) forth unmodified cpu opr, i.e. x1 unchanged for u = any multiple of 32=> rshift ( x1 u -- x2 ) (e)(a)(m,9) forth unmodified cpu opr, i.e. x1 unchanged for u = any multiple of 32=> or ( u1 u2 -- u3 ) (m,6) 'oor' forth bitwise <or> u1 w/ u2=> not ( u1 -- u2 ) 'invert' fig return u2 1-s complement to u1 invert ( u1 -- u2 ) (a:c)(m,2) 'invert' forth return u2 1-s complement to u1=> lshift ( x1 u -- x2 ) (e)(a:c)(m,9) forth unmodified cpu opr, i.e. x1 unchanged for u = any multiple of 32=> not ( u1 -- u2 ) 'invert' fig return u2 1-s complement to u1 invert ( u1 -- u2 ) (a:c)(m,2) 'invert' forth return u2 1-s complement to u1=> andx ( n1 n2 n3 -- n4 ) 'andx' forth n4 := (( n1 AND n2 ) XOR n3 )=> and ( u1 u2 -- u3 ) (m,6) 'aand' forth bitwise <and> u1 w/ u2=> @rshifta ( p +u -- ) (e)(m,9) 'mrshifta' forth shift cell in memory at ptr p by +u < 32 bits, propagate sign bit=> @rshift ( p +u -- ) (e)(m,9) 'mrshift' forth shift cell in memory at ptr p by +u < 32 bits=> @lshift ( p +u -- ) (e)(m,9) 'mlshift' forth shift cell in memory at ptr p by +u < 32 bits=> wswap ( n1 -- n2 ) (c1)(m,3) forth swap lo and hi words (16bit portions) of n1.=> unused ( -- n ) (a:cx) forth available data-space cells, { d-top @ here - 4/ }, may be extended w. {allocate}=> swap ( n1 n2 -- n2 n1 ) (m,8) forth exchange contents of tos and nos cells (e: eflags remain unchanged)=> sp> ( | p -- ) (m,5) 'fspstore' forth re-initiate datastack from @{s0} sp! ( -- ) (fg) 'fspstore' fig f.i.g.-mode: re-initiate datastack from @s0 - F83 mode by ans-word {SP!}. being the safer one this is in {forth} and {fig} vocs for precedence over -re- ANS-mode {SP!}, which is in {ans} vocabulary.=> sp! ( | p -- ) (fg|a:c) 'spstore' forth vectored, either to forth or ans version of {sp!}.=> sp> ( | p -- ) (m,5) 'fspstore' forth re-initiate datastack from @{s0} sp! ( -- ) (fg) 'fspstore' fig f.i.g.-mode: re-initiate datastack from @s0 - F83 mode by ans-word {SP!}. being the safer one this is in {forth} and {fig} vocs for precedence over -re- ANS-mode {SP!}, which is in {ans} vocabulary.=> SP! ( p -- ) (a:c) 'aspstore' ans reset datastack to kref(p). ANS-std word, in {ans} wordlist. (e: eflags remain unchanged)=> rp! ( -- ) (fg) 'rpstore' forth reset returnstack to @r0 from @r0. - f.i.g.-mode return to caller, other returnpoints cleared. pushes return to {quit} below tor, for safety.=> RP! ( p -- ) (a:c) 'arpstore' ans reset returnstack to kref'd p. - ANS mode return to caller, other returnpoints cleared. (e: flags unchanged)=> rot ( n1 n2 n3 -- n2 n3 n1 ) forth (e: eflags remain unchanged)=> roll ( n1 nN n3 ... nm +N -- n1 n2 n3 ... nm nN ) forth move +N-th to tos, move N+1 items one cell up. roll ( n1 nN n3 ... nm -N -- n1 nN n2 n3 ... nm ) move -N items one cell up, move @tos to -N-th cell above tos. N including 0, in either case.=> r ( -- nn ) (R: nn -- nn ) (m,6) forth r@ ( -- nn ) (R: nn -- nn ) 'r' forth duplicate & push top item from returnstack to datastack=> r> ( -- n )(R: n -- ) (m,4) 'rfrom' forth pop cell ftom tor to tos=> r+! ( n -- )(R: n1 -- n2 ) (m,8) 'rps' forth add n to @tor (e: flags after addition)=> r ( -- nn ) (R: nn -- nn ) (m,6) forth r@ ( -- nn ) (R: nn -- nn ) 'r' forth duplicate & push top item from returnstack to datastack=> pick ( nm..n1 n -- nm..n1 n{n} ) (m,5) forth fetch n-th item to tos, { 0 pick } is {dup} or, store @nos item to -n-th item in data-stack. zero index refers to @nos. NOTE: +ve indices, only, for the compiled macro variant; -re- {-pick}. (e: eflags remain unchanged)=> over ( n1 n2 -- n1 n2 n1 ) (m,4) forth copy sing @nos to tos (e: eflags remain unchanged)=> ni ( ni -- nx )(R: nx .. nn -- nx .. nn ) (h4)(m,5) forth copy ni-th outer loop index to tos, cnt begins w. zero for {i}=> locals ( -- n ) forth ret number n of currently available, reserved local cells.=> li ( ni -- nx )(R: nx .. nn -- nx .. nn ) (h4)(m,5) forth copy li-th outer loop limit to tos, cnt begins w. zero for innermost loop.=> j ( -- n2 )(R: n1 n2 -- n1 n2 ) (m,7) forth copy next outer loop index to tos=> i ( -- nn )(R: nn -- nn ) (m,6) forth copy loop index to tos=> drop ( n1 -- ) (e)(m,5) forth remove item from tos (e: eflags remain unchanged)=> dup ( n1 -- n1 n1 ) (m,1) 'cdup' forth duplicate item on tos (e: eflags remain unchanged)=> depth ( -- n ) forth=> -rot ( n1 n2 n3 -- n3 n1 n2 ) (79) 'mrot' forth (e: eflags remain unchanged)=> ?DUP ( n1|0 -- n1 n1 | 0 ) (a:c)(83) 'qdup' ans duplicate n1 if non-zero=> -depth ( -- n ) 'mdepth' forth free space on datastack=> >rr ( nn -- nn )( rp: -- nn ) (f6)(m,4) 'torr' forth push duplicate tos item to returnstack=> >r ( nn -- )( rp: -- nn ) (M,9) 'tor' forth push cell from tos to tor (e: flags unchanged)=> >||< ( n1 -- n2 n3 ) (m,11) 'd2w' forth split n1 lo into n3:=hi and n2:=lo words=> >|< ( n1 -- n2 n3 ) (m,9) 'w2b' forth split n1 lo.word into n3:=hi and n2:=lo bytes (e: eflags remain unchanged)=> >< ( n1 -- n2 ) (lm)(m,2) 'xgb' forth swap l.s. bytes (8bit portions) of cell n1. (e: eflags remain unchanged)=> u/mod ( u1 u2 -- ur uq ) (e) 'ubym' forth unsigned div u1 by u2, ret sing remainder & quotient. dvs = 0 ovf: dvd =/= 0 $ffffffff $ffffffff dvd = 0 1 0=> gcd ( n1 n2 -- u3 ) (e) 'gcd' forth greatest common denominator u3 of the absolute value of two signed sings. If either number is zero, returns the absolute value of the other number. (e: Z if u3 = 1)=> mod ( n1 n2 -- r ) (e) forth 2-s cpl div sing remainder=> u16/mod ( u1 -- u2r u3q ) (e)(m,13) 'ubym16' forth unsigned divide n1 by 16, 'floored' quot u3q & rmd u2r.=> u8/mod ( u1 -- u2r u3q ) (e)(m,13) 'ubym8' forth unsigned divide n1 by 8, 'floored' quot u3q & rmd u2r.=> u4/mod ( u1 -- u2r u3q ) (e)(m,13) 'ubym4' forth unsigned divide n1 by 4, 'floored' quot u3q & rmd u2r.=> / ( n1 n2 -- q ) (m,11) 'by' forth 2-s cpl div sing quotient, 'round near zero' mode if n2=0 ret q = sgn(n1) ovf value or, 1 if n1=n2 check zero or ovf conditions before, if macro compiling.=> /mod ( n1 n2 -- r q ) (e) 'bymod' forth 2-s cpl div sing remainder & quotient, 'floored'=> */mod ( n1 n2 n3 -- n4 n5 ) (e)(a:c) 'mulbym' forth signed divide by n2 double product of signed multiplication n1 by n2 leave signed quotient n5 and remainder n4; rounding mode near zero. (e: overflow into double quot can be checked with NZ flag from {flg}.=> */ ( n1 n2 n3 -- n4 ) 'mulby' forth signed divide by n2 double product of signed multiplication n1 by n2 division result rounding mode as with m/.=> * ( n1 n2 -- n3 ) (m,6) 'smul' forth multiply sings=> - ( n1 n2 -- n3 ) (e)(m,10) 'ssub' forth 2-s cpl subtract sing=> +- ( n1 n2 -- n3 ) (fg) 'spm' forth apply sign =/= 0 of n2 to n1.=> + ( n1 n2 -- n3 ) (e)(m,8) 'plus' forth 2-s cpl add single cells=> +- ( n1 n2 -- n3 ) (fg) 'spm' forth apply sign =/= 0 of n2 to n1.=> umq^ ( u1 u2 -- uq3 ) ((x))(4) 'umqpow' forth unsigned raise sing u1 to the power of sing u2, leave quad result. max ca. 1,7*10^39, ret quad $ff..ff as overflow indicator.=> um/mod ( ud u1 -- u2 u3 ) (e)(GA) 'umbymod' forth unsigned divide ud by u1 leave quotient u3 and remainder u2. dvs = 0 ovf: dvd > 0 $ffffffff $ffffffff dvd = 0 1 0=> um/ ( ud1 u2 -- u3 ud4 ) (e) 'umby' forth unsigned divide double ud1 by single u2, leave unsigned double quotient ud4 and remainder u3. [this is "lib4th" basic unsigned division operation.] dvs = 0 ovf: dvd > 0 $ffffffff.ffffffff $ffffffff dvd = 0 0.00000001 0=> umd* ( ud1 ud2 -- uq3 ) 'umdmul' forth unsigned multiply doubles to quad=> u* ( n1 n2 -- d3 ) (f6)(m,8) 'umul' forth um* ( n1 n2 -- d3 ) (a)(m,8) 'umul' forth unsigned multiply sings, leave double=> udm* ( ud1 u2 -- ud3 ovf ) (e) 'udmmul' forth unsigned multiply double by sing to double, ovf is m.s. cell of treble product. (e: NZ*S if ovf =/= 0)=> u* ( n1 n2 -- d3 ) (f6)(m,8) 'umul' forth um* ( n1 n2 -- d3 ) (a)(m,8) 'umul' forth unsigned multiply sings, leave double=> u+ ( dn1 u2 -- dn3 ) (e) 'uplus' forth unsigned add dn1 + u2 := dn3 (eflags reflect double cell addition)=> u^ ( u1 +u2 -- +d3 ) 'upow' forth return double +d3 as u1 to the pover of u2, ud3 := 0 if u2 < 0=> sm/rem ( d1 n1 -- r2 q3 ) (e)(a:c) 'smbyrem' forth signed divide d1 by n1, leave symmetric quotient q3 and remainder r2. Dividend Divisor | Quotient Remainder -------- ------- + -------- --------- 20 7 | 2 6 -20 7 | -2 -6 20 -7 | -2 6 -20 -7 | 2 -6 dvs = 0 ovf: dvd > 0 $7fffffff $7fffffff dvd < 0 $80000001 $80000001 dvd = 0 1 0 (e: overflow into double quot. if NZ flags)=> q+- ( q1 n2 -- q3 ) 'qpm' forth apply sign of n2 to q1, i.e. negate q if n < 0=> m/mod ( dn n1 -- n2r n3q ) (v) 'mbym' forth double by sing to sing rmd and quot division, xec from uvari (m/mod) which initially is vectored to {sm/rem}.=> m/ ( d1 n2 -- n3 d4 ) (e) 'mby' forth signed divide double d1 by single n2, leave symmetric double quotient d4 and remainder n3. Dividend Divisor | Quotient Remainder -------- ------- + -------- --------- 20 7 | 2 6 -20 7 | -2 -6 20 -7 | -2 6 -20 -7 | 2 -6 dvs = 0 ovf: dvd > 0 $7fffffff.ffffffff $7fffffff dvd < 0 $80000000.00000001 $80000001 dvd = 0 0.00000001 0 [hopefully, all that sick "exceptions" stuff will safely be intercepted...=> udm*/mod ( ud1 u2 u3 -- u4 ud5 ) (4) 'udmmulbym' forth unsingned double ud5 = ud1*u2/u3, u4=rmd; w/ quad intermediate opr.=> um*/ ( u1 u2 u3 -- ud4 ) 'ummulby' forth unsingned double ud4 = u1*u2/u3=> m*/ ( d1 n2 n3 -- d4 ) 'mmulby' forth singned double d4 = d1 * n2 / n3; w/ quad intermediate opr.=> m* ( n1 n2 -- d3 ) (f6)(a)(m,8) 'mmul' forth signed multiply sings n1 by n2 to double d3=> m+ ( dn1 n2 -- dn3 ) (e)(79) 'mplus' forth signed add n2 + dn1 := dn3 (eflags reflect double cell addition)=> fm/mod ( d1 n1 -- n2 n3 ) (e,?)(GA) 'fmbymod' forth signed divide dvd=d1 by dvs=n1, leave floored quotient n3 and remainder n2. fm/mod from sm/rem and, if quot 0<, rmd := rmd + divisor, quot := quot - 1. Dividend Divisor Quotient Remainder -------- ------- | -------- --------- 10 7 | 1 3 -10 7 | -2 4 10 -7 | -2 -4 -10 -7 | 1 -3 dvs = 0 overflow values: dvd > 0 $7fffffff $7fffffff dvd < 0 $80000001 $80000001 dvd = 0 1 0=> factorial ( u -- ud ) forth return double ud as the factorial of u, -1 < u < 21, 0 if out of range=> dm* ( d1 n2 -- d3 ovf ) (e) 'dmmul' forth signed multiply double by sing to double. ovf is m.s. cell of treble product. (e: NZ*S if ovf =/= 0)=> md* ( d1 d2 -- q3 ) (4) 'mdmul' forth signed multiply doubles to quad=> dgcd ( d1 d2 -- d3 ) (4) 'dgcd' forth returns the greatest common denominator d3 of the absolute value of two signed doubles. If either number is zero, returns the absolute value of the other one.=> d+- ( d1 n1 -- d2 ) (79) 'dpm' forth apply sign of sing n1 to double d1.=> ^ ( n1 +n2 -- d3 ) 'pow' forth return signed double d3 as n1 to the pover of n2, d3 := 0 if n2 < 0, d3 := 1 if n2 = 0=> D0<> ( d1 -- flg ) (a) 'dzneq' ans d0=/= ( d1 -- flg ) (m,13)(e) 'dzneq' forth tf if double, dx1 is non-zero (e: NZ if d1 =/= 0=> D0<> ( d1 -- flg ) (a) 'dzneq' ans d0=/= ( d1 -- flg ) (m,13)(e) 'dzneq' forth tf if double, dx1 is non-zero (e: NZ if d1 =/= 0=> d0= ( d1 -- flg ) (a:d)(m,14)(e) 'dzeq' forth tf if d1 equal to 0 (e: Z if d1 = 0=> d0< ( d1 -- flg ) (a:d)(m,6)(e) 'dzless' forth tf if d1 -ve (e: NZ*S if d1 < 0, else NS+Z=> d0> ( d1 -- flg ) (e) 'dzgt' forth tf if d1 non-zero +ve (e: eflags from <test m.s.cell>=> D<> ( d1 d2 -- flg ) 'dneq' ans tf if d1 not equal to d2 d=/= ( d1 d2 -- flg ) 'dneq' forth tf if d1 not equal to d2=> D<> ( d1 d2 -- flg ) 'dneq' ans tf if d1 not equal to d2 d=/= ( d1 d2 -- flg ) 'dneq' forth tf if d1 not equal to d2=> d= ( d1 d2 -- flg ) (79)(a:d)(e) 'deq' forth tf if d1 equal to d2 (e: Z if d1=d2=> du< ( d1 d2 -- flg ) (a:dx)(m,14)(e) 'duless' forth tf if unsigned d1 smaller than d2 (e: NZ*S if d1 u< d2, else Z*NS, flg is C from d1-d2=> d< ( d1 d2 -- flg ) (a:d)(e) 'dless' forth tf if signed d1 smaller than d2 (e: NZ*S if d1<d2, else Z*NS, flg is S from d1-d2=> du> ( d1 d2 -- flg ) (m,14)(e) 'dugreat' forth tf if unsigned d1 greater than d2 (e: NZ*S if d1 u> d2, else Z*NS, flg is C from d2-d1=> d> ( d1 d2 -- flg ) (m,17)(e) 'dgreat' forth tf if signed d1 greater than d2 (e: NZ*S if d1>d2, else Z*NS, flg is S from d2-d1=> ?udcmp ( d1 d2 -- d1 d2 f ) (e) 'qudcmp' forth flag f from unsigned comparison, f=1 if d2 u< d1, f=-1 if d1 u< d2. { d1 d2 -- ) 2over 2over du> if 1 else 2over 2over d= 0= endif ( -- d1 d2 f }=> ?d0= ( d1 -- d1 flg ) (e) 'qdzeq' forth leave d1 unchanged, ret tf if d1 equal to zero (e: Z if d1 = 0=> udsqrt ( ud1 -- ud2 j ) (x) forth ud2 := sqare root of unsigned double |ud1|; j := -1 if top bit of ud1 set (-ve). note: ud2 m.s. sing always zero, left in place for -re- {vsqrt}, {dvsqrt}.=> ud/mod ( ud1 ud2 -- ud3 ud4 ) 'udbym' forth unsigned divide doubles, leave qot ud4 & rmd ud3=> ud/ ( ud1 ud2 -- ud3 ) 'udby' forth unsigned divide doubles, leave qot=> ud* ( ud1 ud2 -- ud3 ) (4) 'udmul' forth unsigned multiply doubles, ret double prd=> dslbits ( d1 -- d1 n ) forth ret no. n of bits by which d1 may be shifted left w/o change of sign.=> dsgn ( d1 -- -1|0|1 ) (e) forth signum of d1; (e: Z and N flags reflect result)=> dminus ( d1 -- -d1 ) (fg)(m,8) 'dnegate' fig dnegate ( d1 -- -d1 ) (a)(m,8) forth 2-s complement of double (eflags reflect result)=> dmod ( d1 d2 -- d3 ) (4) forth divide doubles d1 by d2, leave signed double rmd d3=> dminus ( d1 -- -d1 ) (fg)(m,8) 'dnegate' fig dnegate ( d1 -- -d1 ) (a)(m,8) forth 2-s complement of double (eflags reflect result)=> dmin ( d1 d2 -- dn ) (a:d)(15) forth drop larger one of two doubles.=> dmax ( d1 d2 -- dn ) (a:d) forth drop smaller one of two doubles.=> df/mod ( d1 d2 -- d3r d2q ) 'dfbym' forth floored division of doubles, double remainder and double quotient=> dabs ( d1 -- +d1 ) (f6) forth negate double d1 if -ve=> d1abs ( d1 -- +d1 ) (m,9) forth ret one-s complement of double if -ve=> d/mod ( d1 d2 -- d3 d4 ) (4) 'dbym' forth divide doubles d1 by d2, leave signed doubles rmd d3 and qot d4=> d/ ( d1 d2 -- d3 ) (4) 'dby' forth divide doubles d1 by d2, leave signed double qot d3=> d* ( d1 d2 -- d3 ) (4) 'dmul' forth signed multiply doubles, ret double prd=> d- ( dn1 dn2 -- dn3 ) (e) 'dsub' forth subtract d2 from d1 (eflags reflect double cell subtraction)=> d+ ( dn1 dn2 -- dn3 ) (e) 'dplus' forth add d2 to d1 (eflags reflect double cell addition)=> 2xor ( d1 d2 -- d3 ) (f6) 'xor2' forth bitwise <xor> d1 w/ d2=> 2rshifta ( d1 u -- d2 ) (e)(x) 'drshifta' forth double shift right, arithmetic floored, signed division by 2^(u), u < 64.=> 2rshift ( dx1 u -- dx2 ) (e)(x) 'drshift' forth logic shift right double, u mod 64=> 2or ( d1 d2 -- d3 ) (f6) 'or2' forth bitwise <or> d1 w/ d2=> 2not ( ud1 -- ud2 ) (f6)(m,5) 'dnot' fig return ud2 1-s complement of ud1 2invert ( ud1 -- ud2 ) (f6)(m,5) 'dnot' forth return ud2 1-s complement of ud1=> 2lshift (k)=> 2not ( ud1 -- ud2 ) (f6)(m,5) 'dnot' fig return ud2 1-s complement of ud1 2invert ( ud1 -- ud2 ) (f6)(m,5) 'dnot' forth return ud2 1-s complement of ud1=> 2and ( d1 d2 -- d3 ) (f6) 'and2' forth bitwise <and> d1 w/ d2=> d8/ ( d1 -- d2 ) (e) 'deightby' forth divide double by 8=> d4/ ( d1 -- d2 ) (e) 'dfourby' forth divide double by 4=> d2/ ( d1 -- d2 ) (e)(a:d) 'dtwoby' forth divide double by 2=> d8* ( d1 -- d2 ) (x) 'dmul8' forth multiply double by 8=> d4* ( d1 -- d2 ) (x) 'dmul4' forth multiply double by 4=> d2* ( d1 -- d2 ) (e)(x)(a:d) 'dmul2' forth multiply double by 4=> d8- ( d1 -- d2 ) (e)(f6)(m,7) 'deightm' forth decrement double by 8=> d8+ ( d1 -- d2 ) (e)(f6,m,7) 'deightp' forth increment double by 8=> d4- ( d1 -- d2 ) (e)(f6)(m,7) 'dfourm' forth decrement double by 4=> d4+ ( d1 -- d2 ) (e)(f6)(m,7) 'dfourp' forth increment double by 4=> d2- ( d1 -- d2 ) (e)(f6)(m,7) 'dtwom' forth decrement double by 2=> d2+ ( d1 -- d2 ) (e)(f6)(m,7) 'dtwop' forth increment double by 2=> d1- ( d1 -- d2 ) (e)(f6)(m,7) 'donem' forth decrement double by 1=> d1+ ( d1 -- d2 ) (e)(f6)(m,7) 'donep' forth increment double by 1=> ds-pick ( n1 -- n2 )(C: ..x.. -- ..x.. ) 'dspick' forth ( -n -- )(C: ..x.. n1 -- n1 ..x.. ) 'dspick' forth pick from/to saved top of datastack (as stored by {head} or user/appl) for use while {:}-compiling, in intermediately interpreting state. storeing an item back to data-stack by -n with -1 referring to @tos. (e: eflags remain unchanged)=> cs-roll ( n -- )(C: s(n)..s1 -- ..s1 s(n) )(a:tx) forth roll control item (double cell) on datastack=> cs-pick ( n -- )(C: s(n)..s1 -- s(n)..s1 s(n) )(a:tx) forth pick control item (double cell) from datastack=> cs-drop ( n -- )(C: s(n)..s1 -- s(n).. )(a:tx) forth drop control item (double cell) on datastack=> cs-depth ( -- n ) 'csdepth' forth no. of compile-stack items (doubles) after colon defn. initialization.=> 2swap ( d1 d2 -- d2 d1 ) 'swap2' forth exchange top two doubles at tos (e: eflags remain unchanged)=> 2rot ( d1 d2 d3 -- d2 d3 d1 ) (x)(a:dx) 'rot2' forth roll 3rd double to tos (e: eflags & non-mmx regs remain unchanged)=> 2over ( d1 d2 -- d1 d2 d1 ) 'over2' forth copy double @nos to tos (e: eflags remain unchanged)=> 2drop ( dn -- ) (a:c)(m,5) 'drop2' forth drop double @tos (e: eflags unchanged)=> 2dup ( d1 -- d1 d1 ) (a:d)(m,8) 'dup2' forth duplicate double @tos=> 2pick ( nm..n1 n -- nm..n1 n{n} ) (m,12) 'pick2' forth fetch +n-th double item to tos, { 0 2pick } is {2dup} or, store @nos item to -n-th item in data-stack. zero index refers to @nos. NOTE: +ve indices, only, for the compiled macro variant; -re- {2-pick}. (e: eflags remain unchanged)=> 2roll ( nx...nm +N -- nx...nm nN ) 'roll2' forth ( nx...nm -N -- nN nx...nm ) roll double, re {roll}, index range -16383 < N < 16382=> 2r> ( -- d )(R: d -- ) (m,11) 'rfrom2' forth does{ r> r> }=> ----------------------------------------------------------------------- -- doubles cell order always(!) little endian, l.s.cell @tor, maintained by store+increment PS and decrement+store RS. for ANS-Forth compliance, the only exceptions being the ordered double cells storeing/fetching words 2@, 2!, 2>R, 2R@, 2R>, which by that standard were justified with some silly tricks programmery, combining push/pop with an implied swap was 'natural programming..' to those highly admired, deeply respected, "experts"... L4 mode: 2>r and >r >r PS:[ n2 n1 -- ]top - RS:[ -- n1 n2 ]top 2r@ PS:[ -- n2 n1 ] ANS mode: 2>r PS:[ n2 n1 -- ]top - RS:[ -- n2 n1 ]top >r >r PS:[ n2 n1 -- ]top - RS:[ -- n1 n2 ]top 2R> (R: n1 n2 -- )( -- n2 n1 ) (m,11) 'arfrom2' ans in reversed cells order pop double from tos to returnstack, use w/ {ans} words 2>R and 2R@. DPANS94 17.6.2.0340: @tos corresponds to @tor, cells order on RS reversed. DPANS94 A.6.2.0340: justification of cells order is plain nonsense... ANS-mode push/pop vs l4/4th is { swap 2>r .. 2r@ swap .. 2r> swap }=> 2r ( -- d ) (R: d -- d ) (m,9) 'r2' forth copy double from returnstack to datastack, does{ r> r over >r }. NOTE: consistent, little endian cells & bytes order; -re- {2R@} ANS-voc.=> 2R@ (R: n1 n2 -- )( -- n2 n1 ) 'ar2f' ans copy double from tos to returnstack - in reversed cells order! use w/ {ans} words 2>R and 2R>. ANS-mode push/pop vs l4/4th -re- {2R>}=> 2>rr ( d -- d )(R: -- d ) (m,10) 'torr2' forth copy double from data-stack to to return-stack, { 2dup 2>r }.=> 2>r ( d -- )(R: -- d ) 'tor2' forth push double from tos to returnstack, PS: n1 n2 -- RS: -- n1 n2 F8: runtime of {do}, does{ >r >r }=> 2>R ( n1 n2 -- )(R: -- n2 n1 ) 'ator2' ans in reversed cells order push double from tos to returnstack, use w/ {ans} words 2R@ and 2R>. ANS-mode push/pop vs l4/4th -re- {2R>}=> zcount ( p1 -- p1 u ) (e) forth find length u of <nul> terminated strig at p1. u := 0 if p1 = 0.=> toggle ( p c -- ) (fg) fig xor byte at ptr p with byte c (fig-4th opr w. inverse operands order: byte c @tos, ptr @nos)=> place-size ( -- n ) (c),m,6) 'placesize' forth biggest string size which {place}, {+place} can generate; cpl'd dft 4K.=> place ( p1 n p2 -- ) (a:?) forth copy stg(p1,n) to byte-counted stg at p2. n limited to -re- {place-size}. store <nul>+asciz stg if count > 255, i.e. leading and trailing <nul>. stg at p2 cleared (1st cell) if n=0, unchanged if n<0.=> move ( p1 p2 +n -- ) forth non-overwriting copy +n bytes from p1 to p2, noop if n < 0.=> fill ( p +u c -- ) (fg) forth store +u (8bit-)bytes c to memory beginning at ptr p optimizing to 32bit items if count and destn at cell bounds.=> erase ( p +u -- ) forth store +u <zero> bytes to memory beginning at ptr p=> COUNT ( p1 -- p2 u ) ans p2 := p1+charsize, u := string(p1) length; u := 0 if p1 = 0. NOTE: implementation of 'characters' may change for unicode, etc, thus neither variant of {count} should be (ab)used to substitute { 1+ dup 1- c@ } - re c@+=> count ( p1 -- p2 u ) 'ccount' forth p2 := p1 or p1+charsize, u := string(p1) length; u := 0 if p1 = 0. {count} 1st checks whether leading byte is non-zero and returns, else scans memory until trailing <nul> and returns asciz string's character count. NOT A SUBSTITUTE to { 1+ dup 1- c@ } -re- {c@+}; for instance, { bl word count } will fail on empty input! -re- {zcount} and ans-voc {COUNT}.=> cmove> ( p1 p2 +n -- ) 'cmovegt' forth copy +n bytes from p1 to p2, beginning at high address no action if n = zero or -ve; data copying by bytes.=> cmove ( p1 p2 +n -- ) (fg) 'xcmove' forth copy +n bytes from p1 to p2, beginning at low address. faster than {cmove>}, copying by 32bit items if appropriate.=> c-xchg ( p1 p2 +u -- ) 'cxchg' forth exchange +u bytes in ranges p1,p1+u2 and p2,p2+u2.=> blanks ( p +u -- ) (fg) fig blank ( p +u -- ) (fg)(a:stg) 'blanks' forth store +u <bl> characters (8bit-bytes) to memory beginning at ptr p.=> blanks ( p +u -- ) (fg) fig blank ( p +u -- ) (fg)(a:stg) 'blanks' forth store +u <bl> characters (8bit-bytes) to memory beginning at ptr p.=> bl.r ( p u n -- p u ) (f6) 'bldotr' forth output as many blanks as required to right justified {type}ing stg(p,u) in a field of n chars. no extra chars if n <= u. -re- {+blanks}, which builds a blank string at -re- {here}=> >move< ( p1 p2 +n -- ) 'movex' forth copy n>0 bytes from p1 in reversed order to p2, w/ unrestricted range p1,p2.=> +place ( p1 n1 p2 -- | abort ) (f6) 'pplace' forth +n1: append stg(p1,n1) to byte-counted stg at p2 or, -n1: prepend byte-counted stg at p2 by stg(p1,-n1). counted stg if len < 256, else stored w. leading <nul> byte, for asciz. forcedly storing a <nul>-enclosed string if state-flag <asciz> is set. in either case, dstn stg will be <nul>-terminated. abort if accumulated length > -re- {place-size}, old len recovered in +n case. ( for safety, stg result length limited to max(PAGE_SIZE,PATH_MAX), which can be ( changed by re-compiling w/ a modified value of <pthfsize> -re- "constants.inc".=> 4!! ( p1 p2 -- ) (x) 'qxsto' forth exchange contents of quad at p1 with quad at p2=> 2!! ( p1 p2 -- ) (x) 'twoxsto' forth exchange contents of double at p1 with double at p2=> 2@! ( p1 p2 -- ) (x) 'twofsto' forth copy double cell from ptr p1 to ptr p2 ( mmx mode w/o timing gain )=> 2+! ( ud ptr -- ) (f6) 'twoplsto' forth add double @nos to address pointed to by @tos=> 2! ( d ptr -- ) (a:d)(m,18) 'twosto' fig store double @nos to address pointed to by @tos. 2! ( d ptr -- ) (a:d)(m,18) 'twosto' forth store double @nos to address pointed to by @tos. -re- 2! in {ans} voc, for the ANS-4th big-endian cells order words.=> 2! ( d ptr -- ) (a:d)(m,18) 'twosto' fig store double @nos to address pointed to by @tos. 2! ( d ptr -- ) (a:d)(m,18) 'twosto' forth store double @nos to address pointed to by @tos. -re- 2! in {ans} voc, for the ANS-4th big-endian cells order words.=> 2! ( d ptr -- ) (a:d)(m,18) 'twostoa' ans store double @nos to address pointed to by @tos, NOTE: re DPANS94 .6.1.0310, inconsistent, BIG ENDIAN cells order!=> 2@ ( p -- ud ) (m,10) 'twofetch' fig fetch double pointed to by p. 2@ ( p -- d ) (a:d)(m,10) 'twofetch' forth fetch double pointed to by p. -re- 2@ in {ans} voc, for the ANS-4th big-endian cells order words.=> 2@ ( p -- ud ) (m,10) 'twofetch' fig fetch double pointed to by p. 2@ ( p -- d ) (a:d)(m,10) 'twofetch' forth fetch double pointed to by p. -re- 2@ in {ans} voc, for the ANS-4th big-endian cells order words.=> 2@ ( p -- d ) (a:d)(m,10) 'twofetcha' ans fetch double pointed to by p. NOTE: re DPANS94 .6.1.0350, BIG ENDIAN cells order!=> m+! ( u ptr -- ) (f6) 'mplsto' forth add sign extended sing @nos to double pointed to by @tos=> a! ( n a -- ) (m,10) 'astore' forth store cell to true address=> a@ ( a -- n ) (m,2) 'afetch' forth fetch cell from true address=> !! ( p1 p2 -- ) 'xsto' forth exchange contents of cell at p1 with cell at p2=> !- ( x p1 -- p2 ) (m,12) 'storem' forth pre-decrement p1 by cell size and store x, leave new ptr p2.=> !+ ( x p1 -- p2 ) (m,12) 'storep' forth store x, post-increment p1 by cell size, leave new ptr p2.=> +! ( u p -- ) (m,15) 'plsto' forth add u to cell pointed to by p=> ! ( u ptr -- ) (a:c)(m,11) 'store' forth store item @nos to address pointed to by @tos=> @! ( p1 p2 -- ) 'fsto' forth copy cell at ptr p1 to ptr p2=> @- ( p1 -- p2 u ) (m,8) 'fetchm' forth pre-decrement p1 by cell size and fetch data item @p2=> @+ ( p1 -- p2 u ) (m,8) 'fetchp' forth fetch data item pointed to by p1, post-increment p1 by cell size.=> @ ( p -- n ) (a:c)(m,3) 'fetch' forth fetch cell @p=> w!! ( p1 p2 -- ) 'wxsto' forth exchange contents of word at ptr p1 with word at ptr p2=> w!- ( x p1 -- p2 ) (m,13) 'wstorem' forth pre-decrement p1 by half size of a cell, sto l.s. half cell x, leave p2.=> w!+ ( x p1 -- p2 ) (m,13) 'wstorep' forth sto l.s. half cell x, post-increment p1 by half size of a cell, leave ptr p2.=> w! ( c p -- ) (m,13) 'wstore' forth store l.s.half cell @nos to address pointed to by @tos=> w@! ( p1 p2 -- ) 'wfsto' forth copy 16bit word (l.s.half cell) at ptr p1 to ptr p2=> w@+ ( p1 -- p2 u ) (m,10) 'wfetchp' forth fetch half cell pointed to by p1, increment p1 by its size=> w@ ( p -- u ) (m,4) 'wfetch' forth fetch half cell item @p=> c!! ( p1 p2 -- ) 'cxsto' forth exchange contents of byte at ptr p1 with byte at ptr p2=> c+! ( u p -- ) (m,15) 'cplsto' forth add byte u to byte pointed to by p=> c!+ ( x p1 -- p2 ) (m,10) 'cstorep' forth store char x, post-increment p1 by char size, leave new ptr p2.=> c! ( c p -- ) (a:c)(m,11) 'cstore' forth store char c @nos to address pointed to by p @tos.=> c@! ( p1 p2 -- ) 'cfsto' forth copy byte (char) at ptr p1 to ptr p2=> c@+ ( p1 -- p2 u ) (m,7) 'cfetchp' forth fetch char pointed to by p1, increment p1 by fetched char size. (the traditional {count} implementation)=> c@ ( p -- u ) (m,4) 'cfetch' forth fetch char pointed to by p=> b!- ( x p1 -- p2 ) (m,10) 'bstorem' forth pre-decrement p1 by one, sto byte x, leave ptr p2.=> b!+ ( x p1 -- p2 ) (m,10) 'bstorep' forth store byte x, post-increment p1 by one, leave new ptr p2.=> b! ( c p -- ) (a:c)(m,11) 'bstore' forth store byte c @nos to address pointed to by p @tos.=> b@+ ( p1 -- p2 u ) (m,7) 'bfetchp' forth fetch 8bit-byte pointed to by p1, increment p1 by byte size.=> b@ ( p -- u ) (m,4) 'bfetch' forth fetch char pointed to by p=> xor! ( n p -- ) (f6) 'xors' forth <xor> n to cell at p in memory=> or! ( n p -- ) (f6) 'ors' forth <or> n to cell at p in memory=> and! ( n p -- ) (f6) 'ands' forth <and> n to cell at p in memory=> (d1-) ( n1 -- n2 ) (e,fg)(m,8) 'bd1mb' forth decrement double cell at p by one=> (d1+) ( p -- ) (e,fg)(M,8) 'bd1pb' forth increment double cell at p by one=> (1-) ( n1 -- n2 ) (e,fg)(m,8) 'b1mb' forth decrement cell at p by one=> (1+) ( p -- ) (e,fg)(M,8) 'b1pb' forth increment cell at p by one=> ekey>char ( u -- u ff | c1 tf ) (a:fcx) 'ekey2char' forth return tf if u is in range of printing chars, bounds from uvari (pchr).=> ekey>asci ( u -- u ff | c1 tf ) 'ekey2asci' forth {ekey>char} with lower low bound := 0, bounds from uvari (pchr).=> u>d ( n1 -- ud1 ) (m,3) 'u2dn' ans unsigned extend sing to double. u->d ( n1 -- ud1 ) (m,3) 'u2dn' forth unsigned extend sing to double.=> u>d ( n1 -- ud1 ) (m,3) 'u2dn' ans unsigned extend sing to double. u->d ( n1 -- ud1 ) (m,3) 'u2dn' forth unsigned extend sing to double.=> s>upper ( p1 u1 p2 u2 -- p3 u3 ) 's2upper' forth convert stg(p1,u1) to all upper case characters (per byte), buf-size expected to provide for chars and terminating <nul>. using conversion table { (lo>hi) @ }, no conversion if zero entry. ret <nul>-terminated, un-counted stg(p3,u3) in buf(p2,u2). u3 = 0 if u2 < u1. if (p1,u1) writable, source and buf may be at same address. char conversion tables by dft from iso-8559-1 charset data arrangement, i.e. upper case ranges [65,90] and [192,222], lower case in [97,122] and [224,254],=> s>lower ( p1 u1 p2 u2 -- p3 u3 ) 's2lower' forth convert stg(p1,u1) to all lower case characters (per byte), buf-size expected to provide for chars and terminating <nul>. using conversion table { (hi>lo) @ }, no conversion if zero entry. ret stg(p3,u3) in buf(p2,u2). u3 = 0 if u2 not > u1. if (p1,u1) writable, source and buf may be same area w/ p2:=p1, u2:=u1+1. char conversion tables by dft from iso-8559-1 charset data arrangement, i.e. upper case ranges [65,90] and [192,222], lower case in [97,122] and [224,254],=> s->d ( n1 -- d1 ) (fg)(m,4) 's2dn' forth sign extend sing to double s>d ( n1 -- d1 ) (m,4) 's2dn' forth sign extend sing to double=> s->d ( n1 -- d1 ) (fg)(m,4) 's2dn' forth sign extend sing to double s>d ( n1 -- d1 ) (m,4) 's2dn' forth sign extend sing to double=> s->w ( n1 -- +n1 ) (m,3) 's2wn' forth truncate cell to unsigned word effect is extension of l.s. half cell to unsigned single=> s->c ( n1 -- +n1 ) (m,3) 's2cn' forth truncate cell to unsigned byte effect is extension of l.s.byte to unsigned single=> s->b ( n -- n1 n2 n3 n4 ) 's2bn' forth unsigned extract 4 bytes of a sing, m.s.b @tos=> d->s ( d -- s ) (e) 'd2sn' forth truncate double cell to single (e: NZ if double doesn't fit into single) d>s (a) 'd2sn' forth truncate double cell to single. re DPANS 8.4.1.2: m.s. cell is lost, w/o indication of ovf.=> d->s ( d -- s ) (e) 'd2sn' forth truncate double cell to single (e: NZ if double doesn't fit into single) d>s (a) 'd2sn' forth truncate double cell to single. re DPANS 8.4.1.2: m.s. cell is lost, w/o indication of ovf.=> d->q ( dn -- qn ) (m,5) 'd2qn' forth sign extend double to quad=> d->b ( d -- n1 .. n8 ) 'd2bn' forth unsigned extract 8 bytes of a double, m.s.b @tos=> w->s ( n1 -- s ) (e)(m,3) 'w2sn' forth signed extend l.s.half cell to single=> c>upper ( c1 -- c2 ) 'c2upper' forth convert char c1 to upper case character c2, char = byte, -re- {s>upper}.=> c>lower ( c1 -- c2 ) 'c2lower' forth convert char c1 to lower case character c2, char = byte, -re- {s>lower}.=> c->s ( n1 -- s ) (e)(m,3) 'c2sn' forth signed extend l.s.byte to single=> b->s ( n1 n2 n3 n4 -- n ) 'b2sn' forth combine 4 sings l.s.bytes to sing n, ms.b from tos=> b->d ( n1 .. n8 -- d ) 'b2sn' forth combine 8 sings l.s.bytes to double d, ms.b from tos=> abs>4th ( address -- a ) (m) 'abs2fth' forth convert true (virtual) address to forth ptr=> 4th>abs ( p -- address ) (m) 'fth2abs' forth convert forth ptr to true (virtual) address=> noop ( -- ) (fg)(m,1) forth most efficiently do nothing, hi-level call immediately returns, macro inserts a <nop> operation.=> 1- ( n1 -- n2 ) (e,fg)(m,1) 'sub1' forth char- ( n1 -- n2 ) (e,C)(m,1) 'sub1' forth decrement sing by 1=> 1+ ( n1 -- n2 ) (e,fg)(m,1) 'add1' forth char+ ( n1 -- n2 ) (e,C)(m,1) 'add1' forth increment sing by 1=> cells ( n1 -- n2 ) (a:c)(m,3) 'mul4' ans multiply n1 by cellsize(4) 4* ( n1 -- n2 ) (e)(m,3) 'mul4' forth multiply n1 by 4=> CELL/ ( n1 -- n2 ) (e)(m,3) 'cellby' ans signed divide n1 by 4 (cellsize). w/ floored rounding.=> 4- ( n1 -- n2 ) (e)(f6)(m,3) 'sub4' forth cell- ( n1 -- n2 ) (a)(m,3) 'sub4' forth n2 := n1 - cellsize(4), decrement sing by 4=> 4+ ( n1 -- n2 ) (e)(m,3) 'add4' forth cell+ ( n1 -- n2 ) (GA)(m,3) 'add4' forth n2 := n1 + cellsize(4), increment sing by 4=> abs ( n1 -- n2 ) (e)(m,10) 'cabs' forth negate n1 if -ve; { dup 0 min minus swap 0 max max } "negative zero" case: ret 0 if n1 = -0 (e: C if n1 was -0)=> ABS ( n1 -- n2 ) (e)(m,6) 'aabs' ans ret n2 := | n1 | = { dup 0 min minus swap 0 max max } no "negative zero", ret n2 := n1 if n1 = -0 (e: C if n1 was -0)=> 8* ( n1 -- n2 ) (e)(m,3) 'mul8' forth multiply n1 by 8 abits ( n1 -- n2 ) (m,3) 'mul8' ans n2 := no. of n1 address units bits=> 16/mod ( n1 -- n2 n3 ) (e)(m,) 'div16m' forth signed divide n1 by 16, ret quot n2, rem n3. 'round towards zero' mode.=> 16* ( n1 -- n2 ) (e)(m,3) 'mul16' forth multiply n1 by 16=> 10* ( n1 -- n2 ) (e)(m,3) 'mul10' forth multiply n1 by 10=> 9* ( n1 -- n2 ) (e)(m,3) 'mul9' forth multiply n1 by 9=> 8/ ( n1 -- n2 ) (e)(m,) 'div8' forth signed divide n1 by 8. 'round towards zero' mode.=> 8* ( n1 -- n2 ) (e)(m,3) 'mul8' forth multiply n1 by 8 abits ( n1 -- n2 ) (m,3) 'mul8' ans n2 := no. of n1 address units bits=> 8- ( n1 -- n2 ) (e)(f6)(m,3) 'sub8' forth decrement sing by 8=> 8+ ( n1 -- n2 ) (e)(f6)(m,3) 'add8' forth increment sing by 8=> 7* ( n1 -- n2 ) (e)(m,5) 'mul7' forth multiply n1 by 7=> 6* ( n1 -- n2 ) (e)(m,4) 'mul6' forth multiply n1 by 6=> 5* ( n1 -- n2 ) (e)(m,3) 'mul5' forth multiply n1 by 5=> 4/ ( n1 -- n2 ) (e)(m,13) 'div4' forth signed divide n1 by 4 (cellsize). 'round towards zero' mode.=> cells ( n1 -- n2 ) (a:c)(m,3) 'mul4' ans multiply n1 by cellsize(4) 4* ( n1 -- n2 ) (e)(m,3) 'mul4' forth multiply n1 by 4=> 4- ( n1 -- n2 ) (e)(f6)(m,3) 'sub4' forth cell- ( n1 -- n2 ) (a)(m,3) 'sub4' forth n2 := n1 - cellsize(4), decrement sing by 4=> 4+ ( n1 -- n2 ) (e)(m,3) 'add4' forth cell+ ( n1 -- n2 ) (GA)(m,3) 'add4' forth n2 := n1 + cellsize(4), increment sing by 4=> 3* ( n1 -- n2 ) (e)(m,3) 'mul3' forth multiply n1 by 3=> 2/ ( n1 -- n2 ) (e)(m,12) 'div2' forth signed divide n1 by 2. 'round towards zero' mode. (NOTE: correct result incl. odd -ve, not ANS-4th compliant)=> 2/ ( n1 -- n2 ) (e)(m,2) 'shr2' ans signed divide n1 by 2, 'floored rounding' mode -re- DPANS 6.1.0330.=> chars ( n1 -- n2 ) (a:c)(m,0) forth multiply n1 by charsize (1, i.e. a {noop} word) 2* ( n1 -- n2 ) (e)(m,2) 'mul2' forth multiply n1 by 2=> 2- ( n1 -- n2 ) (e)(fg)(m,3) 'sub2' forth decrement sing by 2=> 2+ ( n1 -- n2 ) (e)(fg)(m,3) 'add2' forth increment sing by 2=> 1abs ( n -- +n ) (f6)(m,6) 'abs1' forth absolute value wrt one-s complement - {invert} if -ve=> 1- ( n1 -- n2 ) (e,fg)(m,1) 'sub1' forth char- ( n1 -- n2 ) (e,C)(m,1) 'sub1' forth decrement sing by 1=> 1+ ( n1 -- n2 ) (e,fg)(m,1) 'add1' forth char+ ( n1 -- n2 ) (e,C)(m,1) 'add1' forth increment sing by 1=> uq/mod ( uq1 uq2 -- uqr uqq ) ((x)) 'uqbym' forth unsigned div quad uq1 by quad uq2, leave quad remainder (@nos) and quotient. div 0: ret uqr := -1, uqq = -1; fast exit if uq2=dvd = 1=> uq2/ ( uq1 -- uq2 ) 'uqdiv2' forth unsigned divide q1 by 2.=> qmod ( q1 q2 -- qr ) ((x)) 'qmod' forth signed div quad by quad, leave quad remainder. -re- {q/mod}=> qf/mod ( q1 q2 -- qr qq ) 'qfbym' forth floored, signed div quad by quad, leave quad remainder (@nos) and quotient. signed 'round near zero' division but, if qq < 0 ret qq:=qq-1, qr:=qr+q2.=> q/ ( q1 q2 -- qq ) ((x)) 'qby' forth signed div quad by quad, leave quad quotient. -re- {q/mod}=> q/mod ( q1 q2 -- qr qq ) ((x)) 'qbym' forth signed div quad by quad, leave quad remainder (@nos) and quotient. 'round near zero' mode, sgn(qot) = sgn(dvd xOR dvs), sgn(rmd) = sgn(dvd).=> uqsm/ ( q1 n2 -- n3 q4 ) (f6) 'uqsmby' forth unsigned divide quad by sing, leave sing rmd n3 & quad quot. div by zero ret quot and rmd w. all bits set, i.e. max value.=> uqsm* ( q1 n1 -- q2 ovf ) (f6) 'uqsmmul' forth unsigned multiply quad by sing, leave quintuple prod, i.e. q2 & overflow=> uqd* ( uq1 ud1 -- uq2 ud2 ) (4) 'uqdmul' forth unsigned multiply quad by double, ret six cells prod.=> uq* ( q1 q2 -- q2 qovf ) (X) 'uqmul' forth unsigned multiply quad by quad, ret quad prod & quad ovf = 8 cells product. does{ 8 nndup 3drop uqd* 6 nnswap drop 2sdrop uqd* 0. -3 2roll 8 n+ drop }=> uqmin ( uq1 uq2 -- uq3 ) ((X)) forth ret uq3 := (uq1+uq2-|uq1-uq2|)/2=> uqmax ( uq1 uq2 -- uq3 ) ((X)) forth ret uq3 := (uq1+uq2+|uq1-uq2|)/2=> uqm/mod ( +q1 ud2 -- ud3 uq4 ) (X) 'uqmbym' forth unsigned divide quad +q1 by ud2, ret quad quotient uq4, double remainder ud3. div 0: ret ud3:=0, uq4:=-1; fast exit if dvd = 1 (w/ shortcut to {uqd/mod} if qot would fit into 2 cells)=> uqd/mod ( uq1 ud2 -- ud3 ud4 ) 'uqdbym' forth unsigned divide quad by double, ret rmd ud3, quot ud4 div 0: ret ud4=qot := -1., ud3=rmd := uq1.lo (modified, bit-wise div. from F-PC, R.L.Smith)=> uq.r ( uq u -- ) 'uqdotr' forth right aligned display unsigned double numeric output string pass 1-s complement fieldwidth u to appending a trailing blank=> qu> ( uq1 uq2 -- flg ) (e) 'qugreat' forth ret true flag if quad uq1 < uq2 (e: ret ^C*^Z if q1 u> q2 (tf), Z if q1=q2=> qu< ( uq1 uq2 -- flg ) (e) 'quless' forth ret true flag if quad uq1 < uq2 (e: ret ^C*^Z if q1 u< q2, Z if q1=q2=> qsqrt ( q1 -- q2 n3 ) ((x))(4) forth ret +ve square root of |q1|, n3 := 1|-1 = sgn(q1), 1 if q1=0 q1 = q2*q2*n3+c | -1 < c < q2, j = [-1,1] q2 is nearest integer the sqare of which is lower or equal |q1|*n3. NOTE: {qsqrt} is different vs {nsqrt}, {dsqrt} wrt flag n3 =/= 0.=> qsm+ ( q1 n1 -- q2 ) (e) 'qsmplus' forth add sign extended sing n1 to quad q1=> qslbits ( q1 -- q1 n ) forth ret no. n of bits by which +/- q1 can be shifted left w/o change of sign.=> qsgn ( q -- 1|0|-1 ) (e)(4) forth ret signed unit of |q| (e: Z if q=0, ecx=sign cell=> qrshift ( q1 n -- q2 ) forth shift quad q1 right by +ve n bits, i.e. unsigned floored div by 2^n. no overflow result, q2 := 0 if unsigned n > 127=> qnegate ( q1 -- q2 ) (4) forth negate quad (2-s complement) q2 := q1 if only signbit of q1 set.=> qlshift ( q1 n -- q2 ) forth shift quad q1 left by +ve n bits, i.e. mul by 2^n. no overflow result, q2 := 0 if unsigned n > 127=> qgcd ( q1 q2 -- q3 ) (4) 'qgcd' forth returns the greatest common denominator q3 of the absolute value of two signed quads. If either number is zero, returns the absolute value of the other one.=> qfm/mod ( q1 d2 -- d3r q2q ) ((x)) 'qfmbym' forth floored division of quad by double, leave double remainder and quad quotient=> qdfm/mod ( q1 d2 -- d3r d2q ) 'qdfmbym' forth floored division of quad by double, double remainder and double quotient Dividend Divisor Quotient Remainder -------- ------- | -------- --------- 10 7 | 1 3 -10 7 | -2 4 10 -7 | -2 -4 -10 -7 | 1 -3 dvs = 0 overflow values: dvd > 0 $7fff.ffff $7fffffff dvd < 0 $8000.0001 $80000001 dvd = 0 0.0001 0=> qabs ( q1 -- -q1|q1 ) 'qabs' forth negate if q1 -ve=> q* ( q1 q2 -- q2 qovf ) 'qmul' forth signed multiply quad by quad, ret quad prod & quad ovf = 8 cells product.=> q= ( q1 q2 -- flg ) (e)(4) 'qeq' forth tf if equal quads (e: Z if q1 = q2, ecx=sign cell of { q1 q2 - }=> q1abs ( q1 -- ~q1|q1 ) forth ret 1s-complement if q1 -ve=> q2/ ( q1 -- q2 ) 'qdiv2' forth signed divide q1 by 2. 'round towards zero' mode. NOTE: correct result, including odd -ve figures (thus NOT ANS compliant).=> q2* ( q1 -- q2 ) (e)(m,0) 'qmul2' forth multiply q1 by 2. (e: C if ovf=> q1+ ( q1 -- q2 ) 'qonep' forth increment quad by one=> q1- ( q1 -- q2 ) 'qonem' forth decrement quad by one=> q0= ( q -- flg ) (e)(4) 'qzeq' forth tf if quad q = 0 (e: Z if q = 0, ecx=sign cell=> q0> ( q -- flg ) (e)(4) 'qzgreat' forth ret true flag if quad q > 0 (e: NZ if q>0=> q0< ( q -- flg ) 'qzless' forth ret true flag if quad q1 is -ve=> q.r ( q u -- ) 'qdotr' forth right aligned display signed quad numeric output string, pass 1-s complement fieldwidth u to appending a trailing blank=> q+ ( q1 q2 -- q3 ) (e) 'qplus' forth add two quad numbers=> q- ( q1 q2 -- q3 ) (e) 'qsub' forth subtract quad q2 from quad q1=> uq. ( q -- ) 'uqdot' forth display unsigned quad numeric output string.=> q. ( q -- ) 'qdot' forth display signed quad numeric output string.=> q< ( q1 q2 -- flg ) 'qless' forth ret true flag if quad q1 signed < q2=> (q.) ( q n1 n2 -- p u ) (k) 'pqdotp' hidden convert quad to (n1:+ve)un- (n1:-ve)signed numeric string 1-s complement fieldwidth n2 to appending a trailing blank.=> q#> ( xq -- caddr u ) (m) 'qsharpgt' forth finish numeric output string, ready to {type}=> q#s ( q1 -- q0 ) 'qsharps' forth convert q1 to numeric characters at @hld - re {#s}=> q# ( q1 -- q2 ) 'qsharp' forth {#} wrt quad no.=> onegate ( o1 -- o2 ) 'onegate' hidden negate eight-cells item=> o+ ( o1 o2 -- o3 ) (e) 'oplus' hidden add two 8-cells numbers. 'ranum' support. (e: eflags from m.s. cells addition=> o- ( o1 o2 -- o3 ) (e) 'osub' hidden subtract 8-cells o2 number from o1. 'ranum' support (e: eflags from m.s. cells subtraction=> o1+ ( o1 -- o2 ) 'o1p' hidden increment eight-cells item by one=> o0= ( o -- flg ) (e)(4) 'ozeq' hidden tf if eigth-cells int o = 0 (e: Z if o = 0, ecx=sign cell=> nos-qnegate ( q1 qx -- q2 qx ) 'qnegaten' hidden negate quad q1 @nos. (double ranum support)=> nos-uq2/ ( uq1 qx -- uq2 qx ) 'uqdiv2n' hidden unsigned divide q1 @nos by 2.=> nos-q2/ ( uq1 qx -- uq2 qx ) 'qdiv2n' hidden unsigned divide q1 @nos by 2.=> nos-q2* ( q1 qx -- q2 qx ) (e)(m,0) 'qmul2n' hidden multiply q1 @nos by 2. (e: C if ovf=> nos-q1- ( q1 qx -- q2 qx ) 'q1mn' hidden dec @nos quad q1 by one. (double ranum support)=> nos-q1+ ( q1 qx -- q2 qx ) 'q1pn' hidden increment quad @nos by one. (double ranum support)=> nos-4not ( q1 qx -- q2 qx ) 'not4n' hidden one's cpl of quad q1 @nos. (double ranum support)=> 8swap ( qv1 qv2 -- qv1 qv2 ) 'swap8' forth { 8 nswap }, 8 cells per item swap=> 8sover ( qv1 qv2 -- qv2 qv1 qv2 ) (x+x) 'sover8' forth { qvswap qvover }, 8 cells per item swap and over=> 8sdrop ( o1 o2 -- o2 ) 'sdrop8' forth=> 8roll ( on .. o1 o0 +n -- .. on-1 .. o1 o0 on ) (4) 'roll8' forth ( on .. o1 o0 -n -- .. o0 on .. o1 )=> 8pick ( ..on..o1 o0 +n -- ..on..o1 o0 on ) (4) 'pick8' forth ( ..on..o1 o0 oo -n -- ..oo..o1 o0 ) n>0: fetch (+n)-th item to tos. index n = 0 @tos. n<0: store @tos item to (-n)-th position, index 0 refers to item to store.=> 8over ( n1..n8 n9..n16 -- n1..n8 n9..n16 n1..n8 )(x) 'over8' forth copy 2nd @tos eight cells=> 8not ( o1 -- o2 ) 'not8' hidden q2 := one-s complement of eight-cells item q1=> 8dup ( n1..n8 -- n1..n8 n1..n8 ) (x) 'dup8' forth duplicate top eight cells=> 8drop ( o1 o2 -- o1 ) (m,5) 'drop8' forth drop top eight cells=> 4rotd ( q1 q2 q3 -- q2 q3 ) (x) 'rot4d' forth fast aequivalent to { 4rot 4drop }.=> 4rot ( q1 q2 q3 -- q2 q3 q1 ) (x) 'rot4' forth roll 3rd quad to @tos=> 4roll ( qn .. q1 q0 +n -- .. qn-1 .. q1 q0 qn ) (4) 'roll4' forth ( qn .. q1 q0 -n -- .. q0 qn .. q1 )=> 4rdrop (R: q -- ) (f6)(m,3) 'rdrop4' forth drop four cells from return-stack=> 4r> ( -- q )(R: q -- ) 'rfrom4' forth=> 4r ( -- q ) (R: q -- q ) 'r4' forth copy double from returnstack to datastack, does{ r> r over >r }. NOTE: consistent, little endian cells & bytes order; -re- {2R@} ANS-voc.=> 4pick ( ..qn..q1 q0 +n -- ..qn..q1 q0 qn ) (4) 'pick4' forth ( ..qn..q1 q0 qq -n -- ..qq..q1 q0 ) n>0: fetch (+n)-th item to tos. index n = 0 @tos. n<0: store @tos item to (-n)-th position, index 0 refers to item to store.=> 4over ( q1 q2 -- q1 q2 q1 ) (x) 'over4' forth duplicate 2nd on stack quad to @tos ( mmx mode w/ minor timing gain )=> 4swap ( q1 q2 -- q2 q1 ) (x) 'swap4' forth swap quads=> 4sover ( q1 q2 -- q2 q1 q2 ) (x) 'sover4' forth does{ 4swap 4over }=> 4sdrop ( q1 q2 -- q2 ) 'sdrop4' forth=> 4not ( q1 -- q2 ) 'not4' forth convert quad to one-s complement=> 4dup ( q1 -- q1 q1 ) (x) 'dup4' forth duplicate quad=> 4drop ( q1 q2 -- q1 ) (m,5) 'drop4' forth drop quad cells=> 4>r ( q -- )(R: -- q ) 'tor4' forth push quad from tos to returnstack, PS: n1 n2 n3 n4 -- RS: -- n1 n2 n3 n4=> 4-rot ( q1 q2 q3 -- q3 q1 q2 ) (x) 'mrot4' forth reverse roll quad @tos to 3rd=> 4@ ( p -- uq ) 'fetch4' forth fetch quad at ptr p=> 4! ( q ptr -- ) 'store4' forth store quad @nos to address pointed to by @tos=> 3rd-uq2/ ( uq1 qx qy -- uq2 qx qy ) 'uqdiv2t' hidden unsigned divide q1 3rd @tos by 2.=> 3rd-q2* ( q1 qx qy -- q2 qx qy ) (e)(m,0) 'qmul2t' hidden multiply q1 3rd @tos by 2. (e: C if ovf=> 3rd-q1+ ( q1 qx qy -- q2 qx qy ) 'q1pt' hidden increment quad 3rd @tos by one. (uq/mod support)=> ?uqcmp ( uq1 uq2 - uq1 uq2 f ) (e) 'quqcmp' forth unsigned compare quads, ret f: 0 if q1=q2, -1 if q2 u< q1, 1 if q2 u> q1. (e: Z if q2=q1, C if @tos u< @nos; ~C*NS*NZ if @tos u> @nos, ecx=sg(q1-q2)=> ?q0= ( q -- q flg ) (e) 'qqzeq' forth non-destructively test quad for zero, tf if quad q = 0 (e: Z if q = 0, ecx = sign cell | NZ*(ecx<0): q<0, NZ*((ecx>0)+(ecx=0)): q>0=> -4dup ( q1 | 0 -- q1 q1 | 0 ) 'qdup4' forth duplicate quad @tos if =/= zero.=> uns/mod ( n0..nn N m -- q0..qn N rm ) 'unsbym' bignum unsigned divide multi-cell dividend by sing divisor, leave sing rmd & N-sized quot. ret +ve or -ve max if m=0; rm:=0 if N=0; trivial case div-1=> uns* ( n0..nn N m -- p0..pn ov P ) 'unsmul' bignum unsigned multiply counted int by sing, leave P:=(N+1) sized prod; P:=0 if N=0; trivial cases mul 1, mul 0=> un. ( .n1. N -- ) (4) 'undot' bignum display unsigned multi-cell integer as numeric stg=> un->un ( .un1. N M -- .un2. M ) 'untoun' bignum unsigned extend/truncate from +N cells to +M cells size=> s>nfactorial ( u -- .ux. n ) 's2nfac' bignum factorial of n, u*(u-1)*...(u-(u-1)) counted integer .ux. n from sing integer u.=> q->n ( qn -- .n.N ) (m,6) 'q2n' bignum convert un-counted quad to bignum=> nsqrt ( .n.N -- .r.R j ) (4) bignum +ve square root .r.R of signed counted integer .n.N and j=0,-1 if x<0. .m.M is nearest integer the sqare of which is lower or equal |.x.X|*(2j-1).=> nshift ( nm .. n0 M -s -- ov n0' .. nm' M+1 ) bignum ( nm .. n0 M +s -- n0' .. nm' ov M+1 ) n > 0: -re- {nlshift} n < 0: -re- {nrshift}=> nsgn ( n1..nn n -- f ) (e) bignum ret signum of counted int, .n.N <0: f:=-1, =0:f:=0, >0: f:=1. (e: eflags reflect sgn(flg)=> nrshift ( nm .. n0 M +n -- ov n0' .. nm' +(M+1) ) bignum right shift block of M cells by unlimited +ve no. n bits, leave ovf bits in ov. NOTE: this is a bit-wise op which might be used for but, is not "arithmetic".=> nnswap ( .nn.N .mm.M -- .mm.M .nn.N ) bignum exchange top two counted ints at tos, by { 1 nnroll }.=> nnsdrop ( .n.N .m.M -- .m.M ) bignum drop next @tos counted int item=> nnrot ( .n.N .m.M .o.O -- .m.M .o.O .n.N ) bignum roll 3rd counted int to tos, by { 2 nnroll }.=> nnroll ( .nn.N .xx.N-1 ... .mm.M n -- .xx.N-1 ... .mm.M .nn.N ) bignum n > 0: roll indexed counted int to tos, { 1 nnroll } == { nnswap }. n < 0: roll counted int @tos into indexed stack posn=> nnpick ( .xX .mM .. .nn.N m -- .xX .mM .. .nn.N .mm.M ) bignum m > 0: copy indexed counted int to tos, { 0 nnpick } == { nndup }. m < 0: replace indexed item by counted int @tos.=> nnover ( .nn.N .mm.M -- .nn.N .mm.M .nn.N ) bignum copy next on tos counted int to tos=> nnr> ( -- n1..nn N )(R: n1..nn N M -- ) 'nnrfrom' bignum transfer counted cells group from tor to tos, as stored w. {nn>r}. does{ r> nr> }=> nnorm ( n1..nn N m1..mn M -- n1..nn N m1..mn N ) bignum adjust two counted integers to minimal, equal size w/o loss of precision.=> nminus ( n1..nn n -- m1..mn n ) (4) bignum 2-s cpl of group of n cells on tos=> nnumber ( ptr +u -- .nn. N flg ) bignum convert string (ptr,+u) to multi-cell number w/ as much cells as required to fully represent the string value. store last dp posn OR-ed w. 0xff800000 to dpl, leading number radix chars valid as w/ standard words. valid chars for fractional part marker are ',.'. leaves flg = 0 after success, else any number =/= 0. input cannot be a '-ve zero'.=> nndup ( nn..n0 +N -- nn..n0 +N nn..n0 +N ) (f6) bignum duplicate +N cells sized multi-cell integer, 0 < N < 32768 cells.=> nndrop ( .xx. N ... .xx. M n -- ) bignum drop n counted int-s=> nn>r ( n1..nn N -- )(R: -- nn..n1 N M ) 'ntor' bignum transfer counted cells group from tos to tor, additioanlly store items count M does{ dup 1+ dup minus roll dup 2 + n>r }=> nn->dd ( .nn.N .mm.M -- .nn .mm ) 'n22d' bignum convert two bignums to un-counted data=> nn-rot ( .n.N .m.M .o.O -- .o.O .n.N .m.M .o.O ) 'nnmrot' bignum roll counted int @tos to 3rd, by { -2 nnroll }.=> ndrop ( x y(n)...y(1) n -- x | abort ) forth reserve -n cells, stack content indeterminate or, drop +n cells from datastack. stack bounds check.=> nminus ( n1..nn n -- m1..mn n ) (4) bignum 2-s cpl of group of n cells on tos=> nliteral (C: .x. N -- )(X: -- .x. N ) (i) bignum cpl: compile bignum (counted integer) as a literal, interp: noop=> nlshift ( nm .. n0 M +n -- n0' .. nm' ov +(M+1) ) bignum left shift block of m cells by unlimited +ve no. n bits, leave ovf bits in ov. NOTE: this is a bit-wise op which might be used for but, is not "arithmetic".=> ninvert ( n1..nn n -- m1..mn n ) (4) bignum 1-s cpl of group of n cells on tos=> ninteger ccc(C: .nn. N -- )(X: -- .nn. N ) bignum counted integer alterable cons; {to}, {+to} NOT applicable. can be modified, e.g. with { ( .nn. N -- ) ' name >body n! }. data @body: [ N ][ .nn. ]=> ngcd ( n.N m.M -- o.O ) (4) 'ngcd' bignum returns the greatest common denominator o.O of the absolute value of two signed bignums. If either number is zero, returns the absolute value of the other one.=> ncmp ( n1..nn n m1..mn m -- flg ) (4)(e) bignum normalize and signed compare two counted integers, on tos. ret flg according to sgn(subtraction) (e: eflags reflect sgn(flg)=> nabs ( n1..nn n -- n1'..nn' n ) (4) bignum negate counted integer if -ve=> n2dup ( .nn.N .mm.M -- .nn.N .mm.M .nn.N .mm.M ) 'nn2dup' bignum duplicate top two multi-cell integers (4th, by { nnover nnover })=> n2/ ( .nn. n -- .mm. m ) 'nn2div' bignum unsigned divide counted int by 2=> n2* ( .nn. n -- .mm. m ) 'nn2mul' bignum multiply counted int by 2=> n1+ ( n1..nn N -- m1..mn N ) 'nonep' bignum increment multi precision integer of n cells on tos by one=> n1- ( n1..nn N -- m1..mn N ) 'nonem' bignum increment multi precision integer of n cells on tos by one=> n0> ( n1..nn n -- flg ) 'nzgt' bignum test group of n cells on tos for +ve non-zero bignum=> n0= ( n1..nn N -- flg ) 'nzeq' bignum test group of n cells on tos for all zero=> n0< ( n1..nn n -- flg ) 'nzlt' bignum test group of n cells on tos for -ve bignum=> ?ncmp ( .n.N .m.M -- .n.N .m.M flg ) (4)(e) 'qncmp' bignum normalize and non-destructively signed compare two counted integers, on tos. ret flg according to sgn(subtraction) (e: eflags reflect sgn(flg)=> ?n0= ( .n.N -- .n.N f ) 'qnzeq' bignum non-destructively test group of n cells on tos for all zero=> n^ ( n.N m -- x.X ) (4) 'npow' bignum raise counted int n.N to the power of sing m.=> n!+ ( .x. N p1 -- p2 ) 'nstorep' bignum store counted int w/ count at l.s.cell to memory ret p2 as p1 advanced by size of N+1 cells.=> n! ( .x. N p -- ) 'nstore' bignum store counted int w/ count at l.s.cell to memory=> n@sp ( .n.N ... .m.M n(n) -- .n.N ... .m.M n2 ) 'nnposn' bignum hidden find disp n2 to <pick> the multi-cell item no. n(n)=> n@+ ( p1 -- p2 .xx. N ) 'nfetchp' bignum fetch counted int from memory w/ count at l.s.cell ret p2 as p1 advanced by size of N+1 cells.=> n@ ( p -- .xx. N ) 'nfetch' bignum fetch counted int from memory w/ count at l.s.cell=> n= ( n1..nn N m1..mn M -- flg ) (e) 'neq' bignum compare two groups of n=m cells ea, on tos. normalizing for signed multi-cell integers if n=/=m. (e: Z if n.N = m.M=> n+- ( n1..nn n m -- n1'..nn' n ) (4) 'npm' bignum apply sign of sing m to counted integer=> n+ ( n1..nn N m1..mn M -- k1..kn N ) 'nadd' bignum add normalized multi precision integers of N cells ea, on tos.=> n->un ( .n.N -- .un.M ) 'n2un' bignum convert signed to unsigned bignum: if .n.N < 0 push top cell := 0, M := N+1=> n->q ( .n.N -- qn ) 'n2q' bignum signed extend/truncate bignum to un-counted quad=> n->n ( .nn1. N M -- .nn2. M ) 'nton' bignum truncate/signed extend from +N cells to +M cells size=> n-> ( .nn1. N -- .nn2. N2 ) 'ntoq' bignum reduce multi-cell signed integer to smallest size w/o. loss of precision=> n- ( n1..nn N m1..mn M -- k1..kn N ) 'nsub' bignum subtract normalize multi precision integers of N cells ea, on tos.=> n. ( .n1. N -- ) (4) 'ndot' bignum display signed multi-cell integer as numeric stg=> n/mod ( .dD .sS -- .rR .qQ ) (4) 'nbym' bignum signed division of dividend .dD by divisor .sS, floored rounding mode leaves quot .qQ, remainder .rR fast trivial cases div +/- 1 and, if .sS>.dD ret sgn(.s)*.dD). div 0: 0/0 ret 0,1; non-zero/0 ret 0,sgn(.d)*.max(D+S).=> n/2^32 ( .n.N -- .m.N-1 ) 'nd32' bignum n:=n/(2^32), divide counted int by cell-size (2^32) does{ dup roll drop 1- }, ret n={0,1} if N u< 2=> n/ ( .d.D .s.S -- .q.Q ) (4) 'nby' bignum signed division of dividend .d.D by divisor .s.S, leaves quot .q.Q.=> n*2^32 ( .n.N -- 0.n.N+1 ) 'nm32' bignum n:=n*(2^32), multiply counted int by cell-size (2^32) does{ 0 over not roll 1+ }=> n* ( .nn. N .mm. M -- .xx. X ) (4) 'nmul' bignum signed multiply two counted integers=> n>number ( nx1 N1 p1 u1 -- nx2 N2 p2 u2 ) 'ntonumber' bignum basic multi-cell string to number conversion routine: accumulate to (nx1,N1) from numeric chars at stg(p1,u1) until 1st non-numeric char encountered or, at most u1 chars. u2 = 0 if successful, else p2 ptr to 1st invalid char code. cells count N2 adjusted to fit.=> n#> ( .n1. N -- p u ) (4) 'nhgt' bignum terminate multi-cell number conversion, leave resultant stg (p,u)=> n<# ( .nn. N -- .nn. N | abort-2 ) 'nlth' bignum check and set-up buf. on top of {pad} area, use cells count adjusted to minimal size. abort if unsufficient space for current conversion radix.=> n#size ( N -- N n ) 'nhsize' bignum no. of address units (bytes) required for stg conversion of N cells counted integer=> n#max ( -- n ) 'nhmax' bignum max cells the size of which a counted integer can be converted to numeric string, at current {base} and memory setup. range can be extended after {allocate} and storeing new data-top to vari {n-top}, e.g. 20000 allocate 0= if dup heaphead-size - @ dup d-top +! n-top +! endif drop=> n#? ( N -- N p flg ) 'nhq' bignum check whether counted int of size N can be converted to stg. flg=0 if unsufficient space for conversion at current radix else p = base (top down) address for multi-cell numeric stg. all of {pad}, {pad2} and {here}/{hld} storage protected.=> n#s ( .n1. N -- .n2. N ) (4) 'nhs' bignum convert all significant digits of a multi-cell integer to stg, leave .n2. = 0=> n# ( .n1. N -- .n2. N ) (4) 'nh' bignum append l.s. digit to number stg output storage=> lg(nn) ( n1..nn N nm -- nk ) (4) 'lgnn' bignum ret nk := numerus lg(.n.N) to the base of nm, i.e nk := count of digits the rsp number would be converted to at radix of nm. only conventionally named "lg" after "logarithm" - which this opr yields not!=> 2n->2uq ( .n1.N .n2.M -- q1 q2 ) 'n22uq' bignum unsigned extend/truncate two bignums to un-counted quad=> 2q->2un ( q1 q2 -- .n1.N .n2.M ) 'q22un' bignum convert a pair of un-counted quads to unsigned bignum=> 2n->2q ( .n1.N .n2.M -- q1 q2 ) 'n22q' bignum signed extend/truncate two bignums to un-counted quad=> 2q->2n ( q1 q2 -- .n1.N .n2.M ) 'q22n' bignum convert a pair of un-counted quads to bignum=> (un.) ( .n1. N -- p u ) (4) 'pundotp' bignum convert unsigned multi-cell integer to numeric stg=> (n.) ( .n1. N -- p u ) (4) 'pndotp' bignum convert signed multi-cell integer to numeric stg=> nxor ( .mm. .nn. m -- nm ) forth binary XOR two groups of m cells=> swapn ( nx nN nm .. n0 M -- nx n0 nm .. nN ) forth swap N-th cell with cell on tos=> s>m ( n1..nn p n -- ) 'stom' forth store n bytes from tos to memory location p beginning w. cell aligned n1=> r>m ( p n -- )(R: n1..nn -- ) 'rtom' forth little-endian store n bytes(!) from tor to memory location p, beginning w. cell aligned n1; sto by true values.=> nswap ( nx0 nx1..nxm ny0 ny1..nym m -- ny0..nym nx0..nxm ) forth multiple cells swap, swap blocks of m cells=> nr@ ( n -- n1..nn )(R: nn..n1 -- ) 'nrfetch' forth copy n cells from tor to tos=> nr> ( n -- n1..nn )(R: nn..n1 -- ) 'nrfrom' forth transfer n cells from tor to tos=> n>r ( n1..nn n -- )(R: -- nn..n1 ) 'ntor' forth transfer n cells from tos to tor, ready to fetching back w. {r>}, etc.=> nor ( .mm. .nn. m -- nm ) forth binary OR two groups of m cells=> ndup ( nn..n0 m -- nn..n0 nm..n0 ) (f6) forth duplicate group of 0 < n < 32768 cells, else drop group of 0 > n > -32768 cells=> ndrop ( x y(n)...y(1) n -- x | abort ) forth reserve -n cells, stack content indeterminate or, drop +n cells from datastack. stack bounds check.=> nand ( .mm. .nn. m -- nm ) forth binary AND two groups of m cells=> m>s ( p n -- n1..nn ) 'mtos' forth fetch n bytes from ptr p to tos, beginning w. cell aligned n1.=> m>r ( p n -- )(R: -- n1..nn ) 'mtor' forth little-endian fetch n bytes(!) to tor, leaving data @RS un-changed, restore true figures w. {4th>abs} when fetched back with {r>}, etc.=> FVARIABLE ccc( -- )(X: -- p ) (i) dvvariable 'fvari' ans float=> FTANH ( f1 -- f2 ) (4) ans float hyperbeltangens, dpans EXT 12.6.2.1626 e^x - e^(-x) e^2x-1 tanh x = ------------ = ------ e^x + e^(-x) e^2x+1=> FTAN ( f1 -- f2 ) tg(dv) ans float=> FSWAP ( f1 f2 -- f2 f1 ) dvswap ans float=> FSQRT ( f1 -- f2 ) dvsqrt 'fsqrtf' ans float=> FSINH ( f1 -- f2 ) ans float hyperbelsinus, dpans EXT 12.6.2.1617 e^x - e^(-x) 1 1 sinh x = ------------ = - ( e^x - --- ) 2 2 e^x=> FSINCOS ( f1 -- f2 ) sincos(dv) 'fsc' ans float=> FSIN ( f1 -- f2 ) sin(dv) 'fsinf' ans float=> dvfround ( dv1 -- dv2 ) (4) rational returns an approximation to the rational number dv1 such that the fractional part rounded to {#fround} digits. simple rounding algorithm which increments last digit by one if next would be greater or equal to 0,5 * rounding factor: intf(frac(dv1)*base@^#fround+0,5) rounded result = --------------------------------- + intf(dv1) base@^#fround noop if (kernel-)value {#fround} < 0. -re- {fround}, {dvround}, {dvfround}=> FROT ( f1 f2 f3 -- f2 f3 f1 ) dvrot ans float=> FRANDOM ( f1 -- f2 ) dvrandom ans float ret random number in range [0,f1), rfsh @{seed}.=> FPICK ( f1 ... n -- ... f1 ) dvpick ans float=> FOVER ( f1 -- f2 ) dvover ans float=> FNEGATE ( f1 -- f2 ) dvnegate ans float=> FMIN ( f1 -- f2 ) dvmin ans float=> FMAX ( f1 -- f2 ) dvmax ans float=> FLOG ( f1 -- f2 ) lg(dv) ans float=> FLNP1 ( f1 -- f2 ) (4) float f2 := ln (f1+1) dpans EXT 12.6.2.1554 - not overly useful: ln(dv) is very accurate, thus FLNP1 exactly equal to the rsp result from FLN.=> FLN ( f1 -- f2 ) ln(dv) ans float=> FLITERAL ( f1 -- ) (i) dvliteral ans float=> FEXPM1 ( f1 -- f2 ) float f2 := e^(f1)-1, dpans EXT 12.6.2.1516 - {FEXP} always more accurate (and faster)=> FEXP ( f1 -- f2 ) e^dv ans float=> FDUP ( f1 -- f1 f1 ) 4dup ans float=> FDROP ( f1 -- ) 4drop ans float=> FDEPTH ( -- n ) dvdepth ans float=> FCOSH ( f1 -- f2 ) (4) ans float hyperbelcosinus dpans94 EXT 12.6.2.1494 1 1 f2 := cosh f1 = - ( e^f1 + ---- ) 2 e^f1=> FCOS ( f1 -- f2 ) cos(dv) 'fcosf' ans float=> FCONSTANT ccc( f1 -- )(X: -- f1 ) (i) dvconstant 'fcons' ans float=> FATANH ( f1 -- f2 ) (4) ans float area tanh, dpans EXT 12.6.2.1491 1 1+x artanh x = - ln ( --- ), |x| < 1 2 1-x=> FATAN2 ( f1 f2 -- f3 ) (4) ans float f1/f2 = tg f3, i.e. f3 := arc tg (f1/f2), dpans EXT 12.6.2.1489 ret pi/4 if f1=f2=0=> FATAN ( f1 -- f2 ) atg(dv) ans float=> FASINH ( f1 -- f2 ) (4) ans float area sinh, dpans EXT 12.6.2.1487 x arsinh = artanh ----------- sqrt(x^2+1)=> FASIN ( f1 -- f2 ) asin(dv) ans float=> FALOG ( f1 -- f2 ) 10^dv 'falogf' ans float=> FACOSH ( f1 -- f2 ) (4) ans float area cosh, f2:=ln(f1-sqrt(f1^2-1)), dpans EXT 12.6.2.1477 sqrt(x^2-1) arcosh = artanh ----------- = ln(x-sqrt(x^2-1)); |x| > 1 x=> FACOS ( f1 -- f2 ) acos(dv) ans float=> fabs ( f1 -- f2 ) dfabs ans float=> F2/ ( f1 -- f2 ) dv2/ 'f2by' ans float div f1 by two; dpans 12.6.1.1410=> F2* ( f1 -- f2 ) dv2* 'f2mul' ans float mul flt by two=> F1- ( f1 -- f2 ) dv1- 'fonem' ans float=> F1+ ( f1 -- f2 ) dv1+ 'fonep' ans float=> F0= ( f1 -- f2 ) dv0= 'fzeq' ans float=> F0< ( f1 -- f2 ) dv0< 'fzlt' ans float=> F~ ( f1 f2 f3 -- flg ) 'faeq' float should check for approximate equality according to dpans, 12.6.2.1640. apparently, w/ f1=test and f2=expected exact result: +ve: f3=abs. tolerance, f2-f3 < f1 < f2+f3. -ve: f3=factor of how much f1 may deviate from f2, (f1-f2)*|f3| < f2 < (f1+f2)*|f3| -?- -re- {dv~} for an alternative approach. -- |r1-r2| r3>0: |r1-r2|<r3; r3<0: --------- < |r3| = |r1-r2|<|r3*(|r1|+|r2|)| |r1|+|r2| -- (verstehe kein wort dieser grausam verschrobenen ausdrucksweise in dpans94. (I do not understand a word of that queer dpans94 description, (section 12.6.2.1640; thus just providing F~, left un-tested,=> F@ ( p -- f1 ) dv@ 'ffetch' ans float=> F< ( f1 -- f2 ) dv< 'flt' ans float=> F/ ( f1 f2 -- f3 ) dv/ 'fby' ans float divide f1 by f2; dpans 12.6.1.1430=> F- ( f1 f2 -- f3 ) dv- 'fsubf' ans float subtract two flts; dpans 12.6.1.1425=> F+ ( f1 f2 -- f3 ) dv+ 'fplus' ans float add two flts; dpans 12.6.1.1420=> dv% ( dv1 dv2 -- dv3 ) 'dvvh' rational div dv1 by 100 and mul by dv2=> dv*/ ( dv1 dv2 dv3 -- dv4 ) 'dvmulby' rational mul dv1 by dv2 and div by dv3=> F* ( f1 f2 -- f3 ) dv* 'fmulf' ans float mul two flts; dpans 12.6.1.1410=> F! ( f1 p -- ) dv! 'fstore' ans float sto flt to mem; dpans 12.6.1.1400=> F. ( f1 -- ) df. 'fdot' ans float=> F^ ( f1 -- f2 ) dv^ 'fpow' ans float F** ( f1 -- f2 ) dv^ 'fpow' ans float=> F^ ( f1 -- f2 ) dv^ 'fpow' ans float F** ( f1 -- f2 ) dv^ 'fpow' ans float=> F>DF ( f1 -- df1 ) dv>qv 'ftodf' ans float=> DF>F ( df1 -- f1 ) qv>dv 'dftof' ans float double flt to sing float=> qv2/ ( uqv1 -- qv2 ) 'qv2div' rational hidden unsigned divide quad ranum by two.=> qv2* ( qv1 -- qv2 ) 'qv2mul' rational hidden fast multiplication by two.=> DF. ( df1 -- ) qf. 'dfdotf' ans float=> DFSWAP ( df1 df2 -- df2 df1 ) qvswap ans float=> DFROT ( df1 df2 df3 -- df2 df3 df1 ) qvrot ans float=> DFPICK ( df1 ... n -- ... df1 ) qvpick ans float=> DFOVER ( df1 -- df2 ) qvover ans float=> DF@ ( p -- f1 ) qv@ 'dffetch' ans float=> DF! ( qv p -- ) qv! 'dfstore' ans float=> float-op ( -- ) (X)(i) 'floatop' float un-praefixed -re- {FLOAT}-voc. words, e.g. for '4d' &c commandline calculator. synonymous wordlist, available if enabled w. L4 'make'-switch "__FLOATOP" (dft).=> SFLOAT+ ( p1 -- p2 ) float+ 'sfloatp' ans=> SFALIGN ( p1 -- p2 ) falign ans=> SF@ ( p -- f1 ) dv@ 'sffetch' ans float=> SF! ( f1 p -- ) dv! 'sfstore' ans float=> FTAN ( f1 -- f2 ) tg(dv) ans float=> FSQRT ( f1 -- f2 ) dvsqrt 'fsqrtf' ans float=> FSINCOS ( f1 -- f2 ) sincos(dv) 'fsc' ans float=> FSIN ( f1 -- f2 ) sin(dv) 'fsinf' ans float=> FS. ( f1 -- f2 ) f. ans float preliminary, non-standard substitute=> FRANDOM ( f1 -- f2 ) dvrandom ans float ret random number in range [0,f1), rfsh @{seed}.=> FLOG ( f1 -- f2 ) lg(dv) ans float=> FLN ( f1 -- f2 ) ln(dv) ans float=> FEXP ( f1 -- f2 ) e^dv ans float=> FE. ( f1 -- f2 ) f. ans float preliminary, non-standard substitute EXT 12.6.2.1513=> FCOS ( f1 -- f2 ) cos(dv) 'fcosf' ans float=> FATAN2 ( f1 f2 -- f3 ) (4) ans float f1/f2 = tg f3, i.e. f3 := arc tg (f1/f2), dpans EXT 12.6.2.1489 ret pi/4 if f1=f2=0=> FATAN ( f1 -- f2 ) atg(dv) ans float=> FASIN ( f1 -- f2 ) asin(dv) ans float=> FALOG ( f1 -- f2 ) 10^dv 'falogf' ans float=> FACOS ( f1 -- f2 ) acos(dv) ans float=> fabs ( f1 -- f2 ) dfabs ans float=> F. ( f1 -- ) df. 'fdot' ans float=> F^ ( f1 -- f2 ) dv^ 'fpow' ans float F** ( f1 -- f2 ) dv^ 'fpow' ans float=> F^ ( f1 -- f2 ) dv^ 'fpow' ans float F** ( f1 -- f2 ) dv^ 'fpow' ans float=> DF. ( df1 -- ) qf. 'dfdotf' ans float=> DF@ ( p -- f1 ) qv@ 'dffetch' ans float=> DF! ( qv p -- ) qv! 'dfstore' ans float=> STEP (C: p1 f -- p2 f )(X: f1 -- ) (i) rational ans float immediately after {for} or {from}, {+from}, modifies loop increment to dv. xec: -re- runtime code, "(step)" cpl: checks flg f, modifies back-ptr p to pointing to immediately after {STEP}.=> NX ( n1 -- f1 ) rational ans float n1-th level nested FOR-loop index. n1 = 0 refers to innermost level, as { IDX }.=> NEXT (C: p f -- ) (i) rational ans float terminates a FOR [ FROM ] [ STEP ] ... NEXT loop xec: -re- runtime code, "(next)" cpl: checks flg f, resolve backward ptr.=> LIM ( -- f1 ) (X) 'flim' rational ans float get innermost FOR-loop limit.=> INC ( -- f1 ) (i)(X) 'fstep' rational ans float get innermost FOR-loop increment.=> IDX ( -- f1 )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) (X) 'fidx' rational ans float push innermost FOR-loop index dv1 to data-stack, loop index in a { FOR .. NEXT } loop; aequivalent to {i} of a DO/LOOP.=> FROM (C: p1 f -- p2 f )(X: f1 -- ) (i) rational ans float immediately after {for} or {step}, modifies loop start to f1 from data-stack. xec: runtime code, -re- {(from)} cpl: checks flg f, modifies back-ptr p to pointing to immediately after {FROM}.=> FOR (C: -- p f )(X: f1 -- ) (i) rational ans float introducing a FOR [ FROM ] [ STEP ] .. [ IDX ][ nn NX ] .. NEXT loop. cpl: leaves back-ptr p for resolution by NEXT and control flag f. xec: begin FOR/NEXT loop, passing loop limit f1, -re- {(for)} runtime code. further, related words -re- {INC}, {LIM}, {END} and the rsp. "!" and "@" variants.=> END ( -- ) (m,) 'fend' rational ans float leave innermost FOR-loop at next xec of NEXT, {END} executes like f.i.g-style {leave}, leaving the loop at next NEXT. (forced termination by storeing the overflow indicator to STP value)=> @NX ( n1 -- p ) 'fnx' rational ans float get ptr p to indexed, n1-th level nested FOR-loop index. n1 = 0 for innermost loop. running index: n1 @NX F@, increment: n1 @NX FLOAT+ F@, limit: n1 @NX DFLOAT+ F@. can be used at runtime to modifying e.g, the loop increment: { inc fdup f* inc f- 0 dv>n @nx float+ f! }=> !INC ( f1 -- )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) 'sinc' rational ans float store f1 from data-stack to innermost FOR-loop increment=> !IDX ( f1 -- )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) 'sidx' rational ans float store f1 from data-stack to innermost FOR-loop index loop index in a { FOR .. IDX .. NEXT } loop.=> +FROM (C: p1 f -- p2 f )(X: f1 -- ) (i) 'pfrom rational ans float immediately after {for} or {step}, adds f1 to start value and limit, i.e. FOR-loop start index := dv and limit := limit + dv, limit := FOR-arg + dv. xec: -re- runtime code, "(+from)" cpl: checks flg f, modifies back-ptr p to pointing to immediately after {+FROM}.=> REPRESENT ( f1 p u -- n flg1 flg2 | xx xx 0 ) 'frepresent' rational ans float decode rational number, dpans 12.6.1.2143: sto characters representation of f1, integral and #fplaces length fractional parts w/o trailing zeroes, w/ implied fractions' marker after 1st character plus n places, to buffer(p,u) as a counted string, leave base-10 exponent n, flg1 := tf if f1 <0, else 0 and, flg2 := tf for a valid result, 0 otherwise. NOTE: n is aequivalent to @dpl by numeric input and, in contrary to the dpans description of REPRESENT, conversion follows current @base setting. buffer(p,u) size should be at least 4 chars, ret false flg2, otherwise. ambiguos condition if f1 is overflow indicator and p = u = 0: flg2 := 1.=> rad>deg ( dv1|f1 -- dv2|f2 ) 'rad2deg' rational ans float convert to sexagesimal degrees.=> ieee>dv ( dn -- f1 ) 'ieee2f' rational IEEE>F ( dn -- f1 ) 'ieee2f' ans float convert IEEE 754 normalized 'double real' to floating pt. (double ranum) format. valid f1 within range of a double ranum, overflow indicator otherwise. "negative zero" as (00..00/$80...00) which propagates zero to any other opr. any "nan" patterns return the overflow indicator (00/00). "signed infinity" returns +/- maximum.=> FVARIABLE ccc( -- )(X: -- p ) (i) dvvariable 'fvari' ans float=> FSWAP ( f1 f2 -- f2 f1 ) dvswap ans float=> FROT ( f1 f2 f3 -- f2 f3 f1 ) dvrot ans float=> FPICK ( f1 ... n -- ... f1 ) dvpick ans float=> FOVER ( f1 -- f2 ) dvover ans float=> FNEGATE ( f1 -- f2 ) dvnegate ans float=> FMIN ( f1 -- f2 ) dvmin ans float=> FMAX ( f1 -- f2 ) dvmax ans float=> FLOOR ( f1 -- f2 ) dv>d ans float=> FLITERAL ( f1 -- ) (i) dvliteral ans float=> FDUP ( f1 -- f1 f1 ) 4dup ans float=> FDROP ( f1 -- ) 4drop ans float=> FDEPTH ( -- n ) dvdepth ans float=> FCONSTANT ccc( f1 -- )(X: -- f1 ) (i) dvconstant 'fcons' ans float=> F2DUP ( f1 f2 -- f1 f2 f1 f2 ) 8dup ans float=> F2/ ( f1 -- f2 ) dv2/ 'f2by' ans float div f1 by two; dpans 12.6.1.1410=> F2* ( f1 -- f2 ) dv2* 'f2mul' ans float mul flt by two=> F1- ( f1 -- f2 ) dv1- 'fonem' ans float=> F1+ ( f1 -- f2 ) dv1+ 'fonep' ans float=> F0= ( f1 -- f2 ) dv0= 'fzeq' ans float=> F0< ( f1 -- f2 ) dv0< 'fzlt' ans float=> F@ ( p -- f1 ) dv@ 'ffetch' ans float=> dv>ieee ( f1 -- dn ) 'f2ieee' rational F>IEEE ( f1 -- dn ) 'f2ieee' ans float convert floating pt. (double ranum) to IEEE 754 normalized 'double real' format. simple rounding method, increment significand by one if bit next to l.s.b set. f1 = +/- infinity represented by num=0 and den=0 or $80..00 (sign bit set), rsp.=> F>DF ( f1 -- df1 ) dv>qv 'ftodf' ans float=> F>D ( f1 -- dn ) d/ 'ftod' ans float=> F< ( f1 -- f2 ) dv< 'flt' ans float=> F/ ( f1 f2 -- f3 ) dv/ 'fby' ans float divide f1 by f2; dpans 12.6.1.1430=> F- ( f1 f2 -- f3 ) dv- 'fsubf' ans float subtract two flts; dpans 12.6.1.1425=> F+ ( f1 f2 -- f3 ) dv+ 'fplus' ans float add two flts; dpans 12.6.1.1420=> F* ( f1 f2 -- f3 ) dv* 'fmulf' ans float mul two flts; dpans 12.6.1.1410=> F! ( f1 p -- ) dv! 'fstore' ans float sto flt to mem; dpans 12.6.1.1400=> DFSWAP ( df1 df2 -- df2 df1 ) qvswap ans float=> DFPICK ( df1 ... n -- ... df1 ) qvpick ans float=> DFROT ( df1 df2 df3 -- df2 df3 df1 ) qvrot ans float=> DFOVER ( df1 -- df2 ) qvover ans float=> DF>F ( df1 -- f1 ) qv>dv 'dftof' ans float double flt to sing float=> deg>rad ( dv1|f1 -- dv2|f2 ) 'deg2rad' rational ans float convert to radians.=> D>F ( dn -- f1 ) d>dv 'dtof' ans float double to flt; dpans 12.6.1.1130=> stg>qv ( p u -- qv f ) 'todfloat' rational >DFLOAT ( p u -- qv f ) 'todfloat' float convert stg(p,u) to a double 'float', i.e. quad ranum. an empty stg, or all blanks, resulting to ovf indicator. valid, optional exponent in range -21 < exp < 22. -re- {>double}=> F~ ( f1 f2 f3 -- flg ) 'faeq' float should check for approximate equality according to dpans, 12.6.2.1640. apparently, w/ f1=test and f2=expected exact result: +ve: f3=abs. tolerance, f2-f3 < f1 < f2+f3. -ve: f3=factor of how much f1 may deviate from f2, (f1-f2)*|f3| < f2 < (f1+f2)*|f3| -?- -re- {dv~} for an alternative approach. -- |r1-r2| r3>0: |r1-r2|<r3; r3<0: --------- < |r3| = |r1-r2|<|r3*(|r1|+|r2|)| |r1|+|r2| -- (verstehe kein wort dieser grausam verschrobenen ausdrucksweise in dpans94. (I do not understand a word of that queer dpans94 description, (section 12.6.2.1640; thus just providing F~, left un-tested,=> SFLOATS ( n1 -- n2 ) (e)(m,3) 'mul16' ans multiply n1 by storeage size (4 cells) of a single 'float', mul by 16.=> SFALIGNED (k)=> SET-PRECISION ( n -- ) ((kv)) ans float set no. of displayable f.p. mode fractional digits, dpans EXT 12.6.2.2035. affects output by {#vf} and {REPRESENT}, modifies kernel-value {#fplaces}.=> #fplaces ( -- n ) (kv) forth kernel-value which returns the maximal number of fractional digits to be included in the f.p. numeric output string by {#vf}, {REPRESENT}. output precision has no influence on internal data representation, use {dvfround} to rounding the actually stored data. -re- {#fround}. PRECISION ( -- n ) ((kv)) 'fprec' ans float no. of displayable fractional digits, dpans EXT 12.6.2.2035. {PRECISION} reads kernel-value {#fplaces}.=> FTANH ( f1 -- f2 ) (4) ans float hyperbeltangens, dpans EXT 12.6.2.1626 e^x - e^(-x) e^2x-1 tanh x = ------------ = ------ e^x + e^(-x) e^2x+1=> FSINH ( f1 -- f2 ) ans float hyperbelsinus, dpans EXT 12.6.2.1617 e^x - e^(-x) 1 1 sinh x = ------------ = - ( e^x - --- ) 2 2 e^x=> FLOAT+ ( p1 -- p2 ) (m,3) 'floatp' ans float add size of a single float (4 cells) to ptr p1, dpans 12.6.1.1555=> FLNP1 ( f1 -- f2 ) (4) float f2 := ln (f1+1) dpans EXT 12.6.2.1554 - not overly useful: ln(dv) is very accurate, thus FLNP1 exactly equal to the rsp result from FLN.=> FEXPM1 ( f1 -- f2 ) float f2 := e^(f1)-1, dpans EXT 12.6.2.1516 - {FEXP} always more accurate (and faster)=> FROUND ( f1 -- f2 ) 'dv2floor' float round float to nearest integral value=> FLOATS ( n1 -- n2 ) (e)(m,3) 'mul16' ans=> FCOSH ( f1 -- f2 ) (4) ans float hyperbelcosinus dpans94 EXT 12.6.2.1494 1 1 f2 := cosh f1 = - ( e^f1 + ---- ) 2 e^f1=> FATANH ( f1 -- f2 ) (4) ans float area tanh, dpans EXT 12.6.2.1491 1 1+x artanh x = - ln ( --- ), |x| < 1 2 1-x=> FASINH ( f1 -- f2 ) (4) ans float area sinh, dpans EXT 12.6.2.1487 x arsinh = artanh ----------- sqrt(x^2+1)=> FACOSH ( f1 -- f2 ) (4) ans float area cosh, f2:=ln(f1-sqrt(f1^2-1)), dpans EXT 12.6.2.1477 sqrt(x^2-1) arcosh = artanh ----------- = ln(x-sqrt(x^2-1)); |x| > 1 x=> DFLOATS ( n1 -- n2 ) (e)(m,5) ans multiply n1 by storeage size (8 cells) of a double 'float', mul by 32.=> DFLOAT+ ( p1 -- p2 ) (m,3) 'dfloatp' ans float add size of a double float (8 cells) to ptr p1=> DFATANH ( df1 -- df2 ) (4) ans float area tanh, dpans EXT 12.6.2.1491 1 1+x artanh x = - ln ( --- ), |x| < 1 2 1-x=> DFALIGNED ( x1 -- x2 ) (a:f)(m) float adjust true address/value x2 to lowest multiple of f.p.-item size (double cell) greater or equal x1.=> DFALIGN ( -- ) (a:e) float adjust dataspace ptr to multiple of double f.p. size (sixteen 8-bit bytes), greater or equal {here}, and erase allocated memory.=> FALIGNED ( x1 -- x2 ) (a:f)(m) float adjust true address/value x2 to lowest multiple of f.p.-item size (double cell) greater or equal x1.=> FALIGN ( -- ) (a:e) float adjust dataspace ptr to multiple of double f.p. size (eight 16-bit bytes), greater or equal {here}, and erase allocated memory.=> >FLOAT ( p u -- dv f ) 'tofloat' float convert stg(p,u) to a single 'float', i.e. double ranum. an empty stg, or all blanks, resulting to ovf indicator. valid, optional exponent in range -14 < exp < 19. -re- {>double}=> qvrdv ( -- qv ) 'qvmdv' rational cons max quad to {qvround}ding a quad to size of a double ranum.=> qv.pi/4 ( -- q2 ) 'cqvpi4' rational cons quad ranum cons pi/4 0,7853981634... +/- 10^-17 (in range of a double) pi/4 = Sa(n->oo) (-1)^(n+1)/(2n-1); n=1...k|k>>0, after 2 days: 0,785398164328770=> qv.pi/2 ( -- q2 ) 'cqvpi2' rational cons quad ranum cons pi/2 1,5707963268... +/- 10^-17 (in range of a sing)=> qv.pi/180 ( -- q2 ) 'cqvpi180' rational cons quad ranum cons pi/180 0,0174532925... +/- 10^-17 (in range of a double)=> qvovf ( -- qv ) rational cons cons (+ve) overflow indicator.=> qv.2pi ( -- q2 ) 'cqv2pi' rational cons quad ranum cons 2*pi 6,2831853072... +/- 2*10^-17 (in range of a double)=> qv.2/3pi ( -- q2 ) 'cqv23pi' rational cons quad ranum cons 2*pi/3 2,09439510240... +/- 10^-16 (in range of a double)=> pi ( -- num den ) 'cacpi' rational cons 3,1415926536... +/- 10^-10=> ln(10) ( -- num den ) 'caln10' rational cons 2,3025850930..=> ln(2) ( -- num den ) 'caln2' rational cons 0,69314718(...)=> lg(e) ( -- num den ) 'calge' rational cons 0,434294481(...)=> lg(2) ( -- num den ) 'calg2' rational cons 0,301029995(...)=> k(t) ( -- num den ) 'cakptp' rational cons 1,64676 CORDIC trigonometric correction factor (by 15 iterations)=> k(h) ( -- num den ) 'cakphp' rational cons 0,8281593 CORDIC hyperbolic correction factor (by 15 iterations)=> euler(v) ( n -- v ) rational cons 1st seven Euler numbers by index 0<n<8 (?: "Euler'sche Zahlen")=> euler-c ( -- dv ) 'caec' rational cons df 0,577215664901532=> dv.ln(10) ( -- dv ) 'cdvln10' rational cons 2,3025850930.. +/- 10^11=> dv.ln(2) ( -- dv ) 'cdvln2' rational cons 0,69314718 +/- 10^11=> dv.e^10 ( -- dv ) 'cae10d' rational cons e to the power of ten, ret dv := 22026,4657948=> dv.e^6 ( -- dv ) 'cae6d' rational cons e to the power of six, ret dv := 403,42879349=> dv.e ( -- dv ) 'caed' rational cons 2,7182818284(59) +/- 10^-12 (ref. Bronstein)=> dvovf ( -- dv ) rational cons cons (+ve) overflow indicator.=> c ( -- num den ) 'cac' rational cons 2,997... +/- 1,6e-9=> bernulli(v) ( n -- v ) rational cons 1st eleven Bernulli numbers by index 0<n<12 (?, "Bernulli'sche Zahlen")=> 10^(1/2) ( -- num den ) 'casqr2n10' rational cons 3,162... +/- 5,7e-9=> 3^(1/2) ( -- num den ) 'casqr2n3' rational cons 1,732050808... +/- 0,5e-9=> 2^(1/2) ( -- num den ) 'casqr2n2' rational cons 1.41421356(2..) +/- 1,5e-9=> 2^(1/12) ( -- num den ) 'casqr12n2' rational cons 1,059... +/- 1,0e-9=> 1qv ( -- qv ) 'v1qv' rational cons cons quad ranum 1=> 100dv ( -- dv ) 'v100dv' rational cons cons double ranum 100=> 1dv ( -- dv ) 'v1dv' rational cons cons double ranum 1=> 0qv ( -- dv ) 'v0dv' rational cons cons quad ranum (double float) 0=> 0dv ( -- dv ) 'v0dv' rational cons cons double ranum 0=> -1qv ( -- qv ) 'vm1dv' rational cons cons quad ranum -1=> -1dv ( -- dv ) 'vm1dv' rational cons cons double ranum -1=> vovf ( -- v ) (m,7) rational cons cons (+ve) overflow indicator (4th word available if L4 cpl'd w. sing ranum support)=> e^10 ( -- v ) 'cae10' rational cons e to the power of ten, ret v := 22026,4657948=> e^6 ( -- v ) 'cae6' rational cons e to the power of ten, ret v := 403,42879349=> e ( -- num den ) 'cae' rational cons 2,7182818284(5)... +/- 10^-10, e = lim (1+1/n)^n n=1->oo=> 1v ( -- v ) 'v1v' rational cons cons ranum 1=> 0v ( -- v ) 'v0v' rational cons cons sing ranum 0=> -1v ( -- v ) 'vm1v' rational cons cons ranum -1=> tg(qv) ( qv1 -- qv2 ) (4) 'tgqv' rational hidden tangens, by tg(x) = sin(x)/cos(x)=> sin(qv) ( qv1 -- qv2 ) (4) 'sinqv' rational hidden ret qv2 sinus of qv1 in rad, by sin(x)=cos(x-pi/2).=> sincos(qv) ( qv1 -- qv2 qv3 ) (4) 'sincosqv' rational hidden qv2 := sin(qv1), qv3 := cos(qv1)=> qvswap ( qv1 qv2 -- qv1 qv2 ) 8swap rational hidden { 8 nswap }, swap 8 cells items=> qvsqrt ( qv1 -- qv2 ) rational hidden qv2 := sgn(qv1) * square root of quad ranum |qv1|. for instance, accurate within 19 integral plus fractional decimal digits. apply 'bignum' words to num/den separately for unlimited, higher range and praecision: scale by common factor as great as possible w/o overflowing into sign bit of denumerator, get square roots of num and den, reduce.=> qvsplit ( qv1 -- qv2 qv3 ) rational hidden floored integral qv2 and (non-negative) fractional qv3 component of qv1. w/ Floored rounding, i.e. v1 = v2 + v3 and assuming +ve v3 is always valid. -re- {qvfrac}, {qv>fq}=> qvsover ( qv1 qv2 -- qv2 qv1 qv2 ) 8sover rational hidden { qvswap qvover ), 8 cells per item swap and over=> qvsgn ( qv -- n ) (e) rational hidden ret sing signum of qv. (e: eflags reflect signum=> qvround ( qv1 +qn -- qv2 ) (X) rational hidden returns an approximation to the rational number qv1 such that neither the numerator nor the denominator of its fractional part exceeds the positive integer +qn. abort w/ addressing mode error if -ve den of qv1. -re- {fround}, {dvfround}, {dvround}, {qvdround}=> qvrot ( qv1 qv2 qv3 -- qv2 qv3 qv1 ) (x)(4) rational hidden roll 3rd @tos to tos.=> qvroll ( qvn .. qv1 n -- .. qv1 qvn ) 8roll rational hidden roll a quad ranum, i.e. 8 cells per item +/- roll=> qvreduce ( qv -- qv) (4) rational hidden reduce quad ranum by greatest common divisor of numerator and denominator.=> qvpick ( qvn .. n -- .. qvn ) 8pick rational hidden pick a quad ranum, i.e. 8 cells per item +/- pick=> qvover ( qv1 qv2 -- qv2 qv1 qv2 ) 8over rational hidden pick @nos to tos=> qvnegate ( qv1 -- qv2 ) nos-qnegate rational hidden negate quad ranum qv1=> qvm/ ( qv1 dv2 -- qv2 ) 'qvmby' rational hidden div quad ranum by double, ret quad=> qvliteral (C: qv1 -- )(X: -- qv1 ) (i) 'qvliteral' rational hidden cpl: compile four cells' pair (quad ranum) as a literal, interp: noop=> qvinteger ccc( qv -- )(X: -- qv ) rational hidden quad ranum integer; modifiable constant (four cells L4 variant of a {value}).=> qvdround ( qv1 -- qv2 ) (X) rational hidden returns approximation to qv1 such that qv2 fits into double ranum range.=> qv2* ( qv1 -- qv2 ) 'qv2mul' rational hidden fast multiplication by two.=> qvfrac ( qv1 -- qv2 ) (4) 'qvfrac' rational hidden ret +ve fractional part of qv1, remainder of floored div'n.=> qvdup ( qv -- qv qv ) 8dup rational hidden duplicate quad ranum @tos=> qvcmp ( qv1 qv2 -- qv1 qv2 f ) (e) rational hidden leave signum of ranum doubles subtraction. (e: eflags reflect signum=> qvabs ( qv1 -- qv2 ) rational hidden negate qv1 if -ve=> qv2dup ( qv1 qv2 -- qv1 qv2 qv1 qv2 ) rational hidden duplicate top two quad ranums=> qv2/ ( uqv1 -- qv2 ) 'qv2div' rational hidden unsigned divide quad ranum by two.=> qv1- ( qv1 -- qv2 ) 'qvonem' rational hidden decrement qv1 by one=> qv1+ ( qv1 -- qv2 ) 'qvonep' rational hidden increment qv1 by one=> qv~ ( qv1 qv2 -- f ) (e) 'qvaeq' rational hidden tf if dv1, qv2 approximately equal or, overflow condition met. (e: Z if qv=0 or ovf, and tf=> qv^s ( qv1 +n -- qv2 ) 'qvpovs' rational hidden raise qv1 to the power of non-negative single integer n. qv2 := ovf if n < 0 or result out of range. w/ signed n: { >r qv>uqv? r> swap >r qv^n r> 0= -exit 1/qv }.=> qv^ ( +qv1 qv2 -- qv3 ) (4) 'qvpowdv' rational hidden qv3 := +ve float or -ve integer qv1 to the power of qv2; qv3 := 1 if qv1 = 0. exact result within 10, up to 12 decimal digits, integer + fractional part. for -ve dv1 get sign of real part and imaginary unit w/ -re- {re,im(v)}, then procede w/ abs(qv1), apply 're' value and use sign of 'im' as appropriate. currently, {re,im(v)} n.i, ambiguous result if -ve qv1 is not an integer. -:- a^x = e^(x ln a), -oo < x < oo; a>0,integral a<0, a=0|a^x := 1=> qv! ( dv p -- ) 'qvstore' rational hidden store qv to memory at p.=> qv@ ( p -- dv ) 'qvfetch' rational hidden fetch qv from memory at p.=> qv= ( qv1 qv2 -- f ) (e) 'qveq' rational hidden tf if dv1, qv2 (within qv accuracy) equal or overflow. (e: Z if qv=0 and tf=> qv-rot ( qv1 qv2 qv3 -- qv3 qv1 qv2 ) (x)(4) 'qvmrot' rational hidden roll @tos to 3rd @tos.=> qv- ( qv1 qv2 -- qv3 ) 'qvsub' rational hidden subtract quad ranum qv2 from qv1.=> qv+ ( qv1 qv2 -- qv3 ) 'qvplus' rational hidden add quad ranums=> qv/ ( qv1 qv2 -- qv3 ) 'qvdiv' rational hidden divide quad ranums=> qv* ( qv1 qv2 -- qv3 ) 'qvmul' rational hidden multiply quad ranums=> qv>uqv? ( qv1 -- qv2 f) 'qv2uqvq' rational hidden return absolute value of signed quad ranum. tf if qv1 was negative.=> qv>q ( qv -- q ) 'dv2dn' rational hidden return the signed integral component of ranum qv as quad integer.=> qv>fq ( qv -- q ) (4) 'qv2q' rational hidden ret floored signed quad integral part of quad ranum. -re- {qvfrac}, {qvsplit}, {qv>s}, {qv>d}, {qv>q}=> qv>s ( qv -- n ) 'dv2n' rational hidden return the m.s. signed integral component of ranum qv as single integer n.=> qv>d ( qv -- d ) 'dv2dn' rational hidden return the m.s. signed integral component of ranum qv as double integer d.=> qv. ( qv -- ) 'qvdot' rational hidden display quad ranum in fractional format (auxilary word, not error free)=> qf.j ( qv n1 n2 -- ) 'qfdotj' rational hidden l/r justified display quad ranum in floating pt format (auxilary word).=> qf. ( qv -- ) 'qfdot' rational hidden display quad ranum in floating pt format (auxilary word, not error free).=> qf#. ( qv -- ) 'dfdecdot' rational hidden display qv in f.p. format at decimal base=> q>qv ( qn -- qv ) 'q2qv' rational hidden signed convert quad integer to quad ranum=> ln(qv) ( qv1 -- qv2 ) 'lnqv' rational hidden qv2 := ln qv1; qv1 > 0, otherwise ret overflow indicator. accurate to 12(+) fractional+integral decimal digits in range 0<qv<10^11. (bj) calculated w/ infinite product to highest possible accuracy within range of quad ranum; terminated at ovf or, x^(1/2^n) == x^(1/2^(n-1)). -:- _oo_ 2 ln x = (x-1)| | -------------, 0<x<oo n=1 x^(1/(2^n))+1=> e^qv ( qv1 -- qv2 ) 'epowqv' rational hidden returns approximation to e^qv1, tested in range -43,6 < qv1 < 43,6. max. deviation +/- 10^-9, best results with |qv|<6, deviation < 10^-10. -:- -- x^n e^x = > ---, x >= 0 -- n! numeric accuracy limited by the last term x/n in x^n x^(n-1) x --- = ------- * --- n! (n-1)! n which terminates the series if x/n cannot be resolved to =/= 0 within range of +ve quad ranums and, by max. four cells range factorial, n=33.=> dv>uqv? ( dv -- +qv f) 'dv2uqvq' rational hidden return absolute quad value of signed double rational no. tf if dv was negative. A ranum is represented on data-stack as ( sign*|numerator| |denominator| ).=> dv>uqv ( dv1 -- qv2 ) 'dv2uqv' rational hidden unsigned expand dv1 to quad qv2.=> cos(qv) ( qv1 -- qv2 ) 'cosqv' rational hidden ret qv2 cosinus of qv1 in rad. -- x^2n x^2n x^(2n-1) x^2 cos x = > (-1)^n -----; x(n) = ----- = --------- * ---------; n=1..33(or ovf) -- (2n)! (2n!) (2(n-1))! 2n*(2n-1) numeric accuracy limited by the last term, x(n), which terminates the series if x^2n/(2n)! cannot be resolved to =/= 0 within the range of +ve quad ranum; and by the max. factorial representable w/ four cells, n! = 33!.=> atg(qv) ( qv1 -- qv2 ) 'atgqv' rational hidden ret qv2 arcus tangens of qv1 in rad. pi -- m^n x-1 atg x = --- + > (-1)^(n+1) ----, m = ---; x=0,x>0; (Hütte I) 4 -- 2n-1 x+1 numeric accuracy limited by the last term, which terminates the series if either the n-th summand is zero within accuracy of a quad ranum or, the running index excedes the (arbitrarily chosen) maximum of n = 255.=> n>qv ( n.N -- qv ) 'n2qv' rational hidden truncate/modify/signed extend counted integer to quad ranum.=> d>qv ( dn -- qv ) 'd2qv' rational hidden signed convert double integer to quad ranum=> 1/qv ( qv1 -- qv2 ) 'qvrecip' rational hidden reciprocal=> ?qv0= ( qv -- qv f ) (e) 'qqvzeq' rational hidden tf if qv is zero or overflow indicator. use additional test w/ {?q0=} to determine whether ovf(tf) or valid zero(ff) value. (e: Z if qv=0 and tf, else NZ; edx:=sign cell=> -qvround ( qv1 -- qv2 ) 'mqvround' rational hidden round quad ranum if numerator or denumerator out of range for double arithmetics normalize, i.e. reduce the fraction, otherwise.=> >quad ( p u -- q n ff | q0 0 tf ) rational hidden fetch quad int or double ranum from stg(p,u); input modifiers apply as w/ {[number]} ret n := radix of current base and false if conversion successful, else true flag. max convertible figure e.g. 19 decimal, fractional+integral digits. -re- {>double}. valid decimal exponent in range -14 < exp < 19.=> <#dvf#> ( dv -- p u ) 'ltdvfgt' rational -re- {#dvf}, signed convert -re- {dvfround}ed double ranum to floating pt stg.=> <#dv#> ( dv -- p u ) 'ltdvgt' rational Signed convert double ranum to fractional format stg. Returns the string(p,u) representing the rational number dv. The string is as described in -re- {#dv}, but will have a preceding minus sign if dv was negative. If dv is the overflow indicator, returns stg "Overflow".=> stg>qv ( p u -- qv f ) 'todfloat' rational >DFLOAT ( p u -- qv f ) 'todfloat' float convert stg(p,u) to a double 'float', i.e. quad ranum. an empty stg, or all blanks, resulting to ovf indicator. valid, optional exponent in range -21 < exp < 22. -re- {>double}=> qv>dv ( qv -- dv ) 'qv2dv' rational returns double which most closely approximates quad ranum. ret ovf indicator (0,0) if qv doesn't fit into dv.=> s>qv ( n -- qv ) 's2qv' rational signed convert single integer to quad ranum=> STEP (C: p1 f -- p2 f )(X: f1 -- ) (i) rational ans float immediately after {for} or {from}, {+from}, modifies loop increment to dv. xec: -re- runtime code, "(step)" cpl: checks flg f, modifies back-ptr p to pointing to immediately after {STEP}.=> NX ( n1 -- f1 ) rational ans float n1-th level nested FOR-loop index. n1 = 0 refers to innermost level, as { IDX }.=> NEXT (C: p f -- ) (i) rational ans float terminates a FOR [ FROM ] [ STEP ] ... NEXT loop xec: -re- runtime code, "(next)" cpl: checks flg f, resolve backward ptr.=> LIM ( -- f1 ) (X) 'flim' rational ans float get innermost FOR-loop limit.=> INC ( -- f1 ) (i)(X) 'fstep' rational ans float get innermost FOR-loop increment.=> IDX ( -- f1 )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) (X) 'fidx' rational ans float push innermost FOR-loop index dv1 to data-stack, loop index in a { FOR .. NEXT } loop; aequivalent to {i} of a DO/LOOP.=> FROM (C: p1 f -- p2 f )(X: f1 -- ) (i) rational ans float immediately after {for} or {step}, modifies loop start to f1 from data-stack. xec: runtime code, -re- {(from)} cpl: checks flg f, modifies back-ptr p to pointing to immediately after {FROM}.=> FOR (C: -- p f )(X: f1 -- ) (i) rational ans float introducing a FOR [ FROM ] [ STEP ] .. [ IDX ][ nn NX ] .. NEXT loop. cpl: leaves back-ptr p for resolution by NEXT and control flag f. xec: begin FOR/NEXT loop, passing loop limit f1, -re- {(for)} runtime code. further, related words -re- {INC}, {LIM}, {END} and the rsp. "!" and "@" variants.=> END ( -- ) (m,) 'fend' rational ans float leave innermost FOR-loop at next xec of NEXT, {END} executes like f.i.g-style {leave}, leaving the loop at next NEXT. (forced termination by storeing the overflow indicator to STP value)=> @NX ( n1 -- p ) 'fnx' rational ans float get ptr p to indexed, n1-th level nested FOR-loop index. n1 = 0 for innermost loop. running index: n1 @NX F@, increment: n1 @NX FLOAT+ F@, limit: n1 @NX DFLOAT+ F@. can be used at runtime to modifying e.g, the loop increment: { inc fdup f* inc f- 0 dv>n @nx float+ f! }=> !INC ( f1 -- )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) 'sinc' rational ans float store f1 from data-stack to innermost FOR-loop increment=> !IDX ( f1 -- )(R: dv1 dv2 dv3 -- dv1 d2 f1 ) 'sidx' rational ans float store f1 from data-stack to innermost FOR-loop index loop index in a { FOR .. IDX .. NEXT } loop.=> +FROM (C: p1 f -- p2 f )(X: f1 -- ) (i) 'pfrom rational ans float immediately after {for} or {step}, adds f1 to start value and limit, i.e. FOR-loop start index := dv and limit := limit + dv, limit := FOR-arg + dv. xec: -re- runtime code, "(+from)" cpl: checks flg f, modifies back-ptr p to pointing to immediately after {+FROM}.=> v>qv ( v1 -- qv2 ) 'v2qv' rational signed expand v1 to double cells size.=> tg(dv) ( dv1 -- dv2 ) (4) 'tgdv' rational tangens, by tg(x) = sin(x)/cos(x)=> sincos(dv) ( dv1 -- dv2 dv3 ) (4) 'sincosdv' rational dv2 := sin(dv1), dv3 := cos(dv1)=> sin(dv) ( dv1 -- dv2 ) (4) 'sindv' rational sinus, -re- {sin(qv)}.=> s>dv ( n -- dv ) 's2dv' rational signed promote sing integer to double ranum equivalent. n --> n s->d 1. =: dv.=> s>dvfactorial ( n -- dv ) 's2dvfac' rational dv := n!, -1<n<21; dv := 0 if not in range of a double ranum. (quad: n -- { s>nfactorial dup 5 < if n->q else ndrop 0qv endif } -- qv )=> REPRESENT ( f1 p u -- n flg1 flg2 | xx xx 0 ) 'frepresent' rational ans float decode rational number, dpans 12.6.1.2143: sto characters representation of f1, integral and #fplaces length fractional parts w/o trailing zeroes, w/ implied fractions' marker after 1st character plus n places, to buffer(p,u) as a counted string, leave base-10 exponent n, flg1 := tf if f1 <0, else 0 and, flg2 := tf for a valid result, 0 otherwise. NOTE: n is aequivalent to @dpl by numeric input and, in contrary to the dpans description of REPRESENT, conversion follows current @base setting. buffer(p,u) size should be at least 4 chars, ret false flg2, otherwise. ambiguos condition if f1 is overflow indicator and p = u = 0: flg2 := 1.=> rad>deg ( dv1|f1 -- dv2|f2 ) 'rad2deg' rational ans float convert to sexagesimal degrees.=> int ( -- ) (i)(4) 'intf' root clear {flt} state to default, integers interpreting mode. takes {FLOAT} from top of voc-stack, if applicable. -re- {sf}, {df}, {qf} for single or, {flt} permanent fp input mode.=> ln(dv) ( dv1 -- dv2 ) 'lndv' rational dv2 := ln dv1; dv1 > 0, otherwise ret overflow indicator, -re- {ln(qv)}.=> lg(dv) ( dv1 -- dv2 ) (4) 'flog' rational decimal logarithm of dv1, by dv2 := ln(dv1)/ln(10)=> flt? ( -- n ) 'fltq' forth ret single item cells count if latest numeric input was a 'ranum' or 'float' or, -1 if 'quad'.=> flt ( -- ) (i)(4) 'fltf' root all numeric input will be taken as a double 'ranum', until xec. of {int}. pushes the -re- {FLOAT} vocabulary 1st to voc-stack if not already there. NOTE that in {flt} state any numeric input will return a rational number (double) cells pair, which can be forded to quad integer w/ '\' praefix. Other numeric types can only be fetched in standard state -re- {int}.=> e^dv ( dv1 -- dv2 ) 'epowdv' rational returns approximation to e^dv1, -re- {e^qv}. tested in range -43,6 < dv1 < 43,6, accurate within min. +/- 10^-10.=> dvvariable ccc(C: -- ) (X: -- p ) rational -re- {4variable}=> dvm/ ( dv1 v2 -- dv3 ) 'dvmby' rational divide double dv2 by sing v2 giving double quotient dv3.=> dvswap ( dv1 dv2 -- dv2 dv1 ) rational -re- {4swap}=> dvsplit ( dv1 -- dv2 dv3 ) rational floored integral dv2 and (non-negative) fractional component dv3 of ranum dv1. w/ Floored rounding. word is tolerant of the overflow condition. re {dv>floor}, {dvfrac}, {dv>int}=> dvsgn ( dv -- n ) (e) rational ret sing signum of dv. (e: eflags reflect signum=> dvsqrt ( dv1 -- dv2 ) rational dv2 := square root of double ranum |dv1| * sgn(dv1). accuracy ok w/ less than 10 decimal digits, -re- {qvsqrt} for higher praecision.=> dvsimplify ( dv1 +dn -- dv2 ) (4) rational returns approximation to the rational number dv1 such that neither the numerator nor the denominator of the fractional component exceeds dn.=> dvround ( dv1 +dn -- dv2 ) rational returns an approximation to the rational number dv1 such that neither the numerator nor the denominator of its fractional part exceeds the +ve integer dn. -re- {fround}, {dvfround}, {qvround}, {qvdround}=> dvrot ( dv1 dv2 dv3 -- dv2 dv3 dv1 ) rational -re- {4rot}=> dvroll ( ... n -- ... dvn ) rational -re- {4roll}=> dvreduce ( dv -- dv) (4) rational normalises double ranum by greatest common divisor of numerator and denominator.=> dvrandom ( dv1 -- dv2 ) (4) rational ret random number in range [0,dv1), rfsh @{seed}. self-initiating.=> dvpick ( ... n -- ... dvn ) rational -re- {4pick}=> dvoverflow ( dv -- f ) rational tf if dv was the overflow indicator -re- {q0=}=> dvover ( dv1 dv2 -- dv1 dv2 dv1 ) rational -re- {4over}=> dvnegate ( dv -- dv ) (m,10)(e) rational negate dv1 (e: eflags reflect result of numerator negation=> dvmin ( dv1 dv2 -- dv3 ) rational ret dv3 the smaller of dv1,dv2.=> dvmax ( dv1 dv2 -- dv3 ) rational ret dv3 the greater of dv1,dv2.=> dvm* ( dv dv -- qv) 'dvmmul' rational multiply two double ranums, generating quad result.=> dvliteral (C: dv -- ) (X: -- dv ) rational -re- 4literal=> dvinteger ccc(C: dv -- ) (X: -- dv ) rational double ranum modifiable constant (two cells L4 variant of a {value}). synonym to -re- {4integer}.=> dvfround ( dv1 -- dv2 ) (4) rational returns an approximation to the rational number dv1 such that the fractional part rounded to {#fround} digits. simple rounding algorithm which increments last digit by one if next would be greater or equal to 0,5 * rounding factor: intf(frac(dv1)*base@^#fround+0,5) rounded result = --------------------------------- + intf(dv1) base@^#fround noop if (kernel-)value {#fround} < 0. -re- {fround}, {dvround}, {dvfround}=> dvfrac ( dv1 -- dv2 ) rational return the fractional component of dv1 as non-negative dv2. w/ Floored rounding. word is tolerant of the overflow condition. re {dv>floor}, {dv>int}=> dvdup ( dv1 -- dv1 dv1 ) rational -re- {4dup}=> dvdrop ( dv1 -- dv1 dv1 ) rational -re- {4drop}=> dvdepth ( -- n ) rational aequivalent to the number of double ranums in data-stack.=> dvconstant ccc(C: dv -- ) (X: -- dv ) rational -re- {4constant}=> dvcmp ( dv1 dv2 -- dv1 dv2 f ) (e) rational leave signum of ranum doubles subtraction. (e: eflags reflect signum=> dvabs ( dv -- |dv| ) rational negate dv if -ve=> dv^s ( dv1 +n -- dv2 ) 'dvpovs' rational raise dv1 to the power of non-negative single integer n. dv2 := ovf if n < 0 or result out of range.=> dv! ( dv p -- ) 'dvstore' rational store dv to memory at p. -re- {4!}.=> dv@ ( p -- dv ) 'dvfetch' rational fetch dv from memory at p. -re- {4@}.=> dv>s ( dv -- n ) 'dv2n' rational return the m.s. signed integral component of ranum dv as signed single integer n.=> ieee>dv ( dn -- f1 ) 'ieee2f' rational IEEE>F ( dn -- f1 ) 'ieee2f' ans float convert IEEE 754 normalized 'double real' to floating pt. (double ranum) format. valid f1 within range of a double ranum, overflow indicator otherwise. "negative zero" as (00..00/$80...00) which propagates zero to any other opr. any "nan" patterns return the overflow indicator (00/00). "signed infinity" returns +/- maximum.=> dv>ieee ( f1 -- dn ) 'f2ieee' rational F>IEEE ( f1 -- dn ) 'f2ieee' ans float convert floating pt. (double ranum) to IEEE 754 normalized 'double real' format. simple rounding method, increment significand by one if bit next to l.s.b set. f1 = +/- infinity represented by num=0 and den=0 or $80..00 (sign bit set), rsp.=> dv>int ( dv1 -- dv2 ) 'dv2int' rational round float to nearest integral value. re {dv>floor}, {dvfrac}=> dv>floor ( dv1 -- dv2 ) 'dv2floor' rational double ranum to floored integral value. -re- {dvfrac}, {dv>int}=> dv>dn ( dv -- d ) 'dv2dn' rational return the m.s. signed integral component of ranum dv as signed integer d.=> dv>d ( dv -- d ) 'dv2d' rational return the floored, integral component of ranum dv as signed integer d.=> dv/ ( dv1 dv2 -- dv3 ) 'dvby' rational divide dv1 by dv2 giving quotient dv3. div-0: ret +/- max or, ret 1 if dv1=0.=> dv-rot ( dv1 dv2 dv3 -- dv3 dv1 dv2 ) 'dvmrot' rational -re- {4-rot}=> dv% ( dv1 dv2 -- dv3 ) 'dvvh' rational div dv1 by 100 and mul by dv2=> dv*/ ( dv1 dv2 dv3 -- dv4 ) 'dvmulby' rational mul dv1 by dv2 and div by dv3=> dv* ( dv dv -- dv) 'dvmul' rational multiply two doubles.=> dv2dup ( dv1 dv2 -- dv1 dv2 dv1 dv2 ) rational -re- {8dup}=> dv2/ ( dv1 -- dv2 ) 'dv2div' rational divide dv1 by 2.=> dv2* ( dv1 -- dv2 ) 'dv2mul' rational multiply dv1 by 2.=> dv1- ( dv1 -- dv2 ) 'dvonem' rational subtract 1 from dv1=> dv1+ ( dv1 -- dv2 ) 'dvonep' rational add 1 to dv1=> dv0= ( dv -- f ) (e) 'dvzeq' rational tf if dv is zero (e: Z if dv=0, ecx=sign cell=> dv0< ( dv -- f ) (m,15)(e) 'dvzlt' rational tf if dv is -ve. (e: S reflects result=> dv>qv ( dv1 -- qv2 ) 'dv2qv' rational signed expand dv1 to quad qv2.=> dv> ( dv1 dv2 -- f ) (4) 'dvgt' rational tf if dv1 signed greater than dv2.=> dv< ( dv1 dv2 -- f ) (4) 'dvlt' rational tf if dv1 signed smaller than dv2.=> dv~ ( dv1 dv2 -- f ) 'dvaeq' rational tf if dv1, dv2 approximately (within dv accuracy) equal or, if |dv1-dv2| = ovf.=> dv= ( dv1 dv2 -- f ) 'dveq' rational tf if d1, dv2 exactly equal.=> dv- ( dv1 dv2 -- dv3 ) 'dvsub' rational subtract dv2 from dv1.=> dv+- ( dv1 n -- dv2 ) 'dvpm' rational negate dv1 if n < 0=> dv+ ( dv1 dv2 -- dv3 ) 'dvplus' rational add two double ranums; fast (i.e. less slow), trivial case if den1 = den2.=> dv.j ( dv n1 n2) 'dvdotj' rational display rational number dv in fractional format, as described in <#dv#>, padded w/ up to n1 leading and, up to n2 trailing spaces, none if -ve.=> dv. ( dv -- ) 'dvdot' rational display a ranum in fractional format as described in dv.j but, w/o left or right justification and, with one trailing space.=> df.j ( dv n1 n2 -- ) 'dvdotfj' rational display double ranum dv according to the rules described in -re- {#dvf}, padded w/ up to n1 leading and up to n2 trailing blanks, none if -ve.=> df. ( dv -- ) 'dvdotf' rational display a rational number in floating point format as w/ -re- {df.j} but without left or right justification, and with one trailing space.=> df#. ( dv -- ) 'dfdecdot' rational display dv in f.p. format at decimal base=> deg>rad ( dv1|f1 -- dv2|f2 ) 'deg2rad' rational ans float convert to radians.=> d>dv ( dn -- dv ) 'd2dv' rational promote double integer to double ranum equivalent. dn --> dn 1. =: dv.=> cos(dv) ( dv1 -- dv2 ) (4) 'cosdv' rational cosinus, -re- {cos(qv)}.=> atg(dv) ( dv1 -- dv2 ) 'atgdv' rational ret dv2 arcus tangens of dv1 in rad. -re- {atg(qv)}.=> asin(dv) ( dv1 -- dv2 ) (4) 'asindv' rational fasin ( dv1 -- dv2 ) ans float x arc sin x = arc tg ------------- (1-x^2)^(1/2)=> acos(dv) ( dv1 -- dv2 ) (4) 'acosdv' rational facos ( f1 -- f2 ) ans float sqrt(1-x^2) arc cos x = arc tg ----------- x=> 10^dv ( dv1 -- dv2 ) (4) 'powdv10' rational raise ten to the power of dv1.=> 1/dv ( dv1 -- dv2 ) 'dvrecip' rational ret dv2 the reciprocal of dv1.=> dv^ ( +dv1 dv2 -- dv3 ) (4) 'dvpowdv' rational dv3 := +ve float or -ve integral dv1 to the power of dv2; dv3 := 1 if dv1 = 0. ambiguous result if -ve dv1 is not an integer, -re- {re,im(v)}. -re- {qv^}, a^x = e^(x ln a); a=0 | a^x := 1=> -flt ( -- f ) (i) 'mflt' root ret tf if numeric input mode not persistent floats -re- {flt}.=> #dvf ( +dv -- 0 0 ) 'sharpdvf' rational append the positive ranum +dv to the numeric output string as a floating point number w/ the current value of {base}. That is to say, the integral component, followed by a marker char -re- {#dp}, the "decimal point", followed by as many digits as specified by -re- {fplaces} w/ no rounding. Returns 0 0 for consistency with other numeric strings conversion words.=> #dv ( dv -- 0.0 ) 'sharpdv' rational append signed double ranum dv to the numeric output string: If dv is zero append "0". If dv has an integral component but no fractional component, append that number. If dv has a fractional component but no integral component append "a/b" where a is the numerator, and b the denominator. If dv has both a an integral and a fractional component append "a b/c" where a is the integral component, b the numerator and c the denominator of the fractional component. There is a delimiting char between the integral and fractional components,-re- {#fd}, {fdelim}. Sign applies to the entire figure; conversion according to current @BASE. Leave double zero, after conversion.=> (step) ( dv -- )(R: dv1 dv2 dv3 -- dv1 d2' dv3 )(X) 'pstepp' novoc modifies loop increment dv2 in returnstack to dv from data-stack. exchanges limit and initial index if dv -ve.=> (next) ( -- )(R: dv1 dv2 dv3 -- ) (X) 'pnextp' novoc terminates a FOR [ FROM ] [ STEP ] ... NEXT loop=> (from) ( dv -- )(R: dv1 dv2 dv3 -- dv1 d2 dv3' ) 'pfromp' novoc modifies loop start dv3 (initial lop index) in returnstack to dv from data-stack. loop limit remains unchanged, -re- {(+from)}.=> (for) ( f1 -- )(R: -- f1 f2 f3 ) 'pforp' novoc runtime introducing a FOR [ FROM ] [ STEP ] ... NEXT loop set initial looping range = limit = f1 (item type of 'double ranum'). pushes loop limit dv1 to the return-stack, plus defaults of start = initial loop index = f3 := 0, step = f2 := 1. data on returnstack in little endian order, suitable to F@, F! wrt RP@. -re- {@NX} for orderly access to any levels loop ctrl. data structures.=> (+from) ( dv -- )(R: dv1 dv2 dv3 -- dv1' d2 dv3' )(X) 'ppfromp' novoc modifies loop start dv3 := dv and limit dv1 := dv3+dv from data-stack; i.e. looping range incremented by dv, from pre-set start to by dv displaced limit.=> digits> ( -- u ) 'vdigitsgt' rational hidden u is the largest number that can be represented in the current base by not more than {digits} number of digits. to preventing very odd values {digits} will be truncated to less than 256 which, if {pad-size} not set to a value below default will always be safe.=> dv>udv? ( dv -- +dv f) 'dv2udvq' rational hidden return absolute value of signed double rational no. tf if dv was negative. A double ranum is represented on the stack as sign*d.numerator +d.denominator.=> v>uv? ( v -- uv f) 'v2uvq' rational hidden uv is the absolute value of the v, f is TRUE if v was negative.=> ud>n? ( ud -- +n f) 'ud2nq' rational hidden converts unsigned double ud to non-negative single +n. tf if conversion failed.=> small? ( dv -- f ) rational hidden returns TRUE if double ranum dv can be normalised by "normal", rather than the slower "vnormal".=> >ch ( p u c -- n ) 'gtch' rational hidden search stg(p,u) for character c. If it is present then n is the position of the first occurrence of ch in the string. If it is not present then n is equal to u.=> <#vf#> ( v -- p n ) 'ltvfgt' rational hidden Returns a string representing the ranum v by stg(p,u). The string is as described in #vf, but will have a preceding minus sign if v was negative. If v is the overflow indicator, returns the string "Overflow".=> <#v#> ( v -- p u ) 'ltvgt' rational hidden Returns the string(p,u) representing the rational number v. The string is as described in #v (above), but will have a preceding minus sign if v was negative. If v is the overflow indicator, returns stg "Overflow".=> vvariable ( -- p ) rational -re- {2variable}=> vswap ( v1 v2 -- v2 v1 ) rational=> vroll ( ... n -- ... vn ) rational=> vrot ( v1 v2 v3 -- v2 v3 v1 ) rational=> vreduce ( v1 -- v2 ) rational reduces a ranum by greatest common divisor of numerator and denominator.=> vpick ( ... n -- ... vn ) rational=> vliteral ( v -- ) (i) rational compile/interpret rational number v as a double literal.=> vover ( v1 v2 -- v1 v2 v1 ) rational=> vinteger ( -- v ) rational -re- {2integer}=> vdup ( v1 -- v1 v1 ) rational=> vdrop ( v1 -- v1 v1 ) rational=> vconstant ( -- v ) rational -re- {2constant}=> v-rot ( v1 v2 v3 -- v3 v1 v2 ) rational=> v2dup ( v1 v2 -- v1 v2 v1 v2 ) rational=> vsimplify ( v1 +n -- v2 ) (4) rational returns an approximation to the rational number v1 such that neither the numerator nor the denominator of the fractional component of v1 exceeds the positive integer n.=> vsqrt ( v1 -- v2 ) rational v2 := sgn(v1) * square root of ranum |v1|. accuracy ok w/ less than 5 decimal digits, -re- {dvsqrt} for higher praecision.=> vsplit ( v1 -- v2 v3 ) rational floored integral v2 and (non-negative) fractional v3 component of v1. w/ Floored rounding, i.e. v1 = v2 + v3 and assuming +ve v3 is always valid. word is tolerant of the overflow condition.=> vsgn ( v -- -1 | 0 | 1 ) (m,) 'vsgn' rational ret sing signum of a ranum=> vround ( v1 +n -- v2 ) (x) rational returns an approximation to the rational number v1 such that neither the numerator nor the denominator exceeds the positive integer n. The intent is that, where high precision is not an issue, vround can be inserted at key points in the code to ensure the quicker "normalise" path is taken in subsequent words that call DV>V=> voverflow (k)=> vnormal ( dv -- v ) (x) rational hidden return the normalised ranum which most closely approximates the signed double rational number passed to it. Returns 1 0 if the double was too large and positive to be represented or -1 0 if too large and negative. Numbers too small to be represented are rounded to zero (0 1). Works by generating approximations from successive numbers in the continued fraction expansion of dv, until no more numbers are available, or overflow occurs. The 1st number in the continued fraction expansion is the integral component and the next the integral component of the reciprocal of the fractional component and so on. The continued fraction of any rational number terminates when the fractional component becomes zero.=> vnegate ( v -- v ) (m,) rational return { ranum -1 * }. The sign bit is in the numerator.=> vmin ( v1 v2--v3) rational returns the smaller of the two ranum arguments. Will always return the overflow condition, if present.=> vmax ( v1 v2 -- v3 ) rational returns the larger of the two ranum arguments. Will always return the overflow condition, if present.=> vm* ( v v -- dv) 'vmmul' rational multiply two ranums, generating double length result.=> vfrac ( v1 -- v2 ) rational return the fractional component of v1 as non-negative ranum v2. w/ Floored rounding. word is tolerant of the overflow condition.=> vabs ( v -- |v| ) ( m, ) rational return absolute value of ranum argument.=> v2/ ( v1 -- v2 ) 'v2div' rational divide v1 by 2=> v2* ( v1 -- v2 ) 'v2mul' rational multiply v1 by 2=> v1- ( v1 -- v2 ) 'vonem' rational decrement v1 by one=> v1+ ( v1 -- v2 ) 'vonep' rational increment v1 by one=> v0= ( v -- f ) 'vzeq' rational flag is true if v is zero.=> v0< ( v -- f) (m,) 'vzlt' rational flag is TRUE if v is negative.=> v^n ( v1 +n -- v2 ) 'vpovn' rational raise v1 to the power of non-negative sing n. v2 := ovf if n < 0. e.g, max e^n w/ n = 21.=> v! ( v p -- ) rational store v to memory at p=> v@ ( p -- v ) rational fetch v from memory at p=> v.j ( v n1 n2) 'vdotj' rational display rational number v in fractioanl format, as described in <#v#> (above), padded with up to n1 leading spaces, and up to n2 trailing spaces, such that the number is justified about the space between the integral and fractional component, if present. If there is no integral component an additional leading space is displayed in lieu of the central space. If there is no fractional component an additional trailing space is displayed in lieu of the central space. No more than "digits" number of characters will be displayed in the numerator or denominator. n1 should be -1 to switch off leading spaces entirely, and likewise n2 for trailing spaces.=> v. ( v -- ) 'vdot' rational display a rational number in fractional format as described in v.f but without justification and, with one trailing space.=> v~ ( v v -- f ) 'vaeq' rational tf if the two ranum arguments are approximately equal. The difference between two ranums may be less than the smallest ranum that is representable with a single cell denominator. In this instance the two ranums may be reasonably described as approximately equal.=> v= ( v1 v2 -- f ) 'veq' rational tf if v1, v2 exactly equal.=> v< ( v1 v2 -- f ) 'vlt' rational tf if v1 less than v2. Returns FALSE if either argument is the overflow condition.=> v> ( v1 v2 -- f ) 'vgt' rational tf if v1 greater than v2. Returns FALSE if either argument is the overflow condition.=> v>s ( v -- n ) 'v2s' rational return the floored, integral component of v as a signed integer.=> v/ ( v1 v2 -- v3 ) 'vby' rational divide v1 by v2 giving quotient v3.=> v* ( v v -- v) 'vmul' rational multiply two ranums using naive algorithm, generating double length result, then round to single.=> v- ( v1 v2 -- v3 ) 'vsub' rational subtract v2 from v1.=> v+- ( v1 n -- v2 ) (m,) 'vpm' rational negate v1 if n < 0=> v+ ( v1 v2 -- v3 ) 'vplus' rational add two ranums using naive algorithm, generating double length result, then round to single.=> s>vfactorial ( n -- v ) 's2vfac' rational v := n!, v := overflow if not fitting into a single ranum (max n = 12).=> s>v ( n -- v ) 's2v' rational promote single integer to ranum equivalent. n --> n 1=> qv>v ( qv1 -- v2 ) (4) 'qv2v' rational reduce quad, qv1 to single cells size, v2.=> f.j ( v n1 n2 -- ) 'vdotfj' rational display ranum v according to the rules described in <#vf#>. The display string will be padded with leading spaces until there are n1 characters before the point and padded with trailing spaces until there are n2 characters after the point. This allows numbers to be aligned about the point for display in tabular form. If there is no point in the string it will be padded with n2+1 trailing spaces for consistency. Trailing zeroes will be truncated according to the rules described in -re- {-zeroes}. If n1 is less than the number of characters to be displayed before the point no spaces will be displayed, but the string will not be foreshortened. Therefore setting n1 to zero will switch off right justification. If n2 is less than the number of characters to the right of the point no spaces will be displayed, but the string will not be truncated. If n2 is zero and places is also zero one trailing space will be displayed in lieu of the point. Therefore n2 should be -1 to switch off left justification, as this will inhibit all trailing spaces.=> f. ( v -- ) 'vdotf' rational display a rational number in floating point format as described in v.fj but without left or right justification, and with one trailing space.=> e^v ( v1 -- v2 ) 'epowv' rational returns approximation to e^x, where x is the rational number v1 | 6 > v1 > -6. Computed as 1st {#s!n} terms (dft 13) of power series; +/- 10^(-8) for |v| < 1. 13 to {#n!v} is maximum for non-overflowing internal factorial calculations.=> dv>v ( dv -- v ) 'dv2v' rational returns the ranum that most closely approximates the unnormalised ranum dv. If overflow is detected (denominator is zero) action is taken to ensure the overflow indicator 0 0 is returned.=> 1/v ( v -- v ) (m,) 'vrecip' rational the reciprocal of a ranum.=> #vf ( +v -- 0 0 ) 'sharpvf' rational append the positive ranum +v to the pictured numeric output string as a floating point number. That is to say, the integral component, followed by a point, followed by as many digits as specified by places. If places is zero no point is included. Returns 0 0 for consistency with other pictured numeric output conversion words. The conversion is done according to the current value of BASE.=> #v ( +v -- 0 0 ) 'sharpv' rational append positive ranum +v to the pictured numeric output string according to the following rules. If +v is zero append "0". If +v has an integral component but no fractional component, append that number. If +v has a fractional component but no integral component append "a/b" where a is the numerator, and b the denominator. If +v has both a an integral and a fractional component append "a b/c" where a is the integral component, b the numerator and c the denominator of the fractional component. There is a space between the integral and fractional components. The conversion is done according to the current value of BASE.=> v>dv ( v1 -- v2 ) 'v2dv' rational expand v1 to double cells size.=> -zeroes ( p u1 -- p u2 ) 'mzeroes' rational strip string(p,u1) of trailing "0"s which follow the fraction marker char, -re- {#dp}. At least one character will remain after the point.=> >double (k)=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> cons ( -- ) (X)(i) 'racons' rational {rational} sub-vocabulary, Rational Numbers' constants.=> hidden ( -- ) (X)(i) 'rahidden' rational {rational} sub-vocabulary for Rational Numbers, quad format and support.=> rational ( -- ) (X)(i) root vocabulary for Rational Numbers opr ('real', 'ranum', 'vulgar numbers'). The "rational" word-set provides basic arithmetic, logical, type conversion and numerical in-/output routines for rational numbers. Basic routines from Vulgar Maths Words Version FSL1.1", Forth Scientific Library Algorithm #46, by Gordon Charlton - gordon@charlton.demon.co.uk. adapted to 'lib4th' and (much) extended. (Find the original FSL text in lib4th source, "./doc/src/vulgar.fth"). 'sing' "v", 'double' "dv", 'quad' "qv" refer to a 'ranum' of the rsp size of ea, the numerator and denominator; prefix 'v...' from 'vulgar'. A 'ranum' in this context is a single or multiple cells pair in the order Numerator Denominator -- , denominator @tos (nenner, divisor), which is (almost) always a reduced fraction. The numerator is a signed integer, and the denominator a non-negative integer. Zero is represented by (0,1). Numbers too large to be represented are indicated by the special value (0,0), which will propagate through a program. Most words in this suite are tolerant of the overflow indicator, with the exception of those that convert rational numbers to other numerical data types. These are flagged in the listing. The data type "rational number" is also referred to by "fractional number", if displayed as an integer and fraction or, by "floating point" number. The term "ranum" will be used for either display type of a rational number. In the range of improper fractions (1,..) the difference between successive representable 'ranums' increases as the absolute value of the fraction increases; i.e. above |2^(bitsize-2)-1| only integers are representable. Range of single cell pairs 'ranums' is thus quite limited, double and quad pairs sizes provided for more accurate ranges and intermediate calculations. Further, -re- {vsplit} is provided, which separates the fractional and the integral part of a rational fraction. If the loss of precision associated with large numbers is not acceptable, vsplit can be used to deal with the fractional component separately, thus maintaining absolute precision.=> FLOAT ( -- ) (X)(i) ans ans FLOATING and FLOATING EXT words, aliased/copied from -re- {rational} voc. 'float' representation is 'double ranum', common 4-cells operations apply, 'double float' by quad cells pairs 'quad ranum' w/ 8-cells basic operations. -re- {flt}/{int} for persistent floats/integers numeric input modes.=> third ( n1 n2 n3 -- n1 n2 n3 n1 ) (m,4) forth fetch 3rd item from stack. substitutes { 2 pick } (e: eflags remain unchanged)=> swap- ( n1 n3 -- n3 ) (e)(m,8) 'swsub' forth reverse subtract: leave result of { n3 n1 - }=> swap2s ( n1 n2 n3 n4 -- n4 n3 n2 n1 ) (m,20) forth revert cells order of top four cells does{ swap 2swap swap } -re- {bswap} for conversion of bytes order in a cell (e: eflags remain unchanged)=> srot ( n1 n2 n3 -- n3 n2 n1 ) (m,8) forth { swap rot }, i.e. exchanges @tos and 2nd (e: eflags remain unchanged)=> TUCK (a:ce) 'sover' ans does{ swap over } sover ( n1 n2 -- n2 n1 n2 ) (m,12) forth { swap over } (e: eflags remain unchanged)=> sdup ( n1 n2 -- n2 n1 n1 ) (m,9) forth does{swap dup} or, {over swap} (e: eflags remain unchanged)=> NIP (a:ce) 'sdrop' ans drop @nos; does{ swap drop } sdrop ( n1 n2 -- n2 ) (m,3) forth drop @nos; does{ swap drop } (e: eflags remain unchanged)=> s= ( p1 u1 p2 u2 -- n ) 'seq' forth compare case dependently, regardless of uc-.. setting.=> rswap (R: n1 n2 -- n2 n1 ) forth swap cells on return-stack=> rots ( n1 n2 n3 -- n2 n1 n3 ) (m,12) forth { rot swap }, i.e. swap next on tos cells (e: eflags remain unchanged)=> rotd2s ( n1 n2 n3 -- n1 n1 n2 n3 ) (m)(x) forth quck-tuck (a?)(n.i.) duplicate 3rd on tos, supporting {skip}, {scan}, etc: { rot dup 2swap } (e: eflags remain unchanged; mmx mode w/ minor timing gain)=> rotd ( n1 n2 n3 -- n2 n3 ) (m,9) forth { rot drop } (e: eflags remain unchanged)=> rot-r ( x1 u -- x2 ) (e)(m,9) 'rotr' forth right rotate x1 by u bits=> rot-l ( x1 u -- x2 ) (e)(m,9) 'rotl' forth left rotate x1 by u bits=> rdrop (R: n1 -- ) (f6)(m,3) forth drop cell from return-stack=> pow2? ( n -- flg ) (e) 'pow2q' forth tf if signed n is a power of 2 (including n=1, n=80000000h). (e: flg value)=> parity ( n1 -- flg ) (m,12) forth ff if n1 w/ odd number of set bits=> dparity ( d1 -- flg ) forth ff if d1 w/ odd number of set bits=> oswap ( n1 n2 -- n2 n2 n1 ) (m,8) forth does{over swap} (e: eflags remain unchanged)=> over- ( n1 n2 -- n1 n3 ) (f6)(m,3) 'overm' forth {over -}, leave n3 := n2-n1 (e: eflags reflect result)=> over+ ( n1 n2 -- n1 n3 ) (m,3) 'overp' forth {over +}, leave n3 := n2+n1 (e: eflags reflect result)=> log ( n1 n2 -- n3 ) forth numerus of log n1, to the base of n2; if n1 = 0 ret n3 := 0=> lg2 ( d1 -- n2 ) 'lg2' forth ret n2 = numerus of log double, d1 to the base of 2=> lg(base) ( n1 -- n2 ) forth numerus of log n1 wrt actual {base} (which is one less than count of digits of the printed number n1) hi-level defn: : lg(base) 0 begin swap base @ / ?dup while swap 1+ repeat ;=> l-or ( n1 n2 -- flg ) 'lor' forth logic OR, ff only if n1 = 0 and n2 = 0.=> l-and ( n1 n2 -- flg ) 'land' forth logic AND, tf only if n1 =/= 0 and n2 =/= 0.=> flg>smb ( n -- p u ) 'flg2smb' tools convert eflags value to symbolic string at {hld}+, string corrupted by consecutive numeric conversions. ls eflags byte: [S|Z|0|A|0|P|1|C]=> flg ( -- u ) (m,3) tools fetch eflags register from latest opr can efficiently be used immediately after those words which are marked "(e)".=> 2^ ( n1 -- d2 ) 'pow2' forth ret d2 := n1-th power of two, -1 < n1 < 64=> dropd ( n1 n2 -- n1 n1 ) (m,3) forth copy @nos to @tos, does{ drop dup } (e: eflags unchanged)=> ddup ( n1 -- n1 n1 n1 ) (m,2) 'ddup' forth twice duplicate sing on tos (e: eflags remain unchanged)=> d2dup ( d1 -- d1 d1 d1 ) (m,x) 'd2dup' forth twice duplicate double on tos (e: eflags remain unchanged)=> bounds ( x1 n -- x2 x1 ) (fg)(m,4) forth leave x1 and x2 := x1+n, ready for do..loop etc. { over + swap } (e: eflags reflect result of addition)=> ?DUP ( n1|0 -- n1 n1 | 0 ) (a:c)(83) 'qdup' ans duplicate n1 if non-zero=> !r ( p -- )(R: n -- ) (m,8) 'storer' hidden store kref(n) - n+KR - to ptr p, remove both from rsp. stacks.=> 3dup ( n1 d2 -- n1 d2 n1 d2 ) (f6)(x) 'dup3' forth duplicate top three cells @tos (e: eflags remain unchanged; mmx mode w/o timing gain)=> 3drop ( n1 n2 n3 -- ) (e)(m,6) 'drop3' forth (e: eflags remain unchanged)=> 2third ( d1 d2 d3 -- d1 d2 d3 d1 ) (m,8) 'third2' forth fetch 3rd double from stack. substitutes { 2 2pick } (e: eflags remain unchanged)=> 2srot ( d1 d2 d3 -- d3 d2 d1 ) (m,8)(x) 'srot2' forth { 2swap 2rot }, i.e. exchanges @tos and 2nd (e: eflags remain unchanged; mmx mode w/o timing gain)=> 2sover ( d1 d2 -- d2 d1 d2 ) (f6)(x)(m,10) 'sover2' forth { 2swap 2over } - macro compiling only if mmx enabled. (e: eflags remain unchanged)=> 2sdup ( d1 d2 -- d2 d1 d1 ) (x) 'sdup2' forth does{ 2swap 2dup } or, { 2over 2swap } (e: eflags remain unchanged)=> 2sdrop ( d1 d2 -- d2 ) (f6)(m,9) 'sdrop2' forth drop double @nos; does{ 2swap 2drop } (e: eflags remain unchanged)=> 2rots ( d1 d2 d3 -- d2 d1 d3 ) (m, )(x) 'rots2' forth { 2rot 2swap }, i.e. swap next on tos doubles (e: eflags remain unchanged)=> 2rotd ( d1 d2 d3 -- d2 d3 ) (x) 'rotd2' forth { 2rot 2drop } (e: eflags remain unchanged; mmx mode w/o timing gain)=> 2rswap (R: d1 d2 -- d2 d1 ) (m,20)(X) 'rswap2' forth swap doubles on return-stack (macro w/ __MMX mode, only)=> 2rdrop (R: n1 n2 -- ) (f6)(m,3) 'rdrop2' forth drop a double from return-stack=> 2r>>2r ( d1 -- d2 )(R: d2 -- d1 ) 'r2xchg' forth exchange doubles on tos and on tor=> 2oswap ( n1 n2 -- n1 n1 n2 ) (m,14)(x) 'oswap2' forth does{ 2over 2swap } (e: eflags remain unchanged; mmx mode w/ minor timing gain )=> 2dropd ( d1 d2 -- d1 d1 ) 'dropd2' forth copy double @nos to @tos, does{ 2drop 2dup } (e: eflags unchanged)=> r>>r ( n1 -- n2 )(R: n2 -- n1 ) (m,14) 'rxchg' forth exchange cells on tos and on tor=> 2-rot ( d1 d2 d3 -- d3 d1 d2 ) 'mrot2' forth reverse roll double @tos to 3rd=> 2-pick ( dm..d1 n -- dm..d1..d2 ) 'mpick2' forth store d1 as n-th item @tos, position of d1 (item to store) counts for zero. drop count and d1 if n < 0=> 0max ( n1 -- n2 ) (k6)(m,6) 'zmax' forth n2 = n1 larger than or adjusted equal to zero=> 0drop ( n | 0 -- n ) (m,9) 'zdrop' forth drop if zero=> -pick ( nm..n1 n -- nm..n1..n2 ) (m,23) 'mpick' forth store n1 as n-th item @tos, position of n1 (item to store) counts for zero. drop count and n1 if n < 0=> -drop ( n | 0 -- 0 ) 'mdrop' forth drop n if non-zero=> -0= ( u1 -- flg ) (m,11) 'mzeq' forth tf if only sign bit (m.s.bit) set of u1=> @0= ( p -- flg ) (m,) 'zeqf' forth tf if cell @ptr p is zero=> TUCK (a:ce) 'sover' ans does{ swap over } sover ( n1 n2 -- n2 n1 n2 ) (m,12) forth { swap over } (e: eflags remain unchanged)=> NIP (a:ce) 'sdrop' ans drop @nos; does{ swap drop } sdrop ( n1 n2 -- n2 ) (m,3) forth drop @nos; does{ swap drop } (e: eflags remain unchanged)=> uv@ ( -n -- p ) (m,7) 'uvfetch' forth get content of user vari by -ve(!) disp, -n < 0 (consecutive disp's wrt uv.link := 0, .aux:=124, .vocs:=-128)=> up+ ( -n -- p ) (m,7) 'upplus' forth get ptr to user vari by disp (consecutive disp's wrt uv.link := 0, .aux:=124, .vocs:=-128)=> state@ ( -- n ) (f6)(m,4) 'statef' forth fetch compile/interpret state flag(s) zero if actively interpreting, any non-zero otherwise=> sp@ ( -- a ) (fg) 'spfetch' forth get datastack ptr ANS: programs shall NOT access datastack by address! @tos stored to corresponding address but, might get lost with operations to follow. references to above @tos will be safe. "above" is to descending addr!=> span@ ( -- n ) (m,4) 'spanf' forth number of chars fetched with latest expect, -re- {#tib}=> source-id ( -- n ) (a:cx)(m,7) 'sourceid' forth current input source. dpans: 11.6.1.2218 -2: initial arguments present -1: input by {evaluate}d string 0: user input device = <stdin>, file if -ve blk@ >0: channel number of file input, 0 and -ve @blk@ for stdin file pointer in channels chp data=> rp@ ( -- a ) (fg)(m,5) 'rpfetch' forth fetch returnstack ptr programs should not access returnstack by address!=> pad-size ( -- n ) (m,4) 'pad-size' forth size of {pad}, {pad2}, implied size of numeric stg conversion buf. at {hld}. should not be set to less than 136 bytes, i.e. for quads' number conversion. system default 256 bytes, 4096 (Page Size) recommended for long strings, etc.=> pad2 ( -- ptr ) forth 2ndary double-cell aligned auxilary memory {pad-size} bytes on top of current dictionary ptr used by literal string storage opr's while interpreting, {s"} etc.=> pad ( -- p ) (a:c) forth double cell aligned auxilary memory {pad-size} bytes on top of current dictionary ptr, "above" {pad2}, stored data may extend until below {sp@}.=> octal ( -- ) (f6) forth set number conversion radix := 8=> in@ ( -- n ) (f6)(m,4) 'infetch' forth does{ in @ }=> hex ( -- ) (f6) forth set number conversion radix := 16=> here ( -- p ) (m,4) forth ptr to bot of unused dataspace current dataspace dictionary ptr, between @{d0} and @{d-top}.=> envp ( -- p ) (m,21) 'envpp' linux get ptr to array of ptr-s to program's asciz environment strings.=> edpl@ ( -- n ) (m,5) 'edplfetch' forth signed, (optional) base-exponent from numeric input.=> dpl@ ( -- n ) (f6)(m,4) 'dplfetch' forth does{ dpl @ }, fetch decimal point location after numeric input.=> decimal ( -- ) (f6) forth set number conversion radix := 10=> cc4cc! ( c p -- ) 'cc4ths' forth store execution ptr p for char c to (cc4th) table. 2drop if @(cc4th) = 0; p = 0 or kref(p) = 0 de-acivates entry=> cc4cc@ ( c -- p ) (83) 'cc4thf' forth user vector, zero ctrl action for char c in jumptable=> binary ( -- ) (f6) forth set number conversion radix := 2=> blk@ ( -- n ) (f6)(m,4) 'blkfetch' forth does{ blk @ }=> base! ( n -- ) (f6)(m,8) 'bases' forth store @tos to uvari {base}.=> base@ ( -- n ) (f6)(m,4) 'basef' forth fetch current number conversion radix. with range check, 1 < @base < 257 if not compiled as a macro. expect abiguous numeric results if out of range 1 < @base < 197. base = 256 used for string data to character code conversion.=> argp ( -- p ) (m,7) 'argpp' linux get ptr to array of ptr-s to program's asciz environment strings.=> work ( -- c ) (m,5) 'workc' forth actual work-channel number=> width ( -- p ) forth max. length of a 4th name moved into header data (currently un-used).=> voc-link ( -- p ) 'voclink' forth vocabulary link pointer, linkage by disp to respective ptrs, chained { voc-link begin dup @ -dup while - dup voc>lfa id. repeat drop }=> up ( -- p ) forth memtop uservari ptr, top down, after last used item=> ti-cal ( -- dn ) (f6)(m,7) 'tical' forth fetch cpu clocks per second, from (tick). non-macro variant checks and inititates calibration, if required=> stdout ( -- c ) (m,5) 'stdoutc' forth actual standard output channel number=> stdin ( -- c ) (m,5) 'stdinc' forth actual standard input channel number=> stderr ( -- c ) (m,5) 'stderrc' forth actual standard error output channel number=> state ( -- p ) (fg)(a) forth ptr to compile/interpret state flag(s). state@ zero if actively interpreting, any non-zero otherwise. lib4th {state} complies to standard, though non-zero values have specific control functions different to common useage!=> span ( -- p ) (79) forth ptr to number of chars fetched with latest expect=> scr ( -- p ) forth fig-4th screenfile line editor, screen number.=> s0 ( -- p ) forth datastack, bottom up; -re- {sp@}, {depth}, {-depth}=> rows ( -- p ) forth editor, output lines cnt=> r0 ( -- p ) forth initial returnstackptr, -re- {rp@}=> out ( -- p ) (fg) 'nout' forth editor, output chars cnt=> ocontext ( -- p ) hidden old context, 2nd volatile item on stack, ALSO moves into voc-stack=> ocurrent ( -- p ) hidden previous current voc, after {definitions}. {prevdef} restores {current} from {ocurrent}.=> lp ( -- p ) local ptr into local data-space, content temporarily exchanged w/ {dp} while compiling a local word header.=> latest ( -- p ) (m,10) forth return lfa of latest word in {current} vocabulary, which is the wordlist currently extended by new definitions.=> last ( -- p ) (79) 'lastu' forth last accessible word in system. -re- {latest} wrt {current} voc.=> kbd ( -- c ) (c)(m,5) 'kbdc' forth initial keyboard channel, set from stdin=> in ( -- p ) (fg) 'xin' fig >in ( -- p ) (a:c) 'xin' forth disp from start to parse area in input buf.=> i-fence ( -- p ) 'ifence' forth upper bound of non-alterable uot-index, no. of 1st writable ix.=> hld0 ( -- p ) hidden initial {hld} after start of number conversion=> hld ( -- p ) forth ptr to current posn in number to string conversion buf.=> fld ( -- p ) uvari, free for user aplication 'ufld' forth=> f-heap ( -- p ) 'fheap' hidden linked list to free allocated heap blocks=> fence@ ( -- n1 n2 n3 ) 'fencef' forth fetch latest {fence!}-ed values to tos, n1:=c-fence, n2:=fence, n3=i-fence NOTE: n3, @i-fence, is 1st un-fenced index, following fenced one.=> fence! ( n1 n2 n3 -- ) 'fences' forth store values from tos, n1:=c-fence, n2:=fence, n3=i-fence to {..fence} ptrs NOTE: n3, @i-fence, is 1st un-fenced index, following fenced one.=> fence ( -- p ) 'fence4' forth upper bound of non-alterable dictionary, 1st writable position.=> dpl ( -- p ) (fg) forth decimal 'point' location, i.e. posn of last numeric fractions marker from (dpl). type flag settings from numeric stg conversion -re- {[number]}:=> dp ( -- p ) forth ptr into dataspace, -re- {here}, {unused}, {d0} content temporarily exchanged w/ {lp} while compiling a local word header.=> d0 ( -- p ) forth bottom of dataspace, in .bss section=> d-top ( -- p ) 'dtop' forth top of data-space (kref'd ptr!), -re- {d0}, {here}, {unused}=> csp ( -- p ) forth saved compile-stack ptr=> current ( -- p ) forth ptr to double voc descriptor of defining vocabulary, i.e. vocabulary the wordlist of which currently will be extended by new definitions.=> cp ( -- p ) forth ptr into codespace, in .bss section; -re- {c-here}, {c-top}=> context ( -- p ) forth ptr to double voc descriptor of 1st voc in search order=> c-top ( -- p ) 'ctop' forth top of code-space (kref'd ptr!), -re- {c0}, {c-here}=> c-here ( -- p ) (m,4) 'chere' forth current executeable code dictionary ptr, between @{c0} and @{c-top}.=> c-fence ( -- p ) 'cfence' forth upper bound of non-alterable compile-space, 1st writable position.=> c0 ( -- p ) forth base address of codespace=> blk ( -- p ) (a:b) forth ptr to block number storeage double will fetch {blk} to l.s. cell, and {in}=> base ( -- p ) forth ptr to number conversion radix=> a-heap ( -- p ) 'aheap' hidden allocated, used memory heap linklist=> !fence ( -- | abort ) 'stofence' forth store current top values to {fence},{c-fence},{i-fence} variables backing up code-, compile- and auxilary compile-ptrs to c-here, thus restricted to be used while (non-intermediately!) executing. NOTE: {i-fence} stores 1st un-used index, following last unsed one.=> in ( -- p ) (fg) 'xin' fig >in ( -- p ) (a:c) 'xin' forth disp from start to parse area in input buf.=> #vocs ( -- n ) (f6) 'nvocs' forth cons, number of vocabulary ptrs in voc-stack, on top of two items volatile stack of context, ocontext. push by {also} is to lower addresses, two cells each.=> (vtim) ( -- p ) 'uiovtim' hidden lo.b: VTIME, hi.b VMAX byte values for stdin ioctl=> (vpal) ( -- p ) 'uvpalette' hidden program's video terminal mode, ptr to data structure=> (vbot) ( -- p ) hidden end of pre-defined user area, up := disp to uv.link in uv.up, { (vbot) tib tib-max + - 4/ } cells free for application defined user vari=> (uot) ( -- p ) 'ultab' hidden bottom of executeables pointers, all true addresses=> (ulink) ( -- p ) 'plinkp' hidden circular linklist to user vari & task reference. this is where <uref> points, jobs' UP = ebp.=> (type) ( -- p ) 'utype' hidden the basic operation for text output to stdout.=> (tick) ( -- p ) 'ptickp' hidden cpu timing cons, cps.=> (tib) ( -- p ) 'ptibp' hidden ptr to ptr to terminal input buf.=> (tattr-s) ( -- a ) 'ustattr' hidden initial terminal settings, true address of data structure=> (tattr) ( -- a ) 'utattr' hidden program's terminal settings, true address of data structure=> (tail) ( -- p ) 'ptailp' hidden backup ptr while compiling=> (stimo) ( -- p ) 'ustimo' hidden timout when waiting for input. nanoseconds setting at (p-4).=> (sp!) ( -- p ) xec vec 'ustosp' hidden=> (source-id) ( -- p ) 'psourceidp' hidden root of input source redirection linklist=> (source) ( -- p ) xec vec 'usource' hidden=> (sighnd) ( -- p ) 'sigh' linux base address of linux signal handlers, -re- {sighnd-size}=> (scanwl) ( -- p ) 'uscanwl' hidden wordlists searching 2nd-ary error handler=> (r) ( -- p ) (f6) 'uprp' hidden ptr to max 4 fill-up chars for formatted string output, for .r, u.r etc=> (quit) ( -- p ) 'uquit' hidden execution entry=> (pchr) ( -- p ) 'pchr' hidden dft: [32,126] & [128,255] ranges of printing chars=> (pause) ( -- p ) xec vec 'upause' hidden 0 or xec after timout to {wait4..} words elapsed, by true address.=> (path) ( -- p ) 'upath' hidden ptr to {path} string=> (padsz) ( -- p ) 'padsz' hidden disp from here to pad2, pad2 to pad, max+4 stg size for {word} {word} fetching long stg-s, <nul>-enclosed, if @(padsz) set to > 256.=> (outchp) ( -- p ) 'poutchpp' hidden stores latest used channels chp, of _any_ i/o call=> (ok) ( -- p ) 'upokb' hidden ptr to true execution ptr to kbd input prompt to re-define, for instance, enter { ' .s idx>xec 4th>abs (ok) ! }=> (oerr) ( -- p ) output error on write 'oerr' hidden=> (number) ( -- p ) xec vec 'unumber' hidden dft {f-number}/{a-number} according to preferred mode, re Makefile=> (m/mod) ( -- p ) xec vec 'upmbymp' hidden=> (lo>hi) ( -- p ) 'ulo2hi' hidden i/o chars, bytewise, lo mapped into hi, 0:no translation=> (lkindex) ( -- p ) 'plkindexp' hidden running ptr to word execution address indices (preserved in tasks!)=> (ix) ( -- p ) 'uprevix' compiler ptr to previously cpl'd uot index=> (iolink) ( -- p ) 'iolink' hidden i/o redirection link pointer, re "lib4th.mac", <pushiosrc> & <popiosrc>.=> (ioacc) ( -- p ) 'uioacc' hidden up to 4 accumulated input chars (for vt emu)=> (inchp) ( -- p ) 'pinchpp' hidden stores latest used channels chp, of _any_ i/o call=> (interpret[) ( -- p ) dft unset 'uinterpretb' hidden=> (interpret) ( -- p ) xec vec 'uinterpret' hidden=> (ierr) ( -- p ) input error code 'ierr' hidden=> (hi>lo) ( -- p ) 'uhi2lo' hidden i/o chars, bytewise, hi mapped into lo, 0:no translation=> (head) ( -- p ) 'pheadp' hidden xec entry ptr while compiling=> (fperm) ( -- p ) 'ufperm' hidden file permission bits for {open-file} etc, dft 600o=> (eval) ( -- p ) 'ueval' hidden ptr to true address of {evaluate}=> (escc) ( -- p ) 'uescc' hidden escape symbol for -re- {etype}=> (error) ( -- p ) 'uerror' hidden ptr to true address of error handler=> (eof) ( -- p ) eof character 'peofp' hidden=> (ekey?) ( -- p ) 'uekeyq' hidden basic character input=> (emit) ( -- p ) 'uemit' hidden {emit} xec vec.=> (dpl) ( -- p ) 'pdplp' forth decimal point location ptr=> (cp) ( -- p ) 'uprevcp' compiler ptr to previously valid code-ptr=> (compile) ( -- p ) xec vec 'ucompile' hidden=> (chans) ( -- p ) i/o channels redirection table 'pchansp' hidden=> (eol) ( -- p ) 'ueol' hidden up to 4 bytes for eol sequence, CR/LF, <nl> char(s)=> (cmc) ( -- p ) 'ucmc' hidden compiled words counter, for optimization support=> (cc4th) ( -- p ) (83) 'icc4th' hidden user vector, kref(ptr) to base of ctrl actions jump-table, else zero=> (can) ( -- p ) 'ucan' hidden lo-w:d_can exit code, hi-w:no. of sequential chars=d_can=> (buffer) ( -- P ) xec vec 'ubuffer' hidden=> (bootp) ( -- p ) 'ubootp' hidden ptr to executeable's data area, supplied sourcefile/data, etc=> (block) ( -- p ) xec vec 'ublock' hidden=> (bits) ( -- p ) 'bbitsb' hidden auxilary flagbits (subject to change, re file constants.inc): caps, mcaps 15 case dependent word search bbign,mbign 16 next numeric input is bignum (counted integer) branu,mranu 17 next numeric input is 'ranum', i.e. an ordered cells' pair, a 'real', rational number, "reelle zahl"... bqranu,mqranu 18 next numeric input is quad 'ranum' (quad cells' pair) bfloat,mfloat 19 set persistent numeric input mode to 'double ranum' bquadm,mquad 20 next numeric input is quad bcall,mcall 21 cpl direct calls by disp, instead of uot-indirect bfmac,mfmac 22 set if <bcmac> set and macro compiling word found bcmac,mcmac 23 compile 'macro' words as inlined code (n.i.) bedpl 24(l.s.b.), medpl 24..31(bits), edpl 3(byte) aux dpl for -ve exponent w. rational numbers input quad ranum received if mfloat,mranu,mquad all set and, medpl mask = $80. mdfloat mqranu|mranu|mquad single quad ranum mfloatm mfloat|mranu|mquad persistent, double ranum mode=> (aux) ( -- p ) 'pauxp' hidden i/o system flags=> (args) ( -- n ) 'args' hidden index to 1st in-active command line arg, after "--" -re- {(argc)}, {(argn)}, {(argp)}=> (argp) ( -- p ) hidden ptr to current argument -re- {(argc)}, {(argn)}, {(args)}=> (argn) ( -- p ) arguments count(er) 'argn' hidden -re- {(argc)}, {(args)}, {(argp)}=> (argc) ( -- p ) hidden program arguments cnt -re- {(args)}, {(argn)}, {(argp)}=> (accept) ( -- p ) 'uaccept' hidden ptr to true address of {accept}.=> (tib-max) ( -- u ) 'ptibmaxp' hidden max bytes of tib storage=> (]interpret) ( -- p ) dft unset 'ubinterpret' hidden=> ([debug]) ( -- p ) dft (compile) 'updebugp' hidden=> (?terminal) ( -- p ) xec vec 'uqterminal' hidden=> (?error) ( -- p ) 'uqerror' hidden ptr to true address of conditional error handler=> (>number) ( -- p ) 'utonum' hidden convert, default xec vec=> (#tib) ( -- p ) 'pntibp' hidden no. of chars in tib=> (#tab) ( -- p) 'pntabp' hidden <tab> spacing. (1 if set to zero)=> [number] ( p -- [dn|qn|cn] ff | 0. 1 ) (fg) 'bnumberb' fig number conversion of chars at ptr p, until <bl> or low code ctrl char. f.i.g.-4th mode, otherwise identical -re- {[number]} in forth voc.=> [number] ( p +u -- dn|qn|cn| f ) (a)(v) 'abnumberb' forth integer number conversion of up to +u chars at ptr p. ANS-style word. returns flag f = no. of remaining, unconverted chars in stg(p,u). ascii-numeric prefixed string terminated by ctrl chars or blank. stg may contain a base exponent mark, either the char corresponding to the rsp. @base figure as converted w/ {h>a} or, up to decimal base the char "e" or "E". the exponent |exp|<128 can be fetched w/ -re- {edpl@} and will automatically be taken into accont while in 'ranum' input mode. stg can be prefixed by char(s) for a specific base value, re {a-base}. valid quad, double and sing numbers include '-ve zero'. modifiers for numeric stgs w/ optional sign & base praefix: { big ..nn.. } for unlimited size counted integers -re- {nnumber}. { quad ..nn.. } quad cells integer. { sf ..nn.. } or, { \nn.. } praefix for rational number single cells ordered pair, { df ..nn..} or, { quad \..nn.. } next input is a double cells rational number, { \nn.. } quad int while in persistent f.p. mode -re- {flt}. { qf ..nn..} next input is a quad cells rational number. dpl settings, 'nn' no. of digits after frac. marker: 0xff80nnnn counted, umlimited size integer 0x000080nn quad integer 0x008000nn rational number ('ranum'), cells pair 0x008008nn float, double ranum by pair of doubles 0x008088nn eight cells, quad ranum by pair of quads -1 sing 000000nn any other +ve is a double edpl@ returns the optional, trailing exponent.=> substitute ( p1 u1 c1 c2 l1 l2 p2 u2 -- p3 u3 n | abort )(4)(x)(l) forth Recursive, multiply nestable string substitution/text translation. in: (p1,u1) source stg c1, c2 start-/end-dlm l1, l2 ptr to reference-/substitution-list (p2,u2) workspace, for result stg out: (p3,u3) stg result, in buffer(p2,u2) n count of substitutions abort if resolved stg doesn't fit in {place}, {+place} limits. Recursively extract stg within innermost delimiters(c1,c2) in stg(p1,u1), search list(l1) for extracted unique counted or <nul> terminated string and substitute with <nul>-enclosed stg at corresponding posn in list(l2). The empty stg can be simulated w/ "<bl><del>", in substitution list. store modified string to buf. (p2,u2), ret counted stg(p3,u3) and flag n := count of substitutions done or, n=0 and p3:=p1, u3:=u1 if no refs found. Abort if {place-size} or storage space u2 exceded.=> sslice ( p1 u1 p2 u2 p3 u3 -- p4 u4 p5 u5 ) (l) forth ret stg slice(p5,u5), enclosed by stg(p2,u2) and stg(p3,u3), remainder(p5,u5). sliced stg does not include the delimiters, remainder begins at end-delimiter, zero length stg-s may be passed for the rsp. stg bound, start or end. adjust slice w/ { u2 negate /string u3 + } to including the delimiting stg-s.=> sign ( n dn -- dn ) (fg) fig FIG mode - ANS-4th is different: ( n -- ) ! when in case-independent search mode and {forth} on top of voc-stack this variant takes precedence over ANS-style {sign}!=> SIGN ( n -- ) (a:c) 'asign' forth ANS word, linked to {forth} vocabulary, fig-4th is different: ( n dn -- dn )! fig-4th {sign} takes precedence when in case-independent search mode and fig on top of voc-stack.=> search ( p1 u1 p2 u2 -- p3 u3 flg ) (a:s) forth search u1 bytes beginning at p1 for string(p2,u2). ret p3 where string found and u3 remaining chars cnt w. true flag, else p3=p1, u3=u1 and false flag. - empty stg will always be found. -re- {csearch}, additionally checking terminating char.=> compare ( p1 u1 p2 u2 -- n ) (a:s) forth compare strings (p1,u1) and (p2,u2) by subtraction of character code in stg2 from char. code in stg1 at the rsp. position. assume stgs terminated by a <nul> byte, while comparing, for deriving the result. letter case dependency obeyed as set by lc-depend/ignore. return n: 1: s1>s2, -1: s1<s2, 0: s1=g2 i.e. difference of 1st different chars determine flag, else length.=> replace ( p1 u1 p2 u2 p3 u3 n p4 u4 -- p5 u5 f) forth replace one text in a string by another text. letter case dependency as previously set, temporarily being forced to case-dependency if source & replacement text would otherwise be equal. in: (p1,u1) source string; (p2,u2) text to replace by.. (p3,u3) ..replacement text; n operational mode flag (re below); (p4,u4) ptr p4 to buffer of size u4, stg and buffer space may be identical. out: (p5,u5) stg result - NOTE: not a "counted" stg! convert replaced to counted stg e.g. { drop over place }; f result flag (re below). n > 0 replace n-th occurrence of text(p2,u2) in stg(p1,u1) by text(p3,u3). n = 0 count text(p2,u2) occurrences, w/o any actual replacement. n = -ve replace any occurrence of text(p2,u2). f := n ret flg & counted stg(p5,u5), stored to buf(p4,u4). p5:=p4 and u5:=u4, f:=-1 if initially unsufficient buffer size; u5:=len, f:=-ve no. of replacements done, if next wouldn't fit; u5:=0, f:= 0 if stg(p1,u1) is empty (u1=0); u5:=u1, f:= 0 if stg(p2,u2) not found in stg(p1,u1); u5:=len, f:= n if replacement done.=> printing? ( p u -- f ) 'printingq' forth tf if stg(p,u) contains no other than printing chars, incl. <nl> or <tab>. u=0 returns true flg (nothing to print is considerd always 'printable'). using -re- {ekey>char} per stg bytes.=> number ( p | p u -- dn | abort ) (v) 'number' forth string to number conversion. - vectored by (number), re fig/ans words, actual xec mode dependent on ans/fig preference as set in "Makefile". default -re- {[number]} in {forth} voc.=> f-number ( p -- dn | abort ) (fg) 'fnumber' fig number ( p -- dn | abort ) 'fnumber' fig counted string to number conversion, f.i.g.-Forth mode. abort if leading char, after opt. prefices, not a currently valid digit. detailed spec. -re- {[number]} in {forth} voc.=> a-number ( p u -- dn | abort ) (a) 'anumber' ans NUMBER ( p u -- dn | abort ) 'anumber' ans counted string to number conversion. detailed spec. -re- {[number]} in {forth} voc.=> hold ( c -- ) forth prepend char c to numeric stg at @-{hld}=> h>a ( n -- c ) (h4) 'h2a' forth character representation c of byte n for any n within range 1 < @{base} < 198=> f-number ( p -- dn | abort ) (fg) 'fnumber' fig number ( p -- dn | abort ) 'fnumber' fig counted string to number conversion, f.i.g.-Forth mode. abort if leading char, after opt. prefices, not a currently valid digit. detailed spec. -re- {[number]} in {forth} voc.=> enum@ ( n p1 -- p2 u ) 'enumf' forth find string(p2,u) by number n in list of <nul>-terminated stg-s at p1. <nul> <nul> is list terminator. enum list constructor -re- {:slist} etc.=> enum# ( p1 u p2 -- n ) (4) 'enumn' forth item number n of string p1,u1 in list of asciz strings at p2. n := +ve item number if stg found, else n := -1. -re- {enum@} and, enum list constructor {:slist} etc.=> enum? ( p -- ) (4) 'enumq' forth display all asciz strings of list p, space delimited. exit w/ <esc> key, halt w/ <bl> and continue w/ any other key. -re- {enum#}, {enum@}, enum list constructor {:slist} etc.=> e\stg ( p1 u1 p2 -- p3 u3 ) 'estg' forth convert stg(p,u) w/ escaped tokens to stg(p3,u3) at buffer (p2). converted stg is never longer than source, thus buffer expected at least u1 chars of size, and not checked. p2 not in stg memory! the escape symbol is re-definable in uvari {(escc)}, dft "\", other chars may follow which receive special treatment: numeric: \nnn character code, octal numeric sequence as valid for a forth single integer, any other radix w/ the appropriate praefix. -re- {[number]}, for instance, s" hick\46" displays hick! s" hick\#33" does the same, w/ decimal code special symbols, letter case dependent: \a <bel> \b <bs> \c w/o trailing <lf> - suppressed, not applicable. \e <esc> \f <ff> \i <csi> \n <new line>, converted to ascii 10, the <lf> vt code. \r <cr> \t <ht> \v <vt> \- noop, e.g. to delimiting \nnn leading regular numeric chars. \\ double escape symbol, sending the escape symbol as a char.=> digit ( c -- n tf | c ff ) forth tf: c is a digit, n := numeric value corresponding to c ff: c not a digit, value remains un-changed base = 256 assumed and no conversion if { @base 256 mod } = 0 abiguous result if 256 > @base > 96=> cslice ( p1 u1 c1 c2 -- p2 u2 p3 u3 ) (4) forth stg slice by delimiting chars, return remaining stg(p2,u2) and slice(p3,u3). neither ret-stg includes the delimiters, remainder begins after end-delimiter, -ve character code may be passed for the rsp. stg bound, start or end. adjust slice w/ { -1 /string 1+ } to including the delimiting chars.=> csearch ( p1 u1 p2 u2 c -- p3 u3 flg ) (4) forth {search} in mem(p1,u1) by char c terminated trailing string(p2,u2). stg(p2,u2) at end of range(p1,u2) w/o delimiter ret 'found' if c=0.=> convert ( dn1 ptr1 -- dn2 ptr2 flg ) 'converta' forth ANS-Forth mode, in {ans} and {forth} vocabularies. CONVERT ( dn1 ptr1 -- dn2 ptr2 ) (a:cx) 'converta' ans interpret string at @ptr as number to radix @base. -re- {[number]}.=> convert ( dn1 ptr1 -- dn2 ptr2 flg ) (fg) fig fig-Forth mode, dft in {fig} vocabulary, only. -re- {>number}. interpret string at @ptr as number to radix @base until 1st non-valid char, leave accumulated double, ptr to after last valid char and flag. 1-s complement of flag is length of digits string found valid. flag result such that {convert} could be continued after having the terminating char analyzed and taken into account (i.e. flg:=flg+1).=> convert ( dn1 ptr1 -- dn2 ptr2 flg ) 'converta' forth ANS-Forth mode, in {ans} and {forth} vocabularies. CONVERT ( dn1 ptr1 -- dn2 ptr2 ) (a:cx) 'converta' ans interpret string at @ptr as number to radix @base. -re- {[number]}.=> compare ( p1 u1 p2 u2 -- n ) (a:s) forth compare strings (p1,u1) and (p2,u2) by subtraction of character code in stg2 from char. code in stg1 at the rsp. position. assume stgs terminated by a <nul> byte, while comparing, for deriving the result. letter case dependency obeyed as set by lc-depend/ignore. return n: 1: s1>s2, -1: s1<s2, 0: s1=g2 i.e. difference of 1st different chars determine flag, else length.=> cbytes ( c -- c u ) 'cbytes4' hidden ret count u of significant characters in cell-sized (32-bit) c.=> bslice ( p1 u1 n1 n2 -- p4 u4 p5 u5 ) forth get stg slice(p5,u5) and remainder(p4,u4) by char(byte) positions n1,n2. sliced stg includes both, the byte positions n1 and n2. ret ( p4 u4 p4+u4 0 ) if n1 not < n2.=> a-number ( p u -- dn | abort ) (a) 'anumber' ans NUMBER ( p u -- dn | abort ) 'anumber' ans counted string to number conversion. detailed spec. -re- {[number]} in {forth} voc.=> a-base ( ptr1 u1 -- ptr2 u2 n ) (f6) 'abase' forth extracts n "base" according to praefix, else current base, -re- {[number]}. (almost) any sequence of praefices will do: -ve: "{praefix}-nnn" and, w/ the same effect "-{praefix}nnn" (OTA-std permitting the above, only). e.g: "-\&2.3" double ranum -2.3 octal = -2,375 dec. n := lsw. (16-bit) corresponding radix value, sign flag in msw. valid prefices & corresponding radices: '%' 2 '§' 12 '!' 4 '$' 16 '@' 8 (OTA) '0x' 16, -ve w/ leading "-", only '&' 8 '"' 256 ascii, any chars except single "-. '#' 10 '^' char-64, convert to single ctrl code. '\' 2nd-ary praefix, fetching a double 'ranum' (cells pairs fraction) '\' quad integers modifier while in persistent ranum mode -re- {flt}. max-len +u adjusted according to praefix or, -ve for limit by 1st non-valid char. NOTE: '^' praefix for a single ctrl-code, by next upper-case char, only.=> 1/string ( p u -- p1 u1 ) (e) 's1string' forth cut 1st char (byte) off stg(p,u); short for { 1 /string }. (e: flags reflect length result)=> /string ( p u n -- p1 u1 ) (a:s)(e)(4) 'sstring' forth adjust string at p by +n and len u by -u, subtracts n from u @tos and adds n to p @nos, unless @tos < 0. +ve n truncates string(p,u) from beginning towards end, min. u1=0, -ve n extends string ptr p and length u beyond its beginning. (e: flags reflect length result)=> +blanks ( u1 u2 -- u1 p2 u2 ) 'pblanks' forth store count and u2:=min({pad-size}-1,max(0,u1-u2)) blanks to {here}, at p2-1, ready to {type}. {pad-size} redefinable w/ uvari (padsz), dft 256. interpreting: { s" hallo" ] 20 +blanks type [ type } right justified. -re- {pad-size}, {(padsz)} and, {bl.r} which jumps into {type}.=> -trailing ( p1 u1 -- p1 u2 ) (fg) 'mtrailing' forth cut trailing blanks and 'whitespace' off stg(p1,u1). 'whitespace' in this context is <tab>, <del>, <bs>. leading <bl> and ctrl-s can be discarded w. { blbl skip }.=> #enum ( p -- n ) (4) 'nenum' forth count n of stgs in <nul>-terminated list of asciz stgs p2. ambiguous result if n > 65535 or missing double <nul> terminator. -re- {enum#} and, enum list constructor {:slist} etc. e.g, unlimited count by substitute: { -1 swap zcount begin + swap 1+ swap count -dup 0= until drop }=> # ( d1 -- d2 ) 'sharp' forth divide d1 by {base}, convert remainder to character, append char to beginning of numeric output string.=> #s ( d1 -- 0. ) 'sharps' forth convert d1 to numeric characters at @-{hld}=> #> ( xd -- caddr u ) (m) 'sharpgt' forth finish numeric output string, ready to {type}=> <# ( -- ) 'ltsharp' forth init pictured number conversion, quad or sing (any size)=> >number ( dn1|qn1 ptr1 u1 -- dn2|qn2 ptr2 u2 ) (v)(m,6) 'tonumber' forth interpret string at @ptr as number to radix @base until 1st non-valid and no more than u1 char(s). leave remaining cnt and ptr. flag u2 := 0 if all chars converted. execute true address uot vector (>number), dft {[>number]}=> (ud.r) ( ud n -- p u ) (f6) 'puddotrp' hidden ret double d as unsigned double numeric stg(p,u) right aligned to n bytes field, ready to {type} pass 1-s complement of fieldwidth n to appending a trailing blank.=> (d.r) ( d n -- p u ) (f6) 'pddotrp' hidden ret double d as signed double numeric stg(p,u) right aligned to n bytes field, ready to {type} pass 1-s complement of fieldwidth n to appending a trailing blank.=> zprint ( p -- ) forth display <nul> terminated string=> ud.r ( ud n -- ) 'uddotr' forth unsigned double numeric output right aligned to n bytes field=> ud. ( ud -- ) 'uddot' forth unsigned double numeric output=> u.r ( u1 +u -- ) 'udotr' forth cnt and ptr to unsigned sing numeric output string right aligned to n bytes field, ready to {type}=> u? ( a -- ) 'uques' forth unsigned display content of cell at ptr a=> u. ( u -- ) 'udot' forth pictured unsigned sing numeric output=> type ( p +n -- ) (kd) forth send string (p,+n) to stdout. uvari vector {(type)}, which defaults to deferred {[type]}, initially set to xec {[etype]} and is-dft {[ctype]}. {out} updated according to printing chars, <nl> and <tab>. NOTE wrt windowing: NO orderly means to finding out about 'pending newline'! neither by console routines nor by vt-sequences, only feasible solution would be useing {emit} and counting the chars, within an application.=> tib-max ( -- u ) (f6)(m,7) 'tibmax' hidden max bytes of tib storage=> tib-dft ( -- p ) (m,8) 'tibdft' hidden default terminal input buffer for stdin input. below user area.=> tib>dft ( -- ) (m,10) 'tib2dft' root set terminal input buffer to default location -re- {tib-dft}.=> tib ( -- p ) (m,4) forth push ptr to terminal input buf. ANS-4th standard: tib is tib and is tIB wich is an Input Buffer, thus any question whether it might be written to is just stupid!=> stdin? ( -- flg ) (e)((s)) 'stdinq' forth test whether stdin readable, @tos := error code. does not affect stdin channel's handling state. NOTE: sys_access isn't always a reliable means for this purpose; a test w. sys_poll might provide more suitable information (e: Z if stdin readable)=> spaces ( +u -- ) forth -re- {type} +u blank spaces.=> space ( -- ) forth send a blank space to @{stdout}=> source ( -- a +u ) (v)(83) forth addr of current input buffer & count of available data. xec true address uot vector (source), dft {[source]}.=> s#. ( n -- ) 'sdecdot' forth pictured signed numeric decimal output=> print ( p -- ) (f6) forth display asciz or counted string=> out-cons? ( -- flg ) ((s)) 'outconsq' forth tf if stdout is console, set stdout-type flag in cdt, clear flag in uvari (aux) if not a console syscall ioctl -re- man 2 ...=> o-cr ( -- ) 'odcr' forth {cr} if output device is a console.=> key! ( n -- ) 'keysto' forth non-overwriting store char n back to std input charbuf, if input buf. empty, for later retrieval w. {key} etc.=> key? ( -- flg ) (a:fa) 'keyq' forth test pending input, don't wait tf if pending ascii char in terminal/standard input=> key ( -- c ) forth ascii range char, wait until received (from stdin) open console if <eof> -?-=> kbd-type ( p u -- ) (e) 'kbdtype' forth send a string to the keyboard channel use { kbd ch-rnum } for error code.=> kbd?key ( -- c1 flg ) 'kbdqkey' forth forcedly query the keyboard channel, -re- {?key}=> kbd-key ( -- c ) 'kbdkey' forth {key} forcedly from keyboard channel, -re- {key}=> kbd-emit ( c -- ) (e) 'kbdemit' forth {emit} to keyboard channel use { kbd ch-rnum } for error code.=> kbd! ( n -- ) 'kbdsto' forth non-overwriting store char n back to keyboard channel charbuf, if input buf. empty, for later retrieval w. {kbd-key} etc.=> io-cons? ( -- flg ) 'ioconsq' forth ret previously determined i/o handling state, tf if both, stdin and stdout connected to a console=> io-cons ( -- ) ((s)) 'siocons' forth determine stdin and stdout handling state flags. should be executed after any new i/o re-direction.=> in-cons? ( -- flg ) ((s)) 'inconsq' forth tf if stdin is console, set stdin-type flag in cdt, clear flag in uvari (aux) if not a console syscall ioctl -re- man 2 ...=> expect ( p +u1 -- ) forth fetch at most u1 chars input from stdin, or until <nl> store no. of received chars in user vari {span}.=> esc? ( -- flg ) (e) 'escq' forth tf if <esc> char input, if <bl> wait until other char NOTE: false flag if {kbd} is not a readable console channel. (e:flags reflect result)=> emit? ( -- flg ) (a:fx)((s)) 'emitq' forth return tf if non-blocking output available, by syscall <access>, ret true if stdout is writable. NOTE: sys_access isn't always a reliable means for this purpose; a zero length read/write test w. sys_read/write might provide more suitable information=> emit-m ( +u c -- ) (f6) 'emitm' forth {emit} +u characters c, 0 < +u < 32768, no-op if > 32767 char c may be up to 4 bytes, full size of a sing.=> emit ( c -- ) (e)(v) 'vemit' forth send single char to @{stdout} initially vectored to {[emit]}=> ekey? ( -- flg ) (a:fax)(v) 'ekeyq' forth test pending input, don't wait. xec uot vector (ekey?); by default vectored to {?terminal}: buf. 1st available char to stdin <cdt.ibuf> & return tf, else ff.=> ekey ( -- c ) forth return any char, wait until received (from stdin) re DPANS 10.4.1.1: char encoding as set for the rsp terminal/linux console.=> edlin ( p1 u1 -- p2 u2 ) (4) forth accept to buf(p1,u1), edit expanded default <nul>-terminated text at p1. cursor posn at dft text 2nd column, expand to eol w/ <end> or curs-down. passing buffer(p1,u1), ret stg(p2,u2) with received len u2 < u1.=> d.r ( d n -- ) (f6) 'ddotr' forth right aligned display signed double numeric output string pass 1-s complement of fieldwidth n to appending a trailing blank.=> d. ( d -- ) 'ddot' forth signed double numeric output=> cr ( -- ) forth send new-line command to @{stdout}=> cons? ( c -- flg ) (s) 'consq' forth tf if c is a console channel, reset iofl if not a console by test w/ syscall ioctl,TIOCGSID; re <toutcons>=> cc4th ( c -- c flg ) (83) forth vectored action on input ctrl chars in range of [0,31],127. checking whether char is ctrl code and corresponding vector set; ret char and tf if not ascii ctrl or if no vector defined, else ctrl-code and ff w. other stack results depending on ctrl action. leave <nul> w.o. action, transpose @tos <del> to vector for <nul> vector ( .yy. c c' -- .yy. .xx. c n ) must preserve char code @nos, @tos may be overwritten. can be de-activated by kref(zero) ptrs at either posn.=> can? ( -- flg ) 'canq' forth tf if consecutive w@(uv.ucan+2) times the char w@uv.ucan received defaults to four times <ctrl>Y = ascii 25. NOTE: false flag if stdin is not a console channel.=> accept ( p +u1 -- +u2 ) (GA) 'vaccept' forth fetch at most u1 chars input from stdin, or until <nl> execute true address uot vector (accept), dft -re- {[accept]}.=> b. ( n1 n2 -- ) 'bdot' forth display signed sing n1 at radix n2, valid radix in range 1 < n2 < 256, no error checking.=> .r ( n u -- ) 'dotr' forth right aligned display n in u chars field, filled up w/ blanks. pass 1-s complement of fieldwidth n to appending a trailing blank.=> . ( n -- ) 'dot' forth signed sing numeric output=> -cr ( flg -- ) (f6) 'dcr' forth {cr} if flg =/= 0=> ?terminal ( -- flg ) (s)(fg) 'qterminal' forth tf if char available from stdin channel, else ff pre-fetches avail char to stdin <cdt.ibuf>, if not already in buf. syscall read -re- man 2 ... stores ernum to uv.ierr and cdt.rnum: >0:(no of) char(s) received 0:no input (VMIN=0), <eof> -9:invalid file descriptor (ebadf) -11:no input (VMIN>0) - (eagain) {?terminal} is default to vectored {ekey?}=> ?key ( -- c1 flg ) (83) 'qkey' forth ascii range char c1 and tf, else invalid c1 and ff remove char from input queue=> ?input ( ch -- flg ) (s)(fg) 'qinput' forth input from supplied channel, otherwise identical -re- {?terminal}=> ?ekey ( -- c flg ) 'qekey' forth return any char c1 and tf, else invalid c1 and ff, don't wait tests pending input & copies currently available char to tos. does{ ekey? IF ibuf c@ ELSE false ENDIF dup 0=/= }=> ? ( a -- ) 'ques' forth signed display content of cell at ptr a=> $. ( n -- ) 'hexdot' forth pictured unsigned numeric sedecimal output=> #tib ( -- u ) (83)(m,7) 'ntib' forth received no. of bytes in tib storage - f83 eq. to {span}=> #. ( n -- ) 'decdot' forth pictured unsigned numeric decimal output=> &. ( n -- ) 'octdot' forth pictured unsigned numeric octal output=> %. ( n -- ) 'bindot' forth pictured unsigned numeric binary output=> vcells+ ccc( n -- )(X: n1 -- n2 ) -n.i.- 'vcellsp' forth defining a "value" which increments @tos n1 by n cells.=> variable ccc( -- p )(C: -- ) (a:c) forth create named ptr to a cell of reserved dataspace (ANS: initiated to zero) execution of name ccc leaves same ptr as { ' ccc >body }.=> value ccc( -- n )(C: n -- ) (a:cx) forth self fetching variable, w/ -re- {to}, {+to}, {=:} alterable cons. value of ccc stored to dataspace and alterable at { ' ccc >body }. {value}s can be altered with {to} and {+to}, which also affects already compiled words. fetching and storeing a {value} is usually faster than the rsp opr on a {variable}.=> val+ ccc( n -- )(X: n1 -- n2 ) 'valp' forth defining a "value" which increments @tos n1 by n.=> -> ccc( n -- ) (i)(p4) 'tov' ans to ccc( n -- ) (i)(a:cx)(a:l) 'tov' forth store new number to a {value} - equivalent: { ' name >body ! }. also substitutes {!} to {variable}s or {defer}red words. values storeing with { to name } is a (tiny) bit faster than with { [ ... ] literal ! } and by about 10% faster than { vari-name ! }. (this would have been much simpler with just a compile-flag if ANSI didn't (decide differently, due to whatever reason -if any- re DPANS, A.6.2.2295.=> -> ccc( n -- ) (i)(p4) 'tov' ans to ccc( n -- ) (i)(a:cx)(a:l) 'tov' forth store new number to a {value} - equivalent: { ' name >body ! }. also substitutes {!} to {variable}s or {defer}red words. values storeing with { to name } is a (tiny) bit faster than with { [ ... ] literal ! } and by about 10% faster than { vari-name ! }. (this would have been much simpler with just a compile-flag if ANSI didn't (decide differently, due to whatever reason -if any- re DPANS, A.6.2.2295.=> is-default ccc( ix -- ) (4)(i) 'isdefault' forth store default action to deferred word use{ ' action is-default deferred-word }=> is@ ( ix -- ix1 ix2 | abort-26 ) (i) 'isf' forth fetch default ix1 and xec token x2 of a deferred word.=> is? ccc( -- ix ) (i) 'isq' forth fetch xec token which the deferred word ccc will execute=> is ccc( -- | abort-26 ) (4)(i) forth check and store an execution token to deferred word. use{ ' name is deferred-word }, for the default opr -re- {is-default}. use{ ['] name is deferred-word } while ANS-mode compiling. {>body} and {to} may be used, instead, which do no error checking.=> integer ccc( -- n )(C: n -- ) (h4)((i)) forth non-alterable sing cons, IMMEDIATEly compiling a literal. literal value can be altered with {to}, {+to}, before compiling, e.g. to determining a constant at compiletime from program data. modification does NOT affect already compiled {integer}s. can substitute { create , } but, would also declare ccc 'immediate'!=> head ccc( -- ) hidden {align} data-space to multiple of cellsize, store data-stack ptr to {csp} - re {ds-pick}, build a word header at {here}, linked to {current} wordlist, leave header 'smudged', not ready to {find}. NOTE: {head} implements semantics like fig-forth "create". [idx|flg][macflg][link][cnt+name][data...] - [items] 4-aligned. ^ifa^ffa ^-mfa ^-lfa ^-nfa ^-pfa initial flg=smud, macflg=0, pfa={ here cell - } >body returns pfa+4, pfa is storage of executeable words' xec-ptr.=> deferred? ( ix -- f ) (4) 'dferdq' forth tf if word the xec token of which is ix is linked to the deferred words chain.=> defer ccc(C: -- )(X: ..xx.. -- ..x.. )(ix) forth execute word the uot index or true xec-address of which is stored in data body. at runtime reverts to default action if defined word not in valid memory range. null ptr de-activates the deferred word and does not revert to default action. compiles an initial {forget>} which removes the word from the {defer-lk} chain, additional forget-handlers may be assigned, which execute prior to the default. xec de-activated if ix = 0 or (fastest) { 0 4th>abs } at data body. {defer}red words linked to {defer-lk}: defer-lk dup @ + -> ptr to last link <lastlink> dup @ + -> ptr to previous link, <zero> at end of chain=> default-is ccc( -- ) (4)(i) 'defaultis' forth restore a deferrred words default action use{ default-is deferred-word }=> create ccc( -- p )(C: -- ) (w) forth xec: word ccc leaves ptr to {here} in dataspace at definition time which is the same ptr which {>body} would return, one cell after the word's pfa. cpl: build by name executeable word header, linked to @{current} wordlist. compiles literal ptr to after <pfa> & <ret> to {c-here}, 7 bytes in codespace. data arranged such that { ' ccc idx>pfa @ } equals { ' ccc idx>xec }=> constant ( -- n )(C: n -- ) (a:c) forth defines a named, non-alterable sing numeric literal.=> cons+ ccc( n -- )(X: n1 -- n2 ) ((i)) 'consp' forth defining a constant which increments @tos by non-alterable literal n. {cons+} compiles an IMMEDIATE word which compiles a literal increment.=> code ccc( -- )(C: -- ) (a:tx) forth cpl: begin named lo-level definition which, initially is not <ret> terminated and does not set-up nor leave any control data in the compile-stack. word ccc can be found immediately after creation by {code} and, should be orderly continued and terminated before return to the interpreter. xec: W-register <ecx>, [kref ecx] = pfa+cell = >body of word ccc T-register <edx>, [kref edx] = code entry (a fairly useless word, just to complying ANS-4th setup and, not tested!)=> build ( p -- ) hidden build a word header at {here}, linked to {current} wordlist. pass ptr p to subroutine for fetching a valid name which should move the name stg to build-time {here} and leave that ptr and true flag on tos - entry to {head} w/o error handling. {build} in contrary to {head} does neither, {align} nor {!csp}.=> alias ccc( ix -- ) tools defines a synonymous word, ccc, executing xec token ix. no code, header only: 28 + 4-aligned (namelength+1) bytes in data-space. NOTE: {alias}ed words conflict w/ {forget} and {:forget}.=> 4variable ( -- p )(C: -- ) (a:c) 'qvari' forth create named ptr to quad cell of reserved dataspace (ANS: initiated to zero)=> 2variable ( -- p )(C: -- ) (a:c) 'twovari' forth create named ptr to double cell of reserved dataspace (ANS: initiated to zero)=> 2value ccc( -- n )(C: n -- ) 'value2' forth double, alterable cons. value of ccc stored to dataspace and alterable at { ' ccc >body 2! }. altered {2value}s also affect already compiled words.=> 2to ccc( dn -- ) (i) 'to2' forth store double to a {2value} does{ ' name >body 2! } w/o error checks!=> 4integer ccc( -- dn )(C: dn -- ) (h4)((i)) 'integer4' forth immediate, quad constant, which executes/compiles a -re- {4literal}. value can be altered e.g. w/ { ' name >body 4! }, before compiling.=> 2integer ccc( -- dn )(C: dn -- ) (h4)((i)) 'integer2' forth immediate, non-alterable double cons, which executes a 2literal. value can be altered e.g. w/ { ' name >body 2! }, before compiling.=> 4constant ( -- qn )(C: qn -- ) (a:d) 'qconstant' forth non-alterable cons quad value, compiled to codespace.=> 2constant ( -- dn )(C: dn -- ) (a:d) 'twocons' forth non-alterable const double value, compiled to codespace.=> ?deferred ( ix -- | error-26 ) 'qdferd' forth=> =: ccc( -- n )(C: n -- ) (h4)(p4) 'valdef' forth store n to previously defined {value} or {integer} if found in current search order. otherwise, in interpreting state, define a new, alterable -re- {value}.=> +> ccc( n -- ) (i)(p4) 'pltov' ans +to ccc( n -- ) (i)(a:cx) 'pltov' forth add n to a {value}, equivalent to { ' name >body +! }. can substitute {+!} to a {variable}, by about 10% faster. defines new {value} if in interpreting state and ccc unknown.=> +> ccc( n -- ) (i)(p4) 'pltov' ans +to ccc( n -- ) (i)(a:cx) 'pltov' forth add n to a {value}, equivalent to { ' name >body +! }. can substitute {+!} to a {variable}, by about 10% faster. defines new {value} if in interpreting state and ccc unknown.=> UNLOOP ( -- ) (i)(a:c)(wc) ans discard loop parameters, i.e. limit and index on RS. requires {exit}ting before next LOOP or explicit branch to after the LOOP disp.=> while - re {if} - (i) forth Forth (lib4th, etc) mode of operation: conditionally, if tf, continue execution until next {while}, {repeat} or {until}, else terminate loop and continue after. multiple {while}s in a begin/until or begin/repeat structure resolved at end of loop, w/o additional words and, terminate the loop execution as soon as one {while} part not entered. {while} cannot point to beyond the end of a {begin}...-loop! -re- {WHILE} in ans voc.=> WHILE - re {if} - (i) 'whilea' ans ANS-4th mode of operation: conditionally, if tf, continue execution until next {while}, {repeat} or {until}, else terminate loop and continue after. resolve excess {while}s in a begin/until or begin/repeat structure by an equal number of additional {else}/{then}, after loop end.=> until (C: .. p1 f1 -- .. pm fm )(X: flg -- )(i) forth {until} resolves {begin} and as many {while}s as used after the corresponding {begin}. -re- ans {WHILE} for ANS-style resolution. optimizing { 0= until } overwrites cpl-d {0=}, compiles {-branch}.=> endif (C: p f -- )(X: -- ) (i) forth THEN synonym to {endif} 'endif' ans terminates { if .. else .. endif } decision.=> repeat (C: pn fn .. p f -- pm fm )( -- )(i) forth unconditionally branch back to after {begin}. {repat} resolves {begin} and as many {while}s as used after the corresponding {begin}. -re- ans {WHILE} for ANS-style resolution.=> recurse ( -- ) (i)(a:c) forth recursion may minimize programming effort but, is slow and resources wasting. one exception is "tail recursion", which lib4th compiles as a branch. cannot be used with headerless words; should not be used in a {does>} part. recursive execution of run-time part in a defining word should be set up separately to circumventing re-execution of the #defining# word. example: : (lit>!) 1- dup 1 < if drop 1 1 else dup recurse endif dup * ; : lit>! create , does> @ (lit>!) ; 10 lit>! 10! 10! . tail recursion: : tt dup 0> if dup . endif 1- recurse ; see tt ( ">;" notifies the JMP instr. to latest word, "tt" )=> OF ( n1 n2 -- | n1 )(C: -- p f ) (i) ans if n1 = n2 drop both and enter code after {of}, continue until {endof} and branch to after {endcase} if n1 =/= n2 drop n2 and continue after next {endof} substitutes { over = if drop .... }=> loop (C: p f -- )(X: -- ) (i) 'xloop' forth increment loop counter by one, terminate { do .. loop } if counter = limit.=> leave (i) 'xleave' forth NOTE: fig-4th mode of operation, i.e. actually leaving a DO..LOOP structure is delayed till next {loop} execution. use{ DO ..words1.. condition IF ..words2.. LEAVE ..words3.. \ executes words2 and(!) words3 ELSE ..words4.. ENDIF ..words5.. LOOP } wherein {words5} will be executed, whether leaving or not.=> leave (i) 'xleave' forth NOTE: fig-4th mode of operation, i.e. actually leaving a DO..LOOP structure is delayed till next {loop} execution. use{ DO ..words1.. condition IF ..words2.. LEAVE ..words3.. \ executes words2 and(!) words3 ELSE ..words4.. ENDIF ..words5.. LOOP } wherein {words5} will be executed, whether leaving or not.=> if ( n -- ) (i) forth if n =/= 0 enter code immediately following {if} else branch forward to next {else} or {endif}, rsp. {if} immediately followed by {else} compiled as {0if}.=> entry (C: p1 f1 p2 f2 -- p2 f2 )(X: -- )(i) 'ntry' forth entrypoint from branch into a BEGIN.. or IF.. construct via {enter}.=> enter (C: -- p1 f1 )(X: -- ) (i) 'nter' forth unconditionally branch forward into a structure, to eliminating the inner unconditional branch in { .. begin ... while ... repeat } to a single one on entry, instead. { .. enter begin ... entry ... until }=> ENDOF (k)=> endif; (C: p f -- )(X: -- ) (i) 'endifs' forth substitutes { ... exit endif }. saves the {exit} code.=> endif (C: p f -- )(X: -- ) (i) forth THEN synonym to {endif} 'endif' ans terminates { if .. else .. endif } decision.=> ENDCASE ( n1 -- )(C: p'1 f1 ... p'n fn -- )(i) ans terminate and resolve a {case} structure. compiles a {drop} of the comarison item and, executes as many {endif}s as {OF}s were encountered, after the latest initiating {CASE}.=> else; (C: p f -- )(X: -- ) (i) 'elses' forth substitutes { ... exit else ... }, saves {exit} and eliminates the unconditional branch to after {endif}.=> else (C: p1 f1 -- p2 f2 )(X: -- ) (i) forth begins alternate part of {if .. else .. endif } decision. immediately after {if} compiles {0if}, in 2nd(+) level cpl-ing mode.=> do (C: -- p f )(X: n1 n2 -- )(R: -- n1' n2' ) (i) forth C: f:"dudu" p:c-here X: push loop limit and start to tor and enter LOOP structure, if n1 = n2 adjust n1 := n1+1 to looping once, only=> noop ( -- ) (fg)(m,1) forth most efficiently do nothing, hi-level call immediately returns, macro inserts a <nop> operation.=> CASE ( n -- n )(C: -- f f ) (i) ans CASE-group is nothing overly useful, just a simplification to writing a sequence of cascaded IF/ELSE decisions, required by DPANS 6.2.0873: { n1 CASE n2 OF ..true.. ENDOF n3 OF ..n3-true.. ENDOF .. ENDCASE } -re- {case:} in forth-voc. for a more efficient 'substitute'...=> begin ( -- )(C: -- p f ) (i) forth enter a loop structure, terminated by {again}, {repeat} or {until}.=> again (C: p f -- )( -- ) (i) forth unconditionally branch back to after {begin}.=> 0if (i) 'nif' hidden substitutes { 0= if }, used in {-enter}=> -leave (X: flg -- ) (i) 'dleave' fig leave if non-zero flag - fig-4th mode! use{ DO ..words1.. condition -LEAVE ..words2.. LOOP } wherein {words2} will be executed, whether leaving or not.=> -enter (C: -- p f )(X: flg -- ) (i) 'mnter' forth conditionally, if true flg, branch forward to after {entry} else continue execution immediately after {-enter}. for instance: { .. .nn. -dup -enter .. enter begin .. entry .. entry ... until } | false `----->--------' | `->--true------>-----------------' {enter} and {-entry} may multiply be nested around a single {begin}.=> +loop ( n -- ) (i) 'ploop' forth increment loop counter by n, branch back to after {do}/{?do} if n > 0: counter unsigned less than limit, n < 0: counter unsigned greater than limit. n = 0: forcedly increments by one, procedes as n > 0.=> ?do ( n1 n2 -- )(R: -- n1' n2' ) (i)(83) 'qdo' forth enter a LOOP structure if n1 =/= n2, else continue after it's end compiles { (?do) [+disp] ... (loop?) [-disp] } which compiles the aequivalent to { 2dup = if do .. loop else 2drop endif }=> ?case ( n1 n2 -- n1 | ) (i)(k6) 'qcase' forth does{ over = if drop }, resolved with {else}/{endif}. use{ nn ..words.. n1 ?case ..words.. else n2 ?case ... endif endif }=> z" ccc( -- p u ) (i) 'zqte' forth unlimited length asciz string literal, p := {pad2} when interpreting stg length actually limited by {word} which truncates after 255 bytes, use {szliteral} to compiling longer asciz string literals: { [ stg1 count pad place stg2 count pad +place pad count ] szliteral ... } -re- {cstg} for counted and {stg} string 'value's.=> to-stg ccc( p1 u1 -- ) (i) 'stgs' forth store stg(p1,u1) into string variable ccc. abort by -re- {place} if cpld {stg} or {cstg} limit exceded. get stg limit w/ { ' stgdefn >body @ }. -re- {+to-stg}, {c+stg}, {cstg} counted and {stg} string 'value's.=> szliteral (C: p u -- )(X: -- a u) (i)(a:s) forth compile an asciz unlimited length string into a colon definition -re- {cstg} for counted and {stg} string 'value's.=> szlit, ( p u -- ) 'szlitc' forth allot u+2 bytes and store <nul> delimited string(p,u) to here.=> sliteral (C: p u -- )(X: -- a u) (i)(a:s) forth compile a string passed into a colon definition, u may be any size. -re- {stg} for counted or <nul>-enclosed string 'value's, -re- {szliteral}, {cstg} for string literals and 'value's.=> slit, ( p u -- ) 'slitc' forth allot u+2 bytes and store counted string(p,u) to here. always <nul> terminated, whether counted or asciz stg. -re-{szlit,}=> string c ccc( -- p u ) (i) 'stng' forth by char c delimited counted string ccc literal, p:={pad2} when interpreting. use{ string <char> <text><char> } e.g. { string ! hallo! type } displays <hallo>. -re- {cstg} for counted and {stg} string 'value's.=> stg ccc( p u n -- )(X: -- p u ) (4) 'stg4' forth define a string value w/ at most n characters of storage space. -re- {to-stg}, {c+stg}, {+to-stg} to modifying an {stg} string value.=> sf ( -- ) (i)(fs) 'sing' root next numeric input will be taken as a SINGLE RATIONAL NUMBER. set 'ranum'-flag in uvari (bits) for numeric stg input -re- {rational}. flag can accumulate for quad ranum input w/ -re- {quad}. reset immediately after next literal number or, at eol.=> s" ccc( -- p u ) (i) 'sqte' forth counted string literal, p := {pad2} when interpreting -re- {cstg} for counted and {stg} string 'value's. dpans: 6.1.2165, 11.6.1.2165=> df ( -- ) (i)(fs) 'ranum' root next numeric input will be taken as a DOUBLE RATIONAL NUMBER. set 'ranum'-flag in uvari (bits) for numeric stg input -re- {rational}. flag can accumulate for quad ranum input w/ -re- {quad}. reset immediately after next literal number or, at eol.=> quad ( -- ) (i)(f6) root next numeric input will be taken as a quad integer or a double 'ranum'. set quad-flag in uvari (bits) for numeric stg input, the flag can accumulate w/ -re- {ranum} or "\" number input praefix. reset immediately after next literal number or, at eol.=> [compile] ccc( -- ) (i) 'bcb' forth POSTPONE ccc( -- ) (i) 'bcb' ans [_] ccc( -- ) (i)(h4) 'bcb' root suppress immediacy of next word <ccc> in input stream or, compile non-immediate word to being compiled at runtime. ([compile], postpone and, [_] execute all the same code)=> o( ccc( -- ) (i) 'ocommentp' root dependent on type of output device print or silently discard a comment.=> literal (C: x1 -- )(X: -- x1 ) (i) forth cpl: compile sing as a literal, interp: noop=> forget, ( ix1 ix2 -- ) 'fgcomma' forth allocate linkage field and link hnd ix2 for word ix1 into forget-lk chain. -re- {:forget}, {forget}, {sforget}.=> forget> ccc( -- ) (i) 'forgetgt' forth to be placed before {does>} and after {create} in a definig word, to setting up a link to the chained word-specific forget handlers. At execution the word being defined will be assigned the word ccc to, which,in turn, will be executed immediatly before the newly compiled word is to be removed by {forget}. -re- {:forget}, {sforget}. compiles a preliminary structure, 3 cells, the last of which contains the execution token ix of the handler word. example: : defn ..words1.. create ..words2.. forget> noop does> ..words3.. ;=> 2LITERAL (C: f1 -- )(X: -- f1 ) (i) 'adliteral' ans cpl: compile float item (double cell) as a literal, interp: noop ANS mode, reversed (big endian) cells order.=> end-code 'endcode' assembler terminates assembly sequence, after ;code, in interpreting state=> does@> ( -- )(C: s1 -- s1 )(X: -- p ) (i) 'fdoesgt' forth substitutes { does> @ }, for cons etc.=> does> ( -- )(C: s1 -- s1 )(X: -- p ) (i) 'doesgt' forth terminates defining part compilation of defining word, compiles (;code) ;S, continues defining hi-level runtime procedure. defining word will not be found until after terminating {;}. the {does>} part of a word can be provided by a separate definition. NOTE: implemented such that it does not permit multiple {does>} in a single defn - which may be enabled w/ <__mdoes>, re lib4th Makefiles.=> qf ( -- ) (i)(fs) 'double' root next numeric input will be taken as a QUAD RATIONAL NUMBER.=> 2literal (C: d1 -- )(X: -- d1 ) (i) 'dliteral' forth cpl: compile double as a literal, interp: noop=> cstg ccc( p u n -- )(X: -- p ) (4) 'cstg4' forth define a counted string value w/ at most n characters of storage space. -re- {to-stg}, {c+stg}, {+to-stg} to modifying a {cstg} string value.=> [CHAR] ccc(C: -- )(X: -- c ) (i) 'char' ans compile leading char of next word in input stream as a literal ascii ccc(C: -- )(X: -- c ) (i) 'char' forth dependent on @{state} compile or... -re- {CHAR} in ans-voc. CHAR ccc(C: -- )(X: -- c ) ans fetch to stack the 1st char of next word in input stream as a literal. control chars can be fetched if (upper case) char prefixed w/ "^".=> cdepth ( -- n ) compiler no. of -double- items in compilestack, valid only after {!csp} or {:}.=> c+stg ccc( c f -- ) (i) 'cstgps' forth append (f>0) or prepend (f<0) multi-byte char(c) to 'string-value' ccc. -re- {+to-stg}, {to-stg}, {cstg} counted and {stg} string-value s.=> c" ccc( -- p ) (i)(a:ce) 'qte' forth counted string literal, p := {pad2} when interpreting -re- {cstg} for counted and {stg} string 'value's.=> big ( -- ) (i)(l4) root next numeric input will be taken as a counted integer. set bignum-flag in uvari (bits) for numeric stg input, flag reset immediately after next literal number or, at eol.=> [CHAR] ccc(C: -- )(X: -- c ) (i) 'char' ans compile leading char of next word in input stream as a literal ascii ccc(C: -- )(X: -- c ) (i) 'char' forth dependent on @{state} compile or... -re- {CHAR} in ans-voc. CHAR ccc(C: -- )(X: -- c ) ans fetch to stack the 1st char of next word in input stream as a literal. control chars can be fetched if (upper case) char prefixed w/ "^".=> abort" ccc( f -- ) (i)(4) 'abtqte' forth if f = 0 continue, else send <"> delimited message stg ccc and {abort}.=> 4literal (C: q1 -- )(X: -- q1 ) (i) 'qliteral' forth cpl: compile quad (four cells) as a literal, interp: noop=> 2literal (C: d1 -- )(X: -- d1 ) (i) 'dliteral' forth cpl: compile double as a literal, interp: noop=> +to-stg ccc( p1 u1 -- ) (i) 'stgps' forth append stg(p1,u1) to string 'value' ccc. abort by -re- {place} if compiled {stg}-vari limit exceded. get stg limit w/ { ' stgdefn >body @ }. -re- {c+stg}, {to-stg}, {cstg} counted and {stg} string 'value's.=> ['] ccc(C: -- )( -- ix ) (i) 'tick' ans compile execution index of word ccc as a literal ' ccc(C: -- )(X: -- ix ) (i) 'tick' forth find execution token of word ccc and return a literal, else abort=> ;CODE ( s1 -- ) (a:tx)(ix)(4) 'scode' ans resolve colon definition w/o terminating code - i.e. no <ret>urn.=> " ccc( -- p ) (i) 'qte' forth counted string literal, p := {pad2} when interpreting; synonym {c"}=> ['] ccc(C: -- )( -- ix ) (i) 'tick' ans compile execution index of word ccc as a literal ' ccc(C: -- )(X: -- ix ) (i) 'tick' forth find execution token of word ccc and return a literal, else abort=> ' ccc( -- ix ) (a:c) 'atick' ans find execution token of word ccc, else abort ANS-4th version, non-immediate.=> ." ccc( -- ) (i)(4) 'dotquote' forth display counted string literal compiling: stores 4th-string to {c-here} execution: displays 4th-string from [IP]+ interpreting: copies 4th-string to {pad2}+=> (;code@) 'pscodefp' assembler cpl'd by {does@>}; appends runtime semantics to current defining word.=> (;code) 'pscodep' assembler cpl'd by {does>}; appends runtime semantics to current defining word. NOTE: definitions using a such created word cannot compile access by uot and thus should reside in the same binary module.=> .\ ccc( -- ) (i) 'dotbslash' root display comment till e.o.l.=> .( ccc( -- ) (i) 'commentp' root display multiple lines spanning comment till matching ")"=> ( ccc( -- ) (i) 'paren' root (* ccc( -- ) (i) 'paren' root discard multiple lines spanning comment till matching ")" dpans: 6.1.0080, 11.6.1.0080=> ( ccc( -- ) (i) 'paren' root (* ccc( -- ) (i) 'paren' root discard multiple lines spanning comment till matching ")" dpans: 6.1.0080, 11.6.1.0080=> <with ccc( -- ) (f6)(n.i.) 'ltwith' forth n.i, name reserved to implementing inheritance of words' defining rules.=> :forget ccc( -- ) (ix) 'colforget' forth initiates a header-less word, linked to the {forget-lk} chain, which will be executed before {forget} removes the word ccc. the handling word receives ix of the word to {forget} @tos and @nos and, should not modify the @nos item nor drop any item from stack; except, a word can be protected by returning @nos cell set to zero. additional data left on stack will be discarded, internally.=> \\ ccc( -- ) 'quit' forth comment till eof, exits loadfile (to next lower nesting level) quit ( .xx. -- .xx. ) (R: .xx. -- ) (C: .xx. -- ) (v) root the outer interpreter, dft xec {[quit]}.=> \ ccc( -- ) (i) 'bslash' root comment till e.o.l.=> [CHAR] ccc(C: -- )(X: -- c ) (i) 'char' ans compile leading char of next word in input stream as a literal ascii ccc(C: -- )(X: -- c ) (i) 'char' forth dependent on @{state} compile or... -re- {CHAR} in ans-voc. CHAR ccc(C: -- )(X: -- c ) ans fetch to stack the 1st char of next word in input stream as a literal. control chars can be fetched if (upper case) char prefixed w/ "^".=> [compile] ccc( -- ) (i) 'bcb' forth POSTPONE ccc( -- ) (i) 'bcb' ans [_] ccc( -- ) (i)(h4) 'bcb' root suppress immediacy of next word <ccc> in input stream or, compile non-immediate word to being compiled at runtime. ([compile], postpone and, [_] execute all the same code)=> [compile] ccc( -- ) (i) 'bcb' forth POSTPONE ccc( -- ) (i) 'bcb' ans [_] ccc( -- ) (i)(h4) 'bcb' root suppress immediacy of next word <ccc> in input stream or, compile non-immediate word to being compiled at runtime. ([compile], postpone and, [_] execute all the same code)=> ; ( -- )(S: s1 [ s2 ] -- |abort ) (i) 'semi' forth terminates a colon definition. modifies last <call> to <jmp> to preventing call+ret sequence, which is disabled after a structure's end-ptr or, {cmc-off}. leaves final <ret> in place, for safe return from compiler.=> (code) (4) 'pcodep' assembler terminates a colon definition, returns to interpreting state. -?-=> range: (k)=> is-case ccc( n1 n2 -- ) (4)(i) 'iscase' forth store list item n1 to list w/ name ccc at posn by index n2 data type flag at 1st cell of data body, over-all list bytes size stored at 2nd cell of data body, -re- {cases,}. forcing to numeric type: { -1 ' listname >body c! } testing whether an index fits into list: { ( caseindex ) 4* casehead-size + ' listname >body 4+ @ 4- > } which returns tf if index was out of range. list entries follow at {casehead-size} bytes disp to data body. modifying a list entry: { ( new-entry caseindex ) 4* casehead-size + ' listname >body + ! }=> case: xec: ( caseindex -- xx ) (i)(f6)(h4) 'caseco' forth cpl: cc1 cc2 ... ; ( -- ) while compiling def: name cc1 cc2... ; ( -- ) while interpreting initiate a case decision by index list of executeables or numeric data: cpl: compile typed list of xec tokens or sing numeric values. list may span multiple lines w/ words separated by {bl}s, only, and may be interleved w/ {\ ...} comment lines. def: compile named word for later execution by name, procede as above. xec: check range and according to type, push indexed value or execute. Executeable type list is a 'jump table' of xt-s, by ix or true address, numeric type returns the rsp. entry corresponding to the supplied index. state dependently built as a named word or, compiled into a forth word. valid range: -1 < caseindex < no. of items, at list execution out of range indices will be fetching from rsp bounds. (rather hypothetical) max. no. of list items is 2^31-3. A numeric type list will be compiled if any one list item was not found as a forth word in current search order, but could be converted to some numeric value, compiling it's least significant cell, any excess data silently discarding. That list returns the rsp. xec token (uot index) in any case an executeable word was specified. case:-indices 'clipped' to actually useable bounds: : ?: 1+ case: dotrue dofalse dotrue ; ; executes <dofalse> on zero, else <dotrue>, on any other index. defining a list compiles each non-immediate item w/ -re- {cases,} until 1st {;} which terminates the list, from input stream; executes other immediates - which should not leave more than one cell on data-stack. while compiling compiles a {case:} list into the current word: ..words.. case: case1name case2name .. lastcasename ; ..words.. while interpreting builds the by <listname> executeable {case:} list: case: listname case1name case2name .. lastcasename ; execution: xec indexed compiled word or, push indexed value to data-stack. -ve index refers to 1st, +ve beyond last refers to last item. modifying a list -re- {is-case}=> cases, ccc..( -- p ) (f6) 'casesc' hidden initiate and build a 'cnum'-list, from uot indices ('xec tokens') or numeric values as found in current search order, from input stream, cpl list items into data-space until {;}, xec other immediates. ret ptr to list header. multiple lines spanning lists should only use the <bl> delimiter. preceded w/ a header field of top case-index and list type: [ list-type flags][ listsize bytes ][ 1st item ] .. [ last ] all entries of cell-size, <listsize> inclusive header cells. l.s.b. flags =/= 0 is numeric type, remaining space reseved. list structure subject to change, -re- {casehead-size}, {case:}.=> casehead-size ( -- n ) 'caseheadsz' hidden size in bytes of a {case:}-list header -re- <inc/l4struc.inc>=> associative: xec: ( n1 -- n2 ) (f6) 'assocc' forth def: cc1 cc2 ... ; ( -- ) while compiling def: name cc1 cc2... ; ( -- ) while interpreting return list index n2 of found value n1, else top index+1. list structure and compiling rules as numeric type -re- {case:}, {case,}.=> #cases ( ix -- n ) 'ncases' forth no of items in a {case:} list; also for {range:} and {associative:}.=> #case ( -- n ) 'ncase' forth if 1st in a compiled word, case:-index by which the word was called. (can be used to reading the <edx> register content)=> (kc (X: -- p ) (k) 'pdocasec' novoc kernel deferred -re- {(dc}=> (is ( p -- ) 'dois' novoc=> (ic (k)=> (dr ( n1 p -- n2 ) (f6) 'dorangec' novoc=> (di ( pp -- ) 'dfi' novoc=> (dd ( pp -- ) 'ddi' novoc=> (dc ( ix p -- xx ) (f6) 'docasec' novoc according to list type fetch or execute by ix indexed cell=>=> (ch ( -- p ) (f6) 'ccasec' novoc build named list for {associative:}, {case:}, {range:}=> cpl? ( -- flg ) (e) 'cplq' root returns true if caller is in permanently compiling state (e: NZ if cpl)=> slist" ccc( -- ) (4) 'slistqte' forth fetch by char {"} enclosed stg ccc and cpl to data-space for ref/subst-list overwrites {pad2} if executed in interpreting mode. -re- {:slist}.=> slist; ( -- ) (4) 'slistsemi' forth terminate addressable list of stg-s. -re- {:slist}.=> slist, (C: p u -- ) (4) 'slistc' forth cpl <nul>-"counted" stg w/o trailing <nul>, add stg(p,u) to ref/subst list. overwrites {pad2} if executed in interpreting mode. -re- {:slist}.=> slist c ccc( -- ) (4) 'slists' forth fetch by char c enclosed stg ccc and cpl to data-space for ref/subst-list. overwrites {pad2} if executed in interpreting mode. -re- {:slist}.=> :slist ccc( -- )(X: -- p ) (4) 'colslist' forth initiate a reference/substitution list for {enum@}, {enum#}, {substitute}. constitute a list of strings w/ -re- {slist"}, {slist}, {slist,}, {slist;}. -re- {#enum} no. of strings in a list, {enum#} find, {enum@} fetch a string.=> paligned- ( x -- x ) (m,) 'palignm' linux truncate true address/value @tos to memory page bounds=> paligned ( x -- x ) 'palignp' linux align-up true address/value @tos to memory page bounds=> naligned ( a1 +u -- a2 ) forth adjust true address/value a2 to lowest multiple of +u greater or equal a1 abort if +u is not a power of 2.=> l-allot ( n -- | abort ) 'lallot' forth allocate +/- b bytes in local memory, abort if out of memory=> allot ( n -- | abort ) forth allocate +/- b bytes in dataspace, abort-12 if out of memory. if required, try allocating memory from host system -re- {?resize}.=> aligned ( x1 -- x2 ) (a:c)(m,) forth adjust x2 to lowest multiple of cellsize greater or equal x1=> align ( -- ) (a) 'xalign' forth adjust dataspace ptr to multiple of cellsize (four 8-bit bytes), greater or equal {here}.=> w, ( n -- ) 'wcomma' forth allocate next half-cell in dataspace and store l.s. 16 bits of n. abort-12 if unsufficient memory=> c, ( c -- ) 'ccomma' forth allocate and store c to next char in dataspace (currently, char=8-bit byte). abort-12 if unsufficient memory=> b, ( n -- ) 'bcomma' forth allocate and store l.s.b. of n to next (8-bit-)byte in dataspace. abort-12 if unsufficient memory=> , ( n -- ) 'comma' forth allocate next cell in dataspace and store n (cell=32-bit 'dword'). abort-12 if unsufficient memory=> mark ( -- ptr ) (79) forth push current {c-here} for later resolution of back reference=> drop;s ( n -- ) (m,)(k) 'drops' hidden {drop} and {;s}=> csp@ ( -- p ) 'cspf' hidden fetch kref'd compilestack ptr to tos (e: eflags remain unchanged)=> compile, ( ix -- ) (a:cx) 'compilec' forth cpl subroutine call by execution token ix: call [uref disp], w. disp=ix*4+uv.ultab-(uv.link) saves cp prior to cpl to (prevcp) and ix to (previx), for [interpret] &c.=> compile ( -- | abort-27 ) forth at runtime compiles next compiled word, abort-17 if not compiling. don't use in macro cpl mode: {compile} is not an immediate word and thus cannot catch any errors which might result from false opcodes. re {compile,} for compiling by execution token (ix, uot index).=> cnalign ( n -- | abort-3) forth align codeptr to nearest greater or equal multiple of n, abort if n not a power of 2.=> cmc-off ( -- ) (i) 'cmcoff' root disable "optimization", i.e. end-of-word <call> to <jmp> conversion until next new entry into compile state. use { ... [ cmc off ] ... } to disabling for next word, only, and to re-enabling common optimization features after disabling.=> cfalign ( -- ) forth adjust ptr to codespace to lowest multiple of f.p.-item size (double cell) greater or equal {c-here}.=> calign ( -- ) forth adjust ptr to codespace to lowest multiple of cellsize greater or equal {c-here}.=> c-allot ( n -- | abort ) 'callot' forth allocate +/- b bytes in compilespace, alignment remaining unchanged. abort-12 if out of memory - which might abort due to a segfault, anyway...=> back ( ptr -- ) 'back' forth cpl back reference at {c-here}, append <ret>.=> ahead ( -- ptr ) (a:te) forth push current {c-here}, reserve cell in code-space for branch disp, append <ret>.=> >resolve ( ptr -- ) (79) 'toresolve' forth resolve forward branch from ptr to {c-here}=> !csp ( -- ) (m,12) 'scsp' forth store datastack ptr to uvari csp. executed by {head} and {:noname}, thus by all named defining words.=> @csp ( -- ) (f6) 'fcsp' hidden restore datastack ptr from saved in {csp} compilestack ptr (e: eflags remain unchanged)=> :noname (C: -- ix s ) 'noname' forth introducing a headerless word, leaves uot index after terminating {;}. {:noname} definitions occupy an uot item but no header-space. stores initial SP to {csp} for fig-compatible handling and {;code}. use{ :noname ... ; : word .. [ 0 cs-pick ] [,] ... ; drop }=> : ccc( -- s1 ) 'colon' forth begin named hi-level definition, linked to {current} wordlist, {smudge}d. ANS mode: leaves s1 = ptr-s to codespace and datastack on datastack! for fig-compatible handling and {;code}, stores initial SP to {csp}.=> ;s ( -- )(R: a -- ) (m,1) 'semis' forth immediately leave current & return to calling word at true address a. (e: no flags affected, pop RS & ret)=> ;r ( -- )(R: a -- ) (i) 'semir' forth modified {;} for adaptive return address adjustment, required for non-immediate or postponed immediate words which compile more than 4 bytes into code-space. cpl'd runtime code of -re- {[;]} and {;}.=> :r ( -- )(R: a -- a' ) (i) 'colonr' forth may be cpl'd initially, introducing a non-immediate compiling word which adjusts codespace for safe return to before newly cpl'd code. cpl's the runtime code -re- {[:]}.=> exit ( -- )(R: a -- ) (i) 'exitf' forth immediately leave current word & return to caller. compiles local values de-allocation and apropriate return opr. modifies last <call & ret> sequence to jmp into last word, dependent on content of {(cmc)} vari and {nopt} header-flag. interpretive compiling locals de-allocation left to {;}. -re- conditional {-exit}, {else;}, {endif;}=> [,] ( ix | ix s1 -- | abort ) (i) 'bcompilecb' root {[,]} takes uot index from tos or from below colon compiler structure=> ]] ( -- ) 'rrbrac' compiler for structures start, instead of {]}. should be used for any construct designed to before teminating the currently defined word permitting an intermediately interpreting sequence. use{ ]] start .. [ .. (interpreting) .. ] .. end [[ }.=> ] ( -- ) 'rbrac' forth enter compiling state. increment compile-state level by one, clear intermediately interpreting state.=> 4, ( n -- ) 'cpl4' forth compile dword n, append <ret> code, advance cp by 4 allocate next cell in code-space and store n=> 2, ( n -- ) 'cpl2' forth compile l.s. word of n, append <ret> code, advance cp 2 allocate next 2 bytes in code-space and store l.s. 16 bits of n=> 1, ( n -- ) 'cpl1' forth compile l.s.byte of n, append <ret> code, advance cp by 1 allocate next byte in code-space and store l.s.byte of n=> -0exit ( flg -- ) (i) 'dzexit' forth cpl/execute conditional {exit} to exitting a word if flg = 0.=> -exit ( flg -- ) (i) 'dexit' forth cpl/execute conditional {exit}, to exitting a word if flg =/= 0.=> -compile, ( ix -- ) 'mcompilec' forth compile call to ix if in compiling state, else execute.=> -compile ccc( -- ) 'mcompile' forth compile call to ccc if in compiling state, else execute.=> word ( c -- ) (4)((x)) 'xword' fig scan input source for text sequence enclosed by chars c, max len 255. fig version, returns counted stg to {here}, where it may be modified.=> word ( c -- p ) (4)(a:c)(x) 'XWORD' forth scan input source for max 255 chars of text sequence enclosed by chars c. returns ptr p to 4th-strg. a blank, not included in length, follows the string. programs may replace characters within the string. this is the ANS-style {word}=> wvoc ( p1 -- p2 ) 'wvoc' util find bottom lfa p2 of wordlist which the word pointed to by lfa p1 is in. get/verify RAM linkage w. { ( p1 ) wvoc lfa>idx idx>wid wid>lfa }.=> voc. ( p -- ) 'vocdot' util display name of wordlist which word pointed to by lfa p is in.=> v ccc( -- ) (4) 'vau' root independently of search order, display which wordlist ccc belongs to, display "-?-" if word doesn't exist.=> wvoc-r ( p1 -- p2 ) 'wvocr' util find 2ndary lfa p2 of wordlist which the word pointed to by lfa p1 is in.=> uc-unmap ( -- ) (e)(s) 'uclu' linux separate upper and lower case chars mapping of input to (work) channel store true error code to (oerr). -re- {uc-map} syscall ioctl -re- man 2 ...=> uc-map ( -- ) (e)(s) 'uclm' linux map upper case to lower case chars of input to (work) channel. re {uc-unmap}=> skip ( p u c -- p' u' ) (83) forth skip leading chars = c of length u string at ptr p, ret posn p' of 1st char =/= c and remaining cnt u'. ret p':= p+u, u':=0 if no other chars than c in the entire string. scan string length u string at ptr p for 1st occurrence of char =/= c. specific handling of <bl> including low ctrl-s if c = 0000<bl><bl>=> ss ( -- ) 'ss4' root required for shell script execution, after {#! /path/executeable}: copy stdin, stdout, stderr to {in-chan}, {out-chan}, {err-chan}, fetch next space delimited argument/string and execute {included}. while executing the scriptfile itself is source to {stdin}, PIPEd or redirected i/o channels can then be referred w/ the copied id-s. use {include}, instead, to omitting the i/o channels setup. optional words may be inserted between path to lib4th executable and {ss} - or {include} - being executed before script execution starts. the entire line, after path to f8 but including the {ss} word, becomes 1st argument passed to the application: #! /usr/local/bin/f8 { optional words } ss (text of 4th script follows)=> sforget ( p u xt -- flg ) (l) hidden forget words defined after and including word w. name of string (p,u) in range (last in kernel) < @ifence < ix(p,u) < min(xt,@(lkindex)). if (p,u) is a voc replace occurrences in voc-stack with {local}-wid - which is short (i.e. fastly searched) and, neutral because forcedly searched 1st, anyway. {context} will be restored from {ocontext}, if possible, else both set to {forth}. flg: -1 success, 1 search-order changed, 0 not found 21 {fence}d, 23 kernel/non-writable memory. NOTE: unsafe if local values exist in the chain of words to forget. which applies to locals assigned while interpreting or, those which may be left at error abortion while defining a word.=> selected ccc( .xx. -- .xx. ) (d)(i) forth pass {words} selective output selection word. - preliminary - An example, selecting {words} output by a text segment: defer (t) \ a string, used in (r) defer (w) \ ( lfa -- flg ) selection s" *" dup stg s ' s is (t) : (r) lfa>nfa count (t) search -rot 2drop ; ' (r) is (w) : sel begin dup 0= -exit dup (w) -exit dup @ - dup @ 0= until ; selected sel forth words \ show words with "*" in their names forth words \ next will be listing all words...=> scanwlist ( n1 p1 -- n2 n3 ) hidden common routine to scanning vocabulary stack expects xec-ptr p1 of working routine w. stack flow ( n1 toplfa -- n1 0 | n2 n3 ) after {locals} wordlist, searching in stacked lists order, toplfa from vocstack and, if no success, lastly from {root}, ret n2 as determined by routine p1, n3 flag according to result. scanning terminates early if supplied routine returns non-zero. last opr if no success is {perform}ing user-vari (scanwl).=> scanvocs ( n1 xt -- n2 ) (e) hidden common routine to scanning vocabulary linkage, latest to 1st. expects xec token (uot index) xt of a working routine w. stack flow ( n1 wid lfa lfa -- exit: nn xxx xxx 0 or -- next word: nn wid lfa 0=/= or -- next voc.: nn xxx 0 0=/= ) scanning terminates if supplied routine returns zero or all vocs done. (eflags reflect state of n2)=> scan ( p u c -- p' u' ) (83) forth scan string length u string at ptr p for 1st occurrence of char = c, ret posn p' of 1st char = c and remaining cnt u'. ret u' = 0 and ptr to after stg if dlm not found. skip leading chars =/= c of length u string at ptr p specific handling of <bl> including low ctrl-s if c = 0000<bl><bl> (e: flags reflect value of u)=> rskip ( p u c -- p' u' ) (83) forth skip trailing chars = c of length u string at ptr p, ret posn p' of 1st char =/= c and remaining cnt u'. scan string length u string at ptr p for 1st occurrence of char =/= c. specific handling of <bl> including low ctrl-s if c = 0000<bl><bl>=> rscan ( p u c -- p' u' ) (83) forth reverse scan stg(p,u) for last occurrence of char c, ret posn p' of last char = c and remaining cnt u'. ret u' := 0 and ptr to after stg, p' = p+u, if dlm not found. ret u' = 0 and ptr to stg p' = p if dlm not found. skip trailing chars =/= c off stg(p,u). specific handling of <bl> including low ctrl-s if c = 0000<bl><bl>=> refill ( -- flg ) (a:c)(e) forth dependent on input mode, -re- {source-id}, fetch next group of input data to current input buf. ret tf, else ret ff if no input available. if @blk > 0 (blockflile access) and not eof next buffer becomes {tib}. (e:flags reflect flg result) dpans: 11.6.2.2125=> query ( -- ) forth fetch at most {#tib}-1 chars, or until <nl>, from stdin to {tib}. returns if either of eol <nl> or {#tib 1-} chars received. store no. of received chars in user vari {span}. store 0 to #in and >in=> perform ( p -- ..xx.. ) forth execute by ptr to uot index, drop & do nothing if p = 0 or @p = 0. ptr p is the ptr to index field (ifa) of a word header or any other variable the l.s.w of which contains an execution token (uot index). example: { ' name sp@ perform }. NOTE: because lib4th vectors may be de-activated by ptr to 0 {perform} cannot execute a call to {root} by uot index.=> parsec ( p1 u1 c -- p1 u2 ) (X) forth push length of char c or <nul> terminated string, up to +u chars parsed from address p1, @in not modified if c=<bl> find any delimiter <bl> or ctrl-code 0..31=> parse ( c -- p u ) ((x)) forth ret ptr p to before next occurrence of char c in current input buf. after disp of {in@}, adjust {in} by +u. if c=<bl> find any delimiter <bl> or ctrl-code 0..31=> marker ccc( -- ) (a:cx)(4) forth defining: save stacked search-order, current, fence values, latest. execution: forget till marker, discard new, rst saved system state. NOTE: {fence} values stored after the rsp marker was defined won't protect against implied forget by the marker word. use -re- {empty} to {forget}ting everything after {fence}s.=> marker ccc( -- ) (a:cx)(4) forth defining: save stacked search-order, current, fence values, latest. execution: forget till marker, discard new, rst saved system state. NOTE: {fence} values stored after the rsp marker was defined won't protect against implied forget by the marker word. use -re- {empty} to {forget}ting everything after {fence}s.=> lcase@ ( -- n ) 'lcasef' forth LCASE@ ( -- n ) 'LCASEF' forth fetch letter-case flag, zero if case-dependency set. -re- {caps?} e.g, use{ lcase@ lc-ignore ..words.. lcase@ 0= if lc-depend endif }=> lcase@ ( -- n ) 'lcasef' forth LCASE@ ( -- n ) 'LCASEF' forth fetch letter-case flag, zero if case-dependency set. -re- {caps?} e.g, use{ lcase@ lc-ignore ..words.. lcase@ 0= if lc-depend endif }=> lc-depend ( -- ) (m,7) 'lcdepend' forth case dependent search and string comparison mode - default state. If case independent search mode enabled 1st match takes precedence, which for L4 kernel applies to lower case version. -re- {lc-ignore}.=> lc-ignore ( -- ) (m,7) 'lcignore' root LC-IGNORE ( -- ) (m,7) 'LCIGNORE' root force case in-dependent search and string comparison. -re- {lc-depend}.=> lc-ignore ( -- ) (m,7) 'lcignore' root LC-IGNORE ( -- ) (m,7) 'LCIGNORE' root force case in-dependent search and string comparison. -re- {lc-depend}.=> interpret[ ( ix f -- ix f ) 'interb' compiler execute if non-zero, true address or xec token in uot vector (interpret[). 1st action, called from <[interpret]> immediately after {find}.=> interpret (v) forth execute true address uot vector (interpret), default is <[interpret]>.=> iforget ( ix -- flg ) hidden forget words defined after and including word by execution token ix in range (last in kernel) < @ifence <= ix < @(lkindex). if ix is a voc replace occurences in voc-stack and current with {local}-wid. header-less words can only be removed in code-space, no data-ref exists. flg: -1 success, 1 search-order changed, 0 not found 21 {fence}d, 23 kernel/non-writable memory.=> id. ( n -- ) (4) 'iddot' forth display name of word by n uot index ("execution token") or lfa. imed words displayed at reversed video.=> forget ccc( -- ) (a:t) forth remove words defined after and including word w. name {ccc} and {allot}ted data from dictionary, i.e. code- and data-space, including and running through all vocabularies (orderly defined, i.e. not just "wordlists"). noop if word not found, fenced or in non-alterable memory. special cases error handling can be achieved w/ -re- {sforget}. see also -re- {empty}, {:forget}, {forget>}, {marker}.=> find ( p -- p 0 | ix 1 | ix -1 ) (e)(4)(a:c) forth find uot index from string at p searching the stacked search order. values returned by FIND while compiling or interpreting may differ. {local} searched 1st, unconditionally, {root} last if not in search order. for wordlist specific search -re- {(find)}, {search-wordlist}. NOTE: the single one word in dpans94(6.1.1550) which expects a '4th-string'! letter case dependency: dft {lc-ignore} and {uc-unmap} mode, true chars case independently, which can be modified by {lc-depend} case dependent {lc-ignore} case independent {uc-map} input mapping upper to lower chars {uc-unmap} input upper and lower chars=> execute ( ix | a -- ..xx.. ) forth execute 4th word by +ve uot index or, by true address a. noop if zero or kref'd zero or, if address not in regular program memory. {execute} can be used by index or by true execution address: { -find name IF lfa>idx execute ENDIF } or, { c" name" find IF execute ENDIF } or, { (ok) @ execute }. or, by ptr from <pfa> in word header if uot entry = 0. asm: <eax> if = ix converted to address, no (other) regs changed.=> -execute ( p flg -- ) 'dexecute' forth -re- {execute} p if flg =/= 0, else drop p and flg=> evaluate ( p +u -- ..xx.. ) (a:c)(v) forth interpret string at p of length +u; dft -re- {[eval]} save/restore {source-id}, execute true address uot vector (eval).=> enclose ( p u c -- p n1 n2 n3 ) 'enclose4' forth separate by char c enclosed text in max. u chars at ptr p+ ret n1 disp to 1st char =/= c, n2 next char = c, n3 next char ans stg then { drop over - rot rot + swap }; w/ char = byte.=> enclose ( p c -- p n1 n2 n3 ) fig separate by char c enclosed text in max. {#tib} chars at ptr p+ ret n1 disp to 1st char =/= c, n2 next char = c, n3 next char ans stg then { drop over - rot rot + swap }=> empty ( -- ) forth forget all above {fence}d ptrs. NOTE: current state of program code & data can be saved w/ -re- {fence!}=> caps? ( -- flg ) 'capsq' forth CAPS? ( -- flg ) 'capsq' forth tf if text comparison is case dependently, for {find}, {compare}, etc=> c[ ( -- ) 'clbrac' root decrement compile-state level by one, leave state flags unchanged. at zero level of state execute until then compiled code. use{ ]] start .. ] ..next level cpl.. c[ .. end [[ }.=> -find ccc( -- p flg) (e)(4)(fg) 'dfind' forth find word w. name string <ccc> in the stacked search order, if found ret lfa and flg := 1 if word is immedate, else -1. ret ptr p to counted string <ccc> and flag 0, if not found. (e: result flag status)=> ]interpret ( p u -- p u ) 'binter' compiler execute if non-zero, true address or xec token in uot vector (]interpret). last action, called from <[interpret]> if neither, a word nor a number found.=> [scanvocs] ( n1 p2 -- n2 ) 'bscanvb' hidden as -re- {scanvocs} but, w/ p2 execution ptr instead of ix.=> [interpret] ( -- ) (k) 'binterpretb' hidden default 'outer interpreter' loop ('inner interpreter' is the cpu). reads word at ptr a1, pre-compiles exec token (uot index) or literal. executes -re- {interpret[} immediately after initial {find}, and -re- {]interpret} if the token was neither a word nor a number.=> [find] ( p u -- p flg ) (l) 'bfindb' forth -re- {find} by stg(p,u)=> [debug] ( flg ix -- flg ix ) 'bdebugb' compiler executed before compiling any non-immediate words. initially a noop. if non-zero execute true address or xec token from uot vector ([debug]). then store current cp and ix @nos to uvari (prevcp) and (previx). debugging routine receives previous ix in ECX reg, current ix is @nos; items on stack may be modified to any appropriate (valid!) value.=> [[ ( -- ) (i) 'llbrac' compiler for structures termination, instead of {[}, re {]]}.=> [ ( -- ) (i) 'lbrac' root decrement compile-state level by one, if non-zero @state set interpreting state to intermediate, else execute until then compiled code. cannot be used as a structures terminator - re {[[} !=> #! ( -- ) 'hb' root enable shell script execution. requires {ss} at end of top line: #! /forth-executeable ..optional args.. ss note that {#!} requires at least one trailing space (blank, tab). {#!} introduces a comment, as -re- {\}, such that an executeable script alternatively can be {included} as a hi-level source file.=> xec>uot ( x -- p ) 'xec2uot' hidden return uot ptr p to execution ptr x, ret 0 if x not in uot=> xec>lfa ( x -- p | 0 ) 'xec2lfa' hidden search uot for x, return lfa ptr p, corresponding to uot index. scan all vocabularies, independently of actual search order.=> xec>idx ( x -- ix | -1 ) (cm,36) 'xec2idx' hidden return uot index of execution ptr x, else -1 (exec ptr is to library code, not to got of user program!=> wid>idx ( wid -- ix | -1 ) 'wid2idx' hidden convert wordlist identifier to vocabulary name's index check { ix (lkindex) @ u< } whether ix is valid.=> wid>top ( p1 -- p2 ) (m,6) 'wid2top' hidden fetch top lfa p2 of vocabulary wordlist from @voclink p1=> wid>lfa ( p1 -- p2 ) (m,6) 'wid2lfa' hidden find primary lfa of vocabulary wordlist=> uot>idx ( p -- ix ) (p)(m,13) 'uot2idx' hidden get word index ix by uot execution ptr p. actually valid range of ix is 0 to @(lkindex)-1, absolute max is { (#tib) (ltab) - 4/ }, always less than 65535.=> uds>idx ( n -- ix ) (p)(m,9) 'uds2idx' hidden return ix index into uot from compiled disp n wrt uot base ptr.=> pfa>lfa ( p1 -- p2 | 0 ) (cm,47) 'pfa2lfa' hidden convert wordheader parameterfield ptr to linkfield ptr ret 0 if no corresponding lfa found.=> nfa>lfa ( n1 -- n2 ) (c)(m,3) 'nfa2lfa' forth convert wordheader namefield ptr to linkfield ptr=> loc' ccc(C: -- )( -- ix ) (i) 'tick' local imed. get xt of a local name ccc, else abort-38 err.ni compiletime utility, ix invalid after word defn finished.=> loc-ptr ccc(C: -- )(X: -- p ) (i) 'locptr' forth get literal ptr to runtime data-space of a local value=> loc-body ccc(C: -- )(X: -- p ) (i) 'locbody' local ccc(I: -- p ) find ptr to "body" of word ccc in {local} wordlist, return/compile literal ptr p. compiletime utility, ix invalid after word defn finished.=> lfa>xec ( p -- x | 0 ) 'lfa2xec' hidden return execution ptr x from uot pointed to by wordheader via lfa p=> lfa>wid ( p1 -- p2 | 0 ) 'lfa2wid' hidden convert p1 lfa to ptr p2 to voclink posn=> lfa>pfa ( n1 -- n2 ) (m,14) 'lfa2pfa' forth convert wordheader linkfield ptr to parameterfield ptr=> lfa>nfa ( n1 -- n2 ) (c)(m,3) 'lfa2nfa' forth convert wordheader linkfield ptr to namefield ptr=> lfa>mfa ( n1 -- n2 ) (c)(m,3) 'lfa2mfa' hidden convert wordheader linkfield ptr to macrofield ptr=> lfa>idx ( n1 -- n2 ) (m,3) 'lfa2idx' forth convert wordheader linkfield ptr to uot index=> lfa>ifa ( n1 -- n2 ) (c)(m,3) 'lfa2ifa' hidden convert wordheader linkfield ptr to indexfield ptr=> lfa>head ( n1 -- n2 ) (c)(m,3) 'lfa2head' forth convert wordheader linkfield ptr to indexfield ptr=> lfa>ffa ( n1 -- n2 ) (c)(m,3) 'lfa2ffa' hidden convert wordheader linkfield ptr to compile-flags field ptr=> lfa>body ( lfa -- p ) 'lfa2body' hidden convert lfa ptr to ptr to words' data space=> ifa>lfa ( n1 -- n2 ) (c)(m,3) 'ifa2lfa' hidden convert wordheader linkfield ptr to indexfield ptr=> idx>xec ( ix -- x | 0 ) 'idx2xec' hidden return executionptr from uot by word index ix. (debugging: x is equal to code-ptr in assembly listing)=> idx>wid ( ix -- wid | 0 ) 'idx2wid' hidden convert vocabulary name's index to wordlist identifier=> idx>uot ( ix -- p | 0 ) (p)(m,18) 'idx2uot' hidden return ptr p to execution ptr by index ix, ret 0 if ix not in uot=> idx>uds ( ix -- p ) (p)(m,7) 'idx2uds' hidden return disp to base of uot for indirect call [uref uv.ultab+disp].=> idx>pfa ( ix -- p | 0 ) 'idx2pfa' hidden convert uot index ix (execution token) to pfa p=> idx>lfa ( ix -- lfa | 0 ) (cm,37) 'idx2lfa' root convert word index to linkfield ptr scan all {voc-link}ed wordlists, independently of actual search order.=> idx>do ( ix -- x | 0 ) 'idx2do' hidden DOES>-entry of word by ix or, zero if not applicable.=> body>lfa ( p1 -- p2 | 0 ) 'body2lfa' hidden ret lfa p2 correspondig to the rsp. ptr p1 from {>body}.=> >data ( ix -- p ) (l4) 'todata' root ref into re-located data-field in RAM of kernel-supplied variables, etc; aequivalent to -re- {>body}, applicable to kernel words, only. NOTE: kernel words store disp into data-space wrt @{d0} while new, {create}d words store the disp to "body" directly as a kref'd ptr.=> >body ( ix -- p ) (a:c) 'tobody' root ANS defines this to fetch the reference where "," etc. would store wrt a -re- {create}d word which, with lib4th is data-memory and does not apply to kernel defined words' relocated alterable memory address -re- {>data}.=> dsp>xec ( p1 -- p2 ) (p)(m,9) 'dsp2xec' hidden return xec ptr p2 from dword disp at ptr p1.=> r+ ( -- n ) (f6)(m,) 'rplus' hidden ! while compiling and, for 2nd level compiling words, only ! fetch n from code-space and advance beyond cell where next level return-ptr points to; i.e. pass an execution token - or other data - to next level word. does{ r> r> dup cell+ >r swap >r @ } e.g, to passing different execution tokens to a generalized frame-word: : frame ..words.. r+ execute ..words.. ; : caller ... frame [ ' .s 4, ] ... ; then, {caller} will execute {frame} with the tick-ed {.s} in between.=> qlit ( -- qn ) hidden fetch quad from compilespace=> flit ( -- df ) hidden fetch double from compilespace=> dlit ( -- dn ) hidden fetch double from compilespace=> lit ( -- n ) (m,6) hidden fetch cell from compilespace=> nlit ( -- .xx. N ) hidden compiled by {nliteral}, fetch bignum from compilespace=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> [quit] ( .xx. -- .xx. ) (R: .xx. -- ) (C: .xx. -- ) 'bquitb' hidden the outer interpreter (dft to {quit}): setup kernel ref, enable interrupts, store zero to {blk}, {id} and {state}, store {btail} to {cp}, clear return-stack, enter interpreting loop, w. data-stack bounds check.=> [squit] ( .xx. -- )(R: .xx. -- ) 'bsquitb' hidden entry from abortion by SEGV signal handler=> [ok] ( -- ) (79) 'bokb' hidden kbd input prompt: ">" while interpreting, "=" compiling. true xec address by dft stored to (ok).=> [eval] ( p +u -- ..xx.. ) 'bevalb' hidden execute command or fetch number or send error. may be nested to any no. of levels, limited by available memory. saves/restores {blk},{in},{span},{stdin},{tib} on return-stack using p and +u, temporarily stored to locally assigned {tib} and {span}. initial vector for -re- {evaluate}.=> [error] ( n -- p u, --> quit ) 'berrb' hidden {error} vector default: rst RP, KR, tib; display (+n)error or (-n)system message; enter {quit}. leave tib+@in and @blk on stack, valid prior to error.=> [etype] ( p +u -- ) (l) 'btypeb' hidden {[type]} string(p,u) to stdout w/ by -re- {e\stg} converted escaped tokens. silently return if -ve, zero or > 64K stg length. error code readable immediately after, from -re- {ch-rnum}, {(oerr)}. numeric token: \nnn character code, numeric sequence as valid for a forth single integer at octal radix, any other w/ the appropriate praefix. for instance s" hick\46" displays hick! s" hick\#33" does the same special symbols, letter case dependent: \a <bel> \b <bs> \c w/o trailing <lf> - suppressed, not applicable \e <esc> \f <ff> \n <new line>, Linux: <lf> \r <cr> \t <ht> \v <vt> \\ double escape symbol, sending the escape symbol as a char. \other character following the escape symbol will be sent.=> [emit] ( c -- ) (e) 'bemitb' hidden send single char to @{stdout}, update {out} accordingly. "single char" may be up to four non-zero bytes of cell c on tos, which will be sent lsb 1st, until rmng @cell = 0 (this is in preparation for unicode capabilities)=> [ctype] ( p +n -- ) (s) 'bctypeb' hidden send string (p,u) to stdout, alternate vector for -re- {type}. silently return if -ve, zero or > 64K stg length. error code stored to cdt -re- {ch-rnum}, and {(oerr)}. syscall write -re- man 2 ...=> [accept] ( p +u1 -- +u2 ) (e) 'osaccept' hidden default for accept. fetch at most u1 chars input from stdin, or until <eol>, to buf. at p. required space is 0 < u1 < u1+(len-of-<eol>-sequence). overwriting kbd input, termination after <eol>, <cr> or <nul> received, buf. protected to not writing beyond bounds 0 < #chars < +u1. trailing <eol> zeroed, +u2 not including length of <eol> sequence. input echo can be dis/enabled w/ {echo-off}/{echo-on}. ctrl actions for minimal editting capabilities w/ Linux console and "rxvt": <bs> ^H back-space, i.e. cursor left. <e>[D cur.lft ditto (vt102 type terminal). <e>[C cur.rgt non-overwriting space, cursor right. <tab> ^I non-overwriting space, cursor right, enabling "last line recall" if 1st keystroke. <e>[1~ pos1 cursor back to line beginning. <e>[4~ end expands till (previous) end of line. <del> '<=' backup & del char at cursor; 'del'-key in "xterm". <lf> ^J line feed, linux expands this to <cr/lf> action. <cr> ^M carriage return, not available, linux does <cr/lf>. <ff> ^L clear screen <bel> ^G noise NOTE: xterm-4.xx vt control broken! others in-consistent; though almost orderly w/ "rxvt", <tab> and <del> may work for cursor positioning, <enter> cutting off at cursor posn, <del-left> ok, delete w/ <^H>. Which may be applicable or not, occasionally, un-predictably...=> [?error] ( flg n2 -- | in blk ,quit ) 'bqerrb' hidden if nonzero flg display error message no. n2 and {quit}=> [>number] ( dn1|qn1 ptr1 u1 -- dn2|qn2 ptr2 u2 ) 'btonumb' hidden dft for {>number}, fetches quad integer immediately after {quad}, quad flag in dpl: 80xx, w. (xx) for digits after fraction sign. -re- {sf}, {df}, {qf} for single or, {flt} permanent fp input mode.=> (s") (X: -- a u ) (a:ce) 'psqtep' hidden fetch non-alterable string ptr & cnt to stack compiled by {s"}, {z"}=> 2rdrop (R: n1 n2 -- ) (f6)(m,3) 'rdrop2' forth drop a double from return-stack=> (-leave) ( flg -- ) (fg)(m,15) 'pmleavep' hidden conditionally prepare loop parametres such that next {loop} will terminate, if flg =/= 0 store limit := (1+index) to leaving structure at next {loop}=> (leave) (m,8) 'pleavep' hidden prepare loop parametres such that next {loop} will terminate, stores limit := (1+index) to leaving structure at next {loop}=> (+loop) ( n -- ) (XR: n1 n2 -- n1 n3 | -- ) 'pploopp' hidden increment loop index by n from datastack and branch until next index(n2) increment overflows or equals limit(n1).=> (loop) (XR: n1 n2 -- n1 n3 | -- ) 'ploopp' hidden increment loop index by one and branch until next index(n2) increment equals limit(n1).=> (do) 'pdop' hidden push loop parameter to returnstack adjust limit to limit+1 if start = limit, to looping once only does{ swap 2dup = IF 1+ ENDIF >r >r }=> (?do) ( n1 n2 -- n1 n2 | ) 'pqdop' hidden if n1 =/= n2 push loop parameter to returnstack, else jump to after end of loop structure=> (find) ( p1 p2 -- p3 flg ) (e) 'pfindp' hidden find name at p1 in headers chain beginning at lfa p2 return lfa p3 and flg =/= 0, else strg p1 and 0; set macro-flag in {state} according to words capabilities. flg := 1 if word is immediately executing in either -re- {state}. default search mode letter case in-dependent, which can be forced to case dependent w/ a header flag in the words' defn or, by {lc-depend}. upper case synonyma should conventionnaly be defined earlier than their lower case counterparts, as in kernel, such that the lower case word would take precedence before upper case defn, in case-independent mode. char and case conversion re-mappable, using tables (lo>hi) and (hi>lo). (e: eflags reflect flag value)=> (") (X: -- p ) (fg) 'pqtep' hidden (c") (X: -- p ) (a:ce) 'pqtep' hidden compiled by {"} and {c"}, fetch non-alterable string ptr to stack=> (.") ( -- )(X: -- ) 'pdotqtep' hidden (.() ( -- )(X: -- ) hidden print compiled <nul> terminated string, for {."} and {.(}=> branch ( -- )(C: -- ) (fg) hidden unconditionally branch, for AGAIN, ELSE, REPEAT=> 0branch ( n -- )(C: -- ptr 'bran' ) (fg) 'zbra' hidden : IF conditionally branch if flag = 0, for WHILE, UNTIL=> 0<branch ( n -- )(C: -- ptr 'bran' ) (fg)(k) 'mibra' hidden : 0< 0= IF=> optimizing branches, not available to hi-level 4th 0>branch (f6)(k) 'gtbra' hidden : 0> 0= IF=> 0-branch (f6)(k) 'lebra' hidden : 0> IF=> ?1branch (f6)(k) 'nzdb' hidden : -dup 0= IF discard @tos & enter true part if @tos = 0, else leave @tos=> ?0branch (f6)(k) 'zdupbra' hidden : -dup IF branch & drop if zero else dup=> ?=branch (f6)(k) 'neqbra' hidden : over = IF drop enter true part and 2drop if @tos = @nos, for {?case}=> +branch (f6)(k) 'plbra' hidden : 0< IF=> (-exit) ( flg -- ) (m,8) 'pdexitp' hidden exit if flg =/= 0=> (-exit?) ( flg -- ) (m,8) 'pdexitqp' hidden exit if flg =/= 0=> -branch ( n -- )(C: -- ptr 'bran' ) (fg) 'nzbra' hidden : 0= IF conditionally branch if flag =/= 0, for IF=> xy ( -- u1 u2 ) forth fetch current cursor posn, col u1, row u2, = -1 if posn not available. NOTE: false values if sending a char to the last column, i.e. posn fetched before and after return identical co-ordinates! (console should solve pending newline 'problema', internally!)=> tab-to ( n -- ) 'tabto' forth advance cursor to column max(current+1,n) at current line=> tab ( -- ) forth blanks till next horizontal tabulator wrt @out, using the tab spacing value from uvari (#tab).=> rs ( -- ) root reset terminal, colours palette, char founts, G0/0 character set.=> ff ( -- ) vt page ( -- ) forth form feed & <cr>, <nl> if out-fd is console, clr {out} and {rows} "clear screen" is -re- {clsc}, in forth vocabulary.=> clsc ( -- ) forth cc4th action for <ff>, clear screen & <cr> if stdin or stdout is console. does not affect the cursor position - use vt {home} for cursor to top left.=> cls ( -- ) forth clear screen & {home} if stdin or stdout is console.=> bs ( -- ) forth send <bs> to @{stdout} NOTE: {bs} is back-_SPACE_, which is not back-_BLANK_ - re {del}!=> bel ( -- ) forth pc-speaker's noise from kbd/console=> at-xy ( u1 u2 - ) (vt)(a:f) 'atxy' forth place cursor at posn u1 chars from the left and u2 rows below top, store u1 to user vari {out}, u2 to {rows}. linux console esc[6n and esc[p1;p2H are in-consistent (Lx 2.2.14): reading refers to home posn = 1;1 while storing begins at 0;0. Lx 2.2.19 was ok. thus kvalue provided, for 'calibration' by {?vt} such, that {xy} adjusts parameters to keeping same posn w/ { xy at-xy }. re DPANS 10.4.1.2: no-op if i/o is not a terminal.=> ?vt ( -- flg ) 'qvt' forth true flag if stdout connected to a terminal of "vt102" type. test for '[?6' vt102, then '[?1;Pc', P=dec.digit, vt100+ of xterm/rxvt. determines whether i/o is file, returns false if in or out not a console. reading response to stdin w. zero timeout, 1s timeout for leading <esc>, modify source at <qvt> if not sufficent.=> ?eol ( -- flg ) 'qeol' forth true flag if max-x not larger than @out=> ?cr ( n -- ) 'qcr' forth new-line if (@out + n) not less than main window width=> vt?esc ( -- flg ) 'wesc' vt initial response to vt request: wait for <esc>, timeout after kbd?key failed for 1s, ret ff if non-<esc> char received w/ <ecx>-reg = char-code. (sec of reading timeout modifiable in asm source, at <wesc> label)=> vt?csi ( -- flg ) 'wcsi' vt initial response to vt request: wait for <esc>[ or <csi>, timeout after kbd?key failed for 1s, ret ff if non-<esc> char received w/ <ecx>-reg = char-code. (sec of reading timeout modifiable in asm source, at <wesc> label)=> vt!state ( -- ) 'vts' vt save console state: cursor, intensity, underline, blink, reverse, charset, color, G0, G1 (note: xterm-4 doesn't save the colours)=> vt@state ( -- ) 'vtf' vt restore most recently saved console state. -re- {vt!state}=> to-row ( n -- ) (vt) vt set cursor posn to row n at current column=> to-col ( n -- ) (vt) vt set cursor posn to column n at current line=> set-palette ( r g b n -- ) 'setpalette' vt set a selected colour by number -1 < n < 16 to the composition of three 8bit colour values for (r)ed, (g)reen, (b)lue. n: 0 black, 1 red, 2 green, 3 yellow, 4 blue, 5 magenta, 6 cyan, 7 white n: -1 to resetting to default values, colour items discarded. NOTE1: restricted to the Linux console, won't work in an xterm, etc. NOTE2: use Linux <reset> to recover from an unexpectedly aborted program.=> row ( -- n ) (vt) vt current cursor posn in row n=> rev-on ( -- ) (vt) 'revon' vt reverse video on=> rev-off ( -- ) (vt) 'revoff' vt reverse video off=> rev ( flg -- ) (vt) vt reverse video on (tf) or off (ff)=> reset-palette ( -- ) 'rstpalette' vt restore terminal colours from inital (default) values. this will restore to defaults from the Linux KERNEL! neither of ioctl or vt sequences, offer any means to reading the #actual# console settings! NOTE: use Linux <reset> to restore from an unexpectedly aborted program.=> relcur ( -- ) vt cursor addressing wrt top left of scrolling region. NOTE: immediately changes curpos and, is inconsistent wrt {xy} and {at-xy}.=> max-y ( -- n ) (vt) vt max. cursor position toward bottom of terminal window=> paper ( co -- ) 'vtpaper' vt set background colour/vt-mode, update {[p]} if co is a colour value.=> max-x ( -- n ) (vt) vt max. cursor position to the right of terminal window=> g1 ( n -- ) vt activate G1, n-th charcter set, 0 for default, -re- {g0}=> g0 ( n -- ) vt activate G0, n-th charcter set; { 0 g0 } for the default charset. n may be passed by character when ORed with -0, { char -0 or } the rsp, linux kernel defined <esc>-sequences: 1 : LAT1_MAP Latin-1 (ISO 8859-1) ESC ( B 2 : GRAF_MAP DEC VT100 pseudographics ESC ( 0 3 : IBMPC_MAP IBM code page 437 ESC ( U 4 : USER_MAP User defined ESC ( K=> max-xy ( -- x y ) 'maxxy' vt max. cursor position x to the right and y bottom of terminal window. NOTE: changed sizes orderly received in rxvt or xterm but, segfault in console e.g, after TIOCSWINSZ ioctl ($5414).=> ink (co -- ) 'vtink' vt set foreground colour/vt-mode, update {[i]} if co is a colour value.=> home ( -- ) vt ^^ (ascii 30), cursor to top left of screen, non-terminal receives <ff>. emulated via { 0 0 at-xy } because only linux console does the standard vt command emulation correctly - may be different with other linux setup...=> ff ( -- ) vt page ( -- ) forth form feed & <cr>, <nl> if out-fd is console, clr {out} and {rows} "clear screen" is -re- {clsc}, in forth vocabulary.=> del ( -- ) vt move cursor one column back and delete char at cursor posn=> cup ( -- ) 'cup' vt cursor one line up (vt sequence, ok w. console, xterm, rxvt)=> curd ( -- ) (vt) vt disable cursor display.=> cure ( -- ) (vt) vt enable cursor display. console (only) cursor appearance can be modified with, e.g. normal blinking underline : '\e[?2c' blinking block : '\e[?6c' red non-blinking block : '\e[?17;0;64c' 1st arg: 0:dft, 1:invis, 2:underline, 4:(?), 8:block +16: soft curs, +32:change bg, +64: bg=/=fg 2nd: char attr to change, 'toggle mask' (XOR): bits 0..2: fg colour, 3:fg highlight/blink bits 4..6: bg colour, 7:fg highlight/blink 3rd: char attr to set, before applying 2nd arg, i.e. clearing a bit by passing as 2nd and 3rd. un-specified args default to zero.=> cur- ( -- ) 'clft' vt cursor one posn to the left (vt sequence, ok w. console, xterm, rxvt)=> cur+ ( -- ) 'crgt' vt cursor one posn to the right, cc4th action for '^_', ascii 31 (vt sequence, ok w. console, xterm, rxvt)=> cur! ( -- ) 'curs' vt save console cursor posn=> cur@ ( -- ) 'curf' vt rst console saved cursor posn=> csr ( n1 n2 -- ) vt set scrolling region to n1=top, n2=bottom row. termcap 'cs' supported by linux console, rxvt, xterm.=> colour ( co bf -- ) 'vtcolour' vt set console colour from colour- and back- or foreground values, re {set-palette} and bg/fg names in {vt}-wordlist - {black}.., {bg}.. NOTE: these settings can also control the xterm, rxvt, etc. display but, use "<esc>[" for <csi> because some terminals won't interpret the latter. {colour} applicable to all 'ECMA-48 Graphic Rendition' cmd-s, "<esc>[<num>m" other parameter values -re- man 4 console_codes: {me} ( -1 0 -- ) reset all attributes to their defaults {md} ( -1 1 -- ) bold {so} ( -1 2 -- ) half-bright {us} ( -1 4 -- ) underscore {mb} ( -1 5 -- ) blink (light colour background) {mr} ( -1 7 -- ) reverse video ( 0 1 -- ) reset toggle-meta flg, selected mapping, display ctrl flg. ( 1 1 -- ) reset toggle-meta flg, select null mapping, set display ctrl flg. ( 2 1 -- ) set toggle-meta flg, select null mapping, set display ctrl flg. ( 1 2 -- ) normal intensity (not ECMA-48) {se} ( 2 2 -- ) normal intensity {ue} ( 4 2 -- ) underline off ( 5 2 -- ) blink off ( 7 2 -- ) reverse video off ( 8 fg -- ) underscore on, set default foreground colour ( 9 fg -- ) underscore off, set default foreground colour ( 9 bg -- ) default background colour=> col ( -- n ) (vt) vt current cursor posn in column n=> cdn ( -- ) 'cdn' vt cursor one line down (vt sequence, ok w. console, xterm, rxvt)=> abscur ( -- ) vt cursor addressing wrt top left of terminal screen (console dft). NOTE: immediately changes cursor posn if prev. state was relative.=> !vtp ( n c -- ) 'vtsp' vt send a vt.. numeric parameter w/ trailing char c, unless c<0. NOTE: numeric stg output buffer @hld will be overwritten.=> @vtp ( -- n ) 'vtfp' vt fetch a vt.. decimal parameter, regardless of @base setting.=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> <pdo2val> ( -- n ) (k) fetch double cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> <csi> ( -- n ) 'lcsig' vt cons, CSI (0x9B) is equivalent to ESC [.=> <del> ( -- n ) 'ldelg' vt cons, DEL (0x7F) is ignored (?, linux console)=> <esc> ( -- n ) 'lescg' vt cons, ESC (0x1B, ^[) starts an escape sequence=> <sub> ( -- n ) 'lsubg' vt cons, SUB (0x1A, ^Z) interrupt escape sequence=> <can> ( -- n ) 'lcang' vt cons, CAN (0x18, ^X) interrupt escape sequence=> <si> ( -- n ) 'lsig' vt cons, SI (0x0F, ^O) activates the G0 character set=> <so> ( -- n ) 'lsog' vt cons, SO (0x0E, ^N) activates G1 character set (graphic chars), and if LF/NL (new line mode) is set also a carriage return=> <cr> ( -- n ) 'lcrg' vt cons, CR (0x0D, ^M) gives a carriage return=> <ff> ( -- n ) 'lffg' vt cons, FF (0x0C, ^L), linefeed to console channels=> <vt> ( -- n ) 'lvtg' vt cons, VT (0x0B, ^K) vertical tabulator, linefeed to console channels=> <lf> ( -- n ) 'llfg' vt cons, LF (0x0A, ^J), linefeed; Linux: also console & files <eol> code.=> <ht> ( -- n ) 'lhtg' vt cons, HT (0x09, ^I) goes to the next tab stop or to the end of the line if there is no earlier tab stop=> <bs> ( -- n ) 'lbsg' vt cons, BS (0x08, ^H) cursor back one column, not clearly def'd: backing up or additionally erasing char before curpos. (but not past the beginning of the line)=> <bel> ( -- n ) 'lbelg' vt cons, BEL (0x07, ^G) beeps;=> Y ( p u -- ) (4) 'eY' editor insert stg(p,u) at cursor.=> X ( -- )ccc (4) 'eX' editor delete following text, spanning full screenfile range. -re- {TILL} for del on cursor line, only=> TRUNCATE ( n -- ) editor truncate current screenfile at or, extend & <nul>-fill till block # n.=> TOP ( -- ) (4) 'etop' editor home cursor to top left of screen=> TILL ccc( -- ) (4) 'till' editor delete on cursor line, from cursor till text beginning.=> text ( c -- ) (4) editor accept following text to pad, w/ blanks filled up to c/l chars, until <eol> or char-code c received.=> T ( n -- ) (4) 'eT' editor type line by # n, save also in pad=> scr! ( n -- ) (m,11) 'scrs' editor sto n to uvari {scr}, the current editor screen no.=> scr@ ( -- n ) (m,7) 'scrf' editor content of uvari {scr}, the current editor screen no.=> S ( n -- ) (4) 'eSe' editor spread making line n blank=> r#@ ( -- n ) (m,7) 'rnf' editor content of uvari {r#}, the editor screen disp from top to cursor.=> r# ( -- p ) (fg) 'unr' editor editor, cursor posn in screenfile=> R ( n -- ) (4) 'eR' editor replace (overwrite) line no. ( n ) with text from pad=> P ( n -- )ccc (4) 'eP' editor put following text to line n=> N ( -- ) (4) 'eN' editor find next occurence of previous text=> max-lw ( -- n ) 'maxlw' editor max stdout display line width, whether terminal window or file. line-width for non-terminal channels from (kernel-)value {#col}.=> match ( p1 u1 p2 u2 -- f u3 ) (4) editor search memory(p1,u1) for stg(p2,u2), ret tf and disp u3 wrt p1 if stg found, else ff and u3 := u1 letter case dependency as set w/ {lc-depend}/{lc-ignore}.=> M ( n -- ) (4) 'eM' editor move cursor by signed amount n, print its line=> LINE ( n -- p | abort ) (4) editor relative to scr. leave address of line=> L- ( -- ) 'relim' editor display previous screen, from {scr}.=> L+ ( -- ) 'relip' editor display next screen, from {scr}.=> L ( -- ) 'relist' editor re-display latest screen, from {scr}.=> I ( n -- ) (4) 'eI' editor insert text from pad onto line # n. spread (S) and replace empty line n from pad (R)=> H ( n -- ) (4) 'eH' editor hold numbered line at pad. copy to pad=> FIND ( -- ) (4)(e) 'efind' editor string at pad over full screenfile range, else error message. (e: Z if found)=> F ( -- )ccc (4) 'eF' editor find occurence of following text=> E ( n -- ) (4) 'eE' editor erase line n with blanks=> DELETE ( n -- ) (4) editor backwards at cursor by count n, spanning full screen.=> D ( n -- ) (4) 'eD' editor delete line n, but hold in pad=> COPY ( n1 n2 -- ) (4) editor duplicate screen n1, onto screen n2. can extend beyond <eof>, itermediate scr-s filled w/ <nul>-bytes.=> CLEAR ( n -- ) editor fill screen no. n (=block) with blanks, and {save-buffers}. can extend beyond <eof>, itermediate scr-s filled w/ <nul>-bytes.=> C ( -- )ccc (4) 'eC' editor insert following text at cursor.=> B ( -- ) (4) 'eB' editor backup cursor by text in pad=> 1line ( -- f ) (4) 'e1line' editor scan line with cursor for match to pad text, update cursor, return boolean=> -text ( p1 u1 p2 -- f ) (4) 'mtext' editor compare stg(p1,u1) whith data at p2, ret f =/= 0 if matching. letter case dependency as set w/ {lc-depend}/{lc-ignore}.=> -move ( p n -- ) 'mmove' editor move c/l chars of text from ptr p to line n of current screen.=> .LINE ( n -- ) 'dotline' editor=> #locate ( -- n1 n2 ) (4) 'hlocate' editor leave cursor offset n2, line n1=> #lead ( -- p n ) (4) 'hlead' editor line address p, offset n from beginning to cursor.=> #lag ( -- p u ) 'hlag' editor cursor address p, count u after cursor till eol.=> (line) ( n1 n2 -- p u ) 'plinep' editor ret ptr to and characters count of line no. n1 in screen n2.=> where ( cur blk -- ) n.i. editor while {load}ing, print screen # and image of error, sto @blk to uvari {scr}, make {editor}-voc current and quit.=> using ( p u -- ) forth pass screenfile name to use w/ subsequent {load} and editting opr. opens {scr-chan} in non-blocking, read-only mode. -re- {editting}.=> use ( -- p ) (fg) fig least recently used block buffer, i.e. block buf. to be used next. if {[use]} unset (zero), defaults to last buffer in chain of blocks. actual {use} represents a block of scr-chan valid immediatly before {prev} assignment, used by {block} only if owner channel un-changed. can forcedly be re-fetched w/ { 0 to [use] }.=> update? ( p -- f ) 'updateq' blkfile ret tf if screenfile buffer at p is in use and {update}d.=> update-off ( -- ) (a:b) 'updateoff' blkfile clear -re- {update} flag of most recently changed block.=> thru ( n1 n2 -- ) (4)(i)(a:b) forth -re- {load} screens n1 till n2 (inclusive, dpans 7.6.2.2280). while executing, only.=> scrfpos ( -- dn ) blkfile ret file-ptr at current screenfile cursor posn, from {scr} and {r#}.=> save-buffers ( -- ) (a:b) 'sbufs' forth write all updated blocks back to the rsp. screenfile sync file w/ cached content. fig-4th aequivalent to {flush}.=> rw@ ( p -- ) 'rwf' blkfile fetch assigned block to buffer p from file by buffer owner or {scr-chan}.=> rw! ( p -- ) (s) 'rws' blkfile clr {update} flag, save block from ptr p to owner file or, {scr-chan}. defaults to {scr-chan}, stored into block header if no channel assigned. silent return if an error occured, with 'EBADF'(-9) in {ch-rnum}. syscall write, llseek -re- man (2), restricted to file size less than 4G.=> ro? ( p -- f ) n.i. 'roq' blkfile ret tf if at p buffered screenfile is not writeable (or not present).=> reading ( -- ) (4) 'rding' blkfile re-open {scr-chan} for non-blocking, read-only access at un-changed file ptr. rsp {block} cleared to be refetched; -re- {editting} for r/w mode. note: requires access to the /proc filing system=> prev ( -- p ) (fg) fig most recently used block buf, i.e. block which contains latest data of at time of last access valid owner, -re- {scr-chan}, {use}, {block}. if unset (zero) defaults to 1st unused, new block if none exists. can forcedly be re-fetched w/ { 0 to [prev] }.=> nextbuf ( p1 -- p2 ) blkfile find next unused or by {scr-chan} owned buffer =/= p1 or, install new block. always succeeds, otherwise fatal error: system out of memory=> lnk>tag ( p -- n ) (m,) 'lnk2tag' blkfile ret owner channel tag n of buffer block by link-ptr p -re- {blk>lnk>}, {buf>lnk}.=> lnk>chn ( p -- n ) (m,) 'lnk2chn' blkfile ret owner channel n of buffer block by link-ptr p -re- {blk>lnk>}, {buf>lnk}.=> lnk>num ( p -- n ) (m,) 'lnk2num' blkfile ret count n of buffers by buffer block link-ptr p -re- {blk>lnk>}, {buf>lnk}.=> list ( n -- ) (a:b) 'elist' forth display screen n, store max(0,n) to uvari -re- {scr}. NOTE: by dft executes escaping -re- {type}, adjust deferred {(type)} to suit.=> limit ( -- p ) (fg) fig next to top address of last block buffer in buffer-block of -re- {prev}. can forcedly be re-fetched w/ { 0 to [limit] }. NOTE: different value if {prev} moved to a different block of buffers. provided for minimal compatibility wrt f.i.g.-4th blockfile access, pointing to the next after last byte of currently used block buffer. {limit} is most probably NOT THE LIMIT of assigned chained buffer blocks which, at any time may be extended to any convenient amount and, cannot be assumed to represent a contiguous data-space, wrt eachother. -re- {ibbuf} in {blkfile} voc.=> head>buf ( p1 -- p2 ) (m,) 'head2buf' blkfile convert ptr p1 to header to ptr to the rsp screenfile buffer. if p1=0 ret p2 := 0, if word not compiled as a macro.=> head>blk ( p -- n ) (m,) 'head2blk' blkfile convert ptr p to buffer header to block no. assigned to the rsp screenfile buffer. n := -1 if buffer not used, if word not compiled as a macro.=> first ( -- p ) (fg) fig bottom address of 1st block buffer in buffer-block of -re- {prev}, defaults to 1st buffer in chain of buffer-blocks if [prev] unset (zero). can forcedly be re-fetched w/ { 0 to [first] }. NOTE: different value if {prev} moved to a different block of buffers. provided for minimal compatibility wrt f.i.g.-4th blockfile access, pointing to the 1st byte of the 1st, currently used block buffer. {first} is NOT necessarily THE BEGINNING of assigned chained buffer blocks, the base address of which can be found with { block-lk @ }. -re- {ibbuf} in {blkfile} voc.=> flush ( -- ) forth write all updated blocks back to the rsp. screenfile, clr/remove buffers. executes {save-buffers}, {empty-buffers}. ANS-mode, use {save-buffers} for the fig-4th aequivalent to {flush}.=> ibbuf ( -- ) blkfile set-up a block of screenfile block buffers. xec only. a buffers' block is of {page-size} bytes, beginning at page-aligned true address which thus may be used to store a minimal, {mmap}ed item. constitutes a quasi-nameless word (name is a <nul> byte) w/ forget-handler such, that buffer blocks removeable by {iforget} per uot-index of the rsp buffer or with {forget} of any older regular word. block of block-/screenfile buffers, header at 8-aligned address: struc blkbuf [ link ][ reserve ][ channel ][ #blocks ] 00: .l circular link, pc-rel disp to next blockptr, zero if no other block exists; initial ptr in -re- {block-lk}, linkage such that {block-lk} disp pointing to 1st, further linkfields to the rsp latest and, last to 1st buffer block: block-lk->[ oldest->most recent->previous->..->next to oldest ] 04: .u owner channel tag 08: .c file channel the rsp buffer is assigned to 0c: .b no. of blocks in this buffer 10: .f #blocks(4) buffer-headers follow: struc blkhead [ updt|blk# ][ disp ] 00: .u: update-flag(bit#31) ORed w/ block-number 04: .d: pc-rel disp-to-blk next buffer in chain ( -- p f ), f=/=0 if next buffer found: { block-lk @ begin dup @ over swap + dup rot - ... } -re- {buffer}, {block}, {blk>lnk}, {buf>lnk}, {blk>head}, {buf>head} &c. data/code structures re file <inc/l4struc.inc>.=> fgb ( ix -- ix ) (k) novoc buffer blocks forget handler=> empty-buffers ( -- ) (fg) 'embufs' forth don't save, make all buffers of {scr-chan} available, force re-fetching of buffered blocks from file. un-assign, i.e. remove buffer from data-space, if {latest}.=> empty-blk ( n -- ) (fg) 'emblk' blkfile in-validate buffer of blk# n, set {use} to it's buffer, don't save. forces re-fetching blk# n from {scr-chan} file.=> editting ( -- ) (4) 'eding' blkfile re-open {scr-chan} for non-blocking, read/write access at un-changed file ptr. rsp {block} cleared to be refetched; -re- {reading} for r/o mode. note: requires access to the /proc filing system=> dr1 ( -- ) 'dr1c' forth activate 2nd screenfile channel, -re- {dr0}, {dr?}=> dr0 ( -- ) 'dr0c' forth activate 1st screenfile channel, -re- {dr1}, {dr?}=> dr? ( -- n ) 'schq' blkfile ret +ve {dr0}-channel, -ve {dr1}-chanel or, zero if neither one is {scr-chan}.=> del-buffer ( -- ) 'fgbblok' blkfile remove, i.e. {forget}, buffer block if {latest} and not the only one.=> c/l ( -- u ) (fg) 'cbyl' fig characters per editor/load line (64)=> buf>head ( p1 -- p2 ) 'buf2head' blkfile ret ptr p2 to header of screenfile buffer at p1. ret 0 if p1 not a screenfile buffer.=> buf>blk ( p -- n ) 'buf2blk' blkfile block no. n. by ptr p to buffer. n := -1 if buffer not used.=> blk>head ( n -- p ) 'blk2head' blkfile ptr p to header of screenfile buffer to which file-block no. n is assigned. ret 0 if p1 not a screenfile buffer.=> blk>buf ( n -- p ) 'blk2buf' blkfile buffer address p of block no. n. p := 0 if block n not buffered.=> buf>lnk ( p1 -- p2 ) 'buf2lnk' blkfile buffer-block link-address p2 of block-buffer at p1. can be used to checking whether a page-aligned ptr belongs to a block of screenfile buffers, p2 := 0 if not.=> blk>lnk ( n -- p ) 'blk2lnk' blkfile buffer-block link-address p of block-buffer of block no. n.=> b/scr ( -- u ) (c)(fg) 'bbyscr' fig blocks per editor/load screen (1)=> b/c ( -- u ) (c) 'bbyc' editor bytes per character (1, max 4 bytes and max 32 bits)=> b/buf ( -- u ) (c) 'bbybuf' forth bytes per block-buffer (1024 per ANS)=> b/b ( -- u ) (c) 'bbyb' system bits per byte, "address unit" (8, max 32)=> buffer ( +u -- p ) (v)(fg) forth leave ptr to useable screenfile buf., flush oldest buf. and re-assign if none free, else leave ptr to next free in list of #buf-s. execute true address uot vector (buffer), dft is {[buffer]}.=> block ( +u -- p ) (v)(fg) forth ptr to block for sreenfile i/o execute true address uot vector (block), dft is {[block]}.=> +buf ( p1 -- p2 tf|ff ) (fg)(e) 'plusbuf' fig find next buffer in chain of buffer-blocks, regardless of the resp owner. ff := 0 if p2 = prev, else any no-zero value for tf (flg := prev - p2 ). (e: Z if p2=prev)=> [upd] ( -- ) 'bupdb' hidden mark most recently changed block, -re- {prev}, to saveing before re-useing. default opr of deferred {update}.=> [load] ( n -- ) (i) hidden file {scr-chan} becomes current input, beginning at screen no. n. on entry, forced to {decimal} and {int}, for non-fp numeric i/o. if blk=scr size n stored to {scr}. dft for deferred -re- {load}. NOTE: input file closed after an error, for safety.=> [f] (X: -- p f ) (i) 'bfb' editor (C: -- ) -re- {-find} and ret flg & lfa = p if in interpreting state, else compile/execute next word w/ forth voc. preferrence.=> [edit] ( -- ) (4) 'beditb' editor initial runtime of deferred {edit}, loading the screenfile editor. message ENOENT if file <edit.f8> not found, else {edit} set to {noop}.=> [buffer] ( +u -- p ) (k)(83) 'bbufb' hidden assign buffer at ptr p to block no. u of owner {scr-chan}; dft for {buffer} beginning w/ {use}, find next buffer =/= {prev} to useing next, set new {use}; ret previous {use} as new {prev}, content stored back to file if {update}ed.=> [block] ( n -- p ) (k)(83) 'bblockb' hidden ret ptr p =: {prev} to buffer for block n, assigned to current {scr-chan}. no. of fetched bytes or file access error can be read by { scr-chan ch-rnum }. either, finds already present block u of {scr-chan} or, assigns and fetches block no. u into p = {use} or, new buffer of rsp scr-chan, re-setting {use}. dft for -re- {block}.=> [0m] ( -- ) (d) 'bm0b' hidden terminal cursor line re-listing. default for deferred {0m}.=> [-->] ( -- ) (i) 'bnxldb' forth cpl from next screen. dft for deferred -re- {-->} using initial, {load}ing block-buffer for tib.=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> x-ok ( -- n ) (m.6) 'xok' forth executable, file access query flag=> write-line ( p u1 fd -- er ) (a:f) 'writeline' forth send string p,u to file fd, append <eol> code(s) as defined in uvari (ccr). dpans: 11.6.1.2485=> write-file ( p u1 c -- u2 er ) (s)(e)(a:f) 'writefile' forth write data from buf. p,u1 to channel c, ret u2 no. of data sent. cdt of channel c stored to uvari {(outchp)}. syscall -re- man 2 write. -re- {WRITE-FILE} in {ans} vocabulary.=> WRITE-FILE ( p u1 c -- er ) (s)(e)(a:f) 'awritefile' ans write data from buf. p,u1 to file chan c, er := 0 or error code. ANS-mode. syscall -re- man 2 write. dpans: 11.6.1.2480, -re- {write-file} in {forth}.=> write-char ( c ch -- ) (s) 'writechar' forth emit a single multi-byte (up to four) char to channel ch use { ch ch-rnum } for error code.=> which ccc( -- ) (i) tools display path+file if ccc in lib4th path. use while executing, only.=> w-close ( -- er ) (s) 'wclose' forth close {work}-channel - re {close-file}.=> w/o ( -- n ) (a:f)(m,7) 'wbyof' forth 'write only' file open access mode. dpans: 11.6.1.2425=> w-ok ( -- n ) (m.6) 'wok' forth writable, file access query flag=> unlock-file ( ch -- er ) (s)(e) 'unlockf' linux clear lock on a file by channel ch, syscall -re- man 2 fcntl (eflags reflect error code)=> umask? ( -- n ) (s) 'umaskq' linux read currently valid file permissions creation mask syscall umask -re- man 2 ...=> umask ( n1 -- n2 ) (s) 'umaskf' linux set new files permissions creation mask, ret previously valid mask. syscall umask -re- man 2 ...=> trn ( n1 -- n2 ) (m,6) 'trnf' linux modify acess flag to truncate after open, i.e. open overwriting=> syn ( n1 -- n2 ) (m,6) 'synf' linux modify acess flag to synchrounous mode, waiting until actual opr. finished - <enter> if console input. flushing output data.=> stat-size ( -- +u ) (m) 'statsize' linux required buf. size for {file-status} data structure.=> search-file ( p1 u1 ch -- d2 0 | dx er ) (s) 'searchf' forth search file by channel ch for stg(p1,u1) beginning at current file-ptr. terminates if stg found or at <eof>, <nul> and after <nl> if ch is a console. if stg found ret disp of file-ptr from entry to end of stg and er = 0 if stg not found ret byte-count until eof and er = ENODATA (-61). stg(p1,u1) may be up to {path-max} bytes of length. reading by single bytes, thus slow but, suitable to any kind of input. stored disp to latest <nl> in uvari (ierr).=> save-input ( -- xn..x1 n ) (a:cx) 'saveinput' forth [n:(source-id), s0, blk, in, (tib), (tib-max), span, set-chan(stdin), (iolink):1] and cnt n stored to data-stack. an application may further store this block to memory and link to (iolink) and, assign local {tib}. local dataspace left over after entry would be resolved by next {restore-input}.=> rw? ( c -- er ) (s) 'rwq' forth ret tf if channel c opend w/ r/w access.=> restore-input ( xn..x1 n -- flg ) (a:cx)(e) 'restoreinput' forth restores data-stack top from (iolink), stores cnt n saved values back to [n:(source-id), s0, blk, in, (tib), (tib-max), span, set-chan(stdin), (iolink):1] and forcedly resolves after latest -re- {save-input} locally assigned memory. (eflags; Z if at top input level else NZ, S after early termination - re <popiosrc>)=> resize-file ( ud c -- er | abort ) (s)(a:f) 'resizef' forth truncate writable file or extend with <nul> bytes, re man(2) ftruncate. VERIFY: <nul>s extension might be linux kernel version dependent. NOTE: ANS-std double cell (64bit) file size available w. linux 2.4. kernel, until then {resize-file} will abort on size overflow into m.s. cell. syscall -re- man 2 ftruncate. dpans: 11.6.1.2147=> reposition-file ( ud c -- er ) (a:f) 'reposnf' forth set file-ptr of channel no. c to position ud. dpans: 11.6.1.2142.=> rename-file ( p1 u1 p2 u2 -- er ) (s)(a:fx) 'renamf' forth rename file p1,u1 to name p2,u2. syscall -re- man 2 renae. dpans: 11.6.2.2130=> readm-c/l ( p u -- p' u' p1 u1 ) 'readmcl' editor read c/l chars(=bytes) from mmapped file, memory range(p,u) ret remaining data field(p',u') and string(p1,u1) ret string(0,0) at <eof> wrt mapped area. -re- {readmc}, {readml}, {mmap}, {mmap-file}, {msync}, {munmap}=> readml ( p u -- p' u' p1 u1 ) forth mmap-ed files' aequivalent to {read-line}: read chars(=bytes) until <eol> found or till <eof>, from memory range(p,u). ret remaining data field(p',u') and string(p1,u1). ret string(0,0) at <eof> wrt mapped area. -re- {readmc}, {readm-c/l}, {mmap}, {mmap-file}, {msync}, {munmap}=> readmc ( p u u2 -- p' u' p1 u1 ) forth mmap-ed files' aequivalent to {read-file}: read at most u2 chars(=bytes) from mmapped file, memory range(p,u) ret remaining data field(p',u') and string(p1,u1) ret string(0,0) at <eof> wrt mapped area. -re- {readm-c/l}, {readml}, {mmap}, {mmap-file}, {msync}, {munmap}=> readlink ( p1 p2 u2 -- p u ) (s) 'readlk' linux resolve linkname per asciz-string at p1 to filename (p,u) in buf. (p2,u2) syscall readlink -re- man 2 ...=> read-line ( p +u1 ch -- u2 flg er ) (a:f) 'readl' forth read at most +u1 chars until <eol> into buffer (p,u1). dpans: 11.6.1.2090 return error code er and no. of received chars u2 until <eol> or u1. false flg and er<0 is an error, regardless of u2, false flg and er=0 and +u2=0 is <eof>. flg=0 and er=EOVERFLOW(-75) if input ok & buffer full, no <eol> received. reading by bytes if ch is a pipe, {ch-fpos} advanced by count of bytes read and, {ch-rnum} returns: 1 if input ok, 0 at eof, -ve after an error. NOTE: fills buffer w. {read-file}, then scans for <eol> and adjusts file pointer accordingly.=> read-file ( p +u1 c -- u2 er ) (s)(a:f) 'readf' forth read +u1 chars into buf. of size u1, or until <eof>. u2 is no of received bytes. er<0 is an error, regardless of u2; er=0 and +u2=0 is <eof>. syscall -re- man 2 read. dpans: 11.6.1.2080; -re- {read-line}, {read-char}=> read-char ( ch -- c flg ) 'readchar' forth input from supplied channel, otherwise identical -re- {?ekey} no time-out, execute { ch ch-eof } to find out whether a file is at it's end.=> r/w ( -- n ) (a:f)(m,7) 'rbywf' forth 'read and write' file open access mode. dpans: 11.6.1.2056=> r/o ( -- n ) (a:f)(m,7) 'rbyof' forth 'read only' file open access mode. dpans: 11.6.1.2054=> r-ok ( -- n ) (m.6) 'rok' forth readable, file access query flag=> pwrite ( p u1 n c -- u2 er ) (s)(e)(a:f) 'pwritef' linux write data from buf. p,u1 to file channel c at fptr n, ret u2 no. of data sent. er<0 is an error, regardless of u2. cdt of channel c stored to uvari {(outchp)}. syscall -re- man 2 pwrite (e: eflags, edx:=chp=> pwd ( -- ) linux print working directory (to stdout).=> push-io ( n -- )(R: -- -tib- nn...nm nc ) 'pushio' forth allocates n bytes of local tib, >in := n, tib-max := n push i/o source data to tor, link into (iolink) chain stores 28 cells plus cells aligned aux. tib size n in bytes to RS.=> pread ( p +u1 n c -- u2 er ) (s)(a:f) 'preadf' linux set file ptr to n, read +u1 chars into buf. of size u1, or until <eof>. u2 is no of received bytes. er<0 is an error, regardless of u2; er=0 and +u2=0 is <eof>. syscall -re- man 2 pread=> pop-io ( -- )(R: -tib- nn...nm nc -- ) (e) 'popio' forth pop i/o source from tor, discard latest local tib, remove from (iolink) chain terminates nested sequence if unsuitable data found @(iolink) or return-stack (eflags: Z if, on entry, no more levels to resolve.=> path-max ( -- n ) (c)(m,6) 'pathmax' linux max. length of a path-name (4K, re linux/include/linux/limits.h)=> path+file ( pe ue pf uf pb ub -- pp up | xx 0 ) 'pthfile' linux find file w. name (pf,uf) in PATH supplied by string(pe,ue). search cwd, only if file-name(pf,uf) begins w/ "./". search HOME-dir, only, if file-name(pf,uf) begins w/ "~/". put found absolute path and name stg(pp,up) into buffer(pb,ub), ret empty stg, up = 0, if no such file found. stg result length limited to size of Linux PATH_MAX (4K). -re- {f"}, {fname"}, {[fname]} which search {f8dir} and {path}. examples: s" /devfs:/dev" s" tty" pad 200 path+file path to current kbd console, whether "devfs" active or not. path s" util.f8" pad 400 path+file path to 'nearest' f8-utils files (or directory). NOTE: path from initial PATH env-vari, HOME as valid while called.=> path ( -- p u ) 'epath' forth ret ptr to string of PATH environmental variable. alternatively, fetch <nul>-terminated stg from @(path) if non-zero. -re- {getenv}, {envstg}.=> open-pipe ( -- c1 c2 ) 'opipe' linux open a pipe, ret channels c1 for input from, c2 output to the pipe. i.e, fd[0] by c1 corresponds to 'stdin', fd[1] by c2 to 'stdout'. failure if either one of c1,c2 is -ve (error code).=> open-file ( p u n1 -- c flg ) (s)(a:f) 'openf' forth open in mode n1 an existing file the name of which is string (p,u). n1 either one of {r/w}, {r/o} or {w/o}, which may be ORed by several modifiers, e.g. {app}, {cre}, {dir}, {nbl}, {nof}, {syn}, {trn}, {any}. file open words expect valid path to file -re- {path+file}, {f"}. permissions set to value from uvari {fperm}, dft 600o ret c := work-channel no. or error code, flg := ff after success, else tf. actual fd stored to (work) and work-chp if open was successful. syscall -re- man 2 open, and glossary "fd open flags". dpans: 11.6.1.1970=> open-dir ( p u -- fd flg ) 'opendirf' linux r/o open directory path (p,u).=> nof ( n1 -- n2 ) (m,6) 'noff' linux modify acess flag to not following links=> nbl ( n1 -- n2 ) (m,6) 'nblf' linux modify acess flag to non-blocking i/o, required for console single key input mode.=> name ccc( -- p u ) (i) hidden fetch a <bl>-enclosed name from input stream to {here} cpl only: immediately overwritten while in interpreting mode=> munmap ( p u -- er ) (s) linux un-map range u at ptr p, mapped file not guaranteed to be updated accordingly unless prior execution of -re- {msync}. syscall re man (2) munmap=> msync ( p u n -- er ) (s) linux synchronize rsp. file w/ mapped range u at ptr p, according to flags n: {ms-a} MS_ASYNC 1 sync entire file asynchronously, including mappings. {ms-i} MS_INVALIDATE 2 invalidate the caches. causes the system to freeing 'clean' pages & flushing any 'dirty' (modified) ones. {ms-s} MS_SYNC 4 synchronous memory sync. init writeout of just the 'dirty' mapped data - no guarantee of file integrity. syscall re man (2) msync; {mmap}=> ms-s ( -- n ) (c) mss linux MS_SYNC 4, synchronous memory sync=> ms-i ( -- n ) (c) msi linux MS_INVALIDATE 2, invalidate the caches=> ms-a ( -- n ) (c) msa linux MS_ASYNC 1, sync memory asynchronously=> mremap ( p2 p1 u1 u2 n -- p3 ) (s) linux re-map memory range(p1,u1) to size u2 w. flag n: MREMAP_MAYMOVE 1 MREMAP_FIXED 2 (lx 2.4+) expand (or shrink) an existing mapping, potentially moving it at the same time (controlled by MREMAP_MAYMOVE and available VM). new address valid only if MREMAP_FIXED specified, implies MREMAP_MAYMOVE. NOTE: undocumented kernel modification w. Lx 2.4: p2, for new address. p2 may be any (dummy) value if L4 run w. a Linux kernel prior to v2.4. syscall re man (2) mremap; mm/remap.c; {mr-f}, {mr-m}, {paligned}.=> mr-f ( -- n ) (c) mrf linux MREMAP_FIXED 2 (lx 2.4+, else zero); re {mr-m}, {mremap}.=> mr-m ( -- n ) (c) mrm linux MREMAP_MAYMOVE 1; re {mr-f}, {mremap}.=> mopen-file ( p u n1 pf -- fd flg ) (s) 'mopenf' linux {open-file} w/ file permissions pf, using @{(fperm)} if not > 0.=> mmap-file ( m f p u -- p u| er 0 ) ((s)) 'mmapf' linux map an entire file by name(p,u) into memory; mapping mode m, flags f -re- {mmap}. ret ptr p to beginning of memory mapped file and length u, u = 0 and p in range [$ffff0000,$ffffffff] is an error. simplified call to -re- {mmap}.=> mmap-chan ( m f ch -- p u| er 0 ) ((s)) 'mmapc' linux map an entire file by channel ch into memory, mapping mode m, flags f. ret ptr p to beginning of memory mapped file and length u, u = 0 and p in range [$ffff0000,$ffffffff] is an error. channel ch will be closed if mapping successful. simplified call to -re- {mmap}.=> mmap ( p1 u1 m f fd o -- p2|er ) (s) linux maps u1 bytes of file/device w/ file-descriptor fd, beginning at offset o bytes, to memory, preferrably at p1, the actual value of which is returned by page-aligned ptr p2 or, an error code er > $ffff0000 (unsigned). p1: if zero the system call returns p2 chosen by host kernel, if flag MAP_FIXED set, p2 will forcedly be set to p1, or failure, any non-zero p1 will be page-aligned towards higher addresses. u1: (partial) file size to map into memory. m: access mode -re- {prot-r}, {prot-w}, {prot-x} or, zero for no access. f: flags (re sys/mman.h), either one of MAP_SHARED or MAP_PRIVATE required, others otional: {mm-s} MAP_SHARED 0x01 Share changes {mm-p} MAP_PRIVATE 0x02 Changes are private {mm-f} MAP_FIXED 0x10 Interpret addr exactly, fail otherwise {mm-a} MAP_ANONYMOUS 0x20 don't use a file {mm-g} MAP_GROWSDOWN 0x0100 stack-like segment {mm-d} MAP_DENYWRITE 0x0800 ETXTBSY {mm-e} MAP_EXECUTABLE 0x1000 mark it as an executable {mm-l} MAP_LOCKED 0x2000 pages are locked {mm-n} MAP_NORESERVE 0x4000 don't check for reservations fd: file descriptor, -re- {ch-id} or, dummy arg w. MAP_ANONYMOUS. o: file ptr to where to begin mapping. sys_mmap receives the data structure: 00: 0 or preferred/forced address, 04: length of file, may be partial length, 08: mode 0C: flags 10: file descriptor, 14: offset wrt file beginning, a multiple of -re- {page-size}. mmap opened file by channel {ch}, ret ptr & size, ready for {munmap}: { ch file-size paligned 0 over prot-r mm-p ch ch-id 0 mmap swap } allocate -sz- bytes r/w/x memory: { 0 -sz- prot-w mm-p mm-a or 0 0 mmap } syscall re man (2) mmap; {page-size}, {paligned}.=> mm-n ( -- n ) (c) mmn linux MAP_NORESERVE 0x4000, don't check for reservations; flag to -re- {mmap}.=> mm-l ( -- n ) (c) mml linux MAP_LOCKED 0x2000, pages are locked; flag to -re- {mmap}.=> mm-e ( -- n ) (c) mme linux MAP_EXECUTABLE 0x1000, mark it as an executable; flag to -re- {mmap}.=> mm-d ( -- n ) (c) mmd linux MAP_DENYWRITE 0x0800, ETXTBSY; flag to -re- {mmap}.=> mm-g ( -- n ) (c) mmg linux MAP_GROWSDOWN 0x0100, stack-like segment; flag to -re- {mmap}.=> mm-a ( -- n ) (c) mma linux MAP_ANONYMOUS 0x20, don't use a file; flag to -re- {mmap}. use dummy file descriptor to /dev/null if MAP_ANONYMOUS not supported.=> mm-f ( -- n ) (c) mmf linux MAP_FIXED 0x10 Interpret addr exactly, fail otherwise; flag to -re- {mmap}.=> mm-p ( -- n ) (c) mmp linux MAP_PRIVATE 0x02, Changes are private; flag to -re- {mmap}.=> mm-s ( -- n ) (c) mms linux MAP_SHARED 0x01, Share changes; flag to -re- {mmap}.=> mfopen ccc( n1 pf -- c flg ) linux open file ccc w/ flags n1 & pf, -re- {mopen-file}.=> mcreate-file ( p u n1 pf -- n2 n3 ) (s) 'mcreaf' linux {create-file}, file permissions pf, dft = 600 if pf not > 0. {mopen-file} w/ TRUNC and CREAT flags or-ed to access code.=> mcreate-dir ( p u pf -- n2 n3 ) (s)(a:f) 'mcread' linux create a directory w/ file access mask pf. -re- man 2 mkdir=> lock-file ( ch -- er ) (s)(e) 'lockf' linux set lock on a file by channel ch, disabling write access by any other file descriptor. 'mandatory' locking if the rsp file is SGID but, not executeable by group syscall -re- man 2 fcntl - returns error free but, no effect... <= (eflags reflect error code)=> llseek ( d1 n2 c -- ud2 er ) (s) 'llseekf' linux syscall _llseek w. d1=signed offset, n2=relation, c=channel; -re- man 2 ... n2 offset set to 0 SEEK_SET unsigned d1 bytes. 1 SEEK_CUR it's current location plus signed d1 bytes. 2 SEEK_END eof plus signed d1 bytes. ret ud2 := new file ptr, er := ernum. file offset may be set beyond the end of the existing end-of-file. If data later written at this point, subsequent reads in the gap return <nul>-bytes.=> included ( .xx. p u -- .yy. | abort ) (a:f) 'included' forth non-blocking open r/o file w. name+path p,u and {include-file}. abort w. error message on open error - while compiling leaves all data on stack and returns the rsp tib address and 1's-complement of the error line's <eol> position. dpans: 11.6.1.1718=> include? www ccc( -- ) 'qincludeq' forth a no-op if word www already accessible, else -re- {include} file ccc.=> include" ccc( -- ) 'includeqte' forth include source from filename <ccc>, delimited by a quote <">. search {f8dir} and {path} if ccc is not a fully qualified file-name=> include ccc( -- ) forth open and include source text from file ccc, re {include-file} search {f8dir} and {path} if ccc is not a fully qualified file-name=> include-file ( .xx. c -- .yy. ) (a:f) 'ifile' forth save current input source description, revert to -re- {int} mode, redirect file input by channel no. to stdin, un-nesting, early termination by return to {quit}. dpans: 11.6.1.1717=> fstat ( c p -- er|p ) (s) 'ffstatf' linux fetch file channel c status data to buf. of size {stat-size} at p. use -re- {file-status} to reading the file status by file name. syscall fstat -re- man 2 ...=> fposre ( d1 c -- d2 er ) (s)(f6) linux set file-ptr by displacement d1 to current posn, return current file-pointer value, {lseek} w. SEEK_CUR=> fname" ccc( p1 u1 -- p2 u2 ) (i)(4) 'fnmqte' forth fetch <"> delimited file-name to buf(p1,u1), search {f8dir}, {path}, {lxpath} ret the fully qualified path+file name stg(p2,u2) to buf(p1,u1).=> fopen ccc( n1 -- c flg ) 'fopenf' forth open file ccc, n1 & ret re {open-file}=> flush-file ( c -- er ) (s)(a:fx) 'flushf' forth assure all rsp. data cached by system flushed to fd. syscall -re- man 2 flush, fdatasync. dpans: 11.6.2.1560=> FILE-STATUS ( p1 +u -- p2 0 | er er ) (s)(a:fx) 'afstatf' ans stores status array to {here}, ret ptr p2 and ff or the ernum er, otherwise as linux -re- {file-status}. dpans: 11.6.2.1524=> file-status ( p1 +u p2 -- er|p2 ) (s) 'fstatf' linux return error or ptr to description of file status, by path+name p1,u. required buffer size at p2 is linux kernel specific, re {stat-size}. -re- {FILE-STATUS} in {ans} voc for dpans: 11.6.2.1524 conformance. -re- {fstat} to reading the file status by number of an open channel. syscall -re- man 2 stat; lx kernel 2.2 stat structure: 00 SHORT st_dev ; device type - re below short pad1 04 CELL st_ino ; inode 08 SHORT st_mode ; protection 0a SHORT st_nlink ; number of hard links 0c SHORT st_uid ; user ID of owner 0e SHORT st_gid ; group ID of owner 10 SHORT st_rdev ; device type (if inode device) short pad2 14 CELL st_size ; total size, in bytes 18 CELL st_blksize; blocksize for filesystem I/O 1c CELL st_blocks ; number of blocks allocated 20 CELL st_atime ; time of last access 24 cell unused1 28 CELL st_mtime ; time of last modification 2c cell unused2 30 CELL st_ctime ; time of last change 34-3c cells unused3..5 <st_dev> bits, all zero for a 'fifo', else should be (but apparently aren't): S_IFMT 0170000q ; device bits mask S_IFSOCK 0140000q ; socket S_IFLNK 0120000q ; symbolic link S_IFREG 0100000q ; regular file S_IFBLK 0060000q ; block device S_IFDIR 0040000q ; directory S_IFCHR 0020000q ; character device S_IFIFO 0010000q ; fifo S_ISUID 0004000q S_ISGID 0002000q S_ISVTX 0001000q ; dir: only owner of file or dir can delete=> file-size ( c -- un|er ) (s)(a:f)(e) 'fsizef' forth 32-bit file size un or error code, by channel no. c. syscall -re- man 2 fstat. dpans: 11.6.1.1522 (eflags reflect error code)=> file-position ( c -- ud er ) (s)(a:f) 'fposf' forth return double file-ptr & error code =/= 0; dpans: 11.6.1.1520=> file-access ( p u n1 -- 0 | er ) (s)(a:fx) 'faccessf' forth n1 OR-able flags {r-ok}, {w-ok}, {x-ok}, {f-ok}. ret zero if caller has access according to flag n1 to file the path+name of which is u chars at p, else ret -ve error code. syscall access -re- man 2 .., linux/fs/open.c. security relevant applications should check _after_ open. NOTE: syscall by <root> returns root permissions, i.e. all enabled.=> file>file ( c1 c2 ud1 u2 -- er ) (s) 'f2file' forth fast, kernel-space only file transfer, send u2 bytes from channel c1 to channel c2, beginning at file-ptr ud1. ret er = error code or er = no. of bytes sent; no channels being closed. copy by file names -re- {copy-file}. syscall sendfile -re- man(2) sendfile, man(2) mmap. NOTE: source restricted to channels which support <mmap> operations, destination may be a socket but, not the source channel.=> faccess ( n c -- er ) (s) 'faccessfd' linux test file access perm by channel no. c w/ query mask n ret er = ff if accessible, else -ve. -re- {file-access}. note: requires access to the /proc filing system=> f8gls ( p1 u1 -- p2 u2 ) ((kv)) util store path+file(p2,u2) of l4-glossary to buf(p1,u1) NOTE: string concatenation requires buf(p1,u1) as an argument!=> f8glo ( -- p u ) (kv) util ret glossary filename stg(p,u)=> -- directories f8doc ( -- p u ) (kv) util ret path to lib4th documentation files (dft compiled in by lib4th compilation).=> f8dir ( -- p u ) forth path to lib4th supplemental files (fix, compiled in w/ __LIBF8D in Makefile): '__LIBF8D:__LIBF8D/app:~/.f8:~/f8:~/.f8/app:~/f8/app:$(__LIBDIR)'=> f-ok ( -- n ) (m,6) 'fok' forth file present, file access query flag=> f" ccc ( -- p u ) (i)(4) 'fqte' forth {fname"} w/ {path-max} bytes buf. at {pad}. -re- {[fname]}.=> dir ( n1 -- n2 ) (m,6) 'dirf' linux modify acess flag to open only if file is directory=> delete-file ( p u -- er ) (s)(a:f) 'deletf' forth ret 0 or, -ve er after failure. syscall -re- man 2 unlink; dpans: 11.6.1.1190 ! if data security is an issue, pse, note that there is no safe way to ! erasing any data from e.g., a hard disk, but physical destruction...=> cwd@ ( p1 u1 -- p1 u2 | er ) (s) 'cwdf' linux fetch current working directory path to buf(p1,u1), ret stg(p1,u2) or, p1 and -ve error code. buffer limited to u bytes, by syscall, max up to { path-size 2+ }. syscall getcwd -re- man 2 ...=> create-file ( p u n1 -- n2 n3 ) (s)(a:f) 'creaf' forth open old and truncate or, create new file; dpans: 11.6.1.1010. {open-file} w/ TRUNC, CREAT, NONBLOCK flags or-ed to access code.=> create-dir ( p u -- n2 n3 ) (s)(a:f) 'cread' linux create a directory w/ file access mask &02700. -re- man 2 mkdir=> cre ( n1 -- n2 ) (m,6) 'cref' linux modify acess flag to truncate after open, i.e. open overwriting=> copy-file ( p1 u1 p2 u2 -- er ) (s) 'copyf' forth fast, kernel-space only file transfer by file names; copy in-file(p1,u1) overwriting to out-file(p2,u2). ret er:=error code or er:=no. of bytes sent. no ernum in {work}-cdt. ret w/ out-file un-modified if in-file opening returns an error. copy by channel numbers -re- {file>file}. syscall -re- man 2 sendfile. NOTE: source restricted to channels which support <mmap> operations, destination may be a socket. for instance, cannot be used to reading /dev/vcs{,a}.=> close-file ( c -- er ) (s) 'closef' forth close-dir ( c -- er ) (s) 'closef' ans closes channel no. c, ret er = 0 after success, else error code er = +ve (fd, duplicate exists) or -ve (fss error). invalidates corresponding chp entry. if {work} is duplicate to channel c closes work, also. flushing from host OS caches back to file, if writeable. doesn't actually close if duplicate channel other than {work} exists, protected if c = stdin or, c=(source-id&(max-chan-1)). syscalls -re- man 2 close, fsync; dpans: 11.6.1.0900=> close-file ( c -- er ) (s) 'closef' forth close-dir ( c -- er ) (s) 'closef' ans closes channel no. c, ret er = 0 after success, else error code er = +ve (fd, duplicate exists) or -ve (fss error). invalidates corresponding chp entry. if {work} is duplicate to channel c closes work, also. flushing from host OS caches back to file, if writeable. doesn't actually close if duplicate channel other than {work} exists, protected if c = stdin or, c=(source-id&(max-chan-1)). syscalls -re- man 2 close, fsync; dpans: 11.6.1.0900=> chdir ( p u -- 0 | er ) (s) 'chdirf' linux change working directory to path (p,u) syscall chdir -re- man 2 ...=> cd ccc( -- ) (4)(i) 'cdf' root change working directory to {bl}-delimited path ccc. no error message, noop if path doesn't exist; $HOME if zero length text. use -re- {s"} or {string} and {chdir} for path names w/ blanks.=> bin ( n1 -- n2 ) (a:f)(m,0) 'binf' forth modify access flag to binary (non text, <eol>, etc) mode. dpans: 11.6.1.0765, specific to a certain 'OS', a {noop} in Linux. ANS required; "bin"ary is a *transfer* mode and not a files entity!=> app ( n1 -- n2 ) (m,6) 'appf' linux modify acess flag to append mode=> a-close ( -- ) 'aclose' util close channels no. 5 .. { max-chan 1- }, and work-channel (3).=> [source] ( -- p +u ) (k)(83) 'bsourceb' hidden dft for {source}, ret input buffer(p,u). does not modify {in}, {span} &c. dpans A.6.1.2216 : { BLK @ IF BLK @ BLOCK 1024 ELSE TIB #TIB @ THEN } modified such that -ve {BLK}@ is 1-s cpl of file ptr and notifies input from 'stream'-file and, initial state of commandline args at program invocation by -ve @{SOURCE-ID}.=> [fname] ( p1 u1 p2 u2 -- p3 u3 ) (i)(4) 'bfnameb' forth search in {f8dir}, {path} and {lxpath} for filename(p2,u2); ret fully qualified path+file name stg(p3,u3) to buf(p1,u1). else, if file not found ret empty stg(p3,u3) u3=0.=> [fn ( p1 u1 p2 u2 -- p3 u3 ) 'pfnamep' hidden -re- {[fname]} runtime, searching for file(p2,u2) in sequence of -re- {f8dir}, {path}, {lxpath}.=> xg-io ( -- ) (4) 'xgio' linux exchange stdin and stdout channel definitions=> xg-chan ( c1 c2 -- ) 'xgchan' forth exchange channel defn-s c1 and c2=> x-io ( -- ) (4) 'xio' root exchange in-chan,out-chan,err-chan w. stdin,stdout,stderr, required to executing piped or redirected input and writing redirected output.=> work-id ( -- n ) 'workid' linux=> work-num ( -- c ) linux find highest channel no. with fd currently in {work}=> to-chan ( c1 c2 -- ) 'tochan' forth copy c1 channel description to channel no. c2=> source-chan ( -- c ) 'sourcechan' forth current input source channel=> set-chan ( .x. .nn. c -- .x. ) 'setchan' linux store file data to channel no. c datafield, clear flags & ptrs=> pty? ( c -- flg ) (4) 'ptyq' linux query channel c by file-name, ret tf if c is a pty device set cdt.iofl in chp according to channel type of pipe or pty. note: requires access to the /proc filing system=> out-pty? ( -- flg ) (4) 'outptyq' linux tf if STDOUT is to a pty-device,=> out-id ( -- n ) 'outid' linux=> new-chan ( -- c | -1 ) 'newchan' forth get lowest free channel number, c in range (prt-chan,scr1-chan).=> max-chan ( -- n ) (c)(m,6) 'maxchan' linux ret max. number of available channel ptrs/numbers.=> kbd-id ( -- n ) 'kbdid' linux keyboard channel number=> kbd-chan ( -- n ) (c)(m,6) 'kbdchan' forth keyboard-channel number - system channel, not redirectable.=> kbd' ccc( -- ) (i) 'kbdt' forth cpl/interpret next word to executing w. stdin from console (keyboard). immediate words <ccc> will be rejected.=> is-chan ( c -- ) 'ischan' forth assign work-channel data to channel no. c=> in-id ( -- n ) 'inid' linux=> get-chan ( .x. c -- .x. .nn. ) 'getchan' linux fetch file description of channel no. c, ready to {set-chan}=> fd>chan ( fd c -- ) (e) 'fd2ch' linux close previously existent channel c, store file descriptor fd to channel c. fills cdt items from {fstat}: iofl if c is a pipe, double cells fptr, perm. note: the pipe flag is yet uncertain, due to false/incomplete linux docs! (e: Z after success, edx:=chp true addr=> err-id ( -- n ) 'errid' linux=> echo-on ( c -- ) ((s)) 'echon' forth test whether c is a console channel, modify cdt-flags to echoing, if appropriate. w/ syscall ioctl,TIOCGSID=> echo-off ( c -- ) 'echof' forth if c is a console channel, modify cdt-flags to non-echoing=> ctag+ ( -- n ) 'ctagp' system increment channel open tag, ret previous no.=> chp>chan ( p -- c ) 'chp2ch' linux find channel number from chp - not for {work}-channel=> chp ( c -- p | abort-3 ) linux ptr p to description of channel c=> chn-num ( fd -- c ) 'chnnum' linux find highest channel no. which refers to file descriptor fd. find highest unused channel no. if fd = -1 passed - re {new-chan}=> channel ( c -- n1 n2 ) forth channel i/o-flags n2 and id n1. n1 := -1 if fd not available, flags then in-valid. other flags -re- {ch-rnum}, {ch-omode}, {ch-perm}, {ch-eof}=> ch-tag ( c -- n ) 'chtag' linux ret channel c tag no. n < 0 if c not an open channel.=> ch-stat ( c -- ) 'chstat' linux collect channel type- & status-bits into cdt.=> ch-rnum ( c -- n ) 'chrnum' linux ret channel c specific latest error code. ret file size initially after open.=> ch-pty? ( c -- flg ) 'chptyq' linux tf if c is in range -re- {max-chan}, and connected to a pty device.=> ch-pipe? ( c -- flg ) 'chpipeq' root tf if c is in range of lib4th channels and a pipe or fifo channel.=> ch-perm ( c -- n ) (m,10) 'chpermf' linux channel permission bits. dft is un-set, n=0=> ch-omode ( c -- n ) (m,10) 'chomodef' linux ret channel open mode from its cdt. dft is un-set, n=0. includes NO test whether the channel is currently accessible!=> ch-name ( p1 u1 c -- p1 u2 | p1 0 ) (s) 'chname' forth find path and filename of channel c; requires access to the "/proc" filesystem. returns valid name w. +ve u2 or, on error u2:=0; does not store a count-byte. error code stored to uvari {(ierr)}, -1 if channel c was not open. uses {hld} area, below {pad2}, overwritten by words for numeric stg output. syscall readlink -re- man 2 ..=> ch-id ( c -- fd | abort-3 ) 'chid' linux file descriptor, n := -1 if fd not available. abort if c not in range [0,max-chan); dft -re- {max-chan} = 64 (L4 v10+). channel flags -re- {channel}, {ch-rnum}, {ch-omode}, {ch-perm}, {ch-eof}.=> ch-flags ( c -- n ) (m,10) 'chflagsf' linux channel flags. dft is un-set, n=0=> ch-eof ( c -- flg ) 'cheof' linux ret tf at file eof (if zero ernum in cdt) -re- {ch-rnum}. tf immediately after open, valid result after any reading/writing attempt.=> ch-cons? ( c -- flg ) 'chconsq' linux tf if c is in range of lib4th channels and a console channel -re- {max-chan}.=> cdt-xptr ( -- n ) (c)(m,6) 'cdtxptr' linux ret disp to xtension ptr in a channel's defn table=> cdt-size ( -- n ) (c)(m,6) 'cdtsize' linux ret size in bytes of a single channel defn table.=> cdt-fptr ( -- n ) (c)(m,6) 'cdtfptr' linux ret disp to double cell file ptr in a channel's defn table -re- {channel}, {ch-rnum}, {ch-omode}, {ch-perm}, {ch-eof}.=> cdt-flags ( -- n ) (c)(m,6) 'cdtflags' linux ret disp to flags in a channel's defn table -re- {channel}, {ch-rnum}, {ch-omode}, {ch-perm}, {ch-eof}.=> WORDLIST? ( wid -- n | -1 ) 'wordlq' ans item number wrt {current} of wordlist by wid in search order, -1 not found. n is index into vocstack, by { ' name idx>wid WORDLIST? -8 * current + }. wid = 0 to finding the actual bottom of vocstack, ret -1 if no space left. -re- {order?} for ref by ix or lfa.=> wordlist ccc(C: -- )(X: -- wid ) (a:s) forth create an empty, named wordlist, linked into {voc-link} chain. 'wid' points to voc-link in the rsp. wordlist header. re DPANS 16.6.1.1595: number of wordlists is not limited.=> vocs ( -- ) (4)(f6) root display names of all vocabularies=> vocabulary ccc( -- )(X: -- ) forth re DPANS 16.6.1.1595: the number of vocabularies is not limited!=> unsmudge ( -- ) root mark -re- {latest} word-header ready for -re- {find}.=> smudge ( -- ) (e) fig toggle smudge bit of -re- {latest} word-header. (e: Z flag reflects smudge state)=> set-vocs ( wfl.. m wid.. n -- ) 'setvocs' root restore search-order(wid,n) and voc-flags(wfl,m) abort if false count/unsufficient data on stack=> set-vocflags ( -- wfl .. wfl n ) 'svocflags' hidden complements {set-order} by storing vocabulary flags abort if false count/unsufficient data on stack=> set-order ( wid ... n -- ) (a:v) 'sorder' root store list of n vocabulary identifiers to stacked search order. includes {context} and {ocontext}, vocflags remain unmodified. abort if false count/unsufficient data on stack=> set-current ( wid -- ) (a:v) 'scurrent' root tore {current} wordlist identifier.=> SEARCH-WORDLIST ( p1 u1 p2 -- p3 flg ) (a:s) 'swlist' ans find name(p1,u1) in headers chain beginning at rsp. top-lfa p2. ANS-4th aequivalent to (find) - re below. p2 from wordlist identifer w. { wordlist wid>top }.=> rvoc ( -- ) (i)(f6)(X) root restore previous context from {ocontext}.=> root-wordlist ( -- wid ) (a:-) 'rootwl' hidden=> previous ( -- ) (i)(a:sx)(x) root copy @{ocontext} to {context}, pop top item from vocstack to {ocontext}.=> prevdef ( -- ) (f6)(X) root restore previous current from {ocurrent}.=> order? ( ix | lfa -- n | -1 ) 'orderq' forth ret item number wrt {current} of voc by ix in voc-stack, -1 if not found. n points to the rsp. ptr into vocstack by { ' name order? -8 * current + }. ix = -1 to finding the actual bottom of vocstack, ret -1 if no space left. -re- {WORDLIST?} for ref by wid.=> order ( -- ) (4)(a:v) root display current, context, previous context and stacked search order vocabularies.=> only ( -- ) (i)(a:sx)(X) root reset search order to only {root} in {context}.=> no-opt ( -- ) (i) 'noopt' root xec: modify -re- {latest} word to not optimizing jmp for ret. cpl: suppress latest word's jmp-modification by resetting the cpl'd words' counter to zero, uvari {(cmc)}.=> immediate ( -- ) root modify -re- {latest} word to immediately executing. -re- {imed?}=> get-vocs ( -- wfl n wid.. n ) (l4) 'getvocs' root fetch all wid-s and voc.-flags currently in stacked search order.=> get-vocflags ( -- wfl..wfl n ) (l4) 'gvocflags' hidden complements {get-order} by fetching vocabulary flags=> GET-ORDER ( -- wid .. wid n ) (a:v) 'gorder' ans get stacked vocabularies identifiers and count. this list includes {context} and {ocontext}, @context top wid on stack the list can be preserved w/ a bignum {ninteger} { GET-ORDER also bignum ninteger -name- previous } for restoration w/ { -name- SET-ORDER }. ANS-4th; -re- {get-vocs}, {set-vocs} for a more complete version.=> get-current ( -- wid ) (a:v) 'gcurrent' root fetch {current} wordlist identifier.=> forth-wordlist ( -- wid ) (a:v) 'forthwl' root=> definitions (a:s)(X) root set current to context vocabulary, store old in ocurrent for restauration by {prevdef}. does { current ocurrent @! context current @! }=> casedep ( -- ) compiler modify -re- {latest} word to only case dependently being found.=> also ( -- ) (i)(a:sx)(x) root push vocs in search order one item up, copy {context} into {ocontext}. push is move all one item down in memory and store new to hi address. stack size is 2+{#vocs} items (dft:2+16).=> words ( -- ) (f6) forth alphabetically sorted list all names of {context} vocabulary, use keys <space> to halt, <esc> to terminate display. for once only(!) selective display -re- {selected}, {words} returns w/ (selected) reset to it's default action.=> wait ( u -- ) (s) forth sleep ( u -- ) (s) linux wait u seconds. syscall -re- man 2 nanosleep=> vlist ( -- ) (fg) forth consecutively list all names of {context} vocabulary, use keys <space> to halt, <esc> to terminate display.=> timezone ( -- n ) ((s)) 'tz4' linux numeric value n of host's clock time zone.=> time&date ( -- n1...n6 ) (4)(a:yx) 'timedate' forth ret time & date n1..n6, second, minute, hour, day, month, year. NOTE: POSIX.1 defines seconds since the Epoch as a value to be interpreted as the number of seconds between a specified time and the Epoch, according to a formula for conversion from GMT equivalent, leap seconds ignoring and considering all years which are a multiple of 4 being leap years.=> time ( -- ts tm| er -1 ) (s) 'time4' forth ret ts := time in seconds, tm := remaining microsec (on tos) or ernum and -1. syscall gettimeofday, re man(2), linux/time.h=> tdump ( p n -- ) (4) tools memory dump w.o. args storage - re {dump}=> see ccc( -- ) (a:f) forth (at most) decompile a hi-level word/soubroutine call by name. interrupt w. <esc>, halt display w. <space>, any other key to carry on. stores final ptr to {fld}, for continuation w. {#see}. NOTE: decompiles aliased words to names earliest in wordheaders list.=> s (4) 'nsee' tools 8 times repeat #see=> rdump ( -- ) (f6) tools repeat previous {dump} or {adump} action=> ndump ( -- ) tools continue dump=> msgstg ( n -- p u ) forth return ptr p and length u of message stg corresponding to signed no. n=> message? ( n -- ) 'messageq' forth display system message if n=/=0, -re- {message}=> message ( n -- ) forth display system message, lib4th defined w/ +n, Linux kernel w/ -n overflow: 'msg #' n display startup text if n = 0x80000000=> hash11 ( p u -- n ) (F4) linux standard ELF hashing procedure, ret hash figure n for string(p,u).=> errstg ( n -- p u ) 'errs' forth return ptr to error name corresponding to no. n leading "E" implied.=> errno? ( -- ) 'ernoq' forth display error names in {errno} list. exit w/ <esc> key, halt w/ <bl> and continue w/ any other key.=> errno ( p u -- n ) 'erno' forth find error number +n corresponding to given name p,u. leading "E" may be omitted.=> dumpa ( p n -- ) (4)(f6) tools dump no. n bytes of contents at ptr p display w. true addresses executes {dump} if cnt is -ve=> dump ( p n -- ) (4)(f6) forth dump no. n bytes of contents at ptr p <space> to halt, <esc> key to abort display, <any other key> after <space> continues. stores p & n for {rdump}, executes {dumpa} if cnt is -ve all {dump} variants use local data-space for numeric conversion. NOTE: system exceptions can lead to local- and data-space corruption, which may partly be recovered, examining dp, lp and s0 values, w/ { dp lp !! } and { last @ lfa>idx >body 4+ dp ! }.=> daystg ( n [cc] -- p u ) 'daystg' forth return ptr to day name corresponding to no. n optional country code cc, one of <en>, <de> (l4_0.0.57).=> day ( -- n ) 'day4' forth no. of day per week, 0 for Sunday.=> date ( -- n ) (s) 'date4' forth ret n := time in seconds sice 1.1.1970 or, error syscall time, re man(2), linux/time.h=> bdump ( -- ) tools continue dump towards lower addr.=> all-words ( -- ) util {vlist} all vocabularies. use keys <space> to halt, <esc> to terminate display.=> all-find ccc( -- lfa flg ) 'allfind' util as {find}, searching all {voc-link}ed wordlists=> adump ( a u -- ) tools dump from true address=> .time&date ( [cc] -- ) (4) 'dotimedate' forth display full size system date & time stg using {hld} buffer below {pad2} and {here} for intermediate storage.=> .s ( -- ) (4) 'dots' forth display datastack content, topmost item to the left, w/ leading ">D[#depth:#base]"; signed if @base = decimal, else unsigned. 1st char, ">" if interpreting, "=" while compiling, by system prompt. (asm debugging: eflags, all reg. and stack contents preserved) stack display variants use local data-space for numeric conversion. NOTE: system exceptions may lead to local- and data-space corruption, which can partly be recovered by exchanging dp and s0 values.=> .rs ( -- ) (4) 'dotrs' tools display kref'd returnstack content, topmost item to the left, w. leading "R[#depth:#base]"; signed if @base = decimal, else unsigned. (asm debugging: eflags, all reg. and stack contents preserved) stack display variants use local data-space for numeric conversion. NOTE: system exceptions may lead to local- and data-space corruption, which can partly be recovered by exchanging dp and s0 values.=> [s] ( -- ) (i)(4) 'dotsi' tools immediate variant of -re- {.s}, for debugging, reg/eflags preserved. displaying state@, rp@, lp@, sp@, before stack content; <cr> terminated. (asm debugging: eflags, all reg. and stack contents preserved)=> [rs] ( -- ) (i)(4) 'dotrsi' tools immediate variant of -re- {.rs}, {cr} appended. (asm debugging: eflags, all reg. and stack contents preserved)=> [all-find] ( p -- lfa flg ) 'ballfindb' util {find} word from counted stg(p) searching all {voc-link}ed wordlists.=> "timezone ( -- n ) ((s)) 'stz4' linux numeric value n of host's clock time zone.=> "time&date ( [cc] -- p u ) (4) 'stimedate' forth full size system date & time stg, in stg buffer at {pad2}.=> "time ( -- p u ) (4) 'stime4' forth return system time stg(p,u) stg in {hld}-buffer below {pad2}, using {here} for intermediate storage.=> "date ( [cc] -- p u ) (4) 'sdate4' forth return system date stg(p,u) stg in {hld}-buffer below {pad2}, using {here} for intermediate storage. use <en> or <de> decoding if [cc] present and = "en" or "de", dft & "en": year-month-day, "de": day-month-year.=> "day ( [cc] -- p u ) (4) 'sday4' forth ret stg(p,u) w/ name-stg of system time day use <en> or <de> decoding if [cc] present and = "en" or "de"=> #see ( -- ) (4) 'hsee' tools continue where {see} terminated, from @fld, inc @fld at least by 1.=> #dcm ( p1 -- p2 ) (4)(e) 'hdcm' tools decompile from ref by ptr p1 to codespace, leave ptr p2 to next opr. (e: ret NZ at end of code section, after <ret> or <jmp ...>=> >time&date ( n1 -- n2..n7 ) (4) 'totida' forth convert n1 seconds since "the Epoch" to time&date format n7:year n6:month n5:day n4:hour n3:minute n2:second=> true ( -- tf ) (e)(m,6) forth leave cell value with all bits set (-1)=> [THEN] ( -- ) (i) 'noop' root terminate [IF] construct.=> [IF] ( flg -- ) (i)(4) 'bifb' root immediate, non-compiling decision construct, for conditional cpl, etc. ([if]/[else]... construct transposed from -re- dpans94 document)=> [ELSE] ( -- ) (i)(4) 'belseb' root enter execution alternative after false flag to [IF].=> defined ccc( -- f ) (w3) forth [DEFINED] ccc( -- f ) (i) ans tf if wordd ccc found in current search order.=> [0=] ( n1 -- flg ) (i) 'zeq' ans "immediate"ly execute {0=}=> mem ( -- n ) (m,3) 'zero' forth flag for bit opr's, test cell in memory (single cons 0)=> if-true ( flg -- ) (i)(f6) 'iftrue' root conditionally include text until <eol> to interpretation=> if-nfound ccc( -- ) (i)(f6) 'ifnfound' root conditionally include text until <eol> to interpretation=> if-found ccc( -- ) (i)(f6) 'iffound' root conditionally include text until <eol> to interpretation=> defined ccc( -- f ) (w3) forth [DEFINED] ccc( -- f ) (i) ans tf if wordd ccc found in current search order.=> xec? ( n -- addr flg ) 'xecq' forth test whether n is -most probably- an {execute}able item, either one of an uot index, kref'd or, true address of code entry. n = 0 is not considered valid, thus ix of {root} not recognized. ret flg (any non-zero value!) and executable true address.=> udisp? ( n -- n flg ) 'udispq' forth check whether disp n to uref(uot) is in range and 4-aligned.=> static? ( p -- fl ) 'staticq' system true flag if program statically linked to L4.=> prog? ( p -- fl ) 'progq' hidden true flag if kref'd p points to allocated compile-memory.=> null? ( p -- f ) 'nullq' hidden tf if p = 0 or ref to zero 4th address=> locals? ( n -- flg ) 'localsq' forth tf if suffient no. of currently reserved local cells available.=> kprog? ( p -- fl ) 'kprogq' hidden true flag if kref'd p in kernel or allocated compile-memory.=> kernel? ( p -- fl ) 'kernelq' hidden true flag if kref'd p points to library kernel memory.=> depth? ( n -- flg ) (f6) 'depthq' forth tf if at least n cells on stack.=> data? ( p -- fl ) 'dataq' hidden true flag if kref'd p points to allocated r/x data-memory.=> ?stack ( -- abort ) (fg) 'qstack' forth abort w. message "empty stack" if unsufficient space, abort w. message "stack overflow" if sp@+2*PAGE_SIZE > rp@, else continue silently=> ?prog ( p -- p | abort-21 ) 'qprog' forth abort if p not in job's allocated compile-memory=> ?pairs ( f1 f2 -- | abort ) (fg) 'qpairs' forth abort if f1 =/= f2=> ?exec ( -- | abort-18 ) 'qexec' forth abort if not in true (vs. imtermediatly) executing state=> ?error ( flg n2 -- | in blk ,quit ) (v) 'qerror' forth if nonzero flg display error message no. n2 and {quit}=> ?depth ( n -- | abort ) (f6) 'qdepth' forth check whether sufficient data cells on datastack, else rst datatstack and send message "off working area" to stderr=> ?csp ( -- | abort ) 'qcsp' forth abort if stack is out of balance w. stored value from {csp}.=> ?comp ( -- | abort-17 ) 'qcomp' forth abort if not in compiling state=> { ccc( -- )(C: n1..nn -- ) (i) 'loccb' forth define local values in stack flow notation order, left to right. use "{ initiated locals | self-zeroing locals -- comment }" accessing double items: .. { n1l n1h } .. loc2@ n1l swap d. .. loc-ptr n1h 2@ swap d. .. NOTE: this was a short 'hack' to enabling the apparently more 'fashionable' notation in stack flow order, where only(!) the initated locals cells storage is in opposite order wrt that of {locals|}.=> locals| ccc( -- )(C: n1..nn -- ) (i)(a:lx) 'locbar' forth parse list of names delimited by "|" and assign local values, accordingly. use at beginning of a colon definition, before any other control structure. accessing double items: .. locals| n1h n1l | .. loc2@ n1h d. .. loc-ptr n1l 2@ d. .. (Non-)Limits: Locals don't interfere w/ any other data access method, stacks, dictionary, etc. and, next levels' locals can be accessed in the order of definition. The number of locals is not limited other than by available stack- and data-space, locals' names are limited to the common 255 chars (bytes) as for any words' names. A runtime local takes 4 bytes of locals area, "below" data-stack, and 7 bytes in code-space. While compiling a local uses 8 cells plus name-length in data space and an uot index. further description re {local:}, compile-mode, and ANS word {(LOCAL)}.=> locref{ ccc ... } ( -- ) (i) 'locref' forth refer to a caller's locals in sequence of given names list such, that any group of forth words operating on locals can be factored to separate words w/o requiring repeatedly fetching and storeing just to pass the arguments. names by this list are local, used to compile the rsp. reference by index in sequence left to right, which coincides w/ the sequence of the caller's words, regardless of their names, if set up with -re- "{". next levels' locals can be accessed in the order of definition. NOTE1: a thus defined word cannot allocate own local values! NOTE2: access to doubles as in the word the locals of which locref{ refers to.=> local: ccc(C: -- )(C: p f ix -- )(X: -- n ) (i)(a:l) 'locol' hidden ccc(I: n -- ) (X: -- n ) define a single cell sized local value by name ccc. used by {locals:}. use outside any other control structure, preferrably at beginning of a coln defn. words with a {locals|} group may be {exit}ted, out of order. While interpreting: constitute a {value} in local dataspace, in {local} wordlist execution of <ccc>: push local value to tos. While compiling: constitute a {value} in local dataspace, in {local} wordlist, accessible by name within the current colon-definition, only. initially push 3rd control item to tos, set <mlocal> state-bit. runtime <ccc> declaration: assign local data-space, transfer cell from tos. execution: push local value to tos. Data structure: memory @s0-@(locb}[ local memory .. @last ... local value(s) ]@s0 xec [ header [@pfa=kref(xec)][@body=disp] ] value @(@s0-disp) Storing a value 1: value initially taken from @tos. 2: {to} and {+to} designed to modify either, local or global {value}s. 3: by ptr to local data-field ( nn -- ) { loc-ptr name ! } multiple cells storage in descending order of locals assignation, latest named local stores l.s.cell of the rsp. item, for instance { ..locals| n1 n2 n3 n4 | loc-ptr n4 4!.. } 4: fetch/store a double ( d1 -- d2 ) { ..loc2! name .. loc2@ name.. } NOTE1: while compiling pushes a 3rd cell to control-stack (at data-stack) which will be required for locals resolution by {;}, therefore the locals| group should not be cpl'd within a program flow structure. NOTE2: due to indirection of local data access, global values, variables or constants execute faster than locals; a short sequence of simple stack operations may be much faster, still. also, consider utilizing the {pick} and {-pick} operations. NOTE3: locals stored to contiguous data-space, thus linearly accessible across multiple, unlimited levels.=> [locdef] (4) 'blocdefb' hidden support for the {(locals)} definition; cpl { also local definitions }.=> locrmv (C: ps lp | ix ps lp -- ) (i)(c) compiler cpl intermediate local values de-allocation, do-nothing if none exist; by {;s}=> loc2@ ccc( -- dn ) (i)(C) 'loc2f' local cpl fetch double local vari, using named value's posn and next. little endian cells order wrt {locals|} setup, name ccc at l.s.cell.=> loc2! ccc( dn -- ) (i)(C) 'loc2s' local cpl store double local vari, using named value's posn and next. little endian cells order wrt {locals|} setup, name ccc at l.s.cell.=> loc!! ccc ccc( -- ) (i) 'locxsto' forth exchange two local values by names, use{ loc!! name1 name2 }.=> >loc ( n -- ) forth allocates and clears +n or de-allocates -n cells of local data-space, accordingly adjusts user vari {s0}, {(locb)} and {csp}. requires explicite removal by -ve n, before end of a compiled word, use before {locals|} defn to keeping the rsp local values' ptrs valid! asm: LP register <esi> set to true addr @s0 after de-/allocation.=> (LOCAL) ( p u -- ) (e) 'plocalp' ans builds a local wordheader w. name from string(p,u). use not within a control structure! stores disp to local cell wrt LP = @s0 to 'body'. at compile-time allocates local memory as required, diff @s0 before and after; single cell runtime reservation. reserved names: '--' introducing comment in " .. { .. | .. -- .. } " ';' terminator of other purpose ordered lists - n.i. '}' terminator in " .. { .. | .. -- .. } " '|' terminator in " .. locals| ... | " and, introducing zero-initiated locals in ".. { .. | .. -- .. }" ';', 'M:' reserved for other data structures (M = single decimal digit) (e: ret Z and char(s) in edx after reserved name, else NZ)=> (locn) ( -- p ) 'locn' hidden local cells count in currently being defined word=> (locb) ( -- p ) 'locb' hidden used local bytes counter=> top-mblock ( -- p ) 'topmblock' forth find ptr to beginning of top {allocate}d memory block, p := "free space" posn, after heap-header, initially = @c0.=> rmv-link ( p1 p2 -- ) 'rmvlink' system un-link ptr p1 from linked list per base ptr p2.=> resize ( p1 u -- p2 er ) (a:m) 'resizem' forth provided for top block, only: new memtop stored to (top), error if 0 > er > -4096 p1 ptr to after heap-header of top {allocate}d block. example: { (bot) @ abs>4th dup headhead-size + swap @ 4000 + resize 0if }. No garbage collection - which lib4th, if efficiently used, does not require, e.g, due to it's extended LOCALS and BLOCK words -re- {local:}, {ibbuf} &c.=> heaphead-size ( -- n ) (c) 'hpheads' linux size of heap header (16/8 bytes = 4/2 cells) allocated: [ len ][ handler ][ pid ][ flagptr ][ ..memory.. ] free: [ len ][ next block ][ ..memory.. ]=> free ( p -- er ) (a:m)(e) 'freem' forth assign {allocate}d top memory block p back to system heap (.bss section) ok if p was top block new memtop stored to (top), error if 0 > er > -4096 {d-top} adjusted to { p heaphead-size - } if new top below old. p is ptr to after heap structure data, as returned by {allocate}. (e: Z after success, S on error, ENOBUFS if ptrs not suitable=> allocate ( u -- p 0 | p er ) (a:m) 'allocatem' forth allocate u bytes of memory in system heap (.bss section), aligned to multiples of Linux PAGE_SIZE, minimum is PAGE_SIZE = 4Kb (for Linux-2.2.+ and 2.4.+). ret ptr p to beginning of free space, after heap header. new memtop stored to (top), error if 0 > er > -4096 {d-top} remains unchanged! adjust if extension of program dataspace intended, new top of data-memory is { p heaphead-size - dup @ + }, which then can be stored to {d-top} to make it available to the rsp. words. -re- LOCALS wordsets, {locals|} &c, for temporary buffers allocation, -re- {ibbuf} and BLOCK words, for an alternate/supplemental allocation scheme.=> add-link ( p1 p2 -- ) 'addlink' system link ptr p1 into linked list per base ptr p2.=> ?resize ( n -- ) '?resizem' forth -re- {resize} if {allot}ting n bytes would leave less than PAGE_SIZE of free data-space; - does not {allot} but, is called by {allot}.=> wait4x ( n1 xt -- n2 n3 ) 'wait4x' linux xec any i/o related word w/ the {(stimo)} uvari set to n1 no. of seconds for specific time-out. restores previous setting, after return. effective for all words which call a {wait4..} word, e.g. {key}, etc. ret n2 = n3 := -1 if xt was not an executeable item.=> wait4' ccc( n1 -- n2 n3 ) (i) 'wait4t' linux xec any i/o related word ccc w/ the {(stimo)} uvari set to n1 no. of seconds for specific time-out. restores previous setting, after return. effective for all words which call a {wait4..} word, e.g. {key}, etc. ret n2 := n3 := -1 if xt was not an executeable item.=> wait4ti ( ch n1 -- n2 n3 ) ((s)) linux wait for n1 seconds until input pending to channel ch, -re- {wait4ch}=> wait4kbd ( -- ) (s) linux wait until keyboard (console channel) input pending=> wait4in ( -- ) (s) linux wait until input pending if stdin is console limited to stdin channel identifiers (fd-s) in range [0,31]. actual FILE_MAX can be read from /proc/sys/fs/file-max=> wait4fd ( fd -- ) (s) linux wait until input pending to channel's fd. limited to fd-s in range [0,31]. time-out from uvari {(stimo)} [s] and {(stimo) 4-} [µs]. max ea $7fffffff. executes the (pause) vector if idle and, if an(y) alternate uot exists. syscall select -re- man 2 ...=> wait4ch ( ch -- n1 n2 ) ((s)) linux wait for @(stimo) seconds until input pending to (any type) channel ch, ret n1=n2=0 after timeout, else remaining seconds(n2) and nanosec(n1). limited to channel identifiers (fd-s) in range [0,31]. syscall -re- man 2 select, remaining time is a feature specific to linux.=> stty-s ( c -- er ) 'sttys' linux set console channel c to known state - Linux "stty sane"=> setty ( -- ) linux prepare stdin to single key input, called once on init after intro, de-activated by byte @uv.aux =/= 0, set to -ve afterwd. can be executed to restoring tty state e.g, after a -re- {sh}ell command <uref> expected valid, but NO <kref>'d code all regs preserved=> rstty ( -- ) linux reset {work}-channel console to initial state, called once, with {bye} or when job/thread(?) killed <uref> expected valid.=> pw!s ( ptr n port -- ) 'pwss' linux store n 16-bit values from memory at ptr to port=> pw! ( n port -- ) 'pws' linux store l.s. 16-bit of n to port=> pw@s ( ptr n port -- ) 'pwfs' linux store n 16-bit values from port to memory at ptr=> pw@ ( port -- n ) 'pwf' linux read 16-bit value from port=> pc!s ( ptr n port -- ) 'pcss' linux store n 8-bit values from memory at ptr to port=> pc! ( n port -- ) 'pcs' linux store l.s. 8-bit of n to port=> pc@s ( ptr n port -- ) 'pcfs' linux store n 8-bit values from port to memory at ptr=> pc@ ( port -- n ) 'pcf' linux read 8-bit value from port=> p!s ( ptr n port -- ) 'pss' linux store n 32-bit values from memory at ptr to port=> p! ( n port -- ) 'ps' linux store 32bit n data to port=> p@s ( ptr n port -- ) 'pfs' linux store n 32-bit values from port to memory at ptr=> p@ ( port -- n ) 'pf' linux read 32-bit value from port=> otty ( -- ) linux open & init r/w channel to current console on succes store fs to stdin cdt, close previous stdin all regs preserved, ernum from open attempt in (ierr) NOTE: open when input was file after program termination leaves console in nowait and no-echo state -> why?=> iopl ( n -- er ) (s) 'sysiopl' linux set i/o permission level to n, requires <root> access rights syscall iopl -re- man 2 ...=> ioperm ( n1 n2 n3 -- er ) (s) 'sysioperm' linux set access mode n3 of n2 ports beginning w. port no. n1. restricted to port 0..3ff, requires <root> access rights syscall ioperm -re- man 2 ...=> iomode ( -- ) (s) linux setting stdin to non-blocking r/o, stdout to sync. w/o syscall fcntl -re- man 2 ...=> ioctl ( p op ch -- ernum ) (e) 'cioctl' linux ioctl system call p ptr to data structure, op ioctl operational flag, ch i/o channel. NOTE: console ioctls are not that useful, though they could, in a more reasonable implementation. many of those nice features are simply useless because the settings affect #all# consoles, globally... (e: S on error)=> fcntl ( p op ch -- ernum ) (e) 'cfcntl' linux fcntl system call p:=ptr to data structure, op:=fcntl operational flag, ch:=i/o channel (e: S on error)=> lxpath ( -- p u ) linux path to host constants sources files=> lxfiles ( -- p u ) linux compiled host constants source files list=> xlock ( ix -- ) system exec routine at ix while interrupts locked and port i/o enabled ix is uot index of word to execute. lock, exec, unlock, ret to caller. suid programs, only! %define __lockthread in "constants.inc" to activate.=> syskill ( n1 +n2 -- er ) (s)(mc) linux send signal +n2 to process(group) n1, receive error flag er. n1 +ve:job, n1=0:current process group, n1=-1:all but pid 0, n1 -ve:-(group) detailled description re man(2) kill, man(7) signal. syscall -re- man 2 kill=> syscall ( p n -- p er ) (mc) 'scall' linux executes OS specific system call n, returns value/error code in er, syscall parameters from table at p, p pointing to top item in list: :lo[ ebp, edi, esi, edx, ecx, ebx ]hi: p pointing to posn of ebx. <ebx> corresponds to 1st arg in the rsp linux manual pages description. sequence of pushed to return-stack arguments is in same order as "C" functions parameter lists but, wrt a structure in memory or, the L4 data-stack which grows towards higher addresses, the arguments should be passed in reversed order, i,e. "right to left". -re- {sys} {[sys]}. NOTE: addresses expected by true values, as converted by {4th>abs}. as some safety measure, {syscall} rejects syscall <mprotect>. example f8 access, all arguments but eax and sp@ are optional, dependent on the rsp. system call: ( edi esi edx ecx ebx sp@ eax -- edi esi edx ecx ebx eax2 ) where eax2 is result, replacing the passed syscall number from eax on entry. for instance, reading a directory entry (file open, channel in work-id): { 0x100 pad 4th>abs work-id sp@ #141 syscall } Further: f8 { HELP name }: (sys), [sys], sys, lxstg, mprotect Linux system calls libc access documentation in <man> section 2, numbers vs names, asmutils <os_linux.inc>, <linux/include/unistd.h>. http://www.lxhp.in-berlin.de/lhpsycal.html (syscalls doc, en)=> uid! ( n -- er ) (s)(m,8) 'uids' linux set real and effective user id of calling job syscall -re- man 2 setuid=> uid@ ( -- n ) (s)(m,8) 'uidf' linux fetch real user id of calling job syscall -re- man 2 getuid=> usercopy ( addr1 -- addr2 ) (k) adjust bounds and copy old to new set of uservari=> sys ccc( p -- er ) (i) linux xec/cpl literal syscall by name ccc, -re- {syscall}, {(sys)}. example:{ pad 0x200 2dup erase over 4th>abs sp@ sys uname 3drop dump } NOTE: { 0 1 sp@ 4th>abs 0 swap sp@ sys nanosleep } kernel 2.2.19 requires different ptrs for nanosleep, which might apply to other syscalls, too.=> wait ( u -- ) (s) forth sleep ( u -- ) (s) linux wait u seconds. syscall -re- man 2 nanosleep=> sleep-m ( u -- ) (s)(mc) linux wait u microseconds syscall -re- man 2 nanosleep=> sleep-n ( u1 u2 -- ) (s) 'nsleep' linux sleep for u1 s + u2 ns syscall -re- man 2 nanosleep=> sigstg ( n -- p u ) 'sigs' linux return ptr to signal name corresponding to no. n leading "SIG" implied.=> signo? ( -- ) 'signoq' linux display signal names in {signo} list. exit w/ <esc> key, halt w/ <bl> and continue w/ any other key.=> signo ( p u -- n ) linux find signal number +n corresponding to given name p,u. leading "SIG" may be omitted.=> sighnd-size ( -- n ) 'sighsz' linux (unified) size of a signal handler definition block. -re- uvari {(sighnd)}.=> set-cal ( -- ) (f6)(mc) 'setcal' hidden find processor timing, 1s quiet + 1s for measurement. single (l.s.) cell result stored to user-vari (tick). multiple measurements accumulate to previous value, 1:1.=> prot-x ( -- n ) (c)(m,6) 'protx' linux enable executing memory access, OR-able mode-flag to {mprotect}, {mmap} (implies reading accessability!)=> prot-w ( -- n ) (c)(m,6) 'protw' linux enable writing memory access, OR-able mode-flag to {mprotect}, {mmap} (implies reading and execution accessability!)=> prot-r ( -- n ) (c)(m,6) 'protr' linux enable reading memory access, OR-able mode-flag to {mprotect}, {mmap} (implies execution accessability!)=> pause ( -- ) 'cpause' system xec from @(pause) either by true address, by uot index or, by 'pfax' ptr. noop if zero, kref'd zero or, not in executeable program memory.=> page-size ( -- n ) (c)(m,6) 'pagesize' linux Linux PAGE_SIZE system cons (4K w/ kernel 2.2.xx), -re- {paligned}.=> pid@ ( -- n ) (s)(m,8) 'pidf' linux fetch process-id of calling job re {4th-id} for main job-id syscall -re- man 2 getpid=> ms ( u -- ) (s)(a:fx) forth wait u milliseconds (accuracy greater than 2 o/oo, w. rt-linux). re DPANS 10.4.1.1/10.6.2.1905: repeatbility w/ rtl extension in range of nano-seconds, otherwise deviation and min. time slice by about 10ms. syscall -re- man 2 nanosleep=> mtunlock ( -- ) system unlock multitasking: enable interrupts, disable global port i/o. a noop if not applicable, -re- {mtlock}=> mtlock ( -- ) system lock multitasking, i.e. interrupts(!), enable global port i/o. use {mtunlock} or {xlock} to re-enable keyboard and files access. NOTE1: use PAIRED WITH {mtunlock}, else might leave OS un-accessible! NOTE2: interrupt locking active w/ root or suid root programs, only. %define __lockthread in "constants.inc" to locked data transfer mode.=> mprotect ( a n1 n2 -- er ) (s) 'mprot' linux set memory access mode, range n1 at true address a, access mode n2. range and address expected page aligned. disabled for linux user "root". NOTE that execution can only be inhibited w. NO access rights, at all! syscall -re- man (2) mprotect; {prot-r}, {prot-w}, {prot-x}, {page-size}.=> gid! ( n -- er ) (s)(m,8) 'gids' linux set real and effective process-group id of calling job syscall -re- man 2 setgid=> gid@ ( -- n ) (s)(m,8) 'gidf' linux fetch real process-group id of calling job syscall -re- man 2 getgid=> getgot ( -- p | 0 ) linux access to lib4th g.o.t.; restores kref, ret 0 if inactive. no subroutine fetching, programs must set up own got reference. re macro <GETGOT> in "reloc.inc"=> getenv ( p1 u1 -- p2 u2 | p1 0 ) (4) 'gtenv' linux get ptr p2 and cnt u2 to program's environment strings by name at p1,u1 p2,u2 ptr to empty stg & u2 := 0 if env-vari name not found. searching case-in/dependently, as set w. {lc-depend} or {lc-ignore}. -re- {envstg}; cmd-line args: {--}, {(argc)}, {(argp)}, {(args)}, {argstg}.=> argstg ( u1 -- p u2 ) linux get program's passed asciz argument strings p,u2 by number u1. cnt begins at 1, 0 for program name. ovf & -ve returns <zero> in-active args after dummy arg "--", with: { (argc) @ dup (argn) @ - begin 1+ 2dup < 0= while dup argstg type cr repeat } -re- {--}, {(argc)}, {(argp)}, {(args)}; {envstg}, {getenv}.=> envstg ( u1 -- p u2 ) linux get ptr to program's asciz environment strings by number u cnt begins at 1, 0 and overflow return empty stg. program name is asciz string at { (argp) @ @ abs>4th }. display all env strings: { -1 1 rshift 1 do i envstg dup if type cr else 2drop leave endif loop } pre-defined: {path}, {term}, re {f8ini} which executes F8INI env vari. -re- {getenv}; cmd-line args: {--}, {(argc)}, {(argp)}, {(args)}, {argstg}.=> lxstg ( n1 n2 -- p u ) linux index list# -- ptr count, u := 0 if n1,n2 out of range index 0..3 for terminal control: 0:ctrls, 1:F-console, 2:F-xterm, 3:colours by [ ctrl stg <nul> ] { 0 4 cstg } returns ptr & sum of length's of syscalls names by items of [ 16bit number | chars name <nul> ] asciz names in sequence of the rsp. numbers, for "sys". { 0 5 cstg } returns ptr & sum of length's of colour-strings 0 ctrl termcaps ho,le,nd,up,do,cl,cd,ce,bl,dc,dl,sf,sr,so,se,us,ue,md, mr,mb,me,blink off, reverse video off,xy,ris,sc,rc 1 console termcaps k1,k2,k3,k4,k5,k6,k7,k8,k9,k0,kl,kr,ku,kd,kh,kH,kN,kP,kb,kD,kI F11..F20 is <\e[23~> ... <\e[34~> - \e[22~ apparently unused(?) 2 xterm termcaps k1,k2,k3,k4,k5,k6,k7,k8,k9,k0,kl,kr,ku,kd,kh,kH,kN,kP,kb,kD,kI 3 colours fg: black,red,green,brown,blue,magenta,cyan,white,underscore-on,-off bg: black,red,green,brown,blue,magenta,cyan,white,default,default=> allocjob ( -- newtop|ernum ) (k) page align and allocate memory in .bss/RAM=> alarm ( n -- ) (s)(4) 'calarm' forth alarm signal after (n) seconds by syscall 'alarm', signal handler executes deferred {(alarm)} which may be set to user supplied word. NOTE: redirected calls due to till unknown reason could push/pop to/from datastack, and may even modify other ptrs/regs. check, before setting (alarm) to a self-calling 4th word! EXAMPLE: : a cur! 0. at-xy .time&date cur@ 10 alarm ; ' a is (alarm) 1 alarm \ enable default-is (alarm) \ disable -re- <4th/edit.f8>=> 4th-id ( -- n ) (f6)(m,7) 'fthid' forth basic task's process id, set on startup. re {pid@} for currently running job's id=> ?ms ( -- n ) ans ret no. of milli-seconds elapsed after host system start. not a standard word! frequently used w/ certain (pseudo-)ansi-ish benchmark programs... initiall 1s delay - if neither {set-cal} nor {ti-cal} previously executed. NOTE: prefer {tick} and {ti-cal}, for reliable & exact time measurements.=> [sys] ( p1 p2 u2 -- p1 er ) (i) 'bsysb' linux execute syscall by name(p2,u2) with register values at addr p1. -re- {syscall}, {(sys)} example: { 0 1 sp@ 4th>abs dup sp@ s" nanosleep" [sys] }=> (sys) ( p u -- n | er ) 'psysp' linux fetch syscall-no. n by name(p,u); syscalls were compiled into L4 from the actually present linux source. display currently available names & numbers w. u<0, e.g. { -1. (sys) }.=> [pause] ( -- ) (s) 'bpauseb' system force re-scheduling (nanosleep w. zero waiting time) syscall -re- man 2 nanosleep=> (top) ( -- p ) 'mtop' hidden true address of global RAM/.bss top, end of user area=> (sstop) ( -- p ) 'sstop' hidden true address of top of .ss section (lowest address) section can be extended by pushing any item to requested new address, e.g: { ]] (sstop) @ 10000 - abs>4th r0 @ swap r0 ! rp! 0 >r rdrop r0 ! rp! [[ }=> (bot) ( -- p ) 'mbot' hidden true address of bottom of user task memory=> (esp) ( -- p ) 'uesp' hidden 'RP', esp of initiating program=> (edi) ( -- p ) 'uedi' hidden 'PS', datastack running ptr initial/task switching register value=> (esi) ( -- p ) 'uesi' hidden 'LS', locals ptr initial/task switching register value=> (ebp) ( -- p ) 'uebp' hidden 'UR', ref into user vari initial/task switching register value=> (ebx) ( -- p ) 'uebx' hidden 'KR', ref into kernel memory (ROM) initial/task switching register value=> (edx) ( -- p ) 'uedx' hidden T-reg., initial/task switching register value=> (ecx) ( -- p ) 'uecx' hidden W-reg., initial/task switching register value=> (eax) ( -- p ) 'ueax' hidden @tos, initial/task switching register value=> <top> ( -- p ) 'utop' hidden p *is* ptr to top of user-vari area - neither read nor store!=> udsqrt ( ud1 -- ud2 j ) 'fudsqrt' non-mmx ud2 := +ve sqare root of double |ud1|; j := -1 if ud1 signed < 0. note: ud2 m.s.cell always zero, left in place for -re- {vsqrt}, {dvsqrt}. ud2 is nearest integer the sqare of which is lower or equal |ud1|*(2j-1).=> rotd2s ( n1 n2 n3 -- n1 n1 n2 n3 ) (m) 'rotd2sf' non-mmx substitutes { rot dup 2swap }, non-mmx (e: eflags remain unchanged)=> femms ( -- ) (m,2) 'femmsf' non-mmx clear floating point cpu registers=> 8sdrop ( q1 q2 -- q2 ) 'sdrop8f' non-mmx=> 8sover ( qv1 qv2 -- qv2 qv1 qv2 ) 'sover8f' non-mmx { qvswap qvover }, 8 cells per item swap and over=> 8over ( n1..n8 n9..n16 -- n1..n8 n9..n16 n1..n8 ) 'over8f' non-mmx copy 2nd @tos eight cells=> 8dup ( ra1 ra2 -- ra1 r2 r1 r2 ) 'dup8f' non-mmx=> 4swap ( q1 q2 -- q2 q1 ) 'swap4f' non-mmx=> 4sover ( q1 q2 -- q2 q1 q2 ) 'sover4f' non-mmx does{ 4swap 4over }=> 4sdrop ( q1 q2 -- q2 ) 'sdrop4f' non-mmx=> 4rotd ( q1 q2 q3 -- q2 q3 ) 'rot4df' non-mmx non-mmx aequivalent to { 4rot 4drop }.=> 4rot ( q1 q2 q3 -- q2 q3 q1 ) 'rot4f' non-mmx roll 3rd quad to @tos=> 4over ( q1 q2 -- q1 q2 q1 ) 'over4f' non-mmx=> 4dup ( q1 -- q1 q1 ) 'dup4f' non-mmx=> 4-rot ( q1 q2 q3 -- q2 q3 q1 ) (4) 'mrot4f' non-mmx reverse roll quad @tos to 3rd=> 4!! ( p1 p2 -- ) 'qxstof' non-mmx exchange contents of quad at p1 with quad at p2, non-mmx=> 3dup ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3 ) 'dup3f' non-mmx duplicate top three cells @tos; non-mmx subst. (e: eflags remain unchanged)=> 2srot ( d1 d2 d3 -- d3 d2 d1 ) () 'srot2f' non-mmx { 2swap 2rot }, i.e. exchanges @tos and 2nd (e: eflags remain unchanged)=> 2sover ( d1 d2 -- d2 d1 d2 ) (4) 'twosoverf' non-mmx { 2swap 2over } (e: eflags remain unchanged)=> 2sdup ( d1 d2 -- d2 d1 d1 ) 'twosdupf' non-mmx does{ 2swap 2dup } or, { 2over 2swap }; non-mmx subst.=> 2rshifta ( dx1 u -- dx2 ) (e) 'drshiftfa' non-mmx shift right a double, sign preserving=> 2rshift ( dx1 u -- dx2 ) (e) 'drshiftf' non-mmx logic shift right double, u mod 64. non-mmx subst.=> 2rotd ( d1 d2 d3 -- d2 d3 ) 'rotd2f' non-mmx (e: eflags remain unchanged)=> 2rot ( d1 d2 d3 -- d2 d3 d1 ) (a:dx) 'rot2f' non-mmx roll 3rd double to tos; non-mmx subst.=> 2lshift ( dx1 u -- dx2 ) (e) 'dlshiftf' non-mmx logic shift left double=> 2!! ( p1 p2 -- ) 'twoxstof' non-mmx exchange contents of double at p1 with double at p2, non-mmx=> 2@! ( p1 p2 -- ) 'twofstof' non-mmx copy double cell from ptr p1 to ptr p2=> nlit, ( .x. N -- ) (k) 'c_nlit' compiler cpl counted integer=> plocto, ( -n -- ) (k)(13) 'c_plocto' compiler cpl local "+to", mov ecx,@tos; spop; add [lref disp],ecx=> locto, ( -n -- ) (k)(13) 'c_locto' compiler cpl local "to", mov ecx,@tos; spop;mov [lref disp],ecx=> locp, ( n -- ) (k)(10) 'c_locp' compiler cpl ptr to a local "value", <spush> : mov eax,LP: sub eax,KR: sub eax,disp=> locv, ( n -- ) (k)(7) 'c_locv' compiler cpl single local "value", <spush> : mov eax,[lref disp]=> flit, ( f -- ) (k) 'c_flit' compiler cpl double precision f.p. literal (n.i.)=> qlit, ( q -- ) (k) 'c_qlit' compiler cpl quad literal=> qvlit, ( qv -- ) (k) 'c_qvlit' compiler cpl quad ranum (four cells' pair) literal=> lit, ( n -- ) (k) 'c_lit' compiler cpl single literal, <spush> mov eax,dword n, $abb8(dd)=> valu, ( n -- ) (k) 'c_valu' compiler cpl single "value": <spush> : mov eax,[kref dword n], $ab8b83(dd)=> sto, ( n -- n ) (k) 'c_sto' compiler prepare cpl store and drop @tos to "value", mov [kref dword n],eax\ <spop> caller must save c-here and store n to this ptr+2, after compilation, re {to} implementation for an example. $8983(dd)8d7ffc8b07=> plsto, ( n -- n ) (k) 'c_plsto' compiler prepare cpl add and drop @tos to "value", add [kref dword n],eax; spop caller must save c-here and store n to this ptr+2, after compilation, re {to} implementation for an example. $8983(dd)8d7ffc8b07=> litp, ( n -- ) (k) 'c_litp' compiler cpl single literal, add eax,dword n, $abb8(dd)=> itos, ( -- ) 'c_itos' compiler mov eax,imed, $b8(dd)=> itos1, ( n -- ) 'c_itos1' compiler mov TOS(1),imed, $c747fc(dd)=> ktos, ( disp -- ) 'c_ktos' compiler mov eax,[kref (disp)], $8b83(dd)=> ktosm, ( -- ) 'c_ktosm' compiler mov TOS(1),ecx, $894ffc=> ktos1, ( disp -- ) 'c_ktos1' compiler mov ecx,[kref (disp)], $8b8b(dd)=> utos, ( disp -- ) 'c_utod' compiler mov eax,[uref (disp)], $8b85(dd-link)=> utosa, ( disp -- ) 'c_utosa' compiler add eax,[uref (disp)], add user vari, $0385(dd-link)=> xtos, ( disp -- ) 'c_xtos' compiler mov eax,[uref uv.ultab+(disp)], $8b85(ltab+dd)=> iwld, ( n -- ) 'c_iwld' compiler load W register: mov ecx,imed, $b9(dd)=> itld, ( n -- ) 'c_itld' compiler load T register: mov edx,imed, $ba(dd)=> ret, ( -- ) 'c_ret' compiler return from suroutine call, $c3=> xjmp, ( disp -- ) 'c_xjmp' compiler jmp [uref uv.ultab+(disp)], $ffa5(ltab+dd)=> xcall, ( disp -- ) 'c_xcall' compiler call [uref uv.ultab+(disp)], $ff95(ltab+dd)=> xcalla, ( -- ) 'c_xcalla' compiler call [uref 4*reg+uv.ultab], $ff9485(ltab+dd)=> kcall, ( disp -- ) 'c_kcall' compiler call [dword kref (disp)], $ff93(dd)=> spop, ( -- ) 'c_spop' compiler drop @nos into @tos, $8B47FC8D7FFC patch -ve bytecount at byte {c-here}-1 and {c-here}-8, after compilation=> spush2, ( -- ) 'c_spush2' compiler free @tos for double data item, $abab (stosd, stosd)=> spush, ( -- ) 'c_spush' compiler push @tos, free @tos for data item; $ab=> tospull, ( -- ) 'c_tospull' compiler TOSPULL(1), dec PS by one cell; $8d7ffc=> tospush, ( -- ) 'c_tospush' compiler TOSPUSH(1), inc PS by one cell; $8d7f04=> jmpn, ( n -- ) 'c_jmpn' compiler jmp near disp $e9(dd)=> jmps, ( n -- ) 'c_jmps' compiler jmp short disp $eb(db)=> jccn, ( n -- ) 'c_jccn' compiler jcc near disp $0f80(dd)=> jccs, ( n -- ) 'c_jccs' compiler jcc short disp $70(db)=> dodoes, ( -- ) (k) 'c_dds' compiler cpl dodoes frame, pfa to be patched in at start+2 cpl: lea edx,[pfa]; lea ecx,[edx+4]; add edx,[kref edx]; add edx,KR; jmp edx=> dlit, ( d -- ) (k) 'c_dlit' compiler cpl double literal=> call, ( n -- ) 'c_call' compiler call dword disp $e8(dd)=> [;] ( -- )(R: a -- ) 'bsemib' compiler terminating words' runtime check/adjustmt of return address a, by -re- {;r}. checking: noop if a > c-here, in dll code (not further tested) cpl <ret> at c-here+1 and adjust a accordingly, otherwise use carefully, might not return to caller! preferrably, utilize the {[:]} word.=> [:] ( -- )(R: a -- a ) 'bcolonb' compiler words' entry runtime check of return address a, by -re- {:r}. checking: fill with <ret> bytes until a+2 if @cp < a < @d0, c-allot accordingly, noop if a within bounds of @c0 and @cp, already cpl'd, noop if a within bounds of dll code, within <Y> and <YE>, dll bot, Y: { 0 4th>abs }, dll top, YE: { 0 @ 4th>abs }. xec addressing error otherwise.=> macro ( -- ) (i) 'cmacro' compiler enable expanded code compiling, flag in (bits) uvari.=> mac-size ( ix -- n ) (i) 'macsize' compiler ret n = no. of bytes to be cpl'd in macro compiling mode, n = 0 if word cannot be compiled as a macro.=> mac-disp ( ix -- n ) (i) 'macdisp' compiler ret n = disp of macro code from xec entry, -ve n if word cannot be compiled as a macro.=> imed? ( n -- f ) 'imedq' compiler ret f =/= 0 if lfa or ix n points to an -re- {immediate} word. other flags -re- {cmac} {imed}, {ixec}, {pfax}, {nopt}, {smud}, {inif}, {varf}, {vocf}, {wcas}, {xwfl} flags set by the rsp. defining words; a program should safely modify no other than {imed}, {smud}, {wcas}: set ( flag lfa -- ) { lfa>ffa or! } clear ( flag lfa -- ) { swap not swap lfa>ffa and! }=> flg>head ( +n xt -- f ) 'flg2head' compiler set flag by mask +n in header of word by uot index xt, ( -n xt -- f ) mask off any unset header bits by mask -n. ret ff if ix not valid, else tf.=> end-macro ( -- ) (i) 'cendmacro' compiler disable expanded code compiling, flag in (bits) uvari.=> cpl; ( -- ) (i) hidden terminate permanent code compilation=> cpl ( -- ) (i) hidden advance {c-here} to current codeptr=> cmc? ( -- ) (i) 'cmcq' compiler immediately(!) sedecimal display {cmc} value.=> call-by-uot ( -- ) (i) 'cbuot' compiler enable call to indirect uot reference compiling mode. system default, 4th word calls are 6 bytes, ea. call-by-uot mode compiles indirect calls to uot cells by index yet n.i: which is independent of a particular lib4th version and, enables position independent pre-compiled modules loading. (re "lib4th.mac", <callx> and <jmpx> macroes for assembly level (application programming.=> call-by-disp ( -- ) (i) 'cbdisp' compiler enable call by displacement compiling mode. code can execute up to about 50% faster than by ref to uot but, might often also be not significantly faster, at all. compiles one byte shorter code for 4th words calls (5 bytes). call-by-disp mode compiles calls by PC-relative displacements which thus depends on a particular lib4th version.=> call-by-disp? ( -- flg ) 'cbdispq' compiler true flag if call by immediate displacement compiling enabled.=> asciz ( -- n ) 'hasciz' compiler state-flag value for the asciz string compiling state, for {z"} & {place}, flg valid until next change of state.=> xwfl ( -- n ) 'hxwfl' compiler header flag: additional parameter-fields count mask (0..15), no. of dwords (cells) after concerning word header's pfa.=> wcas ( -- n ) 'hwcas' compiler header flag: word may only be found case dependently=> vocf ( -- n ) 'hvocf' compiler header flag: word is vocabulary, fieldcount is no. of wordheaders. set by -re- {vocabulary} or {wordlist} definition.=> varf ( -- n ) 'hvarf' compiler header flag: 2nd-ary pfa holds disp to beginning of variables dataspace. used for default values and ptr's of kernel defined variables=> inif ( -- n ) 'hinif' compiler header flag: word which requires initialization from header data @pfa is ptr to init. code wrt beginning of module=> smud ( -- n ) 'hsmud' compiler header flag: word finding disabled, un-set by {unsmudge}, toggled by {smudge}=> nopt ( -- n ) 'hnopt' compiler header flag: suppress backward code optimizing=> pfax ( -- n ) 'hpfax' compiler header flag: execute from pfa in header, pass ptr to body in ecx=> ixec ( -- n ) 'hixec' compiler header flag: do not compiled execute when in interpreting state; provision for the emergency case - e.g. {bye}, {cold}.=> imed ( -- n ) 'himed' compiler header flag: immediately executing, set by {immediate}; -re- {imed?}=> cmac ( -- n ) 'hcmac' compiler header flag: compile-macro, bitmask to compiling inline code.=> c0-8* ( n1 -- n2 ) 'c0m8m' asm-hidden { $c0 - 8 * }=> c0- ( n1 -- n2 ) 'c0m' asm-hidden { $c0 - }=> c0+ ( n1 -- n2 ) 'c0p' asm-hidden { $c0 + }=> 8*+ ( n1 n2 -- n3 ) 'mp8' asm-hidden { 8 * + }=> 16*+ ( n1 n2 -- n3 ) 'mp16' asm-hidden { 16 * + }=> <ret> ( -- n ) (m,6) 'lretg' assembler <ret> processor code=> <nop> ( -- n ) (m,6) 'lnopg' assembler <nop> processor code=> <jr> ( -- n ) (m,6) 'ljrg' assembler <jmp short pcrel> processor code use ( ptr -- ) { <jr> 1, c-here 1+ - 1, }=> <jmp> ( -- n ) (m,6) 'ljmpg' assembler <jmp near pcrel> processor code use ( ptr -- ) { <jmp> 1, c-here 4+ - 4, }=> <call> ( -- n ) (m,6) 'lcallg' assembler <call pc-rel> processor code, use ( ptr -- ) { <call> 1, c-here 4+ - 4, } cpl call by uot index w. -re- {[,]}=> version ( -- ) (u) root display lib4th version=> vers ( -- n ) root decimal 4 bytes version no., release, version, extension, tag. re {lib4th}=> tick>s ( dn -- dn ) 'tic2s' forth convert cpu clocks to seconds=> tick ( -- dn ) (f6)(m,9) 'tic' root read cpu hardware clock register, using "rdtsc" opr. DPANS 10.4.1.1: can be used to determining duration of a system-clock tick.=> term ( -- p u ) 'eterm' linux ret terminal type from TERM env-vari, -re- {getenv}, {envstg}.=> sigmsg ( x -- x ) (s)(u) linux display signal message to STDERR if -ve x in range syscall write -re- man 2 ...=> real-user ( -- ) (s) 'ruser' root if set, recover from setuid-mode: set effective user id equal to real one. syscalls -re- man 2 getuid, setuid=> \\ ccc( -- ) 'quit' forth comment till eof, exits loadfile (to next lower nesting level) quit ( .xx. -- .xx. ) (R: .xx. -- ) (C: .xx. -- ) (v) root the outer interpreter, dft xec {[quit]}.=> lib4th ( -- ) (uninitiated) root rst kref, print library version, re {vers}=> kmessage ( x -- +x ) (s)(u) hidden print to STDERR, message no. @tos, if -ve x in range flags & all regs but W, <ecx>, preserved, KR restored/set syscall write -re- man 2 ...=> help ccc( -- ) (i) root Display help-text from glossary for word ccc or, @context if none given: 1st occurrence of ccc in sequence of all {voc-link}ed wordlists will be displayed; use { hv help } to searching the stacked search order, only. { vocs } displays the default search order specific to {help}. Searching can further be narrowed w/ {lc-depend} to letter case dependency. An error message will be returned, if word ccc or glossary file not found. The glossary file the name of which is stored in -re- {f8glo} is expected in the documentation directory -re- {f8doc}, redirectable by ptrs to the rsp strings in kernel-values {(f8doc)}, {(f8gls)}. {help} finds a word enclosed by leading <nl><bl> and trailing char <= <bl> in a glossary header line, w/ "( .. )" stack balance and ref to vocabulary and, reads/displays the rsp and any following lines until empty line found. By default, applicable to kernel words, only, and if the simple glossaries were generated w/ e.g. <make doc>. Additional, conformant text may then be appended to the file <glossary> in the installed documentation directory which becomes available to any lib4th programs, immediately after. plain ascii, un-escaped text displayed by -re- {[type]}. error messages: ?vocabulary 24 unknown or, voc-ref error in <glossary> file; try {v name} to verifying whether a word exists. invalid arg. -22 <glossary> access or, text format error. no data avail. -61 <glossary> reading error.=> getrefb ( -- ) (k) system restore kernel library reference register (KR=ebx) subroutines, 4th-words, all data refer to this address; for direct 4th/asm programming, single one non-relative reference.=> get-cp ( -- p ) 'getcp' system fetch 4th-ptr to where this word returns. { : tt get-cp [ c-here ] literal = ; tt } returns 'true'.=> --env-ini ( -- ) system f8ini ( -- ) system evaluate F8INI environment variable. active word in {system} wordlist! -re- {getenv}, {envstg}.=> error ( n --> quit ) (d) 'errorv' root display error (+n) or system (-n) message and -re- {quit}.=> bye-r ( n -- ) (s) 'byer' linux display pid & message if n<0 terminate and pass exitcode |n| to caller. syscalls -re- {bye}=> bye ( -- ) (s)(w) root exit program, exitcode 0 syscalls exit, getgid, kill, write -re- man 2 ...=> beep ( n1 n2 -- ) (s) forth sound generation, pitch n1[84µs], duration n2[ms] (standard console ^G sound is n2:=125, n1:=1591) syscall ioctl -re- man 2 ...=> hv ( -- ) 'hvstack' root restrict {help} to searching wordlists from stacked search order, only.=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> [abort] 'babortb' hidden deferred -re- {abort} default.=> .cpu ( -- ) 'dotcpu' forth display actual host system cpu type, "XL(cpu)".=> -- ( -- ) 'slsl' root optional, active initial arguments terminator; a noop used for termination by <argcopy> at program startup - effective only if passed as a single argument! -re- {argstg}, {(argc)}, {(argp)}, {(args)}; {envstg}, {getenv}.=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> TOOLS-EXT ( -- fl ) environment=> TOOLS ( -- fl ) environment=> STRING ( -- fl ) environment=> STACK-CELLS (k)=> SEARCH-ORDER-EXT ( -- fl ) environment=> SEARCH-ORDER ( -- fl ) environment=> RETURNSTACK-CELLS ( -- n ) environment query returns half size of data- and return-stack shared memory area.=> MEMORY_ALLOC ( -- fl ) environment=> MAX-UD ( -- d ) environment=> MAX-U ( -- n ) environment=> MAX-N ( -- n ) environment max. sing integer, MIN-N is -ve MAX-N (i.e. hex 80000000 not a valid integer!).=> MAX-FLOAT (k)=> MAX-D ( -- d ) environment max. double integer, MIN-D is -ve MAX-D (hex 80...00 is not a valid double!).=> MAX-CHAR ( -- n ) environment=> LOCALS-EXT ( -- fl ) environment=> LOCALS ( -- fl ) environment=> LIB4TH ( -- -1 ) environment whether a program is using/based on "lib4th"=> FLOORED ( -- ff ) environment=> FLOATING-EXT (k)=> FLOATING (k)=> FILE-EXT ( -- fl ) environment=> FILE ( -- fl ) environment=> FACIILITY-EXT ( -- fl ) environment=> FACILITY ( -- fl ) environment=> EXCEPTION-EXT ( -- fl ) environment=> EXCEPTION ( -- fl ) environment untested, hi-level substitutes available=> ENVIRONMENT? ( p u -- ff | .xx. flg ) (a:c)(v) 'envirq' root letter case independently find and, execute ANS-4th environment string. returns zero for any non-present capability.=> DOUBLE-EXT ( -- fl ) environment=> DOUBLE ( -- fl ) environment=> STACK-CELLS ( -- n ) environment DATASTACK-SIZE ( -- n ) environment (NOTE: data- and return-stack share a common memory area.)=> CORE-EXT ( -- 0 ) environment=> CORE ( -- 0 ) environment=> BLOCK-EXT ( -- fl ) environment=> BLOCK ( -- fl ) environment=> ADDRESS-UNIT-BITS ( -- n ) environment=> #LOCALS ( -- n ) environment cells count remaining available for allocation in local dataspace. n is taken as half of unused memory between data- and return-stack, where dependent on both stacks actual useage more or less locals may be allocated. This limit is about 1/8 that value while compiling, due to additional space being used for the temporary named word-headers. A Local requires 8 cells plus the name's length, while at runtime occupying only a single cell.=> /PAD ( -- n ) environment=> /HOLD ( -- n ) environment space for numeric to stg conversion, between {pad2} and {here}.=> /COUNTED-STRING ( -- n ) environment=> true ( -- tf ) (e)(m,6) forth leave cell value with all bits set (-1)=> true ( -- tf ) (m,6) 'pone' fig f.i.g. true flag = 1 (+ve!)=> off ( p -- ) (83)(m,) forth store 0 to cell at p=> on ( p -- ) (83)(m,) forth store -1 to cell at p=> mem ( -- n ) (m,3) 'zero' forth flag for bit opr's, test cell in memory (single cons 0)=> blbl ( -- c ) (m,6) 'blbl' hidden dft. character code of double blank space, for skip/scan w. ctrl-s=> bl ( -- c ) (m,6) 'bbl' forth dft. character code of blank space=> -0 ( -- n1 ) (f6)(m,6) 'mzero' forth single cons -0 (zero with sign bit set)=> (lochar) ( -- p ) 'plocharp' hidden dft upper to lower case mapping character table=> (hichar) ( -- p ) 'phicharp' hidden dft lower to upper case mapping character table=> 0. ( -- dn ) (m,4) 'dzero' forth double cons 0=> -0. ( -- dn ) (f6) 'dmzero' forth double cons -0 (zero with sign bit set)=> -1. ( -- dn ) 'dmone' forth double cons -1=> cell ( -- n1 ) (a:c) 'pfour' forth no. of bytes per cell (4)=> ?null ( p -- abort-14 ) 'qnull' forth abort w/ "Bad address" if p is zero or zero 4th address=> int-ptrace ( -- ) (m,2) 'intptrace' system debugger breakpoint NOTE: due to SIGTRAP exits L4-job if not attached to a debugger.=> unpack ( n1 -- n2 ) forth expand l.s. 4 4bit-nibbles to cell of 4 8-bit bytes=> tstb ( p1 n2 -- flg ) (m,13) forth the cpu BT memory instruction, flg =/= 0 if specified bit is set. test bit no. n2 in range of [-2^31..2^31-1] wrt memory ptr p1.=> setb ( p1 n2 -- flg ) (m,13) 'setb4' forth the cpu BTS memory instruction, set bit n2 wrt n1 - re {tstb}=> resb ( p1 n2 -- flg ) (m,13) 'resb4' forth the cpu BTR memory instruction, reset bit n2 wrt n1 - re {tstb}=> rdpmc ( n -- na nb nc nd ) 'rdpmcf' system read perfromance monitoring counters (n = 0 or 1). (not tested: segfaults w. k6-2 cpu)=> push4th ( -- )(R: -- LP UR SP KR ) system save (true) cpu regs used by kernel: KR (ebx), LP(esi), SP(edi), UR(ebp). supposed to preserving L4 state e.g, for usage w/ external libraries.=> pop4th ( -- )(R: LP UR SP KR -- ) system restore cpu regs which were saved to returnstack -re- {push4th}=> pack ( n1 -- n2 ) forth pack a cells 4 l.s. 4bit-nibbles per 8bit-byte to 16bit word=> emms ( -- ) (m,2) 'emmsf' forth clear mmx cpu registers=> cpuid ( n -- na nb nc nd ) 'cpuidf' system clear/sync cpu state. fetch level(n) register values eax..edx of <cpuid> instruction.=> cplb ( p1 n2 -- flg ) (m,13) forth the cpu BTC instruction, complement bit n2 wrt n1 - re {tstb}=> bswap ( n1 -- n2 ) (m,2) 'bbswap' forth swap bytes, convert big <-> little endian byte order. -re- {swap2s} for conversion by cells (e: eflags remain unchanged)=> bsrr ( n1 -- n2 | -1 ) (m,10) forth bit scan register=> bsrm ( p n1 -- n2 | -1 ) forth bit scan reverse in memory, range limited by count n1 > 0 cells. ret bitcount n2 from ptr p to the last non-zero bit in address range [p,p+n1*4].=> bsr ( n1 f -- n2 | -1 ) 'bsrf' forth scan for bit-no. n2 of most significant set bit, beginning at m.s. bit, n1 = cell value if f = 0, else n1 = ptr to memory, scanning up to f cells.=> bsfr ( n1 -- n2 | -1 ) (m,10) forth bit scan register=> bsfm ( p n1 -- n2 | -1 ) forth bit scan forward in memory, range limited by count n1 > 0 cells. ret bitcount n2 from ptr p to the 1st non-zero bit in address range [p,p+n1*4].=> bsf ( n1 f -- n2 | -1 ) 'bsff' forth scan for bit-no. n2 of 1st set bit, beginning at least significant bit, use n1 as a cell value if f=0 -re- {bsfr}- else n1 = ptr to memory and cells range = f -re- {bsfm}: { n 0 bsf } aequivalent to { n sp@ 1 bsf }.=> sh ( p u -- ) root execute an outer shell command by stg(p,u)=> sh| ( p1 u1 p2 u2 -- ) n.i. root execute an outer shell command by stg(p1,u1), pipe output to buffer(p2,u2)=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> random ( d1 -- d2 ) util ret random number d2 in range [0,d1). calc new @{seed}, (re-)init if @{seed} = 0.=> randomize ( -- ) util initiate/refresh quad vari -re- {seed} from /dev/urandom=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> sorted ccc( p n -- ) (i)(4) util according to the relation ccc order array(p,n), n cells at ptr p. use{ SORTED <relation> } - 'relation' being stored to {precedes}.=> sort ( ptr n1 -- ) (4) util Modified "quicksort", sort an array by ptr p to array of n1 items. (R.Zech, Forth 83, Muenchen Franzis' 1987) -re- {quick}, {sorted}. An example application (on assembly level) is -re- {words}.=> quick ( ptr1 ptr2 -- ) (4) util sort arrays by ptrs, using deferred words to enabling virtual memory addressing and task specific evaluation words: {precedes} ( p1 p2 -- flg ) comparison at p1,p2, tf if "lower" {d@} ( p -- n ) fetch sing n from ptr p {d!} ( n p1 -- ) store sing n to ptr p {d!!} ( p1 p2 -- ) exchange sings at p1,p2=> wzo ( -- ) (k)(s)(u)(r) 'writezo' novoc send asciz string <ecx> to stdout. hard coded destn is host STDOUT channel.=> srd ( p -- ) (k) 'psortedp' novoc=> sgb ( -- ) (k)(r) 'rsigb' novoc terminating/recovering signals hnd=> sgt ( -- ) (k)(r) 'rsigt' novoc messaging and rt-signals hnd, job continuing=> t+s (k)=> ts (k)=> ndf ( -- error-26 ) (k) 'ndferd' novoc #26 error, "xec vec undefined"=> <nimp>=> lv@ ( -n1 -- n2 ) (k)(r) 'dolocv' novoc fetch local value which was defined while interpreting, by {local:}=> lv: ( n -- ) (k) 'doloci' novoc initate single cell local vari, cpld by compiling {local:}=> lz: ( -- ) (k) 'dolocz' novoc zero-initate single cell local vari, cpld by compiling "{"=> lv> ( -- ) (k)(r) 'dolocc' novoc fetch local value defined while compiling, cpl'd to pfa of (LOCAL) word=> l!! ( p1 p2 -- ) (k) 'dolxsto' novoc runtime code for {loc!!}=> la: ( -- ) (k)(r) 'doloca' novoc runtime local values' memory allocation, cpld by compiling {local:} local data-space erased. LP-reg := @s0 := @s0 + local bytes, by {>loc}.=> lv; ( -- ) (k)(r) 'dolocr' novoc runtime remove local values. cpl'd by <locrmv> before ;s=> kb] (R: ch -- ) (k) 'kbdtb' novoc restore from console input=> [kb (R: -- ch ) (k) 'bkbdt' novoc enter console input, leave new-chan on t.o.r.=> (i4 ( p -- qn ) (i) 'dointeger4' novoc immediately fetch {4integer} as a {4literal} from data-space.=> (i2 ( p -- dn ) (i) 'dointeger2' novoc run-time code: immediately fetch {2integer} as a {2literal} from data-space.=> (i1 ( -- n ) (i) 'dointeger' novoc=> fgl ( ix -- ) 'fgl' novoc by {forget>} cpl'd runtime code, ix is handler word's xec-token. (asm level useage example -re- {ibbuf}, buffer-blocks allocation)=> fga (k)=> eus ( -- ) (s)(u)(r) 'erustg' novoc uninitiated, print 4 chars @ecx to stderr=> eum ( a -- ) (s)(k) 'erumsg' novoc fetch by true address & send message stg, -re- <erustg>, <erudot>=> eud ( u -- u ) (s)(k)(u) 'erudot' novoc uninitiated, 8 digits unsigned sedec number @eax output to stderr for uninitated erros only; native 4th-routines.=> esm ( n p -- ) (s)(k) 'ersmsg' novoc send message no. and stg, -re- <erustg>, <erudot>=> ekm ( p -- ) (s)(k) 'erkmsg' novoc fetch by ptr & send message stg, -re- <erustg>, <erudot>=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> dvo (X)(k) 'dovoc' novoc vocabulary runtime routine, executed by a vocabulary defn: save previous current in {ocurrent}, drop previous {ocurrent}, store wid = voclink ptr of called voc to {current}.=> df? ( f -- | error-26 ) (k) 'dfder' novoc 0= #26 ?error=> dfg ( ix -- ix ) (k) 'dfdfg' novoc deferred default forget action=> ddo ( -- ) (r) 'dodoes' novoc xec from pfa: [ dodoes ][ kref<pfa> ] pfa: [ kref<cfa> ][ ..data.. ] compiled to code-space in RAM at startup time, re <iwlink> arg passing by W-reg, <ecx>=> ddk (X: -- p ) (k) 'pdodefer' novoc kernel deferred -re- {ddf}=> ddf (X: p -- xx ) (k) 'dodfer' novoc runtime entry from {defer}. cplmem: ptr to pc(data) -> [ xec(code) | xec(default) | linkage ] reverts to default action if defined word not in valid memory range. {noop} if p is null-ptr (=kref+0) or zero.=> c+s (k)=> blwf ( -- n1 f ) (k) novoc does{ bl word find }, eflags set according to {find} flag result=> blw ( -- p ) (k) 'BLWORD' novoc does{ ans bl word }=> (vr ( -- p ) (k) 'pdovar' novoc return ptr to item in dataspace, kernel def'd {variable}=> (vl ( -- n ) (k) 'pdoval' novoc fetch cell content from dataspace, kernel def'd {value}=> (cd ( p u -- ) 'pcdp' novoc=> --version ( -- ) 'sversion' root display lib4th version and exit if no other args passed to program. re {vers}=> noop ( -- ) (fg)(m,1) forth most efficiently do nothing, hi-level call immediately returns, macro inserts a <nop> operation.=> --env-ini ( -- ) system f8ini ( -- ) system evaluate F8INI environment variable. active word in {system} wordlist! -re- {getenv}, {envstg}.=> --help ( -- pid ) (uninitiated) 'ihelp' root rst kref, print system-message, exit immediatelyl if {help} was the single one arg passed w. program invocation. re {vers}=> novoc ( -- ) (i) system inactive, dummy vocabulary for debugging purposes, sub-vocabulary of {system}, list of words for kernel access, only, named to supporting {see} output and w/ header data for internal, redirectably compiling (i.e. by ix) purposes. {novoc} is a noop. words linked to a pseudo-'wordlist' which should not be accessed; the rsp words glossary entries will be displayed w/ { help name }. if activated - w/ some applied magic - would most certainly crash the system!=> environment ( -- ) (x)(i) hidden vocabulary for the ANS-4th environment query.=> testvoc ( -- ) (X)(i) hidden vocabulary for testing purposes=> non-mmx ( -- ) (X)(i) forth non-mmx substitutes vocabulary.=> local ( -- ) (x)(i) hidden local memory support vocabulary, temporary local names & memory ref-s {local} will always be searched 1st and cannot be excluded from search order.=> tools ( -- ) (x)(i) forth non-standard debugging utilities vocabulary=> editor ( -- ) (X)(i) fig the f.i.g-Forth screenfile editor, {fig} sub-vocabulary. some words homononymous to other, Forth words! e.g. {R}, {I}, {J}. B backup cursor by length of text in pad C {text} copy in the following text at cursor posn ( n ) D remove line no. ( n ), put it to pad ( n ) E blank line no. ( n ) F {text} find following text ( n ) H hold line no. ( n ) in pad ( n ) I insert line no. ( n ) from pad L list current screen, L+,L-,L# next, previous, by number. ( n ) M move cursor by ( n ) chars, show line & cursor N find next occurence of text ( after f ) ( n ) P {text} put text until <enter> on line no. ( n ) ( n ) S spread at line no. ( n ), insert an empty line ( n ) R replace line no. ( n ) with text from pad ( n ) T type line no. ( n ) and hold it in pad X {text} delete the following text ( n ) CLEAR clear scr no. n, append to file if appropriate ( n ) DELETE delete n chars backwards ( n1 n2 ) COPY copy screen n1 to n2 flush save updated, modified buffers ( n ) .LINE display line no. n of current screen TEXT {text} to pad TILL {text} delete from cursor till {text} end TOP cursor to top left of current screen ( p u ) using open file to be used w/ screenfile words where (n.i.)=> vt ( -- ) (x)(i) forth vocabulary, vt..-sequences for console appearance & control. ctrls can also be sent as strings { ." \33..." }, etc. -re- {[etype]}.=> bignum ( -- ) (X)(i) forth vocabulary for opr on counted signed integers. a 'counted integer' is a contiguous group of little endian ordered bits in multiples of cell-size w/ sign bit at m.s. position (top address), in 2-s complement notation, and a count cell, bearing the no. of the rsp. cells. located in data-stack w/ count cell @tos or, in memory w/ count cell at l.s. address, for fast data access. -re- {n@} &c. Notation: ( .n.N ) count N of cells n(0..N) (genuine, new implementation, no "Art"work, nothing copied from nowhere...)=> system ( -- ) (x)(i) 'systm' root vocabulary, highly host and system specific words, not for common access.=> linux ( -- ) (X)(i) root vocabulary providing words for host system access which are not defined in a(ny) Forth standard. linux system calls and system specific constants.=> hidden ( -- ) (X)(i) root vocabulary, words which support but aren't standard words.=> compiler ( -- ) (x)(i) root vocabulary, non-standard compiler control.=> asm-hidden ( -- ) (x)(i) assembler vocabulary, -re- {assembler} support=> assembler ( -- ) (x)(i) root vocabulary, native code compiling support=> blkfile ( -- ) (X)(i) forth sub-vocabulary of {forth} block-files specific supplementary words to {forth} wordlist.=> util ( -- ) (X)(i) 'utility' forth vocabulary, forth utility words.=> fig ( -- ) (X)(i) forth {forth} sub-vocabulary f.i.g.-4th specific supplementary words to {forth} wordlist.=> ans ( -- ) (X)(i) forth {forth} sub-vocabulary, ans-4th specific supplementary words to {forth} wordlist.=> forth ( -- ) (X)(i) root most commonly used vocabulary, the standard Forth words -re- "dpans94" doc.=> noop ( -- ) (fg)(m,1) forth most efficiently do nothing, hi-level call immediately returns, macro inserts a <nop> operation.=> root ( -- ) (X)(i) root the basic vocabulary which can't be excluded from search order, where it will be searched last if not explicitely included. contains the words essential to enabling orderly access to the forth system. -re- {only} resets search order to no other vocabulary but {local} and {root}.=>
by [ name | topic | voc ] [ glos | files | xref ] [ notation | dpans94 | syscalls ] [ bot | top ]