rsalz@bbn.com (Rich Salz) (12/19/90)
Submitted-by: Steven Pemberton <steven@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@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@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@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... -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.