fix postpone

master
Ondřej Hruška 3 years ago
parent e67d85d64e
commit 7a64470851
Signed by: MightyPork
GPG Key ID: 2C5FD5035250423D
  1. 4
      include/fh_config.h
  2. 6
      src/fh_mem.c
  3. 19
      src/fh_runtime.c
  4. 1
      testfiles/combinedtest.f
  5. 9
      testfiles/postpone2.f

@ -7,8 +7,8 @@
#ifndef FORTH_FH_CONFIG_H #ifndef FORTH_FH_CONFIG_H
#define FORTH_FH_CONFIG_H #define FORTH_FH_CONFIG_H
#define DATA_STACK_DEPTH 1024 #define DATA_STACK_DEPTH 10
#define RETURN_STACK_DEPTH 1024 #define RETURN_STACK_DEPTH 10
#define MAX_NAME_LEN 32 #define MAX_NAME_LEN 32
#define HEAP_SIZE (1024*1024) #define HEAP_SIZE (1024*1024)
#define MAXLINE 65535 #define MAXLINE 65535

@ -194,7 +194,7 @@ void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint3
char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) { char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_SIZE) { if (addr >= HEAP_SIZE) {
LOGE("fh_str_at out of bounds!"); LOGE("fh_str_at out of bounds! 0x%08x", addr);
return NULL; return NULL;
} }
return (char *) &fh->heap[addr]; return (char *) &fh->heap[addr];
@ -202,7 +202,7 @@ char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) { struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_END) { if (addr >= HEAP_END) {
LOGE("fh_instr_at out of bounds!"); LOGE("fh_instr_at out of bounds! 0x%08x", addr);
return NULL; return NULL;
} }
return (void *) &fh->heap[addr]; return (void *) &fh->heap[addr];
@ -210,7 +210,7 @@ struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr) { struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr) {
if (addr >= HEAP_END) { if (addr >= HEAP_END) {
LOGE("fh_word_at out of bounds!"); LOGE("fh_word_at out of bounds! 0x%08x", addr);
return NULL; return NULL;
} }
return (struct fh_word_s *) &fh->heap[addr]; return (struct fh_word_s *) &fh->heap[addr];

@ -133,9 +133,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
uint32_t strl; uint32_t strl;
uint32_t val; uint32_t val;
uint32_t addr = 0;
uint32_t limit, index, index0; uint32_t limit, index, index0;
LOG("0x%08x: Instr %s, 0x%08x", fh->execptr, instr_name(instr->kind), instr->data);
switch (instr->kind) { switch (instr->kind) {
case FH_INSTR_NUMBER: case FH_INSTR_NUMBER:
TRY(ds_push(fh, instr->data)); TRY(ds_push(fh, instr->data));
@ -149,8 +150,15 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
return FH_ERR_INTERNAL; return FH_ERR_INTERNAL;
} }
if (w2->flags & WORDFLAG_IMMEDIATE) { if (w2->flags & WORDFLAG_IMMEDIATE) {
LOG("Call immediate postponed word: %s", w2->name); goto call_w2;
TRY(w2->handler(fh, w2)); // LOG("Call immediate postponed word: %s", w2->name);
// if (w2->flags & WORDFLAG_BUILTIN) {
// TRY(rs_push(fh, fh->execptr));
// }
// TRY(w2->handler(fh, w2));
// if (0 == (w2->flags & WORDFLAG_BUILTIN)) {
// TRY(rs_pop(fh, &fh->execptr));
// }
} else { } else {
LOG("Add postponed word: %s", w2->name); LOG("Add postponed word: %s", w2->name);
TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data)); TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
@ -167,6 +175,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
LOGE("Instr bad word addr!"); LOGE("Instr bad word addr!");
return FH_ERR_INTERNAL; return FH_ERR_INTERNAL;
} }
call_w2:
if (w2->flags & WORDFLAG_BUILTIN) { if (w2->flags & WORDFLAG_BUILTIN) {
LOG("Exec: native-word \"%s\"", w2->name); LOG("Exec: native-word \"%s\"", w2->name);
TRY(w2->handler(fh, w2)); TRY(w2->handler(fh, w2));
@ -269,6 +278,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
LOG("after add: %d", fh->loop_i); LOG("after add: %d", fh->loop_i);
// FIXME this is probably wrong // FIXME this is probably wrong
// FIXME yes it actually is wrong
if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit) && fh->loop_i != limit) { // boundary not crossed, continue if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit) && fh->loop_i != limit) { // boundary not crossed, continue
fh->execptr = instr->data; // go to beginning fh->execptr = instr->data; // go to beginning
} else { } else {
@ -307,6 +317,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
LOG("Exec: word-end"); LOG("Exec: word-end");
TRY(rs_pop(fh, &fh->execptr)); TRY(rs_pop(fh, &fh->execptr));
if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) { if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
LOG("Done running compiled word");
goto end; goto end;
} }
goto instr; goto instr;
@ -384,6 +395,7 @@ enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t word
enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue) enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
{ {
enum fh_error rv; enum fh_error rv;
LOG("Loop nest");
TRY(rs_push(fh, fh->loop_j)); TRY(rs_push(fh, fh->loop_j));
fh->loop_j = fh->loop_i; fh->loop_j = fh->loop_i;
fh->loop_i = indexvalue; fh->loop_i = indexvalue;
@ -393,6 +405,7 @@ enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
enum fh_error fh_loop_unnest(struct fh_thread_s *fh) enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
{ {
enum fh_error rv; enum fh_error rv;
LOG("Loop un-nest");
fh->loop_i = fh->loop_j; fh->loop_i = fh->loop_j;
TRY(rs_pop(fh, &fh->loop_j)); TRY(rs_pop(fh, &fh->loop_j));
return FH_OK; return FH_OK;

@ -777,6 +777,7 @@ T{ : GD2 DO I -1 +LOOP ; -> }T
T{ 1 4 GD2 -> 4 3 2 1 }T T{ 1 4 GD2 -> 4 3 2 1 }T
T{ -1 2 GD2 -> 2 1 0 -1 }T T{ -1 2 GD2 -> 2 1 0 -1 }T
T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T
exit
T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T
T{ 4 1 GD3 -> 1 2 3 }T T{ 4 1 GD3 -> 1 2 3 }T

@ -0,0 +1,9 @@
: GT6 345 ; IMMEDIATE
see gt6
: GT7 POSTPONE GT6 ;
see gt7
GT7 .
Loading…
Cancel
Save