v23i086: ABC interactive programming environment, Part07/25
Rich Salz
rsalz at bbn.com
Tue Dec 18 05:36:26 AEST 1990
Submitted-by: Steven Pemberton <steven at cwi.nl>
Posting-number: Volume 23, Issue 86
Archive-name: abc/part07
#! /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/abc.hlp abc/bint2/i2gen.c abc/bint3/i3bws.c
# abc/ex/try/position.abc
# Wrapped by rsalz at litchi.bbn.com on Mon Dec 17 13:27:57 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 7 (of 25)."'
if test -f 'abc/abc.hlp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/abc.hlp'\"
else
echo shar: Extracting \"'abc/abc.hlp'\" \(20503 characters\)
sed "s/^X//" >'abc/abc.hlp' <<'END_OF_FILE'
XSUMMARY OF SPECIAL ACTIONS
X
X :name Visit how-to called 'name'
X : Visit last how-to refered to
X :: Display headings of how-to's in this workspace
X
X =name Visit contents of location
X = Visit last location visited
X == Display names of permament locations in this workspace
X
X >name Visit workspace 'name'
X > Visit last workspace visited
X >> Display list of workspace names
X
X QUIT Leave ABC
X
XSUMMARY OF EDITING OPERATIONS
X
X Name Default Keys* Short description
X
X Accept [TAB] Accept suggestion, focus to hole or end of line
X Return [RETURN] Add line or decrease indentation
X
X Widen f1, [ESC] w Widen focus
X Extend f2, [ESC] e Extend focus (usually to the right)
X First f3, [ESC] f Move focus to first contained item
X Last f4, [ESC] l Move focus to last contained item
X
X Previous f5, [ESC] p Move focus to previous item
X Next f6, [ESC] n Move focus to next item
X Upline f7, [ESC] u Move focus to whole line above
X Downline f8, [ESC] d Move focus to whole line below
X
X Up ^, [ESC] U Make new hole, move up
X Down v, [ESC] D Make new hole, move down
X Left <-, [ESC] , Make new hole, move left
X Right ->, [ESC] . Make new hole, move right
X
X Goto [ctrl-G], mouseclick New focus at cursor position
X
X Undo [BACKSPACE] Undo effect of last key pressed (may be repeated)
X Redo [ctrl-U] Redo last UNDOne key (may be repeated)
X
X Copy f9, [ctrl-C], [ESC]c Copy buffer to hole, or focus to buffer
X Delete [ctrl-D] Delete contents of focus (to buffer if empty)
X
X Record [ctrl-R] Start/stop recording keystrokes
X Play [ctrl-P] Play back recorded keystrokes
X
X Look [ctrl-L] Redisplay screen
X Help f10, [ESC]? Print summary of editing operations
X
X Exit [ctrl-X] Finish changes or execute command
X Interrupt (as set by 'stty')Interrupt command execution
X Suspend (as set by 'stty') Suspend ABC (only for shell with job control)
X
X * Notes:
X
X [Ctrl-D] means: hold the [CTRL] (or [CONTROL]) key down while pressing d.
X [ESC] w means: press the [ESC] key first, then w.
X
XABC QUICK REFERENCE
X
X COMMANDS
X
X WRITE expr Write to screen;
X / before or after expr gives new line
X READ address EG expr Read expression from terminal to address;
X expr is example
X READ address RAW Read line of text
X PUT expr IN address Put value of expr in address
X SET RANDOM expr Start random sequence for random and choice
X REMOVE expr FROM list Remove one element from list
X INSERT expr IN list Insert in right place
X DELETE address Delete permanent location or table entry
X PASS Do nothing
X KEYWORD expr KEYWORD ... Execute user-defined command
X KEYWORD Execute refined command
X
X CHECK test Check test and stop if it fails
X IF test: If test succeeds, execute commands;
X commands no ELSE allowed
X SELECT: Select one alternative:
X test: commands try each test in order
X ... (one must succeed;
X test: commands the last test may be ELSE)
X WHILE test: As long as test succeeds
X commands execute commands
X FOR name,... IN train: Take each element of train in turn
X commands
X
X HOW-TO's
X
X HOW TO KEYWORD ...: Define new command KEYWORD ...
X commands
X HOW TO RETURN f: Define new function f with no arguments
X commands (returns a value)
X HOW TO RETURN f x: Define new function f with one argument
X commands
X HOW TO RETURN x f y: Define new function f with two arguments
X commands
X HOW TO REPORT pr: Define new predicate pr with no arguments
X commands (succeeds/fails)
X HOW TO REPORT pr x: Define new predicate pr with one argument
X commands
X HOW TO REPORT x pr y: Define new predicate pr with two arguments
X commands
X
X SHARE name,... Share permanent locations
X (before commands of how-to)
X
X Refinements (after the commands of a how-to)
X
X KEYWORD : commands Define command refinement
X name: commands Define expression- or test-refinement
X
X Terminating commands
X
X QUIT Leave command how-to or command refinement,
X or leave ABC
X RETURN expr Leave function how-to or expression refinement,
X return value of expr
X REPORT test Leave predicate how-to or test-refinement,
X report outcome of test
X SUCCEED The same, report success
X FAIL The same, report failure
X
X EXPRESSIONS AND ADDRESSES
X
X 666, 3.14, 3.14e-9 Exact constants
X
X expr,expr,... Compound
X name,name,... Naming (may also be used as address)
X
X text at p "ABCD"@2 = "BCD" (also address)
X text|q "ABCD"|3 = "ABC" (also address)
X text at p|q "ABCD"@2|1 = "BCD"|1 = "B"
X
X table[expr] Table selection (also address)
X
X "Jan", 'Feb', 'Won''t!' Textual displays (empty: "" or '')
X "value = `expr`;" Conversion of expr to text
X
X {1; 2; 2; ...} List display (empty: {})
X {1..9; ...}, {"a".."z"; ...} List of consecutive values
X
X {["Jan"]: 1; ["Feb"]: 2; ...} Table display (empty: {})
X
X f, f x, x f y Result of function f (no permanent effects)
X name Result of refinement (no permanent effects)
X
X TESTS
X
X x < y, x <= y, x >= y, x > y Order tests
X x = y, x <> y (<> means 'not equals')
X 0 <= d < 10
X
X pr, pr x, x pr y Outcome of predicate pr (no permanent effects)
X name Outcome of refinement (no permanent effects)
X
X test AND test AND ... Fails as soon as one of the tests fails
X test OR test OR ... Succeeds as soon as one of the tests succeeds
X NOT test
X
X SOME name,... IN train HAS test
X Sets name, ... on success
X EACH name,... IN train HAS test
X Sets name, ... on failure
X NO name,... IN train HAS test
X Sets name, ... on failure
X
X PREDEFINED FUNCTIONS AND PREDICATES
X
X Functions and predicates on numbers
X
X ~x Approximate value of x
X exactly x Exact value of x
X exact x Test if x is exact
X +x, x+y, x-y, -x, x*y, x/y Plain arithmetic
X x**y x raised to the power y
X root x, n root x Square root, n-th root
X abs x, sign x Absolute value, sign (= -1, 0, or +1)
X round x, floor x, ceiling x Rounded to whole number
X n round x x rounded to n digits after decimal point
X a mod n Remainder of a on division by n
X */x Numerator of exact number x
X /*x Denominator
X random Random approximate number r, 0 <= r < 1
X e, exp x Base of natural logarithm, exponential function
X log x, b log x Natural logarithm, logarithm to the base b
X pi, sin x, cos x, tan x, arctan x
X Trigonometric functions, with x in radians
X angle (x, y), radius (x, y) Angle of and radius to point (x, y)
X c sin x, c cos x, c tan x Similar, with the circle divided into c parts
X c arctan x, c angle (x, y) (e.g. 360 for degrees)
X now e.g. (1999, 12, 31, 23, 59, 59.999)
X
X Functions on texts
X
X t^u t and u joined into one text
X t^^n t repeated n times
X lower t lower "aBc" = "abc"
X upper t upper "aBc" = "ABC"
X stripped t Strip leading and trailing spaces from t
X split t Split text t into words
X
X Function on tables
X
X keys table List of all keys in table
X
X Functions and predicates on trains
X
X #train Number of elements in train
X e#train Number of elements equal to e
X e in train, e not.in train Test for presence or absence
X min train Smallest element of train
X e min train Smallest element larger than e
X max train, e max train Largest element
X train item n n-th element
X choice train Random element
X
X Functions on all types
X
X x<<n x converted to text, aligned left in width n
X x><n The same, centred
X x>>n The same, aligned right
X
X THE CHARACTERS
X
X !"#$%&'()*+,-./ This is the order of all characters
X 0123456789:;<=>? that may occur in a text.
X @ABCDEFGHIJKLMNO (The first is a space.)
X PQRSTUVWXYZ[\]^_
X `abcdefghijklmno
X pqrstuvwxyz{|}~
X
XABC MANUAL
X
XNAME
X abc - ABC interpreter & environment
X abckeys - change key bindings for 'abc'
X
XSYNOPSIS
X abc [workspace and editor options] [file ...]
X abc [workspace and task options]
X abckeys
X
XDESCRIPTION
X Without options or files, the ABC interpreter is started, using the ABC
X editor, in the last workspace used or in workspace 'first' if this is
X your first abc session. A workspace is kept as a group of files in a
X directory, with separate files for each how-to and location. The
X workspace directories themselves are kept by default in the directory
X $HOME/abc. On non-Unix machines, $HOME is the disk you are working on.
X
X Workspace Options:
X
X -W dir use group of workspaces in 'dir' instead of $HOME/abc.
X
X -w name start in workspace 'name' instead of last workspace used.
X
X -w path use 'path' as workspace (no -W option allowed).
X
X Editor option:
X
X -e Use $EDITOR as editor to edit definitions, instead of ABC
X editor (Unix only).
X
X file ... Read commands from file(s) instead of from standard input;
X input for READ commands is taken from standard input. If a
X file is called '-' and standard input is the keyboard, the
X ABC system is started up interactively for that entry.
X
X Special tasks:
X
X -i tab Fill table 'tab' with text lines from standard input
X
X -o tab Write text lines from table 'tab' to standard output
X
X -l List the how-to's in workspace on standard output
X
X -r Recover a workspace when its index is lost: useful after a
X machine crash if the ABC internal administration files
X didn't get written out.
X
X -R Recover the index of a group of workspaces
X
XUSAGE
X (This is necessarily a very brief description; see 'The ABC Programmer's
X Handbook' for full details.)
X
X Use 'QUIT' to finish an ABC session.
X
X When ABC starts up interactively, it displays a prompt and awaits input.
X
X TYPING AND SUGGESTIONS: as you type, the system tries to suggest a
X possible continuation for what you have typed; to accept the suggestion,
X press [accept] (by default this is bound to the [TAB] key; type '?' to
X find out the bindings for the keyboard you are using). If you don't want
X to accept the suggestion, just carry on typing (you can always type
X character for character, ignoring the suggestions). Usually the system
X knows where a letter must be capital and where not, and you usually don't
X have to use the shift key; however, in the few places where both a
X lower-case and an upper-case letter would be legal (for instance for
X AND), you have to type the letter upper-case.
X
X When you type a control command, like WHILE, the system provides
X indentation automatically for the body of the command; to reduce the
X indentation one level, type [return].
X
X CORRECTING AND EDITING: the [undo] key (by default bound to backspace)
X undoes the last key you typed. Repeatedly typing it undoes more and
X more, up to a certain maximum number of keypresses.
X
X To correct other parts, you must put the 'focus' onto the part you want
X to change. The focus is displayed by underlining or reverse video.
X [Widen] and [extend] make the focus larger, [first] and [last] make it
X smaller.
X
X [Delete] deletes the contents of the focus.
X
X [Copy] copies the contents of the focus to a buffer, or if the focus is
X not focussed on anything, copies the contents of the buffer back to where
X you are positioned.
X
X MOVING THE FOCUS: [Upline] and [downline] focus on one line above or
X below. [Previous] and [next] move the focus left and right. [Up],
X [down], [left], and [right] move an empty focus around. [Goto] widens
X the focus to the largest thing at the current position.
X
X OTHER OPERATIONS: [Look] redraws the screen; [record] records all
X keystrokes until the next time you press [record] - [play] replays them.
X [Redo] redoes the last key(s) undone; [interrupt] interrupts a running
X command.
X
X WORKSPACES: To create a new workspace, or go to an existing workspace,
X type '>name'. To go to the last workspace you were in, type a single
X '>'. To get a list of workspace names, type '>>'.
X
X HOW-TO's: To create a new how-to, just type the first line of the how-to.
X This creates the new how-to, and allows you to type the body. Use [exit]
X to finish it (by default [ESC][ESC]).
X
X To visit a how-to, type a colon, followed by the name of the how-to.
X Again, use [exit] to exit. To visit the last how-to again, or the last
X how-to you got an error message for, type a single ':'. To get a list of
X the how-to's in this workspace, type '::'.
X
X To edit a location, type a '=' followed by the name of the location. To
X re-edit it, type a single '='. To get a list of the locations in the
X workspace, type '=='.
X
XKEY BINDINGS
X The binding of editing operations like [accept] to keys may be different
X for your keyboard; type a '?' at the prompt to find out what the bindings
X are for your keyboard.
X To redefine the keys used for editor operations, run 'abckeys'. This
X produces a private key definitions file. You will be given instructions
X on how to use it.
X Keys labeled f1...f8 are function keys. On Unix, the way to type these is
X terminal-dependent. The codes they send must be defined by the termcap
X entry for your terminal.
X If a terminal has arrow keys which transmit codes to the computer, these
X should be used for Up, Down, Left and Right. Again, the termcap entry
X must define the codes.
X The Goto operation is of most use if the cursor can be moved locally at
X the terminal, or if the terminal has a mouse; the Goto operation will
X sense the terminal for the cursor or mouse position. On Unix, we use two
X extra non-standard termcap capabilities for this: 'sp' which gives the
X string that must be sent to the terminal to sense the cursor position,
X and 'cp' which defines the format of the reply (in the same format as
X other cursor-addressing strings in termcap). If your terminal's mouse-
X click sends the position of the click automatically, just set 'sp' to the
X empty string. See termcap(5) for more details.
X
XFILES
X $HOME/copybuf.abc copy buffer between sessions
X $HOME/abc/wsgroup.abc table mapping workspace names to directory names
X $HOME/abc/abckeys_$TERM private key definitions file (Unix only)
X $HOME/abc/abc.key private key definitions file (non-Unix)
X position.abc focus position of edited how-to's in workspace
X perm.abc table mapping object names to file names
X suggest.abc suggestion list for user-defined commands
X types.abc table with codes for typechecking between how-to's
X *.cmd command how-to's in this workspace
X *.zfd, *.mfd, *.dfd function how-to's in this workspace
X *.zpd, *.mpd, *.dpd predicate how-to's in this workspace
X *.cts permanent locations in this workspace
X abc.msg messages file, used for errors (not on Macintosh)
X abc.hlp helpfile with this text (MacABC.help on Macintosh)
X
X The latter two are searched for first in your startup directory, then in
X $HOME/abc, and finally, on Unix, in a directory determined by the
X installer of ABC. On the IBM PC and Atari ST the directories in your
X $PATH are used in the last stage (if you have a hard disk place these
X files in the workspaces directory abc).
X
XATARI ST IMPLEMENTATION
X There are four files supplied: the program abc.tos itself, abckeys.tos
X for changing your key bindings, the help file abc.hlp, and the error
X messages file abc.msg. (See FILES above.)
X If you start ABC up from the desktop, and you want to use the options
X given above, like -w, you should rename abc.tos to abc.ttp. There is an
X additional facility for redirecting input and output: the parameter
X >outfile redirects all output from ABC to the file called outfile, and
X similarly <infile takes its input from the file called infile.
X
XIBM PC IMPLEMENTATION
X There are four files for running ABC, the program abc.exe itself,
X abckeys.exe for changing your key bindings, the help file abc.hlp, and
X the error messages file abc.msg. (See FILES above.)
X If your screen size is non-standard, or your machine is not 100% BIOS
X compatible (which is unusal these days), you can specify the screen-size,
X and whether to use the BIOS or ANSI.SYS for output, by typing after the
X A> prompt, before you start ABC up, one of the following:
X SET SCREEN=ANSI lines cols
X SET SCREEN=BIOS lines cols
X If you are going to use ANSI.SYS, be sure you have the line
X DEVICE=ANSI.SYS
X in your CONFIG.SYS file. Consult the DOS manual for further details.
X
XAPPLE MACINTOSH IMPLEMENTATION
X There are three files supplied: MacABC, the application itself,
X MacABC.help, the help file, and MacABC.doc, a MacWrite document
X containing a variant of this text. The help file should be in the same
X folder as MacABC, or in your System Folder.
X MacABC runs in a single window. You'll notice that most operations are
X menu entries, as well as being possible from the keyboard. You can start
X ABC up by double-clicking the MacABC icon in which case you start up in
X the last workspace used, or by double-clicking on any icon in a
X workspace, in which case you start in that workspace. In this latter
X case, if the filename of the icon you clicked on ends in .cmd, that how-
X to is executed, but the how-to may not have any parameters.
X Instead of the special option flags mentioned above, most of the tasks,
X like recovering a workspace, can be done from the File menu.
X * Notes for Macintosh guru's:
X The messages are STR# resources in MacABC; you must use a resource editor
X to change them.
X MacABC uses Monaco 9 for the screen, and Courier 10 for printing. You
X can change them with ResEdit, by editing the resource with type Conf and
X ID 0. The horizontal and vertical window-size and the window-title can
X also be adapted there. To facilitate this, first Paste the TMPL resource
X with ID 5189 named Conf from MacABC to (a copy of) ResEdit. But beware,
X MacABC only works properly with Fixed-width Fonts like Monaco and
X Courier.
X
XSEE ALSO
X Leo Geurts, Lambert Meertens and Steven Pemberton, The ABC Programmer's
X Handbook, Prentice-Hall, Englewood Cliffs, New Jersey, 1989,
X ISBN 0-13-000027-2.
X Steven Pemberton, An Alternative Simple Language and Environment for PCs,
X IEEE Software, Vol. 4, No. 1, January 1987, pp. 56-64.
X The ABC Newsletter. Available free from CWI.
X
XAUTHORS
X Frank van Dijk, Leo Geurts, Timo Krijnen, Lambert Meertens, Steven
X Pemberton, Guido van Rossum.
X
XADDRESS
X ABC Distribution, CWI/AA, Postbox 4079, 1009 AB Amsterdam, The
X Netherlands.
X E-mail: 'abc at cwi.nl'.
X
END_OF_FILE
if test 20503 -ne `wc -c <'abc/abc.hlp'`; then
echo shar: \"'abc/abc.hlp'\" unpacked with wrong size!
fi
# end of 'abc/abc.hlp'
fi
if test -f 'abc/bint2/i2gen.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint2/i2gen.c'\"
else
echo shar: Extracting \"'abc/bint2/i2gen.c'\" \(19819 characters\)
sed "s/^X//" >'abc/bint2/i2gen.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* Code generation */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "i2nod.h"
X#include "i2gen.h" /* Must be after i2nod.h */
X#include "i2par.h"
X#include "i3env.h"
X#include "i3int.h"
X#include "i3sou.h"
X
XVisible Procedure fix_nodes(pt, code) parsetree *pt; parsetree *code; {
X context c; value *setup(), *su;
X sv_context(&c);
X curline= *pt; curlino= one;
X su= setup(*pt);
X if (su != Pnil) analyze(*pt, su);
X if (still_ok) no_mysteries();
X curline= *pt; curlino= one;
X inithreads();
X fix(pt, su ? 'x' : 'v');
X endthreads(code);
X cleanup();
X#ifdef TYPE_CHECK
X if (cntxt != In_wsgroup && cntxt != In_prmnv)
X type_check(*pt);
X#endif
X set_context(&c);
X}
X
XHidden Procedure no_mysteries() {
X value names= keys(mysteries);
X int i, n= length(names);
X for (i= 1; i <= n; ++i) {
X value name= thof(i, names);
X value f;
X if (!is_zerfun(name, &f)) {
X value *aa= envassoc(mysteries, name);
X if (locals != Vnil)
X e_replace(*aa, &locals, name);
X else
X e_replace(zero, &globals, name);
X }
X }
X release(names);
X}
X
X/* ******************************************************************** */
X
X/* Utilities used by threading. */
X
X/* A 'threaded tree' is, in our case, a fixed(*) parse tree with extra links
X that are used by the interpreter to determine the execution order.
X __________
X (*) 'Fixed' means: processed by 'fix_nodes', which removes UNPARSED
X nodes and distinguishes TAG nodes into local, global tags etc.
X fix_nodes also creates the threads, but this is accidental, not
X essential. For UNPARSED nodes, the threads are actually laid
X in a second pass through the subtree that was UNPARSED.
X __________
X
X A small example: the parse tree for the expression 'a+b*c' looks like
X
X (DYOP,
X (TAGlocal, "a"),
X "+",
X (DYOP,
X (TAGlocal, "b"),
X "*",
X (TAGlocal, "c"))).
X
X The required execution order is here:
X
X 1) (TAGlocal, "a")
X 2) (TAGlocal, "b")
X 3) (TAGlocal, "c")
X 4) (DYOP, ..., "*", ...)
X 5) (DYOP, ..., "+", ...)
X
X Of course, the result of each operation (if it has a result) is pushed
X on a stack, and the operands are popped from this same stack. Think of
X reversed polish notation (well-known by owners of HP pocket calculators).
X
X The 'threads' are explicit links from each node to its successor in this
X execution order. Conditional operations like IF and AND have two threads,
X one for success and one for failure. Loops can be made by having the
X thread from the last node of the loop body point to the head of the loop.
X
X Threading expressions, locations and simple-commands is easy: recursively
X thread each of the subtrees, then lay a thread from the last threaded
X to the current node. Nodes occurring in a 'location' context are
X marked, so that the interpreter knows when to push a 'location' on
X the stack.
X
X Tests and looping commands cause most of the complexity of the threading
X utilities. The basic technique is 'backpatching'.
X Nodes that need a conditional forward jump are chained together in a
X linked list, and when their destination is reached, all nodes in the
X chain get its 'address' patched into their secondary thread. There is
X one such chain, called 'bpchain', which at all times contains those nodes
X whose secondary destination would be the next generated instruction.
X This is used by IF, WHILE, test-suites, AND and OR.
X
X To generate a loop, both this chain and the last normal instruction
X (if any) are diverted to the node where the loop continues.
X
X For test-suites, we also need to be capable of jumping unconditionally
X forward (over the remainder of the SELECT-command). This is done by
X saving both the backpatch chain and the last node visited, and restoring
X them after the remainder has been processed.
X*/
X
X/* Implementation tricks: in order not to show circular lists to 'release',
X parse tree nodes are generated as compounds where there is room for two
X more fields than their length indicates.
X*/
X
X#define Flag (MkSmallInt(1))
X /* Flag used to indicate Location or TestRefinement node */
X
XHidden parsetree start; /* First instruction. Picked up by endthreads() */
X
XHidden parsetree last; /* Last visited node */
X
XHidden parsetree bpchain; /* Backpatch chain for conditional goto's */
XHidden parsetree *wanthere; /* Chain of requests to return next tree */
X
X#ifdef MSDOS
X#ifdef M_I86LM
X
X/* Patch for MSC 3.0 large model bugs... */
XVisible parsetree *_thread(p) parsetree p; {
X return &_Thread(p);
X}
X
XVisible parsetree *_thread2(p) parsetree p; {
X return &_Thread2(p);
X}
X
X#endif /* M_I86LM */
X#endif /* MSDOS */
X
X/* Start threading */
X
XHidden Procedure inithreads() {
X bpchain= NilTree;
X wanthere= 0;
X last= NilTree;
X here(&start);
X}
X
X/* Finish threading */
X
XHidden Procedure endthreads(code) parsetree *code; {
X jumpto(Stop);
X if (!still_ok) start= NilTree;
X *code= start;
X}
X
X
X/* Fill 't' as secondary thread for all nodes in the backpatch chain,
X leaving the chain empty. */
X
XHidden Procedure backpatch(t) parsetree t; {
X parsetree u;
X while (bpchain != NilTree) {
X u= Thread2(bpchain);
X Thread2(bpchain)= t;
X bpchain= u;
X }
X}
X
XVisible Procedure jumpto(t) parsetree t; {
X parsetree u;
X if (!still_ok) return;
X while (wanthere != 0) {
X u= *wanthere;
X *wanthere= t;
X wanthere= (parsetree*)u;
X }
X while (last != NilTree) {
X u= Thread(last);
X Thread(last)= t;
X last= u;
X }
X backpatch(t);
X}
X
XHidden parsetree seterr(n) int n; {
X return (parsetree)MkSmallInt(n);
X}
X
X/* Visit node 't', and set its secondary thread to 't2'. */
X
XHidden Procedure visit2(t, t2) parsetree t, t2; {
X if (!still_ok) return;
X jumpto(t);
X Thread2(t)= t2;
X Thread(t)= NilTree;
X last= t;
X}
X
X/* Visit node 't' */
X
XHidden Procedure visit(t) parsetree t; {
X visit2(t, NilTree);
X}
X
X/* Visit node 't' and flag it as a location (or test-refinement). */
X
XHidden Procedure lvisit(t) parsetree t; {
X visit2(t, Flag);
X}
X
X#ifdef NOT_USED
XHidden Procedure jumphere(t) parsetree t; {
X Thread(t)= last;
X last= t;
X}
X#endif
X
X/* Add node 't' to the backpatch chain. */
X
XHidden Procedure jump2here(t) parsetree t; {
X if (!still_ok) return;
X Thread2(t)= bpchain;
X bpchain= t;
X}
X
XHidden Procedure here(pl) parsetree *pl; {
X if (!still_ok) return;
X *pl= (parsetree) wanthere;
X wanthere= pl;
X}
X
XVisible Procedure hold(pl) struct state *pl; {
X if (!still_ok) return;
X pl->h_last= last; pl->h_bpchain= bpchain; pl->h_wanthere= wanthere;
X last= bpchain= NilTree; wanthere= 0;
X}
X
XVisible Procedure let_go(pl) struct state *pl; {
X parsetree p, *w;
X if (!still_ok) return;
X if (last != NilTree) {
X for (p= last; Thread(p) != NilTree; p= Thread(p))
X ;
X Thread(p)= pl->h_last;
X }
X else last= pl->h_last;
X if (bpchain != NilTree) {
X for (p= bpchain; Thread2(p) != NilTree; p= Thread2(p))
X ;
X Thread2(p)= pl->h_bpchain;
X }
X else bpchain= pl->h_bpchain;
X if (wanthere) {
X for (w= wanthere; *w != 0; w= (parsetree*) *w)
X ;
X *w= (parsetree) pl->h_wanthere;
X }
X else wanthere= pl->h_wanthere;
X}
X
XHidden bool reachable() {
X return last != NilTree || bpchain != NilTree || wanthere != 0;
X}
X
X
X/* ******************************************************************** */
X/* *********************** code generation **************************** */
X/* ******************************************************************** */
X
XForward bool is_variable();
XForward bool is_cmd_ref();
XForward value copydef();
X
XVisible Procedure fix(pt, flag) parsetree *pt; char flag; {
X struct state st; value v, function;
X parsetree t, l1= NilTree, w;
X typenode nt, nt1; string s; char c; int n, k, len;
X
X t= *pt;
X if (!Is_node(t) || !still_ok) return;
X nt= Nodetype(t);
X if (nt < 0 || nt >= NTYPES) syserr(MESS(2200, "fix bad tree"));
X s= gentab[nt];
X if (s == NULL) return;
X n= First_fieldnr;
X if (flag == 'x') curline= t;
X while ((c= *s++) != '\0' && still_ok) {
X switch (c) {
X case '0':
X case '1':
X case '2':
X case '3':
X case '4':
X case '5':
X case '6':
X case '7':
X case '8':
X case '9':
X n= (c - '0') + First_fieldnr;
X break;
X case 'c':
X v= *Branch(t, n);
X if (v != Vnil) {
X len= Nfields(v);
X for (k= 0; k < len; ++k)
X fix(Field(v, k), flag);
X }
X ++n;
X break;
X case '#':
X curlino= *Branch(t, n);
X ++n;
X break;
X case 'g':
X case 'h':
X ++n;
X break;
X case 'a':
X case 'l':
X if (flag == 'v' || flag == 't')
X c= flag;
X /* Fall through */
X case 'b':
X case 't':
X case 'u':
X case 'v':
X case 'x':
X fix(Branch(t, n), c);
X ++n;
X break;
X case 'f':
X f_fpr_formals(*Branch(t, n));
X ++n;
X break;
X
X case ':': /* code for WHILE loop */
X curlino= *Branch(t, WHL_LINO);
X here(&l1);
X visit(t);
X fix(Branch(t, WHL_TEST), 't');
X v= *Branch(t, WHL_SUITE);
X if (nodetype((parsetree) v) != COLON_NODE)
X syserr(BAD_WHILE);
X visit(v);
X fix(Branch(v, COLON_SUITE), 'x');
X jumpto(l1);
X jump2here(v);
X break;
X
X case ';': /* code for TEST_SUITE */
X if (*Branch(t, TSUI_TEST) == NilTree) {
X sk_tsuite_comment(t, &w);
X if (w != NilTree)
X fix(&w, 'x');
X break;
X }
X curlino= *Branch(t, TSUI_LINO);
X visit(t);
X curline= *Branch(t, TSUI_TEST);
X fix(Branch(t, TSUI_TEST), 't');
X v= *Branch(t, TSUI_SUITE);
X if (nodetype((parsetree) v) != COLON_NODE)
X syserr(BAD_TESTSUITE);
X visit2(v, seterr(1));
X fix(Branch(v, COLON_SUITE), 'x');
X hold(&st);
X sk_tsuite_comment(t, &w);
X if (w != NilTree) {
X jump2here(v);
X fix(&w, 'x');
X }
X let_go(&st);
X break;
X
X case '?':
X if (flag == 'v')
X f_eunparsed(pt);
X else if (flag == 't')
X f_cunparsed(pt);
X else
X syserr(MESS(2201, "fix unparsed with bad flag"));
X fix(pt, flag);
X break;
X case '@':
X f_trim_target(t, '@');
X break;
X case '|':
X f_trim_target(t, '|');
X break;
X case 'C':
X v= *Branch(t, REL_LEFT);
X nt1= nodetype((parsetree) v);
X if (Comparison(nt1))
X jump2here(v);
X break;
X case 'D':
X v= (value)*Branch(t, DYA_NAME);
X if (!is_dyafun(v, &function))
X fixerrV(NO_DEFINITION, v);
X else
X *Branch(t, DYA_FCT)= copydef(function);
X break;
X case 'E':
X v= (value)*Branch(t, DYA_NAME);
X if (!is_dyaprd(v, &function))
X fixerrV(NO_DEFINITION, v);
X else
X *Branch(t, DYA_FCT)= copydef(function);
X break;
X case 'F':
X if (*Branch(t, NUM_VALUE) == Vnil) {
X *Branch(t, NUM_VALUE)=
X numconst(*Branch(t, NUM_TEXT));
X }
X break;
X case 'G':
X jumpto(l1);
X break;
X case 'H':
X here(&l1);
X break;
X case 'I':
X if (*Branch(t, n) == NilTree)
X break;
X /* Else fall through */
X case 'J':
X jump2here(t);
X break;
X case 'K':
X hold(&st);
X break;
X case 'L':
X let_go(&st);
X break;
X case 'M':
X v= (value)*Branch(t, MON_NAME);
X if (is_variable(v) || !is_monfun(v, &function))
X fixerrV(NO_DEFINITION, v);
X else
X *Branch(t, MON_FCT)= copydef(function);
X break;
X case 'N':
X v= (value)*Branch(t, MON_NAME);
X if (is_variable(v) || !is_monprd(v, &function))
X fixerrV(NO_DEFINITION, v);
X else
X *Branch(t, MON_FCT)= copydef(function);
X break;
X case 'Q': /* don't visit comment SUITE nodes */
X if (*Branch(t, n) != NilTree)
X visit(t);
X break;
X#ifdef REACH
X case 'R':
X if (*Branch(t, n) != NilTree && !reachable())
X fixerr(MESS(2202, "command cannot be reached"));
X break;
X#endif
X case 'S':
X jumpto(Stop);
X break;
X case 'T':
X if (flag == 't')
X f_ctag(pt);
X else if (flag == 'v' || flag == 'x')
X f_etag(pt);
X else
X f_ttag(pt);
X break;
X case 'U':
X f_ucommand(pt);
X break;
X case 'V':
X visit(t);
X break;
X case 'X':
X if (flag == 'a' || flag == 'l' || flag == 'b')
X lvisit(t);
X else
X visit(t);
X break;
X case 'W':
X/*!*/ visit2(t, seterr(1));
X break;
X case 'Y':
X if (still_ok && reachable()) {
X if (nt == YIELD)
X fixerr(YIELD_NO_RETURN);
X else
X fixerr(TEST_NO_REPORT);
X }
X break;
X case 'Z':
X if (!is_cmd_ref(t) && still_ok && reachable())
X fixerr(MESS(2203, "refinement returns no value or reports no outcome"));
X *Branch(t, REF_START)= copy(l1);
X break;
X }
X }
X}
X
X/* skip test-suite comment nodes */
X
XHidden Procedure sk_tsuite_comment(v, w) parsetree v, *w; {
X while ((*w= *Branch(v, TSUI_NEXT)) != NilTree &&
X Nodetype(*w) == TEST_SUITE &&
X *Branch(*w, TSUI_TEST) == NilTree)
X v= *w;
X}
X
X/* ******************************************************************** */
X
XHidden bool is_cmd_ref(t) parsetree t; { /* HACK */
X value name= *Branch(t, REF_NAME);
X string s;
X
X if (!Valid(name))
X return No;
X s= strval(name);
X /* return isupper(*s); */
X return *s <= 'Z' && *s >= 'A';
X}
X
XVisible bool is_name(v) value v; {
X if (!Valid(v) || !Is_text(v))
X return No;
X else {
X string s= strval(v);
X /* return islower(*s); */
X return *s <= 'z' && *s >= 'a';
X }
X}
X
XVisible value copydef(f) value f; {
X if (f == Vnil || Funprd(f)->pre == Use) return Vnil;
X return copy(f);
X}
X
XHidden bool is_basic_target(v) value v; {
X if (!Valid(v))
X return No;
X return locals != Vnil && envassoc(locals, v) != Pnil ||
X envassoc(globals, v) != Pnil;
X}
X
XHidden bool is_variable(v) value v; {
X value f;
X if (!Valid(v))
X return No;
X return is_basic_target(v) ||
X envassoc(refinements, v) != Pnil ||
X is_zerfun(v, &f);
X}
X
XHidden bool is_target(p) parsetree *p; {
X value v;
X int k, len;
X parsetree w, *left, *right;
X typenode trimtype;
X typenode nt= nodetype(*p);
X
X switch (nt) {
X
X case TAG:
X v= *Branch(*p, First_fieldnr);
X return is_basic_target(v);
X
X case SELECTION:
X case BEHEAD:
X case CURTAIL:
X case COMPOUND:
X return is_target(Branch(*p, First_fieldnr));
X
X case COLLATERAL:
X v= *Branch(*p, First_fieldnr);
X len= Nfields(v);
X k_Overfields {
X if (!is_target(Field(v, k))) return No;
X }
X return Yes;
X case DYAF:
X if (trim_opr(*Branch(*p, DYA_NAME), &trimtype)) {
X left= Branch(*p, DYA_LEFT);
X if (is_target(left)) {
X right= Branch(*p, DYA_RIGHT);
X w= node3(trimtype, copy(*left), copy(*right));
X release(*p);
X *p= w;
X return Yes;
X }
X }
X return No;
X
X default:
X return No;
X
X }
X}
X
XHidden bool trim_opr(name, type) value name; typenode *type; {
X value v;
X
X if (!Valid(name))
X return No;
X if (compare(name, v= mk_text(S_BEHEAD)) == 0) {
X release(v);
X *type= BEHEAD;
X return Yes;
X }
X release(v);
X if (compare(name, v= mk_text(S_CURTAIL)) == 0) {
X release(v);
X *type= CURTAIL;
X return Yes;
X }
X release(v);
X return No;
X}
X
X/* ******************************************************************** */
X
X#define WRONG_KEYWORD MESS(2204, "wrong keyword %s")
X#define NO_ACTUAL MESS(2205, "missing actual parameter after %s")
X#define EXP_KEYWORD MESS(2206, "can't find expected %s")
X#define ILL_ACTUAL MESS(2207, "unexpected actual parameter after %s")
X#define ILL_KEYWORD MESS(2208, "unexpected keyword %s")
X
XHidden Procedure f_actuals(formals, actuals) parsetree formals, actuals; {
X /* name, actual, next */
X parsetree act, form, next_a, next_f, kw, *pact;
X
X do {
X kw= *Branch(actuals, ACT_KEYW);
X pact= Branch(actuals, ACT_EXPR); act= *pact;
X form= *Branch(formals, FML_TAG);
X next_a= *Branch(actuals, ACT_NEXT);
X next_f= *Branch(formals, FML_NEXT);
X
X if (compare(*Branch(formals, FML_KEYW), kw) != 0)
X fixerrV(WRONG_KEYWORD, kw);
X else if (act == NilTree && form != NilTree)
X fixerrV(NO_ACTUAL, kw);
X else if (next_a == NilTree && next_f != NilTree)
X fixerrV(EXP_KEYWORD, *Branch(next_f, FML_KEYW));
X else if (act != NilTree && form == NilTree)
X fixerrV(ILL_ACTUAL, kw);
X else if (next_a != NilTree && next_f == NilTree)
X fixerrV(ILL_KEYWORD, *Branch(next_a, ACT_KEYW));
X else if (act != NilTree)
X act_expr_gen(pact, form);
X actuals= next_a;
X formals= next_f;
X }
X while (still_ok && actuals != NilTree);
X}
X
X/* Fix and generate code for an actual parameter.
X This generates 'locate' code if it looks like a target,
X or 'evaluate' code if the parameter looks like an expression.
X The formal parameter's form is also taken into account:
X if it is a compound, and the actual is also a compound,
X the number of fields must match and the decision between 'locate'
X and 'evaluate' code is made recursively for each field.
X (If the formal is a compound but the actual isn't,
X that's OK, since it might be an expression or simple location
X of type compound.
X The reverse is also acceptable: then the formal parameter has
X a compound type.) */
X
XHidden Procedure act_expr_gen(pact, form) parsetree *pact; parsetree form; {
X while (Nodetype(form) == COMPOUND)
X form= *Branch(form, COMP_FIELD);
X while (Nodetype(*pact) == COMPOUND)
X pact= Branch(*pact, COMP_FIELD);
X if (Nodetype(form) == COLLATERAL && Nodetype(*pact) == COLLATERAL) {
X value vact= *Branch(*pact, COLL_SEQ);
X value vform= *Branch(form, COLL_SEQ);
X int n= Nfields(vact);
X if (n != Nfields(vform))
X fixerr(MESS(2209, "compound parameter has wrong length"));
X else {
X int k;
X for (k= 0; k < n; ++k)
X act_expr_gen(Field(vact, k), *Field(vform, k));
X visit(*pact);
X }
X }
X else {
X if (is_target(pact))
X f_targ(pact);
X else
X f_expr(pact);
X }
X}
X
XHidden Procedure f_ucommand(pt) parsetree *pt; {
X value t= *pt, *aa;
X parsetree u, f1= *Branch(t, UCMD_NAME), f2= *Branch(t, UCMD_ACTUALS);
X release(*Branch(t, UCMD_DEF));
X *Branch(t, UCMD_DEF)= Vnil;
X if ((aa= envassoc(refinements, f1)) != Pnil) {
X if (*Branch(f2, ACT_EXPR) != Vnil
X || *Branch(f2, ACT_NEXT) != Vnil)
X fixerr(MESS(2210, "refinement with parameters"));
X else *Branch(t, UCMD_DEF)= copy(*aa);
X }
X else if (is_unit(f1, Cmd, &aa)) {
X u= How_to(*aa)->unit;
X f_actuals(*Branch(u, HOW_FORMALS), f2);
X }
X else fixerrV(MESS(2211, "you haven't told me HOW TO %s"), f1);
X}
X
XHidden Procedure f_fpr_formals(t) parsetree t; {
X typenode nt= nodetype(t);
X
X switch (nt) {
X case TAG:
X break;
X case MONF: case MONPRD:
X f_targ(Branch(t, MON_RIGHT));
X break;
X case DYAF: case DYAPRD:
X f_targ(Branch(t, DYA_LEFT));
X f_targ(Branch(t, DYA_RIGHT));
X break;
X default:
X syserr(MESS(2212, "f_fpr_formals"));
X }
X}
X
XVisible bool modify_tag(name, tag) parsetree *tag; value name; {
X value *aa, function;
X *tag= NilTree;
X if (!Valid(name))
X return No;
X else if (locals != Vnil && (aa= envassoc(locals, name)) != Pnil)
X *tag= node3(TAGlocal, name, copy(*aa));
X else if ((aa= envassoc(globals, name)) != Pnil)
X *tag= node2(TAGglobal, name);
X else if ((aa= envassoc(refinements, name)) != Pnil)
X *tag= node3(TAGrefinement, name, copy(*aa));
X else if (is_zerfun(name, &function))
X *tag= node3(TAGzerfun, name, copydef(function));
X else if (is_zerprd(name, &function))
X *tag= node3(TAGzerprd, name, copydef(function));
X else return No;
X return Yes;
X}
X
XHidden Procedure f_etag(pt) parsetree *pt; {
X parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
X if (modify_tag(name, &t)) {
X release(*pt);
X *pt= t;
X if (Nodetype(t) == TAGzerprd)
X fixerrV(MESS(2213, "%s cannot be used in an expression"), name);
X else
X visit(t);
X } else {
X fixerrV(NO_INIT_OR_DEF, name);
X release(name);
X }
X}
X
XHidden Procedure f_ttag(pt) parsetree *pt; {
X parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
X if (modify_tag(name, &t)) {
X release(*pt);
X *pt= t;
X switch (Nodetype(t)) {
X case TAGrefinement:
X fixerr(REF_NO_TARGET);
X break;
X case TAGzerfun:
X case TAGzerprd:
X fixerrV(NO_INIT_OR_DEF, name);
X break;
X default:
X lvisit(t);
X break;
X }
X } else {
X fixerrV(NO_INIT_OR_DEF, name);
X release(name);
X }
X}
X
X#define NO_REF_OR_ZER MESS(2214, "%s is neither a refined test nor a zeroadic predicate")
X
XHidden Procedure f_ctag(pt) parsetree *pt; {
X parsetree t= *pt; value name= copy(*Branch(t, TAG_NAME));
X if (modify_tag(name, &t)) {
X release(*pt);
X *pt= t;
X switch (Nodetype(t)) {
X case TAGrefinement:
X lvisit(t); /* 'Loc' flag here means 'Test' */
X break;
X case TAGzerprd:
X visit(t);
X break;
X default:
X fixerrV(NO_REF_OR_ZER, name);
X break;
X }
X } else {
X fixerrV(NO_REF_OR_ZER, name);
X release(name);
X }
X}
END_OF_FILE
if test 19819 -ne `wc -c <'abc/bint2/i2gen.c'`; then
echo shar: \"'abc/bint2/i2gen.c'\" unpacked with wrong size!
fi
# end of 'abc/bint2/i2gen.c'
fi
if test -f 'abc/bint3/i3bws.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint3/i3bws.c'\"
else
echo shar: Extracting \"'abc/bint3/i3bws.c'\" \(10277 characters\)
sed "s/^X//" >'abc/bint3/i3bws.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X#include "b.h"
X#include "bint.h"
X#include "bfil.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "args.h"
X#include "feat.h"
X#include "i2par.h"
X#include "i3bws.h"
X#include "i3env.h"
X#include "i3sou.h"
X
X/* ******************************************************************** */
X/* workspace routines */
X/* ******************************************************************** */
X
XVisible char *bwsdir= (char *) NULL; /* group name workspaces */
X
XVisible value ws_group= Vnil; /* index workspaces */
XVisible bool groupchanges= No; /* if Yes index is changed */
X
XVisible value curwskey= Vnil; /* special index key for cur_ws */
XVisible value lastwskey= Vnil; /* special index key for last_ws */
X
XVisible value cur_ws= Vnil; /* the current workspace */
X /* only visible for m1bio.c */
XHidden value last_ws= Vnil; /* the last visited workspace */
X
XHidden bool path_workspace= No; /* if Yes no workspace change allowed */
X
X#define gr_exists(name, aa) (in_env(ws_group, name, aa))
X#define def_group(name, f) (e_replace(f, &ws_group, name), groupchanges= Yes)
X#define free_group(name) (e_delete(&ws_group, name), groupchanges= Yes)
X
X#ifndef DIRMODE
X#define DIRMODE 0777
X#endif
X
X/* ******************************************************************** */
X
X#define DEFAULT_WS "first"
X
X#define CURWSKEY ">"
X#define LASTWSKEY ">>"
X
XHidden Procedure initgroup() {
X wsgroupfile= (string) makepath(bwsdir, WSGROUPFILE);
X curwskey= mk_text(CURWSKEY);
X lastwskey= mk_text(LASTWSKEY);
X if (F_exists(wsgroupfile)) {
X value fname= mk_text(wsgroupfile);
X ws_group= getval(fname, In_wsgroup);
X release(fname);
X if (!still_ok) {
X still_ok= Yes;
X rec_wsgroup();
X }
X
X }
X else ws_group= mk_elt();
X groupchanges= No;
X}
X
XHidden Procedure endgroup() {
X save_curlast(curwskey, cur_ws);
X save_curlast(lastwskey, last_ws);
X only_default();
X put_wsgroup();
X}
X
XHidden Procedure save_curlast(wskey, ws) value wskey, ws; {
X value *aa;
X
X if (Valid(ws) && (!gr_exists(wskey, &aa) || (compare(ws, *aa) != 0)))
X def_group(wskey, ws);
X}
X
X/*
X * removes the default entry if it is the only one;
X * the default is [CURWSKEY]: DEFAULT_WS;
X * this has to be done to create the possibility of removing an empty
X * wsgroupfile and bwsdefault directory;
X * still this will hardly happen (see comments in endbws() )
X */
X
XHidden Procedure only_default() {
X value *aa;
X
X if (length(ws_group) == 1 &&
X Valid(curwskey) && gr_exists(curwskey, &aa)
X ) {
X value defws= mk_text(DEFAULT_WS);
X if (compare(defws, *aa) == 0)
X free_group(curwskey);
X release(defws);
X }
X}
X
XHidden Procedure put_wsgroup() {
X value fn;
X intlet len;
X
X if (!groupchanges || !Valid(ws_group))
X return;
X fn= mk_text(wsgroupfile);
X /* Remove the file if empty */
X len= length(ws_group);
X if (len == 0)
X f_delete(fn);
X else
X putval(fn, ws_group, Yes, In_wsgroup);
X release(fn);
X groupchanges= No;
X}
X
X/* ******************************************************************** */
X
XHidden bool wschange(ws) value ws; {
X value name, *aa;
X bool new= No, changed;
X char *path;
X
X if (gr_exists(ws, &aa))
X name= copy(*aa);
X else {
X name= new_fname(ws, Wsp);
X if (!Valid(name))
X return No;
X new= Yes;
X }
X path= makepath(bwsdir, strval(name));
X VOID Mkdir(path);
X changed= chdir(path) == 0 ? Yes : No;
X if (changed && new)
X def_group(ws, name);
X freepath(path);
X release(name);
X return changed;
X}
X
XHidden Procedure wsempty(ws) value ws; {
X char *path, *permpath;
X value *aa;
X
X if (!gr_exists(ws, &aa))
X return;
X path= makepath(bwsdir, strval(*aa));
X permpath= makepath(path, permfile);
X if (F_exists(permpath));
X else if (strcmp(startdir, path) == 0);
X else if (rmdir(path) != 0);
X else free_group(ws);
X freepath(path);
X freepath(permpath);
X}
X
X/* ******************************************************************** */
X
XVisible Procedure goto_ws() {
X value ws= Vnil;
X bool prname; /* print workspace name */
X
X if (path_workspace) {
X parerr(MESS(2900, "change of workspace not allowed"));
X return;
X }
X if (Ceol(tx)) {
X if (Valid(last_ws))
X ws= copy(last_ws);
X else
X parerr(MESS(2901, "no previous workspace"));
X prname= Yes;
X }
X else if (is_tag(&ws))
X prname= No;
X else
X parerr(MESS(2902, "I find no workspace name here"));
X
X if (still_ok && (compare(ws, cur_ws) != 0)) {
X can_interrupt= No;
X endworkspace();
X
X if (wschange(ws)) {
X release(last_ws); last_ws= copy(cur_ws);
X release(cur_ws); cur_ws= copy(ws);
X }
X else {
X parerrV(MESS(2903, "I can't goto/create workspace %s"), ws);
X still_ok= Yes;
X prname= No;
X }
X
X init_workspace(prname);
X wsempty(last_ws);
X can_interrupt= Yes;
X }
X release(ws);
X}
X
XVisible Procedure lst_wss() {
X value wslist, ws;
X value k, len, m;
X
X if (path_workspace) {
X print_wsname();
X return;
X }
X wslist= keys(ws_group);
X
X if (!in(cur_ws, wslist))
X insert(cur_ws, &wslist);
X
X k= one; len= size(wslist);
X while (numcomp(k, len) <= 0) {
X ws= item(wslist, k);
X if (compare(ws, curwskey) == 0);
X else if (compare(ws, lastwskey) == 0);
X else if (compare(ws, cur_ws) == 0)
X putSstr(stdout, ">%s ", strval(ws));
X else
X putSstr(stdout, "%s ", strval(ws));
X release(ws);
X k= sum(m= k, one);
X release(m);
X }
X if (numcomp(len, zero) > 0)
X putnewline(stdout);
X fflush(stdout);
X release(k); release(len);
X release(wslist);
X}
X
X/************************************************************************/
X
X#define NO_PARENT MESS(2905, "*** I cannot find parent directory\n")
X#define NO_WORKSPACE MESS(2906, "*** I cannot find workspace\n")
X#define NO_DEFAULT MESS(2907, "*** I cannot find your home directory\n")
X#define USE_CURRENT MESS(2908, "*** I shall use the current directory as your single workspace\n")
X#define NO_ABCNAME MESS(2909, "*** %s isn't an ABC name\n")
X#define TRY_DEFAULT MESS(2910, "*** I shall try the default workspace\n")
X
XHidden Procedure wserr(m, use_cur) int m; bool use_cur; {
X putmess(errfile, m);
X if (use_cur)
X wscurrent();
X}
X
XHidden Procedure wserrV(m, v, use_cur) int m; value v; bool use_cur; {
X putSmess(errfile, m, strval(v));
X if (use_cur)
X wscurrent();
X}
X
XHidden Procedure wscurrent() {
X putmess(errfile, USE_CURRENT);
X path_workspace= Yes;
X}
X
X/* ******************************************************************** */
X
XHidden bool wsinit() {
X value *aa;
X
X initgroup();
X cur_ws= Vnil;
X last_ws= Vnil;
X if (wsp_arg) {
X /* wsp_arg is a single name here, not a pathname */
X#ifdef WSP_DIRNAME
X /* on the mac wsp_arg is a mac foldername, not an ABC wsname */
X cur_ws= abc_wsname(wsp_arg);
X if (!Valid(cur_ws))
X return No;
X#else
X /* wsp_arg is here an ABC workspace name, not a path */
X cur_ws= mk_text(wsp_arg);
X#endif
X if (!is_abcname(cur_ws)) {
X wserrV(NO_ABCNAME, cur_ws, No);
X wserr(TRY_DEFAULT, No);
X release(cur_ws); cur_ws= Vnil;
X }
X }
X if (gr_exists(curwskey, &aa)) {
X if (!Valid(cur_ws))
X cur_ws= copy(*aa);
X else if (compare(cur_ws, *aa) != 0)
X last_ws= copy(*aa);
X if (!Valid(last_ws) && gr_exists(lastwskey, &aa))
X last_ws= copy(*aa);
X }
X if (!Valid(cur_ws))
X cur_ws= mk_text(DEFAULT_WS);
X if (!is_abcname(cur_ws))
X wserrV(NO_ABCNAME, cur_ws, Yes);
X else if (wschange(cur_ws)) {
X path_workspace= No;
X return Yes;
X }
X else wserr(NO_WORKSPACE, Yes);
X return No;
X}
X
XVisible Procedure initbws() {
X if (is_gr_reccall) { /* recover index of group workspaces */
X if (!setbwsdir() || !D_exists(bwsdir)) {
X wserr(NO_PARENT, No);
X immexit(1);
X }
X initgroup();
X return;
X }
X if (is_path(wsp_arg)) {
X /* !bws_arg already assured in main.c */
X if (chdir(wsp_arg) != 0)
X wserr(NO_WORKSPACE, Yes);
X else
X path_workspace= Yes;
X }
X else if (setbwsdir()) {
X if (!D_exists(bwsdir))
X wserr(NO_PARENT, Yes);
X else if (!wsinit())
X wsrelease();
X }
X else wserr(NO_DEFAULT, Yes);
X if (path_workspace) {
X release(cur_ws);
X cur_ws= mk_text(curdir());
X }
X init_workspace(Yes);
X}
X
XVisible Procedure endbws() {
X if (!is_gr_reccall) {
X endworkspace();
X VOID chdir(startdir);
X if (path_workspace) {
X release(cur_ws);
X cur_ws= Vnil;
X return;
X }
X else wsempty(cur_ws);
X }
X /* else: only index of group workspaces recovered */
X
X endgroup();
X /*
X * if the bwsdefault directory is used and empty, remove it;
X * because of the savings of the last two visited workspaces
X * in the file `bwsdefault`/`wsgroupfile` this will hardly happen;
X * only if you stays for ever in the default workspace.
X */
X if (!bws_arg && bwsdefault)
X VOID rmdir(bwsdefault); /* fails if not empty */
X wsrelease();
X}
X
XVisible bool is_path(path) char *path; {
X if (path == (char *) NULL)
X return No;
X if (strcmp(path, CURDIR) == 0 || strcmp(path, PARENTDIR) == 0)
X return Yes;
X for (; *path; path++) {
X if (Isanysep(*path)) return Yes;
X }
X return No;
X}
X
XHidden bool setbwsdir() {
X if (bws_arg || bwsdefault) {
X if (!bws_arg) {
X bwsdir= savepath(bwsdefault); /* full path name */
X VOID Mkdir(bwsdir);
X }
X else if (!Isabspath(bws_arg))
X bwsdir= makepath(startdir, bws_arg);
X else
X bwsdir= savepath(bws_arg);
X return Yes;
X }
X return No;
X}
X
XHidden Procedure wsrelease() {
X release(last_ws); last_ws= Vnil;
X release(cur_ws); cur_ws= Vnil;
X release(lastwskey); lastwskey= Vnil;
X release(curwskey); curwskey= Vnil;
X release(ws_group); ws_group= Vnil;
X freepath(wsgroupfile); wsgroupfile= (string) NULL;
X freepath(bwsdir); bwsdir= (char *) NULL;
X}
X
X/************************************************************************/
X
XHidden Procedure init_workspace(prname) bool prname; {
X if (interactive && prname)
X print_wsname();
X initworkspace();
X if (!still_ok) {
X still_ok= Yes;
X rec_workspace();
X }
X}
X
XVisible Procedure initworkspace() {
X initsou();
X initfpr();
X initenv();
X#ifdef USERSUGG
X initsugg();
X#endif
X#ifdef SAVEPOS
X initpos();
X#endif
X#ifdef TYPE_CHECK
X initstc();
X#endif
X setprmnv();
X initperm();
X}
X
XVisible Procedure endworkspace() {
X endperm();
X endsou();
X endenv();
X#ifdef USERSUGG
X endsugg();
X#endif
X#ifdef SAVEPOS
X endpos();
X#endif
X#ifdef TYPE_CHECK
X endstc();
X#endif
X enderro();
X}
X
X/************************************************************************/
X
XVisible bool wsp_writable() {
X return F_writable(CURDIR) ? Yes : No;
X}
X
XHidden Procedure print_wsname() {
X putSstr(errfile, ">%s\n", strval(cur_ws));
X fflush(errfile);
X}
X
X/************************************************************************/
END_OF_FILE
if test 10277 -ne `wc -c <'abc/bint3/i3bws.c'`; then
echo shar: \"'abc/bint3/i3bws.c'\" unpacked with wrong size!
fi
# end of 'abc/bint3/i3bws.c'
fi
if test -f 'abc/ex/try/position.abc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/ex/try/position.abc'\"
else
echo shar: Extracting \"'abc/ex/try/position.abc'\" \(12 characters\)
sed "s/^X//" >'abc/ex/try/position.abc' <<'END_OF_FILE'
Xstart.cmd 4
END_OF_FILE
if test 12 -ne `wc -c <'abc/ex/try/position.abc'`; then
echo shar: \"'abc/ex/try/position.abc'\" unpacked with wrong size!
fi
# end of 'abc/ex/try/position.abc'
fi
echo shar: End of archive 7 \(of 25\).
cp /dev/null ark7isdone
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