v23i088: ABC interactive programming environment, Part09/25
Rich Salz
rsalz at bbn.com
Wed Dec 19 06:36:50 AEST 1990
Submitted-by: Steven Pemberton <steven at cwi.nl>
Posting-number: Volume 23, Issue 88
Archive-name: abc/part09
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix at uunet.uu.net if you want that tool.
# Contents: abc/Setup abc/bed/e1sugg.c abc/bint2/i2exp.c
# abc/scripts/mkdep.gen
# Wrapped by rsalz at litchi.bbn.com on Mon Dec 17 13:28:00 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo ' "shar: End of archive 9 (of 25)."'
if test -f 'abc/Setup' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/Setup'\"
else
echo shar: Extracting \"'abc/Setup'\" \(18623 characters\)
sed "s/^X//" >'abc/Setup' <<'END_OF_FILE'
X: 'Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988.'
X
Xecho "Configuration questions for the ABC system."
X
X: some greps do not return status, fix this first.
Xecho "grimblepritz" >grimble
Xif grep blurfldyick grimble >/dev/null 2>&1 ; then
X contains=./contains
Xelse
X if grep grimblepritz grimble >/dev/null 2>&1 ; then
X contains=grep
X else
X contains=./contains
X fi
Xfi
Xrm grimble
X: the following should work in any shell
Xcase $contains in
X./contains)
X echo " "
X echo "Grep doesn't return a status; attempting remedial action."
X cat >contains <<'EOF'
X grep "$1" "$2" >.greptmp && cat .greptmp && test -s .greptmp
XEOF
X chmod 755 ./contains;;
Xesac
X
X: 'Determine if echo -n works'
Xecho -n "bleep" >bleep
Xif $contains n bleep >/dev/null 2>&1
Xthen
X n=""
Xelse
X n="-n"
Xfi
Xrm -f bleep
X
X: 'Get answers from previous run'
Xif test -r answers
Xthen
X . answers
Xelse
X rootdef="/tmp/abc"
X abcdef="/usr/new"
X libdef="/usr/new/lib/abc"
X mandef="/usr/man/mann"
Xfi
X
X: 'Are we preparing for cross compilation?'
Xecho " "
Xecho $n "Are you going to cross-compile the ABC system to a remote machine? "
Xread ans
Xcase $ans in
Xy*|Y*|t*|T*)
Xremote=" remote"
Xrootdir='blurfl'
Xwhile test ! -d "$rootdir" ; do
X case $rootdir in
X blurfl)
X echo " "
X echo "Then please type the full pathname of a local directory"
X echo "where you have write permission"
X echo "and which we can use as a local root to install"
X echo "the ABC system for you to copy to the remote machine"
X echo $n " (default $rootdef) "
X ;;
X *) echo "$rootdir does not appear to exist."
X echo $n "Are you sure you typed the right name? "
X read ans
X case $ans in
X y*|Y*) echo "Don't forget to make $rootdir before 'make install'."
X break
X ;;
X *) echo " "
X echo $n "Please try again (default $rootdef) "
X ;;
X esac
X ;;
X esac
X read rootdir
X case $rootdir in
X "") rootdir=$rootdef;;
X esac
Xdone
X;;
X*)
Xremote=""
Xrootdir=""
X;;
Xesac
X
X: 'What unix?'
Xecho " "
Xecho $n "Finding out about your brand of unix ... "
Xcat >brand.c <<EOF
X#include <stdio.h>
X#include <signal.h>
Xmain() {
X#ifdef SIGCHLD
X#ifdef SIGVTALRM
X printf("BSD4_2\n");
X#else
X printf("BSD\n");
X#endif
X#else
X#ifdef SIGCLD
X printf("ATT\n");
X#else
X printf("unknown\n"); /* Version 7 we hope ... */
X#endif
X#endif
X}
XEOF
Xcc brand.c -o brand
Xunix=`./brand`
Xrm -f brand*
X
Xecho " "
Xcase $unix in
XBSD4_2)
X echo "You appear to be running Berkeley's BSD unix, version 4.2 (or later)."
X echo $n "Is this true? "
X read ans
X case $ans in
X n*|N*|f*|F*) unix="unknown";;
X esac
X ;;
XBSD)
X echo "You appear to be running Berkeley's BSD unix."
X echo $n "Is this true? "
X read ans
X case $ans in
X n*|N*|f*|F*) unix="unknown";;
X esac
X ;;
XATT)
X echo "You appear to be running ATT's System III or System V unix."
X echo $n "Is this true? "
X read ans
X case $ans in
X n*|N*|f*|F*) unix="unknown";;
X esac
X ;;
Xesac
X
Xcase $unix in
Xunknown)
X echo "You might be running VERSION 7 unix."
X echo $n "Is this true? "
X read ans
X case $ans in
X y*|Y*|t*|T*)
X unix=VERSION7;;
X *) echo "We cannot find out what type of unix you are running."
X echo "See ./uhdrs/*.h and ./Problems in case of problems."
X unix=""
X ;;
X esac
X ;;
Xesac
X
X: 'termio system?'
Xecho " "
Xecho $n "Checking for termio system ... "
Xtermio=""
Xcase $unix in
XATT) if test -r /usr/include/termio.h
X then
X termio="#define"
X echo "termio.h found."
X elif test -r /usr/include/sgtty.h
X then
X termio="#undef"
X echo "sgtty.h found."
X fi
X ;;
X*) if test -r /usr/include/sgtty.h
X then
X termio="#undef "
X echo "sgtty.h found."
X elif test -r /usr/include/termio.h
X then
X termio="#define"
X echo "termio.h found."
X fi
X ;;
Xesac
Xcase $termio in
X'') echo " "
X echo "Neither termio.h nor sgtty.h found."
X echo "See ./unix/u1trm.c, ./unix/u1keys.c and ./keys/abckeys.c"
X echo "in case of problems."
X termio="#undef "
Xesac
X
X: 'Include <strings.h> or <string.h>?'
Xecho " "
Xecho $n "Finding include file for string operations ... "
Xif test -r /usr/include/strings.h
Xthen
X strs="<strings.h>"
X echo "strings.h found."
Xelse
X if test -r /usr/include/string.h
X then
X strs="<string.h>"
X echo "string.h found."
X else
X strs="no_strs"
X echo " "
X echo "Neither strings.h nor string.h found."
X echo "We will add some external definitions to ./uhdrs/os.h."
X fi
Xfi
X
X: 'Some ATT System V have <unistd.h> for <sys/file.h>'
X: 'Some systems have both and may need either one, so we must check'
Xecho " "
Xecho $n "Finding include file for access modes ... "
Xif $contains F_OK /usr/include/sys/file.h >/dev/null 2>&1
Xthen
X modes="<sys/file.h>"
X echo "proper sys/file.h found."
Xelse
X if $contains F_OK /usr/include/unistd.h >/dev/null 2>&1
X then
X modes="<unistd.h>"
X echo "proper unistd.h found."
X else
X modes="no_modes"
X echo " "
X echo "No access mode definitions found in sys/file.h or unistd.h."
X echo "We will substitute our own definitions in ./uhdrs/os.h."
X fi
Xfi
X
X: 'Some Berkeley systems (and the PC:-) have ftime(), including <sys/timeb.h>'
Xecho " "
Xecho $n "Finding include file for ftime(3) ... "
Xif test -r /usr/include/sys/timeb.h
Xthen
X ftime="#define"
X echo "sys/timeb.h found."
Xelse
X ftime="#undef "
X echo " "
X echo "No sys/timeb.h found."
X echo "We will assume ftime(3) is not available in ./uhdrs/os.h."
X echo "The ABC function \"now\" will only return entire seconds."
Xfi
X
X: 'Check for void type'
Xecho " "
Xecho $n "Checking to see if your compiler accepts the void type ... "
Xcat >void.c << EOF
Xvoid main();
XEOF
Xif cc -c void.c >/dev/null 2>&1
Xthen
X void="(void)"
X echo "yes, it does."
Xelse
X void=" "
X echo "no, it doesn't."
X echo "We will use an empty VOID in casts."
Xfi
Xrm -f void.c void.o
X
X: 'Determine type for signal handlers'
Xcase $void in
X"(void)")
Xecho " "
Xecho $n "Finding type for signal handlers ... "
Xecho "#include <signal.h>" >sigtype.c
Xecho "main() { void (*oldsig)(); oldsig= signal(SIGINT, SIG_IGN); }" >>sigtype.c
Xcc -c sigtype.c >warnings 2>&1
Xif test -s warnings
Xthen
X sigtype=int
X echo "assuming int."
Xelse
X sigtype=void
X echo "found void."
Xfi
Xrm -f sigtype.c sigtype.o warnings
X;;
X*) sigtype=int;;
Xesac
X
X: 'Floating point arithmetic ok?'
Xecho " "
Xcase $remote in
X" remote")
Xecho "Does your C compiler need a special flag for"
Xecho $n "loading (probably software) floating point routines? "
Xread ans
Xcase $ans in
Xy*|Y*) echo $n "What flag is needed (default -f) "
X read fflag
X case $fflag in
X '') fflag="-f";;
X esac
X echo "We will try $fflag."
X ;;
X*) echo "Assuming no flag is needed."
X fflag=
X ;;
Xesac
X;;
X*)
Xecho $n "Checking your floating point ... "
Xcat >float.c <<EOF
X#include <stdio.h>
Xdouble dadd(a, b) double a, b; {
X return a+b;
X}
Xmain() {
X double a, b, c;
X double dadd();
X a = 3.14;
X b = 2.7 * a;
X c = dadd(a, b);
X exit(0);
X}
XEOF
Xcc -O float.c -o float >/dev/null 2>&1
Xecho " "
Xif sh 2>/dev/null <<EOF
X if ./float
X then exit 0
X else exit 1
X fi
XEOF
Xthen
X echo "Your floating point seems to be alright."
X fflag=""
Xelse
X echo "Your C compiler seems to need a special flag for"
X echo "loading (probably software) floating point routines."
X echo $n "What flag is needed (default -f) "
X read fflag
X case $fflag in
X '') fflag="-f";;
X esac
X cc -O $fflag float.c -o float >/dev/null 2>&1
X until sh 2>/dev/null <<EOF
X if ./float
X then echo "Flag $fflag seems to be allright."
X exit 0
X else exit 1
X fi
XEOF
X do
X echo "This flag doesn't seem to work."
X echo "Try again ([RETURN] to give up) "
X read fflag
X case $fflag in
X '') echo "Giving up on floating point flag"
X break;;
X esac
X cc -O $fflag float.c -o float >/dev/null 2>&1
X done
Xfi
Xrm -f float* core
X;;
Xesac
X
X: 'termcap library for ABC editor'
Xecho " "
Xecho $n "Searching for your termcap-like library routines ... "
Xif test -r /lib/libtermcap.a -o -r /usr/lib/libtermcap.a
Xthen
X termlib="-ltermcap"
X echo "termcap library found."
Xelif test -r /usr/local/lib/libtermcap.a
Xthen
X termlib="/usr/local/lib/libtermcap.a"
X echo "local termcap library found."
Xelif test -r /lib/libcurses.a -o -r /usr/lib/libcurses.a
Xthen
X termlib="-lcurses"
X echo "terminfo library found."
Xelif test -r /usr/local/lib/libcurses.a
Xthen
X termlib="/usr/local/lib/libcurses.a"
X echo "local terminfo library found."
Xelif test -r /lib/libtermlib.a -o -r /usr/lib/libtermlib.a
Xthen
X termlib="-ltermlib"
X echo "termlib library found."
Xelif test -r /usr/local/lib/libtermlib.a
Xthen
X termlib="/usr/local/lib/libtermlib.a"
X echo "local termlib library found."
Xelse
X echo " "
X echo "Your system appears NOT to have any termcap-like library."
X echo $n "Is this true? "
X read ans
X case $ans in
X n*|N*|f*|F*) termlib="ask_it"
X ;;
X *) termlib="libtermcap.a"
X cat <<\EOF
XWe will setup ./Makefile to use the public domain version of the
Xtermcap routines from ./tc. Your users must set the $TERMCAP and
X$TERM environment variables appropriately in their profile; or you
Xcan install shell scripts that arrange these.
XHowever, it would be better if your system administrator installs
Xtermcap in the proper places. You should run Setup again after she
Xhas done so.
XSee ./tc/README for details.
XEOF
X ;;
X esac
Xfi
Xwhile test "$termlib" = "ask_it" -o "$termlib" = "try_again"; do
X case $termlib in
X ask_it)
X echo " "
X echo "Please specify where the termcap-like routines are kept"
X echo $n " (either full pathname or -lxxx option) "
X ;;
X try_again)
X echo $n "Please try again (full pathname or -lyyy option) "
X ;;
X esac
X read termlib
X case $termlib in
X -l*)
X echo "Hope $termlib will do the job."
X ;;
X /*)
X if test -r $termlib
X then
X echo "Ok, we will try $termlib."
X else
X echo "$termlib does not appear to exist."
X termlib="try_again"
X fi
X ;;
X *)
X echo "$termlib is not a valid library specification."
X termlib="try_again"
X ;;
X esac
Xdone
X
X: 'find C preprocessor for ./scripts/mkdep'
Xecho " "
Xecho 'Checking if we can use "cc -M" for generating dependency information ... '
Xcc -M -Iuhdrs mkconfig.c >testcpp.out 2>&1
Xif $contains 'mkconfig.o: *uhdrs/osconf.h' testcpp.out >/dev/null 2>&1 ; then
X echo "Yes, we can."
X cpp='REDUNDANT'
X mkdep="\$(CC) -M \$(DEFS)"
Xelse
X echo "No, we can't; we will try to use ./scripts/mkdep for \"make depend\"."
X mkdep="../scripts/mkdep \$(DEFS)"
X echo "Checking to see how your C preprocessor is invoked ... "
X cpp=''
Xcat <<'EOT' >testcpp.c
X#define ABC abc
X#define XYZ xyz
XABC+XYZ
XEOT
X echo 'Maybe "cc -E" will work ...'
X cc -E testcpp.c >testcpp.out 2>&1
X if $contains 'abc+xyz' testcpp.out >/dev/null 2>&1 ; then
X echo "Yes, it does."
X cpp='cc -E'
X else
X echo 'No ... maybe "cc -P" will work ...'
X cc -P testcpp.c >testcpp.out 2>&1
X if $contains 'abc+xyz' testcpp.out >/dev/null 2>&1 ; then
X echo "Yes, that does."
X cpp='cc -P'
X else
X echo 'Wrong again ... maybe "/lib/cpp" will work ...'
X /lib/cpp testcpp.c >testcpp.out 2>&1
X if $contains 'abc+xyz' testcpp.out >/dev/null 2>&1
X then echo "Hooray, it works! I was beginning to wonder."
X cpp='/lib/cpp'
X else
X echo $n "No. I can't find a C preprocessor. Name one: "
X read cpp
X until sh 2>/dev/null <<EOF
X$cpp testcpp.c >testcpp.out 2>&1
Xif $contains 'abc+xyz' testcpp.out >/dev/null 2>&1
Xthen exit 0
Xelse exit 1
Xfi
XEOF
X do
X echo "Sorry, I can't get that to work."
X echo "Try again ([RETURN] to give up) "
X read cpp
X case $cpp in
X '') : giving up
X break;;
X esac
X done
X fi
X fi
X fi
Xfi
Xrm -f testcpp.*
X
Xcase $cpp in
XREDUNDANT) : no mkdep needed
X ;;
X'') cat <<EOF
XGiving up on C preprocessor.
XYou have to adapt the shell script ./scripts/mkdep yourself;
Xsee the comment at its head.
XEOF
X ;;
X*)
X cat <<EOF
XWe will change the name of the C preprocessor to "$cpp"
Xin ./scripts/mkdep (used by 'make depend').
XBut you still may have problems with the format of the lines that the
Xpreprocessor creates for '#include' statements; see the comment at the
Xstart of ./scripts/mkdep.
XIf you can't get 'make depend' to work see ./Problems for a workaround.
XEOF
X ;;
Xesac
X
X: 'Shall we make ABC public?'
Xpublic="no"
Xecho " "
Xecho $n "Do you want to make ABC publically available? "
Xread ans
Xcase $ans in
Xy*|Y*)
Xpublic="yes"
Xabcdir='blurfl'
Xwhile test ! -d "$rootdir$abcdir" ; do
X case $abcdir in
X blurfl)
X echo " "
X echo "Please type the full pathname of a$remote directory"
X echo "in which you have write permission, and where you"
X echo "want the binaries 'abc' and 'abckeys' installed"
X echo $n " (default $abcdef) "
X ;;
X *) echo "$rootdir$abcdir does not appear to exist."
X echo $n "Are you sure you typed the right name? "
X read ans
X case $ans in
X y*|Y*) echo "Don't forget to make $rootdir$abcdir before 'make install'."
X break
X ;;
X *) echo " "
X echo $n "Please try again (default $abcdef) "
X ;;
X esac
X ;;
X esac
X read abcdir
X case $abcdir in
X "") abcdir=$abcdef;;
X esac
Xdone
Xlibdir='blurfl'
Xwhile test ! -d "$rootdir$libdir" ; do
X case $libdir in
X blurfl)
X echo " "
X echo "Please type the full pathname of the$remote directory"
X echo "where you want to install the auxiliary datafiles"
X echo "needed by the ABC system"
X echo $n " (default $libdef) "
X ;;
X *) echo "$rootdir$libdir does not appear to exist."
X echo $n "Are you sure you typed the right name? "
X read ans
X case $ans in
X y*|Y*) echo "Don't forget to make $rootdir$libdir before 'make install'."
X break
X ;;
X *) echo " "
X echo $n "Please try again (default $libdef) "
X ;;
X esac
X ;;
X esac
X read libdir
X case $libdir in
X "") libdir=$libdef;;
X esac
Xdone
Xmandir='blurfl'
Xwhile test ! -d "$rootdir$mandir" ; do
X case $mandir in
X blurfl)
X echo " "
X echo "Please type the full pathname of the$remote directory"
X echo "where you want to install the 'abc.1' manual page"
X echo $n " (default $mandef) "
X ;;
X *) echo "$rootdir$mandir does not appear to exist."
X echo $n "Are you sure you typed the right name? "
X read ans
X case $ans in
X y*|Y*) echo "Don't forget to make $rootdir$mandir before 'make install'."
X break
X ;;
X *) echo " "
X echo $n "Please try again (default $mandef) "
X ;;
X esac
X ;;
X esac
X read mandir
X case $mandir in
X "") mandir=$mandef;;
X esac
Xdone
X;;
X*)
Xabcdir="$abcdef"
Xlibdir="$libdef"
Xmandir="$mandef"
X;;
Xesac
X
Xcat >answers <<EOF
Xrootdef="$rootdir"
Xabcdef="$abcdir"
Xlibdef="$libdir"
Xmandef="$mandir"
XEOF
X
Xecho " "
Xecho "End of configuration questions for the ABC system."
X
Xrm -f ./contains
X
Xeditor="ed -"
X
X: 'Getting generic copies of Makefile, uhdrs/os.h, and scripts/mkdep.'
X: 'Since some tars leave the owner of the tape as the owner of the files'
X: 'this will make sure the edit scripts will not fail.'
X
Xecho " "
Xecho "Creating Makefile from Makefile.unix."
X
Xcat >Makefile <<EOF
X# This file was generated and edited by the Setup command.
X# To make lasting changes edit the files Makefile.unix and Setup,
X# and run Setup again.
X#
XEOF
Xchmod 644 Makefile
Xcat Makefile.unix >>Makefile
X
Xecho "Creating uhdrs/os.h from uhdrs/os.h.gen."
X
Xcat >uhdrs/os.h <<EOF
X/* This file was generated and edited by the Setup command. */
X/* To make lasting changes edit the files uhdrs/os.h.gen and Setup, */
X/* and run Setup again. */
X
XEOF
Xchmod 644 uhdrs/os.h
Xcat uhdrs/os.h.gen >>uhdrs/os.h
X
Xecho "Creating scripts/mkdep from scripts/mkdep.gen."
X
Xcat >scripts/mkdep <<EOF
X: This file was generated from scripts/mkdep.gen by Setup
X:
XEOF
Xchmod 755 scripts/mkdep
Xcat scripts/mkdep.gen >>scripts/mkdep
X
Xecho " "
Xecho $n "Editing appropriate definitions in these files ... "
X
Xcase $unix in
XBSD4_2)
X make="make \$(MFLAGS)"
X strchr="index"
X perror="#define"
X mkdir="#define"
X getwd="#define"
X rename="#define"
X select="#define"
X readdir="#define"
X ;;
XBSD) make="make \$(MFLAGS)"
X strchr="index"
X perror="#define"
X mkdir="#undef "
X getwd="#undef "
X rename="#undef "
X select="#undef "
X readdir="#undef "
X ;;
XATT) make="make -\$(MAKEFLAGS)"
X strchr="strchr"
X perror="#define"
X mkdir="#define"
X getwd="#define"
X rename="#undef "
X select="#undef "
X readdir="#undef "
X ;;
XVERSION7|*)
X make="make"
X strchr="index"
X perror="#undef "
X mkdir="#undef "
X getwd="#undef "
X rename="#undef "
X select="#undef "
X readdir="#undef "
X ;;
Xesac
X
X$editor Makefile <<EOF
X/^MAKE=/s?MAKE=.*?MAKE= $make?
X/^FLOAT=/s?FLOAT=.*?FLOAT= $fflag?
X/^MKDEP=/s?MKDEP=.*?MKDEP= $mkdep?
X/^TERMLIB=/s?TERMLIB=.*?TERMLIB= $termlib?
Xw
Xq
XEOF
X
Xcase $public in
Xyes)
X $editor Makefile <<EOF
X /^DESTABC=/s?DESTABC=.*?DESTABC= $abcdir?
X /^DESTLIB=/s?DESTLIB=.*?DESTLIB= $libdir?
X /^DESTMAN=/s?DESTMAN=.*?DESTMAN= $mandir?
X w
X q
XEOF
X ;;
Xesac
X
X$editor uhdrs/os.h <<EOF
X/^#include <strings.h>/s?<strings.h>?$strs?
X/^#include <sys\/file.h>/s?<sys/file.h>?$modes?
X/^#define VOID/s?(void)?$void?
X/^#define SIGTYPE/s?int?$sigtype?
X/^#undef TERMIO/s?#undef ?$termio?
X/^#define HAS_FTIME/s?#define?$ftime?
X/^#define HAS_PERROR/s?#define?$perror?
X/^#define HAS_MKDIR/s?#define?$mkdir?
X/^#define HAS_GETWD/s?#define?$getwd?
X/^#define HAS_RENAME/s?#define?$rename?
X/^#define HAS_SELECT/s?#define?$select?
X/^#define HAS_READDIR/s?#define?$readdir?
Xw
Xq
XEOF
X
Xcase $strs in
Xno_strs)
X case $strchr in
X "index") index=index; rindex=rindex;;
X "strchr") index=strchr; rindex=strrchr;;
X esac
X $editor uhdrs/os.h <<EOF
X/#include no_strs/c
X
Xextern char *strcat();
Xextern int strcmp();
Xextern int strncmp();
Xextern char *strcpy();
Xextern char *strncpy();
Xextern int strlen();
Xextern char *$index();
Xextern char *$rindex();
X
X.
Xw
Xq
XEOF
X;;
Xesac
X
Xcase $modes in
Xno_modes)
X $editor uhdrs/os.h <<EOF
X/#include no_modes/c
X
X#define R_OK 4
X#define W_OK 2
X#define F_OK 0
X.
Xw
Xq
XEOF
X;;
Xesac
X
Xcase $strchr in
Xstrchr) $editor uhdrs/os.h <<EOF
X/#define strchr/,/#define strrchr/d
Xw
Xq
XEOF
X;;
Xesac
X
Xcase $unix in
XATT) $editor uhdrs/os.h <<EOF
X/#define HAS_GETWD/a
X#define getwd(path) getcwd(path, SIZE_PATH)
X.
Xw
Xq
XEOF
X;;
Xesac
X
Xcase $termlib in
Xlibtermcap.a)
X $editor Makefile <<EOF
X /TERMLIB=/s?.*?TERMLIB=?
X /#OWNTLIB=/s?#??
X /#KOWNTLIB=/s?#??
X /#OWNTBASE=/s?#??
X w
X q
XEOF
X ;;
Xesac
X
Xcase $cpp in
XREDUNDANT) : no mkdep needed
X ;;
X'') : do it yourself message given above
X ;;
X*)
X $editor scripts/mkdep <<EOF
X /^CPP=/s?.*?CPP="$cpp"?
X w
X q
XEOF
X ;;
Xesac
X
Xecho $n " "
Xecho "done."
X
Xecho " "
Xecho "This completes the setup of the ABC system."
X
Xcase $remote in
X' remote')
X cat <<EOF
XYou should first compile mkconfig (from ./mkconfig.c and ./uhdrs/os.h)
Xwith 'make mkconfig' here, run it on the remote machine and copy the
Xresult to ./uhdrs/config.h.
XAfter that you can proceed here with 'make makefiles'.
XEOF
X ;;
X*) echo "You can now try 'make makefiles'."
X ;;
Xesac
X
Xcase $remote in
X" remote")
X if test ! -d "$rootdir"
X then
X echo " "
X echo "You should 'mkdir $rootdir' before 'make install'."
X fi
X ;;
Xesac
X
Xcase $public in
Xyes)
X if test ! -d "$rootdir$abcdir"
X then
X echo " "
X echo "You should 'mkdir $rootdir$abcdir' before 'make install'."
X fi
X if test ! -d "$rootdir$libdir"
X then
X echo "You should 'mkdir $rootdir$libdir' before 'make install'."
X fi
X if test ! -d "$rootdir$mandir"
X then
X echo "You should 'mkdir $rootdir$mandir' before 'make install'."
X fi
X ;;
Xesac
X
Xexit 0
END_OF_FILE
if test 18623 -ne `wc -c <'abc/Setup'`; then
echo shar: \"'abc/Setup'\" unpacked with wrong size!
fi
chmod +x 'abc/Setup'
# end of 'abc/Setup'
fi
if test -f 'abc/bed/e1sugg.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bed/e1sugg.c'\"
else
echo shar: Extracting \"'abc/bed/e1sugg.c'\" \(17893 characters\)
sed "s/^X//" >'abc/bed/e1sugg.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Suggestion handling module.
X */
X
X#include "b.h"
X#include "feat.h"
X
X#ifdef USERSUGG
X
X#include "b0lan.h"
X#include "bmem.h"
X#include "bedi.h"
X#include "etex.h"
X#include "defs.h"
X#include "bobj.h"
X#include "bfil.h"
X#include "node.h"
X#include "supr.h"
X#include "gram.h"
X#include "tabl.h"
X#include "queu.h"
X#include "args.h"
X
Xextern bool lefttorite;
X
XHidden value *sugg;
XHidden int *symsugg;
XHidden int nsugg= 0;
XHidden int maxnsugg= 0;
XHidden int nbuiltin= 0;
XHidden bool suggchanges;
X
X/*
X * Read the suggestion table from file.
X */
X
XHidden Procedure
Xgetsugg()
X{
X char *line;
X register FILE *fp;
X register c;
X
X fp = fopen(suggfile, "r");
X if (!fp)
X return;
X while ((line= f_getline(fp)) != NULL) {
X addsugg(line, -1);
X }
X fclose(fp);
X}
X
X/*
X * Make sure a line looks like a suggestion, return No if not.
X * Replace the trailing newline or comment-sign by a zero byte.
X * ***** Should check more thoroughly. *****
X */
X
XHidden bool
Xchecksugg(bp)
X string bp;
X{
X if (!isascii(*bp))
X return No;
X if (isupper(*bp)) {
X while (*bp && *bp != '\n' && *bp != '\\') {
X if (maycontinue(*bp, KEYWORD)
X || strchr(" ?:", *bp) != NULL)
X ++bp;
X else
X return No;
X }
X *bp = 0;
X return Yes;
X }
X else if (islower(*bp)) {
X while (*bp && *bp != '\n' && *bp != '\\') {
X if (maycontinue(*bp, NAME))
X ++bp;
X else
X return No;
X }
X *bp = 0;
X return Yes;
X }
X}
X
X/*
X * check that first keyword not forbidden.
X * slight variation on bint2/i2syn.c
X */
X
XHidden char *firstkw[] = {
X K_IF, K_WHILE, K_CHECK, K_HOW, K_RETURN, K_REPORT,
X NULL
X};
X
XHidden bool res_firstkeyword(str) string str; {
X char *fkw;
X char *fkwend;
X string *kw;
X bool r= No;
X
X fkw= savestr(str);
X if ((fkwend=strchr(fkw, ' ')) != NULL)
X *fkwend= '\0';
X for (kw= firstkw; *kw != NULL; kw++) {
X if (strcmp(fkw, *kw) == 0) {
X r= Yes;
X break;
X }
X }
X freestr(fkw);
X return r;
X}
X
X/*
X * Procedure to add a suggestion to the suggestion table.
X * builtin > 0: adding builtin command with this Symbol value;
X * these are inserted in order at the start of sugg[] table;
X * builtin == 0: adding new user defined command;
X * these are inserted after builtin's, and kept sorted;
X * builtin == -1: adding user defined commands from suggestion file
X * (already sorted!).
X */
X
XVisible Procedure
Xaddsugg(str, builtin)
X string str;
X int builtin;
X{
X int i;
X int j;
X int len;
X int cmp;
X string suggi;
X int where = (builtin == -1) ? nsugg : nbuiltin;
X
X if (builtin <= 0 && (!checksugg(str) || res_firstkeyword(str)))
X return;
X for ( len = 0;
X str[len] && (str[len] != ' ' || isupper(str[len+1]));
X ++len)
X ;
X for (i = nsugg-1; i >= 0; --i) {
X suggi = e_strval(sugg[i]);
X cmp = strncmp(str, suggi, len);
X if (cmp < 0)
X continue;
X if (cmp > 0) {
X if (i >= where)
X where = i+1;
X continue;
X }
X if (suggi[len]
X &&
X (suggi[len] != ' '
X ||
X (isascii(suggi[len+1]) && isupper(suggi[len+1]))
X )
X )
X continue; /* No match, just prefix */
X if (!strcmp(str+len, suggi+len))
X return; /* Ignore exact duplicates */
X if (i < nbuiltin)
X return; /* Cannot replace built-in */
X /* Replacement */
X release(sugg[i]);
X sugg[i] = mk_etext(str);
X suggchanges = Yes;
X return;
X }
X /* Insertion */
X if (nsugg == 0) {
X symsugg= (int*) getmem((unsigned) (MAXNBUILTIN * sizeof(int)));
X sugg= (value*) getmem((unsigned) (NSUGGSIZE * sizeof(value)));
X maxnsugg= NSUGGSIZE;
X }
X if (nsugg >= maxnsugg) {
X regetmem((ptr*)&sugg,
X (unsigned) ((maxnsugg+NSUGGSIZE) * sizeof(value)));
X maxnsugg += NSUGGSIZE;
X }
X if (builtin > 0) {
X symsugg[nbuiltin] = builtin;
X ++nbuiltin;
X }
X for (j = nsugg; j > where; --j)
X sugg[j] = sugg[j-1];
X ++nsugg;
X sugg[where] = mk_etext(str);
X suggchanges = Yes;
X}
X
X
X/*
X * Procedure to delete a suggestion from the suggestion table.
X * Must supply the whole string as argument.
X */
X
XHidden Procedure
Xdelsugg(str)
X string str;
X{
X int i;
X
X for (i = nbuiltin; i < nsugg; ++i) {
X if (strcmp(str, e_strval(sugg[i])) == 0) {
X release(sugg[i]);
X --nsugg;
X for (; i < nsugg; ++i)
X sugg[i] = sugg[i+1];
X suggchanges = Yes;
X return;
X }
X }
X}
X
X#define CANT_FINISH MESS(7000, "*** can't finish writing suggestion file [%s]")
X/*
X * Procedure to save the suggestion file if it has been changed.
X */
X
XHidden Procedure
Xsavsugg()
X{
X FILE *fp;
X int i;
X
X if (!suggchanges)
X return;
X suggchanges = No;
X fp = fopen(suggfile, "w");
X if (!fp)
X return;
X for (i = nbuiltin; i < nsugg; ++i)
X fprintf(fp, "%s\n", e_strval(sugg[i]));
X if (fclose(fp) == EOF) {
X ederrS(CANT_FINISH, suggfile);
X return;
X }
X /* Remove the file if it's empty: */
X if (nbuiltin >= nsugg) unlink(suggfile);
X}
X
X/*
X * Return a suitable suggestion which matches str for len characters,
X * followed by new_c.
X * First we lookup the last suggestion given to start the circular
X * search of the suggestion list from the next entry.
X * Before starting the search, we check that no entry exactly matches
X * the new string (only for sugghowname).
X * Nnil is returned if no entry matches.
X */
X
XHidden node nextsugg(str, len, new_c, in_sugghowname, colon_allowed)
Xstring str; int len; int new_c; bool in_sugghowname; bool colon_allowed;
X{
X string sg;
X int i;
X int istop;
X int lastisugg;
X string sugg_i;
X
X lastisugg= findsugg(str);
X
X str[len]= new_c;
X
X if (in_sugghowname) {
X /* if howname matches exactly, return that one */
X /* since [newline] acknowledges entire howname */
X for (i= nbuiltin; i < nsugg; i++) {
X sg= e_strval(sugg[i]);
X if (strncmp(str, sg, len+1) == 0) {
X if (sg[len+1] == '\0'
X || (sg[len+1] == ' ' && sg[len+2] == '?'))
X {
X /* exact match */
X return (node) sugg[i];
X }
X else
X break;
X /* to find nextsugg from lastisugg */
X }
X }
X }
X i= lastisugg+1;
X if (in_sugghowname && i < nbuiltin) {
X i= nbuiltin;
X istop= nsugg;
X }
X else if (i == 0)
X istop= nsugg;
X else
X istop= i;
X do {
X if (i == nsugg) i= (in_sugghowname ? nbuiltin : 0);
X sugg_i= e_strval(sugg[i]);
X if (strncmp(str, sugg_i, len+1) == 0) {
X if (colon_allowed || strchr(sugg_i, ':') == NULL)
X return (node) sugg[i];
X }
X ++i;
X } while (i != istop);
X return Nnil;
X}
X
X/*
X * Find the current suggestion in the table (whole string must match).
X */
X
XHidden int findsugg(str) string str; {
X int i;
X
X for (i= 0; i < nsugg; i++) {
X if (strcmp(str, e_strval(sugg[i])) == 0)
X return i;
X }
X return -1;
X}
X
X/*
X * Place an initial suggestion in a node.
X */
X
XHidden node firstsugg(s, startsugg, colon_allowed)
Xstring s; int startsugg; bool colon_allowed;
X{
X int i;
X string sugg_i;
X
X for (i= startsugg ; i < nsugg; i++) {
X sugg_i= e_strval(sugg[i]);
X if (strncmp(s, sugg_i, strlen(s)) == 0) {
X if (colon_allowed || strchr(sugg_i, ':') == 0)
X return (node) sugg[i];
X }
X }
X return Nnil;
X}
X
XVisible bool
Xsetsugg(pp, c, ep, colon_allowed)
X path *pp;
X char c;
X environ *ep;
X bool colon_allowed;
X{
X char buf[2];
X node n;
X string s;
X string lastunitname();
X
X if (lefttorite)
X return No;
X n= Nnil;
X if (c == ':') {
X if (nsugg <= nbuiltin)
X return No; /* no suggestions for howtoname */
X s= lastunitname();
X if (s != NULL) {
X n= firstsugg(s, nbuiltin, No);
X freestr(s);
X }
X if (n == Nnil) {
X n= (node) mk_etext("");
X }
X }
X else {
X buf[0] = islower(c) ? toupper(c) : c;
X buf[1] = '\0';
X n = firstsugg(buf,
X (parent(*pp) == NilPath ? 0 : 1),
X /* skip "H?OW TO ?:" if not at root */
X colon_allowed);
X }
X if (n == Nnil)
X return No;
X n= nodecopy(n);
X if (c == ':') {
X n= newnode(1, Sugghowname, &n);
X n= newnode(1, Edit_unit, &n);
X }
X else {
X n= newnode(1, Suggestion, &n);
X }
X treereplace(pp, n);
X ep->mode = VHOLE;
X ep->s1 = 2;
X ep->s2 = (c == ':' ? 0 : 1);
X return Yes;
X}
X
XHidden bool fits_how_to(str, pstr, alt_c)
Xstring str; string *pstr; int alt_c;
X{
X if (strcmp(str, S_HOW_TO) == 0) {
X if (alt_c)
X **pstr= alt_c;
X return Yes;
X }
X return No;
X}
X
X/*
X * Find a new suggestion or advance in the current one.
X * Interface styled like resuggest: string pointer is advanced here.
X */
X
XVisible bool newsugg(ep, pstr, alt_c) environ *ep; string *pstr; int alt_c; {
X string str;
X node n = tree(ep->focus);
X node nn;
X int sym = symbol(n);
X path pa= parent(ep->focus);
X int sympa= pa ? symbol(tree(pa)) : Rootsymbol;
X
X Assert(pstr && *pstr);
X if (sym != Suggestion || ep->mode != VHOLE || ep->s1 != 2)
X return No;
X
X str= e_sstrval((value) firstchild(n));
X
X if (str[ep->s2-1] == ' '
X && (!isupper(**pstr) || res_firstkeyword(str)))
X {
X /* require CAPITAL after space */
X /* uses that Keywords start with such */
X if (str[ep->s2] == '?' /* pattern fits expr or loc */
X || fits_how_to(str, pstr, alt_c))
X {
X /* so acknowledge: */
X acksugg(ep); /* if insertion fails rest of editor */
X e_fstrval(str); /* restores suggestion state */
X return Yes;
X }
X /* else: pattern wrong */
X e_fstrval(str);
X return No; /* implies killsugg in caller */
X }
X
X nn= nextsugg(str, ep->s2, (!alt_c ? (int)(**pstr) : alt_c), No,
X allows_colon(sympa));
X
X e_fstrval(str);
X
X if (!nn)
X return No;
X
X if (nn != firstchild(n)) {
X s_down(ep);
X treereplace(&ep->focus, nodecopy(nn));
X s_up(ep);
X }
X
X ++ep->s2;
X if (**pstr == ':') {
X /* must be "SELECT:" */
X acksugg(ep);
X Assert(symbol(tree(ep->focus)) == Select);
X }
X ++*pstr;
X
X return Yes;
X}
X
X
X/*
X * Kill suggestion -- only the part to the left of the focus is kept.
X */
X
XVisible Procedure killsugg(ep, pstr) environ *ep; string *pstr;
X{
X node n = tree(ep->focus);
X node nc;
X value vstr;
X
X Assert(ep->mode == VHOLE && ep->s1 == 2 && symbol(n) == Suggestion);
X Assert(ep->s2 <= Length((value)firstchild(n)));
X
X nc = (node)e_icurtail((value)firstchild(n), ep->s2);
X if (e_ncharval(ep->s2, (value)firstchild(n)) == ' '
X && pstr != (string*)NULL) {
X /* fix for e.g. APPEND WORD >?<TO ?, inserting X */
X /* acksugg threw the space after WORD away */
X e_concto((value*) &nc, vstr=mk_etext(*pstr));
X ep->s2 += e_length(vstr);
X release(vstr);
X **pstr= '\0';
X };
X s_down(ep);
X treereplace(&ep->focus, nc);
X s_up(ep);
X acksugg(ep);
X}
X
X/*
X * Acknowledge a suggestion -- turn it into real nodes.
X */
X
XVisible Procedure acksugg(ep) environ *ep; {
X node n = tree(ep->focus);
X int s2 = ep->s2;
X int isugg;
X string str;
X node nn;
X node n1;
X string rest;
X queue q = Qnil;
X node r;
X
X Assert(symbol(n) == Suggestion && ep->mode == VHOLE && ep->s1 == 2);
X
X str= e_sstrval((value) firstchild(n));
X isugg= findsugg(str);
X
X if (0 <= isugg && isugg < nbuiltin) { /* builtin command */
X nn= gram(symsugg[isugg]);
X treereplace(&ep->focus, nodecopy(nn));
X ep->mode= FHOLE;
X ep->s1= 1;
X /* s2 in or at end of repr[0] */
X Assert(s2 <= Fwidth(table[symsugg[isugg]].r_repr[0]));
X }
X else if ((rest= strchr(str, ' ')) == NULL) { /* just one keyword */
X nn= gram(Keyword);
X setchild(&nn, 1, (node) mk_etext(str));
X treereplace(&ep->focus, nn);
X /* mode VHOLE and s1, s2 allright */
X }
X else { /* Keyword plus ... */
X /* split off first keyword */
X *rest++ = '\0';
X n1= gram(Keyword);
X setchild(&n1, 1, (node) mk_etext(str));
X
X /* hang in Kw_plus */
X nn= gram(Kw_plus);
X setchild(&nn, 1, n1);
X
X /* set focus at hole after space after first keyword */
X treereplace(&ep->focus, nn);
X /* ep->mode= VHOLE; */
X ep->s1= 4;
X ep->s2= 0;
X
X /* rest of suggestion to q */
X r= (node) mk_etext(rest);
X preptoqueue(r, &q);
X noderelease(r);
X
X /* append to first keyword and restore focus position */
X app_queue(ep, &q);
X fixfocus(ep, s2);
X }
X
X e_fstrval(str);
X}
X
X/*
X * newsugg, adv_howsugg and acksugg for Sugghowname.
X * Note that a howsugg is never kiled, just advanced in;
X * ackhowsugg is only used for [newline] and [accept].
X */
X
XForward node adv_howsugg();
X
XVisible bool newhowsugg(ep, pstr, alt_c) environ *ep; string *pstr; int alt_c; {
X string str;
X string qm;
X node n = tree(ep->focus);
X int sym = symbol(n);
X node nn;
X int newc;
X
X Assert(pstr && *pstr);
X if (sym != Sugghowname || ep->mode != VHOLE || ep->s1 != 2)
X return No;
X
X str= e_sstrval((value) firstchild(n));
X
X if (isupper(str[0])) {
X /* ucmd suggestion */
X qm= strchr(str, '?');
X if (qm && qm-str < ep->s2) {
X e_fstrval(str);
X return No; /* refuse insert after questionmark */
X }
X }
X else if (islower(str[0])) {
X /* fpr suggestion */
X if (**pstr == ' ') {
X e_fstrval(str);
X return No; /* refuse space in name */
X }
X }
X
X if (ep->s2 == 0 || !alt_c || !isupper(str[0]))
X newc= (int)(**pstr);
X else
X newc= alt_c;
X
X nn = nextsugg(str, ep->s2, newc, Yes, No);
X
X e_fstrval(str);
X
X if (!nn) {
X if (ep->s2 == 0) { /* nothing suggested */
X treereplace(&ep->focus, gram(Optional));
X ep->mode= ATBEGIN;
X return Yes; /* ins_string will continue */
X }
X nn= adv_howsugg(ep, str[ep->s2-1], (char)newc);
X if (!nn)
X return No;
X }
X
X if (nn != firstchild(n)) {
X s_down(ep);
X treereplace(&ep->focus, nodecopy(nn));
X s_up(ep);
X }
X
X ++ep->s2;
X ++*pstr;
X
X return Yes;
X}
X
XHidden node adv_howsugg(ep, prev_c, new_c)
Xenviron *ep; char prev_c; char new_c;
X{
X int s2= ep->s2;
X char buf[2];
X value hd;
X value tl;
X
X Assert(ep->s2 <= Length((value)firstchild(tree(ep->focus))));
X
X if (isalpha(new_c) ||
X (prev_c != ' ' && strchr("012345679'\". ", new_c) != NULL))
X {
X buf[0]= new_c;
X buf[1]= '\0';
X
X hd= e_icurtail((value) firstchild(tree(ep->focus)), s2);
X tl= mk_etext(buf);
X e_concto(&hd, tl);
X release(tl);
X
X return (node) hd;
X }
X /* else */
X return Nnil;
X}
X
X/*
X * Acknowledge a how-to name suggestion -- but do NOT turn it into real nodes.
X */
X
XVisible Procedure ackhowsugg(ep) environ *ep; {
X ep->mode= VHOLE;
X ep->s1= 2;
X ep->s2= strlen(e_strval((value) firstchild(tree(ep->focus))));
X}
X
X/*
X * Leave a single ':' (edit last unit) as immediate command if
X * the user did not try to edit the suggested last_unit name;
X * this is done to avoid the which_funpred dialog in the interpreter.
X */
X
XVisible Procedure check_last_unit(ep, curr) environ *ep; int curr; {
X if (curr != 1
X || symbol(tree(ep->focus)) != Edit_unit
X || symbol(firstchild(tree(ep->focus))) != Sugghowname)
X return;
X /* else */
X s_down(ep);
X treereplace(&ep->focus, gram(Optional));
X s_up(ep);
X}
X
X
X/*
X * Procedure called when a unit is read in.
X * It tries to update the suggestion database.
X * It also remembers the suggestion so that it can be removed by writesugg
X * if that finds the unit was deleted or renamed.
X */
X
XHidden char *lastsugg= NULL; /* the buffer */
XHidden char *pbuf;
XHidden int buflen= 0;
X
XVisible Procedure
Xreadsugg(p)
X path p;
X{
X p = pathcopy(p);
X top(&p);
X if (getpattern(tree(p)))
X addsugg(lastsugg, 0);
X else {
X freemem((ptr) lastsugg);
X lastsugg= NULL;
X }
X pathrelease(p);
X}
X
X
X/*
X * Procedure called when a unit is saved.
X * It tries to update the suggestion database.
X * Since renaming a unit now deletes to old name, we always delete
X * 'lastsugg'; we add it again if the unit is not empty.
X */
X
XVisible Procedure
Xwritesugg(p)
X path p;
X{
X p = pathcopy(p);
X top(&p);
X if (lastsugg != NULL)
X delsugg(lastsugg);
X if (nodewidth(tree(p)) != 0) {
X if (getpattern(tree(p)))
X addsugg(lastsugg, 0);
X }
X if (lastsugg != NULL) {
X freemem((ptr) lastsugg);
X lastsugg= NULL;
X }
X pathrelease(p);
X}
X
X
X/*
X * Procedure to find out the suggestion that fits the current unit.
X * For user defined commands it just replaces stretches of non-keywords
X * with a single '?'; for functions and predicates it tries to
X * get the name.
X * It uses intimate knowledge about the abc grammar for formal-cmd and
X * formal_formula in ../boot/grammar.abc (such as the separation of
X * keywords and other stuff by spaces).
X */
X
XHidden bool
Xgetpattern(n)
X node n;
X{
X string *rp = noderepr(n);
X int sym;
X int sym1;
X int sym2;
X
X if (lastsugg == NULL) {
X lastsugg= (char*) getmem(SUGGBUFSIZE);
X buflen= SUGGBUFSIZE;
X }
X pbuf= lastsugg;
X
X while (Fw_zero(rp[0])) {
X if (nchildren(n) == 0)
X return No;
X n = firstchild(n);
X rp = noderepr(n);
X }
X if (strcmp(rp[0], R_HOW_TO) || nchildren(n) < 1)
X return No;
X n= firstchild(n);
X sym= symbol(n);
X if (sym == Formal_kw_plus || sym == Keyword) {
X for (;;) {
X switch (sym) {
X case Formal_kw_plus:
X addnode(firstchild(n));
X addstr(" ");
X break;
X case Keyword:
X addnode(n);
X *pbuf= '\0';
X return Yes;
X case Formal_naming_plus:
X addstr("? ");
X break;
X case Name:
X case Multiple_naming:
X case Compound_naming:
X addstr("?");
X *pbuf= '\0';
X return Yes;
X default:
X Assert(No);
X return No;
X }
X n= child(n, 2);
X sym= symbol(n);
X }
X /* NOTREACHED */
X }
X else {
X Assert(sym==Formal_return || sym== Formal_report);
X n= firstchild(n);
X sym= symbol(n);
X if (sym == Blocked_ff || sym == Grouped_ff) {
X sym1= symbol(child(n, 1));
X sym2= symbol(child(n, 2));
X if (sym2 == Name || sym2 == Compound_naming) {
X n= child(n, 1);
X if (sym1 == Blocked_ff)
X n= child(n, 2);
X }
X else if (sym1 == Name || sym1 == Compound_naming) {
X /* sym2 == Blocked_ff || Grouped_ff */
X n= child(n, 2);
X n= firstchild(n);
X }
X }
X if (symbol(n) == Name) {
X addnode(n);
X *pbuf= '\0';
X return Yes;
X }
X /* else */
X return No;
X }
X /*NOTREACHED*/
X}
X
XHidden Procedure addnode(n) node n; {
X string s;
X
X Assert(symbol(n) == Keyword || symbol(n) == Name);
X
X s= e_strval((value) firstchild(n));
X addstr(s);
X}
X
XHidden Procedure addstr(s) string s; {
X while (*s) {
X *pbuf++ = *s++;
X if (pbuf >= lastsugg + buflen) {
X regetmem((ptr*)&lastsugg,
X (unsigned) (buflen+SUGGBUFSIZE));
X pbuf= lastsugg+buflen;
X buflen += SUGGBUFSIZE;
X }
X }
X}
X
XVisible Procedure
Xinitsugg()
X{
X getsugg();
X suggchanges= No;
X}
X
XVisible Procedure
Xendsugg()
X{
X int i;
X savsugg();
X for (i = nbuiltin; i < nsugg; ++i)
X release(sugg[i]);
X nsugg= nbuiltin;
X if (maxnsugg > NSUGGSIZE) {
X regetmem((ptr*)&sugg, (unsigned) (NSUGGSIZE * sizeof(value)));
X maxnsugg= NSUGGSIZE;
X }
X}
X
XVisible Procedure
Xendclasses()
X{
X int i;
X for (i= 0; i < nbuiltin; ++i)
X release(sugg[i]);
X nbuiltin= nsugg= 0;
X freemem((ptr) sugg);
X}
X
X#endif /* USERSUGG */
END_OF_FILE
if test 17893 -ne `wc -c <'abc/bed/e1sugg.c'`; then
echo shar: \"'abc/bed/e1sugg.c'\" unpacked with wrong size!
fi
# end of 'abc/bed/e1sugg.c'
fi
if test -f 'abc/bint2/i2exp.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint2/i2exp.c'\"
else
echo shar: Extracting \"'abc/bint2/i2exp.c'\" \(13508 characters\)
sed "s/^X//" >'abc/bint2/i2exp.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "bint.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "i2par.h"
X#include "i2nod.h"
X#include "i2gen.h" /* Must be after i2nod.h */
X#include "i2exp.h"
X
X/************************************************************************/
X
XHidden struct prio priorities[] = {
X {"", '\0', 1, 13}, /* tag functions */
X
X {S_ABOUT, P_mon, 13, 13},
X {S_PLUS, P_mon, 13, 13},
X {S_NUMBER, P_mon, 12, 12},
X {S_MINUS, P_mon, 9, 9},
X {S_NUMERATOR, P_mon, 2, 13},
X {S_DENOMINATOR, P_mon, 2, 13},
X {S_NUMBER, P_dya, 12, 12},
X {S_POWER, P_dya, 10, 11},
X {S_TIMES, P_dya, 8, 8},
X {S_OVER, P_dya, 7, 8},
X {S_PLUS, P_dya, 6, 6},
X {S_MINUS, P_dya, 6, 6},
X {S_BEHEAD, P_dya, 5, 5},
X {S_CURTAIL, P_dya, 5, 5},
X {S_REPEAT, P_dya, 4, 4},
X {S_JOIN, P_dya, 3, 3},
X {S_LEFT_ADJUST, P_dya, 1, 1},
X {S_CENTER, P_dya, 1, 1},
X {S_RIGHT_ADJUST, P_dya, 1, 1},
X {Bottom, P_dya, 0, 0}
X};
X
X#define NPRIORITIES (sizeof priorities / sizeof priorities[0])
X
XVisible struct prio *pprio(f, adic) value f; char adic; {
X struct prio *pp;
X string s= strval(f);
X
X for (pp= priorities+1; pp < &priorities[NPRIORITIES]; ++pp) {
X if (strcmp(pp->fun, s) == 0 && pp->adic == adic)
X return pp;
X }
X /* tag */
X return priorities;
X}
X
X/************************************************************************/
X
X/*
X * Stack(adm) <= "allocated space" < Top(adm)
X * Sp(adm) points to the first free entry
X */
X
XHidden Procedure initstack(adm, n) expadm *adm; int n; {
X Stack(adm)= Sp(adm)=
X (parsetree *) getmem((unsigned) (n * sizeof(parsetree *)));
X Top(adm)= Stack(adm) + n;
X Nextend(adm)= n;
X}
X
XVisible Procedure initexp(adm, n, level) expadm *adm; int n; char level; {
X initstack(adm, n);
X push_dya(adm, mk_text(Bottom));
X Level(adm)= level;
X Prop(adm)= No;
X Nfld(adm)= 0;
X}
X
XVisible Procedure endstack(adm) expadm *adm; {
X while (Sp(adm) > Stack(adm)) release(Pop(adm));
X freemem((ptr) Stack(adm));
X}
X
XVisible Procedure push_item(adm, v) expadm *adm; parsetree v; {
X if (Sp(adm) >= Top(adm)) st_extend(adm);
X *Sp(adm)++= v;
X}
X
XHidden Procedure st_extend(adm) expadm *adm; {
X int syze= (Top(adm) - Stack(adm)) + Nextend(adm);
X int n= Sp(adm) - Stack(adm);
X
X regetmem((ptr *) &Stack(adm),
X (unsigned) syze * sizeof(parsetree *));
X Sp(adm)= Stack(adm) + n;
X Top(adm)= Stack(adm) + syze;
X}
X
X/* to recognize them on the stack, dyadic operators are pushed as compounds */
X
XHidden Procedure push_dya(adm, v) expadm *adm; value v; {
X value w= mk_compound(1);
X *Field(w, 0)= v;
X push_item(adm, (parsetree) w);
X}
X
X/* ******************************************************************** */
X/* expression */
X/* ******************************************************************** */
X
XVisible parsetree expr(q) txptr q; {
X return collateral(q, singexpr);
X}
X
XVisible parsetree singexpr(q) txptr q; {
X expadm adm;
X parsetree v, par_expr();
X
X if (nothing(q, MESS(2100, "nothing instead of expected expression")))
X return NilTree;
X initexp(&adm, N_EXP_STACK, PARSER);
X v= par_expr(q, &adm);
X endstack(&adm);
X return v;
X}
X
XHidden bool unparsed= No;
X
XVisible parsetree unp_test(q) txptr q; {
X unparsed= Yes;
X return singexpr(q);
X}
X
X#define S_tag1 0 /* zer or mon tag */
X#define S_tag2 1 /* zer, mon or dya tag */
X#define S_elmt 2 /* element */
X#define S_dm 3 /* dyamon sign */
X#define S_mon 4 /* mon sign */
X#define S_dya 5 /* dya sign */
X#define S_unp 6 /* unparsed */
X#define S_err 7 /* error */
X
X#define K_tag 0
X#define K_element 1
X#define K_dyamon 2
X#define K_mon 3
X#define K_dya 4
X
XHidden int trans[5][8]= {
X {S_tag2, S_unp, S_dya, S_unp, S_tag1, S_tag1, S_unp, S_err},
X {S_elmt, S_unp, S_err, S_unp, S_elmt, S_elmt, S_unp, S_err},
X {S_dm, S_unp, S_dya, S_unp, S_mon, S_mon, S_unp, S_err},
X {S_mon, S_unp, S_err, S_unp, S_mon, S_mon, S_unp, S_err},
X {S_dya, S_dya, S_dya, S_err, S_err, S_err, S_unp, S_err}
X};
X
XHidden parsetree par_expr(q, adm) txptr q; expadm *adm; {
X parsetree v= NilTree;
X value w, c;
X int state= S_dya;
X int kind, n;
X txptr tx0, tx1;
X
X if (unparsed) {
X state= S_unp;
X unparsed= No;
X }
X skipsp(&tx);
X tx0= tx;
X while (Text(q)) {
X tx1= tx;
X if (tag_operator(q, &w)) kind= K_tag;
X else if (element(q, &w)) kind= K_element;
X else if (dyamon_sign(&w)) kind= K_dyamon;
X else if (mon_sign(&w)) kind= K_mon;
X else if (dya_sign(&w)) kind= K_dya;
X else break;
X
X state= trans[kind][state];
X if (state == S_err) {
X release(w);
X tx= tx1;
X break;
X }
X else if (state == S_dya)
X do_dya(adm, w);
X else
X push_item(adm, (parsetree) w);
X skipsp(&tx);
X }
X if (Text(q)) {
X if (tx == tx0) parerr(NO_EXPR);
X else parerr(UPTO_EXPR);
X tx= q;
X return NilTree;
X }
X switch (state) {
X case S_mon:
X case S_dya:
X case S_dm:
X case S_err:
X parerr(NO_EXPR);
X return NilTree;
X case S_unp:
X n= (Sp(adm) - Stack(adm)) - 1;
X c= mk_compound(n);
X while (n > 0) *Field(c, --n)= Pop(adm);
X for (tx1= tx; Space(Char(tx1-1)); --tx1);
X return node3(UNPARSED, c, cr_text(tx0, tx1));
X default:
X while (Sp(adm) - Stack(adm) > 2)
X reduce(adm);
X v= Pop(adm);
X if (ValidTree(v) && Is_text(v))
X v= node2(TAG, v);
X return v;
X }
X}
X
X#define SHIFT '1'
X#define START '2'
X
X#define Prio_err(adm) \
X (Level(adm) == PARSER ? pprerr(PRIO) : fixerr(PRIO))
X
XVisible Procedure do_dya(adm, v) expadm *adm; value v; {
X parsetree *p= Sp(adm) - 2; /* skip operand */
X struct prio *pdya, *popr;
X char action= START;
X
X pdya= dprio(v);
X for (;;) {
X popr= Dya_opr(*p) ? dprio(*Field(*p, 0)) : mprio(*p);
X if (popr->L >= pdya->H) { /* reduce */
X if (action == SHIFT)
X Prio_err(adm);
X reduce(adm);
X p= Sp(adm) - 2;
X action= START;
X }
X else if (pdya->L > popr->H) {
X if (Dya_opr(*p))
X break;
X --p;
X action= SHIFT;
X }
X else {
X if (action == START)
X Prio_err(adm);
X break;
X }
X }
X push_dya(adm, v); /* shift */
X}
X
XVisible Procedure reduce(adm) expadm *adm; {
X parsetree x, y;
X value opr, f= Vnil, v;
X
X /* right operand */
X y= Pop(adm);
X if (Level(adm) == PARSER && ValidTree(y) && Is_text(y))
X y= node2(TAG, y);
X
X /* operator */
X opr= (value) Pop(adm);
X if (!Dya_opr(opr)) {
X if (Level(adm) == FIXER) {
X VOID is_monfun(opr, &f);
X f= copydef(f);
X }
X push_item(adm, node4(MONF, opr, y, f));
X return;
X }
X opr= copy(*Field(v= opr, 0));
X release(v);
X
X /* left operand */
X x= Pop(adm);
X if (Level(adm) == PARSER && ValidTree(x) && Is_text(x))
X x= node2(TAG, x);
X if (Level(adm) == FIXER) {
X VOID is_dyafun(opr, &f);
X f= copydef(f);
X }
X push_item(adm, node5(DYAF, x, opr, y, f));
X}
X
X/* ******************************************************************** */
X/* element */
X/* ******************************************************************** */
X
XHidden bool element(q, v) txptr q; value *v; {
X parsetree w;
X
X if (sel_tag(q, &w) || closed_expr(q, &w) || constant(q, &w) ||
X text_dis(q, &w) || tlr_dis(q, &w)) {
X selection(q, &w);
X *v= (value) w;
X return Yes;
X }
X return No;
X}
X
X/* ******************************************************************** */
X/* (sel_tag) */
X/* ******************************************************************** */
X
XHidden bool sel_tag(q, v) txptr q; parsetree *v; {
X value name; txptr tx0= tx;
X if (Text(q) && is_tag(&name)) {
X txptr tx1= tx;
X skipsp(&tx);
X if (Text(q) && sub_sign) {
X tx= tx1;
X *v= node2(TAG, name);
X return Yes;
X }
X else {
X release(name);
X tx= tx0;
X }
X }
X return No;
X}
X
X/* ******************************************************************** */
X/* (expression) */
X/* ******************************************************************** */
X
XHidden bool closed_expr(q, v) txptr q; parsetree *v; {
X return open_sign ? (*v= compound(q, expr), Yes) : No;
X}
X
X/* ******************************************************************** */
X/* constant */
X/* */
X/* note: stand_alone e<number> not allowed */
X/* ******************************************************************** */
X
XHidden bool constant(q, v) txptr q; parsetree *v; {
X if (Dig(Char(tx)) || Char(tx) == C_POINT) {
X txptr tx0= tx;
X bool d= digits(q);
X value text;
X if (Text(q) && point_sign && !digits(q) && !d)
X pprerr(MESS(2101, "point without digits"));
X if (Text(q) && Char(tx) == 'e' &&
X (Dig(Char(tx+1)) || !Tagmark(tx+1) )
X ) {
X tx++;
X if (Text(q) && (plus_sign || minus_sign));
X if (!digits(q)) pprerr(MESS(2102, "e not followed by exponent"));
X }
X text= cr_text(tx0, tx);
X *v= node3(NUMBER, Vnil, text);
X return Yes;
X }
X return No;
X}
X
XHidden bool digits(q) txptr q; {
X txptr tx0= tx;
X while (Text(q) && Dig(Char(tx))) tx++;
X return tx > tx0;
X}
X
X/* ******************************************************************** */
X/* textual_display */
X/* ******************************************************************** */
X
XForward parsetree text_body();
X
XHidden bool text_dis(q, v) txptr q; parsetree *v; {
X value aq;
X if (texdis_sign(&aq)) {
X parsetree w;
X w= text_body(q, aq);
X if (w == NilTree) w= node3(TEXT_LIT, mk_text(""), NilTree);
X *v= node3(TEXT_DIS, aq, w);
X return Yes;
X }
X return No;
X}
X
XHidden parsetree text_body(q, aq) txptr q; value aq; {
X value head; parsetree tail;
X char quote= strval(aq)[0];
X txptr tx0= tx;
X while (Text(q)) {
X if (Char(tx) == quote || Char(tx) == C_CONVERT) {
X head= tx0 < tx ? cr_text(tx0, tx) : Vnil;
X if (Char(tx) == Char(tx+1)) {
X value spec= cr_text(tx, tx+1);
X tx+= 2;
X tail= text_body(q, aq);
X tail= node3(TEXT_LIT, spec, tail);
X }
X else {
X parsetree v;
X if (is_conversion(q, &v)) {
X tail= text_body(q, aq);
X tail= node3(TEXT_CONV, v, tail);
X }
X else {
X tx++;
X tail= NilTree;
X }
X }
X if (head == Vnil) return tail;
X else return node3(TEXT_LIT, head, tail);
X }
X else tx++;
X }
X parerrV(MESS(2103, "cannot find matching %s"), aq);
X return NilTree;
X}
X
XHidden bool is_conversion(q, v) txptr q; parsetree *v; {
X if (conv_sign) {
X txptr ftx, ttx;
X req(S_CONVERT, q, &ftx, &ttx);
X *v= expr(ftx); tx= ttx;
X return Yes;
X }
X return No;
X}
X
X/* ******************************************************************** */
X/* table_display; list_display; range_display; */
X/* ******************************************************************** */
X
XHidden bool elt_dis(v) parsetree *v; {
X if (curlyclose_sign) {
X *v= node1(ELT_DIS);
X return Yes;
X }
X return No;
X}
X
XHidden parsetree par_lta(q, adm, lta_item) txptr q; expadm *adm;
X int (*lta_item)(); {
X txptr ftx, ttx;
X int n;
X parsetree v;
X
X while (still_ok && find(S_SEMICOLON, q, &ftx, &ttx)) {
X (*lta_item)(ftx, adm);
X tx= ttx;
X }
X (*lta_item)(q, adm);
X n= Sp(adm) - Stack(adm);
X v= mk_compound(n);
X while (n>0) *Field(v, --n)= Pop(adm);
X return v;
X}
X
XHidden Procedure tab_item(q, adm) txptr q; expadm *adm; {
X txptr ftx, ttx;
X
X need(S_SUB);
X req(S_BUS, q, &ftx, &ttx);
X push_item(adm, expr(ftx));
X tx= ttx;
X need(S_COLON);
X push_item(adm, singexpr(q));
X}
X
XHidden bool tab_dis(q, v) txptr q; parsetree *v; {
X if (Char(tx) == C_SUB) {
X expadm adm;
X parsetree w;
X
X initstack(&adm, N_LTA_STACK);
X w= par_lta(q, &adm, tab_item);
X endstack(&adm);
X *v= node2(TAB_DIS, w);
X return Yes;
X }
X return No;
X}
X
XHidden bool range_elem(q, v) txptr q; parsetree *v; {
X txptr ftx, ttx;
X if (find(S_RANGE, q, &ftx, &ttx)) {
X parsetree w;
X if (Char(ttx) == '.') { ftx++; ttx++; }
X w= singexpr(ftx); tx= ttx;
X *v= node3(RANGE_BNDS, w, singexpr(q));
X return Yes;
X }
X return No;
X}
X
XHidden Procedure list_item(q, adm) txptr q; expadm *adm; {
X parsetree r;
X if (range_elem(q, &r))
X push_item(adm, r);
X else
X push_item(adm, singexpr(q));
X}
X
XHidden Procedure list_dis(q, v) txptr q; parsetree *v; {
X expadm adm;
X parsetree w;
X
X initstack(&adm, N_LTA_STACK);
X w= par_lta(q, &adm, list_item);
X endstack(&adm);
X *v= node2(LIST_DIS, w);
X}
X
XHidden bool tlr_dis(q, v) txptr q; parsetree *v; {
X if (curlyopen_sign) {
X skipsp(&tx);
X if (!elt_dis(v)) {
X txptr ftx, ttx;
X req(S_CURCLOSE, q, &ftx, &ttx);
X skipsp(&tx);
X if (!tab_dis(ftx, v)) list_dis(ftx, v);
X tx= ttx;
X }
X return Yes;
X }
X return No;
X}
X
X/* ******************************************************************** */
X/* selection */
X/* ******************************************************************** */
X
XVisible Procedure selection(q, v) txptr q; parsetree *v; {
X txptr ftx, ttx;
X skipsp(&tx);
X while (Text(q) && sub_sign) {
X req(S_BUS, q, &ftx, &ttx);
X *v= node3(SELECTION, *v, expr(ftx)); tx= ttx;
X skipsp(&tx);
X }
X}
X
X/* ******************************************************************** */
X/* trim_target */
X/* ******************************************************************** */
X
XVisible Procedure trim_target(q, v) txptr q; parsetree *v; {
X parsetree w;
X value name;
X bool beh;
X struct prio *ptrim, *pdya;
X txptr ftx;
X
X skipsp(&tx);
X while (Text(q) && ((beh= behead_sign) || curtl_sign)) {
X skipsp(&tx);
X if (!findtrim(q, &ftx)) ftx= q;
X w= singexpr(ftx); tx= ftx;
X if (nodetype(w) == DYAF) {
X pdya= dprio(*Branch(w, DYA_NAME));
X name= mk_text(beh ? S_BEHEAD : S_CURTAIL);
X ptrim= dprio(name);
X if (!(pdya->L > ptrim->H))
X pprerr(NO_TRIM_TARG);
X release(name);
X }
X *v= node3(beh ? BEHEAD : CURTAIL, *v, w);
X }
X}
X
X/* ******************************************************************** */
X/* tag_operator */
X/* ******************************************************************** */
X
XVisible bool tag_operator(q, v) txptr q; value *v; {
X value w;
X txptr tx0= tx;
X if (Text(q) && is_tag(&w)) {
X skipsp(&tx);
X if (Text(q) && sub_sign) {
X release(w);
X tx= tx0;
X return No;
X }
X *v= w;
X return Yes;
X }
X return No;
X}
END_OF_FILE
if test 13508 -ne `wc -c <'abc/bint2/i2exp.c'`; then
echo shar: \"'abc/bint2/i2exp.c'\" unpacked with wrong size!
fi
# end of 'abc/bint2/i2exp.c'
fi
if test -f 'abc/scripts/mkdep.gen' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/scripts/mkdep.gen'\"
else
echo shar: Extracting \"'abc/scripts/mkdep.gen'\" \(595 characters\)
sed "s/^X//" >'abc/scripts/mkdep.gen' <<'END_OF_FILE'
X: 'Shell script to create dependency lines for inclusion in a Makefile.'
X: 'This is done by pulling each file through the C preprocessor,'
X: 'filtering all "#<file> 1" lines out and doing some substitutions'
X: 'on them. Since the format of these lines may be different on your'
X: 'system, you may have to modify the sed command below.'
X
X: 'The following should invoke your C preprocessor:'
XCPP="cc -E"
X
XARGS=
Xwhile :
Xdo
X case $1 in
X -*) ARGS="$ARGS $1"; shift;;
X *) break;;
X esac
Xdone
X
Xfor file
Xdo
X obj=`basename $file .c`.o
X $CPP $ARGS $file |
X sed -n '/^# 1 "\(.*\)".*$/s//'$obj': \1/p'
Xdone
END_OF_FILE
if test 595 -ne `wc -c <'abc/scripts/mkdep.gen'`; then
echo shar: \"'abc/scripts/mkdep.gen'\" unpacked with wrong size!
fi
chmod +x 'abc/scripts/mkdep.gen'
# end of 'abc/scripts/mkdep.gen'
fi
echo shar: End of archive 9 \(of 25\).
cp /dev/null ark9isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 25 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still must unpack the following archives:
echo " " ${MISSING}
fi
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list