Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Posting-Version: version B 2.10.2 9/18/84; site lanl.ARPA
Path: utzoo!linus!philabs!cmcl2!lanl!jp
From: jp@lanl.ARPA
Newsgroups: net.sources
Subject: Software Tools in Pascal  7/8
Message-ID: <31471@lanl.ARPA>
Date: Sun, 6-Oct-85 01:03:35 EDT
Article-I.D.: lanl.31471
Posted: Sun Oct  6 01:03:35 1985
Date-Received: Wed, 9-Oct-85 04:05:41 EDT
Distribution: net
Organization: Los Alamos National Laboratory
Lines: 660



*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;