rs@uunet.UU.NET (Rich Salz) (07/08/87)
Mod.sources: Volume 10, Number 39
Submitted by: robison@b.cs.uiuc.edu (Arch Robison)
Archive-name: ifp/Part06
#! /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/infun.c
# interp/inimport.c
# interp/inob.c
# interp/inob.h
# interp/list.c
# interp/main.c
# interp/node.c
# interp/node.h
export PATH; PATH=/bin:$PATH
mkdir interp
if test -f 'interp/infun.c'
then
echo shar: over-writing existing file "'interp/infun.c'"
fi
cat << \SHAR_EOF > 'interp/infun.c'
/****** infun.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: 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. **/
/**********************************************************************/
#include <stdio.h>
#include <ctype.h>
#include "struct.h"
#include "node.h"
#include "string.h"
#include "inob.h"
/*
* PATTERN should be 0. Setting it to 1 enables a parser extension
* for experimental compiler work.
*/
#define PATTERN 0
/*
* MakeForm
*
* If correct, create form with node N and function list Funs.
*
* Output
* result = 1 if no error, 0 otherwise
*/
boolean MakeForm (Correct,N,Funs,InOut)
boolean Correct;
NodePtr N;
ListPtr Funs;
ObjectPtr InOut;
{
#ifdef PARAMBUG /* cure for CRAY C-compiler bug (see struct.h) */
{
ListPtr T = Funs;
NewList (&T,1L);
Funs = T;
}
#else
NewList (&Funs,1L);
#endif
if (SysError || !Correct) {
DelLPtr (Funs);
return 0;
} else {
Funs->Val.Tag = NODE;
Funs->Val.Node = CopyNPtr (N);
RepTag (InOut,LIST);
InOut->List = Funs;
return 1;
}
}
/*
* InNext
*
* Input next composition, which should be followed by Token.
*
* Input
* *F = input
* End = pointer to MetaPtr to end of list.
* Token = token expected.
* K = pointer to entry of form being parsed
*/
boolean InNext (F,End,Token,K,Env)
InDesc *F;
MetaPtr *End;
char *Token;
FormEntry *K;
ListPtr Env;
{
NewList (*End,1L);
if (SysError || !InComp (F,&(**End)->Val,Env)) return 0;
if (!IsTok (F,Token)) {
char Error [80];
extern char *sprintf();
(void) sprintf (Error,"'%s' part of '%s' expected",
Token,K->FormComment);
return InError (F,Error);
}
*End = &(**End)->Next;
return 1;
}
/*
* InPFO
*
* Input a PFO.
*
* Input
* F = input descriptor pointing to 1st token after 1st keyword of form
* K = index of form
* Env = environment list
*
* Output
* InOut = form
*/
private boolean InPFO (F,InOut,K,Env)
register InDesc *F;
ObjectPtr InOut;
FormEntry *K;
ListPtr Env;
{
ListPtr R = NIL;
MetaPtr A = &R;
boolean Correct;
switch (K-FormTable) {
case NODE_If:
Correct = 0;
if (InNext (F,&A,"THEN",K,Env) && InNext (F,&A,"\0",K,Env))
if (IsTok (F,"ELSIF")) {
NewList (A,1L);
Correct = !SysError && InPFO (F,&(*A)->Val,K,Env);
} else
if (IsTok (F,"ELSE")) Correct = InNext (F,&A,"END",K,Env);
else (void) InError (F,"'ELSE' or 'ELSIF' expected");
break;
case NODE_Each:
case NODE_RInsert:
case NODE_Filter:
Correct = InNext (F,&A,"END",K,NIL);
break;
case NODE_While:
Correct = InNext (F,&A,"DO",K,NIL) && InNext (F,&A,"END",K,NIL);
break;
#if XDEF
case NODE_XDef: {
ListPtr OldEnv = Env;
Correct = 0;
NewList (A,1L);
if (SysError || !InLHS (F,&(*A)->Val,&Env)) break;
if (!IsTok (F,":=")) (void) InError (F,"':=' expected");
else {
A = &(*A)->Next;
if (!InNext (F,&A,"}",K,OldEnv)) break;
NewList (A,1L);
if (InSimple (F,&(*A)->Val,Env)) Correct = 1;
}
break;
}
#endif
case NODE_C:
NewList (A,1L);
if (Correct = !SysError && InObject (F,&(*A)->Val))
if ((*A)->Val.Tag == BOTTOM) {
/* Convert #? to #(null) */
DelLPtr (R);
R = NIL;
}
break;
case NODE_Cons:
if (!(Correct = IsTok (F,"]"))) {
while ((Correct = InNext (F,&A,"\0",K,Env)) && IsTok (F,","))
continue;
if (Correct)
if (Correct = IsTok (F,"]"));
else (void) InError (F,"']' or ',' expected");
}
break;
#if FETCH
case NODE_Fetch:
#endif
case NODE_Out:
NewList (A,1L);
Correct = !SysError && InObject (F,&(*A)->Val);
break;
}
return MakeForm (Correct,K->FormNode,R,InOut);
}
/*
* InSelector
*
* Input
* F = input descriptor pointing to selector
*
* Output
* InOut = selector PFO
*/
private boolean InSelector (F,InOut)
register InDesc *F;
ObjectPtr InOut;
{
register ListPtr P;
long Index = 0;
do
Index = 10*Index + (*F->InPtr++) - '0';
while isdigit (*F->InPtr);
RepTag (InOut,LIST);
InOut->List = NIL;
NewList (&InOut->List,2L);
if (SysError) {
InOut->Tag = BOTTOM;
return 0;
}
P = InOut->List;
P->Val.Tag = NODE;
P->Val.Node = FormTable [NODE_Sel].FormNode;
P = P->Next;
P->Val.Tag = INT;
P->Val.Int = IsTok (F,"r") ? -Index : Index;
return 1;
}
/*
* InSimple
*
* Read a simple function
*
* Output
* result = 1 iff error occurs, 0 otherwise
* InOut = simple function if no error
*
* A SysError may occur, in which case InOut is unchanged.
*/
boolean InSimple (F,InOut,Env)
InDesc *F;
ObjectPtr InOut;
ListPtr Env;
{
static char InFirst[] = { /* First characters of InPrefix */
'I','E','W','#','[','F','@'
#if FETCH
,'^'
#endif
#if XDEF
,'{'
#endif
,'\0'
};
register FormEntry *K;
extern char *index ();
if (Debug & DebugParse) {
printf ("InSimple: Env = "); OutList (Env);
printf (", F = %s\n",F->InPtr);
}
InBlanks (F);
#ifdef PATTERN
if (IsTok (F,"!")) return InObject (F,InOut);
#endif
/*
* The "index" lookup below quickly rejects strings which
* cannot be key words.
*/
if (NULL != index (InFirst,*F->InPtr)) {
for (K=FormTable; K < ArrayEnd(FormTable); K++)
if (*K->FormInPrefix != '\0' && IsTok (F,K->FormInPrefix))
return InPFO (F,InOut,K,Env);
} else
if (isdigit (*F->InPtr))
return InSelector (F,InOut);
if (!InNode (F,InOut,Env))
return 0;
else if (InOut->List == NULL)
return InError (F,"'/' not a function");
else
return 1;
}
/*
* InComp
*
* Input a composition
*/
boolean InComp (F,InOut,Env)
register InDesc *F;
ObjectPtr InOut;
ListPtr Env;
{
Object X;
if (Debug & DebugParse) {
printf ("InComp: Env = ");
OutList (Env);
printf (", F = %s\n",F->InPtr);
}
X.Tag = BOTTOM;
if (!InSimple (F,&X,Env)) return 0;
else {
InBlanks (F);
if (!IsTok (F,"|")) {
RepObject (InOut,&X);
RepTag (&X,BOTTOM);
return !SysError;
} else {
ListPtr P,R=NIL;
boolean Correct;
NewList (&R,1L);
if (SysError) Correct = 0;
else {
CopyObject (&(P=R)->Val,&X);
RepTag (&X,BOTTOM);
do {
NewList (&P->Next,1L);
Correct = !SysError && InSimple (F,&(P=P->Next)->Val,NIL);
InBlanks (F);
} while (Correct && IsTok (F,"|"));
}
return MakeForm (Correct,FormTable[NODE_Comp].FormNode,R,InOut);
}
}
}
/*
* InDef
*
* Input a function definition
*
* Input
* FunName = Name of function
* Output
* InOut = function definition
* result = 1 iff successful, 0 otherwise
*/
boolean InDef (F,FunName,InOut)
register InDesc *F;
StrPtr FunName;
ObjectPtr InOut;
{
Object Fun,S;
Fun.Tag = BOTTOM;
S.Tag = BOTTOM;
F->InDefFun = FunName;
InBlanks (F);
if (!IsTok (F,"DEF")) return InError (F,"DEF expected");
else {
InBlanks (F);
(void) InString (F,&S,NodeDelim,0);
if (StrComp (S.String,FunName))
(void) InError (F,"Definition name wrong");
else {
InBlanks (F);
if (!IsTok (F,"AS")) (void) InError (F,"AS expected");
else {
InBlanks (F);
if (InComp (F,&Fun,NIL)) {
InBlanks (F);
if (!IsTok (F,";")) (void) InError (F,"semicolon expected");
else {
InBlanks (F);
if (*F->InPtr) (void) InError (F,"end of file expected");
else {
RepTag (&S,BOTTOM);
CopyObject (InOut,&Fun);
RepTag (&Fun,BOTTOM);
return 1;
}
}
}
}
}
}
RepTag (&S,BOTTOM);
RepTag (&Fun,BOTTOM);
return 0;
}
/********************************** infun.c **********************************/
SHAR_EOF
if test -f 'interp/inimport.c'
then
echo shar: over-writing existing file "'interp/inimport.c'"
fi
cat << \SHAR_EOF > 'interp/inimport.c'
/****** inimport.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: Oct 28, 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"
#include "string.h"
#include "inob.h"
/*
* DoubleDot
*
* Append a ".." to path list by deleting last element.
*
* Input
* *F = file descriptor
* *C = pointer to path list
*
* Output
* result = pointer to last null field, null if error.
*/
MetaPtr DoubleDot (F,C)
InDesc *F;
register MetaPtr C;
{
register MetaPtr A;
if (*C == NULL) {
(void) InError (F,"Too many ..'s.");
return NULL;
} else { /* Remove last element from path list R */
do {
A = C;
C = &(*A)->Next;
} while (*C != NULL);
DelLPtr (*A);
*A = NULL;
return A;
}
}
/*
* NodeDelim is the set of pathname delimiters. Note that '>' and '<' are not
* in the set since they are (perversely) legal function names.
*/
char NodeDelim[] = " ,[](){}|;:/\t\n";
/*
* InNode
*
* Input a path. A path may represent a module, function, or functional
* variable. Local functions are linked if possible to save time and space.
*
* The EBNF production definition for a node is:
*
* ["/"] string { "/" (string | "..") }
*
* Input
* *F = input descriptor pointing to path
* Env = environment
*
* Output
* InOut = node (path list or node format) or functional variable (string)
* *F = input descriptor pointing to next token after path
*
* A SysError may occur, in which case InOut is unchanged.
*/
boolean InNode (F,InOut,Env)
InDesc *F;
ObjectPtr InOut;
ListPtr Env;
{
ListPtr R = NULL; /* path list accumulator */
register MetaPtr A = &R; /* pointer to Next field at end of accumulator */
register NodePtr N;
boolean FirstSlash;
if (Debug & DebugParse) printf ("InNode: '%s'",F->InPtr);
if (!(FirstSlash = *F->InPtr == '/')) {
if (IsTok (F,"..")) {
if (F->InDefMod != NULL) R = MakePath (F->InDefMod);
if (NULL == (A = DoubleDot (F,&R))) goto Error;
} else {
Object S; /* relative path */
S.Tag = BOTTOM;
if (NULL == InString (F,&S,NodeDelim,0)) {
if (!SysError) (void) InError (F,"path expected");
goto Error;
}
if (!IsTok (F,"/")) {
for (; Env!=NULL; Env=Env->Next)
if (ObEqual (&Env->Val,&S)) {
RepObject (InOut,&Env->Val); /* functional variable */
return 1;
}
N = FindNode (F->InDefMod,S.String); /* local function */
if (N != NULL) {
if (N->NodeType == IMPORT) {
/* Imported function - resolve alias */
RepObject (InOut,&N->NodeData.NodeImp.ImpDef);
} else { /* Local function already linked */
RepTag (InOut,NODE);
InOut->Node = CopyNPtr (N);
}
RepTag (&S,BOTTOM);
return 1;
}
}
if (F->InDefMod != NULL) R = MakePath (F->InDefMod);
while (*A != NULL) A = &(*A)->Next;
NewList (A,1L);
(*A)->Val.Tag = STRING;
(*A)->Val.String = S.String;
}
}
while (IsTok (F,"/")) {
if (IsTok (F,".."))
if (NULL == (A = DoubleDot (F,&R))) return 0;
else continue;
else {
NewList (A,1L);
if (SysError) goto Error;
if (NULL == InString (F,&(*A)->Val,NodeDelim,0)) {
if (SysError) goto Error;
else if (*F->InPtr != '/' && FirstSlash) {
(void) DoubleDot (F,&R);
break;
} else {
(void) InError (F,"Invalid path name");
goto Error;
}
}
A = &(*A)->Next;
}
FirstSlash = 0;
}
RepTag (InOut,LIST);
InOut->List = R;
return 1;
Error:
DelLPtr (R);
return 0;
}
/*
* InImport
*
* Input from an import file.
*
* An import file has the following format:
*
* { 'FROM' path 'IMPORT' string {,string} ';' }
*
* Input
* F = input
* M = pointer to module node
*/
void InImport (F,M)
register InDesc *F;
register NodePtr M;
{
Object Path,Def;
register NodePtr N;
MetaPtr A;
F->InDefFun = NULL;
Path.Tag = BOTTOM;
Def.Tag = BOTTOM;
while (*F->InPtr) {
if (!IsTok (F,"FROM")) {
(void) InError (F,"FROM expected");
break;
}
(void) InNode (F,&Path,NIL);
if (!IsTok (F,"IMPORT")) {
(void) InError (F,"IMPORT expected");
break;
}
while (1) {
if (NULL == InString (F,&Def," ,;\n",0)) {
if (!SysError) (void) InError (F,"function name expected");
goto Return;
}
N = MakeChild (M,Def.String);
switch (N->NodeType) {
case IMPORT:
(void) InError (F,"duplicate imported identifier");
break;
case DEF:
if (N->NRef > 1) {
(void) InError (F,"identifies function elsewhere");
break;
} /* else continue on down to NEWNODE */
case NEWNODE: {
extern MetaPtr MakeCopy ();
N->NodeType = IMPORT;
N->NodeData.NodeImp.ImpDef.Tag = LIST;
A = MakeCopy (&N->NodeData.NodeImp.ImpDef.List, Path.List);
NewList (A,1L);
RepObject (&(*A)->Val,&Def);
break;
}
}
if (IsTok (F,";")) break;
if (!IsTok (F,",")) {
(void) InError (F,"comma or semicolon expected");
goto Return;
}
}
}
Return:
RepTag (&Path,BOTTOM);
RepTag (&Def,BOTTOM);
return;
}
/******************************* inimport.c *******************************/
SHAR_EOF
if test -f 'interp/inob.c'
then
echo shar: over-writing existing file "'interp/inob.c'"
fi
cat << \SHAR_EOF > 'interp/inob.c'
/****** inob.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: Aug 6, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*************** object input parser (recursive descent) ***************/
#include <stdio.h>
#include <ctype.h>
#include "struct.h"
#include "node.h"
#include "string.h"
#include "inob.h"
/*
* ObDelim
*
* Theses characters delimit objects.
* Compare with NodeDelim in inimport.c
*/
private char ObDelim[] = " ,<>|[](){};:\t\n";
/*
* InBlanks
*
* Skip to first non-blank character not in comment.
*
* Input
* F = input descriptor
*
* Output
* F = input descriptor pointing to non-blank character
*/
void InBlanks (F)
register InDesc *F;
{
while (1) {
while (1) {
if (!*F->InPtr)
if (F->InLineNum >= 0)
if (NULL != fgets (F->InBuf,INBUFSIZE,F->InFile)) {
F->InPtr = F->InBuf;
F->InLineNum++;
}
if (!isspace (*F->InPtr)) break;
F->InPtr++;
}
if (*F->InPtr == '(' && F->InPtr[1] == '*') {
F->ComLevel++;
F->InPtr+=2;
} else if (*F->InPtr == '*' && F->InPtr[1] == ')') {
F->ComLevel--;
F->InPtr+=2;
} else if (F->ComLevel && *F->InPtr) F->InPtr++;
else break;
}
}
/*
* IsTok
*
* Check if next token in input is S. Skip if found.
*/
boolean IsTok (F,S)
InDesc *F;
register char *S;
{
register char *T;
for (T = F->InPtr; *S; S++,T++)
if (*S != *T) return 0;
/* Check if alphabetic token is prefix of longer token */
if (isalpha (T[-1]) && isalpha (T[0])) return 0;
F->InPtr = T;
InBlanks (F);
return 1;
}
/*
* InString
*
* Input a string.
*
* Input
* *F = input descriptor pointing to first character of string
* Delim = string of non-alphanumeric delimiters
* Quoted = skip closing delimiter
*
* Output
* *F = input descriptor pointing to next token after string
* X = string object
* result = pointer to string, NULL if SysError or empty string.
*
* A SysError may occur, in which case X = bottom.
*/
StrPtr InString (F,X,Delim,Quoted)
register InDesc *F;
ObjectPtr X;
char *Delim;
boolean Quoted;
{
CharPtr U;
register char C;
RepTag (X,STRING);
X->String = NULL;
CPInit (&U,&X->String);
do {
extern char *index ();
C = *F->InPtr++;
if (!isalnum (C) && NULL != index (Delim,C)) C = '\0';
CPAppend (&U,C);
if (SysError) {RepTag (X,BOTTOM); return NULL;}
} while (C);
if (!Quoted) F->InPtr--;
InBlanks (F);
return X->String;
}
/*
* InList
*
* Input a list
*
* Input
* F = input descriptor pointing to first token after '<'
*
* Output
* result = true iff no error occurs
* *X = sequence, or unchanged if error occurs.
*/
private boolean InList (F,X)
register InDesc *F;
ObjectPtr X;
{
ListPtr R=NULL;
register MetaPtr A = &R;
while (!IsTok (F,">")) {
if (!*F->InPtr) {
DelLPtr (R);
return InError (F,"unfinished sequence");
}
NewList (A,1L);
if (SysError || !InObject (F,&(*A)->Val)) {
DelLPtr (R);
return 0;
}
A = & (*A)->Next;
(void) IsTok (F,",");
}
RepTag (X,LIST);
X->List = R;
return 1;
}
/*
* InObject
*
* Read an object.
*
* Input
* *F = input descriptor pointing to object
*
* Output
* *F = input descriptor pointing to next token
* result = true iff object is read successfully.
*
* A SysError may occur, in which case X is unchanged.
*/
boolean InObject (F,X)
register InDesc *F;
register ObjectPtr X;
{
if (IsTok (F,"<")) return InList (F,X);
else if (IsTok (F,"(")) {
(void) InComp (F,X,NIL);
if (!IsTok (F,")")) return InError (F,"')' expected");
} else {
/* Input atom */
static char Delim[2] = {'\0','\0'};
*Delim = *F->InPtr;
if (*Delim == '\"' || *Delim == '\'') {
F->InPtr++;
(void) InString (F,X,Delim,1);
} else {
FPint K;
register StrPtr S = InString (F,X,ObDelim,0);
if (S == NULL) return SysError || InError (F,"object expected");
if (S->StrChar[1] == '\0')
switch (S->StrChar[0]) {
case 'f':
RepBool (X,0);
return 1;
case 't':
RepBool (X,1);
return 1;
case '?':
RepTag (X,BOTTOM);
return 1;
}
if (StrToFloat (X) && !GetFPInt (X,&K)) {
X->Tag = INT;
X->Int = K;
}
}
}
return 1;
}
/*
* InitIn
*
* Initialize input descriptor for node N and file FileDesc.
* Advance the input pointer to the first token.
*
* Input
* *F = input descriptor
* M = module pointer
* FileDesc = open file descriptor
* LineNum = 0 for normal input, -1 if single-line mode
*/
void InitIn (F,M,FileDesc,LineNum)
register InDesc *F;
NodePtr M;
FILE *FileDesc;
int LineNum;
{
F->InFile = FileDesc;
F->InLineNum= LineNum;
F->InPtr = F->InBuf;
*F->InPtr = '\0';
F->InDefMod = M;
F->ComLevel = 0;
InBlanks (F);
}
/******************************* end of inob.c *******************************/
SHAR_EOF
if test -f 'interp/inob.h'
then
echo shar: over-writing existing file "'interp/inob.h'"
fi
cat << \SHAR_EOF > 'interp/inob.h'
/****** inob.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: 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. **/
/**********************************************************************/
#define INBUFSIZE 255 /* 65 <= INBUFSIZE <= 255 for DOS */
/*
* InDesc
*
* Input descriptor.
*
* Currently, there are three forms of IFP input:
*
* 1. Definition files
* 2. Import files
* 3. Terminal input
*
* All three forms are managed by input descriptors. An input descriptor
* buffers the file, and keeps track of context (e.g. line number).
*/
typedef struct {
char *InPtr; /* Pointer to current character being scanned */
int InLineNum; /* Line number of line being read [1] */
int ComLevel; /* Current comment nesting level [2] */
NodePtr InDefMod; /* Module node of current definition being read */
StrPtr InDefFun; /* Name of current definition */
FILE *InFile; /* File descriptor of file being read */
char InBuf[INBUFSIZE]; /* Buffer for current line being scanned */
} InDesc;
/*
* Footnotes
*
* [1] A line number of -1 indicates unnumbered lines, i.e. terminal input.
*
* [2] ComLevel should always be zero outside of function "InBlanks".
* A non-zero value indicates an "open comment" error.
*/
extern StrPtr InString ();
extern char NodeDelim[];
/******************************* end of inob.h *******************************/
SHAR_EOF
if test -f 'interp/list.c'
then
echo shar: over-writing existing file "'interp/list.c'"
fi
cat << \SHAR_EOF > 'interp/list.c'
/****** list.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 15, 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 "node.h"
#include "umax.h"
#include "string.h"
#include "stats.h"
/*
* FreeList
*
* ListCells in free-list always contain:
*
* LRef == LRefOne
* Val.Tag == BOTTOM
* Next == pointer to next cell in free list.
*/
ListPtr FreeList = NULL;
#define LRefAdd(P,Delta) ((P)->LRef+=(Delta))
/*************** Fundamental List Manipulation Routines ***************/
private ListPtr FixCopyLPtr (); /* forward reference */
/*
* Rot3
*/
void Rot3 (A,B,C)
MetaPtr A,B,C;
{
register ListPtr P;
P = *A; *A = *B; *B = *C; *C = P;
}
/*
* ListLength
*
* Input
* P = pointer to list
*
* Output
* result = length of list
*/
long ListLength (P)
register ListPtr P;
{
register long N;
for (N=0; P!=NULL; P=P->Next) N++;
return N;
}
/*
* CopyObject
*
* Copy object: X := Y
*
* A SysError may occur.
*/
void CopyObject (X,Y)
ObjectPtr X,Y;
{
register ListPtr P;
switch (X->Tag = Y->Tag) {
case BOTTOM: break;
case BOOLEAN: X->Bool = Y->Bool; break;
case INT: X->Int = Y->Int; break;
case FLOAT: X->Float = Y->Float; break;
case LIST:
/* CopyLPtr expanded inline for speed */
P = Y->List;
if (P!=NULL && LRefAdd (P,1) == LRefOne-1)
/*
* This won't work for multiprocessor version
* since other processors will not detect overflow.
*/
P = FixCopyLPtr (P);
X->List = P;
break;
case STRING: X->String = CopySPtr (Y->String); break;
case NODE: X->Node = CopyNPtr (Y->Node); break;
}
}
/*
* NewList
*
* Point *A to list of N cells with last cell's Next set to old value of *A.
*
* Each cell value is set to BOTTOM
*
* A SysError may occur, in which case *A remains unchanged.
*
* Implementation note:
* (x >= 0) is faster than (x > 0) on 16-bit machines since only
* the sign bit must be checked.
*/
void NewList (A,N)
MetaPtr A;
register long N;
{
extern ListPtr AllocListPage ();
register MetaPtr B;
ListPtr P;
Stat (StatNewList (N));
if (--N >= 0) {
B = &FreeList;
do {
if (*B == NULL && (*B = AllocListPage ()) == NULL) {
SysError = NO_LIST_FREE;
printf ("NO MORE LIST CELLS LEFT\n");
return;
}
B = &(*B)->Next;
} while (--N >= 0);
P = FreeList;
FreeList = *B;
*B = *A;
*A = P;
}
}
/*
* Repeat
*
* Create a new list containing N copies of an object
*
* Output
* result = pointer to list
*
* A SysError may occur, in which case NULL is returned.
*/
ListPtr Repeat (X,N)
register ObjectPtr X;
long N;
{
ListPtr P=NULL;
register ListPtr Q;
NewList (&P,N);
if (!SysError)
for (Q=P; Q!=NULL; Q=Q->Next)
CopyObject (&Q->Val,X);
return P;
}
/*
* DelLPtr
*
* Delete a list pointer: decrement reference count and return to free-list
* if not used anymore.
*
* Routine is "vectorized" in that it is optimized to return long lists
* to the freelist.
*/
void DelLPtr (P)
register ListPtr P;
{
register ListPtr Q,R;
Stat (StatDelLPtr (P));
for (R=P; R!=NULL; R=R->Next) {
if (R->LRef != LRefOne) {
R->LRef--;
break;
}
if (!Scalar (R->Val.Tag)) {
switch (R->Val.Tag) {
case LIST: DelLPtr (R->Val.List); break;
case STRING: DelSPtr (R->Val.String); break;
case NODE: DelNPtr (R->Val.Node); break;
}
R->Val.Tag = BOTTOM;
}
Q = R;
}
if (R != P) {
Q->Next = FreeList;
FreeList = P;
}
}
/*
* CopyLPtr
*
* Make a copy of a list pointer, incrementing the reference count.
* If the reference count would overflow, a new list cell is generated.
*
* A SysError may occur, in which case the result is NULL.
*/
ListPtr CopyLPtr (P)
ListPtr P;
{
if (P!=NULL) {
if (LRefAdd (P,1) == LRefOne-1) {
return FixCopyLPtr (P);
}
}
return P;
}
/*
* FixCopyLPtr
*
* Copy a list pointer which overflowed.
*
* Input
* P = pointer to list cell
*/
private ListPtr FixCopyLPtr (P)
ListPtr P;
{
ListPtr Q; /* Reference count overflowed */
LRefAdd (P,-1);
Q = CopyLPtr (P->Next);
if (SysError) return NULL;
NewList (&Q,1L);
if (SysError) return NULL;
CopyObject (&Q->Val,&P->Val);
return Q;
}
/*
* RepTag
*
* Replace an object tag with another tag.
*/
void RepTag (Dest,NewTag)
ObjectPtr Dest;
char NewTag;
{
switch (Dest->Tag) {
case LIST: DelLPtr (Dest->List); break;
case STRING: DelSPtr (Dest->String); break;
case NODE: DelNPtr (Dest->Node); break;
/* default: break; */
}
Dest->Tag = NewTag;
}
/*
* RepBool
*
* Replace an object with a boolean object
*/
void RepBool (Dest,Value)
ObjectPtr Dest;
boolean Value;
{
RepTag (Dest,BOOLEAN);
Dest->Bool = Value;
}
/*
* RepObject
*
* Replace an Object by another Object.
*
* A SysError may occur.
*/
boolean RepObject (Y,X)
register ObjectPtr Y,X;
{
Object Z;
switch (Z.Tag = Y->Tag) {
case LIST: Z.List = Y->List; break;
case STRING: Z.String = Y->String; break;
case NODE: Z.Node = Y->Node; break;
}
switch (Y->Tag = X->Tag) {
case BOTTOM: break;
case BOOLEAN: Y->Bool = X->Bool; break;
case INT: Y->Int = X->Int; break;
case FLOAT: Y->Float = X->Float; break;
case LIST: Y->List = CopyLPtr (X->List); break;
case STRING: Y->String = CopySPtr (X->String); break;
case NODE: Y->Node = CopyNPtr (X->Node); break;
}
switch (Z.Tag) {
case LIST: DelLPtr (Z.List); break;
case STRING: DelSPtr (Z.String); break;
case NODE: DelNPtr (Z.Node); break;
}
}
/*
* RepLPtr
*
* Replace pointer variable *A by value B.
*
* A SysError may occur, in which case *A remains unchanged.
*/
void RepLPtr (A,P)
MetaPtr A;
ListPtr P;
{
P = CopyLPtr (P); /* Copy P first so DelLPtr can't trash *P */
if (SysError) return;
DelLPtr (*A);
*A = P;
}
/*
* MakeCopy
*
* Make a copy of a non-empty list.
*
* Input
* P = pointer to list
*
* Output
* *A = pointer to identical list with LRef == LRefOne
* result = metapointer to Next field of end of result list
*
* A SysError may occur, in which case *A remains unchanged.
*
* All sublist-head reference-counts are incremented if no error occurs.
*/
MetaPtr MakeCopy (A,P)
register ListPtr *A,P;
{
register ListPtr Q;
ListPtr R=NULL; /* R = root of new list */
NewList (&R,ListLength (P));
if (SysError) return NULL;
Q = R;
while (1) {
if (Scalar (P->Val.Tag)) {
Q->Val.Data = P->Val.Data;
Q->Val.Tag = P->Val.Tag;
} else {
CopyObject (& Q->Val,& P->Val);
if (SysError) {DelLPtr (R); return NULL;};
}
P = P->Next;
if (P == NULL) break;
Q = Q->Next;
};
*A = R;
return &Q->Next;
}
/*
* CopyTop
*
* Replace *A with a pointer to a fresh (top level) copy of *A.
*
* Input
* *A = pointer to list
* Output
* *A = pointer to identical list with LRef == LRefOne for top level
*
* A SysError may occur, in which case *A remains unchanged.
*/
void CopyTop (A)
register MetaPtr A;
{
register ListPtr P;
while (1) { /* Search for shared part of list */
P = *A;
if (P == NULL) return;
if (P->LRef != LRefOne) break;
Stat (StatRecycle++);
A = & P->Next;
}
(void) MakeCopy (A,P);
P->LRef--;
if (SysError) (*A)->LRef++;
}
/*
* Copy2Top
*
* Replace *A with a pointer to a fresh (top 2 levels) of *A.
*
* Input
* *A = pointer to list
* Output
* *A = pointer to identical list with LRef == LRefOne
* for both top level and any immediate sublists.
*
* A SysError may occur, in which case *A remains unchanged.
*/
void Copy2Top (A)
register MetaPtr A;
{
register ListPtr P;
while (1) { /* Search for shared part of list */
P = *A;
if (P == NULL) return;
if (P->LRef != LRefOne) break;
if (P->Val.Tag == LIST) {
CopyTop (&P->Val.List);
if (SysError) return;
}
Stat (StatRecycle++);
A = & P->Next;
}
/* (*A) now points to shared list */
(void) MakeCopy (A,(P = *A));
if (SysError) return;
P->LRef--;
P = *A;
do
if (P->Val.Tag == LIST && *(A = &P->Val.List) != NULL) {
/*
* There must some more elegant way to efficiently merge these
* two cases.
*/
(*A)->LRef--; /* will be incremented by MakeCopy */
(void) MakeCopy (A,*A);
if (SysError) return;
}
while ((P=P->Next) != NULL);
}
/****************************** end of list.c ******************************/
SHAR_EOF
if test -f 'interp/main.c'
then
echo shar: over-writing existing file "'interp/main.c'"
fi
cat << \SHAR_EOF > 'interp/main.c'
/****** main.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 "cache.h"
#include "stats.h"
#if OPSYS!=CTSS
#endif
static char Version[] = "\nIllinois FP 0.5";
static char Author [] = " Arch D. Robison";
static char Date [] = " Dec 5, 1986\n";
#if OPSYS==UNIX
#define OPSYSTEM "UNIX"
#endif
#if OPSYS==MSDOS
#define OPSYSTEM "MS-DOS"
#endif
#if OPSYS==CTSS
#define OPSYSTEM "CTSS"
#endif
boolean LongPathFlag = 0;
#ifdef COMPILE
boolean CompilerFlag = 0; /* Enable compiler if set */
boolean RuleFlag = 0; /* Display rules if set */
#endif
private void Init ()
{
extern void D_arith (), D_form (), D_pred (), D_misc (), D_seq (),
D_ss (), D_subseq (), D_string (), D_cray (), D_vector ();
extern void InitString (), InitNode (), InitFile ();
extern char RootPath[]; /* from file.c */
#if OPSYS==MSDOS
char CWD [64];
#endif
#if OPSYS==UNIX
extern void EnvGet ();
#endif
if (Debug & DebugInit) printf ("enter Init\n");
InitString ();
#if OPSYS==MSDOS
CWDGet (CWD,MAXPATH);
#endif
#if OPSYS==UNIX
EnvGet ("IFProot",RootPath,MAXPATH); /* Check for RootPath */
#endif
#if ECACHE
InitCache ();
#endif
InitNode ();
D_arith ();
D_form ();
D_pred ();
D_seq ();
D_subseq ();
D_misc ();
D_ss ();
D_string ();
#if OPSYS==MSDOS
InitFile (CWD);
#endif
#if OPSYS==UNIX || OPSYS==CTSS
InitFile ();
#endif
#ifdef COMPILE
if (CompilerFlag) {
extern void InitSymTab (), InitCompiler ();
InitSymTab ();
InitCompiler ();
}
#endif
#ifdef GRAPHICS
InitDraw (); /* for CS9000 graphics only */
#endif
#if STATS
printf (" (stats)");
#endif
if (Debug & DebugInit) printf ("exit Init\n");
}
extern void UserLoop ();
/*
* GetOptions
*
* Process command line options.
*
* Input
* argv = command line arguments
* argc = argument count
*/
private void GetOptions (argc,argv)
int argc;
char *argv[];
{
int k;
char *P;
for (k=1; k<argc; k++)
if (*(P=argv[k]) == '-')
while (*P && *++P)
switch (*P) {
#ifdef COMPILE
case 'c': CompilerFlag = 1; break;
case 'r': RuleFlag = 1; break;
#endif
#if DEBUG
case 'd':
while (*++P) {
extern char *index();
static char Opt[] = DebugOpt;
char *t = index (Opt,*P);
if (t != NULL) Debug |= 1 << (t-Opt);
else printf ("[unknown option = -d%c] ",*P);
}
break;
#endif /* DEBUG */
#if ECACHE
case 'e':
while (*++P)
if (*P >= '0' && *P <= '2')
Cache[*P-'0'].Enable = 1;
else
printf ("[unknown -e option = %c] ",*P);
break;
#endif /* ECACHE */
case 'l': LongPathFlag = 1; break;
default:
printf ("[unknown option = %c] ",*P);
P = "";
break;
}
}
main (argc, argv)
int argc;
char *argv[];
{
printf ("%s: (%s)",Version,OPSYSTEM);
(void) fflush (stdout);
GetOptions (argc,argv);
Init ();
printf ("\n\n");
UserLoop ();
Terminate();
if (Debug & DebugInit) printf ("normal exit\n");
exit (0);
}
/************************** end of main.c **************************/
SHAR_EOF
if test -f 'interp/node.c'
then
echo shar: over-writing existing file "'interp/node.c'"
fi
cat << \SHAR_EOF > 'interp/node.c'
/****** node.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: Nov 23, 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 "struct.h"
#include "node.h"
#include "umax.h"
#include "string.h"
/********************************* NODE RULES ******************************
Function definitions are stored in nodes, which are arranged in a tree
structure mimicking the UNIX file structure. Below is an example:
Rm
|
Am---Bi----Cm-------Dd
| |
Xd Yd--Zd
Rm is the root node, with children Am,Bi,Cm, and Dd. Nodes can be one of three
types: module (m), import (i), or definition (d). Only definition nodes
have a reference count greater than 1. Only module nodes have children.
****************************** end of node rules **************************/
NodePtr RootNode,SysNode,LogicNode,ArithNode;
/* Free nodes have NREF == 0 and are linked by NodeSib field */
NodePtr FreeNode = NULL;
/*
* DelNPtr
*
* Note: node pointers always have a parent pointer to them, so
* we don't have to delete them here.
*
* Input
* N = pointer to node
*/
void DelNPtr (N)
NodePtr N;
{
rsemaphore_enter (NRefSemaphore);
if (N != NULL) N->NRef--;
rsemaphore_exit (NRefSemaphore);
}
/*
* CopyNPtr
*/
NodePtr CopyNPtr (N)
NodePtr N;
{
rsemaphore_enter (NRefSemaphore);
if (N != NULL && !++N->NRef) IntError ("CopyNPtr: too many refs");
rsemaphore_exit (NRefSemaphore);
return N;
}
/*
* NewNode
*
* Point *N to new node from free list. The input value of *N is
* put in the NodeSib field of the new node.
*
* A SysError may occur, in which case *N is unchanged.
*/
private void NewNode (N)
NodePtr *N;
{
extern NodePtr AllocNodePage ();
register NodePtr T;
rsemaphore_enter (NRefSemaphore);
if (FreeNode == NULL && (FreeNode = AllocNodePage ()) == NULL) {
printf ("NO MORE NODE CELLS LEFT\n");
SysError = NO_NODE_FREE;
} else {
T = FreeNode;
FreeNode = FreeNode->NodeSib;
T->NodeSib = *N;
*N = T;
}
rsemaphore_exit (NRefSemaphore);
}
/*
* FindNode
*
* Find a node within a module with a specified name.
*
* Input
* M = pointer to module node
* S = pointer to string
*
* Output
* result = NULL if node not found, pointer to node otherwise
*/
NodePtr FindNode (M,S)
register NodePtr M;
StrPtr S;
{
if (M->NodeType == MODULE)
for (M = M->NodeData.NodeMod.FirstChild; M!=NULL; M=M->NodeSib)
if (0==StrComp (M->NodeName,S)) return M;
return NULL;
}
/*
* MakePath
*
* Make the path list for a given node
*
* Input
* *N = module node
* Output
* *result = path list
*/
ListPtr MakePath (N)
NodePtr N;
{
ListPtr P;
rsemaphore_enter (NRefSemaphore);
P = NULL;
while (N->NodeParent != NULL) {
NewList (&P,1L);
P->Val.Tag = STRING;
P->Val.String = CopySPtr (N->NodeName);
N = N->NodeParent;
}
rsemaphore_exit (NRefSemaphore);
return P;
}
/*
* MakeChild
*
* Find (or create if necessary) a new child node with a specified name.
*
* Input
* M = Parent node
* S = name of child
*
* Output
* N = pointer to child
*
* A SysError may occur.
*/
NodePtr MakeChild (M,S)
NodePtr M;
StrPtr S;
{
register NodePtr N;
rsemaphore_enter (NRefSemaphore);
N = FindNode (M,S);
if (N==NULL) {
NewNode (&M->NodeData.NodeMod.FirstChild);
if (SysError) {
N = NULL;
goto exit;
}
N = M->NodeData.NodeMod.FirstChild;
N->NodeParent = M;
N->NodeName = CopySPtr (S);
N->NodeType = NEWNODE;
}
exit:
rsemaphore_exit (NRefSemaphore);
return N;
}
/*
* Initialize a module node
*
* Input
* M = pointer to new node
*/
void InitModule (M)
register NodePtr M;
{
M->NodeType = MODULE;
M->NodeData.NodeMod.FirstChild = NULL;
ReadImport (M);
}
/*
* MakeNode
*
* Create all nodes required by a path.
*
* Input
* Path = pointer to path list
* Type = type to make node if new node
* Output
* result = pointer to node specified by path or
* NULL if an error occurred.
*/
NodePtr MakeNode (Path,Type)
ListPtr Path;
int Type;
{
register NodePtr M;
register ListPtr P;
rsemaphore_enter (NRefSemaphore);
M = RootNode;
for (P=Path; P != NULL; P=P->Next)
if (P->Val.Tag != STRING) return NULL;
else {
M = MakeChild (M,P->Val.String);
if (M->NodeType == NEWNODE)
if (P->Next!=NULL) InitModule (M);
else
switch (M->NodeType = Type) {
case DEF:
M->NodeData.NodeDef.DefCode.Tag = BOTTOM;
M->NodeData.NodeDef.DefFlags = 0;
break;
case MODULE:
InitModule (M);
break;
}
}
rsemaphore_exit (NRefSemaphore);
return M;
}
/*
* DelImport
*
* Delete all information affected by the %IMPORT file for a module node
* in preparation for rereading the %IMPORT file.
*
* Input
* M = pointer to module node
*
* Notes
* IMPORT nodes can be returned to the free list since their
* reference counts are always 1.
*/
void DelImport (M)
NodePtr M;
{
register NodePtr *L;
register NodePtr N;
rsemaphore_enter (NRefSemaphore);
for (L = &M->NodeData.NodeMod.FirstChild; (N = *L)!= NULL; )
switch (N->NodeType) {
case IMPORT: /* Return IMPORT nodes to free list */
DelSPtr (N->NodeName);
RepTag (&N->NodeData.NodeImp.ImpDef,BOTTOM);
Rot3 ((MetaPtr) &FreeNode, (MetaPtr) L, (MetaPtr) &N->NodeSib);
break;
case DEF: /* Delete local function definitions */
if (N->NodeData.NodeDef.DefCode.Tag != CODE)
RepTag (&N->NodeData.NodeDef.DefCode,BOTTOM);
L = &N->NodeSib;
break;
case MODULE:
L = &N->NodeSib;
break;
default:
printf ("Invalid NodeType in node tree: %d\n",N->NodeType);
L = &N->NodeSib;
break;
}
rsemaphore_exit (NRefSemaphore);
}
/*
* LinkPath
*
* Convert a path list to a node if possible.
*
* Input
* *Def = path list
* Type = NodeType value if new node
*
* Output
* *Def = node or not changed if error occurs
*/
void LinkPath (Path,Type)
ObjectPtr Path;
int Type;
{
register NodePtr N;
rsemaphore_enter (NRefSemaphore);
N = MakeNode (Path->List,Type);
if (N != NULL) {
RepTag (Path,NODE);
Path->Node = CopyNPtr (N);
}
rsemaphore_exit (NRefSemaphore);
}
/*
* SignExtend
*
* Sign extend a byte. Not all machines have signed characters.
*/
#define SignExtend(B) ((((B) + 0x80) & 0xFF) - 0x80)
/*
* PrimDef
*
* Define a primitive function
*
* Input
* *F = object code for function
* S = name of function
* M = module to put function in
* K = code parameter value
*
* Output
* result = pointer to node containing function
*/
/* VARARGS3 */
NodePtr PrimDef (F,S,M,K)
int (*F) ();
char *S;
NodePtr M;
char K;
{
register NodePtr N;
StrPtr T;
T = MakeString (S);
N = MakeChild (M,T);
N->NodeType = DEF;
N->NodeData.NodeDef.DefCode.Tag = CODE;
N->NodeData.NodeDef.DefFlags = 0;
N->NodeData.NodeDef.DefCode.Code.CodePtr = F;
N->NodeData.NodeDef.DefCode.Code.CodeParam = SignExtend (K);
DelSPtr (T);
return N;
}
/*
* GroupDef
*
* Define a group of functions
*
* Input
* T = pointer to table of functions
* N = number entries in table
* M = module node
*/
void GroupDef (T,N,M)
register OpDef *T;
int N;
NodePtr M;
{
while (--N >= 0)
(void) PrimDef (T->OpPtr,T->OpName,M,T->OpParam),
T++;
}
/*
* Initialize root node and 'sys' subnode.
*/
void InitNode ()
{
register NodePtr R;
if (Debug & DebugInit) printf ("enter InitNode\n");
RootNode = NULL;
NewNode (&RootNode);
R = RootNode;
R->NodeSib = NULL;
R->NodeParent = NULL;
R->NodeType = MODULE;
R->NodeName = MakeString ("ROOT");
R->NodeData.NodeMod.FirstChild = NULL;
SysNode = MakeChild (R,MakeString ("sys"));
InitModule (SysNode);
R = MakeChild (R,MakeString ("math"));
InitModule (R);
ArithNode = MakeChild (R,MakeString ("arith"));
InitModule (ArithNode);
LogicNode = MakeChild (R,MakeString ("logic"));
InitModule (LogicNode);
if (Debug & DebugInit) printf ("exit InitNode\n");
}
/****************************** end of node.c ******************************/
SHAR_EOF
if test -f 'interp/node.h'
then
echo shar: over-writing existing file "'interp/node.h'"
fi
cat << \SHAR_EOF > 'interp/node.h'
/****** node.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: July 8, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#ifndef INCLUDE_NODE_H
#define INCLUDE_NODE_H 1
/*
* Define FETCH as 1 to define "fetch" (^k) functional form, 0 otherwise.
* Define XDEF as 1 to define "xdef" ({...} f) functional form, 0 otherwise.
*/
#define FETCH 0
#define XDEF 1
extern ListPtr MakePath ();
extern NodePtr CopyNPtr (), FindNode ();
extern NodePtr MakeNode (), MakeChild (), PrimDef ();
extern NodePtr RootNode, SysNode, ArithNode, LogicNode;
extern void DelNPtr (), FormPath (), GroupDef (), LinkPath ();
void InitNode ();
typedef struct { /* Used for node initialization tables */
char *OpName;
char OpParam;
int (*OpPtr) (); /* Actually void, but compiler complains about void */
} OpDef; /* in static initializations of this structure */
#define OpCount(OpTable) (sizeof(OpTable)/sizeof(OpTable[0]))
extern NodePtr FormNode[];
/*
* Subscripts for FormNode
*
* These must correspond to the entries in the FormOpTable in forms.c
*/
#define NODE_C 0
#define NODE_Comp 1
#define NODE_Cons 2
#define NODE_Each 3
#define NODE_Fetch 4
#define NODE_Filter (4 + FETCH)
#define NODE_If (5 + FETCH)
#define NODE_RInsert (6 + FETCH)
#define NODE_Out (7 + FETCH)
#define NODE_Sel (8 + FETCH)
#define NODE_While (9 + FETCH)
#define NODE_XDef (9 + FETCH + XDEF)
#define FORM_TABLE_SIZE (10 + FETCH + XDEF)
typedef struct {
NodePtr FormNode; /* Node pointer for form */
char *FormInPrefix;
OpDef FormOp;
char *FormComment; /* Comment for `expected' error message */
} FormEntry;
extern FormEntry FormTable[FORM_TABLE_SIZE];
#endif
/****************************** end of node.h ******************************/
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@uund, d, das