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š
œ/™/š
œ<™<Icode™+—šœ
Οk	˜
Jšœœ
œœ˜Jšœœ
œ˜#Jšœœ
œœ˜1Jšœœ
œκ˜ωJšœœ
œ˜(Jšœœ
˜
—J˜šœ
œ
œ
˜Jšœ
œœ
˜Jšœ˜—J˜Jš
˜˜Jšœœ
œΟc˜0Jšœ	œž˜9Jšœ	œ
œ
œ
˜—˜Jšœœ˜J˜šœœ˜Jšœœœœ˜LJšœœœ˜2—šœœ˜Jšœ	œœœ˜HJšœœœœ˜IJšœ
œœœ˜IJšœœ˜—šœœ˜Jšœœœœ˜F—šœœ˜Jšœœœœ˜GJšœœœœ˜FJšœ	œœœ˜EJ˜—Jšœœ˜Jšœœž"˜7Jšœœ˜J˜Jšœœ
œ
˜
Jšœœœ
˜J˜!J˜J˜šΟnœœ
œ˜J˜Jšœ
œ˜"Jš
œ˜Jšœ
œ˜"Jš
œ˜Jšœœ˜#Jš
œ˜Jšœ
œ-œœ˜MJ˜J˜—šŸœœ
œœ
œ
œœ˜]šœœ˜ Jš
œH˜H—J˜Jš
œ1˜1J˜—JšŸœœ
œœœ œ˜[˜Jšœ
œœ˜+Jšœœœ˜&Jšœœ
˜&Jšœœœ
˜J˜J˜:J˜Jš
œ-˜-Jš
œ7˜7Jš
œ'˜'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š
œ˜Jš
œ:˜:Jšœœ˜1Jš
œ˜Jš
œ&˜&Jšœ œ˜<Jš
œ˜Jš
œ&˜&Jšœœ˜+Jš
œ"˜"Jšœ œ˜<Jš
œ˜Jš
œ&˜&Jšœœ˜+Jš
œ(˜(Jšœœ˜6Jš
œ˜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šœœ
œœ˜9J˜ Jšœ$œ˜1Jš
œ˜Jšœœœ
˜Jšœœœ˜1J˜Jšœœ˜
—Jšœ
˜šœœ
˜Jš
œ!˜!Jš
œ"˜"šœ˜Jšœœœ˜$Jšœ	œ5˜AJš
œ˜šœ˜Jšœœ˜#Jš
œ&˜&šœœ˜Jšœœ˜%Jšœ	œ6˜BJ˜7J˜J˜	—Jšœ˜
———J˜—šŸœœ˜ šœœœ
˜Jš
œ
œ
œœ
œ	˜FJ˜J˜—Jšœ˜
J˜—šŸœœ˜ Jš
œ˜šœœ
˜Jš
œ˜Jšœœ ˜2Jš
œ˜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`$