Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume23/abc/part12

Internet Message Format | 1991-01-08 | 54.4 KB

Subject:  v23i091:  ABC interactive programming environment, Part12/25
Newsgroups: comp.sources.unix
Approved: [e-mail]
X-Checksum-Snefru: f303971b 540bb072 9f5a05fb 50aff956

Submitted-by: Steven Pemberton <[e-mail]>
Posting-number: Volume 23, Issue 91
Archive-name: abc/part12

#! /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 [e-mail] if you want that tool.
# Contents:  abc/Makefile.unix abc/boot/grammar.abc abc/btr/i1tex.c
#   abc/lin/i1tlt.c
# Wrapped by [e-mail] on Mon Dec 17 13:28:04 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 12 (of 25)."'
if test -f 'abc/Makefile.unix' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/Makefile.unix'\"
else
  echo shar: Extracting \"'abc/Makefile.unix'\" \(13343 characters\)
  sed "s/^X//" >'abc/Makefile.unix' <<'END_OF_FILE'
X#######################################################################
X#                                                                     #
X#                 Makefile for ABC system under unix.                 #
X#                                                                     #
X#######################################################################
X
X# --- Some make's only make love with the Bourne shell ---
X#
X
XSHELL=    /bin/sh
X
X
X# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X# +++ Start of editable macro definitions; filled in by ./Setup      +++
X# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X# --- pass make options ---
X#
X# On 4.{23}BSD the macro $(MFLAGS) is set by make to the collection of
X# command line options (such as -k, -i) and passed to make in subdirectories.
X# For System V use $(MAKEFLAGS). Otherwise just fill in 'make'.
X
XMAKE=    make $(MFLAGS)
X
X
X# --- Where to install the stuff ---
X#
X# These should all be absolute pathnames.
X
X# destination directory for binaries 'abc' and 'abckeys':
X
XDESTABC=/usr/new
X
X# destination directory for auxiliary data files:
X
XDESTLIB=/usr/new/lib/abc
X
X# destination directory for 'abc.1' manual page:
X
XDESTMAN=/usr/man/mann
X
X# local destination if you cross-compile; empty otherwise:
X
XDESTROOT=
X# you should first generate uhdrs/config.h remotely;
X# see 'make config' below.
X
X
X# --- Software floating point needed? ---
X
XFLOAT=
X
X
X# --- Flags to the C compiler ---
X
XDEFS=    -DNDEBUG
XCFLAGS= -O $(FLOAT) $(DEFS)
X
X
X# --- Flags to the loader ---
X
XLDFLAGS=
X
X
X# --- Specify termcap or termlib library ---
X#
X# Set TERMLIB to the appropriate termcap or termlib library specification
X# (either -lxxx option or absolute pathname) if your system has one.
X# Otherwise leave TERMLIB empty and remove the comment symbols before
X# the definitions of OWNTLIB, KOWNTLIB and OWNTBASE to install the
X# public domain version from ./tc.
X
XTERMLIB= -ltermcap
X
X#OWNTLIB= libtermcap.a
X#KOWNTLIB= ../libtermcap.a
X#OWNTBASE= termcap
X
X
X# --- Libraries for editor-interpreter 'abc' ---
X
XLIBS=    -lm $(TERMLIB) $(OWNTLIB)
X
X
X# --- Libraries for utility 'abckeys' ---
X
XKLIBS=    $(TERMLIB) $(KOWNTLIB)
X
X
X# --- How to generate dependency information for make ---
X#
X# Set MKDEP to $(CC) -M $(DEFS) or to ../scripts/mkdep $(DEFS).
X# 'cc -M' is a 4.2BSD-only feature which causes the C preprocessor
X# to output a list of dependencies that is directly usable by make.
X# This can be simulated exactly by piping the output of your preprocessor
X# through the shell script ./scripts/mkdep.
X# Check the comments there to see if it needs polishing for your system.
X
XMKDEP=    $(CC) -M $(DEFS)
X
X
X# --- names of makefiles and dependency-files in subdirectories ---
X#
X# Only change in case of problems; consult ./Problems.
X
XMF=    Mf
XDEP=    Dep
X
X
X# --- name of messages file (holding abc's error messages) ---
X#
X# Change to MESSAGES=abc.mse in case you had to add or change error messages
X# in the source; then, use 'make messages' to create a new messages file
X# from the source.
X# If you want the error messages in Swahili, translate abc.msg, put the result
X# in abc.swahili, and set MESSAGES=abc.swahili.
X# In both cases use 'make all' to incorporate the new messages file in abc.
X# You might also update the FILES section of the manual ./abc.1.
X
XMESSAGES=abc.msg
X
X
X# --- name of help file (used in helpblurb after keybindings) ---
X#
X# This file contains exactly the abc.1 manual entry.
X# If you translate it, use another name and fill it in here;
X# the changed name will be filled in properly by 'make all'.
X# Also update ./abc.1 in this case.
X
XHELP=abc.hlp
X
X
X# +++++++++++++++++++++++++++++++++++++++++
X# +++ End of editable macro definitions +++
X# +++++++++++++++++++++++++++++++++++++++++
X#
X# The remaining macro definitions should only have to be edited
X# if you make very drastic changes.
X
X# --- Include flags to the C compiler for editor and interpreter directories ---
X
XBINCL=    -I../bhdrs -I../uhdrs
XEINCL=    -I../bhdrs -I../ehdrs -I../uhdrs -I../btr
XIINCL=    -I../bhdrs -I../ihdrs -I../uhdrs
XUINCL=    -I../bhdrs -I../ehdrs -I../ihdrs -I../uhdrs
X
X# --- Editor and interpreter directories ---
X
XCDIRS=    b bed bint1 bint2 bint3 btr unix stc bio
X
XBDIRS=    b
XEDIRS=    bed
XIDIRS=    bint1 bint2 bint3 btr stc bio
XUDIRS=    unix
X
X# --- Editor and interpreter files ---
X
XBOBJS=    b/*.o
XEOBJS=    bed/*.o
XIOBJS=    bint1/*.o bint2/*.o bint3/*.o btr/*.o stc/*.o bio/*.o
XUOBJS=    unix/*.o
X
XBSRCS=    b/*.c
XESRCS=    bed/*.c
XISRCS=    bint1/*.c bint2/*.c bint3/*.c btr/*.c stc/*.c bio/*.c
XUSRCS=    unix/*.c
X
XBHDRS=    bhdrs/*.h
XEHDRS=    ehdrs/*.h
XIHDRS=    ihdrs/*.h btr/*.h bio/*.h
XUHDRS=    uhdrs/*.h
X
X# --- Preliminary dependencies (do not change for Unix) ---
X
XCONFIG=    uhdrs/config.h
XOSHDIR= uhdrs
X
XDEST=    uhdrs/dest.h
X
X# --- Stuff for programmers ---
X
XLINT=        lint
X# change the next one to -p for ATT System V
XLINTFLAGS=    -abhxp
XLINCL=        -Ibhdrs -Iehdrs -Iihdrs -Iuhdrs -Ibtr
X
XTAGDIRS=b bed bint1 bint2 bint3 btr stc bio unix keys bhdrs ehdrs ihdrs uhdrs
X
X
X# ---------------------------------------------------------------------
X# --- make makefiles: construct trivial makefiles in subdirectories ---
X# ----------------------------------------------------------------------
X#
X# This constructs trivial makefiles called 'Mf' in relevant subdirectories.
X# You can use distributed makefiles called 'MF' if this fails.
X# See ./Problems for details.
X
Xmakefiles:
X    for i in $(CDIRS); do \
X        ( cd $$i; echo all: *.c | sed 's/\.c/.o/g' >Mf ) done
X    @./ch_makefiles "$(MF)"
X
X# No automatic makefile in ./keys. Edit that one yourself if need be.
X
X
X# ----------------------------------------------------------------------------
X# --- make depend: construct makefiles with dependencies in subdirectories ---
X# ----------------------------------------------------------------------------
X#
X# This constructs additional makefiles called 'Dep' in subdirectories
X# containing the dependency information.
X# If it fails you can likewise use distributed ones called 'DEP'.
X# See ./Problems.
X
Xdepend: $(CONFIG) $(DEST) bdep edep idep udep kdep
X    @./ch_depend "$(DEP)"
X
X# The file $(DEST) communicates the place and names of auxiliary files
X# to the binaries 'abc' and 'abckeys'.
X# It is unconditionally remade for every 'make all' or 'make install'.
X# Here we just make sure it exists.
X
X$(DEST):
X    touch $(DEST)
X
Xbdep:
X    for i in $(BDIRS); do \
X        ( echo $$i; cd $$i; $(MKDEP) $(BINCL) *.c >Dep ) done
X
Xedep:
X    for i in $(EDIRS); do \
X        ( echo $$i; cd $$i; $(MKDEP) $(EINCL) *.c >Dep ) done
X
Xidep:
X    for i in $(IDIRS); do \
X        ( echo $$i; cd $$i; $(MKDEP) $(IINCL) *.c >Dep ) done
X
Xudep:
X    for i in $(UDIRS); do \
X        ( echo $$i; cd $$i; $(MKDEP) $(UINCL) *.c >Dep ) done
X
Xkdep:
X    cd keys; $(MAKE) MKDEP="$(MKDEP)" DEFS="$(DEFS)" depend >Dep
X
X
X# -------------------------------------------
X# ---  make all: make everything locally  ---
X# -------------------------------------------
X#
X# This makes all programs and utilities in the current directory.
X# (Except for the ready-for-use default key definitions files).
X
Xall:    alldest $(CONFIG) abc abckeys $(MESSAGES) $(HELP)
X    @./ch_all "$(MESSAGES)" "$(HELP)" "$(DESTROOT)"
X
X# The target 'alldest' is used to communicate the place of auxiliary files.
X#
X# Dependency on the (non-existent) file "ALWAYS" causes this entry to
X# be (re)made unconditionally. Make won't complain about ALWAYS not being
X# found because there is also a rule referencing it as target at the
X# very end (which actually doesn't make it, but make doesn't care).
X
Xalldest: ALWAYS
X    echo "#define ABCLIB \"`pwd`\"" >$(DEST)
X    echo "#define MESSFILE \"$(MESSAGES)\"" >>$(DEST)
X    echo "#define HELPFILE \"$(HELP)\"" >>$(DEST)
X
X# CONFIG: generate include file with info about the hardware configuration.
X#
X# Special care is taken to remove an incomplete $(CONFIG) if mkconfig
X# fails halfway. Otherwise a subsequent 'make depend' will happily go on.
X
Xconfig: $(CONFIG)
X
X$(CONFIG): mkconfig.c $(OSHDIR)/osconf.h
X    @./ch_config "$(DESTROOT)" "$(CONFIG)"
X    $(CC) -I$(OSHDIR) mkconfig.c -o mkconfig
X    mkconfig >$(CONFIG) || (rm -f $(CONFIG) && exit 1)
X
X# abc: make the executable that is the kernel of the system.
X#
X# The load must be unconditional, since we cannot know whether
X# any of the submakes had to update some subtarget.
X
Xabc:    $(CONFIG) $(BDIRS) $(EDIRS) $(IDIRS) $(UDIRS) \
X        $(OWNTLIB) $(OWNTBASE) ALWAYS
X    $(CC) $(LDFLAGS) $(BOBJS) $(EOBJS) $(IOBJS) $(UOBJS) $(LIBS) -o abc
X
X# Call make for each editor and interpreter subdirectory with proper flags.
X#
X# If a dependency line has more than one item left of the colon, the
X# commands are executed for each of the items, with $@ substituted
X# by the item's name.
X
X$(BDIRS): $(CONFIG) ALWAYS
X    cd $@; $(MAKE) -f $(MF) -f $(DEP) CFLAGS='$(CFLAGS) $(BINCL)' all
X
X$(EDIRS): $(CONFIG) ALWAYS
X    cd $@; $(MAKE) -f $(MF) -f $(DEP) CFLAGS='$(CFLAGS) $(EINCL)' all
X
X$(IDIRS): $(CONFIG) ALWAYS
X    cd $@; $(MAKE) -f $(MF) -f $(DEP) CFLAGS='$(CFLAGS) $(IINCL)' all
X
X$(UDIRS): $(CONFIG) ALWAYS
X    cd $@; $(MAKE) -f $(MF) -f $(DEP) CFLAGS='$(CFLAGS) $(UINCL)' all
X
X# Make new messages file when you have changed any in the source.
X# Note: the Collect and Change scripts can be found in ./scripts.
X# See ./Problems for details.
X
Xmessages: checkmse abc.mse
X
Xcheckmse:
X    @./ch_messages "$(MESSAGES)"
X
Xabc.mse: $(BSRCS) $(ESRCS) $(ISRCS) $(USRCS) \
X        ihdrs/i0err.h ehdrs/erro.h bio/i4bio.h
X    ./scripts/Collect $(BSRCS) $(ESRCS) $(ISRCS) $(USRCS) \
X        ihdrs/i0err.h ehdrs/erro.h bio/i4bio.h >abc.mse
X
Xabc.msg:
X    @echo "Some dwarf has sneaked away the original messages file"
X    @echo "See ./Problems on how to recreate a new one"
X
X# Help file from manual entry.
X# Sorry, the file unix/abc.mac was created from copyrighted material;
X# therefore, it is not in the distribution.
X#
X# #abc.hlp: unix/abc.mac abc.1
X# #    nroff unix/abc.mac abc.1 >abc.help
X# #    (echo "SUMMARY OF SPECIAL ACTIONS"; \
X# #     sed -e '1,/^SUMMARY/d' abc.help; \
X# #     echo " "; \
X# #     sed -e '/^SUMMARY/,$$d' abc.help) >abc.hlp
X# #    rm abc.help
X
X# Make utility 'abckeys' for redefinition of keybindings.
X#
X# The submake will find out whether recompilation is necessary.
X
Xabckeys: $(OWNTLIB) $(OWNTBASE) ALWAYS
X    cd keys; \
X     $(MAKE) -f Makefile -f $(DEP) \
X         CFLAGS="$(CFLAGS)" LDFLAGS="$(LDFLAGS)" LIBS="$(KLIBS)" all
X
X
X# ----------------------------------------------
X# --- make examples: try the ABC interpreter ---
X# ----------------------------------------------
X
Xexamples:
X    @cd ex; DoExamples local
X#    ch_examples is embedded in DoExamples to cope with cross compilation.
X
X
X# ---------------------------------------------------------
X# --- make try_editor: try the ABC editor interactively ---
X# ---------------------------------------------------------
X
Xtry_editor:
X    @cd ex; TryEditor local
X#    ch_tryeditor embedded in TryEditor.
X
X# ---------------------------------------------------------
X# --- make install: install everything in public places ---
X# ---------------------------------------------------------
X#
X# The dependency of 'install' on 'installdest communicates the place
X# and names of auxiliary files to the binaries 'abc' and 'abckeys'.
X# The unconditional submakes of the latter targets causes the
X# proper files to be remade.
X#
X# The directory ukeys contains default keydefinitions files for
X# several terminals.
X
Xinstall: installdest abc abckeys $(MESSAGES) $(HELP)
X    cp abc abckeys $(DESTROOT)$(DESTABC)
X    cp $(MESSAGES) $(HELP) $(DESTROOT)$(DESTLIB)
X    cd ukeys; cp abckeys_* $(DESTROOT)$(DESTLIB)
X    cp abc.1 $(DESTROOT)$(DESTMAN)
X    @./ch_install "$(MESSAGES)" "$(HELP)" \
X        "$(DESTABC)" "$(DESTLIB)" "$(DESTMAN)" "$(DESTROOT)"
X
Xinstalldest: ALWAYS
X    echo "#define ABCLIB \"$(DESTLIB)\"" >$(DEST)
X    echo "#define MESSFILE \"$(MESSAGES)\"" >>$(DEST)
X    echo "#define HELPFILE \"$(HELP)\"" >>$(DEST)
X
X
X# -------------------------------------------------
X# --- Make our own termcap library and database ---
X# -------------------------------------------------
X#
X# For systems that really don't have any termlib-like library
X# this makes our own from public domain sources in ./tc.
X# See ./tc/README for details.
X# This happens automatically if you remove the comment symbols before
X# the definitions of OWNTLIB and OWNTBASE above.
X
Xlibtermcap.a:
X    cd tc; make library
X
Xtermcap:
X    cd tc; make database
X
X
X# -----------------------------------
X# ---  make clean: local cleanup  ---
X# -----------------------------------
X
Xclean:
X    rm -f */*.o mkconfig $(CONFIG) abc abckeys ex/out
X    @./ch_clean "$(MESSAGES)"
X
X
X# -------------------------------------------------
X# ---  make clobber: additional local cleanup   ---
X# -------------------------------------------------
X
X# To be used after 'make makefiles', 'make depend' and/or 'make messages'.
X
Xclobber:
X    rm -f abc.mse */Mf */Dep */tags tags
X
X
X# --------------------------------------
X# ---  Utilities for the programmer  ---
X# --------------------------------------
X
Xmflags:
X    echo MFLAGS="$(MFLAGS)", MAKEFLAGS="$(MAKEFLAGS)"
X
Xlint:    abclint klint
X
Xabclint:
X    $(LINT) $(LINTFLAGS) $(DEFS) $(LINCL) \
X        $(BSRCS) $(ESRCS) $(ISRCS) $(USRCS)
X
Xklint:
X    cd keys; \
X     $(MAKE) LINT="$(LINT)" LINTFLAGS="$(LINTFLAGS)" DEFS="$(DEFS)" lint
X
Xtags:    ALWAYS
X    rm -f tags   # Remove it so it will be remade when an interrupt hits
X    for i in $(TAGDIRS); \
X    do \
X        ( echo $$i; cd $$i; ctags -w *.[ch]; \
X          sed "s,    ,    $$i/," tags \
X        ) \
X    done | sort -o tags
X
X
Xid:    ALWAYS
X    mkid */*.[hc]
X
X
XALWAYS: # Must not exist, but must be mentioned in the makefile
END_OF_FILE
  if test 13343 -ne `wc -c <'abc/Makefile.unix'`; then
    echo shar: \"'abc/Makefile.unix'\" unpacked with wrong size!
  fi
  # end of 'abc/Makefile.unix'
fi
if test -f 'abc/boot/grammar.abc' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/boot/grammar.abc'\"
else
  echo shar: Extracting \"'abc/boot/grammar.abc'\" \(13172 characters\)
  sed "s/^X//" >'abc/boot/grammar.abc' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X/*
X * Grammar for ABC.
X *
X * This file defines a grammar with three distinct grammatical items:
X * classes, Symbols and LEXICALs.
X *    class-names are [a-z][a-z0-9_]*           # lower-case
X *    Symbol-names are [A-Z][a-z][a-z0-9_]*    # First-upper_rest-lower
X *    LEXICAL-names are [A_Z][A_Z][A_Z0-9_]*  # ALL_UPPER
X * (note: the second char of a Symbol or lexical MUST be alphabetic)
X *
X * A Symbol definition looks like:
X *    Put: "PUT ", expression, " IN ", address.
X * e.g. a sequence of "Fixed text" between quotes, alternated with class- or
X * LEXICAL-names, separated by comma's, ending with a point;
X * between names, any of the "TEXT" items may be missing,
X * but between "TEXT"'s a name must be there;
X * there may be no more than MAXCHILD (4, see main.h) names,
X * and no more than MAXCHILD+1 "TEXT"'s;
X * the text's "\n", "\t" and "\b" are used in this grammar for ABC's
X * newline, increase-indentation and decrease-indentation, respectively.
X *
X * A class definition looks like:
X *    optional_comment: Optional; COMMENT.
X * using only Symbol-names or LEXICAL-names, seperated by comma's and
X * ending in a point.
X * It denotes a sequence of possible alternatives for this class.
X *
X * The Symbol Optional is defined by mktable at the end of the grammar,
X * where the ABC editor expects it, as:
X *    Optional: .
X * If it is used in the alternative list of a class definition, it must be
X * the first one.
X *
X * A LEXICAL definition looks like:
X *    NUMBER: "0123456789", "0123456789".
X * where the first (C-)string denotes the characters this LEXICAL item can
X * start with, and the second string the ones that may be used in a
X * continuation.
X * If the first character of a string is '^', it means:
X *    'any character not matching any of the following in this string'.
X *
X * Since mktable will generate definitions to "envelop" the LEXICALS,
X * one should not use the corresponding Symbol name, e.g. Rawinput.
X * (to prevent clashes in the produced header-file); nor the class-names
X * e.g. rawinput or rawinput-body (just for readability:-).
X *
X * Any names longer than 100 characters are silently truncated.
X *  (if in urgent need however, see NAMELEN in main.h)
X *
X * All Symbol-names and class-names must be defined in a definition.
X *
X * The above rules are checked by 'mktable'.
X *
X *
X * BUT not directly on this file:
X *
X * We use the C preprocessor (cc -E) to collect all KEYWORDS of ABC in
X * a single file 'lang.h'. This way you can easily make a Dutch version:-).
X * (But also change ../ihdrs/i0lan.h!-).
X * This changes all "TEXT"-items in Symbol-definitions into R_NAME's.
X *
X * A second use of the preprocessor is in #defining frequently occuring
X * lists of alternative Symbols in class-definitions.
X * To make the grammar more readable, we only use capitals for the name
X * of such a list, and start it with A_ (which we never do for LEXICALS).
X * (This convention is not enforced by the parser in 'mktable'!)
X *
X * A third corrollary of the use of the preprocessor is that you can
X * use C-comments for comments.
X * (In addition, 'mktable' ignores all lines starting with '#', and
X * everything between a point ending a definition and the end of the line.)
X *
X *
X * WARNING: parts of the ABC editor depend on this specific grammar;
X * if you change anything, you might have to change part of the editor too.
X */
X
X#include "lang.h"
X
X/*
X * Root symbol:
X * (since the ABC editor cannot stand zero's for a symbol in an
X *  alternative sequence \\ all those while(!*cp) 's \\ this must
X *  be the first Symbol definition, and may not be referenced);
X * (anyway, it's only a dummy, that the ABC editor will overwrite
X *  with setroot()).
X */
X
XRootsymbol: imm_cmd.
X
X/*
X * Lexical symbols
X */
X
XNAME:    "abcdefghijklmnopqrstuvwxyz",
X    "abcdefghijklmnopqrstuvwxyz0123456789'\".".
XKEYWORD:"ABCDEFGHIJKLMNOPQRSTUVWXYZ",
X    "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'\".".
XNUMBER: "0123456789.", "0123456789.".
XCOMMENT: "\\", "^".
XTEXT1: "^'`", "^'`".
XTEXT2: "^\"`", "^\"`".
XOPERATOR: "+-*/#^~@|<=>", "".
XRAWINPUT: "^", "^".
XSUGGESTION: "", "".
XSUGGHOWNAME: "", "".
X/* For the latter two see comment at the bottom. */
X
X/*
X * Expressions
X */
X
X#define A_DISPLAY List_or_table_display; Text1_display; Text2_display
X#define A_PRIMARY Sel_expr; NAME; NUMBER; Compound; A_DISPLAY
X#define A_SINGLE_EXPR Blocked; Grouped; OPERATOR; A_PRIMARY
X
Xexpression: Collateral; A_SINGLE_EXPR.
Xoptional_expression: Optional; Collateral; A_SINGLE_EXPR.
XCollateral: single_expression, ", ", expression.
XCompound: "(", coll_test, ")".     /* see comment on ambiguity of '(' below */
Xsingle_expression: A_SINGLE_EXPR.
X
XBlocked: block, group.
Xblock: OPERATOR; A_PRIMARY.
XGrouped: group, " ", single_expression.
Xgroup: Blocked; OPERATOR; A_PRIMARY.
X
Xprimary: A_PRIMARY.
XSel_expr: primary, "[", expression, "]".
X
XList_or_table_display: "{", optional_list_or_table_filler_series, "}".
Xoptional_list_or_table_filler_series:
X    Optional; List_filler_series; A_SINGLE_EXPR;
X        Table_filler_series; Table_filler.
XList_filler_series: list_filler, "; ", list_filler_series_tail.
Xlist_filler_series_tail: A_SINGLE_EXPR; List_filler_series.
Xlist_filler: A_SINGLE_EXPR.
XTable_filler_series: table_filler, "; ", table_filler_series_tail.
Xtable_filler: Table_filler.
Xtable_filler_series_tail: Table_filler_series; Table_filler.
XTable_filler: "[", expression, "]: ", single_expression.
X
XText1_display: "'", txt1, "'".
Xtxt1: Optional; TEXT1; Conversion; Text1_plus.
XText1_plus: text1_conv, text1_next.
Xtext1_conv: TEXT1; Conversion.
Xtext1_next: TEXT1; Conversion; Text1_plus.
X
XText2_display: "\"", txt2, "\"".
Xtxt2: Optional; TEXT2; Conversion; Text2_plus.
XText2_plus: text2_conv, text2_next.
Xtext2_conv: TEXT2; Conversion.
Xtext2_next: TEXT2; Conversion; Text2_plus.
X
XConversion: "`", optional_expression, "`".
X
X/*
X * Addresses
X */
X
X#define A_SINGLE_ADDRESS NAME; Compound_address; Selection; Behead; Curtail
X#define r_expr group
X
Xaddress: Multiple_address; A_SINGLE_ADDRESS.
XMultiple_address: single_address, ", ", address.
Xsingle_address: A_SINGLE_ADDRESS.
XCompound_address: "(", address, ")".
X
XSelection: address, "[", expression, "]".
XBehead: address, "@", r_expr.
XCurtail: address, "|", r_expr.
X
X/* namings are addresses with only NAME's */
X#define A_NAMING Multiple_naming; NAME; Compound_naming
Xnaming: A_NAMING.
XMultiple_naming: single_naming, ", ", naming.
Xsingle_naming: NAME; Compound_naming.
XCompound_naming: "(", naming, ")".
X
X
X/*
X * Tests
X */
X
X#define A_NOT_or_QUANT Not; Some_in; Each_in; No_in
X
Xtest: A_NOT_or_QUANT; And; Or; A_SINGLE_EXPR.
Xe_test: Else_kw; A_NOT_or_QUANT; And; Or; A_SINGLE_EXPR.
XElse_kw: R_ELSE.
X#define t_test single_expression
Xr_test: A_NOT_or_QUANT; A_SINGLE_EXPR.
Xcoll_test: Collateral; A_NOT_or_QUANT; And; Or; A_SINGLE_EXPR.
X/*
X *  This means that a compound expression may in fact contain
X *  a `collateral test', e.g. (a AND b, c AND d).
X *  Of course, this is illegal in ABC; but I couldn't solve the
X *  ambiguity of `(' where a test is expected otherwise;
X *  this may start a parenthesized test or a compound expression;
X *  the latter may be followed by more expression fragments,
X *  the first may not.
X */
X
XNot: R_NOT, r_test.
XSome_in: R_SOME, naming, R_IN_quant, single_expression, R_HAS, r_test.
XEach_in: R_EACH, naming, R_IN_quant, single_expression,  R_HAS, r_test.
XNo_in: R_NO, naming, R_IN_quant, single_expression,  R_HAS, r_test.
X
XAnd: t_test, " ", and.
XOr: t_test, " ", or.
Xand: And_kw.
Xor: Or_kw.
XAnd_kw: R_AND, and_test.
XOr_kw: R_OR, or_test.
Xand_test: A_NOT_or_QUANT; And; A_SINGLE_EXPR.
Xor_test: A_NOT_or_QUANT; Or; A_SINGLE_EXPR.
X
X/*
X * Commands
X *
X * The order here determines which are suggested first!
X * (together with the imm_cmd class in Rootsymbol above!!;
X *  see ../bed/e1gram.c - initclasses)
X */
X#ifndef GFX
X#define A_SIMPLE_CMD SC1; SC2; SC3
X#else
X#define A_SIMPLE_CMD SC1; SC2; SC3; SC4
X#define SC4 Line; Space; Clear
X#endif
X#define SC1 Share; Quit; Return; Write; Read; Read_raw; Put; Delete
X#define SC2 Report; Fail; Succeed; Insert; Remove; Check; Pass
X#define SC3 Set; Suggestion; KEYWORD; Kw_plus
X
X#define A_CONTROL_CMD If; While; For
X#define A_COMP_CMD Short_comp; Long_comp; Cmt_comp; Select
X#define A_CMD If; For; A_COMP_CMD; A_SIMPLE_CMD; While
X/* #define A_SHORTCMD A_SIMPLE_CMD; Cmt_cmd */
X#define A_SHORTCMD If; For; A_SIMPLE_CMD; While; Short_comp; Cmt_comp; Cmt_cmd
X
Xcmd: COMMENT; A_CMD; Cmt_cmd.
XCmt_cmd: simple_cmd, " ", COMMENT.
Xsimple_cmd: A_SIMPLE_CMD.
XShort_comp: ifforwhile,  "\t", shortcmd, "\b".
Xshortcmd: A_SHORTCMD.
XCmt_comp: ifforwhile, COMMENT.
XLong_comp: c_ifforwhile, "\t", suite, "\b".
Xc_ifforwhile: A_CONTROL_CMD; Cmt_comp.
Xifforwhile: A_CONTROL_CMD.
X
X/* The simple commands are separated in two parts:
X * those that can be "softened" because their first keyword(s) may
X * start a User Defined Command,
X * and those that cannot (Check, If, While, Return, Report, How).
X * this separation is used in ../bed/e1que2.c!!! (hack? HACK!)
X */
XPut: R_PUT, expression, R_IN_put, address.
XInsert: R_INSERT, expression, R_IN_insert, address.
XRemove: R_REMOVE, expression, R_FROM_remove, address.
XDelete: R_DELETE, address.
XShare: R_SHARE, naming.
XWrite: R_WRITE, expression.
XRead: R_READ, address, R_EG, single_expression.
XRead_raw: R_READ, address, R_RAW.
XSet: R_SET_RANDOM, expression.
XPass: R_PASS.
X
X#ifdef GFX
XSpace: R_SPACE, R_TO_space, expression, expression.
XLine: R_LINE, expression, R_TO_line, expression.
XClear: R_CLEAR.
X#endif
X
XFor: R_FOR, naming, R_IN_for, single_expression, ": ".
X
XQuit: R_QUIT.
XSucceed: R_SUCCEED.
XFail: R_FAIL.
X
X/* non-softenable: */
X
XCheck: R_CHECK, test.
XIf: R_IF, test, ": ".
XWhile: R_WHILE, test, ": ".
X
XSelect: R_SELECT, optional_comment, "\t", t_suite,  "\b", optional_comment.
X    /* since SELECT SOMETHING is allowed, but SELECT: ANOTHER is not */
XReturn: R_RETURN, expression.
XReport: R_REPORT, test.
X
X/* for user defined commands: */
XKw_plus: KEYWORD, " ", kw_next.
Xkw_next: Collateral; A_SINGLE_EXPR; KEYWORD; Exp_plus; Kw_plus.
XExp_plus: expression, " ", exp_next.
Xexp_next: KEYWORD; Kw_plus.
X
X/*
X * Suites
X */
X
Xsuite: Suite.
XSuite: "\n", cmd, optional_suite.
Xoptional_suite: Optional; Suite.
X
Xoptional_cmdsuite: Optional; A_SHORTCMD; Suite.
Xcmdsuite: A_SHORTCMD; Suite.
X
Xt_suite: Test_suite.
XTest_suite: "\n", e_test, ": ", optional_comment, "\t", cmdsuite, "\b",
X    optional_t_suite.
Xoptional_t_suite: Optional; Test_suite.
X
Xoptional_comment: Optional; COMMENT.
X
X/*
X * Unit
X */
X
X#define A_BODY Head; Cmt_head; Long_unit; Short_unit
X
X/*unit: Optional; A_BODY; Ref_join. ## believed to be unnecessary */
X
XHead: R_HOW_TO, formal_cmd, ": ".
XCmt_head: head, COMMENT.
XLong_unit: commented_head, "\t", suite, "\b".
XShort_unit: head, "\t", shortcmd, "\b".
Xhead: Head.
Xcommented_head: Cmt_head; Head.
X
Xformal_cmd: Formal_return; Formal_report; KEYWORD; Formal_kw_plus.
X
X#define A_SINGLE_NAMING NAME; Compound_naming
XFormal_return: R_RETURN, formal_formula.
XFormal_report: R_REPORT, formal_formula.
X/* the following is too liberal, but that was necessary:
X * the editor allows a formal command with RETURN or REPORT as
X * first keyword, and that cannot be read back without the last
X * alternative in the following rule
X * (another hack? HACK!) */
Xformal_formula: Blocked_ff; Grouped_ff; A_SINGLE_NAMING; Formal_kw_plus.
XBlocked_ff: ff_block, ff_group.
Xff_block: A_SINGLE_NAMING.
Xff_group: Blocked_ff; A_SINGLE_NAMING.
XGrouped_ff: ff_group, " ", formal_formula.
X
XFormal_kw_plus: KEYWORD, " ", formal_kw_next.
Xformal_kw_next: A_NAMING; KEYWORD; Formal_naming_plus; Formal_kw_plus.
XFormal_naming_plus: naming, " ", naming_next.
Xnaming_next: KEYWORD; Formal_kw_plus.
X
XRef_join: refpred, refinements.
Xrefpred: A_BODY.
Xoptional_refinements: Optional; Refinement.
Xrefinements: Refinement.
XRefinement: "\n", name_or_keyword, ": ", optional_comment,
X    "\t", cmdsuite, "\b", optional_refinements.
Xname_or_keyword: NAME; KEYWORD; Keyword_list.
XKeyword_list: KEYWORD, " ", kwltail.
Xkwltail: KEYWORD; Keyword_list.
X
X/*
X * Alternative Roots
X */
X
XUnit_edit: unit_edit.
XTarget_edit: address_edit.
XImm_cmd: imm_cmd.
X
Xunit_edit: Optional; A_BODY; Ref_join.
Xaddress_edit: Optional; A_SINGLE_EXPR.
Ximm_cmd: Optional; COMMENT; Head; A_CMD; Cmt_cmd; Cmt_head;
X    Edit_unit; Edit_address; Workspace_cmd.
X
XEdit_unit: ":", ed_unit.
Xed_unit: Optional; NAME; KEYWORD; Keyword_list; Colon; Sugghowname.
XColon: ":".
XEdit_address: "=", ed_address.
Xed_address: Optional; NAME; Equals.
XEquals: "=".
XWorkspace_cmd: ">", ws_cmd.
Xws_cmd: Optional; NAME; Right.
XRight: ">".
X
XExpression: expression.     /* used by ABC editor for READ EG */
XRaw_input: raw_input.        /* used by ABC editor for READ RAW */
Xraw_input: Optional; RAWINPUT.    /* the underscore prevents clash
X                 * with enveloping Rawinput Symbol
X                 * (See comments above) */
X/*
X * In addition 'mktable' will generate entries defining
X *    Suggestion: suggestion-body.
X *    Sugghowname: sugghowname-body.
X *    Optional: .
X *    Hole: "?".
X * at the very end of the table containing the Symbol definitions.
X *
X * The first two are only defined if the corresponding lexical items are;
X * suggestion-body denotes the enveloping class for that item;
X * the same for sugghowname-body.
X * (See the comments in read.c).
X */
END_OF_FILE
  if test 13172 -ne `wc -c <'abc/boot/grammar.abc'`; then
    echo shar: \"'abc/boot/grammar.abc'\" unpacked with wrong size!
  fi
  # end of 'abc/boot/grammar.abc'
fi
if test -f 'abc/btr/i1tex.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/btr/i1tex.c'\"
else
  echo shar: Extracting \"'abc/btr/i1tex.c'\" \(12939 characters\)
  sed "s/^X//" >'abc/btr/i1tex.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* B texts */
X
X#include "b.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "i1btr.h"
X#include "i1tlt.h"
X
X#define CURTAIL_TEX    MESS(200, "in t|n, t is not a text")
X#define CURTAIL_NUM    MESS(201, "in t|n, n is not a number")
X#define CURTAIL_INT    MESS(202, "in t|n, n is not an integer")
X#define CURTAIL_BND    MESS(203, "in t|n, n is < 0")
X
X#define BEHEAD_TEX    MESS(204, "in t@n, t is not a text")
X#define BEHEAD_NUM    MESS(205, "in t@n, n is not a number")
X#define BEHEAD_INT    MESS(206, "in t@n, n is not an integer")
X#define BEHEAD_BND    MESS(207, "in t@n, n is > #t + 1")
X
X#define CONCAT_TEX    MESS(208, "in t^u, t or u is not a text")
X#define CONCAT_LONG    MESS(209, "in t^u, the result is too long")
X
X#define REPEAT_TEX    MESS(210, "in t^^n, t is not a text")
X#define REPEAT_NUM    MESS(211, "in t^^n, n is not a number")
X#define REPEAT_INT    MESS(212, "in t^^n, n is not an integer")
X#define REPEAT_NEG    MESS(213, "in t^^n, n is negative")
X#define REPEAT_LONG    MESS(214, "in t^^n, the result is too long")
X
X/*
X * Operations on texts represented as B-trees.
X *
X * Comments:
X * - The functions with 'i' prepended (ibehead, etc.) do no argument
X *   checking at all.  They actually implement the planned behaviour
X *   of | and @, where out-of-bounds numerical values are truncated
X *   rather than causing errors {"abc"|100 = "abc"@-100 = "abc"}.
X * - The 'size' field of all texts must fit in a C int.  If the result of
X *   ^ or ^^ would exceed Maxint in size, a user error is signalled.  If
X *   the size of the *input* value(s) of any operation is Bigsize, a syserr
X *   is signalled.
X * - Argument checking: trims, concat and repeat must check their arguments
X *   for user errors.
X * - t^^n is implemented with an algorithm similar to the 'square and
X *   multiply' algorithm for x**n, using the binary representation of n,
X *   but it uses straightforward 'concat' operations.  A more efficient
X *   scheme is possible [see IW219], but small code seems more important.
X * - Degenerated cases (e.g. t@1, t|0, t^'' or t^^n) are not optimized,
X *   but produce the desired result by virtue of the algorithms used.
X *   The extra checking does not seem worth the overhead for the
X *   non-degenerate cases.
X * - The code for PUT v IN t@h|l is still there, but it is not compiled,
X *   as the interpreter implements the same strategy directly.
X * - Code for outputting texts has been added.    This is called from wri()
X *   to output a text, and has running time O(n), compared to O(n log n)
X *   for the old code in wri().
X *
X * *** WARNING ***
X * - The 'zip' routine and its subroutine 'copynptrs' assume that items and
X *   pointers are stored contiguously, so that &Ptr(p, i+1) == &Ptr(p, i)+1
X *   and &[IB]char(p, i+1) == &[IB]char(p, i)+1.  For pointers, the order
X *   might be reversed in the future; then change the macro Incr(pp, n) below
X *   to *decrement* the pointer!
X * - Mkbtext and bstrval make the same assumption about items (using strncpy
X *   to move charaters to/from a bottom node).
X */
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
X#define IsInner(p) (Flag(p) == Inner)
X#define IsBottom(p) (Flag(p) == Bottom)
X
X#define Incr(pp, n) ((pp) += (n))
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XVisible char charval(v) value v; {
X    if (!Character(v))
X        syserr(MESS(215, "charval on non-char"));
X    return Bchar(Root(v), 0);
X}
X
XVisible char ncharval(n, v) int n; value v; {
X    value c= thof(n, v);
X    char ch= charval(c);
X    release(c);
X    return ch;
X}
X
XVisible bool character(v) value v; {
X    return Character(v);
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XHidden btreeptr mkbtext(s, len) string s; int len; {
X    btreeptr p; int chunk, i, n, nbig;
X
X    /*
X     * Determine level of tree.
X     * This is done for each inner node anew, to avoid having
X     * to keep an explicit stack.
X     * Problem is: make sure that for each node at the same
X     * level, the computation indeed finds the same level!
X     * (Don't care about efficiency here; in practice the trees
X     * built by mk_text rarely need more than two levels.)
X     */
X    chunk = 0;
X    i = Maxbottom; /* Next larger chunk size */
X    while (len > i) {
X        chunk = i;
X        i = (i+1) * Maxinner + Maxinner;
X    }
X    n = len / (chunk+1); /* Number of items at this level; n+1 subtrees */
X    chunk = len / (n+1); /* Use minimal chunk size for subtrees */
X    p = grabbtreenode(chunk ? Inner : Bottom, Ct);
X    Size(p) = len;
X    Lim(p) = n;
X    if (!chunk)
X        strncpy(&Bchar(p, 0), s, len);
X    else {
X        nbig = len+1 - (n+1)*chunk;
X            /* There will be 'nbig' nodes of size 'chunk'. */
X            /* The remaining 'n-nbig' will have size 'chunk-1'. */
X        for (i = 0; i < n; ++i) {
X            Ptr(p, i) = mkbtext(s, chunk);
X            s += chunk;
X            Ichar(p, i) = *s++;
X            len -= chunk+1;
X            if (--nbig == 0)
X                --chunk; /* This was the last 'big' node */
X        }
X        Ptr(p, i) = mkbtext(s, len);
X    }
X    return p;
X}
X
XVisible value mk_text(s) string s; {
X    value v; int len = strlen(s);
X
X    v = grab(Tex, Ct);
X    if (len == 0)
X        Root(v) = Bnil;
X    else
X        Root(v) = mkbtext(s, len);
X    return v;
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XHidden string bstrval(buf, p) string buf; btreeptr p; {
X    /* Returns *next* available position in buffer */
X    int i, n = Lim(p);
X    if (IsInner(p)) {
X        for (i = 0; i < n; ++i) {
X            buf = bstrval(buf, Ptr(p, i));
X            *buf++ = Ichar(p, i);
X        }
X        return bstrval(buf, Ptr(p, i));
X    }
X    strncpy(buf, &Bchar(p, 0), n);
X    return buf+n;
X}
X
XHidden char *buffer= NULL;
XVisible string strval(v) value v; {
X    int len = Tltsize(v);
X    if (len == Bigsize) syserr(MESS(216, "strval on big text"));
X    if (len == 0) return "";
X    if (buffer != NULL)
X        regetmem(&buffer, (unsigned) len+1);
X    else
X        buffer = getmem((unsigned) len+1);
X    *bstrval(buffer, Root(v)) = '\0';
X    return buffer;
X}
X
X#ifdef MEMTRACE
XVisible Procedure endstrval() {     /* hack to free static store */
X    if (buffer != NULL)
X        freemem(buffer);
X}
X#endif
X
XVisible string sstrval(v) value v; {
X    return (string) savestr(strval(v));
X}
X
XVisible Procedure fstrval(s) string s; {
X    freestr(s);
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
Xtypedef struct stackelem {
X    btreeptr s_ptr;
X    int s_lim;
X} stackelem;
X
Xtypedef stackelem stack[Maxheight];
Xtypedef stackelem *stackptr;
X
X#define Snil ((stackptr)0)
X
X#define Push(s, p, l) ((s)->s_ptr = (p), ((s)->s_lim = (l)), (s)++)
X#define Pop(s, p, l) (--(s), (p) = (s)->s_ptr, (l) = (s)->s_lim)
X
Xextern stackptr unzip();
Xextern Procedure cpynptrs();
Xextern int movnptrs();
X
XHidden btreeptr zip(s1, sp1, s2, sp2) stackptr s1, sp1, s2, sp2; {
X    btreeptr p1, p2, newptr[2]; int l1, l2, i, n, n2;
X#define q1 newptr[0]
X#define q2 newptr[1]
X    char newitem; bool overflow, underflow, inner;
X    char *cp; btreeptr *pp;
X    char cbuf[2*Maxbottom]; btreeptr pbuf[2*Maxinner+2];
X
X    while (s1 < sp1 && s1->s_lim == 0)
X        ++s1;
X    while (s2 < sp2 && s2->s_lim == Lim(s2->s_ptr))
X        ++s2;
X    inner = overflow = underflow = No;
X    q1 = Bnil;
X    while (s1 < sp1 || s2 < sp2) {
X        if (s1 < sp1)
X            Pop(sp1, p1, l1);
X        else
X            p1 = Bnil;
X        if (s2 < sp2)
X            Pop(sp2, p2, l2);
X        else
X            p2 = Bnil;
X        cp = cbuf;
X        if (p1 != Bnil) {
X            strncpy(cp, (inner ? &Ichar(p1, 0) : &Bchar(p1, 0)), l1);
X            cp += l1;
X        }
X        if (overflow)
X            *cp++ = newitem;
X        n = cp - cbuf;
X        if (p2 != Bnil) {
X            strncpy(cp, (inner ? &Ichar(p2, l2) : &Bchar(p2, l2)), Lim(p2)-l2);
X            n += Lim(p2)-l2;
X        }
X        if (inner) {
X            pp = pbuf; /***** Change if reverse direction! *****/
X            if (p1 != Bnil) {
X                cpynptrs(pp, &Ptr(p1, 0), l1);
X                Incr(pp, l1);
X            }
X            movnptrs(pp, newptr, 1+overflow);
X            Incr(pp, 1+overflow);
X            if (p2 != Bnil) {
X                cpynptrs(pp, &Ptr(p2, l2+1), Lim(p2)-l2);
X                Incr(pp, Lim(p2)-l2);
X            }
X            if (underflow) {
X                underflow= No;
X                n= uflow(n, p1 ? l1 : 0, cbuf, pbuf, Ct);
X            }
X        }
X        overflow = No;
X        if (n > (inner ? Maxinner : Maxbottom)) {
X            overflow = Yes;
X            n2 = (n-1)/2;
X            n -= n2+1;
X        }
X        else if (n < (inner ? Mininner : Minbottom))
X            underflow = Yes;
X        q1 = grabbtreenode(inner ? Inner : Bottom, Ct);
X        Lim(q1) = n;
X        cp = cbuf;
X        strncpy((inner ? &Ichar(q1, 0) : &Bchar(q1, 0)), cp, n);
X        cp += n;
X        if (inner) {
X            pp = pbuf;
X            i = movnptrs(&Ptr(q1, 0), pp, n+1);
X            Incr(pp, n+1);
X            n += i;
X        }
X        Size(q1) = n;
X        if (overflow) {
X            newitem = *cp++;
X            q2 = grabbtreenode(inner ? Inner : Bottom, Ct);
X            Lim(q2) = n2;
X            strncpy((inner ? &Ichar(q2, 0) : &Bchar(q2, 0)), cp, n2);
X            if (inner)
X                n2 += movnptrs(&Ptr(q2, 0), pp, n2+1);
X            Size(q2) = n2;
X        }
X        inner = Yes;
X    }
X    if (overflow)
X        q1 = mknewroot(q1, (itemptr)&newitem, q2, Ct);
X    return q1;
X#undef q1
X#undef q2
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XHidden value ibehead(v, h) value v; int h; { /* v@h */
X    stack s; stackptr sp;
X    sp = (stackptr) unzip(Root(v), h-1, s);
X    v = grab(Tex, Ct);
X    Root(v) = zip(Snil, Snil, s, sp);
X    return v;
X}
X
XHidden value icurtail(v, t) value v; int t; { /* v|t */
X    stack s; stackptr sp;
X    sp = (stackptr) unzip(Root(v), t, s);
X    v = grab(Tex, Ct);
X    Root(v) = zip(s, sp, Snil, Snil);
X    return v;
X}
X
XHidden value iconcat(v, w) value v, w; { /* v^w */
X    stack s1, s2;
X    stackptr sp1 = (stackptr) unzip(Root(v), Tltsize(v), s1);
X    stackptr sp2 = (stackptr) unzip(Root(w), 0, s2);
X    v = grab(Tex, Ct);
X    Root(v) = zip(s1, sp1, s2, sp2);
X    return v;
X}
X
X#define Odd(n) (((n)&1) != 0)
X
XHidden value irepeat(v, n) value v; int n; { /* v^^n */
X    value x, w = grab(Tex, Ct);
X    Root(w) = Bnil;
X    v = copy(v);
X    while (n > 0) {
X        if (Odd(n)) {
X            w = iconcat(x = w, v);
X            release(x);
X        }
X        n /= 2;
X        if (n == 0)
X            break;
X        v = iconcat(x = v, v);
X        release(x);
X    }
X    release(v);
X    return w;
X}
X
X#ifdef UNUSED_CODE
XHidden value jrepeat(v, n) value v; int n; { /* v^^n, recursive solution */
X    value w, x;
X    if (n <= 1) {
X        if (n == 1)
X            return copy(v);
X        w = grab(Tex, Ct);
X        Root(w) = Bnil;
X        return w;
X    }
X    w = jrepeat(v, n/2);
X    w = iconcat(x = w, w);
X    release(x);
X    if (Odd(n)) {
X        w = iconcat(x = w, v);
X        release(x);
X    }
X    return w;
X}
X#endif /* UNUSED_CODE */
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XVisible value curtail(t, after) value t, after; {
X    int syzcurv, syztext;
X
X    if (!Is_text(t)) {
X        reqerr(CURTAIL_TEX);
X        return Vnil;
X    }
X    if (!Is_number(after)) {
X        reqerr(CURTAIL_NUM);
X        return Vnil;
X    }
X    syztext = Tltsize(t);
X    if (syztext == Bigsize)
X        syserr(MESS(217, "curtail on very big text"));
X     if (large(after) || (syzcurv = intval(after)) < 0) {
X        reqerr(CURTAIL_BND);
X        return Vnil;
X    }
X    return icurtail(t, syzcurv);
X}
X
XVisible value behead(t, before) value t, before; {
X    int syzbehv, syztext;
X
X    if (!Is_text(t)) {
X        reqerr(BEHEAD_TEX);
X        return Vnil;
X    }
X    if (!Is_number(before)) {
X        reqerr(BEHEAD_NUM);
X        return Vnil;
X    }
X    syztext = Tltsize(t);
X    if (syztext == Bigsize) syserr(MESS(218, "behead on very big text"));
X    if (large(before) || (syzbehv = intval(before)) > syztext + 1) {
X        reqerr(BEHEAD_BND);
X        return Vnil;
X    }
X    return ibehead(t, syzbehv);
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XVisible value concat(tleft, tright) value tleft, tright; {
X    int syzleft, syzright;
X    if (!Is_text(tleft) || !Is_text(tright)) {
X        reqerr(CONCAT_TEX);
X        return Vnil;
X    }
X    syzleft = Tltsize(tleft);
X    syzright =  Tltsize(tright);
X    if (syzleft == Bigsize || syzright == Bigsize)
X        syserr(MESS(219, "concat on very big text"));
X    if (syzleft > Maxint-syzright
X        || syzright > Maxint-syzleft) {
X        reqerr(CONCAT_LONG);
X        return Vnil;
X    }
X    return iconcat(tleft, tright);
X}
X
XVisible Procedure concato(v, t) value* v; value t; {
X    value v1= *v;
X    *v= concat(*v, t);
X    release(v1);
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XVisible value repeat(t, n) value t, n; {
X    int tsize, k;
X
X    if (!Is_text(t)) {
X        reqerr(REPEAT_TEX);
X        return Vnil;
X    }
X    if (!Is_number(n)) {
X        reqerr(REPEAT_NUM);
X        return Vnil;
X    }
X    if (numcomp(n, zero) < 0) {
X        reqerr(REPEAT_NEG);
X        return Vnil;
X    }
X    tsize = Tltsize(t);
X    if (tsize == 0) return copy(t);
X
X    if (large(n) || Maxint/tsize < (k = intval(n))) {
X        reqerr(REPEAT_LONG);
X        return Vnil;
X    }
X    return irepeat(t, k);
X}
X
X/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
X
XVisible Procedure wrtext(putch, v, quote) int (*putch)(); value v; char quote; {
X    if (v == Vnil || !Is_text(v)) {
X        (*putch)('?');
X        return;
X    }
X    if (quote) (*putch)(quote);
X    if (Root(v) != Bnil) wrbtext(putch, Root(v), quote);
X    if (quote) (*putch)(quote);
X}
X
XHidden Procedure wrbtext(putch, p, quote)
X int (*putch)(); btreeptr p; char quote; {
X    int i, n = Lim(p); char c;
X    if (IsInner(p)) {
X        for (i = 0; still_ok && i < n; ++i) {
X            wrbtext(putch, Ptr(p, i), quote);
X            c = Ichar(p, i);
X            (*putch)(c);
X            if (quote && (c == quote || c == '`')) (*putch)(c);
X        }
X        wrbtext(putch, Ptr(p, i), quote);
X    }
X    else if (quote) {
X        for (i = 0; i < n; ++i) {
X            c = Bchar(p, i);
X            (*putch)(c);
X            if (c == quote || c == '`') (*putch)(c);
X        }
X    }
X    else {
X        for (i = 0; i < n; ++i) (*putch)(Bchar(p, i));
X    }
X}
X
END_OF_FILE
  if test 12939 -ne `wc -c <'abc/btr/i1tex.c'`; then
    echo shar: \"'abc/btr/i1tex.c'\" unpacked with wrong size!
  fi
  # end of 'abc/btr/i1tex.c'
fi
if test -f 'abc/lin/i1tlt.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/lin/i1tlt.c'\"
else
  echo shar: Extracting \"'abc/lin/i1tlt.c'\" \(11273 characters\)
  sed "s/^X//" >'abc/lin/i1tlt.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* generic routines for B texts, lists and tables */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bobj.h"
X#include "i1tlt.h"
X
X#define SIZE_TLT    MESS(300, "in #t, t is not a text list or table")
X
X#define SIZE2_TLT    MESS(301, "in e#t, t is not a text list or table")
X#define SIZE2_CHAR    MESS(302, "in e#t, t is a text, but e is not a character")
X
X#define MIN_TLT        MESS(303, "in min t, t is not a text list or table")
X#define MIN_EMPTY    MESS(304, "in min t, t is empty")
X
X#define MAX_TLT        MESS(305, "in max t, t is not a text list or table")
X#define MAX_EMPTY    MESS(306, "in max t, t is empty")
X
X#define MIN2_TLT    MESS(307, "in e min t, t is not a text list or table")
X#define MIN2_EMPTY    MESS(308, "in e min t, t is empty")
X#define MIN2_CHAR    MESS(309, "in e min t, t is a text, but e is not a character")
X#define MIN2_ELEM    MESS(310, "in e min t, no element of t exceeds e")
X
X#define MAX2_TLT    MESS(311, "in e max t, t is not a text list or table")
X#define MAX2_EMPTY    MESS(312, "in e max t, t is empty")
X#define MAX2_CHAR    MESS(313, "in e max t, t is a text, but e is not a character")
X#define MAX2_ELEM    MESS(314, "in e max t, no element of t is less than e")
X
X#define ITEM_TLT    MESS(315, "in t item n, t is not a text list or table")
X#define ITEM_EMPTY    MESS(316, "in t item n, t is empty")
X#define ITEM_NUM    MESS(317, "in t item n, n is not a number")
X#define ITEM_INT    MESS(318, "in t item n, n is not an integer")
X#define ITEM_L_BND    MESS(319, "in t item n, n is < 1")
X#define ITEM_U_BND    MESS(320, "in t item n, n exceeds #t")
X
X#ifdef B_COMPAT
X
X#define THOF_TLT    MESS(321, "in n th'of t, t is not a text list or table")
X#define THOF_EMPTY    MESS(322, "in n th'of t, t is empty")
X#define THOF_NUM    MESS(323, "in n th'of t, n is not a number")
X#define THOF_INT    MESS(324, "in n th'of t, n is not an integer")
X#define THOF_L_BND    MESS(325, "in n th'of t, n is < 1")
X#define THOF_U_BND    MESS(326, "in n th'of t, n exceeds #t")
X
X#endif /* B_COMPAT */
X
Xextern bool comp_ok;
X
XVisible value mk_elt() { return grab(ELT, 0); }
X
XVisible value size(x) value x; { /* monadic # operator */
X    intlet n= 0;
X    if (Is_range(x))
X        return rangesize(Lwb(x), Upb(x));
X    else if (!Is_tlt(x))
X        interr(SIZE_TLT);
X    else
X        n= Length(x);
X    return mk_integer((int) n);
X}
X
X#define Lisent(tp,k) (*(tp+(k)))
X
XVisible value size2(v, t) value v, t; { /* Dyadic # operator */
X    intlet len, n= 0, k; value *tp= Ats(t);
X    if (!Is_tlt(t)) {
X        interr(SIZE2_TLT);
X        return mk_integer((int) n);
X    }
X    len= Length(t);
X    switch (Type(t)) {
X    case Tex:
X        {string cp= (string)tp; char c;
X            if (Type(v) != Tex || Length(v) != 1)
X                interr(SIZE2_CHAR);
X            else {
X                c= *Str(v);
X                for (k= 0; k < len; k++) if (*cp++ == c) n++;
X            }
X        } break;
X    case ELT:
X        break;
X    case Lis:
X        {intlet lo= -1, mi, xx, mm, hi= len; relation c;
X        bins:    if (hi-lo < 2) break;
X            mi= (lo+hi)/2;
X            if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
X            if (!comp_ok) break;
X            if (c < 0) hi= mi; else lo= mi;
X            goto bins;
X        some:    xx= mi;
X            while (xx-lo > 1) {
X                mm= (lo+xx)/2;
X                if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
X                else lo= mm;
X            }
X            xx= mi;
X            while (hi-xx > 1) {
X                mm= (xx+hi)/2;
X                if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
X                else hi= mm;
X            }
X            n= hi-lo-1;
X        } break;
X    case Ran:
X        if (compare(Lwb(t), v) <= 0
X            &&
X            comp_ok
X            &&
X            compare(v, Upb(t)) <= 0
X        )
X            n= 1;
X        else
X            n= 0;
X        break;
X    case Tab:
X        for (k= 0; k < len; k++) {
X            if (compare(v, Dts(*tp++)) == 0) n++;
X            if (!comp_ok) { n= 0; break; }
X        }
X        break;
X    default:
X        syserr(MESS(327, "size2() on non tlt value"));
X        break;
X    }
X    return mk_integer((int) n);
X}
X
XHidden bool less(r) relation r;    { return r<0; }
XHidden bool greater(r) relation r; { return r>0; }
X
XHidden value mm1(t, rel) value t; bool (*rel)(); {
X    intlet len= Length(t), k; value m, *tp= Ats(t);
X    switch (Type(t)) {
X    case Tex:
X        {string cp= (string) tp; char mc= '\0', mm[2];
X            for (k= 0; k < len; k++) {
X                if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
X                    mc= *cp;
X                cp++;
X            }
X            mm[0]= mc; mm[1]= '\0';
X            m= mk_text(mm);
X        } break;
X    case Lis:
X        if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
X        else m= copy(*(Ats(t)+len-1));
X        break;
X    case Ran:
X        if ((*rel)(-1)) /*min*/ m= copy(Lwb(t));
X        else m= copy(Upb(t));
X        break;
X    case Tab:
X        {value dm= Vnil;
X            for (k= 0; k < len; k++) {
X                if (dm == Vnil)
X                    dm= Dts(*tp);
X                else {
X                    relation c= compare(Dts(*tp), dm);
X                    if (!comp_ok)
X                        return Vnil;
X                    if ((*rel)(c))
X                        dm= Dts(*tp);
X                }
X                tp++;
X            }
X            m= copy(dm);
X        } break;
X    default:
X        syserr(MESS(328, "mm1() on non tlt value"));
X    }
X    return m;
X}
X
XHidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
X    intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
X    switch (Type(t)) {
X    case Tex:
X        {string cp= (string) tp; char c, mc= '\0', mm[2];
X            c= *Str(v);
X            for (k= 0; k < len; k++) {
X                if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
X                    if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
X                        mc= *cp;
X                }
X                cp++;
X            }
X            if (mc != '\0') {
X                mm[0]= mc; mm[1]= '\0';
X                m= mk_text(mm);
X            }
X        } break;
X    case Lis:
X        {intlet lim1, mid, lim2; relation c;
X            if ((*rel)(-1)) { /*min*/
X                lim1= 0; lim2= len-1;
X            } else {
X                lim2= 0; lim1= len-1;
X            }
X            c= compare(v, Lisent(tp, lim2));
X            if (!comp_ok) return Vnil;
X            if (!(*rel)(c)) break;
X            if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
X                m= copy(Lisent(tp,lim1));
X                break;
X            }
X            /* v rel tp[lim2] && !(v rel tp[lim1]) */
X            while (abs(lim2-lim1) > 1) {
X                mid= (lim1+lim2)/2;
X                if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
X                else lim1= mid;
X            }
X            m= copy(Lisent(tp,lim2));
X        } break;
X    case Ran:
X        {relation c= compare(v, Lwb(t));
X            if (!comp_ok)
X                return Vnil;
X            if ((*rel)(-1)) {
X                /* min2 */
X                if (c < 0)
X                    m= copy(Lwb(t));
X                else if (compare(v, Upb(t)) < 0) {
X                    if (integral(v))
X                        m= sum(v, one);
X                    else
X                        m= ceilf(v);
X                }
X                else
X                    m= Vnil;
X            }
X            else {
X                /* max2 */
X                if (c <= 0)
X                    m= Vnil;
X                else if (compare(v, Upb(t)) <= 0) {
X                    if (integral(v))
X                        m= diff(v, one);
X                    else
X                        m= floorf(v);
X                }
X                else
X                    m= copy(Upb(t));
X            }
X        } break;
X    case Tab:
X        {value dm= Vnil; relation c;
X            for (k= 0; k < len; k++) {
X                c= compare(v, Dts(*tp));
X                if (!comp_ok) return Vnil;
X                if ((*rel)(c)) {
X                    if (dm == Vnil ||
X                        (*rel)(compare(Dts(*tp), dm)))
X                        dm= Dts(*tp);
X                }
X                tp++;
X            }
X            if (dm != Vnil) m= copy(dm);
X        } break;
X    default:
X        syserr(MESS(329, "mm2() on non tlt value"));
X        break;
X    }
X    return m;
X}
X
XVisible value min1(t) value t; { /* Monadic min */
X    value m= Vnil;
X    if (!Is_tlt(t))
X        interr(MIN_TLT);
X    else if (Length(t) == 0)
X        interr(MIN_EMPTY);
X    else m= mm1(t, less);
X    return m;
X}
X
XVisible value min2(v, t) value v, t; {
X    value m= Vnil;
X    if (!Is_tlt(t))
X        interr(MIN2_TLT);
X    else if (Length(t) == 0)
X        interr(MIN2_EMPTY);
X    else if (Is_text(t)) {
X        if (!Is_text(v) || Length(v) != 1)
X            interr(MIN2_CHAR);
X    }
X    if (still_ok) {
X        m= mm2(v, t, less);
X        if (m == Vnil && still_ok)
X            interr(MIN2_ELEM);
X    }
X    return m;
X}
X
XVisible value max1(t) value t; {
X    value m= Vnil;
X    if (!Is_tlt(t))
X        interr(MAX_TLT);
X    else if (Length(t) == 0)
X        interr(MAX_EMPTY);
X    else m= mm1(t, greater);
X    return m;
X}
X
XVisible value max2(v, t) value v, t; {
X    value m= Vnil;
X    if (!Is_tlt(t))
X        interr(MAX2_TLT);
X    else if (Length(t) == 0)
X        interr(MAX2_EMPTY);
X    else if (Is_text(t)) {
X        if (!Is_text(v) || Length(v) != 1)
X            interr(MAX2_CHAR);
X    }
X    if (still_ok) {
X        m= mm2(v, t, greater);
X        if (m == Vnil && still_ok)
X            interr(MAX2_ELEM);
X    }
X    return m;
X}
X
XVisible value item(t, n) value t, n; {
X    value w= Vnil;
X    int m;
X    if (!Is_tlt(t))
X        interr(ITEM_TLT);
X    else if (!Is_number(n) || !integral(n))
X        interr(ITEM_INT);
X    else if (empty(t))
X        interr(ITEM_EMPTY);
X    else if (Is_range(t)) {
X        value r;
X        r= rangesize(Lwb(t), Upb(t));
X        if (compare(n, zero) <= 0)
X            interr(ITEM_L_BND);
X        else if (compare(r, n) < 0)
X            interr(ITEM_U_BND);
X        else {
X            release(r);
X            r= sum(n, Lwb(t));
X            w= diff(r, one);
X        }
X        release(r);
X    }
X    else {
X        m= intval(n);
X        if (m <= 0)
X            interr(ITEM_L_BND);
X        else if (m > Length(t))
X            interr(ITEM_U_BND);
X        else w= thof(m, t);
X    }
X    return w;
X}
X
X#ifdef B_COMPAT
X
XVisible value th_of(n, t) value n, t; {
X    value w= Vnil;
X    int m;
X    if (!Is_tlt(t))
X        interr(THOF_TLT);
X    else if (!Is_number(n) || !integral(n))
X        interr(THOF_INT);
X    else if (empty(t))
X        interr(THOF_EMPTY);
X    else if (Is_range(t)) {
X        value r;
X        r= rangesize(Lwb(t), Upb(t));
X        if (compare(n, zero) <= 0)
X            interr(THOF_L_BND);
X        else if (compare(r, n) < 0)
X            interr(THOF_U_BND);
X        else {
X            release(r);
X            r= sum(n, Lwb(t));
X            w= diff(r, one);
X        }
X        release(r);
X    }
X    else {
X        m= intval(n);
X        if (m <= 0)
X            interr(THOF_L_BND);
X        else if (m > Length(t))
X            interr(THOF_U_BND);
X        else w= thof(m, t);
X    }
X    return w;
X}
X
X#endif /* B_COMPAT */
X
XVisible value thof(n, t) int n; value t; {
X    value w= Vnil; value r;
X    switch (Type(t)) {
X        case Tex:
X            {char ww[2];
X                ww[0]= *(Str(t)+n-1); ww[1]= '\0';
X                w= mk_text(ww);
X            } break;
X        case Lis:
X            w= copy(*(Ats(t)+n-1));
X            break;
X        case Ran:
X            r= sum(w= mk_integer(n), Lwb(t));
X            release(w);
X            w= diff(r, one);
X            release(r);
X            break;
X        case Tab:
X            w= copy(Dts(*(Ats(t)+n-1)));
X            break;
X        default:
X            syserr(MESS(330, "thof() on non tlt value"));
X            break;
X    }
X    return w;
X}
X
XVisible bool found_ok= Yes;
X
XVisible bool found(elem, v, probe, where)
X    value (*elem)(), v, probe; intlet *where;
X    /* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
X       found and where at the end satisfy:
X       SELECT:
X           SOME k IN {lo..hi} HAS probe = elem(v,k):
X           found = Yes AND where = k
X           ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
X    */
X{relation c; intlet lo=0, hi= Length(v)-1;
X    found_ok= Yes;
X    if (lo > hi) { *where= lo; return No; }
X    if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
X    if (!comp_ok || c < 0) { found_ok= comp_ok; *where=lo; return No; }
X    if (lo == hi) { *where=hi+1; return No; }
X    if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
X    if (!comp_ok || c > 0) { found_ok= comp_ok; *where=hi+1; return No; }
X    /* elem(lo) < probe < elem(hi) */
X    while (hi-lo > 1) {
X        if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
X            *where= (lo+hi)/2; return Yes;
X        }
X        if (!comp_ok) { found_ok= comp_ok; *where= lo; return No; }
X        if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
X    }
X    *where= hi; return No;
X}
X
XVisible bool in(v, t) value v, t; {
X    intlet where, k, len; value *tp= Ats(t);
X    switch (Type(t)) {
X    case Tex:
X        return strchr((string) tp, *Str(v)) != 0;
X    case ELT:
X        return No;
X    case Lis:
X        return found(list_elem, t, v, &where);
X    case Ran:
X        return (integral(v)
X            &&
X            compare(Lwb(t), v) <= 0
X            &&
X            compare(v, Upb(t)) <= 0);
X    case Tab:
X        len= Length(t);
X        for (k= 0; k < len; k++) {
X            if (compare(v, Dts(*tp++)) == 0) return Yes;
X            if (!comp_ok) return No;
X        }
X        return No;
X    default:
X        syserr(MESS(331, "in() on non tlt value"));
X        return No;
X    }
X}
X
XVisible bool empty(v) value v; {
X    switch (Type(v)) {
X    case Tex:
X    case Lis:
X    case Ran:
X    case Tab:
X    case ELT:
X        return (Length(v) == 0);
X    default:
X        syserr(MESS(332, "empty() on non tlt value"));
X        return (No);
X    }
X}
END_OF_FILE
  if test 11273 -ne `wc -c <'abc/lin/i1tlt.c'`; then
    echo shar: \"'abc/lin/i1tlt.c'\" unpacked with wrong size!
  fi
  # end of 'abc/lin/i1tlt.c'
fi
echo shar: End of archive 12 \(of 25\).
cp /dev/null ark12isdone
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...