
<<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>>

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;
<<header, module refer to object -->>
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[]}
<<                pointer^.BaseTyp _ M2D.undftyp;>>
<<                pointer^.BaseId _ 0 }>>
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.