summaryrefslogtreecommitdiff
path: root/system/dos/1.8.7/src/block i-o
diff options
context:
space:
mode:
Diffstat (limited to 'system/dos/1.8.7/src/block i-o')
-rw-r--r--system/dos/1.8.7/src/block i-o180
1 files changed, 180 insertions, 0 deletions
diff --git a/system/dos/1.8.7/src/block i-o b/system/dos/1.8.7/src/block i-o
new file mode 100644
index 0000000..554fcca
--- /dev/null
+++ b/system/dos/1.8.7/src/block i-o
@@ -0,0 +1,180 @@
+PACKET disk block io DEFINES (* Copyright (C) 1986 *)
+ (* Frank Klapper *)
+ (* 05.01.87 *)
+ read disk block,
+ read disk block and close work if error,
+ read disk cluster,
+ write disk block,
+ write disk block and close work if error,
+ write disk cluster,
+ first non dummy ds page,
+
+ block no dump modus:
+
+BOOL VAR block no dump flag := FALSE;
+
+LET write normal = 0;
+
+INT CONST first non dummy ds page := 2;
+
+INT VAR error;
+
+PROC read disk block (DATASPACE VAR ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ IF block no dump flag THEN dump ("READ ", block no) FI;
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error);
+ IF error > 0
+ THEN lesefehler (error)
+ FI.
+
+END PROC read disk block;
+
+PROC read disk block (DATASPACE VAR ds,
+ INT CONST ds page no,
+ REAL CONST block no):
+ IF block no dump flag THEN dump ("READ ", block no) FI;
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error);
+ IF error > 0
+ THEN lesefehler (error)
+ FI.
+
+END PROC read disk block;
+
+PROC read disk block and close work if error (DATASPACE VAR ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ IF block no dump flag THEN dump ("READ ", block no) FI;
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error);
+ IF error > 0
+ THEN close work;
+ lesefehler (error)
+ FI.
+
+END PROC read disk block and close work if error;
+
+PROC read disk block and close work if error (DATASPACE VAR ds,
+ INT CONST ds page no,
+ REAL CONST block no):
+ IF block no dump flag THEN dump ("READ ", block no) FI;
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error);
+ IF error > 0
+ THEN close work;
+ lesefehler (error)
+ FI.
+
+END PROC read disk block and close work if error;
+
+PROC read disk cluster (DATASPACE VAR ds,
+ INT CONST first ds page no,
+ REAL CONST cluster no):
+ IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI;
+ INT VAR i;
+ FOR i FROM 0 UPTO sectors per cluster - 1 REP
+ read disk block (ds, first ds page no + i, block no + real (i))
+ PER.
+
+block no:
+ begin of cluster (cluster no).
+
+END PROC read disk cluster;
+
+PROC lesefehler (INT CONST fehler code):
+ error stop (fehlertext).
+
+fehlertext:
+ SELECT fehler code OF
+ CASE 1: "Diskettenlaufwerk nicht betriebsbereit"
+ CASE 2: "Lesefehler"
+ OTHERWISE "Lesefehler " + text (fehler code)
+ END SELECT.
+
+END PROC lesefehler;
+
+PROC write disk block (DATASPACE CONST ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ IF block no dump flag THEN dump ("WRITE", block no) FI;
+ check rerun;
+ write block (ds, ds page no, write normal, eublock (block no), error);
+ IF error > 0
+ THEN schreibfehler (error)
+ FI.
+
+END PROC write disk block;
+
+PROC write disk block (DATASPACE CONST ds,
+ INT CONST ds page no,
+ REAL CONST block no):
+ IF block no dump flag THEN dump ("WRITE", block no) FI;
+ check rerun;
+ write block (ds, ds page no, write normal, eublock (block no), error);
+ IF error > 0
+ THEN schreibfehler (error)
+ FI.
+
+END PROC write disk block;
+
+PROC write disk block and close work if error (DATASPACE CONST ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ IF block no dump flag THEN dump ("WRITE", block no) FI;
+ check rerun;
+ write block (ds, ds page no, write normal, eublock (block no), error);
+ IF error > 0
+ THEN close work;
+ schreibfehler (error)
+ FI.
+
+END PROC write disk block and close work if error;
+
+PROC write disk block and close work if error (DATASPACE CONST ds,
+ INT CONST ds page no,
+ REAL CONST block no):
+ IF block no dump flag THEN dump ("WRITE", block no) FI;
+ check rerun;
+ write block (ds, ds page no, write normal, eublock (block no), error);
+ IF error > 0
+ THEN close work;
+ schreibfehler (error)
+ FI.
+
+END PROC write disk block and close work if error;
+
+PROC write disk cluster (DATASPACE CONST ds,
+ INT CONST first ds page no,
+ REAL CONST cluster no):
+ IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI;
+ INT VAR i;
+ FOR i FROM 0 UPTO sectors per cluster - 1 REP
+ write disk block (ds, first ds page no + i, block no + real (i))
+ PER.
+
+block no:
+ begin of cluster (cluster no).
+
+END PROC write disk cluster;
+
+PROC schreibfehler (INT CONST fehler code):
+ error stop (fehlertext).
+
+fehlertext:
+ SELECT fehler code OF
+ CASE 1: "Diskettenlaufwerk nicht betriebsbereit"
+ CASE 2: "Schreibfehler"
+ OTHERWISE "Schreibfehler " + text (fehler code)
+ END SELECT.
+
+END PROC schreibfehler;
+
+PROC block no dump modus (BOOL CONST status):
+ block no dump flag := status
+
+END PROC block no dump modus;
+
+END PACKET disk block io;
+