-- 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 16-Apr-82 9:43:31 By Paul Rovner
DIRECTORY
Inline: TYPE USING [HighHalf, LowHalf],
Strings: TYPE USING [SubStringDescriptor, AppendChar],
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 Inline, Strings
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←cache[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
Strings.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;
Strings.AppendChar[ts, c]};
AppendCode: PROC[code: Code] = LOOPHOLE[Append];
AppendCardinal: PROC[c: CARDINAL] = INLINE {
Append[VAL[c/256]]; Append[VAL[c MOD 256]]};
AppendLongCardinal: PROC [lc: LONG CARDINAL] = {
AppendCardinal[Inline.HighHalf[lc]];
AppendCardinal[Inline.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[VAL[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 {
ss: Strings.SubStringDescriptor;
sei2: ISEIndex;
b1.SubStringForName[@ss,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]];
DO
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]]];
$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 => CHAR.FIRST.ORD,
$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 => CHAR.LAST.ORD,
$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]};
}.