Adding structure to build.
This commit is contained in:
Brad Nelson
@ -1,13 +1,26 @@
|
||||
all: out/ueforth
|
||||
all: out/web/ueforth.js out/posix/ueforth out/arduino/ueforth.ino
|
||||
|
||||
out:
|
||||
mkdir -p out
|
||||
out/web:
|
||||
mkdir -p out/web
|
||||
|
||||
out/ueforth: ueforth.c | out
|
||||
$(CC) $(CFLAGS) $< -o $@ $(LIBS)
|
||||
out/web/ueforth.js: web/fuse_web.js web/web.template.js boot.fs | out/web
|
||||
$^ >$@
|
||||
|
||||
out/posix:
|
||||
mkdir -p out/posix
|
||||
|
||||
CFLAGS=-O2 -Wall -Werror
|
||||
LIBS=-ldl
|
||||
|
||||
out/posix/ueforth: ueforth.c | out/posix
|
||||
$(CC) $(CFLAGS) $< -o $@ $(LIBS)
|
||||
|
||||
out/arduino:
|
||||
mkdir -p out/arduino
|
||||
|
||||
out/arduino/ueforth.ino: arduino/fuse_ino.js \
|
||||
arduino/arduino.template.ino boot.fs | out/arduino
|
||||
$^ >$@
|
||||
|
||||
clean:
|
||||
rm -rf out/
|
||||
|
||||
10
ueforth/arduino/arduino.template.ino
Normal file
10
ueforth/arduino/arduino.template.ino
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
const char boot[] =
|
||||
{{boot}}
|
||||
;
|
||||
|
||||
void start() {
|
||||
}
|
||||
|
||||
void loop() {
|
||||
}
|
||||
23
ueforth/arduino/fuse_ino.js
Executable file
23
ueforth/arduino/fuse_ino.js
Executable file
@ -0,0 +1,23 @@
|
||||
#! /usr/bin/env nodejs
|
||||
|
||||
var fs = require('fs');
|
||||
var code = fs.readFileSync(process.argv[2]).toString();
|
||||
var boot = fs.readFileSync(process.argv[3]).toString();
|
||||
|
||||
function ReplaceAll(haystack, needle, replacement) {
|
||||
for (;;) {
|
||||
var old = haystack;
|
||||
haystack = haystack.replace(needle, replacement);
|
||||
if (old === haystack) {
|
||||
return haystack;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
boot = boot.replace(/["]/g, '\\"');
|
||||
boot = '" ' + boot.split('\n').join(' "\n" ') + ' "';
|
||||
boot = boot.replace(/["] ["]/g, '');
|
||||
boot = boot.replace(/["] [(] ([^)]*)[)] ["]/g, '// $1');
|
||||
code = code.replace('{{boot}}', boot);
|
||||
|
||||
console.log(code);
|
||||
156
ueforth/boot.fs
Normal file
156
ueforth/boot.fs
Normal file
@ -0,0 +1,156 @@
|
||||
( Comments )
|
||||
: ( 41 parse drop drop ; immediate
|
||||
|
||||
( Useful Basic Compound Words )
|
||||
: 2drop ( n n -- ) drop drop ;
|
||||
: 2dup ( a b -- a b a b ) over over ;
|
||||
: nip ( a b -- b ) swap drop ;
|
||||
: rdrop ( r: n n -- ) r> r> drop >r ;
|
||||
: */ ( n n n -- n ) */mod nip ;
|
||||
: * ( n n -- n ) 1 */ ;
|
||||
: /mod ( n n -- n n ) 1 swap */mod ;
|
||||
: / ( n n -- n ) /mod nip ;
|
||||
: mod ( n n -- n ) /mod drop ;
|
||||
: invert ( n -- ~n ) -1 xor ;
|
||||
: negate ( n -- -n ) invert 1 + ;
|
||||
: - ( n n -- n ) negate + ;
|
||||
: rot ( a b c -- c a b ) >r swap r> swap ;
|
||||
: -rot ( a b c -- b c a ) swap >r swap r> ;
|
||||
: < ( a b -- a<b ) - 0< ;
|
||||
: > ( 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 ;
|
||||
: 1+ 1 + ; : 1- 1 - ;
|
||||
: 2* 2 * ; : 2/ 2 / ;
|
||||
: +! ( n a -- ) swap over @ + swap ! ;
|
||||
: bye 0 sysexit ;
|
||||
|
||||
( Dictionary and Cells )
|
||||
: here ( -- a ) 'heap @ ;
|
||||
: allot ( n -- ) 'heap +! ;
|
||||
: cell+ ( n -- n ) cell + ;
|
||||
: cells ( n -- n ) cell * ;
|
||||
: cell/ ( n -- n ) cell / ;
|
||||
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
|
||||
: align here aligned here - allot ;
|
||||
: , ( n -- ) here ! cell allot ;
|
||||
: c, ( ch -- ) here c! 1 allot ;
|
||||
|
||||
( Compilation State )
|
||||
: [ 0 state ! ; immediate
|
||||
: ] -1 state ! ; immediate
|
||||
|
||||
( Quoting Words )
|
||||
: ' bl parse find ;
|
||||
: ['] ' aliteral ; immediate
|
||||
: char bl parse drop c@ ;
|
||||
: [char] char aliteral ; immediate
|
||||
: literal aliteral ; immediate
|
||||
|
||||
( Core Control Flow )
|
||||
: begin here ; immediate
|
||||
: again ['] branch , , ; immediate
|
||||
: until ['] 0branch , , ; immediate
|
||||
: ahead ['] branch , here 0 , ; immediate
|
||||
: then here swap ! ; immediate
|
||||
: if ['] 0branch , here 0 , ; immediate
|
||||
: else ['] branch , here 0 , swap here swap ! ; immediate
|
||||
: while ['] 0branch , here 0 , swap ; immediate
|
||||
: repeat ['] branch , , here swap ! ; immediate
|
||||
: aft drop ['] branch , here 0 , here swap ; immediate
|
||||
|
||||
( Compound words requiring conditionals )
|
||||
: min 2dup < if drop else nip then ;
|
||||
: max 2dup < if nip else drop then ;
|
||||
: abs ( n -- +n ) dup 0< if negate then ;
|
||||
|
||||
( Postpone - done here so we have ['] and IF )
|
||||
: >flags ( xt -- flags ) cell - ;
|
||||
: immediate? ( xt -- f ) >flags @ 1 and 0= 0= ;
|
||||
: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
|
||||
|
||||
( Counted Loops )
|
||||
: for postpone >r postpone begin ; immediate
|
||||
: next postpone donext , ; immediate
|
||||
: do postpone swap postpone >r postpone >r here ; immediate
|
||||
: i postpone r@ ; immediate
|
||||
: j rp@ 3 cells - @ ;
|
||||
: unloop postpone rdrop postpone rdrop ; immediate
|
||||
: +loop postpone r> postpone + postpone r>
|
||||
postpone 2dup postpone >r postpone >r
|
||||
postpone < postpone 0= postpone until
|
||||
postpone unloop ; immediate
|
||||
: loop 1 aliteral postpone +loop ; immediate
|
||||
|
||||
( Constants and Variables )
|
||||
: constant create , does> @ ;
|
||||
: variable create 0 , ;
|
||||
|
||||
( Stack Convience )
|
||||
sp@ constant sp0
|
||||
rp@ constant rp0
|
||||
: depth ( -- n ) sp@ sp0 - cell/ ;
|
||||
|
||||
( Exceptions )
|
||||
variable handler
|
||||
: catch sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
|
||||
: throw handler @ rp! r> handler ! r> swap >r sp! drop r> ;
|
||||
' throw 'throw !
|
||||
|
||||
( Numeric Output )
|
||||
variable hld
|
||||
: pad ( -- a ) here 80 + ;
|
||||
: digit ( u -- c ) 9 over < 7 and + 48 + ;
|
||||
: extract ( n base -- n c ) 0 swap um/mod swap digit ;
|
||||
: <# ( -- ) pad hld ! ;
|
||||
: hold ( c -- ) hld @ 1 - dup hld ! c! ;
|
||||
: # ( u -- u ) base @ extract hold ;
|
||||
: #s ( u -- 0 ) begin # dup while repeat ;
|
||||
: sign ( n -- ) 0< if 45 hold then ;
|
||||
: #> ( w -- b u ) drop hld @ pad over - ;
|
||||
: 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 ;
|
||||
: ? ( a -- ) @ . ;
|
||||
|
||||
( Strings )
|
||||
: $. r@ dup cell+ swap @ type r> dup @ aligned + cell+ >r ;
|
||||
: ." [char] " parse postpone $. dup , 0 do dup c@ c, 1+ loop drop align ; immediate
|
||||
: $@ r@ dup cell+ swap @ r> dup @ aligned + cell+ >r ;
|
||||
: s" [char] " parse postpone $@ dup , 0 do dup c@ c, 1+ loop drop align ; immediate
|
||||
: z$@ r@ cell+ r> dup @ aligned + cell+ >r ;
|
||||
: z" [char] " parse postpone z$@ dup 1+ , 0 do dup c@ c, 1+ loop drop 0 c, align ; 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 cr ['] : see. ' dup see. see-loop drop ['] ; see. cr ;
|
||||
: words last @ begin dup see. >link dup 0= until drop cr ;
|
||||
|
||||
( Input )
|
||||
: accept ( a n -- n ) 0 swap begin 2dup < while
|
||||
key dup nl = if 2drop nip exit then
|
||||
>r rot r> over c! 1+ -rot swap 1+ swap repeat drop nip ;
|
||||
200 constant input-limit
|
||||
: tib ( -- a ) 'tib @ ;
|
||||
create input-buffer input-limit allot
|
||||
: tib-setup input-buffer 'tib ! ;
|
||||
: refill tib-setup tib input-limit accept #tib ! 0 >in ! -1 ;
|
||||
|
||||
( REPL )
|
||||
: prompt ." ok" cr ;
|
||||
: 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
|
||||
42
ueforth/plan.txt
Normal file
42
ueforth/plan.txt
Normal file
@ -0,0 +1,42 @@
|
||||
POSSIBLE PLAN
|
||||
-------------
|
||||
|
||||
* Support many platform variants
|
||||
- Linux & Windows
|
||||
* Expose dlsym / LoadLibrary/GetAddress, build from there
|
||||
* Load Forth bootstraping from command line and well known locations
|
||||
- exe relative boot.fs
|
||||
- exe relative linux.fs
|
||||
- provide facility to find exe relative, provide more libraries:
|
||||
* x11 / GDI
|
||||
* simplified graphics
|
||||
* console / ide
|
||||
* Build distributable zip w/ main exe, boot files
|
||||
- Maybe installer too?
|
||||
- ESP32/8266
|
||||
* Expose key features via built-in words:
|
||||
- Wi-Fi
|
||||
- BLE
|
||||
- GPIO
|
||||
- Raw Flash
|
||||
- FAT
|
||||
- SPI
|
||||
- Clock and Timers
|
||||
* Load Core bootstrap from embedded code
|
||||
* Load User program from internal flash, followed by external
|
||||
* Multiple Build Configurations:
|
||||
- Single .ino file for Arduino install (generated from c source)
|
||||
- ESP-SDK built raw hex & FAT image
|
||||
- Web
|
||||
* Expose CALL opcode taking and returning sp, call item from an array.
|
||||
- Prepopulate array with method to eval and store into same array.
|
||||
* Load js relative Forth bootstrapping:
|
||||
- js relative boot.fs
|
||||
- js relative web.fs:
|
||||
* canvas graphics
|
||||
* simplified graphics
|
||||
* DOM interaction
|
||||
* console / ide
|
||||
* Build distributable js, boot files
|
||||
* Publish built downloadables to gh-pages
|
||||
* Support cross built by providing built binaries with others.
|
||||
@ -1,356 +0,0 @@
|
||||
'use strict';
|
||||
|
||||
(function() {
|
||||
|
||||
const HEAP_SIZE = 10 * 1024 * 1024;
|
||||
const STACK_SIZE = 16 * 1024;
|
||||
|
||||
#define DUP *++sp = tos
|
||||
#define DROP tos = *sp--
|
||||
#define NEXT w = *ip++; goto **(void **) w
|
||||
#define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
|
||||
#define FIND(name) find(name, sizeof(name) - 1)
|
||||
#define LOWER(ch) ((ch) & 95)
|
||||
|
||||
#define OPCODE_LIST \
|
||||
X("0=", OP_ZEQUAL, tos = !tos ? -1 : 0) \
|
||||
X("0<", OP_ZLESS, tos = tos < 0 ? -1 : 0) \
|
||||
X("+", OP_PLUS, tos += *sp--) \
|
||||
X("UM/MOD", OP_UMSMOD, ud = *(udcell_t *) &sp[-1]; \
|
||||
*--sp = (cell_t) (ud % tos); \
|
||||
tos = (cell_t) (ud / tos)) \
|
||||
X("*/MOD", OP_SSMOD, d = (dcell_t) *sp * (dcell_t) sp[-1]; \
|
||||
*--sp = (cell_t) (d % tos); \
|
||||
tos = (cell_t) (d / tos)) \
|
||||
X("AND", OP_AND, tos &= *sp--) \
|
||||
X("OR", OP_OR, tos |= *sp--) \
|
||||
X("XOR", OP_XOR, tos ^= *sp--) \
|
||||
X("DUP", OP_DUP, DUP) \
|
||||
X("SWAP", OP_SWAP, t = tos; tos = *sp; *sp = t) \
|
||||
X("OVER", OP_OVER, DUP; tos = sp[-1]) \
|
||||
X("DROP", OP_DROP, DROP) \
|
||||
X("@", OP_AT, tos = *(cell_t *) tos) \
|
||||
X("C@", OP_CAT, tos = *(uint8_t *) tos) \
|
||||
X("!", OP_STORE, *(cell_t *) tos = *sp; --sp; DROP) \
|
||||
X("C!", OP_CSTORE, *(uint8_t *) tos = *sp; --sp; DROP) \
|
||||
X("FILL", OP_FILL, memset((void *) sp[-1], tos, *sp); sp -= 2; DROP) \
|
||||
X("MOVE", OP_MOVE, memmove((void *) sp[-1], (void *) *sp, tos); sp -= 2; DROP) \
|
||||
X("SP@", OP_SPAT, DUP; tos = (cell_t) sp) \
|
||||
X("SP!", OP_SPSTORE, sp = (cell_t *) tos; DROP) \
|
||||
X("RP@", OP_RPAT, DUP; tos = (cell_t) rp) \
|
||||
X("RP!", OP_RPSTORE, rp = (cell_t *) tos; DROP) \
|
||||
X(">R", OP_TOR, *++rp = tos; DROP) \
|
||||
X("R>", OP_FROMR, DUP; tos = *rp--) \
|
||||
X("R@", OP_RAT, DUP; tos = *rp) \
|
||||
X("EXECUTE", OP_EXECUTE, w = tos; DROP; goto **(void **) w) \
|
||||
X("BRANCH", OP_BRANCH, ip = (cell_t *) *ip) \
|
||||
X("0BRANCH", OP_ZBRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
|
||||
X("DONEXT", OP_DONEXT, if ((*rp)--) ip = (cell_t *) *ip; else (--rp, ++ip)) \
|
||||
X("DOLIT", OP_DOLIT, DUP; tos = *(cell_t *) ip++) \
|
||||
X("ALITERAL", OP_ALITERAL, *g_heap++ = g_DOLIT_XT; *g_heap++ = tos; DROP) \
|
||||
X("CELL", OP_CELL, DUP; tos = sizeof(cell_t)) \
|
||||
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)) \
|
||||
X("FIND", OP_FIND, *sp = find((const char *) *sp, tos); DROP) \
|
||||
X("PARSE", OP_PARSE, DUP; tos = parse(tos, sp)) \
|
||||
X("S>NUMBER?", OP_CONVERT, tos = convert((const char *) *sp, tos, sp); \
|
||||
if (!tos) DROP) \
|
||||
X("CREATE", OP_CREATE, t = parse(32, &tmp); \
|
||||
create((const char *) tmp, t, 0, && OP_DOCREATE); \
|
||||
*g_heap++ = 0) \
|
||||
X("DOES>", OP_DOES, *g_last = (cell_t) && OP_DODOES; \
|
||||
g_last[1] = (cell_t) ip; goto OP_EXIT) \
|
||||
X("IMMEDIATE", OP_IMMEDIATE, g_last[-1] |= 1) \
|
||||
X("'HEAP", OP_HEAP, DUP; tos = (cell_t) &g_heap) \
|
||||
X("STATE", OP_STATE, DUP; tos = (cell_t) &g_state) \
|
||||
X("BASE", OP_BASE, DUP; tos = (cell_t) &g_base) \
|
||||
X("LAST", OP_LAST, DUP; tos = (cell_t) &g_last) \
|
||||
X("'TIB", OP_TIB, DUP; tos = (cell_t) &g_tib) \
|
||||
X("#TIB", OP_NTIB, DUP; tos = (cell_t) &g_ntib) \
|
||||
X(">IN", OP_TIN, DUP; tos = (cell_t) &g_tin) \
|
||||
X("'THROW", OP_TTHROW, DUP; tos = (cell_t) &g_throw) \
|
||||
X(":", OP_COLON, t = parse(32, &tmp); \
|
||||
create((const char *) tmp, t, 0, && OP_DOCOL); \
|
||||
g_state = -1) \
|
||||
X("EVAL1", OP_EVAL1, DUP; sp = eval1(sp, &tmp); \
|
||||
DROP; if (tmp) (w = tmp); \
|
||||
if (tmp) goto **(void **) w) \
|
||||
X("EXIT", OP_EXIT, ip = (void *) *rp--) \
|
||||
X(";", OP_SEMICOLON, *g_heap++ = g_DOEXIT_XT; g_state = 0) \
|
||||
|
||||
var boot = `
|
||||
: ( 41 parse drop drop ; immediate
|
||||
|
||||
( Useful Basic Compound Words )
|
||||
: 2drop ( n n -- ) drop drop ;
|
||||
: 2dup ( a b -- a b a b ) over over ;
|
||||
: nip ( a b -- b ) swap drop ;
|
||||
: rdrop ( r: n n -- ) r> r> drop >r ;
|
||||
: */ ( n n n -- n ) */mod nip ;
|
||||
: * ( n n -- n ) 1 */ ;
|
||||
: /mod ( n n -- n n ) 1 swap */mod ;
|
||||
: / ( n n -- n ) /mod nip ;
|
||||
: mod ( n n -- n ) /mod drop ;
|
||||
: invert ( n -- ~n ) -1 xor ;
|
||||
: negate ( n -- -n ) invert 1 + ;
|
||||
: - ( n n -- n ) negate + ;
|
||||
: rot ( a b c -- c a b ) >r swap r> swap ;
|
||||
: -rot ( a b c -- b c a ) swap >r swap r> ;
|
||||
: < ( a b -- a<b ) - 0< ;
|
||||
: > ( 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 ;
|
||||
: 1+ 1 + ; : 1- 1 - ;
|
||||
: 2* 2 * ; : 2/ 2 / ;
|
||||
: +! ( n a -- ) swap over @ + swap ! ;
|
||||
: bye 0 sysexit ;
|
||||
|
||||
( Dictionary and Cells )
|
||||
: here ( -- a ) 'heap @ ;
|
||||
: allot ( n -- ) 'heap +! ;
|
||||
: cell+ ( n -- n ) cell + ;
|
||||
: cells ( n -- n ) cell * ;
|
||||
: cell/ ( n -- n ) cell / ;
|
||||
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
|
||||
: align here aligned here - allot ;
|
||||
: , ( n -- ) here ! cell allot ;
|
||||
: c, ( ch -- ) here c! 1 allot ;
|
||||
|
||||
( Compilation State )
|
||||
: [ 0 state ! ; immediate
|
||||
: ] -1 state ! ; immediate
|
||||
|
||||
( Quoting Words )
|
||||
: ' bl parse find ;
|
||||
: ['] ' aliteral ; immediate
|
||||
: char bl parse drop c@ ;
|
||||
: [char] char aliteral ; immediate
|
||||
: literal aliteral ; immediate
|
||||
|
||||
( Core Control Flow )
|
||||
: begin here ; immediate
|
||||
: again ['] branch , , ; immediate
|
||||
: until ['] 0branch , , ; immediate
|
||||
: ahead ['] branch , here 0 , ; immediate
|
||||
: then here swap ! ; immediate
|
||||
: if ['] 0branch , here 0 , ; immediate
|
||||
: else ['] branch , here 0 , swap here swap ! ; immediate
|
||||
: while ['] 0branch , here 0 , swap ; immediate
|
||||
: repeat ['] branch , , here swap ! ; immediate
|
||||
: aft drop ['] branch , here 0 , here swap ; immediate
|
||||
|
||||
( Compound words requiring conditionals )
|
||||
: min 2dup < if drop else nip then ;
|
||||
: max 2dup < if nip else drop then ;
|
||||
: abs ( n -- +n ) dup 0< if negate then ;
|
||||
|
||||
( Postpone - done here so we have ['] and IF )
|
||||
: >flags ( xt -- flags ) cell - ;
|
||||
: immediate? ( xt -- f ) >flags @ 1 and 0= 0= ;
|
||||
: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
|
||||
|
||||
( Counted Loops )
|
||||
: for postpone >r postpone begin ; immediate
|
||||
: next postpone donext , ; immediate
|
||||
: do postpone swap postpone >r postpone >r here ; immediate
|
||||
: i postpone r@ ; immediate
|
||||
: j rp@ 3 cells - @ ;
|
||||
: unloop postpone rdrop postpone rdrop ; immediate
|
||||
: +loop postpone r> postpone + postpone r>
|
||||
postpone 2dup postpone >r postpone >r
|
||||
postpone < postpone 0= postpone until
|
||||
postpone unloop ; immediate
|
||||
: loop 1 aliteral postpone +loop ; immediate
|
||||
|
||||
( Constants and Variables )
|
||||
: constant create , does> @ ;
|
||||
: variable create 0 , ;
|
||||
|
||||
( Stack Convience )
|
||||
sp@ constant sp0
|
||||
rp@ constant rp0
|
||||
: depth ( -- n ) sp@ sp0 - cell/ ;
|
||||
|
||||
( Exceptions )
|
||||
variable handler
|
||||
: catch sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
|
||||
: throw handler @ rp! r> handler ! r> swap >r sp! drop r> ;
|
||||
' throw 'throw !
|
||||
|
||||
( Numeric Output )
|
||||
variable hld
|
||||
: pad ( -- a ) here 80 + ;
|
||||
: digit ( u -- c ) 9 over < 7 and + 48 + ;
|
||||
: extract ( n base -- n c ) 0 swap um/mod swap digit ;
|
||||
: <# ( -- ) pad hld ! ;
|
||||
: hold ( c -- ) hld @ 1 - dup hld ! c! ;
|
||||
: # ( u -- u ) base @ extract hold ;
|
||||
: #s ( u -- 0 ) begin # dup while repeat ;
|
||||
: sign ( n -- ) 0< if 45 hold then ;
|
||||
: #> ( w -- b u ) drop hld @ pad over - ;
|
||||
: 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 ;
|
||||
: ? ( a -- ) @ . ;
|
||||
|
||||
( Strings )
|
||||
: $. r@ dup cell+ swap @ type r> dup @ aligned + cell+ >r ;
|
||||
: .\" [char] \" parse postpone $. dup , 0 do dup c@ c, 1+ loop drop align ; immediate
|
||||
: $@ r@ dup cell+ swap @ r> dup @ aligned + cell+ >r ;
|
||||
: s\" [char] \" parse postpone $@ dup , 0 do dup c@ c, 1+ loop drop align ; 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 cr ['] : see. ' dup see. see-loop drop ['] ; see. cr ;
|
||||
: words last @ begin dup see. >link dup 0= until drop cr ;
|
||||
|
||||
( Input )
|
||||
: accept ( a n -- n ) 0 swap begin 2dup < while
|
||||
key dup nl = if 2drop nip exit then
|
||||
>r rot r> over c! 1+ -rot swap 1+ swap repeat drop nip ;
|
||||
200 constant input-limit
|
||||
: tib ( -- a ) 'tib @ ;
|
||||
create input-buffer input-limit allot
|
||||
: tib-setup input-buffer 'tib ! ;
|
||||
: refill tib-setup tib input-limit accept #tib ! 0 >in ! -1 ;
|
||||
|
||||
( REPL )
|
||||
: prompt .\" ok\" cr ;
|
||||
: 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
|
||||
`;
|
||||
|
||||
static cell_t *g_heap;
|
||||
static const char *g_tib;
|
||||
static cell_t g_ntib = sizeof(boot), g_tin = 0;
|
||||
static cell_t *g_last = 0, g_base = 10, g_state = 0, g_throw = 0;
|
||||
static cell_t g_DOLIT_XT, g_DOEXIT_XT;
|
||||
|
||||
static cell_t convert(const char *pos, cell_t n, cell_t *ret) {
|
||||
*ret = 0;
|
||||
cell_t negate = 0;
|
||||
if (!n) { return 0; }
|
||||
if (pos[0] == '-') { negate = -1; ++pos; --n; }
|
||||
for (; n; --n) {
|
||||
uintptr_t d = pos[0] - '0';
|
||||
if (d > 9) {
|
||||
d = LOWER(d) - 7;
|
||||
if (d < 10) { return 0; }
|
||||
}
|
||||
if (d >= (uintptr_t) g_base) { return 0; }
|
||||
*ret = *ret * g_base + d;
|
||||
++pos;
|
||||
}
|
||||
if (negate) { *ret = -*ret; }
|
||||
return -1;
|
||||
}
|
||||
|
||||
static cell_t same(const char *a, const char *b, cell_t len) {
|
||||
for (;len && LOWER(*a) == LOWER(*b); --len, ++a, ++b);
|
||||
return len;
|
||||
}
|
||||
|
||||
static cell_t find(const char *name, cell_t len) {
|
||||
cell_t *pos = g_last;
|
||||
cell_t clen = CELL_LEN(len);
|
||||
while (pos) {
|
||||
if (len == pos[-3] &&
|
||||
same(name, (const char *) &pos[-3 - clen], len) == 0) {
|
||||
return (cell_t) pos;
|
||||
}
|
||||
pos = (cell_t *) pos[-2]; // Follow link
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void create(const char *name, cell_t length, cell_t flags, void *op) {
|
||||
memcpy(g_heap, name, length); // name
|
||||
g_heap += CELL_LEN(length);
|
||||
*g_heap++ = length; // length
|
||||
*g_heap++ = (cell_t) g_last; // link
|
||||
*g_heap++ = flags; // flags
|
||||
g_last = g_heap;
|
||||
*g_heap++ = (cell_t) op; // code
|
||||
}
|
||||
|
||||
static cell_t parse(cell_t sep, cell_t *ret) {
|
||||
while (g_tin < g_ntib && g_tib[g_tin] == sep) { ++g_tin; }
|
||||
*ret = (cell_t) (g_tib + g_tin);
|
||||
while (g_tin < g_ntib && g_tib[g_tin] != sep) { ++g_tin; }
|
||||
cell_t len = g_tin - (*ret - (cell_t) g_tib);
|
||||
if (g_tin < g_ntib) { ++g_tin; }
|
||||
return len;
|
||||
}
|
||||
|
||||
static cell_t *eval1(cell_t *sp, cell_t *call) {
|
||||
*call = 0;
|
||||
cell_t name;
|
||||
cell_t len = parse(' ', &name);
|
||||
cell_t xt = find((const char *) name, len);
|
||||
if (xt) {
|
||||
if (g_state && !(((cell_t *) xt)[-1] & 1)) { // bit 0 of flags is immediate
|
||||
*g_heap++ = xt;
|
||||
} else {
|
||||
*call = xt;
|
||||
}
|
||||
} else {
|
||||
cell_t n;
|
||||
cell_t ok = convert((const char *) name, len, &n);
|
||||
if (ok) {
|
||||
if (g_state) {
|
||||
*g_heap++ = g_DOLIT_XT;
|
||||
*g_heap++ = n;
|
||||
} else {
|
||||
*++sp = n;
|
||||
}
|
||||
} else {
|
||||
*++sp = -1;
|
||||
*call = g_throw;
|
||||
}
|
||||
}
|
||||
return sp;
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
g_heap = malloc(HEAP_SIZE);
|
||||
register cell_t *sp = g_heap; g_heap += STACK_SIZE;
|
||||
register cell_t *rp = g_heap; g_heap += STACK_SIZE;
|
||||
register cell_t tos = 0, *ip, t, w;
|
||||
dcell_t d;
|
||||
udcell_t ud;
|
||||
cell_t tmp;
|
||||
#define X(name, op, code) create(name, sizeof(name) - 1, name[0] == ';', && op);
|
||||
OPCODE_LIST
|
||||
#undef X
|
||||
g_last[-1] = 1; // Make ; IMMEDIATE
|
||||
g_DOLIT_XT = FIND("DOLIT");
|
||||
g_DOEXIT_XT = FIND("EXIT");
|
||||
ip = g_heap;
|
||||
*g_heap++ = FIND("EVAL1");
|
||||
*g_heap++ = FIND("BRANCH");
|
||||
*g_heap++ = (cell_t) ip;
|
||||
g_tib = boot;
|
||||
NEXT;
|
||||
#define X(name, op, code) op: code; NEXT;
|
||||
OPCODE_LIST
|
||||
#undef X
|
||||
OP_DOCREATE: DUP; tos = w + sizeof(cell_t) * 2; NEXT;
|
||||
OP_DODOES: DUP; tos = w + sizeof(cell_t) * 2;
|
||||
*++rp = (cell_t) ip; ip = (cell_t *) *(cell_t *) (w + sizeof(cell_t)); NEXT;
|
||||
OP_DOCOL: *++rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT;
|
||||
}
|
||||
19
ueforth/web/fuse_web.js
Executable file
19
ueforth/web/fuse_web.js
Executable file
@ -0,0 +1,19 @@
|
||||
#! /usr/bin/env nodejs
|
||||
|
||||
var fs = require('fs');
|
||||
var code = fs.readFileSync(process.argv[2]).toString();
|
||||
var boot = fs.readFileSync(process.argv[3]).toString();
|
||||
|
||||
function ReplaceAll(haystack, needle, replacement) {
|
||||
for (;;) {
|
||||
var old = haystack;
|
||||
haystack = haystack.replace(needle, replacement);
|
||||
if (old === haystack) {
|
||||
return haystack;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
code = code.replace('{{boot}}', boot);
|
||||
|
||||
console.log(code);
|
||||
53
ueforth/web/web.template.js
Normal file
53
ueforth/web/web.template.js
Normal file
@ -0,0 +1,53 @@
|
||||
'use strict';
|
||||
|
||||
(function() {
|
||||
|
||||
const HEAP_SIZE = (1024 * 1024);
|
||||
const DSTACK_SIZE = 4096;
|
||||
const RSTACK_SIZE = 4096;
|
||||
|
||||
const boot = `
|
||||
{{boot}}
|
||||
`;
|
||||
|
||||
function Interpreter(stdlib, foreign, heap) {
|
||||
"use asm";
|
||||
|
||||
var imul = stdlib.Math.imul;
|
||||
|
||||
var exit = foreign.exit;
|
||||
var emit = foreign.emit;
|
||||
var qkey = foreign.qkey;
|
||||
var color = foreign.color;
|
||||
var print_decimal = foreign.print_decimal;
|
||||
var print_hexadecimal = foreign.print_hexadecimal;
|
||||
|
||||
var u8 = new stdlib.Uint8Array(heap);
|
||||
var i32 = new stdlib.Int32Array(heap);
|
||||
|
||||
function run(initrp) {
|
||||
initrp = initrp | 0;
|
||||
var tos = 0;
|
||||
var ip = 0;
|
||||
var sp = 0;
|
||||
var rp = 0;
|
||||
var w = 0;
|
||||
var t = 0;
|
||||
var ir = 0;
|
||||
rp = initrp;
|
||||
ip = i32[rp>>2]|0; rp = (rp - 4)|0;
|
||||
sp = i32[rp>>2]|0; rp = (rp - 4)|0;
|
||||
tos = i32[sp>>2]|0; sp = (sp - 4)|0;
|
||||
for (;;) {
|
||||
w = i32[ip>>2]|0;
|
||||
for (;;) {
|
||||
ir = i32[((ip + (w<<2))|0)>>2]|0;
|
||||
ip = (ip + 4)|0;
|
||||
switch (ir & 0xff) {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
})();
|
||||
Reference in New Issue
Block a user