-- ContextPack.Mesa
-- Edited by:  Bruce October 8, 1980  6:46 PM
-- Edited by:  Johnsson September 16, 1980  5:08 PM
-- Edited by:  Sandman July 18, 1980  10:24 AM

DIRECTORY
  BcdDefs USING [Base, CTIndex, CTNull, GFTIndex, MTIndex, NameRecord],
  BcdOps USING [
    BcdBase, CTHandle, FindName, MTHandle, NameString, ProcessConfigs, ProcessModules],
  DContext USING [],
  DebugOps USING [Abort, Numeric, ShortREAD, StringExpToOctal, UserAborted],
  DLoadState USING [
    Acquire, AcquireBcd, Enumerate, GetMap, Invalid, Map, MapConfigToReal,
    MapRealToConfig, ReleaseBcd, Release, ReleaseMap],
  DOutput USING [Blanks, Char, Decimal, EOL, Line, Octal, SubString, Text],
  DPsb USING [Current, Frame],
  Frames USING [Invalid],
  Gf USING [
    Check, CopiedFrame, Deleted, Display, DisplayGFTEntry, Frame, GFI, Handle,
    Name, Original, Validate],
  Lf USING [GF, Handle, NoAccessLink, Validate],
  MachineDefs USING [
    ConfigIndex, FHandle, GFHandle, GfiToFrame, GFTIndex, NullConfig, NullGF,
    nullPHandle, PHandle],
  State USING [AllStrings, Get, GetGS, GSHandle, Handle, strings, Strings],
  Storage USING [String],
  String USING [AppendString],
  Strings USING [EqualSubStrings, SubStringDescriptor],
  UserInput USING [userAbort];
  
ContextPack: PROGRAM
  IMPORTS BcdOps, DebugOps, DOutput, Strings, Frames, Gf, Lf, DLoadState,
    DPsb, MachineDefs, State, Storage, String, UserInput
  EXPORTS DContext =
  BEGIN OPEN BcdDefs, BcdOps, MachineDefs;
  
  strings: State.Strings _ State.AllStrings[];
  data: State.GSHandle _ State.GetGS[];
  
  -- setting
  
  Reset: PUBLIC PROC =
    BEGIN
    h: State.Handle _ State.Get[];
    SetLocal[DebugOps.ShortREAD[@data.StatePtr.dest !
      DebugOps.Abort => CONTINUE]];
    h.pContext _ DPsb.Current[];
    h.howSet _ state;
    END;
    
  SetOctal: PUBLIC PROC [p: POINTER] =
    BEGIN IF ~Gf.Validate[p] THEN SetLocal[p] ELSE SetGlobal[p] END;
    
  SetGlobal: PUBLIC PROC [gf: MachineDefs.GFHandle] =
    BEGIN
    h: State.Handle _ State.Get[];
    IF ~Gf.Validate[gf] THEN {CleanupInvalidContext[gf]; RETURN};
    WriteContext[gf];
    h.gContext _ gf;
    h.lContext _ NIL;
    h.pContext _ nullPHandle;
    h.howSet _ global;
    END;
    
  SetLocal: PUBLIC PROC [lf: MachineDefs.FHandle] =
    BEGIN
    h: State.Handle _ State.Get[];
    gf: MachineDefs.GFHandle _ NIL;
    IF ~Lf.Validate[lf] THEN {CleanupInvalidContext[lf]; RETURN};
    gf _ Lf.GF[lf ! Frames.Invalid, Lf.NoAccessLink => CONTINUE];
    WriteContext[gf];
    h.lContext _ lf;
    h.gContext _ gf;
    h.howSet _ local;
    END;
    
  SetProcess: PUBLIC PROC [p: MachineDefs.PHandle] =
    BEGIN
    h: State.Handle _ State.Get[];
    SetLocal[DPsb.Frame[p]];
    h.pContext _ p;
    h.howSet _ psb;
    END;
    
  CleanupInvalidContext: PROCEDURE [f: UNSPECIFIED] =
    BEGIN OPEN DOutput;
    EOL[]; Octal[f]; Text[" is not a valid frame!"L];
    IF ~data.initBCD THEN SIGNAL DebugOps.Abort ELSE InitConfig[];
    RETURN
    END;
    
InitConfig: PROCEDURE =
  BEGIN
  h: State.Handle _ State.Get[];
  bcd: BcdOps.BcdBase;
  h.lContext _ NIL; h.gContext _ NIL; h.pContext _ nullPHandle;
  h.config _ DLoadState.Acquire[ ! DLoadState.Invalid =>
    {h.config _ NullConfig; h.cti _ CTNull; GOTO noContext}] - 1;
  bcd _ DLoadState.AcquireBcd[h.config];
  h.cti _ IF bcd.nConfigs = 0 AND bcd.nModules = 1
    THEN CTNull ELSE FIRST[CTIndex];
  data.initBCD _ FALSE;
  Cleanup[bcd];
  EXITS
    noContext => NULL;
  END;
  
WriteContext: PROCEDURE [f: MachineDefs.GFHandle] =
  BEGIN
  h: State.Handle _ State.Get[];
  cgfi: GFTIndex;
  config: ConfigIndex;
  bcd: BcdOps.BcdBase;
  FindWhichModule: PROCEDURE[mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
    BEGIN
    IF cgfi IN [mth.gfi..mth.gfi+mth.ngfi) THEN
      BEGIN h.cti _ mth.config; RETURN[TRUE]; END;
    RETURN[FALSE];
    END;
  h.pContext _ nullPHandle;
  [] _ DLoadState.Acquire[ ! DLoadState.Invalid =>
    {h.lContext _ NIL; h.gContext _ NIL; GOTO noContext}];
  [cgfi, config] _ MapRC[Gf.Original[f]];
  IF config = NullConfig THEN ERROR Frames.Invalid[f];
  h.config _ config;
  bcd _ DLoadState.AcquireBcd[config];
  [] _ BcdOps.ProcessModules[bcd, FindWhichModule ! UNWIND => Cleanup[bcd]];
  data.initBCD _ FALSE;
  Cleanup[bcd];
  RETURN
  EXITS noContext => NULL;
  END;
  
  SetRootConfig: PUBLIC PROC [config: STRING] =
    BEGIN
    Rcount: CARDINAL _ 0;
    configdesc: Strings.SubStringDescriptor;
    savecti: CTIndex _ CTNull;
    saveconfig: ConfigIndex;
    data: State.Handle _ State.Get[];
    
    GetSetUp: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
      BEGIN
      found: BOOLEAN _ FALSE;
      bcd: BcdBase;
      CheckForRoot: PROC [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
	BEGIN
	IF UserInput.userAbort THEN Cleanup[bcd,TRUE];
	IF cth.config # CTNull THEN RETURN[FALSE];
	IF ~(found _ TestName[cth.name]) THEN
	  IF cth.namedInstance
	    THEN found _ TestName[FindName[bcd,[config[cti]]]];
	IF found THEN
	  BEGIN savecti _ cti; Rcount _ Rcount+1; saveconfig _ config; END;
	RETURN[FALSE]
	END;
      TestName: PROCEDURE [name: NameRecord] RETURNS [BOOLEAN] =
	BEGIN OPEN Strings;
	tempssb: NameString = LOOPHOLE[bcd+bcd.ssOffset];
	ssd: SubStringDescriptor _ 
	  [base: @tempssb.string, offset: name, length: tempssb.size[name]];
	RETURN[EqualSubStrings[@configdesc, @ssd]]
	END;
      bcd _ DLoadState.AcquireBcd[config];
      IF bcd.nConfigs = 0 AND bcd.nModules = 1 THEN
	BEGIN  
	mth: MTHandle _ @LOOPHOLE[bcd+bcd.mtOffset, Base][FIRST[MTIndex]];
	IF ~(found _ TestName[mth.name]) THEN 
	  IF mth.namedInstance  
	    THEN found _ TestName[FindName[bcd,[module[FIRST[MTIndex]]]]];
	IF found THEN
	  BEGIN Rcount _ Rcount+1; saveconfig _ config; savecti _ CTNull; END;
	END
      ELSE [] _ ProcessConfigs[bcd, CheckForRoot];
      DLoadState.ReleaseBcd[bcd];
      RETURN[FALSE]
      END;
      
    strings[rconfig] _ config;
    configdesc _ Strings.SubStringDescriptor[
      base: config, offset: 0, length: config.length];
    [] _ DLoadState.Acquire[];
    [] _ DLoadState.Enumerate[recentfirst,GetSetUp ! UNWIND => DLoadState.Release[]];
    SELECT Rcount FROM
      = 0 => BEGIN DLoadState.Release[]; NotFound[config] END;
      = 1 => SetupRootConfig[saveconfig, savecti];
      ENDCASE => {DLoadState.Release[]; WriteAmbiguousContext[config, Rcount]};
    RETURN
    END;
    
  SetConfig: PUBLIC PROC [config: STRING] =
    BEGIN
    bcd: BcdBase;
    count: CARDINAL _ 0;
    configdesc: Strings.SubStringDescriptor;
    savecti: CTIndex;
    data: State.Handle _ State.Get[];
    
    CheckConfigName: PROC [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
      BEGIN
      found: BOOLEAN _ FALSE;
      ssb: NameString _ LOOPHOLE[bcd+bcd.ssOffset];
      TestName: PROCEDURE [ssb: NameString, name: NameRecord] RETURNS [BOOLEAN] =
	BEGIN OPEN Strings;
	ssd: SubStringDescriptor _ 
	  [base: @ssb.string, offset: name, length: ssb.size[name]];
	RETURN[EqualSubStrings[@configdesc, @ssd]]
	END;
	
      IF UserInput.userAbort THEN SIGNAL DebugOps.UserAborted;
      IF ~SameConfig[bcd, cth.config, data.cti] THEN RETURN[FALSE];
      IF ~(found _ TestName[ssb, cth.name]) THEN
	IF cth.namedInstance THEN
	  found _ TestName[ssb, FindName[bcd,[config[cti]]]];
    IF found THEN BEGIN count _ count + 1; savecti _ cti; END;
    RETURN[FALSE]
    END;
    strings[config] _ config;
    configdesc _ Strings.SubStringDescriptor[
      base: config, offset: 0, length: config.length];
    IF data.cti = CTNull 
      THEN BEGIN DOutput.Text[" -- Not allowed !"L]; RETURN END;
    [] _ DLoadState.Acquire[];
    bcd _ DLoadState.AcquireBcd[data.config];
    [] _ ProcessConfigs[bcd, CheckConfigName ! UNWIND => Cleanup[bcd]];
    SELECT count FROM
      = 0 => NotFound[config];
      = 1 => IF SetupConfig[bcd, savecti, data.config] THEN data.cti _ savecti;
      ENDCASE => WriteAmbiguousContext[config, count ! UNWIND => Cleanup[bcd]];
    Cleanup[bcd];
    RETURN
    END;
    
  NotFound: PROC [s: STRING]= {
    DOutput.EOL[]; DOutput.Text[s]; DOutput.Line[" not found!"L]};
    
  SetModule: PUBLIC PROC [mod: STRING] = {
    gf: MachineDefs.GFHandle _
      IF DebugOps.Numeric[mod] THEN LOOPHOLE[DebugOps.StringExpToOctal[mod]] 
      ELSE Gf.Frame[mod ! Gf.CopiedFrame => RESUME];
    strings[module] _ mod;
    IF gf = NIL THEN RETURN;
    SetGlobal[gf]};
    
  -- retrieving
  
  GetOctal: PUBLIC PROC RETURNS [p: POINTER] =
    BEGIN RETURN [State.Get[].h.lContext] END;
    
  GetGlobal: PUBLIC PROC RETURNS [gf: MachineDefs.GFHandle] =
    BEGIN RETURN [State.Get[].h.gContext] END;
    
  GetLocal: PUBLIC PROC RETURNS [lf: MachineDefs.FHandle] =
    BEGIN RETURN [State.Get[].h.lContext] END;
    
  GetProcess: PUBLIC PROC RETURNS [p: MachineDefs.PHandle] =
    BEGIN RETURN [State.Get[].h.pContext] END;
    
  GetRootConfig: PUBLIC PROC RETURNS [config: STRING] =
    BEGIN config _ strings[rconfig] END;
    
  GetConfig: PUBLIC PROC RETURNS [config: STRING] =
    BEGIN config _ strings[config] END;
    
  GetModule: PUBLIC PROC RETURNS [mod: STRING] =
    BEGIN
    mod _ strings[module];
    IF mod # NIL THEN RETURN;
    mod _ Storage.String[40];
    strings[module] _ mod;
    Gf.Name[mod,GetGlobal[]];
    END;
    
  GetRootConfigIndex: PUBLIC PROC
      RETURNS [config: ConfigIndex] =
    BEGIN RETURN [State.Get[].h.config] END;
    
  GetConfigIndex: PUBLIC PROC RETURNS [cti: BcdDefs.CTIndex] =
    BEGIN RETURN [State.Get[].h.cti] END;
    
  -- utilities
  
DisplayCurrent: PUBLIC PROCEDURE =
  BEGIN OPEN DLoadState;
  h: State.Handle _ State.Get[];
  module: STRING _ [40];
  bcd: BcdOps.BcdBase _ NIL;
  BEGIN ENABLE UNWIND => Cleanup[bcd];
  [] _ DLoadState.Acquire[ ! DLoadState.Invalid => GOTO noContext];
  DOutput.EOL[];
  Gf.Display[h.gContext, "Module:"L];
  IF h.lContext # NIL THEN
    BEGIN DOutput.Text[", L"L]; WCS[]; DOutput.Octal[h.lContext]; END;
  IF h.pContext # nullPHandle THEN
    BEGIN DOutput.Text[", PSB"L]; WCS[]; DOutput.Octal[h.pContext]; END;
  DOutput.EOL[];
  bcd _ DLoadState.AcquireBcd[h.config];
  IF bcd.nConfigs # 0 THEN
    BEGIN
    cth: CTHandle _ @LOOPHOLE[bcd+bcd.ctOffset, Base][h.cti];
    ssb: NameString _ LOOPHOLE[bcd+bcd.ssOffset];
    DOutput.Text["  Configuration"L]; WCS[];
    IF cth.namedInstance THEN
      BEGIN
      PrintName[ssb, BcdOps.FindName[bcd,[config[h.cti]]]];
      WCS[];
      END;
    PrintName[ssb,cth.name];
    DOutput.EOL[];
    END;
  END;
  Cleanup[bcd];
  RETURN
  EXITS
    noContext => DOutput.Text["No valid context!!"L];
  END;
  
  ListConfigs: PUBLIC PROCEDURE =
    BEGIN
    PrintConfigs: PROCEDURE [config: ConfigIndex] RETURNS [BOOLEAN] =
      BEGIN
      bcd: BcdBase;
      tempssb: NameString;
      ListSons: PROCEDURE [level: CARDINAL, parent: CTIndex] =
	BEGIN
	WriteNames: PROC [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
	  BEGIN
	  IF cth.config = parent THEN
	    BEGIN
	    IF UserInput.userAbort THEN Cleanup[bcd,TRUE];
	    DOutput.EOL[];
	    DOutput.Blanks[level*2];
	    IF cth.namedInstance THEN
	      BEGIN
	      PrintName[tempssb, FindName[bcd,[config[cti]]]];
	      DOutput.Text[": "L];
	      END;
	    PrintName[tempssb, cth.name];
	    ListSons[level+1, cti];
	    END;
	  RETURN[FALSE]
	  END;
	[] _ EnumerateConfigNames[bcd, WriteNames];
	RETURN
	END;
      bcd _ DLoadState.AcquireBcd[config];
      tempssb _ LOOPHOLE[bcd+bcd.ssOffset];
      ListSons[0, CTNull];
      DLoadState.ReleaseBcd[bcd];
      RETURN[FALSE]
      END;
    [] _ DLoadState.Acquire[];
    [] _ DLoadState.Enumerate[recentfirst, PrintConfigs ! UNWIND => DLoadState.Release[]];
    DLoadState.Release[];
    RETURN
    END;
    
  EnumerateConfigNames: PROCEDURE [
    bcd: BcdBase, proc: PROCEDURE [CTHandle, CTIndex] RETURNS [BOOLEAN]]
    RETURNS[CTIndex]=
    BEGIN
    mth: MTHandle = @LOOPHOLE[bcd+bcd.mtOffset, Base][FIRST[MTIndex]];
    tempssb: NameString = LOOPHOLE[bcd+bcd.ssOffset];
    IF bcd.nConfigs = 0 AND bcd.nModules = 1 THEN
      BEGIN
      DOutput.EOL[];
      IF mth.namedInstance THEN
	BEGIN
	PrintName[tempssb, FindName[bcd,[module[FIRST[MTIndex]]]]];
	DOutput.Text[": "L];
	END;
      PrintName[tempssb, mth.name];
      RETURN[CTNull];
      END;
    RETURN[ProcessConfigs[bcd, proc].cti]
    END;
    
  DisplayConfig: PUBLIC PROCEDURE =
    BEGIN
    bcd: BcdBase _ NIL;
    ssb: NameString;
    map: DLoadState.Map;
    data: State.Handle _ State.Get[];
    PrintModules: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      IF UserInput.userAbort THEN Cleanup[bcd,TRUE];
      DOutput.EOL[];
      IF ~SameConfig[bcd, mth.config, data.cti] THEN RETURN[FALSE];
      IF mth.namedInstance THEN
	BEGIN
	PrintName[ssb, FindName[bcd,[module[mti]]]];
	DOutput.Text[": "L];
	END;
      PrintName[ssb, mth.name]; DOutput.Text[", G: "L];
      Gf.DisplayGFTEntry[map[mth.gfi]];
      RETURN[FALSE];
      END;
    BEGIN ENABLE UNWIND => Cleanup[bcd];
    [] _ DLoadState.Acquire[];
    bcd _ DLoadState.AcquireBcd[data.config];
    map _ DLoadState.GetMap[data.config];
    ssb _ LOOPHOLE[bcd+bcd.ssOffset];
    DOutput.Blanks[2];
    IF bcd.nConfigs # 0 THEN
      BEGIN
      cth: CTHandle _ @LOOPHOLE[bcd+bcd.ctOffset, Base][data.cti];
      IF cth.namedInstance THEN
	BEGIN
	PrintName[ssb, FindName[bcd,[config[data.cti]]]];
	DOutput.Text[": "L];
	END;
      PrintName[ssb, cth.name];
      END;
    [] _ ProcessModules[bcd,PrintModules];
    DLoadState.ReleaseMap[map];
    END;
    Cleanup[bcd];
    RETURN;
    END;
    
  SetupRootConfig: PROCEDURE [config: ConfigIndex, cti: CTIndex] =
    BEGIN
    -- LoadState already in
    bcd: BcdBase _ DLoadState.AcquireBcd[config];
    IF SetupConfig[bcd, cti, config] THEN
      BEGIN
      data: State.Handle _ State.Get[];
      data.config _ config;
      data.cti _ cti;
      END;
    Cleanup[bcd]; -- releases LoadState
    RETURN
    END;
    
  SetupConfig: PROCEDURE [
    bcd: BcdBase, cti: CTIndex, config: ConfigIndex] RETURNS [BOOLEAN] =
    BEGIN
    mth: MTHandle;
    data: State.Handle _ State.Get[];
    FindFirstModule: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      RETURN[SameConfig[bcd, mth.config, cti] AND
	~Gf.Deleted[DLoadState.MapConfigToReal[mth.gfi, config]]]
      END;
    mth _ ProcessModules[bcd, FindFirstModule].mth;
    IF mth # NIL THEN
      BEGIN
      data.gContext _ GfiToFrame[DLoadState.MapConfigToReal[mth.gfi, config]];
      data.lContext _ NIL;
      data.pContext _ nullPHandle;
      data.howSet _ global;
      RETURN[TRUE];
      END
    ELSE
      BEGIN
      DOutput.Text[" -- Not Allowed !"L];
      RETURN[FALSE];
      END;
    END;
    
  Enumerate: PUBLIC PROCEDURE [
    proc: PROCEDURE [MachineDefs.GFHandle] RETURNS [BOOLEAN]] =
    --sequences through frames of modules in current config
    BEGIN
    bcd: BcdBase;
    map: DLoadState.Map;
    data: State.Handle _ State.Get[];
    
    SearchModules: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      frame: MachineDefs.GFHandle;
      IF UserInput.userAbort THEN SIGNAL DebugOps.UserAborted;
      IF ~SameConfig[bcd, mth.config, data.cti] THEN RETURN[FALSE];
      frame _ GfiToFrame[map[mth.gfi]];
      IF frame = NullGF THEN RETURN[FALSE];
      Gf.Check[frame];
      IF proc[frame] THEN RETURN[TRUE];
      RETURN[FALSE];
      END;
      
    CleanupMap: PROCEDURE [map: DLoadState.Map, bcd: BcdBase] =
      BEGIN
      DLoadState.ReleaseMap[map];
      Cleanup[bcd];
      RETURN
      END;
      
    [] _ DLoadState.Acquire[ ! DLoadState.Invalid => GOTO nil];
    map _ DLoadState.GetMap[data.config];
    [] _ ProcessModules[bcd _ DLoadState.AcquireBcd[data.config], SearchModules
      ! UNWIND => CleanupMap[map, bcd]];
    CleanupMap[map, bcd];
    RETURN
    EXITS
      nil => RETURN;
    END;
    
  WriteAmbiguousContext: PROCEDURE [s: STRING, c: CARDINAL] =
    BEGIN OPEN DOutput;
    Char['!]; Text[s]; Text[" has "L]; Decimal[c];
    Line[" instances -- this is an ambiguous reference."L];
    RETURN
    END;
    
  MapRC: PUBLIC PROCEDURE [f: MachineDefs.GFHandle]
    RETURNS [cgfi: MachineDefs.GFTIndex, config: MachineDefs.ConfigIndex] =
    BEGIN
    [cgfi, config] _ DLoadState.MapRealToConfig[Gf.GFI[f]];
    RETURN
    END;
    
  CheckForExtension: PROCEDURE [name, ext: STRING] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..name.length) DO
      IF name[i] = '. THEN RETURN;
      ENDLOOP;
    String.AppendString[name, ext];
    RETURN
    END;
    
  Cleanup: PROCEDURE [bcd: BcdBase, abort: BOOLEAN _ FALSE] =
    BEGIN
    IF bcd # NIL THEN DLoadState.ReleaseBcd[bcd];
    DLoadState.Release[];
    IF abort THEN SIGNAL DebugOps.UserAborted;
    END;
    
  PrintName: PROCEDURE [ssb: NameString, name: NameRecord] =
    BEGIN
    ssd: Strings.SubStringDescriptor _
      [base: @ssb.string, offset: name, length: ssb.size[name]];
    DOutput.SubString[@ssd];
    RETURN
    END;
    
  WCS: PROC = {DOutput.Text[": "L]};
  
  SameConfig: PUBLIC PROC [bcd: BcdOps.BcdBase, child, parent: CTIndex]
      RETURNS [BOOLEAN]=
    BEGIN OPEN BcdDefs;
    cti: BcdDefs.CTIndex;
    ctb: Base = LOOPHOLE[bcd+bcd.ctOffset];
    --checks to see if child is related to parent
    FOR cti _ child, ctb[cti].config UNTIL cti = CTNull DO
      IF cti = parent THEN RETURN[TRUE];
      ENDLOOP;
    RETURN[parent = CTNull]
    END;
    
  END.