
DIRECTORY
Basics USING [LongNumber],
ConvertUnsafe USING [SubString],
MobDefs USING [NullVersion, VersionStamp],
OSMiscOps USING [Copy],
SymbolOps USING [DecodeCard, FindMdi, FindString, FirstCtxSe, NameForSe, NextSe, SearchContext, STB, SubStringForName, TypeForm, UnderType],
Symbols USING [Base, codeANY, codeCHAR, CSEIndex, CSENull, CTXFirst, CTXIndex, CTXNull, CTXRecord, FirstStandardCtx, HTRecord, IncludedCTXIndex, IncludedCTXNull, ISEIndex, ISENull, LastStandardCtx, MDIndex, MDNull, Name, nullName, nullType, OwnMdi, Type, TypeClass, typeTYPE],
SymbolTable USING [],
SymbolTablePrivate USING [SymbolTableBaseRep],
Target: TYPE MachineParms USING [bitsPerLongWord, bitsPerReal, bitsPerWord, maxWord, maxLongWord],
TypeStrings USING [Code, TypeString];
TypeStringsImpl: PROGRAM 
IMPORTS OSMiscOps, SymbolOps
EXPORTS TypeStrings, SymbolTable = {
OPEN Symbols, TypeStrings;

STB: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
stb: STB Ź 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: STB, sei: Type, z: UNCOUNTED ZONE] RETURNS [TypeString] = {
IF base = NIL THEN RETURN [NIL];
stb Ź base;
zone Ź z;
ts Ź zone.NEW[StringBody[32]];

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];

IF defs.len > 16 THEN zone.FREE[@defs];
IF stack.len > 16 THEN zone.FREE[@stack];
IF state.max > 16 THEN zone.FREE[@state];
IF list.max > 16 THEN zone.FREE[@list];
IF ts.length + 16 < ts.maxlength THEN {
old: TypeString Ź ts;
oldLen: CARDINAL Ź old.length;
ts Ź zone.NEW[StringBody[oldLen]];
OSMiscOps.Copy[
from: @old.text,
nwords: StringBody[oldLen].WORDS - StringBody[0].WORDS,
to: @ts.text];
ts.length Ź oldLen;
zone.FREE[@old];
};
RETURN [ts];
};

Expand: PROC [s: TypeString] RETURNS [new: TypeString] = {
n: NAT = s.length + (s.length + 4)/2;
new Ź zone.NEW[StringBody[n]];
OSMiscOps.Copy[
from: @s.text,
nwords: StringBody[s.length].WORDS - StringBody[0].WORDS,
to: @new.text];
new.length Ź s.length;
zone.FREE[@s];
};

Append: PROC [c: CHAR] = {  
len: NAT Ź ts.length;
IF len = ts.maxlength THEN {ts Ź Expand[ts]; len Ź ts.length};
IF ts = NIL OR len >= ts.maxlength THEN ERROR;
ts[len] Ź c;
ts.length Ź len + 1;
};

AppendByte: PROC [b: BYTE] = LOOPHOLE[Append];

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

AppendCard: PROC [c: CARD32] = {
encodeMod: NAT = 64;
ln: Basics.LongNumber = [card[c]];
SELECT c FROM
< encodeMod =>
AppendByte[ln.ll];
< encodeMod*256 => {
AppendByte[encodeMod*1+ln.lh];
AppendByte[ln.ll];
};
< encodeMod*LONG[256]*256 => {
AppendByte[encodeMod*2+ln.hl];
AppendByte[ln.lh];
AppendByte[ln.ll];
};
ENDCASE => {
prefix: NAT Ź encodeMod*3;
IF ln.int < 0 AND ln.int > - encodeMod THEN {
AppendByte[prefix-ln.int];
RETURN;
};
AppendByte[prefix];
AppendByte[ln.hh];
AppendByte[ln.hl];
AppendByte[ln.lh];
AppendByte[ln.ll];
};
};

AppendPaint: PROC [type: CSEIndex] = {
form: Symbols.TypeClass = SymbolOps.TypeForm[stb, type];
SELECT form FROM
$enumerated, $definition, $record, $union, $opaque => {
version: MobDefs.VersionStamp Ź MobDefs.NullVersion;
ctx: CTXIndex Ź TypeContext[type];
mdi: MDIndex;
WITH c~~stb.ctxb[ctx] SELECT FROM
simple => mdi Ź OwnMdi;
included => {mdi Ź c.module; ctx Ź c.map};
imported => {
link: Symbols.IncludedCTXIndex Ź c.includeLink;
IF link = Symbols.IncludedCTXNull THEN ERROR;
mdi Ź stb.ctxb[link].module;
ctx Ź stb.ctxb[link].map;
};
ENDCASE => ERROR;
IF ctx NOT IN [FirstStandardCtx..LastStandardCtx] THEN
version Ź LOOPHOLE[stb.mdb[mdi].stamp];
WITH t: stb.seb[type] SELECT FROM
opaque => {
AppendName[SymbolOps.NameForSe[stb, t.id]];
AppendCard[version[0]];
AppendCard[version[1]];
};
ENDCASE => {
index: CARD Ź CARD[ctx-CTXFirst];
index Ź index * BYTES[UNIT];
AppendCard[version[0]];
AppendCard[version[1]];
AppendCard[index];
};
};
ENDCASE => ERROR;
};

AppendName: PROC [name: Name] = {
IF name = nullName
THEN Append[VAL[0]]
ELSE {
offset: CARDINAL = stb.htb[name-HTRecord.SIZE].ssIndex <<+ 1>>;
length: CARDINAL = stb.htb[name].ssIndex - offset;
IF length >= 200b THEN ERROR;
Append[VAL[length]];
FOR i: CARDINAL IN [offset..offset+length) DO Append[stb.ssb[i]]; ENDLOOP;
};
};

AppendField: PROC [iSei: ISEIndex] = INLINE {
AppendName[SymbolOps.NameForSe[stb, iSei]];
AppendTypeString[stb.seb[iSei].idType];
};

AppendTypeString: PROC [type: Type] = {
csei: CSEIndex Ź SymbolOps.UnderType[stb, type];
class: Code;
e: StackElement;
IF SymbolOps.TypeForm[stb, csei]=$opaque THEN csei Ź OpaqueValue[csei, stb];
FOR i: CARDINAL IN [0..state.index) DO
IF state[i].type = csei THEN {csei Ź state[i].current; EXIT};
ENDLOOP;
IF (e Ź Find[csei]) # NIL THEN {
IF e.name='\000 THEN e.name Ź NewName[]; 
AppendCode[$name]; Append[e.name]; RETURN};
Push[csei];
SELECT (class Ź TypeClass[csei]) FROM
$definition => ERROR;
$enumerated => {
ctx: CTXIndex = TypeContext[csei];
IF (ctx-CTXNull) = CTXRecord.nil.SIZE + CTXRecord.simple.SIZE
THEN
AppendCode[$boolean]	-- This is the special common case for BOOLEAN
ELSE
WITH t: stb.seb[csei] SELECT FROM
enumerated => {
IF ~t.painted THEN {
AppendCode[$enumerated];
AppendCode[$leftParen];
FOR iSei: ISEIndex
Ź SymbolOps.FirstCtxSe[stb, ctx], SymbolOps.NextSe[stb, iSei]
UNTIL iSei = ISENull DO
AppendName[SymbolOps.NameForSe[stb, iSei]];
IF t.machineDep THEN
AppendCard[SymbolOps.DecodeCard[stb.seb[iSei].idValue]];
ENDLOOP;
AppendCode[$rightParen];
}
ELSE {
AppendCode[$paint];
AppendPaint[csei];
};
};
ENDCASE => ERROR;
};
$record => {
SELECT (TypeContext[csei]-CTXNull) FROM
CTXRecord.nil.SIZE + 2*CTXRecord.simple.SIZE => AppendCode[$text];
CTXRecord.nil.SIZE + 3*CTXRecord.simple.SIZE => AppendCode[$stringBody];
ENDCASE => {AppendCode[$paint]; AppendPaint[csei]};
};
$structure => {
ctx: CTXIndex = TypeContext[csei];
WITH c~~stb.ctxb[ctx] SELECT FROM
included => IF ~c.complete THEN ERROR;
ENDCASE;
AppendCode[$leftParen];
FOR iSei: ISEIndex Ź SymbolOps.FirstCtxSe[stb, ctx], SymbolOps.NextSe[stb, iSei]
WHILE iSei # ISENull DO
AppendField[iSei];
ENDLOOP;
AppendCode[$rightParen];
};
$union => {
AppendCode[$union];
AppendPaint[csei];
};
$array => {
IF Packed[csei] THEN AppendCode[$packed];
AppendCode[$array];  
AppendTypeString[Domain[csei]]; 
AppendTypeString[Range[csei]];
};
$sequence => {
IF Packed[csei] THEN AppendCode[$packed];
AppendCode[$sequence];  
AppendField[Tag[csei]]; 
AppendTypeString[Range[csei]];
};
$subrange => {
AppendCode[$subrange];
AppendTypeString[Ground[csei]];
AppendCard[First[csei]];
AppendCard[Last[csei]];
};
$opaque =>  {
WITH t~~stb.seb[csei] SELECT FROM
opaque =>
IF stb.seb[t.id].idCtx IN [FirstStandardCtx..LastStandardCtx]
THEN AppendCode[$atomRec]
ELSE {AppendCode[$opaque]; AppendPaint[csei]};
ENDCASE => ERROR;
};
$countedZone, $uncountedZone => {
IF Mds[csei] THEN AppendCode[$mds];
AppendCode[class];
};
$list => {
IF Ordered[csei] THEN AppendCode[$ordered];
IF ReadOnly[csei] THEN AppendCode[$readOnly];
AppendCode[$list];
AppendTypeString[ListArg[csei]];
};
$relativeRef => {
AppendCode[$relativeRef];
AppendTypeString[Base[csei]];
AppendTypeString[Range[csei]];
};
$ref => {
IF ReadOnly[csei] THEN AppendCode[$readOnly];
IF TypeClass[Range[csei]] = $any
THEN AppendCode[$refAny]
ELSE {AppendCode[$ref]; AppendTypeString[Range[csei]]};
};
$var => {
IF ReadOnly[csei] THEN AppendCode[$readOnly];
AppendCode[$var];
AppendTypeString[Range[csei]];
};
$pointer, $longPointer => { 
IF Ordered[csei] THEN AppendCode[$ordered];
IF ReadOnly[csei] THEN AppendCode[$readOnly];
AppendCode[class];
AppendTypeString[Range[csei]];
}; 
$descriptor, $longDescriptor => {
IF ReadOnly[csei] THEN AppendCode[$readOnly];
AppendCode[class];
AppendTypeString[Range[csei]];
};
$procedure, $safeProc => {
AppendCode[class];
AppendTypeString[Domain[csei]];
AppendTypeString[Range[csei]];
};
$port, $program, $signal, $error => {
IF Safe[csei] THEN AppendCode[$safe];
AppendCode[class];
AppendTypeString[Domain[csei]];
AppendTypeString[Range[csei]];
};
$process => {
IF Safe[csei] THEN AppendCode[$safe];
AppendCode[process];
AppendTypeString[Range[csei]];
};
$nil => {
AppendCode[$leftParen];
AppendCode[$rightParen];
};
$cardinal, $integer, $character, $longInteger, $longCardinal, $real, $type, $any, $unspecified, $longUnspecified, $dcard, $dint, $dreal =>
AppendCode[class];
$globalFrame, $localFrame => ERROR;
ENDCASE => ERROR;
Pop[];
};

OpaqueValue: PROC [type: CSEIndex, base: STB] RETURNS [val: CSEIndex] = {
val Ź type;
WITH t1~~stb.seb[type] SELECT FROM
opaque => {
mdi1: MDIndex = (WITH c1~~stb.ctxb[stb.seb[t1.id].idCtx] SELECT FROM
included => c1.module,
imported => stb.ctxb[c1.includeLink].module,
ENDCASE => OwnMdi);
mdi2: MDIndex = SymbolOps.FindMdi[base, stb.mdb[mdi1].stamp];
IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
sei2: ISEIndex;
ss: ConvertUnsafe.SubString = SymbolOps.SubStringForName[stb, stb.seb[t1.id].hash];
sei2 Ź SymbolOps.SearchContext[base, SymbolOps.FindString[base, ss], base.mainCtx];
IF sei2#ISENull AND base.seb[sei2].idType=typeTYPE 
AND base.seb[sei2].public THEN val Ź SymbolOps.UnderType[base, sei2]}};
ENDCASE;
};

lastName: CHAR;

NewName: PROC RETURNS [CHAR] = INLINE {RETURN [lastName Ź lastName.SUCC]};
Canonicalize: PROC [type: Type] = {
AddState[type]; -- gets them all recursively
UNTIL ~Split[] DO NULL ENDLOOP;
ts.length Ź 0;
AppendTypeString[type];  -- will make use of the equivalences
[] Ź InsertDefinitions[];
};

Split: PROC RETURNS [split: BOOLŹFALSE]= {
FOR i: CARDINAL IN [0..state.index) DO
found: BOOL Ź FALSE;
FOR j: CARDINAL IN [0..i) DO 
IF state[i].current=state[j].current THEN found Ź TRUE;
ENDLOOP;
IF ~found THEN {
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 {  -- 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 {  
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]];
OSMiscOps.Copy[
from: @list[0],
nwords: ListVector[list.index].WORDS - ListVector[0].WORDS,
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;
csei: CSEIndex = SymbolOps.UnderType[stb, type];
FOR i: CARDINAL IN [0..state.index) DO
IF state[i].type = csei 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]];
OSMiscOps.Copy[
from: @state[0],
nwords: StateTable[state.index].WORDS - StateTable[0].WORDS,
to: @new[0]];
new.index Ź state.index;
zone.FREE[@state];
state Ź new};
IF state.index >= state.max THEN ERROR;
state[state.index] Ź [csei, CSENull, CSENull];
state.index Ź state.index + 1;
class Ź TypeClass[csei];
SELECT class FROM
$definition => ERROR;
$record => {
};
$enumerated => {
};
$structure =>
FOR iSei: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[csei]], SymbolOps.NextSe[stb, iSei]
WHILE iSei#ISENull DO
AddState[stb.seb[iSei].idType];
ENDLOOP;
$union => NULL;
$array => {
AddState[Domain[csei]];
AddState[Range[csei]]};
$sequence => {
AddState[stb.seb[Tag[csei]].idType];
AddState[Range[csei]]};
$subrange => AddState[Ground[csei]];
$opaque => NULL;
$countedZone, $uncountedZone => NULL;
$list => AddState[ListArg[csei]];
$relativeRef => {
AddState[Base[csei]];
AddState[Range[csei]]};
$ref => AddState[Range[csei]];
$var => AddState[Range[csei]];
$pointer, $longPointer, $descriptor, $longDescriptor => AddState[Range[csei]];
$procedure, $safeProc, $port, $program, $signal, $error => {
AddState[Domain[csei]];
AddState[Range[csei]]};
$process => AddState[Range[csei]];
$nil => NULL;
$globalFrame, $localFrame => ERROR;
$cardinal, $integer, $character, $longInteger, $longCardinal, $real, $type, $any, $unspecified, $longUnspecified, $dcard, $dint, $dreal => NULL;
ENDCASE => ERROR;
};

kEQ: PROC [t1, t2: CSEIndex] RETURNS [BOOL] = {
class1: Code = TypeClass[t1];
class2: Code = TypeClass[t2];
IF class1 # class2 THEN RETURN [FALSE];
IF t1 = t2 THEN RETURN [TRUE];
SELECT class1 FROM
$definition => ERROR;
$enumerated => {
WITH x1: stb.seb[t1] SELECT FROM
enumerated => {
iSei1: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
WITH x2: stb.seb[t2] SELECT FROM
enumerated => {
iSei2: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
IF x1.painted OR x2.painted THEN RETURN [t1 = t2];
IF x1.range # x2.range THEN RETURN [FALSE];
UNTIL iSei1=ISENull OR iSei2=ISENull DO
IF SymbolOps.NameForSe[stb, iSei1] # SymbolOps.NameForSe[stb, iSei2] THEN RETURN [FALSE];
IF stb.seb[iSei1].idValue # stb.seb[iSei2].idValue THEN RETURN [FALSE];
iSei1 Ź SymbolOps.NextSe[stb, iSei1];
iSei2 Ź SymbolOps.NextSe[stb, iSei2];
ENDLOOP;
RETURN [iSei1=iSei2];
};
ENDCASE;
};
ENDCASE;
RETURN [FALSE];
};
$structure => {
iSei1: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
iSei2: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t2]];
UNTIL iSei1=ISENull OR iSei2=ISENull DO
IF SymbolOps.NameForSe[stb, iSei1] # SymbolOps.NameForSe[stb, iSei2] THEN RETURN [FALSE];
IF Current[stb.seb[iSei1].idType] # Current[stb.seb[iSei2].idType] THEN
RETURN [FALSE]; 
iSei1 Ź SymbolOps.NextSe[stb, iSei1];
iSei2 Ź SymbolOps.NextSe[stb, iSei2];
ENDLOOP;
RETURN [iSei1=iSei2];
};
$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 [SymbolOps.NameForSe[stb, iSei1] = SymbolOps.NameForSe[stb, 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]];
$list => RETURN [Current[ListArg[t1]]=Current[ListArg[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]]];
$globalFrame, $localFrame => ERROR;
ENDCASE => RETURN [FALSE];
};

Current: PROC [type: Type] RETURNS [CSEIndex] = {
csei: CSEIndex = SymbolOps.UnderType[stb, type];
FOR i: CARDINAL IN [0..state.index) DO
IF state[i].type=csei THEN RETURN [state[i].current];
ENDLOOP;
ERROR;
};

StateTable: TYPE = RECORD [
index: CARDINAL,
elems: SEQUENCE max: CARDINAL OF RECORD[type, current, next: CSEIndex]];
state: LONG POINTER TO StateTable Ź NIL;

ListVector: TYPE = RECORD [
index: CARDINAL,
elems: SEQUENCE max: CARDINAL OF CSEIndex];
list: LONG POINTER TO ListVector Ź NIL;
StackElementRecord: TYPE = RECORD[name: CHAR, type: CSEIndex, 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: CSEIndex] = INLINE {
IF stack.index = stack.len THEN {
nLen: NAT = stack.index + (stack.index + 4)/2;
new: LONG POINTER TO StackVector = zone.NEW[StackVector[nLen]];
OSMiscOps.Copy[
from: @stack[0],
nwords: StackVector[stack.index].WORDS - StackVector[0].WORDS,
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 = INLINE {
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 {
nLen: NAT = defs.index + (defs.index+4)/2;
new: LONG POINTER TO DefsVector = zone.NEW[DefsVector[nLen]];
OSMiscOps.Copy[
from: @defs[0],
nwords: DefsVector[defs.index].WORDS - DefsVector[0].WORDS,
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: CSEIndex] 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 AND defs[i].index>=index THEN {
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;
ts[index] Ź VAL[Code.definition.ORD];
ts[index+1] Ź defs[j].name;
defs[j].name Ź '\000;
ENDLOOP;
lastName Ź '\000;
defs.index Ź 0;
};
TypeContext: PROC [csei: CSEIndex] RETURNS [CTXIndex] = {
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;
};

ListArg: PROC [csei: CSEIndex] RETURNS [Type] = {
ctx: CTXIndex = TypeContext[SymbolOps.UnderType[stb, Range[csei]]];
iSei: ISEIndex = SymbolOps.FirstCtxSe[stb, ctx];
WITH c~~stb.ctxb[ctx] SELECT FROM
included => IF ~c.complete THEN ERROR;
ENDCASE;
RETURN [stb.seb[iSei].idType];
};

Base: PROC [csei: CSEIndex] RETURNS [Type] = INLINE {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
relative => t.baseType,
ENDCASE => ERROR]
};

Range: PROC [csei: CSEIndex] RETURNS [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,
ENDCASE => ERROR]
};

Domain: PROC [csei: CSEIndex] RETURNS [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 [csei: CSEIndex] RETURNS [ISEIndex] = {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
sequence => t.tagSei,
union => t.tagSei,
ENDCASE => ERROR]
};

First: PROC [csei: CSEIndex] RETURNS [CARD] = {
RETURN [SELECT TypeClass[csei] FROM
$enumerated => 0,
$subrange =>
(WITH t~~stb.seb[csei] SELECT FROM
subrange => t.origin,
ENDCASE => ERROR),
$cardinal => Target.maxWord,
$integer => Target.maxWord - Target.maxWord/2,
$character => CHAR.FIRST.ORD.LONG,
$longInteger => Target.maxLongWord - Target.maxLongWord/2,
$longCardinal => Target.maxLongWord,
ENDCASE => ERROR]
};

Last: PROC [csei: CSEIndex] RETURNS [CARD] = {
RETURN [SELECT TypeClass[csei] FROM
$enumerated =>
(WITH t~~stb.seb[csei] SELECT FROM
enumerated => t.range,
ENDCASE => ERROR),
$subrange =>
(WITH t~~stb.seb[csei] SELECT FROM
subrange => LOOPHOLE[t.origin + t.range],
ENDCASE => ERROR),
$cardinal => Target.maxWord,
$integer => Target.maxWord/2,
$character => CHAR.LAST.ORD.LONG,
$longInteger => Target.maxLongWord/2,
$longCardinal => Target.maxLongWord,
ENDCASE => ERROR]
};

Safe: PROC [csei: CSEIndex] RETURNS [BOOL] = INLINE {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
transfer => t.safe,
ENDCASE => ERROR]
};

ReadOnly: PROC [csei: CSEIndex] RETURNS [BOOL] = {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
ref => t.readOnly,
arraydesc => t.readOnly,
ENDCASE => ERROR]
};

Ordered: PROC [csei: CSEIndex] RETURNS [BOOL] = {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
ref => t.ordered,
ENDCASE => ERROR]
};

Packed: PROC [csei: CSEIndex] RETURNS [BOOL] = {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
array => t.packed,
sequence => t.packed,
ENDCASE => ERROR]
};

Mds: PROC [csei: CSEIndex] RETURNS [BOOL] = INLINE {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
zone => t.mds,
ENDCASE => ERROR]
};

Ground: PROC [csei: CSEIndex] RETURNS [Type] = INLINE {
RETURN [WITH t~~stb.seb[csei] SELECT FROM
subrange => t.rangeType,
ENDCASE => ERROR]  -- NOTE relativeRef not yet
};

TypeClass: PROC [sei: Type] RETURNS [code: Code] = {
csei: CSEIndex;
IF sei=nullType THEN RETURN [$nil];
IF stb.seb[sei].seTag = id THEN RETURN [$definition];
csei Ź SymbolOps.UnderType[stb, sei];
WITH t~~stb.seb[csei] SELECT FROM
basic => code Ź SelectBasicClass[t.code];
record => code Ź (IF t.painted THEN $record ELSE $structure);
definition => code Ź $record;
real => code Ź SELECT t.length FROM
Target.bitsPerReal => $real,
Target.bitsPerReal*2 => $dreal,
ENDCASE => ERROR;
signed => code Ź SELECT t.length FROM
Target.bitsPerWord => $integer,
Target.bitsPerLongWord => $longInteger,
Target.bitsPerWord*2 => $dint,
ENDCASE => ERROR;
unsigned => code Ź SELECT t.length FROM
Target.bitsPerWord => $cardinal,
Target.bitsPerLongWord => $longCardinal,
Target.bitsPerWord*2 => $dcard,
ENDCASE => ERROR;
union => code Ź $union;
array => code Ź $array;
opaque => code Ź $opaque;
sequence => code Ź $sequence;
ref => code Ź (SELECT TRUE FROM
t.var => $var,
t.counted => IF t.list THEN $list ELSE $ref,
ENDCASE => $pointer);
arraydesc => code Ź $descriptor;
relative => code Ź $relativeRef;
enumerated => code Ź $enumerated;
subrange => code Ź $subrange;
transfer => code Ź (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 => code Ź (IF t.counted THEN $countedZone ELSE $uncountedZone);
mode => code Ź $type;
any => code Ź $any;
ENDCASE => ERROR;
};

SelectBasicClass: PROC [code: [0..16)] RETURNS [Code] = INLINE {
RETURN [SELECT code FROM
codeANY => $unspecified,
codeCHAR => $character,
ENDCASE => ERROR]
};

}.


  
T  
TypeStringsImpl.mesa
Copyright Ó 1984, 1985, 1986, 1987, 1988, 1989, 1991 by Xerox Corporation.  All rights reserved.
Satterthwaite, June 18, 1986 11:15:31 am PDT
Russ Atkinson (RRA) December 19, 1989 7:42:24 pm PST
Willie-s, September 24, 1991 4:48 pm PDT
Basic algorithm
Allocate the various state holders if they have not been already allocated.
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.
The length is substantially less than the maxLength, so we can make the string shorter
Special case for small negative numbers
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 add in the name.
Note, must use absolute, not machine relative, units!
RRA: March 11, 1989
avoid code for leftParen and rightParen
substitute concrete type for opaque type
replace type with its set representative
check to see if type is recursive
general cases
RRA: Unpainted enumeration types are identified by their name/value pairs
Painted enumeration types are identified by their paint alone
There are a few special records.  Other records are painted.
CTXRecord.nil.SIZE + 4*CTXRecord.simple.SIZE => AppendCode[$condition];
CTXRecord.nil.SIZE + 5*CTXRecord.simple.SIZE => AppendCode[$lock];
a structure is an unpainted record
Canonicalization	
build an equivalence table for the type
minimize the table
generate a new string
iterate over all k-equivalent classes, 
splitting them into k+1-equivalent classes
check to see if we have done this class already
if not, process the class 
a new class is born
Records and other painted types don't add state because they are unique enough
For painted enumerated values there is no new state because they are unique.
For unpainted enumerated types there is no new state because there are no subsidiary types (just names).
For unpainted records we have to add in the states for the component types.
Another place where unions are assumed to be painted.
This routine is concerned with type equality.
If either is painted, then type index equality suffices
Both are unpainted, so use name&value equality
For structures, equality is determined by name and type equivalence.
Stack management
Grow the stack a little
Grow the defs a little to accomodate the new definition
Procedures that work with the symbol table
For LIST OF T returns T
IF type = fhType THEN RETURN[localFrame];
IF type = nullType THEN RETURN[nil];
IF type = gfhType THEN RETURN[globalFrame];
IF type = unspecType THEN RETURN[unspecified];
 Ęý  (cedarcode) styleNewlineDelimiter
 headIcode
ĎeU`LĎy,,L4L(L Ďk		LL L*L
L
Q)LLL.LCbL%ĎnLL$LL L#L)HLL	LL LLLLLL  	VL
 LL	L
L LKKL	L%L!L#L	L$L!L#LL88L LLL.L LąąL'L	)L	)L''LVLLL
"LL7LLLLLLL  :L%LLL9LLLLL  LL$>L
.LLLL  
	.L L 
	1L  
 LL"LLLLLLLLL-L'LLLLLLLLLLL  &L887L44L"L!LL*L//L -LLLL%6L
'!Ll L++LLLL!5LLLLLLLLL  
!LL?L"2L''L
L
JLLL  -L+L'LL  'L00LLL((L'LL((&L=LL!! L)L#+LL%LL""=LĎc.C!LIILLNhL+L88LLLL==LLLLLLL<<'LBLHLGGLBBL,3LL""L"!L&LLNhLLLLLLLL)LL LLL)LLLLLLLLL!	$=LL*.LL!L#LL

L+L-LL LLLLL	L- LL37L	L-LLLL+L-LLL!L-LLLLLLL%L%LLLLL%LLL	LLLLL#LLLL  IL"$DLL,,LL==3LLSSLSS 3L)GLL L
L L J #L''LĄ,LL
LLLĄ$=LLL  	
*L''L**&L//LL#	7LLLLL&#Ą<L%$L!-LLLL%.L	=LL;LLLLL%LLLLLLL&L!LL  LL0&L$L!L'0L	=LL <LLL	LL'L.LLLLNNLLLLLhhLLKK[^LL
L55LLL$LL$LL %L!LLLLLN<LLL"LL#LLL /L--LLL'L	L L= L=2L77L..L+'LCYL1GL%L%LLLLLLLLLDDL=L='LCYAGLL%L%LLL	)/L(+LLCIL>AL(+LL*pL	-<%+L(+L)7L)78L)/<*0L),L);L#LL  1L0&L5LLLL LL	!HL	(L LL+L	'L	OL	8L LL5L	)L LL5L	'L  &!LL%.L	?LL!>LLL	LL..LLL  LLL-L77L!*L	=LL;LLLLL&&LLL  :	&L0LL 
 =L
L%5LLLLL3LL
NL%LLLLLL** 9!L"L
L L	L
'LL  1LLCCL0!L&LLLL  
5)LLL  /)LLLLLLLL  0)LL%L"LLL  1)LLLL  /#L"LLLL..L	"L::L$$LL  .#"LL"L)LLLL	!L%%L$$LL 
 5)LLL  2)LLLL  1)LLL  0)LLLL 
 4)LLL  
7)LLĄ.L  	4LL))L$$L++L..L#L5L%!L))L	=L
#LLL
%LL''LL
'L L((LLLLLLLL,LL  L  L!!L&L	2LLLLLLLDLLLL  
@LLLL L L  L L L L      X`  ą  