예제 #1
0
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();
}
예제 #2
0
파일: main.c 프로젝트: Snial/FIGnition
void Dot(int x)
{
	char numBuff[16];
	sprintf(numBuff,"%d ",x);
	DotQuote(numBuff);
}
예제 #3
0
파일: init.c 프로젝트: karlredgate/forth
/** \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();
}