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