(*********************************************************************)
(* Title:	Extensions - Implementation			     *)
(* Author: 	Trevor Morris   				     *)
(* 		Copyright (C) 1985 by Acorn Research Centre	     *)
(*********************************************************************)


(*
  $Revision: 1.1 $
  $Author: mjj $
  $Date: 85/06/26 09:46:10 $
  $Source: /util/m2/ns16k/lib/RCS/Extensions.mod,v $
  $State: Exp $
*)

IMPLEMENTATION MODULE Extensions;

(* $T-, $R- *)

FROM SYSTEM IMPORT ADR, MAXCARD;
FROM Exceptions IMPORT RAISEC, StdException;
FROM Strings IMPORT
  String, New, Dispose, CopyCC, CopyCS, CopySS, LengthC, FindC, FindS;


CONST
  DeviceCh = ':';


PROCEDURE SepConcatXX(head, tail: String; headSize, hTail: CARDINAL; dir: BOOLEAN): String;
  VAR
    lHead, lTail, lTo, i, j: CARDINAL;
    to: String;
    sep: CHAR;
  BEGIN
    (*  cannot use LengthS, since original C array may not be null terminated *)
    lTail := 0;
    WHILE (lTail <= hTail) AND (tail^[lTail] # 0C) DO
      INC(lTail)
    END (* while *);

    IF dir THEN
      (* head length not known - 'headSize' is upper bound *)
      lHead := 0;
      WHILE (lHead <= headSize) AND (head^[lHead] # 0C) DO
        INC(lHead)
      END (* while *);
      IF (lHead > 0) AND (lTail > 0) AND (head^[lHead-1] # DeviceCh) THEN
        sep := DirSepCh;
      ELSE
        sep := 0C;
      END;
    ELSE (* ext *)
      (* head length already known *)
      lHead := headSize;
      sep := ExtSepCh;
    END;

    lTo := lHead + lTail;
    IF sep # 0C THEN INC(lTo) END;

    to:= New(lTo);
    i:= 0;
    WHILE i < lHead DO to^[i]:= head^[i]; INC(i) END;

    IF sep # 0C THEN
      to^[i] := sep; INC(i);
    END;

    j := 0;    
    WHILE i < lTo DO to^[i]:= tail^[j]; INC(i); INC(j) END;

    RETURN to;
  END SepConcatXX;


PROCEDURE DirConcatSS(head, tail: String): String;
  BEGIN
    RETURN SepConcatXX(head, tail, MAXCARD, MAXCARD, TRUE);
  END DirConcatSS;


PROCEDURE DirConcatCS(head: ARRAY OF CHAR;  tail: String): String;
  BEGIN
    RETURN SepConcatXX(String(ADR(head)), tail, HIGH(head), MAXCARD, TRUE);
  END DirConcatCS;


PROCEDURE DirConcatSC(head: String; tail: ARRAY OF CHAR): (* to *) String;
  BEGIN
    RETURN SepConcatXX(head, String(ADR(tail)), MAXCARD, HIGH(tail), TRUE);
  END DirConcatSC;


PROCEDURE SepConcatCC(head, tail: ARRAY OF CHAR; dir: BOOLEAN; lHead: CARDINAL;
 VAR to: ARRAY OF CHAR);
  VAR
    i, j, highTail: CARDINAL;
    tailCopy: String;
    sep: CHAR;
  BEGIN
    (*  care needed, since to=head or to=tail is ok but compiler
       might optimise to call by reference
       *)
    IF ADR(tail) = ADR(to) THEN   (* same array (call by reference) *)
      tailCopy := CopyCS(tail); highTail := MAXCARD;
    ELSE
      tailCopy := String(ADR(tail)); highTail := HIGH(tail)
    END (* if *);

    IF ADR(head) # ADR(to) THEN
      CopyCC(head, to);
    END (* if *);

    IF dir THEN
      (* Length of head not known *)
      j := LengthC(head);
      IF (j > 0) AND (tailCopy^[0] # 0C) AND (head[j-1] # DeviceCh) THEN
        sep := DirSepCh;
      ELSE
        sep := 0C;
      END;
    ELSE (* ext *)
      (* length of head passed in 'lHead' *)
      j := lHead;
      sep := ExtSepCh;
    END;

    IF sep # 0C THEN
      IF j > HIGH(to) THEN
	RAISEC(ArrayIndexOutOfRange);
      ELSE
	to[j] := sep;
      END;
      INC(j);
    END;

    i := 0;
    WHILE (i <= highTail) AND (tailCopy^[i] # 0C) DO
      IF (j) > HIGH(to) THEN
        RAISEC(ArrayIndexOutOfRange);
      ELSE
        to[j] := tailCopy^[i];
      END (* if *);
      INC(i);
      INC(j);
    END (* while *);

    IF j <= HIGH(to) THEN
      to[j] := 0C;
    END (* if *);

    IF ADR(tail) = ADR(to) THEN
      Dispose(tailCopy);
    END;
  END SepConcatCC;


PROCEDURE DirConcatCC(head, tail: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
  BEGIN
    SepConcatCC(head, tail, TRUE, 0, to);
  END DirConcatCC;


PROCEDURE TailX(s: String; high: CARDINAL; VAR lwb, upb: CARDINAL);
  VAR
    ch: CHAR;
  BEGIN
    upb := 0;
    lwb := 0;
    LOOP
      IF upb > high THEN EXIT END;
      ch := s^[upb];
      IF ch = 0C THEN EXIT END;
      INC(upb);
      IF (ch = DirSepCh) OR (ch = DeviceCh) THEN lwb := upb END;
    END;
  END TailX;


PROCEDURE TailC(name: ARRAY OF CHAR; VAR lwb, upb: CARDINAL);
  BEGIN
    TailX(String(ADR(name)), HIGH(name), lwb, upb);
  END TailC;


PROCEDURE TailS(name: String; VAR lwb, upb: CARDINAL);
  BEGIN
    TailX(name, MAXCARD, lwb, upb);
  END TailS;


CONST
  MaxM2ExtensionLength = 3;
  (* check this by looking at following procedure (grubby!) *)


PROCEDURE M2ExtensionChars(m2Ext: M2Extension; VAR ext: ARRAY OF CHAR);
  BEGIN
    CASE m2Ext OF
      Def: CopyCC("def", ext);
    | Sym: CopyCC("sym", ext);
    | Mod: CopyCC("mod", ext);
    | Ref: CopyCC("ref", ext);
    | Key: CopyCC("key", ext);
    | Obj: CopyCC("aof", ext);
    | Exe: CopyCC("rif", ext);
    | Asm: CopyCC("asm", ext);
    | Dec: CopyCC("dec", ext);
    END;
  END M2ExtensionChars;


PROCEDURE M2ExtendC(file: ARRAY OF CHAR; m2Ext: M2Extension;
 VAR to: ARRAY OF CHAR);
  VAR
    ext: ARRAY [0..MaxM2ExtensionLength] OF CHAR;
  BEGIN
    M2ExtensionChars(m2Ext, ext);
    ExtendC(file, ext, to);
  END M2ExtendC;


PROCEDURE M2ExtendS(file: String; m2Ext: M2Extension): String;
  VAR
    ext: ARRAY [0..MaxM2ExtensionLength] OF CHAR;
  BEGIN
    M2ExtensionChars(m2Ext, ext);
    RETURN ExtendS(file, ext);
  END M2ExtendS;


PROCEDURE Min(a, b: CARDINAL): CARDINAL;
  BEGIN
    IF a < b THEN RETURN a ELSE RETURN b END;
  END Min;


PROCEDURE ExtendC(file, ext: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
  VAR
    lwb, upb, look: CARDINAL;
  BEGIN
    TailC(file, lwb, upb);
    look := lwb;
    IF FindC(file, ExtSepCh, look) THEN
      CopyCC(file, to);
    ELSE
      upb := Min(lwb + MaxFileNameLength, upb);
      SepConcatCC(file, ext, FALSE, upb, to);
    END;
  END ExtendC;


PROCEDURE ExtendS(file: String; ext: ARRAY OF CHAR): String;
  VAR
    lwb, upb, look: CARDINAL;
  BEGIN
    TailS(file, lwb, upb);
    look := lwb;
    IF FindS(file, ExtSepCh, look) THEN
      RETURN CopySS(file);
    ELSE
      upb := Min(lwb + MaxFileNameLength, upb);
      RETURN SepConcatXX(file, String(ADR(ext)), upb, HIGH(ext), FALSE);
    END;
  END ExtendS;


END Extensions.

(*
$Log:	Extensions.mod,v $
Revision 1.1  85/06/26  09:46:10  mjj
Initial revision

*)