-- CreateAlpineFileImpl.Mesa
-- last edited  November 8, 1983 3:21 pm by Karen Kolling.
-- edited 2-Dec-81  1:09:36 by Paul Rovner.

DIRECTORY
    Directory USING[InsertFile, Lookup],
    File USING[nullCapability, Capability, ShowCapability, Create, Delete, MakePermanent, GetSize, PageCount],
    FileInternal USING[PageGroup, Descriptor],
    FileTypes USING[tUntypedFile],
    IO USING[card, CR, GetCard, GetChar, PutChar, PutF, PutRope, Signal],
    LogicalVolume USING[Handle, VolumeAccessProc],
    LongString USING[AppendNumber, AppendString],
    Rope USING[ROPE],
    UserExec USING[CommandProc, ExecHandle, GetStreams, HistoryEvent, RegisterCommand],
    VolFileMapImpl USING[GetPageGroup],
    Volume USING[GetAttributes, systemID, ID],
    VolumeImpl USING[VolumeAccess];

CreateAlpineFileImpl: PROGRAM
  IMPORTS Directory, File, IO, LongString, UserExec, VolFileMapImpl, Volume, VolumeImpl
  SHARES Directory, VolFileMapImpl, VolumeImpl
   
= BEGIN

filePages: NAT _ 4096;

ContigFileSize: CARDINAL = 100;

Bug: SIGNAL = CODE;

OutOfDisk: PROC[pagesNeeded: NAT] RETURNS[BOOLEAN] =
  {RETURN[Volume.GetAttributes[Volume.systemID].freePageCount < pagesNeeded]};
  
FileIsContiguousOnDisk: PROC[file: File.Capability] RETURNS[BOOLEAN] =
  { pageGroup: FileInternal.PageGroup;
    contiguous: BOOLEAN _ FALSE;
    problem: BOOLEAN _ FALSE;
    v: Volume.ID _ Volume.systemID;
    fpgs: File.PageCount = File.GetSize[file];
    
    d: FileInternal.Descriptor _ [fileID: File.ShowCapability[file].fID,
                                  volumeID: Volume.systemID,
                  body: local[immutable: FALSE,
                              temporary: TRUE,
                          size: fpgs,
                          type: FileTypes.tUntypedFile]];
    
    p: LogicalVolume.VolumeAccessProc =
     {[contiguous, pageGroup] _ VolFileMapImpl.GetPageGroup[volume, @d, 0];
      problem _ NOT contiguous;
      IF problem THEN RETURN[FALSE];
      contiguous _ pageGroup.nextFilePage - pageGroup.filePage = fpgs;
      RETURN[FALSE]};
      
    IF VolumeImpl.VolumeAccess[@v, p, FALSE]  # ok OR problem
     THEN ERROR Bug
     ELSE RETURN[contiguous]; 
  };
  
--CommandProc: TYPE = PROC [event: HistoryEvent, exec: ExecHandle, clientData: REF ANY _ NIL] RETURNS[ok: BOOLEAN _ TRUE, msg: ROPE 
_ NIL];
Main: SAFE PROC [event: UserExec.HistoryEvent, exec: UserExec.ExecHandle, clientData: REF ANY] RETURNS[ok: BOOLEAN, msg: Rope.ROPE] 
= TRUSTED
{ success: BOOLEAN _ FALSE;

  file: File.Capability _ File.nullCapability;
  fileName: LONG STRING _ [25];
  fileNumber: CARDINAL;
  
  fileArrayMaxLength: NAT = 40;
  a: ARRAY [0..fileArrayMaxLength) OF File.Capability _ ALL[File.nullCapability];
  x: NAT _ 0;

  UserExec.GetStreams[exec].out.PutRope["
  Please type desired file index [0..2000]..."];
  fileNumber _ UserExec.GetStreams[exec].in.GetCard[];
  IF fileNumber > 2000 THEN ERROR;
   
  fileName.length _ 0;
  LongString.AppendString[fileName, "Alpine"];
  LongString.AppendNumber[fileName, fileNumber, 10];
  LongString.AppendString[fileName, ".DontDeleteMe"];
 
  IF Directory.Lookup[fileName ! ANY => CONTINUE] # File.nullCapability
   THEN {UserExec.GetStreams[exec].out.PutRope["file already exists. You might want to delete it and try again.
   "];
         RETURN};
 
  UserExec.GetStreams[exec].out.PutRope["
Please type desired file size in pages..."];

  filePages _ UserExec.GetStreams[exec].in.GetCard[];
  
  IF filePages < 1 THEN filePages _ 1 ELSE IF filePages > 16384 THEN filePages _ 16384;
  
  UserExec.GetStreams[exec].out.PutF["*nUsing %g for filePages *n", IO.card[filePages]];
  IF NOT Confirm[exec] THEN RETURN;
  
  UserExec.GetStreams[exec].out.PutRope["This takes a while (small number of minutes, maybe). Hang in there..."];

  IF OutOfDisk[ContigFileSize]
   THEN {UserExec.GetStreams[exec].out.PutRope["Failure. Not enough free disk pages.
   "];
     RETURN};

  file _ File.Create[Volume.systemID, ContigFileSize, FileTypes.tUntypedFile];
  UserExec.GetStreams[exec].out.PutChar['n];
  
  DO IF FileIsContiguousOnDisk[file]
      THEN {a[x] _ file;
            x _ x + 1;
            IF x >= fileArrayMaxLength OR OutOfDisk[filePages] THEN EXIT;
            file _ File.Create[Volume.systemID, filePages, FileTypes.tUntypedFile];
            UserExec.GetStreams[exec].out.PutChar['N];
            IF FileIsContiguousOnDisk[file]
         THEN {success _ TRUE; EXIT}
             ELSE {a[x] _ file;
                   x _ x + 1;
                   IF x >= fileArrayMaxLength OR OutOfDisk[ContigFileSize] THEN EXIT;
                   file _ File.Create[Volume.systemID, ContigFileSize, FileTypes.tUntypedFile];
           UserExec.GetStreams[exec].out.PutChar['n]}};
      a[x] _ file;
      x _ x + 1;
      IF x >= fileArrayMaxLength OR OutOfDisk[ContigFileSize] THEN EXIT;
      file _ File.Create[Volume.systemID, ContigFileSize, FileTypes.tUntypedFile];
      UserExec.GetStreams[exec].out.PutChar['n];
  ENDLOOP; 
 
  FOR i: NAT IN [0..x)
    DO {UserExec.GetStreams[exec].out.PutChar[IF File.GetSize[a[i]] = ContigFileSize THEN 'd ELSE 'D];
        File.Delete[a[i]]}
   ENDLOOP;

  UserExec.GetStreams[exec].out.PutRope["
  "];

  IF success
   THEN {File.MakePermanent[file];
         Directory.InsertFile[fileName, file];
         UserExec.GetStreams[exec].out.PutRope["Success. file has been created.
         "];
         }
   ELSE UserExec.GetStreams[exec].out.PutRope[
                    "Failure. The volume is fragmented enough that you'll have to erase it and start from fresh to create the 
Alpine file.
                    "];
};

UpperCase: PROC[ch: CHARACTER] RETURNS[CHARACTER] =
{SELECT ch FROM
   IN ['a..'z] => RETURN[ch - 'a + 'A];
  ENDCASE => RETURN[ch]};

Confirm: PROC[exec: UserExec.ExecHandle] RETURNS[BOOLEAN] =
  { ENABLE IO.Signal => TRUSTED BEGIN IF ec = Rubout THEN GOTO rubout; END;

    ch: CHARACTER;
    UserExec.GetStreams[exec].out.PutRope["[Confirm] "];
    ch _ UpperCase[UserExec.GetStreams[exec].in.GetChar[]];
    SELECT ch FROM
    IO.CR, 'Y =>
        { UserExec.GetStreams[exec].out.PutRope["(Yes)
        "];
          RETURN[TRUE]};
     ENDCASE =>
        { UserExec.GetStreams[exec].out.PutRope["(No)
        "];
          RETURN[FALSE]};
     EXITS rubout =>
        { UserExec.GetStreams[exec].out.PutRope["(No)
        "];
          RETURN[FALSE]}};


      -- START HERE

UserExec.RegisterCommand[name: "Main", proc: Main];
  
END.