-- CSImpl.mesa
-- last edit by Schmidt, May 6, 1983 1:01 pm
-- last edit by Satterthwaite, August 11, 1983 8:24 am
-- replacement for SubrImpl in the Cedar world

DIRECTORY
  CS: TYPE USING [FileErrorType, read, readWrite, write],
  DCSFileTypes: TYPE USING [tLeaderPage],
  Directory: TYPE USING [CreateFile, Error, ignore, Lookup, UpdateDates],
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [Capability, Permissions, SetSize],
  FileStream: TYPE USING [Create],
  Inline: TYPE USING [DIVMOD, LongDivMod],
  IO: TYPE USING [
    card, GetChar, PFCodeProc, Put, PutF, PutFR, SetPFCodeProc,
    Signal, STREAM, string, Value],
  Rope: TYPE USING [Equal, Fetch, FromProc, Length, Lower, ROPE, Substr, Text],
  SafeStorage: TYPE USING [NewZone],
  Stream: TYPE USING [Handle],
  TimeStamp: TYPE USING [Stamp];
	
CSImpl: CEDAR PROGRAM 
    IMPORTS Directory, File, FileStream, Inline, IO, Rope, SafeStorage
    EXPORTS CS ~ {

 -- variables
  z: PUBLIC ZONE _ NIL;

 -- signals
  FileError: PUBLIC ERROR[error: CS.FileErrorType] ~ CODE;

 -- startup
  Init: PUBLIC PROC ~ {};	-- call to make sure module is started

 -- rope utilities

  RopeToString: PUBLIC UNSAFE PROC[to: LONG STRING, from: Rope.ROPE] ~ UNCHECKED {
    len: CARDINAL ~ from.Length;
    IF to.maxlength <= len THEN ERROR;
    FOR i: CARDINAL IN [0 .. len) DO
      to[i] _ from.Fetch[i];
      ENDLOOP;
    to.length _ len};

  RootName: PUBLIC PROC[name: Rope.ROPE] RETURNS[Rope.ROPE] ~ {
    i: CARDINAL _ name.Length - 1;
    WHILE i > 0 AND name.Fetch[i] ~= '. DO i _ i-1 ENDLOOP;
    RETURN[IF i > 0 THEN name.Substr[0, i] ELSE name]};

  EndsIn: PUBLIC PROC[str: Rope.ROPE, suf: Rope.Text] RETURNS[BOOL] ~ {
    strLength: CARDINAL ~ str.Length;
    sufLength: CARDINAL ~ suf.Length;
    RETURN[sufLength <= strLength AND
      suf.Equal[str.Substr[strLength-sufLength, sufLength], FALSE]]
    };

  EqualRS: PUBLIC PROC[r: Rope.ROPE, s: LONG STRING] RETURNS[BOOL] ~  TRUSTED {
    IF r.Length # s.length THEN RETURN[FALSE];
    FOR i: CARDINAL IN [0 .. s.length) DO
      IF r.Fetch[i] # s[i] THEN RETURN[FALSE];
      ENDLOOP;
    RETURN[TRUE]};

  EquivalentRS: PUBLIC PROC[r: Rope.ROPE, s: LONG STRING] RETURNS[BOOL] ~ TRUSTED {
    IF r.Length # s.length THEN RETURN[FALSE];
    FOR i: CARDINAL IN [0 .. s.length) DO
      IF Rope.Lower[r.Fetch[i]] # Rope.Lower[s[i]] THEN RETURN[FALSE];
      ENDLOOP;
    RETURN[TRUE]};


  StringToRope: PUBLIC UNSAFE PROC[from: LONG STRING]
      RETURNS[Rope.ROPE] ~ UNCHECKED {
    i: CARDINAL _ 0;
    
    EachChar: PROC RETURNS[c: CHAR] ~ TRUSTED {
      c _ from[i]; i _ i+1; RETURN};
      
    RETURN[Rope.FromProc[from.length, EachChar]]};
    
  
  CardFromRope: PUBLIC PROC[r: Rope.ROPE] RETURNS[val: LONG CARDINAL _ 0] ~ {
    FOR i: INT IN [0..r.Length) DO
      c: CHAR ~ r.Fetch[i];
      val _ 10*val + (c.ORD-'0.ORD);
      ENDLOOP;
    RETURN};

  RopeFromCard: PUBLIC PROC[val: LONG CARDINAL] RETURNS[Rope.ROPE] ~ {
    RETURN[IO.PutFR["%d", IO.card[val]]]};
    
    
  StampDigits: TYPE ~ [0 .. 4*TimeStamp.Stamp.SIZE);

  StampFromRope: PUBLIC PROC[r: Rope.ROPE] RETURNS[TimeStamp.Stamp] ~ {
    hex: PACKED ARRAY StampDigits OF [0..16);
    FOR i: NAT IN StampDigits DO
      c: CHAR ~ r.Fetch[i];
      hex[i] _ (SELECT c FROM
        IN ['0..'9] => (c.ORD-'0.ORD),
        IN ['a..'f] => (c.ORD-'a.ORD)+10,
        IN ['A..'F] => (c.ORD-'A.ORD)+10,
        ENDCASE => ERROR);
      ENDLOOP;
    RETURN[LOOPHOLE[hex]]};

  RopeFromStamp: PUBLIC PROC[stamp: TimeStamp.Stamp] RETURNS[Rope.ROPE] ~ {
    hex: PACKED ARRAY StampDigits OF [0..16) ~ LOOPHOLE[stamp];
    i: NAT _ 0;
    
    PutChar: PROC RETURNS[CHAR] ~ {
      d: [0..16) ~ hex[i];
      i _ i+1;
      RETURN[IF d<10 THEN VAL['0.ORD+d] ELSE VAL['a.ORD+(d-10)]]};
      
    RETURN[Rope.FromProc[StampDigits.LAST-StampDigits.FIRST+1, PutChar]]};
    

 -- misc
 
  Confirm: PUBLIC PROC[dch: CHAR, in, out: IO.STREAM] RETURNS[CHAR] ~ {
    ch: CHAR;
    bs: IO.STREAM ~ (IF in.backingStream = NIL THEN in ELSE in.backingStream);
    DO {
      ENABLE IO.Signal => {IF ec = Rubout THEN LOOP};
      out.Put[IO.string["? "L]];
      ch _ bs.GetChar;
      IF ch = '\n THEN ch _ dch;
      RETURN[Rope.Lower[ch]]};
      ENDLOOP;
    };

 -- npages should not include the leader page;  I'll add +1
  NewFile: PUBLIC UNSAFE PROC[name: Rope.Text, access: File.Permissions, npages: NAT]
      RETURNS[cap: File.Capability] ~ UNCHECKED {
    old: BOOL _ FALSE;
    IF access # CS.read THEN 
      cap _ Directory.CreateFile[LOOPHOLE[name], DCSFileTypes.tLeaderPage, npages + 1
		! Directory.Error => {
		    IF type = fileAlreadyExists THEN old _ TRUE 
		    ELSE ERROR FileError[$notFound];
		    CONTINUE}
		]
    ELSE old _ TRUE;
    IF old THEN 
      cap _ Directory.Lookup[fileName~LOOPHOLE[name], permissions~Directory.ignore
		! Directory.Error => {ERROR FileError[$notFound]}];
    cap _ Directory.UpdateDates[cap, access];
    IF old AND npages > 0 AND (access = CS.write OR access = CS.readWrite) THEN
      File.SetSize[cap, npages+1];
    };

  NewStream: PUBLIC UNSAFE PROC[name: Rope.Text, access: File.Permissions]
	RETURNS[Stream.Handle] ~ UNCHECKED {
    RETURN[FileStream.Create[NewFile[name, access, 0]]]};


 -- iostream utilities
 
  SetPFCodes: PUBLIC PROC[h: IO.STREAM] ~ {
    h.SetPFCodeProc['v, PrintVCode];
    h.SetPFCodeProc['y, PrintYCode]};

  PTimeStamp: TYPE ~ REF READONLY TimeStamp.Stamp;

  PrintVCode: IO.PFCodeProc ~ {
    WITH val SELECT FROM
      v: IO.Value.refAny => {
	pts: PTimeStamp ~ NARROW[v.value];
	stream.PutF["(%g#,%g#,%t)", IO.card[pts.net], IO.card[pts.host], IO.card[pts.time]]};
      ENDCASE => ERROR};

  PrintYCode: IO.PFCodeProc ~ {
    WITH val SELECT FROM
      v: IO.Value.cardinal => {
	hr, min, sec: CARDINAL;
	[min, sec] _ Inline.LongDivMod[v.value, 60];
	[hr, min] _ Inline.DIVMOD[min, 60];
	IF hr > 0 THEN
	  stream.PutF["%d:%02d:%02d", IO.card[hr], IO.card[min], IO.card[sec]]
	ELSE IF min > 0 THEN stream.PutF["%d:%02d", IO.card[min], IO.card[sec]]
	ELSE stream.PutF["%d", IO.card[sec]]};
      ENDCASE => ERROR};

 -- called when module is loaded
  Start: PROC ~ {
    z _ SafeStorage.NewZone[initialSize~40*Environment.wordsPerPage]};

 -- start code
  Start[];
  }.