rs@uunet.UU.NET (Rich Salz) (07/08/87)
Mod.sources: Volume 10, Number 40
Submitted by: robison@b.cs.uiuc.edu (Arch Robison)
Archive-name: ifp/Part07
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh.
# The following files will be created:
# interp/outfun.c
# interp/outob.c
# interp/stats.c
# interp/stats.h
# interp/string.c
# interp/string.h
# interp/struct.h
# interp/trace.c
# interp/umax.h
# interp/xdef.c
export PATH; PATH=/bin:$PATH
mkdir interp
if test -f 'interp/outfun.c'
then
echo shar: over-writing existing file "'interp/outfun.c'"
fi
cat << \SHAR_EOF > 'interp/outfun.c'
/****** outfun.c ******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: June 30, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Dec 12, 1985 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#include <stdio.h>
#include <ctype.h>
#include "struct.h"
#include "node.h"
/*
* OutLongNode - internal to OutNode
*/
void OutLongNode (N)
register NodePtr N;
{
if (N->NodeParent != NULL) {
OutLongNode (N->NodeParent);
printf ("/");
OutString (N->NodeName);
}
}
/*
* OutNode
*
* Output a node in UNIX path format.
* Abbreviate if it is in the current directory.
*/
void OutNode (N)
register NodePtr N;
{
register NodePtr M;
extern boolean LongPathFlag;
if (N == NULL) printf ("(NULL NODE)");
else {
if (!LongPathFlag && NULL != (M = FindNode (CurWorkDir,N->NodeName)) &&
(M->NodeType == IMPORT || M->NodeType == DEF))
OutString (N->NodeName);
else OutLongNode (N);
}
}
/*
* OutForm
*
* Print a functional form and its parameters.
*
* Input
* N = pointer to form node
* P = pointer to parameter list
* Depth = depth to print function (ellipses used at that depth)
*/
void OutForm (N,P,Depth)
register NodePtr N;
ListPtr P;
int Depth;
{
long L;
register FormEntry *T;
L = ListLength (P);
for (T=FormTable; T<ArrayEnd(FormTable); T++)
if (T->FormNode == N) {
switch (T-FormTable) {
case NODE_Comp:
while (P!=NULL) {
OutFun (&P->Val,Depth);
if (NULL != (P=P->Next)) printf ("|");
}
break;
case NODE_Cons:
printf ("[");
while (P!=NULL) {
OutFun (&P->Val,Depth);
if (NULL != (P=P->Next)) printf (",");
}
printf ("]");
break;
case NODE_RInsert:
case NODE_Filter:
case NODE_Each:
printf ("%s ",T->FormInPrefix);
OutFun (&P->Val,Depth);
printf (" END");
break;
case NODE_If:
printf ("IF "); OutFun (&P->Val,Depth);
printf (" THEN "); OutFun (&(P=P->Next)->Val,Depth);
printf (" ELSE "); OutFun (&P->Next->Val,Depth);
printf (" END");
break;
case NODE_C:
if (!L) {
printf ("?");
break;
}
/* else drop through */
#if FETCH
case NODE_Fetch:
#endif
case NODE_Out:
printf ("%s",T->FormInPrefix); OutObject (&P->Val);
break;
case NODE_Sel:
if (P->Val.Int >= 0) printf ("%d",P->Val.Int);
else printf ("%dr",-P->Val.Int);
break;
case NODE_While:
printf ("WHILE "); OutFun (&P->Val,Depth);
printf (" DO "); OutFun (&P->Next->Val,Depth);
printf (" END");
break;
#if XDEF
case NODE_XDef: {
extern void OutLHS ();
printf ("{"); OutLHS (&P->Val);
printf (" := "); OutFun (&P->Next->Val,Depth);
printf ("} ");
OutFun (&P->Next->Next->Val,Depth);
break;
}
#endif
}
return;
}
printf ("(");
OutNode (N);
for (; P != NULL; P=P->Next) {
printf (" ");
OutObject (&P->Val);
}
printf (")");
}
/*
* OutFun
*
* Print function *F. *F may be linked if it was unlinked.
*
* The possible representations for the function are described
* in the comments for "Apply" in apply.c.
*
* Input
* *F = function
* Depth = depth to print function, 0 = "..."
*
* Output
* *F = may be linked function
*/
void OutFun (F,Depth)
register ObjectPtr F;
int Depth;
{
register ListPtr P;
if (SysStop > 1) return;
if (F == NULL) printf ("(null)"); /* Internal error */
else if (--Depth < 0) printf ("..");
else
switch (F->Tag) {
default:
printf ("(tag = %d)",F->Tag); /* Internal error */
break;
case LIST:
P = F->List;
if (P == NULL) printf ("()");
else
switch (P->Val.Tag) {
case LIST: /* unlinked form */
LinkPath (&P->Val,DEF);
if (P->Val.Tag!=NODE||P->Val.Node->NodeType!=DEF) {
printf ("(");
OutObject (&P->Val);
for (; P != NULL; P=P->Next) {
printf (" ");
OutObject (&P->Val);
}
printf (")");
return;
} /* else drop down to case NODE */
case NODE: /* linked form */
OutForm (P->Val.Node,P->Next,Depth);
return;
case STRING:
LinkPath (F,DEF);
if (F->Tag == NODE) break; /* drop down to case NODE */
default: /* unlinked function or internal error */
for (; P!=NULL; P=P->Next) {
printf ("/");
OutObject (&P->Val);
}
return;
}
case NODE:
OutNode (F->Node);
break;
case STRING:
OutString (F->String);
break;
}
}
/******************************* end of outfun.c ******************************/
SHAR_EOF
if test -f 'interp/outob.c'
then
echo shar: over-writing existing file "'interp/outob.c'"
fi
cat << \SHAR_EOF > 'interp/outob.c'
/****** out.c *********************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Feb 8, 1987 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#include <stdio.h>
#include <ctype.h>
#include "struct.h"
#include "string.h"
#define BerkMode 0
#define INDENT 3
/*
* OutIndent
*
* Indent N places
*/
void OutIndent (N)
int N;
{
for (; N >= 8; N-=8) printf ("\t");
while (--N >=0) printf (" ");
}
/*
* QuoteCheck
*
* Check if string should be quoted.
*
* Input
* S = string
* Output
* result = quote character ('\0','\'', or '\"');
*/
char QuoteCheck (S)
StrPtr S;
{
CharPtr U;
char Buf[256];
boolean Single=0,Double=0,Quote=0;
register char *T;
if (S==NULL) return ('\"');
else {
CPInit (&U,&S);
if (CPRead (&U,Buf,sizeof (Buf))) {
if (Buf [1] == '\0' && (Buf[0]=='f' || Buf[0]=='t' || Buf[0]=='?'))
return '\"';
do
for (T = Buf; *T; T++)
if (!isalpha (*T)) {
Quote=1;
if (*T == '\'') Single = 1;
if (*T == '\"') Double = 1;
}
while (CPRead (&U,Buf,sizeof (Buf)));
}
if (!Quote) return '\0';
else if (Single) return '\"';
else if (Double) return '\'';
else return '\"'; /* Should be something else */
}
}
/*
* OutString
*
* Output a string.
*/
void OutString (S)
StrPtr S;
{
char Buf[256];
CharPtr U;
if ((Debug & DebugRef) && S != NULL) printf ("[%d]",S->SRef);
CPInit (&U,&S);
while (CPRead (&U,Buf,sizeof (Buf))) printf ("%s",Buf);
}
/*
* OutList
*
* Input
* P = list to output
*/
void OutList (P)
register ListPtr P;
{
printf ("<");
if (P!=NIL)
while (1) {
if (Debug & DebugRef) printf ("{%d}",P->LRef + (1 - LRefOne));
OutObject (& P->Val);
if ((P=P->Next) == NULL) break;
else printf (",");
}
printf (">");
}
/*
* OutObject
*
* Output an object
*
* No reference counts change.
*/
void OutObject (X)
ObjectPtr X;
{
if (SysStop > 1) return;
else if (X == NULL) printf ("(NULL)");
else
switch (X->Tag) {
case BOTTOM: printf ("?"); break;
case BOOLEAN:
switch (X->Bool) {
case 0: printf (BerkMode ? "F" : "f"); break;
case 1: printf (BerkMode ? "T" : "t"); break;
default: printf ("(BOOLEAN %d)",X->Bool); break;
}
break;
case INT:
printf ("%ld",X->Int);
break;
case FLOAT:
printf ("%g",X->Float);
break;
case LIST:
OutList (X->List);
break;
case STRING: {
register char Q;
Q = QuoteCheck (X->String);
if (Q) printf ("%c",Q);
OutString (X->String);
if (Q) printf ("%c",Q);
} break;
case NODE:
OutNode (X->Node);
break;
default:
printf ("(tag = %d)",X->Tag);
break;
}
}
#define LineLength 80
/*
* OutLength
*
* Compute approximate number of characters required to output an object.
* The count is stopped prematurely if it goes over LineLength.
*
* No reference counts change.
*/
private int OutLength (X,Limit)
ObjectPtr X;
int Limit;
{
register ListPtr P;
register int K;
if (X == NULL) K = 6; /* "(null)" */
else
switch (X->Tag) {
case BOTTOM:
case BOOLEAN:
K = 1; /* "?","t","f" */
break;
case INT:
K = 5;
break;
case FLOAT:
K = 8;
break;
case LIST:
K = 2; /* <> */
for (P=X->List; P!=NULL && K <= Limit; P=P->Next)
K += 1 + OutLength (&P->Val,Limit); /* 1 for space between */
break;
case STRING:
K = 2 + LenStr (X->String); /* "'...'" */
break;
default:
K=0;
break;
}
return K;
}
/*
* OutPretty
*
* Output an object with indented sublists
*
* No reference counts change.
*/
void OutPretty (X,Indent)
ObjectPtr X;
int Indent;
{
register ListPtr P;
if (SysStop > 1) return;
OutIndent (Indent);
if (X == NULL) printf ("(null)");
else if (X->Tag != LIST) OutObject (X);
else {
if ((OutLength (X,LineLength) + Indent) > LineLength) {
printf ("<\n");
for (P = X->List; P!=NULL; P=P->Next)
OutPretty (&P->Val,Indent+INDENT);
OutIndent (Indent);
printf (">\n");
return;
} else OutList (X->List);
}
printf ("\n");
}
/************************** end of outob.c **************************/
SHAR_EOF
if test -f 'interp/stats.c'
then
echo shar: over-writing existing file "'interp/stats.c'"
fi
cat << \SHAR_EOF > 'interp/stats.c'
/****** stats.c *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Dec 8, 1985 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/* Statistics collection routines */
#include "struct.h"
#include "stats.h"
#include <stdio.h>
#if STATS
long StatRecycle=0,StatFresh=0;
long StatArg [MAXTAG+1];
long Stat_Apply [StatLimLen+1];
long Stat_NewList [StatLimLen+1];
long Stat_DelLPtrIn [StatLimLen+1];
long Stat_DelLPtrOut [StatLimLen+1];
long Stat_Construct [StatLimLen+1];
long Stat1Simple,Stat2Simple;
long StatC = 0;
void StatConstant (InOut)
ObjectPtr InOut;
{
StatC++;
}
void StatConstruct (P)
ListPtr P;
{
register int N;
N = ListLength (P);
if (N >= StatLimLen) N = StatLimLen;
++Stat_Construct[N];
}
void StatNewList (N)
long N;
{
StatFresh += N;
if (N > StatLimLen) N = StatLimLen;
++Stat_NewList [N];
}
void StatDelLPtr (P)
register ListPtr P;
{
register int N;
N = ListLength (P);
if (N >= StatLimLen) N = StatLimLen;
++Stat_DelLPtrIn [N];
for (N=0; P!=NULL; P=P->Next)
if (P->LRef > LRefOne || ++N >= StatLimLen) break;
++Stat_DelLPtrOut [N];
}
#define SCALAR ((1<<INT)|(1<<FLOAT)|(1<<BOOLEAN)|(1<<STRING))
void StatApply (InOut)
ObjectPtr InOut;
{
ListPtr P;
long L;
StatArg [InOut->Tag] ++;
if (InOut->Tag == LIST) {
L = ListLength (InOut->List);
if (L > StatLimLen) L = StatLimLen;
Stat_Apply [L] ++;
if (L == 2) {
P = InOut->List;
if ((1<<P->Val.Tag) & SCALAR) Stat1Simple++;
if ((1<<P->Next->Val.Tag) & SCALAR) Stat2Simple++;
}
}
}
/*
* ShowDist
*/
void ShowDist (Title,Dist)
char *Title;
long Dist[];
{
int k;
long S,Z;
for (S=0, k=0; k<=StatLimLen; k++) S += Dist[k];
printf (" %s (total = %ld)\n ",Title,S);
if (S)
for (k=0; k<=StatLimLen; k++) {
Z = 1000 * Dist[k]/S;
printf ("%ld.%ld%% [%s%ld] ",Z/10,Z%10,k==StatLimLen?">=":"",k);
Dist[k] = 0;
}
printf ("\n");
}
/*
* ShowStats
*/
void ShowStats ()
{
long Total;
int k;
printf ("\n");
Total = StatRecycle + StatFresh;
printf ("Memory management\n");
printf (" Total cells created = %ld\n",Total);
printf (" Percent of cells recycled = %ld\n",
Total ? 100*StatRecycle/Total : 0L);
ShowDist ("New list length distribution",Stat_NewList);
StatRecycle = StatFresh = 0;
ShowDist ("Deleted list (total) length distribution",Stat_DelLPtrIn);
ShowDist ("Deleted list (partial) length distribution",Stat_DelLPtrOut);
ShowDist ("Constructor list length distribution",Stat_Construct);
printf ("\n");
printf ("Constant function applications = %d\n",StatC);
StatC = 0;
printf ("\n");
if (Stat_Apply [2]) {
Stat1Simple = 100 * Stat1Simple / Stat_Apply [2];
Stat2Simple = 100 * Stat2Simple / Stat_Apply [2];
}
if (StatArg[LIST])
for (k=0; k<=StatLimLen; k++)
Stat_Apply [k] = 100 * Stat_Apply [k] / StatArg[LIST];
Total = 0;
for (k=0; k<=MAXTAG; k++) Total += StatArg [k];
if (Total)
for (k=0; k<=MAXTAG; k++) StatArg [k] = 100 * StatArg [k] / Total;
printf ("\n");
printf ("Apply arguments (Total = %ld)\n",Total);
printf (" Boolean = %ld, Int = %ld, Float = %ld, String = %ld\n",
StatArg[BOOLEAN],StatArg[INT],StatArg[FLOAT],StatArg[STRING]);
printf (" List = %ld\n",StatArg[LIST]);
printf (" ");
for (k=0; k<StatLimLen; k++) printf ("%ld [%ld], ",Stat_Apply [k],k);
printf ("%ld [>=%d]\n",Stat_Apply [StatLimLen],StatLimLen);
printf (" Pair elements [scalar]<%ld,%ld>\n",Stat1Simple,Stat2Simple);
Stat1Simple = Stat2Simple = 0;
for (k=0; k<=StatLimLen; k++) Stat_NewList [k] = Stat_Apply[k] = 0;
for (k=0; k<=MAXTAG; k++) StatArg[k] = 0;
}
#endif
/**************************** end of stats.c ****************************/
SHAR_EOF
if test -f 'interp/stats.h'
then
echo shar: over-writing existing file "'interp/stats.h'"
fi
cat << \SHAR_EOF > 'interp/stats.h'
/****** stats.h *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Dec 8, 1985 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*
* Defining STATS=1 causes interpreter to collect statistics.
* Define STATS=0 for production work since statistics collection
* slows the interpreter.
*/
#define STATS 0
#if STATS
#define StatLimLen 5
#define Stat(X) X
extern long StatRecycle,StatFresh;
extern long StatArg [];
extern long Stat_Apply [];
extern long Stat_NewList [];
extern long Stat1Simple,Stat2Simple;
extern void ShowStats();
extern void StatApply(), StatConstruct(), StatConstant();
extern void StatNewList(), StatDelLPtr();
#else
#define Stat(X)
#endif
/**************************** end of stats.h ****************************/
SHAR_EOF
if test -f 'interp/string.c'
then
echo shar: over-writing existing file "'interp/string.c'"
fi
cat << \SHAR_EOF > 'interp/string.c'
/****** string.c ******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Jan 20, 1987 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#include <stdio.h>
#include "struct.h"
#include "node.h"
#include "umax.h"
#include "string.h"
/* Single character strings, CharString [0] = null string */
StrPtr *CharString;
/* Free string segments have SRef = 1 and are linked by StrNext link */
StrPtr FreeString = NULL;
/*
* NewSCell
*
* return pointer to fresh string cell with SRef = 1 and StrNext = NULL.
*
* A SysError may occur, in which case the NULL pointer is returned.
*/
private StrPtr NewSCell ()
{
extern StrPtr AllocStrPage ();
register StrPtr S;
semaphore_wait (SRefSemaphore);
if (FreeString != NULL || (FreeString = AllocStrPage ()) != NULL) {
S = FreeString;
FreeString = S->StrNext;
S->SRef = 1;
S->StrNext = NULL;
}
else {
SysError = NO_STR_FREE;
printf ("NO MORE STRING CELLS LEFT\n");
S = NULL;
}
semaphore_signal (SRefSemaphore);
return S;
}
/*
* CPInit
*
* Initialize a character pointer.
*/
void CPInit (U,S)
register CharPtr *U;
register StrPtr *S;
{
if ((U->CPSeg = *(U->CPStr = S)) == NULL) U->CPCount = 0;
else {
U->CPCount = StrHeadLen;
U->CPChar = (*S)->StrChar;
}
}
/*
* CPRead
*
* Read up to N-1 characters from and advance a character pointer.
* '\0' is returned as the last character of the string.
*
* Input
* *U = character pointer
* Buf = buffer into which to read characters
* N-1 = number of characters to read
*
* Output
* result = true if characters were read, 0 if end of string.
* Buf = string of characters terminated by '\0'
*/
boolean CPRead (U,Buf,N)
register CharPtr *U;
register char *Buf;
register int N;
{
register char *S;
register int K;
if (!U->CPCount && (NULL==U->CPSeg || NULL==U->CPSeg->StrNext) ||
!*(S = U->CPChar)) {
*Buf = '\0';
return 0;
} else {
--N;
while (N > 0) {
K = U->CPCount;
if (K > N) K = N;
N -= K;
U->CPCount -= K;
while (--K >= 0) *Buf++ = *S++;
if (!U->CPCount) {
if (NULL == (U->CPSeg = U->CPSeg->StrNext)) break;
else {
U->CPCount = StrTailLen;
S = U->CPSeg->StrChar;
}
}
}
U->CPChar = S;
*Buf = '\0';
return 1;
}
}
/*
* CPAppend
*
* Append a character to the end of a string.
*
* A SysError may occur.
*/
void CPAppend (U,C)
register CharPtr *U;
char C;
{
if (U->CPCount-- == 0)
if (C == '\0') return;
else {
register StrPtr S = NewSCell ();
if (SysError) return;
else {
U->CPChar = S->StrChar;
if (*U->CPStr == NULL) {
U->CPSeg = (*U->CPStr = S); /* Append head segment */
U->CPCount = StrHeadLen-1;
} else {
U->CPSeg = (U->CPSeg->StrNext = S); /* Append tail segment */
U->CPCount = StrTailLen-1;
}
}
}
*U->CPChar++ = C;
}
/*
* LenStr
*
* Find the length of a FP string
*
* Input
* S = IFP string
*
* Output
* result = length of string in characters
*/
FPint LenStr (S)
register StrPtr S;
{
register int J = StrHeadLen;
register FPint K = 0;
register char *T;
for (; S!=NULL; S = S->StrNext) {
for (T = S->StrChar; --J >= 0 && *T; T++) K++;
J = StrTailLen;
}
return K;
}
/*
* DelSPtr
*
* Delete a string pointer: decrement reference count and remove string
* if reference count is zero.
*/
void DelSPtr (S)
register StrPtr S;
{
register StrPtr T;
semaphore_wait (SRefSemaphore);
if (S != NULL && !-- S->SRef) {
for (T=S; T->StrChar[0]='\0', T->StrNext!=NULL; T=T->StrNext) continue;
T->StrNext = FreeString;
FreeString = S;
}
semaphore_signal (SRefSemaphore);
}
/*
* NewString
*
* Make a copy of a string. The old string retains its reference count.
*
* Input
* S = pointer to string
*
* Output
* result = pointer to new string
*
* A SysError may occur, in which case NULL is returned.
*/
private StrPtr NewString (S)
register StrPtr S;
{
extern char *strncpy ();
register StrPtr R,T;
if (S == NULL) return NULL;
R = T = NewSCell (); /* R = root of copy */
if (SysError) return NULL;
(void) strncpy (T->StrChar,S->StrChar,StrHeadLen);
while ((S=S->StrNext) != NULL) {
T->StrNext = NewSCell ();
T = T->StrNext;
(void) strncpy (T->StrChar,S->StrChar,StrTailLen);
if (SysError) {
DelSPtr (R); /* flush copy */
return NULL;
}
}
return R;
}
/*
* MakeString
*
* Make an IFP string from a C string.
*
* Input
* S = pointer to character array terminated by '\0'
*
* Output
* result = pointer to IFP (segmented) string
*
* A SysError may occur, in which case a NULL pointer is returned.
*/
StrPtr MakeString (S)
char *S;
{
extern char *strncpy ();
int L=strlen(S);
if (L <= 0) return NULL;
else {
StrPtr R,T;
int N = StrHeadLen;
R = T = NewSCell (); /* R = root of copy */
if (SysError) return NULL;
while (1) {
(void) strncpy (T->StrChar,S,N);
if ((L -= N) <= 0) return R;
else {
S += N;
T->StrNext = NewSCell ();
if (SysError) {
DelSPtr (R); /* flush copy */
return NULL;
}
T = T->StrNext;
N = StrTailLen;
}
}
}
}
/*
* StrComp
*
* Compares two strings. Returns P-Q
*/
int StrComp (P,Q)
StrPtr P,Q;
{
register int Diff,Len;
Len = StrHeadLen;
while (1) {
if (Q == NULL) return P!=NULL;
else if (P == NULL) return -(Q!=NULL);
else if (Diff = strncmp (P->StrChar,Q->StrChar,Len)) return Diff;
else {
Len = StrTailLen;
P = P->StrNext;
Q = Q->StrNext;
}
}
}
/*
* Make a copy of a non-null string pointer, incrementing the reference count.
*
* A SysError may occur, in in which case a NULL pointer is returned.
*/
StrPtr CopySPtr (S)
StrPtr S;
{
semaphore_wait (SRefSemaphore);
if (S != NULL && !++S->SRef) {
S->SRef--;
S = NewString (S);
}
semaphore_signal (SRefSemaphore);
return S;
}
/*
* InitString
*
* Initialize this module
*/
void InitString ()
{
int C;
StrPtr S;
CharString = (StrPtr *) malloc (128 * sizeof (StrPtr));
CharString [0] = NULL;
for (C = 1; C<128; C++) {
CharString [C] = S = NewSCell ();
S->StrChar [0] = C;
S->StrChar [1] = '\0';
}
}
/************************** end of string.c **************************/
SHAR_EOF
if test -f 'interp/string.h'
then
echo shar: over-writing existing file "'interp/string.h'"
fi
cat << \SHAR_EOF > 'interp/string.h'
/****** string.h ******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Jan 20, 1987 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*
* CharPtr
*
* Character pointer
*
* Character pointers are for an IFP string what file pointers are
* for a UNIX file. Character pointers are used for both creating
* (writing) and scanning (reading) IFP strings. The structure of
* IFP strings (type String) is described in struct.h.
*/
typedef struct {
int CPCount; /* number of characters left in current segment */
char *CPChar; /* pointer to current character */
StrPtr *CPStr; /* pointer to root of string */
StrPtr CPSeg; /* pointer to current segment of string */
} CharPtr;
extern StrPtr *CharString; /* from string.c */
extern StrPtr MakeString ();
extern void DelSPtr ();
extern StrPtr CopySPtr ();
extern void CPInit (), CPAppend ();
extern boolean CPRead ();
extern FPint LenStr ();
/************************* end of string.h *************************/
SHAR_EOF
if test -f 'interp/struct.h'
then
echo shar: over-writing existing file "'interp/struct.h'"
fi
cat << \SHAR_EOF > 'interp/struct.h'
/****** struct.h ******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Aug 4, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*
* There are some preprocessor variables which must be defined either
* here or in the cc command. The following options are not available
* in the public domain release:
*
* ARRAYS, COMPILE, UMAX, VECTOR, OUTBERKELEY
*
* Some of the code for these options are removed from the source by
* unifdef(1), so the source may look strange in places. (E.g. degenerate
* switch statements).
*
* The preprocessor variables are listed below.
*
* OPSYS (UNIX, MSDOS, CTSS) - specifies operating system
* PCAT - for compiling on PC/ATs
* SQUEEZE - put space at a premium
* DEBUG - incorporate interpreter debugging spy points
* DUMP - incoporate dump command for debugging (see debug.c)
* REFCHECK - incorporate reference checking command (see apply.c)
* COMPILE - incorporate IFP compiler (see C_comp.h)
* ARRAYS - incorporate array representation of sequences
* VECTOR - define APL-style vector operations (must define ARRAYS also)
* UMAX - make parallel version for Encore Multimax
*
* There are also preprocessor variables which may be turned on or off
* in the following files:
*
* ECACHE in cache.h - implement expression cache
* STATS in stats.h - collect run time statistics
* FETCH in node.h - implement "fetch" functional form
* OUTBERKELEY in outberkely.h - implement routine to print functions in
* Berkeley FP format.
*
* WARNING: Some of the compiling options may interfere with each other.
* Some options have not been tested for many revisions, so
* new bugs may creep out of the woodwork!
*/
#define UMAX 0 /* Must not enable ARRAYS, ECACHE, or STATS if set */
#define DUMP 0
#define ARRAYS 0 /* Must also define VECTOR=1 if set */
#define VECTOR 0
#define DEBUG 0
#define REFCHECK 0
/*
* Possible values for OPSYS preprocessor variable.
*/
#define UNIX 10
#define MSDOS 11
#define CTSS 12
#define OPSYS UNIX
#if OPSYS==CTSS
/*
* PARAMBUG is defined to indicate that the C compiler can not
* take the address (&) of parameter variables correctly.
* When this bug is removed from the CRAY C compiler, this define
* and dependent code should be removed.
*/
#define PARAMBUG 1
#endif
#if OPSYS==MSDOS || OPSYS==CTSS
#define MAXPATH 65 /* Maximum pathname length allowed (in characters) */
#endif
#if OPSYS==UNIX
#define MAXPATH 256 /* Maximum pathname length allowed (in characters) */
#endif
#if OPSYS==CTSS
#define index strchr
#endif
#ifdef PCAT
#define index strchr
#endif
/********** Fundamental Data Structures and Constants **********/
#define private static
#define forward extern /* for forward definitions which are not external */
typedef int boolean;
typedef long FPint;
typedef int FPboolean;
typedef short ushort;
/********************** MACHINE DEPENDENT CONSTANTS **********************/
/* These two definitions assume two's complement arithmetic! */
#define FPMaxInt (((FPint) 1 << 8 * sizeof(FPint) - 1) - 1)
#define MaxInt ((( int) 1 << 8 * sizeof( int) - 1) - 1)
#ifdef SQUEEZE
/* Maximum floating point value representable by an FPfloat */
typedef float FPfloat;
#define MAXFLOAT 1e38
#define LNMAXFLOAT 88.7
#define CompTol (1e-6)
#else
typedef double FPfloat;
/* Maximum floating point value representable by an FPfloat */
#define MAXFLOAT 1.8e308
#define LNMAXFLOAT 710.37 /* ln (MAXFLOAT) */
#define CompTol (1e-8)
#endif
/* if abs(A),abs(B) are both < MAXFACTOR then A*B will fit in FPInt */
#define MAXFACTOR 0xB504L
/****************** end of machine dependent constants *********************/
/********************************* Strings *********************************/
/*
* StrCell
*
* Each string is segmented into a linked list. The first record of the
* linked list contains the reference count for the string.
* The string is terminated by a segment with a null StrNext field or
* a '\0', whichever comes first. The empty string is represented
* by a null pointer. Segments have '\0' as their first character iff
* they are in the free string list.
*/
/*
* StrHeadLen is the maximum number of characters which can be contained in
* the first segment of a string list.
*/
#if OPSYS==CTSS
#define StrHeadLen 8 /* For 64-bit ushort and 64-bit pointer */
#else
#define StrHeadLen 10 /* For 16-bit ushort and 32-bit pointer */
#endif
#define StrTailLen (StrHeadLen + sizeof (ushort))
typedef struct StrCell {
struct StrCell *StrNext;
union {
char StrVar1 [StrTailLen];
struct {
char StrV1F1 [StrHeadLen];
ushort StrV1F2;
} StrVar2;
} StrUni1;
} StrCell;
typedef StrCell *StrPtr;
#define StrChar StrUni1.StrVar1
#define SRef StrUni1.StrVar2.StrV1F2
/****************************** Sequences ******************************/
/*
* Sequences are guaranteed not to have cycles by the definition of FP.
* Note that function representation lists may have a cycle, but the cycle
* will always contain a function name as a member. Cycle will be broken
* when the function definition is deleted.
*/
/* Object Tags */
#define BOTTOM 0
#define BOOLEAN 1
#define INT 2
#define FLOAT 3
#define LIST 4
#define STRING 5
#define NODE 6
#define CODE 7
#define JOIN 8
/* Bitmasks for PairTest */
#define NUMERIC ((1<<FLOAT)|(1<<INT))
#define ATOMIC (NUMERIC | (1<<BOOLEAN) | (1<<STRING))
#define MAXTAG 7
#define SEQUENCE (1<<LIST)
/* Tag checking expressions dependent upon tag value assignments above */
#define Scalar(Tag) ((Tag) < 4)
#define Numeric(Tag) (((Tag)&~1)^2==0)
#define NotNumPair(Tag1,Tag2) ((((Tag1)^2)|((Tag2)^2))&~1)
#define IntPair(Tag1,Tag2) ((Tag1+Tag2) == 4)
typedef struct CodeCell {
int (*CodePtr) (); /* (*CodePtr) (InOut,CodeParam) */
int CodeParam;
} CodeCell;
typedef union {
FPfloat _Float;
FPint _Int;
FPboolean _Bool;
struct ListCell *_List;
StrPtr _String;
struct NodeDesc *_Node;
CodeCell _Code;
} ObUnion;
#define Float Data._Float
#define Int Data._Int
#define Bool Data._Bool
#define List Data._List
#define String Data._String
#define Node Data._Node
#define Code Data._Code
/*
* Note on ARRAYS structures. Cells with the ARRAY tag use the List field
* to point to an array descriptor list. The first element of the list
* uses the APtr field, subsequent elements use the ADim field.
*/
/*
* Object
*
* An Object is a union which stores an IFP object. The _LRef field is not
* logically part of an * object, but rather part of a ListCell. We get much
* better packing by including it in Object, since it fits in a 32-bit word
* along with the Tag field.
*
* Likewise, for the UMAX version the _LRefLock field is physically part
* of Object though it should be part of ListCell.
*
* Note that P->Val = Q->Val will transfer the reference count!
*/
typedef struct {
ObUnion Data;
ushort _LRef;
char Tag; /* BOTTOM,BOOLEAN,INT,FLOAT,LIST,STRING,NODE,CODE,ARRAY */
} Object;
/*
* ListCell
*
* Sequences are represented as linked lists of objects. Each ListCell
* also contains a reference count (hidden in the Object field). The
* value stored in the reference count is offset by -1. The rationale is
* that reference counts are always compared against one, and comparing
* against zero is faster on some machines.
*/
typedef struct ListCell {
Object Val; /* Value of first element of sequence (CAR) */
struct ListCell *Next; /* Pointer tail of sequence (CDR) */
} ListCell;
#define LRef Val._LRef
#define LRefOne 0 /* value of LRef for reference count of 1 */
/*
* Most of the code uses subsets of the alphabet for certain types.
* For example, P,Q, and R are usually ListPtr.
*/
typedef ListCell *ListPtr; /* e.g. P,Q,R */
typedef ListPtr *MetaPtr; /* e.g. A,B,C */
typedef Object *ObjectPtr; /* e.g. X,Y,Z */
#define NIL ((ListPtr) NULL) /* empty list */
/******************************* Definitions ******************************/
/*
* DefDesc
*
* DefFlags = subset of {TRACE,RESOLVED}.
* DefCode = code for definition - BOTTOM if not resident.
*/
typedef struct DefDesc {
char DefFlags;
Object DefCode;
} DefDesc;
typedef DefDesc *DefPtr;
#define TRACE 1 /* Print input and output. */
#define RESOLVED 4 /* Mark bit used by reference checker */
/*
* All compiled FP functions have the following form:
*
* void F (InOut,CodeParam)
* ObjectPtr InOut;
* int CodeParam;
* {...};
*
* F replaces *InOut with the result of applying F to *InOut.
* CodeParam is optional.
*/
/******************************* Modules *******************************/
/*
* Modules are stored as lists of nodes. Each node has a pointer to
* its next sibling and its parent node.
*/
typedef struct { /* Module node descriptor */
struct NodeDesc *FirstChild;
} ModDesc;
/******************************** Imports ******************************/
/*
* Definition nodes are imported with IMPORT nodes. An import node in a
* module points to a definition node elsewhere.
*/
typedef struct {
Object ImpDef; /* Can be path list or node */
} ImpDesc;
/******************************** Nodes ********************************/
#define NEWNODE 0 /* Values for NodeType */
#define MODULE 1
#define DEF 2
#define IMPORT 3
/*
* NodeDesc
*
* See the top of node.c for the description of how these are linked together
* to form the function/module tree.
*
* NRef = reference count (references by objects)
* NodeNext = pointer to next sibling (or parent).
* NodeType = type of node (DEF, MODULE, IMPORT)
* NodeName = print name of node.
*/
typedef union {
DefDesc NodeDef; /* if DEF */
ModDesc NodeMod; /* if MODULE */
ImpDesc NodeImp; /* if IMPORT */
} NDunion;
typedef struct NodeDesc {
struct NodeDesc *NodeSib;
struct NodeDesc *NodeParent;
StrPtr NodeName;
short NRef;
char NodeType;
NDunion NodeData;
} NodeDesc;
typedef struct NodeDesc *NodePtr;
/*----------------- exception handling: see except.c -----------------*/
/* values for SysError, 0 == no error */
#define INTERNAL 1 /* Inexplicable internal error */
#define NO_LIST_FREE 2 /* Ran out of list cell storage */
#define NO_STR_FREE 3 /* " " " string " " */
#define NO_NODE_FREE 4 /* " " " node " " */
extern short SysError; /* An error occurred if SysError != 0 */
extern short SysStop; /* Stop evaluation if != 0 */
/*------------ debugging the interpreter: see debug.c ----------------*/
/*
* The interpreter may be compiled with internal spy points. These spy
* points print internal information on stdout. To include the spy * points,
* the interpreter must be compiled with #define DEBUG 1. To turn on a spy
* point when running ifp, use the command line option '-d' followed by the
* appropriate letters. The letters are defined by ``DebugOpt'' below.
* For example,
*
* ifp -dar
*
* will turn on spy points related to memory allocation (a) and
* reference counts (r).
*/
#define DebugParse (1<<0) /* parser */
#define DebugAlloc (1<<1) /* memory allocation */
#define DebugFile (1<<2) /* file io */
#define DebugRef (1<<3) /* reference counts */
#define DebugInit (1<<4) /* initialization */
#define DebugCache (1<<5) /* expression cache */
#define DebugXDef (1<<6) /* extended definitions */
#define DebugHyper (1<<7) /* hypercube */
#define DebugUMax (1<<8) /* multimax */
#define DebugSemaphore (1<<9) /* semaphores */
#define DebugFreeList (1<<10) /* free list */
#define DebugExpQueue (1<<11) /* expression queue */
#define DebugOpt "pafricxhusle" /* option letters for above */
#if DEBUG
extern int Debug; /* Bit-set of enabled spy points */
#else
#define Debug 0 /* Turn spy points into dead code */
#endif
/*--------------------------------------------------------------------*/
extern NodePtr CurWorkDir; /* Current working directory */
extern NodePtr SysDef ();
extern void DelLPtr (); /* Delete a list pointer */
extern ListPtr CopyLPtr (); /* Copy a list pointer */
extern void Rot3 (); /* list pointer rotation */
extern long ListLength (); /* from list.c */
extern void CopyObject ();
extern ListPtr Repeat ();
extern void NewList ();
extern void RepTag ();
extern boolean RepObject ();
extern void RepLPtr ();
extern void CopyTop ();
extern void Copy2Top ();
extern void RepBool ();
extern void Apply (); /* from apply.c */
extern NodePtr ApplyFun;
extern void NodeExpand ();
extern void ExecEdit (), ReadImport (); /* from file.c */
extern void OutObject (), OutList (); /* from outob.c */
extern void OutString (), OutNode ();
extern void OutForm (), OutFun (); /* from outfun.c */
extern void OutPretty ();
extern void InitIn (), InBlanks (); /* from inob.c */
extern void ReadDef (), DelImport ();
extern void InImport ();
extern int InError(); /* from error.c */
extern void DefError (), IntError ();
extern void FunError (), FormError ();
extern char ArgNotSeq[], ArgObSeq[], ArgSeqOb[], ArgNull[], ArgBottom[];
extern NodePtr PrimDef ();
extern char *malloc();
#define ArrayEnd(A) (A+(sizeof(A)/sizeof A[0]))
/************************** end of struct.h **************************/
SHAR_EOF
if test -f 'interp/trace.c'
then
echo shar: over-writing existing file "'interp/trace.c'"
fi
cat << \SHAR_EOF > 'interp/trace.c'
/****** trace.c *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: Sept 9, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#include <stdio.h>
#include "struct.h"
#include "umax.h"
int TraceIndent = 0; /* Indentation level of trace */
int TraceDepth = 2; /* Depth to which functions are printed */
/*
* PrintTrace
*
* Print a trace messages "ENTER>" or "EXIT> " with their arguments.
* Each message is preceeded by an indentation pattern. Each '|' in
* the pattern represents one level of indentation; each '.' in the
* patttern represents DOTSIZE levels of indentation. The latter
* abbreviation keeps us from going off the deep end.
*/
#define DOTSIZE 20
void PrintTrace (F,InOut,EnterExit)
ObjectPtr F,InOut;
char *EnterExit;
{
int K;
/*
* A SysStop >= 2 indicates multiple user interrupts, i.e. the user
* does not want to see trace information.
*/
if (SysStop < 2) {
LineWait ();
for (K = TraceIndent; K>=DOTSIZE; K-=DOTSIZE) printf (".");
while (--K >= 0) printf (" |");
printf (EnterExit);
OutObject (InOut);
printf (" : ");
OutFun (F,TraceDepth);
printf ("\n");
LineSignal ();
}
}
/******************************* end of trace.c ******************************/
SHAR_EOF
if test -f 'interp/umax.h'
then
echo shar: over-writing existing file "'interp/umax.h'"
fi
cat << \SHAR_EOF > 'interp/umax.h'
/****** umax.h *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: Nov 4, 1986 **/
/** **/
/** Revised by: Arch D. Robison Date: Jan 27, 1987 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*
* Defining UMAX=1 in "struct.h" compiles the ifp interpreter for parallel
* processing on the Multimax.
*/
#define semaphore_wait(s)
#define semaphore_signal(s)
#define rsemaphore_enter(r)
#define rsemaphore_exit(r)
#define spin_lock(s)
#define spin_unlock(s)
#define LineWait()
#define LineSignal()
#define Terminate()
/**************************** end of umax.h ****************************/
SHAR_EOF
if test -f 'interp/xdef.c'
then
echo shar: over-writing existing file "'interp/xdef.c'"
fi
cat << \SHAR_EOF > 'interp/xdef.c'
/****** xdef.c ********************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: Aug 4, 1986 **/
/** **/
/** Revised by: Arch D. Robison Date: Aug 4, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/************************* Extended Definitions ************************/
#include <stdio.h>
#include "struct.h"
#include "node.h"
#include "inob.h"
#if XDEF
ListPtr Environment = NIL;
/*
* OutLHS
*
* Input
* P = LHS to output
*/
void OutLHS (InOut)
ObjectPtr InOut;
{
switch (InOut->Tag) {
case LIST: {
register ListPtr P=InOut->List;
printf ("[");
if (P!=NIL)
while (1) {
if (Debug & DebugRef) printf ("{%d}",P->LRef + (1 - LRefOne));
OutLHS (& P->Val);
if ((P=P->Next) == NULL) break;
else printf (",");
}
printf ("]");
break;
}
default: OutObject (InOut);
}
}
/*
* Assign
*
* Assign functional variables.
*
* Input
* X = object to be matched with LHS.
* F = LHS
*/
private boolean Assign (X,F)
ObjectPtr X,F;
{
register ListPtr P,Q;
extern StrPtr CopySPtr();
switch (F->Tag) {
case STRING:
NewList (&Environment,2L);
P = Environment;
P->Val.Tag = STRING;
P->Val.String = CopySPtr (F->String);
CopyObject (&P->Next->Val,X);
return 1;
case LIST:
if (X->Tag != LIST) return 0;
else {
for (Q=X->List,P=F->List; P!=NULL; Q=Q->Next,P=P->Next)
if (Q==NULL || !Assign (&Q->Val,&P->Val)) return 0;
return 1;
}
default:
return 0;
}
}
/*
* FF_XDef
*
* Apply function F to each element of list InOut
*
* Input
* InOut = list of elements to apply function
* Funs = <lhs rhs function>
*
* Output
* InOut = result
*/
FF_XDef (InOut,Funs)
ObjectPtr InOut;
register ListPtr Funs;
{
ListPtr P;
Object X;
boolean InRange;
if (3L != ListLength (Funs)) {
FormError (InOut,"invalid xdef",NULL,Funs);
return;
}
CopyObject (&X,InOut);
Apply (&X,&Funs->Next->Val);
P = Environment;
InRange = Assign (&X,&Funs->Val);
RepTag (&X,BOTTOM);
if (InRange)
Apply (InOut,&Funs->Next->Next->Val);
else if (PrintErr (InOut)) {
OutLHS (&Funs->Val);
printf (": domain error\n");
OutObject (InOut);
printf ("\n");
RepTag (InOut,BOTTOM);
}
RepLPtr (&Environment,P);
}
/*
* InLHSC
*
* Input
* F = input descriptor pointing to '['
*
* Output
* result = true iff no error occurs
* *X = sequence, or unchanged if error occurs.
*/
private boolean InLHSC (F,X,Env)
register InDesc *F;
ObjectPtr X;
ListPtr *Env;
{
register MetaPtr A;
ListPtr R;
*(A = &R) = NULL;
F->InPtr++;
InBlanks (F);
while (']' != *F->InPtr) {
if (!*F->InPtr) {
DelLPtr (R);
return InError (F,"unfinished construction");
}
NewList (A,1L);
if (SysError || !InLHS (F,&(*A)->Val,Env)) {
DelLPtr (R);
return 0;
}
A = & (*A)->Next;
if (*F->InPtr == ',') {
F->InPtr++;
InBlanks (F);
}
}
F->InPtr++; /* Skip closing ']' */
InBlanks (F);
RepTag (X,LIST);
X->List = R;
return 1;
}
/*
* InLHS
*
* Read a left-hand-side of a functional variable definition.
* Return true iff no error occurred.
*
* Input
* *F = input descriptor pointing to LHS
*
* Output
* *F = input descriptor pointing to next token
* *Lhs = left hand side
* *Env = list of functional variables in LHS
*
* A SysError may occur, in which case X is unchanged.
*/
boolean InLHS (F,LHS,Env)
register InDesc *F;
register ObjectPtr LHS;
ListPtr *Env;
{
register ListPtr P;
if (Debug & DebugParse) printf ("InLHS: %s",F->InPtr);
if (*F->InPtr == '[') return InLHSC (F,LHS,Env);
else {
if (NULL == InString (F,LHS,NodeDelim,0))
return InError (F,"variable name expected");
for (P= *Env; P!=NULL; P=P->Next)
if (ObEqual (&P->Val,LHS))
return InError (F,"redefinition of variable (to left of caret)");
NewList (Env,1L);
CopyObject (&(*Env)->Val,LHS);
return 1;
}
}
#endif /* XDEF */
/******************************* end of xdef.c *******************************/
SHAR_EOF
# End of shell archive
exit 0
--
Rich $alz "Anger is an energy"
Cronus Project, BBN Labs rsalz@pineapple.bbn.com
Moderator, comp.sources.unix sources@uunet.uu.net