v23i091: ABC interactive programming environment, Part12/25
Rich Salz
rsalz at bbn.com
Wed Dec 19 06:39:15 AEST 1990
Submitted-by: Steven Pemberton <steven at cwi.nl>
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 comp-sources-unix at uunet.uu.net if you want that tool.
# Contents: abc/Makefile.unix abc/boot/grammar.abc abc/btr/i1tex.c
# abc/lin/i1tlt.c
# Wrapped by rsalz at litchi.bbn.com 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 at n, t is not a text")
X#define BEHEAD_NUM MESS(205, "in t at n, n is not a number")
X#define BEHEAD_INT MESS(206, "in t at n, n is not an integer")
X#define BEHEAD_BND MESS(207, "in t at 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 at 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 at 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 at 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...
--
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