[ivy]<Satterthwaite>Modula>M2RImpl.mesa!6

FILE: M2RImpl.mesa
Modula-2 Symbol-File and Reference-File Handler
Last Edited by: Gutknecht, September 18, 1985 4:05:43 pm PDT
Satterthwaite December 11, 1985 3:26:42 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 };
IO.Close [f] }
ELSE { M2S.Mark [86]; mod ← NIL }};
WriteNo: PROC [n: CARDINAL] =
{ RefFile.PutChar [0C + n/256]; RefFile.PutChar [0C + 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.