/*
================
idPhysics_RigidBody::PutToRest
put to rest untill something collides with this physics object
================
*/
void idPhysics_RigidBody::PutToRest( void ) {
Rest();
}
/*
================
idPhysics_Monster::Evaluate
================
*/
bool idPhysics_Monster::Evaluate( int timeStepMSec, int endTimeMSec ) {
idVec3 masterOrigin, oldOrigin;
idMat3 masterAxis;
float timeStep;
timeStep = MS2SEC( timeStepMSec );
moveResult = MM_OK;
blockingEntity = NULL;
oldOrigin = current.origin;
// if bound to a master
if ( masterEntity ) {
self->GetMasterPosition( masterOrigin, masterAxis );
current.origin = masterOrigin + current.localOrigin * masterAxis;
clipModel->Link( gameLocal.clip, self, 0, current.origin, clipModel->GetAxis() );
current.velocity = ( current.origin - oldOrigin ) / timeStep;
masterDeltaYaw = masterYaw;
masterYaw = masterAxis[0].ToYaw();
masterDeltaYaw = masterYaw - masterDeltaYaw;
return true;
}
// if the monster is at rest
if ( current.atRest >= 0 ) {
return false;
}
ActivateContactEntities();
// move the monster velocity into the frame of a pusher
current.velocity -= current.pushVelocity;
clipModel->Unlink();
// check if on the ground
idPhysics_Monster::CheckGround( current );
// if not on the ground or moving upwards
float upspeed;
if ( gravityNormal != vec3_zero ) {
upspeed = -( current.velocity * gravityNormal );
} else {
upspeed = current.velocity.z;
}
if ( fly || ( !forceDeltaMove && ( !current.onGround || upspeed > 1.0f ) ) ) {
if ( upspeed < 0.0f ) {
moveResult = MM_FALLING;
}
else {
current.onGround = false;
moveResult = MM_OK;
}
delta = current.velocity * timeStep;
if ( delta != vec3_origin ) {
moveResult = idPhysics_Monster::SlideMove( current.origin, current.velocity, delta );
delta.Zero();
}
if ( !fly ) {
current.velocity += gravityVector * timeStep;
}
} else {
if ( useVelocityMove ) {
delta = current.velocity * timeStep;
} else {
current.velocity = delta / timeStep;
}
current.velocity -= ( current.velocity * gravityNormal ) * gravityNormal;
if ( delta == vec3_origin ) {
Rest();
} else {
// try moving into the desired direction
moveResult = idPhysics_Monster::StepMove( current.origin, current.velocity, delta );
delta.Zero();
}
}
clipModel->Link( gameLocal.clip, self, 0, current.origin, clipModel->GetAxis() );
// get all the ground contacts
EvaluateContacts();
// move the monster velocity back into the world frame
current.velocity += current.pushVelocity;
current.pushVelocity.Zero();
if ( IsOutsideWorld() ) {
gameLocal.Warning( "clip model outside world bounds for entity '%s' at (%s)", self->name.c_str(), current.origin.ToString(0) );
Rest();
}
return ( current.origin != oldOrigin );
}
void Player::Update(bool keys[], Map &map)
{
const int FRAMES_PER_ANIMATION = frameArraySize.x * frameArraySize.x;
hasMoved = false;
if(health <= 0 && state != DYING && state != DEAD)
{
Die();
state = DYING;
}
const bool moveUp = keys[KEY_UP] || keys[KEY_W];
const bool moveLeft = keys[KEY_LEFT] || keys[KEY_A];
const bool moveDown = keys[KEY_DOWN] || keys[KEY_S];
const bool moveRight = keys[KEY_RIGHT] || keys[KEY_D];
const bool attack = keys[KEY_SPACE];
if(state == DYING || state == DEAD)
{
if(attackCounter++ == FRAMES_PER_ANIMATION)
{
state = DEAD;
attackCounter = 0;
}
}
else if(attack)
{
if(attacking == false)
{
attackCounter = 0;
attacking = true;
Attack();
}
}
if(experience >= pow(2.0, level + 1))
{
LevelUp();
}
if(state != DYING && state != DEAD)
{
if((moveUp || moveLeft || moveDown || moveRight || attacking) == false)
{
Rest();
}
else if(attacking)
{
if(attackCounter++ == FRAMES_PER_ANIMATION)
{
for(std::vector<Enemy*>::iterator it = map.enemies.begin(); it != map.enemies.end(); ++it)
{
if(GenerateHitBox(direction).Intersects((*it)->GetBounds()))
{
(*it)->health -= 10;
}
}
attacking = false;
attackCounter = 0;
}
}
else
{
Vector2 coords = GetCoords();
if((coords == previousCoords) == false)
{
previousCoords = coords;
hasMoved = true;
}
if(moveUp)
{
if(moveLeft)
{
Move(map, NORTH_WEST);
}
else if(moveRight)
{
Move(map, NORTH_EAST);
}
else
{
Move(map, NORTH);
}
}
else if(moveDown)
{
if(moveLeft)
{
Move(map, SOUTH_WEST);
}
else if(moveRight)
{
Move(map, SOUTH_EAST);
}
else
{
Move(map, SOUTH);
}
}
else if(moveLeft)
{
Move(map, WEST);
}
else if(moveRight)
{
Move(map, EAST);
}
}
}
}
int main(int argc, char * argv[])
#endif // FOMENT_UNIX
{
int_t pdx = 0;
int adx = 1;
while (adx < argc)
{
if (StringCompareS(argv[adx], "-A") == 0)
adx += 2;
else if (StringCompareS(argv[adx], "-I") == 0)
adx += 2;
else if (StringCompareS(argv[adx], "-X") == 0)
adx += 2;
else if (argv[adx][0] != '-')
{
pdx = adx;
break;
}
else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0)
{
InlineProcedures = 0;
adx += 1;
}
else if (StringCompareS(argv[adx], "-no-inline-imports") == 0)
{
InlineImports = 0;
adx += 1;
}
else if (StringCompareS(argv[adx], "--validate-heap") == 0)
{
ValidateHeap = 1;
adx += 1;
}
#ifdef FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--section-table") == 0)
{
adx += 1;
if (adx < argc)
{
#ifdef FOMENT_32BIT
SectionTableBase = (void *) wcstol(argv[adx], 0, 16);
#endif // FOMENT_32BIT
#ifdef FOMENT_64BIT
SectionTableBase = (void *) _wcstoui64(argv[adx], 0, 16);
#endif // FOMENT_64BIT
adx += 1;
}
}
#endif // FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--random-seed") == 0)
{
adx += 1;
if (adx < argc)
{
RandomSeed = StringToInt(argv[adx]);
adx += 1;
}
}
else
break;
}
FThreadState ts;
try
{
SetupFoment(&ts);
if (pdx > 0)
{
AddToLibraryPath(argv[pdx]);
}
}
catch (FObject obj)
{
printf("Unexpected exception: SetupFoment: %p\n", obj);
WriteSimple(R.StandardOutput, obj, 0);
if (ValidateHeap)
{
FailedGC();
FailedExecute();
}
return(1);
}
FAssert(argc >= 1);
try
{
int adx = 1;
while (adx < argc)
{
if (StringCompareS(argv[adx], "-A") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
FObject lp = R.LibraryPath;
for (;;)
{
FAssert(PairP(lp));
if (Rest(lp) == EmptyListObject)
break;
lp = Rest(lp);
}
// AsPair(lp)->Rest = MakePair(MakeStringS(argv[adx]), EmptyListObject);
SetRest(lp, MakePair(MakeStringS(argv[adx]), EmptyListObject));
adx += 1;
}
else if (StringCompareS(argv[adx], "-I") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
R.LibraryPath = MakePair(MakeStringS(argv[adx]), R.LibraryPath);
adx += 1;
}
else if (StringCompareS(argv[adx], "-X") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
R.LibraryExtensions = MakePair(MakeStringS(argv[adx]), R.LibraryExtensions);
adx += 1;
}
else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0
|| StringCompareS(argv[adx], "-no-inline-imports") == 0
|| StringCompareS(argv[adx], "--validate-heap") == 0)
adx += 1;
#ifdef FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--section-table") == 0)
adx += 2;
#endif // FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--random-seed") == 0)
adx += 2;
else if (argv[adx][0] != '-')
return(ProgramMode(adx, argc, argv));
else
break;
}
R.LibraryPath = ReverseListModify(MakePair(MakeStringC("."), R.LibraryPath));
R.CommandLine = MakePair(MakeInvocation(adx, argv),
MakeCommandLine(argc - adx, argv + adx));
ExecuteThunk(R.InteractiveThunk);
ExitFoment();
return(0);
// return(RunRepl(GetInteractionEnv()));
}
catch (FObject obj)
{
if (ExceptionP(obj) == 0)
WriteStringC(R.StandardOutput, "exception: ");
WriteSimple(R.StandardOutput, obj, 0);
WriteCh(R.StandardOutput, '\n');
if (ValidateHeap)
{
FailedGC();
FailedExecute();
}
return(-1);
}
}
/*
================
idPhysics_Monster::PutToRest
================
*/
void idPhysics_Monster::PutToRest( void ) {
Rest();
}
void HSBalloonSprite::TouchBalloonEnd()
{
Rest();
m_isLister = true;
}
//=================================================================================================
void PlayerController::TravelTick()
{
Rest(1, false, true);
Train(TrainWhat::Move, 0.f, 0);
}
/*
================
idPhysics_RigidBody::Evaluate
Evaluate the impulse based rigid body physics.
When a collision occurs an impulse is applied at the moment of impact but
the remaining time after the collision is ignored.
================
*/
bool idPhysics_RigidBody::Evaluate(int timeStepMSec, int endTimeMSec)
{
rigidBodyPState_t next;
idAngles angles;
trace_t collision;
idVec3 impulse;
idEntity *ent;
idVec3 oldOrigin, masterOrigin;
idMat3 oldAxis, masterAxis;
float timeStep;
bool collided, cameToRest = false;
timeStep = MS2SEC(timeStepMSec);
current.lastTimeStep = timeStep;
if (hasMaster) {
oldOrigin = current.i.position;
oldAxis = current.i.orientation;
self->GetMasterPosition(masterOrigin, masterAxis);
current.i.position = masterOrigin + current.localOrigin * masterAxis;
if (isOrientated) {
current.i.orientation = current.localAxis * masterAxis;
} else {
current.i.orientation = current.localAxis;
}
clipModel->Link(gameLocal.clip, self, clipModel->GetId(), current.i.position, current.i.orientation);
current.i.linearMomentum = mass * ((current.i.position - oldOrigin) / timeStep);
current.i.angularMomentum = inertiaTensor * ((current.i.orientation * oldAxis.Transpose()).ToAngularVelocity() / timeStep);
current.externalForce.Zero();
current.externalTorque.Zero();
return (current.i.position != oldOrigin || current.i.orientation != oldAxis);
}
// if the body is at rest
if (current.atRest >= 0 || timeStep <= 0.0f) {
DebugDraw();
return false;
}
// if putting the body to rest
if (dropToFloor) {
DropToFloorAndRest();
current.externalForce.Zero();
current.externalTorque.Zero();
return true;
}
#ifdef RB_TIMINGS
timer_total.Start();
#endif
// move the rigid body velocity into the frame of a pusher
// current.i.linearMomentum -= current.pushVelocity.SubVec3( 0 ) * mass;
// current.i.angularMomentum -= current.pushVelocity.SubVec3( 1 ) * inertiaTensor;
clipModel->Unlink();
next = current;
// calculate next position and orientation
Integrate(timeStep, next);
#ifdef RB_TIMINGS
timer_collision.Start();
#endif
// check for collisions from the current to the next state
collided = CheckForCollisions(timeStep, next, collision);
#ifdef RB_TIMINGS
timer_collision.Stop();
#endif
// set the new state
current = next;
if (collided) {
// apply collision impulse
if (CollisionImpulse(collision, impulse)) {
current.atRest = gameLocal.time;
}
}
// update the position of the clip model
clipModel->Link(gameLocal.clip, self, clipModel->GetId(), current.i.position, current.i.orientation);
DebugDraw();
if (!noContact) {
#ifdef RB_TIMINGS
timer_collision.Start();
#endif
// get contacts
EvaluateContacts();
#ifdef RB_TIMINGS
timer_collision.Stop();
#endif
// check if the body has come to rest
if (TestIfAtRest()) {
// put to rest
Rest();
cameToRest = true;
} else {
// apply contact friction
ContactFriction(timeStep);
}
}
if (current.atRest < 0) {
ActivateContactEntities();
}
if (collided) {
// if the rigid body didn't come to rest or the other entity is not at rest
ent = gameLocal.entities[collision.c.entityNum];
if (ent && (!cameToRest || !ent->IsAtRest())) {
// apply impact to other entity
ent->ApplyImpulse(self, collision.c.id, collision.c.point, -impulse);
}
}
// move the rigid body velocity back into the world frame
// current.i.linearMomentum += current.pushVelocity.SubVec3( 0 ) * mass;
// current.i.angularMomentum += current.pushVelocity.SubVec3( 1 ) * inertiaTensor;
current.pushVelocity.Zero();
current.lastTimeStep = timeStep;
current.externalForce.Zero();
current.externalTorque.Zero();
if (IsOutsideWorld()) {
gameLocal.Warning("rigid body moved outside world bounds for entity '%s' type '%s' at (%s)",
self->name.c_str(), self->GetType()->classname, current.i.position.ToString(0));
Rest();
}
#ifdef RB_TIMINGS
timer_total.Stop();
if (rb_showTimings->integer == 1) {
gameLocal.Printf("%12s: t %1.4f cd %1.4f\n",
self->name.c_str(),
timer_total.Milliseconds(), timer_collision.Milliseconds());
lastTimerReset = 0;
} else if (rb_showTimings->integer == 2) {
numRigidBodies++;
if (endTimeMSec > lastTimerReset) {
gameLocal.Printf("rb %d: t %1.4f cd %1.4f\n",
numRigidBodies,
timer_total.Milliseconds(), timer_collision.Milliseconds());
}
}
if (endTimeMSec > lastTimerReset) {
lastTimerReset = endTimeMSec;
numRigidBodies = 0;
timer_total.Clear();
timer_collision.Clear();
}
#endif
return true;
}
/*
================
idPhysics_Parametric::Evaluate
================
*/
bool idPhysics_Parametric::Evaluate( int timeStepMSec, int endTimeMSec ) {
idVec3 oldLocalOrigin, oldOrigin, masterOrigin;
idAngles oldLocalAngles, oldAngles;
idMat3 oldAxis, masterAxis;
isBlocked = false;
oldLocalOrigin = current.localOrigin;
oldOrigin = current.origin;
oldLocalAngles = current.localAngles;
oldAngles = current.angles;
oldAxis = current.axis;
current.localOrigin.Zero();
current.localAngles.Zero();
if ( current.spline != NULL ) {
float length = current.splineInterpolate.GetCurrentValue( endTimeMSec );
float t = current.spline->GetTimeForLength( length, 0.01f );
current.localOrigin = current.spline->GetCurrentValue( t );
if ( current.useSplineAngles ) {
current.localAngles = current.spline->GetCurrentFirstDerivative( t ).ToAngles();
}
} else if ( current.linearInterpolation.GetDuration() != 0 ) {
current.localOrigin += current.linearInterpolation.GetCurrentValue( endTimeMSec );
} else {
current.localOrigin += current.linearExtrapolation.GetCurrentValue( endTimeMSec );
}
if ( current.angularInterpolation.GetDuration() != 0 ) {
current.localAngles += current.angularInterpolation.GetCurrentValue( endTimeMSec );
} else {
current.localAngles += current.angularExtrapolation.GetCurrentValue( endTimeMSec );
}
current.localAngles.Normalize360();
current.origin = current.localOrigin;
current.angles = current.localAngles;
current.axis = current.localAngles.ToMat3();
if ( hasMaster ) {
self->GetMasterPosition( masterOrigin, masterAxis );
if ( masterAxis.IsRotated() ) {
current.origin = current.origin * masterAxis + masterOrigin;
if ( isOrientated ) {
current.axis *= masterAxis;
current.angles = current.axis.ToAngles();
}
}
else {
current.origin += masterOrigin;
}
}
if ( isPusher ) {
gameLocal.push.ClipPush( pushResults, self, pushFlags, oldOrigin, oldAxis, current.origin, current.axis );
if ( pushResults.fraction < 1.0f ) {
clipModel->Link( gameLocal.clip, self, 0, oldOrigin, oldAxis );
current.localOrigin = oldLocalOrigin;
current.origin = oldOrigin;
current.localAngles = oldLocalAngles;
current.angles = oldAngles;
current.axis = oldAxis;
isBlocked = true;
return false;
}
current.angles = current.axis.ToAngles();
}
if ( clipModel ) {
clipModel->Link( gameLocal.clip, self, 0, current.origin, current.axis );
}
current.time = endTimeMSec;
if ( TestIfAtRest() ) {
Rest();
}
return ( current.origin != oldOrigin || current.axis != oldAxis );
}
/* Must mutate original if changes required for consistency */
GLOBAL void FunctionConflict(Node *orig, Node *create)
{
Node *ofdcl, *nfdcl;
assert(orig);
assert(create);
assert(orig->typ == Decl);
assert(create->typ == Decl);
ofdcl = NodeDataType(orig);
nfdcl = NodeDataType(create);
if (ofdcl->typ != Fdcl || nfdcl->typ != Fdcl)
goto Mismatch;
/*
* Check if one declaration is T_PROCEDURE and the other is not.
* BUG: I think the whole way we treat 'cilk' and 'inlet' keywords
* is broken. We treat 'cilk' like 'const', but
*
* const int foo()
*
* is not the same as
*
* cilk int foo()
*
* The former returns a 'const int', but the latter does not return a
* 'cilk int' ! - athena
*
* BTW, the following line is a hack :-)
* ((ofdcl->u.fdcl.tq ^ nfdcl->u.fdcl.tq) & (T_PROCEDURE | T_INLET))
* Bradley rewrote it has follows:
*/
if ((tq_has_procedure(ofdcl->u.fdcl.tq) != tq_has_procedure(nfdcl->u.fdcl.tq))
|| (tq_has_inlet(ofdcl->u.fdcl.tq) != tq_has_inlet(nfdcl->u.fdcl.tq)))
goto Mismatch;
/* The Result Type must be equal */
if (!TypeEqual(ofdcl->u.fdcl.returns, nfdcl->u.fdcl.returns))
goto Mismatch;
/* Inspect the parameter lists */
{
List *optr = ofdcl->u.fdcl.args, *nptr = nfdcl->u.fdcl.args;
/* Are both definitions in prototype form? */
if (optr && nptr) {
/* Then every parameter must be compatible */
for (; optr && nptr; optr = Rest(optr), nptr = Rest(nptr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem),
*nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqualFormals(otype, ntype)) {
SetItem(optr, nitem);
goto Mismatch;
}
}
/* And the parameter lists must be of the same length */
if (optr || nptr)
goto Mismatch;
}
/* Check for <Type> f(void) vs <Type> f() */
else if (IsVoidArglist(optr));
/* Check for <Type> f() vs <Type> f(void) */
else if (IsVoidArglist(nptr))
ofdcl->u.fdcl.args = MakeNewList(PrimVoid);
/* Else the provided types must be the "usual unary conversions" */
else {
/* Either this loop will run */
for (; optr; optr = Rest(optr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem);
if (!TypeEqual(otype, UsualUnaryConversionType(otype)) ||
IsEllipsis(otype))
goto Mismatch;
}
/* Or this one will */
for (; nptr; nptr = Rest(nptr)) {
Node *nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqual(ntype, UsualUnaryConversionType(ntype)) ||
IsEllipsis(ntype))
goto Mismatch;
}
}
}
return;
Mismatch:
SyntaxErrorCoord(create->coord,
"identifier `%s' redeclared", VAR_NAME(orig));
fprintf(stderr, "\tPrevious declaration: ");
PRINT_COORD(stderr, orig->coord);
fputc('\n', stderr);
return;
}
/**
* The Simulator Thread which will update all
* Sensors every 'interval'
*/
static void*Simulator(void*const rawtable)
{
if(!rawtable)
{
Log(LOGT_SERVER, LOGL_ERROR, "No database for simulator!");
pthread_exit(NULL);
}
{
Trie*const db = rawtable;
Templock = 0;
Radlock = 0;
Fulllock = 0;
Presslock = 0;
Flowlock = 0;
if(interval)
{
// Get all tables
if(!(RadiationTable = findinTrie(db, "Radiation")))
{
Log(LOGT_SERVER, LOGL_ERROR, "Can not find Radiation Table in Database!");
pthread_exit(NULL);
}
if(!(FlowTable = findinTrie(db, "Flow")))
{
Log(LOGT_SERVER, LOGL_ERROR, "Can not find Flow Table in Database!");
pthread_exit(NULL);
}
if(!(TemperatureTable = findinTrie(db, "Temperature")))
{
Log(LOGT_SERVER, LOGL_ERROR, "Can not find Temperature Table in Database!");
pthread_exit(NULL);
}
if(!(FullnessTable = findinTrie(db, "Fullness")))
{
Log(LOGT_SERVER, LOGL_ERROR, "Can not find Fullness Table in Database!");
pthread_exit(NULL);
}
if(!(PressureTable = findinTrie(db, "Pressure")))
{
Log(LOGT_SERVER, LOGL_ERROR, "Can not find Pressure Table in Database!");
pthread_exit(NULL);
}
{
int fwcollection, fwcollectionav, fwcollectiondelta, count, amount;
while(!stopsimulation)
{
Rest(interval);
// Radiation
fortrie(RadiationTable, &SimulateRadiation);
// Flow
fortrie(FlowTable, &SimulateFlow);
// Temperature
fortrie(TemperatureTable, &SimulateTemperature);
// Fullness
Sensor*const fwsensor = FlowTable->e;
AutoQ *q = fwsensor->delta;
amount = countTrie(FullnessTable);
count = amount;
fwcollection = 0;
while(count > 0)
{
if(!q) break;
{
if(!(*(int*)q->e)) break;
fwcollection += *(int*)q->e;
if(count == 30) fwcollectiondelta = *(int*)q->e;
if(count == 1) fwcollectiondelta = (fwcollectiondelta - (*(int*)q->e));
count--;
q=q->n;
}
}
fwcollectionav = (fwcollection/(amount-count));
if(count > 0) fwcollectiondelta = 0;
if(fwcollectionav > 350 || fwcollectiondelta > 30) SimulateFullness(true);
if(fwcollectionav < 300) SimulateFullness(false);
// Pressure
fortrie(PressureTable, &SimulatePressure);
}
}
}
}
pthread_exit(NULL);
}
/* DEAD CODE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
GLOBAL Bool IsCompatibleFdcls(Node *node1, Node *node2)
{
assert(node1->typ == Fdcl);
assert(node2->typ == Fdcl);
#if 0
printf("IsCompatibleFdcls\n");
PrintNode(stdout, node1, 0);
printf("\n");
PrintNode(stdout, node2, 0);
printf("\n");
#endif
/* The Result Type must be equal */
if (!TypeEqual(node1->u.fdcl.returns, node2->u.fdcl.returns))
return FALSE;
/* Inspect the parameter lists */
{
List *optr = node1->u.fdcl.args, *nptr = node2->u.fdcl.args;
/* Are both definitions in prototype form? */
if (optr && nptr) {
/* Then every parameter must be compatible */
for (; optr && nptr; optr = Rest(optr), nptr = Rest(nptr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem),
*nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqual(otype, ntype)) {
#if 0
PrintNode(stdout, otype, 0);
printf("\n");
PrintNode(stdout, ntype, 0);
printf("\n");
#endif
return FALSE;
}
}
/* And the parameter lists must be of the same length */
if (optr || nptr)
return FALSE;
else
return TRUE;
}
/* Check for <Type> f(void) vs <Type> f() */
else if (IsVoidArglist(optr))
return TRUE;
/* Check for <Type> f() vs <Type> f(void) */
else if (IsVoidArglist(nptr))
return TRUE;
/* Else the provided types must be the "usual unary conversions" */
else {
/* Either this loop will run */
for (; optr; optr = Rest(optr)) {
Node *oitem = FirstItem(optr), *otype = NodeDataType(oitem);
if (!TypeEqual(otype, UsualUnaryConversionType(otype)) ||
IsEllipsis(otype))
return FALSE;
}
/* Or this one will */
for (; nptr; nptr = Rest(nptr)) {
Node *nitem = FirstItem(nptr), *ntype = NodeDataType(nitem);
if (!TypeEqual(ntype, UsualUnaryConversionType(ntype)) ||
IsEllipsis(ntype))
return FALSE;
}
return TRUE;
}
}
}
static FObject CompileEvalExpr(FObject obj, FObject env, FObject body)
{
if (VectorP(obj))
return(MakePair(SyntaxToDatum(obj), body));
else if (PairP(obj) && (IdentifierP(First(obj)) || SymbolP(First(obj))))
{
if (EqualToSymbol(First(obj), R.DefineLibrarySymbol))
{
CompileLibrary(obj);
return(body);
}
else if (EqualToSymbol(First(obj), R.ImportSymbol))
{
EnvironmentImport(env, obj);
if (body != EmptyListObject)
body = MakePair(List(R.NoValuePrimitive), body);
return(body);
}
// FObject op = EnvironmentGet(env, First(obj));
FObject op = ResolvedGet(env, First(obj));
if (op == DefineSyntax)
{
// (define <variable> <expression>)
// (define <variable>)
// (define (<variable> <formals>) <body>)
// (define (<variable> . <formal>) <body>)
FAssert(EnvironmentP(env));
if (AsEnvironment(env)->Immutable == TrueObject)
RaiseExceptionC(R.Assertion, "define",
"environment is immutable", List(env, obj));
if (PairP(Rest(obj)) == 0)
RaiseExceptionC(R.Syntax, "define",
"expected a variable or list beginning with a variable", List(obj));
if (IdentifierP(First(Rest(obj))) || SymbolP(First(Rest(obj))))
{
if (Rest(Rest(obj)) == EmptyListObject)
{
// (define <variable>)
if (EnvironmentDefine(env, First(Rest(obj)), NoValueObject))
RaiseExceptionC(R.Syntax, "define",
"imported variables may not be redefined in libraries",
List(First(Rest(obj)), obj));
return(body);
}
// (define <variable> <expression>)
if (PairP(Rest(Rest(obj))) == 0 || Rest(Rest(Rest(obj))) != EmptyListObject)
RaiseExceptionC(R.Syntax, "define",
"expected (define <variable> <expression>)", List(obj));
if (EnvironmentDefine(env, First(Rest(obj)), NoValueObject))
RaiseExceptionC(R.Syntax, "define",
"imported variables may not be redefined in libraries",
List(First(Rest(obj)), obj));
return(MakePair(List(SetBangSyntax, First(Rest(obj)),
First(Rest(Rest(obj)))), body));
}
else
{
// (define (<variable> <formals>) <body>)
// (define (<variable> . <formal>) <body>)
if (PairP(First(Rest(obj))) == 0 || (IdentifierP(First(First(Rest(obj)))) == 0
&& SymbolP(First(First(Rest(obj)))) == 0))
RaiseExceptionC(R.Syntax, "define",
"expected a list beginning with a variable", List(obj));
if (EnvironmentDefine(env, First(First(Rest(obj))),
CompileLambda(env, First(First(Rest(obj))), Rest(First(Rest(obj))),
Rest(Rest(obj)))))
RaiseExceptionC(R.Syntax, "define",
"imported variables may not be redefined in libraries",
List(First(First(Rest(obj))), obj));
return(body);
}
}
else if (op == DefineValuesSyntax)
{
// (define-values (<variable> ...) <expression>)
FAssert(EnvironmentP(env));
if (AsEnvironment(env)->Immutable == TrueObject)
RaiseExceptionC(R.Assertion, "define-values",
"environment is immutable", List(env, obj));
if (PairP(Rest(obj)) == 0
|| (PairP(First(Rest(obj))) == 0 && First(Rest(obj)) != EmptyListObject)
|| PairP(Rest(Rest(obj))) == 0 || Rest(Rest(Rest(obj))) != EmptyListObject)
RaiseExceptionC(R.Syntax, "define-values",
"expected (define-values (<variable> ...) <expression>)", List(obj));
FObject lst = First(Rest(obj));
while (PairP(lst))
{
if (IdentifierP(First(lst)) == 0 && SymbolP(First(lst)) == 0)
RaiseExceptionC(R.Syntax, "define-values",
"expected (define-values (<variable> ...) <expression>)",
List(First(lst), obj));
if (EnvironmentDefine(env, First(lst), NoValueObject))
RaiseExceptionC(R.Syntax, "define-values",
"imported variables may not be redefined in libraries",
List(First(lst), obj));
lst = Rest(lst);
}
if (lst != EmptyListObject)
RaiseExceptionC(R.Syntax, "define-values", "expected a list of variables",
List(obj));
return(MakePair(List(SetBangValuesSyntax, First(Rest(obj)), First(Rest(Rest(obj)))),
body));
}
else if (op == DefineSyntaxSyntax)
{
// (define-syntax <keyword> <expression>)
FAssert(EnvironmentP(env));
if (AsEnvironment(env)->Immutable == TrueObject)
RaiseExceptionC(R.Assertion, "define",
"environment is immutable", List(env, obj));
if (PairP(Rest(obj)) == 0 || PairP(Rest(Rest(obj))) == 0
|| Rest(Rest(Rest(obj))) != EmptyListObject
|| (IdentifierP(First(Rest(obj))) == 0 && SymbolP(First(Rest(obj))) == 0))
RaiseExceptionC(R.Syntax, "define-syntax",
"expected (define-syntax <keyword> <transformer>)",
List(obj));
FObject trans = CompileTransformer(First(Rest(Rest(obj))), env);
if (SyntaxRulesP(trans) == 0)
RaiseExceptionC(R.Syntax, "define-syntax",
"expected a transformer", List(trans, obj));
if (EnvironmentDefine(env, First(Rest(obj)), trans))
RaiseExceptionC(R.Syntax, "define",
"imported variables may not be redefined in libraries",
List(First(Rest(obj)), obj));
return(body);
}
else if (SyntaxRulesP(op))
return(CompileEvalExpr(ExpandSyntaxRules(MakeSyntacticEnv(env), op, Rest(obj)), env,
body));
else if (op == BeginSyntax)
return(CompileEvalBegin(Rest(obj), env, body, obj, BeginSyntax));
else if (op == IncludeSyntax || op == IncludeCISyntax)
return(CompileEvalBegin(ReadInclude(First(obj), Rest(obj), op == IncludeCISyntax), env,
body, obj, op));
else if (op == CondExpandSyntax)
{
FObject ce = CondExpand(MakeSyntacticEnv(env), obj, Rest(obj));
if (ce == EmptyListObject)
return(body);
return(CompileEvalBegin(ce, env, body, obj, op));
}
}
return(MakePair(obj, body));
}
static FObject DoImportSet(FObject env, FObject is, FObject form)
{
// <library-name>
// (only <import-set> <identifier> ...)
// (except <import-set> <identifier> ...)
// (prefix <import-set> <identifier>)
// (rename <import-set> (<identifier1> <identifier2>) ...)
if (PairP(is) == 0 || (IdentifierP(First(is)) == 0 && SymbolP(First(is)) == 0))
RaiseExceptionC(R.Syntax, "import", "expected a list starting with an identifier",
List(is, form));
if (EqualToSymbol(First(is), R.OnlySymbol))
{
FObject ilst = DoOnlyOrExcept(env, is, 1);
if (ilst == NoValueObject)
RaiseExceptionC(R.Syntax, "import",
"expected (only <import-set> <identifier> ...)", List(is, form));
return(ilst);
}
else if (EqualToSymbol(First(is), R.ExceptSymbol))
{
FObject ilst = DoOnlyOrExcept(env, is, 0);
if (ilst == NoValueObject)
RaiseExceptionC(R.Syntax, "import",
"expected (except <import-set> <identifier> ...)", List(is, form));
return(ilst);
}
else if (EqualToSymbol(First(is), R.PrefixSymbol))
{
if (PairP(Rest(is)) == 0 || PairP(Rest(Rest(is))) == 0
|| Rest(Rest(Rest(is))) != EmptyListObject ||
(IdentifierP(First(Rest(Rest(is)))) == 0 && SymbolP(First(Rest(Rest(is)))) == 0))
RaiseExceptionC(R.Syntax, "import",
"expected (prefix <import-set> <identifier>)", List(is, form));
FObject prfx;
if (SymbolP(First(Rest(Rest(is)))))
prfx = AsSymbol(First(Rest(Rest(is))))->String;
else
prfx = AsSymbol(AsIdentifier(First(Rest(Rest(is))))->Symbol)->String;
FObject ilst = DoImportSet(env, First(Rest(is)), is);
FObject lst = ilst;
while (PairP(lst))
{
FAssert(GlobalP(First(lst)));
// AsGlobal(First(lst))->Name = PrefixSymbol(prfx, AsGlobal(First(lst))->Name);
Modify(FGlobal, First(lst), Name, PrefixSymbol(prfx, AsGlobal(First(lst))->Name));
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(ilst);
}
else if (EqualToSymbol(First(is), R.RenameSymbol))
{
if (PairP(Rest(is)) == 0)
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
FObject ilst = DoImportSet(env, First(Rest(is)), is);
FObject rlst = Rest(Rest(is));
while (PairP(rlst))
{
FObject rnm = First(rlst);
if (PairP(rnm) == 0 || PairP(Rest(rnm)) == 0 || Rest(Rest(rnm)) != EmptyListObject
|| (IdentifierP(First(rnm)) == 0 && SymbolP(First(rnm)) == 0)
|| (IdentifierP(First(Rest(rnm))) == 0 && SymbolP(First(Rest(rnm))) == 0))
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
rlst = Rest(rlst);
}
if (rlst != EmptyListObject)
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
FObject lst = ilst;
while (PairP(lst))
{
FAssert(GlobalP(First(lst)));
FObject nm = CheckForRename(AsGlobal(First(lst))->Name, Rest(Rest(is)));
if (SymbolP(nm))
{
// AsGlobal(First(lst))->Name = nm;
Modify(FGlobal, First(lst), Name, nm);
}
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(ilst);
}
FObject nam = LibraryName(is);
if (PairP(nam) == 0)
RaiseExceptionC(R.Syntax, "import",
"library name must be a list of symbols and/or integers", List(is));
FObject lib = FindOrLoadLibrary(nam);
if (LibraryP(lib) == 0)
RaiseExceptionC(R.Syntax, "import", "library not found", List(nam, form));
FObject ilst = EmptyListObject;
FObject elst = AsLibrary(lib)->Exports;
while (PairP(elst))
{
FAssert(PairP(First(elst)));
FAssert(SymbolP(First(First(elst))));
FAssert(GlobalP(Rest(First(elst))));
ilst = MakePair(ImportGlobal(env, First(First(elst)), Rest(First(elst))), ilst);
elst = Rest(elst);
}
FAssert(elst == EmptyListObject);
return(ilst);
}
FObject CompileProgram(FObject nam, FObject port)
{
FAssert(TextualPortP(port) && InputPortOpenP(port));
WantIdentifiersPort(port, 1);
FDontWait dw;
FObject env = MakeEnvironment(nam, FalseObject);
FObject prog = EmptyListObject;
FObject body = EmptyListObject;
try
{
for (;;)
{
FObject obj = Read(port);
if (obj == EndOfFileObject)
break;
if (PairP(obj) && EqualToSymbol(First(obj), R.CondExpandSymbol))
{
FObject ce = CondExpand(MakeSyntacticEnv(R.Bedrock), obj, Rest(obj));
if (ce != EmptyListObject)
prog = CondExpandProgram(ce, prog);
}
else
prog = MakePair(obj, prog);
}
prog = ReverseListModify(prog);
while (prog != EmptyListObject)
{
FAssert(PairP(prog));
FObject obj = First(prog);
if (PairP(obj) == 0)
break;
if (EqualToSymbol(First(obj), R.ImportSymbol))
EnvironmentImport(env, obj);
else if (EqualToSymbol(First(obj), R.DefineLibrarySymbol))
CompileLibrary(obj);
else
break;
prog = Rest(prog);
}
if (R.LibraryStartupList != EmptyListObject)
{
body = MakePair(MakePair(BeginSyntax, ReverseListModify(R.LibraryStartupList)), body);
R.LibraryStartupList = EmptyListObject;
}
while (prog != EmptyListObject)
{
FAssert(PairP(prog));
body = CompileEvalExpr(First(prog), env, body);
prog = Rest(prog);
}
}
catch (FObject obj)
{
if (ExceptionP(obj) == 0)
WriteStringC(R.StandardOutput, "exception: ");
Write(R.StandardOutput, obj, 0);
WriteCh(R.StandardOutput, '\n');
}
FObject proc = CompileLambda(env, NoValueObject, EmptyListObject, ReverseListModify(body));
UndefinedList = EmptyListObject;
EqHashMapVisit(AsEnvironment(env)->HashMap, Visit, NoValueObject);
if (UndefinedList != EmptyListObject)
RaiseExceptionC(R.Syntax, "program", "identifier(s) used but never defined",
List(UndefinedList, nam));
return(proc);
}
static FObject CompileExports(FObject env, FObject lst)
{
FObject elst = EmptyListObject;
while (PairP(lst))
{
FAssert(PairP(First(lst)));
FAssert(IdentifierP(First(First(lst))) || SymbolP(First(First(lst))));
FObject form = First(lst);
if (EqualToSymbol(First(form), R.ExportSymbol))
{
FObject especs = Rest(form);
while (PairP(especs))
{
FObject spec = First(especs);
if (IdentifierP(spec) == 0 && SymbolP(spec) == 0
&& (PairP(spec) == 0
|| PairP(Rest(spec)) == 0
|| (IdentifierP(First(Rest(spec))) == 0 && SymbolP(First(Rest(spec))) == 0)
|| PairP(Rest(Rest(spec))) == 0
|| (IdentifierP(First(Rest(Rest(spec)))) == 0
&& SymbolP(First(Rest(Rest(spec)))) == 0)
|| Rest(Rest(Rest(spec))) != EmptyListObject
|| EqualToSymbol(First(spec), R.RenameSymbol) == 0))
RaiseExceptionC(R.Syntax, "export",
"expected an identifier or (rename <id1> <id2>)",
List(spec, form));
FObject lid = spec;
FObject eid = spec;
if (PairP(spec))
{
lid = First(Rest(spec));
eid = First(Rest(Rest(spec)));
}
if (IdentifierP(lid))
lid = AsIdentifier(lid)->Symbol;
if (IdentifierP(eid))
eid = AsIdentifier(eid)->Symbol;
FObject gl = EnvironmentLookup(env, lid);
if (GlobalP(gl) == 0)
RaiseExceptionC(R.Syntax, "export", "identifier is undefined",
List(lid, form));
if (GlobalP(Assq(eid, elst)))
RaiseExceptionC(R.Syntax, "export", "identifier already exported",
List(eid, form));
elst = MakePair(MakePair(eid, gl), elst);
especs = Rest(especs);
}
if (especs != EmptyListObject)
RaiseExceptionC(R.Syntax, "export", "expected a proper list of exports",
List(form));
}
else
{
FAssert(EqualToSymbol(First(form), R.ImportSymbol)
|| EqualToSymbol(First(form), R.AkaSymbol)
|| EqualToSymbol(First(form), R.IncludeLibraryDeclarationsSymbol)
|| EqualToSymbol(First(form), R.CondExpandSymbol)
|| EqualToSymbol(First(form), R.BeginSymbol)
|| EqualToSymbol(First(form), R.IncludeSymbol)
|| EqualToSymbol(First(form), R.IncludeCISymbol));
}
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(elst);
}
