gpcp/FileNames.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  FileNames Module for the Gardens Point Component Pascal Compiler.   *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*                                                                      *)
   6 (* ==================================================================== *)
   7
   8 MODULE FileNames;
   9   IMPORT GPFiles;
  10
  11   TYPE
  12         NameString* = ARRAY 128 OF CHAR;
  13
  14 (* ==================================================================== *)
  15 (*                              Utilities                               *)
  16 (* ==================================================================== *)
  17
  18     PROCEDURE GetBaseName*(IN in : ARRAY OF CHAR; OUT out : ARRAY OF CHAR);
  19       VAR sPos : INTEGER;
  20           dPos : INTEGER;
  21           idx  : INTEGER;
  22           chr  : CHAR;
  23     BEGIN
  24      (* ------------------------- *)
  25      (* Index 012...      v--LEN  *)
  26      (*       xxxxxxxxxxxx0       *)
  27      (*      ^---------------sPos *)
  28      (*                   ^--dPos *)
  29      (* ------------------------- *)
  30      (*           before          *)
  31      (* ------------------------- *)
  32      (*                           *)
  33      (*       xxx/xxxxx.xx0       *)
  34      (*          ^-----------sPos *)
  35      (*                ^-----dPos *)
  36      (* ------------------------- *)
  37      (*           after           *)
  38      (* ------------------------- *)
  39       sPos := -1;
  40       dPos := LEN(in$);
  41       FOR idx := 0 TO dPos DO
  42         chr := in[idx];
  43         IF chr = '.' THEN
  44           dPos := idx;
  45         ELSIF chr = GPFiles.fileSep THEN
  46           sPos := idx;
  47         END;
  48       END;
  49       FOR idx := 0 TO dPos-sPos-1 DO
  50         out[idx] := in[idx+sPos+1];
  51       END;
  52       out[dPos-sPos] := 0X;
  53     END GetBaseName;
  54
  55 (* ==================================================================== *)
  56
  57     PROCEDURE StripUpToLast*(mark : CHAR;
  58                          IN  in   : ARRAY OF CHAR;
  59                          OUT out  : ARRAY OF CHAR);
  60       VAR sPos : INTEGER;
  61           dPos : INTEGER;
  62           idx  : INTEGER;
  63           chr  : CHAR;
  64     BEGIN
  65      (* ------------------------- *)
  66      (* Index 012...      v--LEN  *)
  67      (*       xxxxxxxxxxxx0       *)
  68      (*      ^---------------sPos *)
  69      (*                   ^--dPos *)
  70      (* ------------------------- *)
  71      (*           before          *)
  72      (* ------------------------- *)
  73      (*                           *)
  74      (*       xxx!xxxxx.xx0       *)
  75      (*          ^-----------sPos *)
  76      (*                ^-----dPos *)
  77      (* ------------------------- *)
  78      (*           after           *)
  79      (* ------------------------- *)
  80       sPos := -1;
  81       dPos := LEN(in$);
  82       FOR idx := 0 TO dPos DO
  83         chr := in[idx];
  84         IF chr = '.' THEN
  85           dPos := idx;
  86         ELSIF chr = mark THEN
  87           sPos := idx;
  88         END;
  89       END;
  90       FOR idx := 0 TO dPos-sPos-1 DO
  91         out[idx] := in[idx+sPos+1];
  92       END;
  93       out[dPos-sPos] := 0X;
  94     END StripUpToLast;
  95
  96 (* ==================================================================== *)
  97
  98     PROCEDURE AppendExt*(IN in,ext : ARRAY OF CHAR; OUT out : ARRAY OF CHAR);
  99       VAR pos : INTEGER;
 100           idx : INTEGER;
 101           chr : CHAR;
 102     BEGIN
 103       pos := LEN(in$);
 104       FOR idx := 0 TO pos-1 DO out[idx] := in[idx] END;
 105       out[pos] := ".";
 106       FOR idx := 0 TO LEN(ext$) DO out[idx+pos+1] := ext[idx] END;
 107     END AppendExt;
 108
 109 (* ==================================================================== *)
 110
 111     PROCEDURE StripExt*(IN in : ARRAY OF CHAR; OUT out : ARRAY OF CHAR);
 112       VAR pos : INTEGER;
 113           idx : INTEGER;
 114           chr : CHAR;
 115     BEGIN
 116       pos := LEN(in$);
 117       FOR idx := 0 TO pos DO
 118         chr := in[idx];
 119         IF chr = '.' THEN pos := idx END;
 120         out[idx] := chr;
 121       END;
 122       out[pos] := 0X;
 123     END StripExt;
 124
 125 (* ==================================================================== *)
 126 BEGIN
 127 END FileNames.
 128