[ivy]<Satterthwaite>Modula>M2TImpl.mesa!8

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
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;
check for undefined forward references pointing to this new 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 --
initialization of module SYSTEM --
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]]];
initialization of universe --
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.