[_CD6_]<dragon>Modula>M2TImpl.mesa!2

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;

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;

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;

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;

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;

IF ob0 = NIL THEN EXIT;

IF M2S.Diff [id, ob0^.name] = 0 THEN EXIT;

ob0 ← ob0^.next

ENDLOOP;

IF ob0 = NIL THEN { im0 ← im1;

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.