void posix_words() {
Primitive( "getwd", &_getwd );
Colon( "pwd" ); c("getwd"); c("type"); c("cr"); End();
Primitive( "(getenv)", &_getenv );
Primitive( "(setenv)", &_setenv );
Colon( "getenv" ); c("parse-word"); c("(getenv)"); End();
Colon( "setenv" ); c("parse-word"); c("parse-word"); c("(setenv)"); End();
Colon( "printenv" );
c("parse-word"); c("2dup"); c("type");
Literal((Cell)'='); c("emit");
c("(getenv)"); If(); c("type"); Then(); c("cr"); End();
Primitive( "(system)", &_system );
Primitive( "(exec)", &_exec );
/* mmap() protection */
Constant( "PROT_EXEC", (Cell)PROT_EXEC );
Constant( "PROT_READ", (Cell)PROT_READ );
Constant( "PROT_WRITE", (Cell)PROT_WRITE );
Constant( "PROT_NONE", (Cell)PROT_NONE );
/* mmap() Flags */
Constant( "MAP_FIXED", (Cell)MAP_FIXED );
Constant( "MAP_SHARED", (Cell)MAP_SHARED );
Constant( "MAP_PRIVATE", (Cell)MAP_PRIVATE );
Primitive( "mmap", &do_mmap );
Primitive( "getpid", &_getpid );
Primitive( "getppid", &_getppid );
/* Signals for kill */
Constant( "SIGHUP", (Cell)SIGHUP );
Constant( "SIGINT", (Cell)SIGINT );
Constant( "SIGQUIT", (Cell)SIGQUIT );
Constant( "SIGILL", (Cell)SIGILL );
Constant( "SIGTRAP", (Cell)SIGTRAP );
Constant( "SIGABRT", (Cell)SIGABRT );
Constant( "SIGIOT", (Cell)SIGIOT );
Constant( "SIGBUS", (Cell)SIGBUS );
Constant( "SIGFPE", (Cell)SIGFPE );
Constant( "SIGKILL", (Cell)SIGKILL );
Constant( "SIGUSR1", (Cell)SIGUSR1 );
Constant( "SIGSEGV", (Cell)SIGSEGV );
Constant( "SIGUSR2", (Cell)SIGUSR2 );
Constant( "SIGPIPE", (Cell)SIGPIPE );
Constant( "SIGALRM", (Cell)SIGALRM );
Constant( "SIGTERM", (Cell)SIGTERM );
// Constant( "SIGSTKFLT", (Cell)SIGSTKFLT );
// Constant( "SIGCLD", (Cell)SIGCLD );
Constant( "SIGCHLD", (Cell)SIGCHLD );
Constant( "SIGCONT", (Cell)SIGCONT );
Constant( "SIGSTOP", (Cell)SIGSTOP );
Constant( "SIGTSTP", (Cell)SIGTSTP );
Primitive( "kill", &_kill );
}
void compile_dictionary_words() {
Colon( "allot" ); /* ( n -- ) */
c("dp"); c("+!"); End();
Colon( "," ); /* ( n -- ) */
c("here"); c("!"); c("/cell"); c("allot"); End();
Colon( "compile," ); /* ( xt -- ) */
/* c("origin-"); */ c(","); End();
Colon( "compile" ); /* ( -- ) */
c("ip>"); c("dup"); c("cell+"); c(">ip");
c("@"); c("compile,"); End();
/* FIX - Probably want lit and literal defined earlier */
Colon( "lit" ); c("ip>"); c("dup"); c("cell+"); c(">ip");
c("@"); End();
Colon( "literal" ); c("compile"); c("lit"); c(","); End();
/* From page 296 - Kelly/Spies */
/* Maybe redefine in terms of ta1+... */
Colon( ">body" ); /* ( acf -- apf ) */
Literal((Cell)sizeof(ACF)); c("+"); End();
Colon( ">link" ); /* ( acf -- alf ) */
Literal((Cell)sizeof(ALF)); c("-"); End();
Colon( "l>name" ); /* ( alf -- anf ) */
c("1-"); End();
Colon( "n>link" ); /* ( alf -- anf ) */
c("1+"); End();
Colon( ">name" ); /* ( acf -- anf ) */
c(">link"); c("l>name"); End();
Colon( "body>" ); /* ( apf -- acf ) */
Literal((Cell)sizeof(ACF)); c("-"); End();
Colon( "link>" ); /* ( alf -- acf ) */
Literal((Cell)sizeof(ALF)); c("+"); End();
Colon( "name>" ); /* ( anf -- acf ) */
c("n>link"); c("link>"); End();
}
/** \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();
}
// ---------------------------------------------------------
// TCodParser::AttrLineL()
// ---------------------------------------------------------
//
TBool TCodParser::AttrLineL(CMediaObjectData *& aMediaObject)
{
SkipWhiteSpace(); // Skip lines which contain only WS and LF at the end.
while ( IsEndOfLine() )
{
NextLine();
SkipWhiteSpace();
}
TBool ok( ETrue );
if ( iCurP < iEndP )
{
// Still has something to read.
switch( AttrName() )
{
case ECodName:
{
if ( Colon() )
{
ok = aMediaObject->SetNameL( AttrValue() );
EndOfLine();
}
break;
}
case ECodVendor:
{
if ( Colon() )
{
ok = iData->SetVendorL( AttrValue() );
EndOfLine();
}
break;
}
case ECodDescription:
{
if ( Colon() )
{
ok = aMediaObject->SetDescriptionL( AttrValue() );
EndOfLine();
}
break;
}
case ECodSize:
{
if ( Colon() )
{
// Parse as TUint - negative not allowed.
TUint size;
TLex lex( AttrValue() );
if ( !lex.Val( size ) )
{
aMediaObject->SetSize( size );
}
else
{
ok = EFalse;
}
EndOfLine();
}
break;
}
case ECodInstallNotify:
{
if ( Colon() )
{
ok = aMediaObject->SetInstallNotifyL( AttrValue() );
EndOfLine();
}
break;
}
case ECodNextUrl:
{
if ( Colon() )
{
ok = iData->SetNextUrlL( AttrValue() );
EndOfLine();
}
break;
}
case ECodNextUrlAtError:
{
if ( Colon() )
{
ok = iData->SetNextUrlAtErrorL( AttrValue() );
EndOfLine();
}
break;
}
case ECodInfoUrl:
{
if ( Colon() )
{
ok = aMediaObject->SetInfoUrlL( AttrValue() );
EndOfLine();
}
break;
}
case ECodPrice:
{
if ( Colon() )
{
ok = aMediaObject->SetPriceL( AttrValue() );
EndOfLine();
}
break;
}
case ECodIcon:
{
if ( Colon() )
{
ok = aMediaObject->SetIconL( AttrValue() );
EndOfLine();
}
break;
}
case ECodType:
{
if ( Colon() )
{
ok = aMediaObject->SetTypeL( AttrValue() );
EndOfLine();
}
break;
}
case ECodUrl:
{
if ( Colon() )
{
ok = aMediaObject->SetUrlL( AttrValue() );
EndOfLine();
}
break;
}
case ECodUnknownAttr:
{
// Name unknown; check colon anyway (syntax check).
ok = Colon();
// Rest of the line goes unchecked.
break;
}
default:
{
// Unexpected value.
CodPanic( ECodInternal );
}
}
if ( !ok )
{
Error( KErrCodInvalidDescriptor );
}
NextLine(); // Step past LF.
return ETrue; // More lines to go.
}
else
{
// EOF reached; done.
// Note: not expecting EOF in any other place than here (well-formed
// COD has complete attrlines. If EOF is found some other place, it
// is a syntax error.
return EFalse;
}
}
