-- ROMImpl.mesa
-- a program to run within Chipmonk

-- last modified by E. McCreight, November 20, 1981  1:00 PM
-- written by E. McCreight, August 7, 1981  3:52 PM

DIRECTORY
  ChipUserInt,
  MB,
  ppddefs,
  ppdefs,
  RomMakerDefs,
  SegmentDefs,
  StreamDefs,
  StringDefs;

RomImpl: PROGRAM
  IMPORTS
    ChipUserInt, MB, ppdefs, RomMakerDefs,
    SegmentDefs, StreamDefs
  EXPORTS RomMakerDefs =
  BEGIN OPEN ChipUserInt, ppddefs, ppdefs, RomMakerDefs;

  CantBuildRom: PROCEDURE[why, explanation: STRING _ NIL] =
    {Explain[what: "Can't build Rom [Confirm]", why: why,
      explanation: explanation]};

  BuildRom: PUBLIC PROCEDURE[] =
    BEGIN
    romDecoder, romData: DCellPr;

    romDecoderTopLeftCorner, romDecoderLeftMid,
      romDecoderBottomLeftCorner: Cell;
    romDecoderTop, romDecoderTopMid: Cell;
    romDecoderMidV, romDecoderMidH, romDecoderMidVH: Cell;
    romDecoderBottom, romDecoderBottomMid: Cell;
    romDecoderDataTop, romDecoderData, romDecoderDataMid,
      romDecoderDataBottom: Cell;

    romDataTopMid, romDataBottomMid, romOutMuxMid: Cell;
    romDataMidV, romDataMidH, romDataMidVH: Cell;
    romDataTopRightCorner, romDataRight, romDataRightMid,
      romDataBottomRightCorner: Cell;

    romDecoderLeft, romDataTop, romDataBottom, romOutMux: DCell;
    -- column: FALSE => even column, TRUE => odd column

    decodeCell, dataCell: Cell;  -- samples for measurements


    FindRomCells: PROCEDURE [cellFamily: STRING] =
      BEGIN
      romDecoder _ FindDCellPr[cellFamily: cellFamily, required: TRUE,
        memberPrefix: "Decoder"L];
      decodeCell _ romDecoder[TRUE][FALSE];

      -- MidV is a vertical column of cells, MidH is a
      -- horizontal row of cells, and MidVH is the cell that
      -- happens at their intersections.

      romDecoderMidH _ FindCell[
        cellFamily: cellFamily, member: "DecoderMidH"L, hCompat: decodeCell];
      romDecoderMidV _ FindCell[
        cellFamily: cellFamily, member: "DecoderMidV"L, vCompat: decodeCell];
      romDecoderMidVH _ FindCell[
        cellFamily: cellFamily, member: "DecoderMidVH"L, hCompat: romDecoderMidV,
        vCompat: romDecoderMidH,
        required: romDecoderMidV#NIL AND romDecoderMidH#NIL];

      romData _ FindDCellPr[cellFamily: cellFamily, required: TRUE,
        memberPrefix: "Data"L];
      dataCell _ romData[FALSE][FALSE];
      CheckPitchCompatability[decodeCell, dataCell, vertical, [1, 2], [1, 1]];
      romDataMidH _ FindCell[
        cellFamily: cellFamily, member: "DataMidH"L, hCompat: dataCell,
        vCompat: romDecoderMidH,
        required: romDecoderMidH#NIL];
      romDataMidV _ FindCell[
        cellFamily: cellFamily, member: "DataMidV"L, vCompat: dataCell];
      romDataMidVH _ FindCell[
        cellFamily: cellFamily, member: "DataMidVH"L, hCompat: romDataMidV,
        vCompat: romDataMidH,
        required: romDataMidV#NIL AND romDataMidH#NIL];

      romDecoderLeft _ FindDCell[
        cellFamily: cellFamily, memberPrefix: "DecoderLeft"L, vCompat: decodeCell];
      romDecoderLeftMid _ FindCell[
        cellFamily: cellFamily, member: "DecoderLeftMid"L, vCompat: romDecoderMidH,
        required: romDecoderMidH#NIL];
      romDecoderTopLeftCorner _ FindCell[
        cellFamily: cellFamily, member: "DecoderTopLeftCorner"L];
      romDecoderBottomLeftCorner _ FindCell[
        cellFamily: cellFamily, member: "DecoderBottomLeftCorner"L];

      romDecoderTop _ FindCell[
        cellFamily: cellFamily, member: "DecoderTop"L, hCompat: decodeCell];
      romDecoderTopMid _ FindCell[
        cellFamily: cellFamily, member: "DecoderTopMid"L, hCompat: romDecoderMidV,
        required: romDecoderMidV#NIL];
      romDecoderBottom _ FindCell[
        cellFamily: cellFamily, member: "DecoderBottom"L, hCompat: decodeCell];
      romDecoderBottomMid _ FindCell[
        cellFamily: cellFamily, member: "DecoderBottomMid"L, hCompat: romDecoderMidV,
        required: romDecoderMidV#NIL];

      romDecoderData _ FindCell[
        cellFamily: cellFamily, member: "DecoderData"L, vCompat: dataCell];
      romDecoderDataTop _ FindCell[
        cellFamily: cellFamily, member: "DecoderDataTop"L, hCompat: romDecoderData];
      romDecoderDataMid _ FindCell[
        cellFamily: cellFamily, member: "DecoderDataMid"L, hCompat: romDecoderData,
        vCompat: romDecoderMidH,
        required: romDecoderMidH#NIL];
      romDecoderDataBottom _ FindCell[
        cellFamily: cellFamily, member: "DecoderDataBottom"L,
        hCompat: romDecoderData];

      romDataTop _ FindDCell[
        cellFamily: cellFamily, memberPrefix: "DataTop"L, hCompat: dataCell];
      romDataTopMid _ FindCell[
        cellFamily: cellFamily, member: "DataTopMid"L, hCompat: romDataMidV,
        required: romDataMidV#NIL];
      romDataBottom _ FindDCell[
        cellFamily: cellFamily, memberPrefix: "DataBottom"L, hCompat: dataCell];
      romDataBottomMid _ FindCell[
        cellFamily: cellFamily, member: "DataBottomMid"L, hCompat: romDataMidV,
        required: romDataMidV#NIL];

      romOutMux _ FindDCell[cellFamily: cellFamily, memberPrefix: "OutMux"L];
      CheckPitchCompatability[dataCell, romOutMux[FALSE], horizontal, [2, 1], [1, 1]];
      romOutMuxMid _ FindCell[
        cellFamily: cellFamily, member: "OutMuxMid"L, hCompat: romDataMidV,
        required: romOutMux[FALSE]#NIL AND romDataMidV#NIL];

      romDataTopRightCorner _ FindCell[
        cellFamily: cellFamily, member: "DataTopRightCorner"L];
      romDataRight _ FindCell[
        cellFamily: cellFamily, member: "DataRight"L, vCompat: dataCell];
      romDataRightMid _ FindCell[
        cellFamily: cellFamily, member: "DataRightMid"L, vCompat: romDataMidH,
        required: romDataMidH#NIL];
      romDataBottomRightCorner _ FindCell[
        cellFamily: cellFamily, member: "DataBottomRightCorner"L];
      END; -- of FindRomCells

    bodyHeight, decoderDataX, dataX, dataRightX: locNum;
    decoderWidth, wordsPerDataRow, wordCount, wordWidth,
      logWordsPerDataRow: INTEGER;
    dataMidHGap, decodeMidVGap, dataMidVGap: locNum _ 0;
    invertData: BOOLEAN;

    fileName, memName, cellFamily, romName: STRING _ NIL;
    s: StreamDefs.StreamHandle _ NIL;
    mb: MB.MBHandle _ NIL;
    mbMem: MB.MBMemoryPtr _ NIL;

      BEGIN ENABLE Punt => GOTO ExitRom; -- for EXITS
      fileName _ RequestString[""L, "Data file:"L, ".mb format"L];
      fileName _ FixExtension[fileName, ".mb"L];
      s _ StreamDefs.NewWordStream[
        fileName, StreamDefs.Read !
        SegmentDefs.FileNameError => {
          CantBuildRom["Can't find .mb file"L, name]; GOTO ExitRom}];
      mb _ MB.ReadMB[
        s, uz !
        MB.IllegalMBFormat =>
          {CantBuildRom["Isn't .mb format"L, fileName]; GOTO ExitRom}];

      memName _ RequestString[,, "Memory name in .mb file:"L];
      mbMem _ MB.FindMBMemory[mb, memName];
      IF mbMem = NIL THEN {CantBuildRom["Memory isn't in .mb file"L, memName]; GOTO ExitRom};

      cellFamily _ RequestString[,, "Cell family:"L];

      FindRomCells[cellFamily];

      wordsPerDataRow _ 1; logWordsPerDataRow _ 0;
      IF romOutMux[FALSE]#NIL THEN
        BEGIN
        t: INTEGER _ RequestInteger["Words per row:"L, "(power of 2)"L];
        FOR wordsPerDataRow _ 1, 2*wordsPerDataRow WHILE wordsPerDataRow<t DO
          logWordsPerDataRow _ logWordsPerDataRow+1;
          ENDLOOP;
        END;

      MB.ReCast[mem: mbMem, newWordWidth: mbMem.width*wordsPerDataRow];
      invertData _ HeSaysYes["Shall I invert the data?"L];
      IF HeSaysYes["Is a missing data cell equivalent to either"L,
        "real data cell?"L] THEN
        MB.SuppressDefaultWords[mem: mbMem,
        default: HeSaysYes[s1:"Which one?"L, s3: "(0 or 1)"L]#invertData];
      [decoderWidth, wordCount, wordWidth] _ MB.AnalyzeMemory[mbMem];

      decoderWidth _ decoderWidth+logWordsPerDataRow;
      wordCount _ wordCount + (wordCount MOD 2)+2*logWordsPerDataRow;

      IF romDataMidH#NIL THEN
        dataMidHGap _ CellSize[dataCell].y*
          RequestInteger["Data cells vertically per mid cell row?"L];
      IF romDecoderMidV#NIL THEN
        decodeMidVGap _ CellSize[decodeCell].x*
          RequestInteger["Decoder cells horizontally per mid cell column?"L];
      IF romDataMidV#NIL THEN
        dataMidVGap _ CellSize[dataCell].x*
          RequestInteger["Data cells horizontally per mid cell column?"L];

      bodyHeight _ BlockSize[cell: decodeCell, rep: [x: 1, y: wordCount],
        midCell: romDataMidH, midGap: [dataMidVGap, dataMidHGap]].y;
      decoderDataX _ BlockSize[cell: decodeCell, rep: [x: decoderWidth, y: 1],
        midCell: romDecoderMidV, midGap: [decodeMidVGap, dataMidHGap]].x;
      dataX _ decoderDataX+CellSize[romDecoderData].x;
      dataRightX _ dataX+BlockSize[cell: dataCell, rep: [x: wordWidth, y: 1],
        midCell: romDataMidV, midGap: [dataMidVGap, dataMidHGap]].x;

      Repeat[
        cell: romDecoderLeft[FALSE], p: [0,0], corner: topRight,
        dir: down, rep: wordCount,
        midCell: romDecoderLeftMid, midGap: dataMidHGap,
        altCell: romDecoderLeft[TRUE], altMod: 2];
      Repeat[
        cell: romDecoderTopLeftCorner, p: [0,0], corner: bottomRight];
      Repeat[
        cell: romDecoderBottomLeftCorner, p: [0, bodyHeight], corner: topRight];

      Repeat[
        cell: romDecoderTop, p: [0,0], corner: bottomLeft,
        rep: decoderWidth,
        midCell: romDecoderTopMid, midGap: decodeMidVGap];
      Repeat[
        cell: romDecoderBottom, p: [0, bodyHeight], corner: topLeft,
        dir: right, rep: decoderWidth,
        midCell: romDecoderBottomMid, midGap: decodeMidVGap,
        name: [basicName: "Addr"L, x: [-1, decoderWidth-1]]];

      Repeat[cell: romDecoderDataTop,
        p: [decoderDataX, 0], corner: bottomLeft];
      Repeat[
        cell: romDecoderData, p: [decoderDataX, 0], dir: down, rep: wordCount/2,
        midCell: romDecoderDataMid, midGap: dataMidHGap];
      Repeat[cell: romDecoderDataBottom, p: [decoderDataX, bodyHeight]];

      Repeat[cell: romDataTop[FALSE],
        p: [dataX, 0], corner: bottomLeft, dir: right, rep: wordWidth,
        midCell: romDataTopMid, midGap: dataMidVGap,
        altCell: romDataTop[TRUE], altMod: 2];
      Repeat[cell: romDataTopRightCorner,
        p: [dataRightX, 0], corner: bottomLeft];
      Repeat[cell: romDataRight, p: [dataRightX, 0], dir: down, rep: wordCount/2,
        midCell: romDataRightMid, midGap: dataMidHGap];
      Repeat[cell: romDataBottomRightCorner, p: [dataRightX, bodyHeight]];

      IF wordsPerDataRow=1 THEN
        Repeat[cell: romDataBottom[FALSE],
          p: [dataX, bodyHeight], dir: right, rep: wordWidth,
          midCell: romDataBottomMid, midGap: dataMidVGap,
          altCell: romDataBottom[TRUE], altMod: 2,
          name: [basicName: "Data"L, x: [1, 0]]]
      ELSE
        Repeat[cell: romOutMux[FALSE],
          p: [dataX, bodyHeight], dir: right, rep: wordWidth/2,
          midCell: romOutMuxMid, midGap: dataMidVGap,
          altCell: romOutMux[TRUE], altMod: wordsPerDataRow/2,
          name: [basicName: "Data"L, x: [2, 0]]];

      MakeDecoderBlock[cells: romDecoder, p: [0, 0], rep: [decoderWidth, wordCount],
        pairsToDataArray: logWordsPerDataRow, mem: mbMem,
        midCellSize: [x: CellSize[romDecoderMidV].x, y: CellSize[romDecoderMidH].y],
        midGap: [decodeMidVGap, dataMidHGap],
        invertAddress: HeSaysYes["Shall I invert address inputs?"L]];

      MakeMidGrid[p: [0,0], cell: decodeCell, rep: [decoderWidth, wordCount],
        midVCell: romDecoderMidV, midHCell: romDecoderMidH, midVHCell: romDecoderMidVH,
        midGap: [decodeMidVGap, dataMidHGap]];

      MakeDataBlock[cells: romData, p: [dataX, 0], rep: [wordWidth, wordCount/2],
        decodePairs: logWordsPerDataRow, mem: mbMem,
        midCellSize: [x: CellSize[romDataMidV].x, y: CellSize[romDataMidH].y],
        midGap: [dataMidVGap, dataMidHGap],
        invertData: invertData,
        invertAddress: HeSaysYes["Extra inversion for address decode"L,
          "in data array?"L]];

      MakeMidGrid[p: [dataX,0], cell: dataCell, rep: [wordWidth, wordCount/2],
        midVCell: romDataMidV, midHCell: romDataMidH, midVHCell: romDataMidVH,
        midGap: [dataMidVGap, dataMidHGap]];

      romName _ RequestString[,, "Name of completed Rom cell:"L];
      IF romName#NIL AND romName.length>0 THEN
        BEGIN
        DrawCell[MakeNewCell[romName, lpp].ob];
        romName _ NIL;  -- gave string body to cell
        END
      ELSE AddToMasterList[lpp];
      lpp _ NIL; -- gave away list

      EXITS ExitRom => NULL;
      END;

    flushDel[lpp];
    IF fileName # NIL THEN FreeString[fileName];
    IF memName # NIL THEN FreeString[memName];
    IF cellFamily # NIL THEN FreeString[cellFamily];
    IF romName # NIL THEN FreeString[romName];
    IF s # NIL THEN s.destroy[s];
    anyChanges _ sinceIOchanges _ TRUE;
    END; -- of BuildRom

  MakeDecoderBlock: PROCEDURE [cells: DCellPr, p, rep: Point,
    pairsToDataArray: INTEGER, mem: MB.MBMemoryPtr,
    midCellSize: Point _ [0,0], midGap: Point _ [0,0],
    invertAddress: BOOLEAN _ FALSE] =
    BEGIN -- high-order bit on the left, bits passed straight
      -- through for data block decoding on the right.  Assumes
      -- that data block decoding happens in the top
      -- 2*pairsToDataArray data rows.

    w: MB.MBWordPtr _ mem.words;
    FOR iy: INTEGER IN [0..2*pairsToDataArray) DO -- trivial decode
      FOR ix: INTEGER IN [0..rep.x) DO
        rightColumn: BOOLEAN _ ix = rep.x-1-iy/2;
        PlaceCell[p, cells[
          rightColumn AND ((iy MOD 2=0)#invertAddress)]
          [rightColumn AND ((iy MOD 2#0)#invertAddress)],
          [ix, iy], midCellSize, midGap];
        ENDLOOP;
      ENDLOOP;
    FOR iy: INTEGER IN [2*pairsToDataArray..rep.y) DO
      loc: LONG CARDINAL _ w.location;
      FOR ix: INTEGER IN [rep.x-pairsToDataArray..rep.x) DO
        PlaceCell[p, cells[FALSE][FALSE], [ix, iy], midCellSize, midGap];
        ENDLOOP;
      FOR ix: INTEGER DECREASING IN
        [0..rep.x-pairsToDataArray) DO
        PlaceCell[p, cells[((loc MOD 2)#0)#invertAddress]
          [((loc MOD 2)=0)#invertAddress],
          [ix, iy], midCellSize, midGap];
        loc _ loc/2;
        ENDLOOP;
      IF w.nextWord # NIL THEN w _ w.nextWord;
      ENDLOOP;
    END;


  MakeDataBlock: PROCEDURE [cells: DCellPr, p, rep: Point, decodePairs: INTEGER,
    mem: MB.MBMemoryPtr,
    midCellSize: Point _ [0,0], midGap: Point _ [0,0],
    invertAddress, invertData: BOOLEAN _ FALSE] =
    BEGIN
    w0: MB.MBWordPtr;
    mask: INTEGER _ 1;
    FOR iy: INTEGER IN [0..decodePairs) DO
      FOR ix: INTEGER IN [0..rep.x) DO
        t: BOOLEAN _ ix MOD 2*mask >= mask;
        PlaceCell[p, cells[t#invertAddress][t=invertAddress],
          [ix, iy], midCellSize, midGap];
        ENDLOOP;
      mask _ 2*mask;
      ENDLOOP;
    w0 _ mem.words;
    FOR iy: INTEGER IN [decodePairs..rep.y) DO
      w1: MB.MBWordPtr _ IF w0.nextWord # NIL THEN w0.nextWord ELSE w0;
      FOR ix: INTEGER IN [0..rep.x) DO
        PlaceCell[p, cells[w0.value[ix]#invertData]
        [w1.value[ix]#invertData], [ix, iy], midCellSize, midGap];
        ENDLOOP;
      w0 _ w1.nextWord;
      ENDLOOP;
    END;


  END. -- of RomImpl