-- file [Indigo]<Cedar>BCD>TypeStringsImpl.mesa
-- Edited by Satterthwaite, May 21, 1982 1:29 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 [HighByte, HighHalf, LowByte, LowHalf],
Strings: TYPE USING [SubStringDescriptor, AppendChar],
Symbols: TYPE USING [codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex,
ISEIndex, HTIndex, HTNull, MDIndex, MDNull, OwnMdi,
SEIndex, SENull, StandardContext, typeTYPE],
SymbolTable: TYPE USING [Base],
TypeStrings: TYPE USING [Code, TypeString];
TypeStringsImpl: PROGRAM
IMPORTS Inline, Strings
EXPORTS TypeStrings =
BEGIN
OPEN Symbols, TypeStrings;
--*******************************************************************
--basic algorithm
--*******************************************************************
stb: SymbolTable.Base ← NIL;
zone: UNCOUNTED ZONE ← NIL;
ts: TypeString;
Create: PUBLIC PROC [base:SymbolTable.Base, sei:SEIndex, 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 ← 000C;
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[LOOPHOLE[Inline.HighByte[c]]];
Append[LOOPHOLE[Inline.LowByte[c]]]};
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: SEIndex] 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];
IF ctx IN StandardContext THEN paint.version ← ALL[0]
ELSE paint.version ← 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 [hti: HTIndex] = {
length, offset:CARDINAL;
IF hti = HTNull THEN {length ← offset ← 0}
ELSE length ← stb.ht[hti].ssIndex - (offset ← stb.ht[hti-1].ssIndex);
IF length>200B THEN ERROR; -- avoid code for leftParen and rightParen
Append[0c + length];
FOR i:CARDINAL IN [offset..offset+length) DO Append[stb.ssb[i]] ENDLOOP;
};
AppendField: PROC [iSei: ISEIndex] = INLINE {
AppendName[stb.HashForSe[iSei]];
AppendTypeString[stb.seb[iSei].idType]};
AppendTypeString: PROC [type: SEIndex] =
BEGIN
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=000C 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#SENull 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 =>
{AppendCode[class]};
globalFrame, localFrame => ERROR;
ENDCASE => ERROR;
Pop[];
END;
OpaqueValue: PROC [type:CSEIndex, base:SymbolTable.Base] RETURNS[val:SEIndex] = {
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.SubStringForHash[@ss,b1.seb[t1.id].hash];
sei2 ← base.SearchContext[base.FindString[@ss], base.mainCtx];
IF sei2#SENull 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:SEIndex] = {
-- 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:SEIndex] = {
class:Code;
-- strip off unnecessary definitions
type ← UnderStar[type];
--ground:SEIndex ← 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,SENull,SENull];
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#SENull 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 => NULL;
ENDCASE => ERROR;
};
kEQ: PROC [t1,t2:SEIndex] 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=SENull OR iSei2=SENull THEN RETURN[iSei1=iSei2];
IF stb.HashForSe[iSei1] # stb.HashForSe[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.HashForSe[iSei1] = stb.HashForSe[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]]];
type => RETURN[t1=t2]; --***PDR--
nil => RETURN[t1=t2];
any => RETURN[t1=t2]; --***PDR--
unspecified => RETURN[t1=t2];
globalFrame, localFrame => ERROR;
cardinal, integer, character, longInteger, longCardinal, real,
type, any, unspecified =>
RETURN[t1=t2];
ENDCASE => ERROR;
};
Current: PROC [type:SEIndex] RETURNS[SEIndex] = {
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: SEIndex];
state: LONG POINTER TO StateTable ← NIL;
stateLength: CARDINAL;
maxStateLength:CARDINAL = 100;
ListVector: TYPE = ARRAY [0..maxStateLength) OF SEIndex;
list: LONG POINTER TO ListVector ← NIL;
listLength: CARDINAL;
--*******************************************************************
--stack management
--*******************************************************************
StackElementRecord:TYPE = RECORD[name:CHAR,type:SEIndex,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:SEIndex] = {
IF stackIndex=stackLength THEN ERROR;
stack[stackIndex] ← [000C,type,ts.length];
stackIndex ← stackIndex + 1};
Pop: PROC = {
IF stackIndex=0 THEN ERROR;
stackIndex ← stackIndex - 1;
IF stack[stackIndex].name=000C THEN RETURN;
IF defsIndex=defsLength THEN ERROR;
defs[defsIndex] ← stack[stackIndex];
defsIndex ← defsIndex+1};
Find: PROC [type:SEIndex] 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=000C 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 ← 000C;
ENDLOOP;
lastName ← 000C;
defsIndex ← 0};
--*******************************************************************
--hash table management
--*******************************************************************
--Entry:TYPE = LONG POINTER TO EntryRec;
--EntryRec:TYPE = RECORD [type:SEIndex,
-- recursive:BOOL,
-- string:TypeString];
--nullEntry:EntryRec = [SENull, FALSE, NIL];
--array: ARRAY [0..arrayLength) OF EntryRec;
--arrayLength:CARDINAL = 47;
--FlushCache: PROC = {array ← ALL[nullEntry]};
--cache: PROC [sei:SEIndex] RETURNS[Entry] ={
-- p:CARDINAL ← LOOPHOLE[sei,CARDINAL] MOD arrayLength;
-- FOR i:CARDINAL IN [p..arrayLength) DO
-- IF array[i].type=SENull 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=SENull 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: SEIndex] 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: SEIndex] RETURNS [SEIndex] = {
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: SEIndex] RETURNS [SEIndex] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t: stb.seb[csei] SELECT FROM
relative => t.baseType,
ENDCASE => ERROR]};
Range: PROC [type: SEIndex] RETURNS [SEIndex] = {
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: SEIndex] RETURNS [SEIndex] = {
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: SEIndex] 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: SEIndex] RETURNS [LONG CARDINAL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [SELECT TypeClass[csei] FROM
enumerated => 0,
subrange => WITH t: stb.seb[csei] SELECT FROM
subrange => LONG[t.origin],
ENDCASE => ERROR,
cardinal => FIRST[CARDINAL],
integer => LONG[LOOPHOLE[FIRST[INTEGER], CARDINAL]],
character => LONG[LOOPHOLE[FIRST[CHAR], CARDINAL]],
longInteger => LOOPHOLE[FIRST[LONG INTEGER]],
longCardinal => FIRST[LONG CARDINAL],
ENDCASE => ERROR]
};
Last: PROC [type: SEIndex] RETURNS [LONG CARDINAL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [SELECT TypeClass[csei] FROM
enumerated =>
WITH t: stb.seb[csei] SELECT FROM
enumerated => LOOPHOLE[LONG[t.nValues - 1]],
ENDCASE => ERROR,
subrange =>
WITH t: stb.seb[csei] SELECT FROM
subrange => LOOPHOLE[LONG[t.origin + t.range]],
ENDCASE => ERROR,
cardinal => LAST[CARDINAL],
integer => LONG[LOOPHOLE[LAST[INTEGER], CARDINAL]],
character => LONG[LOOPHOLE[LAST[CHAR], CARDINAL]],
longInteger => LOOPHOLE[LAST[LONG INTEGER]],
longCardinal => LAST[LONG CARDINAL],
ENDCASE => ERROR]
};
Safe: PROC [type: SEIndex] RETURNS [BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t: stb.seb[csei] SELECT FROM
transfer => t.safe,
ENDCASE => ERROR]
};
ReadOnly: PROC [type: SEIndex] 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: SEIndex] 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: SEIndex] 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: SEIndex] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t: stb.seb[csei] SELECT FROM
zone => t.mds,
ENDCASE => ERROR]
};
Ground: PROC [type: SEIndex] RETURNS [SEIndex] = {
RETURN [WITH se: stb.seb[type] SELECT FROM
id => se.idInfo, -- a definition
cons =>
WITH cse: se SELECT FROM
subrange => cse.rangeType,
ENDCASE => ERROR, -- NOTE relativeRef not yet
ENDCASE => ERROR]};
UnderStar: PROC [type: SEIndex] RETURNS [SEIndex] = {
WHILE TypeClass[type]=definition DO
type ← stb.UnderType[type];
ENDLOOP;
RETURN[type]};
TypeClass: PROC [sei: SEIndex] RETURNS[ans: Code] =
BEGIN
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=SENull THEN RETURN[nil];
IF stb.seb[sei].seTag = id THEN RETURN[definition];
csei ← stb.UnderType[sei];
ans ←
(WITH ser: stb.seb[csei] SELECT FROM
basic => SelectBasicClass[ser.code],
record => (IF ser.painted THEN record ELSE structure),
definition => record,
real => real,
union => union,
array => array,
opaque => opaque,
sequence => sequence,
ref => (IF ser.counted THEN ERROR ELSE pointer),
arraydesc => descriptor,
long => (WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM
ref => (SELECT TRUE FROM
rse.var => var,
rse.counted => IF rse.list THEN list ELSE ref,
ENDCASE => longPointer),
basic => (IF rse.code = codeINT THEN longInteger ELSE ERROR),
arraydesc => longDescriptor,
ENDCASE => IF IsCardinal[ser.rangeType] THEN longCardinal ELSE ERROR),
relative => relativeRef,
enumerated => enumerated,
subrange => IF IsCardinal[csei] THEN cardinal ELSE subrange,
transfer => (SELECT ser.mode FROM
proc => IF ser.safe THEN safeProc ELSE procedure,
port => port,
signal => signal,
error => error,
process => process,
program => program,
ENDCASE => ERROR),
zone => (IF ser.counted THEN countedZone ELSE uncountedZone),
mode => type,
any => any,
ENDCASE => ERROR);
END;
SelectBasicClass: PROC [code: [0..16)] RETURNS[Code] = INLINE {
RETURN [SELECT code FROM
codeINT => integer,
codeANY => unspecified,
codeCHAR => character,
ENDCASE => ERROR]};
IsCardinal: PROC [type: SEIndex] RETURNS [BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t: stb.seb[csei] SELECT FROM
subrange => (WITH tt: stb.seb[stb.UnderType[t.rangeType]] SELECT FROM
basic => (tt.code = codeINT AND t.origin = 0
AND t.range = LAST[CARDINAL]),
ENDCASE => FALSE),
ENDCASE => FALSE]};
--*******************************************************************
--substitution
--*******************************************************************
Substitute: PUBLIC PROC [concrete,opaque,type:TypeString,z:UNCOUNTED ZONE] = {
maxDef:CHAR ← MaxDefinition[concrete];
IF type.length<opaque.length THEN RETURN;
IF HasCode[concrete,opaque] THEN ERROR; -- potentially recursive
IF maxDef#000C THEN ERROR; -- potentially recursive
zone ← z;
FOR i:CARDINAL DECREASING IN [0..type.length-opaque.length] DO
IF ~Match[opaque,type,i] THEN LOOP;
IF maxDef#000C THEN Rename[concrete,MaxDefinition[type]];
--delete opaque
type.length ← type.length - opaque.length;
FOR j:CARDINAL IN [i..type.length) DO
type[j] ← type[j+opaque.length]; ENDLOOP;
--insert concrete
IF type.length+concrete.length > type.maxlength
THEN type ← Adjust[type,type.length+concrete.length];
type.length ← type.length + concrete.length;
FOR j:CARDINAL DECREASING IN [i+concrete.length..type.length) DO
type[j] ← type[j-concrete.length]; ENDLOOP;
FOR j:CARDINAL IN [0..concrete.length) DO type[i+j] ← concrete[j]; ENDLOOP;
ENDLOOP;
IF maxDef#000C THEN ReorderDefinitions[type,MaxDefinition[type]];
};
Match: PROC [s1,s2:TypeString,index:CARDINAL] RETURNS[BOOL] = INLINE {
FOR i:CARDINAL IN [0..s1.length) DO
IF s1[i]#s2[i+index] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE]};
ReorderDefinitions: PROC [s:TypeString,last:CHAR] = {
a:ARRAY CHAR [001C..020C] OF RECORD[i:CARDINAL,n:CHAR];
skip:CARDINAL ← 0;
min,max:CARDINAL ← 0;
IF last>020C THEN ERROR;
a ← ALL[[0,000C]];
-- build the array of name => index associations
FOR i:CARDINAL IN [0..s.length) DO
IF skip>0 THEN {skip←skip-1; LOOP};
IF LOOPHOLE[s[i],Code]=opaque THEN skip ← 8; -- skip paint
IF LOOPHOLE[s[i],Code]=paint THEN skip ← 8;
IF LOOPHOLE[s[i],Code]#name THEN LOOP;
IF a[s[i+1]].i=0 THEN a[s[i+1]].i ← i;
ENDLOOP;
-- sort names by their position in the string
FOR i:CHAR IN [001C..last] DO
max ← min;
min ← s.length;
FOR j:CHAR IN [001C..last] DO
IF a[j].i >= min THEN LOOP;
IF a[j].i <= max THEN LOOP;
min ← a[j].i;
a[j].n ← i;
ENDLOOP;
ENDLOOP;
-- replace definitions and names with their new names;
FOR i:CARDINAL IN [0..s.length) DO
IF skip>0 THEN {skip←skip-1; LOOP};
IF LOOPHOLE[s[i],Code]=opaque THEN skip ← 8; -- skip paint
IF LOOPHOLE[s[i],Code]=paint THEN skip ← 8;
IF ~(LOOPHOLE[s[i],Code] IN [definition..name]) THEN LOOP;
s[i+1] ← a[s[i+1]].n;
ENDLOOP;
};
MaxDefinition: PROC [s:TypeString] RETURNS[max:CHAR] = {
skip:CARDINAL←0;
max ← 000C;
FOR i:CARDINAL IN [0..s.length) DO
IF skip>0 THEN {skip←skip-1; LOOP};
IF LOOPHOLE[s[i],Code]=opaque THEN skip ← 8; -- skip paint
IF LOOPHOLE[s[i],Code]=paint THEN skip ← 8;
IF LOOPHOLE[s[i],Code]#definition THEN LOOP;
max ← MAX[max,s[i+1]];
ENDLOOP;
};
Rename: PROC [s:TypeString,offset:CHAR] = {
skip:CARDINAL←0;
FOR i:CARDINAL IN [0..s.length) DO
IF skip>0 THEN {skip←skip-1; LOOP};
IF LOOPHOLE[s[i],Code]=opaque THEN skip ← 8; -- skip paint
IF LOOPHOLE[s[i],Code]=paint THEN skip ← 8;
IF ~(LOOPHOLE[s[i],Code] IN [definition..name]) THEN LOOP;
s[i+1] ← s[i+1]+LOOPHOLE[offset];
ENDLOOP;
};
HasCode: PROC [s:TypeString,code:Code] RETURNS[BOOL]= {
skip:CARDINAL←0;
FOR i:CARDINAL IN [0..s.length) DO
IF skip>0 THEN {skip←skip-1; LOOP};
IF LOOPHOLE[s[i],Code]=opaque THEN skip ← 8; -- skip paint
IF LOOPHOLE[s[i],Code]=paint THEN skip ← 8;
IF LOOPHOLE[s[i],Code]=code THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]};
END..