Skip to content

Commit

Permalink
Fixes issue #40
Browse files Browse the repository at this point in the history
When stubbing and updating jump target addresses in `if`, `else` and
`fi`, variable-length encoding was used; this caused problems when the
stub address and final adress were encoded in different length,
corrupting the dictionary.

This change provides a fix by always using the maximum size
variable-length encoding for the initial stub and final target address.
  • Loading branch information
zevv committed Apr 22, 2024
1 parent f997c3b commit 2053d2e
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 16 deletions.
21 changes: 16 additions & 5 deletions forth/core.zf
Original file line number Diff line number Diff line change
Expand Up @@ -10,13 +10,21 @@
: save 131 sys ;


( dictionary access. These are shortcuts through the primitive operations are !!, @@ and ,, )
( dictionary access for regular variable-length cells. These are shortcuts
through the primitive operations are !!, @@ and ,, )

: ! 0 !! ;
: @ 0 @@ ;
: , 0 ,, ;
: # 0 ## ;

( dictionary access for jmp instructions; these make sure to always use the
maximium cell size for the target address to allow safe stubbing and
updating of a jump address. `64` is the magic number for ZF_ACCESS_VAR_MAX,
see zforth.c for details )

: !j 64 !! ;
: ,j 64 ,, ;

( compiler state )

Expand Down Expand Up @@ -73,12 +81,15 @@
: times ( XT n -- ) { >r dup >r exe r> r> dup x} drop drop ;


( 'if' prepares conditional jump, address will be filled in by 'else' or 'fi' )
( 'if' prepares conditional jump, the target address '0' will later be
overwritten by the 'else' or 'fi' words. Note that ,j and !j are used for
writing the jump target address to the dictionary, this makes sure that the
target address is always written with the same cell size)

: if ' jmp0 , here 999 , ; immediate
: if ' jmp0 , here 0 ,j ; immediate
: unless ' not , postpone if ; immediate
: else ' jmp , here 999 , swap here swap ! ; immediate
: fi here swap ! ; immediate
: else ' jmp , here 0 ,j swap here swap !j ; immediate
: fi here swap !j ; immediate


( forth style 'do' and 'loop', including loop iterators 'i' and 'j' )
Expand Down
24 changes: 13 additions & 11 deletions src/zforth/zforth.c
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,17 @@
#define CHECK(exp, abort)
#endif

typedef enum {
ZF_MEM_SIZE_VAR = 0, /* Variable size encoding, 1, 2 or 1+sizeof(zf_cell) bytes */
ZF_MEM_SIZE_CELL = 1, /* sizeof(zf_cell) bytes */
ZF_MEM_SIZE_U8 = 2,
ZF_MEM_SIZE_U16 = 3,
ZF_MEM_SIZE_U32 = 4,
ZF_MEM_SIZE_S8 = 5,
ZF_MEM_SIZE_S16 = 6,
ZF_MEM_SIZE_S32 = 7,
ZF_MEM_SIZE_VAR_MAX = 64, /* Variable size encoding, 1+sizeof(zf_cell) bytes */
} zf_mem_size;

/* Define all primitives, make sure the two tables below always match. The
* names are defined as a \0 separated list, terminated by double \0. This
Expand All @@ -31,17 +42,6 @@

#define _(s) s "\0"

typedef enum {
ZF_MEM_SIZE_VAR,
ZF_MEM_SIZE_CELL,
ZF_MEM_SIZE_U8,
ZF_MEM_SIZE_U16,
ZF_MEM_SIZE_U32,
ZF_MEM_SIZE_S8,
ZF_MEM_SIZE_S16,
ZF_MEM_SIZE_S32
} zf_mem_size;

typedef enum {
PRIM_EXIT, PRIM_LIT, PRIM_LTZ, PRIM_COL, PRIM_SEMICOL, PRIM_ADD,
PRIM_SUB, PRIM_MUL, PRIM_DIV, PRIM_MOD, PRIM_DROP, PRIM_DUP,
Expand Down Expand Up @@ -282,7 +282,9 @@ static zf_addr dict_put_cell_typed(zf_addr addr, zf_cell v, zf_mem_size size)
return dict_put_bytes(addr, t, sizeof(t));
}
}
}

if(size == ZF_MEM_SIZE_VAR || size == ZF_MEM_SIZE_VAR_MAX) {
trace(" ⁵");
t[0] = 0xff;
return dict_put_bytes(addr+0, t, 1) +
Expand Down

0 comments on commit 2053d2e

Please sign in to comment.