-- Copyright (C) 1984, 1985  by Xerox Corporation. All rights reserved. 
-- NewChainCruiser.mesa
-- HGM, 15-Sep-85  1:11:10
-- Brenda Hankins	  20-Sep-84 13:44:01

DIRECTORY
  BitMapDefs USING [Clear, Create, Map, MapIndex, Set, Test],
  File USING [File, nullFile],
  FormSW USING [
    AllocateItemDescriptor, BooleanItem, ClientItemsProcType, CommandItem,
    newLine, nextPlace, NumberItem, ProcType, StringItem],
  Heap USING [systemZone],
  Inline USING [LongCOPY, LowHalf],
  HeapFile USING [
    ChainBlock, headerSize, noSegment, SegmentIndex, segmentsPerPage, segmentSize,
    SerialAndHead],
  MFile USING [Error, GetLength, Handle, ReadOnly, Release],
  Put USING [CR, Decimal, Line, Text],
  Runtime USING [IsBound],
  Space USING [CopyOut, InsufficientSpace, Interval, Kill, Map, nullInterval],
  SpecialMFile USING [GetCapaWithAccess],
  Tool USING [
    Create, MakeFileSW, MakeFormSW, MakeMsgSW, MakeSWsProc, UnusedLogName],
  ToolWindow USING [TransitionProcType],
  VMDefs USING [PageNumber, pageSize],
  Window USING [Box, Handle];

NewChainCruiser: PROGRAM
  IMPORTS
    BitMapDefs, FormSW, Heap, Inline, MFile, Put, Runtime,
    Space, SpecialMFile, Tool
  SHARES HeapFile =

  BEGIN

  --VARIABLES:  

  toolData: MACHINE DEPENDENT RECORD [
    -- tool window stuff:
    msgSW(0): Window.Handle ¬ NIL,
    fileSW(2): Window.Handle ¬ NIL,
    formSW(4): Window.Handle ¬ NIL,
    -- vars:
    heapFileName(6): LONG STRING,
    chainFileName(8): LONG STRING,
    chainFile(10): File.File,
    chainFileHandle(17): MFile.Handle,
    segmentToChange(19): CARDINAL,
    segmentToPointTo(20): CARDINAL,
    segmentBound(21): CARDINAL,  -- last valid real segment no.
    heapSize(22): CARDINAL,
    chainSize(23): CARDINAL,
    filesOpened(24): BOOLEAN,
    permanentChange(25): BOOLEAN,
    chain(26): LONG POINTER TO HeapFile.ChainBlock,
    chainSpace(28): Space.Interval];

  --****************************************************************************

  OpenFiles: FormSW.ProcType =
    BEGIN  --looks for the files in Mesa File System.
    errorOnOpen: BOOLEAN ¬ FALSE;
    IF toolData.heapFileName # NIL THEN
      BEGIN
      ENABLE
        BEGIN
        MFile.Error => {errorOnOpen ¬ TRUE; CONTINUE};
        Space.InsufficientSpace => {
          Put.Line[toolData.msgSW, "Space.InsufficientSpace."L];
          errorOnOpen ¬ TRUE;
          CONTINUE};
        END;
      heapFileHandle: MFile.Handle ¬ MFile.ReadOnly[
        toolData.heapFileName, [NIL, NIL] !
        MFile.Error =>
          Put.Line[toolData.msgSW, "MFile error on open of data file."L]];
      toolData.heapSize ¬ Inline.LowHalf[
        MFile.GetLength[heapFileHandle] / 512 --bytes/pg-- ];
      MFile.Release[heapFileHandle];
      END;
    IF errorOnOpen THEN {
      Put.Line[toolData.fileSW, "Specify the heap size and try again."L]; RETURN};
    toolData.chainSize ¬
      ((toolData.heapSize / HeapFile.segmentSize) +
         HeapFile.segmentsPerPage - 1) /
        HeapFile.segmentsPerPage;
    toolData.segmentBound ¬
      (toolData.heapSize / HeapFile.segmentSize) +
        toolData.chainSize * HeapFile.headerSize - 1;
    IF toolData.chainFileName # NIL THEN
      BEGIN
      ENABLE MFile.Error => {errorOnOpen ¬ TRUE; CONTINUE};
      tempSize: CARDINAL ¬ 0;
      toolData.chainFileHandle ¬ MFile.ReadOnly[
        toolData.chainFileName, [NIL, NIL] !
        MFile.Error =>
          Put.Line[toolData.msgSW, "MFile error on open of chain file."L]];
      toolData.chainFile ¬ SpecialMFile.GetCapaWithAccess[
        toolData.chainFileHandle];
      Put.Line[toolData.fileSW, "Chain file opened."L];
      IF toolData.heapSize > toolData.chainSize * 2 THEN
        Put.Line[
          toolData.msgSW,
          "Warning: size of chainfile is larger than that of Heap."L];
      IF toolData.heapSize < toolData.chainSize * 2 THEN
        Put.Line[
          toolData.msgSW,  --  must stop
          "Size of chainfile is smaller than that of Heap - you should quit."L];
      -- build chain data structure:
      toolData.chainSpace ¬ Space.Map[
        window: [file: File.nullFile, base: 0, count: toolData.chainSize]];
      toolData.chain ¬ toolData.chainSpace.pointer;
      FOR index: CARDINAL IN [0..toolData.chainSize) DO
        tempSpace: Space.Interval;
        chain0, chain1, chainChoice: LONG POINTER TO
          HeapFile.SerialAndHead;
        -- look at the chain in duplicate page pairs and use the 'correct' one.
        tempSpace ¬ LOOPHOLE[Space.Map[
          window: [toolData.chainFile, index * 2 + 1, 2], access: readOnly]];
        -- remember to skip over leader page
        chain0 ¬ LOOPHOLE[tempSpace.pointer];
        chain1 ¬ LOOPHOLE[chain0 + VMDefs.pageSize];
        chainChoice ¬
          IF chain1.serialNumber > chain0.serialNumber THEN chain1 ELSE chain0;
        Inline.LongCOPY[
          from: chainChoice, nwords: VMDefs.pageSize,
          to: toolData.chain + index * VMDefs.pageSize];
        Space.Kill[tempSpace];
        ENDLOOP;
      IF toolData.chain.header[0].chainHead = HeapFile.noSegment THEN
        Put.Line[
          toolData.msgSW, "There are no segments in chain (head pts to end)."L];
      END
    ELSE Put.Line[toolData.msgSW, "No chain file specified."L];
    IF ~errorOnOpen THEN toolData.filesOpened ¬ TRUE;
    END;  -- proc. OpenFiles

  --****************************************************************************

  CheckChain: FormSW.ProcType =
    BEGIN
    segmentCount: CARDINAL ¬ 0;
    lastSeg: CARDINAL;
    foundProblem: BOOLEAN ¬ FALSE;
    freeMap: BitMapDefs.Map;
    IF NOT toolData.filesOpened THEN {
      Put.Line[toolData.msgSW, "No open file."L]; RETURN};
    freeMap ¬ BitMapDefs.Create[toolData.segmentBound + 1];
    FOR index: CARDINAL IN [0..toolData.chainSize) DO
      -- make nonexistent seg indices look 'busy'
      firstBit: BitMapDefs.MapIndex = index * VMDefs.pageSize;
      FOR j: CARDINAL IN [0..HeapFile.headerSize) DO
        BitMapDefs.Set[freeMap, firstBit + j] ENDLOOP;
      ENDLOOP;
    FOR s: CARDINAL ¬ toolData.chain.header[0].chainHead, toolData.chain.next[s]
      UNTIL s = HeapFile.noSegment DO
      IF NOT BitMapDefs.Test[freeMap, s] THEN
        BEGIN
        BitMapDefs.Set[freeMap, s];
        lastSeg ¬ s;
        segmentCount ¬ segmentCount + 1;
        END
      ELSE  -- have found a circularity.
        BEGIN
        foundProblem ¬ TRUE;
        Put.Text[toolData.fileSW, "Logical segment number "L];
        Put.Decimal[toolData.fileSW, segmentCount];
        Put.Text[toolData.fileSW, " (segment index "L];
        Put.Decimal[toolData.fileSW, lastSeg];
        Put.Line[
          toolData.fileSW, ") should be changed to point to rest of chain."L];
        Put.Text[toolData.fileSW, "It now points to segment index "L];
        Put.Decimal[toolData.fileSW, s];
        Put.Line[toolData.fileSW, "."L];
        Put.Text[toolData.fileSW, "That change will leave "L];
        Put.Decimal[toolData.fileSW, segmentCount];
        Put.Text[toolData.fileSW, " segments in the heap."L];
        Put.Text[toolData.fileSW, "When it is full there are "L];
        Put.Decimal[
          toolData.fileSW, toolData.heapSize / HeapFile.segmentSize];
        Put.Line[toolData.fileSW, " segments in the heap."L];
        EXIT;
        END;
      ENDLOOP;
    IF NOT foundProblem THEN
      Put.Line[toolData.fileSW, "No circularity found in chain."L];
    BitMapDefsDelete[freeMap];
    END;  -- proc. CheckChain

  --****************************************************************************

  ChainChanges: FormSW.ProcType =
    BEGIN
    IF NOT toolData.filesOpened THEN {
      Put.Line[toolData.msgSW, "No open file."L]; RETURN};
    Put.Line[
      toolData.msgSW,
      "Segments are specified as real indices NOT logical values (2 is Chain head)."L];
    toolData.chain.next[toolData.segmentToChange] ¬ toolData.segmentToPointTo;
    IF toolData.permanentChange THEN
      BEGIN  -- update chain file:
      page: CARDINAL = toolData.segmentToChange / VMDefs.pageSize;
      chainPage: VMDefs.PageNumber =
        page * 2 +
          (IF toolData.chain.header[page].serialNumber MOD 2 = 0 THEN 0 ELSE 1);
      Put.Line[toolData.fileSW, "This will be a permanent change"L];
      toolData.chain.header[page].serialNumber ¬
        toolData.chain.header[page].serialNumber + 1;

      --old: FileDefs.WritePageToFile[to: client.chainHandle,
      --old:  page: chainPage, from: @client.chain.header[page]];
      [] ¬ Space.CopyOut[
        pointer: @toolData.chain.header[page],
        window: [
        file: toolData.chainFile, base: chainPage + 1,  -- incr to skip over leader page
        count: 1]];
      END;
    END;  -- proc. ChainChanges

  --**************************************************************************

  ShowChainSeq: FormSW.ProcType =
    BEGIN  -- run thru and print out indices.
    segCount: CARDINAL ¬ 0;
    IF NOT toolData.filesOpened THEN {
      Put.Line[toolData.msgSW, "No open file."L]; RETURN};
    FOR s: CARDINAL ¬ toolData.chain.header[0].chainHead, toolData.chain.next[s]
      UNTIL s = HeapFile.noSegment DO
      Put.Decimal[toolData.fileSW, s];
      Put.Text[toolData.fileSW, "  "L];
      segCount ¬ segCount + 1;
      IF segCount > toolData.segmentBound THEN {
        Put.Line[toolData.fileSW, "Stopping due to an apparent circularity."L];
        EXIT};
      ENDLOOP;
    IF segCount <= toolData.segmentBound THEN
      Put.Line[toolData.fileSW, "end of chain."L];
    END;  -- proc. ShowChainSeq

  --**************************************************************************

  GenerateChainSeqs: FormSW.ProcType =
    BEGIN  -- look for all disjoint sequences in chain file, 
    -- it only prints subsequences not on chain.
    seg, lastSeg: CARDINAL;
    seqHeads, chainEntries: BitMapDefs.Map;
    IF NOT toolData.filesOpened THEN {
      Put.Line[toolData.msgSW, "No open file."L]; RETURN};
    seqHeads ¬ BitMapDefs.Create[toolData.segmentBound + 1];
    chainEntries ¬ BitMapDefs.Create[toolData.segmentBound + 1];
    FOR index: CARDINAL IN [0..toolData.chainSize) DO
      -- make nonexistent seg indices look 'busy'
      firstBit: BitMapDefs.MapIndex = index * VMDefs.pageSize;
      FOR j: CARDINAL IN [0..HeapFile.headerSize) DO
        BitMapDefs.Set[chainEntries, firstBit + j] ENDLOOP;
      ENDLOOP;
    seg ¬ toolData.chain.header[0].chainHead;
    UNTIL seg = HeapFile.noSegment DO
      noOfSegs: CARDINAL ¬ 0;
      FOR s: CARDINAL ¬ seg, toolData.chain.next[s] DO
        IF BitMapDefs.Test[chainEntries, s] OR s = HeapFile.noSegment
          THEN
          BEGIN  -- a circularity or can append another sequence
          Put.Text[toolData.fileSW, "Found a sequence "L];
          Put.Decimal[toolData.fileSW, noOfSegs];
          Put.Text[toolData.fileSW, " segments long starting at "L];
          Put.Decimal[toolData.fileSW, seg];
          Put.Text[toolData.fileSW, " and ending at "L];
          Put.Decimal[toolData.fileSW, s];
          Put.CR[toolData.fileSW];
          IF seg = toolData.chain.header[0].chainHead THEN
            Put.Line[toolData.fileSW, "	this is first segment in the chain"L];
          IF s = toolData.chain.header[0].chainHead THEN
            Put.Line[
              toolData.fileSW, "	this last points to current head of the chain"L];
          IF s # HeapFile.noSegment AND BitMapDefs.Test[seqHeads, s]
            AND s # toolData.chain.header[0].chainHead THEN
            BEGIN  -- s is head of a chain we've saved, replace that head with seg
            BitMapDefs.Clear[seqHeads, s];
            Put.Line[
              toolData.fileSW, "	it was prepended to a previous sequence."L];
            END;
          BitMapDefs.Set[seqHeads, seg];  -- store seg as another chain start
          seg ¬ FindFree[chainEntries, seg];
          EXIT;
          END
        ELSE {
          BitMapDefs.Set[chainEntries, s]; lastSeg ¬ s; noOfSegs ¬ noOfSegs + 1}
        ENDLOOP;
      ENDLOOP;
    BitMapDefsDelete[chainEntries];
    BitMapDefsDelete[seqHeads];
    END;  -- proc. GenerateChainSeqs

  --**************************************************************************

  FindFree: PROCEDURE [m: BitMapDefs.Map, near: HeapFile.SegmentIndex]
    RETURNS [new: BitMapDefs.MapIndex] =
    BEGIN  -- stolen from StableStorageImpl.FindSegment
    -- find 'nearest' free segment;
    high: BitMapDefs.MapIndex ¬ near;
    low: BitMapDefs.MapIndex ¬
      (  -- skip over headers at chain page boundaries
        IF near > HeapFile.headerSize THEN
        near -
          (IF near MOD VMDefs.pageSize = HeapFile.headerSize THEN
           HeapFile.headerSize + 1 ELSE 1)
        ELSE HeapFile.headerSize);
    DO
      IF ~BitMapDefs.Test[m, high] THEN {new ¬ high; EXIT};
      IF ~BitMapDefs.Test[m, low] THEN {new ¬ low; EXIT};
      IF high = toolData.segmentBound AND low = HeapFile.headerSize THEN
        RETURN[HeapFile.noSegment];  -- ever get?
      high ¬ MIN[
        high +
        (IF high + 1 MOD VMDefs.pageSize = 0 THEN HeapFile.headerSize
         ELSE 1), toolData.segmentBound];
      low ¬
        (IF low > HeapFile.headerSize THEN
         low -
           (IF low MOD VMDefs.pageSize = HeapFile.headerSize THEN
            HeapFile.headerSize + 1 ELSE 1)
         ELSE HeapFile.headerSize);
      ENDLOOP;
    END;

  --**************************************************************************

  BitMapDefsDelete: PROCEDURE [m: BitMapDefs.Map] =
    BEGIN  -- inverse of BitMapDefs.Create
    Heap.systemZone.FREE[@m.data.BASE];
    Heap.systemZone.FREE[@m];
    END;

  --**************************************************************************

  HelpProc: FormSW.ProcType =
    BEGIN
    Put.Line[
      toolData.fileSW,
      "Specify chain file name.  If data file is on this volume then specify its name else specify its size in pages.  Do 'Open Files'."L];
    Put.Line[
      toolData.fileSW,
      "Now do 'Check Chain', this will indicate whether there is a circularity in the chain."L];
    Put.Line[
      toolData.fileSW,
      "If there is, do 'Generate Chain Seqs' to see if you think any thing has been chopped off the chain  (anything real long will look suspicious)."L];
    Put.Line[
      toolData.fileSW,
      "Do 'Chain Changes' to propose changes to the chain and when you're satisfied with all the changes you've made, do them all again with the boolean 'Permanent Changes' set."L];
    Put.Line[
      toolData.fileSW,
      "Show Chain Seq will show you what the chain looks like."L];
    END;  -- proc. HelpProc

  --**************************************************************************

  -- Tool needed routines:

  ClientTransition: ToolWindow.TransitionProcType =
    BEGIN
    SELECT TRUE FROM
      new = active =>
        BEGIN
        toolData.heapFileName ¬ NIL;
        toolData.chainFileName ¬ NIL;
        toolData.chainFileHandle ¬ NIL;
        toolData.segmentToChange ¬ 2;  -- head of chain.
        toolData.segmentToPointTo ¬ LAST[CARDINAL];  -- end of chain.
        toolData.chainSpace ¬ Space.nullInterval;
        toolData.chain ¬ NIL;
        toolData.heapSize ¬ 0;
        toolData.filesOpened ¬ FALSE;
        toolData.permanentChange ¬ FALSE;
        END;
      old = active =>
        BEGIN
        IF toolData.chainSpace # Space.nullInterval THEN
          Space.Kill[toolData.chainSpace];
        IF toolData.chainFileHandle # NIL THEN
          MFile.Release[toolData.chainFileHandle];
        END;
      ENDCASE;
    END;  -- proc. ClientTransition

  --***************************************************************************

  MakeTool: PROCEDURE [initialBox: Window.Box] =
    BEGIN
    window: Window.Handle ¬ Tool.Create[
      makeSWsProc: MakeSWs, initialState: default, initialBox: initialBox,
      clientTransition: ClientTransition, name: "NewChainCruiser"L,
      tinyName1: "NewChain"L, tinyName2: "Cruiser"L];
    END;  -- proc. MakeTool

  --******************************************************************************

  tIndex: TYPE = {
    heapFileName, chainFileName, openFiles, heapSize, permanentChange,
    segmentToChange, segmentToPointTo, checkChain, chainChanges, showChainSeq,
    generateChainSeqs, help};
  noToolIndices: CARDINAL = tIndex.LAST.ORD + 1;

  MakeCommon: FormSW.ClientItemsProcType =
    BEGIN OPEN FormSW;
    items ¬ AllocateItemDescriptor[noToolIndices];
    items[tIndex.heapFileName.ORD] ¬ StringItem[
      tag: "Heap File Name"L, place: newLine, string: @toolData.heapFileName,
      inHeap: TRUE];
    items[tIndex.chainFileName.ORD] ¬ StringItem[
      tag: "Chain File Name"L, place: newLine, string: @toolData.chainFileName,
      inHeap: TRUE];
    items[tIndex.openFiles.ORD] ¬ CommandItem[
      tag: "OpenFiles"L, proc: OpenFiles, place: newLine];
    items[tIndex.heapSize.ORD] ¬ NumberItem[
      tag: "HeapSize (in pages)"L, value: @toolData.heapSize, radix: decimal,
      place: nextPlace];
    items[tIndex.permanentChange.ORD] ¬ BooleanItem[
      tag: "Make Permanent Change"L, switch: @toolData.permanentChange,
      place: nextPlace];
    items[tIndex.segmentToChange.ORD] ¬ NumberItem[
      tag: "Segment Index To Change"L, value: @toolData.segmentToChange,
      radix: decimal, place: newLine];
    items[tIndex.segmentToPointTo.ORD] ¬ NumberItem[
      tag: "Segment Index To Point To"L, value: @toolData.segmentToPointTo,
      radix: decimal, place: nextPlace];
    items[tIndex.checkChain.ORD] ¬ CommandItem[
      tag: "Check Chain"L, proc: CheckChain, place: newLine];
    items[tIndex.chainChanges.ORD] ¬ CommandItem[
      tag: "Chain Changes"L, proc: ChainChanges, place: nextPlace];
    items[tIndex.showChainSeq.ORD] ¬ CommandItem[
      tag: "Show Chain Seq"L, proc: ShowChainSeq, place: nextPlace];
    items[tIndex.generateChainSeqs.ORD] ¬ CommandItem[
      tag: "Generate Chain Seqs"L, proc: GenerateChainSeqs, place: nextPlace];
    items[tIndex.help.ORD] ¬ CommandItem[
      tag: "Help"L, proc: HelpProc, place: nextPlace];
    RETURN[items: items, freeDesc: TRUE];
    END;  --  proc. MakeCommon.

  --****************************************************************************

  MakeSWs: Tool.MakeSWsProc =
    BEGIN
    logName: STRING ¬ [40];
    Tool.UnusedLogName[unused: logName, root: "ChainCruiser.log"L];
    toolData.msgSW ¬ Tool.MakeMsgSW[window: window, h: 32];
    toolData.formSW ¬ Tool.MakeFormSW[
      window: window, formProc: MakeCommon, h: 96];
    toolData.fileSW ¬ Tool.MakeFileSW[window: window, name: logName, h: 350];
    END;

  --************************************************************************

  -- mainline code:

  IF Runtime.IsBound[LOOPHOLE[BitMapDefs.Create]] THEN
    MakeTool[[[0, 35], [482, 650]]]
  ELSE Put.Line[s: "BitMapDefsImpl not available!"L];

  END.
  

LOG: 
 4-Sep-84 12:31:29	 converted from MSScanTool