From 724cc003460ec67eda269911da85c9f9e40aa6cf Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 30 Sep 2016 16:57:23 +0200 Subject: Add extracted sources from floppy disk images Some files have no textual representation (yet) and were added as raw dataspaces. --- dos/fat.dos | 369 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 369 insertions(+) create mode 100644 dos/fat.dos (limited to 'dos/fat.dos') diff --git a/dos/fat.dos b/dos/fat.dos new file mode 100644 index 0000000..2890b1a --- /dev/null +++ b/dos/fat.dos @@ -0,0 +1,369 @@ +PACKET dos fat DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 11.09.87 *) + read fat, + write fat, + first fat block ok, + clear fat ds, + format fat, + + fat entry, + last fat chain entry, + is last fat chain entry, + erase fat chain, + available fat entry: + + (* Referenz: 4. *) + +LET fat size = 16 384, (* maximal 64 Sektoren a 512 Byte (256 Worte) *) + max anzahl fat sektoren = 64; + +LET FAT = BOUND STRUCT (ALIGN dummy, + ROW 256 INT block row, (* für Kopie des 1. Fatsektors *) + ROW fat size INT fat row); + +DATASPACE VAR fat ds; +INITFLAG VAR fat ds used := FALSE; +FAT VAR fat struktur; + +.fat: fat struktur.fat row. + +REAL VAR erster moeglicher freier eintrag; + +BOOL VAR kleines fat format; + +PROC read fat: + fat ds initialisieren; + fat bloecke lesen; + fat format bestimmen; + erster moeglicher freier eintrag := 2.0. + +fat ds initialisieren: + clear fat ds; + fat struktur := fat ds. + +fat bloecke lesen: + LET kein testblock = FALSE; + INT VAR block no; + FOR block no FROM 0 UPTO fat sectors - 1 REP + fat block lesen (block no, kein testblock) + PER. + +fat format bestimmen: + IF fat entrys <= 4086 + THEN kleines fat format := TRUE + ELSE kleines fat format := FALSE + FI. + +END PROC read fat; + +PROC write fat: + disable stop; + INT VAR block nr; + FOR block nr FROM 0 UPTO fat sectors - 1 REP + fat block schreiben (block nr) + PER. + +END PROC write fat; + +BOOL PROC first fat block ok: + (* überprüft, ob der erste Block der Fat auf Diskette und im Speicher + gleich ist *) + enable stop; + LET testblock = TRUE; + fat block lesen (0, testblock); + INT VAR i; + FOR i FROM 1 UPTO 256 REP + vergleiche woerter + PER; + TRUE. + +vergleiche woerter: + IF fat [i] <> fat struktur.block row [i] + THEN LEAVE first fat block ok WITH FALSE + FI. + +END PROC first fat block ok; + +PROC clear fat ds: + IF initialized (fat ds used) + THEN forget (fat ds) + FI; + fat ds := nilspace. + +END PROC clear fat ds; + +PROC format fat: + fat ds initialisieren; + fat format bestimmen; + erster moeglicher freier eintrag := 2.0; + write first four fat bytes; + write other fat bytes; + vermerke schreibzugriffe; + write fat. + +fat ds initialisieren: + clear fat ds; + fat struktur := fat ds. + +fat format bestimmen: + IF fat entrys <= 4086 + THEN kleines fat format := TRUE + ELSE kleines fat format := FALSE + FI. + +write first four fat bytes: + fat [1] := word (media descriptor, 255); + IF kleines fat format + THEN fat [2] := word (255, 0) + ELSE fat [2] := word (255, 255) + FI. + +write other fat bytes: + INT VAR i; + FOR i FROM 3 UPTO 256 * fat sectors REP + fat [i] := 0 + PER. + +vermerke schreibzugriffe: + FOR i FROM 0 UPTO fat sectors - 1 REP + schreibzugriff (i) + PER. + +END PROC format fat; + +(*-------------------------------------------------------------------------*) + +REAL PROC fat entry (REAL CONST real entry no): + (* 0 <= entry no <= 22 000 *) + INT CONST entry no :: int (real entry no); + IF kleines fat format + THEN construct 12 bit value + ELSE dint (fat [entry no + 1], 0) + FI. + +construct 12 bit value: + INT CONST first byte no := entry no + entry no DIV 2; + IF entry no MOD 2 = 0 + THEN real ((right byte MOD 16) * 256 + left byte) + ELSE real (right byte * 16 + left byte DIV 16) + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +END PROC fat entry; + +TEXT VAR convert buffer := "12"; + +INT PROC fat byte (INT CONST no): + replace (convert buffer, 1, word); + IF even byte no + THEN code (convert buffer SUB 1) + ELSE code (convert buffer SUB 2) + FI. + +even byte no: + no MOD 2 = 0. + +word: + fat [no DIV 2 + 1]. + +END PROC fat byte; + +PROC fat entry (REAL CONST real entry no, real value): + (* 0 <= entry no <= 22 000 *) + INT CONST entry no :: int (real entry no), + value :: low word (real value); + IF kleines fat format + THEN write 12 bit value + ELSE fat [entry no + 1] := value; + schreibzugriff (entry no DIV 256) + FI; + update first possible available entry. + +write 12 bit value: + INT CONST first byte no :: entry no + entry no DIV 2; + schreibzugriff (fat block of first byte); + schreibzugriff (fat block of second byte); + write value. + +fat block of first byte: + first byte no DIV 512. + +fat block of second byte: + second byte no DIV 512. + +write value: + IF even entry no + THEN write fat byte (first byte no, value MOD 256); + write fat byte (second byte no, + (right byte DIV 16) * 16 + value DIV 256) + ELSE write fat byte (first byte no, + (left byte MOD 16) + 16 * (value MOD 16)); + write fat byte (second byte no, value DIV 16) + FI. + +even entry no: + entry no MOD 2 = 0. + +second byte no: + first byte no + 1. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (second byte no). + +update first possible available entry: + IF value = 0 + THEN erster moeglicher freier eintrag := + min (erster moeglicher freier eintrag, real entry no) + FI. + +END PROC fat entry; + +PROC write fat byte (INT CONST byte no, new value): + read old word; + change byte; + write new word. + +read old word: + replace (convert buffer, 1, word). + +write new word: + word := convert buffer ISUB 1. + +word: + fat [byte no DIV 2 + 1]. + +change byte: + replace (convert buffer, byte pos, code (new value)). + +byte pos: + byte no MOD 2 + 1. + +END PROC write fat byte; + +REAL PROC last fat chain entry: + IF kleines fat format + THEN 4 088.0 + ELSE 65 528.0 + FI. + +END PROC last fat chain entry; + +BOOL PROC is last fat chain entry (REAL CONST value): + value >= last fat chain entry + +END PROC is last fat chain entry; + +PROC erase fat chain (REAL CONST first entry no): + REAL VAR next entry no := first entry no, + act entry no := 0.0; + WHILE next entry exists REP + act entry no := next entry no; + next entry no := fat entry (act entry no); + fat entry (act entry no, 0.0) + PER. + +next entry exists: + NOT is last fat chain entry (next entry no). + +END PROC erase fat chain; + +REAL PROC available fat entry: + (* da die fat weniger als 22 000 Einträge umfaßt, kann ich diese als + INTEGER berechnen *) + INT VAR i; + REAL VAR real i := erster moeglicher freier eintrag; + FOR i FROM int (erster moeglicher freier eintrag) UPTO fat entrys - 1 REP + IF fat entry (real i) = 0.0 + THEN erster moeglicher freier eintrag := real i; + LEAVE available fat entry WITH erster moeglicher freier eintrag + FI; + real i INCR 1.0 + PER; + close work; + error stop ("MS-DOS Datentraeger voll"); + 1.0e99. + +END PROC available fat entry; + +(*-------------------------------------------------------------------------*) + +PROC fat block lesen (INT CONST block nr, BOOL CONST test block): + (* 0 <= block nr <= fat sectors - 1 *) + disable stop; + IF NOT test block + THEN kein schreibzugriff (block nr) + FI; + INT VAR kopie nr; + FOR kopie nr FROM 0 UPTO fat copies - 1 REP + clear error; + read disk block (fat ds, ds seiten nr, disk block nr) + UNTIL NOT is error + PER; + IF is error + THEN close work + FI. + +ds seiten nr: + IF test block + THEN 2 + ELSE block nr + 2 + 1 + FI. + +disk block nr: + begin of fat (kopie nr) + block nr. + +END PROC fat block lesen; + +PROC fat block schreiben (INT CONST block nr): + IF war schreibzugriff (block nr) + THEN wirklich schreiben + FI. + +wirklich schreiben: + disable stop; + INT VAR kopie nr; + FOR kopie nr FROM 0 UPTO fat copies - 1 REP + write disk block and close work if error (fat ds, ds seiten nr, disk block nr) + PER; + kein schreibzugriff (block nr). + +ds seiten nr: + block nr + 2 + 1. + +disk block nr: + begin of fat (kopie nr) + block nr. + +END PROC fat block schreiben; + +(*-------------------------------------------------------------------------*) + +ROW max anzahl fat sektoren BOOL VAR schreib zugriff tabelle; + +PROC schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] := TRUE + +END PROC schreibzugriff; + +PROC kein schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] := FALSE + +END PROC kein schreibzugriff; + +BOOL PROC war schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] + +END PROC war schreibzugriff; + +(*-------------------------------------------------------------------------*) + +END PACKET dos fat; + -- cgit v1.2.3