Topspeed_JPI/TS-V3/SRC/FILESYST.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  FILESYST.MOD - File utilities                                           *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1987..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  (*# call(o_a_copy=>off) *)
   12  
   13  (*%F _fdata *)
   14  (*# call(seg_name => null) *)
   15  (*%E *)
   16  
   17  (*# data(seg_name => null) *)
   18  (*# check(stack=>off,
   19            index=>off,
   20            range=>off,
   21            overflow=>off,
   22            nil_ptr=>off) *)
   23  
   24  IMPLEMENTATION MODULE FileSystem;
   25  
   26  IMPORT Str, Storage, CoreIO;
   27  
   28  VAR
   29      LastTempExt: ARRAY [0..8] OF CHAR;
*****                             ^ not supported yet
*****                                   ^ not supported yet
   30  
   31  
   32  PROCEDURE  GetTempFileName(VAR Name: FileNameType): BOOLEAN;
*****                                       ^ undeclared identifier
   33  
   34  VAR
   35      n, p: INTEGER;
   36  BEGIN
   37      n:=Str.Length(Name)-8;
*****         ^ not supported yet
*****             ^ not supported yet
*****                    ^ not supported yet
   38      IF n < 0 THEN
   39  	RETURN FALSE;
   40      END;	
   41      p:=0;
   42      WHILE p < 8 DO		       (* append previous extension *)
   43  	Name[n]:=LastTempExt[p];
*****  	^ not supported yet
*****  	      ^ not supported yet
*****  	         ^ not supported yet
*****  	                      ^ not supported yet
   44  	INC(p);
*****  	^ undeclared identifier
*****  	     ^ not supported yet
   45  	INC(n);
*****  	^ undeclared identifier
*****  	     ^ not supported yet
   46      END;
   47      DEC(n, 5);
*****      ^ undeclared identifier
*****              ^ not supported yet
   48      p:=3;			       (* if yes increment counters *)
   49      REPEAT
   50          LOOP
   51              IF Name[n] < '9' THEN
*****                 ^ not supported yet
*****                       ^ not supported yet
   52                  INC(Name[n]);
*****                  ^ undeclared identifier
*****                      ^ not supported yet
*****                            ^ not supported yet
   53          	INC(LastTempExt[p]);
*****          	^ undeclared identifier
*****          	    ^ not supported yet
*****          	                 ^ not supported yet
   54          	EXIT;
   55              END;
   56              IF p >= 0 THEN
   57                  Name[n]:='0';
*****                  ^ not supported yet
*****                        ^ not supported yet
   58                  DEC(n);
*****                  ^ undeclared identifier
*****                       ^ not supported yet
   59          	LastTempExt[p]:='0';
*****          	^ not supported yet
*****          	             ^ not supported yet
   60          	DEC(p);
*****          	^ undeclared identifier
*****          	     ^ not supported yet
   61              ELSE
   62                  RETURN FALSE;
   63              END;
   64          END;
   65      UNTIL NOT FIO.Exists(Name);
*****                ^ undeclared identifier
*****                    ^ not supported yet
*****                           ^ not supported yet
   66      RETURN TRUE;
   67  END GetTempFileName;
*****      ^ not supported yet
   68  
   69  PROCEDURE  SetErrorType(VAR f: File);
*****                                 ^ undeclared identifier
   70  
   71  BEGIN
   72      CASE FIO.IOresult() OF
*****           ^ undeclared identifier
*****               ^ not supported yet
*****                        ^ not supported yet
   73          | 0 :
   74              f.res:=done;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   75          | 1 :
   76              f.res:=callerror;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   77          | 2 :
   78              f.res:=unknownfile;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   79          | 3 :
   80              f.res:=unknownpath;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   81          | 4 :
   82              f.res:=toomanyfiles;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   83          | 5 :
   84              f.res:=softprotected;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   85          | 15 :
   86              f.res:=unknownmedium;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   87          | 19 :
   88              f.res:=hardprotected;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   89          ELSE
   90              f.res:=notdone;
*****              ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
   91      END;
   92  END SetErrorType;
*****      ^ not supported yet
   93  
   94  
   95  PROCEDURE Create(VAR f: File; Device: ARRAY OF CHAR);
*****                          ^ undeclared identifier
*****                                                 ^ not supported yet
   96  
   97  BEGIN
   98      f.flags:=FlagSet{};
*****      ^ not supported yet
*****        ^ not supported yet
*****               ^ undeclared identifier
   99      f.eof:=FALSE;
  100      f.fileno:=MAX(CARDINAL);
  101      Str.Copy(f.name, Device);
  102      Str.Append(f.name, '\');
  103      Str.Append(f.name, 'FSYSXXXX.XXX');
  104      IF GetTempFileName(f.name) = FALSE THEN
  105          f.res:=toomanyfiles;
  106          RETURN;
  107      END;
  108      f.fileno:=FIO.Create(f.name);
  109      IF f.fileno = MAX(CARDINAL) THEN
  110          SetErrorType(f);
  111          RETURN;
  112      END;
  113      Storage.ALLOCATE(f.buffer, BufferSize);
  114      FIO.AssignBuffer(f.fileno, f.buffer^);
  115      INCL(f.flags, tf);
  116      f.res:=done;
  117      RETURN;
  118  END Create;
  119  
  120  PROCEDURE Close(VAR f: File);
  121  
  122  BEGIN
  123      FIO.Close(f.fileno);
  124      Storage.DEALLOCATE(f.buffer, BufferSize);
  125      IF tf IN f.flags THEN
  126          FIO.Erase(f.name);
  127      END;
  128      f.flags:=FlagSet{};
  129      f.fileno:=MAX(CARDINAL);
  130      f.res:=done;
  131  END Close;
  132  
  133  PROCEDURE Lookup(VAR f: File; Filename: ARRAY OF CHAR; New: BOOLEAN);
  134  
  135  VAR
  136      OK: BOOLEAN;
  137  BEGIN
  138      f.flags:=FlagSet{};
  139      f.eof:=FALSE;
  140      f.fileno:=MAX(CARDINAL);
  141      OK:=TRUE;
  142      Str.Copy(f.name, Filename);
  143      IF FIO.Exists(f.name) THEN
  144          f.fileno:=FIO.Open(f.name);
  145          IF f.fileno = MAX(CARDINAL) THEN
  146              OK:=FALSE;
  147          END;
  148      ELSIF New THEN
  149          f.fileno:=FIO.Create(f.name);
  150          IF f.fileno = MAX(CARDINAL) THEN
  151              OK:=FALSE;
  152          END;
  153      ELSE
  154          OK:=FALSE;
  155      END;
  156      IF NOT OK THEN
  157          f.res:=notdone;
  158          RETURN;
  159      END;
  160      Storage.ALLOCATE(f.buffer, BufferSize);
  161      FIO.AssignBuffer(f.fileno, f.buffer^);
  162      f.res:=done;
  163      RETURN;
  164  END Lookup;
  165  
  166  PROCEDURE Rename(VAR f: File; Filename: ARRAY OF CHAR);
  167  
  168  VAR
  169      NewName: FileNameType;
  170  BEGIN
  171      EXCL(f.flags, tf);
  172      Close(f);
  173      IF Filename[0] = CHAR(0) THEN
  174          Str.Copy(NewName, '\');
  175          Str.Append(NewName, 'FSYSXXXX.XXX');
  176          IF GetTempFileName(NewName) = FALSE THEN
  177              f.res:=toomanyfiles;
  178              RETURN;
  179          END;
  180          FIO.Rename(f.name, NewName);
  181          Lookup(f, NewName, FALSE);
  182          IF f.res # done THEN RETURN END;
  183          INCL(f.flags, tf);
  184      ELSE
  185          FIO.Rename(f.name, Filename);
  186          Lookup(f, Filename, FALSE);
  187          IF f.res # done THEN RETURN END;
  188      END;
  189      f.res:=done;
  190  END Rename;
  191  
  192  PROCEDURE SetRead(VAR f: File);
  193  
  194  VAR
  195      CurrentPos: LONGCARD;
  196  BEGIN
  197      CurrentPos:=FIO.GetPos(f.fileno);
  198      FIO.Seek(f.fileno, CurrentPos);
  199      f.flags:= f.flags - FlagSet{wr, mo};
  200      INCL(f.flags, rd);
  201      f.res:=done;
  202  END SetRead;
  203  
  204  PROCEDURE SetWrite(VAR f: File);
  205  
  206  VAR
  207      CurrentPos: LONGCARD;
  208  BEGIN
  209      CurrentPos:=FIO.GetPos(f.fileno);
  210      FIO.Seek(f.fileno, CurrentPos);
  211      f.flags:=f.flags - FlagSet{rd ,mo};
  212      f.flags:=f.flags + FlagSet{pi, wr};
  213      f.res:=done;
  214  END SetWrite;
  215  
  216  PROCEDURE SetModify(VAR f: File);
  217  
  218  VAR
  219      CurrentPos: LONGCARD;
  220  BEGIN
  221      CurrentPos:=FIO.GetPos(f.fileno);
  222      FIO.Seek(f.fileno, CurrentPos);
  223      f.flags:=f.flags - FlagSet{rd, wr};
  224      INCL(f.flags, mo);
  225      f.res:=done;
  226  END SetModify;
  227  
  228  PROCEDURE SetOpen(VAR f: File);
  229  
  230  VAR
  231      CurrentPos: LONGCARD;
  232  BEGIN
  233      CurrentPos:=FIO.GetPos(f.fileno);
  234      FIO.Seek(f.fileno, CurrentPos);
  235      f.flags:=f.flags - FlagSet{rd, mo, wr};
  236      f.res:=done;
  237  END SetOpen;
  238  
  239  PROCEDURE FillBuffer(f: File);
  240  
  241  VAR
  242      F: FIO.FileInf;
  243      NumRead: INTEGER;
  244  BEGIN
  245      F:=FIO.GetStreamPointer(f.fileno);
  246      WITH F^ DO
  247        IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR  + CoreIO._F_OUT)) # {}) THEN
  248            f.res:=callerror;
  249            RETURN
  250        END;
  251        IF (Flag >= CoreIO._F_EOF) THEN
  252            f.eof:=TRUE;
  253            f.res:=notdone;
  254            RETURN;
  255        END;
  256        IF (Flag >= CoreIO._F_RST) THEN
  257          Flag := Flag - CoreIO._F_RST;
  258        END;
  259        NumRead := CoreIO.read(Handle, Base, Size);
  260        Ptr := Base;
  261        IF (NumRead = -1) AND (NumRead # Size) THEN
  262          Flag := Flag + CoreIO._F_ERR;
  263          Cnt := 0;
  264          f.res:=notdone;
  265          RETURN;
  266        END;
  267        Cnt := NumRead;	            (* reset pointers *)
  268        Flag := Flag + CoreIO._F_IN;         (* set input flag *)
  269        IF NumRead = 0 THEN
  270          Flag := Flag + CoreIO._F_EOF;      (* end of file *)
  271          f.eof:=TRUE;
  272          f.res:=notdone;
  273          RETURN;
  274        END;
  275        f.res:=done;
  276        RETURN;
  277      END;
  278  END FillBuffer;
  279  
  280  PROCEDURE Doio(VAR f: File);
  281  
  282  VAR
  283      CurPos: LONGCARD;
  284  BEGIN
  285      IF (rd IN f.flags) THEN
  286          CurPos:=FIO.GetPos(f.fileno);
  287          FIO.Seek(f.fileno, CurPos);
  288          FillBuffer(f);
  289      ELSIF (wr IN f.flags) THEN
  290          FIO.Flush(f.fileno);
  291      ELSIF (mo IN f.flags) THEN
  292          FIO.Flush(f.fileno);
  293          FillBuffer(f);
  294      ELSE
  295          f.res:=done;
  296      END;
  297  
  298  
  299  END Doio;
  300  
  301  
  302  PROCEDURE SetPos(VAR f: File; HighPos, LowPos: CARDINAL);
  303  
  304  VAR
  305      Pos: LONGCARD;
  306  BEGIN
  307      Pos:=LONGCARD(LowPos)+LONGCARD(HighPos)<<16;
  308      FIO.Seek(f.fileno, Pos);
  309      INCL(f.flags, pi);
  310      f.res:=done;
  311  END SetPos;
  312  
  313  
  314  PROCEDURE GetPos(VAR f: File; VAR HighPos, LowPos: CARDINAL);
  315  
  316  VAR
  317      Pos: LONGCARD;
  318  BEGIN
  319      Pos:=FIO.GetPos(f.fileno);
  320      IF Pos = MAX(LONGCARD) THEN
  321          SetErrorType(f);
  322          RETURN;
  323      END;
  324      LowPos:=CARDINAL(Pos);
  325      HighPos:=CARDINAL(Pos>>16);
  326      f.res:=done;
  327  END GetPos;
  328  
  329  
  330  PROCEDURE Length(VAR f: File; VAR HighPos, LowPos: CARDINAL);
  331  
  332  VAR
  333      Len: LONGCARD;
  334  BEGIN
  335      Len:=FIO.Size(f.fileno);
  336      IF Len = MAX(LONGCARD) THEN
  337          SetErrorType(f);
  338          RETURN;
  339      END;
  340      LowPos:=CARDINAL(Len);
  341      HighPos:=CARDINAL(Len>>16);
  342      f.res:=done;
  343      RETURN;
  344  END Length;
  345  
  346  
  347  PROCEDURE Reset(VAR f: File);
  348  
  349  BEGIN
  350      SetPos(f, 0, 0);
  351      f.flags:=f.flags - FlagSet{rd, mo, wr};
  352      f.eof:=FALSE;
  353      f.res:=done;
  354  END Reset;
  355  
  356  
  357  PROCEDURE Again(VAR f: File);
  358  
  359  BEGIN
  360      IF f.flags * FlagSet{mo, rd} # FlagSet{} THEN
  361          INCL(f.flags, ag);
  362          f.res:=done;
  363      ELSE
  364          f.res:=callerror;
  365      END;
  366      RETURN;
  367  END Again;
  368  
  369  
  370  PROCEDURE ReadWord(VAR f: File; VAR w: WORD);
  371  
  372  BEGIN
  373      IF wr IN f.flags THEN
  374          f.res:=callerror;
  375          RETURN;
  376      ELSIF f.flags * FlagSet{mo, rd} = FlagSet{} THEN
  377          INCL(f.flags, rd);
  378      END;
  379      FIO.EOF:=FALSE;
  380      IF ag IN f.flags THEN
  381          EXCL(f.flags, ag);
  382          w:=f.again;
  383          f.res:=done;
  384          RETURN;
  385      END;
  386      IF FIO.RdBin(f.fileno, w, SIZE(WORD)) # SIZE(WORD) THEN
  387          SetErrorType(f);
  388          f.eof:=FIO.EOF;
  389      ELSE
  390          f.again:=w;
  391          f.res:=done;
  392      END;
  393      RETURN;
  394  END ReadWord;
  395  
  396  
  397  PROCEDURE WriteWord(VAR f: File; w: WORD);
  398  
  399  BEGIN
  400      IF rd IN f.flags THEN
  401          f.res:=callerror;
  402          RETURN;
  403      ELSIF f.flags * FlagSet{mo, wr} = FlagSet{} THEN
  404          INCL(f.flags, wr);
  405      END;
  406      FIO.WrBin(f.fileno, w, SIZE(WORD));
  407      f.res:=done;
  408      RETURN;
  409  END WriteWord;
  410  
  411  PROCEDURE ReadChar(VAR f: File; VAR ch: CHAR);
  412  
  413  BEGIN
  414      IF wr IN f.flags THEN
  415          f.res:=callerror;
  416          RETURN;
  417      ELSIF f.flags * FlagSet{mo, rd} = FlagSet{} THEN
  418          INCL(f.flags, rd);
  419      END;
  420      FIO.EOF:=FALSE;
  421      IF ag IN f.flags THEN
  422          EXCL(f.flags, ag);
  423          ch:=CHAR(f.again);
  424          f.res:=done;
  425          RETURN;
  426      END;
  427      ch:=FIO.RdChar(f.fileno);
  428      IF ch = CHAR(0DH) THEN
  429          ch:=FIO.RdChar(f.fileno);
  430      END;
  431      IF ch = CHR(26) THEN
  432          SetErrorType(f);
  433          f.eof:=FIO.EOF;
  434          f.res:=notdone;
  435      ELSE
  436          f.again:=WORD(ch);
  437          f.res:=done;
  438      END;
  439  END ReadChar;
  440  
  441  PROCEDURE WriteChar(VAR f: File; ch: CHAR);
  442  
  443  VAR
  444      HighEnd, LowEnd: CARDINAL;
  445  BEGIN
  446      IF rd IN f.flags THEN
  447          f.res:=callerror;
  448          RETURN;
  449      ELSIF f.flags * FlagSet{mo, wr} = FlagSet{} THEN
  450          f.flags:= f.flags + FlagSet{pi, wr};
  451      END;
  452      IF pi IN f.flags THEN
  453          Length(f, HighEnd, LowEnd);
  454          SetPos(f, HighEnd, LowEnd);
  455          EXCL(f.flags, pi);
  456      END;
  457      IF ch = EOL THEN
  458          FIO.WrLn(f.fileno);
  459      ELSE
  460          FIO.WrChar(f.fileno, ch);
  461      END;
  462      f.res:=done;
  463      RETURN;
  464  END WriteChar;
  465  
  466  
  467  BEGIN
  468     FIO.IOcheck:=FALSE;
  469     LastTempExt:= "0000.$$$";
  470  END FileSystem.
  471  

   73 errors