-- File: XDUtils.mesa  edit by:
  -- Bruce October 7, 1980  12:21 PM
  -- Johnsson July 18, 1980  11:45 AM

DIRECTORY
  Actions USING [],
  BcdDefs USING [VersionStamp],
  Commands USING [],
  CompilerUtil USING [debug, error, parse, TableId],
  DebugOps USING [Abort],
  DLoadState USING [offset, state],
  DOutput USING [Line, Text],
  DSymOps USING [],
  Event USING [Notify],
  ImageDefs USING [ImageVersion],
  ImageFormat USING [ImageHeader, VersionID],
  Init USING [CommandTab, DebugTab, DIGrammar, FlushCaches, myPlace],
  MachineDefs USING [PageNumber, PageSize],
  MiscDefs USING [DestroyFakeModule],
  NubOps USING [Place],
  Profile USING [],
  OsStaticDefs USING [OsStatics],
  SegmentDefs USING [
    LongFileSegmentAddress, DefaultAccess, DeleteFileSegment, FileHandle, FileNameError,
    FileSegmentAddress, FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment,
    PageCount, Read, SwapIn, Unlock],
  State USING [GetGS, GSHandle, strings],
  Storage USING [Pages],
  String USING [AppendString],
  StringDefs USING [MesaToBcplString],
  Table USING [Base, Region],
  TajoMisc USING [],
  TajoOps USING [LimitAllWindowBoxes],
  UserTerminalOps USING [SetBitmapBox],
  Window USING [Box];

XDUtils: PROGRAM
  IMPORTS
    DebugOps, DLoadState, DOutput, Event, ImageDefs, Init, MiscDefs,
    SegmentDefs, State, Storage, String, StringDefs, TajoOps, UserTerminalOps
  EXPORTS Actions, CompilerUtil, DebugOps, DSymOps, NubOps, Profile, TajoMisc =
  BEGIN OPEN CompilerUtil;

  bitmap: PUBLIC Window.Box;
  data: State.GSHandle _ State.GetGS[];
  myVersion: PUBLIC BcdDefs.VersionStamp _ ImageDefs.ImageVersion[];

  NonExistentMemoryPage: PUBLIC ERROR [page: MachineDefs.PageNumber] = CODE;
  WriteProtected: PUBLIC SIGNAL [page: CARDINAL] = CODE;

  WhereAmI: PUBLIC PROCEDURE RETURNS [NubOps.Place] = {RETURN[Init.myPlace]};

  Tab: TYPE = RECORD [seg: SegmentDefs.FileSegmentHandle, state: {in, out}];

  tables: ARRAY TableId[parse..debug] OF Tab _ ALL[[NIL,out]];

  LockTableSegment: PUBLIC PROC [id: TableId] RETURNS [LONG POINTER] = 
    BEGIN
    seg: SegmentDefs.FileSegmentHandle;
    IF id ~IN TableId[parse..debug] THEN ERROR;
    seg _ IF tables[id].seg = NIL THEN TableSegment[id] ELSE tables[id].seg;
    IF tables[id].state = out THEN {
      SegmentDefs.SwapIn[seg]; tables[id].seg _ seg; tables[id].state _ in};
    RETURN [SegmentDefs.LongFileSegmentAddress[seg]];
    END;

  TableSegment: PUBLIC PROCEDURE [id: TableId]
      RETURNS [seg: SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN CompilerUtil, Init;
    offset: CARDINAL;
    [seg, offset] _ MiscDefs.DestroyFakeModule[SELECT id FROM
	parse => LOOPHOLE[DIGrammar],
	error => LOOPHOLE[CommandTab],
	debug => LOOPHOLE[DebugTab],
	ENDCASE => ERROR];
    IF offset # 0 THEN ERROR;
    RETURN[seg];
    END;

  UnlockTableSegment: PUBLIC PROC [id: CompilerUtil.TableId] = {
    IF id ~IN CompilerUtil.TableId[parse..debug] THEN ERROR;
    IF tables[id].state = in THEN {
      SegmentDefs.Unlock[tables[id].seg]; tables[id].state _ out}};


  SetBitmap: PUBLIC PROCEDURE [box: Window.Box] =
    BEGIN
    bitmap _ UserTerminalOps.SetBitmapBox[box];
    TajoOps.LimitAllWindowBoxes[];
    Event.Notify[setDefaults];
    END;
    
  SetUserName: PUBLIC PROCEDURE [s: STRING] =
    BEGIN OPEN String;
    userName: STRING _ State.strings[user];
    userName.length _ 0;
    AppendString[userName,s];
    StringDefs.MesaToBcplString[s: s, t: OsStaticDefs.OsStatics.UserName];
    Event.Notify[setDefaults];
    END;
    
  SetUserPassword: PUBLIC PROCEDURE [s: STRING] =
    BEGIN
    password: STRING _ State.strings[password];
    password.length _ 0;
    String.AppendString[password,s];
    StringDefs.MesaToBcplString[s: s, t: OsStaticDefs.OsStatics.UserPassword];
    Event.Notify[setDefaults];
    END;
    
  ImageError: PROC [name: STRING] = {
    DOutput.Text[name]; DOutput.Text[" is an invalid image file!"L];
    SIGNAL DebugOps.Abort};

AttachImage: PUBLIC PROCEDURE [file: STRING] = {DoAttach[file, FALSE]};
AttachLoadState: PUBLIC PROCEDURE [file: STRING] = {DoAttach[file, TRUE]};

DoAttach: PROCEDURE [file: STRING, old: BOOLEAN] =
  BEGIN OPEN SegmentDefs;
  fileHandle: FileHandle;
  oldseg, seg: FileSegmentHandle;
  ImageRec: TYPE = RECORD [SELECT OVERLAID * FROM
    imageFile => [image: ImageFormat.ImageHeader],
    runFile => [pad: UNSPECIFIED, page: SegmentDefs.PageCount],
    ENDCASE];
  pass: {one,two} _ one;
  header: POINTER TO ImageRec;
  base, pages: CARDINAL;
  DLoadState.offset _ 0;
  CheckForExtension[file, ".image"L];
  fileHandle _ NewFile[file, DefaultAccess !
    FileNameError => {ImageError[file]; ERROR}];
  seg _ NewFileSegment[fileHandle, 1, 1, Read];
  DO
    SwapIn[seg];
    header _ FileSegmentAddress[seg];
    IF header.image.prefix.versionident = ImageFormat.VersionID THEN EXIT;
    Unlock[seg];
    IF pass = one THEN {
     DLoadState.offset _ header.page;
     MoveFileSegment[seg, header.page + 1, 1];
     pass _ two}
    ELSE {DeleteFileSegment[seg]; ImageError[file]};
    ENDLOOP;
  base _ DLoadState.offset + (IF old THEN header.image.prefix.initialLoadStateBase
    ELSE header.image.prefix.loadStateBase);
  pages _ header.image.prefix.loadStatePages;
  Unlock[seg];
  MoveFileSegment[seg, base, pages];
  IF (oldseg _ DLoadState.state) # NIL THEN
    BEGIN
    UNTIL oldseg.lock = 0 DO Unlock[oldseg]; ENDLOOP;
    DeleteFileSegment[oldseg];
    END;
  DLoadState.state _ seg;
  data.initBCD _ TRUE;
  Init.FlushCaches[newFiles];
  RETURN
  END;

  CheckForExtension: PUBLIC PROC [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;
  
  TeleDebug: PUBLIC PROC [STRING] = {DOutput.Line["ReMote debugging not implemented!"L]};

  SymbolTablePages: CARDINAL = 25;
  SymbolTableSize: CARDINAL = SymbolTablePages*MachineDefs.PageSize;

  GetRegion: PUBLIC PROCEDURE RETURNS [r: Table.Region] = {
    r.origin _ LOOPHOLE[Storage.Pages[SymbolTablePages], Table.Base];
    r.size _  SymbolTableSize};

  END.