-- BFS.Mesa  Edited by Sandman on July 1, 1980  7:43 AM 
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [CharsPerPage, PageNumber, PageSize],
  AltoFileDefs USING [
    CFA, CFP, DefaultSNBits, eofDA, FA, fillinDA, FP, LD, SN, SNBits, vDA, vDC],
  BFSDefs USING [],
  DiskDefs USING [
    CBptr, CBZptr, CleanupCBqueue, DDC, DiskCheckError, DiskRequest,
    DoDiskCommand, FID, FreePageFID, GetCB, InitializeCBstorage, lCBZ, nCB,
    nSectors, RealDA, RetryableDiskError, RetryCount, UnrecoverableDiskError,
    VirtualDA],
  DiskKDDefs USING [AssignDiskPage, NewSN, ReleaseDiskPage],
  MiscDefs USING [DAYTIME, SetBlock, Zero],
  NucleusOps USING [],
  SegmentDefs USING [
    DataSegmentAddress, DataSegmentHandle, DefaultBase, DeleteDataSegment,
    NewDataSegment],
  StringDefs USING [MesaToBcplString];

BFS: PROGRAM
  IMPORTS DiskDefs, DiskKDDefs, MiscDefs, SegmentDefs, StringDefs
  EXPORTS BFSDefs, NucleusOps =
  BEGIN OPEN AltoDefs, AltoFileDefs, DiskDefs;

  -- These should be POINTER TO ARRAY OF ...

  CAvec: TYPE = DESCRIPTOR FOR ARRAY OF POINTER;
  DAvec: TYPE = DESCRIPTOR FOR ARRAY OF vDA;

  ActOnPages: PUBLIC PROCEDURE [arg: POINTER TO update DiskRequest]
    RETURNS [page: PageNumber, bytes: CARDINAL] =
    BEGIN OPEN arg, DiskDefs;
    a: vDC;
    ddc: DDC;
    i: PageNumber;
    cb, nextcb: CBptr;
    cbzone: ARRAY [0..lCBZ) OF UNSPECIFIED;
    zone: CBZptr = @cbzone[0];
    CAs: CAvec = DESCRIPTOR[ca, lastPage + 1];
    DAs: DAvec = DESCRIPTOR[da, lastPage + 2];
    InitializeCBstorage[zone, nCB, firstPage, clear];
    zone.info _ da;
    zone.cleanup _ cleanup;
    BEGIN
    ENABLE RetryableDiskError => RETRY;
    cb _ GetCB[zone, clear ! ANY => ERROR];
    FOR i _ zone.currentPage, i + 1 UNTIL i = lastPage + 1 DO
      BEGIN -- inner compound to skip DoNothing pages
      a _ IF i = lastPage THEN lastAction ELSE action;
      IF a = DoNothing THEN GOTO SkipThisPage;
      IF DAs[i] = eofDA THEN EXIT;
      IF signalCheckError AND zone.checkError AND zone.errorCount = RetryCount/2
	THEN SIGNAL DiskCheckError[i];
      nextcb _ GetCB[zone, clear];
      cb.labelAddress _
	IF DAs[i + 1] = fillinDA THEN LOOPHOLE[@nextcb.header.diskAddress]
	ELSE @nextcb.label;
      ddc _ DDC[cb, IF fixedCA THEN ca ELSE CAs[i], DAs[i], i, fp, FALSE, a];
      DoDiskCommand[@ddc];
      cb _ nextcb;
      EXITS SkipThisPage => NULL;
      END;
      ENDLOOP;
    CleanupCBqueue[zone];
    END; -- of enable block
    RETURN[i - 1, zone.currentBytes]
    END;

  GetNextDA: PUBLIC PROCEDURE [cb: CBptr] =
    BEGIN
    pn: PageNumber = cb.page;
    DAs: DAvec = DESCRIPTOR[cb.zone.info, pn + 2];
    IF DAs[pn + 1] = fillinDA THEN DAs[pn + 1] _ VirtualDA[cb.labelAddress.next];
    IF DAs[pn - 1] = fillinDA THEN DAs[pn - 1] _ VirtualDA[cb.labelAddress.prev];
    RETURN
    END;

  -- Currently DiskRequest.action is not used by WritePages (WriteD is assumed).
  -- Note also that lastAction is used only if lastPage isn't being rewritten.


  WritePages: PUBLIC PROCEDURE [arg: POINTER TO extend DiskRequest]
    RETURNS [page: PageNumber, bytes: CARDINAL] =
    BEGIN
    aop: update DiskRequest;
    firstNewPage: PageNumber;
    local: extend DiskRequest _ arg^;
    DAs: DAvec = DESCRIPTOR[arg.da, arg.lastPage + 2];
    BEGIN OPEN local;
    IF DAs[firstPage] = fillinDA THEN firstNewPage _ firstPage
    ELSE
      BEGIN
      aop _ DiskRequest[
	ca, da, firstPage, lastPage, fp, fixedCA, WriteD, lastAction,
	signalCheckError, update[GetNextDA]];
      [page, bytes] _ ActOnPages[@aop];
      IF (firstPage _ page) = lastPage AND
	(lastAction # WriteD OR bytes = lastBytes) THEN RETURN;
      firstNewPage _ firstPage + 1;
      END;
    IF firstNewPage <= lastPage THEN
      BEGIN
      aop.da _ da;
      aop.firstPage _ firstNewPage;
      aop.lastPage _ lastPage;
      AssignPages[@aop];
      END;
    [page, bytes] _ RewritePages[@local];
    RETURN
    END;
    END;

  -- Note that only da, firstPage, and lastPage are valid on entry.


  AssignPages: PUBLIC PROCEDURE [arg: POINTER TO update DiskRequest] =
    BEGIN OPEN SegmentDefs, arg;
    i: PageNumber;
    DAs: DAvec = DESCRIPTOR[da, lastPage + 2];
    sink: DataSegmentHandle = NewDataSegment[DefaultBase, 1];
    arg^ _ DiskRequest[
      DataSegmentAddress[sink], , , , NIL, TRUE, ReadLD, ReadLD, FALSE, update[
      CheckFreePage]];
    UNTIL firstPage > lastPage DO
      ENABLE UNWIND => DeleteDataSegment[sink];
      FOR i IN [firstPage..lastPage] DO
	DAs[i] _ DiskKDDefs.AssignDiskPage[DAs[i - 1]]; ENDLOOP;
      i _ firstPage;
      [] _ ActOnPages[
	arg !
	UnrecoverableDiskError --[cb]-- =>
	  BEGIN -- skip bad spots and press on
	  firstPage _ cb.page;
	  DAs[firstPage] _ fillinDA;
	  firstPage _ firstPage + 1;
	  RETRY
	  END];
      firstPage _ i;
      FOR i IN [firstPage..lastPage] DO
	IF (DAs[firstPage] _ DAs[i]) # fillinDA THEN firstPage _ firstPage + 1;
	ENDLOOP;
      ENDLOOP;
    DeleteDataSegment[sink];
    RETURN
    END;

  CheckFreePage: PUBLIC PROCEDURE [cb: CBptr] =
    BEGIN
    DAs: POINTER TO ARRAY [0..1) OF vDA = cb.zone.info;
    IF cb.labelAddress.fileID # FreePageFID THEN DAs^[cb.page] _ fillinDA;
    RETURN
    END;

  -- Note that action and lastAction are not used (WriteLD is assumed).


  RewritePages: PUBLIC PROCEDURE [arg: POINTER TO extend DiskRequest]
    RETURNS [PageNumber, CARDINAL] =
    BEGIN OPEN arg;
    i: PageNumber;
    cbzone: ARRAY [0..lCBZ) OF UNSPECIFIED;
    zone: CBZptr = @cbzone[0];
    cb: CBptr;
    CAs: CAvec = DESCRIPTOR[ca, lastPage + 1];
    DAs: DAvec = DESCRIPTOR[da, lastPage + 2];
    ddc: DDC _ DDC[, ca, , , fp, FALSE, WriteLD];
    InitializeCBstorage[zone, nCB, firstPage, clear];
    BEGIN
    ENABLE RetryableDiskError => RETRY;
    FOR i _ zone.currentPage, i + 1 UNTIL i = lastPage + 1 DO
      cb _ GetCB[zone, clear];
      IF (i = lastPage AND lastBytes # CharsPerPage) OR DAs[i + 1] = fillinDA THEN
	DAs[i + 1] _ eofDA;
      cb.label.next _ RealDA[DAs[i + 1]];
      cb.label.prev _ RealDA[DAs[i - 1]];
      cb.label.bytes _ IF i = lastPage THEN lastBytes ELSE CharsPerPage;
      ddc.cb _ cb;
      ddc.da _ DAs[i];
      ddc.page _ i;
      IF ~fixedCA THEN ddc.ca _ CAs[i];
      DoDiskCommand[@ddc];
      ENDLOOP;
    CleanupCBqueue[zone];
    END;
    RETURN[lastPage, lastBytes]
    END;

  jump: CARDINAL = 5*nSectors;

  CreatePages: PUBLIC PROCEDURE [
    ca: POINTER, cfa: POINTER TO CFA, lastPage: PageNumber, lastBytes: CARDINAL] =
    BEGIN
    da: vDA _ cfa.fa.da;
    arg: extend DiskRequest;
    DAs: ARRAY [-1..jump] OF vDA;
    page: PageNumber _ cfa.fa.page;
    DO
      -- until lastPage is written
      MiscDefs.SetBlock[@DAs[-1], fillinDA, jump + 2];
      DAs[0] _ da;
      arg _ DiskRequest[
	ca, @DAs[-page], page, MIN[lastPage, page + (jump - 1)], @cfa.fp, TRUE,
	WriteD, WriteD, FALSE, extend[lastBytes]];
      [] _ WritePages[@arg];
      da _ DAs[arg.lastPage - page];
      page _ arg.lastPage;
      IF page = lastPage THEN EXIT;
      ENDLOOP;
    cfa.fa _ FA[da, lastPage, lastBytes];
    RETURN
    END;

  DeletePages: PUBLIC PROCEDURE [
    ca: POINTER, fp: POINTER TO FP, da: vDA, page: PageNumber] =
    BEGIN
    arg: update DiskRequest;
    lastPage, i: PageNumber;
    DAs: ARRAY [-1..jump] OF vDA;
    UNTIL da = eofDA DO
      MiscDefs.SetBlock[@DAs[-1], fillinDA, jump + 2];
      DAs[0] _ da;
      arg _ DiskRequest[
	ca, @DAs[-page], page, page + (jump - 1), fp, TRUE, ReadD, ReadD, FALSE,
	update[GetNextDA]];
      lastPage _ ActOnPages[@arg].page;
      MiscDefs.Zero[ca, PageSize];
      arg.fp _ LOOPHOLE[0];
      arg.lastPage _ lastPage;
      arg.action _ arg.lastAction _ WriteLD;
      [] _ ActOnPages[@arg];
      FOR i IN [0..lastPage - page] DO
	DiskKDDefs.ReleaseDiskPage[DAs[i]]; ENDLOOP;
      da _ DAs[lastPage + 1 - page];
      page _ lastPage + 1;
      ENDLOOP;
    RETURN
    END;

  CreateFile: PUBLIC PROCEDURE [
    name: STRING, fp, dirFP: POINTER TO FP, snBits: SNBits _ DefaultSNBits] =
    BEGIN OPEN SegmentDefs;
    DAs: ARRAY [-1..2] OF vDA _ [eofDA, fillinDA, fillinDA, eofDA];
    buf: DataSegmentHandle = NewDataSegment[DefaultBase, 1];
    ld: POINTER TO LD = DataSegmentAddress[buf];
    arg: extend DiskRequest _ DiskRequest[
      ld, @DAs[0], 0, 1, fp, TRUE, WriteD, WriteD, FALSE, extend[0]];
    BEGIN
    ENABLE UNWIND => DeleteDataSegment[buf];
    MiscDefs.Zero[ld, PageSize];
    ld.created _ MiscDefs.DAYTIME[];
    StringDefs.MesaToBcplString[name, LOOPHOLE[@ld.name]];
    ld.propBegin _ @ld.props[0] - ld;
    ld.propLength _ LENGTH[ld.props];
    IF dirFP # NIL THEN MakeCFP[@ld.dirFP, dirFP];
    fp^ _ FP[DiskKDDefs.NewSN[], eofDA];
    fp.serial.bits _ snBits;
    [] _ WritePages[@arg];
    END;
    fp.leaderDA _ DAs[0];
    DeleteDataSegment[buf];
    RETURN
    END;

  MakeFP: PUBLIC PROCEDURE [fp: POINTER TO FP, cfp: POINTER TO CFP] =
    BEGIN fp^ _ FP[cfp.serial, cfp.leaderDA]; RETURN END;

  MakeCFP: PUBLIC PROCEDURE [cfp: POINTER TO CFP, fp: POINTER TO FP] =
    BEGIN cfp^ _ CFP[fp.serial, 1, 0, fp.leaderDA]; RETURN END;


  END.