DIRECTORY Rope: TYPE USING [ROPE], FS: TYPE USING [StreamOpen, Error], IO: TYPE USING [STREAM, GetChar, PutChar, Close], M2D: TYPE USING [ObjPtr, HeaderPtr, ModulePtr, ConstPtr, TypPtr, VarPtr, ProcPtr, FieldPtr, LinkagePtr, StrPtr, EnumPtr, RangePtr, PointerPtr, SetPtr, ProcTypPtr, ArrayPtr, RecordPtr, OpaquePtr, PDPtr, CDPtr, ParPtr, Object, Structure, BDesc, Parameter, undftyp, notyp, booltyp, chartyp, inttyp, cardtyp, dbltyp, realtyp, lrltyp, stringtyp, wordtyp, addrtyp, bitstyp, proctyp], M2S: TYPE USING [IdBuf, id, Diff, Mark], M2R: TYPE; M2RImpl : CEDAR PROGRAM IMPORTS FS, IO, M2D, M2S EXPORTS M2R = BEGIN ModNo: PUBLIC CARDINAL; -- current module number ModList: PUBLIC M2D.HeaderPtr; -- list of loaded modules RefFile: PUBLIC IO.STREAM; REFFILE: CARDINAL = 219; CTL: CARDINAL = 170000B; anchorBlk: CARDINAL = 0; ModTagBlk: CARDINAL = 1; ProcTagBlk: CARDINAL = 2; RefTagBlk: CARDINAL = 3; linkageBlk: CARDINAL = 4; STR: CARDINAL = 171000B; enumBlk: CARDINAL = 0; rangeBlk: CARDINAL = 1; pointerBlk: CARDINAL = 2; setBlk: CARDINAL = 3; procTypBlk: CARDINAL = 4; funcTypBlk: CARDINAL = 5; arrayBlk: CARDINAL = 6; dynarrBlk: CARDINAL = 7; recordBlk: CARDINAL = 8; opaqueBlk: CARDINAL = 9; CMP: CARDINAL = 172000B; parrefBlk: CARDINAL = 0; parBlk: CARDINAL = 1; fieldBlk: CARDINAL = 2; OBJ: CARDINAL = 173000B; varrefBlk: CARDINAL = 0; varBlk: CARDINAL = 1; constBlk: CARDINAL = 2; stringBlk: CARDINAL = 3; typeBlk: CARDINAL = 4; procBlk: CARDINAL = 5; funcBlk: CARDINAL = 6; moduleBlk: CARDINAL = 7; svcBlk: CARDINAL = 8; maxM: CARDINAL = 64; minS: CARDINAL = 32; -- first non-standard structure -- maxS: CARDINAL = 1024; f: IO.STREAM; CurStr: CARDINAL; err: BOOLEAN; FldList, LinkList: M2D.HeaderPtr; ParList, LastPar: M2D.ParPtr; InitRef: PUBLIC PROC = { ModNo _ 0; ModList _ NEW [M2D.Object.Header]; ModList^.last _ ModList; FldList _ NEW [M2D.Object.Header]; FldList^.last _ FldList; LinkList _ NEW [M2D.Object.Header]; LinkList^.last _ LinkList; ParList _ NEW [M2D.Parameter _ [typ: M2D.undftyp, varpar: FALSE, next: NIL]]; LastPar _ ParList }; Create: PUBLIC PROC [modname: CARDINAL, modkey: LONG CARDINAL] RETURNS [mod: M2D.ModulePtr] = { mod _ NEW [M2D.Object.Module _ [name: modname, typ: M2D.notyp, ext: Module [key: modkey, mod: ModNo]]]; ModNo _ ModNo + 1; ModList^.last^.next _ mod; ModList^.last _ mod }; InRef: PUBLIC PROC [filename: Rope.ROPE] RETURNS [mod: M2D.ModulePtr, adr, pno: CARDINAL] = { GlbMod: ARRAY [0..maxM] OF M2D.HeaderPtr; Struct: ARRAY [1..maxS] OF M2D.StrPtr; CurMod, id0, block, m, s, t: CARDINAL; opened: BOOLEAN _ TRUE; obj, new: M2D.ObjPtr; newpar: M2D.ParPtr; str: M2D.StrPtr; module: M2D.ModulePtr; header: M2D.HeaderPtr; var: M2D.VarPtr; const: M2D.ConstPtr; type: M2D.TypPtr; proc: M2D.ProcPtr; field: M2D.FieldPtr; enum: M2D.EnumPtr; range: M2D.RangePtr; pointer: M2D.PointerPtr; set: M2D.SetPtr; proctyp: M2D.ProcTypPtr; array: M2D.ArrayPtr; record: M2D.RecordPtr; nextno: PROC RETURNS [CARDINAL] = { ch: CHAR = f.GetChar; ch1: CHAR = f.GetChar; RETURN [ch.ORD*256 + ch1.ORD] }; nextid: PROC RETURNS [CARDINAL] = { ch: CHAR _ f.GetChar; l: CARDINAL _ 0; L: CARDINAL = ch.ORD; i0: CARDINAL = M2S.id; i: CARDINAL _ i0; DO M2S.IdBuf [i] _ ch; i _ i + 1; l _ l + 1; IF l = L THEN EXIT; ch _ f.GetChar ENDLOOP; M2S.id _ i; RETURN [i0] }; Descriptor: PROC [m: CARDINAL] RETURNS [hd: M2D.HeaderPtr, md: M2D.ModulePtr ] = { hd _ GlbMod[m]; md _ NARROW [hd^.base] }; f _ FS.StreamOpen [filename ! FS.Error => { opened _ FALSE; CONTINUE }]; IF opened THEN { IF nextno [] = REFFILE THEN -- FileType -- { Struct [1] _ M2D.undftyp; Struct [2] _ M2D.booltyp; Struct [3] _ M2D.chartyp; Struct [4] _ M2D.inttyp; Struct [5] _ M2D.cardtyp; Struct [6] _ M2D.dbltyp; Struct [7] _ M2D.realtyp; Struct [8] _ M2D.lrltyp; Struct [9] _ M2D.stringtyp; Struct [10] _ M2D.wordtyp; Struct [11] _ M2D.addrtyp; Struct [12] _ M2D.bitstyp; Struct [13] _ M2D.proctyp; CurMod _ 0; CurStr _ minS; err _ FALSE; id0 _ M2S.id; DO block _ nextno []; IF block >= OBJ THEN { block _ block - OBJ; IF block > svcBlk THEN { err _ TRUE; M2S.Mark [86]; EXIT }; SELECT block FROM varBlk => { new _ var _ NEW [M2D.Object.Var]; new^.typ _ Struct[nextno[]]; [hd: header, md: module] _ Descriptor [0]; var^.mod _ module^.mod; var^.lev _ nextno[]; var^.cell _ nextno[]; new^.name _ nextid[] }; constBlk => { new _ const _ NEW [M2D.Object.Const]; new^.typ _ Struct[nextno[]]; [hd: header, md: module] _ Descriptor [nextno[]]; const^.conval. D0 _ nextno[]; const^.conval.D1 _ nextno[]; new^.name _ nextid[] }; stringBlk => { new _ const _ NEW [M2D.Object.Const]; new^.typ _ Struct[nextno[]]; [hd: header, md: module] _ Descriptor [0]; const^.conval.D0 _ 0; const^.conval. D2 _ nextid[]; const^.conval.D1 _ M2S.id - const^.conval.D2; const^.conval.D3 _ 0; new^.name _ nextid[] }; typeBlk => { new _ type _ NEW [M2D.Object.Typ]; s _ nextno[]; new^.typ _ Struct[s]; new^.typ^.strobj _ type; [hd: header, md: module] _ Descriptor [nextno[]]; type^.mod _ NARROW [header^.base]; new^.name _ nextid[] }; procBlk => { pd: M2D.PDPtr = NEW [M2D.BDesc.Block]; new _ proc _ NEW [M2D.Object.Proc]; new^.typ _ M2D.notyp; [hd: header, md: module] _ Descriptor [0]; proc^.bd _ pd; pd^.num _ nextno[]; pd^.lev _ nextno[]; pd^.adr _ nextno[]; pd^.mod _ module^.mod; proc^.firstParam _ ParList^.next; pd^.firstLocal _ NIL; new^.name _ nextid[]; ParList^.next _ NIL; LastPar _ ParList }; funcBlk => { pd: M2D.PDPtr = NEW [M2D.BDesc.Block]; new _ proc _ NEW [M2D.Object.Proc]; new^.typ _ Struct[nextno[]]; [hd: header, md: module] _ Descriptor [0]; proc^.bd _ pd; pd^.num _ nextno[]; pd^.lev _ nextno[]; pd^.adr _ nextno[]; new^.name _ nextid[]; pd^.mod _ module^.mod; proc^.firstParam _ ParList^.next; pd^.firstLocal _ NIL; ParList^.next _ NIL; LastPar _ ParList }; svcBlk => { cd: M2D.CDPtr _ NEW [M2D.BDesc.Code]; new _ proc _ NEW [M2D.Object.Proc]; new^.typ _ NIL; [hd: header, md: module] _ Descriptor [0]; proc^.bd _ cd; proc^.firstParam _ ParList^.next; cd^.num _ nextno[]; cd^.length _ 0; new^.name _ nextid[]; ParList^.next _ NIL; LastPar _ ParList } ENDCASE; obj _ module^.firstObj; -- find object -- WHILE (obj # NIL) AND (M2S.Diff [new^.name, obj^.name]) # 0 DO obj _ obj^.next ENDLOOP; IF obj = NIL THEN { -- new object -- header^.last^.next _ new; header^.last _ new; id0 _ M2S.id } ELSE { IF obj^.class = Typ THEN Struct[s] _ obj^.typ; M2S.id _ id0 }} ELSE IF block >= CMP THEN { block _ block - CMP; IF block > fieldBlk THEN { err _ TRUE; M2S.Mark [86]; EXIT }; IF block = fieldBlk THEN { new _ field _ NEW [M2D.Object.Field]; new^.typ _ Struct[nextno[]]; field^.offset _ nextno[]; new^.name _ nextid[]; FldList^.last^.next _ new; FldList^.last _ new } ELSE -- parameter -- { newpar _ NEW [M2D.Parameter]; newpar^.typ _ Struct[nextno[]]; newpar^.varpar _ block = parrefBlk; newpar^.next _ NIL; LastPar^.next _ newpar; LastPar _ newpar }} ELSE IF block >= STR THEN { block _ block - STR; IF block > opaqueBlk THEN { err _ TRUE; M2S.Mark [86]; EXIT }; str _ NEW [M2D.Structure]; SELECT block FROM enumBlk => { str _ enum _ NEW [M2D.Structure.Enum]; enum^.size _ nextno[]; enum^.NofConst _ nextno[] }; rangeBlk => { str _ range _ NEW [M2D.Structure.Range]; range^.size _ nextno[]; range^.BaseTyp _ Struct[nextno[]]; range^.min _ LOOPHOLE [nextno[], INTEGER]; range^.max _ LOOPHOLE [nextno[], INTEGER]; range^.BndAdr _ 0 }; pointerBlk => { str _ pointer _ NEW [M2D.Structure.Pointer]; pointer^.size _ nextno[]; pointer^.BaseTyp _ M2D.undftyp; pointer^.BaseId _ 0 }; setBlk => { str _ set _ NEW [M2D.Structure.Set]; set^.size _ nextno[]; set^.BaseTyp _ Struct[nextno[]] }; procTypBlk => { str _ proctyp _ NEW [M2D.Structure.ProcTyp]; proctyp^.size _ nextno[]; proctyp^.firstPar _ ParList^.next; ParList^.next _ NIL; LastPar _ ParList; proctyp^.resTyp _ M2D.notyp }; funcTypBlk => { str _ proctyp _ NEW [M2D.Structure.ProcTyp]; proctyp^.size _ nextno[]; proctyp^.firstPar _ ParList^.next; ParList^.next _ NIL; LastPar _ ParList; proctyp.resTyp _ Struct[nextno[]] }; arrayBlk => { str _ array _ NEW [M2D.Structure.Array]; array^.size _ nextno[]; array^.ElemTyp _ Struct[nextno[]]; array^.dyn _ FALSE; array^.IndexTyp _ Struct[nextno[]] }; dynarrBlk => { str _ array _ NEW [M2D.Structure.Array]; array^.size _ nextno[]; array^.ElemTyp _ Struct[nextno[]]; array^.dyn _ TRUE; array^.IndexTyp _ NIL }; recordBlk => { str _ record _ NEW [M2D.Structure.Record]; record^.size _ nextno[]; record^.firstFld _ FldList^.next; FldList^.next _ NIL; FldList^.last _ FldList }; opaqueBlk => { str _ NEW [M2D.Structure.Opaque]; str^.size _ nextno[]} ENDCASE; IF CurStr > maxS THEN { err _ TRUE; M2S.Mark [98]; EXIT }; Struct [CurStr] _ str; CurStr _ CurStr + 1 } ELSE IF block >= CTL THEN { block _ block - CTL; IF block = linkageBlk THEN { pointer: M2D.PointerPtr _ NIL; s _ nextno[]; t _ nextno[]; pointer _ NARROW [Struct[t]]; IF pointer^.BaseTyp # M2D.undftyp THEN M2S.id _ id0 ELSE { pointer^.BaseTyp _ Struct[s]; id0 _ M2S.id }} ELSE IF block = ModTagBlk THEN -- main module -- m _ nextno[] ELSE IF block = anchorBlk THEN { hdr: M2D.HeaderPtr = NEW [M2D.Object.Header]; module: M2D.ModulePtr = NEW [M2D.Object.Module]; hdr^.last _ hdr; new _ module; module^.key _ nextno[]*65536 + nextno[]; new^.name _ nextid[]; obj _ ModList^.next; -- find mod -- WHILE (obj # NIL) AND (M2S.Diff [new^.name, obj^.name] # 0) DO obj _ obj^.next ENDLOOP; IF obj = NIL THEN { module^.mod _ ModNo; ModNo _ ModNo + 1; hdr^.base _ new; id0 _ M2S.id; ModList^.last^.next _ new; ModList^.last _ new } ELSE { foundmod: M2D.ModulePtr = NARROW [obj]; hdr^.base _ obj; M2S.id _ id0; IF (module^.key # foundmod^.key) THEN M2S.Mark [85] ELSE IF (CurMod = 0) AND (obj^.typ # NIL -- flag set --) THEN { GlbMod[0] _ hdr; CurMod _ 1; EXIT }}; IF CurMod > maxM THEN { M2S.Mark [96]; EXIT }; GlbMod[CurMod] _ hdr; CurMod _ CurMod + 1 } ELSE IF block = RefTagBlk THEN { adr _ nextno[]; pno _ nextno[]; EXIT } ELSE { err _ TRUE; M2S.Mark [86]; EXIT }} ELSE { err _ TRUE; M2S.Mark [86]; EXIT } ENDLOOP; IF NOT err AND (CurMod # 0) THEN { header: M2D.HeaderPtr _ NIL; m _ 0; DO -- chain objects to module -- header: M2D.HeaderPtr _ NIL; module: M2D.ModulePtr _ NIL; [hd: header, md: module] _ Descriptor[m]; header^.last^.next _ module^.firstObj; module^.firstObj _ GlbMod[m]^.next; m _ m + 1; IF m = CurMod THEN EXIT ENDLOOP; [hd: header] _ Descriptor [0]; mod _ NARROW [header^.base]; mod^.typ _ M2D.notyp; -- set flag -- } ELSE mod _ NIL } ELSE { M2S.Mark [86]; mod _ NIL }; f.Close [] } ELSE { M2S.Mark [86]; mod _ NIL }}; WriteNo: PROC [n: CARDINAL] = { RefFile.PutChar ['\000 + n/256]; RefFile.PutChar ['\000 + n MOD 256] }; WriteId: PROC [i: CARDINAL] = { I: CARDINAL _ M2S.IdBuf [i].ORD; I _ i + I; DO RefFile.PutChar [M2S.IdBuf [i]]; i _ i + 1; IF i = I THEN EXIT ENDLOOP }; OpenRef: PUBLIC PROC = { WriteNo [REFFILE]; FOR mod: M2D.ObjPtr _ ModList^.next, mod^.next WHILE mod # NIL DO module: M2D.ModulePtr = NARROW [mod]; WriteNo [CTL+anchorBlk]; WriteNo [module^.key/65536]; WriteNo [module^.key MOD 65536]; WriteId [mod^.name]; ENDLOOP; CurStr _ minS }; OutExt: PROC [str: M2D.StrPtr] = { obj: M2D.ObjPtr; par: M2D.ParPtr; n: CARDINAL; SELECT str^.form FROM Enum, Pointer, Opaque => {}; Range => { range: M2D.RangePtr = NARROW [str]; IF range^.BaseTyp^.ref = 0 THEN OutExt [range^.BaseTyp] }; Set => { set: M2D.SetPtr = NARROW [str]; IF set^.BaseTyp^.ref = 0 THEN OutExt [set^.BaseTyp] }; ProcTyp => { proctyp: M2D.ProcTypPtr = NARROW [str]; par _ proctyp^.firstPar; WHILE par # NIL DO IF par^.typ^.ref = 0 THEN OutExt [par^.typ]; par _ par^.next ENDLOOP; IF (proctyp^.resTyp # M2D.notyp) AND (proctyp^.resTyp^.ref = 0) THEN OutExt [proctyp^.resTyp] }; Array => { array: M2D.ArrayPtr = NARROW [str]; IF array^.ElemTyp^.ref = 0 THEN OutExt [array^.ElemTyp]; IF NOT array^.dyn AND (array^.IndexTyp^.ref = 0) THEN OutExt [array^.IndexTyp] }; Record => { record: M2D.RecordPtr = NARROW [str]; obj _ record^.firstFld; WHILE obj # NIL DO IF obj^.typ^.ref = 0 THEN OutExt [obj^.typ]; obj _ obj^.next ENDLOOP } ENDCASE; IF str^.strobj # NIL THEN { type: M2D.TypPtr = str^.strobj; module: M2D.ModulePtr = type^.mod; IF module^.mod # 0 THEN { IF str^.ref = 0 THEN OutStr [str]; WriteNo [OBJ+typeBlk]; WriteNo [str^.ref]; WriteNo [module^.mod]; WriteId [str^.strobj^.name]; IF str^.form = Enum THEN { enum: M2D.EnumPtr = NARROW [str]; n _ enum^.NofConst; obj _ str^.strobj; WHILE n # 0 DO obj _ obj^.next; { const: M2D.ConstPtr = NARROW [obj]; WriteNo [OBJ+constBlk]; WriteNo [str^.ref]; WriteNo [module^.mod]; WriteNo [const^.conval.D0]; WriteNo [const^.conval.D1]; WriteId [obj^.name] }; n _ n - 1 ENDLOOP }}}}; OutPar: PROC [prm: M2D.ParPtr] = { WHILE prm # NIL DO IF prm^.varpar THEN WriteNo [CMP+parrefBlk] ELSE WriteNo [CMP+parBlk]; WriteNo [prm^.typ^.ref]; prm _ prm^.next ENDLOOP }; OutStr: PROC [str: M2D.StrPtr] = { obj: M2D.ObjPtr; WITH str SELECT FROM enum: M2D.EnumPtr => { WriteNo [STR+enumBlk]; WriteNo [enum^.size]; WriteNo [enum^.NofConst] }; range: M2D.RangePtr => { IF range^.BaseTyp^.ref = 0 THEN OutStr [range^.BaseTyp]; WriteNo [STR+rangeBlk]; WriteNo [range^.size]; WriteNo [range^.BaseTyp^.ref]; WriteNo [LOOPHOLE[range^.min, CARDINAL]]; WriteNo [LOOPHOLE[range^.max, CARDINAL]] }; pointer: M2D.PointerPtr => { obj _ NEW [M2D.Object.Linkage _ [ typ: pointer^.BaseTyp, ext: Linkage [baseref: CurStr]]]; LinkList^.last^.next _ obj; LinkList^.last _ obj; WriteNo [STR+pointerBlk]; WriteNo [pointer^.size] }; set: M2D.SetPtr => { IF set^.BaseTyp^.ref = 0 THEN OutStr [set^.BaseTyp]; WriteNo [STR+setBlk]; WriteNo [set^.size]; WriteNo [set^.BaseTyp^.ref] }; proctyp: M2D.ProcTypPtr => { FOR par: M2D.ParPtr _ proctyp^.firstPar, par^.next WHILE par # NIL DO -- out parameter structure -- IF par^.typ^.ref = 0 THEN OutStr [par^.typ]; ENDLOOP; OutPar [proctyp^.firstPar]; IF proctyp^.resTyp = M2D.notyp THEN -- ordinary procedure -- { WriteNo [STR+procTypBlk]; WriteNo [proctyp^.size] } ELSE -- function -- { IF proctyp^.resTyp^.ref = 0 THEN OutStr [proctyp^.resTyp]; WriteNo [STR+funcTypBlk]; WriteNo [proctyp^.size]; WriteNo [proctyp^.resTyp^.ref] }}; array: M2D.ArrayPtr => { IF array^.ElemTyp^.ref = 0 THEN OutStr [array^.ElemTyp]; IF NOT array^.dyn THEN { IF array^.IndexTyp^.ref = 0 THEN OutStr [array^.IndexTyp]; WriteNo [STR+arrayBlk]; WriteNo [array^.size]; WriteNo [array^.ElemTyp^.ref]; WriteNo [array^.IndexTyp^.ref] } ELSE { WriteNo [STR+dynarrBlk]; WriteNo [array^.size]; WriteNo [array^.ElemTyp^.ref] }}; record: M2D.RecordPtr => { obj _ record^.firstFld; WHILE obj # NIL DO -- out field structure -- IF obj^.typ^.ref = 0 THEN OutStr [obj^.typ]; obj _ obj^.next ENDLOOP; obj _ record^.firstFld; WHILE obj # NIL DO -- out fields -- field: M2D.FieldPtr = NARROW [obj]; WriteNo [CMP+fieldBlk]; WriteNo [obj^.typ^.ref]; WriteNo [field^.offset]; WriteId [obj^.name]; obj _ obj^.next ENDLOOP; WriteNo [STR+recordBlk]; WriteNo [record^.size] }; opaque: M2D.OpaquePtr => { WriteNo [STR+opaqueBlk]; WriteNo [opaque^.size] } ENDCASE; str^.ref _ CurStr; CurStr _ CurStr + 1 }; OutObj: PROC [obj: M2D.ObjPtr] = { par: M2D.ParPtr; SELECT obj^.class FROM Module => { module: M2D.ModulePtr = NARROW [obj]; WriteNo [OBJ+moduleBlk]; WriteNo [module^.mod] }; Proc => {proc: M2D.ProcPtr = NARROW [obj]; par _ proc^.firstParam; WHILE par # NIL DO IF par^.typ^.ref = 0 THEN OutExt [par^.typ]; par _ par^.next ENDLOOP; IF (obj^.typ # M2D.notyp) AND (obj^.typ^.ref = 0) THEN OutExt [obj^.typ]; par _ proc^.firstParam; WHILE par # NIL DO IF par^.typ^.ref = 0 THEN OutStr [par^.typ]; par _ par^.next ENDLOOP; IF (obj^.typ # M2D.notyp) AND (obj^.typ^.ref = 0) THEN OutStr [obj^.typ]; OutPar [proc^.firstParam]; WITH proc^.bd SELECT FROM pd: M2D.PDPtr => { IF obj^.typ = M2D.notyp THEN WriteNo [OBJ+procBlk] ELSE { WriteNo [OBJ+funcBlk]; WriteNo [obj^.typ^.ref] }; WriteNo [pd^.num]; WriteNo [pd^.lev]; WriteNo [pd^.adr] }; cd: M2D.CDPtr => { WriteNo [OBJ+svcBlk]; WriteNo [cd^.num] }; ENDCASE; }; Const => { const: M2D.ConstPtr = NARROW [obj]; IF obj^.typ^.ref = 0 THEN OutExt [obj^.typ]; IF obj^.typ^.ref = 0 THEN { OutStr [obj^.typ] }; IF obj^.typ^.form # String THEN -- numeric constant -- { WriteNo [OBJ+constBlk]; WriteNo [obj^.typ^.ref]; WriteNo [0]; -- main module -- WriteNo [const^.conval.D0]; WriteNo [const^.conval.D1] } ELSE -- literal string -- { WriteNo [OBJ+stringBlk]; WriteNo [obj^.typ^.ref]; WriteId [const^.conval.D2] }}; Typ => { IF obj^.typ^.ref = 0 THEN OutExt [obj^.typ]; IF obj^.typ^.ref = 0 THEN OutStr [obj^.typ]; WriteNo [OBJ+typeBlk]; WriteNo [obj^.typ^.ref]; WriteNo [0]; -- main module -- }; Var => { var: M2D.VarPtr = NARROW [obj]; IF obj^.typ^.ref = 0 THEN OutExt [obj^.typ]; IF obj^.typ^.ref = 0 THEN { OutStr [obj^.typ] }; IF var^.varpar THEN WriteNo [OBJ+varrefBlk] ELSE WriteNo [OBJ+varBlk]; WriteNo [obj^.typ^.ref]; WriteNo [var^.lev]; WriteNo [var^.cell] } ENDCASE; WriteId [obj^.name] }; OutLink: PROC = -- out synthetic objects and pointer linkages -- { FOR obj: M2D.ObjPtr _ LinkList^.next, obj^.next WHILE obj # NIL DO linkage: M2D.LinkagePtr = NARROW [obj]; IF obj^.typ^.ref = 0 THEN OutExt [obj^.typ]; IF obj^.typ^.ref = 0 THEN OutStr [obj^.typ]; WriteNo [CTL+linkageBlk]; WriteNo [obj^.typ^.ref]; WriteNo [linkage^.baseref]; ENDLOOP; LinkList^.next _ NIL; LinkList^.last _ LinkList }; OutUnit: PUBLIC PROC [unit: M2D.ObjPtr] = { WITH unit SELECT FROM proc: M2D.ProcPtr => WITH proc^.bd SELECT FROM pd: M2D.PDPtr => { FOR obj: M2D.ObjPtr _ pd^.firstLocal, obj^.next WHILE obj # NIL DO OutObj [obj]; ENDLOOP; OutLink; WriteNo [CTL+ProcTagBlk]; WriteNo [pd^.num] }; ENDCASE; module: M2D.ModulePtr => { FOR obj: M2D.ObjPtr _ module^.firstObj, obj^.next WHILE obj # NIL DO OutObj [obj]; ENDLOOP; OutLink; WriteNo [CTL+ModTagBlk]; WriteNo [module^.mod] }; ENDCASE }; OutPos: PUBLIC PROC [sourcepos, pc: CARDINAL] = { IF pc < CTL THEN { WriteNo [pc]; WriteNo [sourcepos] } ELSE M2S.Mark [99] }; CloseRef: PUBLIC PROC [adr, pno: CARDINAL] = { WriteNo [CTL+RefTagBlk]; WriteNo [adr]; WriteNo [pno] }; M2D.undftyp^.ref _ 1; M2D.booltyp^.ref _ 2; M2D.chartyp^.ref _ 3; M2D.inttyp^.ref _ 4; M2D.cardtyp^.ref _ 5; M2D.dbltyp^.ref _ 6; M2D.realtyp^.ref _ 7; M2D.lrltyp^.ref _ 8; M2D.stringtyp^.ref _ 9; M2D.wordtyp^.ref _ 10; M2D.addrtyp^.ref _ 11; M2D.bitstyp^.ref _ 12; M2D.proctyp^.ref _ 13 END. FILE: M2RImpl.mesa Modula-2 Symbol-File and Reference-File Handler Last Edited by: Gutknecht, September 18, 1985 4:05:43 pm PDT Satterthwaite March 11, 1986 5:38:16 pm PST header, module refer to object -- pointer^.BaseTyp _ M2D.undftyp; pointer^.BaseId _ 0 } Κ˜Jšœ™Jšœ/™/šœ<™˜>Jšœ˜J˜šœœœœ˜!Jšœœœ ˜.Jšœœ œ˜ J˜—šœœœœ˜!Jšœœ ˜Jšœœ œœ˜&Jšœœœ˜(šœ˜J˜Jšœœœ˜J˜—Jšœ˜Jšœ œ˜J˜—šŸ œœœœ*˜PJšœœ˜+J˜—Jš œœœœœ˜Hšœ˜šœœ œœž˜,J˜PJ˜KJ˜NJ˜PJ˜Jšœ!œ˜'J˜ š˜Jšœ˜šœ œœœ˜+Jšœœ œœ˜;šœ˜Jšœœ˜-Jšœ ˜ Jšœ-˜-Jšœ˜Jšœ-˜-Jšœ˜Jšœœ˜3Jšœ˜Jšœ4˜4Jšœ=˜=Jšœ˜Jšœœ˜4Jšœ˜Jšœ-˜-Jšœ6˜6J˜0J˜Jšœ˜Jšœœ˜/Jšœ'˜'Jšœ˜Jšœ4˜4Jšœœ˜%Jšœ˜Jšœœ˜3Jšœœ˜&Jšœ˜Jšœ-˜-J˜Jšœ*˜*Jšœ-˜-Jšœ6œ˜:J˜Jšœœ˜,Jšœœ˜3Jšœœ˜&Jšœ˜Jšœ-˜-J˜Jšœ*˜*Jšœ,˜,Jšœ˜Jšœ6œ˜:Jšœœ˜,Jšœœ˜1Jšœœ˜&Jšœœ˜Jšœ-˜-Jšœ˜Jšœ$˜$Jšœ&˜&J˜Jšœœ˜+—Jšœ˜Jšœ!™!Jšœž˜)šœœœ'˜>J˜—Jšœ˜šœœœž˜$J˜-Jšœ˜—š˜Jšœœœ˜0J˜——š˜šœ œœœ˜+Jšœœ œœ˜=šœ˜Jšœœ˜'Jšœ˜Jšœ˜Jšœ˜Jšœ0˜0—šœž˜Jšœ œ˜JšœC˜CJšœœ-˜?——š˜šœ œœœ˜+Jšœœ œœ˜>Jšœœ˜šœ˜Jšœœ˜3Jšœ7˜7Jšœœ˜6Jšœ˜Jšœ&˜&Jšœœ œ˜.Jšœœ œ˜.Jšœ˜Jšœ œ˜Jšœœ˜7Jšœ˜Jšœ&˜&Jšœœœ˜/Jšœœ˜9Jšœ˜Jšœ6œ˜:Jšœ˜Jšœœ˜0Jšœ˜Jšœ#™#Jšœ™—Jšœ˜Jšœœ œœ˜:J˜J˜—š˜šœ œœœ˜+šœœœ˜;Jšœ&œ ˜9Jšœ œ ˜3Jšœ0˜4—šœœœž˜0J˜ —šœœ˜Jšœœ˜/Jšœœ˜0Jšœ˜Jšœ7˜7Jšœ˜Jšœž˜#Jšœœœ'œ˜NJšœ˜šœœ˜Jšœ)˜)Jšœ˜Jšœ0˜0—šœœ˜.Jšœ˜Jšœœ˜3š œœœ œžœ˜=Jšœœ˜'——Jšœœœ˜.Jšœ+˜+—šœœ˜Jšœ"œ˜(—Jšœ œœ˜)—Jšœ œœ˜(————Jšœ˜šœœœ˜ Jšœœ˜%šœž˜ Jšœœ˜Jšœœ˜Jšœ)˜)J˜&J˜#J˜ Jšœ œ˜—Jšœ˜J˜Jšœœ˜Jšœžœ˜&—Jšœœ˜—Jšœœ˜"Jšœ ˜ —Jšœœ˜#J˜—šŸœœœ˜Jšœ>œ˜I—J˜šŸœœœ˜Jšœœœ˜"Jšœ ˜ šœ,˜.Jšœœ˜—Jšœ˜ J˜—šŸœœœ˜Jšœ œ˜š œœ œœ˜AJšœœ˜%Jšœ œ ˜Jšœ2œ˜=J˜—Jšœ˜J˜J˜—šŸœœ˜ Jšœ'œ˜0šœ ˜J˜Jšœ"œ˜/Jšœœœ˜>Jšœœ˜)Jšœœœ˜:Jšœ'œ˜4Jšœ˜Jšœœœ˜Jšœœœ˜1J˜Jšœœ˜ Jšœœœ˜HJšœ ˜ Jšœ"œ˜/Jšœœœ˜Jšœ œ"˜2Jšœ"˜"Jšœ œ œ˜-Jšœ œ œ˜/Jšœ˜Jšœ œ˜'Jšœ>˜>Jšœ5˜5Jšœ œ(˜8Jšœ˜Jšœœœ˜:Jšœ œ=˜MJšœ˜Jš œœ#œ œœ˜KJšœž˜"Jšœœœ˜1Jšœœ˜ J˜Jšœœœž˜@Jšœœ'˜:Jšœœž˜Jšœœœ˜AJšœœ&˜7J˜'Jšœ˜Jšœœœ˜>Jšœœœ ˜Jšœœœ˜AJšœœ"˜3J˜DJšœ˜Jšœœ#˜6J˜&Jšœ˜Jšœ˜Jšœœœœž˜0Jšœœœ˜1J˜Jšœœ˜ J˜Jšœœœœž˜'Jšœœ˜(Jšœœ$˜5J˜2J˜Jšœœ˜ Jšœ œ&˜6Jšœ˜Jšœœ%˜7—Jšœ˜J˜)J˜——šŸœœ˜ J˜šœ ˜šœ$œ˜1Jšœ œ%˜5Jšœœ˜+Jšœ˜Jšœœœ˜Jšœœœ˜1J˜Jšœœ˜ Jšœœœ˜:J˜J˜Jšœœœ˜Jšœœœ˜1J˜Jšœœ˜ Jšœœœ˜:J˜J˜Jšœœ œ˜J˜Jšœœœ œ ˜8Jšœœ œ%˜>J˜@J˜Jšœœ˜0Jšœœ˜ Jšœ˜Jšœ"œ˜/Jšœœœ˜0Jšœœœ˜4Jšœœœž˜:Jšœœ ˜Jšœ+žœ˜=Jšœ=˜=Jšœœž˜Jšœœ ˜Jšœ˜J˜#Jšœ œœ˜6Jšœœœ˜0Jšœ œ ˜Jšœ*žœ˜>Jšœœ˜)Jšœœœ˜0Jšœœœ˜4Jšœœ œ œ ˜/Jšœœ œ ˜J˜F—Jšœ˜J˜J˜—šŸœœž0˜@š œœ œ œœ˜DJšœœ˜'Jšœœ˜,Jšœœ˜,Jšœ œB˜N—Jšœ˜Jšœœ˜2J˜—šŸœœœ˜)šœœœ˜šœ˜šœ œ˜šœ˜š œœœ œœ˜CJšœ ˜ —Jšœ˜J˜Jšœ œ"˜.—Jš˜——šœ˜š œœœ œœ˜DJšœ ˜ —Jšœ˜J˜Jšœ œ%˜1—šœ˜ J˜———šŸœœœœ˜/Jšœœœœ&˜8Jšœ˜J˜—šŸœœœ œ˜,Jšœ œ,˜:J˜—J˜AJ˜@J˜BJ˜DJ˜J˜—Jšœ˜—…—J`$