void ForthCopyBootStrap(void)
{
ushort labels[4]; // only allowed 4 labels.
ushort dst=0;
byte *src=(byte *)gTestProg;
DotQuote("FB");
KeyHeart();
do {
byte b=GetPgmByte(*src);
src++;
switch(b) {
case kFigLblDef:
b=GetPgmByte(*src); // get label value.
src++; // next byte.
labels[b]=dst; // save.
break;
case kFigLblFRef: {
ushort ref;
Emit('.'); // label!
b=GetPgmByte(*src); // get offset value.
src++; // next byte.
ref=0x8000+dst+2+(char)b; // sign extend.
DotHex(ref);
SramAbsWr(dst++,(byte)(ref>>8)); // big-endian.
SramAbsWr(dst++,(byte)(ref&255)); // low-byte.
}
break;
case kFigLblRef:
b=GetPgmByte(*src); // get label value.
src++; // next byte.
SramAbsWr(dst++,(byte)(labels[b]>>8)); // big-endian.
SramAbsWr(dst++,(byte)(labels[b]&255)); // low-byte.
case kFigLitWord:
SramAbsWr(dst++,GetPgmByte(*src++)); // big-endian.
SramAbsWr(dst++,GetPgmByte(*src++)); // low-byte.
break;
default:
SramAbsWr(dst++, b);
break;
}
}while(src<&gTestProgEnd);
Emit(kKeyEnter); // cr.
Emit('a');
dst=0;
src=(byte *)gTestProg;
do {
Dot(SramAbsRd(dst++));
src++;
}while(src<&gTestProgEnd);
KeyHeart();
Cls();
}
void Dot(int x)
{
char numBuff[16];
sprintf(numBuff,"%d ",x);
DotQuote(numBuff);
}
/** \brief Load all the initial dictionary words.
*/
void
init_dictionary(int dictsize) {
init_compiler(dictsize);
memory_words();
compile_primitives();
compile_core_constants();
core_words();
core_extension_words();
compile_dictionary_words();
controlflow_words();
more_core_words();
compile_double();
string_words();
exception_words();
file_words();
format_words();
compile_stack_words();
implementation_words();
vocabulary_words();
interpreter_words();
platform_words();
/* FIX - NEED TO DO THESE */
// Primitive( "d<", &lesser ); /* ( d1 d2 -- f ) */
// Primitive( "d>", &lesser ); /* ( d1 d2 -- f ) */
// Primitive( "u*", &um_star ); /* ( x y -- x*y ) */
// Primitive( "du*", &um_star ); /* ( x y -- x*y ) */
// Primitive( "du/mod", &um_star ); /* ( x y -- x*y ) */
// Primitive( "du<", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m+", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m-", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m*", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m*/", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m/", &um_star ); /* ( x y -- x*y ) */
// Primitive( "m/mod", &um_star ); /* ( x y -- x*y ) */
/* FIX - NEED TO DO THESE */
/* FIX - these two words are no longer used - why are they here ?? */
// Primitive( "um*", &um_star ); /* ( x y -- x*y ) */
// Colon( "udm*" ); /* ( d.lo d.hi n -- d.lo' d.hi' ) */
// c("tuck"); c("um*"); c("drop"); c("-rot"); c("um*");
// c("rot"); c("+"); End();
Colon( ".version" );
DotQuote("Portable ANS Forth - [email protected]");
c("cr");
End();
Colon( "rstrace" );
DotQuote("( R: ");
c("rp@");
c("rp0");
c("@");
Do();
c("i");
c(".");
c("space");
c("/cell");
PlusLoop();
DotQuote(" )");
c("cr");
End();
Variable( "argument-hook" );
/* To( Tick("ndrop"), "argument-hook" ); */
ACF x = find("unnest");
To( (Cell)x, "argument-hook" );
Colon( "cold" );
c(".version");
c("cold-chain");
/* included may be replaced with path-included which reads
FORTH_PATH environment variable to look in selected
directories */
c("debug");
c("@");
If();
DotQuote("Loading Forth files...");
Then();
/* StringLiteral("base.fth"); c("included"); */
DotQuote("loading base.fth");
c("cr");
StringLiteral("base.fth");
Tick("included");
c("catch");
c("?aborted");
If();
DotQuote("Failed to load.");
c("cr");
Then();
c("debug");
c("@");
If();
DotQuote("done.");
c("cr");
Then();
c("hex");
#if 0
c("argument-hook");
c("@");
Tick("execute");
c("catch");
c("?aborted");
If();
DotQuote("argument-hook failed");
c("cr");
Then();
#endif
c("read-eval-loop");
End();
Colon( "warm" );
DotQuote( "Warm Started." );
c("cr");
c("rstrace");
c("quit");
End();
/* header */
Colon( "name," );
c("dup");
c("1+");
c("talign");
c("allot");
c("dup");
c("here");
c("1-");
c("c!");
c("here");
c("1-");
c("over");
c("-");
c("swap");
c("cmove");
End();
Colon( "header" );
c("name,");
c("link");
c("do-create");
c(",");
End();
Colon( "create" );
c("parse-word");
c("header");
End();
Colon( "codefield" ); /* ( codefield -- ) */
c("lastacf");
c("!");
End();
Colon( ":" );
c("create");
c("hide");
c("do-colon");
c("codefield");
c("]");
End();
Colon( ";" );
c("compile");
c("unnest");
c("[");
c("reveal");
End();
immediate();
}
