jp@lanl.ARPA (10/06/85)
*COPY NOTICE
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
*COPY SWTOOLS
{ SWTOOLS -- Software Tools Environment Definitions }
%print off
const
IOERROR = 0; { status values for open files }
STDIN = 1;
STDOUT = 2;
STDERR = 3;
{ other IO-related stuff }
IOAVAIL = 1;
IOREAD = 2;
IOWRITE = 3;
MAXOPEN = 10;
MAXARG = 30;
{ universal manifest constants }
ENDFILE = Chr(1);
ENDSTR = Chr(0);
MAXSTR = 200;
{ EBCDIC character set }
BACKSPACE = Chr(8);
BACKSLASH = CHR(224);
TAB = Chr(5);
NEWLINE = Chr(10);
BLANK = ' ';
EXCLAM = '!';
QUESTION = '?';
DQUOTE = '"';
SHARP = '#';
DOLLAR = '$';
PERCENT = '%';
AMPER = '&';
SQUOTE = '''';
ACUTE = SQUOTE;
LPAREN = '(';
RPAREN = ')';
STAR = '*';
PLUS = '+';
COMMA = ',';
MINUS = '-';
DASH = MINUS;
PERIOD = '.';
SLASH = '/';
COLON = ':';
SEMICOL = ';';
LESS = '<';
EQUALS = '=';
GREATER = '>';
ATSIGN = '@';
ESCAPE = ATSIGN;
LBRACK = Chr(173);
RBRACK = Chr(189);
CARET = '^';
UNDERLINE = '_';
GRAVE = '9C'XC;
LBRACE = Chr(139);
RBRACE = Chr(155);
BAR = '|';
TILDE = '~';
LETA = 'a';
LETB = 'b';
LETC = 'c';
LETD = 'd';
LETE = 'e';
LETF = 'f';
LETG = 'g';
LETH = 'h';
LETI = 'i';
LETJ = 'j';
LETK = 'k';
LETL = 'l';
LETM = 'm';
LETN = 'n';
LETO = 'o';
LETP = 'p';
LETQ = 'q';
LETR = 'r';
LETS = 's';
LETT = 't';
LETU = 'u';
LETV = 'v';
LETW = 'w';
LETX = 'x';
LETY = 'y';
LETZ = 'z';
BIGA = 'A';
BIGB = 'B';
BIGC = 'C';
BIGD = 'D';
BIGE = 'E';
BIGF = 'F';
BIGG = 'G';
BIGH = 'H';
BIGI = 'I';
BIGJ = 'J';
BIGK = 'K';
BIGL = 'L';
BIGM = 'M';
BIGN = 'N';
BIGO = 'O';
BIGP = 'P';
BIGQ = 'Q';
BIGR = 'R';
BIGS = 'S';
BIGT = 'T';
BIGU = 'U';
BIGV = 'V';
BIGW = 'W';
BIGX = 'X';
BIGY = 'Y';
BIGZ = 'Z';
DIG0 = '0';
DIG1 = '1';
DIG2 = '2';
DIG3 = '3';
DIG4 = '4';
DIG5 = '5';
DIG6 = '6';
DIG7 = '7';
DIG8 = '8';
DIG9 = '9';
{ Standard types }
type
FileDesc = IOERROR..MAXOPEN;
StringType = packed array [1..MAXSTR] of Char;
CharType = Char;
{ Externally supplied primitive interfaces }
procedure Error (s: String(MAXSTR));
external;
procedure FClose (fd: FileDesc);
external;
function FCreate (name: StringType; mode: Integer): FileDesc;
external;
function FOpen (name: StringType; mode: Integer): FileDesc;
external;
procedure FSeek (recno: Integer; fd: FileDesc);
external;
function GetArg (n: Integer; var str: StringType;
maxSize: Integer): Boolean;
external;
function GetC (var c: CharType): CharType;
external;
function GetCF (var c: CharType; fd: FileDesc): CharType;
external;
function GetLine (var str: StringType; fd: FileDesc;
maxSize: Integer): Boolean;
external;
procedure Message (s: String(MAXSTR));
external;
function Nargs: Integer;
external;
procedure PutC (c: CharType);
external;
procedure PutCF (c: CharType; fd: FileDesc);
external;
procedure PutStr (const str: StringType; fd: FileDesc);
external;
procedure MPutStr (const str: StringType; fd: FileDesc);
external;
procedure Remove (var name: StringType);
external;
procedure SysExit (status: Integer);
external;
procedure ToolInit;
external;
{ Externally supplied utilities }
function AddStr (c: CharType; var outSet: StringType;
var j: Integer; maxSet: Integer): Boolean;
external;
function CToI (var s: StringType; var i: Integer): Integer;
external;
procedure CvtSST (src: String(MAXSTR); var dest: StringType);
external;
procedure CvtSTS (src: StringType; var dest: String(MAXSTR));
external;
function Equal (var str1, str2: StringType): Boolean;
external;
function Esc (var s: StringType; var i: Integer): CharType;
external;
procedure FCopy (fin, fout: FileDesc);
external;
function GetFid (var line: StringType; idx: Integer;
var fileName: StringType): Boolean;
external;
function GetWord (var s: StringType; i: Integer;
var out: StringType): Integer;
external;
function IsAlphaNum (c: CharType): Boolean;
external;
function IsDigit (c: CharType): Boolean;
external;
function IsLetter (c: CharType): Boolean;
external;
function IsLower (c: CharType): Boolean;
external;
function IsUpper (c: CharType): Boolean;
external;
function IToC (n: Integer; var s: StringType; i: Integer): Integer;
external;
function MustOpen (var fName: StringType; fMode: Integer): FileDesc;
external;
procedure PutDec (n, w: Integer);
external;
procedure SCopy (var src: StringType; i: Integer;
var dest: StringType; j: Integer);
external;
function StrIndex (const s: StringType; c: CharType): Integer;
external;
function StrLength (const s: StringType): Integer;
external;
procedure ProgExit (const returnCode: Integer); external;
%print on
*COPY EDITCONS
{ EditCons -- const declarations for edit }
const
CURLINE = PERIOD;
LASTLINE = DOLLAR;
SCAN = SLASH;
BACKSCAN = BACKSLASH;
ACMD = LETA;
CCMD = LETC;
DCMD = LETD;
ECMD = LETE;
EQCMD = EQUALS;
FCMD = LETF;
GCMD = LETG;
ICMD = LETI;
MCMD = LETM;
KCMD = LETK;
OCMD = LETO;
PCMD = LETP;
LCMD = LETL;
QCMD = LETQ;
RCMD = LETR;
SCMD = LETS;
WCMD = LETW;
XCMD = LETX;
promptFlag = 0;
verboseFlag = 1;
noMetaFlag = 2;
{ insert more option flags here }
numFlag = 15;
*COPY EDITTYPE
{ EditType -- types for in-memory version of edit }
type
STCode = (ENDDATA, ERR, OK); { status returns }
*COPY EDITPROC
{ EditProc -- routine declarations for SW editor }
function GetList (var lin: StringType; var i: Integer;
var status: STCode): STCode; external;
function GetOne (var lin: StringType; var i, num: Integer;
var status: STCode): STCode; external;
function GetNum (var lin: StringType; var i, num: integer;
var status: STCode): STCode; external;
function OptPat (var lin: StringType; var i: Integer): STCode; external;
function PatScan (way: CharType; var n: Integer): STCode; external;
function NextLn (n: Integer): Integer; external;
function PrevLn (n: Integer): Integer; external;
function Default (def1, def2: Integer;
var status: STCode): STCode; external;
function DoPrint (n1, n2: Integer): STCode; external;
function DoLPrint (n1, n2: Integer): STCode; external;
function DoCmd (var lin: StringType; var i: Integer;
glob: Boolean; var status: STCode): STCode; external;
function Append (line: Integer; glob: Boolean): STCode; external;
procedure BlkMove (n1, n2, n3: Integer); external;
procedure Reverse (n1, n2: Integer); external;
procedure GetTxt (n: Integer; var s: StringType); external;
procedure SetBuf; external;
function PutTxt (var lin: StringType): STCode; external;
function CkP (var lin: StringType; i: Integer;
var pFlag: Boolean; var status: STCode):
STCode; external;
function LnDelete (n1, n2: Integer; var status: STCode):
STCode; external;
function Move (line3: Integer): STCode; external;
function Kopy (line3: Integer): STCode; external;
function GetRHS (var lin: StringType; var i: Integer;
var sub: StringType; var gFlag: Boolean):
STCode; external;
function SubSt (var sub: StringType; gFlag, glob: Boolean):
STCode; external;
procedure SkipBl (var s: StringType; var i: Integer);
external;
function GetFn(var lin: StringType; var i:Integer;
var fil: StringType): STCode; external;
function DoRead (n: integer; var fil: StringType): STCode; external;
function DoWrite (n1, n2: Integer; var fil: StringType): STCode;
external;
function CkGlob (var lin: StringType; var i: Integer;
var status: STCode): STCode; external;
function DoGlob (var lin: StringType; var i, curSave: Integer;
var status: STCode): STCode; external;
procedure ClrBuf; external;
function GetMark(n: Integer): Boolean; external;
procedure PutMark(n: Integer; m: Boolean); external;
function DoOption(var lin: STringType; var i: Integer):
STCode; external;
function OptIsOn(flag: promptFlag..numFlag): Boolean; external;
*COPY IODEF
type
IOBlock =
record
fileVar: Text;
mode: IOERROR..IOWRITE
end;
function FDAlloc: Integer; External;
*COPY IOREF
{ GlobRef -- standard global references (IO support mainly) }
%include iodef
ref openList: array [FileDesc] of IOBlock;
ref ERRORIO: Boolean;
ref ATTENTION: Boolean;
ref cmdLin: StringType;
ref cmdArgs: 0..MAXARG;
ref cmdIdx: array [1..MAXARG] of 1..MAXSTR;
*COPY EDITREF
{ EditRef -- external reference definitions for SW editor }
ref
line1: Integer; { first line number }
line2: Integer; { second line number }
nLines: Integer; { # of lines specified }
curLn: Integer; { current line }
lastLn: Integer; { last line in buffer }
pat: StringType; { pattern string }
lin: StringType; { input line }
saveFile: StringType; { current remembered file name }
*COPY MATCHDEF
{ MatchDef -- definitions of match and sub-fcns }
function PatSize (var pat: StringType; n: Integer): Integer;
external;
function OMatch (var lin: StringType; var i: Integer;
var pat: StringType; j: Integer): Boolean;
external;
function Locate (c: CharType; var pat: StringType;
offset: Integer): Boolean;
external;
function Match (var lin, pat: StringType): Boolean;
external;
function AMatch (var lin: StringType; offset: Integer;
var pat: StringType; j: Integer): Integer;
external;
*COPY PATDEF
{ PatDef -- pattern constant declarations for GetPat }
const
MAXPAT = MAXSTR;
CLOSIZE = 1; { size of closure entry }
BOL = PERCENT;
EOL = DOLLAR;
ANY = QUESTION;
CCL = LBRACK;
CCLEND = RBRACK;
NEGATE = CARET;
NCCL = SHARP;{ cannot be the same as NEGATE }
LITCHAR = LETC;
NCHAR = EXCLAM;
CLOSURE = STAR;
function GetCCL (var arg: StringType; var i: Integer;
var pat: StringType; var j: Integer)
:Boolean;
external;
procedure StClose(var pat: StringType; var j: Integer;
lastJ: Integer);
external;
function GetPat (var arg, pat: StringType): Boolean;
external;
function MakePat (var arg: StringType; start: Integer;
delim: CharType; var pat: StringType): Integer;
external;
procedure DoDash (delim: CharType; var src: StringType;
var i: Integer; var dest: StringType;
var j: Integer; maxSet: Integer);
external;
function MakeSet (var inSet: StringType; k: Integer;
var outSet: StringType; maxSet: Integer): Boolean;
external;
*COPY SUBDEF
{ subdef -- definitions of substitution routines }
const
DITTO = Chr(255);
procedure SubLine (var lin, pat, sub: StringType);
external;
procedure CatSub (var lin: StringType; s1,s2: Integer;
var sub: StringType; var new: StringType;
var k: Integer; maxNew: Integer);
external;
procedure PutSub(var lin: StringType; s1, s2: Integer;
var sub: StringType);
external;
function MakeSub (var arg: StringType; from: Integer;
delim: CharType; var sub: StringType): Integer;
external;
function GetSub (var arg, sub: StringType): Boolean;
external;
*COPY DEFVAR
{ DefVar -- var declarations for define }
def
hashTab: array [1..HASHSIZE] of NDPtr;
NDTable: CharBuf;
nextTab: CharPos; { first free position in NDTable }
buf: array [1..BUFSIZE] of CharType; { for push back }
bp: 0..BUFSIZE; { next available character; init = 0 }
defn: StringType;
token: StringType;
tokType: STType; { type returned by lookup }
defName: StringType; { value is 'define' }
null: StringType; { value is '' }
*COPY DEFDEF
{ DefDef -- definitions needed for define }
{ DefCons -- const declarations for define }
const
BUFSIZE = 500; { size of push back buffer }
MAXCHARS = 5000; { size of name-defn table }
MAXDEF = MAXSTR; { max chars in a defn }
MAXTOK = MAXSTR; { max chars in a token }
HASHSIZE = 53; { size of hash table }
{ DefType -- type declarations for define }
type
CharPos = 1..MAXCHARS;
CharBuf = array [1..MAXCHARS] of CharType;
STType = (DEFTYPE, MACTYPE); { symbol table types }
NDPtr = -> NDBlock; { pointer to name-defn block }
NDBlock =
record
name: CharPos;
defn: CharPos;
kind: STType;
nextPtr: NDPtr;
end;
*COPY DEFPROC
{ DefProc -- procedures needed for define }
procedure CSCopy (var cb: CharBuf; i: CharPos;
var s: StringType);
external;
procedure SCCopy (var s: StringType; var cb: CharBuf;
i: CharPos);
external;
procedure PutBack (c: CharType);
external;
function GetPBC (var c: CharType): CharType;
external;
procedure PBStr (var s: StringType);
external;
function GetTok (var token: StringType; tokSize: Integer): CharType;
external;
procedure GetDef (var token: StringType; tokSize: Integer;
var defn: StringType; defSize: Integer);
external;
procedure InitHash;
external;
function Hash (var name: StringType): Integer;
external;
function HashFind (var name: StringType): NDPtr;
external;
procedure Install (var name, defn: StringType; t: STType);
external;
function Lookup (var name, defn: StringType; var t: STType): Boolean;
external;
procedure InitDef;
external;
*COPY DEFREF
def
hashTab: array [1..HASHSIZE] of NDPtr;
NDTable: CharBuf;
nextTab: CharPos; { first free position in NDTable }
buf: array [1..BUFSIZE] of CharType; { for push back }
bp: 0..BUFSIZE; { next available character; init = 0 }
defn: StringType;
token: StringType;
tokType: STType; { type returned by lookup }
defName: StringType; { value is 'define' }
null: StringType; { value is '' }
*COPY METADEF
{ MetaDef -- definitions for Meta bracket implementation }
const
BOM = LBRACE; { start of meta bracket }
EOM = RBRACE; { end of meta bracket }
type
MetaIndexType = Integer;
MetaElementType =
record
first: Integer;
last: Integer;
end;
MetaTableType = array [0..9] of MetaElementType;
MetaStackType = array [0..9] of MetaIndexType;
def
metaIndex: MetaIndexType;
metaTable: MetaTableType;
nullMetaTable: MetaTableType;
metaStack: MetaStackType;
metaStackPointer: Integer;
*COPY CHARDEF
const
ChLetter = 0;
ChLower = 1;
ChUpper = 2;
ChDigit = 3;
ChSpecial = 4;
type
ChEntry = packed set of 0..7;
ChTable = array [0..255] of ChEntry;
def
CharTable: ChTable;
function CharClass(const tIndex: CharType): ChEntry; external;
*COPY MACPROC
{ MacProc -- procedures needed for define }
procedure CSCopy (var cb: CharBuf; i: CharPos;
var s: StringType);
external;
procedure SCCopy (var s: StringType; var cb: CharBuf;
i: CharPos);
external;
procedure PutBack (c: CharType);
external;
function GetPBC (var c: CharType): CharType;
external;
procedure PBStr (var s: StringType);
external;
function GetTok (var token: StringType; tokSize: Integer): CharType;
external;
procedure GetDef (var token: StringType; tokSize: Integer;
var defn: StringType; defSize: Integer);
external;
procedure InitHash;
external;
function Hash (var name: StringType): Integer;
external;
function HashFind (var name: StringType): NDPtr;
external;
procedure Install (var name, defn: StringType; t: STType);
external;
function Lookup (var name, defn: StringType; var t: STType): Boolean;
external;
procedure PutTok(var s: StringType);
external;
procedure PutChr(c: CharType);
external;
procedure InitMacro;
external;
function Push (ep: Integer; var argStk: PosBuf;
ap: Integer): Integer;
external;
procedure Eval(var argStk: PosBuf; td: StType;
i,j: Integer);
external;
procedure DoDef (var argStk: PosBuf; i,j: Integer);
external;
procedure DoIf(var argStk: PosBuf; i,j: Integer);
external;
procedure DoExpr(var argStk: PosBuf; i,j: Integer);
external;
function Expr(var s: StringType; var i: Integer): Integer;
external;
function Term(var s: StringType; var i: Integer): Integer;
external;
function Factor(var s: StringType; var i: Integer): Integer;
external;
function GnbChar(var s: StringType; var i: Integer): CharType;
external;
procedure DoLen(var argStk: PosBuf; i,j: Integer);
external;
procedure DoSub(var argStk: PosBuf; i,j: Integer);
external;
procedure DoChq(var argStk: PosBuf; i,j: Integer);
external;
procedure PBNum(n: Integer);
external;
*COPY MACDEFS
{ Macdefs -- all definitions for Macro }
const
BUFSIZE = 1000; { size of pushback buffer }
MAXCHARS = 5000; { size of name-defn table }
MAXPOS = 500;
CALLSIZE = MAXPOS;
ARGSIZE = MAXPOS;
EVALSIZE = MAXCHARS;
MAXDEF = MAXSTR; { max chars in a defn }
MAXTOK = MAXSTR; { max length of a token }
HASHSIZE = 53; { size of hash table }
ARGFLAG = DOLLAR; { macro invocation character }
{ MacType -- type declarations for Macro }
type
CharPos = 1..MAXCHARS;
CharBuf = packed array [1..MAXCHARS] of CharType;
PosBuf = packed array [1..MAXPOS] of CharPos;
Pos = 0..MAXPOS;
StType = (DEFTYPE, MACTYPE, IFTYPE, SUBTYPE,
EXPRTYPE, LENTYPE, CHQTYPE); { symbol table types }
NdPtr = ->NdBlock;
NdBlock =
record
name: CharPos;
defn: CharPos;
kind: StType;
nextPtr: NdPtr;
end {record};
{ Macvar -- def declarations for macro }
def
traceing: Boolean;
buf: packed array [1..BUFSIZE] of CharType; { for pushback }
bp: 0..BUFSIZE;
hashTab: array [1..HASHSIZE] of NdPtr;
ndTable: CharBuf;
nextTab: CharPos; { first free position in ndTable }
callStk: PosBuf;
cp: Pos; { current call stack position }
typeStk: array [1..CALLSIZE] of StType; { type }
pLev: array [1..CALLSIZE] of Integer; { paren level }
argStk: PosBuf; { argument stack for this call }
ap: Pos; { current argument position }
evalStk: CharBuf; { evaluation stack }
ep: CharPos; { first character unused in evalStk }
{ builtins }
defName: StringType; { 'define' }
exprName: StringType;{ 'expr' }
subName: StringType; { 'substr' }
ifName: StringType; { 'ifelse' }
lenName: StringType; { 'len' }
chqName: StringType; { 'changeq' }
null: StringType; { value is '' }
lQuote: CharType; { left quote character }
rQuote: CharType; { right quote character }
defn: StringType;
token: StringType;
tokType: StType;
t: CharType;
nlPar: Integer;