-- file PGSControl.Mesa
-- last modified by Satterthwaite, August 29, 1980 1:49 PM
DIRECTORY
AltoFileDefs: TYPE USING [CFA],
BcdDefs: TYPE USING [VersionStamp],
CharIO: TYPE USING [CR, TAB, PutChar, PutString],
DisplayDefs: TYPE USING [DisplayOn, DisplayOff],
ImageDefs: TYPE USING [ImageVersion, StopMesa],
Inline: TYPE USING [BITOR, DIVMOD],
KeyDefs: TYPE USING [Keys, KeyBits],
MiscDefs: TYPE USING [CommandLineCFA, DestroyFakeModule],
PGS1: TYPE USING [Parse],
PGScondefs: TYPE,
PGSParseData: TYPE,
SegmentDefs: TYPE USING [
Append, DefaultVersion, DestroyFile, FileHandle, FileNameError,
FileSegmentAddress, FileSegmentHandle, GetFileTimes, InsertFile,
LockFile, NewFile, OldFileOnly, Read, SwapIn, SwapOut, Unlock,
UnlockFile, Write],
StreamDefs: TYPE USING [
CleanupDiskStream, CreateByteStream, CreateWordStream, GetIndex,
JumpToFA, ModifyIndex, NewByteStream, NormalizeIndex, ReadBlock,
SetIndex, StreamError, StreamHandle, StreamIndex, WriteBlock],
StringDefs: TYPE USING [AppendChar, AppendString, EqualStrings, EquivalentStrings],
SystemDefs: TYPE USING [
AllocateHeapNode, AllocatePages, AllocateSegment, FreeHeapNode, FreePages,
FreeSegment],
TimeDefs: TYPE USING [AppendDayTime, CurrentDayTime, PackedTime, UnpackDT];
PGSControl: PROGRAM
IMPORTS
CharIO, DisplayDefs, ImageDefs, Inline, MiscDefs,
PGS1, PGScondefs, PGSParseData,
SegmentDefs, StreamDefs, StringDefs, SystemDefs, TimeDefs
EXPORTS PGScondefs, PGS1 =
BEGIN
eofile, totaltokens, numprod, nextalias: PUBLIC CARDINAL;
warningslogged: PUBLIC BOOLEAN;
flags: PUBLIC ARRAY PGScondefs.Options OF BOOLEAN;
symtab: PUBLIC PGScondefs.Symtab;
syminfo: PUBLIC PGScondefs.Syminfo;
aliases: PUBLIC PGScondefs.Aliases;
tokeninfo: PUBLIC PGScondefs.Tokeninfo;
prodinfo: PUBLIC PGScondefs.Prodinfo;
rhschar: PUBLIC PGScondefs.Rhschar;
slim, tentries, ntentries: PUBLIC CARDINAL;
bitstrsize: PUBLIC CARDINAL;
PGSfail: PUBLIC ERROR = CODE;
outStream: StreamDefs.StreamHandle;
outeol: PUBLIC PROC [n:CARDINAL] = {
OPEN CharIO; THROUGH [1..n] DO PutChar[outStream,CR] ENDLOOP};
outchar: PUBLIC PROC [c:CHARACTER, n:INTEGER]= {
OPEN CharIO; THROUGH [1..n] DO PutChar[outStream,c] ENDLOOP};
outstring: PUBLIC PROC [string:STRING] = {
CharIO.PutString[outStream,string]};
outtab: PUBLIC PROC = {CharIO.PutChar[outStream,CharIO.TAB]};
signchar: PUBLIC CHARACTER ← '-;
outnum: PUBLIC PROC [val:INTEGER, cols:CARDINAL] = {
i: CARDINAL;
power, digits: CARDINAL ← 1;
num: CARDINAL ← ABS[val];
sign: CARDINAL = IF val<0 THEN 1 ELSE 0;
WHILE (i←power*10)<=num DO power ← i; digits ← digits+1 ENDLOOP;
outchar[' , INTEGER[cols-digits-sign]];
IF sign#0 THEN CharIO.PutChar[outStream,signchar];
UNTIL power < 1
DO
[i,num] ← Inline.DIVMOD[num,power]; CharIO.PutChar[outStream,i+'0];
power ← power/10;
ENDLOOP};
startTime: TimeDefs.PackedTime;
outtime: PUBLIC PROC = {
OPEN TimeDefs;
time: STRING = [20];
AppendDayTime[time, UnpackDT[startTime]];
time.length ← time.length-3;
CharIO.PutString[outStream,time]};
-- storage allocation for PGSscan, PGSlalr, PGStab
AllocateSegment: PUBLIC PROC [nwords:CARDINAL] RETURNS [POINTER] = {
RETURN[SystemDefs.AllocateSegment[nwords]]};
FreeSegment: PUBLIC PROC [base:POINTER] = {SystemDefs.FreeSegment[base]};
AllocateHeapNode: PUBLIC PROC [nwords:CARDINAL] RETURNS [POINTER] = {
RETURN[SystemDefs.AllocateHeapNode[nwords]]};
FreeHeapNode: PUBLIC PROC [base:POINTER] = {SystemDefs.FreeHeapNode[base]};
LongDes:TYPE = PGScondefs.LongDes;
LongPointer:TYPE = PGScondefs.LongPointer;
makearray: PUBLIC PROC [length, width:CARDINAL] RETURNS [LongDes] = {
n: CARDINAL = length*width;
new: LongPointer ← AllocateSegment[n];
FOR i: CARDINAL IN [0..n) DO (new+i)↑ ← 0 ENDLOOP;
RETURN [DESCRIPTOR[new, length]]};
expand: PUBLIC PROC [des:LongDes, width, ext:CARDINAL] RETURNS [LongDes] = {
new, old: LongPointer;
i: CARDINAL;
new ← AllocateSegment[(LENGTH[des]+ext)*width];
old ← BASE[des];
FOR i IN [0..LENGTH[des]*width) DO (new+i)↑ ← (old+i)↑ ENDLOOP;
FOR i IN [LENGTH[des]*width..(LENGTH[des]+ext)*width) DO (new+i)↑ ← 0 ENDLOOP;
FreeSegment[old];
RETURN [DESCRIPTOR[new, LENGTH[des]+ext]]};
orcount: PUBLIC CARDINAL;
orbits: PUBLIC PROC [source,sink:LongPointer] = {
FOR i: CARDINAL IN [0..PGScondefs.bitstrsize)
DO (sink+i)↑ ← Inline.BITOR[(sink+i)↑,(source+i)↑] ENDLOOP;
orcount ← orcount+1};
-- streams and files
logstr, sourcestr, outstr, errstr: StreamDefs.StreamHandle;
tempFile: SegmentDefs.FileHandle;
sourceName: PUBLIC STRING ← [40];
sourceVersion: PUBLIC BcdDefs.VersionStamp;
objectVersion: PUBLIC BcdDefs.VersionStamp;
rootname: STRING ← [40];
extension: STRING ← [40];
binfname: STRING ← [40];
typename: STRING ← [40];
modfname: STRING ← [40];
intfname: STRING ← [40];
CreateTime: PROC [s: StreamDefs.StreamHandle] RETURNS [time: LONG INTEGER] = {
RETURN [WITH s: s SELECT FROM
Disk => SegmentDefs.GetFileTimes[s.file].create,
ENDCASE => 0]};
DefaultFileName: PROC [name, defaultExtension: STRING] = {
FOR i: CARDINAL IN [0..name.length) DO IF name[i] = '. THEN RETURN ENDLOOP;
StringDefs.AppendString[name, defaultExtension]};
getstream: PROC [dotstring: STRING] RETURNS [StreamDefs.StreamHandle] = {
OPEN StringDefs, SegmentDefs;
fileName: STRING ← [40];
fileName.length ← 0;
AppendString[fileName, rootname]; AppendString[fileName, dotstring];
RETURN [StreamDefs.NewByteStream[fileName, Write+Append]]};
seterrstream: PUBLIC PROC = {
IF errstr = NIL
THEN {
outStream ← errstr ← getstream[".pgslog"L];
outstring[herald]; outstring[" -- "L]; outstring[rootname]; outstring[".pgslog"L];
outeol[2]}
ELSE outStream ← errstr};
setoutstream: PUBLIC PROC [dotstring: STRING] = {
outStream ← outstr ← getstream[dotstring]};
resetoutstream: PUBLIC PROC = {outStream ← outstr};
cleanupstreams: PUBLIC PROC = { -- used for checkout
OPEN StreamDefs;
IF outstr # NIL THEN CleanupDiskStream[outstr];
IF errstr # NIL THEN CleanupDiskStream[errstr]};
closeoutstream: PUBLIC PROC = {
IF outstr # NIL THEN {outstr.destroy[outstr]; outstr ← NIL}};
openwordstream: PUBLIC PROC [scratch: BOOLEAN] = {
OPEN SegmentDefs;
outstr ← StreamDefs.CreateWordStream[
tempFile ← NewFile[binfname,Read+Write+Append,DefaultVersion],
Write+Append];
LockFile[tempFile];
IF ~scratch AND intfname.length # 0
THEN PGScondefs.WriteBcdHeader[
outstr,
binfname,
IF StringDefs.EqualStrings[intfname,"SELF"L] THEN NIL ELSE intfname,
alto]};
closewordstream: PUBLIC PROC = {
OPEN SegmentDefs;
closeoutstream[]; UnlockFile[tempFile]; DestroyFile[tempFile]};
outword: PUBLIC PROC [n: CARDINAL] = {outstr.put[outstr,n]};
inword: PUBLIC PROC RETURNS [CARDINAL] = {RETURN[outstr.get[outstr]]};
outblock: PUBLIC PROC [address: POINTER, words: CARDINAL] = {
[] ← StreamDefs.WriteBlock[outstr, address, words]};
tB: POINTER TO PACKED ARRAY OF CHARACTER;
preprocess:BOOLEAN;
nextbuffer: PUBLIC PROC RETURNS [
p: POINTER TO PACKED ARRAY OF CHARACTER, c: CARDINAL, last: BOOLEAN] = {
OPEN PGScondefs;
words: [0..TextWords];
bytes: [0..cpw);
i: CARDINAL;
words ← StreamDefs.ReadBlock[sourcestr, tB, TextWords];
bytes ← StreamDefs.GetIndex[sourcestr].byte MOD cpw;
IF bytes # 0 THEN words ← words-1;
i ← words*cpw + bytes;
IF preprocess
THEN {
[] ← StreamDefs.WriteBlock[errstr,tB,words];
FOR j: CARDINAL IN [words*cpw..i) DO errstr.put[errstr,tB[j]] ENDLOOP};
RETURN [tB, i, i<TextChars]};
locateindex: PUBLIC PROC [index: CARDINAL] RETURNS [base: CARDINAL] = {
OPEN PGScondefs;
page: CARDINAL;
page ← index/(pagesize*cpw);
base ← page*(pagesize*cpw);
StreamDefs.SetIndex[sourcestr, [page:sourceOrigin.page+page, byte:sourceOrigin.byte]]};
StreamIndex:TYPE = StreamDefs.StreamIndex;
PrintTextLine: PROC [origin: StreamIndex] RETURNS [start: StreamIndex] = {
OPEN PGScondefs;
lineIndex: StreamIndex;
char: CHARACTER;
n: [1..100];
start ← lineIndex ← origin;
FOR n IN [1..100] UNTIL lineIndex = [0, 0]
DO lineIndex ← StreamDefs.ModifyIndex[lineIndex, -1];
StreamDefs.SetIndex[sourcestr, lineIndex];
IF sourcestr.get[sourcestr] = CR THEN EXIT;
start ← lineIndex;
ENDLOOP;
StreamDefs.SetIndex[sourcestr, start];
FOR n IN [1..100]
DO char ← sourcestr.get[sourcestr ! StreamDefs.StreamError => EXIT];
SELECT char FROM
CR, ControlZ => EXIT;
ENDCASE => outchar[char,1];
ENDLOOP;
outeol[1]; RETURN};
sourceOrigin: StreamDefs.StreamIndex;
ErrorContext: PUBLIC PROC [message: STRING, tokenIndex: CARDINAL] = {
saveIndex: StreamIndex = StreamDefs.GetIndex[sourcestr];
origin: StreamIndex = StreamDefs.NormalizeIndex[
[page: sourceOrigin.page, byte: sourceOrigin.byte+tokenIndex]];
char: CHARACTER;
seterrstream[];
StreamDefs.SetIndex[sourcestr, PrintTextLine[origin]];
UNTIL StreamDefs.GetIndex[sourcestr] = origin
DO
char ← sourcestr.get[sourcestr ! StreamDefs.StreamError => EXIT];
outchar[IF char = CharIO.TAB THEN CharIO.TAB ELSE ' ,1];
ENDLOOP;
outstring["↑ ["L]; outnum[tokenIndex,1];
outchar['],1]; outeol[1]; outstring[message];
StreamDefs.SetIndex[sourcestr, saveIndex]};
CursorBits: TYPE = ARRAY [0..16) OF WORD;
Cursor: POINTER TO CursorBits = LOOPHOLE[431B];
savedCursor: CursorBits;
PGSCursor: CursorBits =
[177777b, 177777b, 0, 0,
160606b, 111111b, 111010b, 111004b, 161302b, 101101b, 101111b, 100606b,
0, 0, 177777b, 177777b];
advise: PROC = {
outstring["Errors or warnings logged"L]; outeol[1];
IF pause THEN {
BlankCursor: CursorBits = ALL[0];
QueryCursor: CursorBits =
[2000B, 74000B, 140000B, 12767B, 12525B, 53566B, 111113B, 163100B,
0B, 0B, 154000B, 53520B, 62520B, 53360B, 155440B, 140B];
savedCursor: CursorBits = Cursor↑;
KeyBits: TYPE = ARRAY [0..SIZE[KeyDefs.KeyBits]-1) OF WORD;
Keys: POINTER TO KeyBits = LOOPHOLE[KeyDefs.Keys+1];
savedKeys: KeyBits = Keys↑;
RTC: POINTER TO
MACHINE DEPENDENT RECORD [high: [0..4096), low: [0..16)] =
LOOPHOLE[430B];
savedTime: CARDINAL;
state: {off, on1, on2};
Cursor↑ ← BlankCursor; state ← off; savedTime ← RTC.high;
DO
IF RTC.high # savedTime
THEN {
SELECT state FROM
off => {Cursor↑ ← QueryCursor; state ← on1};
on1 => state ← on2;
on2 => {Cursor↑ ← BlankCursor; state ← off};
ENDCASE;
savedTime ← RTC.high};
IF Keys↑ # savedKeys THEN EXIT;
ENDLOOP;
Cursor↑ ← savedCursor}};
-- processing options
alto: BOOLEAN ← TRUE;
pause: BOOLEAN ← TRUE;
-- making an image
pgsVersion: PUBLIC BcdDefs.VersionStamp;
tableseghandle: SegmentDefs.FileSegmentHandle;
herald: STRING ← [50];
tableseghandle ← MiscDefs.DestroyFakeModule[LOOPHOLE[PGSParseData]].seg;
--ImageDefs.MakeImage["PGS.image"];
pgsVersion ← LOOPHOLE[ImageDefs.ImageVersion[]]; -- ** bootstrap **
StringDefs.AppendString[to:herald, from:"Mesa PGS "];
TimeDefs.AppendDayTime[herald, TimeDefs.UnpackDT[pgsVersion.time]];
herald.length ← herald.length - 3;
-- * * * * * * HERE IT BEGINS * * * * * *
BEGIN OPEN SegmentDefs;
outStream ← logstr ← StreamDefs.NewByteStream["pgs.log"L, Write+Append];
outstring[herald]; outeol[1];
END;
BEGIN OPEN SegmentDefs;
CR: CHARACTER = CharIO.CR;
c: CHARACTER;
ext, ok, scratchexists: BOOLEAN;
cfa: POINTER TO AltoFileDefs.CFA = MiscDefs.CommandLineCFA[];
commandStream: StreamDefs.StreamHandle ←
StreamDefs.CreateByteStream[SegmentDefs.InsertFile[@cfa.fp, Read], Read];
StreamDefs.JumpToFA[commandStream, @cfa.fa];
sourceName.length ← rootname.length ← extension.length ← 0; ext ← FALSE;
UNTIL commandStream.endof[commandStream]
DO
IF (c←commandStream.get[commandStream]) # ' AND c # CR THEN EXIT;
ENDLOOP;
UNTIL commandStream.endof[commandStream] OR c = ' OR c = CR
DO
IF c = '/ THEN GO TO Switches;
StringDefs.AppendChar[sourceName, c];
IF c = '. THEN ext ← TRUE;
StringDefs.AppendChar[IF ext THEN extension ELSE rootname, c];
c ← commandStream.get[commandStream];
REPEAT
Switches => {
sense: BOOLEAN ← TRUE;
UNTIL commandStream.endof[commandStream] OR
(c←commandStream.get[commandStream]) = ' OR c = CR
DO
SELECT c FROM
'-, '~ => sense ← ~sense;
'a, 'A => {alto ← sense; sense ← TRUE};
'p, 'P => {pause ← sense; sense ← TRUE};
ENDCASE;
ENDLOOP};
ENDLOOP;
IF sourceName.length = 0 THEN GO TO NoSource;
IF ~ext THEN StringDefs.AppendString[sourceName, ".Mesa"L];
outeol[1]; outstring["Process: "L];
outstring[sourceName]; outeol[1];
sourcestr ← StreamDefs.CreateByteStream[
NewFile[sourceName, Read, OldFileOnly
!FileNameError => {
outchar[' ,1]; outstring["File Name Error"L]; GO TO NoSource}],
Read];
DisplayDefs.DisplayOff[black];
savedCursor ← Cursor↑; Cursor↑ ← PGSCursor;
startTime ← TimeDefs.CurrentDayTime[];
tB ← SystemDefs.AllocatePages[PGScondefs.TextPages];
warningslogged ← scratchexists ← FALSE;
binfname.length ← typename.length ← modfname.length ← intfname.length ← 0;
IF ~ext OR StringDefs.EquivalentStrings[extension, ".Mesa"L] THEN {
StringDefs.AppendChar[sourceName,'$];
errstr ← StreamDefs.NewByteStream[sourceName, Write+Append];
sourceName.length ← sourceName.length-1; --strip $
tempFile ← NewFile["pgs.scratch"L,Read+Write+Append,DefaultVersion];
outstr ← StreamDefs.CreateByteStream[tempFile, Write+Append];
LockFile[tempFile];
preprocess ← scratchexists ← TRUE;
outStream ← outstr;
PGScondefs.Format[binfname,typename,modfname,intfname !PGSfail => GOTO quit];
-- copies input to sourceName$ (errstr), modified input to pgs.scratch (outstr),
-- sets up data for printgrammar and optionally the binary and module file names
outstr.destroy[outstr]; errstr.destroy[errstr]; sourcestr.destroy[sourcestr];
-- since no rename facility, copy pgs.scratch to sourceName
sourcestr ← StreamDefs.CreateByteStream[tempFile,Read];
errstr ← StreamDefs.NewByteStream[sourceName,Write+Append];
WHILE ~nextbuffer[].last DO NULL ENDLOOP;
sourceVersion ← [0, 0, CreateTime[errstr]];
errstr.destroy[errstr]; sourcestr.destroy[sourcestr];
-- output grammar to pgs.scratch
outstr ← StreamDefs.CreateByteStream[tempFile,Write+Append];
outStream ← outstr;
PGScondefs.PrintGrammar[];
outstr.destroy[outstr];
-- connect pgs.scratch to input stream and fix sourceNames
sourcestr ← StreamDefs.CreateByteStream[tempFile,Read];
IF modfname.length=0 THEN {
IF typename.length # 0 THEN StringDefs.AppendString[modfname,typename]
ELSE {
StringDefs.AppendString[modfname,rootname];
StringDefs.AppendString[modfname,"ParseTable"L]}};
-- derive missing type id (compatibility feature)
IF typename.length = 0 THEN
FOR i: CARDINAL IN [0..modfname.length) DO
IF modfname[i] = '. THEN EXIT;
StringDefs.AppendChar[typename, modfname[i]];
ENDLOOP;
DefaultFileName[modfname,".Mesa"L];
IF binfname.length=0 THEN {
StringDefs.AppendString[binfname,rootname];
StringDefs.AppendString[binfname,"ParseData"L]};
DefaultFileName[binfname, IF intfname.length=0 THEN ".binary"L ELSE ".bcd"L]}
ELSE {
sourceVersion ← [0, 0, CreateTime[sourcestr]];
StringDefs.AppendString[binfname,rootname];
StringDefs.AppendString[binfname,".binary"L];
-- derive type name
StringDefs.AppendString[typename,rootname];
StringDefs.AppendString[typename,"ParseTable"L];
StringDefs.AppendString[modfname,typename];
StringDefs.AppendString[modfname,".Mesa"L]};
preprocess ← FALSE;
outstr ← errstr ← NIL;
sourceOrigin ← StreamDefs.GetIndex[sourcestr];
-- load table and call first pass here
BEGIN
SwapIn[tableseghandle];
ok ← PGS1.Parse[LOOPHOLE[FileSegmentAddress[tableseghandle]]].nErrors = 0;
Unlock[tableseghandle]; SwapOut[tableseghandle];
END;
SystemDefs.FreePages[tB];
sourcestr.destroy[sourcestr]; closeoutstream[];
IF scratchexists THEN {UnlockFile[tempFile]; DestroyFile[tempFile]};
-- now if no errors generate the tables then package them on request
IF ok AND (flags[lists] OR flags[printlalr] OR flags[printlr]) THEN {
ok ← PGScondefs.lalrgen[ ! PGSfail => {ok ← FALSE; CONTINUE}];
IF ok AND flags[lists] THEN {
outstr.destroy[outstr]; -- flush output from lalrgen
outstr ← StreamDefs.CreateWordStream[tempFile,Read]; -- for reinput
IF ~PGScondefs.tabgen[] THEN closewordstream[]
ELSE {
IF intfname.length # 0 THEN PGScondefs.FixupBcdHeader[];
outstr.destroy[outstr]; -- flush tabgen output
outstr ← StreamDefs.NewByteStream[modfname, Write+Append];
outStream ← outstr;
PGScondefs.outmodule[typename,modfname];
outstr.destroy[outstr]}}};
IF errstr # NIL THEN errstr.destroy[errstr];
outStream ← logstr;
IF ~ok OR warningslogged THEN advise[];
Cursor↑ ← savedCursor; DisplayDefs.DisplayOn[];
EXITS
NoSource => NULL;
quit => {
outStream ← logstr;
outeol[1]; outstring["Directives incorrect or out of sequence"L]; outeol[1];
outstr.destroy[outstr]; UnlockFile[tempFile]; DestroyFile[tempFile]; advise[]};
END;
logstr.destroy[logstr]; ImageDefs.StopMesa[];
END.