-- file StringCompactor.mesa
-- last edited by Satterthwaite, November 2, 1982 11:51 am
DIRECTORY
CharIO: TYPE USING [NumberFormat, PutChar, PutNumber, PutString],
Environment: TYPE USING [charsPerWord],
FileStream: TYPE USING [FileByteIndex, Create, EndOf, GetIndex, SetIndex],
LongStorage: TYPE USING [Node, Free],
OSMiscOps: TYPE USING [FindFile],
Stream: TYPE USING [Handle, Delete, GetChar, PutChar, PutWord],
Strings: TYPE USING [String, AppendString],
TableCommand: TYPE USING [CreateBCDStream, FinishBcdStream];
StringCompactor: PROGRAM
IMPORTS
CharIO, FileStream, OSMiscOps, Storage: LongStorage,
Stream, Strings, TableCommand
EXPORTS TableCommand = {
charsPerWord: CARDINAL = Environment.charsPerWord;
StreamIndex: TYPE = FileStream.FileByteIndex;
SyntaxError: ERROR = CODE;
CompStrDesc: TYPE = RECORD [offset, length: CARDINAL];
nArrays: CARDINAL;
nStrings: CARDINAL;
nChars: CARDINAL;
nWords: CARDINAL;
in: Stream.Handle;
SLptr: TYPE = LONG POINTER TO SL;
SL: TYPE = RECORD [
link: SLptr,
startIndex: StreamIndex,
length: CARDINAL];
ALptr: TYPE = LONG POINTER TO AL;
AL: TYPE = RECORD [
link: ALptr,
name: NL,
ARRAYindex: StreamIndex,
needsIndexDef: BOOL,
headSL, tailSL: SLptr,
nstrings: CARDINAL];
NL: TYPE = RECORD [startIndex: StreamIndex, length: CARDINAL];
BackUp: PROC [s: Stream.Handle] = {
FileStream.SetIndex[s, FileStream.GetIndex[s] - 1]};
NextString: PROC [s: SLptr] RETURNS [found: BOOL ← TRUE] = {
nc: CARDINAL ← 0;
quoteFound, collectingChars: BOOL ← FALSE;
DO
c: CHAR;
IF FileStream.EndOf[in] THEN ERROR SyntaxError;
c ← in.GetChar[];
IF c = '; AND ~collectingChars THEN RETURN [FALSE];
IF c = '" THEN
IF quoteFound THEN
IF collectingChars THEN {quoteFound ← FALSE; nc ← nc+1} ELSE ERROR
ELSE
IF collectingChars THEN quoteFound ← TRUE
ELSE {s.startIndex ← FileStream.GetIndex[in]; collectingChars ← TRUE}
ELSE
IF quoteFound THEN {s.length ← nc; BackUp[in]; EXIT}
ELSE IF collectingChars THEN nc ← nc+1;
ENDLOOP;
nStrings ← nStrings+1;
nChars ← nChars + nc; nWords ← nWords + StringBody[nc].SIZE};
lastCR: StreamIndex;
AllDone: ERROR = CODE;
NextItem: PROC [a: ALptr] = {
nc: CARDINAL ← 0;
state: {
start, aRray, arRay, arrAy, arraY,
sTring, stRing, strIng, striNg, strinG, Of, oF, end} ← $start;
array: BOOL;
DO
c: CHAR;
IF FileStream.EndOf[in] THEN ERROR AllDone;
c ← in.GetChar[]; nc ← nc+1;
SELECT c FROM
'A =>
state ← SELECT state FROM
$start => $aRray,
$arrAy => $arraY,
$stRing => $strIng,
ENDCASE => $start;
'R =>
state ← SELECT state FROM
$aRray => $arRay,
$arRay => $arrAy,
$stRing => $strIng,
ENDCASE => $start;
'Y =>
IF state = $arraY THEN {
array ← TRUE; a.ARRAYindex ← FileStream.GetIndex[in]; state ← $end}
ELSE state ← $start;
'S =>
IF state = $start THEN {a.name.length ← nc-1; state ← $sTring} ELSE state ← $start;
'T => state ← IF state = $sTring THEN $stRing ELSE $start;
'I => state ← IF state = $strIng THEN $striNg ELSE $start;
'N => state ← IF state = $striNg THEN $strinG ELSE $start;
'G => IF state = $strinG THEN {array ← FALSE; state ← $end} ELSE state ← $start;
'\n => {
IF state = $end THEN EXIT;
lastCR ← FileStream.GetIndex[in]; nc ← 0; state ← $start};
IN ['\000..' ] => IF state = $end THEN EXIT ELSE state ← $start;
ENDCASE => state ← $start;
ENDLOOP;
a.name.startIndex ← lastCR; a.needsIndexDef ← array;
IF array THEN {
state ← $Of;
DO
c: CHAR;
IF FileStream.EndOf[in] THEN ERROR SyntaxError;
c ← in.GetChar[]; nc ← nc+1;
SELECT c FROM
IN ['\000..' ] =>
SELECT state FROM
$start => state ← $Of;
$Of => NULL;
$end => EXIT;
ENDCASE => state ← $start;
'O => state ← IF state = $Of THEN $oF ELSE $start;
'F => state ← IF state = $oF THEN $end ELSE $start;
ENDCASE => {a.needsIndexDef ← FALSE; state ← $start};
ENDLOOP;
a.name.length ← nc};
CollectStrings[a];
IF array THEN nArrays ← nArrays + 1};
headAL, tailAL: ALptr;
CollectStrings: PROC [a: ALptr] = {
s: SLptr;
oldnStrings: CARDINAL = nStrings;
a.headSL ← a.tailSL ← NIL;
WHILE NextString[s ← AllocateSL[]] DO AppendSL[a, s] ENDLOOP;
Storage.Free[s];
a.nstrings ← nStrings - oldnStrings};
CollectArrays: PROC = {
a: ALptr;
headAL ← tailAL ← NIL;
nArrays ← nStrings ← nChars ← nWords ← 0;
lastCR ← 0;
DO
NextItem[a ← AllocateAL[] ! AllDone => {Storage.Free[a]; EXIT}];
AppendAL[a];
ENDLOOP};
AllocateSL: PROC RETURNS [s: SLptr] = {
s ← Storage.Node[SL.SIZE]; s.link ← NIL; RETURN};
AppendSL: PROC [a: ALptr, s: SLptr] = {
IF a.tailSL = NIL THEN a.headSL ← s ELSE a.tailSL.link ← s;
a.tailSL ← s};
AllocateAL: PROC RETURNS [a: ALptr] = {
a ← Storage.Node[AL.SIZE]; a.link ← NIL; RETURN};
AppendAL: PROC [a: ALptr] = {
IF tailAL = NIL THEN headAL ← a ELSE tailAL.link ← a;
tailAL ← a};
OutStrings: PROC [out: Stream.Handle, compact: BOOL] = {
charPos: CARDINAL;
buffer: PACKED ARRAY [0..charsPerWord) OF CHAR;
byte: [0 .. charsPerWord] ← 0;
FlushBuffer: PROC = {UNTIL byte = 0 DO PutChar['\000] ENDLOOP};
PutChar: PROC [c: CHAR] = {
buffer[byte] ← c;
IF (byte ← byte+1) = charsPerWord THEN {
FOR i: [0..charsPerWord) IN [0..charsPerWord) DO
out.PutChar[buffer[i]] ENDLOOP;
byte ← 0}};
IF compact THEN {out.PutWord[nStrings*CompStrDesc.SIZE+1]; charPos ← 0}
ELSE {out.PutWord[nStrings]; charPos ← (nStrings+1)*charsPerWord};
FOR a: ALptr ← headAL, a.link UNTIL a = NIL DO
FOR s: SLptr ← a.headSL, s.link UNTIL s = NIL DO
IF compact THEN {
out.PutWord[charPos]; out.PutWord[s.length];
charPos ← charPos + s.length}
ELSE {
out.PutWord[charPos/charsPerWord];
charPos ← charPos + StringBody[s.length].SIZE*charsPerWord};
ENDLOOP;
ENDLOOP;
IF compact THEN {out.PutWord[nChars]; out.PutWord[nChars]};
FOR a: ALptr ← headAL, a.link UNTIL a = NIL DO
s: SLptr ← a.headSL;
UNTIL s = NIL
DO
nextS: SLptr = s.link;
IF ~compact THEN {out.PutWord[s.length]; out.PutWord[s.length]};
FileStream.SetIndex[in, s.startIndex];
FOR i: CARDINAL IN [0 .. s.length) DO
c: CHAR = in.GetChar[];
PutChar[IF c # '" THEN c ELSE in.GetChar[]];
ENDLOOP;
IF ~compact THEN FlushBuffer[];
Storage.Free[s]; s ← nextS;
ENDLOOP;
ENDLOOP;
FlushBuffer[]};
OutRecordDecl: PROC [
out: Stream.Handle, formatId: Strings.String, compact, altoCode: BOOL] = {
OPEN CharIO;
a: ALptr ← headAL;
FOR i: CARDINAL IN [0..formatId.length) DO
IF formatId[i] = '. THEN EXIT; PutChar[out, formatId[i]];
ENDLOOP;
PutString[out, ": DEFINITIONS = {
CSRptr: TYPE = "L];
IF ~altoCode THEN PutString[out, "LONG "L];
PutString[out, "BASE POINTER TO CompStrRecord;"L];
PutString[out, IF compact THEN "
CompStrDesc: TYPE = RECORD [offset, length: CARDINAL];
CompStrRecord: TYPE = RECORD [
stringOffset: CSRptr RELATIVE POINTER TO StringBody,\n"L
ELSE "
StringOffset: TYPE = CSRptr RELATIVE POINTER TO StringBody;
StringRecord: TYPE = RECORD [
nStrings: CARDINAL,\n"L];
a ← headAL;
DO
nextA: ALptr = a.link;
nonBlank: BOOL ← FALSE;
FileStream.SetIndex[in, a.name.startIndex];
PutString[out, " "L];
FOR i: CARDINAL IN [0..a.name.length) DO
c: CHAR;
IF a.needsIndexDef AND FileStream.GetIndex[in] = a.ARRAYindex THEN {
PutString[out, " [0.."L];
PutNumber[out, a.nstrings, NumberFormat[10,FALSE,FALSE,0]];
PutChar[out, ')]};
c ← in.GetChar[];
IF nonBlank OR c # ' THEN {PutChar[out, c]; nonBlank ← TRUE};
ENDLOOP;
PutString[out, IF compact THEN "CompStrDesc"L ELSE "StringOffset"L];
Storage.Free[a];
IF (a ← nextA) = NIL THEN EXIT;
PutChar[out, ',]; PutChar[out, '\n];
ENDLOOP;
PutString[out, "];\n\n }.\n"L]};
CompileStrings: PUBLIC PROC [
inputFile: Strings.String, -- the source file
interfaceId: Strings.String, -- exported interface or "SELF"
formatId: Strings.String, -- ASCII record declaration
moduleId: Strings.String, -- output file
compact, altoCode: BOOL]
RETURNS [CARDINAL, CARDINAL] = {
t: STRING = [40];
sStream, rStream: Stream.Handle;
t.length ← 0; Strings.AppendString[t, inputFile];
in ← FileStream.Create[OSMiscOps.FindFile[t, read]];
CollectArrays[];
sStream ← TableCommand.CreateBCDStream[
in: in, modId: moduleId,
interfaceId: interfaceId,
altoCode: altoCode];
OutStrings[sStream, compact];
TableCommand.FinishBcdStream[]; Stream.Delete[sStream];
t.length ← 0; Strings.AppendString[t, formatId];
rStream ← FileStream.Create[OSMiscOps.FindFile[t, write]];
OutRecordDecl[rStream, formatId, compact, altoCode]; Stream.Delete[rStream];
Stream.Delete[in];
RETURN [nStrings, nChars]};
}.