//
//
//
// --------------------------------------------------------------------------
// Собственно сами коды LForthMachine
//----------------------------------------------------------------------------
void LFMInit(int SizeStack)
{
Stret=new Stack(400);
for(int i=0;i<NumRunMet;i++) Run[i]=NULL;
PrevData=NULL;
//Prev=NULL;
DictBegin=NULL;
NumElemFunc=0;
Stk= new Stack(SizeStack);
StateLFM=Immediat;
//
// Создания словаря из базовых слов.
//
LFMAddWord("FORGET",forget,"");
LFMAddWord("_EXECUTE",execute,"");
LFMAddWord("_ILITERAL",iliteral,"");
LFMAddWord("_IF",aIFa,"");
LFMAddWord("_ELSE",aELSEa,"");
LFMAddWord("NOP",nop,"");
LFMAddWord(".",dot,"");
LFMAddWord("+",iplus,"");
LFMAddWord("-",iminus,"");
LFMAddWord("*",imultip,"");
LFMAddWord("/",idiv,"");
LFMAddWord("MOD",imod,"mod.htm");
LFMAddWord("IMMEDIATE",immediate,"immediate.htm");immediate(NULL);
LFMAddWord("?IMMEDIATE",woprimmediate,"");
LFMAddWord("?COMP",woprcomp,"");
LFMAddWord(":",dbldot,"");
LFMAddWord(";",dotpunkt,"");immediate(NULL);
//LFMAddWord("DUP",dup,"dup.htm");
LFMAddWord("SWAP",swap,"swap.htm");
LFMAddWord("ROT",rot,"rot.htm");
//LFMAddWord("OVER",over,"over.htm");
LFMAddWord("DROP",drop,"drop.htm");
//LFMAddWord("2DUP",dupdup,"2dup.htm");
LFMAddWord("2DROP",dropdrop,"2drop.htm");
LFMAddWord("1+",plus1,"");
LFMAddWord("1-",minus1,"");
LFMAddWord("2*",dwumn,"");
LFMAddWord("2/",dwdiv,"");
LFMAddWord("BEEP",beep,"beep.htm");
LFMAddWord("R>",rb,"");
LFMAddWord("R<",rm,"");
LFMAddWord("\\**",kom,"kom.htm");immediate(NULL);// \**
LFMAddWord("IF",IF,"if.htm");immediate();
LFMAddWord("THEN",THEN,"if.htm");immediate();
LFMAddWord("ELSE",ELSE,"if.htm");immediate();
LFMAddWord("0=",arwa,"0rw.htm");
LFMAddWord("0>",abla,"0bl.htm");
LFMAddWord("0<",amna,"0mn.htm");
LFMAddWord("NOT",NOT,"not.htm");
LFMAddWord("AND",AND,"and.htm");
LFMAddWord("OR",OR,"or.htm");
LFMAddWord("XOR",XOR,"xor.htm");
}
/* Greja lite mera... */
static void doSomeMore(void)
{
INPUT *in;
OPERAND op1;
OPERAND op2;
in=READER();
if(!in) return;
switch(in->type) {
case IS_INSTR:
op1=in->data.instr.op1;
op2=in->data.instr.op2;
switch(in->data.instr.instr) {
case INSTR68_PEA:
outputInstr(in,INSTR68_LEA,op1,tempReg(SIZE_L,OP_WRITE),O_NORMAL);
outputInstr(in,INSTR68_PUSH,tempReg(SIZE_L,OP_READ),noOperand(),O_SRC);
break;
case INSTR68_ST:
outputInstr(in,INSTR68_MOVE,immediate(255,SIZE_B),stdOp(op1,SIZE_B,OP_WRITE),O_NORMAL);
break;
case INSTR68_MOVEM:
if(!doPushPull(in,op1,op2))
goto normal;
break;
case INSTR68_MOVE:
if(!doPushPull(in,op1,op2))
goto normal;
break;
default:
normal:
output((OUTPUT *)in);
break;
}
break;
default:
output((OUTPUT *)in);
break;
}
}
/** \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();
}
