-- file Pass4D.Mesa
-- last modified by Satterthwaite, December 20, 1979  1:37 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [charlength, wordlength],
  ComData: FROM "comdata"
    USING [
      definitionsOnly, mainBody, mainCtx, textIndex,
      typeCARDINAL, typeCONDITION, typeLOCK],
  ControlDefs: FROM "controldefs" USING [GFTIndex, globalbase, localbase],
  LiteralOps: FROM "literalops" USING [Find, FindDescriptor],
  Log: FROM "log" USING [Error, ErrorSei, ErrorTree, Warning],
  P4: FROM "p4"
    USING [
      Repr, none, signed, unsigned, both, other, Mark,
      BitsForType, ConstantInterval, EmptyInterval, Interval,
      LayoutArgs, LayoutFields, MakeEPLink, NeutralExp, PushAssignment, Rhs,
      StructuredLiteral, TreeLiteral, TreeLiteralValue, VPop, VRep],
  Symbols: FROM "symbols"
    USING [seType, ctxType, bodyType,
      ExtensionType, SEIndex, ISEIndex, CSEIndex, RecordSEIndex,
      CTXIndex, CBTIndex,
      SENull, BTNull,
      codeANY, codeCHARACTER, codeINTEGER, lZ, lG, typeANY],
  SymbolOps: FROM "symbolops"
    USING [
      Cardinality, ConstantId, CtxEntries, EnterExtension, FindExtension,
      LinkMode, NextSe, NormalType, UnderType, WordsForType],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [treeType, Index, Link, Map, Scan, Null],
  TreeOps: FROM "treeops"
    USING [
      CopyTree, FreeNode, FreeTree, GetNode, IdentityMap,
      ListHead, ListLength, PopTree, PushList, PushLit, PushNode, PushTree,
      ScanList, SetAttr, SetInfo, TestTree, UpdateList];

Pass4D: PROGRAM
    IMPORTS
	Log, LiteralOps, P4, SymbolOps, TreeOps,
	dataPtr: ComData
    EXPORTS P4 =
  BEGIN
  OPEN TreeOps, SymbolOps, Symbols;

  tb: Table.Base;	-- tree base address (local copy)
  seb: Table.Base;	-- se table base address (local copy)
  ctxb: Table.Base;	-- context table base address (local copy)
  bb: Table.Base;	-- body table base address (local copy)

  DeclNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    tb ← base[Tree.treeType];
    seb ← base[seType];  ctxb ← base[ctxType];
    bb ← base[bodyType];
    END;


  VarInit: PUBLIC SIGNAL RETURNS [BOOLEAN] = CODE;

  OwnGfi: ControlDefs.GFTIndex = 1;

  DeclItem: PUBLIC PROCEDURE [item: Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[item];
    type: CSEIndex;
    expNode: Tree.Index;
    initFlag, eqFlag: BOOLEAN;

    ExpInit: PROCEDURE =
      BEGIN  OPEN tb[node];
      val, info: UNSPECIFIED;
      t: Tree.Link;
      son[3] ← P4.Rhs[son[3], type];
      IF eqFlag
	THEN
	  BEGIN
	  t ← son[3];
	  WHILE TestTree[t, cast]
	    DO
	    WITH t SELECT FROM  subtree =>  t ← tb[index].son[1];  ENDCASE;
	    ENDLOOP;
	  IF P4.TreeLiteral[t] THEN
	    BEGIN
	    val ← P4.TreeLiteralValue[t]; info ← BTNull; GO TO define
	    END;
	  IF ConstInit[t] THEN
	    BEGIN
	    WITH t SELECT FROM subtree => tb[index].info ← type; ENDCASE;
	    AugmentSEValue[son[1], value, t, FALSE];  son[3] ← Tree.Null;
	    val ← 0;  info ← BTNull;  GO TO define
	    END;
	  IF seb[type].typeTag = transfer THEN
	    WITH t SELECT FROM
	      symbol =>
		BEGIN
		sei: ISEIndex = index;
		IF seb[sei].constant THEN
		  BEGIN
		  IF seb[sei].extended THEN
		    AugmentSEValue[son[1], form, FindExtension[sei].tree, TRUE];
		  val ← seb[sei].idValue;  info ← seb[sei].idInfo;
		  GO TO define
		  END;
		END;
	      ENDCASE;
	  DefineSEVar[son[1]];
	  EXITS
	    define =>
	      BEGIN
	      DefineSEValue[son[1], val, info];  son[3] ← FreeTree[son[3]];
	      END;
	  END;
      SELECT seb[NormalType[type]].typeTag FROM
	pointer, arraydesc, relative =>
	  IF ListLength[son[1]] # 1 AND son[3] # Tree.Null
	   AND ~P4.TreeLiteral[son[3]] AND ~TestTree[son[3], mwconst]
	    THEN Log.Warning[pointerInit];
	ENDCASE;
      P4.VPop[];
      END;

    saveIndex: CARDINAL = dataPtr.textIndex;
    IF tb[node].attr3 = P4.Mark THEN RETURN;	-- already processed
    tb[node].attr3 ← P4.Mark;
    dataPtr.textIndex ← tb[node].info;
    initFlag ← tb[node].son[3] # Tree.Null;
    IF tb[node].name = typedecl
      THEN
	BEGIN  ENABLE VarInit => RESUME [FALSE];
	TypeExp[tb[node].son[2]];  CheckDefaults[item];
	END
      ELSE
	BEGIN  OPEN tb[node];
	IF ~initFlag
	  THEN
	    BEGIN
	    IF son[2] # Tree.Null THEN TypeExp[son[2]];
	    type ← TypeForDecl[node];
	    WITH seb[type] SELECT FROM
	      record =>
		IF FrameVars[son[1]] AND
		 (type = dataPtr.typeLOCK OR type = dataPtr.typeCONDITION)
		  THEN  son[3] ← ProcessInit[type];
	      transfer =>
		IF mode = port
		  THEN
		    BEGIN
		    PushNode[portinit, 0]; SetInfo[type]; son[3] ← PopTree[];
		    END;
	      ENDCASE;
	    END
	  ELSE
	    BEGIN  eqFlag ← attr1;
	    IF son[2] # Tree.Null THEN TypeExp[son[2], TestTree[son[3],body]];
	    type ← TypeForDecl[node];
	    WITH son[3] SELECT FROM
	      symbol, literal =>  ExpInit[];
	      subtree =>
		BEGIN  expNode ← index;
		SELECT tb[expNode].name FROM
		  body, procinit =>
		    BEGIN
		    bti: CBTIndex = tb[expNode].info;
		    IF eqFlag
		      THEN
			BEGIN
			IF tb[expNode].attr3  -- inline
			  THEN
			    BEGIN
			    DefineSEValue[son[1], 0, bti];
			    IF dataPtr.definitionsOnly THEN
			      AugmentSEValue[son[1], form, TrimTree[son[3]], FALSE];
			    END
			  ELSE DefineSEValue[
				son[1],
				P4.MakeEPLink[bb[bti].entryIndex, OwnGfi],
				bti];
			son[3] ← Tree.Null;
			END
		      ELSE
			BEGIN
			PushNode[body, 0];  SetInfo[bti];  son[3] ← PopTree[];
			END;
		    END;
		  signalinit =>
		    IF eqFlag 
		      THEN
			BEGIN
			DefineSEValue[
				son[1],
				P4.MakeEPLink[tb[expNode].info, OwnGfi],
				dataPtr.mainBody]; 
			son[3] ← FreeTree[son[3]];
			END;
		  stringinit =>
		    BEGIN  OPEN exp: tb[expNode];
		    IF ListLength[son[1]] # 1 THEN Log.Warning[pointerInit];
		    exp.son[2] ← P4.Rhs[exp.son[2], dataPtr.typeCARDINAL];  
		    P4.VPop[];
		    END;
		  inline =>
		    BEGIN
		    tb[expNode].son[1] ←
			UpdateList[tb[expNode].son[1], InlineOp];
		    DefineSEValue[son[1], 0, BTNull];
		    AugmentSEValue[son[1], value, son[3], FALSE];
		    son[3] ← Tree.Null;
		    END;
		  ENDCASE =>  ExpInit[];
		END;
	      ENDCASE;
	    END;
	END;
    MarkAndCheckSE[tb[node].son[1], initFlag];
    dataPtr.textIndex ← saveIndex;
    END;

  TypeForDecl: PROCEDURE [node: Tree.Index] RETURNS [CSEIndex] =
    BEGIN
    type: SEIndex;
    t: Tree.Link;
    IF tb[node].son[2] # Tree.Null
      THEN  type ← TypeForTree[tb[node].son[2]]
      ELSE
	BEGIN
	t ← ListHead[tb[node].son[1]];
	type ← WITH t SELECT FROM symbol=>seb[index].idType, ENDCASE=>ERROR;
	END;
    RETURN [UnderType[type]]
    END;

  FrameVars: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    s: Tree.Link = ListHead[t];
    RETURN [WITH s SELECT FROM
      symbol =>
	SELECT ctxb[seb[index].idCtx].level FROM
	  lZ => FALSE,
	  lG => ~dataPtr.definitionsOnly,
	  ENDCASE => TRUE,
      ENDCASE => FALSE]
    END;

  ConstInit: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [IF ~TestTree[t, all] THEN P4.StructuredLiteral[t]
				 ELSE ConstInit[tb[GetNode[t]].son[1]]]
    END;

   ProcessInit: PROCEDURE [type: CSEIndex] RETURNS [Tree.Link] =
    BEGIN
    condInit: ARRAY [0..2) OF WORD ← [0, 100];
    SELECT type FROM
      dataPtr.typeLOCK =>
	BEGIN  PushLit[LiteralOps.Find[100000B]];  PushNode[cast, 1]  END;
      dataPtr.typeCONDITION =>
	BEGIN
	PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[condInit]]];
	PushNode[mwconst, 1];
	END;
      ENDCASE => ERROR;
    SetInfo[type];  RETURN [PopTree[]]
    END;

  InlineOp: Tree.Map =  BEGIN  RETURN [UpdateList[t, P4.NeutralExp]]  END;


  DefineSEVar: PROCEDURE [ids: Tree.Link] =
    BEGIN

    UpdateSE: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
	symbol => seb[index].constant ← FALSE;
	ENDCASE =>  ERROR;
      END;

    ScanList[ids, UpdateSE];
    END;

  DefineSEValue: PROCEDURE [ids: Tree.Link, value, info: UNSPECIFIED] =
    BEGIN

    UpdateSE: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei ← index;
	  seb[sei].constant ← TRUE;
	  seb[sei].idValue ← value;  seb[sei].idInfo ← info;
	  END;
	ENDCASE =>  ERROR;
      END;

    ScanList[ids, UpdateSE];
    END;

  AugmentSEValue: PROCEDURE [
	ids: Tree.Link,
	type: ExtensionType, extension: Tree.Link,
	copy: BOOLEAN] =
    BEGIN

    UpdateSE: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
	symbol =>
	  EnterExtension[index,
		type, IF copy THEN IdentityMap[extension] ELSE extension];
	ENDCASE =>  ERROR;
      copy ← TRUE;
      END;

    ScanList[ids, UpdateSE];
    END;


  MarkAndCheckSE: PROCEDURE [t: Tree.Link, initialized: BOOLEAN] =
    BEGIN

    UpdateSE: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei ← index;
	  seb[sei].mark4 ← TRUE;
	  IF dataPtr.definitionsOnly THEN CheckDefinition[sei, initialized];
	  END;
	ENDCASE =>  ERROR;
      END;

    ScanList[t, UpdateSE];
    END;

  CheckDefinition: PROCEDURE [sei: ISEIndex, initialized: BOOLEAN] =
    BEGIN
    SELECT seb[sei].idCtx FROM
      dataPtr.mainCtx =>
	SELECT LinkMode[sei] FROM
	  val =>  IF ~initialized OR seb[sei].extended THEN RETURN;
	  ref =>  IF ~initialized THEN RETURN;
	  manifest =>  IF ConstantId[sei] THEN RETURN;
	  ENDCASE;
      ENDCASE =>  RETURN;
    Log.ErrorSei[nonDefinition, sei];
    END;

  CheckDefaults: PROCEDURE [t: Tree.Link] =
    BEGIN

    TestDefault: Tree.Map =
      BEGIN
      IF TestTree[t, void]
	THEN  v ← t
	ELSE
	  BEGIN
	  v ← P4.NeutralExp[t];
	  IF ~(ConstInit[v] OR (SIGNAL VarInit[]))
	    THEN Log.ErrorTree[nonConstant, v];
	  END;
      RETURN
      END;

    TestDefaults: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      saveIndex: CARDINAL = dataPtr.textIndex;
      id: Tree.Link = ListHead[tb[node].son[1]];
      sei: ISEIndex = WITH id SELECT FROM symbol => index, ENDCASE => ERROR;
      dataPtr.textIndex ← tb[node].info;
      IF seb[sei].extended
	THEN
	  [] ← FreeTree[
		UpdateList[
		  CopyTree[[@tb, FindExtension[sei].tree], IdentityMap],
		  TestDefault]];
      dataPtr.textIndex ← saveIndex;
      END;

    IF dataPtr.definitionsOnly THEN ScanList[t, TestDefaults];
    END;


  TrimTree: Tree.Map =
    BEGIN
    node: Tree.Index;
    WITH t SELECT FROM
      subtree =>
	BEGIN  node ← index;
	SELECT tb[node].name FROM
	  body =>
	    BEGIN  OPEN tb[node];
	    PushTree[TrimTree[son[1]]];
	    PushTrimDecls[son[2]];
	    PushTree[TrimTree[son[3]]];  PushTree[TrimTree[son[4]]];
	    PushNode[body, 4];  SetInfo[info];
	    SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3];
	    v ← PopTree[];
	    END;
	  block =>
	    BEGIN  OPEN tb[node];
	    PushTrimDecls[son[1]];  PushTree[TrimTree[son[2]]];
	    PushNode[block, 2];  SetInfo[info];
	    SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3];
	    v ← PopTree[];
	    END;
	  cdot =>  v ← TrimTree[tb[node].son[2]];
	  ENDCASE =>  v ← CopyTree[[@tb, t], TrimTree];
	END;
      ENDCASE =>  v ← t;
    RETURN
    END;

  PushTrimDecls: PROCEDURE [t: Tree.Link] =
    BEGIN
    n: CARDINAL;

    PushDecl: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      SELECT tb[node].name FROM
	typedecl =>  NULL;
	decl =>
	  IF tb[node].son[3] # Tree.Null THEN
	    BEGIN  OPEN  tb[node];
	    PushTree[TrimTree[son[1]]];  PushTree[Tree.Null];
	    PushTree[TrimTree[son[3]]];
	    PushNode[decl, 3];  SetInfo[info];
	    SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, ~P4.Mark];
	    n ← n+1;
	    END;
	ENDCASE => ERROR;
      END;

    n ← 0;  ScanList[t, PushDecl];  PushList[n];
    END;


  DeclUpdate: PUBLIC PROCEDURE [item: Tree.Link] RETURNS [update: Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[item];
    IF tb[node].name = typedecl OR tb[node].son[3] = Tree.Null
      THEN update ← Tree.Null
      ELSE
	BEGIN  OPEN tb[node];
	P4.PushAssignment[son[1], son[3], UnderType[TypeForTree[son[2]]]];
	SetInfo[info];  update ← PopTree[];  son[3] ← Tree.Null;
	END;
    FreeNode[node];
    RETURN
    END;


  TypeExp: PUBLIC PROCEDURE [typeExp: Tree.Link, body: BOOLEAN ← FALSE] =
    BEGIN  -- body => arg records subsumed by frame
    node: Tree.Index;
    sei: CSEIndex;
    WordLength: CARDINAL = AltoDefs.wordlength;
    ByteLength: CARDINAL = AltoDefs.charlength;
    WITH typeExp SELECT FROM
      symbol =>
	BEGIN
	iSei: ISEIndex = index;
	IF ~seb[iSei].mark4 
	  THEN DeclItem[Tree.Link[subtree[index: seb[iSei].idValue]]];
	END;
      subtree =>
	BEGIN  node ← index;
	SELECT tb[node].name FROM
	  discrimTC =>  TypeExp[tb[node].son[1]];
	  cdot =>  TypeExp[tb[node].son[2]];
	  frameTC =>  NULL;
	  ENDCASE =>
	    BEGIN  OPEN tb[node];
	    sei ← info;
	    IF ~seb[sei].mark4 THEN
	     WITH type: seb[sei] SELECT FROM
	      enumerated =>  NULL;
	      record =>
		BEGIN
		ENABLE VarInit => RESUME [FALSE];
		ScanList[son[1], DeclItem];
		WITH type SELECT FROM
		  notLinked =>
		    P4.LayoutFields[LOOPHOLE[sei, RecordSEIndex], 0];
		  ENDCASE;
		ExtractFieldAttributes[LOOPHOLE[sei, RecordSEIndex]];
		CheckDefaults[son[1]];
		END;
	      pointer =>  IF TypeConstructor[son[1]] THEN TypeExp[son[1]];
	      array =>
		BEGIN
		IF son[1] # Tree.Null THEN TypeExp[son[1]];
		TypeExp[son[2]];
		type.comparable ← ComparableType[UnderType[type.componentType]];
		END;
	      arraydesc =>  IF TypeConstructor[son[1]] THEN TypeExp[son[1]];
	      transfer =>
		BEGIN
		origin, newOrigin: CARDINAL;
		rSei: RecordSEIndex;
		origin ← SELECT type.mode FROM
		  program => ControlDefs.globalbase,
		  signal, error => ControlDefs.localbase+1,
		  procedure => ControlDefs.localbase,
		  ENDCASE => 0;
		ScanList[son[1], DeclItem];  CheckDefaults[son[1]];
		rSei ← type.inRecord;
		IF rSei # SENull
		  THEN
		    BEGIN
		    newOrigin ← P4.LayoutArgs[rSei, origin, body];
		    seb[rSei].length ← (newOrigin - origin)*WordLength;
		    seb[rSei].mark4 ← TRUE;
		    origin ← newOrigin;
		    END;
		ScanList[son[2], DeclItem];  CheckDefaults[son[2]];
		rSei ← type.outRecord;
		IF rSei # SENull
		  THEN
		    BEGIN
		    seb[rSei].length ←
		     (P4.LayoutArgs[rSei, origin, body] - origin)*WordLength;
		    seb[rSei].mark4 ← TRUE;
		    END;
		END;
	      definition =>  NULL;
	      union =>
		BEGIN
		DeclItem[son[1]];
		ProcessVariants[UnderType[seb[type.tagSei].idType], son[2]];
		END;
	      relative =>
		BEGIN
		IF TypeConstructor[son[1]] THEN TypeExp[son[1]];
		IF TypeConstructor[son[2]] THEN TypeExp[son[2]];
		END;
	      subrange =>
		BEGIN
		subNode: Tree.Index;
		tSei: CSEIndex = UnderType[type.rangeType];
		TypeExp[son[1]];
		subNode ← GetNode[son[2]];
		IF P4.Interval[subNode, 0, P4.both]
		  THEN [type.origin, type.range] ← P4.ConstantInterval[subNode
		    ! P4.EmptyInterval => BEGIN type.empty ← TRUE; RESUME END]
		  ELSE type.origin ← type.range ← 0;
		type.filled ← TRUE;
		SELECT P4.VRep[] FROM
		  P4.none => Log.ErrorTree[mixedRepresentation, son[2]];
		  P4.unsigned =>
		    IF type.origin < 0 THEN Log.Error[subrangeNesting];
		  ENDCASE;
		P4.VPop[];
		WITH cover: seb[tSei] SELECT FROM
		  subrange =>	-- incomplete test
		    IF  type.origin < cover.origin
		     OR (~type.empty AND type.range > cover.range)
		      THEN Log.Error[subrangeNesting];
		  ENDCASE =>  NULL;
		son[2] ← FreeTree[son[2]];
		END;
	      long =>  TypeExp[son[1]];
	      ENDCASE =>  ERROR;
	    seb[sei].mark4 ← TRUE;
	    END;
	END;
      ENDCASE =>  ERROR;
    END;

  TypeConstructor: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [WITH t SELECT FROM
      subtree =>
	SELECT tb[index].name FROM
	  dot, cdot, discrimTC => FALSE,
	  ENDCASE => TRUE,
      ENDCASE => FALSE]
    END;

  ExtractFieldAttributes: PROCEDURE [rType: RecordSEIndex] =
    BEGIN
    -- compatibility version
    sei: ISEIndex;
    type: CSEIndex;
    comparable, privateFields: BOOLEAN;
    comparable ← TRUE;   privateFields ← FALSE;
    FOR sei ← ctxb[seb[rType].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull
      DO
      IF ~seb[sei].public THEN privateFields ← TRUE;
      type ← UnderType[seb[sei].idType];
      WITH t: seb[type] SELECT FROM
	record =>
	  IF ~t.hints.comparable AND ~ComparableType[type]
	    THEN comparable ← FALSE;
	array =>
	  IF ~t.comparable AND ~ComparableType[type] THEN comparable ← FALSE;
	union =>
	  IF ~t.equalLengths THEN comparable ← FALSE;
	ENDCASE;
      ENDLOOP;
    seb[rType].hints.comparable ← comparable;
    seb[rType].hints.privateFields ← privateFields;
    END;

  ProcessVariants: PROCEDURE [tagType: CSEIndex, list: Tree.Link] =
    BEGIN
    lb, ub: CARDINAL;
  
    CheckTag: Tree.Scan =
      BEGIN
      sei: ISEIndex = WITH t SELECT FROM symbol => index, ENDCASE => ERROR;
      tag: CARDINAL = seb[sei].idValue;
      IF tag ~IN [lb .. ub) THEN  Log.ErrorSei[boundsFault, sei];
      seb[sei].idValue ← tag - lb;
      END;

    ProcessVariant: Tree.Scan =
      BEGIN
      saveIndex: CARDINAL = dataPtr.textIndex;
      node: Tree.Index = GetNode[t];
      dataPtr.textIndex ← tb[node].info;
      ScanList[tb[node].son[1], CheckTag];
      DeclItem[t];
      dataPtr.textIndex ← saveIndex;
      END;

    lb ← BiasForType[tagType];  ub ← lb + Cardinality[tagType];
    ScanList[list, ProcessVariant];
    END;


  TypeForTree: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [SEIndex] =
    BEGIN
    RETURN [WITH t SELECT FROM
      symbol => index,
      subtree => tb[index].info,
      ENDCASE => typeANY]
    END;



  BiasForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [INTEGER] =
    BEGIN
    ctx: CTXIndex;
    IF type = SENull THEN RETURN [0];
    DO
      WITH seb[type] SELECT FROM
	subrange =>  RETURN [origin];
	record =>
	  BEGIN  ctx ← fieldCtx;
	  IF ~hints.unifield OR CtxEntries[ctx] # 1 THEN RETURN [0];
	  type ← UnderType[seb[ctxb[ctx].seList].idType];
	  END;
	ENDCASE =>  RETURN [0]
      ENDLOOP;
    END;

  RepForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [P4.Repr] =
    BEGIN
    ctx: CTXIndex;
    IF type = SENull THEN RETURN [P4.none];
    DO
      WITH seb[type] SELECT FROM
	basic =>
	  RETURN [SELECT code FROM
	    codeANY => P4.both + P4.other,
	    codeINTEGER => P4.signed,
	    codeCHARACTER => P4.both,
	    ENDCASE => P4.other];
	enumerated => RETURN [P4.both];
	pointer => RETURN [P4.unsigned];
	record =>
	  BEGIN  ctx ← fieldCtx;
	  IF ~hints.unifield OR CtxEntries[ctx] # 1 THEN RETURN [P4.other];
	  type ← UnderType[seb[ctxb[ctx].seList].idType];
	  END;
	relative =>  type ← UnderType[offsetType];
	subrange =>
	  RETURN [IF origin >= 0
	    THEN
	      (IF CARDINAL[origin] + range > 77777B
		THEN P4.unsigned ELSE P4.both)
	    ELSE (IF range <= 77777B THEN P4.signed ELSE P4.none)];
	long =>  type ← UnderType[rangeType];
	ENDCASE =>  RETURN [P4.other]
      ENDLOOP;
    END;


  WordsForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [nW: CARDINAL] =
    BEGIN
    WordLength: CARDINAL = AltoDefs.wordlength;
    IF ~seb[type].mark4
      THEN  nW ← (P4.BitsForType[type]+(WordLength-1))/WordLength
      ELSE
	BEGIN
	WITH seb[type] SELECT FROM
	  record => lengthUsed ← TRUE;
	  array => lengthUsed ← TRUE;
	  ENDCASE => NULL;
	nW ← SymbolOps.WordsForType[type];
	END;
    RETURN
    END;


  ComparableType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [BOOLEAN] =
    BEGIN
    -- compatibility version
    RETURN [WITH seb[type] SELECT FROM
      record => hints.comparable
		  OR (~hints.variant OR ComparableUnion[LOOPHOLE[type]]),
      array => comparable OR ComparableType[UnderType[componentType]],
      ENDCASE => TRUE]
    END;

  ComparableUnion: PROCEDURE [rType: RecordSEIndex] RETURNS [BOOLEAN] =
    BEGIN
    sei: ISEIndex;
    type: CSEIndex;
    FOR sei ← ctxb[seb[rType].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull
      DO
      type ← UnderType[seb[sei].idType];
      WITH seb[type] SELECT FROM
	union => RETURN [equalLengths];
	ENDCASE;
      ENDLOOP;
    RETURN [FALSE]
    END;

  END.