/****************************************************************** An unfinished cross-platform forth system using GNU lightning. (C) 2004 Doug Hoyte, hcsw.org. All rights reserved. ******************************************************************/ /* Makefile: *********************************************************** LIGHTNINGDIR=../lightning-1.2 all: gcc -g -o forth -I$(LIGHTNINGDIR) lightning-forth.c clean: rm -f forth *********************************************************** */ /* Register usage: lightning forth V0 W V1 IP SP PSP V2 RSP R0 TOS */ #include #include #include #include "lightning.h" #define KERNELSIZE 8192 #define PSTACKSIZE 4096 #define RSTACKSIZE 4096 #define DICTSIZE 16384 #define PARSEBUFSIZE 4096 #define IMMEDIATE 32 #define COMPILE_ONLY 64 int CELLSIZE; int JMPRSIZE; int JMPISIZE; static char kernel[KERNELSIZE]; static char pstack[PSTACKSIZE]; static char rstack[RSTACKSIZE]; static char dict[DICTSIZE]; static char parsebuf[PARSEBUFSIZE]; char *l=NULL; char *h=kernel; int state=0; int base=10; void align() { //FIXME: Optimise this: while(((int)jit_get_ip().ptr) % CELLSIZE) jit_get_ip().ptr++; } char *create_header(char *name, int flags, char *cfa) { int len; int *tp = (int *) jit_get_ip().ptr; char *tp2; tp[0] = (int) l; l = (char *) tp; jit_get_ip().ptr += CELLSIZE; len = strlen(name); if (len > 31) len = 31; jit_get_ip().ptr[0] = len|flags; jit_get_ip().ptr++; memcpy(jit_get_ip().ptr, name, len); jit_get_ip().ptr += len; align(); tp2 = jit_get_ip().ptr; //printf("<%s> CFA: 0x%x\n", name, tp2); if (cfa != NULL) { jit_jmpi(cfa); } return tp2; } char *get_cfa(char *name) { char *tp = l; int t, len; len = strlen(name); while (tp != NULL) { t = ((int)*(tp+CELLSIZE)) & 31; if (t == len && strncmp(name, tp+CELLSIZE+1, len) == 0) { t = (int) (tp+CELLSIZE+1+len); while(t % CELLSIZE) t++; return (char*) t; } tp = *((char**)tp); } fprintf(stderr, "COMPILATION FAILURE! UNABLE TO LOCATE CFA OF '%s'\n", name); exit(-1); return NULL; } void compnum(int q) { ((int*)(jit_get_ip().ptr))[0] = q; jit_get_ip().ptr += CELLSIZE; } void compword(char *w) { compnum((int)get_cfa(w)); } void assemble_kernel() { char *c_next, *c_docolon, *c_doconst, *c_dovar; jit_insn *main_entrance, *tp, *tp2; // Initialisation: jit_movi_p(JIT_SP, pstack+PSTACKSIZE); jit_movi_p(JIT_V2, rstack+RSTACKSIZE); jit_movi_i(JIT_R0, 0); jit_movi_i(JIT_V0, 0); main_entrance = jit_movi_p(JIT_V1, jit_forward()); // we let it fall through to NEXT! // NEXT: c_next = jit_get_ip().ptr; jit_ldr_p(JIT_V0, JIT_V1); jit_addi_i(JIT_V1, JIT_V1, CELLSIZE); jit_jmpr(JIT_V0); // DOCOLON: c_docolon = jit_get_ip().ptr; jit_subi_i(JIT_V2, JIT_V2, CELLSIZE); jit_str_p(JIT_V2, JIT_V1); jit_addi_i(JIT_V1, JIT_V0, JMPISIZE); jit_jmpi(c_next); // DOCONST: c_doconst = jit_get_ip().ptr; jit_pushr_i(JIT_R0); jit_ldr_i(JIT_R0, JIT_V1); jit_addi_i(JIT_V1, JIT_V1, CELLSIZE); jit_jmpi(c_next); // DOVAR: c_dovar = jit_get_ip().ptr; jit_pushr_i(JIT_R0); jit_movr_p(JIT_R0, JIT_V1); jit_addi_i(JIT_V1, JIT_V1, CELLSIZE); jit_jmpi(c_next); create_header("exit", 0, NULL); jit_ldr_p(JIT_V1, JIT_V2); jit_addi_i(JIT_V2, JIT_V2, CELLSIZE); jit_jmpi(c_next); create_header("dup", 0, NULL); jit_pushr_i(JIT_R0); jit_jmpi(c_next); create_header("drop", 0, NULL); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("swap", 0, NULL); jit_popr_i(JIT_R1); jit_pushr_i(JIT_R0); jit_movr_i(JIT_R0, JIT_R1); jit_jmpi(c_next); create_header("=", 0, NULL); jit_popr_i(JIT_R1); jit_eqr_i(JIT_R0, JIT_R0, JIT_R1); jit_jmpi(c_next); create_header("0=", 0, NULL); jit_movi_i(JIT_R1, 0); jit_ner_i(JIT_R0, JIT_R0, JIT_R1); jit_jmpi(c_next); create_header("lit", 0, NULL); jit_pushr_i(JIT_R0); jit_ldr_i(JIT_R0, JIT_V1); jit_addi_i(JIT_V1, JIT_V1, 4); jit_jmpi(c_next); create_header("compile", 0, NULL); jit_ldr_i(JIT_R1, JIT_V1); jit_movi_i(JIT_V0, &h); jit_str_i(JIT_V0, JIT_V1); jit_addi_i(JIT_V0, JIT_V0, 4); jit_sti_i(&h, JIT_V0); jit_addi_i(JIT_V1, JIT_V1, 4); jit_jmpi(c_next); create_header("bra", 0, NULL); jit_ldr_i(JIT_V1, JIT_V1); jit_jmpi(c_next); // DO NOT UNCOUPLE THE FOLLOWING TWO! create_header("fbra", 0, NULL); tp = jit_beqi_i(jit_forward(), JIT_R0, 0); jit_popr_i(JIT_R0); jit_addi_i(JIT_V1, JIT_V1, 4); jit_jmpi(c_next); create_header("tbra", 0, NULL); tp2 = jit_beqi_i(jit_forward(), JIT_R0, 0); jit_patch(tp); jit_popr_i(JIT_R0); jit_ldr_i(JIT_V1, JIT_V1); jit_jmpi(c_next); jit_patch(tp2); jit_popr_i(JIT_R0); jit_addi_i(JIT_V1, JIT_V1, 4); jit_jmpi(c_next); create_header("!", 0, NULL); jit_popr_i(JIT_R1); jit_str_i(JIT_R0, JIT_R1); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("@", 0, NULL); jit_ldr_i(JIT_R0, JIT_R0); jit_jmpi(c_next); create_header("c!", 0, NULL); jit_popr_i(JIT_R1); jit_str_c(JIT_R0, JIT_R1); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("c@", 0, NULL); jit_ldr_c(JIT_R0, JIT_R0); jit_jmpi(c_next); create_header("1+", 0, NULL); jit_addi_i(JIT_R0, JIT_R0, 1); jit_jmpi(c_next); create_header("1-", 0, NULL); jit_subi_i(JIT_R0, JIT_R0, 1); jit_jmpi(c_next); create_header("+", 0, NULL); jit_popr_i(JIT_R1); jit_addr_i(JIT_R0, JIT_R0, JIT_R1); jit_jmpi(c_next); create_header("-", 0, NULL); jit_popr_i(JIT_R1); jit_subr_i(JIT_R0, JIT_R1, JIT_R0); jit_jmpi(c_next); create_header("*", 0, NULL); jit_popr_i(JIT_R1); jit_mulr_i(JIT_R0, JIT_R0, JIT_R1); jit_jmpi(c_next); create_header("/", 0, NULL); jit_popr_i(JIT_R1); jit_divr_i(JIT_R0, JIT_R1, JIT_R0); jit_jmpi(c_next); create_header("mod", 0, NULL); jit_popr_i(JIT_R1); jit_modr_i(JIT_R0, JIT_R1, JIT_R0); jit_jmpi(c_next); create_header("h", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, &h); jit_jmpi(c_next); create_header("l", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, &l); jit_jmpi(c_next); create_header("s0", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, pstack+PSTACKSIZE); jit_jmpi(c_next); create_header("r0", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, rstack+RSTACKSIZE); jit_jmpi(c_next); create_header("state", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, &state); jit_ldr_i(JIT_R0, JIT_R0); jit_jmpi(c_next); create_header("[", IMMEDIATE, NULL); jit_movi_i(JIT_R1, &state); jit_sti_i(JIT_R1, 0); jit_jmpi(c_next); create_header("]", 0, NULL); jit_movi_i(JIT_R1, &state); jit_sti_i(JIT_R1, 0); jit_jmpi(c_next); create_header("base", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, &base); jit_jmpi(c_next); create_header("r>", 0, NULL); jit_pushr_i(JIT_R0); jit_addi_i(JIT_V2, JIT_V2, CELLSIZE); jit_ldr_i(JIT_R0, JIT_V2); jit_jmpi(c_next); create_header(">r", 0, NULL); jit_str_i(JIT_V2, JIT_R0); jit_subi_i(JIT_V2, JIT_V2, CELLSIZE); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header(",", 0, NULL); jit_movi_i(JIT_V0, &h); jit_str_i(JIT_V0, JIT_R0); jit_addi_i(JIT_V0, JIT_V0, CELLSIZE); jit_sti_i(&h, JIT_V0); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("c,", 0, NULL); jit_movi_i(JIT_V0, &h); jit_str_c(JIT_V0, JIT_R0); jit_addi_i(JIT_V0, JIT_V0, 1); jit_sti_i(&h, JIT_V0); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("parsebuf", 0, NULL); jit_pushr_i(JIT_R0); jit_movi_i(JIT_R0, &parsebuf[0]); jit_jmpi(c_next); create_header("emit", 0, NULL); jit_movi_p(JIT_R1, "%c"); jit_prepare_i(2); jit_pusharg_p(JIT_R0); jit_pusharg_c(JIT_R1); jit_finish(printf); jit_popr_i(JIT_R0); jit_jmpi(c_next); create_header("accept", 0, NULL); jit_movi_i(JIT_R2, 0); jit_popr_i(JIT_R1); jit_prepare_i(3); jit_pusharg_i(JIT_R0); jit_pusharg_p(JIT_R1); jit_pusharg_i(JIT_R2); jit_finish(read); //jit_retval_i(JIT_R0); jit_jmpi(c_next); create_header("quit", 0, c_docolon); jit_patch_movi(main_entrance, jit_get_ip().ptr); /* compwords("reset"); newlabel("quit_loop"); compwords("state @"); comptbra("quit_skip_dispok"); compwords("dispok"); newlabel("quit_skip_dispok"); */ compword("lit"); compnum('D'); compword("emit"); compword("lit"); compnum('o'); compword("emit"); compword("lit"); compnum('u'); compword("emit"); compword("lit"); compnum('g'); compword("emit"); compword("lit"); compnum('\n'); compword("emit"); // Infinite loop! tp = jit_get_ip().ptr; compword("bra"); compnum((int)tp); //compword("exit"); } void get_machine_data() { char *tp; tp = jit_get_ip().ptr; jit_jmpi(NULL); JMPISIZE = jit_get_ip().ptr - tp; tp = jit_get_ip().ptr; jit_jmpr(JIT_R1); JMPRSIZE = jit_get_ip().ptr - tp; //FIXME: Should prolly die if these don't == CELLSIZE = sizeof(int) > sizeof(char*) ? sizeof(int) : sizeof(char*); } int main(int argc, char *argv[]) { void (*entry_point)(); int len; entry_point = (jit_set_ip(kernel).iptr); get_machine_data(); jit_flush_code(kernel, jit_get_ip().ptr); entry_point = (jit_set_ip(kernel).iptr); assemble_kernel(); jit_flush_code(kernel, jit_get_ip().ptr); len = (int) (jit_get_ip().ptr - kernel); printf("kernel compiled to %d bytes\n", len); entry_point(); while(1) ; return 0; }