alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding more syscalls, fix throw.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-03 00:10:13 -08:00
parent ec68dadb80
commit 952a7d9d07
3 changed files with 21 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
ueforth/common/boot.fs
View File

@ -52,7 +52,7 @@
: ] -1 state ! ; immediate : ] -1 state ! ; immediate
( Quoting Words ) ( Quoting Words )
: ' bl parse find ; : ' bl parse find dup 0= 'throw @ execute ;
: ['] ' aliteral ; immediate : ['] ' aliteral ; immediate
: char bl parse drop c@ ; : char bl parse drop c@ ;
: [char] char aliteral ; immediate : [char] char aliteral ; immediate
@ -110,8 +110,10 @@ rp@ constant rp0
( Exceptions ) ( Exceptions )
variable handler variable handler
: catch sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ; : catch ( xt -- n )
: throw handler @ rp! r> handler ! r> swap >r sp! drop r> ; sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
: throw ( n -- )
dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
' throw 'throw ! ' throw 'throw !
( Values ) ( Values )
@ -120,7 +122,7 @@ variable handler
else ' >body ! then ; immediate else ' >body ! then ; immediate
( Deferred Words ) ( Deferred Words )
: defer ( "name" -- ) create 0 , does> @ execute ; : defer ( "name" -- ) create 0 , does> @ dup 0= throw execute ;
: is ( xt "name -- ) postpone to ; immediate : is ( xt "name -- ) postpone to ; immediate
( Defer I/O to platform specific ) ( Defer I/O to platform specific )
@ -185,4 +187,3 @@ create input-buffer input-limit allot
: query begin ['] eval-buffer catch : query begin ['] eval-buffer catch
if ." ERROR" cr then prompt refill drop again ; if ." ERROR" cr then prompt refill drop again ;
: ok ." uEForth" cr prompt refill drop query ; : ok ." uEForth" cr prompt refill drop query ;

1
ueforth/common/core.h
View File

@ -111,6 +111,7 @@ static void ueforth(const char *src, cell_t src_len) {
g_sys.last[-1] = 1; // Make ; IMMEDIATE g_sys.last[-1] = 1; // Make ; IMMEDIATE
g_sys.DOLIT_XT = FIND("DOLIT"); g_sys.DOLIT_XT = FIND("DOLIT");
g_sys.DOEXIT_XT = FIND("EXIT"); g_sys.DOEXIT_XT = FIND("EXIT");
g_sys.tthrow = FIND("DROP");
ip = g_sys.heap; ip = g_sys.heap;
*g_sys.heap++ = FIND("EVAL1"); *g_sys.heap++ = FIND("EVAL1");
*g_sys.heap++ = FIND("BRANCH"); *g_sys.heap++ = FIND("BRANCH");

19
ueforth/posix/posix.fs
View File

@ -5,24 +5,33 @@
create calls create calls
' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call0 , ' call1 , ' call2 , ' call3 , ' call4 ,
' call5 , ' call6 , ' call7 , ' call8 , ' call9 , ' call5 , ' call6 , ' call7 , ' call8 , ' call9 ,
: sofunc ( z n a "name" -- ) swap >r swap dlsym create , r> cells calls + @ , : sofunc ( z n a "name" -- )
does> dup @ swap cell+ @ execute ; swap >r swap dlsym dup 0= throw create , r> cells calls + @ ,
does> dup @ swap cell+ @ execute ;
: sysfunc ( z n "name" -- ) 0 sofunc ; : sysfunc ( z n "name" -- ) 0 sofunc ;
: shared-library ( z "name" -- ) RTLD_NOW dlopen create , does> @ sofunc ; : shared-library ( z "name" -- )
RTLD_NOW dlopen 0= throw create , does> @ sofunc ;
( Major Syscalls ) ( Major Syscalls )
z" open" 3 sysfunc open
z" creat" 2 sysfunc creat
z" close" 1 sysfunc close z" close" 1 sysfunc close
z" read" 3 sysfunc read z" read" 3 sysfunc read
z" write" 3 sysfunc write z" write" 3 sysfunc write
z" open" 3 sysfunc open z" lseek" 3 sysfunc lseek
z" creat" 2 sysfunc creat
z" exit" 1 sysfunc sysexit z" exit" 1 sysfunc sysexit
z" fork" 0 sysfunc fork
( Default Pipes ) ( Default Pipes )
0 constant stdin 0 constant stdin
1 constant stdout 1 constant stdout
2 constant stderr 2 constant stderr
( Seek )
0 constant SEEK_SET
1 constant SEEK_CUR
2 constant SEEK_END
( Terminal handling ) ( Terminal handling )
: n. ( n -- ) base @ swap decimal <# #s #> type base ! ; : n. ( n -- ) base @ swap decimal <# #s #> type base ! ;
: esc 27 emit ; : esc 27 emit ;