From be64916eece6c244a6dc8c8a345642c2bfbcbb3c Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Fri, 25 Feb 2022 19:46:28 -0800 Subject: [PATCH] Optimize variable and constant, and change color! --- ueforth/common/boot.fs | 6 +----- ueforth/common/forth_namespace_tests.fs | 4 ++-- ueforth/common/grf_test.fs | 4 ++-- ueforth/common/grf_utils.fs | 24 ++++++++++++++++++------ ueforth/common/interp.h | 8 ++++++-- ueforth/common/opcodes.h | 11 +++++++++-- ueforth/examples/heart_game.fs | 14 +++++++------- ueforth/web/dump_web_opcodes.c | 4 ++-- ueforth/web/fuse_web.js | 4 ++-- ueforth/web/web.template.js | 4 ++-- ueforth/windows/interp.h | 12 +++++++++--- 11 files changed, 60 insertions(+), 35 deletions(-) diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs index 85f11f2..63ea390 100644 --- a/ueforth/common/boot.fs +++ b/ueforth/common/boot.fs @@ -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 diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs index 157849b..14f7511 100644 --- a/ueforth/common/forth_namespace_tests.fs +++ b/ueforth/common/forth_namespace_tests.fs @@ -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: : diff --git a/ueforth/common/grf_test.fs b/ueforth/common/grf_test.fs index e517c2f..d795ebf 100755 --- a/ueforth/common/grf_test.fs +++ b/ueforth/common/grf_test.fs @@ -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 diff --git a/ueforth/common/grf_utils.fs b/ueforth/common/grf_utils.fs index b3880db..a80487f 100644 --- a/ueforth/common/grf_utils.fs +++ b/ueforth/common/grf_utils.fs @@ -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 diff --git a/ueforth/common/interp.h b/ueforth/common/interp.h index 140d2de..3efff23 100644 --- a/ueforth/common/interp.h +++ b/ueforth/common/interp.h @@ -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; diff --git a/ueforth/common/opcodes.h b/ueforth/common/opcodes.h index 4bb9dbd..725df52 100644 --- a/ueforth/common/opcodes.h +++ b/ueforth/common/opcodes.h @@ -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); \ diff --git a/ueforth/examples/heart_game.fs b/ueforth/examples/heart_game.fs index ff82246..81bbc0f 100755 --- a/ueforth/examples/heart_game.fs +++ b/ueforth/examples/heart_game.fs @@ -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 diff --git a/ueforth/web/dump_web_opcodes.c b/ueforth/web/dump_web_opcodes.c index cc77b5a..79c6b7c 100644 --- a/ueforth/web/dump_web_opcodes.c +++ b/ueforth/web/dump_web_opcodes.c @@ -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 diff --git a/ueforth/web/fuse_web.js b/ueforth/web/fuse_web.js index 449b12d..8af072f 100755 --- a/ueforth/web/fuse_web.js +++ b/ueforth/web/fuse_web.js @@ -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 diff --git a/ueforth/web/web.template.js b/ueforth/web/web.template.js index 129b728..f59032b 100644 --- a/ueforth/web/web.template.js +++ b/ueforth/web/web.template.js @@ -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 diff --git a/ueforth/windows/interp.h b/ueforth/windows/interp.h index 94149da..1193418 100644 --- a/ueforth/windows/interp.h +++ b/ueforth/windows/interp.h @@ -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;