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

More shuffling.

Browse Source
This commit is contained in:
Brad Nelson
2022-07-14 11:04:18 -07:00
parent 3da2f4bfd3
commit 8066bfb2e8
14 changed files with 53 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile
View File

@ -190,18 +190,19 @@ COMMON_PHASE1 = common/comments.fs \
common/structures.fs
COMMON_PHASE1e = common/comments.fs \
common/tier2_forth.fs \
common/tier2a_forth.fs \
common/boot.fs \
common/tier2b_forth.fs \
common/io.fs \
common/conditionals.fs \
common/vocabulary.fs \
common/floats.fs \
common/structures.fs
COMMON_PHASE2 = common/tasks.fs common/utils.fs common/locals.fs \
common/streams.fs
COMMON_PHASE2 = common/utils.fs common/locals.fs
COMMON_FILETOOLS = common/filetools.fs common/including.fs \
COMMON_FILETOOLS = common/tasks.fs common/streams.fs \
common/filetools.fs common/including.fs \
common/blocks.fs
COMMON_DESKTOP = common/ansi.fs common/desktop.fs \

5
common/boot.fs
View File

@ -23,16 +23,11 @@ fp@ constant fp0
: remaining ( -- n ) 'heap-start @ 'heap-size @ + 'heap @ - ;
: used ( -- n ) 'heap @ sp@ 'stack-cells @ cells + - 28 + ;
( Compilation State )
: [ 0 state ! ; immediate
: ] -1 state ! ; immediate
( Quoting Words )
: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
: ['] ' aliteral ; immediate
: char bl parse drop c@ ;
: [char] char aliteral ; immediate
: literal aliteral ; immediate
( Core Control Flow )
: begin here ; immediate

14
common/forth_namespace_tests.fs
View File

@ -121,13 +121,10 @@ e: check-boot
out: until
out: again
out: begin
out: literal
out: [char]
out: char
out: [']
out: '
out: ]
out: [
out: used
out: remaining
out: fdepth
@ -147,7 +144,6 @@ e: check-tier2-opcodes
out: >link&
out: >link
out: >name
out: >body
out: aligned
out: align
;e
@ -215,6 +211,9 @@ e: check-tier1-opcodes
;e
e: check-tier0-opcodes
out: [
out: ]
out: literal
out: 0=
out: 0<
out: +
@ -256,6 +255,7 @@ e: check-tier0-opcodes
out: CONSTANT
out: DOES>
out: IMMEDIATE
out: >BODY
out: :
out: EXIT
out: ;
@ -471,14 +471,14 @@ e: check-filetools
check-blocks
check-imports
check-snapshots
out: streams
out: ms
check-tasks
;e
e: check-phase2
out: streams
check-locals
check-utils
out: ms
check-tasks
;e
DEFINED? windows [IF]

6
common/tasks.fs
View File

@ -14,10 +14,12 @@
( Cooperative Tasks )
vocabulary tasks tasks definitions
vocabulary tasks tasks definitions also internals
variable task-list
: .tasks task-list @ begin dup 2 cells - see. @ dup task-list @ = until drop ;
forth definitions tasks also internals
: pause
@ -51,4 +53,4 @@ DEFINED? ms-ticks [IF]
tasks definitions
0 0 0 task main-task main-task start-task
forth definitions
only forth definitions

1
common/tier0_opcodes.h
View File

@ -145,6 +145,7 @@ typedef struct {
DROPn(2); COMMA(tos); DROP) \
X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
Y(IMMEDIATE, DOIMMEDIATE()) \
X(">BODY", TOBODY, tos = (cell_t) TOBODY(tos)) \
XV(internals, "'SYS", SYS, DUP; tos = (cell_t) g_sys) \
YV(internals, YIELD, PARK; return rp) \
X(":", COLON, DUP; DUP; tos = parse(32, sp); \

5
common/tier1_opcodes.h
View File

@ -81,4 +81,7 @@
XV(internals, "'argv", ARGV, DUP; tos = (cell_t) &g_sys->argv) \
XV(internals, "'runner", RUNNER, DUP; tos = (cell_t) &g_sys->runner) \
Y(context, DUP; tos = (cell_t) (g_sys->context + 1)) \
Y(latestxt, DUP; tos = (cell_t) g_sys->latestxt)
Y(latestxt, DUP; tos = (cell_t) g_sys->latestxt) \
XV(forth_immediate, "[", LBRACKET, g_sys->state = 0) \
XV(forth_immediate, "]", RBRACKET, g_sys->state = -1) \
YV(forth_immediate, literal, COMMA(g_sys->DOLIT_XT); COMMA(tos); DROP)

13
common/tier1a_forth.fs
View File

@ -73,16 +73,5 @@ drop
( Compilation State )
: [ 0 state ! ; immediate
: ] -1 state ! ; immediate
: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
: literal aliteral ; immediate
: f= ( r r -- f ) f- f0= ;
: f< ( r r -- f ) f- f0< ;
: f> ( r r -- f ) fswap f< ;
: f<> ( r r -- f ) f= 0= ;
: f<= ( r r -- f ) f> 0= ;
: f>= ( r r -- f ) f< 0= ;
4 constant sfloat
: sfloats ( n -- n*4 ) sfloat * ;
: sfloat+ ( a -- a ) sfloat + ;

1
common/tier2_opcodes.h
View File

@ -19,7 +19,6 @@
X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \
X(">link", TOLINK, tos = *TOLINK(tos)) \
X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
X(">body", TOBODY, tos = (cell_t) TOBODY(tos)) \
Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys->heap = (cell_t *) CELL_ALIGNED(g_sys->heap)) \
YV(internals, fill32, cell_t c = tos; DROP; cell_t n = tos; DROP; \

11
common/tier2_forth.fs → common/tier2a_forth.fs
View File

@ -12,16 +12,13 @@
\ See the License for the specific language governing permissions and
\ limitations under the License.
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
: align here aligned here - allot ;
( Dictionary Format )
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
: >name-length ( xt -- n ) >flags& 1+ c@ ;
: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
: >link& ( xt -- a ) 2 cells - ; : >link ( xt -- a ) >link& @ ;
: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
: align here aligned here - allot ;
: fill32 ( a n v ) swap >r swap r> 0 ?do 2dup ! cell+ loop 2drop ;

15
common/tier2b_forth.fs Normal file
View File

@ -0,0 +1,15 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
: fill32 ( a n v ) swap >r swap r> 0 ?do 2dup ! cell+ loop 2drop ;

5
common/utils.fs
View File

@ -122,8 +122,3 @@ forth definitions also internals
: words 0 to line-pos context @ @
begin dup while ?ins. dup onlines see. >link repeat drop cr ;
only forth definitions
( Extra Task Utils )
tasks definitions also internals
: .tasks task-list @ begin dup 2 cells - see. @ dup task-list @ = until drop ;
only forth definitions

5
web/fini.fs
View File

@ -18,6 +18,11 @@ transfer internals-builtins
forth definitions internals
( Bring a forth to the top of the vocabulary. )
: ok ." uEforth" raw-ok ;
: dummy-type 2drop yield ; ' dummy-type is type
: dummy-key yield 0 ; ' dummy-key is key
: dummy-key? yield 0 ; ' dummy-key is key?
transfer forth
forth
ok

3
web/fuse_web.js
View File

@ -139,6 +139,9 @@ cases = ReplaceAll(cases, 'DOES(ip)', 'DOES(ip|0)');
cases = ReplaceAll(cases, 'PARK;', ''); // TODO
cases = ReplaceAll(cases, '; ', ';\n ');
cases = ReplaceAll(cases, 'tos = ((tos) + (*(tos) == OP_DOCREATE || *(tos) == OP_DODOES ? 2 : 1))',
'tos = TOBODY(tos|0)|0');
code = code.replace('{{boot}}', function() { return boot; });
code = code.replace('{{dict}}', function() { return dict; });
code = code.replace('{{cases}}', function() { return cases; });

5
web/web.template.js
View File

@ -83,7 +83,7 @@ function TONAME(xt) {
? u8[TOLINK(xt)] : TOLINK(xt) - CELL_ALIGNED(u8[TONAMELEN(xt)]);
}
function TOBODY(xt) {
return xt + (i32[xt>>2] === OP_DOCREATE || i32[xt>>2] === OP_DODOES ? 2 : 1);
return xt + (i32[xt>>2] === OP_DOCREATE || i32[xt>>2] === OP_DODOES ? 2 : 1) * 4;
}
function DOES(ip) {
@ -437,6 +437,7 @@ function VM(stdlib, foreign, heap) {
var DOES = foreign.DOES;
var DOIMMEDIATE = foreign.DOIMMEDIATE;
var UNSMUDGE = foreign.UNSMUDGE;
var TOBODY = foreign.TOBODY;
var create = foreign.create;
var find = foreign.find;
var parse = foreign.parse;
@ -533,6 +534,7 @@ var ffi = {
'COMMA': function(n) { COMMA(n); },
'CCOMMA': function(n) { COMMA(n); },
'SSMOD': function(sp) { SSMOD(sp); },
'TOBODY': function(tos) { return TOBODY(tos); },
'DOES': function(ip) { DOES(ip); },
'DOIMMEDIATE': function() { DOIMMEDIATE(); },
'UNSMUDGE': function() { UNSMUDGE(); },
@ -549,6 +551,7 @@ var module = VM(globalObj, ffi, heap);
Init();
setTimeout(function() {
module.run();
console.log('yield');
}, 10);
})();