DIRECTORY
M2D: TYPE USING [ObjClass, StrForm, ObjPtr, HeaderPtr, ConstPtr, TypPtr, ModulePtr, StrPtr, EnumPtr, RangePtr, PointerPtr, ProcPtr, SetPtr, RecordPtr, ProcTypPtr, CDPtr, ParPtr, ImpPtr, ExpPtr, Object, Structure, BDesc, Parameter, ImportItem, ExportItem, WordSize, nilval, sysmod, mainmod, undftyp, notyp, cardtyp, inttyp, dbltyp, realtyp, lrltyp, booltyp, chartyp, stringtyp, bitstyp, addrtyp, wordtyp, proctyp, InitData],
M2S: TYPE USING [id, Enter, Diff, Mark],
M2T: TYPE;

M2TImpl : CEDAR PROGRAM 
IMPORTS M2D, M2S
EXPORTS M2T = 

BEGIN OPEN M2T;

Scope: PUBLIC M2D.HeaderPtr; -- header of scope located by Find

topScope: M2D.HeaderPtr;
universe: M2D.HeaderPtr;

lastpar: M2D.ParPtr;
lastimp: M2D.ImpPtr;
lastexp: M2D.ExpPtr;


FindField: PUBLIC PROC [id: CARDINAL, rec: M2D.RecordPtr] RETURNS [fld: M2D.ObjPtr] =
{ fld _ rec^.firstFld;
DO
IF fld = NIL THEN EXIT;
IF M2S.Diff [id, fld^.name] = 0 THEN EXIT;
fld _ fld^.next
ENDLOOP };

FindExport: PUBLIC PROC [id: CARDINAL, mod: M2D.ModulePtr] RETURNS [obj: M2D.ObjPtr] =
{ -- find an object in export list of module mod --
IF mod^.key = 0 THEN -- local module --
{ FOR exp: M2D.ExpPtr _ mod^.firstExp, exp^.next DO
IF exp = NIL THEN { obj _ NIL; EXIT };
IF M2S.Diff [id, exp^.name] = 0 THEN { obj _ exp^.item; EXIT };
ENDLOOP }
ELSE { obj _ mod^.firstObj;
DO
IF obj = NIL THEN EXIT;
IF M2S.Diff [id, obj^.name] = 0 THEN EXIT;
obj _ obj^.next
ENDLOOP }};

FindInScope: PROC [id: CARDINAL, hdr: M2D.HeaderPtr] RETURNS [obj: M2D.ObjPtr] =
{ obj _ hdr^.next;
DO
IF obj = NIL THEN EXIT;
IF M2S.Diff [id, obj^.name] = 0 THEN EXIT;
obj _ obj^.next
ENDLOOP;
IF obj = NIL THEN { 
FOR imp: M2D.ImpPtr _ hdr^.firstImp, imp^.next DO
IF imp = NIL THEN EXIT;
IF M2S.Diff [id, imp^.name] = 0 THEN { obj _ imp^.item; EXIT };
ENDLOOP }};

Find: PUBLIC PROC [id: CARDINAL] RETURNS [obj: M2D.ObjPtr] =
{ Scope _ topScope;
DO 
obj _ FindInScope [id, Scope];
IF obj # NIL THEN EXIT;
IF Scope^.kind = Module THEN
{ obj _ FindInScope [id, universe]; EXIT };
Scope _ NARROW [Scope^.base]
ENDLOOP };

NewObj: PUBLIC PROC [id: CARDINAL, class: M2D.ObjClass] RETURNS [obj: M2D.ObjPtr] =
{ obj _ FindInScope [id, topScope];
IF obj # NIL THEN M2S.Mark [100];
SELECT class FROM
Header	=>	obj _ NEW [M2D.Object.Header _ [name: id, ext: Header []]];
Const		=>	obj _ NEW [M2D.Object.Const _ [name: id, ext: Const [[Int [0]]]]];
Typ		=>	obj _ NEW [M2D.Object.Typ _ [name: id, ext: Typ []]];
Var		=>	obj _ NEW [M2D.Object.Var _ [name: id, ext: Var []]];
Field		=>	obj _ NEW [M2D.Object.Field _ [name: id, ext: Field []]];
Proc		=>	{ obj _ NEW [M2D.Object.Proc _ [name: id, ext: Proc []]]; NewProc };
Module	=>	obj _ NEW [M2D.Object.Module _ [name: id, ext: Module [firstExp: lastexp]]]; 
ENDCASE;
topScope^.last^.next _ obj; topScope^.last _ obj };

NewStr: PUBLIC PROC [form: M2D.StrForm] RETURNS [str: M2D.StrPtr] =
{ SELECT form FROM
Undef		=> str _ NEW [M2D.Structure.Undef];
Bool		=> str _ NEW [M2D.Structure.Bool];
Char		=> str _ NEW [M2D.Structure.Char];
Int		=> str _ NEW [M2D.Structure.Int];
Card		=> str _ NEW [M2D.Structure.Card];
Double	=> str _ NEW [M2D.Structure.Double];
Real		=> str _ NEW [M2D.Structure.Real];
LongReal	=> str _ NEW [M2D.Structure.LongReal];
String		=> str _ NEW [M2D.Structure.String];
Opaque	=> str _ NEW [M2D.Structure.Opaque];
Enum		=> str _ NEW [M2D.Structure.Enum];
Range		=> str _ NEW [M2D.Structure.Range];
Pointer	=> str _ NEW [M2D.Structure.Pointer];
Set 		=> str _ NEW [M2D.Structure.Set];
Array 	=> str _ NEW [M2D.Structure.Array];
Record 	=> str _ NEW [M2D.Structure.Record];
ProcTyp 	=> { str _ NEW [M2D.Structure.ProcTyp]; NewProc }
ENDCASE };

NewImp: PUBLIC PROC [obj: M2D.ObjPtr] =
{ imp: M2D.ImpPtr _ lastimp;
n: CARDINAL; 
WHILE imp # NIL DO
IF M2S.Diff [imp^.name, obj^.name] = 0 THEN M2S.Mark [100];
imp _ imp^.next
ENDLOOP;
imp _ NEW [M2D.ImportItem _ [ name: obj^.name, item: obj, next: lastimp ]];
lastimp _ imp;
IF (obj^.class = Typ) AND (obj^.typ^.form = Enum) THEN
{ -- import enum constants too --
enum: M2D.EnumPtr = NARROW [obj^.typ];
n _ enum^.NofConst;
WHILE n > 0 DO
n _ n - 1; obj _ obj^.next; NewImp [obj]
ENDLOOP }};

NewProc: PUBLIC PROC  =
{ lastpar _ NIL };

NewPar: PUBLIC PROC [typ: M2D.StrPtr, varpar: BOOLEAN] =
{ par: M2D.ParPtr = NEW [M2D.Parameter _ [typ: typ, varpar: varpar, next: lastpar]];
lastpar _ par };

NewExp: PUBLIC PROC [id: CARDINAL] =
{ exp: M2D.ExpPtr = NEW [M2D.ExportItem _ [name: id, item: NIL, next: lastexp]];
lastexp _ exp };

ParamLink: PUBLIC PROC RETURNS [p: M2D.ParPtr] =
{ q: M2D.ParPtr; -- reverse parameter chain --
p _ NIL;
WHILE lastpar # NIL DO
q _ lastpar; lastpar _ q^.next; q^.next _ p; p _ q
ENDLOOP };

FirstObj: PUBLIC PROC RETURNS [M2D.ObjPtr] =  { RETURN [topScope^.next] };

LastObj: PUBLIC PROC RETURNS [M2D.ObjPtr] =  { RETURN [topScope^.last] };

NewScope: PUBLIC PROC [class: M2D.ObjClass] RETURNS [hdr: M2D.HeaderPtr] =
{ hdr _ NEW [M2D.Object.Header _ [ext: Header [kind: class, base: topScope]]];
IF class = Module THEN hdr^.firstImp _ lastimp;
hdr^.last _ hdr; topScope _ hdr };

LinkScope: PUBLIC PROC =
{ -- link object list of definition module to scope --
obj: M2D.ObjPtr _ M2D.mainmod^.firstObj;
topScope^.next _ obj;
IF obj # NIL THEN
{ WHILE obj^.next # NIL DO obj _ obj^.next ENDLOOP;
topScope^.last _ obj }};

CloseScope: PUBLIC PROC = { topScope _ NARROW [topScope^.base] };

CheckUDP: PUBLIC PROC [obj: M2D.ObjPtr] =
{ -- obj is newly defined type;
FOR ob1: M2D.ObjPtr _ topScope^.next, ob1^.next WHILE ob1 # NIL DO
IF (ob1^.class = Typ) AND (ob1^.typ^.form = Pointer) THEN
{ pointer: M2D.PointerPtr _ NARROW [ob1^.typ];
IF (pointer^.BaseTyp = M2D.undftyp) AND (M2S.Diff [pointer^.BaseId, obj^.name] = 0) THEN pointer^.BaseTyp _ obj^.typ };
ENDLOOP };

InitImpExp: PUBLIC PROC = { lastimp _ NIL; lastexp _ NIL };

ValidateExports: PUBLIC PROC [ancestor: M2D.ModulePtr, qual: BOOLEAN] =
{ ob0, ob1, ob2: M2D.ObjPtr; im0, im1: M2D.ImpPtr; id: CARDINAL;
env: M2D.HeaderPtr = NARROW [topScope^.base];
lastimp _ env^.firstImp;
im1 _ topScope^.firstImp; ob1 _ topScope^.next; 
FOR exp: M2D.ExpPtr _ ancestor^.firstExp, exp^.next WHILE exp # NIL DO
id _ exp^.name; ob0 _ ob1;
DO
IF ob0 = NIL THEN EXIT;
IF M2S.Diff [id, ob0^.name] = 0 THEN EXIT;
ob0 _ ob0^.next
ENDLOOP;
IF ob0 = NIL THEN { im0 _ im1;
DO
IF im0 = NIL THEN EXIT;
IF M2S.Diff [id, im0^.name] = 0 THEN { ob0 _ im0^.item; EXIT };
im0 _ im0^.next
ENDLOOP };
IF ob0 # NIL THEN { exp^.item _ ob0;
IF NOT qual THEN
{ ob2 _ FindInScope [ob0^.name, env];
IF ob2 = NIL THEN NewImp [ob0] ELSE M2S.Mark [150] -- collision -- }
ELSE M2S.Mark [80] };
ENDLOOP;
env^.firstImp _ lastimp };

Mark: PUBLIC PROC = { topScope^.name _ M2S.id -- Mark name buffer --};

Release: PUBLIC PROC = { M2S.id _ topScope^.name -- Release name buffer --};

InitTableHandler: PUBLIC PROC = { topScope _ universe; M2D.mainmod _ NIL };

EnterTyp: PROC [name: REF TEXT, form: M2D.StrForm, size: CARDINAL] RETURNS [str: M2D.StrPtr] =
{ obj: M2D.TypPtr = NARROW [NewObj [M2S.Enter [name], Typ]];
str _ NewStr [form]; obj^.typ _ str;
str^.strobj _ obj; str^.size _ size };

EnterProc: PROC [name: REF TEXT, num: CARDINAL, res: M2D.StrPtr] =
{ obj: M2D.ProcPtr = NARROW [NewObj [M2S.Enter [name], Proc]];
cd: M2D.CDPtr = NEW [M2D.BDesc.Code _ [Code[num: num, cod: ]]];
NewProc;
obj^.typ _ res;  obj^.bd _ cd };

{ obj: M2D.ObjPtr;
BBtyp: M2D.StrPtr;

set: M2D.SetPtr _ NIL;
range: M2D.RangePtr _ NIL;
proctyp: M2D.ProcTypPtr _ NIL;
const: M2D.ConstPtr;

M2D.InitData;
InitImpExp; topScope _ NIL; Scope _ NIL; M2D.mainmod _ NIL;
universe _ NewScope [Module];
M2D.undftyp _ NewStr [Undef]; M2D.undftyp^.size _ 1;
M2D.notyp _ NewStr [Undef]; M2D.notyp^.size _ 0;
M2D.stringtyp _ NewStr [String]; M2D.stringtyp^.size _ 0;
BBtyp _ NewStr[Range]; -- Bitset basetype --

M2D.wordtyp _ EnterTyp ["WORD ", Undef, 1];
M2D.addrtyp _ EnterTyp ["ADDRESS ", Double, 1];
EnterProc ["TSIZE ", 8, NIL];
EnterProc ["ADR ", 10, M2D.addrtyp];
M2D.sysmod _ NEW [M2D.Object.Module _ [ name: M2S.Enter ["SYSTEM "],
ext: Module [key: 1, firstExp: lastexp, firstObj: topScope^.next]]];

InitImpExp;
topScope^.last _ topScope;
M2D.cardtyp _ EnterTyp ["CARDINAL ", Card, 1];
M2D.inttyp _ EnterTyp ["INTEGER ", Int, 1];
M2D.chartyp _ EnterTyp ["CHAR ", Char, 1];
M2D.booltyp _ EnterTyp ["BOOLEAN ", Bool, 1];
obj _ NewObj [M2S.Enter ["FALSE "], Const]; obj^.typ _ M2D.booltyp;
const _ NARROW [obj]; const^.conval.B _ FALSE;
obj _ NewObj [M2S.Enter ["TRUE "], Const]; obj^.typ _ M2D.booltyp; 
const _ NARROW [obj]; const^.conval.B _ TRUE;
obj _ NewObj [M2S.Enter ["NIL "], Const]; obj^.typ _ M2D.addrtyp; 
const _ NARROW [obj]; const^.conval.C _ M2D.nilval;
M2D.realtyp _ EnterTyp ["REAL ", Real, 2];
M2D.bitstyp _ EnterTyp ["BITSET ", Set, 1];
set _ NARROW [M2D.bitstyp]; set^.BaseTyp _ BBtyp;
BBtyp^.size _ 1;
range _ NARROW [BBtyp]; range^.BaseTyp _ M2D.cardtyp;
range^.min _ 0; range^.max _ M2D.WordSize - 1;
M2D.dbltyp _ EnterTyp ["LONGINT ", Double, 2];
M2D.lrltyp _ EnterTyp ["LONGREAL ", LongReal, 4];
M2D.proctyp _ EnterTyp ["PROC ", ProcTyp, 1];
proctyp _ NARROW [M2D.proctyp];
proctyp^.firstPar _ NIL; proctyp^.resTyp _ M2D.notyp;
EnterProc ["HALT ", 1, M2D.notyp];
EnterProc ["ABS ", 2, M2D.inttyp];
EnterProc ["CAP ", 3, M2D.chartyp];
EnterProc ["FLOAT ", 4, M2D.realtyp];
EnterProc ["ODD ", 5, M2D.booltyp];
EnterProc ["ORD ", 6, M2D.cardtyp];
EnterProc ["TRUNC ", 7, M2D.cardtyp];
EnterProc ["SIZE ", 8, NIL];
EnterProc ["MIN ", 11, M2D.cardtyp];
EnterProc ["MAX ", 12, M2D.cardtyp];
EnterProc ["HIGH ", 13, M2D.cardtyp];
EnterProc ["CHR ", 14, M2D.chartyp];
EnterProc ["LONG ", 15, M2D.dbltyp];
EnterProc ["INC ", 16, M2D.notyp];
EnterProc ["DEC ", 17, M2D.notyp];
EnterProc ["INCL ", 18, M2D.notyp];
EnterProc ["EXCL ", 19, M2D.notyp];
EnterProc ["SHIFT ", 20, M2D.cardtyp];
Mark}

END.

$FILE: M2TImpl.mesa
Modula-2 Symboltable Handler
Last Edited by: Gutknecht, September 18, 1985 0:29:18 am PDT
Satterthwaite December 11, 1985 3:25:14 pm PST
check for undefined forward references pointing to this new type
initialization of module SYSTEM --
initialization of universe --
Κ
Θ˜Jš
œ™Jš
œ™š
œ<™<Icode™.—šœ
Οk	˜
Jšœœ
œ˜˜§Jšœœ
œ˜(Jšœœ
˜
J˜—šœ
œ
œ
˜Jšœ	˜Jšœ˜—J˜šœ
œ˜J˜JšœœΟc"˜?J˜Jš
œ˜Jš
œ˜J˜J˜J˜J˜J˜J˜š
Οn	œœ
œœœ˜UJ˜š
˜Jšœœ
œ
œ
˜Jšœœ
œ
˜*J˜—Jšœ˜
J˜—š
Ÿ
œœ
œœœ˜VJšœž1˜3šœœ
ž˜'šœœ,˜3Jš
œœ
œ	œœ˜&Jšœœœ˜?—Jšœ˜	—šœ˜š
˜Jšœœ
œ
œ
˜Jšœœ
œ
˜*J˜—Jšœ˜—J˜—šŸœœœœ˜PJš
œ˜š
˜Jšœœ
œ
œ
˜Jšœœ
œ
˜*J˜—Jšœ
˜šœœ
œ˜šœ
œœ	˜1Jšœœ
œ
œ
˜Jšœœœ˜?—Jšœ˜—J˜—š
Ÿœœ
œœœ˜<J˜šœ
˜Jš
œ˜Jšœœ
œ
œ
˜šœ˜Jšœ$œ˜+—Jšœœ˜—Jšœ˜
J˜—š
Ÿœœ
œœœ˜SJš
œ#˜#Jšœœ
œ˜!šœ˜Jšœœ2˜EJšœœ9˜LJšœœ,˜=Jšœœ,˜=Jšœœ0˜CJšœœ9˜MJšœœD˜W—Jšœ
˜Jš
œ3˜3J˜—šŸœœ
œœ˜Cšœœ˜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šœœB˜KJ˜šœœ˜6Jšœž˜!Jšœœ˜&Jš
œ˜šœ˜J˜(—Jšœ˜J˜——šŸœœ
œ˜Jšœœ˜J˜—šŸœœ
œœ˜8Jšœœ=˜TJ˜J˜—šŸœœ
œœ˜$Jšœœ$œ˜PJ˜J˜—šŸ	œœ
œ
œ˜0Jšœž˜.Jšœœ
˜šœœ
˜J˜2—Jšœ˜
J˜—Jš
Ÿœœ
œ
œœ˜J—˜Jš
Ÿœœ
œ
œœ˜I—˜šŸœœ
œœ˜JJšœœC˜NJšœœ˜/Jš
œ"˜"J˜—šŸ	œœ
œ˜Jšœž4˜6Jš
œ(˜(J˜šœœ
˜Jš	œœ
œ
œœ
˜3Jš
œ˜J˜——JšŸ
œœ
œœ˜AJ˜šŸœœ
œ˜)Jšœž˜Jš
œ@™@šœ-œœ
˜Bšœœ˜9Jšœœ˜.Jšœ"œ-œ˜w——Jšœ˜
J˜—Jš
Ÿ
œœ
œœœ˜;J˜šŸœœ
œ!œ˜GJšœ7œ
˜@Jšœœ˜-Jš
œ˜J˜0šœ1œœ
˜FJ˜š
˜Jšœœ
œ
œ
˜Jšœœ
œ
˜*J˜—Jšœ
˜šœœ
œ
˜š
˜Jšœœ
œ
œ
˜Jšœœœ˜?J˜—Jšœ˜
—šœœ
œ˜$šœ
œ˜J˜%Jš
œœ
œœžœ˜D—Jšœ˜——Jšœ
˜Jš
œ˜J˜—JšŸœœ
œžœ˜FJ˜JšŸœœ
œžœ˜LJ˜JšŸœœ
œ(œ˜KJ˜šŸœœœ
œœœ˜^Jšœœ"˜<J˜$J˜&J˜—š
Ÿ	œœœ
œœ˜BJšœœ#˜>Jšœœ,˜?Jš
œ˜Jš
œ ˜ J˜—J˜J˜J˜Jšœœ
˜Jšœœ
˜Jšœœ
˜Jš
œ˜J˜Jš
œ
˜
Jšœœ
œœ
˜;J˜J˜4J˜0J˜9Jšœž˜,J˜Jš
œ"™"J˜+Jš
œ/˜/Jšœœ˜J˜$šœ
œ4˜DJš
œD˜D—J˜Jš
œ™J˜Jš
œ˜J˜.J˜+J˜*J˜-Jš
œC˜CJšœœœ
˜.Jš
œC˜CJšœœœ
˜-Jš
œB˜BJšœœ%˜3J˜*J˜+Jšœœ%˜1J˜Jšœœ'˜5J˜.J˜.J˜1J˜-Jšœ
œ˜Jšœœ˜5J˜"J˜"J˜#J˜%J˜#J˜#J˜%Jšœœ˜J˜$J˜$J˜%J˜$J˜$J˜"J˜"J˜#J˜#J˜&J˜J˜—Jšœ
˜—…—&&2