TypeStringsImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Satterthwaite, May 6, 1983 1:11 pm
Maxwell, 19-Feb-82 11:33:15 (NOTE: we need better error reporting)
Paul Rovner, July 6, 1983 1:57 pm
Levin, August 8, 1983 4:09 pm
Russ Atkinson, October 23, 1984 3:40:07 pm PDT
DIRECTORY
Basics USING [HighHalf, LowHalf],
ConvertUnsafe USING [SubString],
PrincOpsUtils USING [LongCopy],
Symbols
USING [
codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex, ISEIndex, ISENull, MDIndex, MDNull, Name, nullName, nullType, OwnMdi, StandardContext, Type, TypeClass, typeTYPE],
SymbolTable USING [Base],
TypeStrings USING [Code, TypeString];
TypeStringsImpl:
PROGRAM
IMPORTS Basics, PrincOpsUtils
EXPORTS TypeStrings = {
OPEN Symbols, TypeStrings;
*******************************************************************
basic algorithm
*******************************************************************
stb: SymbolTable.Base ← NIL;
zone: UNCOUNTED ZONE ← NIL;
ts: TypeString ← NIL;
stackQuick: INT ← 0;
defsQuick: INT ← 0;
stateQuick: INT ← 0;
listQuick: INT ← 0;
createCalls: INT ← 0;
Create:
PUBLIC
PROC
[base: SymbolTable.Base, sei: Type, z: UNCOUNTED ZONE] RETURNS[TypeString] = {
IF base=NIL THEN RETURN[NIL];
stb ← base;
zone ← z;
ts ← zone.NEW[StringBody[32]];
Allocate the various state holders if they have not been already allocated.
createCalls ← createCalls + 1;
IF stack =
NIL
THEN stack ← zone.NEW[StackVector[4]]
ELSE stackQuick ← stackQuick + 1;
IF defs =
NIL
THEN defs ← zone.NEW[DefsVector[4]]
ELSE defsQuick ← defsQuick + 1;
IF state =
NIL
THEN state ← zone.NEW[StateTable[4]]
ELSE stateQuick ← stateQuick + 1;
IF list =
NIL
THEN list ← zone.NEW[ListVector[4]]
ELSE listQuick ← listQuick + 1;
stack.index ← defs.index ← state.index ← list.index ← 0;
lastName ← '\000;
AppendTypeString[sei];
IF InsertDefinitions[] THEN Canonicalize[sei];
Free the various holders if they have grown a lot. We try to hold on to little ones to reduce the cost for quick type string construction in the (hopefully common) small cases.
IF defs.len > 16 THEN {zone.FREE[@defs]; defs ← NIL};
IF stack.len > 16 THEN {zone.FREE[@stack]; stack ← NIL};
IF state.max > 16 THEN {zone.FREE[@state]; state ← NIL};
IF list.max > 16 THEN {zone.FREE[@list]; list ← NIL};
IF ts.length + 4 > ts.maxlength THEN ts ← Retract[ts];
RETURN[ts];
};
Expand:
PROC[s: TypeString]
RETURNS[new: TypeString] = {
n: NAT ← s.length + (s.length + 4) / 2;
new ← zone.NEW[StringBody[n]];
PrincOpsUtils.LongCopy[
from: LOOPHOLE[s, LONG POINTER] + SIZE[StringBody[0]],
nwords: SIZE[StringBody[s.length]] - SIZE[StringBody[0]],
to: LOOPHOLE[new, LONG POINTER] + SIZE[StringBody[0]]];
new.length ← s.length;
zone.FREE[@s];
RETURN[new];
};
Retract:
PROC[s: TypeString]
RETURNS[new: TypeString] = {
new ← zone.NEW[StringBody[s.length]];
PrincOpsUtils.LongCopy[
from: LOOPHOLE[s, LONG POINTER] + SIZE[StringBody[0]],
nwords: SIZE[StringBody[s.length]] - SIZE[StringBody[0]],
to: LOOPHOLE[new, LONG POINTER] + SIZE[StringBody[0]]];
new.length ← s.length;
zone.FREE[@s];
RETURN[new];
};
Append:
PROC[c:
CHAR] = {
IF ts.length = ts.maxlength THEN ts ← Expand[ts];
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};
AppendPaint:
PROC[type: Type] = {
form: Symbols.TypeClass = stb.TypeForm[type];
SELECT form
FROM
$enumerated, $definition, $record, $union, $opaque => {
version: ARRAY [0..3) OF CARDINAL;
ctx: CTXIndex ← TypeContext[type];
index: CARDINAL;
mdi: MDIndex;
WITH c~~stb.ctxb[ctx]
SELECT
FROM
simple => mdi ← OwnMdi;
included => {mdi ← c.module; ctx ← c.map};
ENDCASE => ERROR;
index ← LOOPHOLE[ctx];
IF form = $opaque
THEN {
RRA: Opaque types do not really have their own contexts, so we can't just rely on the context index within the BCD. Therefore we make the index a hash code instead of a context, where the hash code is dependent on the context and the name used (all opaque types have names, don't they?). We could do better than this, but only by changing the format of type strings, which we would rather not do.
WITH t: stb.seb[stb.UnderType[type]]
SELECT
FROM
opaque => index ← HashInName[index, stb.NameForSe[t.id]];
ENDCASE => ERROR;
};
version ←
(IF ctx IN StandardContext THEN ALL[0] ELSE LOOPHOLE[stb.mdb[mdi].stamp]);
AppendCardinal[version[0]];
AppendCardinal[version[1]];
AppendCardinal[version[2]];
AppendCardinal[index];
};
ENDCASE => ERROR;
};
HashInName:
PROC[hash:
CARDINAL, name: Name]
RETURNS [
CARDINAL] = {
Given an initial hash, scramble the hash to make it dependent on the given name. This only scrambles 16 bits, so it should only be used to scramble things that are already nearly disambiguated.
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
hash ← hash + length; -- make the hash dependent on the length
FOR i:
CARDINAL
IN [offset..offset+length)
DO
Hash in a new character. First, rotate the hash left one bit. Then add in the character code. This should make the hash dependent on the character code and the position of character within the string.
hash ← hash + hash + (hash / 100000B);
hash ← hash + (stb.ssb[i] - 0C);
ENDLOOP;
RETURN [hash];
};
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..state.index)
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[type]}};
$record => {
SELECT
LOOPHOLE[TypeContext[type],
CARDINAL]
FROM
6 => AppendCode[text];
8 => AppendCode[stringBody];
10 => AppendCode[condition];
12 => AppendCode[lock];
ENDCASE => {AppendCode[paint]; AppendPaint[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[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[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
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[];
};
Split:
PROC
RETURNS [split:
BOOL←
FALSE]= {
iterate over all k-equivalent classes,
splitting them into k+1-equivalent classes
FOR i:
CARDINAL
IN [0..state.index)
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[0] ← state[i].type;
list.index ← 1;
state[i].next ← state[i].type;
FOR j:
CARDINAL
IN (i..state.index)
DO
IF state[j].current#state[i].current THEN LOOP; -- not in the class
found ← FALSE;
FOR k:
CARDINAL
IN [0..list.index)
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 list.index = list.max
THEN {
nLen: NAT ← list.index + (list.index + 4) / 2;
new: LONG POINTER TO ListVector ← zone.NEW[ListVector[nLen]];
PrincOpsUtils.LongCopy[
from: @list[0],
nwords: SIZE[ListVector[list.index]] - SIZE[ListVector[0]],
to: @new[0]];
new.index ← list.index;
zone.FREE[@list];
list ← new;
};
IF list.index >= list.max THEN ERROR;
list[list.index]←state[j].type;
list.index ← list.index + 1;
split ← TRUE;
ENDLOOP;
ENDLOOP;
FOR i:
CARDINAL
IN [0..state.index)
DO
state[i].current ← state[i].next;
ENDLOOP};
AddState:
PROC[type:Type] = {
class: Code;
type ← UnderStar[type];
FOR i:
CARDINAL
IN [0..state.index)
DO
IF state[i].type = type THEN RETURN;
ENDLOOP;
IF state.index = state.max
THEN {
nLen: NAT ← state.index + (state.index + 4) / 2;
new: LONG POINTER TO StateTable ← zone.NEW[StateTable[nLen]];
PrincOpsUtils.LongCopy[
from: @state[0],
nwords: SIZE[StateTable[state.index]] - SIZE[StateTable[0]],
to: @new[0]];
new.index ← state.index;
zone.FREE[@state];
state ← new;
};
IF state.index >= state.max THEN ERROR;
state[state.index] ← [type,nullType,nullType];
state.index ← state.index + 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]] 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..state.index)
DO
IF state[i].type=type THEN RETURN[state[i].current];
ENDLOOP;
ERROR};
StateTable:
TYPE =
RECORD [
index: CARDINAL,
elems: SEQUENCE max: CARDINAL OF RECORD[type, current, next: Type]];
state: LONG POINTER TO StateTable ← NIL;
ListVector:
TYPE =
RECORD [
index: CARDINAL,
elems: SEQUENCE max: CARDINAL OF Type];
list: LONG POINTER TO ListVector ← NIL;
*******************************************************************
stack management
*******************************************************************
StackElementRecord: TYPE = RECORD[name: CHAR, type: Type, index: CARDINAL];
StackElement: TYPE = LONG POINTER TO StackElementRecord;
StackVector:
TYPE =
RECORD [
index: CARDINAL,
elems: SEQUENCE len: CARDINAL OF StackElementRecord];
stack: LONG POINTER TO StackVector ← NIL;
DefsVector:
TYPE =
RECORD [
index: CARDINAL,
elems: SEQUENCE len: CARDINAL OF StackElementRecord];
defs: LONG POINTER TO DefsVector ← NIL;
Push:
PROC[type:Type] = {
IF stack.index = stack.len
THEN {
Grow the stack a little
nLen: NAT ← stack.index + (stack.index + 4) / 2;
new: LONG POINTER TO StackVector ← zone.NEW[StackVector[nLen]];
PrincOpsUtils.LongCopy[
from: @stack[0],
nwords: SIZE[StackVector[stack.index]] - SIZE[StackVector[0]],
to: @new[0]];
new.index ← stack.index;
zone.FREE[@stack];
stack ← new;
};
stack[stack.index] ← ['\000, type, ts.length];
stack.index ← stack.index + 1;
};
Pop:
PROC = {
IF stack.index=0 THEN ERROR;
stack.index ← stack.index - 1;
IF stack[stack.index].name='\000 THEN RETURN;
IF defs.index = defs.len
THEN {
Grow the defs a little to accomodate the new definition
nLen: NAT ← defs.index + (defs.index+4) / 2;
new: LONG POINTER TO DefsVector ← zone.NEW[DefsVector[nLen]];
PrincOpsUtils.LongCopy[
from: @defs[0],
nwords: SIZE[DefsVector[defs.index]] - SIZE[DefsVector[0]],
to: @new[0]];
new.index ← defs.index;
zone.FREE[@defs];
defs ← new;
};
defs[defs.index] ← stack[stack.index];
defs.index ← defs.index+1;
};
Find:
PROC [type:Type]
RETURNS[StackElement←
NIL] = {
FOR i:
CARDINAL
IN [0..stack.index)
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..defs.index)
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 ← Expand[ts];
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;
defs.index ← 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];
WITH t: stb.seb[csei]
SELECT
FROM
enumerated => RETURN [t.valueCtx];
record => RETURN [t.fieldCtx];
definition => RETURN [t.defCtx];
union => RETURN [t.caseCtx];
opaque => RETURN [stb.seb[t.id].idCtx];
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]};
}.