-- XDUserSegments.Mesa
-- Edited by:
--             Sandman on July 22, 1980  5:07 PM
--             Johnsson on August 30, 1978  12:02 PM
--             Barbara on April 6, 1979  12:22 PM
--             Bruce on October 3, 1980  5:04 PM

DIRECTORY
  AltoDefs USING [BYTE, BytesPerPage, PageNumber],
  AltoFileDefs USING [eofDA, FP],
  BcdDefs USING [Base, CodeDesc, FTNull, FTSelf, GFTIndex, MTIndex],
  BcdOps USING [BcdBase, FTHandle, MTHandle, NameString, ProcessModules, SGHandle],
  ControlDefs USING [InstWord],
  DebugFormat USING [CodeObject],
  DebugOps USING [CacheNewFile, LongREAD, LongWRITE, ShortCopyREAD, ShortCopyWRITE],
  DLoadState USING [Acquire, AcquireBcd, MapRealToConfig, ReleaseBcd, Release],
  Drum USING [DrumItem, Handle],
  Frames USING [Invalid],
  Gf USING [Check, GFI, Handle, Original],
  Init USING [bootLoaded],
  Inline USING [LongNumber],
  MachineDefs USING [BYTE, BytePC, FHandle, GFTIndex, GlobalFrame, GFHandle, NullConfig],
  Mopcodes USING [zRBL],
  SegmentDefs USING [
    AddressFromPage, BankIndex, DefaultAccess, DeleteFileSegment, FileHandle, FileHint,
    FileObject, FileSegmentAddress, FileSegmentHandle, FileSegmentObject,
    InsertFile, InvalidFP, LongAddressFromPage, LongVMtoFileSegment, NewFileSegment,
    PageFromAddress, PageNumber, Read, ReleaseFile, SegmentFault, SetEndOfFile,
    SwapIn, SwapOut, Unlock],
  State USING [GetGS, GSHandle],
  Storage USING [Free, Node],
  String USING [AppendString],
  Strings USING [AppendSubString, SubStringDescriptor];

XDUserSegments: PROGRAM
  IMPORTS BcdOps, DebugOps, DLoadState, Frames, Gf, Init,
    SegmentDefs, State, Storage, String, Strings
  EXPORTS DebugOps, Drum, Gf =

BEGIN OPEN DebugOps, DebugFormat, Gf, Drum, MachineDefs;

FrameHandle: TYPE = MachineDefs.FHandle;
GlobalFrameHandle: TYPE = MachineDefs.GFHandle;
FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;

NoCode: ERROR = CODE;

data: State.GSHandle _ State.GetGS[];

-- Utilities

UserSegment: SegmentDefs.FileSegmentObject;

ReadUserSegment: PROCEDURE [s: FileSegmentHandle] RETURNS [FileSegmentHandle] =
  BEGIN
  ShortCopyREAD[to: @UserSegment, from: s,
    nwords: SIZE[SegmentDefs.FileSegmentObject]];
  RETURN [@UserSegment]
  END;

WriteUserSegment: PROCEDURE [s: FileSegmentHandle] =
  BEGIN
  ShortCopyWRITE[ to: s, from: @UserSegment,
    nwords: SIZE[SegmentDefs.FileSegmentObject]];
  END;

-- "Swapping Drum" and user code manipulation

  diHead: Handle _ NIL;
  endHint: SegmentDefs.FileHint;
  endPage: AltoDefs.PageNumber;
  drumFile: SegmentDefs.FileHandle;

  MoveToDrum: PROCEDURE [f: GlobalFrameHandle, co: CodeObject] =
    BEGIN
    LocateCode[f];
    IF gfCache.seg # NIL THEN Alloc[gfCache.seg].di.co _ co;
    FlushCodeCache[];
    RETURN
    END;

  Alloc: PUBLIC PROCEDURE [useg: FileSegmentHandle]
    RETURNS [di: Handle] =
    BEGIN OPEN SegmentDefs;
    p: Handle;
    lfo: FileObject;
    tfile: FileHandle = @lfo; -- copy of user file object
    tseg: FileSegmentHandle; -- copy of user segment
    dseg: FileSegmentHandle = MapUSeg[useg];
    old: FileHandle = dseg.file;
    di _ Storage.Node[SIZE[DrumItem]];
    di.next _ NIL;
    di.dseg _ dseg;
    -- copy values from user segment
    tseg _ ReadUserSegment[di.useg _ useg];
    di.oldBase _ tseg.base;
    di.oldFile _ tseg.file;
    WITH t: tseg SELECT FROM
      disk => di.oldHint _ t.hint;
      ENDCASE => ERROR RemoteSeg[useg
	! UNWIND => Storage.Free[di]];
    -- remove segment from user's file object
    ShortCopyREAD[to: tfile, from: tseg.file, nwords: SIZE[FileObject]];
    tfile.lock _ tfile.lock + 1;
    tfile.segcount _ tfile.segcount - 1;
    IF tseg.swappedin THEN tfile.swapcount _ tfile.swapcount - 1;
    ShortCopyWRITE[from: tfile, to: tseg.file, nwords: SIZE[FileObject]];
    -- move user segment to drum file
    tseg.file _ data.ESV.drumFile;
    tseg.base _ endPage;
    -- reflect new seg and swap counts in users drum file object
    ShortCopyREAD[
      to: tfile, from: data.ESV.drumFile, nwords: SIZE[FileObject]];
    tfile.segcount _ tfile.segcount + 1;
    IF tseg.swappedin THEN tfile.swapcount _ tfile.swapcount + 1;
    ShortCopyWRITE[
      from: tfile, to: data.ESV.drumFile, nwords: SIZE[FileObject]];
    SwapIn[dseg];
    dseg.write _ TRUE;
    -- update seg and swap counts for debugger's files
    old.swapcount _ old.swapcount - 1;
    IF (old.segcount _ old.segcount - 1) = 0 THEN
      ReleaseFile[old];
    drumFile.segcount _ drumFile.segcount + 1;
    drumFile.swapcount _ drumFile.swapcount + 1;
    -- move drum segment to drum file
    dseg.file _ drumFile;
    dseg.base _ endPage;
    WITH d: dseg SELECT FROM
      disk => d.hint _ endHint;
      ENDCASE;
    endPage _ endPage + dseg.pages;
    Unlock[dseg];
    SwapOut[dseg !
      SegmentFault =>
	BEGIN
	SetEndOfFile[drumFile,endPage-1,AltoDefs.BytesPerPage];
	RETRY
	END];
    WITH d: dseg SELECT FROM
      disk => endHint _ d.hint;
      ENDCASE;
    WITH t: tseg SELECT FROM
      disk => t.hint _ endHint;
      ENDCASE;
    WriteUserSegment[useg];
    dseg.write _ FALSE;
    -- add new item to end of list
    IF diHead = NIL THEN diHead _ di
    ELSE FOR p _ diHead, p.next UNTIL p.next = NIL DO
      NULL;
      REPEAT FINISHED => p.next _ di;
      ENDLOOP;
    RETURN
    END;

  Free: PUBLIC PROCEDURE [f: GlobalFrameHandle] =
    BEGIN
    LocateCode[f];
    IF gfCache.seg # NIL THEN Remove[gfCache.seg];
    FlushCodeCache[];
    RETURN
    END;

  Remove: PUBLIC PROCEDURE [useg: FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    lfo: FileObject;
    tfile: FileHandle = @lfo; -- copy of user file object
    tseg: FileSegmentHandle; -- copy of user segment
    prev, di: Handle;
    -- find item on the list
    prev _ NIL;
    FOR di _ diHead, di.next UNTIL di = NIL DO
      IF di.useg = useg THEN EXIT;
      prev _ di;
      REPEAT FINISHED => RETURN
      ENDLOOP;
    IF prev = NIL THEN diHead _ di.next
    ELSE prev.next _ di.next;
    -- put old values back into user segment
    tseg _ ReadUserSegment[useg];
    tseg.file _ di.oldFile;
    tseg.base _ di.oldBase;
    WITH t: tseg SELECT FROM
      disk => t.hint _ di.oldHint;
      ENDCASE;
    -- add segment to original file
    ShortCopyREAD[to: tfile, from: tseg.file, nwords: SIZE[FileObject]];
    tfile.lock _ tfile.lock - 1;
    tfile.segcount _ tfile.segcount + 1;
    IF tseg.swappedin THEN tfile.swapcount _ tfile.swapcount + 1;
    ShortCopyWRITE[from: tfile, to: tseg.file, nwords: SIZE[FileObject]];
    -- remove segment from drum file
    ShortCopyREAD[
      to: tfile, from: data.ESV.drumFile, nwords: SIZE[FileObject]];
    tfile.segcount _ tfile.segcount - 1;
    IF tseg.swappedin THEN tfile.swapcount _ tfile.swapcount - 1;
    ShortCopyWRITE[
      from: tfile, to: data.ESV.drumFile, nwords: SIZE[FileObject]];
    WriteUserSegment[useg];
    -- update end values and shuffle
    WITH s: di.dseg SELECT FROM
      disk => endHint _ s.hint;
      ENDCASE;
    endPage _ di.dseg.base;
    DeleteFileSegment[di.dseg]; -- delete the real debugger segment
    ShuffleDrum[di.next];
    Storage.Free[di];
    RETURN
    END;

  CodeOnDrum: PROCEDURE [co: CodeObject] RETURNS [BOOLEAN] =
    BEGIN
    di: Handle;
    FOR di _ diHead, di.next UNTIL di = NIL DO
      IF di.co = co THEN RETURN[TRUE];
      ENDLOOP;
    RETURN[FALSE];
    END;

  ShuffleDrum: PROCEDURE [di: Handle] =
    -- Starting with di, shuffle segments to lower addresses on the drum
    -- and update the user's copies
    BEGIN OPEN SegmentDefs;
    seg: FileSegmentHandle;
    useg: FileSegmentHandle;
    UNTIL di = NIL DO
      SwapIn[seg _ di.dseg];
      useg _ ReadUserSegment[di.useg];
      useg.base _ seg.base _ endPage;
      WITH s: seg SELECT FROM
	disk => s.hint _ endHint;
	ENDCASE;
      WITH u: useg SELECT FROM
	disk => u.hint _ endHint;
	ENDCASE;
      WriteUserSegment[di.useg];
      endPage _ endPage + seg.pages;
      Unlock[seg];
      SwapOut[seg];
      WITH s: seg SELECT FROM
	disk => endHint _ s.hint;
	ENDCASE;
      di _ di.next;
      ENDLOOP;
    END;

  RemoteSeg: PUBLIC SIGNAL [seg: FileSegmentHandle] = CODE;

  MapUSeg: PUBLIC PROCEDURE [useg: FileSegmentHandle] RETURNS [seg: FileSegmentHandle]=
    -- Return a segment in the debugger space for the given user segment
    BEGIN OPEN SegmentDefs;
    tempseg:  FileSegmentHandle;
    localfp: AltoFileDefs.FP;
    tempseg _ ReadUserSegment[useg];
    IF tempseg = NIL OR tempseg.file = NIL THEN RETURN[NIL];
    ShortCopyREAD[
      from: @tempseg.file.fp,
      to: @localfp,
      nwords: SIZE[AltoFileDefs.FP]];
    seg _ NewFileSegment[
      InsertFile[@localfp, Read],tempseg.base,tempseg.pages,Read];
    WITH s: seg SELECT FROM
      disk =>
	s.hint _ WITH t: tempseg SELECT FROM
	  disk => t.hint,
	  ENDCASE => FileHint[AltoFileDefs.eofDA, 0];
      ENDCASE;
    RETURN
    END;

  Initialize: PUBLIC PROCEDURE =
    BEGIN
    next: Handle;
    UNTIL diHead = NIL DO
      next _ diHead.next;
      SegmentDefs.DeleteFileSegment[diHead.dseg];
      Storage.Free[diHead];
      diHead _ next;
      ENDLOOP;
    drumFile _ data.debuggeeFH;
    endHint _ [AltoFileDefs.eofDA, 0];
    endPage _ 256;  -- after core image
    SegmentDefs.SetEndOfFile[drumFile,endPage+19,AltoDefs.BytesPerPage];
    RETURN
    END;

  GetInst: PROC [offset: INTEGER] RETURNS [iword: ControlDefs.InstWord] = {
    SegmentDefs.SwapIn[gfCache.dseg];
    iword _ (SegmentDefs.FileSegmentAddress[gfCache.dseg]+gfCache.offset+offset)^;
    SegmentDefs.Unlock[gfCache.dseg]};

  ReadCodeByte: PUBLIC PROCEDURE [gf: GFHandle, pc: BytePC] RETURNS [BYTE] = {
    iword: ControlDefs.InstWord _ ReadCodeWord[gf,pc/2];
    RETURN[IF pc MOD 2 = 0 THEN iword.evenbyte ELSE iword.oddbyte]};

  ReadCodeWord: PUBLIC PROCEDURE [gf: GFHandle, offset: INTEGER] RETURNS [u: UNSPECIFIED] =
    BEGIN OPEN SegmentDefs;
    LocateCode[gf];
    SELECT TRUE FROM
      Init.bootLoaded => RETURN[GetInst[offset]];
      gfCache.in OR gfCache.seg = NIL => {
	lpc: LONG POINTER _ gfCache.p+offset;
	RETURN[LongREAD[lpc]]};
      gfCache.seg # NIL =>
	BEGIN ENABLE InvalidFP => GOTO bad;
	useg: FileSegmentHandle = ReadUserSegment[gfCache.seg];
	WITH useg SELECT FROM
	  remote => ERROR RemoteSeg[gfCache.seg];
	  ENDCASE;
	RETURN[GetInst[offset]];
	EXITS bad => RETURN[0];
	END;
      Init.bootLoaded => RETURN[GetInst[offset]];
      ENDCASE;
    ERROR NoCode;
    END;

  WriteCodeByte: PUBLIC PROCEDURE [gf: GlobalFrameHandle, pc: BytePC, inst: BYTE] =
    BEGIN
    iword: ControlDefs.InstWord;
    even: BOOLEAN;
    pi: POINTER TO ControlDefs.InstWord;
    co: CodeObject;
    even _ pc MOD 2 = 0;
    co _ Code[gf];
    IF Init.bootLoaded THEN RETURN;
    IF ~CodeOnDrum[co] THEN MoveToDrum[gf, co];
    LocateCode[gf];
    IF gfCache.in OR gfCache.seg = NIL THEN
      BEGIN
      iword _ LongREAD[gfCache.p+pc/2];
      IF even THEN iword.evenbyte _ inst ELSE iword.oddbyte _ inst;
      LongWRITE[gfCache.p+pc/2, iword];
      END;
    IF gfCache.seg # NIL THEN
      BEGIN OPEN SegmentDefs;
      useg: FileSegmentHandle = ReadUserSegment[gfCache.seg];
      WITH useg SELECT FROM
	remote => ERROR RemoteSeg[gfCache.seg];
	ENDCASE;
      gfCache.dseg.write _ TRUE;
      SwapIn[gfCache.dseg];
      pi _ FileSegmentAddress[gfCache.dseg]+gfCache.offset+pc/2;
      IF even THEN pi.evenbyte _ inst ELSE pi.oddbyte _ inst;
      Unlock[gfCache.dseg];
      END;
    RETURN
    END;

  COCacheObject: TYPE = RECORD [
    gf: GlobalFrameHandle,
    code: CodeObject];

  coCache: COCacheObject _ [NIL,];

  Code: PUBLIC PROCEDURE [f: GlobalFrameHandle] RETURNS [CodeObject] =
    BEGIN OPEN DLoadState, coCache;
    cgfi: MachineDefs.GFTIndex;
    bcd: BcdOps.BcdBase;
    FindModuleSeg: PROCEDURE [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
      RETURNS [BOOLEAN] =
      BEGIN
      IF cgfi IN[mth.gfi..mth.gfi+mth.ngfi) THEN {
	IF Init.bootLoaded THEN FindSeg[bcd, mth.code, f];
	code.seg _ mth.code.sgi; RETURN[TRUE]};
      RETURN[FALSE];
      END;
    IF coCache.gf = f THEN RETURN[code];
    [] _ Acquire[];
    [cgfi,code.config] _ MapRealToConfig[GFI[Original[f]]];
    IF code.config = NullConfig THEN ERROR Frames.Invalid[f];
    bcd _ AcquireBcd[code.config];
    [] _ BcdOps.ProcessModules[bcd, FindModuleSeg];
    ReleaseBcd[bcd];
    Release[];
    coCache.gf _ f;
    RETURN[code]
    END;


  FindSeg: PROC [bcd: BcdOps.BcdBase, code: BcdDefs.CodeDesc, gf: GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs;
    sgb: BcdDefs.Base = LOOPHOLE[bcd+bcd.sgOffset];
    sgh: BcdOps.SGHandle = @sgb[code.sgi];
    f: BcdOps.FTHandle = @LOOPHOLE[bcd+bcd.ftOffset, BcdDefs.Base][sgh.file];
    IF gfCache.gf = gf THEN RETURN;
    FlushCodeCache[];
    SELECT sgh.file FROM
      BcdDefs.FTNull => ERROR NoCode;
      BcdDefs.FTSelf => 
	BEGIN
	bcdseg: FileSegmentHandle _ LongVMtoFileSegment[bcd];
	gfCache.dseg _ NewFileSegment[bcdseg.file, sgh.base, sgh.pages, Read];
	END;
      ENDCASE => gfCache.dseg _ NewFileSegment[OpenFile[bcd,f], sgh.base, sgh.pages, Read];
    gfCache.gf _ gf; gfCache.seg _ NIL; gfCache.p _ NIL;
    gfCache.in _ FALSE; gfCache.offset _ code.offset;
    END;

  OpenFile: PROC [bcd: BcdOps.BcdBase, f: BcdOps.FTHandle]
    RETURNS [fh: SegmentDefs.FileHandle] = {
    ssb: BcdOps.NameString = LOOPHOLE[bcd+bcd.ssOffset];
    ss: Strings.SubStringDescriptor _ [@ssb.string, f.name, ssb.size[f.name]];
    name: STRING _ [40];
    Strings.AppendSubString[name, @ss];
    CheckExtension[name];
    fh _ DebugOps.CacheNewFile[name, SegmentDefs.DefaultAccess] };

  CheckExtension: PROCEDURE [s: STRING] = {
    FOR i: CARDINAL DECREASING IN [1..s.length) DO
      IF s[i] = '. THEN RETURN;
      ENDLOOP;
    String.AppendString[s,".bcd"L]};
  
  FrameCacheObject: TYPE = RECORD [
    gf: GlobalFrameHandle,
    seg: FileSegmentHandle,
    p: LONG POINTER,
    in: BOOLEAN,
    offset: CARDINAL,
    dseg: FileSegmentHandle];

  gfCache: FrameCacheObject _ [NIL,,,,,];

  FlushCodeCache: PROCEDURE =
    BEGIN
    IF gfCache.gf # NIL AND gfCache.dseg # NIL THEN
      SegmentDefs.DeleteFileSegment[gfCache.dseg];
    gfCache.gf _ NIL;
    RETURN;
    END;

  FlushCodeSegmentCache: PUBLIC PROCEDURE =
    BEGIN
    FlushCodeCache[];
    coCache.gf _ NIL;
    RETURN;
    END;

  LN: TYPE = Inline.LongNumber;

  File: PUBLIC PROCEDURE [f: GlobalFrameHandle] RETURNS [SegmentDefs.FileHandle] =
    BEGIN
    co: CodeObject _ Code[f];
    di: Handle;
    fp: AltoFileDefs.FP;
    LocateCode[f];
    IF gfCache.dseg = NIL THEN RETURN[NIL];
    FOR di _ diHead, di.next UNTIL di = NIL DO
      IF di.co = co THEN
	BEGIN OPEN SegmentDefs;
	IF di.oldFile = NIL THEN RETURN[NIL];
	ShortCopyREAD[from: @di.oldFile.fp, to: @fp, nwords: SIZE[AltoFileDefs.FP]];
	RETURN[InsertFile[@fp, Read]]
	END;
      ENDLOOP;
    RETURN[gfCache.dseg.file]
    END;

  LocateCode: PROCEDURE [f: GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs, gfCache;
    gf: GlobalFrame;
    IF gfCache.gf = f THEN RETURN;
    FlushCodeCache[];
    Gf.Check[f];
    IF Init.bootLoaded THEN {[] _ Code[f]; RETURN};
    gfCache.gf _ f;
    in _ TRUE;
    p _ NIL;
    seg _ NIL;
    offset _ 0;
    ShortCopyREAD[from: f, to: @gf, nwords: SIZE[GlobalFrame]];
    IF gf.code.out THEN gf.code.out _ in _ FALSE;
    IF gf.code.highByte # 0 THEN
      BEGIN
      seg _ gf.code.handle;
      IF in THEN
	BEGIN
	LOOPHOLE[p, LN].lowbits _ LOOPHOLE[gf.code.shortbase];
	offset _ LOOPHOLE[gf.code.shortbase, CARDINAL] -
	  LOOPHOLE[AddressFromPage[ReadUserSegment[seg].VMpage], CARDINAL];
	END
      ELSE offset _ gf.code.offset;
      IF ReadUserSegment[seg].swappedin THEN {
	in _ TRUE;
	p _ offset + LongAddressFromPage[ReadUserSegment[seg].VMpage]};
      END
    ELSE
      BEGIN
      p _ gf.code.longbase;
      IF gf.code.otherByte <= LAST[BankIndex] THEN
	BEGIN
	LREAD: PROCEDURE [page: CARDINAL, bank: CARDINAL] RETURNS [POINTER] =
	  MACHINE CODE BEGIN Mopcodes.zRBL, 0 END;
	page: CARDINAL = PageFromAddress[gf.code.shortbase];
	seg _ LREAD[page: page, bank: gf.code.otherByte];
	in _ TRUE;
	offset _ LOOPHOLE[gf.code.shortbase, CARDINAL] -
	  LOOPHOLE[AddressFromPage[ReadUserSegment[seg].VMpage], CARDINAL];
	END;
      END;
    dseg _ IF seg # NIL THEN MapUSeg[seg] ELSE NIL;
    END;


END.