rs@uunet.UU.NET (Rich Salz) (07/07/87)
Mod.sources: Volume 10, Number 37
Submitted by: robison@b.cs.uiuc.edu (Arch Robison)
Archive-name: ifp/Part04
#! /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/G_confont.c
# interp/G_draw.c
# interp/Makefile
# interp/README
# interp/alloc.c
# interp/apply.c
# interp/binio.c
export PATH; PATH=/bin:$PATH
mkdir interp
if test -f 'interp/G_confont.c'
then
echo shar: over-writing existing file "'interp/G_confont.c'"
fi
cat << \SHAR_EOF > 'interp/G_confont.c'
/* Written 12:01 pm Jan 8, 1985 by gwyn@brl-tgr in uiucdcsb:net.unix */
/*
symbol -- software character generator subroutine
last edit: 26-Nov-1984 D A Gwyn
18-Mar-1985 A D Robison - hacked for GSI card
rehacked for console
Function:
This routine plots an ASCII character string as vector strokes.
Calling sequence:
void ConSymbol (
char *string, // -> NUL-terminated string
int transform [2][3]; // text transformation //
);
The characters are on a 6 high by 4 wide grid. The transform is scaled
by 1024 and transforms from the character grid onto console device coordinates.
E.g. the unit transform is {{1024,0,0},{0,1024,0}}.
*/
/*
STROKE TABLES
The stroke[] table contains encodings for all vector strokes
needed to draw each character at a standard size. Actual plot
output is of course properly positioned, scaled, and rotated.
To keep code size small, variable-length entries are used; each
character stroke sequence is terminated by a 0 datum. Pointers
to the appropriate data for every character is stored into
sstroke[] during a one-time initialization.
The prototypes are constrained to a 4 x 6 unit area, except for
occasional descenders up to 2 units below the baseline. All
visible strokes should be "basic" vectors (in directions that
are integral multiples of 45 degrees) for best overall results
on most devices, especially with small character height. The
first 16 "control" characters are plotted as non-standard extra
symbols, the next 16 produce Calcomp "centered plotting symbols"
(not centered here!), and the final 96 characters are plotted as
corresponding ASCII graphics (DEL plots as a grid).
A prototype stroke is encoded as 8 bits SVXXXYYY:
S = 0 if YYY is correct as is
1 if YYY needs to have 2 subtracted
V = 0 if stroke is invisible (move)
1 if stroke is visible (draw)
XXX = final X coord of stroke (0..4)
YYY = final Y coord of stroke (0..6)
*/
/* bit masks for fields in stroke vector */
#define S 0200
#define V 0100
#define XXX 0070
#define YYY 0007
#define XJUST 3 /* bits to the right of XXX */
/* stroke vectors for all characters */
static char stroke[] =
{
/*NUL*/ 0003, 0105, 0123, 0143, 0141, 0121, 0125, 0,
/*SOH*/ 0006, 0115, 0112, 0142, 0022, 0121, 0141, 0140, 0120, 0013,
0133, 0034, 0114, 0015, 0126, 0,
/*STX*/ 0021, 0125, 0105, 0103, 0123, 0141, 0143, 0,
/*ETX*/ 0012, 0114, 0034, 0104, 0106, 0126, 0124, 0033, 0113, 0021,
0141, 0042, 0122, 0120, 0,
/*EOT*/ 0005, 0125, 0134, 0145, 0143, 0023, 0125, 0015, 0113, 0,
/*ENQ*/ 0011, 0131, 0142, 0144, 0135, 0115, 0104, 0102, 0111, 0012,
0114, 0134, 0133, 0113, 0023, 0132, 0,
/*ACK*/ 0011, 0131, 0142, 0144, 0135, 0115, 0104, 0102, 0111, 0034,
0114, 0112, 0132, 0,
/*BEL*/ 0021, 0122, 0142, 0133, 0134, 0124, 0125, 0024, 0114, 0113,
0102, 0122, 0,
/*BS */ 0012, 0103, 0114, 0003, 0143, 0,
/*HT */ 0003, 0143, 0034, 0143, 0132, 0,
/*LF */ 0012, 0121, 0132, 0021, 0125, 0,
/*VT */ 0021, 0125, 0014, 0125, 0134, 0,
/*FF */ 0012, 0121, 0132, 0021, 0125, 0014, 0125, 0134, 0,
/*CR */ 0012, 0103, 0114, 0003, 0143, 0034, 0143, 0132, 0,
/*SO */ 0004, 0124, 0126, 0106, 0104, 0014, 0112, 0142, 0034, 0130, 0,
/*SI */ 0021, 0123, 0013, 0115, 0025, 0105, 0003, 0123, 0141, 0143, 0,
/*DLE*/ 0023, 0125, 0145, 0141, 0101, 0105, 0125, 0,
/*DC1*/ 0023, 0125, 0135, 0144, 0142, 0131, 0111, 0102, 0104, 0115,
0125, 0,
/*DC2*/ 0023, 0124, 0142, 0102, 0124, 0,
/*DC3*/ 0021, 0125, 0003, 0143, 0,
/*DC4*/ 0001, 0145, 0005, 0141, 0,
/*NAK*/ 0023, 0125, 0143, 0121, 0103, 0125, 0,
/*SYN*/ 0021, 0125, 0143, 0103, 0125, 0,
/*ETB*/ 0001, 0145, 0105, 0141, 0,
/*CAN*/ 0005, 0145, 0101, 0141, 0,
/*EM */ 0023, 0121, 0005, 0123, 0145, 0,
/*SUB*/ 0023, 0145, 0034, 0132, 0141, 0032, 0112, 0101, 0012, 0114,
0105, 0014, 0134, 0,
/*ESC*/ 0001, 0145, 0025, 0121, 0041, 0105, 0003, 0143, 0,
/*FS */ 0001, 0141, 0105, 0145, 0101, 0,
/*GS */ 0021, 0125, 0,
/*RS */ 0023, 0125, 0024, 0142, 0102, 0124, 0021, 0122, 0144, 0104,
0122, 0,
/*US */ 0023, 0143, 0,
/*SP */ 0,
/* ! */ 0020, 0121, 0022, 0126, 0,
/* " */ 0014, 0116, 0036, 0134, 0,
/* # */ 0010, 0116, 0036, 0130, 0042, 0102, 0004, 0144, 0,
/* $ */ 0002, 0111, 0131, 0142, 0133, 0113, 0104, 0115, 0135, 0144,
0026, 0120, 0,
/* % */ 0001, 0145, 0025, 0114, 0105, 0116, 0125, 0032, 0141, 0130,
0121, 0132, 0,
/* & */ 0040, 0104, 0105, 0116, 0125, 0124, 0102, 0101, 0110, 0120,
0142, 0,
/* ' */ 0014, 0136, 0,
/* ( */ 0030, 0112, 0114, 0136, 0,
/* ) */ 0010, 0132, 0134, 0116, 0,
/* * */ 0001, 0145, 0025, 0121, 0041, 0105, 0,
/* + */ 0021, 0125, 0003, 0143, 0,
/* , */ 0211, 0120, 0121, 0,
/* - */ 0003, 0143, 0,
/* . */ 0020, 0121, 0,
/* / */ 0001, 0145, 0,
/* 0 */ 0001, 0145, 0136, 0116, 0105, 0101, 0110, 0130, 0141, 0145, 0,
/* 1 */ 0010, 0130, 0020, 0126, 0115, 0,
/* 2 */ 0005, 0116, 0136, 0145, 0144, 0100, 0140, 0,
/* 3 */ 0001, 0110, 0130, 0141, 0142, 0133, 0144, 0145, 0136, 0116,
0105, 0023, 0133, 0,
/* 4 */ 0030, 0136, 0024, 0102, 0142, 0,
/* 5 */ 0001, 0110, 0130, 0141, 0143, 0134, 0114, 0103, 0106, 0146, 0,
/* 6 */ 0002, 0113, 0133, 0142, 0141, 0130, 0110, 0101, 0105, 0116,
0136, 0145, 0,
/* 7 */ 0006, 0146, 0145, 0112, 0110, 0,
/* 8 */ 0013, 0102, 0101, 0110, 0130, 0141, 0142, 0133, 0113, 0104,
0105, 0116, 0136, 0145, 0144, 0133, 0,
/* 9 */ 0001, 0110, 0130, 0141, 0145, 0136, 0116, 0105, 0104, 0113,
0133, 0144, 0,
/* : */ 0020, 0121, 0023, 0124, 0,
/* ; */ 0211, 0120, 0121, 0023, 0124, 0,
/* < */ 0030, 0103, 0136, 0,
/* = */ 0002, 0142, 0044, 0104, 0,
/* > */ 0010, 0143, 0116, 0,
/* ? */ 0005, 0116, 0136, 0145, 0144, 0122, 0021, 0120, 0,
/* @ */ 0031, 0133, 0124, 0113, 0112, 0121, 0131, 0142, 0144, 0135,
0115, 0104, 0101, 0110, 0130, 0,
/* A */ 0104, 0126, 0144, 0140, 0042, 0102, 0,
/* B */ 0130, 0141, 0142, 0133, 0144, 0145, 0136, 0106, 0100, 0003,
0133, 0,
/* C */ 0045, 0136, 0116, 0105, 0101, 0110, 0130, 0141, 0,
/* D */ 0130, 0141, 0145, 0136, 0106, 0100, 0,
/* E */ 0003, 0133, 0046, 0106, 0100, 0140, 0,
/* F */ 0106, 0146, 0033, 0103, 0,
/* G */ 0022, 0142, 0141, 0130, 0110, 0101, 0105, 0116, 0136, 0145, 0,
/* H */ 0106, 0046, 0140, 0043, 0103, 0,
/* I */ 0010, 0130, 0020, 0126, 0016, 0136, 0,
/* J */ 0001, 0110, 0130, 0141, 0146, 0,
/* K */ 0106, 0046, 0102, 0013, 0140, 0,
/* L */ 0006, 0100, 0140, 0,
/* M */ 0106, 0124, 0146, 0140, 0,
/* N */ 0106, 0005, 0141, 0040, 0146, 0,
/* O */ 0010, 0130, 0141, 0145, 0136, 0116, 0105, 0101, 0110, 0,
/* P */ 0106, 0136, 0145, 0144, 0133, 0103, 0,
/* Q */ 0010, 0130, 0141, 0145, 0136, 0116, 0105, 0101, 0110, 0022,
0140, 0,
/* R */ 0106, 0136, 0145, 0144, 0133, 0103, 0013, 0140, 0,
/* S */ 0001, 0110, 0130, 0141, 0142, 0133, 0113, 0104, 0105, 0116,
0136, 0145, 0,
/* T */ 0020, 0126, 0006, 0146, 0,
/* U */ 0006, 0101, 0110, 0130, 0141, 0146, 0,
/* V */ 0006, 0102, 0120, 0142, 0146, 0,
/* W */ 0006, 0100, 0122, 0140, 0146, 0,
/* X */ 0101, 0145, 0146, 0006, 0105, 0141, 0140, 0,
/* Y */ 0020, 0123, 0105, 0106, 0046, 0145, 0123, 0,
/* Z */ 0040, 0100, 0101, 0145, 0146, 0106, 0013, 0133, 0,
/* [ */ 0030, 0110, 0116, 0136, 0,
/* \ */ 0005, 0141, 0,
/* ] */ 0010, 0130, 0136, 0116, 0,
/* ^ */ 0004, 0126, 0144, 0,
/* _ */ 0201, 0341, 0,
/* ` */ 0016, 0134, 0,
/* a */ 0003, 0114, 0134, 0143, 0140, 0042, 0112, 0101, 0110, 0130,
0141, 0,
/* b */ 0106, 0001, 0110, 0130, 0141, 0143, 0134, 0114, 0103, 0,
/* c */ 0043, 0134, 0114, 0103, 0101, 0110, 0130, 0141, 0,
/* d */ 0043, 0134, 0114, 0103, 0101, 0110, 0130, 0141, 0040, 0146, 0,
/* e */ 0002, 0142, 0143, 0134, 0114, 0103, 0101, 0110, 0130, 0141, 0,
/* f */ 0010, 0115, 0126, 0136, 0145, 0034, 0104, 0,
/* g */ 0201, 0310, 0330, 0341, 0144, 0041, 0130, 0110, 0101, 0103,
0114, 0134, 0143, 0,
/* h */ 0106, 0003, 0114, 0134, 0143, 0140, 0,
/* i */ 0020, 0124, 0114, 0025, 0126, 0,
/* j */ 0201, 0310, 0330, 0341, 0144, 0045, 0146, 0,
/* k */ 0106, 0044, 0100, 0022, 0140, 0,
/* l */ 0020, 0126, 0116, 0,
/* m */ 0104, 0003, 0114, 0123, 0120, 0040, 0143, 0134, 0123, 0,
/* n */ 0104, 0003, 0114, 0134, 0143, 0140, 0,
/* o */ 0010, 0130, 0141, 0143, 0134, 0114, 0103, 0101, 0110, 0,
/* p */ 0001, 0110, 0130, 0141, 0143, 0134, 0114, 0103, 0004, 0300, 0,
/* q */ 0041, 0130, 0110, 0101, 0103, 0114, 0134, 0143, 0044, 0340, 0,
/* r */ 0104, 0003, 0114, 0134, 0143, 0,
/* s */ 0001, 0110, 0130, 0141, 0132, 0112, 0103, 0114, 0134, 0143, 0,
/* t */ 0004, 0134, 0015, 0111, 0120, 0130, 0141, 0,
/* u */ 0004, 0101, 0110, 0130, 0141, 0040, 0144, 0,
/* v */ 0004, 0102, 0120, 0142, 0144, 0,
/* w */ 0004, 0101, 0110, 0121, 0022, 0121, 0130, 0141, 0144, 0,
/* x */ 0144, 0004, 0140, 0,
/* y */ 0201, 0310, 0330, 0341, 0144, 0004, 0101, 0110, 0130, 0141, 0,
/* z */ 0004, 0144, 0100, 0140, 0,
/* { */ 0030, 0121, 0122, 0113, 0124, 0125, 0136, 0,
/* | */ 0020, 0126, 0,
/* } */ 0010, 0121, 0122, 0133, 0124, 0125, 0116, 0,
/* ~ */ 0005, 0116, 0134, 0145, 0,
/*DEL*/ 0140, 0146, 0106, 0100, 0010, 0116, 0026, 0120, 0030, 0136, 0
};
/* pointers to start of stroke data for each character */
static char *sstroke[128] = {(char *) 0};
/* CONSTANTS */
#define CHSPAC 6 /* prototype text spacing */
#define ASCMASK 0177 /* 7-bit ASCII mask */
#define void int
/* GLOBAL DATA */
static int (*T)[3]; /* text transformation */
/* ENTRY POINT */
void ConSymbol (string,transform)
char *string; /* -> NUL-terminated string */
int transform[2][3]; /* text transformation */
{
register char *sp; /* -> stroke data */
register int cornx; /* proto X of cell corner */
register int c; /* char from ASCII string */
/* also used for stroke data */
/* initialize starting stroke pointers upon first entry only */
if (!sstroke[0]) {
sp = stroke;
for (c = 0; c < 128; ++c) {
sstroke [c] = sp; /* starts here */
while (*sp++) continue; /* 0 terminates the data */
}
}
T = transform;
/* look up strokes for each character and plot them */
for (cornx = 0; c = *string++; cornx += CHSPAC) {
sp = sstroke [c & ASCMASK]; /* -> stroke data */
plot (cornx,0,0,0); /* get to character cell LLC */
/* draw the strokes starting at LLC */
while (c = *sp++ ) /* get stroke */
plot (cornx + ((c & XXX) >> XJUST),
(c & YYY) - ((c & S) ? 2 : 0),
(c & V),
(*sp & V)); /* move or draw */
}
}
/* transform prototype coordinates to actual plot coordinates */
#define map(x,y,n) ((T[n][0] * x + T[n][1]*y + T[n][2]) + 512 >> 10);
static void plot (dx,dy,vis,NextVis) /* plot adjusted stroke */
int dx,dy; /* unrot pos rel to text LLC */
int vis; /* nonzero => visible */
int NextVis; /* Is the next stroke visible? */
{
static int oldposx=0,oldposy=0;
static int olddx,olddy;
static int oldValid;
int posx,posy;
if (vis && !oldValid) {
oldposx = map (olddx,olddy,0);
oldposy = map (olddx,olddy,1);
VI_AMove (oldposx,oldposy);
}
posx = map (dx,dy,0);
posy = map (dx,dy,1);
/* no arithmetic overflow checking is done */
if (vis) VI_RLine (posx-oldposx,posy-oldposy);
oldValid = vis;
olddx = dx;
olddy = dy;
oldposx = posx;
oldposy = posy;
}
/* End of text from uiucdcsb:net.unix */
SHAR_EOF
if test -f 'interp/G_draw.c'
then
echo shar: over-writing existing file "'interp/G_draw.c'"
fi
cat << \SHAR_EOF > 'interp/G_draw.c'
/****** G_draw.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: June 18, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/******************** FP Graphics Interface Module ********************/
/*
* The fp interpreter must be compiled with the -DGRAPHICS option to use
* the graphics interface. The interface is specific to the PC/RT.
*
* There are no graphics primitives in FP itself, rather FP is used to
* calculate a display list. The display list is then fed to DrawObject,
* which draws the picture specified by the display list.
*
* The display list has the following structure:
*
* display-list == < {display-list} > | polyline | color | transform | text
* polyline == < "line" { < x y > } >
* color == < "color" color-index display-list >
* text == <"text" print-atom size ["center"]>
* transform = <"trans" t-matrix display-list >
* t-matrix = <<Txx Txy Txo> <Tyx Tyy Tyo>>
*
* The polyline structure specifies a sequence of points. Adjacent points
* are connected with line segments.
*
* The color structure draws the display-list in the color specified by
* the color index (0..15). The color applies to all parts of the
* subordinate display-list which are not subordinate to a color structure
* within.
*
* The transform structure draws the display-list as transformed by the
* t-matrix. Transforms may be nested.
*
* The text structure draws a string with the lower-left corner at (0,0).
* Each character is drawn in a 1.0 by 1.0 box (including spacing).
*/
#include <stdio.h>
#include "struct.h"
#include "string.h"
#define NKey 4
StrPtr SKey[4],SCenter;
private short ScreenDim[2];
private void GraphError (InOut,Message)
ObjectPtr InOut;
char *Message;
{
VI_Term ();
printf ("%s\n",Message);
OutObject (InOut);
printf ("\n");
RepTag (InOut,BOTTOM);
}
void InitDraw ()
{
printf (" (RT/PC graphics)");
fflush (stdout);
SKey[0] = MakeString ("line");
SKey[1] = MakeString ("trans");
SKey[2] = MakeString ("color");
SKey[3] = MakeString ("text");
SCenter = MakeString ("center");
}
typedef double Transform [2][3];
Transform TransDefault = {
{800,0,0},
{0,800,0}
};
forward void DrOb(), DrawText(), DrawTrans(), DrawColor (), PolyLine();
void DrawObject (InOut)
ObjectPtr InOut;
{
if (InOut->Tag == BOTTOM) return;
VI_Init(ScreenDim,ScreenDim+1);
VI_Force();
VI_Color (0);
VI_Tile (ScreenDim[0],ScreenDim[1],1,1,"\0");
DrOb (InOut,TransDefault,1);
if (InOut->Tag != BOTTOM) {
while (getchar () != '\n') continue;
VI_Term ();
}
}
/*
* DrOb
*
* Draw object Inout with transform T and in color Color.
*/
private void DrOb (InOut,T,Color)
register ObjectPtr InOut;
Transform T;
int Color;
{
register int K;
register ListPtr P;
if (InOut->Tag != LIST)
GraphError (InOut,"DrOb: invalid display object");
else {
P = InOut->List;
if (P == NULL || P->Val.Tag == LIST)
for (; P!=NULL; P=P->Next) DrOb (&P->Val,T,Color);
else if (P->Val.Tag != STRING)
GraphError (InOut,"DrOb: first element must be string");
else {
for (K=0; K<NKey; K++)
if (!StrComp (SKey [K],P->Val.String)) break;
switch (K) {
case 0:
PolyLine (P->Next,T,Color);
break;
case 1:
DrawTrans (P->Next,T,Color);
break;
case 2:
DrawColor (P->Next,T);
break;
case 3:
DrawText (P->Next,T,Color);
break;
default:
GraphError (InOut,"DrOb: unknown drawing command");
break;
}
}
}
}
private void GetCoor (P,T,X,Y)
register ListPtr P;
Transform T;
int *X,*Y;
{
extern short sddmul ();
register ListPtr Q;
double Xf,Yf;
if (!PairTest (&P->Val,NUMERIC,NUMERIC))
GraphError (&P->Val,"GetCoor: numeric pair expected\n");
else {
Q = P->Val.List;
GetDouble (&Q->Val,&Xf);
GetDouble (&Q->Next->Val,&Yf);
*X = Xf * T[0][0] + Yf * T[0][1] + T[0][2];
*Y = Xf * T[1][0] + Yf * T[1][1] + T[1][2];
}
}
private void DrawText (P,T,Color)
register ListPtr P;
Transform T;
int Color;
{
char Buf[256];
CharPtr U;
int S[2][3];
int i,j,N3;
double Size;
boolean Center;
if (P!=NULL) {
switch (P->Val.Tag) {
default: return;
case STRING:
CPInit (&U,&P->Val.List);
(void) CPRead (&U,Buf,256);
break;
case BOOLEAN:
(void) sprintf (Buf,P->Val.Bool ? "t" : "f");
break;
case INT:
(void) sprintf (Buf,"%ld",P->Val.Int);
break;
case FLOAT:
(void) sprintf (Buf,"%g",P->Val.Float);
break;
}
Size = 1.0;
Center = 0;
if (NULL != (P=P->Next)) {
GetDouble (&P->Val,&Size);
if (NULL != (P=P->Next) && P->Val.Tag == STRING &&
!StrComp (P->Val.String,SCenter)) {
Center = 1;
N3 = 3*strlen (Buf);
}
}
Size /= 6.0;
for (i=0; i<2; i++)
for (j=0; j<3; j++)
S[i][j] = (int) ((j<2 ? Size * T[i][j] : T[i][j]) * (1 << 10));
if (Center) {
S[0][2] -= N3 * S[0][0] + 3 * S[0][1];
S[1][2] -= N3 * S[1][0] + 3 * S[1][1];
}
ConSymbol (Buf,S);
}
}
private void PolyLine (P,T,Color)
register ListPtr P;
Transform T;
int Color;
{
int X,Y;
VI_Color (!Color);
if (P != NULL) {
GetCoor (P,T,&X,&Y);
VI_AMove (X,Y);
while (NULL != (P=P->Next)) {
GetCoor (P,T,&X,&Y);
VI_ALine (X,Y);
}
}
}
boolean GetTrans (X,T)
ObjectPtr X;
Transform T;
{
register ListPtr P,Q;
register int i,j;
if (!PairTest (X,1<<LIST,1<<LIST)) return 0;
else {
P = X->List;
for (i=0; i<2; P=P->Next,i++) {
Q = P->Val.List;
for (j=0; j<3; Q=Q->Next,j++) {
if (Q == NULL) return 0;
if (GetDouble (&Q->Val,&T[i][j])) return 0;
}
}
return 1;
}
}
private void DrawTrans (P,T,Color)
register ListPtr P;
Transform T;
int Color;
{
Transform R,S;
int i,j;
if (P!=NULL)
if (!GetTrans (&P->Val,R))
GraphError (&P->Val,"DrawTrans: not a transform");
else {
for (i=0; i<2; i++) {
for (j=0; j<3; j++)
S[i][j] = T[i][0] * R[0][j] + T[i][1] * R[1][j];
S[i][2] += T[i][2];
}
}
if (NULL != (P=P->Next)) DrOb (&P->Val,S,Color);
}
private void DrawColor (P,T)
register ListPtr P;
Transform T;
{
int Color;
if (P!=NULL) {
switch (P->Val.Tag) {
case INT:
Color = P->Val.Int;
break;
case FLOAT:
Color = (int) (P->Val.Float + 0.5);
break;
default:
GraphError (&P->Val,"DrawColor: not a color");
}
if (P->Next != NULL) DrOb (&P->Next->Val,T,Color);
}
}
/***************************** end of G_draw.c *******************************/
SHAR_EOF
if test -f 'interp/Makefile'
then
echo shar: over-writing existing file "'interp/Makefile'"
fi
cat << \SHAR_EOF > 'interp/Makefile'
#
#****** Makefile ******************************************************#
#** **#
#** 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, 1986 **#
#** **#
#** Principal Investigators: Prof. R. H. Campbell **#
#** Prof. W. J. Kubitz **#
#** **#
#** **#
#**------------------------------------------------------------------**#
#** (C) Copyright 1987 University of Illinois Board of Trustees **#
#** All Rights Reserved. **#
#**********************************************************************#
# makefile for ifp interpreter
#
# This makefile is set up for compiling the IFP interpreter on plain
# vanilla UNIX boxes. It has been tested on VAXen, Pyramids, and RT/PCs.
#
# Other machines may required modifications to both this Makefile and
# the header file struct.h. You should first look at the beginning of
# struct.h, which contains the machine-dependent preprocessor variables.
# for VAXen, Pyramids, RT/PC and other plain vanilla UNIX boxes.
CFLAGS= -O
# Definitions for cross-compiling a MS-DOS version of IFP with the
# XENIX system on a PC/AT. The OPSYS variable in struct.h must
# also be changed from UNIX to MSDOS.
#AOBJS=dos.o
#CFLAGS= -Ml -DPCAT -K -O -dos -F 24000
#LFLAGS= -DPCAT
# Definitions for compiling a XENIX version of IFP on a PC/AT.
#CFLAGS= -DPCAT -Ml -O
#LFLAGS= -DPCAT
# Definitions are for compiling IFP on a CRAY X-MP under CTSS
#CFLAGS =
# Definitions RT/PC with graphics
#CFLAGS= -DCOMPILE -DGRAPHICS
#LFLAGS= -DCOMPILE -DGRAPHICS
#GSRC = G_draw.c G_confont.c
#GOBJS= G_draw.o G_confont.o
#LIBS= -laed
#------------------------------------------------------------------------------
IHDRS= cache.h inob.h node.h stats.h string.h struct.h umax.h
ISRC= F_arith.c F_pred.c F_misc.c F_seq.c F_ss.c F_subseq.c F_string.c\
alloc.c apply.c binio.c cache.c convert.c command.c debug.c\
error.c except.c file.c forms.c infun.c inimport.c inob.c list.c\
main.c node.c outfun.c outob.c stats.c string.c trace.c\
xdef.c
# Miscellaneous source files for special versions of interpreter
VSRC= dos.s G_draw.c G_confont.c
IOBJS= F_arith.o F_pred.o F_misc.o F_seq.o F_ss.o F_subseq.o F_string.o \
alloc.o apply.o binio.o cache.o convert.o command.o debug.o \
error.o except.o file.o forms.o infun.o inimport.o inob.o list.o \
main.o node.o outfun.o outob.o stats.o string.o trace.o \
xdef.o
#-----------------------------------------------------------------------------
ifp: $(IOBJS) $(AOBJS) $(GOBJS)
cc $(CFLAGS) $(AOBJS) $(GOBJS) $(IOBJS) $(LIBS) -lm -o ifp
# strip ifp
echo "ifp recompiled"
$(IOBJS): struct.h
G_confont.o: G_confont.c #console vector font
G_draw.o: struct.h G_draw.c #optional graphics
F_misc.o: node.h F_misc.c #F_* = primitive functions
F_string.o: node.h
alloc.o: node.h umax.h
apply.o: cache.h node.h stats.h
cache.o: cache.h
command.o: cache.h inob.h node.h stats.h umax.h
error.o: inob.h
file.o: inob.h node.h umax.h
forms.o: node.h stats.h umax.h
infun.o: inob.h node.h
inimport.o: inob.h node.h
inob.o: inob.h node.h
list.o: node.h stats.h umax.h
main.o: cache.h stats.h umax.h
node.o: node.h umax.h
outfun.o: string.h node.h
outob.o: string.h
stats.o: stats.h
string.o: string.h umax.h
xdef.o: node.h
#------------------------------------------------------------------------------
lint: $(IHDRS) $(ISRC) $(GSRC)
lint -u -h $(LFLAGS) $(ISRC) $(GSRC) >lint.err
dos: ifp
doscp -r ifp A:/ifp.exe
SHAR_EOF
if test -f 'interp/README'
then
echo shar: over-writing existing file "'interp/README'"
fi
cat << \SHAR_EOF > 'interp/README'
See the Makefile for how to compile IFP.
SHAR_EOF
if test -f 'interp/alloc.c'
then
echo shar: over-writing existing file "'interp/alloc.c'"
fi
cat << \SHAR_EOF > 'interp/alloc.c'
/****** alloc.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 2, 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"
/*
* Storage is divided into 4 classes:
*
* free storage
* list cells
* strings
* nodes descriptors
*
* Storage is allocated by pages.
*/
/*
* Currently, the page table and descriptors don't do anything,
* so we define them out of existence. Their intended use t is to allow
* reclamation of pages.
*/
#define PAGETABLE 0
#if PAGETABLE
#define FreePage 0 /* Defines for PageType field of PageDesc structure */
#define ListPage 1
#define StrPage 2
#define NodePage 3
typedef struct {
char PageType; /* Type of page. See defines above */
char *PageBase; /* Base address of page */
unsigned PageLen; /* Length of page in bytes */
} PageDesc;
PageDesc PageTable [MaxPages];
int PageCount=0;
#endif /* PAGETABLE */
#if (OPSYS==UNIX || OPSYS==CTSS)
#define MaxPages 256
#define SizeListPage (512 * sizeof (ListCell))
#define SizeStrPage (512 * sizeof (StrCell))
#define SizeNodePage (256 * sizeof (NodeDesc))
#endif
#if OPSYS==MSDOS
#define MaxPages 128
#define SizeListPage (256 * sizeof (ListCell))
#define SizeStrPage (256 * sizeof (StrCell))
#define SizeNodePage (128 * sizeof (NodeDesc))
#endif
/*
* AllocListPage
*
* Returns pointer to list of cells in new list page.
* Each cell's value is initialized to NULL.
*
* NULL is returned if there are no more list pages available.
*/
ListPtr AllocListPage ()
{
#if PAGETABLE
register PageDesc *PDp;
#endif
register ListPtr P;
register int K;
if (Debug & DebugAlloc) {
LineWait ();
printf ("AllocListPage ()\n");
LineSignal ();
}
#if PAGETABLE
if (PageCount >= MaxPages) return NULL;
#endif
P = (ListPtr) malloc (SizeListPage);
if (P == NULL) return NULL;
#if PAGETABLE
PDp = PageTable + PageCount++;
PDp->PageType = ListPage;
PDp->PageLen = SizeListPage;
PDp->PageBase = (char *) P;
#endif
P->Next = NULL;
for (K = SizeListPage/(sizeof (ListCell));;) {
P->LRef = LRefOne;
P->Val.Tag = BOTTOM;
if (!--K) break;
P++;
P->Next = P-1;
}
return P;
}
StrPtr AllocStrPage ()
{
#if PAGETABLE
register PageDesc *PDp;
#endif
register StrPtr P;
register int K;
if (Debug & DebugAlloc) printf ("AllocStrPage ()\n");
#if PAGETABLE
if (PageCount >= MaxPages) return NULL;
#endif
P = (StrPtr) malloc (SizeStrPage);
if (P == NULL) return NULL;
#if PAGETABLE
PDp = PageTable + PageCount++;
PDp->PageType = StrPage;
PDp->PageLen = SizeStrPage;
PDp->PageBase = (char *) P;
PDp = PageTable + PageCount++;
#endif
P->StrNext = NULL;
for (K = SizeStrPage/(sizeof (StrCell));;) {
P->StrChar [0] = '\0';
P->SRef = 1;
if (!--K) break;
P++;
P->StrNext = P-1;
}
return P;
}
/*
* AllocNodePage
*
* Returns pointer to list of nodes in new node page.
*/
NodePtr AllocNodePage ()
{
#if PAGETABLE
register PageDesc *PDp;
#endif
register NodePtr P;
register int K;
if (Debug & DebugAlloc) printf ("AllocNodePage ()\n");
#if PAGETABLE
if (PageCount >= MaxPages) return NULL;
#endif
P = (NodePtr) malloc (SizeNodePage);
if (P == NULL) return NULL;
#if PAGETABLE
PDp = PageTable + PageCount++;
PDp->PageType = NodePage;
PDp->PageLen = SizeNodePage;
PDp->PageBase = (char *) P;
PDp = PageTable + PageCount++;
#endif
P->NodeSib = NULL;
for (K = SizeNodePage/(sizeof (NodeDesc));;) {
P->NRef = 1;
if (!--K) break;
P++;
P->NodeSib = P-1;
};
return P;
}
SHAR_EOF
if test -f 'interp/apply.c'
then
echo shar: over-writing existing file "'interp/apply.c'"
fi
cat << \SHAR_EOF > 'interp/apply.c'
/****** apply.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. **/
/**********************************************************************/
#include <stdio.h>
#include "struct.h"
#include "node.h"
#include "stats.h"
#include "cache.h"
/*
* ApplyCheck
*
* Check if a function definition is internally consistent
*/
boolean ApplyCheck (F)
ObjectPtr F;
{
register ListPtr P;
ObjectPtr D;
switch (F->Tag) {
case LIST:
if ((P = F->List) == NULL) return 0;
else {
switch (P->Val.Tag) {
case NODE: return 1;
case LIST: /* unlinked form */
LinkPath (&P->Val,DEF);
if (P->Val.Tag==NODE && P->Val.Node->NodeType==DEF) {
D = &P->Val.Node->NodeData.NodeDef.DefCode;
if (D->Code.CodeParam >= 0 &&
D->Code.CodeParam != ListLength (P->Next)) {
DefError ((NodePtr) NULL,F,
"wrong number of parameters");
return 0;
}
} else {
DefError ((NodePtr) NULL,F,"not a PFO");
return 0;
}
if (P->Val.Node == FormTable[NODE_Sel].FormNode)
return P->Next->Val.Tag == INT;
else if (P->Val.Node == FormTable[NODE_C].FormNode)
return (P=P->Next) == NULL || P->Next == NULL;
else if (P->Val.Node == FormTable[NODE_Out].FormNode)
return 1;
#if FETCH
else if (P->Val.Node == FormTable[NODE_Fetch].FormNode)
return 1;
#endif
else {
while ((P=P->Next) != NULL)
if (!ApplyCheck (&P->Val)) return 0;
return 1;
}
case STRING: /* unlinked function */
LinkPath (F,DEF);
if (F->Tag != NODE || F->Node->NodeType != DEF) {
DefError ((NodePtr) NULL,F,"not a definition");
return 0;
} else return 1;
default:
IntError ("ApplyCheck: illegal P->Val.Tag value");
return 0;
}
}
case NODE: return 1; /* Linked function */
#if XDEF
/* We should check that the string is a functional variable */
case STRING: return 1;
#endif
default:
DefError ((NodePtr) NULL,F,"Invalid function/form definition");
return 0;
}
}
/*----------------------------------------------------------------------*/
extern int TraceIndent; /* Indentation level of trace */
boolean Trace = 0; /* Print function trace if set */
#define ENTER "ENTER> "
#define EXIT "EXIT> "
/*
* ApplyFun points to node whenever a compiled function is being applied.
* It is undefined at all other times.
* It is undefined when running multithread.
*/
NodePtr ApplyFun;
/*
* Apply
*
* Apply function *F to argument *InOut. Put result in *InOut.
* *F is linked if it was unlinked.
*
* There are five possible representations for the function:
*
* <string ...> Unlinked function
* node Linked function
* <<string ...> ...> Unlinked PFO
* <node ...> Linked PFO
* string Functional variable
*
* Input
* *InOut = function argument
* *F = function
*
* Output
* *InOut = result of applying F to InOut
* *F = linked function
*
* Note: There is some weird casting for the linked form case.
* This is merely to avoid putting another pointer on the stack,
* which we want to avoid since that case is recursive.
*/
void Apply (InOut,F)
ObjectPtr InOut;
register ObjectPtr F;
{
extern void PrintTrace ();
register ListPtr P;
if (SysStop) {
RepTag (InOut,BOTTOM);
return;
}
#if OPSYS==MSDOS
StackCheck (); /* Check for stack overflow or interrupt */
#endif
Stat (StatApply (InOut)); /* Collect "apply()" statistics */
switch (F->Tag) {
case LIST:
if ((P=F->List)->Val.Tag == NODE) {
if (Trace) PrintTrace (F,InOut,ENTER); /* linked PFO */
TraceIndent++;
P = (ListPtr) P->Val.Node;
#define Fn ((NodePtr) P)->NodeData.NodeDef.DefCode
if (Fn.Tag == CODE)
(*Fn.Code.CodePtr) (InOut,F->List->Next);
#undef Fn
else
DefError ((NodePtr) NULL,&F->List->Val,
"No compiled def for form");
TraceIndent--;
if (Trace || InOut->Tag==BOTTOM) PrintTrace (F,InOut,EXIT);
} else if (P->Val.Tag == STRING) { /* unlinked function */
LinkPath (F,DEF);
if (F->Tag==NODE && F->Node->NodeType==DEF)
goto FunApply;
else {
DefError ((NodePtr) NULL,F,"not a definition");
RepTag (InOut,BOTTOM);
}
} else {
printf ("INTERNAL ERROR in Apply: illegal P->Val = ");
OutObject (F);
printf ("\n");
}
break;
FunApply:
case NODE: { /* linked function */
int SaveTrace;
/* Evaluate linked function */
P = (ListPtr) &(ApplyFun=F->Node)->NodeData.NodeDef;
#define D ((DefPtr) P)
SaveTrace = Trace;
Trace = D->DefFlags & TRACE;
if (Trace|SaveTrace) PrintTrace (F,InOut,ENTER);
TraceIndent++;
if (D->DefCode.Tag != CODE) {
if (D->DefCode.Tag == BOTTOM) ReadDef ((NodePtr) NULL,F);
if (D->DefCode.Tag != BOTTOM)
CheckCache (&Cache[CacheUser],Apply (InOut,&D->DefCode))
else {
DefError ((NodePtr) NULL,F,"no source definition");
RepTag (InOut,BOTTOM);
}
} else
CheckCache (&Cache[CachePrim],
(*D->DefCode.Code.CodePtr)
(InOut,D->DefCode.Code.CodeParam));
#undef D
TraceIndent--;
if (Trace|SaveTrace || InOut->Tag == BOTTOM)
PrintTrace (F,InOut,EXIT);
Trace = SaveTrace;
return;
}
#if XDEF
case STRING: {
extern ListPtr Environment;
P = Environment;
for (P=Environment; P!=NULL; P=P->Next->Next)
if (P->Val.String == F->String) {
RepObject (InOut,&P->Next->Val);
return;
}
IntError ("Apply: variable not in environment\n");
return;
}
#endif
default:
DefError ((NodePtr) NULL,F,"Invalid function/form definition");
RepTag (InOut,BOTTOM);
return;
}
}
#if REFCHECK || UMAX
/*
* RefCheck
*
* Check if all references required to apply function *F are defined and
* resolved.
*
* *F is linked if it was unlinked.
*
* See function 'apply' above for the function representations
*
* Input
* Caller = &node of calling function, NULL for top level
* *F = function
*
* Output
* *F = linked function
* result = 1 iff all references resolved, 0 otherwise.
*
* Note: There is some weird casting for the linked form case.
* This is merely to avoid putting another pointer on the stack,
* which we want to avoid since that case is recursive.
*/
boolean RefCheck (Caller,F)
NodePtr Caller;
register ObjectPtr F;
{
register ListPtr P;
if (SysStop) return 0;
#if OPSYS==MSDOS
StackCheck ();
#endif
switch (F->Tag) {
case LIST:
P = F->List;
if (P == NULL) {
IntError ("RefCheck: empty list");
return 0;
} else {
switch (P->Val.Tag) {
case LIST: /* unlinked form */
LinkPath (&P->Val,DEF);
if (P->Val.Tag!=NODE || P->Val.Node->NodeType!=DEF) {
DefError (Caller,&P->Val,"not a form");
return 0;
} /* else drop down to case NODE */
case NODE: { /* linked form */
register NodePtr Fn;
if ((Fn = P->Val.Node) == NULL) {
IntError ("RefCheck: empty NodePtr");
return 0;
} else if (Fn->NodeData.NodeDef.DefCode.Tag != CODE) {
DefError (Caller,&F->List->Val,
"No compiled def for form");
return 0;
} else {
int OK = 1;
FormEntry *T;
for (T=FormTable; T<ArrayEnd(FormTable); T++)
if (T->FormNode == Fn) break;
switch (T-FormTable) {
case NODE_Comp:
case NODE_Cons:
case NODE_Each:
case NODE_Filter:
case NODE_If:
case NODE_RInsert:
case NODE_While:
for (P = F->List; (P=P->Next) != NULL; )
OK &= RefCheck (Caller,&P->Val);
}
return OK;
}
}
case STRING: /* unlinked function */
LinkPath (F,DEF);
if (F->Tag != NODE || F->Node->NodeType != DEF) {
DefError (Caller,F,"Not a function");
return 0;
} else break; /* down to case NODE */
default:
IntError ("Apply: illegal P->Val.Tag value");
return 0;
}
}
case NODE: {
/* Evaluate linked function */
boolean OK=1;
P = (ListPtr) &F->Node->NodeData.NodeDef;
#define D ((DefPtr) P)
if (D->DefCode.Tag != CODE) {
if (!(D->DefFlags & RESOLVED)) {
D->DefFlags |= RESOLVED;
if (D->DefCode.Tag == BOTTOM) ReadDef (Caller,F);
if (D->DefCode.Tag != BOTTOM)
OK = RefCheck (F->Node,&D->DefCode);
else {
DefError (Caller,F,"no source definition");
OK = 0;
}
D->DefFlags &= ~RESOLVED;
}
}
#undef D
return OK;
}
default:
DefError (Caller,F,"Invalid function/form definition");
return 0;
}
}
#endif /* REFCHECK */
/******************************* end of apply.c *******************************/
SHAR_EOF
if test -f 'interp/binio.c'
then
echo shar: over-writing existing file "'interp/binio.c'"
fi
cat << \SHAR_EOF > 'interp/binio.c'
/****** binio.c *******************************************************/
/** **/
/** University of Illinois **/
/** **/
/** Department of Computer Science **/
/** **/
/** Tool: IFP Version: 0.5 **/
/** **/
/** Author: Arch D. Robison Date: May 12, 1986 **/
/** **/
/** Revised by: Arch D. Robison Date: June 20, 1986 **/
/** **/
/** Principal Investigators: Prof. R. H. Campbell **/
/** Prof. W. J. Kubitz **/
/** **/
/** **/
/**------------------------------------------------------------------**/
/** (C) Copyright 1987 University of Illinois Board of Trustees **/
/** All Rights Reserved. **/
/**********************************************************************/
/******************************* end of binio.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.#< to h