From 3edc0161144d46fdfdb7fd9da78cb6e65f88efd2 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Fri, 1 Jan 2021 18:34:43 -0800 Subject: [PATCH] Adding structure to build. --- ueforth/Makefile | 23 +- ueforth/arduino/arduino.template.ino | 10 + ueforth/arduino/fuse_ino.js | 23 ++ ueforth/boot.fs | 156 ++++++++++++ ueforth/plan.txt | 42 ++++ ueforth/ueforth.js | 356 --------------------------- ueforth/web/fuse_web.js | 19 ++ ueforth/web/web.template.js | 53 ++++ 8 files changed, 321 insertions(+), 361 deletions(-) create mode 100644 ueforth/arduino/arduino.template.ino create mode 100755 ueforth/arduino/fuse_ino.js create mode 100644 ueforth/boot.fs create mode 100644 ueforth/plan.txt delete mode 100644 ueforth/ueforth.js create mode 100755 ueforth/web/fuse_web.js create mode 100644 ueforth/web/web.template.js diff --git a/ueforth/Makefile b/ueforth/Makefile index 36d41df..74467ea 100644 --- a/ueforth/Makefile +++ b/ueforth/Makefile @@ -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/ diff --git a/ueforth/arduino/arduino.template.ino b/ueforth/arduino/arduino.template.ino new file mode 100644 index 0000000..528c190 --- /dev/null +++ b/ueforth/arduino/arduino.template.ino @@ -0,0 +1,10 @@ + +const char boot[] = +{{boot}} +; + +void start() { +} + +void loop() { +} diff --git a/ueforth/arduino/fuse_ino.js b/ueforth/arduino/fuse_ino.js new file mode 100755 index 0000000..e69355e --- /dev/null +++ b/ueforth/arduino/fuse_ino.js @@ -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); diff --git a/ueforth/boot.fs b/ueforth/boot.fs new file mode 100644 index 0000000..c88b01e --- /dev/null +++ b/ueforth/boot.fs @@ -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 ( 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 diff --git a/ueforth/plan.txt b/ueforth/plan.txt new file mode 100644 index 0000000..1e59b3c --- /dev/null +++ b/ueforth/plan.txt @@ -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. diff --git a/ueforth/ueforth.js b/ueforth/ueforth.js deleted file mode 100644 index 3ff4c6b..0000000 --- a/ueforth/ueforth.js +++ /dev/null @@ -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 ( 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; -} diff --git a/ueforth/web/fuse_web.js b/ueforth/web/fuse_web.js new file mode 100755 index 0000000..2cd503c --- /dev/null +++ b/ueforth/web/fuse_web.js @@ -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); diff --git a/ueforth/web/web.template.js b/ueforth/web/web.template.js new file mode 100644 index 0000000..a29727c --- /dev/null +++ b/ueforth/web/web.template.js @@ -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) { + } + } + } + } +} + +})();