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

Optimize variable and constant, and change color!

Browse Source
This commit is contained in:
Brad Nelson
2022-02-25 19:46:28 -08:00
parent 1af99d92ec
commit be64916eec
11 changed files with 60 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
ueforth/common/boot.fs
View File

@ -17,10 +17,6 @@
: #! 10 parse drop drop ; immediate ( shebang for scripts )
( Now can do comments! )
( Constants and Variables )
: constant ( n "name" -- ) create , does> @ ;
: variable ( "name" -- ) create 0 , ;
( Stack Baseline )
sp@ constant sp0
rp@ constant rp0
@ -100,7 +96,7 @@ variable handler
' throw 'notfound !
( Values )
: value ( n -- ) create , does> @ ;
: value ( n -- ) constant ;
: value-bind ( xt-val xt )
>r >body state @ if aliteral r> , else r> execute then ;
: to ( n -- ) ' ['] ! value-bind ; immediate

4
ueforth/common/forth_namespace_tests.fs
View File

@ -135,8 +135,6 @@ e: check-boot
out: fp0
out: rp0
out: sp0
out: variable
out: constant
out: #!
out: \
out: (
@ -250,6 +248,8 @@ e: check-core-opcodes
out: FIND
out: PARSE
out: CREATE
out: VARIABLE
out: CONSTANT
out: DOES>
out: IMMEDIATE
out: :

4
ueforth/common/grf_test.fs
View File

@ -30,8 +30,8 @@ grf
." CHAR: " last-char . cr
then
)
0 to color 0 0 width height box
LEFT-BUTTON pressed? if $ccccff else $ffccff then to color
0 color! 0 0 width height box
LEFT-BUTTON pressed? if $ccccff else $ffccff then color!
mouse-x mouse-y height heart
flip
event FINISHED = until

24
ueforth/common/grf_utils.fs
View File

@ -14,24 +14,36 @@
( Graphics Utilities )
\ Pen:
\ ( n ) to color
\ color! ( col -- )
\ Drawing:
\ box ( x y w h -- )
also internals
grf definitions
0 value color
internals definitions
variable color
( Scale to be divided by $10000 )
variable sx variable sy
$10000 sx ! $10000 sy !
( Translation )
variable tx variable ty
: hline { x y w }
\ x y pixel w 1- for color over l! 4 + next drop ;
x y pixel w color fill32 ;
\ x y pixel w 1- for color @ over l! 4 + next drop ;
x y pixel w color @ fill32 ;
grf definitions also internals
: color! ( col -- ) color ! ;
: box { left top w h }
left sx @ * tx @ + 16 rshift to left
top sy @ * ty @ + 16 rshift to top
w sx @ * 16 rshift to w
h sy @ * 16 rshift to h
left w + top h + { right bottom }
left 0 max to left
top 0 max to top

8
ueforth/common/interp.h
View File

@ -14,7 +14,9 @@
#define JMPW goto **(void **) w
#define NEXT w = *ip++; JMPW
#define ADDR_DOCOLON && OP_DOCOLON
#define ADDR_DOCOL && OP_DOCOL
#define ADDR_DOCON && OP_DOCON
#define ADDR_DOVAR && OP_DOVAR
#define ADDR_DOCREATE && OP_DOCREATE
#define ADDR_DODOES && OP_DODOES
@ -43,7 +45,9 @@ static cell_t *forth_run(cell_t *init_rp) {
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
OP_DOCOLON: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT;
OP_DOCOL: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT;
OP_DOCON: DUP; tos = *(cell_t *) (w + sizeof(cell_t)); NEXT;
OP_DOVAR: DUP; tos = w + sizeof(cell_t); NEXT;
OP_DOCREATE: DUP; tos = w + sizeof(cell_t) * 2; NEXT;
OP_DODOES: DUP; tos = w + sizeof(cell_t) * 2;
++rp; *rp = (cell_t) ip; ip = (cell_t *) *(cell_t *) (w + sizeof(cell_t)); NEXT;

11
ueforth/common/opcodes.h
View File

@ -43,7 +43,8 @@ typedef uintptr_t ucell_t;
#define TOLINK(xt) (((cell_t *) (xt)) - 2)
#define TONAME(xt) ((*TOFLAGS(xt) & BUILTIN_MARK) ? (*(char **) TOLINK(xt)) \
: (((char *) TOLINK(xt)) - CELL_ALIGNED(*TONAMELEN(xt))))
#define TOBODY(xt) (((cell_t *) xt) + ((void *) *((cell_t *) xt) == ADDR_DOCOLON ? 1 : 2))
#define TOBODY(xt) (((cell_t *) xt) + ((void *) *((cell_t *) xt) == ADDR_DOCREATE || \
(void *) *((cell_t *) xt) == ADDR_DODOES ? 2 : 1))
#define DOIMMEDIATE() *TOFLAGS(*g_sys.current) |= IMMEDIATE
#define UNSMUDGE() *TOFLAGS(*g_sys.current) &= ~SMUDGE; finish()
@ -122,12 +123,18 @@ typedef struct {
Y(CREATE, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, 0, ADDR_DOCREATE); \
COMMA(0); DROPn(2)) \
Y(VARIABLE, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, 0, ADDR_DOVAR); \
COMMA(0); DROPn(2)) \
Y(CONSTANT, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, 0, ADDR_DOCON); \
DROPn(2); COMMA(tos); DROP) \
X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
Y(IMMEDIATE, DOIMMEDIATE()) \
XV(internals, "'SYS", SYS, DUP; tos = (cell_t) &g_sys) \
YV(internals, YIELD, PARK; return rp) \
X(":", COLON, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, SMUDGE, ADDR_DOCOLON); \
create((const char *) *sp, tos, SMUDGE, ADDR_DOCOL); \
g_sys.state = -1; --sp; DROP) \
YV(internals, EVALUATE1, DUP; float *tfp = fp; \
sp = evaluate1(sp, &tfp); \

14
ueforth/examples/heart_game.fs
View File

@ -72,22 +72,22 @@ create arrow-table
: draw-one { e } e ->kind @ { kind }
HEART-GOAL kind = if
$ff0000 128 random dup 8 lshift + + to color
$ff0000 128 random dup 8 lshift + + color!
e ->x @ 100 / e ->y @ 100 / e ->step @ heart
exit
then
FIRE kind = if
$222222 to color
$222222 color!
e ->x @ 100 / 4 - e ->y @ 100 / 4 - 8 8 box
exit
then
SPARK kind = if
$ff7700 128 random 8 lshift + to color
$ff7700 128 random 8 lshift + color!
e ->x @ 100 / 4 - e ->y @ 100 / 4 - 8 8 box
exit
then
ARROW kind = if
$ffff00 256 random + to color
$ffff00 256 random + color!
39 for
e ->x @ 100 / e ->vx @ i 200 */ + i arrow-- 2/ -
e ->y @ 100 / e ->vy @ i 200 */ + i arrow-- 2/ -
@ -99,16 +99,16 @@ create arrow-table
: volcano
height 2/ for
$334400 i 100 height */ + to color
$334400 i 100 height */ + color!
width 2/ i 2/ - i height 2/ + i height 8 / + 1 box
next
0 to color
0 color!
width 2/ height 2/
height 8 / 20 box
;
: draw
$003300 to color 0 0 width height box
$003300 color! 0 0 width height box
volcano
entity-count 0 ?do i entity draw-one loop
flip

4
ueforth/web/dump_web_opcodes.c
View File

@ -21,8 +21,8 @@
X("CALL", CALL, sp = Call(sp|0, tos|0) | 0; DROP) \
enum {
OP_DOCOLON = 0,
OP_DOCREATE = 1,
OP_DOCOL = 0,
OP_DOVAR = 1,
OP_DODOES = 2,
#define XV(flags, name, op, code) OP_ ## op,
PLATFORM_OPCODE_LIST

4
ueforth/web/fuse_web.js
View File

@ -58,8 +58,8 @@ cases = ReplaceAll(cases, 'g_sys.state', 'i32[(i32[g_sys>>2] + (3 * 4))>>2]');
cases = ReplaceAll(cases, 'g_sys.DOLIT_XT', 'i32[(i32[g_sys>>2] + (10 * 4))>>2]|0');
cases = ReplaceAll(cases, 'g_sys.DOEXIT_XT', 'i32[(i32[g_sys>>2] + (11 * 4))>>2]|0');
cases = ReplaceAll(cases, '&g_sys', 'g_sys');
cases = ReplaceAll(cases, '&& OP_DOCOLON', '0');
cases = ReplaceAll(cases, '&& OP_DOCREATE', '1');
cases = ReplaceAll(cases, '&& OP_DOCOL', '0');
cases = ReplaceAll(cases, '&& OP_DOVAR', '1');
cases = ReplaceAll(cases, 'goto **(void **) w', 'break decode');
cases = ReplaceAll(cases, 'SSMOD_FUNC', '');
// Keep Together vvv

4
ueforth/web/web.template.js
View File

@ -200,12 +200,12 @@ function VM(stdlib, foreign, heap) {
ir = u8[w]|0;
log(ir|0);
switch (ir&0xff) {
case 0: // OP_DOCOLON
case 0: // OP_DOCOL
rp = (rp + 4) | 0;
i32[rp>>2] = ip;
ip = (w + 4) | 0;
break;
case 1: // OP_DOCREATE
case 1: // OP_DOVAR
sp = (sp + 4) | 0;
i32[sp>>2] = tos;
tos = (w + 8) | 0; // 4 * 2

12
ueforth/windows/interp.h
View File

@ -14,12 +14,16 @@
#define NEXT goto next
#define JMPW goto work
#define ADDR_DOCOLON ((void *) OP_DOCOLON)
#define ADDR_DOCOL ((void *) OP_DOCOL)
#define ADDR_DOCON ((void *) OP_DOCON)
#define ADDR_DOVAR ((void *) OP_DOVAR)
#define ADDR_DOCREATE ((void *) OP_DOCREATE)
#define ADDR_DODOES ((void *) OP_DODOES)
enum {
OP_DOCOLON = 0,
OP_DOCOL = 0,
OP_DOCON,
OP_DOVAR,
OP_DOCREATE,
OP_DODOES,
#define XV(flags, name, op, code) OP_ ## op,
@ -59,7 +63,9 @@ work:
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
case OP_DOCOLON: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT;
case OP_DOCOL: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT;
case OP_DOCON: DUP; tos = *(cell_t *) (w + sizeof(cell_t)); NEXT;
case OP_DOVAR: DUP; tos = w + sizeof(cell_t); NEXT;
case OP_DOCREATE: DUP; tos = w + sizeof(cell_t) * 2; NEXT;
case OP_DODOES: DUP; tos = w + sizeof(cell_t) * 2;
++rp; *rp = (cell_t) ip;