DIRECTORY Basics: TYPE USING [HighHalf, LowHalf], ConvertUnsafe: TYPE USING [SubString], PrincOpsUtils: TYPE USING [LongCopy], Symbols: TYPE, SymbolTable: TYPE USING [Base], TypeStrings: TYPE 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--: 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 + 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: @s.text, nwords: StringBody[s.length].SIZE - StringBody[0].SIZE, to: @new.text]; new.length _ s.length; zone.FREE[@s]; RETURN}; Retract: PROC[s: TypeString] RETURNS[new: TypeString] = { new _ zone.NEW[StringBody[s.length]]; PrincOpsUtils.LongCopy[ from: @s.text, nwords: StringBody[s.length].SIZE - StringBody[0].SIZE, to: @new.text]; new.length _ s.length; zone.FREE[@s]; RETURN}; 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[VAL[c/256]]; Append[VAL[c MOD 256]]}; AppendLongCardinal: PROC[lc: LONG CARDINAL] = { AppendCardinal[Basics.HighHalf[lc]]; AppendCardinal[Basics.LowHalf[lc]]}; AppendPaint: PROC[type: CSEIndex] = { 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; IF form = $opaque THEN { WITH t: stb.seb[type] SELECT FROM opaque => index _ HashInName[ctx-CTXIndex.FIRST, stb.NameForSe[t.id]]; ENDCASE => ERROR; } ELSE index _ ctx-CTXIndex.FIRST; 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; FOR i: CARDINAL IN [offset..offset+length) DO hash _ hash + hash + (hash/100000b); hash _ hash + stb.ssb[i].ORD; 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[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] = { csei: CSEIndex _ stb.UnderType[type]; class: Code; e: StackElement; IF stb.TypeForm[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 LOOPHOLE[ctx, CARDINAL] = 4 THEN AppendCode[$boolean] -- This is the special common case for BOOLEAN ELSE WITH t: stb.seb[csei] SELECT FROM enumerated => { IF t.unpainted THEN { AppendCode[$enumerated]; AppendCode[$leftParen]; FOR iSei: ISEIndex _ stb.FirstCtxSe[ctx], stb.NextSe[iSei] UNTIL iSei = ISENull DO AppendName[stb.NameForSe[iSei]]; IF t.machineDep THEN AppendCardinal[stb.seb[iSei].idValue]; ENDLOOP; AppendCode[$rightParen]} ELSE { -- Painted enumeration types are identified by their paint alone AppendCode[$paint]; AppendPaint[csei]}; }; ENDCASE => ERROR; }; $record => { -- There are a few special records. Other records are painted. SELECT LOOPHOLE[TypeContext[csei],CARDINAL] FROM 6 => AppendCode[$text]; 8 => AppendCode[$stringBody]; ENDCASE => {AppendCode[$paint]; AppendPaint[csei]}; }; $structure => { -- a structure is an unpainted record ctx: CTXIndex = TypeContext[csei]; 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[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 => { -- 10 bytes AppendCode[$subrange]; AppendTypeString[Ground[csei]]; AppendLongCardinal[First[csei]]; AppendLongCardinal[Last[csei]]}; $opaque => { WITH t~~stb.seb[csei] SELECT FROM opaque => IF stb.seb[t.id].idCtx IN StandardContext 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 => AppendCode[class]; $globalFrame, $localFrame => ERROR; ENDCASE => ERROR; Pop[]}; OpaqueValue: PROC[type: CSEIndex, base: SymbolTable.Base] RETURNS[val: CSEIndex] = { 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] = 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]]; PrincOpsUtils.LongCopy[ from: @list[0], nwords: ListVector[list.index].SIZE - ListVector[0].SIZE, 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 = stb.UnderType[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]]; PrincOpsUtils.LongCopy[ from: @state[0], nwords: StateTable[state.index].SIZE - StateTable[0].SIZE, 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 _ stb.FirstCtxSe[TypeContext[csei]], stb.NextSe[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 => 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; $record, union => RETURN[t1=t2]; $enumerated => { WITH x1: stb.seb[t1] SELECT FROM enumerated => { iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]]; WITH x2: stb.seb[t2] SELECT FROM enumerated => { iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]]; IF NOT (x1.unpainted OR x2.unpainted) THEN RETURN[t1 = t2]; IF x1.nValues # x2.nValues THEN RETURN[FALSE]; UNTIL iSei1=ISENull OR iSei2=ISENull DO 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; RETURN[iSei1=iSei2]}; ENDCASE; }; ENDCASE; RETURN[FALSE]}; $structure => { iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]]; iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t2]]; UNTIL iSei1=ISENull OR iSei2=ISENull DO 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; 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[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[CSEIndex] = { csei: CSEIndex = stb.UnderType[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] = { 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: StackVector[stack.index].SIZE - StackVector[0].SIZE, 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: DefsVector[defs.index].SIZE - DefsVector[0].SIZE, 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[stb.UnderType[Range[csei]]]; 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[csei: CSEIndex] RETURNS[Type] = { 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, long => Range[stb.UnderType[t.rangeType]], 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] }; LC: TYPE = LONG CARDINAL; First: PROC[csei: CSEIndex] RETURNS[LC] = { 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 => LOOPHOLE[INTEGER.FIRST, CARDINAL].LONG, $character => CHAR.FIRST.ORD.LONG, $longInteger => LOOPHOLE[INT.FIRST], $longCardinal => LC.FIRST, ENDCASE => ERROR] }; Last: PROC[csei: CSEIndex] RETURNS[LC] = { 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 => INTEGER.LAST.LONG, $character => CHAR.LAST.ORD.LONG, $longInteger => INT.LAST, $longCardinal => LC.LAST, ENDCASE => ERROR] }; Safe: PROC[csei: CSEIndex] RETURNS[BOOL] = { 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 long => ReadOnly[stb.UnderType[t.rangeType]], ref => t.readOnly, arraydesc => t.readOnly, ENDCASE => ERROR] }; Ordered: PROC[csei: CSEIndex] RETURNS[BOOL] = { RETURN[WITH t~~stb.seb[csei] SELECT FROM long => Ordered[stb.UnderType[t.rangeType]], 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] = { RETURN[WITH t~~stb.seb[csei] SELECT FROM zone => t.mds, ENDCASE => ERROR] }; Ground: PROC[csei: CSEIndex] RETURNS[Type] = { RETURN[WITH t~~stb.seb[csei] SELECT FROM subrange => t.rangeType, ENDCASE => ERROR] -- NOTE relativeRef not yet }; TypeClass: PROC[sei: Type] RETURNS[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] }; }. ΪInternalTypeStringsImpl.mesa Copyright c 1984, 1985 by Xerox Corporation. All rights reserved. Satterthwaite, April 30, 1986 10:09:34 am PDT Russ Atkinson (RRA) August 28, 1985 1:46:25 am 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. RRA: Opaque types do not really have their own contexts, so we can't just rely on the context index within the BCD. Therefore we make the index a hash code instead of a context, where the hash code is dependent on the context and the name used (all opaque types have names, don't they?). We could do better than this, but only by changing the format of type strings, which we would rather not do. Given an initial hash, scramble the hash to make it dependent on the given name. This only scrambles 16 bits, so it should only be used to scramble things that are already nearly disambiguated. Hash in a new character. First, rotate the hash left one bit. Then add in the character code. This should make the hash dependent on the character code and the position of character within the string. 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 10 => AppendCode[$condition]; 12 => AppendCode[$lock]; ******************************************************************* 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]; Κj˜codešœ™Kšœ Οmœ7™BKšœ-™-K™2K˜—šΟk ˜ Kšœžœžœ˜'Kšœžœžœ ˜&Kšœžœžœ ˜%Kšœ žœ˜Kšœ žœžœ˜Kšœ žœžœ˜+K˜—šœžœ˜Kšžœ˜Kšžœ˜Kšžœ˜K˜—KšœC™CKšœ™KšœC™C˜Kšœžœ˜Kšœž œžœžœ˜Kšœžœ˜K˜Kšœ žœ˜Kšœ žœ˜Kšœ žœ˜Kšœ žœ˜Kšœ žœ˜K˜šΟnœžœžœΟcœ ž œžœžœ˜iKš žœžœžœžœžœ˜K˜ K˜ Kšœ žœ˜K˜KšœK™KKšœ˜Kšžœ žœžœ˜4Kšžœ˜!Kšžœžœ žœ˜1Kšžœ˜Kšžœ žœžœ˜3Kšžœ˜!Kšžœžœ žœ˜1Kšžœ˜Kšœ8˜8K˜K˜K˜Kšžœžœ˜.K˜Kšœ±™±Kšžœžœžœ˜'Kšžœžœžœ ˜)Kšžœžœžœ ˜)Kšžœžœžœ˜'Kšžœžœ˜6Kšžœ˜ K˜—šŸœžœžœ˜8Kšœžœ˜%Kšœ žœ˜šœ˜Kšœ˜Kšœžœžœ˜7Kšœ˜—Kšœ˜Kšœžœ˜Kšžœ˜K˜—šŸœžœžœ˜9Kšœ žœ˜%šœ˜Kšœ˜Kšœžœžœ˜7Kšœ˜—Kšœ˜Kšœžœ˜Kšžœ˜K˜—šŸœžœžœ˜Kšžœžœ˜1K˜K˜—š Ÿ œžœžœžœžœ˜-Kš žœžœžœžœžœ˜1K˜K˜K˜—KšŸ œžœžœ ˜0K˜šŸœžœžœžœ˜,Kšœžœžœžœ˜-K˜—šŸœžœžœžœ˜/K˜$K˜$K˜—šŸ œžœ˜%Kšœ-˜-šžœž˜˜7Kšœ žœžœžœ˜"K˜"Kšœžœ˜K˜ šžœžœž˜!K˜K˜*Kšžœžœ˜—šžœžœ˜Kšœ™šžœžœž˜!Kšœ*žœ˜FKšžœžœ˜—K˜—Kšžœžœ˜ ˜ Kš œžœžœžœžœžœžœ˜J—K˜K˜K˜Kšœ˜—Kšžœžœ˜—Kšœ˜K˜—š Ÿ œžœžœžœžœ˜BKšœΒ™ΒKšœžœ˜Kšžœžœ˜+KšžœC˜GKšžœ žœžœ *˜EKšœ˜šžœžœžœž˜-KšœΛ™ΛKšœ$˜$Kšœžœ˜Kšž˜—Kšžœ˜K˜—šŸ œžœ˜ Kšœžœ˜Kšžœžœ˜+KšžœC˜GKšžœ žœžœ *˜EKšœžœ ˜Kš žœžœžœžœžœ˜JK˜—šŸ œžœžœ˜,K˜ K˜(K˜—šŸœžœ˜&Kšœ%˜%K˜ K˜Kšœ(™(Kšžœžœ˜AKšœ(™(šžœžœžœž˜&Kšžœžœžœ˜=Kšžœ˜—Kšœ!™!šžœžœžœ˜ Kšžœžœ˜)Kšœ#žœ˜+—Kšœ ™ K˜ šžœž˜%Kšœžœ˜˜Kšœ"˜"šžœžœžœž˜#Kšœ .˜C—šž˜šžœžœž˜!˜šžœ žœ˜KšœI™IKšœ˜K˜šžœ8žœž˜RK˜ Kšžœžœ'˜;Kšžœ˜—K˜—šžœ @˜GKšœ'˜'—K˜—Kšžœžœ˜——Kšœ˜—šœ  ?˜Lšžœžœžœž˜0K˜K˜Kšœ™Kšœ™Kšžœ,˜3—Kšœ˜—šœ %˜5K˜"šžœžœž˜!Kšœ žœ žœžœ˜&Kšžœ˜—K˜šžœ8žœž˜PKšœ˜Kšžœ˜—K˜—šœ ˜ Kšœ'˜'—˜ Kšžœžœ˜)K˜K˜ K˜—˜Kšžœžœ˜)K˜K˜K˜—šœ  ˜K˜K˜K˜ K˜ —˜ šžœžœž˜!˜ Kšžœžœžœ˜CKšžœ*˜.—Kšžœžœ˜—Kšœ˜—˜!Kšžœ žœ˜#K˜—šœ ˜ Kšžœžœ˜+Kšžœžœ˜-K˜K˜!—˜K˜K˜K˜—˜ Kšžœžœ˜-Kšžœžœ˜9Kšžœ4˜8—˜ Kšžœžœ˜-K˜K˜—˜Kšžœžœ˜+Kšžœžœ˜-K˜K˜ —˜!Kšžœžœ˜-K˜K˜—˜K˜K˜K˜—˜%Kšžœ žœ˜%K˜K˜K˜—˜ Kšžœ žœ˜%K˜K˜—K˜:˜sK˜—Kšœžœ˜#Kšžœžœ˜—K˜K˜—šŸ œžœ)žœ˜TKšžœ ˜ K˜ šžœžœž˜!˜ šœžœ"žœž˜BK˜K˜+Kšžœ ˜—K˜1šžœžœžœ˜3K˜K˜FK˜=šžœžœ ˜3Kšžœžœ˜<———Kšž˜—šœ˜K˜——Kšœ žœ˜K˜KšŸœžœžœžœžœžœžœ˜HK˜K˜—KšœC™CKšœ™KšœC™C˜šŸ œžœ˜"Kšœ'™'Kšœ ˜,Kšœ™Kšžœ žœžœžœ˜Kšœ™K˜Kšœ $˜=Kšœ˜K˜—š Ÿœžœžœžœžœ˜)Kšœ'™'Kšœ*™*šžœžœžœž˜&Kšœ/™/Kšœžœžœ˜šžœžœžœžœ˜Kšžœ#žœ žœ˜7Kšžœ˜—šžœžœ˜Kšœ™K˜K˜K˜šžœžœžœž˜&šžœ#žœ ˜˜AKšžœ(˜+—Kšœ˜—Kšœ žœ)žœžœ˜oKšœ žœ˜Kšœžœ˜-Kšœ žœ,˜;˜šžœ$˜*Kšžœ(˜+——Kšœžœ(˜6Kšœžœ(˜6˜8Kšžœ(˜.—˜<šžœ)˜/Kšžœ)˜,——Kšœ žœ(˜:Kšœžœ˜Kšœžœ˜#˜sKšžœ˜—Kšžœžœ˜—šœ˜K˜——šŸœžœ žœ˜/K˜%šžœžœžœž˜&Kšžœžœžœ˜4Kšžœ˜—Kšžœ˜K˜—šœ žœžœ˜Kšœžœ˜Kš œžœžœžœžœ!˜H—Kš œžœžœžœžœ˜(K˜šœ žœžœ˜Kšœžœ˜Kšœžœžœžœ ˜+—Kš œžœžœžœžœ˜'K˜K˜—KšœC™CKšœ™KšœC™C˜Kš œžœžœžœžœ˜OKš œžœžœžœžœ˜8K˜šœ žœžœ˜Kšœžœ˜Kšœžœžœžœ˜5—Kš œžœžœžœžœ˜)K˜šœ žœžœ˜Kšœžœ˜Kšœžœžœžœ˜5—Kš œžœžœžœžœ˜'K˜šŸœžœ˜šžœžœ˜!Kšœ™Kšœžœ%˜.Kš œžœžœžœžœ˜?šœ˜Kšœ˜Kšœ!žœžœ˜šœ žœž˜Kšœ žœžœ žœ ˜2K˜K˜K˜K˜K˜Kšžœžœ˜—Kšœ žœ žœžœ˜=K˜K˜ Kšžœžœ˜—šœ˜K˜——šŸœžœžœ žœ˜>šžœžœž˜K˜K˜K˜Kšžœžœ˜—šœ˜K˜——šŸ œžœ žœžœ˜.K˜%šžœžœžœž˜(šœ žœ)žœž˜EKš œžœžœ žœžœ˜JKšžœžœ˜—Kšžœžœ˜—šœ˜K˜——K˜K˜K˜˜K˜K˜K˜K˜———…—VJ