-- file StringCompactor.mesa
-- last edited by Satterthwaite, January 24, 1980 2:09 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [CharsPerWord],
CharIO: FROM "chario"
USING [CR, NUL, NumberFormat, PutChar, PutNumber, PutString],
PGScondefs: FROM "PGScondefs" USING [FixupBcdHeader],
StreamDefs: FROM "streamdefs"
USING [
StreamHandle, StreamIndex, Read, Write, Append,
GetIndex, ModifyIndex, NewByteStream, SetIndex],
StringDefs: FROM "stringdefs" USING [WordsForString],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
TableCommand: FROM "tablecommand" USING [CreateBCDStream];
StringCompactor: PROGRAM
IMPORTS
CharIO, PGScondefs, StreamDefs, StringDefs, SystemDefs, TableCommand
EXPORTS TableCommand =
BEGIN OPEN StreamDefs;
CharsPerWord: CARDINAL = AltoDefs.CharsPerWord;
CompStrDesc: TYPE = RECORD [offset, length: CARDINAL];
nArrays: CARDINAL;
nStrings: CARDINAL;
nChars: CARDINAL;
nWords: CARDINAL;
in: StreamHandle;
SLptr: TYPE = POINTER TO SL;
SL: TYPE = RECORD [
link: SLptr,
startIndex: StreamIndex,
length: CARDINAL];
ALptr: TYPE = POINTER TO AL;
AL: TYPE = RECORD [
link: ALptr,
name: NL,
ARRAYindex: StreamIndex,
needsIndexDef: BOOLEAN,
headSL, tailSL: SLptr,
nstrings: CARDINAL];
NL: TYPE = RECORD [startIndex: StreamIndex, length: CARDINAL];
BackUp: PROC [s: StreamHandle] =
{SetIndex[s, ModifyIndex[GetIndex[s], -1]]};
NextString: PROC [s: SLptr] RETURNS [BOOLEAN] =
BEGIN
c: CHARACTER;
nc: CARDINAL ← 0;
quoteFound, collectingChars: BOOLEAN ← FALSE;
DO
IF in.endof[in] THEN SIGNAL SyntaxError;
c ← in.get[in];
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 ← 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 + StringDefs.WordsForString[nc];
RETURN [TRUE]
END;
lastCR: StreamIndex;
AllDone: SIGNAL = CODE;
SyntaxError: SIGNAL = CODE;
NextItem: PROC [a: ALptr] =
BEGIN
c: CHARACTER;
nc: CARDINAL;
state: {start, aRray, arRay, arrAy, arraY,
sTring, stRing, strIng, striNg, strinG, Of, oF, end};
array: BOOLEAN;
state ← start; nc ← 0;
DO
IF in.endof[in] THEN SIGNAL AllDone;
c ← in.get[in]; 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 ← 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;
CharIO.CR =>
BEGIN
IF state = end THEN EXIT;
lastCR ← GetIndex[in]; nc ← 0; state ← start;
END;
IN [0C..' ] => IF state = end THEN EXIT ELSE state ← start;
ENDCASE => state ← start;
ENDLOOP;
a.name.startIndex ← lastCR;
a.needsIndexDef ← array;
IF array THEN
BEGIN
state ← Of;
DO
IF in.endof[in] THEN SIGNAL SyntaxError;
c ← in.get[in]; nc ← nc+1;
SELECT c FROM
IN [0C..' ] =>
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;
END;
CollectStrings[a];
IF array THEN nArrays ← nArrays + 1;
END;
headAL, tailAL: ALptr;
CollectStrings: PROC [a: ALptr] =
BEGIN
s: SLptr;
oldnStrings: CARDINAL = nStrings;
a.headSL ← a.tailSL ← NIL;
WHILE NextString[s ← AllocateSL[]] DO AppendSL[a, s] ENDLOOP;
SystemDefs.FreeHeapNode[s];
a.nstrings ← nStrings - oldnStrings;
END;
CollectArrays: PROC =
BEGIN
a: ALptr;
headAL ← tailAL ← NIL;
nArrays ← nStrings ← nChars ← nWords ← 0;
lastCR ← StreamIndex[0,0];
DO
NextItem[a ← AllocateAL[] !
AllDone => {SystemDefs.FreeHeapNode[a]; EXIT}];
AppendAL[a];
ENDLOOP;
END;
AllocateSL: PROC RETURNS [s: SLptr] =
{s ← SystemDefs.AllocateHeapNode[SIZE[SL]]; s.link ← NIL; RETURN};
AppendSL: PROC [a: ALptr, s: SLptr] =
BEGIN
IF a.tailSL = NIL THEN a.headSL ← s ELSE a.tailSL.link ← s;
a.tailSL ← s;
END;
AllocateAL: PROC RETURNS [a: ALptr] =
{a ← SystemDefs.AllocateHeapNode[SIZE[AL]]; a.link ← NIL; RETURN};
AppendAL: PROC [a: ALptr] =
BEGIN
IF tailAL = NIL THEN headAL ← a ELSE tailAL.link ← a;
tailAL ← a;
END;
OutStrings: PROC [out: StreamHandle, compact: BOOLEAN] =
BEGIN
a: ALptr;
s, nexts: SLptr;
charpos: CARDINAL;
i: CARDINAL;
c: CHARACTER;
buffer: PACKED ARRAY [0..CharsPerWord) OF CHARACTER;
byte: [0 .. CharsPerWord];
FlushBuffer: PROC = {UNTIL byte = 0 DO PutChar[CharIO.NUL] ENDLOOP};
PutChar: PROC [c: CHARACTER] =
BEGIN
buffer[byte] ← c;
IF (byte ← byte+1) = CharsPerWord THEN {out.put[out, buffer]; byte ← 0};
END;
IF compact
THEN {out.put[out, nStrings*SIZE[CompStrDesc]+1]; charpos ← 0}
ELSE {out.put[out, nStrings]; charpos ← (nStrings+1)*CharsPerWord};
FOR a ← headAL, a.link UNTIL a = NIL
DO
FOR s ← a.headSL, s.link UNTIL s = NIL
DO
IF compact
THEN
BEGIN
out.put[out, charpos]; out.put[out, s.length];
charpos ← charpos + s.length;
END
ELSE
BEGIN
out.put[out, charpos/CharsPerWord];
charpos ←
charpos + StringDefs.WordsForString[s.length]*CharsPerWord;
END;
ENDLOOP;
ENDLOOP;
IF compact THEN {out.put[out, nChars]; out.put[out, nChars]};
byte ← 0;
FOR a ← headAL, a.link UNTIL a = NIL
DO
s ← a.headSL;
FOR s ← a.headSL, nexts UNTIL s = NIL
DO
IF ~compact THEN {out.put[out, s.length]; out.put[out, s.length]};
SetIndex[in, s.startIndex];
FOR i IN [0 .. s.length)
DO
c ← in.get[in]; PutChar[IF c # '" THEN c ELSE in.get[in]];
ENDLOOP;
IF ~compact THEN FlushBuffer[];
nexts ← s.link;
SystemDefs.FreeHeapNode[s];
ENDLOOP;
ENDLOOP;
FlushBuffer[];
END;
OutRecordDecl: PROC [
out: StreamHandle, formatId: STRING, compact: BOOLEAN] =
BEGIN OPEN CharIO;
a, nexta: ALptr;
c: CHARACTER;
nonBlank: BOOLEAN;
i: CARDINAL;
FOR i IN [0..formatId.length)
DO
IF formatId[i] = '. THEN EXIT; PutChar[out, formatId[i]];
ENDLOOP;
PutString[out, ": DEFINITIONS =
BEGIN
CSRptr: TYPE = 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,
"L
ELSE "
StringOffset: TYPE = CSRptr RELATIVE POINTER TO StringBody;
StringRecord: TYPE = RECORD [
nStrings: CARDINAL,
"L];
a ← headAL;
DO
SetIndex[in, a.name.startIndex];
PutString[out, " "L]; nonBlank ← FALSE;
FOR i IN [0..a.name.length)
DO
IF a.needsIndexDef AND GetIndex[in] = a.ARRAYindex THEN
BEGIN
PutString[out, " [0.."L];
PutNumber[out, a.nstrings, NumberFormat[10,FALSE,FALSE,0]];
PutChar[out, ')];
END;
c ← in.get[in];
IF nonBlank OR c # ' THEN {PutChar[out, c]; nonBlank ← TRUE};
ENDLOOP;
PutString[out, IF compact THEN "CompStrDesc"L ELSE "StringOffset"L];
nexta ← a.link;
SystemDefs.FreeHeapNode[a];
IF (a ← nexta) = NIL THEN EXIT;
PutChar[out, ',]; PutChar[out, CharIO.CR];
ENDLOOP;
PutString[out, "];
END.
"L];
END;
CompileStrings: PUBLIC PROC [
inputFile: STRING, -- the source file
interfaceId: STRING, -- exported interface or "SELF"
formatId: STRING, -- ASCII record declaration
moduleId: STRING, -- output file
compact, altoCode: BOOLEAN]
RETURNS [CARDINAL, CARDINAL] =
BEGIN
sStream, rStream: StreamHandle;
in ← NewByteStream[inputFile, Read];
CollectArrays[];
sStream ← TableCommand.CreateBCDStream[
in: in, modId: moduleId,
count: 1 + nStrings*(IF compact THEN SIZE[CompStrDesc] ELSE 1) +
(IF compact THEN StringDefs.WordsForString[nChars] ELSE nWords),
interfaceId: interfaceId,
altoCode: altoCode];
OutStrings[sStream, compact];
PGScondefs.FixupBcdHeader[]; sStream.destroy[sStream];
rStream ← NewByteStream[formatId, Write+Append];
OutRecordDecl[rStream, formatId, compact]; rStream.destroy[rStream];
in.destroy[in];
RETURN [nStrings, nChars];
END;
END.