<> <> <> <> DIRECTORY Basics USING [HighHalf, LowHalf], ConvertUnsafe USING [SubString], PrincOpsUtils USING [LongCopy], Symbols, SymbolTable USING [Base], TypeStrings USING [Code, TypeString]; TypeStringsImpl: PROGRAM IMPORTS Basics, PrincOpsUtils EXPORTS TypeStrings = { OPEN Symbols, TypeStrings; <<*******************************************************************>> <> <<*******************************************************************>> 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]]; <> 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]; 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: CHAR] = { 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]]; }; 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 { <> 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] = { <> 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 _ 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; <> type _ UnderStar[type]; <> IF stb.TypeForm[type]=$opaque THEN type _ OpaqueValue[LOOPHOLE[type,CSEIndex],stb]; <> FOR i: CARDINAL IN [0..state.index) DO IF state[i].type = type THEN {type _ state[i].current; EXIT}; ENDLOOP; <> IF (e _ Find[type]) # NIL THEN { IF e.name='\000 THEN e.name_NewName[]; AppendCode[name]; Append[e.name]; RETURN}; <> Push[type]; SELECT (class _ TypeClass[type]) FROM $definition => ERROR; $enumerated => { SELECT LOOPHOLE[TypeContext[type],CARDINAL] FROM 4 => <> AppendCode[boolean]; ENDCASE => { WITH x: stb.seb[LOOPHOLE[type, Symbols.CSEIndex]] SELECT FROM enumerated => { p: LONG POINTER TO enumerated cons Symbols.SERecord _ @x; IF p.unpainted THEN { <> AppendCode[enumerated]; AppendCode[leftParen]; FOR iSei: ISEIndex _ stb.FirstCtxSe[TypeContext[type]], stb.NextSe[iSei] WHILE iSei#ISENull DO AppendName[stb.NameForSe[iSei]]; AppendCardinal[stb.seb[iSei].idValue]; ENDLOOP; AppendCode[rightParen]; } ELSE { <> AppendCode[paint]; AppendPaint[type]; }; }; ENDCASE => ERROR; }; }; $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 => { <> IF Ordered[type] THEN AppendCode[ordered]; IF ReadOnly[type] THEN AppendCode[readOnly]; AppendCode[list]; AppendTypeString[ListArg[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]}; <<*******************************************************************>> <> <<*******************************************************************>> 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 LOOP; <> 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; <> 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 => { <> <> }; $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[ListArg[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]; IF t1 = t2 THEN RETURN [TRUE]; SELECT class1 FROM $definition => ERROR; $record, union => RETURN [t1=t2]; $enumerated => { WITH x1: stb.seb[LOOPHOLE[t1, Symbols.CSEIndex]] SELECT FROM enumerated => { iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]]; WITH x2: stb.seb[LOOPHOLE[t2, Symbols.CSEIndex]] SELECT FROM enumerated => { iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]]; ser1: LONG POINTER TO enumerated cons Symbols.SERecord _ @x1; ser2: LONG POINTER TO enumerated cons Symbols.SERecord _ @x2; IF NOT (ser1.unpainted OR ser2.unpainted) THEN RETURN [t1 = t2]; <> IF ser1.nValues # ser2.nValues THEN RETURN [FALSE]; <> <> DO IF iSei1=ISENull OR iSei2=ISENull THEN RETURN [iSei1=iSei2]; IF stb.NameForSe[iSei1] # stb.NameForSe[iSei2] THEN RETURN [FALSE]; IF stb.seb[iSei1].idValue # stb.seb[iSei2].idValue THEN RETURN [FALSE]; iSei1 _ stb.NextSe[iSei1]; iSei2 _ stb.NextSe[iSei2]; ENDLOOP; }; ENDCASE; }; ENDCASE; RETURN [FALSE]; }; $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[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]]]; $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; <<*******************************************************************>> <> <<*******************************************************************>> 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 { <> 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 { <> 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 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; }; <<*******************************************************************>> <> <<*******************************************************************>> 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; }; ListArg: 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 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]; }; }.