Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
/* * skel.engine.c - the Crim/Flua inner interpreter * edrx 2001apr20 */ #include <stdio.h> typedef unsigned int uint; typedef unsigned char uchar; typedef unsigned short ushort; typedef int (*funptr)(); ushort *RS; int *DS, *SS; /**[lua return "\n"..strings.Cdefs.."\n"..strings.Cdefs_LAST lua]**/ extern uchar _f0[]; int underflow[100]; ushort _RS0[100]; int _DS0[100], _SS0[100]; #define RDEPTH ((RS-_RS0)+1) #define DDEPTH ((DS-_DS0)+1) #define SDEPTH ((SS-_SS0)+1) int DBG_BITS = 0; /* a bit mask; -1 means to print all debug info */ #define DBG_FORTH 1 /* if set show the stacks in the "forth" states */ #define DBG_HEAD 2 /* if set show the stacks in the "head" states */ #define DBG_OK 4 /* if set print an "ok!" when leaving */ #define DBG_LONGFORM 8 /* use the long form for stack dumps */ #define DBG_USETABS 16 /* usa tabs instead of spaces in the stack dumps */ void DBG(char *statename, int bit); unsigned int SF_TO_F[] = { /**[lua return "\n " .. strings.SFprims lua]**/ /* end: */ 0}; /* void *SF_TO_ADR[] = {}; */ /* not being used at this moment */ /**[lua return "\n" .. strings.Cextras1 lua]**/ /* * The engine itself. */ void engine(void) { ushort instr, tmp; uchar byte; funptr fun; goto head; forth: DBG("forth", DBG_FORTH); if (RS[0] >= FIP_LAST) /* ip primitive? */ goto run_forth_ip_primitive; byte = _f0[RS[0]]; RS[0]++; if (byte >= SF_LAST) { /* one-byte instruction? */ instr = SF_TO_F[255 - byte]; goto run_forth_instr; } else { /* it's a normal call */ instr = (byte << 8) | _f0[RS[0]]; RS[0]++; goto run_forth_instr; } run_forth_instr: if (instr >= F_LAST) goto run_forth_primitive; run_forth_call: RS++; RS[0] = instr; goto head; run_forth_primitive: switch (instr) { /**[lua return "\n"..strings.Fprims lua]**/ } run_forth_ip_primitive: instr = RS[0]; switch (instr) { /**[lua return "\n"..strings.FIPprims lua]**/ } head: DBG("head ", DBG_HEAD); byte = _f0[RS[0]]; RS[0]++; switch (byte) { /**[lua return "\n"..strings.Hprims lua]**/ } } /* * Debugging routines called by the engine. * */ void dbg_print_int(int x) { uint w = (uchar *)x - _f0; if (w<=0xFFFF) printf((DBG_BITS&DBG_LONGFORM?" _f0+%x":" %x+_"), w); else printf(" %x", x); } void DBG(char *statename, int bit) { int i; char *t = DBG_BITS&DBG_USETABS?"\t":" "; if ((bit&DBG_BITS)==0) return; if (DBG_BITS&DBG_LONGFORM) { printf("state=%s R::", statename); for (i=-RDEPTH+1; i<=0; ++i) printf(" %x", RS[i]); printf("%sS::", t); for (i=-SDEPTH+1; i<=0; ++i) dbg_print_int(SS[i]); printf("%sD::", t); for (i=-DDEPTH+1; i<=0; ++i) dbg_print_int(DS[i]); printf("\n"); } else { for (i=-RDEPTH+1; i<=0; ++i) printf(" %x", RS[i]); printf("%s///", t); for (i=-SDEPTH+1; i<=0; ++i) dbg_print_int(SS[i]); printf("%s//", t); for (i=-DDEPTH+1; i<=0; ++i) dbg_print_int(DS[i]); printf("%s:: %s\n", t, statename); } } /* * Make the engine execute the word "DEMO" * */ extern uchar ADR_DEMO[]; int main(int argc, char **argv) { if (argc>1) DBG_BITS = atoi(argv[1]); /* use argv[1] to set the debug bits */ RS = _RS0 + 1; /* depth 2 (RS[-1] is valid, RS[-2] isn't) */ DS = _DS0 - 1; /* depth 0 */ SS = _SS0 - 1; /* depth 0 */ RS[-1] = FIP_RETURN; RS[0] = 0x1F; RS[0] = ADR_DEMO - _f0; engine(); if (DBG_BITS & DBG_OK) printf("Ok!\n"); return 0; }