v23i094: ABC interactive programming environment, Part15/25
Rich Salz
rsalz at bbn.com
Thu Dec 20 04:53:35 AEST 1990
Submitted-by: Steven Pemberton <steven at cwi.nl>
Posting-number: Volume 23, Issue 94
Archive-name: abc/part15
#! /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/bed/DEP abc/bint2/i2cmd.c abc/bint2/i2uni.c
# abc/bint3/i3int.c abc/ehdrs/tabl.h abc/unix/u1keys.c
# Wrapped by rsalz at litchi.bbn.com on Mon Dec 17 13:28:08 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 15 (of 25)."'
if test -f 'abc/bed/DEP' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bed/DEP'\"
else
echo shar: Extracting \"'abc/bed/DEP'\" \(9951 characters\)
sed "s/^X//" >'abc/bed/DEP' <<'END_OF_FILE'
Xe1cell.o: e1cell.c
Xe1cell.o: ../bhdrs/b.h
Xe1cell.o: ../uhdrs/osconf.h
Xe1cell.o: ../uhdrs/os.h
Xe1cell.o: ../uhdrs/conf.h
Xe1cell.o: ../uhdrs/config.h
Xe1cell.o: ../bhdrs/b0lan.h
Xe1cell.o: ../bhdrs/bedi.h
Xe1cell.o: ../bhdrs/bmem.h
Xe1cell.o: ../bhdrs/bobj.h
Xe1cell.o: ../ehdrs/node.h
Xe1cell.o: ../ehdrs/cell.h
Xe1cell.o: ../uhdrs/args.h
Xe1code.o: e1code.c
Xe1code.o: ../bhdrs/b.h
Xe1code.o: ../uhdrs/osconf.h
Xe1code.o: ../uhdrs/os.h
Xe1code.o: ../uhdrs/conf.h
Xe1code.o: ../uhdrs/config.h
Xe1code.o: ../ehdrs/code.h
Xe1comm.o: e1comm.c
Xe1comm.o: ../bhdrs/b.h
Xe1comm.o: ../uhdrs/osconf.h
Xe1comm.o: ../uhdrs/os.h
Xe1comm.o: ../uhdrs/conf.h
Xe1comm.o: ../uhdrs/config.h
Xe1comm.o: ../bhdrs/bedi.h
Xe1comm.o: ../uhdrs/feat.h
Xe1comm.o: ../bhdrs/bfil.h
Xe1comm.o: ../bhdrs/bcom.h
Xe1comm.o: ../ehdrs/node.h
Xe1comm.o: ../ehdrs/supr.h
Xe1comm.o: ../ehdrs/tabl.h
Xe1deco.o: e1deco.c
Xe1deco.o: ../bhdrs/b.h
Xe1deco.o: ../uhdrs/osconf.h
Xe1deco.o: ../uhdrs/os.h
Xe1deco.o: ../uhdrs/conf.h
Xe1deco.o: ../uhdrs/config.h
Xe1deco.o: ../bhdrs/bedi.h
Xe1deco.o: ../btr/etex.h
Xe1deco.o: ../bhdrs/bobj.h
Xe1deco.o: ../uhdrs/feat.h
Xe1deco.o: ../ehdrs/erro.h
Xe1deco.o: ../ehdrs/node.h
Xe1deco.o: ../ehdrs/gram.h
Xe1deco.o: ../ehdrs/supr.h
Xe1deco.o: ../ehdrs/queu.h
Xe1deco.o: ../ehdrs/tabl.h
Xe1edit.o: e1edit.c
Xe1edit.o: ../bhdrs/b.h
Xe1edit.o: ../uhdrs/osconf.h
Xe1edit.o: ../uhdrs/os.h
Xe1edit.o: ../uhdrs/conf.h
Xe1edit.o: ../uhdrs/config.h
Xe1edit.o: ../bhdrs/bedi.h
Xe1edit.o: ../btr/etex.h
Xe1edit.o: ../uhdrs/feat.h
Xe1edit.o: ../bhdrs/bmem.h
Xe1edit.o: ../ehdrs/erro.h
Xe1edit.o: ../bhdrs/bobj.h
Xe1edit.o: ../ehdrs/node.h
Xe1edit.o: ../ehdrs/tabl.h
Xe1edit.o: ../ehdrs/gram.h
Xe1edit.o: ../ehdrs/supr.h
Xe1edit.o: ../ehdrs/queu.h
Xe1edoc.o: e1edoc.c
Xe1edoc.o: ../bhdrs/b.h
Xe1edoc.o: ../uhdrs/osconf.h
Xe1edoc.o: ../uhdrs/os.h
Xe1edoc.o: ../uhdrs/conf.h
Xe1edoc.o: ../uhdrs/config.h
Xe1edoc.o: ../bhdrs/bedi.h
Xe1edoc.o: ../btr/etex.h
Xe1edoc.o: ../uhdrs/feat.h
Xe1edoc.o: ../bhdrs/bobj.h
Xe1edoc.o: ../uhdrs/defs.h
Xe1edoc.o: ../ehdrs/node.h
Xe1edoc.o: ../ehdrs/erro.h
Xe1edoc.o: ../ehdrs/gram.h
Xe1edoc.o: ../ehdrs/keys.h
Xe1edoc.o: ../ehdrs/queu.h
Xe1edoc.o: ../ehdrs/supr.h
Xe1edoc.o: ../ehdrs/tabl.h
Xe1erro.o: e1erro.c
Xe1erro.o: ../bhdrs/b.h
Xe1erro.o: ../uhdrs/osconf.h
Xe1erro.o: ../uhdrs/os.h
Xe1erro.o: ../uhdrs/conf.h
Xe1erro.o: ../uhdrs/config.h
Xe1erro.o: ../bhdrs/bedi.h
Xe1erro.o: ../uhdrs/feat.h
Xe1erro.o: ../bhdrs/bmem.h
Xe1erro.o: ../bhdrs/bobj.h
Xe1erro.o: ../ehdrs/erro.h
Xe1erro.o: ../ehdrs/node.h
Xe1eval.o: e1eval.c
Xe1eval.o: ../bhdrs/b.h
Xe1eval.o: ../uhdrs/osconf.h
Xe1eval.o: ../uhdrs/os.h
Xe1eval.o: ../uhdrs/conf.h
Xe1eval.o: ../uhdrs/config.h
Xe1eval.o: ../bhdrs/b0lan.h
Xe1eval.o: ../bhdrs/bedi.h
Xe1eval.o: ../btr/etex.h
Xe1eval.o: ../ehdrs/node.h
Xe1eval.o: ../ehdrs/gram.h
Xe1getc.o: e1getc.c
Xe1getc.o: ../bhdrs/b.h
Xe1getc.o: ../uhdrs/osconf.h
Xe1getc.o: ../uhdrs/os.h
Xe1getc.o: ../uhdrs/conf.h
Xe1getc.o: ../uhdrs/config.h
Xe1getc.o: ../uhdrs/feat.h
Xe1getc.o: ../bhdrs/bmem.h
Xe1getc.o: ../bhdrs/bobj.h
Xe1getc.o: ../bhdrs/bfil.h
Xe1getc.o: ../ehdrs/keys.h
Xe1getc.o: ../ehdrs/getc.h
Xe1getc.o: ../uhdrs/args.h
Xe1goto.o: e1goto.c
Xe1goto.o: ../bhdrs/b.h
Xe1goto.o: ../uhdrs/osconf.h
Xe1goto.o: ../uhdrs/os.h
Xe1goto.o: ../uhdrs/conf.h
Xe1goto.o: ../uhdrs/config.h
Xe1goto.o: ../bhdrs/bedi.h
Xe1goto.o: ../btr/etex.h
Xe1goto.o: ../uhdrs/feat.h
Xe1goto.o: ../bhdrs/bobj.h
Xe1goto.o: ../ehdrs/erro.h
Xe1goto.o: ../ehdrs/node.h
Xe1goto.o: ../ehdrs/gram.h
Xe1goto.o: ../ehdrs/supr.h
Xe1gram.o: e1gram.c
Xe1gram.o: ../bhdrs/b.h
Xe1gram.o: ../uhdrs/osconf.h
Xe1gram.o: ../uhdrs/os.h
Xe1gram.o: ../uhdrs/conf.h
Xe1gram.o: ../uhdrs/config.h
Xe1gram.o: ../bhdrs/bedi.h
Xe1gram.o: ../btr/etex.h
Xe1gram.o: ../bhdrs/bmem.h
Xe1gram.o: ../uhdrs/feat.h
Xe1gram.o: ../bhdrs/bobj.h
Xe1gram.o: ../ehdrs/node.h
Xe1gram.o: ../ehdrs/gram.h
Xe1gram.o: ../ehdrs/supr.h
Xe1gram.o: ../ehdrs/tabl.h
Xe1gram.o: ../ehdrs/code.h
Xe1gram.o: ../uhdrs/args.h
Xe1help.o: e1help.c
Xe1help.o: ../bhdrs/b.h
Xe1help.o: ../uhdrs/osconf.h
Xe1help.o: ../uhdrs/os.h
Xe1help.o: ../uhdrs/conf.h
Xe1help.o: ../uhdrs/config.h
Xe1help.o: ../bhdrs/bedi.h
Xe1help.o: ../uhdrs/feat.h
Xe1help.o: ../bhdrs/bmem.h
Xe1help.o: ../bhdrs/bfil.h
Xe1help.o: ../bhdrs/bobj.h
Xe1help.o: ../ehdrs/keys.h
Xe1help.o: ../ehdrs/getc.h
Xe1ins2.o: e1ins2.c
Xe1ins2.o: ../bhdrs/b.h
Xe1ins2.o: ../uhdrs/osconf.h
Xe1ins2.o: ../uhdrs/os.h
Xe1ins2.o: ../uhdrs/conf.h
Xe1ins2.o: ../uhdrs/config.h
Xe1ins2.o: ../bhdrs/bedi.h
Xe1ins2.o: ../btr/etex.h
Xe1ins2.o: ../bhdrs/bobj.h
Xe1ins2.o: ../ehdrs/node.h
Xe1ins2.o: ../ehdrs/supr.h
Xe1ins2.o: ../ehdrs/queu.h
Xe1ins2.o: ../ehdrs/gram.h
Xe1ins2.o: ../ehdrs/tabl.h
Xe1inse.o: e1inse.c
Xe1inse.o: ../bhdrs/b.h
Xe1inse.o: ../uhdrs/osconf.h
Xe1inse.o: ../uhdrs/os.h
Xe1inse.o: ../uhdrs/conf.h
Xe1inse.o: ../uhdrs/config.h
Xe1inse.o: ../bhdrs/bedi.h
Xe1inse.o: ../btr/etex.h
Xe1inse.o: ../uhdrs/feat.h
Xe1inse.o: ../bhdrs/bobj.h
Xe1inse.o: ../ehdrs/node.h
Xe1inse.o: ../ehdrs/gram.h
Xe1inse.o: ../ehdrs/supr.h
Xe1inse.o: ../ehdrs/tabl.h
Xe1inse.o: ../ehdrs/code.h
Xe1lexi.o: e1lexi.c
Xe1lexi.o: ../bhdrs/b.h
Xe1lexi.o: ../uhdrs/osconf.h
Xe1lexi.o: ../uhdrs/os.h
Xe1lexi.o: ../uhdrs/conf.h
Xe1lexi.o: ../uhdrs/config.h
Xe1lexi.o: ../bhdrs/bedi.h
Xe1lexi.o: ../bhdrs/bobj.h
Xe1lexi.o: ../ehdrs/node.h
Xe1lexi.o: ../ehdrs/tabl.h
Xe1line.o: e1line.c
Xe1line.o: ../bhdrs/b.h
Xe1line.o: ../uhdrs/osconf.h
Xe1line.o: ../uhdrs/os.h
Xe1line.o: ../uhdrs/conf.h
Xe1line.o: ../uhdrs/config.h
Xe1line.o: ../bhdrs/bedi.h
Xe1line.o: ../btr/etex.h
Xe1line.o: ../bhdrs/bobj.h
Xe1line.o: ../ehdrs/node.h
Xe1line.o: ../ehdrs/gram.h
Xe1line.o: ../ehdrs/supr.h
Xe1move.o: e1move.c
Xe1move.o: ../bhdrs/b.h
Xe1move.o: ../uhdrs/osconf.h
Xe1move.o: ../uhdrs/os.h
Xe1move.o: ../uhdrs/conf.h
Xe1move.o: ../uhdrs/config.h
Xe1move.o: ../uhdrs/feat.h
Xe1move.o: ../bhdrs/bedi.h
Xe1move.o: ../btr/etex.h
Xe1move.o: ../bhdrs/bobj.h
Xe1move.o: ../ehdrs/node.h
Xe1move.o: ../ehdrs/supr.h
Xe1move.o: ../ehdrs/gram.h
Xe1move.o: ../ehdrs/tabl.h
Xe1node.o: e1node.c
Xe1node.o: ../bhdrs/b.h
Xe1node.o: ../uhdrs/osconf.h
Xe1node.o: ../uhdrs/os.h
Xe1node.o: ../uhdrs/conf.h
Xe1node.o: ../uhdrs/config.h
Xe1node.o: ../bhdrs/bedi.h
Xe1node.o: ../btr/etex.h
Xe1node.o: ../bhdrs/bobj.h
Xe1node.o: ../ehdrs/node.h
Xe1node.o: ../bhdrs/bmem.h
Xe1outp.o: e1outp.c
Xe1outp.o: ../bhdrs/b.h
Xe1outp.o: ../uhdrs/osconf.h
Xe1outp.o: ../uhdrs/os.h
Xe1outp.o: ../uhdrs/conf.h
Xe1outp.o: ../uhdrs/config.h
Xe1outp.o: ../bhdrs/bedi.h
Xe1outp.o: ../btr/etex.h
Xe1outp.o: ../bhdrs/bobj.h
Xe1outp.o: ../bhdrs/bmem.h
Xe1outp.o: ../ehdrs/node.h
Xe1outp.o: ../ehdrs/supr.h
Xe1outp.o: ../ehdrs/gram.h
Xe1outp.o: ../ehdrs/cell.h
Xe1outp.o: ../ehdrs/tabl.h
Xe1que1.o: e1que1.c
Xe1que1.o: ../bhdrs/b.h
Xe1que1.o: ../uhdrs/osconf.h
Xe1que1.o: ../uhdrs/os.h
Xe1que1.o: ../uhdrs/conf.h
Xe1que1.o: ../uhdrs/config.h
Xe1que1.o: ../bhdrs/bedi.h
Xe1que1.o: ../btr/etex.h
Xe1que1.o: ../uhdrs/feat.h
Xe1que1.o: ../bhdrs/bobj.h
Xe1que1.o: ../ehdrs/node.h
Xe1que1.o: ../ehdrs/supr.h
Xe1que1.o: ../ehdrs/queu.h
Xe1que1.o: ../ehdrs/gram.h
Xe1que1.o: ../ehdrs/tabl.h
Xe1que2.o: e1que2.c
Xe1que2.o: ../bhdrs/b.h
Xe1que2.o: ../uhdrs/osconf.h
Xe1que2.o: ../uhdrs/os.h
Xe1que2.o: ../uhdrs/conf.h
Xe1que2.o: ../uhdrs/config.h
Xe1que2.o: ../bhdrs/bedi.h
Xe1que2.o: ../btr/etex.h
Xe1que2.o: ../uhdrs/feat.h
Xe1que2.o: ../bhdrs/bobj.h
Xe1que2.o: ../ehdrs/node.h
Xe1que2.o: ../ehdrs/supr.h
Xe1que2.o: ../ehdrs/queu.h
Xe1que2.o: ../ehdrs/gram.h
Xe1que2.o: ../ehdrs/tabl.h
Xe1que2.o: ../ehdrs/code.h
Xe1save.o: e1save.c
Xe1save.o: ../bhdrs/b.h
Xe1save.o: ../uhdrs/osconf.h
Xe1save.o: ../uhdrs/os.h
Xe1save.o: ../uhdrs/conf.h
Xe1save.o: ../uhdrs/config.h
Xe1save.o: ../bhdrs/b0lan.h
Xe1save.o: ../bhdrs/bedi.h
Xe1save.o: ../btr/etex.h
Xe1save.o: ../bhdrs/bmem.h
Xe1save.o: ../bhdrs/bobj.h
Xe1save.o: ../ehdrs/node.h
Xe1save.o: ../ehdrs/gram.h
Xe1scrn.o: e1scrn.c
Xe1scrn.o: ../bhdrs/b.h
Xe1scrn.o: ../uhdrs/osconf.h
Xe1scrn.o: ../uhdrs/os.h
Xe1scrn.o: ../uhdrs/conf.h
Xe1scrn.o: ../uhdrs/config.h
Xe1scrn.o: ../bhdrs/bedi.h
Xe1scrn.o: ../btr/etex.h
Xe1scrn.o: ../uhdrs/feat.h
Xe1scrn.o: ../bhdrs/bobj.h
Xe1scrn.o: ../ehdrs/erro.h
Xe1scrn.o: ../ehdrs/node.h
Xe1scrn.o: ../ehdrs/supr.h
Xe1scrn.o: ../ehdrs/gram.h
Xe1scrn.o: ../ehdrs/cell.h
Xe1scrn.o: ../ehdrs/trm.h
Xe1scrn.o: ../uhdrs/args.h
Xe1spos.o: e1spos.c
Xe1spos.o: ../bhdrs/b.h
Xe1spos.o: ../uhdrs/osconf.h
Xe1spos.o: ../uhdrs/os.h
Xe1spos.o: ../uhdrs/conf.h
Xe1spos.o: ../uhdrs/config.h
Xe1spos.o: ../uhdrs/feat.h
Xe1spos.o: ../bhdrs/bedi.h
Xe1spos.o: ../bhdrs/bobj.h
Xe1spos.o: ../bhdrs/bfil.h
Xe1spos.o: ../ehdrs/node.h
Xe1spos.o: ../ehdrs/supr.h
Xe1spos.o: ../bhdrs/bmem.h
Xe1sugg.o: e1sugg.c
Xe1sugg.o: ../bhdrs/b.h
Xe1sugg.o: ../uhdrs/osconf.h
Xe1sugg.o: ../uhdrs/os.h
Xe1sugg.o: ../uhdrs/conf.h
Xe1sugg.o: ../uhdrs/config.h
Xe1sugg.o: ../uhdrs/feat.h
Xe1sugg.o: ../bhdrs/b0lan.h
Xe1sugg.o: ../bhdrs/bmem.h
Xe1sugg.o: ../bhdrs/bedi.h
Xe1sugg.o: ../btr/etex.h
Xe1sugg.o: ../uhdrs/defs.h
Xe1sugg.o: ../bhdrs/bobj.h
Xe1sugg.o: ../bhdrs/bfil.h
Xe1sugg.o: ../ehdrs/node.h
Xe1sugg.o: ../ehdrs/supr.h
Xe1sugg.o: ../ehdrs/gram.h
Xe1sugg.o: ../ehdrs/tabl.h
Xe1sugg.o: ../ehdrs/queu.h
Xe1sugg.o: ../uhdrs/args.h
Xe1supr.o: e1supr.c
Xe1supr.o: ../bhdrs/b.h
Xe1supr.o: ../uhdrs/osconf.h
Xe1supr.o: ../uhdrs/os.h
Xe1supr.o: ../uhdrs/conf.h
Xe1supr.o: ../uhdrs/config.h
Xe1supr.o: ../bhdrs/bedi.h
Xe1supr.o: ../btr/etex.h
Xe1supr.o: ../uhdrs/feat.h
Xe1supr.o: ../bhdrs/bobj.h
Xe1supr.o: ../ehdrs/erro.h
Xe1supr.o: ../ehdrs/node.h
Xe1supr.o: ../ehdrs/supr.h
Xe1supr.o: ../ehdrs/gram.h
Xe1supr.o: ../ehdrs/tabl.h
Xe1tabl.o: e1tabl.c
Xe1tabl.o: ../bhdrs/b.h
Xe1tabl.o: ../uhdrs/osconf.h
Xe1tabl.o: ../uhdrs/os.h
Xe1tabl.o: ../uhdrs/conf.h
Xe1tabl.o: ../uhdrs/config.h
Xe1tabl.o: ../bhdrs/bedi.h
Xe1tabl.o: ../ehdrs/tabl.h
Xe1term.o: e1term.c
Xe1term.o: ../bhdrs/b.h
Xe1term.o: ../uhdrs/osconf.h
Xe1term.o: ../uhdrs/os.h
Xe1term.o: ../uhdrs/conf.h
Xe1term.o: ../uhdrs/config.h
Xe1term.o: ../uhdrs/feat.h
Xe1term.o: ../ehdrs/erro.h
Xe1wide.o: e1wide.c
Xe1wide.o: ../bhdrs/b.h
Xe1wide.o: ../uhdrs/osconf.h
Xe1wide.o: ../uhdrs/os.h
Xe1wide.o: ../uhdrs/conf.h
Xe1wide.o: ../uhdrs/config.h
Xe1wide.o: ../bhdrs/bedi.h
Xe1wide.o: ../btr/etex.h
Xe1wide.o: ../bhdrs/bobj.h
Xe1wide.o: ../ehdrs/node.h
Xe1wide.o: ../ehdrs/supr.h
Xe1wide.o: ../ehdrs/gram.h
Xe1wide.o: ../ehdrs/tabl.h
END_OF_FILE
if test 9951 -ne `wc -c <'abc/bed/DEP'`; then
echo shar: \"'abc/bed/DEP'\" unpacked with wrong size!
fi
# end of 'abc/bed/DEP'
fi
if test -f 'abc/bint2/i2cmd.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint2/i2cmd.c'\"
else
echo shar: Extracting \"'abc/bint2/i2cmd.c'\" \(9327 characters\)
sed "s/^X//" >'abc/bint2/i2cmd.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "b0lan.h"
X#include "i2par.h"
X#include "i2nod.h"
X#include "i3env.h"
X
X/* ******************************************************************** */
X/* command_suite */
X/* ******************************************************************** */
X
XVisible parsetree cmd_suite(cil, first, suite) intlet cil; bool first;
X parsetree (*suite)(); {
X parsetree v= NilTree;
X
X if (ateol()) {
X bool emp= Yes;
X
X v= (*suite)(cil, first, &emp);
X if (emp) parerr(MESS(2000, "no command suite where expected"));
X return v;
X }
X else {
X value c= Vnil;
X intlet l= lino;
X
X suite_command(&v, &c);
X return node5(SUITE, mk_integer(l), v, c, NilTree);
X }
X}
X
XVisible parsetree cmd_seq(cil, first, emp) intlet cil; bool first, *emp; {
X value c= Vnil;
X intlet level, l;
X
X level= ilev(); l= lino;
X if (is_comment(&c))
X return node5(SUITE, mk_integer(l), NilTree, c,
X cmd_seq(cil, first, emp));
X if (chk_indent(level, cil, first)) {
X parsetree v= NilTree;
X
X findceol();
X suite_command(&v, &c);
X *emp= No;
X return node5(SUITE, mk_integer(l), v, c, cmd_seq(level, No, emp));
X }
X veli();
X return NilTree;
X}
X
XHidden Procedure chk_indent(nlevel, olevel, first) intlet nlevel, olevel;
X bool first; {
X if (nlevel > olevel) {
X if (!first) parerr(WRONG_INDENT);
X else if (nlevel - olevel == 1) parerr(SMALL_INDENT);
X return Yes;
X }
X return nlevel == olevel && !first ? Yes : No;
X}
X
XHidden Procedure suite_command(v, c) parsetree *v; value *c; {
X char *kw;
X
X if (!is_cmdname(ceol, &kw) || !control_command(kw, v) &&
X !simple_command(kw, v, c) )
X parerr(MESS(2001, "no command where expected"));
X}
X
X/* ******************************************************************** */
X/* is_comment, tail_line */
X/* ******************************************************************** */
X
XVisible bool is_comment(v) value *v; {
X txptr tx0= tx;
X skipsp(&tx);
X if (comment_sign) {
X while (Space(Char(tx0-1))) tx0--;
X while (!Eol(tx)) tx++;
X *v= cr_text(tx0, tx);
X return Yes;
X }
X tx= tx0;
X return No;
X}
X
XVisible value tail_line() {
X value v;
X if (is_comment(&v)) return v;
X if (!ateol()) parerr(MESS(2002, "something unexpected in this line"));
X return Vnil;
X}
X
X/* ******************************************************************** */
X/* simple_command */
X/* */
X/* ******************************************************************** */
X
XVisible bool simple_command(kw, v, c) char *kw; parsetree *v; value *c; {
X return bas_com(kw, v) || term_com(kw, v) || udr_com(kw, v)
X ? (*c= tail_line(), Yes) : No;
X}
X
X/* ******************************************************************** */
X/* basic_command */
X/* ******************************************************************** */
X
XHidden bool bas_com(kw, v) char *kw; parsetree *v; {
X parsetree w, t;
X txptr ftx, ttx;
X
X if (check_keyword(kw)) { /* CHECK */
X *v= node2(CHECK, test(ceol));
X }
X else if (delete_keyword(kw)) /* DELETE */
X *v= node2(DELETE, targ(ceol));
X else if (insert_keyword(kw)) { /* INSERT */
X req(K_IN_insert, ceol, &ftx, &ttx);
X w= expr(ftx); tx= ttx;
X *v= node3(INSERT, w, targ(ceol));
X }
X else if (pass_keyword(kw)) { /* PASS */
X upto(ceol, K_PASS);
X *v= node1(PASS);
X }
X else if (put_keyword(kw)) { /* PUT */
X req(K_IN_put, ceol, &ftx, &ttx);
X w= expr(ftx); tx= ttx;
X *v= node3(PUT, w, targ(ceol));
X }
X else if (read_keyword(kw)) { /* READ */
X if (find(K_RAW, ceol, &ftx, &ttx)) {
X *v= node2(READ_RAW, targ(ftx)); tx= ttx;
X upto(ceol, K_RAW);
X }
X else {
X req(K_EG, ceol, &ftx, &ttx);
X t= targ(ftx); tx= ttx;
X *v= node3(READ, t, expr(ceol));
X }
X }
X else if (remove_keyword(kw)) { /* REMOVE */
X req(K_FROM_remove, ceol, &ftx, &ttx);
X w= expr(ftx); tx= ttx;
X *v= node3(REMOVE, w, targ(ceol));
X }
X else if (setrandom_keyword(kw)) /* SET RANDOM */
X *v= node2(SET_RANDOM, expr(ceol));
X else if (write_keyword(kw)) { /* WRITE */
X intlet b_cnt= 0, a_cnt= 0;
X value cr_newlines();
X
X skipsp(&tx);
X if (Ceol(tx))
X parerr(MESS(2003, "no parameter where expected"));
X while (nwl_sign) {b_cnt++; skipsp(&tx); }
X if (Ceol(tx)) w= NilTree;
X else {
X ftx= ceol;
X while (Space(Char(ftx-1)) || Char(ftx-1) == '/')
X if (Char(--ftx) == '/') a_cnt++;
X skipsp(&tx);
X w= ftx > tx ? expr(ftx) : NilTree;
X }
X *v= node4(w == NilTree || Nodetype(w) != COLLATERAL
X ? WRITE1 : WRITE,
X cr_newlines(b_cnt), w, cr_newlines(a_cnt));
X tx= ceol;
X#ifdef GFX
X }
X else if (spacefrom_keyword(kw)) { /* SPACE FROM */
X req(K_TO_space, ceol, &ftx, &ttx);
X w= expr(ftx); tx= ttx;
X *v= node3(SPACE, w, expr(ceol));
X }
X else if (linefrom_keyword(kw)) { /* LINE FROM */
X req(K_TO_line, ceol, &ftx, &ttx);
X w= expr(ftx); tx= ttx;
X *v= node3(LINE, w, expr(ceol));
X }
X else if (clearscreen_keyword(kw)) { / CLEAR SCREEN */
X upto(ceol, K_CLEARSCREEN);
X *v= node1(CLEAR);
X#endif
X }
X else return No;
X return Yes;
X}
X
XHidden value cr_newlines(cnt) intlet cnt; {
X value v, t= mk_text(S_NEWLINE), n= mk_integer(cnt);
X v= repeat(t, n);
X release(t); release(n);
X return v;
X}
X
X/* ******************************************************************** */
X/* terminating_command */
X/* ******************************************************************** */
X
XVisible bool term_com(kw, v) char *kw; parsetree *v; {
X if (fail_keyword(kw)) { /* FAIL */
X upto(ceol, K_FAIL);
X *v= node1(FAIL);
X }
X else if (quit_keyword(kw)) { /* QUIT */
X upto(ceol, K_QUIT);
X *v= node1(QUIT);
X }
X else if (return_keyword(kw)) /* RETURN */
X *v= node2(RETURN, expr(ceol));
X else if (report_keyword(kw)) /* REPORT */
X *v= node2(REPORT, test(ceol));
X else if (succeed_keyword(kw)) { /* SUCCEED */
X upto(ceol, K_SUCCEED);
X *v= node1(SUCCEED);
X }
X else return No;
X return Yes;
X}
X
X/* ******************************************************************** */
X/* user_defined_command; refined_command */
X/* ******************************************************************** */
X
XHidden bool udr_com(kw, v) char *kw; parsetree *v; {
X value hu_actuals();
X value w= mk_text(kw);
X
X if (!in(w, res_cmdnames)) {
X *v= node4(USER_COMMAND, copy(w), hu_actuals(ceol, w), Vnil);
X return Yes;
X }
X release(w);
X return No;
X}
X
XHidden value hu_actuals(q, kw) txptr q; value kw; {
X parsetree t= NilTree;
X value v= Vnil, nkw;
X txptr ftx;
X
X skipsp(&tx);
X if (!findkw(q, &ftx))
X ftx= q;
X if (Text(ftx))
X t= expr(ftx);
X if (Text(q)) {
X nkw= mk_text(keyword());
X v= hu_actuals(q, nkw);
X }
X return node4(ACTUAL, kw, t, v);
X}
X
X/* ******************************************************************** */
X/* control_command */
X/* ******************************************************************** */
X
XVisible bool control_command(kw, v) char *kw; parsetree *v; {
X parsetree s, t, alt_suite();
X value c;
X txptr ftx, ttx, utx, vtx;
X
X skipsp(&tx);
X if (if_keyword(kw)) { /* IF */
X req(S_COLON, ceol, &utx, &vtx);
X t= test(utx); tx= vtx;
X if (!is_comment(&c)) c= Vnil;
X *v= node4(IF, t, c, cmd_suite(cur_ilev, Yes, cmd_seq));
X }
X else if (select_keyword(kw)) { /* SELECT */
X need(S_COLON);
X c= tail_line();
X *v= node3(SELECT, c, alt_suite());
X }
X else if (while_keyword(kw)) { /* WHILE */
X intlet l= lino;
X
X req(S_COLON, ceol, &utx, &vtx);
X t= test(utx); tx= vtx;
X if (!is_comment(&c)) c= Vnil;
X s= node2(COLON_NODE, cmd_suite(cur_ilev, Yes, cmd_seq));
X *v= node5(WHILE, mk_integer(l), t, c, s);
X }
X else if (for_keyword(kw)) { /* FOR */
X req(S_COLON, ceol, &utx, &vtx);
X req(K_IN_for, ceol, &ftx, &ttx);
X if (ttx > utx) {
X parerr(MESS(2005, "IN after colon"));
X ftx= utx= tx; ttx= vtx= ceol;
X }
X idf_cntxt= In_ranger;
X t= idf(ftx); tx= ttx;
X s= expr(utx); tx= vtx;
X if (!is_comment(&c)) c= Vnil;
X *v= node5(FOR, t, s, c, cmd_suite(cur_ilev, Yes, cmd_seq));
X }
X else return No;
X return Yes;
X}
X
X/* ******************************************************************** */
X/* alternative_suite */
X/* ******************************************************************** */
X
XHidden parsetree alt_suite() {
X parsetree v, alt_seq();
X bool emp= Yes;
X
X v= alt_seq(cur_ilev, Yes, No, &emp);
X if (emp) parerr(MESS(2006, "no alternative suite for SELECT"));
X return v;
X}
X
XHidden parsetree alt_seq(cil, first, else_encountered, emp)
X bool first, else_encountered, *emp; intlet cil; {
X value c;
X intlet level, l;
X char *kw;
X
X level= ilev(); l= lino;
X if (is_comment(&c))
X return node6(TEST_SUITE, mk_integer(l), NilTree, c,
X node2(COLON_NODE, NilTree),
X alt_seq(cil, first, else_encountered, emp));
X if (chk_indent(level, cil, first)) {
X parsetree v, s;
X txptr ftx, ttx, tx0= tx;
X
X if (else_encountered)
X parerr(MESS(2007, "after ELSE no more alternatives allowed"));
X findceol();
X req(S_COLON, ceol, &ftx, &ttx);
X *emp= No;
X if (is_keyword(&kw) && else_keyword(kw)) {
X upto(ftx, K_ELSE); tx= ttx;
X if (!is_comment(&c)) c= Vnil;
X s= cmd_suite(level, Yes, cmd_seq);
X release(alt_seq(level, No, Yes, emp));
X return node4(ELSE, mk_integer(l), c, s);
X }
X else tx= tx0;
X v= test(ftx); tx= ttx;
X if (!is_comment(&c)) c= Vnil;
X s= node2(COLON_NODE, cmd_suite(level, Yes, cmd_seq));
X return node6(TEST_SUITE, mk_integer(l), v, c, s,
X alt_seq(level, No, else_encountered, emp));
X }
X veli();
X return NilTree;
X}
END_OF_FILE
if test 9327 -ne `wc -c <'abc/bint2/i2cmd.c'`; then
echo shar: \"'abc/bint2/i2cmd.c'\" unpacked with wrong size!
fi
# end of 'abc/bint2/i2cmd.c'
fi
if test -f 'abc/bint2/i2uni.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint2/i2uni.c'\"
else
echo shar: Extracting \"'abc/bint2/i2uni.c'\" \(9532 characters\)
sed "s/^X//" >'abc/bint2/i2uni.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "b0lan.h"
X#include "i2par.h"
X#include "i2nod.h"
X#include "i3env.h"
X#include "i3sou.h"
X
X/* ******************************************************************** */
X/* unit */
X/* ******************************************************************** */
X
XHidden value formlist, sharelist;
XHidden envtab reftab;
XVisible literal idf_cntxt;
X
XForward parsetree ref_suite();
X
X#define unicmd_suite(level) cmd_suite(level, Yes, ucmd_seq)
X
XVisible parsetree unit(heading, editing) bool heading, editing; {
X parsetree cmd_unit(), funprd_unit();
X parsetree v= NilTree;
X char *kw;
X
X if (!heading) {
X lino= 1;
X cntxt= In_unit;
X release(uname); uname= Vnil;
X }
X if (is_keyword(&kw) && how_keyword(kw)) {
X need(K_TO_how);
X if (cur_ilev != 0)
X parerr(MESS(2800, "how-to starts with indentation"));
X skipsp(&tx);
X if (is_cmdname(ceol, &kw)) {
X if (return_keyword(kw))
X v= funprd_unit(heading, Yes);
X else if (report_keyword(kw))
X v= funprd_unit(heading, No);
X else v= cmd_unit(kw, heading);
X }
X else parerr(MESS(2801, "no how-to name where expected"));
X }
X else parerr(MESS(2802, "no how-to keyword where expected"));
X
X#ifdef TYPE_CHECK
X if (!heading && !editing) type_check(v);
X#endif
X return v;
X}
X
X/* ******************************************************************** */
X/* cmd_unit */
X/* ******************************************************************** */
X
XHidden parsetree cmd_unit(kw, heading) char *kw; bool heading; {
X parsetree v;
X value w= mk_text(kw);
X value c, f, cmd_formals();
X txptr ftx, ttx;
X intlet level= cur_ilev;
X
X formlist= mk_elt();
X release(uname); uname= permkey(w, Cmd);
X if (in(w, res_cmdnames))
X pprerrV(MESS(2803, "%s is a reserved keyword"), w);
X req(S_COLON, ceol, &ftx, &ttx);
X idf_cntxt= In_formal;
X f= cmd_formals(ftx, w); tx= ttx;
X if (!is_comment(&c)) c= Vnil;
X v= node8(HOW_TO, copy(w), f, c, NilTree, NilTree, Vnil, Vnil);
X if (!heading) {
X sharelist= mk_elt();
X *Branch(v, HOW_SUITE)= unicmd_suite(level);
X reftab= mk_elt();
X *Branch(v, HOW_REFINEMENT)= ref_suite(level);
X *Branch(v, HOW_R_NAMES)= reftab;
X release(sharelist);
X }
X release(formlist);
X return v;
X}
X
XHidden value cmd_formals(q, kw) txptr q; value kw; {
X value t= Vnil, v= Vnil;
X txptr ftx;
X value nkw;
X
X skipsp(&tx);
X if (!findkw(q, &ftx))
X ftx= q;
X if (Text(ftx))
X t= idf(ftx);
X if (Text(q)) {
X nkw= mk_text(keyword());
X v= cmd_formals(q, nkw);
X }
X return node4(FORMAL, kw, t, v);
X}
X
X/* ******************************************************************** */
X/* fun_unit/prd_unit */
X/* ******************************************************************** */
X
XHidden parsetree funprd_unit(heading, isfunc) bool heading, isfunc; {
X parsetree v, f;
X parsetree fp_formals();
X value name, c, adicity;
X txptr ftx, ttx;
X intlet level= cur_ilev;
X
X formlist= mk_elt();
X skipsp(&tx);
X req(S_COLON, ceol, &ftx, &ttx);
X f= fp_formals(ftx, isfunc, &name, &adicity); tx= ttx;
X if (!is_comment(&c)) c= Vnil;
X v= node9(isfunc ? YIELD : TEST, copy(name), adicity, f, c, NilTree,
X NilTree, Vnil, Vnil);
X if (!heading) {
X sharelist= mk_elt();
X *Branch(v, FPR_SUITE)= unicmd_suite(level);
X reftab= mk_elt();
X *Branch(v, FPR_REFINEMENT)= ref_suite(level);
X *Branch(v, FPR_R_NAMES)= reftab;
X release(sharelist);
X }
X release(formlist);
X return v;
X}
X
X/* ******************************************************************** */
X
X#define FML_IN_FML MESS(2804, "%s is already a formal parameter or operand")
X#define SH_IN_FML FML_IN_FML
X#define SH_IN_SH MESS(2805, "%s is already a shared name")
X#define REF_IN_FML SH_IN_FML
X#define REF_IN_SH SH_IN_SH
X#define REF_IN_REF MESS(2806, "%s is already a refinement name")
X
XHidden Procedure treat_idf(t) value t; {
X switch (idf_cntxt) {
X case In_formal: if (in(t, formlist))
X pprerrV(FML_IN_FML, t);
X insert(t, &formlist);
X break;
X case In_share: if (in(t, formlist))
X pprerrV(SH_IN_FML, t);
X if (in(t, sharelist))
X pprerrV(SH_IN_SH, t);
X insert(t, &sharelist);
X break;
X case In_ref: if (in(t, formlist))
X pprerrV(REF_IN_FML, t);
X if (in(t, sharelist))
X pprerrV(REF_IN_SH, t);
X break;
X case In_ranger: break;
X default: break;
X }
X}
X
X#define NO_FUN_NAME MESS(2807, "cannot find function name")
X
XHidden parsetree fp_formals(q, isfunc, name, adic) txptr q; bool isfunc;
X value *name, *adic; {
X parsetree v1, v2, v3;
X parsetree fml_operand();
X
X *name= Vnil;
X idf_cntxt= In_formal;
X v1= fml_operand(q);
X skipsp(&tx);
X if (!Text(q)) { /* zeroadic */
X *adic= zero;
X if (nodetype(v1) == TAG) {
X *name= *Branch(v1, TAG_NAME);
X release(uname);
X uname= permkey(*name, isfunc ? Zfd : Zpd);
X }
X else pprerr(MESS(2808, "user defined functions must be names"));
X return v1;
X }
X
X v2= fml_operand(q);
X skipsp(&tx);
X if (!Text(q)) { /* monadic */
X *adic= one;
X if (nodetype(v1) == TAG) {
X *name= copy(*Branch(v1, TAG_NAME));
X release(uname);
X uname= permkey(*name, isfunc ? Mfd : Mpd);
X }
X else pprerr(NO_FUN_NAME);
X if (nodetype(v2) == TAG) treat_idf(*Branch(v2, TAG_NAME));
X release(v1);
X return node4(isfunc ? MONF : MONPRD, *name, v2, Vnil);
X }
X
X v3= fml_operand(q);
X /* dyadic */
X *adic= mk_integer(2);
X if (nodetype(v2) == TAG) {
X *name= copy(*Branch(v2, TAG_NAME));
X release(uname);
X uname= permkey(*name, isfunc ? Dfd : Dpd);
X }
X else pprerr(NO_FUN_NAME);
X upto1(q, MESS(2809, "something unexpected in formula template"));
X if (nodetype(v1) == TAG) treat_idf(*Branch(v1, TAG_NAME));
X if (nodetype(v3) == TAG) treat_idf(*Branch(v3, TAG_NAME));
X release(v2);
X return node5(isfunc ? DYAF : DYAPRD, v1, *name, v3, Vnil);
X}
X
XHidden parsetree fml_operand(q) txptr q; {
X value t;
X skipsp(&tx);
X if (nothing(q, MESS(2810, "nothing instead of expected template operand")))
X return NilTree;
X else if (is_tag(&t)) return node2(TAG, t);
X else if (open_sign) return compound(q, idf);
X else {
X parerr(MESS(2811, "no template operand where expected"));
X tx= q;
X return NilTree;
X }
X}
X
X/* ******************************************************************** */
X/* unit_command_suite */
X/* ******************************************************************** */
X
XVisible parsetree ucmd_seq(cil, first, emp) intlet cil; bool first, *emp; {
X value c;
X intlet level= ilev();
X intlet l= lino;
X
X if (is_comment(&c))
X return node5(SUITE, mk_integer(l), NilTree, c,
X ucmd_seq(cil, first, emp));
X if ((level == cil && !first) || (level > cil && first)) {
X parsetree v;
X findceol();
X if (share(ceol, &v, &c))
X return node5(SUITE, mk_integer(l), v, c,
X ucmd_seq(level, No, emp));
X veli();
X *emp= No;
X return cmd_suite(cil, first, cmd_seq);
X }
X veli();
X return NilTree;
X}
X
XHidden bool share(q, v, c) txptr q; parsetree *v; value *c; {
X char *kw;
X txptr tx0= tx;
X
X if (is_cmdname(q, &kw) && share_keyword(kw)) {
X idf_cntxt= In_share;
X *v= node2(SHARE, idf(q));
X *c= tail_line();
X return Yes;
X }
X else tx= tx0;
X return No;
X}
X
X
X/* ******************************************************************** */
X/* refinement_suite */
X/* ******************************************************************** */
X
XHidden parsetree ref_suite(cil) intlet cil; {
X char *kw;
X value name= Vnil;
X bool t;
X txptr tx0;
X
X if (ilev() != cil) {
X parerr(WRONG_INDENT);
X return NilTree;
X }
X tx0= tx;
X findceol();
X if ((t= is_tag(&name)) || is_cmdname(ceol, &kw)) {
X parsetree v, s;
X value w, *aa, r;
X
X skipsp(&tx);
X if (Char(tx) != ':') {
X release(name);
X tx= tx0;
X veli();
X return NilTree;
X }
X /* lino= 1; cntxt= In_ref; */
X tx++;
X if (t) {
X idf_cntxt= In_ref;
X treat_idf(name);
X }
X else name= mk_text(kw);
X if (in_env(reftab, name, &aa))
X pprerrV(REF_IN_REF, name);
X if (!is_comment(&w)) w= Vnil;
X s= cmd_suite(cil, Yes, cmd_seq);
X v= node6(REFINEMENT, name, w, s, Vnil, Vnil);
X e_replace(r= mk_ref(v), &reftab, name);
X release(r);
X *Branch(v, REF_NEXT)= ref_suite(cil);
X return v;
X }
X veli();
X return NilTree;
X}
X
X/* ******************************************************************** */
X/* collateral, compound */
X/* ******************************************************************** */
X
XHidden parsetree n_collateral(q, n, base) txptr q; intlet n;
X parsetree (*base)(); {
X parsetree v, w; txptr ftx, ttx;
X if (find(S_COMMA, q, &ftx, &ttx)) {
X w= (*base)(ftx); tx= ttx;
X v= n_collateral(q, n+1, base);
X }
X else {
X w= (*base)(q);
X if (n == 1) return w;
X v= mk_compound(n);
X }
X *Field(v, n-1)= w;
X return n > 1 ? v : node2(COLLATERAL, v);
X}
X
XVisible parsetree collateral(q, base) txptr q; parsetree (*base)(); {
X return n_collateral(q, 1, base);
X}
X
XVisible parsetree compound(q, base) txptr q; parsetree (*base)(); {
X parsetree v; txptr ftx, ttx;
X req(S_CLOSE, q, &ftx, &ttx);
X v= (*base)(ftx); tx= ttx;
X return node2(COMPOUND, v);
X}
X
X/* ******************************************************************** */
X/* idf, singidf */
X/* ******************************************************************** */
X
XHidden parsetree singidf(q) txptr q; {
X parsetree v;
X skipsp(&tx);
X if (nothing(q, MESS(2812, "nothing instead of expected name")))
X v= NilTree;
X else if (open_sign)
X v= compound(q, idf);
X else if (is_tag(&v)) {
X treat_idf(v);
X v= node2(TAG, v);
X }
X else {
X parerr(MESS(2813, "no name where expected"));
X v= NilTree;
X }
X upto1(q, MESS(2814, "something unexpected in name"));
X return v;
X}
X
XVisible parsetree idf(q) txptr q; {
X return collateral(q, singidf);
X}
END_OF_FILE
if test 9532 -ne `wc -c <'abc/bint2/i2uni.c'`; then
echo shar: \"'abc/bint2/i2uni.c'\" unpacked with wrong size!
fi
# end of 'abc/bint2/i2uni.c'
fi
if test -f 'abc/bint3/i3int.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint3/i3int.c'\"
else
echo shar: Extracting \"'abc/bint3/i3int.c'\" \(8835 characters\)
sed "s/^X//" >'abc/bint3/i3int.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* B interpreter using threaded trees */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "i2nod.h"
X#include "i3env.h"
X#include "i3int.h"
X#include "i3in2.h"
X#include "i3sou.h"
X#include "i3sta.h"
X
X/* Relics from old system: */
X
XVisible value resval;
XVisible bool terminated;
X
X
X/* Shorthands: */
X
X#define Pop2(fun) (w = pop(), v = pop(), fun(v, w), release(v), release(w))
X#define Pop1(fun) (v = pop(), fun(v), release(v))
X#define Dyop(funvw) \
X (w = pop(), v = pop(), push(funvw), release(v), release(w))
X#define Monop(funv) (v = pop(), push(funv), release(v))
X#define Flagged() (Thread2(pc) != NilTree)
X#define LocFlagged() Flagged()
X#define ValOrLoc(feval, floc) (LocFlagged() ? (floc) : (feval))
X#define Jump() (next = Thread2(pc))
X#define Comp(op) (w = pop(), v = pop(), report = (compare(v, w) op 0), Comp2())
X#define Comp2() (release(v), !Flagged() ? release(w) : Comp3())
X#define Comp3() (report ? push(w) : (release(w), jumptoend()))
X#define F(n) ((value)*Branch(pc, (n)))
X
X/* Execute a threaded tree until the end or until a terminating-command.
X The boolean argument 'wantvalue' tells whether it must deliver
X a value or not.
X*/
X
XHidden value
Xrun(start, wantvalue) parsetree start; bool wantvalue; {
X value u, v, w; int k, len; bool X, Y; int call_stop= call_level;
X parsetree old_next= next;
X /* While run can be used recursively, save some state info */
X
X next= start;
X while (still_ok && !Interrupted()) {
X pc= next;
X if (pc == Halt) {
X interr(MESS(3500, "unexpected program halt"));
X break;
X }
X if (!Is_parsetree(pc)) {
X if (pc == Stop) {
X if (call_level == call_stop) break;
X ret();
X continue;
X }
X if (!Is_number(pc)) syserr(MESS(3501, "run: bad thread"));
X switch (intval(pc)) {
X case 0:
X pc= Stop;
X break;
X case 1:
X interr(
X MESS(3502, "none of the alternative tests of SELECT succeeds"));
X break;
X case 2:
X if (resexp == Rep)
X interr(TEST_NO_REPORT);
X else
X interr(YIELD_NO_RETURN);
X break;
X case 3:
X if (resexp == Rep)
X interr(MESS(3503, "test refinement reports no outcome"));
X else
X interr(MESS(3504, "refinement returns no value"));
X /* "expression-" seems superfluous here */
X break;
X default:
X v= convert(pc, No, No);
X interrV(MESS(3505, "run-time error %s"), v);
X release(v);
X }
X continue;
X }
X next = Thread(pc);
X
X/* <<<<<<<<<<<<<<<< */
Xswitch (Nodetype(pc)) {
X
Xcase HOW_TO:
Xcase REFINEMENT:
X interr(MESS(3506, "run: cannot execute how-to definition"));
X break;
X
Xcase YIELD:
Xcase TEST:
X switch (Nodetype(F(FPR_FORMALS))) {
X case TAG:
X break;
X case MONF: case MONPRD:
X w= pop(); v= pop();
X put(v, w); release(v); release(w);
X break;
X case DYAF: case DYAPRD:
X w= pop(); v= pop(); u= pop();
X put(u, w); release(u); release(w);
X u= pop();
X put(u, v); release(u); release(v);
X break;
X default:
X syserr(MESS(3507, "bad FPR_FORMAL"));
X break;
X }
X release(uname); uname= get_pname(pc);
X cntxt= In_unit;
X break;
X
X/* Commands */
X
Xcase SUITE:
X curlino = F(SUI_LINO);
X curline = F(SUI_CMD);
X break;
X
Xcase WHILE:
X curlino= F(WHL_LINO);
X curline= pc;
X break;
X
Xcase TEST_SUITE:
X curlino= F(TSUI_LINO);
X curline= F(TSUI_TEST);
X break;
X
Xcase IF:
Xcase AND:
Xcase COLON_NODE:
X if (!report) Jump(); break;
X
Xcase OR: if (report) Jump(); break;
X
Xcase FOR:
X w= pop(); v= pop();
X if (!in_ranger(v, &w)) { release(v); release(w); Jump(); }
X else { push(v); push(w); }
X break;
X
Xcase PUT: Pop2(put_with_check); break;
Xcase INSERT: Pop2(l_insert); break;
Xcase REMOVE: Pop2(l_remove); break;
Xcase SET_RANDOM: Pop1(set_random); break;
Xcase DELETE: Pop1(l_delete); break;
Xcase CHECK: if (!report) checkerr(); break;
X
Xcase WRITE: /* collateral expression */
X nl(F(WRT_L_LINES));
X v = pop();
X len = Nfields(v);
X for (k= 0; k < len && still_ok; ++k)
X writ(*Field(v, k));
X release(v);
X nl(F(WRT_R_LINES));
X break;
Xcase WRITE1: /* single expression */
X nl(F(WRT_L_LINES));
X if (F(WRT_EXPR) != Vnil) { v = pop(); writ(v); release(v); }
X nl(F(WRT_R_LINES));
X break;
X
Xcase READ: Pop2(read_eg); break;
X
Xcase READ_RAW: Pop1(read_raw); break;
X
Xcase QUIT:
X if (resexp != Voi)
X interr(MESS(3508, "QUIT may only occur in a command or command-refinement"));
X if (call_level == 0 && still_ok) terminated= Yes;
X next= Stop; break;
Xcase RETURN:
X if (resexp != Ret)
X interr(MESS(3509, "RETURN may only occur in a function or expression-refinement"));
X resval = pop(); next= Stop; break;
Xcase REPORT:
X if (resexp != Rep)
X interr(MESS(3510, "REPORT may only occur in a predicate or test-refinement"));
X next= Stop; break;
Xcase SUCCEED:
X if (resexp != Rep)
X interr(MESS(3511, "SUCCEED may only occur in a predicate or test-refinement"));
X report = Yes; next= Stop; break;
Xcase FAIL:
X if (resexp != Rep)
X interr(MESS(3512, "FAIL may only occur in a predicate or test-refinement"));
X report = No; next= Stop; break;
X
Xcase USER_COMMAND:
X x_user_command(F(UCMD_NAME), F(UCMD_ACTUALS), F(UCMD_DEF));
X break;
X
X/* Expressions, targets */
X
Xcase COLLATERAL:
X v = mk_compound(k= Nfields(F(COLL_SEQ)));
X while (--k >= 0)
X *Field(v, k) = pop();
X push(v);
X break;
X
X/* Expressions, targets */
X
Xcase SELECTION: Dyop(ValOrLoc(associate(v, w), tbsel_loc(v, w))); break;
X
Xcase BEHEAD:
X w= pop(); v= pop();
X push(LocFlagged() ? trim_loc(v, w, '@') : behead(v, w));
X release(v); release(w);
X break;
X
Xcase CURTAIL:
X w= pop(); v= pop();
X push(LocFlagged() ? trim_loc(v, w, '|') : curtail(v, w));
X release(v); release(w);
X break;
X
Xcase MONF:
X v = pop();
X formula(Vnil, F(MON_NAME), v, F(MON_FCT));
X release(v);
X break;
X
Xcase DYAF:
X w = pop(); v = pop();
X formula(v, F(DYA_NAME), w, F(DYA_FCT));
X release(v); release(w);
X break;
X
Xcase TEXT_LIT:
X v= F(XLIT_TEXT);
X if (F(XLIT_NEXT) != Vnil) { w= pop(); v= concat(v, w); release(w); }
X else copy(v);
X push(v);
X break;
X
Xcase TEXT_CONV:
X if (F(XCON_NEXT) != Vnil) w= pop();
X u= pop();
X v= convert(u, Yes, Yes);
X release(u);
X if (F(XCON_NEXT) != Vnil) {
X v= concat(u= v, w);
X release(u);
X release(w);
X }
X push(v);
X break;
X
Xcase ELT_DIS: push(mk_elt()); break;
X
Xcase LIST_DIS:
X k= Nfields(F(LDIS_SEQ));
X v= pop();
X if (Is_rangebounds(v) && k == 1) {
X u= mk_range(R_LWB(v), R_UPB(v));
X release(v);
X }
X else {
X u= mk_elt();
X while (1) {
X if (Is_rangebounds(v))
X ins_range(R_LWB(v), R_UPB(v), &u);
X else
X insert(v, &u);
X release(v);
X if (--k <= 0)
X break;
X v= pop();
X }
X }
X push(u);
X break;
X
Xcase RANGE_BNDS: Dyop(mk_rbounds(v, w)); break;
X
Xcase TAB_DIS:
X u = mk_elt();
X k= Nfields(F(TDIS_SEQ));
X while ((k -= 2) >= 0) {
X w = pop(); v = pop();
X /* Should check for same key with different associate */
X replace(w, &u, v);
X release(v); release(w);
X }
X push(u);
X break;
X
X/* Tests */
X
Xcase NOT: report = !report; break;
X
X/* Quantifiers can be described as follows:
X Report X at first test which reports Y. If no test reports Y, report !X.
X type X Y
X SOME Yes Yes
X EACH No No
X NO No Yes. */
X
Xcase EACH_IN: X= Y= No; goto quant;
Xcase NO_IN: X= No; Y= Yes; goto quant;
Xcase SOME_IN: X= Y= Yes;
Xquant:
X w= pop(); v= pop();
X if (Is_compound(w) && report == Y) { report= X; Jump(); }
X else if (!in_ranger(v, &w)) { report= !X; Jump(); }
X else { push(v); push(w); break; }
X release(v); release(w);
X break;
X
Xcase MONPRD:
X v = pop();
X proposition(Vnil, F(MON_NAME), v, F(MON_FCT));
X release(v);
X break;
X
Xcase DYAPRD:
X w = pop(); v = pop();
X proposition(v, F(DYA_NAME), w, F(DYA_FCT));
X release(v); release(w);
X break;
X
Xcase LESS_THAN: Comp(<); break;
Xcase AT_MOST: Comp(<=); break;
Xcase GREATER_THAN: Comp(>); break;
Xcase AT_LEAST: Comp(>=); break;
Xcase EQUAL: Comp(==); break;
Xcase UNEQUAL: Comp(!=); break;
X
Xcase TAGlocal:
X push(ValOrLoc(v_local(F(TAG_NAME), F(TAG_ID)), local_loc(F(TAG_ID))));
X break;
X
Xcase TAGglobal:
X push(ValOrLoc(v_global(F(TAG_NAME)), global_loc(F(TAG_NAME))));
X break;
X
Xcase TAGrefinement:
X call_refinement(F(TAG_NAME), F(TAG_ID), Flagged());
X break;
X
Xcase TAGzerfun:
X formula(Vnil, F(TAG_NAME), Vnil, F(TAG_ID));
X break;
X
Xcase TAGzerprd:
X proposition(Vnil, F(TAG_NAME), Vnil, F(TAG_ID));
X break;
X
Xcase NUMBER:
X push(copy(F(NUM_VALUE)));
X break;
X
X#ifdef GFX
Xcase SPACE: Pop2(space_to); break;
Xcase LINE: Pop2(line_to); break;
Xcase CLEAR: clear_screen(); break;
X#endif
X
Xdefault:
X syserr(MESS(3513, "run: bad node type"));
X
X}
X/* >>>>>>>>>>>>>>>> */
X }
X v = Vnil;
X if (wantvalue && still_ok) v = pop();
X /* Unwind stack when stopped by error: */
X while (call_level != call_stop) ret();
X next= old_next;
X return v;
X}
X
X
X/* External interfaces: */
X
XVisible Procedure execthread(start) parsetree start; {
X VOID run(start, No);
X}
X
XVisible value evalthread(start) parsetree start; {
X return run(start, Yes);
X}
X
XHidden Procedure jumptoend() {
X while (Thread2(pc) != NilTree)
X pc= Thread2(pc);
X next= Thread(pc);
X}
END_OF_FILE
if test 8835 -ne `wc -c <'abc/bint3/i3int.c'`; then
echo shar: \"'abc/bint3/i3int.c'\" unpacked with wrong size!
fi
# end of 'abc/bint3/i3int.c'
fi
if test -f 'abc/ehdrs/tabl.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/ehdrs/tabl.h'\"
else
echo shar: Extracting \"'abc/ehdrs/tabl.h'\" \(2890 characters\)
sed "s/^X//" >'abc/ehdrs/tabl.h' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X/* Header file with grammar table structure. */
X
X/* WARNING: this file is constructed by 'mktable'. */
X/* If you want to change the grammar, see ../boot/README. */
X
Xtypedef char classelem;
Xtypedef classelem *classptr;
X
Xstruct classinfo {
X classptr c_class;
X classptr c_insert;
X classptr c_append;
X classptr c_join;
X};
X
X#define MAXCHILD 4
X
Xstruct table {
X string r_name;
X string r_repr[MAXCHILD+1];
X struct classinfo *r_class[MAXCHILD];
X node r_node;
X};
X
Xextern struct table *table;
X#define TABLEN 95
Xstruct lexinfo {
X string l_start;
X string l_continue;
X};
X
Xextern struct lexinfo *lextab;
X
X/* Symbols indexing grammar table */
X
X#define Rootsymbol 0
X#define Name 1
X#define Keyword 2
X#define Number 3
X#define Comment 4
X#define Text1 5
X#define Text2 6
X#define Operator 7
X#define Rawinput 8
X#define Collateral 9
X#define Compound 10
X#define Blocked 11
X#define Grouped 12
X#define Sel_expr 13
X#define List_or_table_display 14
X#define List_filler_series 15
X#define Table_filler_series 16
X#define Table_filler 17
X#define Text1_display 18
X#define Text1_plus 19
X#define Text2_display 20
X#define Text2_plus 21
X#define Conversion 22
X#define Multiple_address 23
X#define Compound_address 24
X#define Selection 25
X#define Behead 26
X#define Curtail 27
X#define Multiple_naming 28
X#define Compound_naming 29
X#define Else_kw 30
X#define Not 31
X#define Some_in 32
X#define Each_in 33
X#define No_in 34
X#define And 35
X#define Or 36
X#define And_kw 37
X#define Or_kw 38
X#define Cmt_cmd 39
X#define Short_comp 40
X#define Cmt_comp 41
X#define Long_comp 42
X#define Put 43
X#define Insert 44
X#define Remove 45
X#define Delete 46
X#define Share 47
X#define Write 48
X#define Read 49
X#define Read_raw 50
X#define Set 51
X#define Pass 52
X#define For 53
X#define Quit 54
X#define Succeed 55
X#define Fail 56
X#define Check 57
X#define If 58
X#define While 59
X#define Select 60
X#define Return 61
X#define Report 62
X#define Kw_plus 63
X#define Exp_plus 64
X#define Suite 65
X#define Test_suite 66
X#define Head 67
X#define Cmt_head 68
X#define Long_unit 69
X#define Short_unit 70
X#define Formal_return 71
X#define Formal_report 72
X#define Blocked_ff 73
X#define Grouped_ff 74
X#define Formal_kw_plus 75
X#define Formal_naming_plus 76
X#define Ref_join 77
X#define Refinement 78
X#define Keyword_list 79
X#define Unit_edit 80
X#define Target_edit 81
X#define Imm_cmd 82
X#define Edit_unit 83
X#define Colon 84
X#define Edit_address 85
X#define Equals 86
X#define Workspace_cmd 87
X#define Right 88
X#define Expression 89
X#define Raw_input 90
X#define Suggestion 91
X#define Sugghowname 92
X#define Optional 93
X#define Hole 94
X
X/* LEXICAL symbols */
X
X#define LEXICAL 95
X
X#define NAME 95
X#define KEYWORD 96
X#define NUMBER 97
X#define COMMENT 98
X#define TEXT1 99
X#define TEXT2 100
X#define OPERATOR 101
X#define RAWINPUT 102
X#define SUGGESTION 103
X#define SUGGHOWNAME 104
X
X#define NLEX 10
END_OF_FILE
if test 2890 -ne `wc -c <'abc/ehdrs/tabl.h'`; then
echo shar: \"'abc/ehdrs/tabl.h'\" unpacked with wrong size!
fi
# end of 'abc/ehdrs/tabl.h'
fi
if test -f 'abc/unix/u1keys.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/unix/u1keys.c'\"
else
echo shar: Extracting \"'abc/unix/u1keys.c'\" \(9064 characters\)
sed "s/^X//" >'abc/unix/u1keys.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "feat.h"
X#include "bmem.h"
X#include "getc.h"
X#include "keys.h"
X#include "args.h"
X
Xchar *getenv();
X
X/* struct tabent {int code; string name, def, rep;} in getc.h */
X
X/* Table of key definitions, filled by the following defaults
X and by reading definitions from a file.
X
X For the code field the following holds:
X code > 0:
X definitions for editor operations,
X new defs from keydefs file will be added in bed/e1getc.c,
X eliminating conflicting ones;
X code < 0:
X strings to be send to the terminal,
X any new defs from keydefs file overwrite the old ones
X
X Not all control characters can be freely used:
X ^Q and ^S are used by the Unix operating system
X for output flow control, and ^Z is used by BSD
X Unix systems for `job control'.
X Also note that ^H, ^I and ^M (and somtimes ^J) have their
X own keys on most keyboards and thus usually have a strong
X intuitive meaning.
X
X 'def' fields initialized with a string starting with '=' are termcap names,
X and are replaced by the corresponding termcap entry (NULL if none);
X
X 'def' fields initialized with a string starting with "&" are
X special characters for unix, and taken from tty structures.
X
X*/
X
XVisible struct tabent deftab[MAXDEFS] = {
X {IGNORE, S_IGNORE, NULL, NULL},
X /* Entry to ignore a key */
X
X /* if there are no or too few function or arrow keys: */
X {WIDEN, S_WIDEN, "\033w", "ESC w"},
X {EXTEND, S_EXTEND, "\033e", "ESC e"},
X {FIRST, S_FIRST, "\033f", "ESC f"},
X {LAST, S_LAST, "\033l", "ESC l"},
X {PREVIOUS, S_PREVIOUS, "\033p", "ESC p"},
X {NEXT, S_NEXT, "\033n", "ESC n"},
X {UPARROW, S_UPARROW, "\033k", "ESC k"},
X {DOWNARROW, S_DOWNARROW, "\033j", "ESC j"},
X {LEFTARROW, S_LEFTARROW, "\033,", "ESC ,"},
X /* , below < */
X {RITEARROW, S_RITEARROW, "\033.", "ESC ."},
X /* . below > */
X {UPLINE, S_UPLINE, "\033u", "ESC u"},
X {DOWNLINE, S_DOWNLINE, "\033d", "ESC d"},
X {COPY, S_COPY, "\033c", "ESC c"},
X /* in case ^C is interrupt */
X
X /* function and arrow keys as in termcap;
X * these must follow, because the first key in the helpblurb
X * will be the last one */
X {WIDEN, S_WIDEN, "=k1", "F1"},
X {EXTEND, S_EXTEND, "=k2", "F2"},
X {FIRST, S_FIRST, "=k3", "F3"},
X {LAST, S_LAST, "=k4", "F4"},
X {PREVIOUS, S_PREVIOUS, "=k5", "F5"},
X {NEXT, S_NEXT, "=k6", "F6"},
X {UPLINE, S_UPLINE, "=k7", "F7"},
X {DOWNLINE, S_DOWNLINE, "=k8", "F8"},
X {COPY, S_COPY, "=k9", "F9"},
X {UPARROW, S_UPARROW, "=ku", "^"},
X {DOWNARROW, S_DOWNARROW, "=kd", "v"},
X {LEFTARROW, S_LEFTARROW, "=kl", "<-"},
X {RITEARROW, S_RITEARROW, "=kr", "->"},
X#ifdef GOTOCURSOR
X {GOTO, S_GOTO, "\033g", "ESC g"},
X {GOTO, S_GOTO, "\007", "Ctrl-g"},
X#endif
X {ACCEPT, S_ACCEPT, "\011", "TAB"},
X {NEWLINE, S_NEWLINE, "\015", "RETURN"},
X {UNDO, S_UNDO, "\010", "BACKSP"},
X {REDO, S_REDO, "\025", "Ctrl-U"},
X {COPY, S_COPY, "\003", "Ctrl-C"},
X {DELETE, S_DELETE, "\004", "Ctrl-D"},
X#ifdef RECORDING
X {RECORD, S_RECORD, "\022", "Ctrl-R"},
X {PLAYBACK, S_PLAYBACK, "\020", "Ctrl-P"},
X#endif
X {REDRAW, S_LOOK, "\014", "Ctrl-L"},
X#ifdef HELPFUL
X {HELP, S_HELP, "\033?", "ESC ?"},
X {HELP, S_HELP, "=k0", "F10"},
X#endif
X {EXIT, S_EXIT, "\030", "Ctrl-X"},
X {EXIT, S_EXIT, "\033\033", "ESC ESC"},
X
X /* These three are taken from stty settings: */
X
X {CANCEL, S_INTERRUPT, "&\003", NULL},
X /* take from intr char */
X {SUSPEND, S_SUSPEND, "&\032", NULL},
X /* take from susp char */
X {UNDO, S_UNDO, "&\b", NULL},
X /* take from erase char */
X
X /* These two are not key defs but string-valued options: */
X
X {TERMINIT, S_TERMINIT, "=ks", NULL},
X {TERMDONE, S_TERMDONE, "=ke", NULL},
X {0, NULL, NULL, NULL}
X};
X
X/* Merge key definitions from termcap into the default table. */
X
XHidden Procedure readtermcap() {
X string tgetstr();
X char buffer[1024]; /* Constant dictated by termcap manual entry */
X static char area[1024];
X string endarea= area;
X string anentry;
X struct tabent *d, *last;
X
X switch (tgetent(buffer, getenv("TERM"))) {
X
X default:
X putmess(errfile, MESS(6800, "*** Bad tgetent() return value.\n"));
X /* Fall through */
X case -1:
X putmess(errfile, MESS(6801, "*** Can't read termcap.\n"));
X /* Fall through again */
X case 0:
X putmess(errfile, MESS(6802, "*** No description for your terminal.\n"));
X immexit(1);
X
X case 1:
X break;
X }
X
X last= deftab+ndefs;
X for (d= deftab; d < last; ++d) {
X if (d->def != NULL && d->def[0] == '=') {
X anentry= tgetstr(d->def+1, &endarea);
X if (anentry != NULL && anentry[0] != '\0') {
X undefine(d->code, anentry);
X d->def= anentry;
X }
X else
X d->def= d->rep= NULL;
X }
X }
X}
X
X/* Code to get the defaults for interrupt, suspend and undo/erase_char
X * from tty structs.
X */
X
X#ifndef KEYS
XHidden char *intr_char= NULL;
XHidden char *susp_char= NULL;
X#else
XVisible char *intr_char= NULL;
XVisible char *susp_char= NULL;
X#endif
X
XHidden char *erase_char= NULL;
X
X#ifndef TERMIO
X#include <sgtty.h>
X#else
X#include <termio.h>
X#endif
X#ifdef SIGNAL
X#include <signal.h>
X#endif
X
XHidden char *getspchars() {
X#ifndef TERMIO
X struct sgttyb sgbuf;
X#ifdef TIOCGETC
X struct tchars tcbuf;
X#endif
X static char str[6];
X
X if (gtty(0, &sgbuf) == 0) {
X if ((int)sgbuf.sg_erase != -1
X &&
X !(isprint(sgbuf.sg_erase) || sgbuf.sg_erase == ' ')
X ) {
X str[0]= sgbuf.sg_erase;
X erase_char= &str[0];
X }
X }
X#ifdef TIOCGETC
X if (ioctl(0, TIOCGETC, (char*)&tcbuf) == 0) {
X if ((int)tcbuf.t_intrc != -1) {
X str[2]= tcbuf.t_intrc;
X intr_char= &str[2];
X }
X }
X#endif
X#if defined(TIOCGLTC) && defined(SIGTSTP)
X {
X struct ltchars buf;
X SIGTYPE (*handler)();
X
X handler= signal(SIGTSTP, SIG_IGN);
X if (handler != SIG_IGN) {
X /* Shell has job control */
X signal(SIGTSTP, handler); /* Reset original handler */
X if (ioctl(0, TIOCGLTC, (char*) &buf) == 0 &&
X (int)buf.t_suspc != -1) {
X str[4]= buf.t_suspc;
X susp_char= &str[4];
X }
X }
X }
X#endif /* TIOCGLTC && SIGTSTP */
X#else /* TERMIO */
X struct termio sgbuf;
X static char str[6];
X
X if (ioctl(0, TCGETA, (char*) &sgbuf) == 0) {
X if ((int) sgbuf.c_cc[VERASE] != 0377
X &&
X !(isprint(sgbuf.c_cc[VERASE]))
X ) {
X str[0]= sgbuf.c_cc[VERASE];
X erase_char= &str[0];
X }
X if ((int) sgbuf.c_cc[VINTR] != 0377) {
X str[2]= sgbuf.c_cc[VINTR];
X intr_char= &str[2];
X }
X }
X /* TODO: susp_char (c_cc[VSWTCH]) #ifdef VSWTCH && SIGTSTP_EQUIVALENT */
X#endif /* TERMIO */
X}
X
XVisible bool is_spchar(c) char c; {
X if (intr_char != NULL && *intr_char == c)
X return Yes;
X else if (susp_char != NULL && *susp_char == c)
X return Yes;
X return No;
X}
X
XHidden Procedure sig_undef(c) char c; {
X struct tabent *d, *last= deftab+ndefs;
X string p;
X
X for (d= deftab; d < last; ++d) {
X if (d->code > 0 && d->def != NULL) {
X for (p= d->def; *p != '\0'; ++p) {
X if (*p == c) {
X d->def= d->rep= NULL;
X break;
X }
X }
X }
X }
X}
X
X/* The following is needed for the helpblurb */
X
X#ifndef KEYS
XHidden string reprchar(c) int c; {
X#else
XVisible string reprchar(c) int c; {
X#endif /* KEYS */
X
X static char str[20];
X
X c&= 0377;
X
X if ('\000' <= c && c < '\040') { /* control char */
X switch (c) {
X case '\010':
X return "BACKSP";
X case '\011':
X return "TAB";
X case '\012':
X return "LINEFEED";
X case '\015':
X return "RETURN";
X case '\033':
X return "ESC";
X default:
X sprintf(str, "Ctrl-%c", c|0100);
X return str;
X }
X }
X else if (c == '\040') { /* space */
X return "SPACE";
X }
X else if ('\041' <= c && c < '\177') { /* printable char */
X str[0]= c; str[1]= '\0';
X return str;
X }
X else if (c == '\177') { /* delete */
X return "DEL";
X }
X else if (c == 0200) { /* conv null char */
X return "NULL";
X }
X else {
X sprintf(str, "\\%03o", c); /* octal value */
X return str;
X }
X}
X
XHidden Procedure get_special_chars() {
X string anentry;
X struct tabent *d, *last;
X
X getspchars();
X last= deftab+ndefs;
X for (d= deftab; d < last; ++d) {
X if (d->def != NULL && d->def[0] == '&') {
X if (d->def[1] == '\003') /* interrupt */
X anentry= intr_char;
X else if (d->def[1] == '\b') /* undo/backspace */
X anentry= erase_char;
X else if (d->def[1] == '\032') /* suspend */
X anentry= susp_char;
X else
X anentry= NULL;
X if (anentry != NULL && anentry[0] != '\0') {
X if (anentry == erase_char)
X undefine(d->code, anentry);
X else
X sig_undef(anentry[0]);
X d->def= anentry;
X d->rep= (string) savestr(reprchar(anentry[0]));
X#ifdef MEMTRACE
X fixmem((ptr) d->rep);
X#endif
X }
X else
X d->def= d->rep= NULL;
X }
X }
X}
X
XVisible Procedure initkeys() {
X countdefs();
X#ifdef DUMPKEYS
X if (kflag)
X dumpkeys("before termcap");
X#endif
X readtermcap();
X#ifdef DUMPKEYS
X if (kflag)
X dumpkeys("after termcap");
X#endif
X get_special_chars();
X#ifdef DUMPKEYS
X if (kflag)
X dumpkeys("after special chars");
X#endif
X rd_keysfile();
X}
X
X#ifdef UNUSED
X
XVisible int kbchar() {
X/* Strip high bit from input characters (matters only on PWB systems?) */
X return getchar() & 0177;
X}
X
X#endif
X
XVisible int cvchar(c) int c; {
X#ifdef KEYS
X if (c == 0)
X return 0200;
X#endif
X return c;
X}
END_OF_FILE
if test 9064 -ne `wc -c <'abc/unix/u1keys.c'`; then
echo shar: \"'abc/unix/u1keys.c'\" unpacked with wrong size!
fi
# end of 'abc/unix/u1keys.c'
fi
echo shar: End of archive 15 \(of 25\).
cp /dev/null ark15isdone
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