[Indigo]<Cedar>BCDStuff>TypeStringsImpl.mesa!1

file [Indigo]<Cedar>BCD>TypeStringsImpl.mesa

Edited by Satterthwaite, May 6, 1983 1:11 pm

Edited by Maxwell, 19-Feb-82 11:33:15 (NOTE: we need better error reporting)

Last Modified On July 6, 1983 1:57 pm By Paul Rovner

Last Edited by: Levin, August 8, 1983 4:09 pm

DIRECTORY

Basics: TYPE USING [HighHalf, LowHalf],

ConvertUnsafe: TYPE USING [SubString],

Symbols: TYPE USING [

codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex,

ISEIndex, ISENull, MDIndex, MDNull, Name, nullName, nullType,

OwnMdi, Type, StandardContext, typeTYPE],

SymbolTable: TYPE USING [Base],

TypeStrings: TYPE USING [Code, TypeString];

TypeStringsImpl: PROGRAM

IMPORTS Basics

EXPORTS TypeStrings = {

OPEN Symbols, TypeStrings;

*******************************************************************

basic algorithm

*******************************************************************

stb: SymbolTable.Base ← NIL;

zone: UNCOUNTED ZONE ← NIL;

ts: TypeString;

Create: PUBLIC PROC[base: SymbolTable.Base, sei: Type, z: UNCOUNTED ZONE]

RETURNS[TypeString] = {

n:Entry;

IF base#stb THEN FlushCache[];

IF base=NIL THEN RETURN[NIL];

stb ← base;

zone ← z;

stackIndex ← defsIndex ← 0;

IF (n�he[sei]).type=sei THEN RETURN[n.string];

ts ← zone.NEW[StringBody[50]];

stack ← zone.NEW[StackVector];

defs ← zone.NEW[DefsVector];

lastName ← '\000;

stateLength ← 0;

AppendTypeString[sei];

n.type ← sei;

n.recursive ← InsertDefinitions[];

IF InsertDefinitions[] THEN Canonicalize[sei];

n.string ← ts;

zone.FREE[@defs]; zone.FREE[@stack];

IF ts.length # ts.maxlength THEN ts ← Adjust[ts,ts.length];

RETURN[ts]};

Adjust: PROC[s: TypeString, n: CARDINAL] RETURNS[new: TypeString] = {

new ← zone.NEW[StringBody[n]];

FOR i: CARDINAL IN [0..MIN[n, s.length]) DO

AppendChar[new, s[i]] ENDLOOP;

zone.FREE[@s];

RETURN[new]};

Append: PROC[c: CHAR] = {

WHILE ts.length >= ts.maxlength DO

ts ← Adjust[ts,ts.length+20] ENDLOOP;

AppendChar[ts, c]};

AppendChar: PROC [s: LONG STRING, c: CHARACTER] = {

IF s = NIL OR s.length >= s.maxlength THEN ERROR;

s[s.length] ← c;

s.length ← s.length + 1;

};

AppendCode: PROC[code: Code] = LOOPHOLE[Append];

AppendCardinal: PROC[c: CARDINAL] = INLINE {

Append[LOOPHOLE[c/256]]; Append[LOOPHOLE[c MOD 256]]};

AppendLongCardinal: PROC [lc: LONG CARDINAL] = {

AppendCardinal[Basics.HighHalf[lc]];

AppendCardinal[Basics.LowHalf[lc]]};

AppendString: PROC [s:TypeString] = INLINE {

FOR i: CARDINAL IN [0..s.length) DO Append[s[i]] ENDLOOP};

Paint: TYPE = MACHINE DEPENDENT RECORD [

version (0): ARRAY [0..3) OF CARDINAL,

index (3): CARDINAL];

GetPaint: PROC[type: Type] RETURNS[paint: Paint] = {

SELECT stb.TypeForm[type] FROM

$enumerated, $definition, $record, $union => {

ctx: CTXIndex ← TypeContext[type];

mdi: MDIndex;

WITH c~~stb.ctxb[ctx] SELECT FROM

simple => mdi ← OwnMdi;

included => {mdi ← c.module; ctx ← c.map};

ENDCASE => ERROR;

paint.index ← LOOPHOLE[ctx];

paint.version ←

(IF ctx IN StandardContext THEN ALL[0] ELSE LOOPHOLE[stb.mdb[mdi].stamp])};

$opaque =>

paint ← [LOOPHOLE[stb.mdb[OwnMdi].stamp], LOOPHOLE[type]];

ENDCASE => ERROR};

AppendPaint: PROC[paint:Paint] = {

AppendCardinal[paint.version[0]];

AppendCardinal[paint.version[1]];

AppendCardinal[paint.version[2]];

AppendCardinal[paint.index]};

AppendName: PROC[name: Name] = {

length, offset: CARDINAL;

IF name = nullName THEN length ← offset ← 0

ELSE length ← stb.ht[name].ssIndex - (offset ← stb.ht[name-1].ssIndex);

IF length>200b THEN ERROR; -- avoid code for leftParen and rightParen

Append[LOOPHOLE[length]];

FOR i: CARDINAL IN [offset..offset+length) DO Append[stb.ssb[i]] ENDLOOP};

AppendField: PROC[iSei: ISEIndex] = INLINE {

AppendName[stb.NameForSe[iSei]];

AppendTypeString[stb.seb[iSei].idType]};

AppendTypeString: PROC[type: Type] = {

class: Code;

e: StackElement;

strip off definitions

type ← UnderStar[type];

substitute concrete type for opaque type

IF stb.TypeForm[type]=$opaque THEN

type ← OpaqueValue[LOOPHOLE[type,CSEIndex],stb];

replace type with its set representative

FOR i: CARDINAL IN [0..stateLength) DO

IF state[i].type = type THEN {type ← state[i].current; EXIT};

ENDLOOP;

check to see if type is recursive

IF (e ← Find[type]) # NIL THEN {

IF e.name='\000 THEN e.name←NewName[];

AppendCode[name]; Append[e.name]; RETURN};

general cases

Push[type];

SELECT (class ← TypeClass[type]) FROM

$definition => ERROR;

$enumerated => {

SELECT LOOPHOLE[TypeContext[type],CARDINAL] FROM

4 => AppendCode[boolean];

ENDCASE => {AppendCode[paint]; AppendPaint[GetPaint[type]]}};

$record => {

SELECT LOOPHOLE[TypeContext[type],CARDINAL] FROM

6 => AppendCode[text];

8 => AppendCode[stringBody];

10 => AppendCode[condition];

12 => AppendCode[lock];

ENDCASE => {AppendCode[paint]; AppendPaint[GetPaint[type]]}};

$structure => {

ctx: CTXIndex = TypeContext[type];

WITH c~~stb.ctxb[ctx] SELECT FROM

included => IF ~c.complete THEN ERROR;

ENDCASE;

AppendCode[leftParen];

FOR iSei: ISEIndex ← stb.FirstCtxSe[ctx], stb.NextSe[iSei] WHILE iSei#ISENull DO

AppendField[iSei] ENDLOOP;

AppendCode[rightParen]};

$union => {AppendCode[union]; AppendPaint[GetPaint[type]]};

$array => {

IF Packed[type] THEN AppendCode[packed];

AppendCode[array];

AppendTypeString[Domain[type]];

AppendTypeString[Range[type]]};

$sequence => {

IF Packed[type] THEN AppendCode[packed];

AppendCode[sequence];

AppendField[Tag[type]];

AppendTypeString[Range[type]]};

$subrange => { -- 10 bytes

AppendCode[subrange];

AppendTypeString[Ground[type]];

AppendLongCardinal[First[type]];

AppendLongCardinal[Last[type]]};

$opaque => {

csei: CSEIndex = LOOPHOLE[type];

WITH t~~stb.seb[csei] SELECT FROM

opaque =>

IF stb.seb[t.id].idCtx IN StandardContext THEN AppendCode[atomRec]

ELSE {AppendCode[opaque]; AppendPaint[GetPaint[type]]};

ENDCASE => ERROR};

$countedZone, $uncountedZone => {

IF Mds[type] THEN AppendCode[mds];

AppendCode[class]};

$list => { -- list = REF RECORD[cdr]

IF Ordered[type] THEN AppendCode[ordered];

IF ReadOnly[type] THEN AppendCode[readOnly];

AppendCode[list];

AppendTypeString[Cdr[type]]};

$relativeRef => {

AppendCode[relativeRef];

AppendTypeString[Base[type]];

AppendTypeString[Range[type]]};

$ref => {

IF ReadOnly[type] THEN AppendCode[readOnly];

IF TypeClass[Range[type]] = $any THEN AppendCode[refAny]

ELSE {AppendCode[ref]; AppendTypeString[Range[type]]}};

$var => {

IF ReadOnly[type] THEN AppendCode[readOnly];

AppendCode[var]; AppendTypeString[Range[type]]};

$pointer, $longPointer => {

IF Ordered[type] THEN AppendCode[ordered];

IF ReadOnly[type] THEN AppendCode[readOnly];

AppendCode[class]; AppendTypeString[Range[type]]};

$descriptor, $longDescriptor => {

IF ReadOnly[type] THEN AppendCode[readOnly];

AppendCode[class]; AppendTypeString[Range[type]]};

$procedure, $safeProc => {

AppendCode[class];

AppendTypeString[Domain[type]];

AppendTypeString[Range[type]]};

$port, $program, $signal, $error => {

IF Safe[type] THEN AppendCode[safe];

AppendCode[class];

AppendTypeString[Domain[type]];

AppendTypeString[Range[type]]};

$process => {

IF Safe[type] THEN AppendCode[safe];

AppendCode[process]; AppendTypeString[Range[type]]};

$nil => {AppendCode[leftParen]; AppendCode[rightParen]};

$cardinal, $integer, $character, $longInteger, $longCardinal, $real,

$type, $any, $unspecified, $longUnspecified =>

AppendCode[class];

$globalFrame, $localFrame => ERROR;

ENDCASE => ERROR;

Pop[]};

OpaqueValue: PROC[type: CSEIndex, base: SymbolTable.Base] RETURNS[val: Type] = {

OPEN b1~~stb;

val ← type;

WITH t1~~b1.seb[type] SELECT FROM

opaque => {

mdi1:MDIndex = (WITH c1~~b1.ctxb[b1.seb[t1.id].idCtx] SELECT FROM

included => c1.module,

imported => b1.ctxb[c1.includeLink].module,

ENDCASE => OwnMdi);

mdi2: MDIndex = base.FindMdi[b1.mdb[mdi1].stamp];

IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {

sei2: ISEIndex;

ss: ConvertUnsafe.SubString = b1.SubStringForName[b1.seb[t1.id].hash];

sei2 ← base.SearchContext[base.FindString[ss], base.mainCtx];

IF sei2#ISENull AND base.seb[sei2].idType=typeTYPE

AND base.seb[sei2].public THEN val ← base.UnderType[sei2]}};

ENDCASE};

lastName: CHAR;

NewName: PROC RETURNS[CHAR] = {RETURN[lastName ← lastName+1]};

*******************************************************************

canonicalization

*******************************************************************

Canonicalize: PROC [type:Type] = {

build an equivalence table for the type

stateLength ← 0;

state ← zone.NEW[StateTable];

AddState[type]; -- gets them all recursively

minimize the table

UNTIL ~Split[] DO NULL ENDLOOP;

generate a new string

ts.length ← 0;

AppendTypeString[type]; -- will make use of the equivalences

[] ← InsertDefinitions[];

zone.FREE[@state]};

Split: PROC RETURNS [split: BOOL←FALSE]= {

iterate over all k-equivalent classes,

splitting them into k+1-equivalent classes

FOR i: CARDINAL IN [0..stateLength) DO

check to see if we have done this class already

found: BOOL ← FALSE;

FOR j: CARDINAL IN [0..i) DO

IF state[i].current=state[j].current THEN found ← TRUE;

ENDLOOP;

IF found THEN LOOP;

if not, process the class

list ← zone.NEW[ListVector];

list[0] ← state[i].type; listLength ← 1;

state[i].next ← state[i].type;

FOR j: CARDINAL IN (i..stateLength) DO

IF state[j].current#state[i].current THEN LOOP; -- not in the class

found ← FALSE;

FOR k: CARDINAL IN [0..listLength) DO

IF kEQ[state[j].type,list[k]] THEN {

state[j].next ← list[k]; found ← TRUE; EXIT};

ENDLOOP;

IF found THEN LOOP;

a new class is born

state[j].next ← state[j].type;

IF listLength >= maxStateLength THEN ERROR;

list[listLength]←state[j].type;

listLength ← listLength + 1;

split ← TRUE;

ENDLOOP;

zone.FREE[@list];

ENDLOOP;

FOR i: CARDINAL IN [0..stateLength) DO

state[i].current ← state[i].next;

ENDLOOP};

AddState: PROC[type:Type] = {

class: Code;

strip off unnecessary definitions

type ← UnderStar[type];

ground: Type ← type;

WHILE TypeClass[ground]=$definition DO

type ← ground;

ground ← stb.UnderType[type];

ENDLOOP;

type ← ground;

FOR i: CARDINAL IN [0..stateLength) DO

IF state[i].type = type THEN RETURN;

ENDLOOP;

IF stateLength >= maxStateLength THEN ERROR;

state[stateLength] ← [type,nullType,nullType];

stateLength ← stateLength + 1;

class ← TypeClass[type];

SELECT class FROM

$definition => ERROR;

$record, $enumerated => NULL;

$structure =>

FOR iSei: ISEIndex ← stb.FirstCtxSe[TypeContext[type]], stb.NextSe[iSei]

WHILE iSei#ISENull DO

AddState[stb.seb[iSei].idType];

ENDLOOP;

$union => NULL;

$array => {AddState[Domain[type]]; AddState[Range[type]]};

$sequence => {AddState[stb.seb[Tag[type]].idType]; AddState[Range[type]]};

$subrange => AddState[Ground[type]];

$opaque => NULL;

$countedZone, $uncountedZone => NULL;

$list => AddState[Cdr[type]];

$relativeRef => {AddState[Base[type]]; AddState[Range[type]]};

$ref => AddState[Range[type]];

$var => AddState[Range[type]];

$pointer, $longPointer, $descriptor, $longDescriptor => AddState[Range[type]];

$procedure, $safeProc, $port, $program, $signal, $error => {

AddState[Domain[type]]; AddState[Range[type]]};

$process => AddState[Range[type]];

$nil => NULL;

$globalFrame, $localFrame => ERROR;

$cardinal, $integer, $character, $longInteger, $longCardinal, $real,

$type, $any, $unspecified, $longUnspecified => NULL;

ENDCASE => ERROR};

kEQ: PROC[t1, t2: Type] RETURNS[BOOL] = {

class1: Code = TypeClass[t1];

class2: Code = TypeClass[t2];

IF class1#class2 THEN RETURN[FALSE];

SELECT class1 FROM

$definition => ERROR;

$record, enumerated, union => RETURN[t1=t2];

$structure => {

iSei1: ISEIndex ← stb.FirstCtxSe[TypeContext[t1]];

iSei2: ISEIndex ← stb.FirstCtxSe[TypeContext[t2]];

IF iSei1=ISENull OR iSei2=ISENull THEN RETURN[iSei1=iSei2];

IF stb.NameForSe[iSei1] # stb.NameForSe[iSei2] THEN RETURN[FALSE];

IF Current[stb.seb[iSei1].idType]#Current[stb.seb[iSei2].idType] THEN RETURN[FALSE];

iSei1 ← stb.NextSe[iSei1];

iSei2 ← stb.NextSe[iSei2];

ENDLOOP};

$array =>

RETURN[Current[Domain[t1]]=Current[Domain[t2]]

AND Current[Range[t1]]=Current[Range[t2]]];

$sequence => {

iSei1: ISEIndex = Tag[t1];

iSei2: ISEIndex = Tag[t2];

RETURN[stb.NameForSe[iSei1] = stb.NameForSe[iSei2]

AND Current[stb.seb[iSei1].idType]=Current[stb.seb[iSei2].idType]

AND Current[Range[t1]]=Current[Range[t2]]]};

$subrange => RETURN[Current[Ground[t1]]=Current[Ground[t2]] AND First[t1] = First[t2] AND Last[t1] = Last[t2]];

$opaque => RETURN[t1=t2];

$countedZone, uncountedZone => RETURN[t1=t2];

$list => RETURN[Current[Cdr[t1]]=Current[Cdr[t2]]];

$relativeRef =>

RETURN[Current[Base[t1]]=Current[Base[t2]]

AND Current[Range[t1]]=Current[Range[t2]]];

$ref => RETURN[Current[Range[t1]]=Current[Range[t2]]];

$var => RETURN[Current[Range[t1]]=Current[Range[t2]]];

$pointer, $longPointer, $descriptor, $longDescriptor =>

RETURN[Current[Range[t1]]=Current[Range[t2]]];

$procedure, $safeProc, $port, $program, $signal, $error => {

RETURN[Current[Domain[t1]]=Current[Domain[t2]]

AND Current[Range[t1]]=Current[Range[t2]]]};

$process => RETURN[Current[Range[t1]]=Current[Range[t2]]];

$nil => RETURN[t1=t2];

$globalFrame, $localFrame => ERROR;

$cardinal, $integer, $character, $longInteger, $longCardinal, $real,

$type, $any, $unspecified, $longUnspecified =>

RETURN[t1=t2];

ENDCASE => ERROR};

Current: PROC[type:Type] RETURNS[Type] = {

type ← UnderStar[type];

FOR i: CARDINAL IN [0..stateLength) DO

IF state[i].type=type THEN RETURN[state[i].current];

ENDLOOP;

ERROR};

StateTable: TYPE = ARRAY [0..maxStateLength) OF RECORD[type, current, next: Type];

state: LONG POINTER TO StateTable ← NIL;

stateLength: CARDINAL;

maxStateLength: CARDINAL = 100;

ListVector: TYPE = ARRAY [0..maxStateLength) OF Type;

list: LONG POINTER TO ListVector ← NIL;

listLength: CARDINAL;

*******************************************************************

stack management

*******************************************************************

StackElementRecord: TYPE = RECORD[name: CHAR, type: Type, index: CARDINAL];

StackElement: TYPE = LONG POINTER TO StackElementRecord;

StackVector: TYPE = ARRAY [0..stackLength) OF StackElementRecord;

stack: LONG POINTER TO StackVector ← NIL;

stackLength: CARDINAL = 100;

stackIndex: CARDINAL ← 0;

DefsVector: TYPE = ARRAY [0..defsLength) OF StackElementRecord;

defs: LONG POINTER TO DefsVector ← NIL;

defsLength: CARDINAL = 30;

defsIndex: CARDINAL ← 0;

Push: PROC[type:Type] = {

IF stackIndex=stackLength THEN ERROR;

stack[stackIndex] ← ['\000,type,ts.length];

stackIndex ← stackIndex + 1};

Pop: PROC = {

IF stackIndex=0 THEN ERROR;

stackIndex ← stackIndex - 1;

IF stack[stackIndex].name='\000 THEN RETURN;

IF defsIndex=defsLength THEN ERROR;

defs[defsIndex] ← stack[stackIndex];

defsIndex ← defsIndex+1};

Find: PROC [type:Type] RETURNS[StackElement←NIL] = {

FOR i:CARDINAL IN [0..stackIndex) DO

IF stack[i].type=type THEN RETURN[@stack[i]];

ENDLOOP};

InsertDefinitions: PROC RETURNS[recursive: BOOL ← FALSE] = {

WHILE TRUE DO

index, j: CARDINAL ← 0;

found: BOOL ← FALSE;

FOR i: CARDINAL IN [0..defsIndex) DO

IF defs[i].name='\000 THEN LOOP;

IF defs[i].index<index THEN LOOP;

index ← defs[i].index; j ← i;

found ← recursive ← TRUE;

ENDLOOP;

IF ~found THEN EXIT;

IF ts.length+2 > ts.maxlength THEN ts ← Adjust[ts,ts.length+4];

ts.length ← ts.length + 2;

FOR i: CARDINAL DECREASING IN [index+2..ts.length) DO ts[i] ← ts[i-2] ENDLOOP;

LOOPHOLE[ts[index],Code] ← $definition;

ts[index+1] ← defs[j].name;

defs[j].name ← '\000;

ENDLOOP;

lastName ← '\000;

defsIndex ← 0};

*******************************************************************

hash table management

*******************************************************************

Entry:TYPE = LONG POINTER TO EntryRec;

EntryRec:TYPE = RECORD [type:Type,

recursive:BOOL,

string:TypeString];

nullEntry:EntryRec = [nullType, FALSE, NIL];

array: ARRAY [0..arrayLength) OF EntryRec;

arrayLength:CARDINAL = 47;

FlushCache: PROC = {array ← ALL[nullEntry]};

cache: PROC [sei:Type] RETURNS[Entry] ={

p:CARDINAL ← LOOPHOLE[sei,CARDINAL] MOD arrayLength;

FOR i:CARDINAL IN [p..arrayLength) DO

IF array[i].type=nullType THEN RETURN[@array[i]];

IF array[i].type=sei THEN RETURN[@array[i]];

ENDLOOP;

FOR i:CARDINAL IN [0..p) DO

IF array[i].type=nullType THEN RETURN[@array[i]];

IF array[i].type=sei THEN RETURN[@array[i]];

ENDLOOP;

ERROR}; ++ too many types!!!

*******************************************************************

procedures that work with the symbol table

*******************************************************************

TypeContext: PROC[type: Type] RETURNS[CTXIndex] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

enumerated => t.valueCtx,

record => t.fieldCtx,

definition => t.defCtx,

union => t.caseCtx,

ENDCASE => ERROR]};

Cdr: PROC[type: Type] RETURNS[Type] = {

ctx: CTXIndex = TypeContext[Range[type]];

iSei: ISEIndex ← stb.FirstCtxSe[ctx];

WITH c~~stb.ctxb[ctx] SELECT FROM

included => IF ~c.complete THEN ERROR;

ENDCASE;

RETURN [stb.seb[iSei].idType]};

Base: PROC[type: Type] RETURNS[Type] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

relative => t.baseType,

ENDCASE => ERROR]};

Range: PROC[type: Type] RETURNS[Type] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

array => t.componentType,

sequence => t.componentType,

transfer => t.typeOut,

ref => t.refType,

relative => t.offsetType,

arraydesc => t.describedType,

long => Range[t.rangeType],

ENDCASE => ERROR]};

Domain: PROC[type: Type] RETURNS[Type] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

array => t.indexType,

sequence => stb.seb[t.tagSei].idType,

union => stb.seb[t.tagSei].idType,

transfer => t.typeIn,

ENDCASE => ERROR]};

Tag: PROC[type: Type] RETURNS[ISEIndex] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

sequence => t.tagSei,

union => t.tagSei,

ENDCASE => ERROR]};

First: PROC[type: Type] RETURNS[LONG CARDINAL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [SELECT TypeClass[csei] FROM

$enumerated => 0,

$subrange =>

(WITH t~~stb.seb[csei] SELECT FROM

subrange => t.origin.LONG,

ENDCASE => ERROR),

$cardinal => CARDINAL.FIRST,

$integer => LONG[LOOPHOLE[INTEGER.FIRST, CARDINAL]],

$character => LONG[LOOPHOLE[CHAR.FIRST, CARDINAL]],

$longInteger => LOOPHOLE[FIRST[LONG INTEGER]],

$longCardinal => FIRST[LONG CARDINAL],

ENDCASE => ERROR]};

Last: PROC[type: Type] RETURNS[LONG CARDINAL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [SELECT TypeClass[csei] FROM

$enumerated =>

(WITH t~~stb.seb[csei] SELECT FROM

enumerated => LOOPHOLE[(t.nValues - 1).LONG],

ENDCASE => ERROR),

$subrange =>

(WITH t~~stb.seb[csei] SELECT FROM

subrange => LOOPHOLE[(t.origin + t.range).LONG],

ENDCASE => ERROR),

$cardinal => CARDINAL.LAST,

$integer => LONG[LOOPHOLE[INTEGER.LAST, CARDINAL]],

$character => LONG[LOOPHOLE[CHAR.LAST, CARDINAL]],

$longInteger => LOOPHOLE[LAST[LONG INTEGER]],

$longCardinal => LAST[LONG CARDINAL],

ENDCASE => ERROR]};

Safe: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

transfer => t.safe,

ENDCASE => ERROR]};

ReadOnly: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

long => ReadOnly[t.rangeType],

ref => t.readOnly,

arraydesc => t.readOnly,

ENDCASE => ERROR]};

Ordered: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

long => Ordered[t.rangeType],

ref => t.ordered,

ENDCASE => ERROR]};

Packed: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

array => t.packed,

sequence => t.packed,

ENDCASE => ERROR]};

Mds: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

zone => t.mds,

ENDCASE => ERROR]};

Ground: PROC[type: Type] RETURNS[Type] = {

RETURN [WITH se~~stb.seb[type] SELECT FROM

id => se.idInfo, -- a definition

cons =>

WITH t~~se SELECT FROM

subrange => t.rangeType,

ENDCASE => ERROR, -- NOTE relativeRef not yet

ENDCASE => ERROR]};

UnderStar: PROC[type: Type] RETURNS[Type] = {

WHILE TypeClass[type]=$definition DO

type ← stb.UnderType[type];

ENDLOOP;

RETURN[type]};

TypeClass: PROC[sei: Type] RETURNS[ans: Code] = {

csei: CSEIndex;

IF type = fhType THEN RETURN[localFrame];

IF type = nullType THEN RETURN[nil];

IF type = gfhType THEN RETURN[globalFrame];

IF type = unspecType THEN RETURN[unspecified];

IF sei=nullType THEN RETURN[$nil];

IF stb.seb[sei].seTag = id THEN RETURN[$definition];

csei ← stb.UnderType[sei];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

basic => SelectBasicClass[t.code],

record => (IF t.painted THEN $record ELSE $structure),

definition => $record,

real => $real,

union => $union,

array => $array,

opaque => $opaque,

sequence => $sequence,

ref => (IF t.counted THEN ERROR ELSE $pointer),

arraydesc => $descriptor,

long => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM

ref => (SELECT TRUE FROM

rt.var => $var,

rt.counted => IF rt.list THEN $list ELSE $ref,

ENDCASE => $longPointer),

basic => (SELECT rt.code FROM

codeINT => $longInteger,

codeANY => $longUnspecified

ENDCASE => ERROR),

arraydesc => $longDescriptor,

ENDCASE => IF IsCardinal[t.rangeType] THEN $longCardinal ELSE ERROR),

relative => $relativeRef,

enumerated => $enumerated,

subrange => IF IsCardinal[csei] THEN $cardinal ELSE $subrange,

transfer => (SELECT t.mode FROM

$proc => IF t.safe THEN $safeProc ELSE $procedure,

$port => $port,

$signal => $signal,

$error => $error,

$process => $process,

$program => $program,

ENDCASE => ERROR),

zone => (IF t.counted THEN $countedZone ELSE $uncountedZone),

mode => $type,

any => $any,

ENDCASE => ERROR]};

SelectBasicClass: PROC[code: [0..16)] RETURNS[Code] = INLINE {

RETURN [SELECT code FROM

codeINT => $integer,

codeANY => $unspecified,

codeCHAR => $character,

ENDCASE => ERROR]};

IsCardinal: PROC[type: Type] RETURNS[BOOL] = {

csei: CSEIndex = stb.UnderType[type];

RETURN [WITH t~~stb.seb[csei] SELECT FROM

subrange => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM

basic => (rt.code = codeINT AND t.origin = 0 AND t.range = CARDINAL.LAST),

ENDCASE => FALSE),

ENDCASE => FALSE]};