Commit e3568a67 authored by bernd's avatar bernd

Separate generally useful tools

parent 0574b3db
......@@ -81,20 +81,10 @@ User buf-state cell uallot drop
cr i 2@ n2o:$.
2 cells +LOOP ;
\ generic stack using string array primitives
: gen-pop ( stack -- x ) >r
\g generic single-stack pop
r@ $[]# dup 0<= !!object-empty!!
1- dup r@ $[] @ swap cells r> $!len ;
: gen-push ( x stack -- )
\g generic single-stack push
dup $[]# swap $[] ! ;
\ object stack
: o-pop ( o:o1 o:x -- o1 o:x ) object-stack gen-pop ;
: o-push ( o1 o:x -- o:o1 o:x ) object-stack gen-push ;
: o-pop ( o:o1 o:x -- o1 o:x ) object-stack stack> ;
: o-push ( o1 o:x -- o:o1 o:x ) object-stack >stack ;
: n:>o ( o1 o:o2 -- o:o2 o:o1 )
>o r> o-push ;
......@@ -105,8 +95,8 @@ User buf-state cell uallot drop
\ token stack - only for decompiling
: t-push ( addr -- ) t-stack gen-push ;
: t-pop ( -- addr ) t-stack gen-pop ;
: t-push ( addr -- ) t-stack >stack ;
: t-pop ( -- addr ) t-stack stack> ;
\ float are stored big endian.
......@@ -403,13 +393,13 @@ Variable throwcount
User neststart#
: nest[ ( -- ) neststart# @ nest-stack gen-push
: nest[ ( -- ) neststart# @ nest-stack >stack
cmdbuf# @ neststart# ! ;
: cmd> ( -- addr u )
init0buf mykey-salt# + maxdata 2/ erase
cmdbuf$ neststart# @ safe/string neststart# @ cmdbuf# !
nest-stack gen-pop neststart# ! ;
nest-stack stack> neststart# ! ;
: cmd>nest ( -- addr u ) cmd> >initbuf 2dup mykey-encrypt$ ;
: cmd>tmpnest ( -- addr u )
......
\ net2o tools
: ?nextarg ( -- addr u noarg-flag )
argc @ 1 > IF next-arg true ELSE false THEN ;
[IFUNDEF] safe/string
: safe/string ( c-addr u n -- c-addr' u' )
\G protect /string against overflows.
dup negate >r dup 0> IF
/string dup r> u>= IF + 0 THEN
ELSE
/string dup r> u< IF + 1+ -1 THEN
THEN ;
[THEN]
: or! ( x addr -- ) >r r@ @ or r> ! ;
: xor! ( x addr -- ) >r r@ @ xor r> ! ;
: and! ( x addr -- ) >r r@ @ and r> ! ;
: min! ( n addr -- ) >r r@ @ min r> ! ;
: max! ( n addr -- ) >r r@ @ max r> ! ;
: umin! ( n addr -- ) >r r@ @ umin r> ! ;
: umax! ( n addr -- ) >r r@ @ umax r> ! ;
: xorc! ( x c-addr -- ) >r r@ c@ xor r> c! ;
: andc! ( x c-addr -- ) >r r@ c@ and r> c! ;
: orc! ( x c-addr -- ) >r r@ c@ or r> c! ;
: max!@ ( n addr -- ) >r r@ @ max r> !@ ;
: umax!@ ( n addr -- ) >r r@ @ umax r> !@ ;
\ generic stack using string array primitives
: stack> ( stack -- x ) >r
\g generic single-stack pop
r@ $[]# dup 0<= !!object-empty!!
1- dup r@ $[] @ swap cells r> $!len ;
: >stack ( x stack -- )
\g generic single-stack push
dup $[]# swap $[] ! ;
......@@ -17,33 +17,8 @@
\ helper words
: ?nextarg ( -- addr u noarg-flag )
argc @ 1 > IF next-arg true ELSE false THEN ;
[IFUNDEF] safe/string
: safe/string ( c-addr u n -- c-addr' u' )
\G protect /string against overflows.
dup negate >r dup 0> IF
/string dup r> u>= IF + 0 THEN
ELSE
/string dup r> u< IF + 1+ -1 THEN
THEN ;
[THEN]
: or! ( x addr -- ) >r r@ @ or r> ! ;
: xor! ( x addr -- ) >r r@ @ xor r> ! ;
: and! ( x addr -- ) >r r@ @ and r> ! ;
: min! ( n addr -- ) >r r@ @ min r> ! ;
: max! ( n addr -- ) >r r@ @ max r> ! ;
: umin! ( n addr -- ) >r r@ @ umin r> ! ;
: umax! ( n addr -- ) >r r@ @ umax r> ! ;
: xorc! ( x c-addr -- ) >r r@ c@ xor r> c! ;
: andc! ( x c-addr -- ) >r r@ c@ and r> c! ;
: orc! ( x c-addr -- ) >r r@ c@ or r> c! ;
: max!@ ( n addr -- ) >r r@ @ max r> !@ ;
: umax!@ ( n addr -- ) >r r@ @ umax r> !@ ;
require net2o-err.fs
require net2o-tools.fs
\ required tools
......@@ -55,7 +30,6 @@ require unix/mmap.fs
require unix/pthread.fs
require unix/filestat.fs
require 64bit.fs
require net2o-err.fs
require debugging.fs
require kregion.fs
require libkeccak.fs
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment