home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / diskette.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  17KB  |  471 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. MODULE Diskette;    (* Marc Pilloud, 19. Apr 94 *) 
  5. IMPORT
  6.     SYSTEM, AmigaBase, Amiga, MFM := AmigaMFM, Exec := AmigaExec, 
  7.     Files, Kernel;
  8. (* ORIGINAL OBERON TYPES *)
  9. FileDesc =   RECORD                    (* image of dir entry *)
  10.                name:ARRAY 22 OF CHAR;    (* size(FileDesc)  = 32 Byte *)
  11.                time,date:INTEGER;
  12.                head:INTEGER;
  13.                size:LONGINT
  14.              END;
  15.   File       = POINTER TO FileHandle;
  16.   FileHandle = RECORD
  17.                  prev,next:File;
  18.                  file:FileDesc
  19.                END;
  20.   EntryHandler* = PROCEDURE(name:ARRAY OF CHAR; date, time, size:LONGINT);
  21.   MFMPtr = POINTER TO MFM.IOExtMFM;
  22. CONST
  23. (* AMIGA VERSION CONST  *)
  24.   ON  = TRUE;
  25.   OFF = FALSE;
  26.   tries = 3;                      (* Anzahl Versuch ein Kommando auszufhren *)
  27.   sectorSize = LONG(MFM.sector);
  28.   trackSize  = LONG(MFM.numSecs*MFM.sector);        (* 9 sectors * 512 Bytes *)
  29. (* ORIGINAL OBERON CONST *)
  30.   Oberon* = 0E9X;
  31.   MSDOS*  = 0F9X;
  32. (* AMIGA VERSION VAR *)
  33.   mfmPortLI  : Exec.MsgPortPtr;
  34.   mfmioLI      : MFM.IOExtMFMPtr;
  35.   mfmOpen   : BOOLEAN;
  36.   unit            : LONGINT;
  37.   update       : BOOLEAN; (*IF update    THEN nach jedem PutSector Daten zurckschreiben *)
  38.   stopMotor : BOOLEAN; (*IF stopMotor THEN nach jedem Put-,GetSector Motor abschalten *)
  39.   err*            : LONGINT;
  40. (* ORIGINAL OBERON VAR *)
  41.   res*    :INTEGER; (* result of file-oriented operation, error = ( res # 0) *)
  42.   sect*   :LONGINT;
  43.   busy*   :BOOLEAN; (* state of device driver                                *)
  44.   dir     : File;
  45.   trailer : FileDesc;
  46.   usedF, usedC : INTEGER;
  47.   FAT     : ARRAY 720 OF INTEGER;
  48. (*===========================================================================*)
  49. (*                             DEVICE DRIVER                                 *)
  50. (*===========================================================================*)
  51. (*****************************************************************************)
  52. (*                                CLOSE                                      *)
  53. (*****************************************************************************)
  54. PROCEDURE Close*;
  55. BEGIN
  56.   IF mfmOpen THEN Exec.CloseDevice(mfmioLI); mfmOpen := FALSE END;
  57.   IF mfmPortLI # 0 THEN Exec.DeleteMsgPort(mfmPortLI); mfmPortLI:=0 END;
  58.   IF mfmioLI # 0 THEN Exec.DeleteIORequest(mfmioLI); mfmioLI:=0 END
  59. END Close;
  60. (*****************************************************************************)
  61. (*                               SET DRIVE                                                     *)
  62. (*****************************************************************************)
  63. PROCEDURE SetDrive*(unitNr:LONGINT);
  64.   VAR mfmio:MFMPtr;
  65. BEGIN
  66.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
  67.   IF (unitNr >= 0) & (unitNr <= 3) & ((unit#unitNr) OR (~mfmOpen)) THEN
  68.     unit := unitNr;
  69.     IF mfmPortLI = 0 THEN mfmPortLI := Exec.CreateMsgPort() END;
  70.     IF mfmPortLI = 0 THEN HALT(50) END;
  71.     IF mfmioLI = 0 THEN 
  72.         mfmioLI := Exec.CreateIORequest(mfmPortLI, SIZE(MFM.IOExtMFM)); 
  73.         mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
  74.     END;
  75.     IF mfmioLI   = 0 THEN HALT(50) END;
  76.     IF mfmOpen THEN Exec.CloseDevice(mfmioLI) END;  (* Altes Device schliessen *)
  77.     mfmOpen:= (Exec.OpenDevice(MFM.name,unit,mfmioLI,{})=0)
  78.                    & (mfmio.req.error=0);               (* Neues Device ffnen     *)
  79.   END;
  80.   IF ~mfmOpen THEN HALT(50) END;
  81. END SetDrive;
  82. (*****************************************************************************)
  83. (*                        DoCommand and Error Handling                          *)
  84. (*****************************************************************************)
  85. PROCEDURE DoCommand(com:INTEGER):LONGINT;
  86.   VAR try:SHORTINT;
  87.          mfmio:MFMPtr;
  88. BEGIN
  89.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);             (* Type cast *)
  90.   busy := TRUE;
  91.   mfmio.req.command:=com;
  92.   try := 1;
  93.   REPEAT
  94.     err := Exec.DoIO(mfmioLI);
  95.     INC(try)
  96.   UNTIL (err=0) OR (try>tries);
  97.   IF err#0 THEN
  98.    IF (err#23) & (err#28) THEN HALT(51) END;
  99.   ELSE busy := FALSE
  100.   END;
  101.   RETURN err
  102. END DoCommand;
  103. (*****************************************************************************)
  104. (*            GetDiskChanges, StopMotor, ClearBuf, Update                 *)
  105. (*****************************************************************************)
  106. PROCEDURE GetDiskChanges():LONGINT;
  107.    VAR mfmio:MFMPtr;
  108. BEGIN
  109.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  110.   mfmio.req.command:=MFM.changeNum;
  111.   IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END;
  112.   RETURN (mfmio.req.actual)
  113. END GetDiskChanges;
  114. PROCEDURE StopMotor;
  115.   VAR mfmio:MFMPtr;
  116. BEGIN
  117.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  118.   mfmio.req.length:=0;
  119.   mfmio.req.command:=MFM.motor;
  120.   IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
  121. END StopMotor;
  122. PROCEDURE ClearBuf;
  123.   VAR mfmio:MFMPtr;
  124. BEGIN
  125.  mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  126.  mfmio.req.command:=MFM.extClear;
  127.  IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
  128. END ClearBuf;
  129. PROCEDURE Update;
  130. BEGIN
  131.  IF DoCommand(MFM.extUpdate)#0 THEN HALT(53) END
  132. END Update;
  133. (*****************************************************************************)
  134. (*                               RESET                                       *)
  135. (*****************************************************************************)
  136. PROCEDURE Reset*;
  137.   VAR mfmio:MFMPtr;
  138. BEGIN
  139.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  140.   mfmio.secLabel := 0;                (* Sektor-Label wird nicht verwendet *)
  141.   mfmio.count    := GetDiskChanges();   (* Diskwechselzhler setzten         *)
  142.   StopMotor;                            (* Motor abschalten                  *)
  143.   ClearBuf;                             (* Interner DiskBuffer lschen       *)
  144.   stopMotor := ON; update := ON;
  145. END Reset;
  146. (*****************************************************************************)
  147. (*                                 GetSector                                 *)
  148. (*****************************************************************************)
  149. PROCEDURE GetSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
  150.   VAR oldcount:LONGINT;
  151.          mfmio:MFMPtr;
  152. BEGIN
  153.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  154.   IF busy THEN Reset END;
  155.   sect        := sec;
  156.   oldcount    := mfmio.count;
  157.   mfmio.count := GetDiskChanges();
  158.   IF oldcount # mfmio.count THEN ClearBuf END;
  159.   mfmio.req.offset := sec*sectorSize;
  160.   mfmio.req.data   := SYSTEM.ADR(buf[off]);
  161.   mfmio.req.length := sectorSize;
  162.   IF DoCommand(MFM.extRead)#0 THEN HALT(52) END;
  163.   IF stopMotor THEN StopMotor END;
  164. END GetSector;
  165. (*****************************************************************************)
  166. (*                              PUT SECTOR                                   *)
  167. (*****************************************************************************)
  168. PROCEDURE PutSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
  169.    VAR mfmio:MFMPtr;
  170. BEGIN
  171.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  172.   IF busy THEN Reset END;
  173.   sect             := sec;
  174.   mfmio.count      := GetDiskChanges();
  175.   mfmio.req.offset := sec*sectorSize;
  176.   mfmio.req.data   := SYSTEM.ADR(buf[off]);
  177.   mfmio.req.length := sectorSize;
  178.   IF DoCommand(MFM.extWrite)#0 THEN HALT(53) END;
  179.   IF update    THEN Update    END;
  180.   IF stopMotor THEN StopMotor END;
  181. END PutSector;
  182. (*****************************************************************************)
  183. (*                               FORMAT                                      *)
  184. (*****************************************************************************)
  185. PROCEDURE Format*;
  186.   VAR c:INTEGER;
  187.          buf: ARRAY trackSize OF SYSTEM.BYTE;
  188.          mfmio:MFMPtr;
  189. BEGIN
  190.   mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI);     (* Type cast *)
  191.   IF busy THEN Reset END;
  192.   c:=0; WHILE c<trackSize DO buf[c]:=SYSTEM.VAL(SYSTEM.BYTE,0E5H); INC(c) END;
  193.   c:=0;
  194.   WHILE c < 160 DO
  195.     mfmio.count      := GetDiskChanges();
  196.     mfmio.req.offset := c*trackSize;                         (* Track Nummer *)
  197.     mfmio.req.data   := SYSTEM.ADR(buf[0]);
  198.     mfmio.req.length := trackSize;
  199.     IF DoCommand(MFM.extFormat)#0 THEN HALT(51) END;
  200.     INC(c);
  201.   END;
  202.   StopMotor;                                             (* Motor abschalten *)
  203. END Format;
  204. (*===========================================================================*)
  205. (*                            DIRECTORY PROCEDURES                           *)
  206. (*===========================================================================*)
  207. (*****************************************************************************)
  208. (*           COPY AND TURN FILEDESC (Litleendian <-> Bigendian)              *)
  209. (*****************************************************************************)
  210. PROCEDURE CopyFileDesc(VAR a,b:FileDesc);
  211.   TYPE TWOINT=ARRAY 2 OF INTEGER;
  212.   VAR size:TWOINT;
  213. BEGIN
  214. b.name := a.name; b.name[21] := 0X;
  215. b.time := SYSTEM.ROT(a.time,8);
  216. b.date := SYSTEM.ROT(a.date,8);
  217. b.head := SYSTEM.ROT(a.head,8);
  218. size   := SYSTEM.VAL(TWOINT,a.size);
  219. b.size := SYSTEM.LSH(LONG(SYSTEM.ROT(size[1],8)),16)+SYSTEM.ROT(size[0],8);
  220. END CopyFileDesc;
  221. PROCEDURE InitDir*;
  222.   VAR t, d: LONGINT; i: INTEGER;
  223. BEGIN
  224.   trailer.name[0] := 0X;
  225.   NEW(dir); dir.file.name[0] := 0FFX;
  226.   dir.file.name[11] := 8X;                               (* def as vol label *)
  227.   dir.next := dir; dir.prev := dir;
  228.   usedF := 1; usedC := 7;
  229.   FAT[0] := -1; FAT[1] := -1;
  230.   i := 2;
  231.   REPEAT FAT[i] := 0; FAT[i+1] := 0; INC(i,2) UNTIL i=720
  232. END InitDir;
  233. PROCEDURE Clusters (size:LONGINT):INTEGER;
  234. BEGIN RETURN SHORT((size + 1023) DIV 1024);
  235. END Clusters;
  236. PROCEDURE findFile (name: ARRAY OF CHAR; VAR f: File);
  237. BEGIN
  238.   f := dir.next;
  239.   WHILE f.file.name < name DO f := f.next END;
  240. END findFile;
  241. PROCEDURE ReadDir*;
  242.   VAR f,g :File;
  243.       n   :LONGINT;
  244.       s,i,j,n0,n1:INTEGER;
  245.       buf : ARRAY 1536 OF CHAR;
  246.       dBuf: ARRAY 16 OF FileDesc;                  (* size(dBuf) = 512 Bytes *)
  247. BEGIN
  248.   stopMotor := OFF;                                    (* Motor laufen lassen *)
  249. (* read boot sector *)
  250.   GetSector(0, buf, 0);
  251.   IF (buf[21] # 0F9X) & (buf[21] # 0E9X) THEN HALT(54) END;
  252. (* read volum label *)
  253.   GetSector(7, dBuf, 0);
  254.   NEW(f); CopyFileDesc(dBuf[0],f.file);
  255.   IF f.file.name[11] # 08X THEN HALT(54) END;            (* not volume label  *)
  256.   IF (f.file.name[0] < 0E5X) & (f.file.name[0] # 0X) THEN HALT(54) END;
  257.                                                          (* not Oberon Format *)
  258.   f.file.name[0] := 0FFX;
  259. (* read dir *)
  260.   f.prev := f; f.next := f; dir := f;
  261.   usedF := 1; usedC := 7;
  262.   s := 7; j := 1;
  263.   LOOP
  264.     IF (dBuf[j].name[0] = 0X) OR (dBuf[j].name[0] = 0E5X) THEN EXIT END;
  265.     NEW(f); CopyFileDesc(dBuf[j],f.file);
  266.     findFile(f.file.name, g);
  267.     f.next := g; g.prev.next := f; f.prev := g.prev; g.prev := f;
  268.     INC(usedF); usedC := usedC + Clusters(f.file.size);
  269.     INC(j);
  270.     IF j = 16 THEN INC(s); j:=0;
  271.       IF s = 14 THEN EXIT END;
  272.       GetSector(s, dBuf, 0)
  273.     END
  274.   END;
  275. (* read FAT *)
  276.   GetSector(1, buf, 0);
  277.   GetSector(2, buf, 512);
  278.   GetSector(3, buf, 1024);
  279.   stopMotor := ON; StopMotor;                           (* Motor ausschalten *)
  280.   FAT[0] := -1; FAT[1] := -1;
  281.   i := 2; j := 3;
  282.   REPEAT
  283.     n :=     ORD(buf[j+2]); n := n*256;
  284.     n := n + ORD(buf[j+1]); n := n*256;
  285.     n := n + ORD(buf[j]);
  286.     n0 := SHORT (n MOD 4096); n1 := SHORT(n DIV 4096);
  287.     IF n0 > 2047 THEN n0 := n0 - 4096 END;
  288.     IF n1 > 2047 THEN n1 := n1 - 4096 END;
  289.     FAT[i] := n0; FAT[i+1] := n1;
  290.     i := i + 2; j := j + 3
  291.   UNTIL i = 720
  292. END ReadDir;
  293. PROCEDURE WriteDir*;
  294.   VAR f: File;
  295.       n: LONGINT;
  296.       s, i, j, n0, n1:INTEGER;
  297.       buf : ARRAY 1536 OF CHAR;  (* 3*512 (sectors 1 2 3) *)
  298.       dBuf: ARRAY 16 OF FileDesc;
  299. BEGIN
  300.   update  := OFF; stopMotor := OFF;
  301. (* write boot sector *)
  302.   buf[21] := 0F9X;
  303.   PutSector(0, buf, 0);
  304. (* write FAT *)
  305.   buf[0] := 0F9X;
  306.   buf[1] := 0FFX;
  307.   buf[2] := 0FFX;
  308.   i := 2; j := 3;
  309.   REPEAT
  310.     n0 := FAT[i]; n1 := FAT[i+1];
  311.     IF n0<0 THEN n0 := n0 + 4096 END;
  312.     IF n1<0 THEN n1 := n1 + 4096 END;
  313.     n := n1; n := n*4096 + n0;
  314.     buf[j]   := CHR(SHORT(n MOD 256)); n := n DIV 256;
  315.     buf[j+1] := CHR(SHORT(n MOD 256)); n := n DIV 256;
  316.     buf[j+2] := CHR(SHORT(n));
  317.     i:=i+2; j:=j+3
  318.   UNTIL i=720;
  319.   PutSector(1, buf, 0);
  320.   PutSector(2, buf, 512);
  321.   PutSector(3, buf, 1024);
  322. (* write dir *)
  323.   s := 7; j := 0; f := dir;
  324.   REPEAT
  325.     CopyFileDesc(f.file,dBuf[j]); INC(j);
  326.     IF j = 16 THEN PutSector(s, dBuf, 0); INC(s); j := 0 END;
  327.     f := f.next
  328.   UNTIL f = dir;
  329.   IF s # 14 THEN
  330.     CopyFileDesc(trailer,dBuf[j]);
  331.     PutSector(s,dBuf,0)
  332.   END;
  333.   update   := ON; Update;
  334.   stopMotor:= ON; StopMotor;
  335. END WriteDir;
  336. PROCEDURE GetData*(VAR date,time:LONGINT; VAR nofFiles,nofClusters:INTEGER);
  337. BEGIN
  338.   date := dir.file.date; time := LONG(dir.file.time)*2;
  339.   nofFiles := usedF; nofClusters := usedC;
  340. END GetData;
  341. PROCEDURE Enumerate* (proc:EntryHandler);
  342.   VAR f:File;
  343. BEGIN f:=dir.next;
  344.   WHILE f#dir DO
  345.     proc(f.file.name, f.file.date, LONG(f.file.time)*2, f.file.size);
  346.     f := f.next;
  347.   END
  348. END Enumerate;
  349. (*===========================================================================*)
  350. (*                              FILES PROCEDURES                             *)
  351. (*===========================================================================*)
  352. PROCEDURE readFile (f: File; g: Files.File);
  353.   VAR Wg: Files.Rider;
  354.       size: LONGINT; i: INTEGER;
  355.       buf: ARRAY 1024 OF CHAR;
  356. BEGIN
  357.   Files.Set(Wg, g, 0);
  358.   size := f.file.size;
  359.   IF size # 0 THEN
  360.     i := f.file.head;
  361.     stopMotor := OFF;
  362.     LOOP
  363.       GetSector(10 + 2*i, buf, 0);
  364.       GetSector(11 + 2*i, buf, 512);
  365.       IF FAT[i] = -1 THEN EXIT END;
  366.       Files.WriteBytes(Wg, buf, 1024);
  367.       size := size - 1024; i := FAT[i]
  368.     END;
  369.     stopMotor := ON; StopMotor;
  370.     Files.WriteBytes(Wg, buf, SHORT(size))
  371.   END
  372. END readFile;
  373. PROCEDURE deleteFile (f:File);
  374.   VAR i,j:INTEGER;
  375. BEGIN
  376.   f.prev.next := f.next; f.next.prev := f.prev;
  377.   i := f.file.head;
  378.   REPEAT j:=FAT[i]; FAT[i]:=0; i:=j UNTIL i=-1
  379. END deleteFile;
  380. PROCEDURE addFile (f: Files.File; g, h: File);
  381.   VAR Rf: Files.Rider;
  382.       need, i, j: INTEGER;
  383.       buf: ARRAY 1024 OF CHAR;
  384. BEGIN
  385.   Files.Set(Rf, f, 0);
  386.   need := Clusters(g.file.size);
  387.   IF need # 0 THEN
  388.     j := 2;
  389.     WHILE FAT[j] # 0 DO INC(j) END;
  390.     g.file.head := j;
  391.     stopMotor := OFF; update := OFF;
  392.     LOOP i := j;
  393.       Files.ReadBytes(Rf, buf, 1024);
  394.       PutSector(10 + 2*i, buf, 0);
  395.       PutSector(11 + 2*i, buf, 512);
  396.       DEC(need);
  397.       IF need = 0 THEN EXIT END;
  398.       INC(j);
  399.       WHILE FAT[j] # 0 DO INC(j) END;
  400.       FAT[i] := j
  401.     END;
  402.     FAT[i] := -1;
  403.     update    := ON; Update;
  404.     stopMotor := ON; StopMotor
  405.   END;
  406.   g.next := h; h.prev.next := g; g.prev := h.prev; h.prev := g
  407. END addFile;
  408. PROCEDURE ReadAll*;
  409.   VAR f: File; g: Files.File; ch: CHAR;
  410. BEGIN
  411.   ReadDir;
  412.   f := dir.next;
  413.   WHILE f # dir DO
  414.     g := Files.New(f.file.name); readFile(f, g); Files.Register(g); f := f.next
  415.   END
  416. END ReadAll;
  417. PROCEDURE ReadFile* (name: ARRAY OF CHAR);
  418.   VAR f: File; g: Files.File;
  419. BEGIN
  420.   findFile(name, f);
  421.   IF f.file.name = name THEN
  422.     g := Files.New(name); readFile(f, g); Files.Register(g); res := 0
  423.   ELSE res := 1
  424.   END
  425. END ReadFile;
  426. PROCEDURE WriteFile* (name: ARRAY OF CHAR);
  427.   VAR f: Files.File; g, h: File; d, t: LONGINT; needC: INTEGER;
  428. BEGIN res := 0;
  429.   NEW(g); g.file.name[11] := 0X; (*attributes*)
  430.   COPY(name, g.file.name);
  431.   f := Files.Old(name);
  432.   IF f # NIL THEN
  433.     g.file.size := Files.Length(f);
  434.     Kernel.GetClock(t, d);
  435.     g.file.date := SHORT(d); g.file.time := SHORT(t DIV 2);
  436.     findFile(g.file.name, h);
  437.     IF h.file.name = g.file.name THEN
  438.       needC := Clusters(g.file.size) - Clusters(h.file.size);
  439.       IF usedC + needC <= 720 THEN
  440.         deleteFile(h); addFile(f, g, h.next);
  441.         usedC := usedC + needC
  442.       ELSE res := 2
  443.       END
  444.     ELSE needC := Clusters(g.file.size);
  445.       IF (usedF < 112) & (usedC + needC <= 720) THEN
  446.         addFile(f, g, h);
  447.         INC(usedF); usedC := usedC + needC
  448.       ELSE res := 2
  449.       END
  450.     END
  451.   ELSE res := 1
  452.   END
  453. END WriteFile;
  454. PROCEDURE DeleteFile* (name: ARRAY OF CHAR);
  455.   VAR g: File;
  456. BEGIN
  457.   findFile(name, g);
  458.   IF g.file.name = name THEN
  459.     deleteFile(g); DEC(usedF); usedC := usedC - Clusters(g.file.size); res := 0
  460.   ELSE res := 1
  461.   END
  462. END DeleteFile;
  463. (*===========================================================================*)
  464. (*                           INITIAL ACTIONS                                 *)
  465. (*===========================================================================*)
  466. BEGIN
  467.   Amiga.TermProcedure(Close);
  468.   mfmioLI := 0; mfmPortLI := 0; mfmOpen := FALSE;         (* Initialisierung *)
  469.   SetDrive(0); Reset
  470. END Diskette.
  471.