brachman@ubc-cs.UUCP (Barry Brachman) (09/15/86)
This is GProlog 1.5 for the SUN 2 and SUN 3 (4.2BSD Releases 2.3/3.0).
Gprolog lets you call routines in the SUNCORE library from C-Prolog.
The distribution includes:
- diffs to be applied to C-Prolog 1.5
- code that implements the interface between Prolog and SUNCORE
- a user's manual
- three puny demos
You'll need:
- Larry Wall's (great!) patch program (or a lot of patience)
- the unaltered source to C-Prolog version 1.5
- a SUN 2 or SUN 3 with a console (i.e., bit mapped display),
the SUNCORE library and preferably suntools (does everybody get
SUNCORE and suntools?)
To get things rolling:
1) Make a copy of the original C-Prolog source in a new directory
2) cd to the new directory
3) I keep all the C-Prolog boot stuff in a separate directory so:
mkdir pl; mv *.pl pl
4) feed the sharfile below to /bin/sh
5) run 'patch < diffs.1' to apply the diffs to C-Prolog
6) cd pl
7) run 'patch < ../diffs.2' to apply the diffs to the .pl files
8) Edit the makefile; set up the paths for your site
9) make install
A) There are three demos, one of which runs outside of suntools.
Try the first demo. Crank up gprolog, then utter the following:
['martini.bw2dd'].
init.
demo.
<... be impressed for a few seconds :-) ...>
halt.
The other two demos, 'martini.pixwindd' and 'c_curve' may be
run similarly when you start up gprolog inside of a graphics tool
subwindow.
Miscellaneous:
1) Since we don't have a colour monitor here, gprolog has not been
configured for colour. It should simply be a matter of editing
gr1.c (at the very end of the file) and adding a vwsurf struct and
an entry to the Surface struct.
2) You'll want to make a few minor changes to the documentation file
(gprolog.nr) to reflect your local setup.
3) I have a LaTeX version of the documentation but I figure everyone
will have [nt]roff. I also have a version of gprolog corresponding
to C-Prolog 1.4.
4) There may be some stuff in the SUNCORE library for the SUN 3 that
I've not added to gprolog. I pretty much just recompiled
the SUN 2 version on the SUN 3.
5) I haven't the faintest idea where you can get C-Prolog, what the cost
is, or what the licensing arrangements are.
6) gprolog 1.4 has been extensively tested on the SUN 2/50. gprolog 1.5
has been tested, perhaps less extensively, on both the SUN 2/50 and
the SUN 3/75. Several functions for testing gprolog remain (if you
do a #list. you'll see them), just in case.
7) Should you have any bug reports or make any improvements I would
appreciate it if you would send them to me instead of posting them
to the net.
ENJOY!
-----
Barry Brachman
Dept. of Computer Science
Univ. of British Columbia
Vancouver, B.C. V6T 1W5
.. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
brachman@cs.ubc.cdn
brachman%ubc.csnet@csnet-relay.arpa
brachman@ubc.csnet
----- CUT HERE ----- CUT HERE ----- CUT HERE ----- CUT HERE ----- CUT HERE
: This is a shar archive. Extract with sh, not csh.
: This archive ends with exit, so do not worry about trailing junk.
if test -f 'demo'
then rm 'demo'
fi
if test -d 'demo'
then :
else echo 'Making demo/'
mkdir 'demo'
fi
chmod 'u=rwx,g=rx,o=rx' 'demo'
echo 'Extracting demo/c_curve'
sed 's/^X//' > demo/c_curve << '+ END-OF-FILE demo/c_curve'
X
X/* C curve */
X
Xinit :- #def(basic,BASIC), #def(noinput,NOINPUT), #def(twod,TWOD),
X #initialize_core(BASIC,NOINPUT,TWOD),
X #def(false,FALSE),
X #initialize_view_surface(pixwindd,FALSE),
X #select_view_surface(pixwindd),
X #set_viewport_2(0.125,0.875,0.125,0.75),
X #set_window(-80.0,80.0,-50.0,80.0).
X
Xdemo :- #create_temporary_segment,
X #move_abs_2(10.0,10.0),
X c_curve(50.0,0.4),
X #close_temporary_segment,
X label("C-Curve").
X
Xlabel(Label) :- #create_temporary_segment,
X #move_abs_2(20.0,-20.0),
X #text(Label),
X #close_temporary_segment.
Xlabel(X) :- fail.
X
Xc_curve(Length,Angle) :- Length < 3.0, !, plotline(Length,Angle).
Xc_curve(Length,Angle) :- #def(pi,PI), L is Length / (PI / 2),
X A1 is Angle + PI / 4.0,
X A2 is Angle - PI / 4.0,
X c_curve(L,A1),
X c_curve(L,A2).
X
Xplotline(Length,Angle) :- X is Length * cos(Angle),
X Y is Length * sin(Angle),
X #line_rel_2(X,Y).
X
Xdone :- #deselect_view_surface(pixwindd),
X #terminate_core.
X
+ END-OF-FILE demo/c_curve
chmod 'u=rw,g=r,o=r' 'demo/c_curve'
echo ' -rw-r--r-- 1 brachman 949 Sep 13 16:26 demo/c_curve (as sent)'
echo -n ' '
/bin/ls -l demo/c_curve
echo 'Extracting demo/martini.bw2dd'
sed 's/^X//' > demo/martini.bw2dd << '+ END-OF-FILE demo/martini.bw2dd'
Xinit :- #def(basic,BASIC), #def(noinput,NOINPUT), #def(twod,TWOD),
X #initialize_core(BASIC,NOINPUT,TWOD).
X
Xdemo :- #def(false,FALSE),
X #initialize_view_surface(bw2dd,FALSE),
X #select_view_surface(bw2dd),
X #set_viewport_2(0.125,0.875,0.125,0.75),
X #set_window(-50.0,50.0,-10.0,80.0),
X #create_temporary_segment,
X #move_abs_2(0.0,0.0),
X glassdx(X), glassdy(Y),
X #polyline_rel_2(X,Y,9),
X #move_rel_2(-12.0,33.0),
X #line_rel_2(24.0,0.0),
X #close_temporary_segment.
X
Xdone :- #deselect_view_surface(bw2dd),
X #terminate_core.
X
Xglassdx([-10.0,9.0,0.0,-14.0,30.0,-14.0,0.0,9.0,-10.0]).
X
Xglassdy([0.0,1.0,19.0,15.0,0.0,-15.0,-19.0,-1.0,0.0]).
+ END-OF-FILE demo/martini.bw2dd
chmod 'u=rw,g=r,o=r' 'demo/martini.bw2dd'
echo ' -rw-r--r-- 1 brachman 633 Sep 13 16:26 demo/martini.bw2dd (as sent)'
echo -n ' '
/bin/ls -l demo/martini.bw2dd
echo 'Extracting demo/martini.pixwin'
sed 's/^X//' > demo/martini.pixwin << '+ END-OF-FILE demo/martini.pixwin'
Xinit :- #def(basic,BASIC), #def(noinput,NOINPUT), #def(twod,TWOD),
X #initialize_core(BASIC,NOINPUT,TWOD).
X
Xdemo :- #def(false,FALSE),
X #initialize_view_surface(pixwindd,FALSE),
X #select_view_surface(pixwindd),
X #set_viewport_2(0.125,0.875,0.125,0.75),
X #set_window(-50.0,50.0,-10.0,80.0),
X #create_temporary_segment,
X #move_abs_2(0.0,0.0),
X glassdx(X), glassdy(Y),
X #polyline_rel_2(X,Y,9),
X #move_rel_2(-12.0,33.0),
X #line_rel_2(24.0,0.0),
X #close_temporary_segment.
X
Xdone :- #deselect_view_surface(pixwindd),
X #terminate_core.
X
Xglassdx([-10.0,9.0,0.0,-14.0,30.0,-14.0,0.0,9.0,-10.0]).
X
Xglassdy([0.0,1.0,19.0,15.0,0.0,-15.0,-19.0,-1.0,0.0]).
+ END-OF-FILE demo/martini.pixwin
chmod 'u=rw,g=r,o=r' 'demo/martini.pixwin'
echo ' -rw-r--r-- 1 brachman 642 Sep 13 16:26 demo/martini.pixwin (as sent)'
echo -n ' '
/bin/ls -l demo/martini.pixwin
echo 'Extracting diffs.1'
sed 's/^X//' > diffs.1 << '+ END-OF-FILE diffs.1'
X
XIndex: arith.c
X28a29,30
X> static int sawfloat; /* Convert results to integer conditionally */
X>
X38a41,45
X> #ifdef GRAPHICS
X> extern double fabs(),ceil();
X> extern int abs();
X> #endif
X>
X57c64,71
X< ffail
X---
X> #ifdef GRAPHICS
X> ffail, /* abs/fabs */
X> ffail, /* float */
X> ffail, /* int */
X> ceil
X> #else
X> ffail
X> #endif
X76,77c90,99
X< SOMETIMES, /* 15 1 SPARE */
X< ALWAYS, /* 16 - UNUSABLE */
X---
X> #ifdef GRAPHICS
X> SOMETIMES, /* 15 1 abs/fabs */
X> ALWAYS, /* 16 1 float */
X> SOMETIMES, /* 17 1 int */
X> SOMETIMES, /* 18 1 ceil */
X> ALWAYS, /* 19 - UNUSABLE */
X> #else
X> SOMETIMES, /* 15 1 SPARE */
X> ALWAYS, /* 16 - UNUSABLE */
X> #endif
X130a153,155
X> #ifdef GRAPHICS
X> sawfloat++;
X> #endif
X201a227,230
X> #ifdef GRAPHICS
X> if (fl == ALWAYS)
X> sawfloat++;
X> #endif
X211a241,261
X> #ifdef GRAPHICS
X> case FLOAT:
X> break;
X> case INT:
X> if (typ) {
X> if (v.AsFloat >= 0.0)
X> v.AsInt = (int)(v.AsFloat + 0.5);
X> else
X> v.AsInt = (int)(v.AsFloat - 0.5);
X> v.Float = FALSE;
X> if (sawfloat)
X> sawfloat--;
X> }
X> break;
X> case ABS:
X> if (typ)
X> v.AsFloat = fabs(v.AsFloat);
X> else
X> v.AsInt = abs(v.AsInt);
X> break;
X> #endif
X224c274,278
X< int fl = floatable[op+16], typ;
X---
X> #ifdef GRAPHICS
X> int fl = floatable[op+19], typ;
X> #else
X> int fl = floatable[op+16], typ;
X> #endif
X240a295,298
X> #ifdef GRAPHICS
X> if (fl == ALWAYS)
X> sawfloat++;
X> #endif
X305c363
X< r.Float = !Narrow(r.AsFloat, &(r.AsInt));
X---
X> r.Float = !Narrow_to_int(r.AsFloat, &(r.AsInt));
X318a377
X> sawfloat = 0; /* BJB */
X320a380,381
X> if (r.Float && sawfloat == 0) /* BJB */
X> r.Float = !Narrow_to_int(r.AsFloat, &(r.AsInt));
X322,323d382
X< r.Float = !Narrow(r.AsFloat, &(r.AsInt));
X< if (r.Float)
X335a395
X> sawfloat = 0; /* BJB */
X337a398,399
X> if (r.Float && sawfloat == 0) /* BJB */
X> r.Float = !Narrow_to_int(r.AsFloat, &(r.AsInt));
X339,340d400
X< r.Float = !Narrow(r.AsFloat, &(r.AsInt));
X< if (r.Float)
X352a413
X> sawfloat = 0; /* BJB */
X355a417,418
X> if (r.Float && sawfloat == 0) /* BJB */
X> r.Float = !Narrow_to_int(r.AsFloat, &(r.AsInt));
X357,358d419
X< r.Float = !Narrow(r.AsFloat, &(r.AsInt));
X< if (r.Float)
X486a548,550
X> #ifdef GRAPHICS
X> return FALSE;
X> #else
X490a555
X> #endif
X492a558,580
X> #ifdef GRAPHICS
X> int
X> Narrow_to_int(f,i)
X> double f;
X> int *i;
X> {
X> register int k;
X>
X> if (f < MinInt || f > MaxInt) return FALSE;
X> if ((double)(k = (int)f) != f) return FALSE;
X> *i = k;
X> return TRUE;
X> }
X> #else
X> int
X> Narrow_to_int(f,i)
X> double f;
X> int *i;
X> {
X> return(Narrow(f,i));
X> }
X> #endif
X>
X497c585
X< if (v->Float) v->Float = !Narrow(v->AsFloat, &(v->AsInt));
X---
X> if (v->Float) v->Float = !Narrow_to_int(v->AsFloat, &(v->AsInt));
X
XIndex: arithop.h
X47a48,54
X> #ifdef GRAPHICS
X> #define ABS 15
X> #define FLOAT 16
X> #define INT 17
X> #define CEIL 18
X> #endif
X>
X
XIndex: bootcmd
X1c1
X< ['all.pl'].
X---
X> ['pl/grall.pl'].
X
XIndex: main.c
X1345a1346,1351
X> #ifdef GRAPHICS
X> case _unary+ABS:
X> case _unary+FLOAT:
X> case _unary+INT:
X> case _unary+CEIL:
X> #endif
X
XIndex: parms.c
X80a81,83
X> #ifdef GRAPHICS
X> char version[] = "C-Prolog version 1.5 + SunCore";
X> #else
X81a85
X> #endif
X
XIndex: rewrite.c
X205a206
X> #ifdef GRAPHICS
X206a208,236
X> int k;
X> char *p1,buf[256];
X> float num;
X>
X> num = XtrFloat(t);
X> sprintf(OutBuf,"%g",num);
X> if (index(OutBuf,'.') == 0) {
X> p1 = index(OutBuf,'e');
X> if (p1 == 0) {
X> k = strlen(OutBuf);
X> OutBuf[k] = '.';
X> OutBuf[k+1] = '0';
X> OutBuf[k+2] = '\0';
X> }
X> else {
X> k = p1 - OutBuf;
X> strncpy(buf,OutBuf,k);
X> buf[k] = '.';
X> buf[k+1] = '0';
X> strcpy(buf+k+2,p1);
X> PutString(buf);
X> return;
X> }
X> }
X> PutString(OutBuf);
X> return;
X> }
X> #else
X> if (IsFloat(t)) {
X209a240
X> #endif
X773a805,807
X> #ifdef GRAPHICS
X> int flag = 0;
X> #endif
X779a814,817
X> #ifdef GRAPHICS
X> if (chtyp[*t] == N)
X> flag = 1;
X> #endif
X794a833,838
X> #ifdef GRAPHICS
X> if (flag)
X> *p = ConsFloat(d);
X> else
X> if (Narrow_to_int(d,&i))
X> #else
X795a840
X> #endif
X
XOnly in gprolog1.5: gprolog.nr
XOnly in gprolog1.5: gr.h
XOnly in gprolog1.5: gr1.c
XOnly in gprolog1.5: gr2.c
XOnly in gprolog1.5: gr3.c
XOnly in gprolog1.5: makefile
XOnly in gprolog1.5: prtable.c
XOnly in gprolog1.5: pushargs.s
XOnly in gprolog1.5: demo/*
X
+ END-OF-FILE diffs.1
chmod 'u=rw,g=r,o=r' 'diffs.1'
echo ' -rw-r--r-- 1 brachman 4427 Sep 13 16:33 diffs.1 (as sent)'
echo -n ' '
/bin/ls -l diffs.1
echo 'Extracting diffs.2'
sed 's/^X//' > diffs.2 << '+ END-OF-FILE diffs.2'
X
XIndex: arith.pl
X83a84,88
X> $rename_op0(abs,1,$abs). % BJB for use with GRAPHICS extensions
X> $rename_op0(float,1,$float).
X> $rename_op0(int,1,$int).
X> $rename_op0(ceil,1,$ceil).
X>
X
XIndex: init.pl
X154a155,158
X> :-$sysflgs(abs(A),15). % BJB for use with GRAPHICS extensions
X> :-$sysflgs(float(A),16).
X> :-$sysflgs(int(A),17).
X> :-$sysflgs(ceil(A),18).
X184a189,192
X> $abs(A,X) :- 145. % BJB for use with GRAPHICS extensions
X> $float(A,X) :- 146.
X> $int(A,X) :- 147.
X> $ceil(A,X) :- 148.
X215a224
X> plgraphics(X) :- 120. % BJB for use with GRAPHICS extensions
X
XOnly in gprolog1.5/pl: grall.pl
XOnly in gprolog1.5/pl: graphics.pl
+ END-OF-FILE diffs.2
chmod 'u=rw,g=r,o=r' 'diffs.2'
echo ' -rw-r--r-- 1 brachman 636 Sep 13 16:04 diffs.2 (as sent)'
echo -n ' '
/bin/ls -l diffs.2
echo 'Extracting gprolog.nr'
sed 's/^X//' > gprolog.nr << '+ END-OF-FILE gprolog.nr'
X.ls 2
X.de hd
X'sp 2
X.tl ''- Page % -''
X'sp 2
X..
X.de fo
X'bp
X..
X.wh -6 fo
X.de NP
X.sp 2
X.ti +5
X..
X.de DW Day of the week into text
X.if \\n(dw-6 .if !\\n(dw-7 Saturday\ \c
X.if \\n(dw-5 .if !\\n(dw-6 Friday\ \c
X.if \\n(dw-4 .if !\\n(dw-5 Thursday\ \c
X.if \\n(dw-3 .if !\\n(dw-4 Wednesday\ \c
X.if \\n(dw-2 .if !\\n(dw-3 Tuesday\ \c
X.if \\n(dw-1 .if !\\n(dw-2 Monday\ \c
X.if \\n(dw .if !\\n(dw-1 Sunday\ \c
X..
X.de YR
X19\\n(yr
X..
X.de DY
X\\n(dy,\ \c
X..
X.de MO Month of the year into text
X.if \\n(mo-11 .if !\\n(mo-12 December\ \c
X.if \\n(mo-10 .if !\\n(mo-11 November\ \c
X.if \\n(mo-9 .if !\\n(mo-10 October\ \c
X.if \\n(mo-8 .if !\\n(mo-9 September\ \c
X.if \\n(mo-7 .if !\\n(mo-8 August\ \c
X.if \\n(mo-6 .if !\\n(mo-7 July\ \c
X.if \\n(mo-5 .if !\\n(mo-6 June\ \c
X.if \\n(mo-4 .if !\\n(mo-5 May\ \c
X.if \\n(mo-3 .if !\\n(mo-4 April\ \c
X.if \\n(mo-2 .if !\\n(mo-3 March\ \c
X.if \\n(mo-1 .if !\\n(mo-2 February\ \c
X.if \\n(mo .if !\\n(mo-1 January\ \c
X..
X.de DT Print date: Month Day, Year
X.nf
X'MO
X'DY
X'YR
X.fi
X..
X.sp 10
X.ce 5
XGProlog Users Manual
X.sp 2
XBarry Brachman
X.sp 2
XDepartment of Computer Science
X.sp 2
XUniversity of British Columbia
X.sp 2
XVancouver, B.C., V6T 1W5
X.DT
X.bp 1
X.sp 2
X.ul 1
XINTRODUCTION
X.NP
XThis manual describes the modifications applied to
XC-Prolog [2] on the SUN workstation to allow calling of functions from
Xthe SunCore library [3].
X.wh 0 hd
XThe SunCore library is SUN Microsystems' implementation of the CORE
Xgraphics standard.
XDifferences between the enhanced C-Prolog interpreter
X(which we will refer to as GProlog) and standard C-Prolog will be explained.
X.NP
XC-Prolog is an interpreter for the Prolog language [1].
XIt is written in C and runs under UNIX 4.2 BSD.
XThe GProlog interpreter is a version of C-Prolog incorporating the
XSunCore library.
XAll but a few of the approximately 200 SunCore functions are
Xcurrently callable from GProlog.
XRoutines in the SunCore library are callable only from C or from FORTRAN-77.
XC-Prolog programs will run identically under GProlog, with the exception
Xof programs which rely on C-Prolog's conversion of results which
Xare real numbers into integers.
X(C-Prolog will unify 3 with 3.0
Xand convert 3.0 to 3 in arithmetic computations.)
XThe greeting message printed by GProlog identifies it so that the
Xuser is aware of the version of Prolog being used.
X.sp 2
X.ul 1
XStarting Up GProlog
X.NP
XIf the graphics capabilities of GProlog are to be used, the user
Xmust be signed on at the console; otherwise any terminal may be used.
XThe console is a monochrome bit-mapped display.
XGProlog may currently be used in conjunction with
Xeither the "bw1dd" viewing
Xsurface or the "pixwindd" viewing surface (there is no color display device
Xat UBC).
XThe former uses the entire display for both conversation with
Xthe interpreter and graphics output.
XThe latter viewing surface, which is used with the Suntools windowing
Xpackage [4], is recommended since separate text and graphics subwindows are
Xavailable: interaction with the interpreter does not disturb the
Xgraphics.
XGProlog may be started
Xafter a "GRAPHICS-TOOL" window has been created.
XGProlog may be found in "/usr2/brachman/bin/gprolog".
XNote that many operations on a window (e.g., moving it) destroy the
Xgraphics part of the window, although the text subwindow is preserved.
XTherefore the user should adjust the size of the subwindows before
Xdisplaying any graphics.
X.sp 2
X.ul 1
XGraphics Extensions
X.NP
XThe evaluable predicate 'plgraphics' is used to invoke a SunCore function.
XThe form of a call is:
X.sp 1
X.ti +10
Xplgraphics(<SunCore function name>)
X.sp 1
Xor
X.sp 1
X.ti +10
Xplgraphics(<SunCore function name>(<arg1>,...,<argn>))
X.sp 1
XFor convenience, a prefix operator has been built into the system:
X.sp 1
X.ti +10
X#<SunCore function name>
X.sp 1
Xor
X.sp 1
X.ti +10
X#<SunCore function name>(<arg1>,...,<argn>)
X.sp 1
XThe <SunCore function name> is any SunCore function which
Xappears in the SunCore User's Manual [3],
Xwith the exceptions listed below.
XFor example,
X.ti +10
X.sp 1
X#move_abs_2(0.0,0.0)
X.sp 1
Xwill call the SunCore function 'move_abs_2' with the two arguments.
X.NP
XArguments which are vectors in the SunCore documentation are
Xrepresented as lists in GProlog.
XData is returned to Prolog predicates through uninstantiated variables.
XIn the current implementation, when a value is returned the corresponding
Xargument in the Prolog predicate must be uninstantiated.
XFor example, the SunCore function 'polyline_rel_2',
Xwhich draws a sequence of line
Xsegments given their endpoints, would be called in this manner:
X.sp 1
X.in +10
X#polyline_rel_2([1.0,3.0,4.0,5.0],[1.0,2.0,3.0,4.0],4)
X.in -10
X.sp 1
Xor equivalently,
X.sp 1
X.in +10
XX = [1.0,3.0,4.0,5.0],
X.br
XY = [1.0,2.0,3.0,4.0],
X.br
X#polyline_rel_2(X,Y,4)
X.in -10
X.sp 1
XThe first argument to 'polyline_rel_2' is a list of the X coordinates,
Xthe second argument is a list of the Y coordinates, and the third
Xargument is the number of coordinate pairs.
X.NP
XThe function 'inquire_current_position_2', which returns the two-dimensional
Xworld coordinates of the current position, would be called with the
Xarguments uninstantiated:
X.sp 1
X.in +10
X#inquire_current_position_2(X,Y)
X.in -10
X.sp 1
XThe variable X will be unified with the X coordinate and Y will be unified
Xwith the Y coordinate.
XNote that since the SunCore documentation specifies that X and Y are
Xreal numbers, GProlog guarantees that the values will stay real.
X.NP
XA number of manifest constants used by SunCore appear in the include
Xfile "/usr/include/usercore.h".
XTo give the GProlog programmer access to these constants, they have
Xbeen made part of GProlog.
XThe value of a symbolic constant is obtained by a call of the form:
X.sp 1
X.ti +10
X#def(<symbolic name>,<value>)
X.sp 1
Xwhere <symbolic name> is a defined constant appearing in
Xthe SunCore User's Manual.
XNote that the <symbolic name> must be in lowercase even though it
Xappears in uppercase in the manual.
XFor example,
X.sp 1
X.ti +10
X#def(false,X)
X.sp 1
Xwill unify X with the value of the constant 'false'.
XThe second argument to 'def' should be an uninstantiated variable.
X.NP
XThe special function name 'list' may be used to list each SunCore
Xfunction in the system along with its arity.
XSince there are around 200 functions, the 'list' command tries to
Xprint the commands in a table with as many columns as possible.
XSeveral test functions, not for general use, are also part of GProlog.
X.NP
XThe GProlog function 'getenv(X, Y)' may be used to determine the value
Xof an environment variable.
XThe first argument, the name of the environment variable, is a string.
XThe second argument, an uninstantiated variable, is unified with the value
Xof the environment variable.
XThe function will fail if the environment variable is not found.
XFor example,
X.sp 1
X.ti +10
X#getenv("TERM", T)
X.sp 1
Xwill unify T with the name of the terminal being used.
X.NP
XSeveral of the SunCore functions have not been included in GProlog.
XThis is because they are more difficult to implement and also because
Xthey would not appear to be frequently used.
XThey could be added to GProlog in the future.
XThe following functions are not available:
X.sp 1
X.in +10
X.ls 1
Xset_world_coordinate_matrix_2
X.br
Xset_world_coordinate_matrix_3
X.br
Xset_viewing_parameters
X.br
Xinquire_viewing_parameters
X.br
Xinquire_world_coordinate_matrix_2
X.br
Xinquire_world_coordinate_matrix_3
X.br
Xinquire_inverse_coordinate_matrix
X.br
Xinquire_retained_segment_surfaces
X.br
Xput_raster
X.br
Xget_raster
X.br
Xsize_raster
X.br
Xallocate_raster
X.br
Xfree_raster
X.br
Xraster_to_file
X.br
Xfile_to_raster
X.br
Xset_primitive_attributes
X.br
Xinquire_primitive_attributes
X.br
Xawait_stroke_2
X.in -10
X.ls 2
X.NP
XA call to a SunCore routine requires that GProlog convert any
Xarguments from their Prolog representation to the representation
Xrequired by the C calling conventions.
XProlog list structures, for example, must be converted to
Xvectors where the elements are contiguous in memory.
XCalls to SunCore routines will fail
Xwithin the interface between GProlog and SunCore
Xif the number of arguments is incorrect or if the type of any
Xargument is incorrect.
XIn either case GProlog will display an appropriate diagnostic.
XIf the failure occurs within the SunCore routine itself
X(e.g., an argument is out-of-range), SunCore prints a message and the
Xpredicate fails.
X(Aside: construction of this interface routine was complicated by
Xthe absence of any documentation describing the data structures used
Xwithin C-Prolog.)
X.NP
XNote that the maximum length of a string passed to a SunCore
Xfunction is 255 characters.
X.sp 2
X.ul 1
XOther Differences
X.NP
XSeveral changes were made to C-Prolog
Xin addition to the modifications described above.
XGProlog does not
Xconvert floating point numbers to integers.
XThis is because the user would expect a vector of floating point numbers
Xto stay as floating point numbers.
XC-Prolog converts those that it
Xcan to integers.
XTherefore, GProlog will not unify 3 with 3.0.
XAlso, if any of the intermediate results during evaluation of the "is"
Xpredicate is a real, then the result is a real.
XThe exception to this is the new evaluable predicate "int" which always
Xreturns an integer value.
X.NP
XThe following table lists each numeric evaluable predicate and its associated
Xtype:
X.sp 1
X.in +10
X.ls 1
X.ul 1
XFunction/Operator Type of Result
X.sp 1
Xunary -,+ Same as operand
X.br
X\\ Always integer
X.br
Xexp,log,log10, Always real
X.br
Xsqrt " "
X.br
Xsin,cos,tan,asin,acos,atan " "
X.br
Xfloor,ceil Same as operand
X.br
Xabs Same as operand
X.br
Xint Always integer
X.br
Xfloat Always real
X.br
X+,-,* Integer if both operands are integers; otherwise real
X.br
X/ Always real
X.br
Xmod,/\\,\\/,<<,>>,// Always integer
X.br
X^ Always real
X.br
X.ls 2
X.in -10
X.NP
XFour (unary) numeric evaluable predicates have been added to GProlog:
X.sp 2
X.in +10
X.ls 1
Xabs - absolute value
X.br
Xint - rounds argument to nearest integer
X.br
Xfloat - converts argument to floating point
X.br
Xceil - ceiling function
X.sp 2
X.ls 2
X.in -10
X.NP
XFor example, the result of
X.sp 1
X.in +10
XX is 4 + 3.0.
X.sp 1
X.in -10
Xis X = 7.0.
XThe result of
X.sp 1
X.in +10
XX is cos(0).
X.sp 1
X.in -10
Xis X = 1.0.
X.sp 2
X.ul 1
XSome Errors in C-Prolog and its Documentation
X.NP
XThe following errors in the C-Prolog (and GProlog)
Xinterpreter and the C-Prolog documentation [2]
Xhave been observed:
X.in +10
X.sp 1
X1. C-Prolog will not accept
X'in +3
Xconsecutive plus or minus operators that
Xare not separated by space or by parentheses; e.g.,
XX is 0--1.
XWhen printed, however, the correct version is identical to
Xthe incorrect version; e.g.,
X"X = 0--1, Y is X." will not succeed while
X"X = 0-(-1), Y is X ." will succeed with X = 0--1 and Y = 1.
X'in -3
X.sp 1
X2. It is possible for C-Prolog to
X'in +3
Xenter a state where only a process
Xstop signal (default: control-z) allows the user to regain control.
XThe session is not recoverable.
XThe conditions under which this occurs are not yet known.
X'in -3
X.sp 1
X3. Referring to Section 5.2 of the manual,
X'in +3
Xgiven "X is 2*1.5.",
XC-Prolog should give a result of 3 (GProlog will give 3.0).
X'in -3
X.sp 1
X4. Referring to Section 5.2 of the manual,
X'in +3
X"expanded_exprs(Old,New)"
Xshould be replaced by "expand_exprs(Old,New)".
X'in -3
X.sp 1
X5. By interrupting GProlog while a SunCore
X'in +3
Xroutine is being executed,
Xthe user may damage the window in which GProlog is running.
XThis seems to be due to a locking mechanism which GProlog and SunCore
Xuse to communicate.
X.in -3
X.sp 1
X6. Single line type comments may be used.
X'in +3
XThey are preceded by a '%'.
X'in -3
X.in -10
X.sp 2
X.ul 1
XFurther Work
X.NP
XThe remaining SunCore routines should be implemented.
XAn on-line help facility for use with SunCore might be useful.
X.de hd
X'sp 4
X..
X.bp
X.ul 1
XReferences
X.sp 2
X1. Clocksin, W. F. and Mellish, C. S.,
X'in +4
X.ul 1
XProgramming in Prolog,
XSpringer-Verlag, 1981.
X.in -4
X.sp 1
X2. Pereira, Fernando (Ed.),
X'in +4
X.ul 1
XC-Prolog User's Manual,
XVersion 1.4,
XUniversity of Edinburgh, Department of Architecture, January 19, 1984.
X'in -4
X3. Sun Microsystems, Inc.,
X'in +4
X.ul 1
XProgrammer's Reference Manual for SunCore,
XRevision D of November 1, 1983 for Sun System Release 1.0.
X'in -4
X.sp 1
X4. Sun Microsystems, Inc.,
X'in +4
X.ul 1
XUNIX Programmer's Manual,
X4.2 BSD, Section I,
XRevision D of November 1, 1983 for Sun System Release 1.0.
X'in -4
X.sp 1
+ END-OF-FILE gprolog.nr
chmod 'u=rw,g=r,o=r' 'gprolog.nr'
echo ' -rw-r--r-- 1 brachman 12573 Sep 13 16:23 gprolog.nr (as sent)'
echo -n ' '
/bin/ls -l gprolog.nr
echo 'Extracting gr.h'
sed 's/^X//' > gr.h << '+ END-OF-FILE gr.h'
X
X/*
X * Gprolog 1.4/1.5
X *
X * Barry Brachman
X * Dept. of Computer Science
X * Univ. of British Columbia
X * Vancouver, B.C. V6T 1W5
X *
X * .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X * brachman@cs.ubc.cdn
X * brachman%ubc.csnet@csnet-relay.arpa
X * brachman@ubc.csnet
X */
X
X#include <usercore.h>
X
X#define NCOLS 2 /* Defaults for list table */
X#define COLW 40
X
X#define MAXARGS 10 /* Maximum number of args to a CORE routine */
X
Xstruct Core_info {
X char *Core_name;
X int (*Core_func)();
X char Core_arity;
X char Core_arg_type[MAXARGS];
X};
X
Xstruct Surface {
X char *surface_name;
X struct vwsurf *surface;
X};
X
Xextern int (*oldbussignal)();
Xextern int (*oldsegvsignal)();
X
X#define INT_ARG 0
X#define FLOAT_ARG 1
X#define CHAR_ARG 2
X#define STRING_ARG 3
X#define FLOAT_VEC_ARG 4
X#define INT_VEC_ARG 5
X#define ADDR_ARG 6
X#define INT_PTR 7
X#define FLOAT_PTR 8
X#define INT_MAT_PTR 9
X#define FLOAT_MAT_PTR 10
X#define STRUCT_PTR 11
X#define STRING_PTR 12
X#define ADDR_PTR 13
+ END-OF-FILE gr.h
chmod 'u=rw,g=r,o=r' 'gr.h'
echo ' -rw-r--r-- 1 brachman 969 Sep 14 14:32 gr.h (as sent)'
echo -n ' '
/bin/ls -l gr.h
echo 'Extracting gr1.c'
sed 's/^X//' > gr1.c << '+ END-OF-FILE gr1.c'
X
X/*
X * Gprolog 1.4/1.5
X *
X * Barry Brachman
X * Dept. of Computer Science
X * Univ. of British Columbia
X * Vancouver, B.C. V6T 1W5
X *
X * .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X * brachman@cs.ubc.cdn
X * brachman%ubc.csnet@csnet-relay.arpa
X * brachman@ubc.csnet
X */
X
X#include "gr.h"
X
X/* Interface test routines */
X
Xextern int list();
Xextern int test1(), test2(), test3(), test4(), test5(), test6(), test7();
X
X/* Core functions */
X
X/* int allocate_raster(); */
Xint await_any_button();
Xint await_any_button_get_locator_2();
Xint await_any_button_get_valuator();
Xint await_keyboard();
Xint await_pick();
X/* int await_stroke_2(); */
Xint begin_batch_of_updates();
Xint close_retained_segment();
Xint close_temporary_segment();
Xint create_retained_segment();
Xint create_temporary_segment();
Xint define_color_indices();
Xint delete_all_retained_segments();
Xint delete_retained_segment();
Xint deselect_view_surface();
Xint end_batch_of_updates();
X/* int file_to_raster(); */
X/* int free_raster(); */
Xint get_mouse_state();
X/* int get_raster(); */
Xint initialize_core();
Xint initialize_device();
Xint initialize_view_surface();
Xint inquire_charjust();
Xint inquire_charpath_2();
Xint inquire_charpath_3();
Xint inquire_charprecision();
Xint inquire_charsize();
Xint inquire_charspace();
Xint inquire_charup_2();
Xint inquire_charup_3();
X/* int inquire_color_indices(); */
Xint inquire_current_position_2();
Xint inquire_current_position_3();
Xint inquire_detectability();
Xint inquire_echo();
Xint inquire_echo_position();
Xint inquire_echo_surface();
Xint inquire_fill_index();
Xint inquire_font();
Xint inquire_highlighting();
Xint inquire_image_transformation_2();
Xint inquire_image_transformation_3();
Xint inquire_image_transformation_type();
Xint inquire_image_translate_2();
Xint inquire_image_translate_3();
X/* int inquire_inverse_composite_matrix(); */
Xint inquire_keyboard();
Xint inquire_line_index();
Xint inquire_linestyle();
Xint inquire_linewidth();
Xint inquire_locator_2();
Xint inquire_marker_symbol();
Xint inquire_ndc_space_2();
Xint inquire_ndc_space_3();
Xint inquire_open_retained_segment();
Xint inquire_open_temporary_segment();
Xint inquire_pen();
Xint inquire_pick_id();
Xint inquire_polygon_edge_style();
Xint inquire_polygon_interior_style();
X/* int inquire_primitive_attributes(); */
Xint inquire_rasterop();
Xint inquire_projection();
X/* int inquire_rasterop(); */
X/* int inquire_retained_segment_names(); */
X/* int inquire_retained_segment_surfaces(); */
Xint inquire_segment_detectability();
Xint inquire_segment_highlighting();
Xint inquire_segment_image_transformation_2();
Xint inquire_segment_image_transformation_3();
Xint inquire_segment_image_transformation_type();
Xint inquire_segment_image_translate_2();
Xint inquire_segment_image_translate_3();
Xint inquire_segment_visibility();
Xint inquire_stroke();
Xint inquire_text_extent_2();
Xint inquire_text_extent_3();
Xint inquire_text_index();
Xint inquire_valuator();
Xint inquire_view_depth();
Xint inquire_view_plane_distance();
Xint inquire_view_plane_normal();
Xint inquire_view_reference_point();
Xint inquire_view_up_2();
Xint inquire_view_up_3();
Xint inquire_viewing_control_parameters();
X/* int inquire_viewing_parameters(); */
Xint inquire_viewport_2();
Xint inquire_viewport_3();
Xint inquire_visibility();
Xint inquire_window();
X/* int inquire_world_coordinate_matrix_2(); */
X/* int inquire_world_coordinate_matrix_3(); */
Xint line_abs_2();
Xint line_abs_3();
Xint line_rel_2();
Xint line_rel_3();
Xint map_ndc_to_world_2();
Xint map_ndc_to_world_3();
Xint map_world_to_ndc_2();
Xint map_world_to_ndc_3();
Xint marker_abs_2();
Xint marker_abs_3();
Xint marker_rel_2();
Xint marker_rel_3();
Xint move_abs_2();
Xint move_abs_3();
Xint move_rel_2();
Xint move_rel_3();
Xint new_frame();
Xint polygon_abs_2();
Xint polygon_abs_3();
Xint polygon_rel_2();
Xint polygon_rel_3();
Xint polyline_abs_2();
Xint polyline_abs_3();
Xint polyline_rel_2();
Xint polyline_rel_3();
Xint polymarker_abs_2();
Xint polymarker_abs_3();
Xint polymarker_rel_2();
Xint polymarker_rel_3();
Xint print_error();
X/* int put_raster(); */
X/* int raster_to_file(); */
Xint rename_retained_segment();
Xint report_most_recent_error();
Xint restore_segment();
Xint save_segment();
Xint select_view_surface();
Xint set_back_plane_clipping();
Xint set_charjust(); /* NOT YET IMPLEMENTED IN SUNCORE */
Xint set_charpath_2();
Xint set_charpath_3();
Xint set_charprecision();
Xint set_charsize();
Xint set_charspace();
Xint set_charup_2();
Xint set_charup_3();
Xint set_coordinate_system_type();
Xint set_detectability();
Xint set_drag();
Xint set_echo();
Xint set_echo_group();
Xint set_echo_position();
Xint set_echo_surface();
Xint set_fill_index();
Xint set_font();
Xint set_front_plane_clipping();
Xint set_highlighting();
Xint set_image_transformation_2();
Xint set_image_transformation_3();
Xint set_image_transformation_type();
Xint set_image_translate_2();
Xint set_image_translate_3();
Xint set_keyboard();
Xint set_light_direction();
Xint set_line_index();
Xint set_linestyle();
Xint set_linewidth();
Xint set_locator_2();
Xint set_marker_symbol();
Xint set_ndc_space_2();
Xint set_ndc_space_3();
Xint set_output_clipping();
Xint set_pen();
Xint set_pick();
Xint set_pick_id();
Xint set_polygon_edge_style(); /* NOT YET IMPLEMENTED IN SUNCORE */
Xint set_polygon_interior_style();
X/* int set_primitive_attributes(); */
Xint set_projection();
Xint set_rasterop();
Xint set_segment_detectability();
Xint set_segment_highlighting();
Xint set_segment_image_transformation_2();
Xint set_segment_image_transformation_3();
Xint set_segment_image_translate_2();
Xint set_segment_image_translate_3();
Xint set_segment_visibility();
Xint set_shading_parameters();
Xint set_stroke();
Xint set_text_index();
Xint set_valuator();
Xint set_vertex_indices();
Xint set_vertex_normals();
Xint set_view_depth();
Xint set_view_plane_distance();
Xint set_view_plane_normal();
Xint set_view_reference_point();
Xint set_view_up_2();
Xint set_view_up_3();
X/* int set_viewing_parameters(); */
Xint set_viewport_2();
Xint set_viewport_3();
Xint set_visibility();
Xint set_window();
Xint set_window_clipping();
X/* int set_world_coordinate_matrix_2(); */
X/* int set_world_coordinate_matrix_3(); */
Xint set_zbuffer_cut();
X/* int size_raster(); */
Xint terminate_core();
Xint terminate_device();
Xint terminate_view_surface();
Xint text();
X
X/*
X * The following are non-SunCore functions
X */
Xint getenv_mapper();
X
X/*
Xstruct Core_info {
X char *Core_name;
X int (*Core_func)();
X char Core_arity;
X char Core_arg_type[MAXARGS];
X};
X*/
X
Xstruct Core_info Core_info[] = {
X
X /* Must be in alphabetical order! */
X
X { "await_any_button", await_any_button,
X 2, { INT_ARG, INT_PTR } },
X { "await_any_button_get_locator_2", await_any_button_get_locator_2,
X 5, { INT_ARG, INT_ARG, INT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "await_any_button_get_valuator", await_any_button_get_valuator,
X 4, { INT_ARG, INT_ARG, INT_PTR, FLOAT_PTR } },
X { "await_keyboard", await_keyboard,
X 4, { INT_ARG, INT_ARG, STRING_PTR, INT_PTR } },
X { "await_pick", await_pick,
X 4, { INT_ARG, INT_ARG, INT_PTR, INT_PTR } },
X/* { "await_stroke_2", await_stroke_2,
X 6, { INT_ARG, INT_ARG, INT_ARG, FLOAT_VEC_PTR,
X FLOAT_VEC_PTR, INT_PTR } },
X*/
X { "begin_batch_of_updates", begin_batch_of_updates,
X 0 },
X { "close_retained_segment", close_retained_segment,
X 0 },
X { "close_temporary_segment", close_temporary_segment,
X 0 },
X { "create_retained_segment", create_retained_segment,
X 1, { INT_ARG } },
X { "create_temporary_segment", create_temporary_segment,
X 0 },
X { "define_color_indices", define_color_indices,
X 6, { ADDR_ARG, INT_ARG, INT_ARG, FLOAT_VEC_ARG,
X FLOAT_VEC_ARG, FLOAT_VEC_ARG } },
X { "delete_all_retained_segments", delete_all_retained_segments,
X 0 },
X { "delete_retained_segment", delete_retained_segment,
X 1, { INT_ARG } },
X { "deselect_view_surface", deselect_view_surface,
X 1, { ADDR_ARG } },
X { "end_batch_of_updates", end_batch_of_updates,
X 0 },
X { "get_mouse_state", get_mouse_state,
X 5, { INT_ARG, INT_ARG, FLOAT_PTR, FLOAT_PTR, INT_PTR } },
X/**/ { "getenv", getenv_mapper,
X 2, { STRING_ARG, STRING_PTR } },
X { "initialize_core", initialize_core,
X 3, { INT_ARG, INT_ARG, INT_ARG } },
X { "initialize_device", initialize_device,
X 2, { INT_ARG, INT_ARG } },
X { "initialize_view_surface", initialize_view_surface,
X 2, { ADDR_ARG, INT_ARG } },
X { "inquire_charjust", inquire_charjust,
X 1, { INT_PTR } },
X { "inquire_charpath_2", inquire_charpath_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_charpath_3", inquire_charpath_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_charprecision", inquire_charprecision,
X 1, { INT_PTR } },
X { "inquire_charsize", inquire_charsize,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_charspace", inquire_charspace,
X 1, { FLOAT_PTR } },
X { "inquire_charup_2", inquire_charup_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_charup_3", inquire_charup_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_current_position_2", inquire_current_position_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_current_position_3", inquire_current_position_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_detectability", inquire_detectability,
X 1, { INT_PTR } },
X { "inquire_echo", inquire_echo,
X 3, { INT_ARG, INT_ARG, INT_PTR } },
X { "inquire_echo_position", inquire_echo_position,
X 4, { INT_ARG, INT_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_echo_surface", inquire_echo_surface,
X 3, { INT_ARG, INT_ARG, ADDR_PTR } },
X { "inquire_fill_index", inquire_fill_index,
X 1, { INT_PTR } },
X { "inquire_font", inquire_font,
X 1, { INT_PTR } },
X { "inquire_highlighting", inquire_highlighting,
X 1, { INT_PTR } },
X { "inquire_image_transformation_2", inquire_image_transformation_2,
X 5, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_image_transformation_3", inquire_image_transformation_3,
X 9, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR,
X FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_image_transformation_type",
X inquire_image_transformation_type,
X 1, { INT_PTR } },
X { "inquire_image_translate_2", inquire_image_translate_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_image_translate_3", inquire_image_translate_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_keyboard", inquire_keyboard,
X 4, { INT_ARG, INT_PTR, STRING_PTR, INT_PTR } },
X { "inquire_line_index", inquire_line_index,
X 1, { INT_PTR } },
X { "inquire_linestyle", inquire_linestyle,
X 1, { INT_PTR } },
X { "inquire_linewidth", inquire_linewidth,
X 1, { FLOAT_PTR } },
X { "inquire_locator_2", inquire_locator_2,
X 3, { INT_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_marker_symbol", inquire_marker_symbol,
X 1, { INT_PTR } },
X { "inquire_ndc_space_2", inquire_ndc_space_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_ndc_space_3", inquire_ndc_space_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_open_retained_segment", inquire_open_retained_segment,
X 1, { INT_PTR } },
X { "inquire_open_temporary_segment", inquire_open_temporary_segment,
X 1, { INT_PTR } },
X { "inquire_pen", inquire_pen,
X 1, { INT_PTR } },
X { "inquire_pick_id", inquire_pick_id,
X 1, { INT_PTR } },
X { "inquire_polygon_edge_style", inquire_polygon_edge_style,
X 1, { INT_PTR } },
X { "inquire_polygon_interior_style", inquire_polygon_interior_style,
X 1, { INT_PTR } },
X { "inquire_projection", inquire_projection,
X 4, { INT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_rasterop", inquire_rasterop,
X 1, { INT_PTR } },
X { "inquire_segment_detectability", inquire_segment_detectability,
X 2, { INT_ARG, INT_PTR } },
X { "inquire_segment_highlighting", inquire_segment_highlighting,
X 2, { INT_ARG, INT_PTR } },
X { "inquire_segment_image_transformation_2",
X inquire_segment_image_transformation_2,
X 6, { INT_ARG, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR,
X FLOAT_PTR } },
X { "inquire_segment_image_transformation_3",
X inquire_segment_image_transformation_3,
X 10 , { INT_ARG, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR,
X FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR
X } },
X { "inquire_segment_image_transformation_type",
X inquire_segment_image_transformation_type,
X 2, { INT_ARG, INT_PTR } },
X { "inquire_segment_image_translate_2",
X inquire_segment_image_translate_2,
X 3, { INT_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_segment_image_translate_3",
X inquire_segment_image_translate_3,
X 4, { INT_ARG, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_segment_visibility", inquire_segment_visibility,
X 2, { INT_ARG, INT_PTR } },
X { "inquire_stroke", inquire_stroke,
X 4, { INT_ARG, INT_PTR, FLOAT_PTR, INT_PTR } },
X { "inquire_text_extent_2", inquire_text_extent_2,
X 3, { STRING_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_text_extent_3", inquire_text_extent_3,
X 4, { STRING_ARG, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_text_index", inquire_text_index,
X 1, { INT_PTR } },
X { "inquire_valuator", inquire_valuator,
X 4, { INT_ARG, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_view_depth", inquire_view_depth,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_view_plane_distance", inquire_view_plane_distance,
X 1, { FLOAT_PTR } },
X { "inquire_view_plane_normal", inquire_view_plane_normal,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_view_reference_point", inquire_view_reference_point,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_view_up_2", inquire_view_up_2,
X 2, { FLOAT_PTR, FLOAT_PTR } },
X { "inquire_view_up_3", inquire_view_up_3,
X 3, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_viewing_control_parameters",
X inquire_viewing_control_parameters,
X 4, { INT_PTR, INT_PTR, INT_PTR, INT_PTR } },
X { "inquire_viewport_2", inquire_viewport_2,
X 4, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_viewport_3", inquire_viewport_3,
X 9, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR,
X FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "inquire_visibility", inquire_visibility,
X 1, { INT_PTR } },
X { "inquire_window", inquire_window,
X 4, { FLOAT_PTR, FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "line_abs_2", line_abs_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "line_abs_3", line_abs_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "line_rel_2", line_rel_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "line_rel_3", line_rel_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "list", list,
X 0 },
X { "map_ndc_to_world_2", map_ndc_to_world_2,
X 4, { FLOAT_ARG, FLOAT_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "map_ndc_to_world_3", map_ndc_to_world_3,
X 6, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "map_world_to_ndc_2", map_world_to_ndc_2,
X 4, { FLOAT_ARG, FLOAT_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "map_world_to_ndc_3", map_world_to_ndc_3,
X 6, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_PTR, FLOAT_PTR, FLOAT_PTR } },
X { "marker_abs_2", marker_abs_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "marker_abs_3", marker_abs_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "marker_rel_2", marker_rel_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "marker_rel_3", marker_rel_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "move_abs_2", move_abs_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "move_abs_3", move_abs_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "move_rel_2", move_rel_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "move_rel_3", move_rel_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "new_frame", new_frame,
X 0 },
X { "polygon_abs_2", polygon_abs_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polygon_abs_3", polygon_abs_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_ARG, INT_ARG } },
X { "polygon_rel_2", polygon_rel_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polygon_rel_3", polygon_rel_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_ARG, INT_ARG } },
X { "polyline_abs_2", polyline_abs_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polyline_abs_3", polyline_abs_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polyline_rel_2", polyline_rel_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polyline_rel_3", polyline_rel_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polymarker_abs_2", polymarker_abs_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polymarker_abs_3", polymarker_abs_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_ARG, INT_ARG } },
X { "polymarker_rel_2", polymarker_rel_2,
X 3, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "polymarker_rel_3", polymarker_rel_3,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_ARG, INT_ARG } },
X { "print_error", print_error,
X 2, { STRING_ARG, INT_ARG } },
X { "rename_retained_segment", rename_retained_segment,
X 2, { INT_ARG, INT_ARG } },
X { "report_most_recent_error", report_most_recent_error,
X 1, { INT_PTR } },
X { "restore_segment", restore_segment,
X 2, { INT_ARG, STRING_ARG } },
X { "save_segment", save_segment,
X 2, { INT_ARG, STRING_ARG } },
X { "select_view_surface", select_view_surface,
X 1, { ADDR_ARG } },
X { "set_back_plane_clipping", set_back_plane_clipping,
X 1, { INT_ARG } },
X { "set_charjust", set_charjust,
X 1, { INT_ARG } },
X { "set_charpath_2", set_charpath_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_charpath_3", set_charpath_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_charprecision", set_charprecision,
X 1, { INT_ARG } },
X { "set_charsize", set_charsize,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_charspace", set_charspace,
X 1, { FLOAT_ARG } },
X { "set_charup_2", set_charup_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_charup_3", set_charup_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_coordinate_system_type", set_coordinate_system_type,
X 1, { INT_ARG } },
X { "set_detectability", set_detectability,
X 1, { INT_ARG } },
X { "set_drag", set_drag,
X 1, { INT_ARG } },
X { "set_echo", set_echo,
X 3, { INT_ARG, INT_ARG, INT_ARG } },
X { "set_echo_group", set_echo_group,
X 4, { INT_ARG, INT_VEC_ARG, INT_ARG, INT_ARG } },
X { "set_echo_position", set_echo_position,
X 4, { INT_ARG, INT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_echo_surface", set_echo_surface,
X 3, { INT_ARG, INT_ARG, ADDR_ARG } },
X { "set_fill_index", set_fill_index,
X 1, { INT_ARG } },
X { "set_font", set_font,
X 1, { INT_ARG } },
X { "set_front_plane_clipping", set_front_plane_clipping,
X 1, { INT_ARG } },
X { "set_highlighting", set_highlighting,
X 1, { INT_ARG } },
X { "set_image_transformation_2", set_image_transformation_2,
X 5, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_image_transformation_3", set_image_transformation_3,
X 9, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_image_transformation_type", set_image_transformation_type,
X 1, { INT_ARG } },
X { "set_image_translate_2", set_image_translate_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_image_translate_3", set_image_translate_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_keyboard", set_keyboard,
X 4, { INT_ARG, INT_ARG, STRING_ARG, INT_ARG } },
X { "set_light_direction", set_light_direction,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_line_index", set_line_index,
X 1, { INT_ARG } },
X { "set_linestyle", set_linestyle,
X 1, { INT_ARG } },
X { "set_linewidth", set_linewidth,
X 1, { FLOAT_ARG } },
X { "set_locator_2", set_locator_2,
X 3, { INT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_marker_symbol", set_marker_symbol,
X 1, { INT_ARG } },
X { "set_ndc_space_2", set_ndc_space_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_ndc_space_3", set_ndc_space_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_output_clipping", set_output_clipping,
X 1, { INT_ARG } },
X { "set_pen", set_pen,
X 1, { INT_ARG } },
X { "set_pick", set_pick,
X 2, { INT_ARG, FLOAT_ARG } },
X { "set_pick_id", set_pick_id,
X 1, { INT_ARG } },
X { "set_polygon_edge_style", set_polygon_edge_style,
X 1, { INT_ARG } },
X { "set_polygon_interior_style", set_polygon_interior_style,
X 1, { INT_ARG } },
X { "set_projection", set_projection,
X 4, { INT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_rasterop", set_rasterop,
X 1, { INT_ARG } },
X { "set_segment_detectability", set_segment_detectability,
X 2, { INT_ARG, INT_ARG } },
X { "set_segment_highlighting", set_segment_highlighting,
X 2, { INT_ARG, INT_ARG } },
X { "set_segment_image_transformation_2",
X set_segment_image_transformation_2,
X 6, { INT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_ARG } },
X { "set_segment_image_transformation_3",
X set_segment_image_transformation_3,
X 10, { INT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_ARG } },
X { "set_segment_image_translate_2", set_segment_image_translate_2,
X 3, { INT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_segment_image_translate_3", set_segment_image_translate_3,
X 4, { INT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_segment_visibility", set_segment_visibility,
X 2, { INT_ARG, INT_ARG } },
X { "set_shading_parameters", set_shading_parameters,
X 7, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X INT_ARG, INT_ARG } },
X { "set_stroke", set_stroke,
X 4, { INT_ARG, INT_ARG, FLOAT_ARG, INT_ARG } },
X { "set_text_index", set_text_index,
X 1, { INT_ARG } },
X { "set_valuator", set_valuator,
X 4, { INT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_vertex_indices", set_vertex_indices,
X 2, { INT_VEC_ARG, INT_ARG } },
X { "set_vertex_normals", set_vertex_normals,
X 4, { FLOAT_VEC_ARG, FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "set_view_depth", set_view_depth,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_view_plane_distance", set_view_plane_distance,
X 1, { FLOAT_ARG } },
X { "set_view_plane_normal", set_view_plane_normal,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_view_reference_point", set_view_reference_point,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_view_up_2", set_view_up_2,
X 2, { FLOAT_ARG, FLOAT_ARG } },
X { "set_view_up_3", set_view_up_3,
X 3, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_viewport_2", set_viewport_2,
X 4, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_viewport_3", set_viewport_3,
X 6, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG,
X FLOAT_ARG, FLOAT_ARG } },
X { "set_visibility", set_visibility,
X 1, { INT_ARG } },
X { "set_window", set_window,
X 4, { FLOAT_ARG, FLOAT_ARG, FLOAT_ARG, FLOAT_ARG } },
X { "set_window_clipping", set_window_clipping,
X 1, { INT_ARG } },
X { "set_zbuffer_cut", set_zbuffer_cut,
X 4, { ADDR_ARG, FLOAT_VEC_ARG, FLOAT_VEC_ARG, INT_ARG } },
X { "terminate_core", terminate_core,
X 0 },
X { "terminate_device", terminate_device,
X 2, { INT_ARG, INT_ARG } },
X { "terminate_view_surface", terminate_view_surface,
X 1, { ADDR_ARG } },
X/**/ { "test1", test1,
X 2, { INT_ARG, FLOAT_ARG } },
X/**/ { "test2", test2,
X 2, { INT_ARG, FLOAT_VEC_ARG } },
X/**/ { "test3", test3,
X 1, { STRING_ARG } },
X/**/ { "test4", test4,
X 2, { INT_ARG, INT_VEC_ARG } },
X/**/ { "test5", test5,
X 1, { CHAR_ARG } },
X/**/ { "test6", test6,
X 1, { STRING_PTR } },
X/**/ { "test7", test7,
X 3, { STRING_ARG, FLOAT_PTR, FLOAT_PTR } },
X { "text", text,
X 1, { STRING_ARG } },
X { "", 0,
X 0 }
X};
X
Xint ncorefuncs = (sizeof Core_info / sizeof Core_info[0]) - 1;
X
Xextern int pixwindd(), bw1dd(), bw2dd();
X
X/*
XOld way:
Xstruct Surface {
X char *surface_name;
X int (*surface)();
X};
X*/
X
X/*
XNew way:
Xstruct Surface {
X char *surface_name;
X struct vwsurf *surface;
X};
X*/
X
Xstruct vwsurf pixwindd_surf = DEFAULT_VWSURF(pixwindd);
Xstruct vwsurf bw1dd_surf = DEFAULT_VWSURF(bw1dd);
Xstruct vwsurf bw2dd_surf = DEFAULT_VWSURF(bw2dd);
X
Xstruct Surface Surface[] = {
X "pixwindd", &pixwindd_surf,
X "bw1dd", &bw1dd_surf,
X "bw2dd", &bw2dd_surf,
X "", 0
X};
+ END-OF-FILE gr1.c
chmod 'u=rw,g=r,o=r' 'gr1.c'
echo ' -rw-r--r-- 1 brachman 23482 Sep 14 14:29 gr1.c (as sent)'
echo -n ' '
/bin/ls -l gr1.c
echo 'Extracting gr2.c'
sed 's/^X//' > gr2.c << '+ END-OF-FILE gr2.c'
X
X/*
X * Gprolog 1.4/1.5
X *
X * plgraphics - interface from CProlog to CORE graphics package
X *
X * Usage: plgraphics(<func_name>)
X * or: plgraphics(<func_name>(arg1,arg2,...,argn))
X *
X * Barry Brachman
X * Dept. of Computer Science
X * Univ. of British Columbia
X * Vancouver, B.C. V6T 1W5
X *
X * .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X * brachman@cs.ubc.cdn
X * brachman%ubc.csnet@csnet-relay.arpa
X * brachman@ubc.csnet
X */
X
X#include "pl.h"
X#include "gr.h"
X
X#include <signal.h>
X#include <setjmp.h>
X
Xstruct {
X PTR space;
X int size;
X} sp[MAXARGS];
X
Xtypedef union {
X char aschar;
X int asint; /* chars are passed as INTS */
X char *ascharp;
X PTR asPTR;
X double asdouble; /* floats are passed as DOUBLES! */
X} Mixed;
X
Xtypedef union {
X int asint;
X float asfloat;
X PTR asPTR;
X char *ascharp;
X} Argspace;
X
Xextern struct Core_info Core_info[];
Xextern struct Surface Surface[];
X
Xstatic short noerr;
Xstatic nspaces = -1; /* This must be initialized only once! */
Xstatic PTR p;
X
Xstatic jmp_buf jmpbuf;
Xint (*oldbussignal)();
Xint (*oldsegvsignal)();
Xchar *fnm;
X
X/*
X * Entry from CProlog to CORE graphics routines
X * Prolog usage:
X * plgraphics(<CORE_NAME>)
X * or
X * plgraphics(<CORE_NAME>(<ARG1>,<ARG2>,...,<ARGn>))
X *
X * Note that getsp(arg) returns a pointer to enough space for arg PTR's,
X * each PTR requires 4 bytes
X *
X */
X
Xplgraphics()
X{
X register int i,j,arity;
X register PTR ax,g,k,t;
X register struct Core_info *cp;
X PTR a,e,f,e1,f1,t1;
X PTR argptr[MAXARGS];
X Mixed argvec[MAXARGS];
X Argspace *spp;
X struct Surface *s;
X char argtypes[MAXARGS];
X struct Core_info *lookup_core();
X int catchbus(),catchsegv();
X
X k = ARG1;
X oldbussignal = signal(SIGBUS,catchbus);
X oldsegvsignal = signal(SIGSEGV,catchsegv);
X if (setjmp(jmpbuf)) {
X resetsigs();
X return(0);
X }
X if (IsPrim(k)) { /* Number or DB reference */
X err1("Improper function name");
X resetsigs();
X return(0);
X }
X if (IsAtomic(k)) {
X cp = lookup_core(AtomP(k)->stofae);
X if (cp == 0) {
X err2("Unknown function - %s",AtomP(k)->stofae);
X resetsigs();
X return(0);
X }
X if (cp->Core_arity != 0) {
X err();
X sprintf(OutBuf,"Arity of %s should be %d",AtomP(k)->stofae,cp->Core_arity);
X PutString(OutBuf);
X resetsigs();
X return(0);
X }
X i = (*cp->Core_func)();
X return(!i);
X }
X if (!IsRef(k)) {
X err1("Improper function name");
X resetsigs();
X return(0);
X }
X g = MolP(k)->Env;
X t = MolP(k)->Sk;
X f = SkelP(t)->Fn;
X arity = FunctorP(f)->arityoffe;
X if ((cp = lookup_core((FunctorP(f)->atoffe)->stofae)) == 0) {
X err2("Unknown function - %s",(FunctorP(f)->atoffe)->stofae);
X resetsigs();
X return(0);
X }
X fnm = cp->Core_name;
X if (cp->Core_arity != arity) {
X err();
X sprintf(OutBuf,"Arity of %s should be %d",fnm,cp->Core_arity);
X PutString(OutBuf);
X resetsigs();
X return(0);
X }
X noerr = TRUE;
X for (i = 0; i < arity && noerr == TRUE; i++) {
X ax = argv(++t,g,&f);
X switch (cp->Core_arg_type[i]) {
X case INT_PTR:
X case ADDR_PTR:
X case FLOAT_PTR:
X if (!IsRef(ax) || !Undef(*ax)) {
X err3(i+1,fnm,"uninstantiated variable");
X noerr = FALSE;
X break;
X }
X argvec[i].asPTR = v1;
X GrowGlobal(1);
X argtypes[i] = 4;
X argptr[i] = ax;
X break;
X case STRING_PTR:
X if (!IsRef(ax) || !Undef(*ax)) {
X err3(i+1,fnm,"uninstantiated variable");
X noerr = FALSE;
X break;
X }
X argvec[i].asPTR = sp[++nspaces].space = getsp(64);
X sp[nspaces].size = 64;
X argtypes[i] = 4;
X argptr[i] = ax;
X break;
X case INT_ARG:
X if (!IsInt(ax)) {
X err3(i+1,fnm,"integer");
X noerr = FALSE;
X break;
X }
X argvec[i].asint = XtrInt(ax);
X argtypes[i] = 4;
X break;
X case FLOAT_ARG:
X if (!IsFloat(ax)) {
X err3(i+1,fnm,"float");
X noerr = FALSE;
X break;
X }
X argvec[i].asdouble = (double)(XtrFloat(ax));
X argtypes[i] = 8;
X break;
X case INT_VEC_ARG:
X p = arg(t,g);
X if (IsInp(p) || Undef(*p)) {
X err3(i+1,fnm,"list of integers/1");
X noerr = FALSE;
X break;
X }
X p = MolP(p)->Sk;
X if (IsAtomic(p) || IsVar(p) ||
X SkelP(p)->Fn != listfunc) {
X err3(i+1,fnm,"list of integers/2");
X noerr = FALSE;
X break;
X }
X e1 = f;
X f1 = SkelP(ax)->Fn;
X if (SkelP(ax)->Fn != listfunc) {
X err3(i+1,fnm,"list of integers/3");
X noerr = FALSE;
X break;
X }
X j = 0;
X p = ax;
X while (IsComp(p) && (MolP(p)->Sk == listfunc)) {
X j++;
X p = argv(Addr(SkelP(p)->Arg2),e1,&e1);
X }
X if (p != atomnil) {
X err3(i+1,fnm,"list of integers/4");
X noerr = FALSE;
X break;
X }
X if (j == 0) {
X err3(i+1,fnm,"(non-empty) list of integers");
X noerr = FALSE;
X break;
X }
X spp = (j == 1 ? getsp(2) : getsp(j));
X sp[++nspaces].space = spp;
X sp[nspaces].size = j;
X argvec[i].asPTR = (PTR)spp;
X argtypes[i] = 4;
X e1 = f;
X f1 = SkelP(ax)->Fn;
X p = ax;
X while (j--) {
X a = arg(Addr(SkelP(p)->Arg1),e1);
X if (!IsPrim(a) || !IsInt(a)) {
X err3(i+1,fnm,"list of integers/5");
X noerr = FALSE;
X break;
X }
X /* sprintf(OutBuf,"%d\n",XtrInt(a)); PutString(OutBuf); */
X spp->asint = XtrInt(a);
X spp++;
X p = argv(Addr(SkelP(p)->Arg2),e1,&e1);
X }
X break;
X case FLOAT_VEC_ARG:
X p = arg(t,g);
X if (IsInp(p) || Undef(*p)) {
X err3(i+1,fnm,"list of floats/1");
X noerr = FALSE;
X break;
X }
X p = MolP(p)->Sk;
X if (IsAtomic(p) || IsVar(p) ||
X SkelP(p)->Fn != listfunc) {
X err3(i+1,fnm,"list of floats/2");
X noerr = FALSE;
X break;
X }
X e = f;
X f1 = SkelP(ax)->Fn;
X p = ax;
X j = 0;
X while (IsComp(p) && (MolP(p)->Sk == listfunc)) {
X j++;
X p = argv(Addr(SkelP(p)->Arg2),e,&e);
X }
X if (p != atomnil) {
X err3(i+1,fnm,"list of floats/3");
X noerr = FALSE;
X }
X if (noerr == FALSE)
X break;
X if (j == 0) {
X err3(i+1,fnm,"(non-empty) list of floats");
X noerr = FALSE;
X break;
X }
X /* Each double needs 8 bytes */
X spp = sp[++nspaces].space = getsp(j*2);
X sp[nspaces].size = j * 2;
X argvec[i].asPTR = (PTR)spp;
X argtypes[i] = 4;
X e = f;
X p = ax;
X while (j--) {
X a = arg(Addr(SkelP(p)->Arg1),e);
X if (!IsPrim(a) || !IsFloat(a)) {
X err3(i+1,fnm,"list of floats/4");
X noerr = FALSE;
X break;
X }
X /* sprintf(OutBuf,"%f\n",XtrFloat(a)); PutString(OutBuf); */
X spp->asfloat = XtrFloat(a);
X spp++;
X p = argv(Addr(SkelP(p)->Arg2),e,&e);
X }
X break;
X case ADDR_ARG:
X if (!IsAtomic(ax) || IsNumber(ax)) {
X err3(i+1,fnm,"surface name/1");
X noerr = FALSE;
X break;
X }
X ax = FunctorP(SkelP(ax)->Fn)->atoffe;
X for (s = Surface; s->surface_name[0] != '\0'; s++)
X if (strcmp(AtomP(ax)->stofae,s->surface_name) == 0)
X break;
X if (s->surface_name[0] != '\0')
X argvec[i].asPTR = s->surface;
X else {
X err3(i+1,fnm,"surface name/2");
X noerr = FALSE;
X break;
X }
X argtypes[i] = 4;
X break;
X case STRING_ARG:
X ax = arg(t,g);
X spp = sp[++nspaces].space = getsp(64);
X sp[nspaces].size = 64;
X if (!list_to_string(ax,(char *)spp,255)) {
X err3(i+1,fnm,"string");
X noerr = FALSE;
X break;
X }
X argvec[i].ascharp = (PTR)spp;
X argtypes[i] = 4;
X break;
X case CHAR_ARG:
X ax = arg(t,g);
X if (ax == atomnil) {
X argvec[i].aschar = '\0';
X argtypes[i] = 4;
X break;
X }
X if (IsInp(ax) || Undef(*ax)) {
X err3(i+1,fnm,"character/1");
X noerr = FALSE;
X break;
X }
X e1 = MolP(ax)->Env;
X p = MolP(ax)->Sk;
X if (IsAtomic(p) || IsVar(p) ||
X SkelP(p)->Fn != listfunc) {
X err3(i+1,fnm,"character/2");
X noerr = FALSE;
X break;
X }
X a = arg(Addr(SkelP(p)->Arg1),e1);
X if (!IsInt(a) || (a = XtrInt(a)) < 0 || a > 255) {
X err3(i+1,fnm,"character/3");
X noerr = FALSE;
X break;
X }
X if (argv(Addr(SkelP(p)->Arg2),e1,&e1) != atomnil) {
X err3(i+1,fnm,"character/4");
X noerr = FALSE;
X break;
X }
X /* sprintf(OutBuf,"char = %d\n",a); PutString(OutBuf); */
X argvec[i].asint = a;
X argtypes[i] = 4;
X break;
X default:
X err3(i+1,fnm,"Internal switch error!");
X noerr = FALSE;
X break;
X }
X }
X if (noerr == TRUE) {
X j = pushargs(cp->Core_func,argvec,arity,argtypes);
X
X /* reset SIGINT etc since Core has screwed them up */
X CatchSignals();
X }
X else
X j = -1; /* Return failure */
X
X for (i = 0; i < arity && j == 0; i++) {
X int *intp,len,n;
X char *charp;
X float *floatp;
X
X ax = argptr[i];
X switch (cp->Core_arg_type[i]) {
X case INT_PTR:
X case ADDR_PTR:
X intp = argvec[i].asPTR;
X /* sprintf(OutBuf,"Int = %d\n",*intp); PutString(OutBuf); */
X if (!unifyarg(ax,ConsInt(*intp),0)) {
X j = -1;
X break;
X }
X break;
X case FLOAT_PTR:
X floatp = argvec[i].asPTR;
X /* sprintf(OutBuf,"Float = %f\n",*floatp); PutString(OutBuf); */
X if (!unifyarg(ax,ConsFloat(*floatp),0)) {
X j = -1;
X break;
X }
X break;
X case STRING_PTR:
X charp = argvec[i].asPTR;
X len = strlen(charp);
X if (len > 0) {
X p = v + 1;
X n = len + 1;
X while (len-- > 0)
X *++p = ConsInt(*charp++);
X *(p+1) = atomnil;
X p = makelist(n,v+2);
X v1 -= 2;
X if (!unifyarg(ax,MolP(p)->Sk,MolP(p)->Env)) {
X j = -1;
X break;
X }
X }
X else {
X if (!unifyarg(ax,atomnil,0)) {
X j = -1;
X break;
X }
X }
X break;
X default:
X break;
X }
X }
X /* We really want to disable events during the following critical section */
X while (nspaces >= 0) {
X freeblock(sp[nspaces].space,sp[nspaces].size);
X nspaces--;
X }
X resetsigs();
X return(!j);
X}
X
Xstatic
Xcatchbus()
X{
X signal(SIGBUS,catchbus);
X sprintf(OutBuf,"plgraphics: a SIGBUS has occured\n");
X PutString(OutBuf);
X sprintf(OutBuf,"Current function is %s\n",fnm);
X PutString(OutBuf);
X longjmp(jmpbuf,1);
X}
X
Xstatic
Xcatchsegv()
X{
X signal(SIGSEGV,catchsegv);
X sprintf(OutBuf,"plgraphics: a SIGSEGV has occured\n");
X PutString(OutBuf);
X sprintf(OutBuf,"Current function is %s\n",fnm);
X PutString(OutBuf);
X longjmp(jmpbuf,1);
X}
+ END-OF-FILE gr2.c
chmod 'u=rw,g=r,o=r' 'gr2.c'
echo ' -rw-r--r-- 1 brachman 9695 Sep 14 14:29 gr2.c (as sent)'
echo -n ' '
/bin/ls -l gr2.c
echo 'Extracting gr3.c'
sed 's/^X//' > gr3.c << '+ END-OF-FILE gr3.c'
X
X/*
X * Gprolog 1.4/1.5
X *
X * Barry Brachman
X * Dept. of Computer Science
X * Univ. of British Columbia
X * Vancouver, B.C. V6T 1W5
X *
X * .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X * brachman@cs.ubc.cdn
X * brachman%ubc.csnet@csnet-relay.arpa
X * brachman@ubc.csnet
X */
X
X#include "pl.h"
X#include "gr.h"
X
X#include <signal.h>
X
Xextern struct Core_info Core_info[];
Xextern int ncorefuncs;
X
X/*
X * Binary search
X */
Xstruct Core_info
X*lookup_core(s)
Xchar *s;
X{
X register int low,high,mid,cond;
X register struct Core_info *cp;
X
X cp = Core_info;
X low = 0;
X high = ncorefuncs;
X while (low <= high) {
X mid = (low + high) / 2;
X if ((cond = strcmp(s,(cp+mid)->Core_name)) < 0)
X high = mid - 1;
X else if (cond > 0)
X low = mid + 1;
X else
X return(cp+mid);
X }
X return(0);
X}
X
Xgetenv_mapper(s1, s2)
Xchar *s1, *s2;
X{
X char *p;
X char *getenv();
X
X if ((p = getenv(s1)) == 0)
X return(1);
X strcpy(s2, p);
X return(0);
X}
X
Xresetsigs()
X{
X signal(SIGBUS,oldbussignal);
X signal(SIGSEGV,oldsegvsignal);
X}
X
Xerr()
X{
X sprintf(OutBuf,"plgraphics: "); PutString(OutBuf);
X}
X
Xerr1(s)
Xchar *s;
X{
X sprintf(OutBuf,"plgraphics: %s\n",s); PutString(OutBuf);
X}
X
Xerr2(s1,s2)
Xchar *s1,*s2;
X{
X sprintf(OutBuf,"plgraphics: "); PutString(OutBuf);
X sprintf(OutBuf,s1,s2); PutString(OutBuf);
X sprintf(OutBuf,"\n"); PutString(OutBuf);
X}
X
Xerr3(i,s1,s2)
Xint i;
Xchar *s1,*s2;
X{
X sprintf(OutBuf,"plgraphics: "); PutString(OutBuf);
X sprintf(OutBuf,"Argument %d of %s must be %s\n",i,s1,s2);
X PutString(OutBuf);
X}
X
Xtest1(i,f)
Xint i;
Xfloat f;
X{
X sprintf(OutBuf,"test1: %d,%f\n",i,f); PutString(OutBuf);
X return(0);
X}
X
Xtest2(n,f)
Xint n;
Xfloat *f;
X{
X register int i;
X
X sprintf(OutBuf,"test2:\n"); PutString(OutBuf);
X for (i = 0; i < n; i++) {
X sprintf(OutBuf,"%f\n",f[i]);
X PutString(OutBuf);
X }
X return(0);
X}
X
Xtest3(s)
Xchar *s;
X{
X sprintf(OutBuf,"test3: %s\n",s); PutString(OutBuf);
X return(0);
X}
X
Xtest4(n,v)
Xint n,*v;
X{
X register int i;
X
X sprintf(OutBuf,"test4:\n"); PutString(OutBuf);
X for (i = 0; i < n; i++) {
X sprintf(OutBuf,"%d\n",v[i]);
X PutString(OutBuf);
X }
X return(0);
X}
X
Xtest5(ch)
Xchar ch;
X{
X sprintf(OutBuf,"test5: %d\n",ch); PutString(OutBuf);
X return(0);
X}
X
Xtest6(s)
Xchar *s;
X{
X sprintf(OutBuf,"test6:\n"); PutString(OutBuf);
X strcpy(s,"test6 string");
X return(0);
X}
X
Xtest7(s, f1, f2)
Xchar *s;
Xfloat *f1, *f2;
X{
X
X sprintf(OutBuf, "test7: s=%s\n", s); PutString(OutBuf);
X *f1 = 1.23;
X *f2 = 2.34;
X return(0);
X}
X
X/*
X * Print a list of the implemented functions
X * in a nice table
X *
X * NOTE: Ideally, this routine should check on the size of the
X * window it is running in through termcap and adjust the number
X * of columns dynamically.
X * Problem is that the window system does not seem to distribute
X * SIGWINCH as advertised.
X */
Xlist()
X{
X int pentry(), len();
X
X sprintf(OutBuf,"%d functions:\n",ncorefuncs);
X PutString(OutBuf);
X prtable(Core_info, ncorefuncs, 0, 0, pentry, len);
X return(0);
X}
X
Xstatic int
Xpentry(base, index)
Xstruct Core_info *base;
Xint index;
X{
X register int l;
X register struct Core_info *p;
X
X p = base + index;
X sprintf(OutBuf, "%s(%d)", p->Core_name, p->Core_arity);
X l = strlen(OutBuf);
X PutString(OutBuf);
X return(l);
X}
X
Xstatic int
Xlen(base, index)
Xstruct Core_info *base;
Xint index;
X{
X register struct Core_info *p;
X
X p = base + index;
X sprintf(OutBuf, "%s(%d)", p->Core_name, p->Core_arity);
X return(strlen(OutBuf));
X}
X
+ END-OF-FILE gr3.c
chmod 'u=rw,g=r,o=r' 'gr3.c'
echo ' -rw-r--r-- 1 brachman 3327 Sep 14 14:30 gr3.c (as sent)'
echo -n ' '
/bin/ls -l gr3.c
echo 'Extracting makefile'
sed 's/^X//' > makefile << '+ END-OF-FILE makefile'
XPLSTARTUP="Startup"
XBIN="gprolog1.5"
XGRIND=igrind
X
X# Replace VAX by IEEE for IEEE floating point machines (e.g. Sun)
XFLOATING=IEEE
X
X# Replace the right-end side by the empty string to get
X# -1 as end of file character
X
XEOF=
X
XCFLAGS=-w -O $(EOF) -D$(FLOATING) -DGRAPHICS -DSTARTUPFILE=\"$(PLSTARTUP)\"
X# change define in parms.c - no mistakes then!
XOBJECTS=main.o unify.o rewrite.o dbase.o sysbits.o space.o trace.o\
X parms.o arith.o compare.o auxfn.o gr1.o gr2.o gr3.o prtable.o\
X pushargs.o
X
XCProlog : $(OBJECTS)
X $(CC) -o CProlog -s $(OBJECTS) -lg -ltermcap -lm
X
Xmain.o : arithop.h evalp.h
X
Xgr1.o : gr.h
X $(CC) $(CFLAGS) -c gr1.c
X ld -r gr1.o -lcore -lsunwindow -lpixrect
X mv a.out gr1.o
Xgr2.o : gr.h
Xgr3.o : gr.h
X
X(OBJECTS) : pl.h
Xarith.o : arithop.h
X
Xpushargs.o : pushargs.s
X as -o pushargs.o pushargs.s
X
Xstartup : CProlog pl/init.pl
X ./CProlog -b pl/init.pl <bootcmd
X
Xinstall : CProlog startup
X mv startup $(PLSTARTUP)
X mv CProlog $(BIN)
X
Xdoc :
X nroff gprolog.nr > gprolog.doc
X
Xgrind:
X $(GRIND) pl.h evalp.h arithop.h main.c rewrite.c dbase.c auxfn.c \
X arith.c unify.c compare.c sysbits.c space.c parms.c
X $(GRIND) -x index
+ END-OF-FILE makefile
chmod 'u=rw,g=r,o=r' 'makefile'
echo ' -rw-r--r-- 1 brachman 1137 Sep 13 16:10 makefile (as sent)'
echo -n ' '
/bin/ls -l makefile
if test -f 'pl'
then rm 'pl'
fi
if test -d 'pl'
then :
else echo 'Making pl/'
mkdir 'pl'
fi
chmod 'u=rwx,g=rx,o=rx' 'pl'
echo 'Extracting pl/grall.pl'
sed 's/^X//' > pl/grall.pl << '+ END-OF-FILE pl/grall.pl'
X/* all: Load all the current bits of the standard Prolog system
X
X Fernando Pereira
X Updated: 30 December 82
X*/
X
X:-([
X 'pl/arith.pl', % Arithmetic compilation
X 'pl/grammar.pl', % DCG grammar rule translation
X 'pl/setof.pl', % Setof and sorting
X 'pl/tracing.pl', % Debugging evaluable predicates
X 'pl/listing.pl', % Listing the database
X 'pl/graphics.pl' % Graphics
X ]).
X
X
X:-([ 'pl/protect.pl' ]). % Lock things up
X
+ END-OF-FILE pl/grall.pl
chmod 'u=rw,g=r,o=r' 'pl/grall.pl'
echo ' -rw-r--r-- 1 brachman 601 Sep 13 16:04 pl/grall.pl (as sent)'
echo -n ' '
/bin/ls -l pl/grall.pl
echo 'Extracting pl/graphics.pl'
sed 's/^X//' > pl/graphics.pl << '+ END-OF-FILE pl/graphics.pl'
X% Graphics interface
X
X:- op(910,fx,'#').
X:- op(911,fx,'##').
X
X'#'(def(X,Y)) :- '##'def(X,Y).
X'#'(def(X,Y)) :- !, write('plgraphics: '), write(X), write(' is not defined'),
X nl, fail.
X
X% The following are special cases:
X% To make the usage of the functions as similar to the C usage as
X% possible and to avoid kludging up the code for 'plgraphics', we introduce
X% extra arguments to these calls at this point
X
X% '#'(set_world_coordinate_matrix_2(X)) :-
X% plgraphics(set_world_coordinate_matrix_2(3,3,X)).
X% '#'(set_world_coordinate_matrix_3(X)) :-
X% plgraphics(set_world_coordinate_matrix_3(4,4,X)).
X% '#'(inquire_world_coordinate_matrix_2(X)) :-
X% plgraphics(inquire_world_coordinate_matrix_2(3,3,X)).
X% '#'(inquire_world_coordinate_matrix_3(X)) :-
X% plgraphics(inquire_world_coordinate_matrix_3(4,4,X)).
X% '#'(inquire_inverse_composite_matrix(X)) :-
X% plgraphics(inquire_inverse_composite_matrix(4,4,X)).
X
X'#'(X) :- plgraphics(X).
X
X% @(#)usercore.h 1.8 83/08/31 SMI
X% Copyright (c) 1983 by Sun Microsystems, Inc.
X
X'##'def(pi,3.141592654).
X
X'##'def(true,1).
X'##'def(false,0).
X'##'def(on,1). % same as true - bjb
X
X'##'def(string,0).
X'##'def(character,1).
X
X'##'def(maxvsurf,5). % view surfaces; maximum number of
X
X'##'def(parallel,0). % transform constants
X'##'def(perspective,1).
X
X'##'def(none,1). % segment types
X'##'def(xlate2,2).
X'##'def(xform2,3).
X'##'def(xlate3,2).
X'##'def(xform3,3).
X
X'##'def(solid,0). % line styles
X'##'def(dotted,1).
X'##'def(dashed,2).
X'##'def(dotdashed,3).
X
X'##'def(constant,0). % polygon shading modes
X'##'def(gouraud,1).
X'##'def(phong,2).
X
X'##'def(pick,0). % input device constants
X'##'def(keyboard,1).
X'##'def(button,2).
X'##'def(locator,3).
X'##'def(valuator,4).
X'##'def(stroke,5).
X
X'##'def(roman,0). % Font select constants
X'##'def(greek,1).
X'##'def(script,2).
X'##'def(oldenglish,3).
X'##'def(stick,4).
X'##'def(symbols,5).
X
X'##'def(gallant,0). % raster font constants
X'##'def(gacha,1).
X'##'def(sail,2).
X'##'def(gachabold,3).
X'##'def(cmr,4).
X'##'def(cmrbold,5).
X
X'##'def(off,0). % char justify constants
X'##'def(left,1).
X'##'def(center,2).
X'##'def(right,3).
X
X'##'def(normal,0). % rasterop selection
X'##'def(xorrop,1).
X'##'def(orrop,2).
X
X'##'def(plain,0). % polygon interior style
X'##'def(shaded,1).
X
X'##'def(basic,0). % Core output levels
X'##'def(buffered,1).
X'##'def(dynamica,2).
X'##'def(dynamicb,3).
X'##'def(dynamicc,4).
X
X'##'def(noinput,0). % Core input levels
X'##'def(synchronous,1).
X'##'def(complete,2).
X
X'##'def(twod,0). % Core dimensions
X'##'def(threed,1).
X
X%static struct { % default primitive attributes
X% int lineindx;
X% int fillindx;
X% int textindx;
X% int linestyl;
X% int polyintstyl;
X% int polyedgstyl;
X% float linwidth;
X% int pen;
X% int font;
X% float chwidth,chheight;
X% float chup[4], chpath[4], chspace[4];
X% int chjust;
X% int chqualty;
X% int marker;
X% int pickid;
X% int rasterop;
X% } PRIMATTS = {1,1,1,SOLID,PLAIN,SOLID,0.0,0,STICK,11.,11.,
X% {0.,1.,0.,1.},{1.,0.,0.,1.}, {0.,0.,0.,1.},
X% OFF,STRING,42,0,NORMAL};
X%
+ END-OF-FILE pl/graphics.pl
chmod 'u=rw,g=r,o=r' 'pl/graphics.pl'
echo ' -rw-r--r-- 1 brachman 2995 Sep 13 16:04 pl/graphics.pl (as sent)'
echo -n ' '
/bin/ls -l pl/graphics.pl
echo 'Extracting prtable.c'
sed 's/^X//' > prtable.c << '+ END-OF-FILE prtable.c'
X
X/*
X * Gprolog 1.4/1.5
X *
X * Barry Brachman
X * Dept. of Computer Science
X * Univ. of British Columbia
X * Vancouver, B.C. V6T 1W5
X *
X * .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X * brachman@cs.ubc.cdn
X * brachman%ubc.csnet@csnet-relay.arpa
X * brachman@ubc.csnet
X */
X
X#define NCOLS 5 /* default number of cols */
X
X/*
X * Routine to print a table
X * Modified from 'ls.c' mods (BJB/83)
X * Arguments:
X * base - address of first entry
X * num - number of entries
X * d_cols - number of columns to use if > 0, "best" size if == 0
X * width - max line width if not zero
X * prentry - address of the routine to call to print the string
X * length - address of the routine to call to determine the length
X * of string to be printed
X *
X * prtable and length are called with the the address of the base and
X * an index
X */
Xprtable(base, num, d_cols, width, prentry, length)
Xchar *base;
Xint num, d_cols;
Xint (*prentry)(), (*length)();
X{
X register int c, j;
X register int a, b, cols, loc, maxlen, nrows, z;
X
X if (num == 0)
X return;
X maxlen = get_maxlen(base, num, length) + 1;
X if (d_cols > 0)
X cols = d_cols;
X else if (width == 0)
X cols = get_columns() / maxlen;
X else
X cols = width / maxlen;
X if (cols == 0)
X cols = NCOLS;
X nrows = (num - 1) / cols + 1;
X for (a = 1; a <= nrows; a++) {
X b = c = z = loc = 0;
X for (j = 0; j < num; j++) {
X c++;
X if (c >= a + b)
X break;
X }
X while (j < num) {
X (*prentry)(base, j);
X loc += (*length)(base, j);
X z++;
X b += nrows;
X for (j++; j < num; j++) {
X c++;
X if (c >= a + b)
X break;
X }
X if (j < num) {
X while (loc < z * maxlen) {
X printf(" ");
X loc++;
X }
X }
X }
X printf("\n");
X }
X}
X
Xstatic int
Xget_maxlen(base, num, length)
Xchar *base;
Xint num;
Xint (*length)();
X{
X register int i, len, max;
X
X max = (*length)(base, 0);
X for (i = 0; i < num; i++) {
X if ((len = (*length)(base, i)) > max)
X max = len;
X }
X return(max);
X}
X
Xstatic int
Xget_columns()
X{
X char *term, tbuf[2024];
X char *getenv();
X int tgetnum();
X
X if ((term = getenv("TERM")) == (char *) 0)
X return(0);
X if (tgetent(tbuf, term) <= 0)
X return(0);
X return(tgetnum("co"));
X}
+ END-OF-FILE prtable.c
chmod 'u=rw,g=r,o=r' 'prtable.c'
echo ' -rw-r--r-- 1 brachman 2638 Sep 14 14:35 prtable.c (as sent)'
echo -n ' '
/bin/ls -l prtable.c
echo 'Extracting pushargs.s'
sed 's/^X//' > pushargs.s << '+ END-OF-FILE pushargs.s'
X
X|
X| Gprolog 1.4/1.5
X|
X| Barry Brachman
X| Dept. of Computer Science
X| Univ. of British Columbia
X| Vancouver, B.C. V6T 1W5
X|
X| .. {ihnp4!alberta, uw-beaver}!ubc-vision!ubc-cs!brachman
X| brachman@cs.ubc.cdn
X| brachman%ubc.csnet@csnet-relay.arpa
X| brachman@ubc.csnet
X|
X
X|
X| pushargs(func,argvec,arity,argtypes)
X| int func();
X| Mixed argvec[MAXARGS];
X| int arity;
X| char argtypes[MAXARGS];
X|
X| - checks elements in argvec against types found in argtypes
X| - each element in the union argvec takes up 8 bytes
X| - an element in argtypes indicates how many bytes the corresponding
X| element in argvec requires
X|
X
X.globl _pushargs
X
X_pushargs:
X link a6,#0 | a6 gets stacked
X|
X| First we get a pointer to the end of argvec
X| so that the arguments can be stacked in the correct sequence
X|
X movl a6@(16),d0 | get arity
X movl a6@(12),a0 | get address of argvec
X movl d0,d1
X asll #3,d1 | each entry always uses 8 bytes
X addl d1,a0
X|
X| Now we stack the args, in the correct sequence
X| and considering the size of each
X|
X movl a6@(20),a1 | get address of argtype vector
X addl d0,a1 | this must also point to end of list!
X jra 1f
X2:
X subql #8,a0 | field width is 8 bytes
X movb a1@-,d1 | get an element from argtype vector
X cmpb #4,d1 | just 4 bytes?
X beq 3f
X cmpb #8,d1
X beq 4f
X movb a0@,sp@- | push a character
X jra 1f
X4:
X movl a0@(4),sp@- | assume 8 bytes for now
X movl a0@(0),sp@-
X jra 1f
X3:
X movl a0@,sp@- | push vector element
X1:
X dbra d0,2b
X
X movl a6@(8),a0 | get address of func
X jsr a0@ | call func
X unlk a6
X rts
+ END-OF-FILE pushargs.s
chmod 'u=rw,g=r,o=r' 'pushargs.s'
echo ' -rw-r--r-- 1 brachman 1513 Sep 14 14:36 pushargs.s (as sent)'
echo -n ' '
/bin/ls -l pushargs.s
exit 0