DIRECTORY Atom USING [GetPName, GetProp, PutProp], AtomsPrivate USING [EnumerateAtoms, UnsafeMakeAtom], BcdDefs USING [ EVIndex, EVNull, EXPIndex, FTSelf, Link, MTIndex, MTRecord, NullVersion, TYPRecord, VarLimit, VersionStamp], BcdOps USING [ BcdBase, EXPHandle, MTHandle, NameString, ProcessExports, ProcessModules], CedarLinkerOps, Loader USING [Error], LongString USING [AppendString, AppendDecimal], PilotLoadStateOps USING [ AcquireBcd, ConfigIndex, InputLoadState, GetMap, Map, ReleaseBcd, ReleaseLoadState, ReleaseMap], PrincOps USING [ ControlLink, GFTIndex, GlobalFrameHandle, NullLink], PrincOpsRuntime USING [GetFrame, GFT], Rope USING [Text], SafeStorage USING [NewZone], Table USING [Base]; CedarExporterImpl: PROGRAM IMPORTS Atom, AtomsPrivate, BcdOps, CedarLinkerOps, Loader, PilotLoadStateOps, PrincOpsRuntime, SafeStorage, String: LongString EXPORTS CedarLinkerOps SHARES Rope = BEGIN OPEN BcdDefs, BcdOps, CedarLinkerOps; Export: PUBLIC PROC[bcd: BcdBase, map: PilotLoadStateOps.Map] = BEGIN maxInterfaceNameLength: NAT = 40; name: STRING = [maxInterfaceNameLength]; toBeProcessed: LIST OF Pending; ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset]; ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset]; ExportInterface: PROC[exph: EXPHandle, expi: EXPIndex] RETURNS[stop: BOOLEAN _ FALSE] = BEGIN interface: IR; atom: ATOM; rgfi: PrincOps.GFTIndex; pending: LIST OF Pending; name.length _ 0; FOR i: NAT IN [0..ssb.size[exph.name]) DO m: STRING = "interface name too long"; IF name.length = maxInterfaceNameLength THEN ERROR Loader.Error[type: invalidBcd, message: LOOPHOLE[LONG[m]]]; name[name.length] _ ssb.string.text[exph.name+i]; name.length _ name.length+1; ENDLOOP; atom _ AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[LONG[name]]]; interface _ GetIR[atom, ftb[exph.file].version, exph.size].interface; FOR i: NAT IN [0..exph.size) DO IF NullLink[exph.links[i]] THEN LOOP; rgfi _ map[exph.links[i].gfi]; -- determine the real gfi SELECT exph.links[i].vtag FROM var => {frame: PrincOps.GlobalFrameHandle; [interface[i], frame] _ FindVariableLink[bcd, exph.links[i], rgfi]; IF frame # NIL THEN SaveFrame[interface, i, frame]}; proc0, proc1 => interface[i] _ [procedure[gfi: rgfi, ep: exph.links[i].ep, tag: TRUE]]; type => interface[i] _ CheckType[bcd, exph.links[i], LOOPHOLE[interface[i]], i, name]; ENDCASE => ERROR; ENDLOOP; pending _ GetPendingList[atom]; IF pending # NIL THEN { [toBeProcessed, pending] _ SaveResolvedEntries[toBeProcessed, pending, interface]; SetPendingList[atom, pending]}; END; [] _ BcdOps.ProcessExports[bcd, ExportInterface]; IF toBeProcessed # NIL THEN ProcessPendingEntries[toBeProcessed]; IF pendingModules # NIL THEN ExportModules[bcd, map]; END; ExportModules: PROC[bcd: BcdBase, map: PilotLoadStateOps.Map] = BEGIN -- check to see if this bcd has a module that someone is waiting for. link: UNSPECIFIED; list, lastPending: LIST OF PendingModule; ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset]; ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset]; Export: PROC[mth: MTHandle, mti: MTIndex] RETURNS[stop: BOOLEAN _ FALSE] = BEGIN found: BOOLEAN; FOR list _ pendingModules, list.rest WHILE list # NIL DO IF mth.file = BcdDefs.FTSelf THEN IF list.first.version # bcd.version THEN LOOP ELSE NULL ELSE IF list.first.version # ftb[mth.file].version THEN LOOP; found _ TRUE; IF list.first.name.length # ssb.size[mth.name] THEN LOOP; FOR i: NAT IN [0..list.first.name.length) DO IF list.first.name.text[i] # ssb.string.text[mth.name+i] THEN {found _ FALSE; EXIT}; ENDLOOP; IF ~found THEN LOOP; link _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[map[mth.gfi]]]; CedarLinkerOps.OpenLinkSpace[list.first.frame, list.first.mth, list.first.bcd]; CedarLinkerOps.WriteLink[list.first.index, link]; CedarLinkerOps.CloseLinkSpace[list.first.frame]; list.first.frame _ NIL; ENDLOOP; END; [] _ BcdOps.ProcessModules[bcd, Export]; FOR list _ pendingModules, list.rest WHILE list # NIL DO IF list.first.frame # NIL THEN {lastPending _ list; LOOP}; IF lastPending = NIL THEN pendingModules _ list.rest ELSE lastPending.rest _ list.rest; ENDLOOP; END; SaveResolvedEntries: PROC[process, pending: LIST OF Pending, interface: IR] RETURNS[newProcess, newPending: LIST OF Pending] = BEGIN -- move resolved pending items to the 'toBeProcessed' list. index: NAT; next, lastPending: LIST OF Pending; newProcess _ process; newPending _ pending; FOR pending _ pending, next WHILE pending # NIL DO next _ pending.rest; -- 'rest' may be changed index _ LOOPHOLE[pending.first.link]; IF NullLink[interface[index]] THEN {lastPending _ pending; LOOP}; pending.first.link _ interface[index]; -- redefines 'link' IF lastPending # NIL THEN lastPending.rest _ next ELSE newPending _ next; IF newProcess = NIL OR LOOPHOLE[pending.first.frame, CARDINAL] < LOOPHOLE[newProcess.first.frame, CARDINAL] THEN { pending.rest _ newProcess; newProcess _ pending; LOOP}; FOR process _ newProcess, process.rest DO IF process.rest = NIL OR LOOPHOLE[pending.first.frame, CARDINAL] < LOOPHOLE[process.rest.first.frame, CARDINAL] THEN { pending.rest _ process.rest; process.rest _ pending; EXIT}; ENDLOOP; ENDLOOP; END; ProcessPendingEntries: PROC[list: LIST OF Pending] = BEGIN OPEN CedarLinkerOps; frame: PrincOps.GlobalFrameHandle _ NIL; FOR list _ list, list.rest WHILE list # NIL DO IF list.first.frame # frame THEN OpenLinkSpace[list.first.frame, list.first.mth, list.first.bcd]; WriteLink[list.first.index, list.first.link]; IF list.rest = NIL OR list.rest.first.frame # frame THEN CloseLinkSpace[frame]; ENDLOOP; END; typeIndex: NAT _ 0; types: ExportedTypes _ NEW[ExportedTypesSequence[100]]; ExportedTypes: TYPE = REF ExportedTypesSequence; ExportedTypesSequence: TYPE = RECORD[s: SEQUENCE size: NAT OF BcdDefs.TYPRecord]; CheckType: PROC[bcd: BcdBase, new, old: BcdDefs.Link, i: NAT, name: STRING] RETURNS[PrincOps.ControlLink] = BEGIN -- compare the old type with the one we want to export. oldIndex: NAT = LOOPHOLE[old.typeID]; typb: Table.Base = LOOPHOLE[bcd + bcd.typOffset]; IF oldIndex = 0 THEN { -- first time exported. FOR i: NAT IN [1..typeIndex) DO IF types[i] # typb[new.typeID] THEN LOOP; old _ [type[typeID: LOOPHOLE[i], type: new.type, proc: new.proc]]; RETURN[LOOPHOLE[old]]; ENDLOOP; typeIndex _ typeIndex + 1; IF typeIndex >= types.size THEN { -- allocate a large one larger: ExportedTypes _ Zone.NEW[ExportedTypesSequence[types.size + 100]]; FOR i: NAT IN [0..types.size) DO larger[i] _ types[i]; ENDLOOP; types _ larger}; types[typeIndex] _ typb[new.typeID]; old _ [type[typeID: LOOPHOLE[typeIndex], type: new.type, proc: new.proc]]; RETURN[LOOPHOLE[old]]}; IF types[oldIndex] # typb[new.typeID] THEN { typeError: STRING = [100]; String.AppendString[typeError, "Exported Type Clash for interface "L]; String.AppendString[typeError, name]; String.AppendString[typeError, ", item # "L]; String.AppendDecimal[typeError, i]; ERROR Loader.Error[versionMismatch, LOOPHOLE[LONG[typeError]]]}; RETURN[LOOPHOLE[old]]; END; FindVariableLink: PUBLIC PROC[ bcd: BcdBase, mthLink: BcdDefs.Link, rgfi: PrincOps.GFTIndex] RETURNS [link: PrincOps.ControlLink, frame: PrincOps.GlobalFrameHandle] = BEGIN ep: CARDINAL; evi: EVIndex; evb: Table.Base; mth: MTHandle; [mth, ep] _ FindModule[bcd, mthLink.vgfi]; IF mth = NIL THEN RETURN[PrincOps.NullLink, NIL]; evb _ LOOPHOLE[bcd + bcd.evOffset, Table.Base]; frame _ PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]]; IF (ep _ ep + mthLink.var) = 0 THEN RETURN[LOOPHOLE[frame], NIL]; IF (evi _ mth.variables) = EVNull THEN RETURN[PrincOps.NullLink, NIL]; RETURN[LOOPHOLE[frame + evb[evi].offsets[ep]], frame]; END; -- end FindVariableLink FindModule: PROC[bcd: BcdBase, gfi: PrincOps.GFTIndex] RETURNS[mth: MTHandle, ep: CARDINAL] = BEGIN -- expansion of BcdOps.ProcessModules[bcd, FindModule] mti: MTIndex; mtb: Table.Base = LOOPHOLE[bcd + bcd.mtOffset]; i: CARDINAL; mti _ FIRST[MTIndex]; FOR i IN [0..bcd.nModules) DO mth _ @mtb[mti]; IF gfi IN [mth.gfi..mth.gfi+mth.ngfi) THEN RETURN[mth, VarLimit*(gfi - mth.gfi)]; mti _ mti + (WITH m: mtb[mti] SELECT FROM direct => SIZE[MTRecord[direct]] + m.length*SIZE[Link], indirect => SIZE[MTRecord[indirect]], multiple => SIZE[MTRecord[multiple]], ENDCASE => ERROR) ENDLOOP; RETURN[NIL, 0]; END; frameIndex: NAT _ 0; frames: ExportedVariables _ NEW[ExportedVariablesSequence[10]]; ExportedVariables: TYPE = REF ExportedVariablesSequence; ExportedVariablesSequence: TYPE = RECORD[s: SEQUENCE size: NAT OF VariableRecord]; VariableRecord: TYPE = RECORD[ interface: IR, index: CARDINAL, frame: PrincOps.GlobalFrameHandle]; SaveFrame: PROC[interface: IR, index: CARDINAL, frame: PrincOps.GlobalFrameHandle] = BEGIN IF frame = NIL THEN RETURN; IF frameIndex >= frames.size THEN { -- allocate a larger one larger: ExportedVariables _ Zone.NEW[ExportedVariablesSequence[frames.size + 10]]; FOR i: NAT IN [0..frames.size) DO larger[i] _ frames[i]; ENDLOOP; frames _ larger}; frames[frameIndex] _ [interface, index, frame]; frameIndex _ frameIndex + 1; END; GetFrame: PUBLIC PROC[interface: IR, index: CARDINAL] RETURNS[PrincOps.GlobalFrameHandle] = BEGIN FOR i: CARDINAL DECREASING IN [0..frameIndex) DO -- decreasing to catch last export IF frames[i].interface # interface THEN LOOP; IF frames[i].index # index THEN LOOP; RETURN[frames[i].frame]; ENDLOOP; RETURN[NIL]; END; Zone: ZONE _ SafeStorage.NewZone[]; GetIR: PUBLIC PROCEDURE[ atom: ATOM, version: BcdDefs.VersionStamp, length: CARDINAL] -- in case a new one must be created RETURNS[name: ATOM, interface: IR, versionStamp: BcdDefs.VersionStamp] = BEGIN old: REF BcdDefs.VersionStamp; IF atom = NIL THEN atom _ FindAtom[version]; IF atom = NIL THEN RETURN[NIL, NIL, NullVersion]; IF version # NullVersion THEN IF (old _ NARROW[Atom.GetProp[atom, $version]]) = NIL THEN {-- create a new one old _ Zone.NEW[VersionStamp _ version]; Atom.PutProp[atom, $version, old]} ELSE IF version # old^ THEN -- check version mismatch Loader.Error[versionMismatch, LOOPHOLE[Atom.GetPName[atom]]]; interface _ NARROW[Atom.GetProp[atom, $IR]]; IF length = 0 THEN RETURN[atom, interface, IF old = NIL THEN NullVersion ELSE old^]; IF interface = NIL THEN { interface _ Zone.NEW[IRRecord[length]]; Atom.PutProp[atom, $IR, interface]}; RETURN[atom, interface, IF old = NIL THEN NullVersion ELSE old^]; END; FindAtom: PROCEDURE[version: BcdDefs.VersionStamp] RETURNS[atom: ATOM] = BEGIN CheckVersion: SAFE PROC[atom: ATOM] RETURNS[stop: BOOLEAN] = TRUSTED { old: REF BcdDefs.VersionStamp; old _ NARROW[Atom.GetProp[atom, $version]]; IF old = NIL THEN RETURN[stop: FALSE]; RETURN[stop: old^ = version]}; IF version = BcdDefs.NullVersion THEN RETURN[NIL]; atom _ AtomsPrivate.EnumerateAtoms[CheckVersion]; END; Initialize: PROC = BEGIN OPEN PilotLoadStateOps; ENABLE UNWIND => {ReleaseLoadState[]}; map: Map; bcd: BcdBase; nbcds: ConfigIndex _ InputLoadState[]; FOR i: NAT IN [0..nbcds) DO bcd _ AcquireBcd[i]; map _ GetMap[i]; Export[bcd, map]; ReleaseMap[map]; ReleaseBcd[bcd]; ENDLOOP; ReleaseLoadState[]; END; Initialize[]; END . . . ÄCedarExporterImpl.mesa exports a newly loaded bcd to the current set of interface records. Last edited by: John Maxwell on: February 22, 1983 2:49 pm Last edited by: Paul Rovner on: January 18, 1983 9:59 am List USING [AList, DottedPairNode], ******************************************************************** Export: exports procedure descriptors, variables, and types to the appropriate interfaces. Checks to see if anybody is waiting for the new entry. Sorts pending entries by frame and assigns them all at once at the end. Modules are only exported if there is somebody waiting for one. ('map' is a mapping between the bcd-relative gfi's and the real world.) ******************************************************************** get the name of the interface get the interface record export to the interface export the item to the interface put the resolved pending items on the toBeProcessed list START Export HERE we have a match!!! Fill in the link. nullify the entry (will be removed later) START ExportModules HERE remove completed modules the link slot is redefined to be the new interface element. this is convoluted! remove resolved entry from pending list add the entry to the processed list, SORTED BY FRAME does it go before the first element the processed list? put it where it belongs process all of the resolved pending items ******************************************************************** CheckType: Concrete types are represented in the IR as an index into the sequence 'types'. We want to check that there is at most one concrete type for each opaque type. Someday we will use an RTTypes.Type to represent the type. Currently exported types are ignored by the importing module. ******************************************************************** look for an existing entry create a new entry raise an error if there is a type clash ******************************************************************** utility procedures ******************************************************************** an imported program a pointer to the variable in the frame ~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~ ******************************************************************** a cache of frames for exported varables ******************************************************************** ******************************************************************** manipulating interface records ******************************************************************** ʘJšœ™JšœC™CJšœ:™:Jšœ8™8J˜šÏk ˜ Jšœœ˜(Jšœ œ"˜4šœœ˜J˜Jšœ œœ ˜%Jšœœ˜1šœœŸ˜.Jšœ™šœœœ˜Jšœœœ˜)Jšœœ&˜BJšœœ˜Jšœ˜—Jšœ™J˜šœœŸ˜9Jšœœ*˜Jšœœœ˜ J˜Jšœ˜—J˜—J˜$Jšœœ.˜JJšœœ˜—Jšœ'™'šœ$œ˜,Jšœ œ ˜J˜FJ˜%J˜-J˜#Jšœœœ˜@—Jšœœ˜Jšœ˜J˜—J™JšœD™DJšœ™JšœD™DJ˜šžœœœ˜J˜=JšœB˜IJš˜Jšœœ˜ J˜ J˜J˜J˜*Jš œœœœœ˜1Jšœœ!˜/Jšœ1œ˜<š œœœœ œ˜CJšœ™—Jšœ œœœ˜Fšœœ)˜8Jšœ&™&—JšœŸ˜J˜—šž œœ'˜7Jšœœ˜&JšœŸ6˜