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

  }.