Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!uunet!rs
From: rs@uunet.UU.NET (Rich Salz)
Newsgroups: comp.sources.unix
Subject: v10i038: Interpreted Functional Programming lanuage, Part 05/07
Message-ID: <575@uunet.UU.NET>
Date: Tue, 7-Jul-87 00:32:10 EDT
Article-I.D.: uunet.575
Posted: Tue Jul 7 00:32:10 1987
Date-Received: Wed, 8-Jul-87 04:03:06 EDT
Organization: UUNET Communications Services, Arlington, VA
Lines: 2277
Approved: rs@uunet.uu.net
Mod.sources: Volume 10, Number 38
Submitted by: robison@b.cs.uiuc.edu (Arch Robison)
Archive-name: ifp/Part05
#! /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/cache.c
# interp/cache.h
# interp/command.c
# interp/convert.c
# interp/debug.c
# interp/dos.s
# interp/error.c
# interp/except.c
# interp/file.c
# interp/forms.c
export PATH; PATH=/bin:$PATH
mkdir interp
if test -f 'interp/cache.c'
then
echo shar: over-writing existing file "'interp/cache.c'"
fi
cat << \SHAR_EOF > 'interp/cache.c'
/****** cache.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: July 29, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*
* NOTE: Function HashOb assumes a FPfloat is either 1x or 2x the size
* of a long.
*/
#include "struct.h"
#include "cache.h"
#include
#if ECACHE
CacheEntry ECache[CACHE_SIZE];
CacheRec Cache [4] = {
{0,0,0,0,"Prim"},
{0,0,0,0,"User"},
{0,0,0,0,"PFO"},
{0,0,0,0,"Total"},
};
#define ArraySize(A) (sizeof(A)/sizeof(A[0]))
/*
* Print the cache statistics on stdout and clear the cache statistics tallies.
*/
void ShowCache ()
{
CacheRec *C,*T= &Cache[CacheTotal];
CacheEntry *E;
int Tally=0;
for (E=ECache; E < ArrayEnd(ECache); E++)
if (E->EC_Fun != NULL) Tally++;
printf ("%d/%d = %g full cache\n",
Tally, ArraySize (ECache), (double) Tally / ArraySize (ECache));
T->Enable = 0;
for (C= &Cache[0]; C<&Cache[4]; C++) {
if (C->Enable) {
Cache[CacheTotal].Enable=1;
printf ("%s:\t%d hits in %d looks = %g%% hit rate [%d evictions]\n",
C->Name,C->Hits,C->Looks,
100.0 * C->Hits / (C->Looks ? C->Looks : 1), C->Evictions);
T->Hits += C->Hits;
T->Looks += C->Looks;
T->Evictions += C->Evictions;
C->Hits = C->Looks = C->Evictions = 0;
}
}
if (!T->Enable) printf ("The cache is disabled\n");
}
#if DEBUG
void PrintCache (Message,E)
char *Message;
CacheEntry *E;
{
printf ("ECache %s ",Message); OutObject (&E->EC_In);
printf (" : "); OutNode (E->EC_Fun);
printf (" -> "); OutObject (&E->EC_Out);
printf ("\n");
}
#endif /* DEBUG */
/*
* HashOb
*
* HashOb computes an integer function (hash code) of an object.
*
* Input
* X = object
* Output
* result = hash code
*/
int HashOb (X)
ObjectPtr X;
{
register long H;
register ListPtr P;
switch (X->Tag) {
case BOTTOM: H = 2305; break;
case BOOLEAN: H = X->Bool; break;
case INT: H = X->Int * 9; break;
case FLOAT:
if (sizeof (FPfloat) == 2*sizeof (long))
H = ((long *)&(X->Float))[0] + ((long *)&(X->Float))[1];
else if (sizeof (FPfloat) == sizeof (long))
H = ((long *)&(X->Float))[0];
else
fprintf (stderr,"HashOb: can't hash floats on this machine!\n");
break;
case STRING: H = (long) X->String; break;
case LIST:
H = 5298;
for (P=X->List; P!=NULL; P=P->Next)
H = H * 0x1243 + HashOb (&P->Val);
break;
case NODE: H = (long) X->Node * 5; break;
case CODE: H = (long) X->Code.CodePtr +
(long) X->Code.CodeParam; break;
default:
fprintf (stderr,"HashOb: invalid tag (%d)\n",X->Tag);
break;
}
return H;
}
ClearCache () /* Clear all entries from the cache. */
{
CacheEntry *C;
for (C=ECache+CACHE_SIZE; --C >= ECache; ) {
RepTag (&C->EC_In, BOTTOM);
C->EC_Fun = NULL;
RepTag (&C->EC_Out,BOTTOM);
}
}
InitCache () /* Initialize the cache */
{
register CacheEntry *E;
CacheRec *C;
printf (" (cache");
for (C=Cache; C<&Cache[3]; C++)
if (C->Enable) printf (" %s",C->Name);
printf (")");
for (E=ECache+CACHE_SIZE; --E >= ECache; ) {
E->EC_In. Tag = BOTTOM;
E->EC_Fun = NULL;
E->EC_Out.Tag = BOTTOM;
}
}
#endif /* ECACHE */
SHAR_EOF
if test -f 'interp/cache.h'
then
echo shar: over-writing existing file "'interp/cache.h'"
fi
cat << \SHAR_EOF > 'interp/cache.h'
/****** cache.h *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.1 **/
/** **/
/** Author: Arch D. Robison Date: May 1, 1985 **/
/** **/
/** Revised by: Arch D. Robison Date: July 29, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#define ECACHE 0 /* Implement expression cache if defined */
#if ECACHE
/*
* The expression cache can be turned on selectively for expressions with
* primitive functions, user-defined functions, or PFOs.
*
* Cache[i].Enable = 0/1 to turn off/on cache for expression type i in [0..2].
*/
#define CachePrim 0
#define CacheUser 1
#define CachePFO 2
#define CacheTotal 3
typedef struct {
boolean Enable;
int Looks; /* Number of looks into cache */
int Hits; /* Number of successful looks */
int Evictions; /* Number of evictions */
char *Name; /* "Prim", "User", "PFO", etc.*/
} CacheRec;
extern CacheRec Cache[];
#if DEBUG
extern void PrintCache ();
#endif
/*
* The expression cache is implemented as a hash table. It
* associates outputs with pairs.
*/
#define CACHE_SIZE 1024 /* Must be power of 2 */
/*
* EC_Fun.Tag = BOTTOM iff that cache entry is empty
*/
typedef struct {
Object EC_In, EC_Out;
NodePtr EC_Fun;
} CacheEntry;
extern CacheEntry ECache[];
extern int HashOb ();
extern void ShowCache (); /* Show cache statistics */
/*
* CheckCache
*
* Parameter
* T = &Cache[i] where i is type of function to be cached.
* A = call to "apply" with appropriate arguments.
*/
#define CheckCache(T,A) \
if ((T)->Enable) { \
CacheEntry *C; \
extern int TraceDepth; \
\
(T)->Looks++; \
C = &ECache [(HashOb(InOut) + (long) F->Node) * 0x9B & CACHE_SIZE-1]; \
if (ApplyFun == C->EC_Fun && ObEqual (InOut,&C->EC_In)) { \
if (Debug & DebugCache) PrintCache ("Hit!",C); \
(T)->Hits++; \
if (Trace|SaveTrace) printf ("IBID\n"); \
RepObject (InOut,&C->EC_Out); \
} else { \
if (C->EC_Fun != NULL) { \
(T)->Evictions++; \
if (Debug & DebugCache) PrintCache ("Evict",C); \
} \
C->EC_Fun = NULL; \
RepObject (&C->EC_In,InOut); \
{A;} \
C->EC_Fun = F->Node; \
RepObject (&C->EC_Out,InOut); \
if (Debug & DebugCache) PrintCache ("Load",C); \
} \
} else {A;}
#else
#define CheckCache(T,A) {A;}
#define ClearCache()
#endif
/***************************** end of cache.h ****************************/
SHAR_EOF
if test -f 'interp/command.c'
then
echo shar: over-writing existing file "'interp/command.c'"
fi
cat << \SHAR_EOF > 'interp/command.c'
/****** command.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 28, 1987 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/*************************** Command Interpreter **************************/
#include
#include
#include "struct.h"
#include "node.h"
#include "umax.h"
#include "inob.h"
#include "cache.h"
#include "stats.h"
#if OPSYS==UNIX
#include
#include
#endif
#if OPSYS==MSDOS
#include "/usr/include/dos/spawn.h" /* Full name so lint can find it */
#include "/usr/include/dos/string.h"
#endif
extern char EditorPath [],*EdCommand;
extern char *getenv ();
extern boolean RefCheck (); /* from apply.c */
#if OPSYS==UNIX
extern fork (),execl ();
#endif
InDesc UserIn;
/*
* ReadNode
*/
private NodePtr ReadNode (U)
InDesc *U;
{
Object S;
if (!InNode (U,&S,NIL)) return NULL;
LinkPath (&S,DEF);
if (S.Tag == NODE) return S.Node;
else {
printf ("Error: ");
OutString (S.String);
printf (" not defined\n");
return NULL;
}
}
#if REFCHECK
/*
* ShowRefCheck
*/
void ShowRefCheck ()
{
Object F;
register InDesc *U;
U = &UserIn;
F.Tag = BOTTOM;
(void) InComp (U,&F,NIL);
(void) RefCheck ((NodePtr) NULL,&F);
RepTag (&F,BOTTOM);
}
#endif
/*
* ShowApply
*/
private void ShowApply (OutGraph)
int OutGraph;
{
Object X,F;
register InDesc *U;
U = &UserIn;
X.Tag = BOTTOM;
F.Tag = BOTTOM;
if (InObject (U,&X)) {
if (!IsTok (U,":")) (void) InError (U,"colon expected");
else {
(void) InComp (U,&F,NIL);
if (Debug & DebugFile) {
printf ("Object = "); OutObject (&X); printf ("\n");
printf ("Function = "); OutFun (&F,MaxInt); printf ("\n");
}
if (*U->InPtr) (void) InError (U,"extra character on line");
else {
U->InPtr++;
ClearCache ();
Apply (&X,&F);
#ifdef GRAPHICS
if (OutGraph) DrawObject (&X);
else OutPretty (&X,0);
#else
OutPretty (&X,0);
printf ("\n");
#endif
}
}
}
RepTag (&X,BOTTOM);
RepTag (&F,BOTTOM);
}
/*
* ExecFile
*
* Execute a file
*
* Input
* Prog = program to be executed
* Arg = argument string
*/
void ExecFile (Prog,Arg)
char *Prog,*Arg;
{
if (Debug & DebugFile) printf ("ExecFile (%s,%s)\n",Prog,Arg);
#if OPSYS==UNIX
if (fork ()) (void) wait ((union wait *)NULL);
else {
if (Debug & DebugFile) printf ("prepare to flush\n");
(void) fflush (stdout);
execl (Prog,Prog,Arg,(char *)NULL);
perror (Prog);
exit (1);
}
#endif
#if OPSYS==MSDOS
if (spawnl (P_WAIT,Prog,Prog,Arg,(char *)NULL)) perror (Prog);
#endif
}
void ExecEdit (FileName)
char *FileName;
{
if (Debug & DebugFile) printf ("ExecEdit (%s)\n",FileName);
#if OPSYS==UNIX
ExecFile (EditorPath,FileName);
#endif
#if OPSYS==MSDOS
{
extern char *PathSplit ();
char *T;
T = PathSplit (FileName);
if (T != NULL) ExecFile (EditorPath,T);
}
#endif
}
/*
* EditRm
*
* Action depends on ``Edit'' flag:
*
* Edit
* Apply the user's editor to a function or import file. If a function,
* delete the function definition from memory. If %IMPORT file, reread it.
*
* !Edit
* Remove a function definition or %IMPORT file.
*/
private void EditRm (U,Edit)
register InDesc *U;
boolean Edit;
{
Object N;
char Buf[MAXPATH+1];
static char *Import = "%IMPORT";
if (Debug & DebugFile) printf ("EditRm (%s,%d)\n",U->InPtr,Edit);
if (IsTok (U,Import)) {
if (Edit) ExecFile (EditorPath,Import);
else
if (unlink (Import)) perror (Import);
DelImport (U->InDefMod);
ReadImport (U->InDefMod);
} else {
N.Tag = BOTTOM;
(void) InNode (U,&N,NIL);
LinkPath (&N,DEF);
/* Kill old source code definition */
if (N.Tag == NODE)
switch (N.Node->NodeType) {
case DEF:
RepTag (&N.Node->NodeData.NodeDef.DefCode,BOTTOM);
break;
case MODULE:
break;
}
FormPath (&N,Buf,&Buf[MAXPATH]);
RepTag (&N,BOTTOM);
if (Edit) ExecEdit (Buf);
else
if (unlink (Buf)) perror (Buf);
}
}
#if OPSYS==UNIX
/*
* Shell
*
* Execute a shell command
*/
void Shell (U)
register InDesc *U;
{
if (Debug & DebugFile) printf ("Shell: '%s'\n",U->InPtr);
if (fork ()) (void) wait ((union wait *)NULL);
else {
(void) fflush (stdout);
execl ("/bin/sh","sh","-c",U->InPtr,(char *)NULL);
}
}
#endif
#if OPSYS==MSDOS
/*
* ChDirToCWD
*
* Set DOS current working directory to IFP current working directory.
*
* This procedure is a necessary KLUDGE because the current directory
* cache mechanism changes the current working directory all over the place.
*/
void ChDirToCWD ()
{
char Buf[MAXPATH];
extern char *FormNPath ();
(void) FormPath (CurWorkDir,Buf,&Buf[MAXPATH]);
chdir (Buf);
}
/*
* Directory
*
* Show the current directory
*/
void Directory (U)
register InDesc *U;
{
extern char DirPath[];
ChDirToCWD ();
ExecFile (DirPath,U->InPtr);
}
#endif
/*
* SetDepth
*
* Set function printing depth used for printing.
*/
SetDepth (U)
register InDesc *U;
{
Object X;
FPint N;
extern int TraceDepth;
X.Tag = BOTTOM;
(void) InObject (U,&X);
if (GetFPInt (&X,&N) || N < 0 || N > MaxInt)
printf ("Error: depth must be integer in range 0..%d\n",MaxInt);
else TraceDepth = N;
}
/*
* SetTrace
*
* Set or reset function trace flags.
*/
private void SetTrace (U)
register InDesc *U;
{
NodePtr N;
int T; /* phone home */
if (IsTok (U,"on")) T=1;
else if (IsTok (U,"off")) T=0;
else {
printf ("trace [on|off] f1 f2 f3 ... \n");
return;
}
while (*U->InPtr) {
N = ReadNode (U);
if (N != NULL) {
if (T) N->NodeData.NodeDef.DefFlags |= TRACE;
else N->NodeData.NodeDef.DefFlags &= ~TRACE;
} else break;
}
}
#if DUMP
extern void DumpNode();
#endif
void UserLoop ()
{
register InDesc *U;
int N;
U = &UserIn;
while (1) {
extern char FPprompt [], *gets();
extern void ResetExcept();
#if OPSYS==MSDOS
extern char CWDCache [];
CWDCache [0] = '\0'; /* Clear current directory cache */
#endif
ResetExcept ();
if (Debug & DebugAlloc) {
extern ListPtr FreeList;
printf ("length (FreeList) = %ld\n",ListLength (FreeList));
}
printf ("%s",FPprompt);
(void) fflush (stdout);
InitIn (U,CurWorkDir,stdin,-1);
/* Copy prompt so that error message '^' will point correctly. */
U->InPtr += N = strlen (strcpy (U->InPtr,FPprompt));
(void) fgets (U->InPtr, INBUFSIZE-N, stdin);
if (!*U->InPtr || IsTok (U,"exit")) {
#if OPSYS==MSDOS
ChDirToCWD ();
#endif
return;
}
else if (IsTok (U,"depth")) SetDepth (U);
else if (IsTok (U,"show")) ShowApply (0);
#if HYPERCUBE
else if (IsTok (U,"send")) {
Object X;
ForkFP ();
InObject (U,&X);
OutBinObject (&X);
}
#endif
#if COMPILE
else if (CompilerFlag && IsTok (U,"c")) Compile (U);
#endif
#if REFCHECK
else if (IsTok (U,"check")) ShowRefCheck ();
#endif
#if ECACHE
else if (IsTok (U,"cache")) ShowCache ();
#endif
#if STATS
else if (IsTok (U,"stats")) ShowStats ();
#endif
else if (IsTok (U,"trace")) SetTrace (U);
else if (IsTok (U,EdCommand)) EditRm (U,1);
#if DUMP
else if (IsTok (U,"dump")) DumpNode (CurWorkDir,0);
#endif
#ifdef GRAPHICS
else if (IsTok (U,"graph")) ShowApply (1);
#endif
/* else if (IsTok (U,"test")) Test (U); */
#if OPSYS==UNIX
else if (IsTok (U,"rm")) EditRm (U,0);
else Shell (U);
#endif
#if OPSYS==MSDOS
else if (IsTok (U,"del")) EditRm (U,0);
else if (IsTok (U,"dir")) Directory (U);
#endif
#if OPSYS==MSDOS || OPSYS==CTSS
else printf ("Unknown command: %s\n",U->InPtr);
#endif
}
}
/************************** end of command.c **************************/
SHAR_EOF
if test -f 'interp/convert.c'
then
echo shar: over-writing existing file "'interp/convert.c'"
fi
cat << \SHAR_EOF > 'interp/convert.c'
/****** convert.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: July 2, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/* Type conversion functions */
#include
#include
#include "struct.h"
#include "string.h"
#include
#define BUFSIZE 80 /* Maximum length of numeric string */
/*
* GetFPInt
*
* Get value of FP integer.
*
* Input
* X = FP object
*
* Output
* *K = FPint value of X
* result = error code: 0 = X was converted to integer *K
* 1 = X not an integer
* 2 = X too big
*/
int GetFPInt (X,K)
ObjectPtr X;
FPint *K;
{
switch (X->Tag) {
default: return 1;
case INT: *K = X->Int; return 0;
case FLOAT: {
double F;
F = X->Float;
if (fabs (F) <= (double) FPMaxInt) {
*K = (FPint) F;
F -= (double) *K;
return fabs (F) >= CompTol;
} else return 2;
}
}
}
#if OPSYS==CTSS
/*
* IsFloat
*
* Determine if a string represents floating point number as defined
* by C's atof function. This function is necessary for the CRAY
* since there is a bug in sscanf for the CRAY.
*
* Input
* S = string
*
* Output
* result = true iff string represents number.
*/
int IsFloat (S)
register char *S;
{
int Digits = 0;
if (*S == '+' || *S == '-') S++;
while (isdigit (*S)) {
S++;
Digits++;
}
if (*S == '.')
while (isdigit (*++S)) Digits++;
if (!Digits) return 0;
if (*S == '\0') return 1;
if (*S++ != 'e') return 0;
if (*S == '+' || *S == '-') S++;
while (isdigit (*S)) S++;
return *S == '\0';
}
#endif /* OPSYS==CTSS */
/*
* StrToFloat
*
* Convert object to float representation if possible.
*
* Input
* *X = object
*
* Output
* *X = new representation of object
* result = 1 if *X is float, 0 otherwise.
*/
boolean StrToFloat (X)
ObjectPtr X;
{
CharPtr U;
char Buf[BUFSIZE+1];
double F;
#if OPSYS!=CTSS
char Term;
#endif
CPInit (&U,&X->String);
(void) CPRead (&U,Buf,BUFSIZE);
#if OPSYS==CTSS
if (!IsFloat (Buf)) return 0;
F = atof (Buf);
#else
Buf [strlen (Buf)] = '\1';
if (2 != sscanf (Buf,"%lf%c",&F,&Term) || Term != '\1') return 0;
#endif
RepTag (X,FLOAT);
X->Float = (FPfloat) F;
return 1;
}
/*
* GetDouble
*
* Output
* result = 0 if *D is valid, 1 otherwise.
*/
int GetDouble (X,D)
ObjectPtr X;
double *D;
{
switch (X->Tag) {
case INT: *D = X->Int; return 0;
case FLOAT: *D = X->Float; return 0;
default: return 1;
}
}
/****************************** end of convert.c *****************************/
SHAR_EOF
if test -f 'interp/debug.c'
then
echo shar: over-writing existing file "'interp/debug.c'"
fi
cat << \SHAR_EOF > 'interp/debug.c'
/****** debug.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 5, 1985 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
#include
#include "struct.h"
#include "string.h"
#if DEBUG
int Debug = 0; /* Print debugging statements if true */
#endif
#if DUMP
/*
* DumpNode
*
* Print out node N and all its decendants.
*/
void DumpNode (N,Indent)
register NodePtr N;
int Indent;
{
extern void OutIndent ();
OutIndent (3*Indent);
if (N == NULL) printf ("DumpNode: N = NULL\n");
else {
OutString (N->NodeName);
switch (N->NodeType) {
case NEWNODE: printf ("(new) "); break;
case MODULE:
printf (" module\n");
for (N = N->NodeData.NodeMod.FirstChild; N!=NULL; N=N->NodeSib)
DumpNode (N,Indent+1);
break;
case DEF:
printf (" function");
if (N->NodeData.NodeDef.DefFlags & TRACE)
printf ("(trace) ");
OutObject (&N->NodeData.NodeDef.DefCode);
printf ("\n");
break;
case IMPORT:
printf (" import");
OutObject (&N->NodeData.NodeImp.ImpDef);
printf ("\n");
break;
default:
printf (" invalid NodeType (%x)\n",N->NodeType);
break;
}
}
}
#endif /* DUMP */
/*************************** end of debug.c *********************************/
SHAR_EOF
if test -f 'interp/dos.s'
then
echo shar: over-writing existing file "'interp/dos.s'"
fi
cat << \SHAR_EOF > 'interp/dos.s'
;
;/****** dos.s**********************************************************/
;/** **/
;/** 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 28, 1985 **/
;/** **/
;/** Principal Investigators: Prof. R. H. Campbell **/
;/** Prof. W. J. Kubitz **/
;/** **/
;/** **/
;/**------------------------------------------------------------------**/
;/** (C) Copyright 1987 University of Illinois Board of Trustees **/
;/** All Rights Reserved. **/
;/**********************************************************************/
;/***** Assembly Language Routines for MS-DOS Implementation of IFP *****/
TITLE dos
PUBLIC _StackCheck, _SetCBrk
EXTRN __chkstk:FAR
DOS_TEXT SEGMENT BYTE PUBLIC 'CODE'
ASSUME CS: DOS_TEXT
;
; SetCBrk
;
; Set control-C trapping for any DOS call.
;
_SetCBrk PROC FAR
mov ax,3301H
mov dl,01H
int 21H
ret
_SetCBrk ENDP
;
; StackCheck
;
; Check if there is enough room on the stack and check for break signal
;
_StackCheck PROC FAR
push bp
mov bp,sp
mov ax,64H
call FAR PTR __chkstk
push es
mov ah,2FH
int 21H ; Dummy GET_DTA to look for control-C
pop es
mov sp,bp
pop bp
ret
_StackCheck ENDP
DOS_TEXT ENDS
END
;/************************** end of dos.s **************************/
SHAR_EOF
if test -f 'interp/error.c'
then
echo shar: over-writing existing file "'interp/error.c'"
fi
cat << \SHAR_EOF > 'interp/error.c'
/****** error.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 8, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/************************ Error Message Routines **********************/
#include
#include
#include "struct.h"
#include "node.h"
#include "umax.h"
#include "inob.h"
/* Some common error messages */
char ArgNotSeq[] = "not a sequence",
ArgSeqOb [] = "must be ",
ArgObSeq [] = "must be