Moved I/O into platform.
This commit is contained in:
Brad Nelson
@ -11,8 +11,13 @@ all: $(TARGETS)
|
||||
out/gen:
|
||||
mkdir -p out/gen
|
||||
|
||||
out/gen/boot.h: common/source_to_string.js common/boot.fs | out/gen
|
||||
$^ boot >$@
|
||||
POSIX_BOOT = common/boot.fs posix/posix.fs
|
||||
out/gen/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | out/gen
|
||||
echo "ok" | cat $(POSIX_BOOT) - | $< boot >$@
|
||||
|
||||
ARDUINO_BOOT = common/boot.fs posix/posix.fs
|
||||
out/gen/arduino_boot.h: common/source_to_string.js $(ARDUINO_BOOT) | out/gen
|
||||
echo "ok" | cat $(ARDUINO_BOOT) - | $< boot >$@
|
||||
|
||||
out/gen/dump_web_opcodes: web/dump_web_opcodes.c common/opcodes.h | out/gen
|
||||
$(CC) $(CFLAGS) $< -o $@
|
||||
@ -32,7 +37,7 @@ out/web/terminal.html: web/terminal.html | out/web
|
||||
out/web/ueforth.js: \
|
||||
web/fuse_web.js \
|
||||
web/web.template.js \
|
||||
out/gen/boot.h \
|
||||
common/boot.fs \
|
||||
out/gen/web_dict.js \
|
||||
out/gen/web_cases.js | out/web
|
||||
$^ >$@
|
||||
@ -44,7 +49,7 @@ out/posix/ueforth: \
|
||||
posix/posix_main.c \
|
||||
common/opcodes.h \
|
||||
common/core.h \
|
||||
out/gen/boot.h | out/posix
|
||||
out/gen/posix_boot.h | out/posix
|
||||
$(CC) $(CFLAGS) $< -o $@ $(LIBS)
|
||||
|
||||
out/arduino:
|
||||
@ -55,7 +60,7 @@ out/arduino/ueforth.ino: \
|
||||
arduino/arduino.template.ino \
|
||||
common/opcodes.h \
|
||||
common/core.h \
|
||||
out/gen/boot.h | out/arduino
|
||||
out/gen/arduino_boot.h | out/arduino
|
||||
$^ >$@
|
||||
|
||||
clean:
|
||||
|
||||
@ -19,13 +19,10 @@
|
||||
: > ( a b -- a>b ) swap - 0< ;
|
||||
: = ( a b -- a!=b ) - 0= ;
|
||||
: <> ( a b -- a!=b ) = 0= ;
|
||||
: emit ( n -- ) >r rp@ 1 type rdrop ;
|
||||
: bl 32 ; : space bl emit ;
|
||||
: nl 10 ; : cr nl emit ;
|
||||
: bl 32 ; : nl 10 ;
|
||||
: 1+ 1 + ; : 1- 1 - ;
|
||||
: 2* 2 * ; : 2/ 2 / ;
|
||||
: +! ( n a -- ) swap over @ + swap ! ;
|
||||
: bye 0 sysexit ;
|
||||
|
||||
( Cells )
|
||||
: cell+ ( n -- n ) cell + ;
|
||||
@ -78,8 +75,14 @@
|
||||
: max 2dup < if nip else drop then ;
|
||||
: abs ( n -- +n ) dup 0< if negate then ;
|
||||
|
||||
( Postpone - done here so we have ['] and IF )
|
||||
( Dictionary Format )
|
||||
: >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ;
|
||||
: >link ( xt -- a ) 2 cells - @ ;
|
||||
: >flags ( xt -- flags ) cell - ;
|
||||
: >body ( xt -- a ) 2 cells + ;
|
||||
: >:body ( xt -- a ) cell+ ;
|
||||
|
||||
( Postpone - done here so we have ['] and IF )
|
||||
: immediate? ( xt -- f ) >flags @ 1 and 0= 0= ;
|
||||
: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
|
||||
|
||||
@ -111,6 +114,22 @@ variable handler
|
||||
: throw handler @ rp! r> handler ! r> swap >r sp! drop r> ;
|
||||
' throw 'throw !
|
||||
|
||||
( Deferred Words )
|
||||
: defer create 0 , does> @ execute ;
|
||||
: is ' >body ! ;
|
||||
|
||||
( Values )
|
||||
: value ( n -- ) create , does> @ ;
|
||||
: to ( n -- ) state @ if postpone ['] postpone >body postpone !
|
||||
else ' >body ! then ; immediate
|
||||
|
||||
( Defer I/O to platform specific )
|
||||
defer type
|
||||
defer key
|
||||
defer bye
|
||||
: emit ( n -- ) >r rp@ 1 type rdrop ;
|
||||
: space bl emit ; : cr nl emit ;
|
||||
|
||||
( Numeric Output )
|
||||
variable hld
|
||||
: pad ( -- a ) here 80 + ;
|
||||
@ -125,8 +144,8 @@ variable hld
|
||||
: str ( n -- b u ) dup >r abs <# #s r> sign #> ;
|
||||
: hex ( -- ) 16 base ! ;
|
||||
: decimal ( -- ) 10 base ! ;
|
||||
: u. ( u -- ) <# #s #> space type ;
|
||||
: . ( w -- ) base @ 10 xor if u. exit then str space type ;
|
||||
: u. ( u -- ) <# #s #> type space ;
|
||||
: . ( w -- ) base @ 10 xor if u. exit then str type space ;
|
||||
: ? ( a -- ) @ . ;
|
||||
|
||||
( Strings )
|
||||
@ -139,14 +158,11 @@ variable hld
|
||||
: z" postpone s" state @ if postpone drop else drop then ; immediate
|
||||
|
||||
( Examine Dictionary )
|
||||
: >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ;
|
||||
: >link ( xt -- a ) 2 cells - @ ;
|
||||
: >body ( xt -- a ) cell+ ;
|
||||
: see. ( xt -- ) >name type space ;
|
||||
: see-one ( xt -- xt+1 )
|
||||
dup @ dup ['] DOLIT = if drop cell+ dup @ . else see. then cell+ ;
|
||||
: exit= ( xt -- ) ['] exit = ;
|
||||
: see-loop >body begin see-one dup @ exit= until ;
|
||||
: see-loop >:body begin see-one dup @ exit= until ;
|
||||
: see cr ['] : see. ' dup see. see-loop drop ['] ; see. cr ;
|
||||
: words last @ begin dup see. >link dup 0= until drop cr ;
|
||||
|
||||
@ -165,4 +181,4 @@ create input-buffer input-limit allot
|
||||
: eval-line begin >in @ #tib @ < while eval1 repeat ;
|
||||
: query begin ['] eval-line catch if ." ERROR" cr then prompt refill drop again ;
|
||||
: ok ." uEForth" cr prompt refill drop query ;
|
||||
ok
|
||||
|
||||
|
||||
@ -88,6 +88,7 @@ static cell_t *eval1(cell_t *sp, cell_t *call) {
|
||||
*++sp = n;
|
||||
}
|
||||
} else {
|
||||
//fwrite((void *) name, 1, len, stderr);
|
||||
*++sp = -1;
|
||||
*call = g_sys.tthrow;
|
||||
}
|
||||
|
||||
@ -2,8 +2,8 @@
|
||||
|
||||
var fs = require('fs');
|
||||
|
||||
var source = fs.readFileSync(process.argv[2]).toString();
|
||||
var name = process.argv[3];
|
||||
var source = fs.readFileSync(process.stdin.fd).toString();
|
||||
var name = process.argv[2];
|
||||
|
||||
source = source.replace(/["]/g, '\\"');
|
||||
source = '" ' + source.split('\n').join(' "\n" ') + ' "';
|
||||
|
||||
33
ueforth/posix/posix.fs
Normal file
33
ueforth/posix/posix.fs
Normal file
@ -0,0 +1,33 @@
|
||||
( Shared Library Handling )
|
||||
1 constant RTLD_LAZY
|
||||
2 constant RTLD_NOW
|
||||
: dlopen ( n z -- a ) [ 0 z" dlopen" dlsym aliteral ] call2 ;
|
||||
create calls
|
||||
' call0 , ' call1 , ' call2 , ' call3 , ' call4 ,
|
||||
' call5 , ' call6 , ' call7 , ' call8 , ' call9 ,
|
||||
: sofunc ( z n a -- ) swap >r swap dlsym create , r> cells calls + @ ,
|
||||
does> dup @ swap cell+ @ execute ;
|
||||
: sysfunc ( z n -- ) 0 sofunc ;
|
||||
: shared-library ( z -- ) RTLD_NOW dlopen create ,
|
||||
( z n -- ) does> @ sofunc ;
|
||||
|
||||
( Major Syscalls )
|
||||
z" close" 1 sysfunc close
|
||||
z" read" 3 sysfunc read
|
||||
z" write" 3 sysfunc write
|
||||
z" open" 3 sysfunc open
|
||||
z" creat" 2 sysfunc creat
|
||||
z" exit" 1 sysfunc sysexit
|
||||
|
||||
( Default Pipes )
|
||||
0 constant stdin
|
||||
1 constant stdout
|
||||
2 constant stderr
|
||||
|
||||
( Hookup I/O )
|
||||
: stdout-write ( a n -- ) stdout -rot write drop ;
|
||||
' stdout-write is type
|
||||
: stdin-key ( -- n ) 0 >r stdin rp@ 1 read drop r> ;
|
||||
' stdin-key is key
|
||||
: posix-bye 0 sysexit ;
|
||||
' posix-bye is bye
|
||||
@ -18,13 +18,10 @@
|
||||
X("CALL7", OP_CALL7, tos = ((cell_t (*)()) tos)(sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
|
||||
X("CALL8", OP_CALL8, tos = ((cell_t (*)()) tos)(sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 8) \
|
||||
X("CALL9", OP_CALL9, tos = ((cell_t (*)()) tos)(sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 9) \
|
||||
X("TYPE", OP_TYPE, fwrite((void *) *sp, 1, tos, stdout); --sp; DROP) \
|
||||
X("KEY", OP_KEY, DUP; tos = fgetc(stdin)) \
|
||||
X("SYSEXIT", OP_SYSEXIT, DUP; exit(tos)) \
|
||||
|
||||
#include "common/core.h"
|
||||
|
||||
#include "gen/boot.h"
|
||||
#include "gen/posix_boot.h"
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
ueforth(boot, sizeof(boot));
|
||||
|
||||
Reference in New Issue
Block a user