refactored the testing system, fixed fput and removed arr_asm.sl
This commit is contained in:
igor
374
libs/fn.sl
Normal file
374
libs/fn.sl
Normal file
@@ -0,0 +1,374 @@
|
||||
#call-syntax-rewrite [* | fnameToken] -> [* | handled]
|
||||
word call-syntax-rewrite
|
||||
dup token-lexeme identifier? 0 == if drop 0 exit end
|
||||
peek-token dup nil? if drop drop 0 exit end
|
||||
dup token-lexeme "(" string= 0 == if drop drop 0 exit end
|
||||
swap >r # stash fnameTok
|
||||
drop # discard peeked '('
|
||||
next-token drop # consume '('
|
||||
list-new # out
|
||||
list-new # out cur
|
||||
begin
|
||||
next-token dup nil? if "unterminated call expression" parse-error end
|
||||
dup token-lexeme ")" string= if
|
||||
drop
|
||||
# flush current arg
|
||||
list-extend # out'
|
||||
r> list-append # out''
|
||||
inject-tokens
|
||||
1 exit
|
||||
end
|
||||
dup token-lexeme "," string= if
|
||||
drop
|
||||
list-extend # out'
|
||||
list-new # out' cur
|
||||
continue
|
||||
end
|
||||
# default: append tok to cur
|
||||
list-append
|
||||
again
|
||||
end
|
||||
immediate
|
||||
compile-only
|
||||
|
||||
|
||||
word extend-syntax
|
||||
"call-syntax-rewrite" set-token-hook
|
||||
end
|
||||
immediate
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-op-prec
|
||||
dup "+" string= if drop 1 exit end
|
||||
dup "-" string= if drop 1 exit end
|
||||
dup "*" string= if drop 2 exit end
|
||||
dup "/" string= if drop 2 exit end
|
||||
dup "%" string= if drop 2 exit end
|
||||
drop 0
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-operator?
|
||||
fn-op-prec 0 >
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-check-dup
|
||||
>r # params (r: name)
|
||||
0 # params idx
|
||||
begin
|
||||
over list-length swap >= if # params flag
|
||||
r> exit
|
||||
end
|
||||
dup >r # params idx (r: idx name)
|
||||
over swap list-get # params elem
|
||||
1 rpick string= if "duplicate parameter names in fn definition" parse-error end
|
||||
drop # drop comparison flag when no error
|
||||
r> 1 + # params idx+1
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-params
|
||||
list-new # lexer params
|
||||
swap # params lexer
|
||||
>r # params (r: lexer)
|
||||
begin
|
||||
0 rpick lexer-pop token-lexeme # params lex
|
||||
swap drop # params lex (drop returned lexer)
|
||||
dup ")" string= if drop r> exit end
|
||||
dup "int" string= 0 == if "only 'int' parameters are supported in fn definitions" parse-error end
|
||||
drop # params
|
||||
0 rpick lexer-pop token-lexeme # params lexer pname
|
||||
swap drop # params pname
|
||||
dup identifier? 0 == if "invalid parameter name in fn definition" parse-error end
|
||||
fn-check-dup # params pname
|
||||
list-append # params
|
||||
0 rpick lexer-pop token-lexeme # params lexer sep
|
||||
swap drop # params sep
|
||||
dup "," string= if drop continue end
|
||||
dup ")" string= if drop r> exit end
|
||||
"expected ',' or ')' in parameter list" parse-error
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-collect-body
|
||||
"{" lexer-expect drop # consume opening brace, keep lexer
|
||||
lexer-collect-brace # lexer bodyTokens
|
||||
swap drop # bodyTokens
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-lexemes-from-tokens
|
||||
>r # (r: tokens)
|
||||
list-new # acc
|
||||
begin
|
||||
0 rpick list-empty? if
|
||||
rdrop exit
|
||||
end
|
||||
0 rpick list-pop-front # acc tokens' first
|
||||
rdrop # acc tokens'
|
||||
swap # acc first tokens'
|
||||
>r # acc first (r: tokens')
|
||||
token-lexeme # acc lex
|
||||
list-append # acc'
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-validate-body
|
||||
dup list-length 0 == if "empty function body" parse-error end
|
||||
dup 0 list-get token-lexeme "return" string= 0 == if "function body must start with 'return'" parse-error end
|
||||
dup list-last ";" string= 0 == if "function body must terminate with ';'" parse-error end
|
||||
list-clone # body body'
|
||||
list-pop drop # body expr' (trim trailing ';')
|
||||
list-pop-front drop # body expr (trim leading 'return')
|
||||
dup list-length 0 == if "missing return expression" parse-error end
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-filter-raw-body # bodyLexemes -- tokens
|
||||
list-new swap # out body
|
||||
begin
|
||||
dup list-empty? if
|
||||
drop # out
|
||||
exit
|
||||
end
|
||||
list-pop-front # out body' tok
|
||||
swap >r # out tok (r: body')
|
||||
dup "return" string= if
|
||||
drop
|
||||
r>
|
||||
continue
|
||||
end
|
||||
dup ";" string= if
|
||||
drop
|
||||
r>
|
||||
continue
|
||||
end
|
||||
list-append # out'
|
||||
r> # out' body'
|
||||
continue
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-body->tokens # bodyLexemes -- tokens
|
||||
dup list-length 0 == if "empty function body" parse-error end
|
||||
dup 0 list-get token-lexeme "return" string= if
|
||||
fn-validate-body # expr
|
||||
shunt # postfix
|
||||
exit
|
||||
end
|
||||
fn-filter-raw-body
|
||||
dup list-length 0 == if "empty function body" parse-error end
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-emit-prologue # params out -- params out
|
||||
over list-length # params out n
|
||||
begin
|
||||
dup 0 > if
|
||||
1 - # params out n-1
|
||||
>r # params out (r: n-1)
|
||||
">r" list-append # params out'
|
||||
r> # params out' n-1
|
||||
continue
|
||||
end
|
||||
drop # params out
|
||||
exit
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-emit-epilogue # params out -- out
|
||||
over list-length >r # params out (r: n)
|
||||
begin
|
||||
r> dup 0 > if
|
||||
1 - >r
|
||||
"rdrop" list-append
|
||||
continue
|
||||
end
|
||||
drop # drop counter
|
||||
swap drop # out
|
||||
exit
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-translate-prologue-loop # count --
|
||||
dup 0 > if
|
||||
1 -
|
||||
0 rpick ">r" list-append drop
|
||||
fn-translate-prologue-loop
|
||||
end
|
||||
drop
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-translate-epilogue-loop # count --
|
||||
dup 0 > if
|
||||
1 -
|
||||
0 rpick "rdrop" list-append drop
|
||||
fn-translate-epilogue-loop
|
||||
end
|
||||
drop
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-param-index # params name -- params idx flag
|
||||
>r # params (r: name)
|
||||
0 # params idx
|
||||
|
||||
begin
|
||||
over list-length over swap >= if # params idx flag (idx >= len?)
|
||||
drop # params
|
||||
r> drop # drop name
|
||||
-1 0 exit # params -1 0
|
||||
end # params idx
|
||||
over over list-get # params idx elem
|
||||
0 rpick string= # params idx flag
|
||||
if
|
||||
r> drop # drop name
|
||||
1 exit # params idx 1
|
||||
end
|
||||
drop # params idx
|
||||
1 + # params idx+1
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-build-param-map # params -- params map
|
||||
map-new # params map
|
||||
0 # params map idx
|
||||
begin
|
||||
2 pick list-length # params map idx len
|
||||
over swap >= if # params map idx flag
|
||||
drop # params map
|
||||
exit
|
||||
end # params map idx
|
||||
2 pick over list-get # params map idx name
|
||||
swap # params map name idx
|
||||
dup >r # params map name idx (r: idx)
|
||||
map-set # params map'
|
||||
r> 1 + # params map' idx'
|
||||
continue
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-translate-token # out map tok -- out map
|
||||
# number?
|
||||
dup string>number # out map tok num ok
|
||||
if
|
||||
# (out map tok num) -> (out' map)
|
||||
>r # out map tok (r: num)
|
||||
drop # out map
|
||||
r> # out map num
|
||||
swap >r # out num (r: map)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
exit
|
||||
end
|
||||
drop # out map tok
|
||||
|
||||
# param?
|
||||
dup >r # out map tok (r: tok)
|
||||
map-get # out map idx|nil ok
|
||||
if
|
||||
# append idx
|
||||
swap >r # out idx (r: map tok)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
# append "rpick"
|
||||
"rpick" swap >r # out' "rpick" (r: map tok)
|
||||
list-append # out''
|
||||
r> # out'' map
|
||||
# drop saved tok
|
||||
r> drop # out'' map
|
||||
exit
|
||||
end
|
||||
# not a param: drop idx|nil, append original tok
|
||||
drop # out map
|
||||
r> # out map tok
|
||||
swap >r # out tok (r: map)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-translate-postfix-loop # map out postfix -- map out
|
||||
begin
|
||||
dup list-empty? if
|
||||
drop
|
||||
exit
|
||||
end
|
||||
list-pop-front # map out postfix' tok
|
||||
swap >r # map out tok (r: postfix')
|
||||
>r swap r> # out map tok (r: postfix')
|
||||
fn-translate-token # out map
|
||||
swap # map out
|
||||
r> # map out postfix'
|
||||
continue
|
||||
again
|
||||
end
|
||||
compile-only
|
||||
|
||||
|
||||
word fn-translate-postfix # postfix params -- out
|
||||
swap # params postfix
|
||||
list-new # params postfix out
|
||||
|
||||
# prologue: stash args on return stack (emit ">r")
|
||||
swap >r # params out (r: postfix)
|
||||
fn-emit-prologue # params out
|
||||
r> swap # params postfix out
|
||||
|
||||
# build param map (name -> index)
|
||||
2 pick fn-build-param-map # params postfix out params map
|
||||
>r drop r> # params postfix out map
|
||||
# reorder to: params map out postfix
|
||||
swap >r swap r> swap # params map out postfix
|
||||
|
||||
# translate tokens
|
||||
fn-translate-postfix-loop # params map out
|
||||
# drop map, emit epilogue
|
||||
swap drop # params out
|
||||
fn-emit-epilogue # out
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn-build-body
|
||||
fn-translate-postfix # words
|
||||
end
|
||||
compile-only
|
||||
|
||||
word fn
|
||||
"(),{};+-*/%," lexer-new # lexer
|
||||
dup lexer-pop # lexer nameTok
|
||||
dup >r # save nameTok
|
||||
token-lexeme # lexer name
|
||||
dup identifier? 0 == if "invalid function name for 'fn'" parse-error end
|
||||
>r # save name string
|
||||
drop # leave lexer only for params
|
||||
"(" lexer-expect drop # consume '(' keep lexer
|
||||
fn-params # params lexer
|
||||
fn-collect-body # params bodyTokens
|
||||
swap >r # bodyTokens (r: params)
|
||||
fn-lexemes-from-tokens # lexemes
|
||||
fn-body->tokens # tokens
|
||||
r> # postfix params
|
||||
fn-build-body # body
|
||||
r> drop # drop name string
|
||||
r> # name token
|
||||
swap emit-definition
|
||||
end
|
||||
immediate
|
||||
compile-only
|
||||
121
libs/nob.sl
Normal file
121
libs/nob.sl
Normal file
@@ -0,0 +1,121 @@
|
||||
import stdlib/stdlib.sl
|
||||
import stdlib/linux.sl
|
||||
import stdlib/mem.sl
|
||||
|
||||
# sh [*, cmd_addr | cmd_len ] -> [* | exit_code ]
|
||||
word sh
|
||||
swap
|
||||
>r # save cmd_addr
|
||||
>r # save cmd_len
|
||||
|
||||
r@ 1 +
|
||||
dup >r # stash len+1 for munmap
|
||||
alloc
|
||||
dup 0 < if
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
else
|
||||
dup >r # remember buffer pointer
|
||||
drop
|
||||
|
||||
3 rpick # src addr
|
||||
0 rpick # dst addr
|
||||
swap
|
||||
2 rpick # len
|
||||
memcpy
|
||||
|
||||
0 rpick
|
||||
2 rpick
|
||||
+
|
||||
0
|
||||
c!
|
||||
|
||||
mem
|
||||
"/bin/sh" drop
|
||||
!
|
||||
mem 8 +
|
||||
"-c" drop
|
||||
!
|
||||
mem 16 +
|
||||
0 rpick
|
||||
!
|
||||
mem 24 +
|
||||
0
|
||||
!
|
||||
mem 32 +
|
||||
0
|
||||
!
|
||||
|
||||
syscall.fork
|
||||
syscall
|
||||
dup 0 < if
|
||||
>r
|
||||
1 rpick
|
||||
2 rpick
|
||||
free
|
||||
r>
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
else
|
||||
dup 0 == if
|
||||
drop
|
||||
"/bin/sh" drop
|
||||
mem
|
||||
dup
|
||||
32 +
|
||||
syscall.execve
|
||||
syscall
|
||||
drop
|
||||
127
|
||||
syscall.exit
|
||||
syscall
|
||||
else
|
||||
mem
|
||||
40 +
|
||||
dup >r
|
||||
0
|
||||
0
|
||||
syscall.wait4
|
||||
syscall
|
||||
dup 0 < if
|
||||
>r
|
||||
rdrop
|
||||
1 rpick
|
||||
2 rpick
|
||||
free
|
||||
r>
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
else
|
||||
drop
|
||||
0 rpick
|
||||
@
|
||||
rdrop
|
||||
dup
|
||||
128 %
|
||||
dup 0 != if
|
||||
swap drop
|
||||
128 +
|
||||
else
|
||||
drop
|
||||
256 /
|
||||
end
|
||||
>r
|
||||
1 rpick
|
||||
2 rpick
|
||||
free
|
||||
r>
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
rdrop
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user