sources-request@genrad.UUCP (07/12/85)
Mod.sources: Volume 2, Issue 6
Submitted by: ihnp4!mnetor!clewis (Chris Lewis
Moderators Note:
This is the README file from a distribution of software tools written
in Pascal. Some of the sources are from (or derived from) the book
"Software Tools in Pascal", and permission has been obtained from
Brian Kernighan to post these here. I have not tried to compile
these myself, they seem to be tailored to a VM/CMS pascal. Hopefully
translation will not be too difficult.
John Nelson (decvax!genrad!john) [moderator, mod.sources]
#!/bin/sh
echo 'Start of pack.out, part 01 of 01:'
echo 'x - README'
sed 's/^X//' > README << '/'
X A version of Kernighan and Plauger's
X Software Tools in Pascal (SWTiP)
X
X Chris Lewis, Copyright (c) June 1985
X {whereever}!utzoo!mnetor!clewis
X
X All of the software in this distribution is copyright, see
X the notices on the individual files to determine the ownership.
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X
XTools in this distribution:
X
XDefine define handler
XDeskCalculator desk calculator
XEcho
XExpand "expand" input "picture"
XGrep
XKwic kwic index stuff
XMacro macro and define expansion
XRot "rotate" a picture
XScreen prints table of characters
XSort generic sort merge
XSortDriv " " "
XSW editor
Xswch sort of a "sed"
XSWTr more or less UNIX "tr"
XUnique uniq
XWc word count
X
Xfontinit.pascal contains a font definition - you should be able
Xto figure out how to build a driver for it. It is in two pieces,
Xfontinit.A and fontinit.B (so that the batch is smaller than 50k).
XJust catenate them together.
X
XSome of these are from SWTiP, some I have written myself - these are
Xnoted in the headers.
X
XUsing this software (details for Pascal/VS on VM/CMS):
X 1) take the swtools.copy file:
X convert it to Fixed 80
X add line numbers in column 73-80
X MACLIB it to SWTOOLS MACLIB
X swtools.copy is the complete set of include files required
X for building the tools. (from each *COPY to the next)
X 2) Compile all of the source that are "segment"s, and
X put the objects in a TXTLIB.
X These are library routines used by various programs.
X 3) Compile all of the source that are "program"s, and
X link them with TXTLIB.
X
XMVS users: you will have to change some of the I/O routines (the
Xones copyrighted by me) to use appropriate MVS functions.
X
XNon-Pascal/VS: you will have to convert the flavour of pascal to
Xwhat you have:
X Pascal/VS supports separate compilations
X Pascal/VS supports true strings (which I don't use much)
X Pascal/VS supports includes
X Pascal/VS supports fairly complicated initialized global
X data types, including binary constants.
X You may have to throw out all of the I/O, some of the
X include files, and include all of the routines for a given
X program together. Yech! Good Luck!
X
XThis software is unsupported, however, upon request I may be able
Xto provide some hints.
/
echo 'Part 01 of pack.out complete.'
exitsources-request@genrad.UUCP (07/12/85)
Mod.sources: Volume 2, Issue 7
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 01 of 06:'
echo 'x - deskcalc.pascal'
sed 's/^X//' > deskcalc.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
Xprogram DeskCalculator;
X%include swtools
Xconst
X maxStackIndex = 500;
X maxRegisterIndex = 500;
Xtype
X StackIndexType = 0..maxStackIndex;
X StackElementType = Real;
X RegisterIndexType = 0..maxRegisterIndex;
Xvar
X stack: array [StackIndexType] of StackElementType;
X stackPointer: StackIndexType;
X registers: array [RegisterIndexType] of StackElementType;
X%page
Xprocedure StackPush(const val: Real);
Xbegin
X if stackPointer < maxStackIndex then begin
X stack[stackPointer] := val;
X stackPointer := Succ(stackPointer)
X end {then}
X else
X Message('Stack overflow, value ignored');
Xend; {StackPush}
X
X
Xprocedure StackPop(var val: Real);
Xbegin
X if stackPointer > Lowest(StackIndexType) then begin
X stackPointer := Pred(stackPointer);
X val := stack[stackPointer]
X end {then}
X else begin
X Message('Stack Underflow, replaced with zero');
X val := 0
X end {if};
Xend; {StackPop}
X%page
XProcedure PrintHelp;
Xbegin
X MPutStr('Desk Calculator HELP:$N$N$N$E', STDOUT);
X MPutStr('DeskCalc implements a reverse Polish calculator$N' ||
X '(or RPN) similar to a Hewlett Packard Calculator$N$E',
X STDOUT);
X MPutStr('There are the basic operators as well as a stack of$N' ||
X 'up to 500 deep and 500 registers for SAVE/READ$N$N$E',
X STDOUT);
X MPutStr('* Multiply$N$E',STDOUT);
X MPutStr('/ Divide$N$E', STDOUT);
X MPutStr('+ Plus$N$E', STDOUT);
X MPutStr('- Minus$N$E', STDOUT);
X MPutStr('% Modulo (integer)$N$E', STDOUT);
X MPutStr('_ Unary negate$N$N$E',STDOUT);
X MPutStr('Other commands, only first letter significant$N$N$E',
X STDOUT);
X MPutStr('Print Print top of stack$N$E',STDOUT);
X MPutStr('Clear Clear stack$N$E',STDOUT);
X MPutStr('Quit Quit$N$E', STDOUT);
X MPutStr('Help Help (you''re reading it)$N$E',STDOUT);
X MPutStr('Save Save TOS-1 in register TOS,$N$E' ||
X ' pops TOS-1 and TOS$N$E', STDOUT);
X MPutStr('Read Read register TOS into TOS$N$E', STDOUT);
X MPutStr('Drop Pop and ignore top of stack$N$E', STDOUT);
X MPutStr('Trace If TOS 0, turn off tracing, else on$N$E', STDOUT);
X MPutStr('Wap sWap TOS and TOS-1$N$E', STDOUT);
Xend {PrintHelp};
X%page
Xfunction Calculate(const arg: StringType):Boolean;
X
Xvar
X val, left, right: StackElementType;
X temp: String(MAXSTR);
X outVal: StringType;
X i,j,k: Integer;
X
Xstatic
X traceFlag: Boolean;
Xvalue
X traceFlag := false;
X
X
Xbegin
X Calculate := true;
X
X if traceFlag then begin
X PutDec(stackPointer, 4);
X PutC(BLANK);
X PutStr(arg, STDOUT);
X PutC(NEWLINE);
X end;
X
X if arg[1] in [DIG0..DIG9,PERIOD] then begin
X ReadStr(Str(arg), val);
X StackPush(val)
X end
X
X else begin
X case arg[1] of
X STAR, MINUS, PLUS, SLASH, PERCENT: begin
X StackPop(right);
X StackPop(left);
X case arg[1] of
X STAR:
X left := left * right;
X MINUS:
X left := left - right;
X PLUS:
X left := left + right;
X SLASH:
X left := left / right;
X PERCENT:
X left := Round(left) mod Round(right)
X end {case};
X StackPush(left)
X end; { Dyadic operators }
X
X UNDERLINE: begin
X StackPop(left);
X StackPush(- left)
X end {UNDERLINE (unary negate)};
X
X LETD, BIGD: StackPop(left);
X
X LETC, BIGC: stackPointer :=
X Lowest(StackIndexType);
X
X LETH, BIGH: PrintHelp;
X
X LETW, BIGW: begin
X StackPop(right);
X StackPop(left);
X StackPush(right);
X StackPush(left);
X end {LETW, BIGW};
X
X LETQ, BIGQ: Calculate := false;
X
X LETP, BIGP: begin
X StackPop(left);
X StackPush(left);
X if (left > 1.0e11) or (left < 1.0e-5) then
X WriteStr(temp, left:20)
X else
X WriteStr(temp, left:20:10);
X outVal := temp;
X outVal[Length(temp) + 1] := ENDSTR;
X PutStr(outVal, STDOUT);
X PutC(NEWLINE)
X end {LETP, BIGP};
X
X LETT, BIGT: begin
X StackPop(left);
X if left = 0 then
X traceFlag := false
X else
X traceFlag := true
X end {LETT, BIGT};
X
X LETR, BIGR: begin
X StackPop(right);
X j := Round(right);
X if (j >= Lowest(RegisterIndexType)) and
X (j <= Highest(RegisterIndexType)) then
X StackPush(registers[j])
X else begin
X Message('READ: Bad register number');
X StackPush(0.0)
X end
X end {LETR, BIGR};
X
X LETS, BIGS: begin
X StackPop(right);
X StackPop(left);
X j := Round(right);
X if (j >= Lowest(RegisterIndexType)) and
X (j <= Highest(RegisterIndexType)) then
X registers[j] := left
X else
X Message('SAVE: Bad register number');
X end {LETR, BIGR}
X
X otherwise begin
X PutCF(NEWLINE, STDERR);
X PutCF(SQUOTE, STDERR);
X PutStr(arg, STDERR);
X Message('''is illegal input.');
X end {otherwise}
X
X end {case}
X
X end {if};
X
Xend {Calculate};
X%page
Xvar
X lin: StringType;
X arg: StringType;
X lineIndex, nextLineIndex: 0..MAXSTR;
X argNumber: Integer;
X notDone: Boolean;
X
Xbegin
X ToolInit;
X stackPointer := 0;
X notDone := true;
X if NArgs> 0 then begin
X argNumber := 1;
X while notDone and GetArg(argNumber, lin, MAXSTR) do begin
X /* PutDec(argNumber, 1); PutC(BLANK);
X PutStr(lin, STDOUT);
X PutC(NEWLINE); */
X notDone := Calculate(lin);
X argNumber := argNumber + 1
X end {while}
X end
X else begin
X MPutStr('Desk Calculator V0.00 (type H for help)$N$E', STDOUT);
X while notDone and GetLine(lin, STDIN, MAXSTR) do begin
X lineIndex := 1;
X nextLineIndex := GetWord(lin, lineIndex, arg);
X while notDone and (nextLineIndex > 0) do begin
X notDone := Calculate(arg);
X lineIndex := nextLineIndex;
X nextLineIndex := GetWord(lin, lineIndex, arg)
X end {while}
X end {while}
X end {if}
Xend.
/
echo 'x - fontinit.B'
sed 's/^X//' > fontinit.B << '/'
X{'d'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0000110001100000'B,
X '0001111100000000'B,'0000100011000000'B,'0000110001100000'B,
X '0000100010000000'B,'0000100011000000'B,'0000110001100000'B,
X '0000100010000000'B,'0000100011000000'B,'0000110001100000'B,
X '0000100010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111100000000'B,'0001111110000000'B,'0001111111000000'B,
X{'e'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001111110000000'B,
X '0001000000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111110000000'B,'0001111111000000'B,'0001111111100000'B,
X{'f'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001111110000000'B,
X '0001000000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X%PAGE
X{'g'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0000111110000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001101111000000'B,'0001100111100000'B,
X '0001001110000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0000111100000000'B,'0000111110000000'B,'0000111111000000'B,
X{'h'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100001100000'B,
X '0000000000000000'B,'0001100011000000'B,'0001100001100000'B,
X '0000000000000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100011000000'B,'0001111111100000'B,
X '0001000100000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100011000000'B,'0001100001100000'B,
X{'i'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111110000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000011000000000'B,
X '0001110000000000'B,'0000011000000000'B,'0000011000000000'B,
X '0000100000000000'B,'0000011000000000'B,'0000011000000000'B,
X '0000100000000000'B,'0000011000000000'B,'0000011000000000'B,
X '0000100000000000'B,'0001111110000000'B,'0001111110000000'B,
X '0001110000000000'B,'0001111110000000'B,'0001111110000000'B,
X%PAGE
X{'j'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111110000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111110000'B,
X '0000000000000000'B,'0000011111100000'B,'0000000110000000'B,
X '0000000000000000'B,'0000000110000000'B,'0000000110000000'B,
X '0000011100000000'B,'0000000110000000'B,'0000000110000000'B,
X '0000001000000000'B,'0000000110000000'B,'0000000110000000'B,
X '0000001000000000'B,'0001100110000000'B,'0001100110000000'B,
X '0001001000000000'B,'0001100110000000'B,'0001100110000000'B,
X '0000110000000000'B,'0000111100000000'B,'0000111100000000'B,
X{'k'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100011000000'B,
X '0000000000000000'B,'0001100011000000'B,'0001100110000000'B,
X '0000000000000000'B,'0001100110000000'B,'0001101100000000'B,
X '0001001000000000'B,'0001101100000000'B,'0001111000000000'B,
X '0001010000000000'B,'0001111000000000'B,'0001111000000000'B,
X '0001100000000000'B,'0001101100000000'B,'0001101100000000'B,
X '0001010000000000'B,'0001100110000000'B,'0001100110000000'B,
X '0001001000000000'B,'0001100011000000'B,'0001100011000000'B,
X{'l'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001111111000000'B,'0001111111000000'B,
X '0001111000000000'B,'0001111111000000'B,'0001111111000000'B,
X%PAGE
X{'m'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000110000'B,
X '0000000000000000'B,'0001100000110000'B,'0001110001110000'B,
X '0000000000000000'B,'0001110001110000'B,'0001111011110000'B,
X '0001100110000000'B,'0001111011110000'B,'0001101110110000'B,
X '0001011010000000'B,'0001101110110000'B,'0001100100110000'B,
X '0001000010000000'B,'0001100100110000'B,'0001100000110000'B,
X '0001000010000000'B,'0001100000110000'B,'0001100000110000'B,
X '0001000010000000'B,'0001100000110000'B,'0001100000110000'B,
X{'n'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000110000'B,
X '0000000000000000'B,'0001100001100000'B,'0001110000110000'B,
X '0000000000000000'B,'0001110001100000'B,'0001111000110000'B,
X '0001000100000000'B,'0001111001100000'B,'0001101100110000'B,
X '0001100100000000'B,'0001101101100000'B,'0001100110110000'B,
X '0001010100000000'B,'0001100111100000'B,'0001100011110000'B,
X '0001001100000000'B,'0001100011100000'B,'0001100001110000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100000110000'B,
X{'o'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0001111100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000100000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111100000000'B,'0000111110000000'B,'0000111111000000'B,
X%PAGE
X{'p'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0001111000000000'B,'0001100011000000'B,'0001111111100000'B,
X '0001000100000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100000000000'B,'0001100000000000'B,
X{'q'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001100011000000'B,'0001100001100000'B,
X '0000111100000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001101011000000'B,'0001101101100000'B,
X '0001001010000000'B,'0001100111000000'B,'0001100111000000'B,
X '0001000100000000'B,'0001100010000000'B,'0001111111000000'B,
X '0000111010000000'B,'0000111101000000'B,'0000111101100000'B,
X{'r'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0001111000000000'B,'0001100011000000'B,'0001111111100000'B,
X '0001000100000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111000000000'B,'0001101100000000'B,'0001100110000000'B,
X '0001001000000000'B,'0001100110000000'B,'0001100011000000'B,
X '0001000100000000'B,'0001100011000000'B,'0001100001100000'B,
X%PAGE
X{'s'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111111000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001100001100000'B,'0001100000100000'B,
X '0001111100000000'B,'0001100000000000'B,'0000111100000000'B,
X '0001000000000000'B,'0000111111000000'B,'0000001111000000'B,
X '0001111100000000'B,'0000000001100000'B,'0001000001100000'B,
X '0000000100000000'B,'0001100001100000'B,'0001111111100000'B,
X '0001111100000000'B,'0000111111000000'B,'0000111111000000'B,
X{'t'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111100000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111100000'B,'0000001100000000'B,
X '0001111100000000'B,'0000001100000000'B,'0000001100000000'B,
X '0000010000000000'B,'0000001100000000'B,'0000001100000000'B,
X '0000010000000000'B,'0000001100000000'B,'0000001100000000'B,
X '0000010000000000'B,'0000001100000000'B,'0000001100000000'B,
X '0000010000000000'B,'0000001100000000'B,'0000001100000000'B,
X{'u'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100001100000'B,
X '0000000000000000'B,'0001100001100000'B,'0001100001100000'B,
X '0000000000000000'B,'0001100001100000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100001100000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100001100000'B,
X '0001000100000000'B,'0001111111100000'B,'0001111111100000'B,
X '0000111000000000'B,'0000111111000000'B,'0000111111000000'B,
X%PAGE
X{'v'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000011000'B,
X '0000000000000000'B,'0001100001100000'B,'0001100000011000'B,
X '0000000000000000'B,'0001100001100000'B,'0001100000011000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100000011000'B,
X '0001000100000000'B,'0001100001100000'B,'0000110000110000'B,
X '0001000100000000'B,'0000110011000000'B,'0000011001100000'B,
X '0000101000000000'B,'0000011110000000'B,'0000001111000000'B,
X '0000010000000000'B,'0000001100000000'B,'0000000110000000'B,
X{'w'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000011000'B,
X '0000000000000000'B,'0001100000011000'B,'0001100000011000'B,
X '0000000000000000'B,'0001100000011000'B,'0001100000011000'B,
X '0001000001000000'B,'0001100000011000'B,'0001100000011000'B,
X '0001000001000000'B,'0001100000011000'B,'0001100000011000'B,
X '0001001001000000'B,'0001100110011000'B,'0001100110011000'B,
X '0000111110000000'B,'0000111111110000'B,'0000111111110000'B,
X '0000010100000000'B,'0000011001100000'B,'0000011001100000'B,
X{'x'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000110000'B,
X '0000000000000000'B,'0001100001100000'B,'0000110001100000'B,
X '0000000000000000'B,'0000110011000000'B,'0000011011000000'B,
X '0001000100000000'B,'0000011110000000'B,'0000001110000000'B,
X '0000101000000000'B,'0000001100000000'B,'0000001110000000'B,
X '0000010000000000'B,'0000011110000000'B,'0000011011000000'B,
X '0000101000000000'B,'0000110011000000'B,'0000110001100000'B,
X '0001000100000000'B,'0001100001100000'B,'0001100000110000'B,
X%PAGE
X{'y'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000011000'B,
X '0000000000000000'B,'0001100000011000'B,'0000110000110000'B,
X '0000000000000000'B,'0000110000110000'B,'0000011001100000'B,
X '0001000100000000'B,'0000011001100000'B,'0000001111000000'B,
X '0000101000000000'B,'0000001111000000'B,'0000000110000000'B,
X '0000010000000000'B,'0000000110000000'B,'0000000110000000'B,
X '0000010000000000'B,'0000000110000000'B,'0000000110000000'B,
X '0000010000000000'B,'0000000110000000'B,'0000000110000000'B,
X{'z'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000000110000000'B,
X '0001111100000000'B,'0000001100000000'B,'0000001100000000'B,
X '0000001000000000'B,'0000011000000000'B,'0000011000000000'B,
X '0000010000000000'B,'0000110000000000'B,'0000110000000000'B,
X '0000100000000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111100000000'B,'0001111110000000'B,'0001111111000000'B,
X%PAGE
X{'0'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111100000'B,'0001110000000111'B,
X '0000111111000000'B,'0001100001100000'B,'0001110000000111'B,
X '0001111111100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0001111111100000'B,'0001111111100000'B,'0000111111111110'B,
X '0000111111000000'B,'0000111111000000'B,'0000011111111100'B,
X{'1'}
X '0000000000000000'B,'0000000000000000'B,'0000011100000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111100000000'B,
X '0000000000000000'B,'0000011000000000'B,'0001111100000000'B,
X '0000000000000000'B,'0000111000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0001111000000000'B,'0000011100000000'B,
X '0000111000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X{'2'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000011111100000'B,'0001110000000111'B,
X '0000000000000000'B,'0000111111110000'B,'0001110000000111'B,
X '0000111100000000'B,'0001100000110000'B,'0000000000000111'B,
X '0001111110000000'B,'0000000000110000'B,'0000000000000111'B,
X '0001100011000000'B,'0000000001100000'B,'0000000000111110'B,
X '0000000011000000'B,'0000000011000000'B,'0000000011111000'B,
X '0000000110000000'B,'0000000110000000'B,'0000001110000000'B,
X '0000001100000000'B,'0000001100000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000111000000000'B,
X '0000110000000000'B,'0000110000000000'B,'0001110000000000'B,
X '0001111111000000'B,'0001111111110000'B,'0001111111111111'B,
X '0001111111000000'B,'0001111111110000'B,'0001111111111111'B,
X%PAGE
X{'3'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000011110000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000111111000000'B,'0001110000000111'B,
X '0000011110000000'B,'0001100001100000'B,'0000000000000111'B,
X '0000111111000000'B,'0000000001100000'B,'0000000000000111'B,
X '0001100001100000'B,'0000000001100000'B,'0000000011111110'B,
X '0000000001100000'B,'0000011111000000'B,'0000000011111110'B,
X '0000011111000000'B,'0000011111000000'B,'0000000000000111'B,
X '0000011111000000'B,'0000000001100000'B,'0000000000000111'B,
X '0000000001100000'B,'0000000001100000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100001100000'B,'0001110000000111'B,
X '0000111111000000'B,'0000111111000000'B,'0000111111111110'B,
X '0000011110000000'B,'0000011110000000'B,'0000011111111100'B,
X{'4'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000100'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000001100'B,
X '0000000000000000'B,'0000000001100000'B,'0000000000011100'B,
X '0000000000000000'B,'0000000011100000'B,'0000000000111100'B,
X '0000000011000000'B,'0000000111100000'B,'0000000001111100'B,
X '0000000111000000'B,'0000001101100000'B,'0000000011111100'B,
X '0000001111000000'B,'0000011001100000'B,'0000000111011100'B,
X '0000011011000000'B,'0000110001100000'B,'0000001110011100'B,
X '0000110011000000'B,'0001111111111000'B,'0000011100011100'B,
X '0001111111110000'B,'0001111111111000'B,'0000111000011100'B,
X '0001111111110000'B,'0000000001100000'B,'0001111111111111'B,
X '0000000011000000'B,'0000000001100000'B,'0001111111111111'B,
X '0000000011000000'B,'0000000001100000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000001100000'B,'0000000000011100'B,
X{'5'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111110000'B,'0001110000000000'B,
X '0000000000000000'B,'0001111111110000'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001111111111100'B,
X '0001111111100000'B,'0001100000000000'B,'0001111111111110'B,
X '0001100000000000'B,'0001111111100000'B,'0000000000000111'B,
X '0001111111000000'B,'0001111111110000'B,'0000000000000111'B,
X '0001111111100000'B,'0000000000110000'B,'0000000000000111'B,
X '0000000001100000'B,'0000000000110000'B,'0000000000000111'B,
X '0000000001100000'B,'0000000000110000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100000110000'B,'0001110000000111'B,
X '0001111111000000'B,'0001111111110000'B,'0000111111111110'B,
X '0000111110000000'B,'0000111111100000'B,'0000011111111100'B,
X%PAGE
X{'6'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111000000'B,'0001100000001100'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100001100000'B,'0001100000000000'B,'0001111111111100'B,
X '0001100000000000'B,'0001111111111000'B,'0001111111111110'B,
X '0001111111000000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100001100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100001100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111100000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111000000'B,'0000111111111000'B,'0000011111111100'B,
X{'7'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000001110'B,
X '0001111111110000'B,'0000000000011000'B,'0000000000011100'B,
X '0001111111110000'B,'0000000000110000'B,'0000000000111000'B,
X '0000000001100000'B,'0000000001100000'B,'0000000001110000'B,
X '0000000011000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000110000000'B,'0000000111000000'B,
X '0000001100000000'B,'0000001100000000'B,'0000001110000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000110000000000'B,'0000110000000000'B,'0000111000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X{'8'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0000011111111100'B,
X '0001100000110000'B,'0000111111111000'B,'0000011111111100'B,
X '0000111111100000'B,'0000111111111000'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X{'9'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0000111111111111'B,
X '0001100000110000'B,'0001111111111100'B,'0000011111111111'B,
X '0001111111110000'B,'0000111111111100'B,'0000000000000111'B,
X '0000111111110000'B,'0000000000001100'B,'0000000000000111'B,
X '0000000000110000'B,'0000000000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X%PAGE
X{'.'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0001111110000000'B,
X{':'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0000000000000000'B,
X '0001111000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0001111110000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111110000000'B,
X '0001111000000000'B,'0001111100000000'B,'0000000000000000'B,
X '0001111000000000'B,'0001111100000000'B,'0000000000000000'B,
X '0001111000000000'B,'0001111100000000'B,'0000000000000000'B,
X{'/'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000011000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000011000000'B,'0000000000000111'B,
X '0000000110000000'B,'0000000110000000'B,'0000000000001110'B,
X '0000000110000000'B,'0000000110000000'B,'0000000000011100'B,
X '0000001100000000'B,'0000001100000000'B,'0000000000111000'B,
X '0000001100000000'B,'0000001100000000'B,'0000000001110000'B,
X '0000001100000000'B,'0000001100000000'B,'0000000011100000'B,
X '0000011000000000'B,'0000011000000000'B,'0000000111000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000001110000000'B,
X '0000110000000000'B,'0000110000000000'B,'0000011100000000'B,
X '0001100000000000'B,'0001100000000000'B,'0000111000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X%PAGE
X{'$'}
X '0000000000000000'B,'0000000000000000'B,'0000001111110000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000000110000000'B,'0001110011100111'B,
X '0000000000000000'B,'0000111111110000'B,'0001110011100111'B,
X '0000001100000000'B,'0001111111111000'B,'0000111011100000'B,
X '0000111111000000'B,'0001100110011000'B,'0000011111100000'B,
X '0001101101100000'B,'0001100110000000'B,'0000000111100000'B,
X '0001101100000000'B,'0001111111110000'B,'0000000011110000'B,
X '0001111111000000'B,'0000111111111000'B,'0000000011111100'B,
X '0000111111100000'B,'0000000110011000'B,'0000000011101110'B,
X '0000001101100000'B,'0001100110011000'B,'0001110011100111'B,
X '0001101101100000'B,'0001111111111000'B,'0001110011100111'B,
X '0000111111000000'B,'0000111111110000'B,'0000111111111110'B,
X '0000001100000000'B,'0000000110000000'B,'0000001111110000'B,
X{'@'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110001100111'B,
X '0001111111110000'B,'0001100011111100'B,'0001110011110111'B,
X '0001100000110000'B,'0001100110001100'B,'0001110110010111'B,
X '0001100111110000'B,'0001100110001100'B,'0001110110011110'B,
X '0001101100110000'B,'0001100111111100'B,'0001110011111100'B,
X '0001101111110000'B,'0001100011111000'B,'0001110001100000'B,
X '0001100111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000010000'B,'0001100000001100'B,'0001110000000001'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B);
X%PAGE
X fontWidth := FontWidthType (
X 06,06,06, {' '}
X 12,14,16, {'A'}
X 12,14,16, {'B'}
X 12,14,16, {'C'}
X 12,14,16, {'D'}
X 12,14,16, {'E'}
X 12,14,16, {'F'}
X 12,14,16, {'G'}
X 12,14,16, {'H'}
X 09,09,16, {'I'}
X 10,12,16, {'J'}
X 11,12,16, {'K'}
X 12,14,16, {'L'}
X 13,15,16, {'M'}
X 13,15,16, {'N'}
X 12,14,16, {'O'}
X 12,14,16, {'P'}
X 12,14,16, {'Q'}
X 12,14,16, {'R'}
X 12,13,16, {'S'}
X 13,15,16, {'T'}
X 12,14,16, {'U'}
X 13,15,16, {'V'}
X 12,14,16, {'W'}
X 14,16,16, {'X'}
X 15,16,16, {'Y'}
X 12,14,16, {'Z'}
X 09,10,11, {'a'}
X 09,10,11, {'b'}
X 09,10,11, {'c'}
X 09,10,11, {'d'}
X 09,10,11, {'e'}
X 09,10,11, {'f'}
X 09,10,11, {'g'}
X 08,10,11, {'h'}
X 06,09,09, {'i'}
X 07,09,09, {'j'}
X 07,10,10, {'k'}
X 07,10,10, {'l'}
X 09,12,12, {'m'}
X 08,11,12, {'n'}
X 08,10,11, {'o'}
X 08,10,11, {'p'}
X 09,10,11, {'q'}
X 08,10,11, {'r'}
X 08,10,11, {'s'}
X 08,11,11, {'t'}
X 08,11,11, {'u'}
X 08,11,13, {'v'}
X 10,13,13, {'w'}
X 08,11,12, {'x'}
X 08,11,13, {'y'}
X 08,09,10, {'z'}
X 11,11,16, {'0'}
X 09,09,16, {'1'}
X 10,11,16, {'2'}
X 11,11,16, {'3'}
X 12,15,16, {'4'}
X 11,12,16, {'5'}
X 11,14,16, {'6'}
X 12,14,16, {'7'}
X 12,14,16, {'8'}
X 12,14,16, {'9'}
X 07,08,16, {'.'}
X 07,08,16, {':'}
X 09,10,16, {'/'}
X 11,13,16, {'$'}
X 12,14,16 {'@'}
X );
X{ Initialize font descriptions }
Xprocedure FontInit;
Xbegin
X CvtSST(' ABCDEFGHIJKLMNOPQRSTUVWXYZ'||
X 'abcdefghijklmnopqrstuvwxyz'||
X '0123456789.:/$@', transArray);
X fontFirst[0] := 4;
X fontFirst[1] := 2;
X fontFirst[2] := 0;
Xend;
/
echo 'x - hashfind.pascal'
sed 's/^X//' > hashfind.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ HashFind -- find name in hash table }
Xsegment HashFind;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction HashFind;
Xvar
X p: NDPtr;
X tempName: StringType;
X found: Boolean;
Xbegin
X found := false;
X p := hashTab[Hash(name)];
X while (not found) and (p <> nil) do begin
X CSCopy(NDTable, p->.name, tempName);
X if (Equal(name, tempName)) then
X found := true
X else
X p := p->.nextPtr
X end;
X HashFind := p
Xend;
/
echo 'Part 01 of pack.out complete.'
exitsources-request@genrad.UUCP (07/13/85)
Mod.sources: Volume 2, Issue 8
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 02 of 06:'
echo 'x - charclas.pascal'
sed 's/^X//' > charclas.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CharClass -- definition of character table }
Xsegment CharClass;
X%include swtools
X%include chardef
Xvalue
X CharTable := ChTable(
X [] { 00 }, [] { 01 }, [] { 02 }, [] { 03 },
X [] { 04 }, [] { 05 }, [] { 06 }, [] { 07 },
X [] { 08 }, [] { 09 }, [] { 0a }, [] { 0b },
X [] { 0c }, [] { 0d }, [] { 0e }, [] { 0f },
X [] { 10 }, [] { 11 }, [] { 12 }, [] { 13 },
X [] { 14 }, [] { 15 }, [] { 16 }, [] { 17 },
X [] { 18 }, [] { 19 }, [] { 1a }, [] { 1b },
X [] { 1c }, [] { 1d }, [] { 1e }, [] { 1f },
X [] { 20 }, [] { 21 }, [] { 22 }, [] { 23 },
X [] { 24 }, [] { 25 }, [] { 26 }, [] { 27 },
X [] { 28 }, [] { 29 }, [] { 2a }, [] { 2b },
X [] { 2c }, [] { 2d }, [] { 2e }, [] { 2f },
X [] { 30 }, [] { 31 }, [] { 32 }, [] { 33 },
X [] { 34 }, [] { 35 }, [] { 36 }, [] { 37 },
X [] { 38 }, [] { 39 }, [] { 3a }, [] { 3b },
X [] { 3c }, [] { 3d }, [] { 3e }, [] { 3f },
X [ChSpecial] { 40 },
X [] { 41 }, [] { 42 }, [] { 43 },
X [] { 44 }, [] { 45 }, [] { 46 }, [] { 47 },
X [] { 48 }, [] { 49 },
X [ChSpecial] { 4a }, [ChSpecial] { 4b },
X [ChSpecial] { 4c }, [ChSpecial] { 4d },
X [ChSpecial] { 4e }, [ChSpecial] { 4f },
X [ChSpecial] { 50 },
X [] { 51 }, [] { 52 }, [] { 53 },
X [] { 54 }, [] { 55 }, [] { 56 }, [] { 57 },
X [] { 58 }, [] { 59 },
X [ChSpecial] { 5a }, [ChSpecial] { 5b },
X [ChSpecial] { 5c }, [ChSpecial] { 5d },
X [ChSpecial] { 5e }, [ChSpecial] { 5f },
X [ChSpecial] { 60 }, [ChSpecial] { 61 },
X [] { 62 }, [] { 63 },
X [] { 64 }, [] { 65 }, [] { 66 }, [] { 67 },
X [] { 68 }, [] { 69 }, [] { 6a },
X [ChSpecial] { 6b },
X [ChSpecial] { 6c }, [ChSpecial] { 6d },
X [ChSpecial] { 6e }, [ChSpecial] { 6f },
X [] { 70 }, [] { 71 }, [] { 72 }, [] { 73 },
X [] { 74 }, [] { 75 }, [] { 76 }, [] { 77 },
X [] { 78 }, [] { 79 },
X [ChSpecial] { 7a }, [ChSpecial] { 7b },
X [ChSpecial] { 7c }, [ChSpecial] { 7d },
X [ChSpecial] { 7e }, [ChSpecial] { 7f },
X [] { 80 },
X [ChLetter,ChLower] { 81 },
X [ChLetter,ChLower] { 82 }, [ChLetter,ChLower] { 83 },
X [ChLetter,ChLower] { 84 }, [ChLetter,ChLower] { 85 },
X [ChLetter,ChLower] { 86 }, [ChLetter,ChLower] { 87 },
X [ChLetter,ChLower] { 88 }, [ChLetter,ChLower] { 89 },
X [] { 8a },
X [ChSpecial] { 8b },
X [] { 8c }, [] { 8d }, [] { 8e }, [] { 8f },
X [] { 90 },
X [ChLetter,ChLower] { 91 },
X [ChLetter,ChLower] { 92 }, [ChLetter,ChLower] { 93 },
X [ChLetter,ChLower] { 94 }, [ChLetter,ChLower] { 95 },
X [ChLetter,ChLower] { 96 }, [ChLetter,ChLower] { 97 },
X [ChLetter,ChLower] { 98 }, [ChLetter,ChLower] { 99 },
X [] { 9a },
X [ChSpecial] { 9b },
X [] { 9c }, [] { 9d }, [] { 9e }, [] { 9f },
X [] { a0 }, [] { a1 },
X [ChLetter,ChLower] { a2 }, [ChLetter,ChLower] { a3 },
X [ChLetter,ChLower] { a4 }, [ChLetter,ChLower] { a5 },
X [ChLetter,ChLower] { a6 }, [ChLetter,ChLower] { a7 },
X [ChLetter,ChLower] { a8 }, [ChLetter,ChLower] { a9 },
X [] { aa }, [] { ab },
X [] { ac },
X [ChSpecial] { ad },
X [] { ae }, [] { af },
X [] { b0 }, [] { b1 }, [] { b2 }, [] { b3 },
X [] { b4 }, [] { b5 }, [] { b6 }, [] { b7 },
X [] { b8 }, [] { b9 }, [] { ba }, [] { bb },
X [] { bc },
X [ChSpecial] { bd },
X [] { be }, [] { bf },
X [] { c0 },
X [ChLetter,ChUpper] { c1 },
X [ChLetter,ChUpper] { c2 }, [ChLetter,ChUpper] { c3 },
X [ChLetter,ChUpper] { c4 }, [ChLetter,ChUpper] { c5 },
X [ChLetter,ChUpper] { c6 }, [ChLetter,ChUpper] { c7 },
X [ChLetter,ChUpper] { c8 }, [ChLetter,ChUpper] { c9 },
X [] { ca }, [] { cb },
X [] { cc }, [] { cd }, [] { ce }, [] { cf },
X [] { d0 },
X [ChLetter,ChUpper] { d1 },
X [ChLetter,ChUpper] { d2 }, [ChLetter,ChUpper] { d3 },
X [ChLetter,ChUpper] { d4 }, [ChLetter,ChUpper] { d5 },
X [ChLetter,ChUpper] { d6 }, [ChLetter,ChUpper] { d7 },
X [ChLetter,ChUpper] { d8 }, [ChLetter,ChUpper] { d9 },
X [] { da }, [] { db },
X [] { dc }, [] { dd }, [] { de }, [] { df },
X [] { e0 }, [] { e1 },
X [ChLetter,ChUpper] { e2 }, [ChLetter,ChUpper] { e3 },
X [ChLetter,ChUpper] { e4 }, [ChLetter,ChUpper] { e5 },
X [ChLetter,ChUpper] { e6 }, [ChLetter,ChUpper] { e7 },
X [ChLetter,ChUpper] { e8 }, [ChLetter,ChUpper] { e9 },
X [] { ea }, [] { eb },
X [] { ec }, [] { ed }, [] { ee }, [] { ef },
X [ChDigit] { f0 }, [ChDigit] { f1 },
X [ChDigit] { f2 }, [ChDigit] { f3 },
X [ChDigit] { f4 }, [ChDigit] { f5 },
X [ChDigit] { f6 }, [ChDigit] { f7 },
X [ChDigit] { f8 }, [ChDigit] { f9 },
X [] { fa }, [] { fb },
X [] { fc }, [] { fd }, [] { fe }, [] { ff }
X );
Xfunction CharClass;
Xbegin
X CharClass := CharTable[Ord(tIndex)]
Xend;
/
echo 'x - docmd.pascal'
sed 's/^X//' > docmd.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoCmd -- handle all commands except globals }
Xsegment DoCmd;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoCmd;
Xvar
X fil, sub: StringType;
X line3: Integer;
X gFlag, pFlag: Boolean;
Xbegin
X pFlag := false; { may be set by d, m, s }
X status := ERR;
X case lin[i] of
X PCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X status := DoPrint(line1, line2);
X LCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X status := DoLPrint(line1, line2);
X NEWLINE: begin
X if (nLines = 0) then begin
X line2 := nextLn(curLn);
X line1 := line2;
X end; {if}
X status := DoPrint(line1, line2)
X end;
X QCMD:
X if (lin[i+1] = NEWLINE) and (nLines = 0) and (not glob) then
X status := ENDDATA;
X OCMD:
X if (not glob) then
X status := DoOption(lin, i);
X ACMD:
X if (lin[i+1] = NEWLINE) then
X status := Append(line2, glob);
X CCMD:
X if (lin[i+1] = NEWLINE) then
X if (Default(curLn, curLn, status) = OK) then
X if (LnDelete(line1, line2, status) = OK) then
X status := Append(PrevLn(line1), glob);
X DCMD:
X if (CkP(lin, i+1, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X if (LnDelete(line1, line2, status) = OK) then
X if (NextLn(curLn) <> 0) then
X curLn := NextLn(curLn);
X ICMD:
X if (lin[i+1] = NEWLINE) then begin
X if (line2 = 0) then
X status := Append(0, glob)
X else
X status := Append(PrevLn(line2), glob)
X end;
X EQCMD:
X if (CkP(lin, i+1, pFlag, status) = OK) then begin
X PutDec(line2, 1);
X PutC(NEWLINE);
X end;
X KCMD: begin
X i := i + 1;
X SkipBl(lin, i);
X if (GetOne(lin, i, line3, status) = ENDDATA) then
X status := ERR;
X if (status = OK) then
X if (CkP(lin, i, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X status := Kopy(line3)
X end;
X MCMD: begin
X i := i + 1;
X SkipBl(lin, i);
X if (GetOne(lin, i, line3, status) = ENDDATA) then
X status := ERR;
X if (status = OK) then
X if (CkP(lin, i, pFlag, status) = OK) then
X if (Default(curLn, curLn, status) = OK) then
X status := Move(line3)
X end;
X SCMD: begin
X i := i + 1;
X if (OptPat(lin,i) = OK) then
X if (GetRHS(lin,i,sub,gFlag) = OK) then
X if (CkP(lin,i+1,pFlag,status) = OK) then
X if (Default(curLn,curLn,status) = OK) then
X status := SubSt(sub, gFlag, glob)
X end;
X ECMD:
X if (nLines = 0) then
X if (GetFn(lin, i, fil) = OK) then begin
X SCopy(fil, 1, saveFile, 1);
X ClrBuf;
X SetBuf;
X status := DoRead(0, fil)
X end;
X FCMD:
X if (nLines = 0) then
X if (GetFn(lin,i,fil) = OK) then begin
X SCopy(fil, 1, saveFile, 1);
X PutStr(saveFile, STDOUT);
X PutC(NEWLINE);
X status := OK
X end;
X RCMD:
X if (GetFn(lin, i, fil) = OK) then
X status := DoRead(line2, fil);
X WCMD:
X if (GetFn(lin,i,fil) = OK) then
X if (Default(1, lastLn, status) = OK) then
X status := DoWrite(line1, line2, fil)
X otherwise
X status := ERR
X end;
X if (status = OK) and (pFlag) then
X status := DoPrint(curLn, curLn);
X DoCmd := status
Xend;
/
echo 'x - fontinit.A'
sed 's/^X//' > fontinit.A << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Font -- definitions of font file }
Xsegment FontInit;
X%include swtools
Xconst
X nChars = 68;
X charHeight = 14;
X nFonts = 3;
X nElements = nChars * charHeight * nFonts;
Xtype
X CharElement = packed -32768..32767;
X ElementArray = array [1..nElements] of CharElement;
X FontFirstType = array [0..nFonts-1] of 0..charHeight-1;
X FontWidthType = packed array [1..nChars * nFonts] of
X 0..16;
Xdef
X fontWidth: FontWidthType;
X fontFirst: array [0..nFonts-1] of 0..charHeight-1;
X Displays: ElementArray;
X transArray: StringType;
Xprocedure FontInit; external;
X%PAGE
X{ BANNER FONTS }
Xvalue
X Displays := ElementArray(
X{' '}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X{'A'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X{'B'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0000011100000111'B,
X '0000000000000000'B,'0001111111111100'B,'0000011100000111'B,
X '0001111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011111111100'B,
X '0000110000110000'B,'0000011111111000'B,'0000011111111100'B,
X '0000111111100000'B,'0000011111111000'B,'0000011100000111'B,
X '0000111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111110'B,
X '0001111111100000'B,'0001111111111000'B,'0001111111111100'B,
X%PAGE
X{'C'}
X '0000000000000000'B,'0000000000000000'B,'0000111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111000000'B,'0001100000001100'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100001100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000111'B,
X '0001100001100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111100000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111000000'B,'0000111111111000'B,'0000011111111100'B,
X{'D'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0000011100000111'B,
X '0000000000000000'B,'0001111111111100'B,'0000011100000111'B,
X '0001111111100000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0000110000110000'B,'0000011000001100'B,'0000011100000111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111110'B,
X '0001111111100000'B,'0001111111111000'B,'0001111111111100'B,
X{'E'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001111111111000'B,
X '0001100000000000'B,'0001111111100000'B,'0001111111111000'B,
X '0001111110000000'B,'0001111111100000'B,'0001110000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X%PAGE
X{'F'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001111111111000'B,
X '0001100000000000'B,'0001111111100000'B,'0001111111111000'B,
X '0001111110000000'B,'0001111111100000'B,'0001110000000000'B,
X '0001111110000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X{'G'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000000'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000110000'B,'0001100000000000'B,'0001110001111110'B,
X '0001100000000000'B,'0001100000000000'B,'0001110001111111'B,
X '0001100111100000'B,'0001100001111000'B,'0001110000000111'B,
X '0001100111110000'B,'0001100001111100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X{'H'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X%PAGE
X{'I'}
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000011100000000'B,
X '0000000000000000'B,'0001111110000000'B,'0000011100000000'B,
X '0001111110000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111110000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000011100000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X '0001111110000000'B,'0001111110000000'B,'0001111111000000'B,
X{'J'}
X '0000000000000000'B,'0000000000000000'B,'0000000011111111'B,
X '0000000000000000'B,'0000000000000000'B,'0000000011111111'B,
X '0000000000000000'B,'0000000111111110'B,'0000000011111111'B,
X '0000000000000000'B,'0000000111111110'B,'0000000000011100'B,
X '0000001111110000'B,'0000000000110000'B,'0000000000011100'B,
X '0000001111110000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0000000000110000'B,'0000000000011100'B,
X '0000000011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001100011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001111111000000'B,'0000111111110000'B,'0000111111111100'B,
X '0000111110000000'B,'0000011111100000'B,'0000011111111000'B,
X{'K'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000001110'B,
X '0000000000000000'B,'0001100000110000'B,'0001110000011100'B,
X '0000000000000000'B,'0001100001100000'B,'0001110000111000'B,
X '0001100001100000'B,'0001100011000000'B,'0001110001110000'B,
X '0001100011000000'B,'0001100110000000'B,'0001110011100000'B,
X '0001100110000000'B,'0001101100000000'B,'0001111111000000'B,
X '0001101100000000'B,'0001111000000000'B,'0001111111000000'B,
X '0001111000000000'B,'0001111000000000'B,'0001110011100000'B,
X '0001111000000000'B,'0001101100000000'B,'0001110001110000'B,
X '0001101100000000'B,'0001100110000000'B,'0001110000111000'B,
X '0001100110000000'B,'0001100011000000'B,'0001110000011100'B,
X '0001100011000000'B,'0001100001100000'B,'0001110000001110'B,
X '0001100001100000'B,'0001100000110000'B,'0001110000000111'B,
X%PAGE
X{'L'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0000000000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X{'M'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000001'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000001110'B,'0001111000001111'B,
X '0001100000011000'B,'0001111000011110'B,'0001111100011111'B,
X '0001110000111000'B,'0001111100111110'B,'0001111110111111'B,
X '0001111001111000'B,'0001101111110110'B,'0001111111111111'B,
X '0001111111111000'B,'0001100111100110'B,'0001110111110111'B,
X '0001101111011000'B,'0001100011000110'B,'0001110011100111'B,
X '0001100110011000'B,'0001100000000110'B,'0001110001000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X{'N'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000000110'B,'0001111000000111'B,
X '0001100000011000'B,'0001111000000110'B,'0001111100000111'B,
X '0001110000011000'B,'0001111100000110'B,'0001111110000111'B,
X '0001111000011000'B,'0001101110000110'B,'0001110111000111'B,
X '0001111100011000'B,'0001100111000110'B,'0001110011100111'B,
X '0001101110011000'B,'0001100011100110'B,'0001110001110111'B,
X '0001100111011000'B,'0001100001110110'B,'0001110000111111'B,
X '0001100011111000'B,'0001100000111110'B,'0001110000011111'B,
X '0001100001111000'B,'0001100000011110'B,'0001110000001111'B,
X '0001100000111000'B,'0001100000001110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000011'B,
X%PAGE
X{'O'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111111000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111111000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111110000'B,'0000111111111000'B,'0000011111111100'B,
X{'P'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111110'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111100'B,
X '0001111111110000'B,'0001111111111000'B,'0001110000000000'B,
X '0001111111100000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X '0001100000000000'B,'0001100000000000'B,'0001110000000000'B,
X{'Q'}
X '0000000000000000'B,'0000000000000000'B,'0000011111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001100111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001110111'B,
X '0001100000110000'B,'0001100011001100'B,'0001110000111111'B,
X '0001100110110000'B,'0001100001101100'B,'0001110000011111'B,
X '0001100011110000'B,'0001100000111100'B,'0001110000001110'B,
X '0001111111100000'B,'0001111111111000'B,'0000111111111111'B,
X '0000111110110000'B,'0000111111101100'B,'0000011111110011'B,
X%PAGE
X{'R'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111100'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111110'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111100'B,'0001110000000111'B,
X '0001111111100000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111110'B,
X '0001100000110000'B,'0001111111111100'B,'0001111111111100'B,
X '0001111111110000'B,'0001111111111000'B,'0001110011100000'B,
X '0001111111100000'B,'0001100011000000'B,'0001110001110000'B,
X '0001100110000000'B,'0001100001100000'B,'0001110000111000'B,
X '0001100011000000'B,'0001100000110000'B,'0001110000011100'B,
X '0001100001100000'B,'0001100000011000'B,'0001110000001110'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X{'S'}
X '0000000000000000'B,'0000000000000000'B,'0000001111111000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111111110'B,
X '0000000000000000'B,'0000111111110000'B,'0001110000000111'B,
X '0000000000000000'B,'0001111111111000'B,'0001110000000111'B,
X '0000111111100000'B,'0001100000011000'B,'0000111000000000'B,
X '0001111111110000'B,'0001100000000000'B,'0000011100000000'B,
X '0001100000110000'B,'0001100000000000'B,'0000000111000000'B,
X '0001100000000000'B,'0001111111110000'B,'0000000001110000'B,
X '0001111111100000'B,'0000111111111000'B,'0000000000011100'B,
X '0000111111110000'B,'0000000000011000'B,'0000000000001110'B,
X '0000000000110000'B,'0000000000011000'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000011000'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111000'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111110000'B,'0000001111111000'B,
X{'T'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111110'B,'0000000011100000'B,
X '0000000000000000'B,'0001111111111110'B,'0000000011100000'B,
X '0001111111111000'B,'0000000011000000'B,'0000000011100000'B,
X '0001111111111000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000011100000'B,
X%PAGE
X{'U'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110000000111'B,
X '0001111111110000'B,'0001111111111100'B,'0000111111111110'B,
X '0000111111100000'B,'0000111111111000'B,'0000011111111100'B,
X{'V'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0001110000000111'B,
X '0001100000011000'B,'0001100000000110'B,'0000110000001110'B,
X '0001100000011000'B,'0000110000001100'B,'0000011100011100'B,
X '0000110000110000'B,'0000011000011000'B,'0000001110111000'B,
X '0000011001100000'B,'0000001100110000'B,'0000000111110000'B,
X '0000001111000000'B,'0000000111100000'B,'0000000011100000'B,
X '0000000110000000'B,'0000000011000000'B,'0000000001000000'B,
X{'W'}
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000001100'B,'0001110001000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110001000111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110011100111'B,
X '0001100000110000'B,'0001100000001100'B,'0001110111110111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111111111111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111110111111'B,
X '0001100000110000'B,'0001100000001100'B,'0001111100011111'B,
X '0001100100110000'B,'0001100010001100'B,'0001111000001111'B,
X '0001101110110000'B,'0000110111011000'B,'0001110000000111'B,
X '0000111011100000'B,'0000011101110000'B,'0001100000000011'B,
X '0000010001000000'B,'0000001000100000'B,'0001000000000001'B,
X%PAGE
X{'X'}
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0000000000000000'B,'0001110000000111'B,
X '0000000000000000'B,'0001100000000011'B,'0000111000001110'B,
X '0000000000000000'B,'0000110000000110'B,'0000011100011100'B,
X '0001100000001100'B,'0000011000001100'B,'0000001110111000'B,
X '0000110000011000'B,'0000001100011000'B,'0000000111110000'B,
X '0000011000110000'B,'0000000110110000'B,'0000000011100000'B,
X '0000001101100000'B,'0000000011100000'B,'0000000111110000'B,
X '0000000111000000'B,'0000000011100000'B,'0000001110111000'B,
X '0000000111000000'B,'0000000110110000'B,'0000011100011100'B,
X '0000001101100000'B,'0000001100011000'B,'0000111000001110'B,
X '0000011000110000'B,'0000011000001100'B,'0001110000000111'B,
X '0000110000011000'B,'0000110000000110'B,'0001100000000011'B,
X '0001100000001100'B,'0001100000000011'B,'0001000000000001'B,
X{'Y'}
X '0000000000000000'B,'0000000000000000'B,'0001000000000001'B,
X '0000000000000000'B,'0000000000000000'B,'0001100000000011'B,
X '0000000000000000'B,'0001100000000011'B,'0001110000000111'B,
X '0000000000000000'B,'0001110000000111'B,'0000111000001110'B,
X '0001100000000110'B,'0000111000001110'B,'0000011100011100'B,
X '0000110000001100'B,'0000011100011100'B,'0000001110111000'B,
X '0000011000011000'B,'0000001110111000'B,'0000000111110000'B,
X '0000001100110000'B,'0000000111110000'B,'0000000011100000'B,
X '0000000111100000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011100000'B,'0000000011100000'B,
X{'Z'}
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111111111'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000001110'B,
X '0000000000000000'B,'0001111111111100'B,'0000000000011100'B,
X '0001111111110000'B,'0000000000011000'B,'0000000000111000'B,
X '0001111111110000'B,'0000000000110000'B,'0000000001110000'B,
X '0000000001100000'B,'0000000001100000'B,'0000000011100000'B,
X '0000000011000000'B,'0000000011000000'B,'0000000111000000'B,
X '0000000110000000'B,'0000000110000000'B,'0000001110000000'B,
X '0000001100000000'B,'0000001100000000'B,'0000011100000000'B,
X '0000011000000000'B,'0000011000000000'B,'0000111000000000'B,
X '0000110000000000'B,'0000110000000000'B,'0001110000000000'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X '0001111111110000'B,'0001111111111100'B,'0001111111111111'B,
X%PAGE
X{'a'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0000111100000000'B,'0001100011000000'B,'0001111111100000'B,
X '0001000010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111110000000'B,'0001111111000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001100011000000'B,'0001100001100000'B,
X{'b'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0001111111000000'B,
X '0000000000000000'B,'0001111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0000110001100000'B,
X '0001111100000000'B,'0000100011000000'B,'0000111111000000'B,
X '0000100010000000'B,'0000111110000000'B,'0000111111000000'B,
X '0000111100000000'B,'0000100011000000'B,'0000110001100000'B,
X '0000100010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0001111100000000'B,'0001111110000000'B,'0001111111000000'B,
X{'c'}
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000000000000000'B,
X '0000000000000000'B,'0000000000000000'B,'0000111111000000'B,
X '0000000000000000'B,'0000111110000000'B,'0001111111100000'B,
X '0000000000000000'B,'0001111111000000'B,'0001100001100000'B,
X '0000111110000000'B,'0001100011000000'B,'0001100000000000'B,
X '0001000010000000'B,'0001100000000000'B,'0001100000000000'B,
X '0001000000000000'B,'0001100011000000'B,'0001100001100000'B,
X '0001000010000000'B,'0001111111000000'B,'0001111111100000'B,
X '0000111110000000'B,'0000111110000000'B,'0000111111000000'B,
X%PAGE
/
echo 'x - sort.pascal'
sed 's/^X//' > sort.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SortDriv -- Driver and Quick sort }
Xprogram Sort;
X%include SWTOOLS
X%include ioref
Xconst
X inCoreSize = 500;
X MERGEORDER = 5;
Xtype
X LineType = -> StringType;
X fdBufType = array [1..MERGEORDER] of FileDesc;
Xvar
X notEof: Boolean;
X inBuf: array [1..inCoreSize] of LineType;
X inFile: fdBufType;
X i: Integer;
X temp: StringType;
X depth: Integer;
X maxDepth: Integer;
Xprocedure GName (n: Integer; var name: StringType);
Xvar
X junk: Integer;
X temp: String(30);
Xbegin
X WriteStr(temp, 'STEMP',n:1,' TEMP A');
X name := temp;
Xend; {GName}
Xprocedure GOpen (var inFile: fdBufType; f1, f2: Integer);
Xvar
X name: StringType;
X i: 1..MERGEORDER;
Xbegin
X for i := 1 to f2-f1+1 do begin
X GName (f1+i-1, name);
X inFile[i] := MustOpen(name, IOREAD);
X end; {for}
Xend; {GOpen}
Xprocedure GRemove (var inFile: fdBufType; f1, f2: Integer);
Xvar
X name: StringType;
X i: 1..MERGEORDER;
Xbegin
X for i := 1 to f2-f1+1 do begin
X FClose (inFile[i]);
X GName (f1+i-1, name);
X Remove (name);
X end; {for}
Xend; {GRemove}
Xfunction MakeFile (n: Integer): FileDesc;
Xvar
X name: StringType;
X temp: FileDesc;
Xbegin
X GName (n, name);
X temp := FCreate (name, IOWRITE);
X if temp = IOERROR then
X Error('Could not create temporary file' || Str(name));
X MakeFile := temp;
Xend; {MakeFile}
Xprocedure PText (nLines: Integer; outFile: FileDesc);
Xvar
X i: Integer;
Xbegin
X for i := 1 to nLines do begin
X PutStr(inBuf[i]@, outFile);
X end; {for}
Xend; {PText}
Xfunction GText (var nLines: Integer; inFile: FileDesc): Boolean;
Xvar
X temp: StringType;
X done: Boolean;
Xbegin
X nLines := 1;
X done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
X while (not done) do begin
X nLines := nLines + 1;
X if nLines > inCoreSize then leave;
X done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
X end; {while}
X nLines := nLines - 1;
X GText := done;
Xend; {GText}
X
Xprocedure QSort(l,r: integer);
X var i,j: integer;
X temp, hold: LineType;
Xbegin
X if l >= r then return;
X depth := depth + 1;
X maxDepth := Max (maxDepth, depth);
X i := l;
X j := r;
X temp := inBuf[(i+j) div 2];
X repeat
X while inBuf[i]@ < temp@ do
X i := i+1;
X while temp@ < inBuf[j]@ do
X j := j-1;
X if i <= j then begin
X hold := inBuf[i];
X inBuf[i] := inBuf[j];
X inBuf[j] := hold;
X i := i+1;
X j := j-1
X end
X until i > j;
X { if left smaller do: }
X if (j - l) < (r - i) then begin
X QSort(l,j); {left side first}
X QSort(i,r);
X end
X else begin
X QSort(i,r); {right side first}
X QSort(l,j);
X end; {if}
X depth := depth - 1;
Xend {QSort} ;
X{ Merge -- Merge infile[1] .. infile[nf] into outfile }
Xprocedure Merge(var inFile: fdBufType; nf: Integer; outFile: FileDesc);
Xvar
X i,j: Integer;
X lbp: Integer;
X temp: LineType;
X fromArray: array [1..MERGEORDER] of Integer;
Xprocedure ReHeap (nf: Integer);
Xvar
X i,j,k: Integer;
X temp: LineType;
Xbegin
X i := 1;
X j := 2 * i;
X while (j <= nf) do begin
X if (j < nf) then { find smaller child }
X if inBuf[j]@ > inBuf[j+1]@ then
X j := j + 1;
X if inBuf[i]@ <= inBuf[j]@ then
X i := nf { proper position found, terminate loop }
X else begin
X k := fromArray[i];
X fromArray[i] := fromArray[j];
X fromArray[j] := k;
X temp := inBuf[i];
X inBuf[i] := inBuf[j];
X inBuf[j] := temp;
X end; {if}
X i := j;
X j := 2 * i;
X end; {while}
Xend; {while}
Xprocedure PermSort(l,r: Integer);
Xvar
X i,j,k: Integer;
X temp: LineType;
Xbegin
X for i := 1 to r do
X fromArray[i] := i;
X
X for i := r downto 2 do
X for j := 1 to i-1 do
X if inBuf[j]@ > inBuf[j + 1]@ then begin
X k := fromArray[j];
X fromArray[j] := fromArray[j + 1];
X fromArray[j + 1] := k;
X temp := inBuf[j];
X inBuf[j] := inBuf[j + 1];
X inBuf[j + 1] := temp;
X end; {if}
Xend; {PermSort}
Xbegin
X j := 1;
X for i := 1 to nf do { get one line from each file }
X if GetLine(inBuf[j]@, inFile[i], MAXSTR) then
X j := j + 1;
X nf := j - 1;
X PermSort (1, nf); { make initial heap }
X while (nf > 0) do begin
X PutStr(inBuf[1]@, outFile);
X if not
X (GetLine(inBuf[1]@, inFile[fromArray[1]], MAXSTR))
X then begin
X temp := inBuf[1];
X inBuf[1] := inBuf[nf];
X inBuf[nf] := temp;
X fromArray[1] := fromArray[nf];
X nf := nf - 1;
X end; {if}
X ReHeap(nf);
X end; {while}
Xend; {Merge}
X
Xvar
X done: Boolean;
X nLines: Integer;
X highMark: Integer;
X lowMark: Integer;
X lim: Integer;
X outFile: FileDesc;
X name: StringType;
Xbegin
X ToolInit;
X highMark := 0;
X for i := 1 to inCoreSize do
X New(inBuf[i]);
X
X repeat { initial formation of runs }
X done := GText (nLines, STDIN);
X depth := 0;
X maxDepth := 0;
X QSort(1, nLines);
X highMark := highMark + 1;
X outFile := MakeFile(highMark);
X PText (nLines, outFile);
X FClose (outFile);
X until (done);
X lowMark := 1;
X while (lowMark < highMark) do begin { merge runs }
X lim := Min(lowMark + MERGEORDER - 1, highMark);
X GOpen (inFile, lowMark, lim);
X highMark := highMark + 1;
X outFile := MakeFile(highMark);
X Merge(inFile, lim-lowMark+1, outFile);
X FClose (outFile);
X GRemove (inFile, lowMark, lim);
X lowMark := lowMark + MERGEORDER;
X end; {while}
X GName (highMark, name); { final cleanup }
X outFile := FOpen (name, IOREAD);
X FCopy (outFile, STDOUT);
X FClose (outFile);
X Remove (name);
Xend.
/
echo 'Part 02 of pack.out complete.'
exitsources-request@genrad.UUCP (07/13/85)
Mod.sources: Volume 2, Issue 9
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 03 of 06:'
echo 'x - amatch.pascal'
sed 's/^X//' > amatch.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ AMatch -- look for match of pat[i]... at lin[offset]... }
Xsegment AMatch;
X%include swtools
X%include patdef
X%include matchdef
X%include metadef
Xfunction RAMatch (var lin: StringType; offset: Integer;
X var pat: StringType; j: Integer): Integer;
X forward;
Xfunction AMatch;
Xvar
X k: Integer;
Xbegin
X metaStackPointer := 1;
X metaIndex := 1;
X metaTable := nullMetaTable;
X metaTable[0].first := offset;
X k := RAMatch(lin, offset, pat, j);
X metaTable[0].last := k;
X AMatch := k;
Xend;
X{ RAMatch -- new AMatch with metas }
Xfunction RAMatch;
Xvar
X i, k: Integer;
X metaStackTemp: Integer;
X done: Boolean;
Xbegin
X done := false;
X while (not done) and (pat[j] <> ENDSTR) do
X if (pat[j] = CLOSURE) then begin
X metaStackTemp := metaStackPointer;
X j := j + PatSize(pat, j);
X i := offset;
X {match as many as possible }
X while (not done) and (lin[i] <> ENDSTR) do
X if (not OMatch(lin, i, pat, j)) then begin
X metaStackPointer := metaStackTemp;
X done := true;
X end
X else
X metaStackTemp := metaStackPointer;
X { i points to input character that made us fail }
X { match rest of pattern against rest of input }
X { shrink closure by 1 after each failure }
X done := false;
X while (not done) and (i >= offset) do begin
X metaStackTemp := metaStackPointer;
X k := RAMatch(lin, i, pat, j+PatSize(pat, j));
X if (k > 0) then { matched rest of pattern}
X done := true
X else begin
X metaStackPointer := metaStackTemp;
X i := i - 1
X end
X end;
X offset := k; { if k = 0 failure, else success }
X done := true
X end
X else if (not OMatch(lin, offset, pat, j)) then begin
X offset := 0;
X done := true
X end
X else { OMatch succeeded on this pattern element }
X j := j + PatSize(pat, j);
X RAMatch := offset
Xend;
/
echo 'x - default.pascal'
sed 's/^X//' > default.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Default -- set Defaulted line numbers }
Xsegment Default;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Default;
Xbegin
X if (nLines = 0) then begin
X line1 := def1;
X line2 := def2
X end;
X if (line1 > line2) or (line1 <= 0) then
X status := ERR
X else
X status := OK;
X Default := status
Xend;
/
echo 'x - eval.pascal'
sed 's/^X//' > eval.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Eval -- expand args i..j: do built-in or push back defn }
Xsegment Eval;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure Eval;
Xvar
X argNo, k, t: Integer;
X temp: StringType;
X l,m,n: Integer;
Xbegin
X t := argStk[i];
X if traceing then begin
X MPutStr('Traceing -$E', STDOUT);
X case td of
X DEFTYPE:
X MPutStr('define($N$E', STDOUT);
X EXPRTYPE:
X MPutStr('expr($N$E', STDOUT);
X SUBTYPE:
X MPutStr('substr($N$E', STDOUT);
X IFTYPE:
X MPutStr('ifelse($N$E', STDOUT);
X LENTYPE:
X MPutStr('len($N$E', STDOUT);
X CHQTYPE:
X MPutStr('changeq($N$E', STDOUT)
X otherwise
X MPutStr('macro expansion:$N$E', STDOUT);
X end {case};
X for l := i + 2 to j do begin
X CsCopy(evalStk, argStk[l], temp);
X PutStr(temp, STDOUT);
X PutCF(NEWLINE, STDOUT)
X end {for};
X MPutStr('<<<<<<$N$E', STDOUT);
X end {if};
X
X if (td = DEFTYPE) then
X DoDef(argStk, i, j)
X else if (td = EXPRTYPE) then
X DoExpr(argStk, i, j)
X else if (td = SUBTYPE) then
X DoSub(argStk, i, j)
X else if (td = IFTYPE) then
X DoIf(argStk, i, j)
X else if (td = LENTYPE) then
X DoLen(argStk, i, j)
X else if (td = CHQTYPE) then
X DoChq(argStk, i, j)
X else begin
X k := t;
X while (evalStk[k] <> ENDSTR) do
X k := k + 1;
X k := k - 1; { last character of data }
X while (k > t) do begin
X if (evalStk[k-1] <> ARGFLAG) then
X PutBack(evalStk[k])
X else begin
X argNo := Ord(evalStk[k]) - Ord(DIG0);
X if (argNo >= 0) and (argNo < j-1) then begin
X CsCopy(evalStk, argStk[i+argNo+1], temp);
X PBStr(temp)
X end {if};
X k := k - 1 { skip over $ }
X end {if};
X k := k - 1
X end {while};
X if (k = t) then { do last character }
X PutBack(evalStk[k])
X end {if}
Xend {Eval};
/
echo 'x - kwic.pascal'
sed 's/^X//' > kwic.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Kwic -- make Keyword in Context index }
Xprogram Kwic;
X%include swtools
X%include cms
Xconst
X FOLD = DOLLAR;
Xvar
X buf: StringType;
X tempFile1: FileDesc;
X tempFile2: FileDesc;
X fileName: StringType;
X RCode: Integer;
X{ Rotate -- output rotated lines }
Xprocedure Rotate (var buf: StringType; n: Integer);
Xvar
X i: Integer;
Xbegin
X i := n;
X while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin
X PutCF(buf[i], tempFile1);
X i := i + 1
X end;
X PutCF(FOLD, tempFile1);
X for i := 1 to n - 1 do
X PutCF(buf[i], tempFile1);
X PutCF(NEWLINE, tempFile1)
Xend;
X{ PutRot -- create lines with keyword at front }
Xprocedure PutRot(var buf: StringType);
Xvar
X i: Integer;
Xbegin
X i := 1;
X while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin
X if (IsAlphaNum(buf[i])) then begin
X Rotate(buf, i); { token starts at "i" }
X repeat
X i := i + 1
X until (not IsAlphaNum(buf[i]))
X end;
X i := i + 1
X end
Xend;
X/* temporarily commented out until CMS cmd works
X{ UnRotate -- Unrotate lines rotated by first half of KWIC }
Xprocedure UnRotate;
Xconst
X MAXOUT = 80;
X MIDDLE = 40;
Xvar
X inBuf, outBuf: StringType;
X i, j, f: Integer;
Xbegin
X while (GetLine(inBuf, tempFile2, MAXSTR)) do begin
X for i := 1 to MAXOUT -1 do
X outBuf[i] := BLANK;
X f := StrIndex(inBuf, FOLD);
X j := MIDDLE - 1;
X for i := StrLength(inBuf)-1 downto f+1 do begin
X outBuf[j] := inBuf[i];
X j := j - 1;
X if (j <= 0) then
X j := MAXOUT - 1
X end;
X j := MIDDLE + 3;
X for i := 1 to f-1 do begin
X outBuf[j] := inBuf[i];
X j := j mod (MAXOUT - 1) + 1
X end;
X for j := 1 to MAXOUT - 1 do
X if (outBuf[j] <> BLANK) then
X i := j;
X outBuf[i+1] := ENDSTR;
X PutStr(outBuf, STDOUT);
X PutC(NEWLINE)
X end
Xend;
X*/
X{ Main program for Kwic }
Xbegin
X ToolInit;
X/* Cannot get CMS to call sort properly
X CvtSST('KWIC1 TEMP A', fileName);
X tempFile1 := FOpen(fileName, IOWRITE);
X if tempFile1 = IOERROR then
X Error('Cannot open first KWIC temporary');
X*/
X/* */
X tempFile1 := STDOUT;
X/* */
X while (GetLine(buf, STDIN, MAXSTR)) do
X PutRot(buf);
X/*
X Cms('EXEC OSSORT KWIC1 TEMP A KWIC2 TEMP A 1 10', RCode);
X if RCode <> 0 then
X Error('KWIC: BNRSORT failed');
X CvtSST('KWIC2 TEMP A', fileName);
X tempFile2 := FOpen(fileName, IOREAD);
X if tempFile2 = IOERROR then
X Error('KWIC: cannot open sorted rotated file');
X UnRotate
X*/
Xend.
/
echo 'x - macro.pascal'
sed 's/^X//' > macro.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Macro -- expand macros with arguments }
Xprogram Macro;
X%include swtools
X%include macdefs
X%include macproc
Xbegin
X ToolInit;
X InitMacro;
X Install(defName, null, DEFTYPE);
X Install(exprName, null, EXPRTYPE);
X Install(subName, null, SUBTYPE);
X Install(ifName, null, IFTYPE);
X Install(lenName, null, LENTYPE);
X Install(chqName, null, CHQTYPE);
X
X cp := 0;
X ap := 1;
X ep := 1;
X while (GetTok(token, MAXTOK) <> ENDFILE) do
X if (IsLetter(token[1])) then begin
X if (not Lookup(token, defn, tokType)) then
X PutTok(token)
X else begin
X cp := cp + 1;
X if (cp > CALLSIZE) then
X Error('Macro: call stack overflow');
X callStk[cp] := ap;
X typeStk[cp] := tokType;
X ap := Push(ep, argStk, ap);
X PutTok(defn); { push definition }
X PutChr(ENDSTR);
X ap := Push(ep, argStk, ap);
X PutTok(token); { stack name }
X PutChr(ENDSTR);
X ap := Push(ep, argStk, ap);
X t := GetTok(token, MAXTOK); { peek at next }
X PBStr(token);
X if (t <> LPAREN) then begin { add () }
X PutBack(RPAREN);
X PutBack(LPAREN);
X end;
X pLev[cp] := 0
X end
X end
X else if (token[1] = lQuote) then begin { strip quotes }
X nlPar := 1;
X repeat
X t := GetTok(token, MAXTOK);
X if (t = rQuote) then
X nlPar := nlPar - 1
X else if (t = lQuote) then
X nlPar := nlPar + 1
X else if (t = ENDFILE) then
X Error('Macro: missing right quote');
X if nlPar > 0 then
X PutTok(token)
X until (nlPar = 0)
X end
X else if (cp = 0) then { not in macro at all }
X PutTok(token)
X else if (token[1] = LPAREN) then begin
X if (pLev[cp] > 0) then
X PutTok(token);
X pLev[cp] := pLev[cp] + 1
X end {then}
X else if (token[1] = RPAREN) then begin
X pLev[cp] := pLev[cp] - 1;
X if (pLev[cp] > 0) then
X PutTok(token)
X else begin { end of argument list }
X PutChr(ENDSTR);
X Eval(argStk, typeStk[cp], callStk[cp], ap - 1);
X ap := callStk[cp]; { pop eval stack }
X ep := argStk[ap];
X cp := cp - 1
X end
X end
X else if (token[1] = COMMA) and (pLev[cp] = 1) then begin
X PutChr(ENDSTR); { new argument }
X ap := Push(ep, argStk, ap)
X end {then}
X else
X PutTok(token); { just stack it }
X if (cp <> 0) then
X Error('Macro: unexpected end of input')
Xend.
/
echo 'x - makepat.pascal'
sed 's/^X//' > makepat.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MakePat -- make pattern from arg[i], terminate at delim }
Xsegment MakePat;
X%include swtools
X%include patdef
X%include metadef
Xfunction MakePat;
Xvar
X i,j, lastJ, lj: Integer;
X k: Integer;
X done, junk: Boolean;
Xbegin
X j := 1; { pat index}
X i := start; { arg index}
X metaStackPointer := 0;
X metaIndex := 1;
X done := false;
X k := start;
X while (arg[k] <> delim) and ((k + 2) <= MAXSTR) do
X if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
X arg[k] := delim;
X arg[k+1] := NEWLINE;
X arg[k+2] := ENDSTR;
X end
X else
X k := k + 1;
X
X while (not done) and (arg[i] <> delim) and
X (arg[i] <> ENDSTR) do begin
X lj := j;
X if (arg[i] = ANY) then
X junk := AddStr(ANY, pat, j, MAXPAT)
X else if (arg[i] = BOL) and (i = start) then
X junk := AddStr(BOL, pat, j, MAXPAT)
X else if (arg[i] = BOM) then begin
X junk := AddStr(BOM, pat, j, MAXPAT);
X metaStackPointer := metaStackPointer + 1;
X metaIndex := metaIndex + 1;
X if (metaStackPointer > 9) or
X (metaIndex > 9) then
X done := true
X end
X else if (arg[i] = EOM) and (metaStackPointer > 0) then begin
X junk := AddStr(EOM, pat, j, MAXPAT);
X metaStackPointer := metaStackPointer - 1;
X if (metaStackPointer < 0) then
X done := true
X end
X else if (arg[i] = EOL) and (arg[i+1] = delim) then
X junk := AddStr(EOL, pat, j, MAXPAT)
X else if (arg[i] = CCL) then
X done := (GetCCL(arg, i, pat, j) = false)
X else if (arg[i] = CLOSURE) and (i > start) then begin
X lj := lastJ;
X if (pat[lj] in [BOL, EOL, CLOSURE]) then
X done := true { force loop termination }
X else
X STClose(pat, j, lastJ)
X end
X else begin
X junk := AddStr(LITCHAR, pat, j, MAXPAT);
X junk := AddStr(Esc(arg,i), pat, j, MAXPAT)
X end;
X lastJ := lj;
X if (not done) then
X i := i + 1;
X end;
X if (done) or (arg[i] <> delim) or (metaStackPointer <> 0) then
X MakePat := 0
X else if (not AddStr(ENDSTR, pat, j, MAXPAT)) then
X MakePat := 0 { no room}
X else
X MakePat := i;
Xend;
/
echo 'x - setbuf.pascal'
sed 's/^X//' > setbuf.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SetBuf -- set Buffer and other Buffer handlers (new-free) }
Xsegment SetBuf;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xconst
X MAXLINES = 10000;
Xtype
X BufType = { in-memory new/free buffer handler }
X record
X txt: StringPtr; { text of line }
X mark: Boolean; { mark for line }
X end;
Xref OUTOFSPACE: Boolean;
Xstatic heapMark: @ Integer;
Xstatic { This is a PRIVATE buffer }
X intBuff: array [0..MAXLINES] of BufType;
X{ SetBuf -- (new-free) initialize line storage Buffer }
Xprocedure SetBuf;
Xvar
X i: 0..MAXLINES;
Xbegin
X Mark(heapMark);
X for i := 0 to MAXLINES do
X intBuff[i].txt := nil;
X curLn := 0;
X lastLn := 0
Xend;
X{ ClrBuf -- (new-free) release storage }
Xprocedure ClrBuf;
Xvar i: 0..MAXLINES;
Xbegin
X Release(heapMark)
Xend;
X{ GetTxt -- (new-free) get text from line n into s }
Xprocedure GetTxt;
Xbegin
X { note: the null is already there }
X if intBuff[n].txt = nil then
X s[1] := ENDSTR
X else
X s := intBuff[n].txt@;
Xend;
X{ PutTxt -- (new-free) put text from lin after curLn }
Xfunction PutTxt;
Xvar
X sSize: Integer;
Xbegin
X PutTxt := ERR;
X if (lastLn < MAXLINES) then begin
X lastLn := lastLn + 1;
X sSize := StrLength(lin) + 1;
X if intBuff[lastLn].txt = nil then
X New(intBuff[lastLn].txt, sSize)
X else if (sSize > MaxLength(intBuff[lastLn].txt@)) then begin
X Dispose(intBuff[lastLn].txt);
X New(intBuff[lastLn].txt, sSize)
X end;
X { Check for New failing }
X if OUTOFSPACE then begin
X intBuff[lastLn].txt := nil; { insurance }
X lastLn := lastLn - 1; { insurance }
X OUTOFSPACE := false;
X Message('out of space, write out and edit again');
X return { error }
X end;
X WriteStr(intBuff[lastLn].txt@, lin:sSize);
X PutMark(lastLn, false);
X BlkMove(lastLn, lastLn, curLn);
X curLn := curLn + 1;
X PutTxt := OK
X end
Xend;
X{ GetMark -- get mark from nth line }
Xfunction GetMark;
Xbegin
X GetMark := intBuff[n].mark
Xend;
X{ PutMark -- put mark m on nth line }
Xprocedure PutMark;
Xbegin
X intBuff[n].mark := m
Xend;
X{ BlkMove -- move block of lines n1..n2 to after n3 }
Xprocedure BlkMove;
Xbegin
X if (n3 < n1-1) then begin
X Reverse (n3+1,n1-1);
X Reverse (n1,n2);
X Reverse (n3+1,n2)
X end
X else if (n3 > n2) then begin
X Reverse(n1,n2);
X Reverse(n2+1,n3);
X Reverse(n1,n3)
X end
Xend;
X{ Reverse -- reverse intBuff[n1]...intBuff[n2] }
Xprocedure Reverse;
Xvar temp: BufType;
Xbegin
X while (n1 < n2) do begin
X temp := intBuff[n1];
X intBuff[n1] := intBuff[n2];
X intBuff[n2] := temp;
X n1 := n1 + 1;
X n2 := n2 - 1
X end
Xend;
/
echo 'x - sortdriv.pascal'
sed 's/^X//' > sortdriv.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SortDriv -- Driver and Quick sort }
Xprogram SortDriv;
X%include SWTOOLS
X%include ioref
Xconst
X inCoreSize = 500;
Xtype
X LineType = StringPtr;
Xvar
X notEof: Boolean;
X inBuf: array [1..inCoreSize] of LineType;
X i: Integer;
X temp: StringType;
Xprocedure PText (nLines: Integer; outFile: FileDesc);
Xvar
X i: Integer;
Xbegin
X for i := 1 to nLines do
X PutStr (inBuf[i]@, outFile);
Xend; {PText}
Xfunction GText (var nLines: Integer; inFile: FileDesc): Boolean;
Xvar
X i: Integer;
X temp: StringType;
Xbegin
X nLines := 0;
X done := (GetLine(temp, inFile, MAXSTR) = false);
X while (not done) and (nLines < inCoreSize) do begin
X nLines := nLines + 1;
X inBuf[nLines]@ := Str(temp);
X done := (GetLine(temp, inFile, MAXSTR) = false);
X end; {while}
Xend; {GText}
X
Xprocedure QSort(l,r: integer);
X var i,j: integer;
X temp, hold: LineType;
Xbegin
X i := l;
X j := r;
X temp := inBuf[(i+j) div 2];
X repeat
X while inBuf[i]@ < temp@ do
X i := i+1;
X while temp@ < inBuf[j]@ do
X j := j-1;
X if i <= j then begin
X hold := inBuf[i];
X inBuf[i] := inBuf[j];
X inBuf[j] := hold;
X i := i+1;
X j := j-1
X end
X until i > j;
X if l < j then
X QSort(l,j);
X if i < r then
X QSort(i,r)
Xend {QSort} ;
Xvar
X done: Boolean;
X nLines: Integer;
X high: Integer;
X outFile: FileDesc;
Xbegin
X ToolInit;
X high := 0;
X for i := 1 to inCoreSize do
X New(inBuf[i], SizeOf(StringType));
X repeat { initial formation of runs }
X done := GText (nLines, STDIN);
X QSort(1, nLines);
X high := high + 1;
X outFile := MakeFile(high);
X PText (nLines, outFile);
X Close (outFile);
X until (done);
X low := 1;
X while (low < high) do begin { merge runs }
X lim := Min(low + MERGEORDER - 1, high);
X GOpen (inFile, low, lim);
X high := high + 1;
X outFile := MakeFile(high);
X Merge(inFile, lim-low+1, outFile);
X Close (outFile);
X GRemove (inFile, low, lim);
X low := low + MERGEORDER;
X end; {while}
X GName (high, name) { final cleanup }
X outFile := FOpen (name, IOREAD);
X FCopy (outFile, STDOUT);
X Close (outFile);
X Remove (name);
Xend.
/
echo 'x - swtools.copy'
sed 's/^X//' > swtools.copy << '/'
X*COPY NOTICE
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X*COPY SWTOOLS
X{ SWTOOLS -- Software Tools Environment Definitions }
X%print off
Xconst
X IOERROR = 0; { status values for open files }
X STDIN = 1;
X STDOUT = 2;
X STDERR = 3;
X
X{ other IO-related stuff }
X
X IOAVAIL = 1;
X IOREAD = 2;
X IOWRITE = 3;
X MAXOPEN = 10;
X MAXARG = 30;
X
X{ universal manifest constants }
X
X ENDFILE = Chr(1);
X ENDSTR = Chr(0);
X MAXSTR = 200;
X
X{ EBCDIC character set }
X
X BACKSPACE = Chr(8);
X BACKSLASH = CHR(224);
X TAB = Chr(5);
X NEWLINE = Chr(10);
X BLANK = ' ';
X EXCLAM = '!';
X QUESTION = '?';
X DQUOTE = '"';
X SHARP = '#';
X DOLLAR = '$';
X PERCENT = '%';
X AMPER = '&';
X SQUOTE = '''';
X ACUTE = SQUOTE;
X LPAREN = '(';
X RPAREN = ')';
X STAR = '*';
X PLUS = '+';
X COMMA = ',';
X MINUS = '-';
X DASH = MINUS;
X PERIOD = '.';
X SLASH = '/';
X COLON = ':';
X SEMICOL = ';';
X LESS = '<';
X EQUALS = '=';
X GREATER = '>';
X ATSIGN = '@';
X ESCAPE = ATSIGN;
X LBRACK = Chr(173);
X RBRACK = Chr(189);
X CARET = '^';
X UNDERLINE = '_';
X GRAVE = '9C'XC;
X LBRACE = Chr(139);
X RBRACE = Chr(155);
X BAR = '|';
X TILDE = '~';
X LETA = 'a';
X LETB = 'b';
X LETC = 'c';
X LETD = 'd';
X LETE = 'e';
X LETF = 'f';
X LETG = 'g';
X LETH = 'h';
X LETI = 'i';
X LETJ = 'j';
X LETK = 'k';
X LETL = 'l';
X LETM = 'm';
X LETN = 'n';
X LETO = 'o';
X LETP = 'p';
X LETQ = 'q';
X LETR = 'r';
X LETS = 's';
X LETT = 't';
X LETU = 'u';
X LETV = 'v';
X LETW = 'w';
X LETX = 'x';
X LETY = 'y';
X LETZ = 'z';
X BIGA = 'A';
X BIGB = 'B';
X BIGC = 'C';
X BIGD = 'D';
X BIGE = 'E';
X BIGF = 'F';
X BIGG = 'G';
X BIGH = 'H';
X BIGI = 'I';
X BIGJ = 'J';
X BIGK = 'K';
X BIGL = 'L';
X BIGM = 'M';
X BIGN = 'N';
X BIGO = 'O';
X BIGP = 'P';
X BIGQ = 'Q';
X BIGR = 'R';
X BIGS = 'S';
X BIGT = 'T';
X BIGU = 'U';
X BIGV = 'V';
X BIGW = 'W';
X BIGX = 'X';
X BIGY = 'Y';
X BIGZ = 'Z';
X DIG0 = '0';
X DIG1 = '1';
X DIG2 = '2';
X DIG3 = '3';
X DIG4 = '4';
X DIG5 = '5';
X DIG6 = '6';
X DIG7 = '7';
X DIG8 = '8';
X DIG9 = '9';
X
X{ Standard types }
X
Xtype
X FileDesc = IOERROR..MAXOPEN;
X StringType = packed array [1..MAXSTR] of Char;
X CharType = Char;
X
X{ Externally supplied primitive interfaces }
X
Xprocedure Error (s: String(MAXSTR));
X external;
Xprocedure FClose (fd: FileDesc);
X external;
Xfunction FCreate (name: StringType; mode: Integer): FileDesc;
X external;
Xfunction FOpen (name: StringType; mode: Integer): FileDesc;
X external;
Xprocedure FSeek (recno: Integer; fd: FileDesc);
X external;
Xfunction GetArg (n: Integer; var str: StringType;
X maxSize: Integer): Boolean;
X external;
Xfunction GetC (var c: CharType): CharType;
X external;
Xfunction GetCF (var c: CharType; fd: FileDesc): CharType;
X external;
Xfunction GetLine (var str: StringType; fd: FileDesc;
X maxSize: Integer): Boolean;
X external;
Xprocedure Message (s: String(MAXSTR));
X external;
Xfunction Nargs: Integer;
X external;
Xprocedure PutC (c: CharType);
X external;
Xprocedure PutCF (c: CharType; fd: FileDesc);
X external;
Xprocedure PutStr (const str: StringType; fd: FileDesc);
X external;
Xprocedure MPutStr (const str: StringType; fd: FileDesc);
X external;
Xprocedure Remove (var name: StringType);
X external;
Xprocedure SysExit (status: Integer);
X external;
Xprocedure ToolInit;
X external;
X
X{ Externally supplied utilities }
X
Xfunction AddStr (c: CharType; var outSet: StringType;
X var j: Integer; maxSet: Integer): Boolean;
X external;
Xfunction CToI (var s: StringType; var i: Integer): Integer;
X external;
Xprocedure CvtSST (src: String(MAXSTR); var dest: StringType);
X external;
Xprocedure CvtSTS (src: StringType; var dest: String(MAXSTR));
X external;
Xfunction Equal (var str1, str2: StringType): Boolean;
X external;
Xfunction Esc (var s: StringType; var i: Integer): CharType;
X external;
Xprocedure FCopy (fin, fout: FileDesc);
X external;
Xfunction GetFid (var line: StringType; idx: Integer;
X var fileName: StringType): Boolean;
X external;
Xfunction GetWord (var s: StringType; i: Integer;
X var out: StringType): Integer;
X external;
Xfunction IsAlphaNum (c: CharType): Boolean;
X external;
Xfunction IsDigit (c: CharType): Boolean;
X external;
Xfunction IsLetter (c: CharType): Boolean;
X external;
Xfunction IsLower (c: CharType): Boolean;
X external;
Xfunction IsUpper (c: CharType): Boolean;
X external;
Xfunction IToC (n: Integer; var s: StringType; i: Integer): Integer;
X external;
Xfunction MustOpen (var fName: StringType; fMode: Integer): FileDesc;
X external;
Xprocedure PutDec (n, w: Integer);
X external;
Xprocedure SCopy (var src: StringType; i: Integer;
X var dest: StringType; j: Integer);
X external;
Xfunction StrIndex (const s: StringType; c: CharType): Integer;
X external;
Xfunction StrLength (const s: StringType): Integer;
X external;
Xprocedure ProgExit (const returnCode: Integer); external;
X%print on
X*COPY EDITCONS
X{ EditCons -- const declarations for edit }
Xconst
X CURLINE = PERIOD;
X LASTLINE = DOLLAR;
X SCAN = SLASH;
X BACKSCAN = BACKSLASH;
X ACMD = LETA;
X CCMD = LETC;
X DCMD = LETD;
X ECMD = LETE;
X EQCMD = EQUALS;
X FCMD = LETF;
X GCMD = LETG;
X ICMD = LETI;
X MCMD = LETM;
X KCMD = LETK;
X OCMD = LETO;
X PCMD = LETP;
X LCMD = LETL;
X QCMD = LETQ;
X RCMD = LETR;
X SCMD = LETS;
X WCMD = LETW;
X XCMD = LETX;
X promptFlag = 0;
X verboseFlag = 1;
X noMetaFlag = 2;
X { insert more option flags here }
X numFlag = 15;
X*COPY EDITTYPE
X{ EditType -- types for in-memory version of edit }
Xtype
X STCode = (ENDDATA, ERR, OK); { status returns }
X*COPY EDITPROC
X{ EditProc -- routine declarations for SW editor }
Xfunction GetList (var lin: StringType; var i: Integer;
X var status: STCode): STCode; external;
Xfunction GetOne (var lin: StringType; var i, num: Integer;
X var status: STCode): STCode; external;
Xfunction GetNum (var lin: StringType; var i, num: integer;
X var status: STCode): STCode; external;
Xfunction OptPat (var lin: StringType; var i: Integer): STCode; external;
Xfunction PatScan (way: CharType; var n: Integer): STCode; external;
Xfunction NextLn (n: Integer): Integer; external;
Xfunction PrevLn (n: Integer): Integer; external;
Xfunction Default (def1, def2: Integer;
X var status: STCode): STCode; external;
Xfunction DoPrint (n1, n2: Integer): STCode; external;
Xfunction DoLPrint (n1, n2: Integer): STCode; external;
Xfunction DoCmd (var lin: StringType; var i: Integer;
X glob: Boolean; var status: STCode): STCode; external;
Xfunction Append (line: Integer; glob: Boolean): STCode; external;
Xprocedure BlkMove (n1, n2, n3: Integer); external;
Xprocedure Reverse (n1, n2: Integer); external;
Xprocedure GetTxt (n: Integer; var s: StringType); external;
Xprocedure SetBuf; external;
Xfunction PutTxt (var lin: StringType): STCode; external;
Xfunction CkP (var lin: StringType; i: Integer;
X var pFlag: Boolean; var status: STCode):
X STCode; external;
Xfunction LnDelete (n1, n2: Integer; var status: STCode):
X STCode; external;
Xfunction Move (line3: Integer): STCode; external;
Xfunction Kopy (line3: Integer): STCode; external;
Xfunction GetRHS (var lin: StringType; var i: Integer;
X var sub: StringType; var gFlag: Boolean):
X STCode; external;
Xfunction SubSt (var sub: StringType; gFlag, glob: Boolean):
X STCode; external;
Xprocedure SkipBl (var s: StringType; var i: Integer);
X external;
Xfunction GetFn(var lin: StringType; var i:Integer;
X var fil: StringType): STCode; external;
Xfunction DoRead (n: integer; var fil: StringType): STCode; external;
Xfunction DoWrite (n1, n2: Integer; var fil: StringType): STCode;
X external;
Xfunction CkGlob (var lin: StringType; var i: Integer;
X var status: STCode): STCode; external;
Xfunction DoGlob (var lin: StringType; var i, curSave: Integer;
X var status: STCode): STCode; external;
Xprocedure ClrBuf; external;
Xfunction GetMark(n: Integer): Boolean; external;
Xprocedure PutMark(n: Integer; m: Boolean); external;
Xfunction DoOption(var lin: STringType; var i: Integer):
X STCode; external;
Xfunction OptIsOn(flag: promptFlag..numFlag): Boolean; external;
X*COPY IODEF
Xtype
X IOBlock =
X record
X fileVar: Text;
X mode: IOERROR..IOWRITE
X end;
Xfunction FDAlloc: Integer; External;
X*COPY IOREF
X{ GlobRef -- standard global references (IO support mainly) }
X%include iodef
Xref openList: array [FileDesc] of IOBlock;
Xref ERRORIO: Boolean;
Xref ATTENTION: Boolean;
Xref cmdLin: StringType;
Xref cmdArgs: 0..MAXARG;
Xref cmdIdx: array [1..MAXARG] of 1..MAXSTR;
X*COPY EDITREF
X{ EditRef -- external reference definitions for SW editor }
Xref
X line1: Integer; { first line number }
X line2: Integer; { second line number }
X nLines: Integer; { # of lines specified }
X curLn: Integer; { current line }
X lastLn: Integer; { last line in buffer }
X pat: StringType; { pattern string }
X lin: StringType; { input line }
X saveFile: StringType; { current remembered file name }
X*COPY MATCHDEF
X{ MatchDef -- definitions of match and sub-fcns }
Xfunction PatSize (var pat: StringType; n: Integer): Integer;
X external;
Xfunction OMatch (var lin: StringType; var i: Integer;
X var pat: StringType; j: Integer): Boolean;
X external;
Xfunction Locate (c: CharType; var pat: StringType;
X offset: Integer): Boolean;
X external;
Xfunction Match (var lin, pat: StringType): Boolean;
X external;
Xfunction AMatch (var lin: StringType; offset: Integer;
X var pat: StringType; j: Integer): Integer;
X external;
X*COPY PATDEF
X{ PatDef -- pattern constant declarations for GetPat }
Xconst
X MAXPAT = MAXSTR;
X CLOSIZE = 1; { size of closure entry }
X BOL = PERCENT;
X EOL = DOLLAR;
X ANY = QUESTION;
X CCL = LBRACK;
X CCLEND = RBRACK;
X NEGATE = CARET;
X NCCL = SHARP;{ cannot be the same as NEGATE }
X LITCHAR = LETC;
X NCHAR = EXCLAM;
X CLOSURE = STAR;
Xfunction GetCCL (var arg: StringType; var i: Integer;
X var pat: StringType; var j: Integer)
X :Boolean;
X external;
Xprocedure StClose(var pat: StringType; var j: Integer;
X lastJ: Integer);
X external;
Xfunction GetPat (var arg, pat: StringType): Boolean;
X external;
Xfunction MakePat (var arg: StringType; start: Integer;
X delim: CharType; var pat: StringType): Integer;
X external;
Xprocedure DoDash (delim: CharType; var src: StringType;
X var i: Integer; var dest: StringType;
X var j: Integer; maxSet: Integer);
X external;
Xfunction MakeSet (var inSet: StringType; k: Integer;
X var outSet: StringType; maxSet: Integer): Boolean;
X external;
X*COPY SUBDEF
X{ subdef -- definitions of substitution routines }
Xconst
X DITTO = Chr(255);
Xprocedure SubLine (var lin, pat, sub: StringType);
X external;
Xprocedure CatSub (var lin: StringType; s1,s2: Integer;
X var sub: StringType; var new: StringType;
X var k: Integer; maxNew: Integer);
X external;
Xprocedure PutSub(var lin: StringType; s1, s2: Integer;
X var sub: StringType);
X external;
Xfunction MakeSub (var arg: StringType; from: Integer;
X delim: CharType; var sub: StringType): Integer;
X external;
Xfunction GetSub (var arg, sub: StringType): Boolean;
X external;
X*COPY DEFVAR
X{ DefVar -- var declarations for define }
Xdef
X hashTab: array [1..HASHSIZE] of NDPtr;
X NDTable: CharBuf;
X nextTab: CharPos; { first free position in NDTable }
X buf: array [1..BUFSIZE] of CharType; { for push back }
X bp: 0..BUFSIZE; { next available character; init = 0 }
X defn: StringType;
X token: StringType;
X tokType: STType; { type returned by lookup }
X defName: StringType; { value is 'define' }
X null: StringType; { value is '' }
X*COPY DEFDEF
X{ DefDef -- definitions needed for define }
X{ DefCons -- const declarations for define }
Xconst
X BUFSIZE = 500; { size of push back buffer }
X MAXCHARS = 5000; { size of name-defn table }
X MAXDEF = MAXSTR; { max chars in a defn }
X MAXTOK = MAXSTR; { max chars in a token }
X HASHSIZE = 53; { size of hash table }
X{ DefType -- type declarations for define }
Xtype
X CharPos = 1..MAXCHARS;
X CharBuf = array [1..MAXCHARS] of CharType;
X STType = (DEFTYPE, MACTYPE); { symbol table types }
X NDPtr = -> NDBlock; { pointer to name-defn block }
X NDBlock =
X record
X name: CharPos;
X defn: CharPos;
X kind: STType;
X nextPtr: NDPtr;
X end;
X*COPY DEFPROC
X{ DefProc -- procedures needed for define }
Xprocedure CSCopy (var cb: CharBuf; i: CharPos;
X var s: StringType);
X external;
Xprocedure SCCopy (var s: StringType; var cb: CharBuf;
X i: CharPos);
X external;
Xprocedure PutBack (c: CharType);
X external;
Xfunction GetPBC (var c: CharType): CharType;
X external;
Xprocedure PBStr (var s: StringType);
X external;
Xfunction GetTok (var token: StringType; tokSize: Integer): CharType;
X external;
Xprocedure GetDef (var token: StringType; tokSize: Integer;
X var defn: StringType; defSize: Integer);
X external;
Xprocedure InitHash;
X external;
Xfunction Hash (var name: StringType): Integer;
X external;
Xfunction HashFind (var name: StringType): NDPtr;
X external;
Xprocedure Install (var name, defn: StringType; t: STType);
X external;
Xfunction Lookup (var name, defn: StringType; var t: STType): Boolean;
X external;
Xprocedure InitDef;
X external;
X*COPY DEFREF
Xdef
X hashTab: array [1..HASHSIZE] of NDPtr;
X NDTable: CharBuf;
X nextTab: CharPos; { first free position in NDTable }
X buf: array [1..BUFSIZE] of CharType; { for push back }
X bp: 0..BUFSIZE; { next available character; init = 0 }
X defn: StringType;
X token: StringType;
X tokType: STType; { type returned by lookup }
X defName: StringType; { value is 'define' }
X null: StringType; { value is '' }
X*COPY METADEF
X{ MetaDef -- definitions for Meta bracket implementation }
Xconst
X BOM = LBRACE; { start of meta bracket }
X EOM = RBRACE; { end of meta bracket }
Xtype
X MetaIndexType = Integer;
X MetaElementType =
X record
X first: Integer;
X last: Integer;
X end;
X MetaTableType = array [0..9] of MetaElementType;
X MetaStackType = array [0..9] of MetaIndexType;
Xdef
X metaIndex: MetaIndexType;
X metaTable: MetaTableType;
X nullMetaTable: MetaTableType;
X metaStack: MetaStackType;
X metaStackPointer: Integer;
X*COPY CHARDEF
Xconst
X ChLetter = 0;
X ChLower = 1;
X ChUpper = 2;
X ChDigit = 3;
X ChSpecial = 4;
Xtype
X ChEntry = packed set of 0..7;
X ChTable = array [0..255] of ChEntry;
Xdef
X CharTable: ChTable;
Xfunction CharClass(const tIndex: CharType): ChEntry; external;
X*COPY MACPROC
X{ MacProc -- procedures needed for define }
Xprocedure CSCopy (var cb: CharBuf; i: CharPos;
X var s: StringType);
X external;
Xprocedure SCCopy (var s: StringType; var cb: CharBuf;
X i: CharPos);
X external;
Xprocedure PutBack (c: CharType);
X external;
Xfunction GetPBC (var c: CharType): CharType;
X external;
Xprocedure PBStr (var s: StringType);
X external;
Xfunction GetTok (var token: StringType; tokSize: Integer): CharType;
X external;
Xprocedure GetDef (var token: StringType; tokSize: Integer;
X var defn: StringType; defSize: Integer);
X external;
Xprocedure InitHash;
X external;
Xfunction Hash (var name: StringType): Integer;
X external;
Xfunction HashFind (var name: StringType): NDPtr;
X external;
Xprocedure Install (var name, defn: StringType; t: STType);
X external;
Xfunction Lookup (var name, defn: StringType; var t: STType): Boolean;
X external;
Xprocedure PutTok(var s: StringType);
X external;
Xprocedure PutChr(c: CharType);
X external;
Xprocedure InitMacro;
X external;
Xfunction Push (ep: Integer; var argStk: PosBuf;
X ap: Integer): Integer;
X external;
Xprocedure Eval(var argStk: PosBuf; td: StType;
X i,j: Integer);
X external;
Xprocedure DoDef (var argStk: PosBuf; i,j: Integer);
X external;
Xprocedure DoIf(var argStk: PosBuf; i,j: Integer);
X external;
Xprocedure DoExpr(var argStk: PosBuf; i,j: Integer);
X external;
Xfunction Expr(var s: StringType; var i: Integer): Integer;
X external;
Xfunction Term(var s: StringType; var i: Integer): Integer;
X external;
Xfunction Factor(var s: StringType; var i: Integer): Integer;
X external;
Xfunction GnbChar(var s: StringType; var i: Integer): CharType;
X external;
Xprocedure DoLen(var argStk: PosBuf; i,j: Integer);
X external;
Xprocedure DoSub(var argStk: PosBuf; i,j: Integer);
X external;
Xprocedure DoChq(var argStk: PosBuf; i,j: Integer);
X external;
Xprocedure PBNum(n: Integer);
X external;
X*COPY MACDEFS
X{ Macdefs -- all definitions for Macro }
Xconst
X BUFSIZE = 1000; { size of pushback buffer }
X MAXCHARS = 5000; { size of name-defn table }
X MAXPOS = 500;
X CALLSIZE = MAXPOS;
X ARGSIZE = MAXPOS;
X EVALSIZE = MAXCHARS;
X MAXDEF = MAXSTR; { max chars in a defn }
X MAXTOK = MAXSTR; { max length of a token }
X HASHSIZE = 53; { size of hash table }
X ARGFLAG = DOLLAR; { macro invocation character }
X
X{ MacType -- type declarations for Macro }
Xtype
X CharPos = 1..MAXCHARS;
X CharBuf = packed array [1..MAXCHARS] of CharType;
X PosBuf = packed array [1..MAXPOS] of CharPos;
X Pos = 0..MAXPOS;
X StType = (DEFTYPE, MACTYPE, IFTYPE, SUBTYPE,
X EXPRTYPE, LENTYPE, CHQTYPE); { symbol table types }
X NdPtr = ->NdBlock;
X NdBlock =
X record
X name: CharPos;
X defn: CharPos;
X kind: StType;
X nextPtr: NdPtr;
X end {record};
X{ Macvar -- def declarations for macro }
Xdef
X traceing: Boolean;
X buf: packed array [1..BUFSIZE] of CharType; { for pushback }
X bp: 0..BUFSIZE;
X hashTab: array [1..HASHSIZE] of NdPtr;
X ndTable: CharBuf;
X nextTab: CharPos; { first free position in ndTable }
X callStk: PosBuf;
X cp: Pos; { current call stack position }
X typeStk: array [1..CALLSIZE] of StType; { type }
X pLev: array [1..CALLSIZE] of Integer; { paren level }
X argStk: PosBuf; { argument stack for this call }
X ap: Pos; { current argument position }
X evalStk: CharBuf; { evaluation stack }
X ep: CharPos; { first character unused in evalStk }
X { builtins }
X defName: StringType; { 'define' }
X exprName: StringType;{ 'expr' }
X subName: StringType; { 'substr' }
X ifName: StringType; { 'ifelse' }
X lenName: StringType; { 'len' }
X chqName: StringType; { 'changeq' }
X null: StringType; { value is '' }
X lQuote: CharType; { left quote character }
X rQuote: CharType; { right quote character }
X
X defn: StringType;
X token: StringType;
X tokType: StType;
X t: CharType;
X nlPar: Integer;
/
echo 'x - toolinit.pascal'
sed 's/^X//' > toolinit.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ ToolInit -- (CMS) standard program prologue }
Xsegment ToolInit;
X%include swtools
X%include iodef
Xdef openList: array [FileDesc] of IOBlock;
Xdef cmdLin: StringType;
Xdef cmdArgs: 0..MAXARG;
Xdef cmdIdx: array [1..MAXARG] of 1..MAXSTR;
Xdef termInput: Boolean;
Xref ERRORIO: Boolean;
Xvalue
X termInput := false;
Xprocedure ToolInit;
Xvar
X t: 1..MAXSTR;
X i: FileDesc;
X idx: 1..MAXSTR;
X delim: CharType;
X PARMSTRING: String(MAXSTR);
X fileName: StringType;
X cmdLength: 0..MAXSTR;
X redirIn: Boolean;
X j: 1..MAXSTR;
X dummy: StringType;
X okay: Boolean;
X tempArgs: 0..MAXARG;
X XFileName: String(MAXSTR);
X k: 0..MAXSTR;
X nextChar: 1..MAXSTR;
Xbegin
X TermIn(input);
X TermOut(output);
X for i := STDIN to MAXOPEN do
X openList[i].mode := IOAVAIL;
X openList[STDERR].mode := IOWRITE;
X TermOut(openList[STDERR].fileVar);
X PARMSTRING := PARMS;
X if (Length(PARMSTRING) >= 1) and (PARMSTRING[1] = STAR) then begin
X WriteLn('Input Command Parameters:');
X ReadLn(PARMSTRING);
X PARMSTRING := PARMSTRING || SubStr(PARMS, 2, Length(PARMS)-1)
X end;
X for idx := 1 to Length(PARMSTRING) do
X cmdLin[idx] := PARMSTRING[idx];
X cmdLin[Length(PARMSTRING) + 1] := NEWLINE;
X cmdLin[Length(PARMSTRING) + 2] := ENDSTR;
X idx := 1;
X cmdArgs := 0;
X while ((cmdLin[idx] <> ENDSTR) and
X (cmdLin[idx] <> NEWLINE)) do begin
X while (cmdLin[idx] = BLANK) do
X idx := idx + 1;
X if (cmdLin[idx] <> NEWLINE) then begin
X delim := BLANK;
X cmdArgs := cmdArgs + 1;
X if (cmdLin[idx] = SQUOTE) or
X (cmdLin[idx] = DQUOTE) then begin
X cmdIdx[cmdArgs] := idx + 1;
X delim := cmdLin[idx];
X idx := idx + 1
X end
X else
X cmdIdx[cmdArgs] := idx;
X while ((cmdLin[idx] <> NEWLINE) and
X (cmdLin[idx] <> delim)) do
X idx := idx + 1;
X cmdLin[idx] := ENDSTR;
X idx := idx + 1;
X end
X end;
X j := 1;
X tempArgs := cmdArgs;
X while (j <= cmdArgs) do begin
X okay := GetArg(j, dummy, MAXSTR);
X j := j + 1;
X if (dummy[1] = LESS) or (dummy[1] = GREATER) then begin
X if dummy[1] = LESS then
X redirIn := true
X else
X redirIn := false;
X SCopy(dummy, 2, fileName, 1);
X nextChar := StrLength(fileName) + 1;
X tempArgs := tempArgs - 1;
X k := j;
X while (k <= cmdArgs) do begin
X okay := GetArg(k, dummy, MAXSTR);
X k := k + 1;
X if okay and (dummy[1] <> LESS) and
X (dummy[1]<> GREATER) then begin
X tempArgs := tempArgs - 1;
X fileName[nextChar] := BLANK;
X nextChar := nextChar + 1;
X SCopy(dummy, 1, fileName, nextChar);
X nextChar := StrLength(fileName) + 1;
X j := j + 1;
X end
X else
X k := cmdArgs + 1;
X end;
X t := 1;
X okay := GetFid(fileName, t, fileName);
X if not okay then
X Error('Bad redirection file name');
X CvtSTS(fileName, XFileName);
X if redirIn then begin
X openList[STDIN].mode := IOREAD;
X Reset(openList[STDIN].fileVar, 'NAME=' ||
X XFileName);
X termInput := false;
X if ERRORIO then begin
X openList[STDIN].mode := IOAVAIL;
X Error('Cannot open STDIN file');
X ERRORIO := false
X end
X end
X else begin
X openList[STDOUT].mode := IOWRITE;
X Remove(fileName);
X ReWrite(openList[STDOUT].fileVar,
X 'LRECL=1000,NAME=' || XFileName);
X if ERRORIO then begin
X openList[STDOUT].mode := IOAVAIL;
X ERRORIO := false
X end
X end
X end
X end;
X cmdArgs := tempArgs;
X if openList[STDIN].mode = IOAVAIL then begin
X TermIn(openList[STDIN].fileVar);
X openList[STDIN].mode := IOREAD;
X termInput := true;
X end;
X if openList[STDOUT].mode = IOAVAIL then begin
X TermOut(openList[STDOUT].fileVar);
X openList[STDOUT].mode := IOWRITE;
X end;
Xend;
/
echo 'Part 03 of pack.out complete.'
exitsources-request@genrad.UUCP (07/13/85)
Mod.sources: Volume 2, Issue 10
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 04 of 06:'
echo 'x - ckglob.pascal'
sed 's/^X//' > ckglob.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CkGlob -- if global prefix, mark lines to be affected }
Xsegment CkGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction CkGlob;
Xvar
X n: Integer;
X gFlag: Boolean;
X temp: StringType;
Xbegin
X if (lin[i] <> GCMD) and (lin[i] <> XCMD) then
X status := ENDDATA
X else begin
X gFlag := (lin[i] = GCMD);
X i := i + 1;
X if (OptPat(lin, i) = ERR) then
X status := ERR
X else if (Default(1, lastLn, status) <> ERR) then begin
X i := i + 1; { mark affected lines }
X for n := line1 to line2 do begin
X GetTxt(n, temp);
X PutMark(n, (Match(temp, pat) = gFlag))
X end;
X for n := 1 to line1-1 do { erase other marks }
X PutMark(n, false);
X for n := line2+1 to lastLn do
X PutMark(n, false);
X status := OK
X end
X end;
X CkGlob := status
Xend;
/
echo 'x - define.pascal'
sed 's/^X//' > define.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Define -- simple string replacement macro processor }
Xprogram Define;
X%include swtools
X%include defdef
X%include defvar
X%include defproc
X{ InitDef -- initialize variables for define }
Xprocedure InitDef;
Xbegin
X CvtSST('define', defName);
X bp := 0; { push back buffer pointer }
X InitHash
Xend;
Xbegin
X ToolInit;
X null[1] := ENDSTR;
X InitDef;
X Install(defName, null, DEFTYPE);
X while (GetTok(token, MAXTOK) <> ENDFILE) do
X if (not IsLetter(token[1])) then
X PutStr(token, STDOUT)
X else if (not Lookup(token, defn, tokType)) then
X PutStr(token, STDOUT) { undefined }
X else if (tokType = DEFTYPE) then begin { defn }
X GetDef(token, MAXTOK, defn, MAXDEF);
X Install(token, defn, MACTYPE)
X end
X else
X PBStr(defn) { push back replacement string }
Xend.
/
echo 'x - dodash.pascal'
sed 's/^X//' > dodash.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoDash -- expand set at src(i) into dest(j), stop at delim }
Xsegment DoDash;
X%include swtools
X%include patdef
Xprocedure DoDash;
Xvar
X k: CharType;
X junk: Boolean;
Xbegin
X while (src[i] <> delim) and (src[i] <> ENDSTR) do begin
X if (src[i] = ESCAPE) then
X junk := AddStr(Esc(src,i), dest, j, maxSet)
X else if (src[i] <> DASH) then
X junk := AddStr(src[i], dest, j, maxSet)
X else if (j <= 1) or (src[i+1] = ENDSTR) then
X junk := AddStr(DASH, dest, j, maxSet) { literal -}
X else if IsAlphaNum(src[i-1]) and
X IsAlphaNum(src[i+1]) and
X (src[i-1] <= src[i+1]) then begin
X for k := Succ(src[i-1]) to src[i+1] do
X { the following obscenity is due to EBCDIC "holes" }
X if IsAlphaNum(k) then begin
X junk := AddStr(k, dest, j, maxSet);
X end;
X i := i + 1
X end
X else
X junk := AddStr(DASH, dest, j, maxSet);
X i := i + 1
X end
Xend;
/
echo 'x - dooption.pascal'
sed 's/^X//' > dooption.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoOption -- build options for the swtools editor }
Xsegment DoOption;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xdef
X optionFlags: set of promptFlag..numFlag;
Xvalue
X optionFlags := [];
Xfunction DoOption;
Xvar
X optSel: promptFlag..numFlag;
X setting: Boolean;
Xbegin
X DoOption := OK; { error handling done here }
X i := i + 1;
X if (lin[i] = NEWLINE) or (lin[i+1] = NEWLINE) then
X Message('Bad option string')
X else begin
X if lin[i+1] in [LETS, BIGS] then setting := true
X else if lin[i+1] in [LETC, BIGC] then setting := false
X else begin
X Message('You must [s]et or [c]lear the option');
X return
X end;
X case lin[i] of
X LETP, BIGP:
X optSel := promptFlag;
X LETM, BIGM:
X optSel := noMetaFlag;
X LETV, BIGV:
X optSel := verboseFlag;
X LETN, BIGN:
X optSel := numFlag
X otherwise
X begin
X Message('You gave an illegal option');
X Message('available options are:');
X Message('ps/pc: turn on/off prompting');
X Message('vs/vc: turn on/off verbose mode');
X Message('ns/nc: turn on/off line numbers');
X Message('ms/mc: turn on/off stupid matching');
X return
X end
X end;
X if setting then
X optionFlags := optionFlags + [optSel]
X else
X optionFlags := optionFlags - [optSel]
X end
Xend;
Xfunction OptIsOn;
Xbegin
X if flag in optionFlags then OptIsOn := true
X else OptIsOn := false
Xend;
/
echo 'x - doread.pascal'
sed 's/^X//' > doread.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoRead -- read "fil" after line n }
Xsegment DoRead;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoRead;
Xvar
X count: Integer;
X t: Boolean;
X stat: STCode;
X fd: FileDesc;
X inLine: StringType;
Xbegin
X fd := FOpen(fil, IOREAD);
X if (fd = IOERROR) then
X stat := ERR
X else begin
X curLn := n;
X stat := OK;
X count := 0;
X repeat
X t := GetLine(inLine, fd, MAXSTR);
X if (t) then begin
X stat := PutTxt(inLine);
X if (stat <> ERR) then
X count := count + 1
X end
X until (stat <> OK) or (t = false);
X FClose(fd);
X PutDec(count, 1);
X PutC(NEWLINE);
X end;
X DoRead := stat
Xend;
/
echo 'x - dosub.pascal'
sed 's/^X//' > dosub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoSub -- Select substring }
Xsegment DoSub;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoSub;
Xvar
X ap, fc, k, nc: Integer;
X temp1, temp2: StringType;
Xbegin
X if (j - i >= 3) then begin
X if (j - i < 4) then
X nc := MAXTOK
X else begin
X CsCopy(evalStk, argStk[i+4], temp1);
X k := 1;
X nc := Expr(temp1, k)
X end {if};
X CsCopy(evalStk, argStk[i+3], temp1); { origin }
X ap := argStk[i+2]; { target string }
X k := 1;
X fc := ap + Expr(temp1, k) - 1; { first char }
X CsCopy(evalStk, ap, temp2);
X if (fc >= ap) and (fc < ap + StrLength(temp2)) then begin
X CsCopy(evalStk, fc, temp1);
X for k := fc + Min(nc, StrLength(temp1))-1 downto fc do
X PutBack(evalStk[k])
X end {if}
X end {if}
Xend {DoSub};
/
echo 'x - expand.pascal'
sed 's/^X//' > expand.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Expand -- Expand a file by a specified factor }
Xprogram Expand;
X%include swtools
Xconst maxWidth = 2000;
Xvar
X arguments: StringType;
X outBuffer: array [1..maxWidth] of Char;
X inPtr: Integer;
X anchor: Integer;
X i: Integer;
X factor: Integer;
X index: Integer;
X j: Integer;
Xbegin
X ToolInit;
X index := 1;
X if GetArg(1, arguments, MAXSTR) then begin
X factor := CToI(arguments, index);
X if factor = 0 then
X Error('Argument to Expand should be numeric, > 0');
X end
X else
X factor := 1;
X while true do begin
X inPtr := 1;
X { read an input line, expanding on the fly }
X while (GetC(outBuffer[inPtr]) <> ENDFILE) do begin
X if outBuffer[inPtr] = NEWLINE then leave;
X anchor := inPtr;
X for j := 1 to factor - 1 do begin
X inPtr := inPtr + 1;
X outBuffer[inPtr] := outBuffer[anchor];
X end; {for}
X inPtr := inPtr + 1;
X end; {while}
X if outBuffer[inPtr] = ENDFILE then leave;
X { output expanded array twice }
X for j := 1 to factor do
X for i := 1 to inPtr do
X PutC(outBuffer[i]);
X end; {while}
Xend. {Expand}
/
echo 'x - fopen.pascal'
sed 's/^X//' > fopen.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FOpen -- open a file }
Xsegment FOpen;
X%include swtools
X%include cms
X%include ioref
Xfunction FOpen;
Xvar
X returnCode: Integer;
X cmsString: String(MAXSTR);
X sName: String(MAXSTR);
X f: FileDesc;
X i: 1..MAXSTR;
X fixedName: StringType;
Xbegin
X if mode = IOREAD then begin
X cmsString := 'STATE ';
X for i := 1 TO StrLength(name) do
X if name[i] in [NEWLINE, PERIOD] then
X cmsString := cmsString || Str(' ')
X else
X cmsString := cmsString || Str(name[i]);
X Cms(cmsString, returnCode);
X if returnCode <> 0 then begin
X FOpen := IOERROR;
X return
X end;
X end;
X i := 1;
X if (not GetFid(Name, i, fixedName)) then
X Error('Bad file name');
X CvtSTS(fixedName, sName);
X f := FDAlloc;
X if f = IOERROR then
X Error('Out of file descriptors')
X else begin
X openList[f].mode := mode;
X if mode = IOREAD then
X Reset(openList[f].fileVar, 'name=' || sName)
X else begin
X Remove(fixedName);
X ReWrite(openList[f].fileVar, 'name=' || sName);
X end;
X if ERRORIO then begin
X openList[f].mode := IOAVAIL;
X f := IOERROR;
X ERRORIO := false;
X end
X end;
X FOpen := f
Xend;
/
echo 'x - getdef.pascal'
sed 's/^X//' > getdef.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetDef -- get name and definition }
Xsegment GetDef;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure GetDef;
Xvar
X i, nlPar: Integer;
X c: CharType;
Xbegin
X token[1] := ENDSTR; { in case of bad input }
X defn[1] := ENDSTR;
X if (GetPBC(c) <> LPAREN) then
X Message('define: missing left paren')
X else if (not IsLetter(GetTok(token, tokSize))) then
X Message('define: non-alphanumeric name')
X else if (GetPBC(c) <> COMMA) then
X Message('define: missing comma in define')
X else begin { got '(name,' so far }
X while (GetPBC(c) = BLANK) do
X ; { skip leading blanks }
X PutBack(c); { went one too far }
X nlPar := 0;
X i := 1;
X while (nlPar >= 0) do begin
X defn[i] := GetPBC(c);
X if (i >= defSize) then
X Error('define: definition too long')
X else if (c = ENDFILE) then
X Error('define: missing right paren')
X else if (c = LPAREN) then
X nlPar := nlPar + 1
X else if (c = RPAREN) then
X nlPar := nlPar - 1;
X { else normal char in defn[i] }
X i := i + 1
X end;
X defn[i-1] := ENDSTR
X end
Xend;
/
echo 'x - getfid.pascal'
sed 's/^X//' > getfid.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetFid -- convert a string into a file name }
Xsegment GetFid;
X%include swtools
X%include ioref
Xfunction GetFid;
Xvar
X nameIndex: 1..MAXSTR;
X temp: StringType;
X fMode: StringType;
X fType: StringType;
X i: 0..MAXSTR;
X j: 0..MAXSTR;
Xbegin
X SCopy(line, idx, temp, 1);
X for nameIndex := 1 to StrLength(temp) do
X if (not (line[nameIndex] in
X [DOLLAR, LETA..LETZ, BIGA..BIGZ, DIG0..DIG9, BLANK])) then
X temp[nameIndex] := BLANK;
X i := GetWord(temp, 1, fileName);
X if i = 0 then begin
X GetFid := false;
X return;
X end;
X j := GetWord(temp, i, fType);
X if j = 0 then begin
X CvtSST('TEMP', fType);
X CvtSST('*', fMode);
X end
X else begin
X j := GetWord(temp, j, fMode);
X if j = 0 then
X CvtSST('*', fMode);
X end;
X i := StrLength(fileName);
X fileName[i+1] := PERIOD;
X SCopy(fType, 1, fileName, i + 2);
X i := StrLength(fileName);
X fileName[i+1] := PERIOD;
X SCopy(fMode, 1, fileName, i + 2);
X getFid := true;
Xend;
/
echo 'x - getfn.pascal'
sed 's/^X//' > getfn.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetFn -- get file name from lin[i] .... }
Xsegment GetFn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetFn;
Xvar
X k: Integer;
X stat: STCode;
Xbegin
X stat := ERR;
X if (lin[i+1] = BLANK) then begin
X Scopy(lin, i+2, fil, 1);
X if fil[StrLength(fil)] = NEWLINE then
X fil[StrLength(fil)] := ENDSTR;
X stat := OK
X end
X else if (lin[i+1] = NEWLINE) and (saveFile[1] <> ENDSTR) then begin
X Scopy(saveFile, 1, fil, 1);
X stat := OK
X end;
X if (stat = OK) and (saveFile[1] = ENDSTR) then
X Scopy(fil, 1, saveFile, 1); { save if no old one }
X k := 1;
X if stat = Ok then
X if (not GetFid(saveFile, k, saveFile)) then
X stat := ERR;
X GetFn := stat
Xend;
/
echo 'x - getline.pascal'
sed 's/^X//' > getline.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetLine-- put string out on file }
Xsegment GetLine;
X%include swtools
X%include ioref
Xref termInput: Boolean;
Xfunction GetKeyBoard(var str: StringType; maxSize: Integer): Boolean;
X forward;
Xfunction GetLine;
Xvar
X i: Integer;
Xbegin
X if (fd < STDIN) or (fd > MAXOPEN) or
X (openList[fd].mode <> IOREAD) then
X Error('Getline with unopen or bad fd')
X else if (fd = STDIN) and (termInput) then
X GetLine := GetKeyBoard(str, maxSize)
X else begin
X i := 1;
X GetLine := false;
X if Eof(openList[fd].fileVar) then begin
X str[1] := NEWLINE;
X str[2] := ENDSTR;
X return;
X end;
X Readln(openList[fd].fileVar, str);
X i := maxSize;
X while (i > 0) do begin
X if (str[i] <> BLANK) then leave;
X i := i - 1
X end;
X str[i+1] := NEWLINE;
X str[i+2] := ENDSTR;
X GetLine := true
X end
Xend;
Xfunction GetKeyBoard;
Xvar
X i: Integer;
Xbegin
X ReadLn(openList[STDIN].fileVar, str);
X if Eof(openList[STDIN].fileVar) then begin
X TermIn(openList[STDIN].fileVar);
X i := 0
X end
X else begin
X i := maxSize;
X while (i > 0) do begin
X if str[i] <> BLANK then leave;
X i := i - 1
X end
X end;
X str[i + 1] := NEWLINE;
X str[i + 2] := ENDSTR;
X if (str[1] = ATSIGN) and (str[2] = NEWLINE) then
X GetKeyBoard := false
X else
X GetKeyBoard := true
Xend;
/
echo 'x - getlist.pascal'
sed 's/^X//' > getlist.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetList -- Get list of line numbers at lin[i], increment i }
Xsegment GetList;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetList;
Xvar
X num: Integer;
X done: Boolean;
Xbegin
X line2 := 0;
X nLines := 0;
X done := (GetOne(lin, i, num, status) <> OK);
X if done and (lin[i] = COMMA) then begin
X done := false;
X num := 1
X end; {if}
X while (not done) do begin
X line1 := line2;
X line2 := num;
X nLines := nLines + 1;
X if (lin[i] = SEMICOL) then
X curLn := num;
X if (lin[i] = COMMA) or (lin[i] = SEMICOL) then begin
X i := i + 1;
X done := (GetOne(lin, i, num, status) <> OK);
X if done then begin
X num := lastLn;
X done := false
X end {if}
X end
X else
X done := true
X end;
X nLines := Min(nLines, 2);
X if (nLines = 0) then
X line2 := curLn;
X if (nLines <= 1) then
X line1 := line2;
X if (status <> ERR) then
X status := OK;
X GetList := status
Xend;
/
echo 'x - getnum.pascal'
sed 's/^X//' > getnum.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetNum -- get single line number component }
Xsegment GetNum;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetNum;
Xbegin
X status := OK;
X SkipBl(lin, i);
X if (IsDigit(lin[i])) then begin
X num := CToI(lin, i);
X i := i - 1 { move back, to be advanced at end }
X end
X else if (lin[i] = PLUS) or (lin[i] = MINUS) then begin
X num := curLn;
X i := i - 1; {don't eat the plus or minus sign}
X end
X else if (lin[i] = CURLINE) then
X num := curLn
X else if (lin[i] = LASTLINE) then
X num := lastLn
X else if (lin[i] = SCAN) or (lin[i] = BACKSCAN) then begin
X if (OptPat(lin,i) = ERR) then { build pattern }
X status := ERR
X else
X status := PatScan(lin[i], num)
X end
X else
X status := ENDDATA;
X if (status = OK) then
X i := i + 1; { advance to next character }
X GetNum := status
Xend;
/
echo 'x - getone.pascal'
sed 's/^X//' > getone.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetOne -- get one line number expression }
Xsegment GetOne;
X%include swtools
X%include editcons
X%include edittype
X%include editref
X%include editproc
Xfunction GetOne;
Xvar
X iStart, mul, pNum: Integer;
Xbegin
X iStart := i;
X num := 0;
X if (GetNum(lin, i, num, status) = OK) then { 1st term }
X repeat { + or - terms }
X SkipBl(lin, i);
X if (lin[i] <> PLUS) and (lin[i] <> MINUS) then
X status := ENDDATA
X else begin
X if (lin[i] = PLUS) then
X mul := 1
X else
X mul := -1;
X i := i + 1;
X if (GetNum(lin, i, pNum, status) = OK) then
X num := num + mul * pNum;
X if (status = ENDDATA) then
X status := ERR
X end
X until (status <> OK);
X if (num < 0) or (num > lastLn) then
X status := ERR;
X if (status <> ERR) then begin
X if (i <= iStart) then
X status := ENDDATA
X else
X status := OK
X end;
X GetOne := status
Xend;
/
echo 'x - getpat.pascal'
sed 's/^X//' > getpat.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetPat -- get pattern from lin, increment i }
Xsegment GetPat;
X%include swtools
X%include patdef
Xfunction GetPat;
Xbegin
X GetPat := (MakePat(arg, 1, ENDSTR, pat) > 0)
Xend;
/
echo 'x - install.pascal'
sed 's/^X//' > install.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Install -- add name, definition and type to table }
Xsegment Install;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure Install;
Xvar
X h, dlen, nlen: Integer;
X p: NDPtr;
Xbegin
X nlen := StrLength(name) + 1; { 1 for ENDSTR }
X dlen := StrLength(defn) + 1;
X if (nextTab + nlen + dlen > MAXCHARS) then begin
X PutStr(name, STDERR);
X Error(': too many definitions')
X end
X else begin
X h := Hash(name);
X new(p);
X p->.nextPtr := hashTab[h];
X hashTab[h] := p;
X p->.name := nextTab;
X SCCopy(name, ndTable, nextTab);
X nextTab := nextTab + nlen;
X p->.defn := nextTab;
X SCCopy(defn, ndTable, nextTab);
X nextTab := nextTab + dlen;
X p->.kind := t
X end
Xend;
/
echo 'x - kopy.pascal'
sed 's/^X//' > kopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Kopy -- move line1 thru line2 after line3 }
Xsegment Kopy;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Kopy;
Xvar
X i: Integer;
X curSave, lastSave: Integer;
X tempLine: StringType;
Xbegin
X if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X Kopy := ERR
X else begin
X curSave := curLn;
X lastSave := lastLn;
X curLn := lastLn;
X for i := line1 to line2 do begin
X GetTxt(i, tempLine);
X if PutTxt(tempLine) = ERR then begin
X curLn := curSave;
X lastLn := lastSave;
X Kopy := ERR;
X return
X end
X end; {if}
X BlkMove(lastSave+1, lastSave+1+line2-line1, line3);
X if (line3 > line1) then
X curLn := line3
X else
X curLn := line3 + (line2 - line1 + 1);
X Kopy := OK
X end
Xend;
/
echo 'x - makesub.pascal'
sed 's/^X//' > makesub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MakeSub -- make substitution string from arg into sub }
Xsegment MakeSub;
X%include swtools
X%include patdef
X%include subdef
X%include metadef
Xvalue
X nullMetaTable := MetaTableType(
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0));
Xfunction MakeSub;
Xvar
X k: Integer;
X i, j: Integer;
X l: Integer;
X junk: Boolean;
Xbegin
X j := 1;
X i := from;
X k := from;
X while (arg[k] <> delim) and (k <= (MAXSTR - 2)) do
X if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
X arg[k] := delim;
X arg[k+1] := NEWLINE;
X arg[k+2] := ENDSTR;
X end
X else
X k := k + 1;
X while (arg[i] <> delim) and (arg[i] <> ENDSTR) do begin
X if (arg[i] = AMPER) then begin
X junk := AddStr(DITTO, sub, j, MAXPAT);
X { &n handler for meta brackets }
X if (arg[i+1] in [DIG0..DIG9]) then begin
X i := i + 1;
X junk := AddStr(Chr(Ord(arg[i]) - Ord(DIG0)),
X sub, j, MAXPAT)
X end
X end
X else
X junk := AddStr(Esc(arg,i), sub, j, MAXPAT);
X i := i + 1
X end;
X if (arg[i] <> delim) then { missing delim }
X MakeSub := 0
X else if (not AddStr(ENDSTR, sub, j, MAXPAT)) then
X MakeSub := 0
X else
X MakeSub := i
Xend;
/
echo 'x - mputstr.pascal'
sed 's/^X//' > mputstr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MPutStr -- put meta'd string out on file }
Xsegment MPutStr;
X%include swtools
X%include ioref
Xprocedure MPutStr;
Xvar
X i: Integer;
X j: integer;
X len: Integer;
X outString: StringType;
Xbegin
X i := 1;
X j := 1;
X len := StrLength(str);
X while i <= len do begin
X if str[i] = DOLLAR then begin
X i := i + 1;
X if (str[i] = BIGN) or (str[i] = LETN) then begin
X if j = 1 then WriteLn(openList[fd].fileVar,' ')
X else WriteLn(openList[fd].fileVar,
X outString:j-1);
X j := 1
X end
X else if (str[i] = BIGE) or (str[i] = LETE) then
X return
X else
X i := i - 1
X end else
X if str[i] = NEWLINE then begin
X if j = 1 then WriteLn(openList[fd].fileVar,' ')
X else WriteLn(openList[fd].fileVar, outString:j-1);
X j := 1;
X end {then}
X else begin
X outString[j] := str[i];
X j := j + 1;
X end; {if}
X i := i + 1
X end; {while}
X if j <> 1 then write(openList[fd].fileVar, outString:j-1);
Xend; {MPutStr}
/
echo 'x - omatch.pascal'
sed 's/^X//' > omatch.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ OMatch -- match one pattern element at pat[j] }
Xsegment OMatch;
X%include swtools
X%include matchdef
X%include patdef
X%include metadef
Xfunction OMatch;
Xvar
X advance: -1..1;
X mIndex: Integer;
Xbegin
X advance := -1;
X if (lin[i] = ENDSTR) then
X OMatch := false
X else
X case pat[j] of
X LITCHAR:
X if (lin[i] = pat[j+1]) then
X advance := 1;
X BOM:
X if (metaStackPointer <= 9) and
X (metaIndex <= 9) then begin
X metaStack[metaStackPointer] := metaIndex;
X metaTable[metaIndex].first := i;
X metaIndex := metaIndex + 1;
X metaStackPointer := metaStackPointer + 1;
X advance := 0
X end
X else
X Error('OMatch/meta: can''t happen');
X EOM:
X if (metaStackPointer >= 1) then begin
X metaStackPointer := metaStackPointer - 1;
X mIndex := metaStack[metaStackPointer];
X metaTable[mIndex].last := i;
X advance := 0
X end
X else
X Error('OMatch/meta/EOM can''t happen');
X BOL:
X if (i = 1) then
X advance := 0;
X ANY:
X if (lin[i] <> NEWLINE) then
X advance := 1;
X EOL:
X if (lin[i] = NEWLINE) then
X advance := 0;
X CCL:
X if (Locate(lin[i], pat, j+1)) then
X advance := 1;
X NCCL:
X if (lin[i] <> NEWLINE) and
X (not Locate(lin[i], pat, j+1)) then
X advance := 1
X otherwise
X Error('in omatch: can''t happen')
X end;
X if (advance >= 0) then begin
X i := i + advance;
X OMatch := true
X end
X else
X OMatch := false
Xend;
/
echo 'x - onerror.pascal'
sed 's/^X//' > onerror.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ OnError -- intercept pascalvs run-time errors }
Xsegment OnError;
Xdef ERRORIO: Boolean;
Xdef ATTENTION: Boolean;
Xdef OUTOFSPACE: Boolean;
Xvalue
X ERRORIO := false;
X ATTENTION := false;
X OUTOFSPACE := false;
X%include onerror
Xprocedure OnError;
Xvar
X statementNumber: String(10);
X procName: String(10);
X errorNo: String(10);
Xbegin
X if (FERROR in [41..53,75..78]) then begin
X ERRORIO := true;
X FACTION := [];
X end
X else if FERROR = 30 then begin
X ATTENTION := true;
X FACTION := [];
X end
X else if (FERROR = 64) and (not OUTOFSPACE) then begin
X OUTOFSPACE := true;
X FACTION := []
X end
X else if FERROR = 36 then begin
X FACTION := [XUMSG,XTRACE,XHALT];
X WriteStr(statementNumber, FSTMTNO:5);
X WriteStr(procName, FPROCNAME:8);
X WriteStr(errorNo, FERROR:5);
X FRETMSG := 'SWTOOLS ASSERT FAILURE: RID=' || PROCNAME||
X '; S#=' || statementNumber ||
X '; EID' || errorNo || ';';
X end
X else begin
X FACTION := [XUMSG,XTRACE];
X WriteStr(statementNumber, FSTMTNO:5);
X WriteStr(procName, FPROCNAME:8);
X WriteStr(errorNo, FERROR: 5);
X FRETMSG := '***SWTOOLS error: RID=' || procName
X || '; S#=' || statementNumber ||
X '; EID=' || errorNo || ';';
X end
Xend;
/
echo 'x - rot.pascal'
sed 's/^X//' > rot.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Rot -- Rotate a file 90 degrees clockwise }
Xprogram Rot;
X%include swtools
Xconst
X maxWidth = 2000;
X maxHeight = 130;
Xvar
X buffers: array [1..maxHeight] of array
X [1..maxWidth] of Char;
X i: Integer;
X j: Integer;
X maxReadWidth: Integer;
X maxReadHeight: Integer;
Xbegin
X ToolInit;
X i := 1;
X j := 1;
X maxReadWidth := 0;
X while (GetC(buffers[i,j]) <> ENDFILE) do begin
X if (buffers[i,j] = NEWLINE) then begin
X maxReadWidth := Max(maxReadWidth,j);
X for j := j to maxWidth do
X buffers[i,j] := BLANK;
X j := 1;
X i := i + 1;
X end
X else
X j := j + 1;
X if (i > maxHeight) or (j > maxWidth) then begin
X Message('input file too big');
X leave
X end
X end;
X maxReadHeight := i - 1;
X for i := 1 to maxReadWidth do begin
X for j := maxReadHeight downto 1 do
X PutC (buffers[j,i]);
X PutC (NEWLINE)
X end;
Xend.
/
echo 'x - subst.pascal'
sed 's/^X//' > subst.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SubSt -- substitute "sub" for occurrences of pattern }
Xsegment SubSt;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
X%include subdef
Xfunction SubSt;
Xvar
X new, old: StringType;
X j, k, lastm, line, m: Integer;
X stat: STCode;
X done, subbed, junk: Boolean;
Xbegin
X if (glob) then
X stat := OK
X else
X stat := ERR;
X done := (line1 <= 0);
X line := line1;
X while (not done) and (line <= line2) do begin
X j := 1;
X subbed := false;
X GetTxt(line, old);
X lastm := 0;
X k := 1;
X while (old[k] <> ENDSTR) do begin
X if (gFlag) or (not subbed) then
X m := AMatch(old, k, pat, 1)
X else
X m := 0;
X if (m > 0) and (lastm <> m) then begin
X { replace matched text }
X subbed := true;
X CatSub(old, k, m, sub, new, j, MAXSTR);
X lastm := m
X end;
X if (m = 0) or (m = k) then begin
X { no match or null match }
X junk := AddStr(old[k], new, j, MAXSTR);
X k := k + 1
X end
X else
X { skip matched text }
X k := m
X end;
X if (subbed) then begin
X if (not AddStr(ENDSTR, new, j, MAXSTR)) then begin
X stat := ERR;
X done := true
X end
X else begin
X stat := LnDelete(line, line, stat);
X stat := PutTxt(new);
X line2 := line2 + curLn - line;
X line := curLn;
X if (stat = ERR) then
X done := true
X else
X stat := OK
X end
X end;
X line := line + 1
X end;
X SubSt := stat
Xend;
/
echo 'x - sw.pascal'
sed 's/^X//' > sw.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SW[edit] -- main routine for text editor }
Xprogram SW;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xvar
X curSave, i: Integer;
X status: STCode;
X more: Boolean;
X argIndex: Integer;
Xdef line1: Integer; { first line number }
Xdef line2: Integer; { second line number }
Xdef nLines: Integer; { # lines in buffer }
Xdef curLn: Integer; { current line: value of dot }
Xdef lastLn: Integer; { last line: value of $ }
Xdef pat: StringType; { pattern }
Xdef lin: StringType; { input line }
Xdef saveFile: StringType; { file name }
Xvalue
X line1 := 0;
X line2 := 0;
X nLines := 0;
Xbegin
X ToolInit;
X SetBuf;
X pat[1] := ENDSTR;
X saveFile[1] := ENDSTR;
X i := 1;
X for argIndex := 1 to Nargs do
X if GetArg(argIndex, lin, MAXSTR) then begin
X SCopy (lin, 1, saveFile, i);
X i := StrLength(saveFile) + 2;
X saveFile[i-1] := BLANK
X end;
X i := 1;
X if saveFile[1] <> ENDSTR then
X if (not GetFid(saveFile, i, saveFile)) then
X saveFile[1] := ENDSTR;
X if saveFile[1] <> ENDSTR then
X if (DoRead(0, saveFile) = ERR) then
X Message('Cannot open input file');
X if (OptIsOn(promptFlag)) then begin
X PutC(COLON);
X PutC(NEWLINE)
X end;
X more := GetLine(lin, STDIN, MAXSTR);
X while (more) do begin
X i := 1;
X curSave := curLn;
X if (GetList(lin, i, Status) = OK) then begin
X if (CKGlob(lin, i, status) = OK) then
X status := DoGlob(lin, i, curSave, status)
X else if (status <> ERR) then
X status := DoCmd(lin, i, false, status)
X { else error - do nothing }
X end;
X if (status = ERR) then begin
X Message('eh?');
X curLn := Min(curSave, lastLn)
X end
X else if (status = ENDDATA) then
X more := false;
X { else ok }
X if (more) then begin
X if OptIsOn(promptFlag) then begin
X PutC(COLON);
X PutC(NEWLINE)
X end;
X more := GetLine(lin, STDIN, MAXSTR)
X end
X end;
X ClrBuf
Xend.
/
echo 'x - swtr.pascal'
sed 's/^X//' > swtr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Translit -- map characters }
Xprogram SWTr;
X%include swtools
X%include patdef
Xvar
X arg, fromSet, toSet: StringType;
X c: CharType;
X i, lastTo: 0..MAXSTR;
X allBut, squash: Boolean;
X{ XIndex -- conditionally invert value from strindex }
Xfunction XIndex (var inSet: StringType; c: CharType;
X allBut: Boolean; lastTo: Integer): Integer;
Xbegin
X if (c = ENDFILE) then
X XIndex := 0
X else if (not allBut) then
X XIndex := StrIndex(inSet,c)
X else if (StrIndex(inSet,c) > 0) then
X XIndex := 0
X else
X XIndex := lastTo + 1
Xend;
Xbegin
X ToolInit;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('usage: translit from to');
X allBut := (arg[1] = NEGATE);
X if allBut then
X i := 2
X else
X i := 1;
X if (not MakeSet(arg, i, fromSet, MaxStr)) then
X Error('translit: "from" set too large');
X if (not GetArg(2,arg, MAXSTR)) then
X toSet[1] := ENDSTR
X else if (not MakeSet(arg, 1, toSet, MAXSTR)) then
X Error('translit: "to" set too large')
X else if (StrLength(fromSet) < StrLength(toSet)) then
X Error('Translit: "from" shorter than "to"');
X lastTo := StrLength(toSet);
X squash := (StrLength(fromSet) > lastTo) or (allBut);
X repeat
X i := XIndex(fromSet, GetC(c), allBut, lastTo);
X if (squash) and (i >= lastTo) and (lastTo > 0) then begin
X PutC(toSet[lastTo]);
X repeat
X i := XIndex(fromSet, GetC(c), allBut, lastTo)
X until (i < lastTo)
X end;
X if (c <> ENDFILE) then begin
X if (i > 0) and (lastTo > 0) then { translate }
X PutC(toSet[i])
X else if (i = 0) then { copy }
X PutC(c)
X { else delete (don't print) }
X end
X until (c = ENDFILE)
Xend;
/
echo 'x - unique.pascal'
sed 's/^X//' > unique.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Unique -- strip adjacent duplicate lines in a file }
Xprogram Unique;
X%include swtools
Xvar
X buffer: array [0..1] of StringType;
X bufNum: 0..1;
X sameRecCount: Integer;
X counts: Boolean;
X lastRec: StringType;
Xbegin
X ToolInit;
X buffer[1,1] := ENDSTR;
X buffer[0,1] := NEWLINE; { just so's they're different }
X lastRec := buffer[1];
X counts := NArgs > 0;
X bufNum := 0;
X sameRecCount := 0;
X while(GetLine(buffer[bufNum], STDIN, MAXSTR)) do begin
X if (not Equal(buffer[0], buffer[1])) then begin
X if counts and (sameRecCount <> 0) then begin
X PutDec(sameRecCount, 6);
X PutC(BLANK)
X end;
X if sameRecCount <> 0 then
X PutStr(lastRec, STDOUT);
X lastRec := buffer[bufNum];
X sameRecCount := 1
X end
X else
X sameRecCount := sameRecCount + 1;
X bufNum := (1 - bufNum)
X end;
X if sameRecCount <> 0 then begin
X if counts then begin
X PutDec(sameRecCount, 6);
X PutC(BLANK)
X end;
X PutStr(lastRec, STDOUT)
X end
Xend.
/
echo 'x - unrotate.pascal'
sed 's/^X//' > unrotate.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ UnRotate -- Unrotate lines rotated by first half of KWIC }
XProgram UnRotate;
X%include swtools
Xconst
X MAXOUT = 80;
X MIDDLE = 40;
X FOLD = DOLLAR;
Xvar
X inBuf, outBuf: StringType;
X tempFile2: FileDesc;
X i, j, f: Integer;
Xbegin
X ToolInit;
X tempFile2 := STDIN;
X while (GetLine(inBuf, tempFile2, MAXSTR)) do begin
X for i := 1 to MAXOUT -1 do
X outBuf[i] := BLANK;
X f := StrIndex(inBuf, FOLD);
X j := MIDDLE - 1;
X for i := StrLength(inBuf)-1 downto f+1 do begin
X outBuf[j] := inBuf[i];
X j := j - 1;
X if (j <= 0) then
X j := MAXOUT - 1
X end;
X j := MIDDLE + 3;
X for i := 1 to f-1 do begin
X outBuf[j] := inBuf[i];
X j := j mod (MAXOUT - 1) + 1
X end;
X for j := 1 to MAXOUT - 1 do
X if (outBuf[j] <> BLANK) then
X i := j;
X outBuf[i+1] := ENDSTR;
X PutStr(outBuf, STDOUT);
X PutC(NEWLINE)
X end
Xend;
/
echo 'Part 04 of pack.out complete.'
exitsources-request@genrad.UUCP (07/13/85)
Mod.sources: Volume 2, Issue 11
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 05 of 06:'
echo 'x - append.pascal'
sed 's/^X//' > append.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Append -- append lines after "line" }
Xsegment Append;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Append;
Xvar
X inLine: StringType;
X stat: STCode;
X done: Boolean;
Xbegin
X if (glob) then
X stat := ERR
X else begin
X curLn := line;
X stat := OK;
X done := false;
X while (not done) and (stat = OK) do
X if (not GetLine(inLine, STDIN, MAXSTR)) then
X stat := ENDDATA
X else if (inLine[1] = PERIOD) and
X (inLine[2] = NEWLINE) then
X done := true
X else if (PutTxt(inLine) = ERR) then
X stat := ERR
X end;
X Append := stat
Xend;
/
echo 'x - catsub.pascal'
sed 's/^X//' > catsub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CatSub -- add replacement text to end of new }
Xsegment CatSub;
X%include swtools
X%include subdef
X%include metadef
Xprocedure CatSub;
Xvar
X i,j: Integer;
X junk: Boolean;
X l: Integer;
Xbegin
X i := 1;
X while (sub[i] <> ENDSTR) do begin
X if (sub[i] = DITTO) then begin
X l := Ord(sub[i+1]);
X if (l in [0..9]) then begin
X for j := metaTable[l].first to metaTable[l].last -1 do
X junk := AddStr(lin[j], new, k, maxNew);
X i := i + 1
X end
X else
X for j := s1 to s2-1 do
X junk := AddStr(lin[j], new, k, maxNew)
X end
X else
X junk := AddStr(sub[i], new, k, maxNew);
X i := i + 1
X end
Xend;
/
echo 'x - ckp.pascal'
sed 's/^X//' > ckp.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CkP -- check for "p" after command }
Xsegment CkP;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction CkP;
Xbegin
X SkipBl(lin, i);
X if (lin[i] = PCMD) then begin
X i := i + 1;
X pFlag := true
X end
X else
X pFlag := false;
X if (lin[i] = NEWLINE) then
X status := OK
X else
X status := ERR;
X CkP := status
Xend;
/
echo 'x - cscopy.pascal'
sed 's/^X//' > cscopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CSCopy -- copy cb[i]... to string s }
Xsegment CSCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure CSCopy;
Xvar
X j: Integer;
Xbegin
X j := 1;
X while (cb[i] <> ENDSTR) do begin
X s[j] := cb[i];
X i := i + 1;
X j := j + 1
X end;
X s[j] := ENDSTR
Xend;
/
echo 'x - ctoi.pascal'
sed 's/^X//' > ctoi.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CToI -- convert string at s[i] to integer, increment i }
Xsegment ctoi;
X%include swtools
Xfunction CToI;
Xvar
X n, sign: Integer;
Xbegin
X while (s[i] = BLANK) or (s[i] = TAB) do
X i := i + 1;
X if (s[i] = MINUS) then
X sign := -1
X else
X sign := 1;
X if (s[i] = MINUS) or (s[i] = PLUS) then
X i := i + 1;
X n := 0;
X while(IsDigit(s[i])) do begin
X n := 10 * n + Ord(s[i]) - Ord(DIG0);
X i := i + 1;
X end;
X CToI := sign * n;
Xend;
/
echo 'x - dochq.pascal'
sed 's/^X//' > dochq.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoChq -- Change quote characters }
Xsegment DoChq;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoChq;
Xvar
X temp: StringType;
X n: Integer;
Xbegin
X CsCopy(evalStk, argStk[i+2], temp);
X n := StrLength(temp);
X if (n <= 0) then begin
X lQuote := GRAVE;
X rQuote := ACUTE;
X end {elseif}
X else if (n = 1) then begin
X lQuote := temp[1];
X rQuote := lQuote
X end {elseif}
X else begin
X lQuote := temp[1];
X rQuote := temp[2]
X end {if}
Xend {DoCkq};
/
echo 'x - dodef.pascal'
sed 's/^X//' > dodef.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoDef -- install definition in table }
Xsegment DoDef;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoDef;
Xvar
X temp1, temp2: StringType;
Xbegin
X if (j - i > 2) then begin
X CsCopy(evalStk, argStk[i+2], temp1);
X CsCopy(evalStk, argStk[i+3], temp2);
X Install(temp1, temp2, MACTYPE)
X end {if};
Xend {DoDef};
/
echo 'x - doglob.pascal'
sed 's/^X//' > doglob.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoGlob -- do command at lin[i] on all marked lines }
Xsegment DoGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoGlob;
Xvar
X count, iStart, n: Integer;
Xbegin
X status := OK;
X count := 0;
X n := line1;
X iStart := i;
X repeat
X if (GetMark(n)) then begin
X PutMark(n, false);
X curLn := n;
X curSave := curLn;
X i := iStart;
X if (GetList(lin, i, status) = OK) then
X if (DoCmd(lin, i, true, status) = OK) then
X count := 0;
X end
X else begin
X n := NextLn(n);
X count := count + 1
X end
X until (count > lastLn) or (status <> OK);
X DoGlob := status
Xend;
/
echo 'x - doif.pascal'
sed 's/^X//' > doif.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoIf -- Select one of two arguments }
Xsegment DoIf;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoIf;
Xvar
X temp1, temp2, temp3: StringType;
Xbegin
X if (j - i >= 4) then begin
X CsCopy(evalStk, argStk[i+2], temp1);
X CsCopy(evalStk, argStk[i+3], temp2);
X if (Equal(temp1, temp2)) then
X CsCopy(evalStk, argStk[i+4], temp3)
X else if (j - i >= 5) then
X CsCopy(evalStk, argStk[i+5], temp3)
X else
X temp3[1] := ENDSTR;
X PBStr(temp3)
X end {if}
Xend {DoIf};
/
echo 'x - dolen.pascal'
sed 's/^X//' > dolen.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoLen -- Return length of argument }
Xsegment DoLen;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoLen;
Xvar
X temp: StringType;
Xbegin
X if (j - i > 1) then begin
X CsCopy(evalStk, argStk[i+2], temp);
X PBNum(StrLength(temp))
X end {then}
X else
X PBNum(0)
Xend {DoLen};
/
echo 'x - dolprint.pascal'
sed 's/^X//' > dolprint.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoLPrint -- print lines n1 thru n2 unambiguously }
Xsegment DoLPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include chardef
Xfunction DoLPrint;
Xvar
X lp: Integer;
X i: Integer;
X line: StringType;
Xbegin
X if (n1 < 0) then
X DoLPrint := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X if OptIsOn(numFlag) then begin
X PutDec(i, 5);
X PutC(BLANK)
X end;
X for lp := 1 to StrLength(line) do begin
X if CharClass(line[lp]) <> [] then
X PutC(line[lp])
X else if line[lp] = NEWLINE then
X PutC(NEWLINE)
X else begin
X PutC(BACKSLASH);
X PutDec(Ord(line[lp]), 3)
X end
X end
X end;
X curLn := n2;
X DoLPrint := OK
X end
Xend;
/
echo 'x - doprint.pascal'
sed 's/^X//' > doprint.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoPrint -- print lines n1 thru n2 }
Xsegment DoPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoPrint;
Xvar
X i: Integer;
X line: StringType;
Xbegin
X if (n1 < 0) then
X DoPrint := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X if OptIsOn(numFlag) then begin
X PutDec(i, 5);
X PutC(BLANK)
X end;
X PutStr(line, STDOUT)
X end;
X curLn := n2;
X DoPrint := OK
X end
Xend;
/
echo 'x - dowrite.pascal'
sed 's/^X//' > dowrite.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoWrite -- write lines n1..n2 into file }
Xsegment DoWrite;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoWrite;
Xvar
X i: Integer;
X fd: FileDesc;
X line: StringType;
Xbegin
X fd := FCreate(fil, IOWRITE);
X if (fd = IOERROR) then
X DoWrite := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X PutStr(line,fd)
X end;
X FClose(fd);
X PutDec(n2-n1+1, 1);
X PutC(NEWLINE);
X DoWrite := OK
X end
Xend;
/
echo 'x - esc.pascal'
sed 's/^X//' > esc.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Esc -- map s(i) into escaped characters, increment i }
Xsegment Esc;
X%include swtools
Xfunction Esc;
Xbegin
X if (s[i] <> ESCAPE) then
X Esc := s[i]
X else if (s[i+1] = ENDSTR) then { @ not special at end }
X Esc := ESCAPE
X else begin
X i := i + 1;
X if (s[i] = LETN) or (s[i] = BIGN) then
X Esc := NEWLINE
X else if (s[i] = TAB) then
X Esc := TAB
X else
X Esc := s[i]
X end
Xend;
/
echo 'x - expr.pascal'
sed 's/^X//' > expr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Expr -- Recursive expression evaluation }
Xsegment Expr;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Expr;
Xvar
X v: Integer;
X t: CharType;
Xbegin
X v := Term(s, i);
X t := GNBChar(s, i);
X while (t in [PLUS, MINUS]) do begin
X i := i + 1;
X if (t = PLUS) then
X v := v + Term(s, i)
X else
X v := v - Term(s, i);
X t := GNBChar(s, i)
X end {while};
X Expr := v
Xend {Expr};
/
echo 'x - factor.pascal'
sed 's/^X//' > factor.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Factor -- Evaluate factor of arithmetic expression }
Xsegment Factor;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Factor;
Xbegin
X if (GNBChar(s, i) = LPAREN) then begin
X i := i + 1;
X Factor := Expr(s, i);
X if (GNBChar(s, i) = RPAREN) then
X i := i + 1
X else
X Message('Macro: missing paren in expr')
X end {then}
X else
X Factor := CToI(s, i)
Xend {Factor};
/
echo 'x - getccl.pascal'
sed 's/^X//' > getccl.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetCCL -- expand char class at arg[i] into pat[j }
Xsegment GetCCL;
X%include swtools
X%include patdef
Xfunction GetCCL;
Xvar
X jStart: Integer;
X junk: Boolean;
Xbegin
X i := i + 1; {skip over CCL}
X if (arg[i] = NEGATE) then begin
X junk := AddStr(NCCL, pat, j, MAXPAT);
X i := i + 1
X end
X else
X junk := AddStr(CCL, pat, j, MAXPAT);
X jStart := j;
X junk := AddStr(ENDSTR, pat, j, MAXPAT); {make room for count}
X DoDash(CCLEND, arg, i, pat, j, MAXPAT);
X { putting an integer into a char only works if the number is les
X than 255}
X pat[jStart] := Chr(j - jStart - 1);
X GetCCL := (arg[i] = CCLEND)
Xend;
/
echo 'x - getpbc.pascal'
sed 's/^X//' > getpbc.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetPBC -- get a (possibly pushed back) character }
Xsegment GetPBC;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetPBC;
Xbegin
X if (bp > 0) then
X c := buf[bp]
X else begin
X bp := 1;
X buf[bp] := GetC(c);
X end;
X if (c <> ENDFILE) then
X bp := bp - 1;
X GetPBC := c
Xend;
/
echo 'x - getrhs.pascal'
sed 's/^X//' > getrhs.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetRHS -- get right hand side of "s" command }
Xsegment GetRHS;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include subdef
Xfunction GetRHS;
Xbegin
X GetRHS := OK;
X if (lin[i] = ENDSTR) then
X GetRHS := ERR
X else if (lin[i+1] = ENDSTR) then
X GetRHS := ERR
X else begin
X i := MakeSub(lin, i+1, lin[i], sub);
X if (i = 0) then
X GetRHS := ERR
X else if (lin[i+1] = LETG) then begin
X i := i + 1;
X gFlag := true
X end
X else
X gFlag := false
X end
Xend;
/
echo 'x - gettok.pascal'
sed 's/^X//' > gettok.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetTok -- get token for define }
Xsegment GetTok;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetTok;
Xvar
X i: Integer;
X done: Boolean;
X junk: CharType;
Xbegin
X i := 1;
X done := false;
X while (not done) and (i < tokSize) do begin
X token[i] := GetPBC(junk);
X if (IsAlphaNum(token[i])) then
X i := i + 1
X else
X done := true
X end;
X if (i >= tokSize) then
X Error('define: token too long');
X if (i > 1) then begin { some alpha was seen }
X PutBack(token[i]);
X i := i - 1
X end;
X { else single non-alphanumeric }
X token[i+1] := ENDSTR;
X GetTok := token[1]
Xend;
/
echo 'x - getword.pascal'
sed 's/^X//' > getword.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ getword -- get word form s(i) into out }
Xsegment GetWord;
X%include swtools
Xfunction GetWord;
Xvar
X j: Integer;
Xbegin
X while (s[i] in [BLANK,TAB,NEWLINE]) do
X i := i + 1;
X j := 1;
X while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin
X out[j] := s[i];
X i := i + 1;
X j := j + 1
X end;
X out[j] := ENDSTR;
X if (j = 1) then
X GetWord := 0
X else
X GetWord := i
Xend;
/
echo 'x - grep.pascal'
sed 's/^X//' > grep.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Grep -- Globally look for Regular Expressions and Print }
Xprogram Grep;
X%include swtools
X%include patdef
X%include matchdef
Xvar
X arg, lin, pat: StringType;
X returnCode: Integer;
Xbegin
X ToolInit;
X returnCode := 4;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('Usage: Grep pattern');
X if (not GetPat(arg, pat)) then
X Error('Grep: illegal pattern');
X while (GetLine(lin, STDIN, MAXSTR)) do
X if (Match(lin, pat)) then begin
X returnCode := 0;
X PutStr(lin, STDOUT)
X end;
X ProgExit(returnCode)
Xend.
/
echo 'x - includ.pascal'
sed 's/^X//' > includ.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Includ -- replace include file by contents }
XProgram Includ;
X%include swtools
Xvar incl: StringType;
X{ FInclude -- include file desc f }
Xprocedure FInclude(f: FileDesc);
Xvar
X line,strg: StringType;
X loc, i: Integer;
X f1: FileDesc;
Xbegin
X while(GetLine(line,f,MAXSTR)) do begin
X loc := GetWord(line,1,strg);
X if (not Equal(strg,incl)) then
X PutStr(line,STDOUT)
X else begin
X if GetFid(line, loc, strg) then begin
X f1 := MustOpen(strg,IOREAD);
X FInclude(f1);
X FClose(f1);
X end
X else
X Error('Bad file name');
X end
X end
Xend;
Xbegin
X ToolInit;
X CvtSST('#include', incl);
X FInclude(STDIN)
Xend.
/
echo 'x - initmacr.pascal'
sed 's/^X//' > initmacr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ InitMacro -- initialize variables for macro }
Xsegment InitMacro;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure InitMacro;
Xbegin
X null[1] := ENDSTR;
X CvtSST('define', defName);
X CvtSST('substr', subName);
X CvtSST('expr', exprName);
X CvtSST('ifelse', ifName);
X CvtSST('len', lenName);
X CvtSST('changeq', chqName);
X bp := 0; { push back buffer pointer }
X traceing := false;
X if NArgs > 0 then traceing := true;
X InitHash;
X lQuote := GRAVE;
X rQuote := ACUTE;
Xend {InitMacro};
/
echo 'x - kwic.exec'
sed 's/^X//' > kwic.exec << '/'
X&CONTROL OFF
X&IF &1 EQ ? &GOTO -EXPLAIN
XSTATE &1 &2 *
X&IF &RETCODE NE 0 &GOTO -NOFILE
XKWIC < &1 &2 > KWIC TEMP1 A
X&IF &RETCODE NE 0 &GOTO -DIED
XBNRSORT KWIC TEMP1 KWIC TEMP2 AP 1 20
X&IF &RETCODE NE 0 &GOTO -DIED
XUNROTATE < KWIC TEMP2 > &1 KWIC A
X&IF &RETCODE NE 0 &GOTO -DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&EXIT 0
X-NOFILE
X&TYPE FILE &1 &2 DOES NOT EXIST
X&EXIT 4
X-DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&TYPE ONE OF THE KWIC PASSES DIED
X&EXIT 8
X-EXPLAIN
X&BEGTYPE
X KWIC INNAME INTYPE
X
X Kwic is an EXEC that produces a "Keyword in Context" Index.
X Kwic takes the file specified by inFile inType and creates
X the index in a file called "inFile KWIC"
X
X The first "inName inFile" encountered in your search path is
X used. "inFile KWIC" is created on your A disk.
X
X It is recommended that you never "KWIC" a "KWIC" file.
X&END
/
echo 'x - lndelete.pascal'
sed 's/^X//' > lndelete.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ LnDelete -- delete lines n1 thru n2 }
Xsegment LnDelete;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction LnDelete;
Xbegin
X if (n1 <= 0) then
X status := ERR
X else begin
X BlkMove(n1, n2, lastLn);
X lastLn := lastLn - (n2 - n1 + 1);
X curLn := PrevLn(n1);
X status := OK
X end;
X LnDelete := status
Xend;
/
echo 'x - locate.pascal'
sed 's/^X//' > locate.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Locate -- look for c in character class at pat[offset] }
Xsegment Locate;
X%include swtools
X%include matchdef
Xfunction Locate;
Xvar
X i: Integer;
Xbegin
X { size of class is at pat[offset], characters follow }
X Locate := false;
X i := offset + Ord(pat[offset]); { last position }
X while (i > offset) do
X if (c = pat[i]) then begin
X locate := true;
X i := offset { force loop termination }
X end
X else
X i := i - 1
Xend;
/
echo 'x - lookup.pascal'
sed 's/^X//' > lookup.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Lookup -- locate name, get defn and type from table }
Xsegment Lookup;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction Lookup;
Xvar
X p: ndPtr;
Xbegin
X p := HashFind(name);
X if (p = nil) then
X Lookup := false
X else begin
X Lookup := true;
X CSCopy(NDTable, p->.defn, defn);
X t := p->.kind
X end
Xend;
/
echo 'x - match.pascal'
sed 's/^X//' > match.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Match -- find match anywhere on line + support fcns }
Xsegment Match;
X%include swtools
X%include patdef
X%include matchdef
Xfunction Match;
Xvar
X i, pos: Integer;
Xbegin
X pos := 0;
X i := 1;
X while (lin[i] <> ENDSTR) and (pos = 0) do begin
X pos := AMatch(lin, i, pat, 1);
X i := i + 1;
X end;
X Match := (pos > 0)
Xend;
/
echo 'x - move.pascal'
sed 's/^X//' > move.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Move -- move line1 thru line2 after line3 }
Xsegment Move;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Move;
Xbegin
X if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X Move := ERR
X else begin
X BlkMove(line1, line2, line3);
X if (line3 > line1) then
X curLn := line3
X else
X curLn := line3 + (line2 - line1 + 1);
X Move := OK
X end
Xend;
/
echo 'x - nextln.pascal'
sed 's/^X//' > nextln.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ NextLn/PrevLn -- get next/previous line number }
Xsegment NextLn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction NextLn;
Xbegin
X if (n >= lastLn) then
X nextLn := 0
X else
X nextLn := n + 1
Xend;
Xfunction PrevLn;
Xbegin
X if (n <= 0) then
X PrevLn := lastLn
X else
X PrevLn := n - 1
Xend;
/
echo 'x - optpat.pascal'
sed 's/^X//' > optpat.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ OptPat -- get optional pattern from lin[i], increment i }
Xsegment OptPat;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include patdef
Xfunction OptPat;
Xbegin
X if (lin[i] = ENDSTR) then
X i := 0
X else if (lin[i + 1] = ENDSTR) then
X i := 0
X else if (lin[I + 1] = lin[i]) then { leave existing pattern alone }
X i := i + 1
X else
X i := MakePat(lin, i+1, lin[i], pat);
X if (pat[1] = ENDSTR) then
X i := 0;
X if (i = 0) then begin
X pat[1] := ENDSTR;
X OptPat := ERR
X end
X else
X OptPat := OK
Xend;
/
echo 'x - patscan.pascal'
sed 's/^X//' > patscan.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PatScan -- find next occurance of pattern after line n }
Xsegment PatScan;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction PatScan;
Xvar
X done: Boolean;
X line: StringType;
Xbegin
X n := curLn;
X PatScan := ERR;
X done := false;
X repeat
X if (way = SCAN) then
X n := NextLn(n)
X else
X n := PrevLn(n);
X GetTxt(n, line);
X if (Match(line, pat)) then begin
X PatScan := OK;
X done := true
X end
X until (n = curLn) or (done)
Xend;
/
echo 'x - patsize.pascal'
sed 's/^X//' > patsize.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PatSize -- returns size of pattern entry at pat[n] }
Xsegment PatSize;
X%include swtools
X%include patdef
X%include matchdef
X%include metadef
Xfunction PatSize;
Xbegin
X case pat[n] of
X LITCHAR:
X PatSize := 2;
X BOL, EOL, ANY, BOM, EOM:
X PatSize := 1;
X CCL, NCCL:
X PatSize := Ord(pat[n+1]) + 2;
X CLOSURE:
X PatSize := CLOSIZE
X otherwise
X Error('in PatSize: Can''t happen');
X end
Xend;
/
echo 'x - putchr.pascal'
sed 's/^X//' > putchr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutChr -- put single char on output or eval stack }
Xsegment PutChr;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PutChr;
Xbegin
X if (cp <= 0) then
X PutC(c)
X else begin
X if (ep > EVALSIZE) then
X Error('Macro: evaluation stack overflow');
X evalStk[ep] := c;
X ep := ep + 1
X end {if}
Xend {PutChr};
/
echo 'x - putstr.pascal'
sed 's/^X//' > putstr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutStr -- put string out on file }
Xsegment PutStr;
X%include swtools
X%include ioref
Xprocedure PutStr;
Xvar
X i: Integer;
X j: integer;
X len: Integer;
X outString: StringType;
Xbegin
X i := 1;
X j := 1;
X len := StrLength(str);
X while i <= len do begin
X if str[i] = NEWLINE then begin
X if j = 1 then WriteLn(openList[fd].fileVar)
X else WriteLn(openList[fd].fileVar, outString:j-1);
X j := 1;
X end {then}
X else begin
X outString[j] := str[i];
X j := j + 1;
X end; {if}
X i := i + 1
X end; {while}
X if j <> 1 then write(openList[fd].fileVar, outString:j-1);
Xend; {PutStr}
/
echo 'x - putsub.pascal'
sed 's/^X//' > putsub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutSub -- output substitution text }
Xsegment PutSub;
X%include swtools
X%include subdef
Xprocedure PutSub;
Xvar
X i, j: Integer;
X junk: Boolean;
Xbegin
X i := 1;
X while (sub[i] <> ENDSTR) do begin
X if (sub[i] = DITTO) then
X for j := s1 to s2-1 do
X PutC(lin[j])
X else
X PutC(sub[i]);
X i := i + 1
X end
Xend;
/
echo 'x - sccopy.pascal'
sed 's/^X//' > sccopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SCCopy -- copy string s to cb[i] }
Xsegment SCCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure SCCopy;
Xvar
X j: Integer;
Xbegin
X j := 1;
X while (s[j] <> ENDSTR) do begin
X cb[i] := s[j];
X j := j + 1;
X i := i + 1
X end;
X cb[i] := ENDSTR
Xend;
/
echo 'x - screen.pascal'
sed 's/^X//' > screen.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Screen -- line printer character test }
Xprogram Screen;
X%include swtools
X%include ioref
Xvar i: Integer;
X first: Integer;
Xbegin
XToolInit;
XWriteLn(openList[STDOUT].fileVar, ' C H A R A C T E R S E T');
XPutC(NEWLINE);
XWriteLn(openList[STDOUT].FileVar,
X ' 0 1 2 3 4 5 6 7 8 9 A B C D E F');
Xfor i := 0 to 255 do begin
X if i mod 16 = 0 then begin
X PutC(NEWLINE);
X PutC(NEWLINE);
X first := i div 16;
X if first >= 10 then
X PutC(Chr(first + Ord(BIGA) - 10))
X else
X PutC(Chr(i div 16 + Ord(DIG0)));
X PutC(DIG0);
X PutC(BLANK);
X PutC(BLANK);
X end;
X Write(openList[STDOUT].fileVar, ' ', Chr(i))
Xend
Xend.
/
echo 'x - stclose.pascal'
sed 's/^X//' > stclose.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ StClose -- insert closure entry at pat[j] }
Xsegment STClose;
X%include swtools
X%include patdef
Xprocedure StClose;
Xvar
X jp, jt: Integer;
X junk: Boolean;
Xbegin
X for jp := j-1 downto lastJ do begin
X jt := jp + CLOSIZE;
X junk := AddStr(pat[jp], pat, jt, MAXPAT)
X end;
X j := j + CLOSIZE;
X pat[lastJ] := CLOSURE { where original pattern began }
Xend;
/
echo 'x - strindex.pascal'
sed 's/^X//' > strindex.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ StrIndex -- find position of character c in string s }
Xsegment StrIndex;
X%include swtools
Xfunction StrIndex;
Xvar
X i: Integer;
Xbegin
X i := 1;
X while (s[i] <> c) and (s[i] <> ENDSTR) do
X i := i + 1;
X if (s[i] = ENDSTR) then
X StrIndex := 0
X else
X StrIndex := i
Xend;
/
echo 'x - subline.pascal'
sed 's/^X//' > subline.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SubLine -- substitute sub for pat in lin and print }
Xsegment SubLine;
X%include swtools
X%include patdef
X%include subdef
X%include matchdef
Xprocedure SubLine;
Xvar
X i, lastm, m: Integer;
X junk: Boolean;
Xbegin
X lastm := 0;
X i := 1;
X while (lin[i] <> ENDSTR) do begin
X m := AMatch(lin, i, pat, 1);
X if (m > 0) and (lastm <> m) then begin
X { replace substituted text }
X PutSub(lin, i, m, sub);
X lastm := m
X end;
X if (m = 0) or (m = i) then begin
X { no match or null match }
X PutC(lin[i]);
X i := i + 1
X end
X else { skip matched text }
X i := m
X end
Xend;
/
echo 'x - swch.pascal'
sed 's/^X//' > swch.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Change -- change "from" into "to" on each line }
Xprogram swch;
X%include swtools
X%include patdef
X%include matchdef
X%include subdef
Xvar
X lin, pat, sub, arg: StringType;
Xbegin
X ToolInit;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('usage: change from <to>');
X if (not GetPat(arg, pat)) then
X Error('change: illegal "from" pattern');
X if (not GetArg(2, arg, MAXSTR)) then
X arg[1] := ENDSTR;
X if (not GetSub(arg, sub)) then
X Error('change: illegal "to" string');
X while (GetLine(lin, STDIN, MAXSTR)) do
X SubLine(lin, pat, sub)
Xend;
/
echo 'x - swprint.exec'
sed 's/^X//' > swprint.exec << '/'
X&TRACE OFF
XCP SPOOL PRT CONT HOLD FORM LW1T
XERASE CMS EXEC A
XEXECUTIL WRITE CMS EXEC A (&TRACE OFF)
XLISTFILE * PASCAL C (APPEND
XEXEC CMS EXEC SWPRIN1
XERASE CMS EXEC A
XERASE SWTOOLS LDATE C
XEXECUTIL WRITE SWTOOLS LDATE C (JUNK)
XERASE CMS EXEC
XCP SPOOL PRT CLOSE
/
echo 'x - term.pascal'
sed 's/^X//' > term.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Term -- Evaluate term of arithmetic expression }
Xsegment Term;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Term;
Xvar
X v: Integer;
X t: CharType;
Xbegin
X v := Factor(s, i);
X t := GNBChar(s, i);
X while (t in [STAR, SLASH, PERCENT]) do begin
X i := i + 1;
X case t of
X STAR:
X v := v * Factor(s, i);
X SLASH:
X v := v div Factor(s, i);
X PERCENT:
X v := v mod Factor(s, i)
X end {case};
X t := GNBChar(s, i)
X end {while};
X Term := v
Xend { Term };
/
echo 'x - wc.pascal'
sed 's/^X//' > wc.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Wc -- Word Counting program }
Xprogram Wc;
X%include SWTOOLS
Xvar
X buffer: StringType;
X numChars: Integer;
X numWords: Integer;
X numLines: Integer;
X i: Integer;
X lineLength: Integer;
X inWord: Boolean;
Xbegin
X ToolInit;
X numChars := 0;
X numWords := 0;
X numLines := 0;
X while (GetLine(buffer, STDIN, MAXSTR)) do begin
X inWord := false;
X numLines := numLines + 1;
X lineLength := StrLength (buffer);
X numChars := numChars + lineLength;
X for i := 1 to lineLength do
X if (buffer[i] = BLANK) then
X inWord := false
X else if (not inWord) then begin
X inWord := true;
X numWords := numWords + 1;
X end; {if}
X end; {while}
X PutDec(numChars, 7);
X PutDec(numWords, 7);
X PutDec(numLines, 7);
Xend; {Wc}
/
echo 'Part 05 of pack.out complete.'
exitsources-request@genrad.UUCP (07/14/85)
Mod.sources: Volume 2, Issue 12
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 06 of 06:'
echo 'x - addstr.pascal'
sed 's/^X//' > addstr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ AddStr -- put c in outSet[j] if it fits, increment j }
Xsegment AddStr;
X%include swtools
Xfunction Addstr;
Xbegin
X if (j > maxSet) then
X AddStr := false
X else begin
X outSet[j] := c;
X j := j + 1;
X AddStr := true
X end
Xend;
/
echo 'x - cvtsst.pascal'
sed 's/^X//' > cvtsst.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CvtSST -- assign pascalvs string to StringType }
Xsegment CvtSST;
X%include swtools
Xprocedure CvtSST;
Xvar
X i: 1..MAXSTR;
Xbegin
X for i := 1 to Length(src) do
X dest[i] := src[i];
X dest[Length(src) + 1] := ENDSTR;
Xend;
/
echo 'x - cvtsts.pascal'
sed 's/^X//' > cvtsts.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CvtStS -- convert swtools StringType to Pascalvs String }
Xsegment cvtsts;
X%include swtools
Xprocedure cvtsts;
Xbegin
X WriteStr(dest, src:StrLength(src));
Xend;
/
echo 'x - doexpr.pascal'
sed 's/^X//' > doexpr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoExpr -- Evaluate arithmetic expression }
Xsegment DoExpr;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoExpr;
Xvar
X temp: StringType;
X junk: Integer;
Xbegin
X CsCopy(evalStk, argStk[i+2], temp);
X junk := 1;
X PBNum(Expr(temp, junk))
Xend {DoExpr};
/
echo 'x - echo.pascal'
sed 's/^X//' > echo.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Echo -- echo arguments }
Xprogram Echo;
X%include swtools
Xvar
X lin: StringType;
X i: Integer;
X junk: Boolean;
Xbegin
X ToolInit;
X for i := 1 to Nargs do begin
X junk := GetArg(i, lin, MAXSTR);
X PutStr(lin, STDOUT);
X if i < Nargs then PutCF(BLANK, STDOUT)
X end;
X PutCF(NEWLINE, STDOUT)
Xend.
/
echo 'x - equal.pascal'
sed 's/^X//' > equal.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Equal -- test two strings for equality }
Xsegment Equal;
X%include swtools
Xfunction Equal;{str1, str2: StringType): Boolean}
Xvar
X i: Integer;
Xbegin
X i := 1;
X while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
X i := i + 1;
X Equal := (str1[i] = str2[i])
Xend;
/
echo 'x - error.pascal'
sed 's/^X//' > error.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
Xsegment Error;
X%include swtools
Xprocedure Error;
Xvar
X i: 1..MAXSTR;
Xbegin
X for i := 1 to Length(s) do
X PutCF(s[i], STDERR);
X PutCF(NEWLINE,STDERR);
X RetCode(1000);
X HALT;
Xend;
/
echo 'x - fclose.pascal'
sed 's/^X//' > fclose.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FClose -- close a file }
Xsegment FClose;
X%include swtools
X%include ioref
Xprocedure FClose;
Xbegin
X if (fd > STDERR) and (fd <= MAXOPEN) and
X (openList[fd].mode <> IOAVAIL) then begin
X Close(openList[fd].fileVar);
X openList[fd].mode := IOAVAIL;
X ERRORIO := false;
X end;
Xend;
/
echo 'x - fcopy.pascal'
sed 's/^X//' > fcopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FCopy -- Copy file fin to file fout }
Xsegment FCopy;
X%include SWTOOLS
X%include IODEF
Xprocedure FCopy;
Xvar
X temp: StringType;
Xbegin
X while (GetLine(temp, fin, MAXSTR)) do
X PutStr(temp, fout);
Xend; {FCopy}
/
echo 'x - fcreate.pascal'
sed 's/^X//' > fcreate.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FCreate -- create a file (temporary version) }
Xsegment FCreate;
X%include swtools
Xfunction FCreate;
Xbegin
X FCreate := FOpen(name, mode)
Xend;
/
echo 'x - fdalloc.pascal'
sed 's/^X//' > fdalloc.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FDAlloc - find a free file descriptor }
Xsegment FDAlloc;
X%include swtools
X%include ioref
Xfunction FDAlloc;
Xvar
X fd: FileDesc;
X done: Boolean;
Xbegin
X done := false;
X fd := Succ(STDERR);
X repeat
X done := (openList[fd].mode = IOAVAIL) or (fd = MAXOPEN);
X if (not done) then
X fd := Succ(fd)
X until (done);
X if openList[fd].mode = IOAVAIL then
X FDAlloc := fd
X else
X FDAlloc := IOERROR
Xend;
/
echo 'x - getarg.pascal'
sed 's/^X//' > getarg.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetArg (CMS) -- get n-th command line parameter }
Xsegment GetArg;
X%include swtools
X%include ioref
Xfunction GetArg;
Xbegin
X if ((n < 1) or (cmdArgs < n)) then
X GetArg := false
X else begin
X SCopy(cmdLin,cmdIdx[n], str, 1);
X GetArg := true
X end
Xend;
/
echo 'x - getcf.pascal'
sed 's/^X//' > getcf.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetCF -- get character from file }
Xsegment GetCF;
X%include swtools
X%include ioref
Xfunction GetCF;
Xbegin
X if Eof(openList[fd].fileVar) then begin
X c := ENDFILE;
X GetCF := ENDFILE
X end
X else if Eoln(openList[fd].fileVar) then begin
X GetCF := NEWLINE;
X c := NEWLINE;
X ReadLn(openList[fd].fileVar);
X end
X else begin
X Read(openList[fd].fileVar,c);
X GetCF := c;
X end
Xend;
Xfunction GetC;
Xbegin
X c := GetCF(c, STDIN);
X GetC := c;
Xend;
/
echo 'x - getsub.pascal'
sed 's/^X//' > getsub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetSub -- Get substitution pattern and support fcns }
Xsegment GetSub;
X%include swtools
X%include patdef
X%include subdef
X{ GetSub -- Get substitution pattern and support fcns }
Xfunction GetSub;
Xbegin
X GetSub := (MakeSub(arg, 1, ENDSTR, sub) > 0)
Xend;
/
echo 'x - gnbchar.pascal'
sed 's/^X//' > gnbchar.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GNBChar -- Get next non-blank character }
Xsegment GNBChar;
X%include swtools
X%include macdefs
X%include macproc
Xfunction GNBChar;
Xbegin
X while (s[i] in [BLANK, TAB, NEWLINE]) do
X i := i + 1;
X GNBChar := s[i]
Xend {GNBChar};
/
echo 'x - hash.pascal'
sed 's/^X//' > hash.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Hash -- compute hash function of a name }
Xsegment Hash;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction Hash;
Xvar
X i, h: Integer;
Xbegin
X h := 0;
X for i := 1 to StrLength(name) do
X h := (3 * h + Ord(name[i])) mod HASHSIZE;
X Hash := h + 1
Xend;
/
echo 'x - inithash.pascal'
sed 's/^X//' > inithash.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ InitHash -- initialize hash table to nil }
Xsegment InitHash;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure InitHash;
Xvar
X i: 1..HASHSIZE;
Xbegin
X nextTab := 1; { first free slot in table }
X for i := 1 to HASHSIZE do
X hashTab[i] := nil
Xend;
/
echo 'x - isalphan.pascal'
sed 's/^X//' > isalphan.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ IsAlphaNum -- true if c is letter or digit }
Xsegment IsAlphaNum;
X%include swtools
Xfunction IsAlphaNum;
Xbegin
X IsAlphaNum := ((c >= LETA) and (c <= LETI)) or
X ((c >= LETJ) and (c <= LETR)) or
X ((c >= LETS) and (c <= LETZ)) or
X ((c >= BIGA) and (c <= BIGI)) or
X ((c >= BIGJ) and (c <= BIGR)) or
X ((c >= BIGS) and (c <= BIGZ)) or
X ((c >= DIG0) and (c <= DIG9))
Xend;
/
echo 'x - isdigit.pascal'
sed 's/^X//' > isdigit.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ IsDigit -- true if c is a digit }
Xsegment IsDigit;
X%include swtools
Xfunction IsDigit;
Xbegin
X IsDigit := c in [DIG0..DIG9];
Xend;
/
echo 'x - isletter.pascal'
sed 's/^X//' > isletter.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ IsLetter -- true if c is a letter of either case }
Xsegment IsLetter;
X%include swtools
X%include chardef
Xfunction IsLetter;
Xbegin
X IsLetter := ChLetter in CharClass(c)
Xend;
/
echo 'x - itoc.pascal'
sed 's/^X//' > itoc.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ IToC -- convert integer n to char string in s[i] ... }
Xsegment IToC;
X%include swtools
Xfunction IToC;
Xbegin
X if (n < 0) then begin
X s[i] := MINUS;
X IToC := IToC(-n, s, i+1);
X end
X else begin
X if (n >= 10) then
X i := IToC(n div 10, s, i);
X s[i] := Chr(n mod 10 + Ord(DIG0));
X s[i+1] := ENDSTR;
X IToC := i + 1;
X end
Xend;
/
echo 'x - makeset.pascal'
sed 's/^X//' > makeset.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MakeSet -- make set from inset(k) in outset }
Xsegment MakeSet;
X%include swtools
X%include patdef
Xfunction MakeSet;
Xvar
X j: Integer;
Xbegin
X j := 1;
X DoDash(ENDSTR, inSet, k, outSet, j, maxSet);
X makeSet := AddStr(ENDSTR, outSet, j, maxSet)
Xend;
/
echo 'x - message.pascal'
sed 's/^X//' > message.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Message -- print a PASCALVS string on STDERR }
Xsegment Message;
X%include swtools
Xprocedure Message;
Xvar
X i: 1..MAXSTR;
Xbegin
X for i := 1 to Length(s) do
X PutCF(s[i], STDERR);
X PutCF(NEWLINE,STDERR);
Xend;
/
echo 'x - mustopen.pascal'
sed 's/^X//' > mustopen.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MustOpen -- same as FOpen except for no allowance of failure }
Xsegment MustOpen;
X{ mustopen -- open file or die }
X%include swtools
Xfunction MustOpen;
Xvar
X fd: FileDesc;
Xbegin
X fd := FOpen(fname, fMode);
X if (fd = IOERROR) then begin
X PutStr(fname, STDERR);
X Error(': can''t open file')
X end;
X MustOpen := fd
Xend;
/
echo 'x - nargs.pascal'
sed 's/^X//' > nargs.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Nargs (CMS) -- return number of arguments }
Xsegment Nargs;
X%include swtools
X%include ioref
Xfunction NArgs;
Xbegin
X NArgs := cmdArgs
Xend;
/
echo 'x - pbnum.pascal'
sed 's/^X//' > pbnum.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PBNum -- Convert number to string, push back on input }
Xsegment PBNum;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PBNum;
Xvar
X temp: StringType;
X junk: Integer;
Xbegin
X junk := IToC(n, temp, 1);
X PBStr(temp)
Xend {PBNum};
/
echo 'x - pbstr.pascal'
sed 's/^X//' > pbstr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PBStr -- push string back onto input }
Xsegment PBStr;
X%include swtools
X%include defdef
X%include defproc
Xprocedure PBStr;
Xvar
X i: Integer;
Xbegin
X for i := StrLength(s) downto 1 do
X PutBack(s[i])
Xend;
/
echo 'x - progexit.pascal'
sed 's/^X//' > progexit.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ ProgExit -- Returns a return code and quits }
Xsegment ProgExit;
X%include swtools
Xprocedure ProgExit;
Xbegin
X RetCode(returnCode);
X HALT
Xend; {ProgExit}
/
echo 'x - push.pascal'
sed 's/^X//' > push.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Push -- push ep onto argStk, return new position ap }
Xsegment Push;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Push;
Xbegin
X if (ap > ARGSIZE) then
X Error('Macro: argument stack overflow');
X argStk[ap] := ep;
X Push := ap + 1
Xend {Push};
/
echo 'x - putback.pascal'
sed 's/^X//' > putback.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutBack -- push character back onto input }
Xsegment PutBack;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure PutBack;
Xbegin
X if (bp >= BUFSIZE) then
X Error('Too many characters pushed back');
X bp := bp + 1;
X buf[bp] := c
Xend;
/
echo 'x - putc.pascal'
sed 's/^X//' > putc.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutC -- print character to STDOUT }
Xsegment PutC;
X%include swtools
Xprocedure PutC;
Xbegin
X PutCF(c, STDOUT)
Xend;
/
echo 'x - putcf.pascal'
sed 's/^X//' > putcf.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutCF -- put string out on file }
Xsegment PutCF;
X%include swtools
X%include ioref
Xprocedure PutCF;
Xbegin
X if openList[fd].mode = IOAVAIL then
X Error('putcf on unopen file');
X if c = NEWLINE then
X writeln(openList[fd].fileVar)
X else
X write(openList[fd].fileVar, c)
Xend;
/
echo 'x - putdec.pascal'
sed 's/^X//' > putdec.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutDec -- put decimal integer n in field width >= w }
Xsegment PutDec;
X%include swtools
Xprocedure PutDec;
Xvar
X i, nd: Integer;
X s: StringType;
Xbegin
X nd := itoc(n, s, 1);
X for i := nd to w do
X PutC(BLANK);
X for i := 1 to nd-1 do
X PutC(s[i])
Xend;
/
echo 'x - puttok.pascal'
sed 's/^X//' > puttok.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ PutTok -- put token on output or evaluation stack }
Xsegment PutTok;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PutTok;
Xvar
X i: Integer;
Xbegin
X i := 1;
X while s[i] <> ENDSTR do begin
X PutChr(s[i]);
X i := i + 1
X end {while};
Xend {PutTok};
/
echo 'x - remove.pascal'
sed 's/^X//' > remove.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Remove -- remove a file - very tricky }
Xsegment Remove;
X%include swtools
X%include cms
Xprocedure Remove;
Xvar
X cmsString: String(MAXSTR);
X returnCode: Integer;
X i: 1..MAXSTR;
Xbegin
X cmsString := 'ERASE ';
X for i := 1 TO StrLength(name) do
X if name[i] in [NEWLINE, PERIOD] then
X cmsString := cmsString || Str(' ')
X else
X cmsString := cmsString || Str(name[i]);
X Cms(cmsString, returnCode);
Xend;
/
echo 'x - scopy.pascal'
sed 's/^X//' > scopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SCopy (CMS) -- copy strings }
Xsegment SCopy;
X%include swtools
Xprocedure SCopy;
Xbegin
X while(src[i] <> ENDSTR) do begin
X dest[j] := src[i];
X i := i + 1;
X j := j + 1;
X end;
X dest[j] := ENDSTR;
Xend;
/
echo 'x - skipbl.pascal'
sed 's/^X//' > skipbl.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SkipBl -- skip blanks and tabs s[i] ... }
Xsegment SkipBl;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xprocedure SkipBl;
Xbegin
X while (s[i] = BLANK) or (s[i] = TAB) do
X i := i + 1
Xend;
/
echo 'x - strlengt.pascal'
sed 's/^X//' > strlengt.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ StrLength -- determine length of swtools string }
Xsegment StrLength;
X%include swtools
Xfunction StrLength;
Xvar
X i: Integer;
Xbegin
X i := LBound(s);
X while (s[i] <> ENDSTR) and (i < MAXSTR) do
X i := i + 1;
X StrLength := i - LBound(s)
Xend;
/
echo 'x - swprin1.exec'
sed 's/^X//' > swprin1.exec << '/'
X&TRACE OFF
XEXEC TIMEFOR SWTOOLS LDATE C &1 &2 &3 PRINT &1 &2 &3
/
echo 'x - swtpc.exec'
sed 's/^X//' > swtpc.exec << '/'
X&CONTROL ERROR
XSTATE &1 PASCAL *
X&IF &RETCODE NE 0 &EXIT
XEXEC PASCALVS &1 (LIB(SWTOOLS) NOPRINT NOGOS NOCHECK NODEBUG &2 &3 &4 &5 &6
X&IF &RETCODE > 4 &EXIT &RETCODE
XTXTLIB DEL SWTOOLS &1
XTXTLIB ADD SWTOOLS &1
/
echo 'Part 06 of pack.out complete.'
exit