-- I/O module of silicon (pretty picture) program
-- last modified by McCreight, December 20, 1983 2:21 PM
-- modified by Petit, Sept 20, 1981
DIRECTORY
InlineDefs,
MiscDefs,
StreamDefs,
SystemDefs,
IODefs,
AltoDefs,
DirectoryDefs,
AltoFileDefs,
StringDefs,
ppoutdefs,
ppdefs,
ProcessDefs;
ppout: MONITOR
IMPORTS ppdefs, InlineDefs, MiscDefs, StreamDefs, DirectoryDefs, ProcessDefs
EXPORTS ppoutdefs =
BEGIN OPEN ppdefs, ppoutdefs, InlineDefs, StreamDefs, IODefs, DirectoryDefs;
fp: AltoFileDefs.FP;
cellNameA: PUBLIC LONG DESCRIPTOR FOR ARRAY OF LONG POINTER TO cell object;
oCnt, cCnt: PUBLIC CARDINAL;
outObject: PROCEDURE [ob: LONG POINTER TO object] =
BEGIN
i, j: CARDINAL;
qq:INTEGER;
IF ob=NIL THEN outWord[0] -- read as NIL
ELSE
SELECT ob.otyp FROM
cell =>
BEGIN
outWord[1]; -- code for cell
j ← 0;
FOR i IN [1..cCnt] DO
IF ob = cellNameA[i] THEN BEGIN j ← i; EXIT; END; ENDLOOP;
outWord[j]; -- unique # to identify cell
END;
xstr =>
BEGIN
d: LONG POINTER TO xstr object;
d ← LOOPHOLE[ob];
outWord[2]; -- code for xstr
outWord[d.width];
outWord[d.length];
j ← d.lExt + d.wExt*64;
IF d.pullup THEN j ← BITOR[j, 40000B];
IF d.impl>0 THEN j ← BITOR[j, 100000B];
IF d.angle THEN j ← BITOR[j, 20000B];
IF d.l=pdif THEN j ← BITOR[j, 10000B];
outWord[j]; -- packed word
IF d.l=pdif THEN outWord[d.surround];
IF d.angle THEN
BEGIN
qq←MAX[0,d.size[1]-d.wExt-d.length-2*d.lExt];
outWord[qq]; -- angle extension
END;
IF d.impl>0 THEN outWord[d.impl];
END;
cont =>
BEGIN
d: LONG POINTER TO cont object ← LOOPHOLE[ob];
ss:INTEGER←d.size[1];
outWord[3]; -- code for contact
j ← 0;
FOR i IN [1..contTypALen] DO
IF d.typ = contTypA[i] THEN BEGIN j ← i; EXIT; END; ENDLOOP;
j ← BITOR[j, BITSHIFT[ss, 8]];
outWord[j]; -- contact type code
outWord[d.l]; -- put out layer parameter
outWord[d.surround];-- put out surround
IF d.typ=burr THEN
BEGIN
outWord[d.size[0]];
outWord[BITOR[BITSHIFT[d.wExt,8],d.lExt]];
END;
END;
wire =>
BEGIN
d: LONG POINTER TO wire object ← LOOPHOLE[ob];
s0:INTEGER←d.size[0];
s1:INTEGER←d.size[1];
outWord[4]; -- code for wire
outPoint[[x: ob.size[0], y: ob.size[1]]];
outWord[d.l];
IF d.l=pdif THEN outWord[d.surround];
END;
rect =>
BEGIN
outWord[5]; -- code for rect
outPoint[[x: ob.size[0], y: ob.size[1]]];
outWord[ob.l];
END;
bus =>
BEGIN
d: LONG POINTER TO bus object;
d ← LOOPHOLE[ob];
outWord[7]; -- code for wire
outWord[d.wwidth];
outWord[d.firstLength];
outWord[d.l];
outWord[d.wCnt];
outWord[d.wspace];
outWord[d.topIncr];
outWord[d.lenIncr+d.topIncr];
END;
ENDCASE => outWord[0]; -- code for unknown, reads as NIL
END;
outPoint: PROC[p: Point] = {outWord[p.x]; outWord[p.y]};
outRect: PROC[r: Rect] = {outPoint[[r.x1, r.y1]]; outPoint[[r.x2, r.y2]]};
outInt: PROC[i: INT] =
BEGIN
ln: LongNumber = [li[i]];
outWord[ln.highbits];
outWord[ln.lowbits]
END;
outPushedLevels: PROC [cs: cellSEPtr, depth: NAT ← 1] =
BEGIN
IF cs=NIL THEN RETURN;
outPushedLevels[cs.nxt, depth+1];
outWord[depth];
outWord[cs.changes];
outPoint[cs.origSize];
outRect[cs.origBB];
outObject[cs.dest];
outList[cs.lp];
outPositionInList[cs.instance, cs.lp];
END;
outPositionInList: PROC [target, within: listPtr] =
BEGIN
i: INT ← 1;
FOR lp: listPtr ← within, lp.nxt WHILE lp#NIL DO
IF lp=target THEN {outInt[i]; RETURN};
i ← i+1;
ENDLOOP;
outInt[0]; -- not found
END;
outList: PROCEDURE [lp: LONG POINTER TO list] =
BEGIN
i: CARDINAL ← 0;
FOR tp: listPtr ← lp, tp.nxt WHILE tp # NIL DO i ← i + 1 ENDLOOP;
outWord[i]; -- count of items
FOR lp ← lp, lp.nxt WHILE lp # NIL DO
pop: propPtr;
propCount: INTEGER ← 0;
outWord[lp.lx];
outWord[lp.ly];
outWord[lp.idx];
outObject[lp.ob];
FOR pop ← lp.props, pop.next WHILE pop#NIL DO
propCount ← propCount+1;
ENDLOOP;
outWord[propCount];
FOR pop ← lp.props, pop.next WHILE pop#NIL DO
outWord[2];
outAtom[pop.attribute];
outAtom[pop.value];
ENDLOOP;
ENDLOOP;
END;
freeAtom: PUBLIC INTEGER ← 1;
auxAtom: PUBLIC ARRAY [0..atomTableSize] OF RECORD [
older, younger: INTEGER -- doubly-linked LRU list --];
outAtom: PROC [a: Atom] =
BEGIN
i: INTEGER;
BEGIN
FOR i ← auxAtom[0].older, auxAtom[i].older WHILE i#0 DO
IF a=atomTable[i] THEN
BEGIN
outWord[-i];
-- re-arrange LRU queue
auxAtom[auxAtom[i].older].younger ← auxAtom[i].younger;
auxAtom[auxAtom[i].younger].older ← auxAtom[i].older;
GOTO Touchi;
END;
ENDLOOP;
-- add a new atom
IF freeAtom<atomTableSize THEN {i ← freeAtom; freeAtom ← freeAtom+1}
ELSE
BEGIN
i ← auxAtom[0].younger; -- re-use oldest table entry
auxAtom[0].younger ← auxAtom[i].younger;
auxAtom[auxAtom[i].younger].older ← 0;
END;
atomTable[i] ← a;
outWord[i];
outString[LOOPHOLE[a]];
GOTO Touchi;
EXITS
Touchi =>
BEGIN
auxAtom[i].older ← auxAtom[0].older;
auxAtom[i].younger ← 0;
auxAtom[auxAtom[0].older].younger ← i;
auxAtom[0].older ← i;
END;
END;
END;
outCell: PROCEDURE [p: obPtr, cp: LONG POINTER TO cList] =
BEGIN
WITH dp: p SELECT FROM
cell =>
BEGIN
IF dp.marked THEN RETURN;
FOR lp: listPtr ← dp.ptr, lp.nxt WHILE lp # NIL DO
outCell[lp.ob, cp];
ENDLOOP;
oCnt ← oCnt + 1;
cellNameA[oCnt] ← @dp;
p.marked ← TRUE;
outWord[oCnt];
outCellName[@dp, cp];
outWord[p.size[0]];
outWord[p.size[1]];
outWord[dp.cnt];
outList[dp.ptr];
END;
ENDCASE => NULL;
END;
outCellName: PROCEDURE [
p: LONG POINTER TO cell object, cp: LONG POINTER TO cList] =
BEGIN
s: STRING ← "";
WHILE cp # NIL DO
IF cp.ob = p THEN BEGIN s ← cp.name; EXIT; END; cp ← cp.nxt; ENDLOOP;
outString[s];
END;
outWord: PROC[UNSPECIFIED]; -- a variable
writeAll: PUBLIC ENTRY PROCEDURE [put: PROC[UNSPECIFIED]] =
BEGIN ENABLE UNWIND => NULL;
cdp, ctp: LONG POINTER TO cell object;
oCnt ← cCnt ← 0;
outWord ← put;
ctp ← cdp ← GetCellSuper[];
WHILE ctp # NIL DO
cCnt ← cCnt + 1; ctp.marked ← FALSE; ctp ← ctp.super; ENDLOOP;
freeAtom ← 1;
auxAtom[0] ← [older: 0, younger: 0];
outWord[codeWordForDataFile];
outWord[8]; -- version #
outWord[cCnt]; -- output count of cell objects
BEGIN ENABLE UNWIND => FreeSpace[BASE[cellNameA]];
cellNameA ← DESCRIPTOR[
GetSpace[(cCnt + 1)*SIZE[LONG POINTER TO cell object]], cCnt + 1];
WHILE cdp # NIL DO outCell[cdp, cellList]; cdp ← cdp.super; ENDLOOP;
IF oCnt # cCnt THEN ERROR;
outPushedLevels[cellStack];
outWord[0]; -- now level 0
outWord[anyChanges];
outList[masterList]; -- output master list
END;
FreeSpace[BASE[cellNameA]];
END;
outString: PROCEDURE [s: LONG STRING] =
BEGIN
bflg: BOOLEAN ← FALSE;
sav: UNSPECIFIED;
i: CARDINAL;
obyt: PROCEDURE [u: UNSPECIFIED] =
BEGIN
IF bflg THEN outWord[BITOR[u, sav]] ELSE sav ← BITSHIFT[u, 8];
bflg ← NOT bflg;
END;
obyt[s.length];
FOR i IN [0..s.length) DO obyt[s[i]]; ENDLOOP;
obyt[0];
END;
openOfile: PUBLIC PROCEDURE [fname: STRING, existOK: BOOLEAN]
RETURNS [DiskHandle] =
BEGIN
IF NOT existOK AND DirectoryLookup[@fp, fname, FALSE] THEN RETURN[NIL];
RETURN[NewWordStream[fname, Write + Append]];
END;
doBackupNow: BOOLEAN ← FALSE;
killBackup: BOOLEAN ← FALSE;
EnableBackup: PUBLIC PROC = {doBackupNow ← TRUE};
DisableBackup: PUBLIC PROC = {doBackupNow ← FALSE; killBackup ← TRUE};
backupPass: PUBLIC LONG CARDINAL ← 0;
BackupDemonProcess: PUBLIC PROC =
BEGIN OPEN ProcessDefs;
WritingInterrupted: ERROR = CODE;
bf, obf, tf: DiskHandle;
PutBackupWord: PROC[w: UNSPECIFIED] =
BEGIN
Yield[];
IF killBackup THEN ERROR WritingInterrupted;
IF GetPosition[bf]=0 THEN w ← 0; -- write a bad seal
bf.put[bf, w];
END;
ProcessDefs.SetPriority[0];
bf ← NewWordStream["Chipmonk-Backup1.chip",
Write + Append];
obf ← NewWordStream["Chipmonk-Backup2.chip",
Write + Append];
bf.reset[obf];
bf.put[obf, 0]; -- smash seal, backup is obsolete if not invalid
CleanupDiskStream[obf];
DO
bf.reset[bf];
bf.put[bf, 0]; -- smash seal, backup is obsolete if not invalid
CleanupDiskStream[bf];
ProcessDefs.Pause[ProcessDefs.SecondsToTicks[15]];
IF NOT doBackupNow THEN LOOP;
killBackup ← FALSE;
bf.reset[bf];
writeAll[PutBackupWord !
UNWIND => NULL;
WritingInterrupted => LOOP;
ANY =>
{MiscDefs.CallDebugger["Signal to Backup writer, OK to proceed"]; LOOP}];
CleanupDiskStream[bf];
bf.reset[bf];
bf.put[bf, codeWordForDataFile]; -- validate seal, backup is good
CleanupDiskStream[bf];
tf ← bf; bf ← obf; obf ←tf; -- swap files
backupPass ← backupPass+1;
ENDLOOP;
END;
END.