allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (09/24/89)
Posting-number: Volume 8, Issue 62
Submitted-by: net@tub.UUCP (Oliver Laumann)
Archive-name: elk/part14
[Let this be a lesson to submitters: this was submitted as uuencoded,
compressed files. I lost the source information while unpacking it; this
is the best approximation I could come up with. ++bsa]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 14 (of 14)."
# Contents: lib/util/symbol.c lib/util/Makefile lib/util/string.h
# lib/util/objects.c lib/Makefile lib/chdir.c lib/when.c lib/debug.c
# lib/hunk.c lib/string.c lib/struct.c lib/hack.c lib/monitor.c
# lib/README.mon lib/c++.c lib/unix.c lib/xhp/Makefile
# lib/xhp/arrow.d lib/xhp/bboard.d lib/xhp/toggle.d
# lib/xhp/menusep.d lib/xhp/form.d lib/xhp/sash.d lib/xhp/cascade.d
# lib/xhp/pbutton.d lib/xhp/list.d lib/xhp/menubutton.d
# lib/xhp/vpw.d lib/xhp/popupmgr.d lib/xhp/valuator.d
# lib/xhp/rowcol.d lib/xhp/scroll.d lib/xhp/stext.d
# lib/xhp/textedit.d stk stk/Makefile stk/test1.c stk/test2.c
# Wrapped by net@tub on Sun Sep 17 17:32:44 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/util/symbol.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/util/symbol.c\"
else
echo shar: Extracting \"lib/util/symbol.c\" \(1267 characters\)
sed "s/^X//" >lib/util/symbol.c <<'END_OF_lib/util/symbol.c'
X#include <scheme.h>
X#include "symbol.h"
X
Xunsigned long Symbols_To_Bits (x, mflag, stab) Object x; SYMDESCR *stab; {
X register SYMDESCR *syms;
X register unsigned long mask = 0;
X Object l, s;
X register char *p;
X register n;
X
X for (l = x; !Nullp (l); l = Cdr (l)) {
X if (mflag) {
X Check_Type (l, T_Pair);
X x = Car (l);
X }
X Check_Type (x, T_Symbol);
X s = SYMBOL(x)->name;
X p = STRING(s)->data;
X n = STRING(s)->size;
X for (syms = stab; syms->name; syms++)
X if (n && strncmp (syms->name, p, n) == 0) break;
X if (syms->name == 0)
X Primitive_Error ("invalid argument: ~s", x);
X mask |= syms->val;
X if (!mflag) break;
X }
X return mask;
X}
X
XObject Bits_To_Symbols (x, mflag, stab) unsigned long x; SYMDESCR *stab; {
X register SYMDESCR *syms;
X Object list, tail, cell;
X GC_Node2;
X
X if (mflag) {
X GC_Link2 (list, tail);
X for (list = tail = Null, syms = stab; syms->name; syms++)
X if ((x & syms->val) && syms->val != ~0) {
X Object z = Intern (syms->name);
X cell = Cons (z, Null);
X if (Nullp (list))
X list = cell;
X else
X P_Setcdr (tail, cell);
X tail = cell;
X }
X GC_Unlink;
X return list;
X }
X for (syms = stab; syms->name; syms++)
X if (syms->val == x)
X return Intern (syms->name);
X return Null;
X}
END_OF_lib/util/symbol.c
if test 1267 -ne `wc -c <lib/util/symbol.c`; then
echo shar: \"lib/util/symbol.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/util/Makefile\"
else
echo shar: Extracting \"lib/util/Makefile\" \(283 characters\)
sed "s/^X//" >lib/util/Makefile <<'END_OF_lib/util/Makefile'
XH= ../../src/config.h\
X ../../src/object.h\
X ../../src/extern.h\
X ../../src/macros.h
X
XC= objects.c\
X symbol.c
X
XO= objects.o\
X symbol.o
X
Xall: $(O)
X
Xobjects.o: $(H) objects.h
Xsymbol.o: $(H) symbol.h
X
Xlint:
X lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
Xclean:
X rm -f *.o core a.out
END_OF_lib/util/Makefile
if test 283 -ne `wc -c <lib/util/Makefile`; then
echo shar: \"lib/util/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/string.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/util/string.h\"
else
echo shar: Extracting \"lib/util/string.h\" \(328 characters\)
sed "s/^X//" >lib/util/string.h <<'END_OF_lib/util/string.h'
X#define Make_C_String(from,to) {\
X register _n_;\
X if (TYPE(from) == T_Symbol)\
X from = SYMBOL(from)->name;\
X else if (TYPE(from) != T_String)\
X Wrong_Type_Combination (from, "string or symbol");\
X _n_ = STRING(from)->size;\
X to = alloca (_n_+1);\
X bcopy (STRING(from)->data, to, _n_);\
X to[_n_] = '\0';\
X}
END_OF_lib/util/string.h
if test 328 -ne `wc -c <lib/util/string.h`; then
echo shar: \"lib/util/string.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/objects.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/util/objects.c\"
else
echo shar: Extracting \"lib/util/objects.c\" \(3536 characters\)
sed "s/^X//" >lib/util/objects.c <<'END_OF_lib/util/objects.c'
X#include <varargs.h>
X#include <scheme.h>
X#include "objects.h"
X
X#define INIT_SIZE 50
X#define SIZE_INCR 20
X
Xtypedef struct {
X GENERIC group;
X Object obj;
X PFO term;
X char flags;
X} OBJECT;
Xstatic OBJECT *Pool;
Xstatic pool_size = INIT_SIZE;
X
X#define USED 0x1 /* flags */
X#define LEADER 0x2
X#define MARK 0x4
X
Xextern char *malloc(), *realloc();
X
X/* Register an object with the given group and termination function;
X * object can be marked as LEADER.
X */
XRegister_Object (obj, group, term, leader_flag) Object obj; GENERIC group;
X PFO term; {
X register OBJECT *p;
X
X for (p = Pool; p < Pool+pool_size; p++)
X if (!(p->flags & USED)) break;
X if (p == Pool+pool_size) {
X pool_size += SIZE_INCR;
X if ((Pool = (OBJECT *)realloc ((char *)Pool,
X pool_size * sizeof (OBJECT))) == 0)
X Fatal_Error ("realloc: out of memory");
X p = Pool + pool_size - SIZE_INCR;
X Clear_Pool (p, SIZE_INCR);
X }
X p->obj = obj;
X p->group = group;
X p->term = term;
X p->flags = leader_flag ? (USED|LEADER) : USED;
X}
X
XDeregister_Object (obj) Object obj; {
X register OBJECT *p;
X
X for (p = Pool; p < Pool+pool_size; p++)
X if ((p->flags & USED) && EQ(p->obj, obj))
X p->flags = 0;
X}
X
X/* Search for an object of a given type and group.
X * Use the given match function; it is called with an object and
X * the remaining arguments of Find_Object() (a va_list).
X * Null is returned when the object has not been found.
X */
X/*VARARGS*/
XObject Find_Object (va_alist) va_dcl {
X register OBJECT *p;
X register type;
X register GENERIC group;
X PFO match;
X va_list args;
X
X va_start (args);
X type = va_arg (args, int);
X group = va_arg (args, GENERIC);
X match = va_arg (args, PFO);
X for (p = Pool; p < Pool+pool_size; p++) {
X if (!(p->flags & USED) || TYPE(p->obj) != type || p->group != group)
X continue;
X if (match (p->obj, args)) {
X va_end (args);
X return p->obj;
X }
X }
X va_end (args);
X return Null;
X}
X
X/* Terminate all objects belonging to the given group except LEADERs.
X */
XTerminate_Group (group) GENERIC group; {
X register OBJECT *p;
X
X for (p = Pool; p < Pool+pool_size; p++)
X if ((p->flags & USED) && p->group == group && !(p->flags & LEADER)) {
X if (p->term)
X (void)p->term (p->obj);
X p->flags = 0;
X }
X}
X
X/* The after-GC function. LEADERs are terminated in a second pass.
X */
Xstatic void Terminate_Objects () {
X register OBJECT *p;
X register Object *tag;
X
X for (p = Pool; p < Pool+pool_size; p++) {
X if (!(p->flags & USED))
X continue;
X tag = (Object *)POINTER(p->obj);
X if (TYPE(*tag) == T_Broken_Heart) {
X SETPOINTER(p->obj, POINTER(*tag));
X } else if (p->flags & LEADER) {
X p->flags |= MARK;
X } else {
X if (p->term)
X (void)p->term (p->obj);
X p->flags = 0;
X }
X }
X for (p = Pool; p < Pool+pool_size; p++) {
X if (p->flags & MARK) {
X if (p->term)
X (void)p->term (p->obj);
X p->flags = 0;
X }
X }
X}
X
X/* Compute a unique integer from an object.
X * -1 is returned if the object is not in the pool.
X */
XUnique_Id (obj) Object obj; {
X register OBJECT *p;
X
X for (p = Pool; p < Pool+pool_size; p++)
X if ((p->flags & USED) && EQ(p->obj, obj))
X return Make_Fixnum (p-Pool);
X return -1;
X}
X
Xstatic Clear_Pool (p, n) register OBJECT *p; register n; {
X for ( ; n > 0; n--, p++)
X p->flags = 0;
X}
X
Xinit_util_objects () {
X if ((Pool = (OBJECT *)malloc (INIT_SIZE *
X (sizeof (OBJECT)))) == 0)
X Fatal_Error ("malloc: out of memory");
X Clear_Pool (Pool, INIT_SIZE);
X Register_After_GC (Terminate_Objects);
X}
END_OF_lib/util/objects.c
if test 3536 -ne `wc -c <lib/util/objects.c`; then
echo shar: \"lib/util/objects.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/Makefile\"
else
echo shar: Extracting \"lib/Makefile\" \(516 characters\)
sed "s/^X//" >lib/Makefile <<'END_OF_lib/Makefile'
XH= ../src/config.h\
X ../src/object.h\
X ../src/extern.h\
X ../src/macros.h\
X util/string.h
X
XC= string.c\
X when.c\
X chdir.c\
X hunk.c\
X monitor.c\
X struct.c\
X hack.c\
X debug.c\
X unix.c\
X c++.c
X
XO= string.o\
X when.o\
X chdir.o\
X hunk.o\
X monitor.o\
X struct.o\
X hack.o\
X debug.o\
X unix.o\
X c++.o
X
Xall: $(O)
X
Xstring.o: $(H)
Xwhen.o: $(H)
Xchdir.o: $(H)
Xhunk.o: $(H)
Xstruct.o: $(H)
Xhack.o: $(H)
Xdebug.o: $(H)
Xunix.o: $(H)
Xc++.o: $(H)
X
Xlint:
X lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
X
Xclean:
X rm -f *.o core a.out
END_OF_lib/Makefile
if test 516 -ne `wc -c <lib/Makefile`; then
echo shar: \"lib/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/chdir.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/chdir.c\"
else
echo shar: Extracting \"lib/chdir.c\" \(678 characters\)
sed "s/^X//" >lib/chdir.c <<'END_OF_lib/chdir.c'
X#include <scheme.h>
X
Xextern char *getenv(), *alloca();
XObject V_Home;
X
Xstatic Object P_Chdir (argc, argv) Object *argv; {
X Object dir;
X register n;
X register char *s;
X
X dir = argc == 0 ? Val (V_Home) : argv[0];
X Check_Type (dir, T_String);
X n = STRING(dir)->size;
X s = alloca (n+1);
X bcopy (STRING(dir)->data, s, n);
X s[n] = '\0';
X if (chdir (s) < 0) {
X Saved_Errno = errno;
X Primitive_Error ("~s: ~E", dir);
X }
X return Void;
X}
X
Xinit_lib_chdir () {
X register char *p = getenv ("HOME");
X
X if (p == 0)
X p = ".";
X Define_Variable (&V_Home, "home", Make_String (p, strlen (p)));
X Define_Primitive (P_Chdir, "chdir", 0, 1, VARARGS);
X}
END_OF_lib/chdir.c
if test 678 -ne `wc -c <lib/chdir.c`; then
echo shar: \"lib/chdir.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/when.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/when.c\"
else
echo shar: Extracting \"lib/when.c\" \(380 characters\)
sed "s/^X//" >lib/when.c <<'END_OF_lib/when.c'
X#include <scheme.h>
X
X/* (when condition form1 form2 ...)
X */
Xstatic Object P_When (argl) Object argl; {
X Object cond;
X GC_Node;
X TC_Prolog;
X
X GC_Link (argl);
X TC_Disable;
X cond = Eval (Car (argl));
X TC_Enable;
X GC_Unlink;
X return Truep (cond) ? Begin (Cdr (argl)) : False;
X}
X
Xinit_lib_when () {
X Define_Primitive (P_When, "when", 2, MANY, NOEVAL);
X}
END_OF_lib/when.c
if test 380 -ne `wc -c <lib/when.c`; then
echo shar: \"lib/when.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/debug.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/debug.c\"
else
echo shar: Extracting \"lib/debug.c\" \(217 characters\)
sed "s/^X//" >lib/debug.c <<'END_OF_lib/debug.c'
X#include <scheme.h>
X
Xstatic Object P_Debug (on) Object on; {
X Check_Type (on, T_Boolean);
X GC_Debug = EQ(on, True);
X return Void;
X}
X
Xinit_lib_debug () {
X Define_Primitive (P_Debug, "debug", 1, 1, EVAL);
X}
END_OF_lib/debug.c
if test 217 -ne `wc -c <lib/debug.c`; then
echo shar: \"lib/debug.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/hunk.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/hunk.c\"
else
echo shar: Extracting \"lib/hunk.c\" \(2073 characters\)
sed "s/^X//" >lib/hunk.c <<'END_OF_lib/hunk.c'
X#include <scheme.h>
X
X#define T_Hunk3 (T_Last+1)
X
X#define HUNK3(x) ((struct S_Hunk3 *)POINTER(x))
X
Xstruct S_Hunk3 {
X Object first, second, third;
X};
X
Xstatic Object P_Hunk3_Cons (a, b, c) Object a, b, c; {
X register char *p;
X Object h;
X GC_Node3;
X
X GC_Link3 (a, b, c);
X p = Get_Bytes (sizeof (struct S_Hunk3));
X SET(h, T_Hunk3, (struct S_Hunk3 *)p);
X HUNK3(h)->first = a; HUNK3(h)->second = b; HUNK3(h)->third = c;
X GC_Unlink;
X return h;
X}
X
Xstatic Object P_Hunk3p (x) Object x; {
X return TYPE(x) == T_Hunk3 ? True : False;
X}
X
Xstatic Object P_Hunk3_Cxr (h, n) Object h, n; {
X Check_Type (h, T_Hunk3);
X switch (Get_Integer (n)) {
X case 0: return HUNK3(h)->first;
X case 1: return HUNK3(h)->second;
X case 2: return HUNK3(h)->third;
X default: Range_Error (n);
X }
X}
X
Xstatic Object P_Hunk3_Set_Cxr (h, n, val) Object h, n, val; {
X Check_Type (h, T_Hunk3);
X switch (Get_Integer (n)) {
X case 0: HUNK3(h)->first = val; break;
X case 1: HUNK3(h)->second = val; break;
X case 2: HUNK3(h)->third = val; break;
X default: Range_Error (n);
X }
X return h;
X}
X
Xstatic Hunk3_Eqv (a, b) Object a, b; { return EQ(a,b); }
X
Xstatic Hunk3_Equal (a, b) Object a, b; {
X return Equal (HUNK3(a)->first, HUNK3(b)->first) &&
X Equal (HUNK3(a)->second, HUNK3(b)->second) &&
X Equal (HUNK3(a)->third, HUNK3(b)->third);
X}
X
Xstatic Hunk3_Print (h, port, raw, depth, length) Object h, port; {
X Printf (port, "#[hunk3 %u]", POINTER(h));
X}
X
Xstatic Hunk3_Visit (hp, f) Object *hp; int (*f)(); {
X (*f)(&HUNK3(*hp)->first);
X (*f)(&HUNK3(*hp)->second);
X (*f)(&HUNK3(*hp)->third);
X}
X
Xinit_lib_hunk () {
X Define_Type (T_Hunk3, "hunk3", NOFUNC, sizeof (struct S_Hunk3),
X Hunk3_Eqv, Hunk3_Equal, Hunk3_Print, Hunk3_Visit);
X Define_Primitive (P_Hunk3_Cons, "hunk3-cons", 3, 3, EVAL);
X Define_Primitive (P_Hunk3p, "hunk3?", 1, 1, EVAL);
X Define_Primitive (P_Hunk3_Cxr, "hunk3-cxr", 2, 2, EVAL);
X Define_Primitive (P_Hunk3_Set_Cxr, "hunk3-set-cxr!", 3, 3, EVAL);
X}
END_OF_lib/hunk.c
if test 2073 -ne `wc -c <lib/hunk.c`; then
echo shar: \"lib/hunk.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/string.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/string.c\"
else
echo shar: Extracting \"lib/string.c\" \(345 characters\)
sed "s/^X//" >lib/string.c <<'END_OF_lib/string.c'
X#include <scheme.h>
X
Xstatic Object P_String_Reverse (str) Object str; {
X register char c, *s, *t;
X
X Check_Type (str, T_String);
X for (s = STRING(str)->data, t = s+STRING(str)->size; --t > s; s++)
X c = *s, *s = *t, *t = c;
X return str;
X}
X
Xinit_lib_string () {
X Define_Primitive (P_String_Reverse, "string-reverse!", 1, 1, EVAL);
X}
END_OF_lib/string.c
if test 345 -ne `wc -c <lib/string.c`; then
echo shar: \"lib/string.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/struct.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/struct.c\"
else
echo shar: Extracting \"lib/struct.c\" \(3257 characters\)
sed "s/^X//" >lib/struct.c <<'END_OF_lib/struct.c'
X#include <scheme.h>
X
X#define STRUCT(x) ((struct S_Struct *)POINTER(x))
X
Xstruct S_Struct {
X Object name;
X Object slots;
X Object values;
X};
X
Xint T_Struct;
X
Xstatic Object P_Structurep (x) Object x; {
X return TYPE(x) == T_Struct ? True : False;
X}
X
Xstatic Object P_Structure_Name (x) Object x; {
X Check_Type (x, T_Struct);
X return STRUCT(x)->name;
X}
X
Xstatic Object P_Structure_Slots (x) Object x; {
X Check_Type (x, T_Struct);
X return P_Vector_To_List (STRUCT(x)->slots);
X}
X
Xstatic Object P_Structure_Values (x) Object x; {
X Check_Type (x, T_Struct);
X return P_Vector_To_List (STRUCT(x)->values);
X}
X
Xstatic Check_Structure_Type (x, t) Object x, t; {
X Check_Type (x, T_Struct);
X Check_Type (t, T_Symbol);
X if (!EQ(STRUCT(x)->name, t))
X Primitive_Error ("wrong structure type ~s (expected ~s)",
X STRUCT(x)->name, t);
X}
X
Xstatic Object P_Structure_Ref (x, t, n) Object x, t, n; {
X Check_Structure_Type (x, t);
X return P_Vector_Ref (STRUCT(x)->values, n);
X}
X
Xstatic Object P_Structure_Set (x, t, n, obj) Object x, t, n, obj; {
X Check_Structure_Type (x, t);
X return P_Vector_Set (STRUCT(x)->values, n, obj);
X}
X
Xstatic Object P_Make_Structure (name, slots) Object name, slots; {
X register char *p;
X register n;
X Object s, vec, *vp;
X GC_Node3;
X
X Check_Type (name, T_Symbol);
X Check_List (slots);
X s = Null;
X GC_Link3 (s, name, slots);
X p = Get_Bytes (sizeof (struct S_Struct));
X SET(s, T_Struct, (struct S_Struct *)p);
X STRUCT(s)->name = name;
X n = Internal_Length (slots);
X vec = Make_Vector (n, Null);
X STRUCT(s)->values = vec;
X vec = Make_Vector (n, Null);
X STRUCT(s)->slots = vec;
X GC_Unlink;
X for (vp = VECTOR(vec)->data; n--; slots = Cdr (slots)) {
X Check_Type (Car (slots), T_Symbol);
X *vp++ = Car (slots);
X }
X return s;
X}
X
Xstatic Structure_Eqv (a, b) Object a, b; { return EQ(a,b); }
X
Xstatic Structure_Equal (a, b) Object a, b; {
X return EQ(STRUCT(a)->name,STRUCT(b)->name) &&
X Equal (STRUCT(a)->slots, STRUCT(b)->slots) &&
X Equal (STRUCT(a)->values, STRUCT(b)->values);
X}
X
Xstatic Structure_Print (x, port, raw, depth, length) Object x, port; {
X GC_Node2;
X
X GC_Link2 (port, x);
X Printf (port, "#[");
X Print_Object (STRUCT(x)->name, port, raw, depth, length);
X Printf (port, "-structure %u]", POINTER(x));
X GC_Unlink;
X}
X
Xstatic Structure_Visit (sp, f) register Object *sp; register (*f)(); {
X (*f)(&STRUCT(*sp)->name);
X (*f)(&STRUCT(*sp)->slots);
X (*f)(&STRUCT(*sp)->values);
X}
X
Xinit_lib_struct () {
X T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct),
X Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit);
X Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL);
X Define_Primitive (P_Structure_Name, "structure-name", 1, 1, EVAL);
X Define_Primitive (P_Structure_Slots, "structure-slots", 1, 1, EVAL);
X Define_Primitive (P_Structure_Values, "structure-values", 1, 1, EVAL);
X Define_Primitive (P_Structure_Ref, "structure-ref", 3, 3, EVAL);
X Define_Primitive (P_Structure_Set, "structure-set!", 4, 4, EVAL);
X Define_Primitive (P_Make_Structure, "make-structure", 2, 2, EVAL);
X P_Provide (Intern ("structures"));
X}
END_OF_lib/struct.c
if test 3257 -ne `wc -c <lib/struct.c`; then
echo shar: \"lib/struct.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/hack.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/hack.c\"
else
echo shar: Extracting \"lib/hack.c\" \(347 characters\)
sed "s/^X//" >lib/hack.c <<'END_OF_lib/hack.c'
X#include <scheme.h>
X
Xstatic Object P_Hack_Procedure_Environment (p, e) Object p, e; {
X Check_Type (p, T_Compound);
X Check_Type (e, T_Environment);
X COMPOUND(p)->env = e;
X return p;
X}
X
Xinit_lib_hack () {
X Define_Primitive (P_Hack_Procedure_Environment,
X "hack-procedure-environment!", 2, 2, EVAL);
X P_Provide (Intern ("hack"));
X}
END_OF_lib/hack.c
if test 347 -ne `wc -c <lib/hack.c`; then
echo shar: \"lib/hack.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/monitor.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/monitor.c\"
else
echo shar: Extracting \"lib/monitor.c\" \(433 characters\)
sed "s/^X//" >lib/monitor.c <<'END_OF_lib/monitor.c'
X#include <scheme.h>
X
X#define MONSTART 2
X
Xstatic monitoring;
X
Xstatic Object P_Monitor (on) Object on; {
X char *brk;
X
X Check_Type (on, T_Boolean);
X if (Truep (on)) {
X if (!monitoring) {
X brk = sbrk (0);
X monstartup (MONSTART, (int (*)())brk);
X monitoring = 1;
X }
X } else {
X monitor (0);
X monitoring = 0;
X }
X return Void;
X}
X
Xinit_lib_monitor () {
X Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL);
X}
END_OF_lib/monitor.c
if test 433 -ne `wc -c <lib/monitor.c`; then
echo shar: \"lib/monitor.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/README.mon -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/README.mon\"
else
echo shar: Extracting \"lib/README.mon\" \(322 characters\)
sed "s/^X//" >lib/README.mon <<'END_OF_lib/README.mon'
XBSD:
X 1) ar x /lib/libc.a mon.o
X 2) In the symboltable of mon.o replace mcount by Mcount
X and _moncontrol by _Moncontrol (using emacs).
X
XSun:
X 1) cp /lib/mcrt0.o mon.o
X 2) In the symboltable of mon.o replace start by Start
X and _environ by _Environ.
X
X3) ld -r mon.o monitor.o; mv a.out monitor.o; rm mon.o
END_OF_lib/README.mon
if test 322 -ne `wc -c <lib/README.mon`; then
echo shar: \"lib/README.mon\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/c++.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/c++.c\"
else
echo shar: Extracting \"lib/c++.c\" \(483 characters\)
sed "s/^X//" >lib/c++.c <<'END_OF_lib/c++.c'
X#include <scheme.h>
X
Xstatic Object New_Handler;
X
Xstatic void New_Handler_Proc () {
X (void)Funcall (New_Handler, Null, 0);
X}
X
Xstatic Object P_Set_New_Handler (p) Object p; {
X Object old;
X
X Check_Procedure (p);
X old = New_Handler;
X New_Handler = p;
X return old;
X}
X
Xinit_lib_cplusplus () {
X New_Handler = Null;
X Global_GC_Link (New_Handler);
X set_new_handler (New_Handler_Proc);
X Define_Primitive (P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL);
X}
END_OF_lib/c++.c
if test 483 -ne `wc -c <lib/c++.c`; then
echo shar: \"lib/c++.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/unix.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/unix.c\"
else
echo shar: Extracting \"lib/unix.c\" \(2889 characters\)
sed "s/^X//" >lib/unix.c <<'END_OF_lib/unix.c'
X#include <sys/types.h>
X#include <sys/stat.h>
X#include <errno.h>
X#include <signal.h>
X
X#include <scheme.h>
X#include "util/string.h"
X
X#ifdef DIRENT
X# include <dirent.h>
X#else
X# include <sys/dir.h>
X#endif
X
Xextern char *getenv();
X
Xstatic Object P_Read_Directory (name) Object name; {
X register char *s;
X register DIR *d;
X#ifdef DIRENT
X register struct dirent *dp;
X#else
X register struct direct *dp;
X#endif
X Object ret;
X GC_Node;
X
X ret = Null;
X GC_Link (ret);
X Make_C_String (name, s);
X Disable_Interrupts;
X if ((d = opendir (s)) == NULL)
X Primitive_Error ("cannot open directory ~s", name);
X while ((dp = readdir (d)) != NULL) {
X Object x = Make_String (dp->d_name, strlen (dp->d_name));
X ret = Cons (x, ret);
X }
X closedir (d);
X Enable_Interrupts;
X GC_Unlink;
X return ret;
X}
X
Xstatic Object P_File_Status (name) Object name; {
X register char *s;
X struct stat st;
X
X Make_C_String (name, s);
X if (stat (s, &st) == -1) {
X switch (errno) {
X case ENOTDIR:
X case EINVAL:
X case ENOENT:
X case EACCES:
X#ifdef ENAMETOOLONG
X case ENAMETOOLONG:
X#endif
X#ifdef ELOOP
X case ELOOP:
X#endif
X s = "non-existent"; break;
X default:
X Saved_Errno = errno;
X Primitive_Error ("cannot stat ~s: ~E", name);
X }
X } else {
X switch (st.st_mode & S_IFMT) {
X case S_IFDIR: s = "directory"; break;
X case S_IFCHR: s = "character-special"; break;
X case S_IFBLK: s = "block-special"; break;
X case S_IFREG: s = "regular"; break;
X#ifdef S_IFSOCK
X case S_IFSOCK: s = "socket"; break;
X#endif
X#ifdef S_IFFIFO
X case S_IFFIFO: s = "fifo"; break;
X#endif
X default: s = "unknown"; break;
X }
X }
X return Intern (s);
X}
X
Xstatic Object P_System (cmd) Object cmd; {
X register char *s;
X register i, n, pid;
X int status;
X
X Make_C_String (cmd, s);
X#ifdef VFORK
X switch (pid = vfork ()) {
X#else
X switch (pid = fork ()) {
X#endif
X case -1:
X Saved_Errno = errno;
X Primitive_Error ("cannot fork: ~E");
X case 0:
X#ifdef MAX_OFILES
X n = MAX_OFILES;
X#else
X n = getdtablesize ();
X#endif
X for (i = 3; i < n; i++)
X (void)close (i);
X execl ("/bin/sh", "sh", "-c", s, (char *)0);
X _exit (127);
X default:
X Disable_Interrupts;
X while ((i = wait (&status)) != pid && i != -1)
X ;
X Enable_Interrupts;
X }
X if (i == -1)
X return False;
X if (n = (status & 0377))
X return Cons (Make_Fixnum (n), Null);
X return Make_Fixnum ((status >> 8) & 0377);
X}
X
Xstatic Object P_Getenv (e) Object e; {
X register char *s;
X
X Make_C_String (e, s);
X return (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
X}
X
Xinit_lib_unix () {
X Define_Primitive (P_Read_Directory, "read-directory", 1, 1, EVAL);
X Define_Primitive (P_File_Status, "file-status", 1, 1, EVAL);
X Define_Primitive (P_System, "system", 1, 1, EVAL);
X Define_Primitive (P_Getenv, "getenv", 1, 1, EVAL);
X P_Provide (Intern ("unix"));
X}
END_OF_lib/unix.c
if test 2889 -ne `wc -c <lib/unix.c`; then
echo shar: \"lib/unix.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/Makefile\"
else
echo shar: Extracting \"lib/xhp/Makefile\" \(509 characters\)
sed "s/^X//" >lib/xhp/Makefile <<'END_OF_lib/xhp/Makefile'
XWIDGET_SET= xhp
X
XO= arrow.o\
X bboard.o\
X cascade.o\
X form.o\
X list.o\
X menubutton.o\
X menusep.o\
X pbutton.o\
X popupmgr.o\
X rowcol.o\
X sash.o\
X scroll.o\
X stext.o\
X textedit.o\
X toggle.o\
X valuator.o\
X vpw.o
X
X.SUFFIXES: .d .c .o
X
X.d.c:
X ../../src/scheme -l ../xt/make-widget $< $@ $(WIDGET_SET)
X
X.d.o:
X ../../src/scheme -l ../xt/make-widget $< $*.c $(WIDGET_SET)
X $(CC) $(CFLAGS) -c $*.c
X
Xall: $(O)
X
Xlint:
X lint $(LINTFLAGS) -abxh *.c | egrep -v '\?\?\?'
X
Xclean:
X rm -f *.o *.c
END_OF_lib/xhp/Makefile
if test 509 -ne `wc -c <lib/xhp/Makefile`; then
echo shar: \"lib/xhp/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/arrow.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/arrow.d\"
else
echo shar: Extracting \"lib/xhp/arrow.d\" \(180 characters\)
sed "s/^X//" >lib/xhp/arrow.d <<'END_OF_lib/xhp/arrow.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'arrow "Arrow.h")
X
X(define-widget-class 'arrow 'XwarrowWidgetClass)
X
X(define-callback 'arrow 'select #f)
X(define-callback 'arrow 'release #f)
END_OF_lib/xhp/arrow.d
if test 180 -ne `wc -c <lib/xhp/arrow.d`; then
echo shar: \"lib/xhp/arrow.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/bboard.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/bboard.d\"
else
echo shar: Extracting \"lib/xhp/bboard.d\" \(117 characters\)
sed "s/^X//" >lib/xhp/bboard.d <<'END_OF_lib/xhp/bboard.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'bboard "BBoard.h")
X
X(define-widget-class 'bboard 'XwbulletinBoardWidgetClass)
END_OF_lib/xhp/bboard.d
if test 117 -ne `wc -c <lib/xhp/bboard.d`; then
echo shar: \"lib/xhp/bboard.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/toggle.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/toggle.d\"
else
echo shar: Extracting \"lib/xhp/toggle.d\" \(186 characters\)
sed "s/^X//" >lib/xhp/toggle.d <<'END_OF_lib/xhp/toggle.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'toggle "Toggle.h")
X
X(define-widget-class 'toggle 'XwtoggleWidgetClass)
X
X(define-callback 'toggle 'select #f)
X(define-callback 'toggle 'release #f)
END_OF_lib/xhp/toggle.d
if test 186 -ne `wc -c <lib/xhp/toggle.d`; then
echo shar: \"lib/xhp/toggle.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/menusep.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/menusep.d\"
else
echo shar: Extracting \"lib/xhp/menusep.d\" \(121 characters\)
sed "s/^X//" >lib/xhp/menusep.d <<'END_OF_lib/xhp/menusep.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'menusep "MenuSep.h")
X
X(define-widget-class 'menu-separator 'XwmenuSepWidgetClass)
END_OF_lib/xhp/menusep.d
if test 121 -ne `wc -c <lib/xhp/menusep.d`; then
echo shar: \"lib/xhp/menusep.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/form.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/form.d\"
else
echo shar: Extracting \"lib/xhp/form.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/form.d <<'END_OF_lib/xhp/form.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'form "Form.h")
X
X(define-widget-class 'form 'XwformWidgetClass)
END_OF_lib/xhp/form.d
if test 102 -ne `wc -c <lib/xhp/form.d`; then
echo shar: \"lib/xhp/form.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/sash.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/sash.d\"
else
echo shar: Extracting \"lib/xhp/sash.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/sash.d <<'END_OF_lib/xhp/sash.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'sash "Sash.h")
X
X(define-widget-class 'sash 'XwsashWidgetClass)
END_OF_lib/xhp/sash.d
if test 102 -ne `wc -c <lib/xhp/sash.d`; then
echo shar: \"lib/xhp/sash.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/cascade.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/cascade.d\"
else
echo shar: Extracting \"lib/xhp/cascade.d\" \(114 characters\)
sed "s/^X//" >lib/xhp/cascade.d <<'END_OF_lib/xhp/cascade.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'cascade "Cascade.h")
X
X(define-widget-class 'cascade 'XwcascadeWidgetClass)
END_OF_lib/xhp/cascade.d
if test 114 -ne `wc -c <lib/xhp/cascade.d`; then
echo shar: \"lib/xhp/cascade.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/pbutton.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/pbutton.d\"
else
echo shar: Extracting \"lib/xhp/pbutton.d\" \(207 characters\)
sed "s/^X//" >lib/xhp/pbutton.d <<'END_OF_lib/xhp/pbutton.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'pbutton "PButton.h")
X
X(define-widget-class 'push-button 'XwpushButtonWidgetClass)
X
X(define-callback 'push-button 'select #f)
X(define-callback 'push-button 'release #f)
END_OF_lib/xhp/pbutton.d
if test 207 -ne `wc -c <lib/xhp/pbutton.d`; then
echo shar: \"lib/xhp/pbutton.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/list.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/list.d\"
else
echo shar: Extracting \"lib/xhp/list.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/list.d <<'END_OF_lib/xhp/list.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'list "List.h")
X
X(define-widget-class 'list 'XwlistWidgetClass)
END_OF_lib/xhp/list.d
if test 102 -ne `wc -c <lib/xhp/list.d`; then
echo shar: \"lib/xhp/list.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/menubutton.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/menubutton.d\"
else
echo shar: Extracting \"lib/xhp/menubutton.d\" \(167 characters\)
sed "s/^X//" >lib/xhp/menubutton.d <<'END_OF_lib/xhp/menubutton.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'menubutton "MenuBtn.h")
X
X(define-widget-class 'menu-button 'XwmenubuttonWidgetClass)
X
X(define-callback 'menu-button 'select #f)
END_OF_lib/xhp/menubutton.d
if test 167 -ne `wc -c <lib/xhp/menubutton.d`; then
echo shar: \"lib/xhp/menubutton.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/vpw.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/vpw.d\"
else
echo shar: Extracting \"lib/xhp/vpw.d\" \(101 characters\)
sed "s/^X//" >lib/xhp/vpw.d <<'END_OF_lib/xhp/vpw.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'vpw "VPW.h")
X
X(define-widget-class 'vpw 'XwvPanedWidgetClass)
END_OF_lib/xhp/vpw.d
if test 101 -ne `wc -c <lib/xhp/vpw.d`; then
echo shar: \"lib/xhp/vpw.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/popupmgr.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/popupmgr.d\"
else
echo shar: Extracting \"lib/xhp/popupmgr.d\" \(123 characters\)
sed "s/^X//" >lib/xhp/popupmgr.d <<'END_OF_lib/xhp/popupmgr.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'popupmgr "PopupMgr.h")
X
X(define-widget-class 'popup-manager 'XwpopupMgrWidgetClass)
END_OF_lib/xhp/popupmgr.d
if test 123 -ne `wc -c <lib/xhp/popupmgr.d`; then
echo shar: \"lib/xhp/popupmgr.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/valuator.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/valuator.d\"
else
echo shar: Extracting \"lib/xhp/valuator.d\" \(470 characters\)
sed "s/^X//" >lib/xhp/valuator.d <<'END_OF_lib/xhp/valuator.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'valuator "Valuator.h")
X
X(define-widget-class 'valuator 'XwvaluatorWidgetClass)
X
X(define-callback 'valuator 'sliderMoved #t)
X(define-callback 'valuator 'sliderReleased #t)
X(define-callback 'valuator 'areaSelected #t)
X
X(c->scheme 'valuator-sliderMoved
X" return Make_Integer ((int)x);")
X(c->scheme 'valuator-sliderReleased
X" return Make_Integer ((int)x);")
X(c->scheme 'valuator-areaSelected
X" return Make_Integer ((int)x);")
END_OF_lib/xhp/valuator.d
if test 470 -ne `wc -c <lib/xhp/valuator.d`; then
echo shar: \"lib/xhp/valuator.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/rowcol.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/rowcol.d\"
else
echo shar: Extracting \"lib/xhp/rowcol.d\" \(114 characters\)
sed "s/^X//" >lib/xhp/rowcol.d <<'END_OF_lib/xhp/rowcol.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'rowcol "RCManager.h")
X
X(define-widget-class 'row-col 'XwrowColWidgetClass)
END_OF_lib/xhp/rowcol.d
if test 114 -ne `wc -c <lib/xhp/rowcol.d`; then
echo shar: \"lib/xhp/rowcol.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/scroll.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/scroll.d\"
else
echo shar: Extracting \"lib/xhp/scroll.d\" \(480 characters\)
sed "s/^X//" >lib/xhp/scroll.d <<'END_OF_lib/xhp/scroll.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'scrollbar "ScrollBar.h")
X
X(define-widget-class 'scrollbar 'XwscrollbarWidgetClass)
X
X(define-callback 'scrollbar 'sliderMoved #t)
X(define-callback 'scrollbar 'sliderReleased #t)
X(define-callback 'scrollbar 'areaSelected #t)
X
X(c->scheme 'scrollbar-sliderMoved
X" return Make_Integer ((int)x);")
X(c->scheme 'scrollbar-sliderReleased
X" return Make_Integer ((int)x);")
X(c->scheme 'scrollbar-areaSelected
X" return Make_Integer ((int)x);")
END_OF_lib/xhp/scroll.d
if test 480 -ne `wc -c <lib/xhp/scroll.d`; then
echo shar: \"lib/xhp/scroll.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/stext.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/stext.d\"
else
echo shar: Extracting \"lib/xhp/stext.d\" \(203 characters\)
sed "s/^X//" >lib/xhp/stext.d <<'END_OF_lib/xhp/stext.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'stext "SText.h")
X
X(define-widget-class 'static-text 'XwstatictextWidgetClass)
X
X(define-callback 'static-text 'select #f)
X(define-callback 'static-text 'release #f)
END_OF_lib/xhp/stext.d
if test 203 -ne `wc -c <lib/xhp/stext.d`; then
echo shar: \"lib/xhp/stext.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/textedit.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xhp/textedit.d\"
else
echo shar: Extracting \"lib/xhp/textedit.d\" \(1236 characters\)
sed "s/^X//" >lib/xhp/textedit.d <<'END_OF_lib/xhp/textedit.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'textedit "TextEdit.h"
X
X"static SYMDESCR Sourcetype_Syms[] = {
X { \"string\", XwstringSrc },
X { \"disk\", XwdiskSrc },
X { \"prog-defined\", XwprogDefinedSrc },
X { 0, 0 }
X};
Xstatic SYMDESCR Edittype_Syms[] = {
X { \"text-read\", XwtextRead },
X { \"text-append\", XwtextAppend },
X { \"text-edit\", XwtextEdit },
X { 0, 0 }
X};")
X
X(scheme->c 'text-edit-editType
X" return (XtArgVal)Symbols_To_Bits (x, 0, Edittype_Syms);")
X
X(scheme->c 'text-edit-sourceType
X" return (XtArgVal)Symbols_To_Bits (x, 0, Sourcetype_Syms);")
X
X(define-widget-class 'text-edit 'XwtexteditWidgetClass
X '(string String String)
X '(maximumSize Length Int)
X '(file String String)
X '(editType EditType EditMode)
X '(font Font FontStruct)
X '(foreground Foreground Pixel))
X
X(define-primitive 'text-copy-buffer '(w)
X" char *b;
X Object ret;
X Check_Widget_Class (w, XwtexteditWidgetClass);
X b = (char *)XwTextCopyBuffer (WIDGET(w)->widget);
X ret = Make_String (b, strlen (b));
X XtFree (b);
X return ret;")
X
X(define-primitive 'text-clear-buffer '(w)
X" Check_Widget_Class (w, XwtexteditWidgetClass);
X XwTextClearBuffer (WIDGET(w)->widget);
X return Void;")
END_OF_lib/xhp/textedit.d
if test 1236 -ne `wc -c <lib/xhp/textedit.d`; then
echo shar: \"lib/xhp/textedit.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d stk ; then
echo shar: Creating directory \"stk\"
mkdir stk
fi
if test -f stk/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"stk/Makefile\"
else
echo shar: Extracting \"stk/Makefile\" \(364 characters\)
sed "s/^X//" >stk/Makefile <<'END_OF_stk/Makefile'
XMACHTYPE= 68k
X
Xall: test1 test2
X
Xtest1: test1.o ../src/stack.o
X $(CC) $(CFLAGS) -o test1 test1.c ../src/stack.o
X
Xtest2: test2.o ../src/stack.o
X $(CC) $(CFLAGS) -o test2 test2.c ../src/stack.o
X
X../src/stack.o: ../src/stack.s
X cp ../src/stack.s.$(MACHTYPE) ../src/stack.s
X /lib/cpp <../src/stack.s | sed '/^#/d' >stack.ss
X as -o ../src/stack.o stack.ss
X rm stack.ss
END_OF_stk/Makefile
if test 364 -ne `wc -c <stk/Makefile`; then
echo shar: \"stk/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f stk/test1.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"stk/test1.c\"
else
echo shar: Extracting \"stk/test1.c\" \(658 characters\)
sed "s/^X//" >stk/test1.c <<'END_OF_stk/test1.c'
X/* This program tests whether stksize() is producing reasonable
X * results.
X */
X
Xint Special;
Xchar *stkbase;
X
Xmain () {
X char foo;
X
X stkbase = &foo;
X f ();
X printf ("stksize() seems to work fine.\n");
X exit (0);
X}
X
Xf () {
X int s, t;
X char buf[100];
X
X s = stksize ();
X if (s < 100 || s > 100000) {
X printf ("There seems to be a problem [1] with stksize().\n");
X exit (1);
X }
X (void)alloca (100);
X t = stksize ();
X if (t < s) {
X printf ("There seems to be a problem [2] with stksize().\n");
X exit (1);
X }
X if (t > s + 104) {
X printf ("There seems to be a problem with stksize() or alloca().\n");
X exit (1);
X }
X}
END_OF_stk/test1.c
if test 658 -ne `wc -c <stk/test1.c`; then
echo shar: \"stk/test1.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f stk/test2.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"stk/test2.c\"
else
echo shar: Extracting \"stk/test2.c\" \(857 characters\)
sed "s/^X//" >stk/test2.c <<'END_OF_stk/test2.c'
X/* If saveenv() and jmpenv() are working correctly, this program
X * prints the numbers 0 to 9.
X */
X
Xchar *malloc();
Xchar *env, *env2;
Xchar *stkbase;
Xint Special;
X
Xint i, r = 1;
X
Xmain () {
X char foo;
X
X stkbase = &foo;
X i = inner ();
X if (i == 7)
X jmpenv (env2, 9);
X jmpenv (env, r++);
X printf ("There seems to be a problem [1] with saveenv or jmpenv.\n");
X exit (1);
X}
X
Xinner () {
X int r, len;
X
X inner2 ();
X len = stksize ();
X env = malloc (len);
X r = saveenv (env);
X printf ("%d\n", r+1);
X return r;
X}
X
Xinner2 () {
X int r, len = stksize ();
X int a[10000];
X a[0] = 1; a[9999] = 2;
X
X env2 = malloc (len);
X r = saveenv (env2);
X printf ("%d\n", r);
X if (a[0] != 1 || a[9999] != 2) {
X printf ("There seems to be a problem [2] with saveenv or jmpenv.\n");
X exit (1);
X }
X if (r > 0)
X exit ();
X}
END_OF_stk/test2.c
if test 857 -ne `wc -c <stk/test2.c`; then
echo shar: \"stk/test2.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 14 \(of 14\).
cp /dev/null ark14isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 14 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0