-- File DJExtMerge.mesa -- Written by Martin Newell, June 1981 -- Last updated: July 24, 1981 3:08 PM DIRECTORY crD: FROM "CoreDefs" USING [CloseFile, OpenFile, PageNumber, ReadPages, UFileHandle, UFileTruncate, WritePages], InlineDefs: FROM "InlineDefs" USING[BITAND, BITSHIFT], DJExtMergeDefs: FROM "DJExtMergeDefs", DJExtTypes: FROM "DJExtTypes" USING [NodeNumber], MiscDefs: FROM "MiscDefs" USING [CallDebugger, Zero], Mopcodes: FROM "Mopcodes" USING [zEXCH, zPOP], ovD: FROM "OverviewDefs" USING [ErrorCode, ok], --SegmentDefs: FROM "SegmentDefs" USING [NewFile, Read, OldFileOnly, DestroyFile], StringDefs: FROM "StringDefs" USING [AppendString], SystemDefs: FROM "SystemDefs" USING [AllocateResidentPages, FreePages]; DJExtMerge: PROGRAM IMPORTS crD, InlineDefs, MiscDefs, StringDefs, SystemDefs EXPORTS DJExtMergeDefs = BEGIN OPEN crD, InlineDefs, DJExtTypes, MiscDefs, Mopcodes, ovD, StringDefs, SystemDefs; InitMerge: PUBLIC PROCEDURE [] = -- Initialize merge to use file fileName BEGIN GenValue _ ZeroValue; SmallValue _ ZeroValue; OpenMergeFile["merge.tmp$"]; END; ConsolidateMerge: PUBLIC PROCEDURE = BEGIN END; FinishMerge: PUBLIC PROCEDURE = -- Close files and release structures BEGIN CloseMergeFile[]; END; GenNodeNumber: PUBLIC PROCEDURE RETURNS[n: NodeNumber] = --Generate new Merge value BEGIN RETURN[GenValue _ GenValue + 1]; END; ReserveNodeNumbers: PUBLIC PROCEDURE [n: NodeNumber] = BEGIN GenValue _ GenValue + n; END; Merge: PUBLIC PROCEDURE [n1,n2: NodeNumber] RETURNS[r: NodeNumber] = --Merge numbers n1 and n2 towards smaller of the two --Returns resulting value of Lookup[n1] (=Lookup[n2]) BEGIN r1,r2: NodeNumber; n1buff,n2buff,r1buff,r2buff: CARDINAL; IF n1 = 0 OR n2 = 0 THEN CallDebugger["Merge called with 0"]; IF n1 = n2 THEN RETURN[n1]; n1buff _ Lock[n1,0]; n2buff _ Lock[n2,0]; --find roots, r1,r2 of n1,n2 [r1,r1buff] _ IntLookup[n1,n1buff]; [] _ Lock[r1,r1buff]; [r2,r2buff] _ IntLookup[n2,n2buff]; [] _ Lock[r2,r2buff]; --merge roots --new root is min of r1 and r2 IF LessThan[r1,r2] THEN BEGIN r _ r1; [] _ SetValue[r2,r2buff,r]; END ELSE BEGIN r _ r2; [] _ SetValue[r1,r1buff,r]; END; --shorten paths from n1 and n2 to new root [] _ SetValue[n1,n1buff,r]; [] _ SetValue[n2,n2buff,r]; UnlockAll[]; END; Lookup: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[r: NodeNumber] = --Return smallest number to which n has been merged, transitively closed BEGIN nbuff: CARDINAL; IF n = 0 THEN CallDebugger["Lookup called with 0"]; nbuff _ Lock[n,0]; r _ IntLookup[n,nbuff].r; Unlock[nbuff]; END; LookSmall: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[r: NodeNumber] = --Return smallest number it can assign to n BEGIN nbuff: CARDINAL; IF n = 0 THEN CallDebugger["LookSmall called with 0"]; nbuff _ Lock[n,0]; r _ IntLookup2[n,nbuff].r; Unlock[nbuff]; END; GetSmall: PUBLIC PROCEDURE RETURNS[NodeNumber] = --Return smallest number assigned BEGIN RETURN[SmallValue]; END; IsSmall: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[BOOLEAN] = --Return true if it has been assigned a small number BEGIN r,t: NodeNumber; rbuff,nbuff: CARDINAL; flag: BOOLEAN _ FALSE; IF n = 0 THEN CallDebugger["IsSmall called with 0"]; nbuff _ Lock[n,0]; --find root, r, of n [t,nbuff,flag] _ GetValue[n,nbuff]; r _ n; rbuff _ nbuff; UNTIL flag OR t = r DO r _ t; [t,rbuff,flag] _ GetValue[r,rbuff]; --rbuff is only a hint on rhs ENDLOOP; Unlock[nbuff]; RETURN[flag]; END; PutProp: PUBLIC PROCEDURE[n: NodeNumber, prop:LONG UNSPECIFIED] = --attach prop to node number n BEGIN vptr: POINTER TO NodeNumber; npage,noffset: CARDINAL; realnbuff: CARDINAL; nbuff: CARDINAL _ Lock[n,0]; [npage,noffset] _ PageAddress[n]; realnbuff _ GetPage[npage,nbuff]; vptr _ BufferTable[realnbuff].buffer + noffset + SIZE[NodeNumber]; IF vptr^#prop THEN --avoid setting .dirty if possible BEGIN vptr^ _ prop; BufferTable[realnbuff].dirty _ TRUE; END; Unlock[nbuff]; END; GetProp: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[LONG UNSPECIFIED] = --get the prop that has been attached to n. BEGIN vptr: POINTER TO NodeNumber; npage,noffset: CARDINAL; realnbuff: CARDINAL; v: LONG POINTER TO UNSPECIFIED; nbuff: CARDINAL _ Lock[n,0]; [npage,noffset] _ PageAddress[n]; realnbuff _ GetPage[npage,nbuff]; vptr _ BufferTable[realnbuff].buffer + noffset + SIZE[NodeNumber]; IF (v _ vptr^) = ZeroValue THEN v _ NIL; Unlock[nbuff]; RETURN[v]; END; --Private procedures-- BufferTable: ARRAY [0..4) OF BufferDesc; BufferDesc: TYPE = RECORD [ page: INTEGER, dirty: BOOLEAN, lock: INTEGER, buffer: POINTER ]; next4: ARRAY [0..4) OF CARDINAL _ [1, 2, 3, 0]; FileName: STRING _ [40]; uFH: crD.UFileHandle _ NIL; bufferArea: POINTER; OpenMergeFile: PROCEDURE[fileName: STRING] = BEGIN i: CARDINAL; erc: ovD.ErrorCode; buffer: POINTER; FileName.length _ 0; AppendString[FileName,fileName]; [erc,uFH] _ crD.OpenFile[[["Extractor"],[""]],[fileName],update]; IF erc#ovD.ok THEN MergeError["Problem opening file"]; IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN MergeError["Problem opening old file"]; bufferArea _ AllocateResidentPages[4]; buffer _ bufferArea; FOR i IN [0..4) DO BufferTable[i] _ [ page: -1, dirty: FALSE, lock: 0, buffer: buffer]; buffer _ buffer + 256; ENDLOOP; END; CloseMergeFile: PROCEDURE = BEGIN FreePages[bufferArea]; IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN MergeError["Problem truncating file"]; IF crD.CloseFile[uFH]#ovD.ok THEN MergeError["Problem closing file"]; uFH _ NIL; -- DestroyFile[NewFile[FileName,Read,OldFileOnly]]; END; IntLookup: PROCEDURE[n: NodeNumber, nbuff: CARDINAL] RETURNS[r: NodeNumber, rbuff: CARDINAL] = --Return smallest number to which n has been merged, transitively closed BEGIN t: NodeNumber _ 0; flag: BOOLEAN _ FALSE; --find root, r, of n [t,nbuff] _ GetValue[n,nbuff]; r _ n; rbuff _ nbuff; UNTIL flag OR t = r DO r _ t; [t,rbuff,flag] _ GetValue[r,rbuff]; --rbuff is only a hint on rhs ENDLOOP; IF flag THEN CallDebugger["Lookup called after LookSmall"]; IF n # r THEN [] _ SetValue[n,nbuff,r]; END; IntLookup2: PROCEDURE[n: NodeNumber, nbuff: CARDINAL] RETURNS[r: NodeNumber, rbuff: CARDINAL] = --Return smallest number it can assign to n BEGIN t: NodeNumber; flag: BOOLEAN _ FALSE; --find root, r, of n [t,nbuff,flag] _ GetValue[n,nbuff]; r _ n; rbuff _ nbuff; UNTIL flag OR t = r DO r _ t; [t,rbuff,flag] _ GetValue[r,rbuff]; --rbuff is only a hint on rhs ENDLOOP; IF n # r THEN [] _ SetValue[n,nbuff,r]; -- otherwise you'ld destroy small value IF flag THEN { r _ LOOPHOLE[LOOPHOLE[t,LONG CARDINAL] - 2B10] } ELSE { SmallValue _ SmallValue + 1; [] _ SetValue[r,nbuff,LOOPHOLE[SmallValue+2B10]]; r _ SmallValue; }; END; SetValue: PROCEDURE[n: NodeNumber, nbuff: CARDINAL, v: NodeNumber] RETURNS[realnbuff: CARDINAL] = BEGIN vptr: POINTER TO NodeNumber; npage,noffset: CARDINAL; IF n=v THEN RETURN; --not uncommon [npage,noffset] _ PageAddress[n]; realnbuff _ GetPage[npage,nbuff]; vptr _ BufferTable[realnbuff].buffer + noffset; IF vptr^#v THEN --avoid setting .dirty if possible BEGIN vptr^ _ v; BufferTable[realnbuff].dirty _ TRUE; END; END; GetValue: PROCEDURE[n: NodeNumber, nbuff: CARDINAL] RETURNS[v: NodeNumber, realnbuff: CARDINAL, done:BOOLEAN] = BEGIN vptr: POINTER TO NodeNumber; npage,noffset: CARDINAL; [npage,noffset] _ PageAddress[n]; realnbuff _ GetPage[npage,nbuff]; vptr _ BufferTable[realnbuff].buffer + noffset; IF (v _ vptr^) = ZeroValue THEN v _ n; done _ (LOOPHOLE[v,LONG CARDINAL] >= 2B10); END; Lock: PROCEDURE[n: NodeNumber, nbuff: CARDINAL] RETURNS[realnbuff: CARDINAL] = BEGIN npage,noffset: CARDINAL; [npage,noffset] _ PageAddress[n]; realnbuff _ GetPage[npage,nbuff]; BufferTable[realnbuff].lock _ BufferTable[realnbuff].lock + 1; END; Unlock: PROCEDURE[buff: CARDINAL] = BEGIN BufferTable[buff].lock _ BufferTable[buff].lock - 1; END; UnlockAll: PROCEDURE = BEGIN i: CARDINAL; FOR i IN [0..4) DO BufferTable[i].lock _ 0; ENDLOOP; END; LessThan: PROCEDURE[n1,n2: NodeNumber] RETURNS[BOOLEAN] = BEGIN c1: LONG CARDINAL _ LOOPHOLE[n1]; c2: LONG CARDINAL _ LOOPHOLE[n2]; RETURN[c1