home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / files.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  24KB  |  773 lines

  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. StampElems
  6. Alloc
  7. 24 Dec 95
  8. Syntax10b.Scn.Fnt
  9. (* AMIGA *)
  10. MODULE Files;  (* shml/cn 16.12.1992 Oberon files mapped onto AmigaDOS files, 
  11.     NOTE
  12.         This module is built on the assumption, that it never holds
  13.         an exclusive lock on any of its open files. Only temporary
  14.         files used within a single procedure (like in rename) may
  15.         be opend exclusively, but have to be closed before the
  16.         procedure termination.
  17. IMPORT
  18.     SYSTEM,Amiga,Dos:=AmigaDos,I:=AmigaIntuition,Kernel;
  19. CONST
  20.     BigEndianSet=FALSE;    (* TRUE for HP,PowerOberon, FALSE for others (e.g. Amiga) *)
  21.     BigEndianMachine=TRUE;    (* 680x0 is big endian, i386 is little endian *)
  22.     nofbufs=4;
  23.     bufsize=4096;
  24.     fileTabSize=100;
  25.     noDesc=0;
  26.     (* file states *)
  27.     open=0; create=1; close=2;
  28.     (* error results *)
  29.     noError=0; directoryNotFound=1; fileNotFound=2;
  30.     FileName=ARRAY 104 OF CHAR;
  31.     File*=POINTER TO Handle;
  32.     Buffer=POINTER TO BufDesc;
  33.     FileInfoBlockPtr=POINTER TO Dos.FileInfoBlock;
  34.     workName: The name currently in use on the underlying file system.
  35.     registerName: Name to enter in the directory, if the file is registered.
  36.     fl: AmigaDos lock to the file.
  37.     fd: AmigaDos file handle to the file.
  38.     len: legth of the file.
  39.     pos: Remebers the actual position in the underlying AmigaDos file.
  40.     bufs: Buffers for the file.
  41.     swapper: Number of the last swapped out buffer.
  42.     state: see below.
  43.     idx:
  44.     When a file is opened with Old, its name is stored into workName,
  45.     registerName is empty and state becomes open. fd and fl are valid
  46.     handle and lock to the file.
  47.     When a file is created with New, its name is stored into registerName,
  48.     while workName stays empty and state becomes create. fd and fl are
  49.     not set up, as no connection to an actual file is performed at this stage.
  50.     Create will actually associate an AmigaDos file to the Oberon file when
  51.     this is needed. If the state is create, then only a temporary file is associated
  52.     to it. This follows the Oberon idea, that no directory entry is made unless
  53.     Register is called. The state close indicates to Create, that we are registering
  54.     a file which hasn't yet an association to an AmigaDos file. The register name
  55.     is thus used. In any case the file changes state to open, as now an association
  56.     is made.
  57.     Handle=RECORD
  58.         registerName:FileName;
  59.         fl:Dos.FileLockPtr;
  60.         fd:Dos.FileHandlePtr;
  61.         len,pos:LONGINT;
  62.         bufs:ARRAY nofbufs OF Buffer;
  63.         swapper,state,idx:INTEGER
  64.     END;
  65.     f: File to which this buffer belongs.
  66.     chg: TRUE if buffer content differs from the one stored in the file.
  67.     org: The offset within the underlying file which corresponds to the first byte of the buffer.
  68.     size: The numer of valid bytes in this buffer.
  69.     data: buffer space.
  70.     BufDesc=RECORD
  71.         f:File;
  72.         chg:BOOLEAN;
  73.         org,size:LONGINT;
  74.         data:ARRAY bufsize OF SYSTEM.BYTE
  75.     END;
  76.     Rider*=RECORD
  77.         res*:LONGINT;
  78.         eof*:BOOLEAN;
  79.         buf:Buffer;
  80.         org,offset:LONGINT
  81.     END;
  82.     CurrentDir-:ARRAY 256 OF CHAR;
  83.     searchPath:ARRAY 256 OF CHAR;
  84.     fileTab:ARRAY fileTabSize OF LONGINT;
  85.     startTime:LONGINT;
  86.     tempno:INTEGER;
  87. PROCEDURE^ Finalize(obj:SYSTEM.PTR);
  88. PROCEDURE isSeekError(oldPos,pos:LONGINT):BOOLEAN;
  89.     Pre V39 seek doesn't correctly return -1 on a seek
  90.     error. This procedure corrects for this.
  91. BEGIN
  92.     IF (oldPos=pos) & (Dos.dosVersion<39) THEN
  93.         RETURN Dos.IoErr()#0
  94.     ELSE
  95.         RETURN oldPos<0
  96. END isSeekError;
  97. PROCEDURE SeekAndExtend(f:Dos.FileHandlePtr; newpos:LONGINT);
  98.     Seek to the selected position in the file, extending it
  99.     if necessary to reach this position.
  100.     pos:LONGINT;
  101. BEGIN
  102.     pos:=Dos.Seek(f,newpos,Dos.beginning);
  103.     IF isSeekError(pos,newpos) THEN
  104.             Error in seek, probably because the file was too
  105.             short. So extend the file and then seek again.
  106.         pos:=Dos.SetFileSize(f,newpos,Dos.beginning);
  107.         ASSERT(pos=newpos, 44);
  108.         pos:=Dos.Seek(f,newpos,Dos.beginning);
  109.         ASSERT(~isSeekError(pos,newpos), 45)
  110. END SeekAndExtend;
  111. PROCEDURE MakeFileName(dir,name:ARRAY OF CHAR; VAR dest:ARRAY OF CHAR);
  112. BEGIN
  113.     dest[0]:=0X;
  114.     IF Dos.AddPart(dest,dir,LEN(dest)) THEN END;
  115.     IF Dos.AddPart(dest,name,LEN(dest)) THEN END
  116. END MakeFileName;
  117. PROCEDURE GetTempName(VAR path:ARRAY OF CHAR);
  118.     Generate a new temporary file name.
  119.     n,i,c:LONGINT;
  120.     name:FileName;
  121. BEGIN
  122.     INC(tempno);
  123.     n:=tempno;
  124.     COPY(".tmp.00000000.00000",name);
  125.     i:=18;
  126.     WHILE n>0 DO
  127.         name[i]:=CHR(n MOD 10+ORD("0"));
  128.         n:=n DIV 10;
  129.         DEC(i)
  130.     END;
  131.     n:=startTime;
  132.     i := 12;
  133.     WHILE n>0 DO
  134.         c:=n MOD 16;
  135.         IF c>9 THEN INC(c,ORD("A")-ORD("9")-1) END;
  136.         name[i]:=CHR(c+ORD("0"));
  137.         n:=n DIV 16;
  138.         DEC(i)
  139.     END;
  140.     MakeFileName(CurrentDir,name,path)
  141. END GetTempName;
  142. PROCEDURE CacheEntry(fl:Dos.FileLockPtr):File;
  143.     Given an AmigaDos file lock search our open file
  144.     table, whether the file was already opened.
  145.     f:File;
  146.     i:INTEGER;
  147. BEGIN
  148.     FOR i:=0 TO fileTabSize-1 DO
  149.         f:=SYSTEM.VAL(File,fileTab[i]);
  150.         IF (f#NIL) THEN
  151.             IF Dos.SameLock(fl,f.fl)=Dos.same THEN
  152.                 RETURN f
  153.             END
  154.         END
  155.     END;
  156.     RETURN NIL
  157. END CacheEntry;
  158. PROCEDURE Rename*(old,new:ARRAY OF CHAR; VAR res:INTEGER);
  159.     Rename a file. If necessary perform a copy/delete operation,
  160.     to move the file across file systems.
  161. CONST
  162.     bufSize=4096;
  163.     fdold,fdnew:Dos.FileHandlePtr;
  164.     n,errno:LONGINT;
  165.     lock:Dos.FileLockPtr;
  166.     buf:ARRAY bufSize OF CHAR;
  167.     tmp:ARRAY 104 OF CHAR;
  168.     success:BOOLEAN;
  169. BEGIN
  170.         First locate the old file. Dos.Lock can only file, if the
  171.         file doesn't exist, or if some other program than Oberon
  172.         has it opened exclusively.
  173.     lock:=Dos.Lock(old,Dos.sharedLock);
  174.     IF lock=0 THEN
  175.         res:=fileNotFound
  176.     ELSE
  177.             Delete any file already existing with the new name.
  178.         IF ~Dos.DeleteFile(new) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END;
  179.         IF res=Dos.objectInUse THEN
  180.             (*
  181.                 If the named file cannot be deleted, because it's
  182.                 opened, then rename it to some temporary name.
  183.             *)
  184.             GetTempName(tmp);
  185.             success:=Dos.Rename(new,tmp);
  186.             ASSERT(success,91)
  187.         END;
  188.             Now try to rename the old file to the
  189.             new name.
  190.         success:=Dos.Rename(old,new);
  191.         Dos.UnLock(lock);
  192.         IF ~success THEN
  193.             errno:=Dos.IoErr();
  194.             IF errno#Dos.renameAcrossDevices THEN
  195.                 (*
  196.                     The rename failed because of some unexpected
  197.                     reason, report this reason in res.
  198.                 *)
  199.                 res:=SHORT(errno);
  200.                 RETURN
  201.             ELSE
  202.                 (*
  203.                     The rename failed because the new name specifies a different file
  204.                     systen than the old name. The files has to be moved by a copy
  205.                     delete operation.
  206.                     NOTE
  207.                         The new files is opened exclusively, thus should guarantee its
  208.                         closure as Oberon cannot handle exclusively locked files.
  209.                 *)
  210.                 fdold:=Dos.Open(old,Dos.oldFile);
  211.                 IF fdold=0 THEN errno:=Dos.IoErr(); HALT(92) END;
  212.                 fdnew:=Dos.Open(new,Dos.newFile);
  213.                 IF fdnew=0 THEN errno:=Dos.IoErr(); HALT(93) END;
  214.                 IF Dos.SetProtection(new,{Dos.protExecute}) THEN END; (* everything but excute *)
  215.                 n:=Dos.Read(fdold,buf,bufSize);
  216.                 WHILE n>0 DO
  217.                     errno:=Dos.Write(fdnew,buf,n);
  218.                     IF errno#n THEN
  219.                         errno:=Dos.IoErr();
  220.                         IF Dos.Close(fdold) THEN END;
  221.                         IF Dos.Close(fdnew) THEN END;
  222.                         HALT(94)
  223.                     END;
  224.                     n:=Dos.Read(fdold,buf,bufSize)
  225.                 END;
  226.                 IF Dos.Close(fdold) THEN END;
  227.                 IF Dos.Close(fdnew) THEN END;
  228.                 IF Dos.DeleteFile(old) THEN END;
  229.                 res:=0
  230.             END
  231.         END;
  232.         res:=0
  233. END Rename;
  234. PROCEDURE Delete*(name:ARRAY OF CHAR; VAR res:INTEGER);
  235.     Delete a file. If it is hold by Oberon, it is renamed to a
  236.     temporary file.
  237.     f:File;
  238.     lock:Dos.FileLockPtr;
  239.     tempName:FileName;
  240. BEGIN
  241.     lock:=Dos.Lock(name,Dos.sharedLock);
  242.     IF lock=0 THEN
  243.             If we can't lock it, it either doesn't exist, or is
  244.             locked exclusively by another program.
  245.         res:=fileNotFound
  246.     ELSE
  247.         f:=CacheEntry(lock);
  248.         Dos.UnLock(lock);
  249.         IF f=NIL THEN
  250.             (*
  251.                 The file is not one of those opened by Oberon, so just delete it
  252.                 using Dos.DeleteFile.
  253.             *)
  254.             IF ~Dos.DeleteFile(name) THEN res:=SHORT(Dos.IoErr()) ELSE res:=0 END
  255.         ELSE
  256.             (*
  257.                 The file is opened by Oberon, thus we have to rename
  258.                 it to a temporary file, and not really delete it.
  259.             *)
  260.             IF ~Dos.NameFromLock(f.fl,f.registerName) THEN f.registerName:="" END;
  261.             GetTempName(tempName);
  262.             Rename(f.registerName,tempName,res);
  263.             IF res#0 THEN HALT(117) END
  264.         END
  265. END Delete;
  266. PROCEDURE Create(f:File);
  267.     err:ARRAY 25 OF CHAR;
  268.     errno:LONGINT;
  269.     fl:Dos.FileLockPtr;
  270.     i,res:INTEGER;
  271.     newName:FileName;
  272.     oldF:File;
  273.     tmpName:FileName;
  274. BEGIN
  275.     IF f.fd=noDesc THEN
  276.             We haven't yet associated an AmigaDos file to this
  277.             Oberon file.
  278.         IF f.state=create THEN
  279.             (*
  280.                 The file was "just" created (Files.New), so assign a temporary
  281.                 name to it.
  282.             *)
  283.             GetTempName(newName)
  284.         ELSIF f.state=close THEN
  285.             (*
  286.                 We are already registering the file. Let's check, if
  287.                 try to use the name of an existing file which we already
  288.                 use. If we do, then the other file is "removed" from
  289.                 the directory, i.e. it gets a temporary name.
  290.             *)
  291.             fl:=Dos.Lock(f.registerName,Dos.sharedLock);
  292.             IF fl#0 THEN
  293.                 oldF:=CacheEntry(fl);
  294.                 IF oldF#NIL THEN
  295.                     IF ~Dos.NameFromLock(oldF.fl,oldF.registerName) THEN oldF.registerName:="" END;
  296.                     GetTempName(tmpName);
  297.                     Rename(oldF.registerName,tmpName,res);
  298.                     IF res#0 THEN HALT(107) END
  299.                 END;
  300.                 Dos.UnLock(fl)
  301.             END;
  302.             newName:=f.registerName;
  303.             f.registerName:=""
  304.         END;
  305.         IF Dos.DeleteFile(newName) THEN END;
  306.         f.fd:=Dos.Open(newName,Dos.readWrite);
  307.         IF f.fd=0 THEN errno:=Dos.IoErr(); err:="create not done"; HALT(95) END;
  308.         f.fl:=0; f.idx:=-1;
  309.         Kernel.RegisterObject(f,Finalize);
  310.         IF Dos.SetProtection(newName,{Dos.protExecute}) THEN END; (* everything but excute *)
  311.         i:=0;
  312.         WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
  313.         IF i=fileTabSize THEN
  314.             IF Dos.Close(f.fd) THEN END;
  315.             f.fd:=0;
  316.             err:="too many files open"; HALT(96)
  317.         END;
  318.         fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
  319.         f.state:=open; f.pos:=0; f.fl:=Dos.DupLockFromFH(f.fd); f.idx:=i
  320. END Create;
  321. PROCEDURE Flush(buf:Buffer);
  322.     err:ARRAY 25 OF CHAR;
  323.     errno:LONGINT;
  324.     f:File;
  325.     registerName,workName:FileName;
  326. BEGIN
  327.     IF buf.chg THEN
  328.         f:=buf.f;
  329.         Create(f);
  330.         IF buf.org#f.pos THEN SeekAndExtend(f.fd,buf.org) END;
  331.         errno:=Dos.Write(f.fd,buf.data,buf.size);
  332.         IF errno#buf.size THEN
  333.             errno:=Dos.IoErr();
  334.             IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
  335.             registerName:=f.registerName;
  336.             err:="error in writing file";
  337.             HALT(97)
  338.         END;
  339.         f.pos:=buf.org+buf.size;
  340.         buf.chg:=FALSE
  341. END Flush;
  342. PROCEDURE Close*(f:File);
  343.     i:INTEGER;
  344. BEGIN
  345.     IF (f.state#create) OR (f.registerName#"") THEN
  346.         Create(f);
  347.         i:=0; WHILE (i<nofbufs) & (f.bufs[i]#NIL) DO Flush(f.bufs[i]); INC(i) END
  348. END Close;
  349. PROCEDURE Length*(f:File):LONGINT;
  350. BEGIN
  351.     RETURN f.len
  352. END Length;
  353. PROCEDURE New*(name:ARRAY OF CHAR):File;
  354.     f:File;
  355. BEGIN
  356.     NEW(f); MakeFileName(CurrentDir,name,f.registerName);
  357.     f.fd:=noDesc; f.state:=create; f.len:=0; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
  358.     RETURN f
  359. END New;
  360. PROCEDURE Old*(name:ARRAY OF CHAR):File;
  361.     f:File;
  362.     fd:Dos.FileHandlePtr;
  363.     fl:Dos.FileLockPtr;
  364.     err,path:ARRAY 256 OF CHAR;
  365.     i:INTEGER;
  366. BEGIN
  367.     IF name="" THEN
  368.         f:=NIL;    (* Can't open a file without a name. *)
  369.     ELSE
  370.         MakeFileName(CurrentDir,name,path);
  371.             First search the file in the current directory. If it
  372.             wasn't found, prepend the Oberon search path
  373.             to it, and retry.
  374.         fd:=Dos.Open(path,Dos.oldFile);
  375.         IF (fd=0) & (name[0]#":") THEN
  376.             MakeFileName(searchPath,name,path);
  377.             fd:=Dos.Open(path,Dos.oldFile)
  378.         END;
  379.         IF fd=0 THEN
  380.             f:=NIL;    (* couldn't locate the file. *)
  381.         ELSE
  382.             fl:=Dos.DupLockFromFH(fd);
  383.             f:=CacheEntry(fl);
  384.             IF f#NIL THEN
  385.                 (*
  386.                     The file is already opened, so use the
  387.                     existing file handle, and close the
  388.                     AmigaDos file.
  389.                 *)
  390.                 Dos.UnLock(fl);
  391.                 IF Dos.Close(fd) THEN END
  392.             ELSE
  393.                 (*
  394.                     A new file. locate a free slot in the file table,
  395.                     and enter the file.
  396.                 *)
  397.                 i:=0;
  398.                 WHILE (i<fileTabSize) & (fileTab[i]#0) DO INC(i) END;
  399.                 IF i=fileTabSize THEN
  400.                     IF Dos.Close(fd) THEN END;
  401.                     Dos.UnLock(fl);
  402.                     err:="too many files open";
  403.                     HALT(98)
  404.                 END;
  405.                 NEW(f); fileTab[i]:=SYSTEM.VAL(LONGINT,f); INC(Kernel.nofiles);
  406.                 f.len:=Dos.Seek(fd,0,Dos.end);
  407.                 f.len:=Dos.Seek(fd,f.len,Dos.beginning);
  408.                 f.fd:=fd; f.fl:= fl; f.idx:=i;
  409.                 Kernel.RegisterObject(f,Finalize);
  410.                 f.state:=open; f.pos:=0; f.swapper:=-1; (*all f.buf[i]=NIL*)
  411.                 f.registerName:=""
  412.             END
  413.         END
  414.     END;
  415.     RETURN f
  416. END Old;
  417. PROCEDURE Purge*(f:File);
  418.     Reduce the files size to 0.
  419.     i:INTEGER;
  420. BEGIN
  421.     FOR i:=0 TO nofbufs-1 DO
  422.         IF f.bufs[i]#NIL THEN f.bufs[i].org:=-1; f.bufs[i]:=NIL END
  423.     END;
  424.     IF (f.fd#noDesc) & (Dos.SetFileSize(f.fd,0,Dos.beginning)=0) THEN END;
  425.     f.pos:=0; f.len:=0; f.swapper:=-1
  426. END Purge;
  427. PROCEDURE GetDate*(f:File; VAR t,d:LONGINT);
  428.     Get a files date.
  429.     fib:FileInfoBlockPtr;
  430.     sec,min,hour,days,mday,mon,year:LONGINT;
  431. BEGIN
  432.     Create(f); NEW(fib);
  433.     IF Dos.Examine(f.fl,fib^) THEN
  434.         sec:=fib.date.tick DIV Dos.ticksPerSecond;
  435.         min:=fib.date.minute MOD 60;
  436.         hour:=fib.date.minute DIV 60;
  437.         t:=sec+ASH(min,6)+ASH(hour,12);
  438.         days:=fib.date.days+28430; (* Days between 1.1.1978 and 1.3.1900 *)
  439.         year:=(4*days+3) DIV 1461;
  440.         DEC(days,1461*year DIV 4);
  441.         mon:=(5*days+2) DIV 153;
  442.         mday:=days-(153*days+2) DIV 5 +1;
  443.         INC(mon,3);
  444.         IF mon>12 THEN INC(year); DEC(mon,12) END;
  445.         d:=mday+ASH(mon,5)+ASH(year MOD 100,9)
  446.     ELSE
  447.         t:=0; d:=0
  448. END GetDate;
  449. PROCEDURE Pos*(VAR r:Rider):LONGINT;
  450.     Get the position of a rider.
  451. BEGIN
  452.     RETURN r.org+r.offset
  453. END Pos;
  454. PROCEDURE Set*(VAR r:Rider; f:File; pos:LONGINT);
  455.     Set the rider to a specific position within the file.
  456.     buf:Buffer;
  457.     err:ARRAY 25 OF CHAR;
  458.     org,offset,i,n,errno:LONGINT;
  459.     workName,registerName:FileName;
  460. BEGIN
  461.     IF pos>f.len THEN pos:=f.len ELSIF pos<0 THEN pos:=0 END;
  462.     offset:=pos MOD bufsize; org:=pos-offset; i:=0;
  463.     WHILE (i<nofbufs) & (f.bufs[i]#NIL) & (org#f.bufs[i].org) DO INC(i) END;
  464.     IF i<nofbufs THEN
  465.         IF f.bufs[i]=NIL THEN NEW(buf); buf.chg:=FALSE; buf.org:=-1; buf.f:=f; f.bufs[i]:=buf; (* found empty buffer slot. *)
  466.         ELSE buf:=f.bufs[i]; (* found buffer which contains position. *)
  467.         END
  468.     ELSE
  469.             All slots used, but none containing the requested position.
  470.             Swap out one of the buffers.
  471.         f.swapper:=(f.swapper+1) MOD nofbufs;
  472.         buf:=f.bufs[f.swapper];
  473.         Flush(buf)
  474.     END;
  475.     IF buf.org#org THEN
  476.             A new buffer was selected. If the selected position is at the
  477.             end of the file, just an empty buffer is initialized. Otherwise,
  478.             the buffer is loaded from the file.
  479.         IF org=f.len THEN
  480.             buf.size:=0
  481.         ELSE
  482.             Create(f);
  483.             IF f.pos#org THEN n:=Dos.Seek(f.fd,org,Dos.beginning) END;
  484.             n:=Dos.Read(f.fd,buf.data,bufsize);
  485.             IF n<0 THEN errno:=Dos.IoErr();
  486.                 IF ~Dos.NameFromLock(f.fl,workName) THEN workName:="" END;
  487.                 registerName:=f.registerName;
  488.                 err:="read not done"; HALT(99)
  489.             END;
  490.             f.pos:=org+n;
  491.             buf.size:=n
  492.         END;
  493.         buf.org:=org; buf.chg:=FALSE
  494.     END;
  495.     r.buf:=buf; r.org:=org; r.offset:=offset; r.eof:=FALSE; r.res:=0
  496. END Set;
  497. PROCEDURE Read*(VAR r:Rider; VAR x:SYSTEM.BYTE);
  498.     buf:Buffer;
  499.     offset:LONGINT;
  500. BEGIN
  501.     buf:=r.buf; offset:=r.offset;
  502.     IF r.org#buf.org THEN Set(r,buf.f,r.org+offset); buf:=r.buf; offset:=r.offset END;
  503.     IF (offset<buf.size) THEN
  504.         x:=buf.data[offset]; r.offset:=offset+1
  505.     ELSIF r.org+offset<buf.f.len THEN
  506.         Set(r,r.buf.f,r.org+offset);
  507.         x:=r.buf.data[0]; r.offset:=1
  508.     ELSE
  509.         x:=0X; r.eof:=TRUE
  510. END Read;
  511. PROCEDURE ReadBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
  512.     buf:Buffer;
  513.     xpos,min,restInBuf,offset:LONGINT;
  514. BEGIN
  515.     IF n>LEN(x) THEN HALT(43) END;
  516.     xpos:=0; buf:=r.buf; offset:=r.offset;
  517.     WHILE n>0 DO
  518.         IF (r.org#buf.org) OR (offset>=bufsize) THEN
  519.             Set(r,buf.f,r.org+offset);
  520.             buf:=r.buf; offset:=r.offset
  521.         END;
  522.         restInBuf:=buf.size-offset;
  523.         IF restInBuf=0 THEN r.res:=n; r.eof:=TRUE; RETURN
  524.         ELSIF n>restInBuf THEN min:=restInBuf
  525.         ELSE min:=n
  526.         END;
  527.         SYSTEM.MOVE(SYSTEM.ADR(buf.data)+offset,SYSTEM.ADR(x)+xpos,min);
  528.         INC(offset,min); r.offset:=offset; INC(xpos,min); DEC(n,min)
  529.     END;
  530.     r.res:=0; r.eof:=FALSE
  531. END ReadBytes;
  532. PROCEDURE Base*(VAR r:Rider):File;
  533.     Get the file on which this rider is based.
  534. BEGIN
  535.     RETURN r.buf.f
  536. END Base;
  537. PROCEDURE Write*(VAR r:Rider; x:SYSTEM.BYTE);
  538.     buf:Buffer;
  539.     offset:LONGINT;
  540. BEGIN
  541.     buf:=r.buf; offset:=r.offset;
  542.     IF (r.org#buf.org) OR (offset>=bufsize) THEN
  543.         Set(r,buf.f,r.org+offset);
  544.         buf:=r.buf; offset:=r.offset
  545.     END;
  546.     buf.data[offset]:=x;
  547.     buf.chg:=TRUE;
  548.     IF offset=buf.size THEN
  549.         INC(buf.size); INC(buf.f.len)
  550.     END;
  551.     r.offset:=offset+1; r.res:=0
  552. END Write;
  553. PROCEDURE WriteBytes*(VAR r:Rider; VAR x:ARRAY OF SYSTEM.BYTE; n:LONGINT);
  554.     xpos,min,restInBuf,offset:LONGINT;
  555.     buf:Buffer;
  556. BEGIN
  557.     IF n>LEN(x) THEN HALT(43) END;
  558.     xpos:=0; buf:=r.buf; offset:=r.offset;
  559.     WHILE n>0 DO
  560.         IF (r.org#buf.org) OR (offset>=bufsize) THEN
  561.             Set(r,buf.f,r.org+offset);
  562.             buf:=r.buf; offset:=r.offset
  563.         END;
  564.         restInBuf:=bufsize-offset;
  565.         IF n>restInBuf THEN min:=restInBuf ELSE min:=n END;
  566.         SYSTEM.MOVE(SYSTEM.ADR(x)+xpos,SYSTEM.ADR(buf.data)+offset,min);
  567.         INC(offset,min); r.offset:=offset;
  568.         IF offset>buf.size THEN INC(buf.f.len,offset-buf.size); buf.size:=offset END;
  569.         INC(xpos,min); DEC(n,min); buf.chg:=TRUE
  570.     END;
  571.     r.res:=0
  572. END WriteBytes;
  573. PROCEDURE Register*(f:File);
  574.     errno:INTEGER;
  575.     file:FileName;
  576. BEGIN
  577.     IF (f.state=create) & (f.registerName#"") THEN f.state:=close (* shortcut renaming *) END;
  578.     Close(f);
  579.     IF f.registerName#"" THEN
  580.         IF ~Dos.NameFromLock(f.fl,file) THEN file:="" END;
  581.         Rename(file,f.registerName,errno);
  582.         IF errno#0 THEN COPY(f.registerName,file); HALT(100) END;
  583.         f.registerName:=""
  584. END Register;
  585. PROCEDURE ChangeDirectory*(path:ARRAY OF CHAR; VAR res:INTEGER);
  586.     lock,oldLock:Dos.FileLockPtr;
  587. BEGIN
  588.     lock:=Dos.Lock(path,Dos.sharedLock);
  589.     IF lock#0 THEN
  590.         oldLock:=Dos.CurrentDir(lock);
  591.         Dos.UnLock(oldLock);
  592.         IF Dos.NameFromLock(lock,CurrentDir) THEN END;
  593.         res:=noError
  594.     ELSE
  595.         res:=directoryNotFound
  596. END ChangeDirectory;
  597. (*----------------- Files1 ----------------*)
  598.     little endian,
  599.     ORD({0})=1,
  600.     false=0,true =1
  601.     IEEE real format,
  602.     null terminated strings,
  603.     compact format according to M.Odersky
  604. PROCEDURE FlipBytes(VAR src,dest:ARRAY OF SYSTEM.BYTE);
  605.     i,j:LONGINT;
  606. BEGIN
  607.     j:=0;
  608.     FOR i:=LEN(src)-1 TO 0 BY -1 DO dest[j]:=src[i]; INC(j) END
  609. END FlipBytes;
  610. PROCEDURE ReadBool*(VAR R:Rider; VAR x:BOOLEAN);
  611. BEGIN
  612.     Read(R,SYSTEM.VAL(CHAR,x))
  613. END ReadBool;
  614. PROCEDURE ReadInt*(VAR R:Rider; VAR x:INTEGER);
  615.     b:ARRAY 2 OF CHAR;
  616. BEGIN
  617.     ReadBytes(R,b,2);
  618.     x:=ORD(b[0])+ORD(b[1])*256
  619. END ReadInt;
  620. PROCEDURE ReadLInt*(VAR R:Rider; VAR x:LONGINT);
  621.     b:ARRAY 4 OF CHAR;
  622. BEGIN
  623.     ReadBytes(R,b,4);
  624.     x:=LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H+LONG(ORD(b[2]))*10000H+LONG(ORD(b[3]))*1000000H
  625. END ReadLInt;
  626. PROCEDURE ReadSet*(VAR R:Rider; VAR x:SET);
  627.     b:ARRAY 4 OF CHAR;
  628.     s2,s3:SET;
  629.     i:LONGINT;
  630. BEGIN
  631.     IF BigEndianSet THEN
  632.         ReadBytes(R,b,4);
  633.         s2:=SYSTEM.VAL(SET,LONG(ORD(b[0]))+LONG(ORD(b[1]))*100H +
  634.         LONG(ORD(b[2]))*10000H +LONG(ORD(b[3]))*1000000H);
  635.         s3:={};
  636.         FOR i:=0 TO 31 DO
  637.             IF i IN s2 THEN INCL(s3,31-i) END
  638.         END;
  639.         x:=s3
  640.     ELSE
  641.         IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
  642.         ELSE ReadBytes(R,x,4)
  643.         END
  644. END ReadSet;
  645. PROCEDURE ReadReal*(VAR R:Rider; VAR x:REAL);
  646.     b:ARRAY 4 OF CHAR;
  647. BEGIN
  648.     IF BigEndianMachine THEN ReadBytes(R,b,4); FlipBytes(b,x)
  649.     ELSE ReadBytes(R,x,4)
  650. END ReadReal;
  651. PROCEDURE ReadLReal*(VAR R:Rider; VAR x:LONGREAL);
  652.     b:ARRAY 8 OF CHAR;
  653. BEGIN
  654.     IF BigEndianMachine THEN ReadBytes(R,b,8); FlipBytes(b,x)
  655.     ELSE ReadBytes(R,x,8)
  656. END ReadLReal;
  657. PROCEDURE ReadString*(VAR R:Rider; VAR x:ARRAY OF CHAR);
  658.     i:INTEGER;
  659.     ch:CHAR;
  660. BEGIN
  661.     i:=0; REPEAT Read(R,ch); x[i]:=ch; INC(i) UNTIL ch=0X
  662. END ReadString;
  663. PROCEDURE ReadNum*(VAR R:Rider; VAR x:LONGINT);
  664.     ch:CHAR;
  665.     n:LONGINT;
  666.     s:SHORTINT;
  667. BEGIN
  668.     s:=0; n:=0; Read(R,ch);
  669.     WHILE ORD(ch)>=128 DO INC(n,ASH(LONG(ORD(ch))-128,s) ); INC(s,7); Read(R,ch) END;
  670.     x:=n+ASH(LONG(ORD(ch)) MOD 64-ORD(ch) DIV 64*64,s)
  671. END ReadNum;
  672. PROCEDURE WriteBool*(VAR R:Rider; x:BOOLEAN);
  673. BEGIN
  674.     Write(R,SYSTEM.VAL(CHAR,x))
  675. END WriteBool;
  676. PROCEDURE WriteInt*(VAR R:Rider; x:INTEGER);
  677.     b:ARRAY 2 OF CHAR;
  678. BEGIN
  679.     b[0]:=CHR(x); b[1]:=CHR(x DIV 256);
  680.     WriteBytes(R,b,2)
  681. END WriteInt;
  682. PROCEDURE WriteLInt*(VAR R:Rider; x:LONGINT);
  683.     b:ARRAY 4 OF CHAR;
  684. BEGIN
  685.     b[0]:=CHR(x); b[1]:=CHR(x DIV 100H); b[2]:=CHR(x DIV 10000H); b[3]:=CHR(x DIV 1000000H);
  686.     WriteBytes(R,b,4)
  687. END WriteLInt;
  688. PROCEDURE WriteSet*(VAR R:Rider; x:SET);
  689.     b:ARRAY 4 OF CHAR; i:LONGINT; s2:SET;
  690. BEGIN
  691.     IF BigEndianSet THEN
  692.         s2:={};
  693.         FOR i:=0 TO 31 DO
  694.             IF i IN x THEN INCL(s2,31-i) END
  695.         END;
  696.         i:=SYSTEM.VAL(LONGINT,s2);
  697.         b[0]:=CHR(i); b[1]:=CHR(i DIV 100H); b[2]:=CHR(i DIV 10000H); b[3]:=CHR(i DIV 1000000H);
  698.         WriteBytes(R,b,4)
  699.     ELSE
  700.         IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
  701.         ELSE WriteBytes(R,x,4)
  702.         END
  703. END WriteSet;
  704. PROCEDURE WriteReal*(VAR R:Rider; x:REAL);
  705.     b:ARRAY 4 OF CHAR;
  706. BEGIN
  707.     IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,4)
  708.     ELSE WriteBytes(R,x,4)
  709. END WriteReal;
  710. PROCEDURE WriteLReal*(VAR R:Rider; x:LONGREAL);
  711.     b:ARRAY 8 OF CHAR;
  712. BEGIN
  713.     IF BigEndianMachine THEN FlipBytes(x,b); WriteBytes(R,b,8)
  714.     ELSE
  715.         WriteBytes(R,x,8)
  716. END WriteLReal;
  717. PROCEDURE WriteString*(VAR R:Rider; x:ARRAY OF CHAR);
  718.     i:INTEGER;
  719. BEGIN
  720.     i:=0; WHILE x[i]#0X DO INC(i) END;
  721.     WriteBytes(R,x,i+1)
  722. END WriteString;
  723. PROCEDURE WriteNum*(VAR R:Rider; x:LONGINT);
  724. BEGIN
  725.     WHILE (x<-64) OR (x>63) DO Write(R,CHR(x MOD 128+128)); x:=x DIV 128 END;
  726.     Write(R,CHR(x MOD 128))
  727. END WriteNum;
  728. PROCEDURE Finalize(obj:SYSTEM.PTR);
  729.     file:File;
  730.     pref:FileName;
  731.     name:FileName;
  732. BEGIN
  733.     file:=SYSTEM.VAL(File,obj);
  734.     ASSERT(file#NIL);
  735.     IF ~Dos.NameFromLock(file.fl,name) THEN name:="" END;
  736.     IF file.fl#0 THEN
  737.         Dos.UnLock(file.fl);
  738.         file.fl:=0
  739.     END;
  740.     IF file.fd#noDesc THEN
  741.         SeekAndExtend(file.fd,file.len);
  742.         IF Dos.Close(file.fd) THEN END;
  743.         file.fd:=noDesc
  744.     END;
  745.     IF file.idx>=0 THEN
  746.         DEC(Kernel.nofiles);
  747.         fileTab[file.idx]:=0
  748.     END;
  749.         test for ".tmp." in first 5 chars and call Dos.Deletefile in
  750.         this case.
  751.     Dos.FilePart(name,pref);
  752.     pref[5]:=0X;
  753.     IF pref=".tmp." THEN
  754.         IF ~Dos.DeleteFile(name) THEN
  755.         END
  756. END Finalize;
  757. PROCEDURE Init;
  758.     i:LONGINT;
  759.     lock:Dos.FileLockPtr;
  760. BEGIN
  761.     I.CurrentTime(startTime,i);
  762.     tempno:=-1;
  763.     lock:=Dos.Lock("",Dos.sharedLock);
  764.     IF ~Dos.NameFromLock(lock,CurrentDir) THEN CurrentDir:="" END;
  765.     Dos.UnLock(lock);
  766.     FOR i:=0 TO fileTabSize-1 DO fileTab[i]:=0 END;
  767.     Kernel.nofiles:=0;
  768.     Amiga.GetSearchPath(searchPath)
  769. END Init;
  770. BEGIN
  771.     Init
  772. END Files.
  773.