{==============================================================}
{			IXSTRG.PAS			       }
{Copyright (C) 1986 David E. Cortesi--see notice in IXMAIN.PAS.}
{							       }
{ This include-file contains declarations and code related to  }
{ the implementation of dynamically-allocated strings.	The    }
{ method chosen uses strictly standard Pascal facilities, and  }
{ was chosen because nonstandard stuff varies between CP/M and }
{ MSDOS versions of Turbo Pascal, and between Turbo and other  }
{ Pascal systems (yes, Virginia, there are some).  It's kinda  }
{ clunky, but it works good enuff for what this program needs. }
{							       }
{ We define an INDEPENDENT string as a character array of the  }
{ max size in which the string data are kept, left justified   }
{ and bounded by a null (like in C).			       }
{							       }
{ A string BLOCK is a 2K block holding a bunch of strings in   }
{ compact form, without padding to the max length for each.    }
{ Blocks are allocated as needed, whenever the current one is  }
{ full, up to a limit set by SBLKMAX.			       }
{							       }
{ Once stowed in a block, a string may be referred to using a  }
{ STREF, an index to its block's address plus its offset in    }
{ that block.						       }
{ History:						       }
{ initial code 6/2/86					       }
{==============================================================}

type
    strblock = record		{ string block has count of    }
	free : 0..sblksize;	{ ..bytes free in block and    }
	data : array[1..sblksize] of nchar { ..space for bytes }
    end;
var
    sblkptrs : array[1..sblkmax] of ^strblock;{ blocks of bytes}
    sblkcnt  : 0..sblkmax;	{ how many blocks are active   }

{------ initialize string storage -----------------------------}
procedure initstrg;
begin
    new (sblkptrs[1]);
    sblkcnt := 1;
    sblkptrs[1]^.free := sblksize;
end;

{------ make a copy of a string with alphas forced to upcase --}
{------ and punctuation deleted, so it can be compared in -----}
{------ "dictionary sequence." --------------------------------}

procedure stucase(var a,b:str);
var	aj, bj : strindex; n: nchar;
begin
    aj := 1;
    bj := 1;
    repeat
	n := a[aj]; aj := aj+1;
	if (chr(n) in allowset) then n := n-32;
	b[bj] := n; bj := bj+1;
    until (n=null)
end;

{------ stow independent string A in a string block and fill --}
{------ in its STREF, allocate new string block as needed -----}
procedure stput(var a:str; var b:stref);
var	bp : ^strblock;
	j : strlength;
	k : 0..sblksize;
	n : nchar;
begin
    bp := sblkptrs[sblkcnt];	{ ^latest string buffer        }
    k := sblksize - bp^.free;	{ index of next free byte -1   }
    if(k < sblksize) then b.bo := k+1;{ note start in stref }
    j := 0;			{ index start of string        }
    repeat { copy bytes from str to block until null copied }
	if (k >= sblksize) then begin
	    { ooops, off end of block, start over in a new one }
	    if (sblkcnt = sblkmax) then { uh-oh }
		disaster(1);
	    sblkcnt := sblkcnt + 1;
	    new(sblkptrs[sblkcnt]);
	    bp := sblkptrs[sblkcnt];
	    k := 0; b.bo := 1; j := 0
	end;
	j := j + 1;
	n := a[j];
	k := k + 1;
	bp^.data[k] := n;
    until (n = null);
    b.nb := sblkcnt; { complete the stref }
    bp^.free := sblksize - k;
end;

{------ retrieve stowed string into independent array --------}
procedure stget(var b:stref; var a:str);
var	bp : ^strblock;
	j : strindex;
	k : 1..sblksize;
	n : nchar;
begin
    bp := sblkptrs[b.nb];	{ point to the buffer page     }
    k := b.bo;			{ ..and offset into it	       }
    j := 1;
    repeat { copy bytes until the null }
	n := bp^.data[k];
	a[j] := n;
	if (n<>null) then begin k := k+1; j := j+1 end
    until (n=null);
end;

{------ EXACT compare of string A to stowed string B, so a ----}
{------ leading substring is found to be "less" ---------------}
function stbcmpx(var a:str; var b:stref) : relation;
var	bp : ^strblock;
	j  : strlength;
	k  : 0..sblksize;
	x,y : nchar;
begin
    bp := sblkptrs[b.nb]; k := b.bo - 1;
    j := 0;
    repeat
	j := j + 1;
	x := a[j];
	k := k + 1;
	y := bp^.data[k];
    until ((x<>y) or (x=null));

    if (x=y) then stbcmpx := equal
    else if x<y then stbcmpx := less
    else stbcmpx := more;
end;

{------ APPROXIMATE compare of string A to stowed B, so that --}
{------ a leading substring is returned as EQUAL --------------}
function stbcmpa(var a:str; var b:stref) : relation;
var	bp : ^strblock;
	j  : strlength;
	k  : 0..sblksize;
	x,y : nchar;
begin
    bp := sblkptrs[b.nb]; k := b.bo - 1;
    j := 0;
    repeat
	j := j+1;
	x := a[j];
	k := k+1;
	y := bp^.data[k];
    until ((x<>y) or (x=null));

    if ((x=y) or (x=null)) then stbcmpa := equal
    else if (x<y) then stbcmpa := less
    else stbcmpa := more;
end;

{------ EXACT compare of stowed strings A and B - same as  ----}
{------ stbcomp except both strings are strefs	---------------}
function sbbcmpx(var a, b:stref) : relation;
var	ba, bb : ^strblock;
	j,k : 0..sblksize;
	x,y : nchar;
begin
    ba := sblkptrs[a.nb]; j := a.bo-1;
    bb := sblkptrs[b.nb]; k := b.bo-1;

    repeat
	j := j+1;
	x := ba^.data[j];
	k := k+1;
	y := bb^.data[k];
    until ((x<>y) or (x=null));

    if (x=y) then sbbcmpx := equal
    else if x<y then sbbcmpx := less
    else sbbcmpx := more;
end;
y) or (x=null));

    if (x=y) then sbbcmpx := equal
  