diff options
Diffstat (limited to 'system/dos')
48 files changed, 10681 insertions, 0 deletions
diff --git a/system/dos/1.8.7/doc/dos-dat-handbuch b/system/dos/1.8.7/doc/dos-dat-handbuch new file mode 100644 index 0000000..a1e4fd4 --- /dev/null +++ b/system/dos/1.8.7/doc/dos-dat-handbuch @@ -0,0 +1,650 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#MS-DOS-DAT + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#free(4.5)# + +#center#Lesen und Schreiben +#center#von +#center#MS-DOS Dateien + +#on ("b")##center#MS-DOS-DAT#off ("b")# +#free(1.5)# + + +#center#Version 2.0 + +#center#Stand 10.09.87 +#page# +#pagenr ("%",1)##setcount (1)##block##pageblock##count per page# +#headeven# +% #center#MS-DOS-DAT +#center#____________________________________________________________ + +#end# +#headodd# +#center#MS-DOS-DAT#right#% +#center#____________________________________________________________ + +#end# +#on("bold")# +#ib#1. Allgemeines#ie# +#off ("b")# + +Dieses Programm ermöglicht MS-DOS Dateien vom EUMEL aus von Disketten zu +lesen und auf Disketten zu schreiben. Die Benutzerschnittstelle ist ähnlich der des +EUMEL-Archivs organisiert. Der Benutzer kommuniziert mit einer Task des +EUMEL-Systems, nämlich mit der Task 'DOS'. Diese wickelt dann über das Archiv +laufwerk die Diskettenzugriffe ab. Der Benutzer meldet die MS-DOS Diskette mit +'reserve ("...", /"DOS")' an und kann dann mit 'list (/"DOS")', 'fetch ("...", /"DOS")', +'save ("...", /"DOS")' und weiteren Kommandos auf die MS-DOS Diskette zugreifen. +Für das Schreiben und Lesen (save, fetch) stehen insgesamt 7 verschiedene Be +triebsarten zur Verfügung. Man kann in eine Datei im ASCII Code mit und ohne +Anpassung der Umlaute, im IBM-ASCII Code, im Atari-ST Code oder ganz ohne +Codeumsetzung lesen bzw. schreiben. Die Betriebsart selbst wird beim Anmelden der +MS-DOS Diskette durch den Textparameter des 'reserve'-Kommandos bestimmt. + +Die gleiche Benutzerschnittstelle gilt für die Kommunikation mit der Task 'DOS HD'. +Diese Task liest und schreibt aber nicht auf der Diskette, sondern in der MS-DOS +Partition der Festplatte (falls vorhanden). + + +#on("bold")# +#ib#2. Benutzeranleitung #ie# +#off ("b")# +Im Normalfall will man als Benutzer eine EUMEL-Textdatei auf eine MS-DOS +Diskette schreiben oder eine mit z.B. Word-Star erstellte MS-DOS-Textdatei in +das EUMEL-System einlesen (implementierte Formate siehe Abschnitt 3). + +Lesen einer MS-DOS-Datei: + +#linefeed (1.25)# +#on ("b")# + reserve ("file ascii german", /"DOS"); + (* MS-DOS-Diskette ins Laufwerk einlegen *) + fetch (filename, /"DOS"); + release (/"DOS") +#off ("b")# + +Schreiben einer MS-DOS-Datei: + +#on ("b")# + reserve ("file ascii german", /"DOS"); + (* MS-DOS-Diskette ins Laufwerk einlegen *) + save (filename, /"DOS"); + release (/"DOS") +#off("b")# +#linefeed (1.0)# + + +Sollen statt der Umlaute []{|}\ verwendet werden, so ist statt "file ascii german" "file +ascii" einzustellen. Eine genaue Beschreibung aller 7 möglichen Betriebsarten wird in +Abschnitt 6 gegeben. Der Dateiname 'file name' unterliegt den im Abschnitt 4 be +schriebenen Einschränkungen. + + +#on("bold")# +#ib#3. Implementierte Formate#ie# +#off("b")# + +Diese Hardware ermöglicht das Bearbeiten von MS-DOS Disketten mit Hilfe der +Task /"DOS" und (falls es sich um einen MS-DOS fähigen Rechner mit MS-DOS Parti +tion auf der Festplatte handelt) das Bearbeiten von Daten in der MS-DOS Partition +der Platte. + +#on("bold")# +#ib#3.1 Arbeiten mit der Task /"DOS"#ie# +#off ("b")# + +Die Task /"DOS" verwendet das Archivlaufwerk als MS-DOS Datenträger. Es sind +alle mit dem IBM-Format der DOS Version 2 und 3 kompatiblen Formate für 5.25 +Zoll und 3.5 Zoll Disketten implementiert, sofern diese 512 Byte große Sektoren +verwenden und im ersten Sektor einen erweiterten BIOS-Parameterblock (BPB) +enthalten (hierzu gehören auch mit dem Atari ST bearbeitete Disketten). Weiterhin +sind die beiden von IBM verwendeten Formate der DOS Version 1 implementiert (5.25 +Zoll, ein- bzw. zweiseitig, 40 Spuren a 8 Sektoren). + +Die einzige Hardwarevoraussetzung besteht darin, daß der Hardwareanpassungs +modul (SHard) alle von DOS benutzten Sektoren lesen und schreiben können muß. + +#on("bold")# +#ib#3.2 Arbeiten mit der Task /"DOS HD"#ie# +#off ("b")# + +Die Task /"DOS HD" verwendet die MS-DOS Partition der Festplatte als Daten +träger (falls eine solche vorhanden ist und das SHard diese ansprechen kann). Hier +gibt es keine Beschränkungen bezüglich des Plattentyps. + + +#on("bold")# +#ib#4. Dateibenennung#ie# +#off ("b")# + +Die Namen für MS-DOS Dateien unterliegen bestimmten Regeln. Ein Dateiname +kann aus +- einem bis acht Zeichen oder +- einem bis acht Zeichen gefolgt von einem Punkt und einer Namenserweiterung + von einem bis drei Zeichen +bestehen. + +Gültige Zeichen sind +- die Buchstaben A bis Z +- die Ziffern 0 bis 9 +- die Sonder- und Satzzeichen $ \# & § ! ( ) { } + +Da weitere Sonderzeichen in verschiedenen MS-DOS Versionen in unterschiedlich +em Umfang erlaubt sind, ist ihre Verwendung beim Schreiben (save) vom EUMEL aus +nicht zugelassen. Beim Lesen und Löschen dagegen sind sie erlaubt. + +Außerdem sind die Buchstaben a - z erlaubt. Diese werden beim Zugriff auf das +MS-DOS Inhaltsverzeichnis (Directory) in große Buchstaben konvertiert. Durch das +Kommando 'fetch ("Test", /"DOS")' wird also die MS-DOS Datei mit dem Namen +'TEST' in die EUMEL Datei mit dem Namen 'Test' gelesen; 'save ("test", /"DOS")' +überschreibt dann die MS-DOS-Datei 'TEST' (natürlich nach Anfrage). + + +#on("bold")# +#ib#5. Beschreibung der Kommandos#ie# +#off ("b")# + +In diesem Abschnitt steht der Begriff Dostask beim Arbeiten mit der Floppy für die +Task /"DOS" und beim Arbeiten mit der MS-DOS Partition der Platte für die Task +/"DOS HD". Analog steht der Begriff Dosbereich beim Arbeiten mit der Floppy für die +Floppy und beim Arbeiten mit der MS-DOS Partition der Platte für diese Partition. + +#on("bold")# +THESAURUS OP ALL (TASK CONST task) +#off ("b")# + Wird der 'ALL'-Operator für die Dostask aufgerufen, so wird ein Thesaurus ge + liefert. In diesem Thesaurus sind alle im Dosbereich vorhandenen Dateien einge + tragen. Die vorhandenen Unterinhaltsverzeichnisse (Subdirectories) werden nicht + eingetragen. + + +#on("bold")# +PROC check (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe + reich prüfgelesen. Es werden nur die mit Daten belegten Blöcke prüfgelesen. Sollen + auch der Einträge im Inhaltsverzeichnis überprüft werden, so erreicht man dies + durch vorheriges neues Anmelden mit der Prozedur 'reserve'. + + +#on("bold")# +PROC clear (TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Task /"DOS" wird die gesamte Diskette ge + löscht. Mit dieser Prozedur können #on ("u")#nur MS-DOS formatierte Disketten#off ("u")# behandelt + werden. Soll eine Diskette dagegen für den Gebrauch unter MS-DOS initialisiert + werden, so ist sie auf einem MS-DOS-Rechner zu formatieren. + + Der Aufruf dieser Prozedur für die Task /DOS HD" ist aus Sicherheitsgründen nicht + erlaubt. + + +#on("bold")# +PROC erase (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe + reich gelöscht. + + +#on("bold")# +BOOL PROC exists (TEXT CONST name, TASK CONST task) +#off ("b")# + Wird diese Prozedur für die Dostask aufgerufen, so liefert sie 'TRUE', falls eine + Datei mit dem Namen 'name' im Dosbereich existiert. Andernfalls liefert sie + 'FALSE'. + + +#on("bold")# +PROC fetch (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' aus dem + Dosbereich gelesen. Hierbei wird in der beim Anmelden (reserve ("...", dostask)) + bestimmten Betriebsart gelesen (siehe Abschnitt 6). + + +#on("bold")# +PROC list (TASK CONST task) +#off ("b")# + Wird diese Prozedur für die Dostask aufgerufen, so werden alle Dateien des In + haltsverzeichnisses und alle Unterverzeichnisse des Dosbereichs aufgelistet. + + +#on("bold")# +PROC release (TASK CONST task) +#off ("b")# + Der Aufruf dieser Prozedur für die Task Dostask hebt deren Reservierung auf. + Gleichzeitig wird auch der für block i/o benutzte Kanal freigegeben, so daß bei + Benutzung der Task /"DOS" der Archivkanal durch das EUMEL-Archiv wieder + benutzt werden kann. + + Um möglichst effizient arbeiten zu können, werden Inhaltsverzeichnis und Ket + tungsblock des Dosbereichs als Kopie im EUMEL gehalten. Der hierdurch belegte + Speicher wird beim 'release' wieder freigegeben. Dies ist bei kleinen Systemen + besonders wichtig. + + +#on("bold")# +PROC reserve (TEXT CONST mode, TASK CONST task) +#off ("b")# + Durch Aufruf für die Dostask werden Operationen mit dem Dosbereich angemel + det. Gleichzeitig koppelt sich die Dostask an den entsprechenden Kanal an. + (/"DOS" an Kanal 31 und /"DOS HD" an Kanal 29). Die Anmeldung wird abge + lehnt, wenn der für die MS-DOS Operationen benötigte Kanal belegt ist (z.B. bei + Kanal 31 durch eine ArchivOperation). Ähnlich wie beim EUMEL-Archiv bleibt + diese Reservierung bis 5 Minuten nach dem letzten Zugriff gültig. + + Wird beim Arbeiten mit der Task /"DOS" die MS-DOS Diskette gewechselt, so + muß erneut 'reserve ("...", /"DOS")' aufgerufen werden. Nur so ist gewährleistet, + daß das Inhaltsverzeichnis der neuen Diskette geladen wird. + + Der Text 'mode' gibt die Betriebsart für das Schreiben und Lesen der Diskette + sowie den Pfad für das Bearbeiten von Subdirectories an und nicht wie beim + EUMEL-Archiv den Diskettennamen. Es gilt folgende Systax: + + modus :[\directory][\directory]...[\directory] + + Hierbei sind die Angaben in eckigen Klammern optional. Wird kein Pfad angege + ben, so wird mit dem Hauptdirektory der Diskette gearbeitet. Ansonsten wird mit + dem Directory gearbeitet, welches durch den hinter dem Doppelpunkt angegeben + Pfad bezeichnet wird. Als 'modus' können alle in Abschnitt 6 beschriebenen Be + triebsarten verwendet werden. + + +#on("bold")# +PROC save (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' in den + Dosbereich geschrieben. Hierbei wird in der beim Anmelden (reserve ("...", + dostask)) bestimmten Betriebsart geschrieben (siehe Abschnitt 6). + + +#on("bold")# +#ib#6. Die Betriebsarten von 'fetch' und 'save'#ie# + +#ib#6.1 Betriebsart: file ascii#ie# + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII + Code, internationale Referenzversion interpretiert. Die Datei wird so aufbereitet, daß + ein Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht folgenderma + ßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - 'Ctrl z' in der MS-DOS Datei wird als Dateiende interpretiert. Fehlt dieses, + so wird bis zum letzten Zeichen des letzten Sektors der Datei gelesen. + - Alle anderen Zeichen mit 0 <= code (zeichen) <= 31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code, internationale Referenzversion gemäß DIN 66 003 verwendet. + Dies geschieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der internationalen Referenzversion des ASCII Codes vorhandenen + Eumel-Zeichen werden auf diese abgebildet. + - Alle in der internationalen Referenzversion des ASCII Codes nicht vorhande + nen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt (der + Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von + \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + - Am Ende der Datei wird 'ctrl z' angehängt. + + +#on("bold")# +#ib#6.2 Betriebsart: file ascii german#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII + Code, deutsche Referenzversion interpretiert. Die Datei wird so aufbereitet, daß ein + Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht wie in der Be + triebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute und ß zur Verfügung. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code, deutsche Referenzversion gemäß DIN 66 003 verwendet. Dies + geschieht wie in der Betriebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute + zur Verfügung. + + +#on("bold")# +#ib#6.3 Betriebsart: file ibm#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden alle Zeichen wie in der von IBM verwendeten Version des ASCII Codes + interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL- + Editor möglich ist. Dies geschieht folgendermaßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - Alle anderen Zeichen mit 0 <= code (zeichen) <= 31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code in der von IBM verwendeten Version verwendet. Dies ge + schieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der IBM Version des ASCII Codes vorhandenen Eumel-Zeichen + werden auf diese abgebildet. + - Alle in der IBM Version des ASCII Codes nicht vorhandenen Eumel-Zeichen + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + + +#on("bold")# +#ib#6.4 Betriebsart: file atari st#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden alle Zeichen wie in der vom Atari ST verwendeten Version des ASCII Codes + interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL- + Editor möglich ist. Dies geschieht folgendermaßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - Alle anderen Zeichen mit 0 <= code (zeichen) <= 31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code in der vom Atari ST verwendeten Version verwendet. Dies + geschieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der vom Atari ST verwendeten Version des ASCII Codes vorhandenen + Eumel-Zeichen werden auf diese abgebildet. + - Alle in der vom Atari ST verwendeten Version des ASCII Codes nicht + vorhandenen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt + (der Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von + \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + + +#on("bold")# +#ib#6.5 Betriebsart: file transparent#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen alle 8 Bit interpretiert. Es werden keine Zeichen einge + fügt, gelöscht oder gewandelt. Somit stehen dann auch CR und LF Zeichen in der + EUMEL-Datei. + + Da eine solche Datei noch Steuerzeichen enthält, ist beim Bearbeiten mit dem + Editor Vorsicht geboten. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Es werden keine + Codeumsetzungen durchgeführt. Insbesondere muß die EUMEL-Datei auch die CR + LF Sequenzen für das Zeilenende enthalten. + + +#on("bold")# +#ib#6.6 Betriebsart: row text#ie# +#off ("b")# + +Diese Betriebsart ist nur für Programmierer interessant. Sie ist für die Umsetzung +exotischer Codes in den EUMEL-Code mittels ELAN-Programmen gedacht. + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in einen Datenraum mit folgender Struktur + kopiert: + + STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) + + Dabei bekommt der Datenraum den Type 1000. Der Integer 'benutzte texte' gibt an, + wieviele Elemente des ROW 4000 TEXT benutzt sind. In jedem benutzten Element + des ROW 4000 TEXT steht der Inhalt einer logischen Gruppe der MS-DOS Disket + te. (Eine logische Gruppe umfaßt bei einer einseitig beschriebenen MS-DOS + Diskette 512 Byte und bei einer zweiseitig beschriebenen 1024 bzw. 2048 Byte). In + dieser Betriebsart werden keine Zeichen der MS-DOS Datei konvertiert oder + interpretiert, so daß also auch alle Steuerzeichen erhalten bleiben. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Hier bezeichnet 'filename' einen Datenraum der Struktur: + + STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) + + Dieser Datenraum muß den Type 1000 haben. + Es werden die benutzten Texte (1 bis benutzte texte) aneinandergehängt und ohne + irgendwelche Konvertierungen bzw. Interpretationen als MS-DOS Datei 'filename' + geschrieben. Dies bedeutet, daß die Texte auch alle von MS-DOS benötigten + Steuerzeichen (z.B. 'ctrl z' als Dateiendekennzeichen) enthalten müssen. + + +#on("bold")# +#ib#6.7 Betriebsart: ds#ie# +#off ("b")# +Diese Betriebsart ist nur für den Programmierer interessant. Sie ermöglicht das Abbil +den von Datenstrukturen zwischen MS-DOS und EUMEL. + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird blockweise in den Datenraum 'filename' ko + piert. Hierbei wird der erste Block der MS-DOS Datei in die 2. Seite des Daten + raums kopiert. (Die 2. Seite eines Datenraums ist die erste, die von einer Daten + struktur voll überdeckt werden kann). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Der Datenraum 'filename' wird ab seiner 2. Seite in die MS-DOS Datei 'filename' + geschrieben. Hierbei werden alle Seiten des Datenraums (auch die nicht allokier + ten) bis einschließlich der letzten allokierten Datenraumseite geschrieben. + + +#on("bold")# +#ib#7. Installation#ie# +#off ("b")# + +Die Software zur Generierung der Tasks /"DOS" und /"DOS HD" wird auf einem +EUMEL-Archiv ausgeliefert. + +#on("bold")# +#ib#7.1 Installation der Task /"DOS"#ie# + +#ib#7.1.1 Installation im Multi-User#ie# +#off ("b")# + +Die Software muß in einer privilegierten Task mit dem Namen 'DOS' installiert wer +den. Dies geschieht folgendermaßen: + + + begin ("DOS", "SYSUR") + + archive ("austausch"); + fetch ("dos inserter", archive); + run ("dos inserter") + + +Danach stehen die Prozeduren + + + PROC dos manager + PROC dos manager (INT CONST channel) + + +zur Verfügung. Beide Prozeduren machen die aufrufende Task zur Kommunikations +task für das Schreiben und Lesen von MS-DOS Disketten. Die erste benutzt dazu +den Archivkanal (Kanal 31), bei der zweiten ist der Kanal über den Parameter ein +stellbar. Eine dieser Prozeduren muß jetzt aufgerufen werden. + +#on("bold")# +#ib#7.1.2. Installation im Single-User#ie# +#off ("b")# + +Die Software wird im Monitor ('gib Kommando'-Modus) durch folgende Kommandos +installiert: + + + archive ("austausch"); + fetch ("dos inserter", archive); + run ("dos inserter") + + +Für das Schreiben und Lesen von MS-DOS Disketten wird der Archivkanal (Kanal +31) benutzt. + + +#on("bold")# +#ib#7.2 Installation der Task /"DOS HD"#ie# +#off ("b")# + +Die Software muß in einer privilegierten Task mit dem Namen 'DOS HD' installiert +werden. Dies geschieht folgendermaßen: + + + begin ("DOS HD", "SYSUR") + + archive ("austausch"); + fetch ("dos hd inserter", archive); + run ("dos hd inserter") + + +Danach steht die Prozedur + + + PROC dos manager + + +zur Verfügung. Sie macht die aufrufende Task zur Kommunikationstask für das +Schreiben und Lesen in der MS-DOS Partition der Platte. Sie benutzt dazu den +Kanal 29, der, wie im Portierungshandbuch für den 8086 beschrieben, implementiert +sein muß. + +#page# +#headeven# +#end# + + + + + +Herausgegeben von: + + Gesellschaft für Mathematik und Datenverarbeitung mbH + (GMD) + Schloß Birlinghoven + 5205 Sankt Augustin 1 + + und + + Hochschulrechenzentrum der Universität Bielefeld + (HRZ) + Universitätsstraße + 4800 Bielefeld 1 + +Autor: + + Frank Klapper + +überarbeitet von: + + Thomas Müller + Hansgeorg Freese (GMD) + +Umschlaggestaltung: + + Hannelotte Wecken + + + + + + diff --git a/system/dos/1.8.7/source-disk b/system/dos/1.8.7/source-disk new file mode 100644 index 0000000..cc5ebe0 --- /dev/null +++ b/system/dos/1.8.7/source-disk @@ -0,0 +1 @@ +187_ergos/04_dos.img 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; + diff --git a/system/dos/1.8.7/src/bpb ds b/system/dos/1.8.7/src/bpb ds Binary files differnew file mode 100644 index 0000000..dabf721 --- /dev/null +++ b/system/dos/1.8.7/src/bpb ds diff --git a/system/dos/1.8.7/src/dir.dos b/system/dos/1.8.7/src/dir.dos new file mode 100644 index 0000000..08456b5 --- /dev/null +++ b/system/dos/1.8.7/src/dir.dos @@ -0,0 +1,693 @@ +PACKET dir DEFINES (* Copyright (c) 1986, 87 *) + (* Frank Klapper *) + open dir, (* 02.03.88 *) + insert dir entry, + delete dir entry, + init dir ds, + file info, + format dir, + + dir list, + file exists, + subdir exists, + all files, + all subdirs: + +LET max dir entrys = 1000; + +(*-------------------------------------------------------------------------*) + +INITFLAG VAR dir block ds used := FALSE; +DATASPACE VAR dir block ds; +BOUND STRUCT (ALIGN dummy, ROW 64 REAL daten) VAR dir block; +REAL VAR last read dir block no; + +PROC init dir block io: + last read dir block no := -1.0; + IF NOT initialized (dir block ds used) + THEN dir block ds := nilspace; + dir block := dir block ds + FI. + +END PROC init dir block io; + +PROC read dir block (REAL CONST block nr): + IF last read dir block no <> block nr + THEN last read dir block no := -1.0; + read disk block and close work if error (dir block ds, 2, block nr); + last read dir block no := block nr + FI. + +END PROC read dir block; + +PROC write dir block (REAL CONST block nr): + write disk block and close work if error (dir block ds, 2, block nr); + last read dir block no := block nr. + +END PROC write dir block; + +PROC write dir block: + IF last read dir block no < 0.0 + THEN error stop ("Lesefehler") + FI; + write dir block (last read dir block no) + +END PROC write dir block; + +PROC get dir entry (TEXT VAR entry buffer, INT CONST block entry no): + (* 0 <= block entry no <= 15 *) + entry buffer := 32 * "."; + INT CONST replace offset := 4 * block entry no; + replace (entry buffer, 1, dir block.daten [replace offset + 1]); + replace (entry buffer, 2, dir block.daten [replace offset + 2]); + replace (entry buffer, 3, dir block.daten [replace offset + 3]); + replace (entry buffer, 4, dir block.daten [replace offset + 4]). + +END PROC get dir entry; + +PROC put dir entry (TEXT CONST entry buffer, INT CONST block entry no): + (* 0 <= block entry no <= 15 *) + INT CONST offset := 4 * block entry no; + dir block.daten [offset + 1] := entry buffer RSUB 1; + dir block.daten [offset + 2] := entry buffer RSUB 2; + dir block.daten [offset + 3] := entry buffer RSUB 3; + dir block.daten [offset + 4] := entry buffer RSUB 4. + +END PROC put dir entry; + +(*-------------------------------------------------------------------------*) + +LET DIRPOS = REAL; (* 16.0 * msdos block nr + entry no *) + (* 0 <= entry no <= 15 *) + +DIRPOS PROC dirpos (REAL CONST block nr, INT CONST entry nr): + block nr * 16.0 + real (entry nr). + +END PROC dir pos; + +REAL PROC block no (DIRPOS CONST p): + floor (p / 16.0) + +END PROC block no; + +INT PROC entry no (DIRPOS CONST p): + int (p MOD 16.0) + +END PROC entry no; + +PROC incr (DIRPOS VAR p): + p INCR 1.0. + +END PROC incr; + +(*-------------------------------------------------------------------------*) + +LET FREELIST = STRUCT (ROW max dir entrys DIRPOS stack, + INT stacktop, + DIRPOS begin of free area, + end of dir, + REAL dir root); (* erste Clusterno, 0 für Main Dir *) + +PROC init free list (FREELIST VAR flist, REAL CONST root): + flist.stacktop := 0; + flist.begin of free area := dir pos (9.0e99, 0); + flist.end of dir := dir pos (-1.0, 0); + flist.dir root := root. + +END PROC init free list; + +PROC store (FREELIST VAR flist, DIRPOS CONST free pos): + flist.stacktop INCR 1; + flist.stack [flist.stack top] := free pos. + +END PROC store; + +PROC store begin of free area (FREELIST VAR flist, DIRPOS CONST begin): + flist.begin of free area := begin + +END PROC store begin of free area; + +PROC store end of dir (FREELIST VAR flist, DIRPOS CONST end): + flist.end of dir := end + +END PROC store end of dir; + +DIRPOS PROC free dirpos (FREELIST VAR flist): + enable stop; + DIRPOS VAR result; + IF flist.stacktop > 0 + THEN pop + ELIF NOT free area empty + THEN first of free area + ELIF expansion alloweded + THEN allocate new dir cluster; + result := free dirpos (flist) + ELSE error stop ("Directory voll") + FI; + result. + +pop: + result := flist.stack [flist.stacktop]; + flist.stacktop DECR 1. + +free area empty: + flist.begin of free area > flist.end of dir. + +first of free area: + result := flist.begin of free area; + incr (flist.begin of free area). + +expansion alloweded: + flist.dir root >= 2.0. + +allocate new dir cluster: + REAL CONST new dir cluster :: available fat entry; + REAL VAR last entry no; + search last entry no of fat chain; + fat entry (new dir cluster, last fat chain entry); + fat entry (last entry no, new dir cluster); + write fat; + store begin of free area (flist, dir pos (first new block, 0)); + store end of dir (flist, dir pos (last new block, 15)); + init new dir cluster. + +search last entry no of fat chain: + last entry no := flist.dir root; + WHILE NOT is last fat chain entry (fat entry (last entry no)) REP + last entry no := fat entry (last entry no) + PER. + +first new block: + begin of cluster (new dir cluster). + +last new block: + begin of cluster (new dir cluster) + real (sectors per cluster - 1). + +init new dir cluster: + TEXT CONST empty dir entry :: 32 * ""0""; + INT VAR i; + FOR i FROM 0 UPTO 15 REP + put dir entry (empty dir entry, i) + PER; + disable stop; + REAL VAR block no := first new block; + WHILE block no <= last new block REP + write dir block (block no) + PER. + +END PROC free dirpos; + +(*-------------------------------------------------------------------------*) + +LET FILEENTRY = STRUCT (TEXT date and time, + REAL size, + first cluster, + DIRPOS dirpos), + + FILELIST = STRUCT (THESAURUS thes, + ROW max dir entrys FILEENTRY entry); + +PROC init file list (FILELIST VAR flist): + flist.thes := empty thesaurus. + +END PROC init file list; + +PROC store file entry (FILELIST VAR flist, TEXT CONST entry text, DIRPOS CONST position): + INT VAR entry index; + insert (flist.thes, file name, entry index); + store file entry (flist.entry [entry index], entry text, position). + +file name: + TEXT CONST name pre :: compress (subtext (entry text, 1, 8)), + name post :: compress (subtext (entry text, 9, 11)); + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +END PROC store file entry; + +PROC store file entry (FILEENTRY VAR fentry, TEXT CONST entry text, DIRPOS CONST position): + fentry.first cluster := real (entry text ISUB 14); + fentry.date and time := dos date + " " + dos time; + fentry.size := dint (entry text ISUB 15, entry text ISUB 16); + fentry.dirpos := position. + +dos date: + day + "." + month + "." + year. + +day: + text2 (code (entry text SUB 25) MOD 32). + +month: + text2 (code (entry text SUB 25) DIV 32 + 8 * (code (entry text SUB 26) MOD 2)). + +year: + text (80 + code (entry text SUB 26) DIV 2, 2). + +dos time: + hour + ":" + minute. + +hour: + text2 (code (entry text SUB 24) DIV 8). + +minute: + text2 (code (entry text SUB 23) DIV 32 + 8 * (code (entry text SUB 24) MOD 8)). + +END PROC store file entry; + +TEXT PROC text2 (INT CONST intvalue): + IF intvalue < 10 + THEN "0" + text (intvalue) + ELSE text (int value) + FI. + +END PROC text2; + +DIRPOS PROC file entry pos (FILELIST CONST flist, TEXT CONST file name): + INT CONST link index :: link (flist.thes, file name); + IF link index = 0 + THEN error stop ("Die Datei """ + file name + """ gibt es nicht") + FI; + flist.entry [link index].dir pos. + +END PROC file entry pos; + +PROC delete (FILELIST VAR flist, TEXT CONST file name): + INT VAR dummy; + delete (flist.thes, file name, dummy). + +END PROC delete; + +PROC file info (FILELIST CONST flist, TEXT CONST file name, REAL VAR first cluster no, storage): + INT CONST link index :: link (flist.thes, file name); + IF link index = 0 + THEN error stop ("Die Datei """ + file name + """ gibt es nicht") + FI; + first cluster no := flist.entry [link index].first cluster; + storage := flist.entry [link index].size + +END PROC file info; + +BOOL PROC contains (FILELIST VAR flist, TEXT CONST file name): + flist.thes CONTAINS file name + +END PROC contains; + +PROC list (FILE VAR f, FILELIST CONST flist): + INT VAR index := 0; + TEXT VAR name; + get (flist.thes, name, index); + WHILE index > 0 REP + list file; + get (flist.thes, name, index) + PER. + +list file: + write (f, centered name); + write (f, " "); + write (f, text (flist.entry [index].size, 11, 0)); + write (f, " Bytes belegt "); + write (f, flist.entry [index].date and time); +(*COND TEST*) + write (f, " +++ "); + write (f, text (flist.entry [index].first cluster)); +(*ENDCOND*) + line (f). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +END PROC list; + +(*-------------------------------------------------------------------------*) + +LET DIRENTRY = REAL, + + DIRLIST = STRUCT (THESAURUS thes, + ROW max dir entrys DIRENTRY entry); + +PROC init dir list (DIRLIST VAR dlist): + dlist.thes := empty thesaurus. + +END PROC init dir list; + +PROC store subdir entry (DIRLIST VAR dlist, TEXT CONST entry text): + INT VAR entry index; + insert (dlist.thes, subdir name, entry index); + dlist.entry [entry index] := real (entry text ISUB 14). + +subdir name: + TEXT CONST name pre :: compress (subtext (entry text, 1, 8)), + name post :: compress (subtext (entry text, 9, 11)); + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +END PROC store subdir entry; + +REAL PROC first cluster of subdir (DIRLIST CONST dlist, TEXT CONST name): + INT CONST link index := link (dlist.thes, name); + IF link index = 0 + THEN error stop ("Das Unterverzeichnis """ + name + """ gibt es nicht") + FI; + dlist.entry [link index]. + +END PROC first cluster of subdir; + +BOOL PROC contains (DIRLIST CONST dlist, TEXT CONST subdir name): + dlist.thes CONTAINS subdir name + +END PROC contains; + +PROC list (FILE VAR f, DIRLIST CONST dlist): + INT VAR index := 0; + TEXT VAR name; + get (dlist.thes, name, index); + WHILE index > 0 REP + list dir; + get (dlist.thes, name, index) + PER. + +list dir: + write (f, centered name); + write (f, " <DIR>"); +(*COND TEST*) + write (f, " +++ "); + write (f, text (dlist.entry [index])); +(*ENDCOND*) + line (f). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +END PROC list; + +(*-------------------------------------------------------------------------*) + +LET DIR = BOUND STRUCT (FILELIST filelist, + DIRLIST dirlist, + FREELIST freelist, + TEXT path); + +DIR VAR dir; +DATASPACE VAR dir ds; +INITFLAG VAR dir ds used := FALSE; + +PROC open dir (TEXT CONST path string): + init dir block io; + init dir ds; + dir.path := path string; + load main dir; + TEXT VAR rest path := path string; + WHILE rest path <> "" REP + TEXT CONST sub dir name := next sub dir name (rest path); + load sub dir + PER. + +load main dir: + init file list (dir.filelist); + init dir list (dir.dirlist); + init free list (dir.free list, 0.0); + store end of dir (dir.freelist, dirpos (last main dir sector, 15)); + BOOL VAR was last dir sector := FALSE; + REAL VAR block no := first main dir sector; + INT VAR i; + FOR i FROM 1 UPTO dir sectors REP + load dir block (block no, was last dir sector); + block no INCR 1.0 + UNTIL was last dir sector + PER. + +first main dir sector: + real (begin of dir). + +last main dir sector: + real (begin of dir + dir sectors - 1). + +load sub dir: + REAL VAR cluster no := first cluster of sub dir (dir.dirlist, sub dir name); + was last dir sector := FALSE; + init file list (dir.filelist); + init dir list (dir.dirlist); + init free list (dir.free list, cluster no); + WHILE NOT is last fat chain entry (cluster no) REP + load sub dir entrys of cluster; + cluster no := fat entry (cluster no) + UNTIL was last dir sector + PER. + +load sub dir entrys of cluster: + store end of dir (dir.freelist, dirpos (last block no of cluster, 15)); + block no := begin of cluster (cluster no); + FOR i FROM 1 UPTO sectors per cluster REP + load dir block (block no, was last dir sector); + block no INCR 1.0 + UNTIL was last dir sector + PER. + +last block no of cluster: + begin of cluster (cluster no) + real (sectors per cluster - 1). + +END PROC open dir; + +PROC load dir block (REAL CONST block no, BOOL VAR was last block): + was last block := FALSE; + read dir block (block no); + INT VAR entry no; + TEXT VAR entry; + FOR entry no FROM 0 UPTO 15 REP + get dir entry (entry, entry no); + process entry + UNTIL was last block + PER. + +process entry: + SELECT pos (""0"."229"", entry SUB 1) OF + CASE 1: end of dir search + CASE 2: (* root des aktuellen directorys oder des übergeordneten, also nichts tun *) + CASE 3: free entry + OTHERWISE volume label or file entry or subdir entry + END SELECT. + +end of dir search: + was last block := TRUE; + store begin of free area (dir.freelist, dir pos (block no, entry no)). + +free entry: + store (dir.freelist, dir pos (block no, entry no)). + +volume label or file entry or subdir entry: + INT CONST byte 11 :: code (entry SUB 12); + IF (byte 11 AND 8) > 0 + THEN (* volume label *) + ELIF (byte 11 AND 16) > 0 + THEN sub dir entry + ELSE file entry + FI. + +sub dir entry: + store subdir entry (dir.dir list, entry). + +file entry: + store file entry (dir.file list, entry, dir pos (block no, entry no)). + +END PROC load dir block; + +TEXT PROC next subdir name (TEXT VAR path string): + TEXT VAR subdir name; + IF (path string SUB 1) <> "\" + THEN error stop ("ungültige Pfadbezeichnung") + FI; + INT CONST backslash pos :: pos (path string, "\", 2); + IF backslash pos = 0 + THEN subdir name := subtext (path string, 2); + path string := "" + ELSE subdir name := subtext (path string, 2, backslash pos - 1); + path string := subtext (path string, backslash pos) + FI; + dos name (subdir name, read modus). + +END PROC next subdir name; + +PROC init dir ds: + IF initialized (dir ds used) + THEN forget (dir ds) + FI; + dir ds := nilspace; + dir := dir ds. + +END PROC init dir ds; + +PROC insert dir entry (TEXT CONST name, REAL CONST start cluster, storage): + DIRPOS CONST ins pos :: free dirpos (dir.free list); + TEXT CONST entry string :: entry name + ""32"" + (10 * ""0"") + dos time + + dos date + entry start cluster + entry storage; + write entry on disk; + write entry in dir ds. + +entry name: + INT CONST point pos := pos (name, "."); + IF point pos > 0 + THEN subtext (name, 1, point pos - 1) + (9 - point pos) * " " + + subtext (name, point pos + 1) + (3 - LENGTH name + point pos) * " " + ELSE name + (11 - LENGTH name) * " " + FI. + +dos time: + TEXT CONST akt time :: time of day (clock (1)); + code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8). + +hour: + int (subtext (akt time, 1, 2)). + +minute: + int (subtext (akt time, 4, 5)). + +dos date: + TEXT CONST akt date :: date (clock (1)); + code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8). + +day: + int (subtext (akt date, 1, 2)). + +month: + int (subtext (akt date, 4, 5)). + +year: + int (subtext (akt date, 7, 8)). + +entry start cluster: + TEXT VAR buffer2 := "12"; + replace (buffer2, 1, low word (start cluster)); + buffer2. + +entry storage: + TEXT VAR buffer4 := "1234"; + replace (buffer4, 1, low word (storage)); + replace (buffer4, 2, high word (storage)); + buffer4. + +write entry on disk: + read dir block (block no (ins pos)); + put dir entry (entry string, entry no (ins pos)); + write dir block. + +write entry in dir ds: + store file entry (dir.file list, entry string, ins pos). + +END PROC insert dir entry; + +PROC delete dir entry (TEXT CONST name): + TEXT VAR entry; + DIRPOS CONST del pos :: file entry pos (dir.filelist, name); + read dir block (block no (del pos)); + get dir entry (entry, entry no (del pos)); + put dir entry (""229"" + subtext (entry, 2, 32), entry no (del pos)); + write dir block; + delete (dir.filelist, name); + store (dir.freelist, del pos). + +END PROC delete dir entry; + +PROC format dir: + init dir block io; + init dir ds; + build empty dir block; + REAL VAR block no := real (begin of dir); + disable stop; + FOR i FROM 1 UPTO dir sectors REP + write dir block (block no); + block no INCR 1.0 + PER; + enable stop; + dir.path := ""; + init file list (dir.file list); + init dir list (dir.dir list); + init free list (dir.free list, 0.0); + store begin of free area (dir.free list, dir pos (real (begin of dir), 0)); + store end of dir (dir.free list, dir pos (last main dir sector, 15)). + +build empty dir block: + INT VAR i; + FOR i FROM 0 UPTO 15 REP + put dir entry (32 * ""0"", i) + PER. + +last main dir sector: + real (begin of dir + dir sectors - 1). + +END PROC format dir; + +PROC file info (TEXT CONST file name, REAL VAR start cluster, size): + file info (dir.file list, file name, start cluster, size) + +END PROC file info; + +THESAURUS PROC all files: + THESAURUS VAR t := dir.filelist.thes; + t + +END PROC all files; + +THESAURUS PROC all subdirs: + dir.dirlist.thes + +END PROC all subdirs; + +BOOL PROC file exists (TEXT CONST file name): + contains (dir.filelist, file name) + +END PROC file exists; + +BOOL PROC subdir exists (TEXT CONST subdir name): + contains (dir.dirlist, subdir name) + +END PROC subdir exists; + +PROC dir list (DATASPACE VAR ds): + open list file; + head line (list file, list file head); + list (list file, dir.file list); + list (list file, dir.dir list). + +open list file: + forget (ds); + ds := nilspace; + FILE VAR list file := sequential file (output, ds); + putline (list file, ""). + +list file head: + "DOS" + path string. + +path string: + IF dir.path <> "" + THEN " PATH: " + dir.path + ELSE "" + FI. + +END PROC dir list; + +END PACKET dir; + diff --git a/system/dos/1.8.7/src/disk descriptor.dos b/system/dos/1.8.7/src/disk descriptor.dos new file mode 100644 index 0000000..0b0d7fc --- /dev/null +++ b/system/dos/1.8.7/src/disk descriptor.dos @@ -0,0 +1,339 @@ +PACKET dos disk DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* Referenz: 3-22 *) (* 11.09.87 *) + + open dos disk, + + sectors per cluster, + fat copies, + dir sectors, + media descriptor, + fat sectors, + + begin of fat, + fat entrys, + begin of dir, + begin of cluster, + cluster size, + + bpb exists, + write bpb, + + eu block, + + bpb dump modus: + +INITFLAG VAR bpb ds initialisiert := FALSE; +DATASPACE VAR bpb ds; +BOUND STRUCT (ALIGN dummy, ROW 512 INT daten) VAR bpb; + +BOOL VAR bpb dump flag := FALSE; + +REAL VAR begin of data area; +INT VAR sectors per track, + heads; + +IF exists ("shard interface") + THEN load shard interface table +FI; + +TEXT CONST bpb type 254 :: ""00""00""00"" + + ""69""85""77""69""76""66""80""66"" + + ""00""02"" + + ""01"" + + ""01""00"" + + ""02"" + + ""64""00"" + + ""64""01"" + + ""254"" + + ""01""00"" + + ""08""00"" + + ""01""00"" + + ""00""00"", + bpb type 255 :: ""00""00""00"" + + ""69""85""77""69""76""66""80""66"" + + ""00""02"" + + ""02"" + + ""01""00"" + + ""02"" + + ""112""00"" + + ""128""02"" + + ""255"" + + ""01""00"" + + ""08""00"" + + ""02""00"" + + ""00""00""; + +PROC open dos disk: + enable stop; + bpb ds an bound koppeln; + bpb lesen; + IF bpb ungueltig + THEN versuche pseudo bpb zu verwenden + FI; + ueberpruefe bpb auf gueltigkeit; + globale variablen initialisieren; + IF bpb dump flag + THEN dump schreiben + FI. + +bpb ds an bound koppeln: + IF NOT initialized (bpb ds initialisiert) + THEN bpb ds := nilspace; + bpb := bpb ds + FI. + +bpb lesen: + INT VAR return; + check rerun; + read block (bpb ds, 2, 0, return); + IF return <> 0 + THEN lesefehler (return) + FI. + +bpb ungueltig: + (* Byte 12 = Byte 13 = ... = Byte 23 <==> Word 6 = ... = Word 11 *) + INT VAR word no; + FOR word no FROM 6 UPTO 10 REP + IF bpb.daten [word no + 1] <> bpb.daten [word no + 2] + THEN LEAVE bpb ungueltig WITH FALSE + FI + PER; + TRUE. + +versuche pseudo bpb zu verwenden: + lies ersten fat sektor; + IF fat sektor gueltig und pseudo bpb vorhanden + THEN pseudo bpb laden + ELSE error stop ("Format unbekannt") + FI. + +lies ersten fat sektor: + (* da der bpb in diesem Fall ungültig, lese ich den fat sektor in den bpb + Datenraum *) + check rerun; + read block (bpb ds, 2, 1, return); + IF return <> 0 + THEN lesefehler (return) + FI. + +fat sektor gueltig und pseudo bpb vorhanden: + TEXT VAR fat start := "1234"; + replace (fat start, 1, bpb.daten [1]); + replace (fat start, 2, bpb.daten [2]); + (fat start SUB 2) = ""255"" CAND (fat start SUB 3) = ""255"" CAND + pseudo bpb vorhanden. + +pseudo bpb vorhanden: + pos (""254""255"", fat start SUB 1) > 0. + +pseudo bpb laden: + INT VAR i; + FOR i FROM 1 UPTO 15 REP + bpb.daten [i] := bpb puffer ISUB i + PER. + +bpb puffer: + IF pseudo bpb name = ""255"" + THEN bpb type 255 + ELSE bpb type 254 + FI. + +pseudo bpb name: + fat start SUB 1. + +ueberpruefe bpb auf gueltigkeit: + IF bytes per sector <> 512 + THEN error stop ("DOS Format nicht implementiert (unzulässige Sektorgröße)") + FI; + IF (fat sectors > 64) + THEN error stop ("ungültige DOS Disk (BPB)") + FI. + +globale variablen initialisieren: + sectors per track := bpb byte (25) * 256 + bpb byte (24); + heads := bpb byte (27) * 256 + bpb byte (26); + begin of data area := real (reserved sectors + fat copies * fat sectors + dir sectors). + +dump schreiben: + dump ("Sektoren pro Cluster", sectors per cluster); + dump ("Fat Kopien ", fat copies); + dump ("Dir Sektoren ", dir sectors); + dump ("Media Descriptor ", media descriptor); + dump ("Sektoren pro Fat ", fat sectors); + dump ("Fat Anfang (0) ", begin of fat (0)); + dump ("Fat Einträge ", fat entrys); + dump ("Dir Anfang ", begin of dir). + +END PROC open dos disk; + +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; + +TEXT VAR konvertier puffer := "12"; + +INT PROC bpb byte (INT CONST byte no): + replace (konvertier puffer, 1, bpb.daten [byte no DIV 2 + 1]); + code (konvertier puffer SUB puffer pos). + +puffer pos: + IF even byte no + THEN 1 + ELSE 2 + FI. + +even byte no: + (byte no MOD 2) = 0. + +END PROC bpb byte; + +INT PROC bytes per sector: + bpb byte (12) * 256 + bpb byte (11) + +END PROC bytes per sector; + +INT PROC sectors per cluster: + bpb byte (13) + +END PROC sectors per cluster; + +INT PROC reserved sectors: + bpb byte (15) * 256 + bpb byte (14) + +END PROC reserved sectors; + +INT PROC fat copies: + bpb byte (16) + +END PROC fat copies; + +INT PROC dir sectors: + dir entrys DIV dir entrys per sector. + +dir entrys: + bpb byte (18) * 256 + bpb byte (17). + +dir entrys per sector: + 16. + +END PROC dir sectors; + +REAL PROC dos sectors: + real (bpb byte (20)) * 256.0 + real (bpb byte (19)) + +END PROC dos sectors; + +INT PROC media descriptor: + bpb byte (21) + +END PROC media descriptor; + +INT PROC fat sectors: + bpb byte (23) * 256 + bpb byte (22) + +END PROC fat sectors; + +INT PROC begin of fat (INT CONST fat copy no): + (* 0 <= fat copy no <= fat copies - 1 *) + reserved sectors + fat copy no * fat sectors + +END PROC begin of fat; + +INT PROC fat entrys: + anzahl daten cluster + 2. + +anzahl daten cluster: + int ((dos sectors - tabellen sektoren) / real (sectors per cluster)). + +tabellen sektoren: + real (reserved sectors + fat copies * fat sectors + dir sectors). + +END PROC fat entrys; + +INT PROC begin of dir: + reserved sectors + fat copies * fat sectors. + +END PROC begin of dir; + +REAL PROC begin of cluster (REAL CONST cluster no): + begin of data area + (cluster no - 2.0) * real (sectors per cluster) + +END PROC begin of cluster; + +INT PROC cluster size: + 512 * sectors per cluster + +END PROC cluster size; + +BOOL PROC bpb exists (INT CONST no): + + exists ("bpb ds") AND no > 0 AND no < 4. + +END PROC bpb exists; + +PROC write bpb (INT CONST no): + INT VAR return; + write block (old ("bpb ds"), no + 1, 0, 0, return); + IF return <> 0 + THEN error stop ("Schreibfehler") + FI. + +END PROC write bpb; + +(* Da DOS-Partitionen maximal 32 MByte groß sein können, können die Blocknummern + durch 16 BIT unsigned Integer dargestellt werden. Die Werte die die 'eublock'- + Prozeduren liefern sind als solche zu verstehen *) + +INT PROC eu block (INT CONST dos block no): + IF hd version + THEN dos block no + ELSE dos block no floppy format + FI. + +dos block no floppy format: + IF page format + THEN head * eu sectors per head + trac * eu sectors + sector + ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector + FI. + +page format: + eu heads < 0. + +sector: + dos block no MOD sectors per track. + +trac: + (dos block no DIV sectors per track) DIV heads. + +head: + (dos block no DIV sectors per track) MOD heads. + +eu sectors per head: + eu sectors * eu tracks. + +eu sectors: + eu last sector - eu first sector + 1. + +END PROC eu block; + +INT PROC eu block (REAL CONST dos block no): + eublock (low word (dos block no)). + +END PROC eublock; + +PROC bpb dump modus (BOOL CONST status): + bpb dump flag := status + +END PROC bpb dump modus; + +END PACKET dos disk; + diff --git a/system/dos/1.8.7/src/dos hd inserter b/system/dos/1.8.7/src/dos hd inserter new file mode 100644 index 0000000..24be82b --- /dev/null +++ b/system/dos/1.8.7/src/dos hd inserter @@ -0,0 +1,41 @@ +IF NOT single user + THEN do ("IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI"); +FI; + +archive ("austausch"); +check off; +command dialogue (FALSE); +fetch ("insert.dos", archive); +fetch ("bpb ds", archive); +IF single user + THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos"); + gen s ("manager/S.dos") + ELSE fetch (ALL "insert.dos", archive); + fetch ("manager/M.dos", archive); + release (archive); + do (PROC (TEXT CONST) gen m, ALL "insert.dos"); + gen m ("manager/M.dos"); +FI; +do ("hd version (TRUE)"); +forget ("insert.dos", quiet); +forget ("dos hd inserter", quiet); +IF NOT single user + THEN do ("dos manager (29)") +FI. + +single user: + (pcb (9) AND 255) = 1. + +PROC gen m (TEXT CONST name): + insert (name); + forget (name, quiet) + +END PROC gen m; + +PROC gen s (TEXT CONST t): + fetch (t, archive); + insert (t); + forget (t, quiet) + +END PROC gen s; + diff --git a/system/dos/1.8.7/src/dos inserter b/system/dos/1.8.7/src/dos inserter new file mode 100644 index 0000000..2f70b28 --- /dev/null +++ b/system/dos/1.8.7/src/dos inserter @@ -0,0 +1,59 @@ +IF NOT single user + THEN do ("IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI"); +FI; + +archive ("austausch"); +check off; +command dialogue (FALSE); +hol ("shard interface"); +hol ("bpb ds"); +hol ("insert.dos"); +IF single user + THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos"); + gen s ("manager/S.dos") + ELSE do (PROC (TEXT CONST) hol, ALL "insert.dos"); + hol ("manager/M.dos"); + release (archive); + do (PROC (TEXT CONST) gen m, ALL "insert.dos"); + gen m ("manager/M.dos"); + putline ("jetzt mit 'dos manager' bzw. 'dos manager (channnel)' starten"); +FI; +do ("hd version (FALSE)"); +do ("load shard interface table"); +forget ("shard interface", quiet); +forget ("insert.dos", quiet); +forget ("dos inserter", quiet). + +single user: + (pcb (9) AND 255) = 1. + +PROC gen m (TEXT CONST name): + insert (name); + forget (name, quiet) + +END PROC gen m; + +PROC gen s (TEXT CONST t): + hol (t); + insert (t); + forget (t, quiet) + +END PROC gen s; + +PROC hol (TEXT CONST t): + IF NOT exists (t) + THEN fetch (t, archive) + FI + +END PROC hol; + + + + + + + + + + + diff --git a/system/dos/1.8.7/src/dump b/system/dos/1.8.7/src/dump new file mode 100644 index 0000000..5138162 --- /dev/null +++ b/system/dos/1.8.7/src/dump @@ -0,0 +1,49 @@ +PACKET dump DEFINES + + dump: + +TEXT VAR ergebnis := ""; + +PROC dump (TEXT CONST kommentar, dump text): + ergebnis := kommentar; + ergebnis CAT ": "; + INT VAR i; + FOR i FROM 1 UPTO LENGTH dump text REP + zeichen schreiben + PER; + ergebnis schreiben. + +zeichen schreiben: + INT CONST char code :: code (dump text SUB i); + IF char code < 32 + THEN ergebnis CAT ("$" + text (char code) + "$") + ELSE ergebnis CAT code (char code) + FI. + +END PROC dump; + +PROC dump (TEXT CONST kommentar, INT CONST dump int): + ergebnis := kommentar; + ergebnis CAT ": "; + ergebnis CAT text (dump int); + ergebnis schreiben. + +END PROC dump; + +PROC dump (TEXT CONST kommentar, REAL CONST dump real): + ergebnis := kommentar; + ergebnis CAT ": "; + ergebnis CAT text (dump real); + ergebnis schreiben. + +END PROC dump; + +PROC ergebnis schreiben: + FILE VAR f := sequential file (output, "logbuch"); + putline (f, ergebnis); + ergebnis := "". + +END PROC ergebnis schreiben; + +END PACKET dump; + diff --git a/system/dos/1.8.7/src/eu disk descriptor b/system/dos/1.8.7/src/eu disk descriptor new file mode 100644 index 0000000..5a61367 --- /dev/null +++ b/system/dos/1.8.7/src/eu disk descriptor @@ -0,0 +1,107 @@ +PACKET eu disk DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* 05.01.87 *) + load shard interface table, + open eu disk, + eu size, + eu heads, + eu tracks, + eu first sector, + eu last sector: + +LET table length = 15, + + size field = 1, + head field = 2, + track field = 3, + first sector field = 4, + last sector field = 5; + +ROW table length ROW 5 INT VAR format table; + +INT VAR table top := 0, + table pointer; + +PROC open eu disk: + enable stop; + init check rerun; + IF hd version + THEN LEAVE open eu disk + FI; + INT CONST blocks := archive blocks; + IF blocks <= 0 + THEN error stop ("keine Diskette eingelegt") + FI; + search format table entry. + +search format table entry: + IF table top < 1 + THEN error stop ("SHard-Interfacetabelle nicht geladen") + FI; + table pointer := 1; + WHILE format table [table pointer][size field] <> blocks REP + table pointer INCR 1; + IF table pointer > table top + THEN error stop ("Diskettenformat nicht implementiert") + FI + PER. + +END PROC open eu disk; + +PROC load shard interface table: + FILE VAR f := sequential file (input, "shard interface"); + TEXT VAR line; + table top := 0; + WHILE NOT eof (f) REP + get line (f, line); + IF (line SUB 1) <> ";" + THEN load line + FI + PER. + +load line: + table top INCR 1; + IF table top > table length + THEN error stop ("Shard Interface Tabelle zu groß") + FI; + INT VAR blank pos := 1; + format table [table top][size field] := next int; + format table [table top][head field] := next int; + format table [table top][track field] := next int; + format table [table top][first sector field] := next int; + format table [table top][last sector field] := next int. + +next int: + line := compress (subtext (line, blank pos)) + " "; + blank pos := pos (line, " "); + int (subtext (line, 1, blank pos - 1)). + +END PROC load shard interface table; + +INT PROC eu size: + format table [table pointer][size field] + +END PROC eu size; + +INT PROC eu heads: + format table [table pointer][head field] + +END PROC eu heads; + +INT PROC eu tracks: + format table [table pointer][track field] + +END PROC eu tracks; + +INT PROC eu first sector: + format table [table pointer][first sector field] + +END PROC eu first sector; + +INT PROC eu last sector: + format table [table pointer][last sector field] + +END PROC eu last sector; + +END PACKET eu disk; + diff --git a/system/dos/1.8.7/src/fat.dos b/system/dos/1.8.7/src/fat.dos new file mode 100644 index 0000000..2890b1a --- /dev/null +++ b/system/dos/1.8.7/src/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; + diff --git a/system/dos/1.8.7/src/fetch b/system/dos/1.8.7/src/fetch new file mode 100644 index 0000000..7cb7571 --- /dev/null +++ b/system/dos/1.8.7/src/fetch @@ -0,0 +1,371 @@ +PACKET fetch DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 27.04.87 *) + fetch, + check file: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + dump = 7, + atari st = 10, + ibm = 11, + + (*line end chars = ""10""12""13"",*) + min line end char = ""10"", + max line end char = ""13"", + lf = ""10"", + cr = ""13"", + tab code = 9, + lf code = 10, + ff code = 12, + cr code = 13, + ctrl z = ""26"", + + page cmd = "#page#", + + row text length = 4000, + row text type = 1000; + +BOUND STRUCT (INT size, + ROW row text length TEXT cluster row) VAR cluster struct; + +FILE VAR file; + +TEXT VAR buffer; +INT VAR buffer length; + +PROC fetch (TEXT CONST name, DATASPACE VAR file ds, INT CONST mode): + + SELECT mode OF + CASE ascii, ascii german, atari st, ibm, transparent: + fetch filemode (file ds, name, mode) + CASE row text : fetch row textmode (file ds, name) + CASE ds : fetch dsmode (file ds, name) + CASE dump : fetch dumpmode (file ds, name) + OTHERWISE error stop ("Unzulässige Betriebsart") + END SELECT. + +END PROC fetch; + +PROC fetch filemode (DATASPACE VAR file space, TEXT CONST name, + INT CONST code type): + enable stop; + initialize fetch filemode; + open fetch dos file (name); + WHILE NOT was last fetch cluster REP + get text of cluster; + write lines; +(***************************************) + IF lines (file) > 3900 + THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<"); + LEAVE fetch filemode + FI; +(***************************************) + UNTIL file end via ctrl z + PER; + write last line if necessary; + close fetch dos file. + +initialize fetch filemode: + buffer := ""; + buffer length := 0; + forget (file space); + file space := nilspace; + file := sequential file (output, file space); + BOOL VAR file end via ctrl z := FALSE. + +get text of cluster: + cat next fetch dos cluster (buffer); + IF ascii code + THEN ctrl z is buffer end + FI; + adapt code (buffer, buffer length + 1, code type); + buffer length := length (buffer). + +ascii code: + (code type = ascii) OR (code type = ascii german). + +ctrl z is buffer end: + INT CONST ctrl z pos :: pos (buffer, ctrl z, buffer length + 1); + file end via ctrl z := ctrl z pos > 0; + IF file end via ctrl z + THEN buffer := subtext (buffer, 1, ctrl z pos - 1); + buffer length := length (buffer) + FI. + +write lines: + INT VAR line begin pos := 1, line end pos; + compute line end pos; + WHILE line end pos > 0 REP + putline (file, subtext (buffer, line begin pos, line end pos)); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + line begin pos := line end pos + 1; + compute line end pos + PER; + buffer := subtext (buffer, line begin pos); + buffer length := length (buffer); + IF buffer length > 5 000 + THEN putline (file, buffer); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + buffer := ""; + buffer length := 0 + FI. + +compute line end pos: + line end pos := line begin pos; + REP + line end pos := pos (buffer, min line end char, max line end char, line end pos); + INT CONST line end code :: code (buffer SUB line end pos); + SELECT line end code OF + CASE lf code: look for cr + CASE 11 : line end pos INCR 1 + CASE cr code: look for lf + END SELECT + UNTIL line end code <> 11 + PER. + +look for cr: + IF line end pos = buffer length + THEN line end pos := 0 + ELIF (buffer SUB line end pos + 1) = cr + THEN line end pos INCR 1 + FI. + +look for lf: + IF line end pos = buffer length + THEN line end pos := 0 + ELIF (buffer SUB line end pos + 1) = lf + THEN line end pos INCR 1 + FI. + +write last line if necessary: + IF buffer length > 0 + THEN putline (file, buffer); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + FI. + +END PROC fetch filemode; + +PROC adapt code (TEXT VAR text buffer, INT CONST start pos, code type): + SELECT code type OF + CASE ascii : cancel bit 8 + CASE ascii german: cancel bit 8; ascii german adaption + CASE atari st : atari st adaption + CASE ibm : ibm adaption + (*CASE transparent : do nothing *) + END SELECT. + +cancel bit 8: + INT VAR set pos := pos (text buffer, ""128"", ""255"", start pos); + WHILE set pos > 0 REP + replace (text buffer, set pos, seven bit char); + set pos := pos (text buffer, ""128"", ""255"", set pos + 1) + PER. + +seven bit char: + code (code (text buffer SUB set pos) AND 127). + +ascii german adaption: + change all by replace (text buffer, start pos, "[", "Ä"); + change all by replace (text buffer, start pos, "\", "Ö"); + change all by replace (text buffer, start pos, "]", "Ü"); + change all by replace (text buffer, start pos, "{", "ä"); + change all by replace (text buffer, start pos, "|", "ö"); + change all by replace (text buffer, start pos, "}", "ü"); + change all by replace (text buffer, start pos, "~", "ß"). + +atari st adaption: + change all by replace (text buffer, start pos, ""142"", "Ä"); + change all by replace (text buffer, start pos, ""153"", "Ö"); + change all by replace (text buffer, start pos, ""154"", "Ü"); + change all by replace (text buffer, start pos, ""132"", "ä"); + change all by replace (text buffer, start pos, ""148"", "ö"); + change all by replace (text buffer, start pos, ""129"", "ü"); + change all by replace (text buffer, start pos, ""158"", "ß"). + +ibm adaption: + change all by replace (text buffer, start pos, ""142"", "Ä"); + change all by replace (text buffer, start pos, ""153"", "Ö"); + change all by replace (text buffer, start pos, ""154"", "Ü"); + change all by replace (text buffer, start pos, ""132"", "ä"); + change all by replace (text buffer, start pos, ""148"", "ö"); + change all by replace (text buffer, start pos, ""129"", "ü"); + change all by replace (text buffer, start pos, ""225"", "ß"). + +END PROC adapt code; + +PROC change all by replace (TEXT VAR string, INT CONST begin pos, + TEXT CONST old, new): + + INT VAR p := pos (string, old, begin pos); + WHILE p > 0 REP + replace (string, p, new); + p := pos (string, old, p + 1) + PER. + +END PROC change all by replace; + +PROC control char conversion (TEXT VAR string, INT CONST code type): + + IF code type <> transparent + THEN code conversion + FI. + +code conversion: + INT VAR p := pos (string, ""0"", ""31"", 1); + WHILE p > 0 REP + convert char; + p := pos (string, ""0"", ""31"", p) + PER. + +convert char: + INT CONST char code := code (string SUB p); + SELECT char code OF + CASE tab code: expand tab + CASE lf code: change (string, p, p, "") + CASE ff code: change (string, p, p, page cmd) + CASE cr code: change (string, p, p, "") + OTHERWISE ersatzdarstellung + END SELECT. + +expand tab: + change (string, p, p, (8 - (p - 1) MOD 8) * " "). + +ersatzdarstellung: + TEXT CONST t := text (char code); + change (string, p, p, "#" + (3 - length (t)) * "0" + t + "#"). + +END PROC control char conversion; + +PROC fetch rowtextmode (DATASPACE VAR file space, + TEXT CONST name): + enable stop; + open fetch dos file (name); + initialize fetch rowtext mode; + WHILE NOT was last fetch cluster REP + cluster struct.size INCR 1; + cluster struct.cluster row [cluster struct.size] := ""; + cat next fetch dos cluster (cluster struct.cluster row [cluster struct.size]) + PER; + close fetch dos file. + +initialize fetch row text mode: + forget (file space); + file space := nilspace; + cluster struct := file space; + type (file space, row text type); + cluster struct.size := 0. + +END PROC fetch rowtext mode; + +PROC fetch ds mode (DATASPACE VAR in ds, TEXT CONST name): + enable stop; + open fetch dos file (name); + init fetch dsmode; + WHILE NOT was last fetch cluster REP + read next fetch dos cluster (in ds, ds block no); + PER; + close fetch dos file. + +init fetch dsmode: + forget (in ds); + in ds := nilspace; + INT VAR ds block no := 2. + +END PROC fetch ds mode; + +PROC fetch dumpmode (DATASPACE VAR file space, TEXT CONST name): + enable stop; + open fetch dos file (name); + initialize fetch dumpmode; + WHILE NOT was last fetch cluster REP + TEXT VAR cluster buffer := ""; + cat next fetch dos cluster (cluster buffer); + dump cluster + UNTIL offset > 50 000.0 + PER; + close fetch dos file. + +initialize fetch dump mode: + BOOL VAR fertig := FALSE; + REAL VAR offset := 0.0; + forget (file space); + file space := nilspace; + file := sequential file (output, file space). + +dump cluster: + TEXT VAR dump line; + INT VAR line, column; + FOR line FROM 0 UPTO (cluster size DIV 16) - 1 REP + build dump line; + putline (file, dump line); + offset INCR 16.0 + UNTIL fertig + PER. + +build dump line: + TEXT VAR char line := ""; + dump line := text (offset, 6, 0); + dump line := subtext (dump line, 1, 5); + dump line CAT " "; + FOR column FROM 0 UPTO 7 REP + convert char; + dump line CAT " " + PER; + dump line CAT " "; + FOR column FROM 8 UPTO 15 REP + convert char; + dump line CAT " " + PER; + dump line CAT " "; + dump line CAT char line. + +convert char: + TEXT CONST char :: cluster buffer SUB (line * 16 + column + 1); + IF char = "" + THEN fertig := TRUE; + dump line CAT " "; + LEAVE convert char + FI; + INT CONST char code := code (char); + LET hex chars = "0123456789ABCDEF"; + dump line CAT (hex chars SUB (char code DIV 16 + 1)); + dump line CAT (hex chars SUB (char code MOD 16 + 1)); + charline CAT show char. + +show char: + IF (char code > 31 AND char code < 127) + THEN char + ELSE "." + FI. + +END PROC fetch dump mode; + +PROC check file (TEXT CONST name): + disable stop; + DATASPACE VAR test ds := nilspace; + enable check file (name, test ds); + forget (test ds); + IF is error + THEN clear error; + error stop ("Fehler beim Prüflesen der Datei """ + name + """") + FI. + +END PROC check file; + +PROC enable check file (TEXT CONST name, DATASPACE VAR test ds): + enable stop; + open fetch dos file (name); + WHILE NOT was last fetch cluster REP + INT VAR dummy := 2; + read next fetch dos cluster (test ds, dummy) + PER; + close fetch dos file. + +END PROC enable check file; + +END PACKET fetch; + diff --git a/system/dos/1.8.7/src/fetch save interface b/system/dos/1.8.7/src/fetch save interface new file mode 100644 index 0000000..27b4925 --- /dev/null +++ b/system/dos/1.8.7/src/fetch save interface @@ -0,0 +1,70 @@ +PACKET fetch save DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + save fetch mode, (* 22.04.87 *) + path: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + dump = 7, + atari st = 10, + ibm = 11; + +INT PROC save fetch mode (TEXT CONST reserve string): + TEXT VAR modus; + INT CONST p := pos (reserve string, ":"); + IF p = 0 + THEN modus := reserve string + ELSE modus := subtext (reserve string, 1, p - 1) + FI; + modus normieren; + IF modus = "FILEASCII" + THEN ascii + ELIF modus = "FILEASCIIGERMAN" + THEN asciigerman + ELIF modus = "FILEATARIST" + THEN atari st + ELIF modus = "FILEIBM" + THEN ibm + ELIF modus = "FILETRANSPARENT" + THEN transparent + ELIF modus = "ROWTEXT" + THEN row text + ELIF modus = "DS" + THEN ds + ELIF modus = "DUMP" + THEN dump + ELSE error stop ("Unzulässige Betriebsart"); -1 + FI. + +modus normieren: + change all (modus, " ", ""); + INT VAR i; + FOR i FROM 1 UPTO LENGTH modus REP + INT CONST char code :: code (modus SUB i); + IF is lower case + THEN replace (modus, i, upper case char) + FI + PER. + +is lower case: + char code > 96 AND char code < 123. + +upper case char: + code (char code - 32). + +END PROC save fetch mode; + +TEXT PROC path (TEXT CONST reserve string): + INT CONST p :: pos (reserve string, ":"); + IF p = 0 + THEN "" + ELSE subtext (reserve string, p + 1) + FI. + +END PROC path; + +END PACKET fetch save; + diff --git a/system/dos/1.8.7/src/get put interface.dos b/system/dos/1.8.7/src/get put interface.dos new file mode 100644 index 0000000..1d6de92 --- /dev/null +++ b/system/dos/1.8.7/src/get put interface.dos @@ -0,0 +1,368 @@ +PACKET dos get put DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* 11.12.87 *) + log modus, + + open dos disk, + close dos disk, + access dos disk, + + open fetch dos file, + close fetch dos file, + cat next fetch dos cluster, + read next fetch dos cluster, + was last fetch cluster, + + open save dos file, + write next save dos cluster, + close save dos file, + + erase dos file, + + all dosfiles, + all dossubdirs, + dosfile exists, + dos list, + + clear dos disk, + format dos disk: + +BOOL VAR log flag := FALSE; + +PROC log modus (BOOL CONST status): + log flag := status + +END PROC log modus; + +(*-------------------------------------------------------------------------*) + +LET max cluster size = 8192, (* 8192 * 8 = 64 KB *) + reals per sector = 64; + +LET CLUSTER = BOUND STRUCT (ALIGN dummy, + ROW max cluster size REAL cluster row); + +CLUSTER VAR cluster; +DATASPACE VAR cluster ds; +INITFLAG VAR cluster ds used := FALSE; + +TEXT VAR convert buffer; +INT VAR convert buffer length; + +PROC init cluster handle: + IF initialized (cluster ds used) + THEN forget (cluster ds) + FI; + cluster ds := nilspace; + cluster := cluster ds; + convert buffer := ""; + convert buffer length := 0. + +END PROC init cluster handle; + +PROC cat cluster text (REAL CONST cluster no, TEXT VAR destination, INT CONST to): + read disk cluster (cluster ds, 2, cluster no); + init convert buffer; + INT VAR i; + FOR i FROM 1 UPTO sectors per cluster * reals per sector REP + replace (convert buffer, i, cluster.cluster row [i]) + PER; + destination CAT subtext (convert buffer, 1, to). + +init convert buffer: + IF convert buffer length < cluster size + THEN convert buffer CAT (cluster size - convert buffer length) * "*"; + convert buffer length := cluster size + FI. + +END PROC cat cluster text; + +PROC write text to cluster (REAL CONST cluster no, TEXT CONST string): + IF LENGTH string < cluster size + THEN execute write text (text (string, cluster size)) + ELSE execute write text (string) + FI; + write disk cluster (cluster ds, 2, cluster no). + +END PROC write text to cluster; + +PROC execute write text (TEXT CONST string): + INT VAR i; + FOR i FROM 1 UPTO sectors per cluster * reals per sector REP + cluster.cluster row [i] := string RSUB i + PER. + +END PROC execute write text; + +(*-------------------------------------------------------------------------*) + +BOOL VAR disk open := FALSE; +TEXT VAR act path; + +REAL VAR last access time; + +PROC open dos disk (TEXT CONST path): + IF log flag THEN dump ("open dos disk", path) FI; + enable stop; + close work; + init cluster handle; + act path := path; + disk open := TRUE + +END PROC open dos disk; + +PROC close dos disk: + IF log flag THEN dump ("close dos disk", "") FI; + enable stop; + disk open := FALSE; + close work; + init cluster handle; (* Datenraumespeicher freigeben *) + clear fat ds; + init dir ds. + +END PROC close dos disk; + +PROC access dos disk: + enable stop; + IF NOT disk open + THEN error stop ("DOS-Arbeit nicht eröffnet") + FI; + IF work closed COR (last access more than 5 seconds ago CAND disk changed) + THEN open eu disk; (* hier wird der RERUN Check initialisiert *) + open dos disk; + read fat; + open dir (act path); + last access time := clock (1); + open work + FI. + +last access more than 5 seconds ago: + abs (clock (1) - last access time) > 5.0. + +disk changed: + IF hd version + THEN FALSE + ELSE last access time := clock (1); + NOT first fat block ok + FI. + +END PROC access dos disk; + +(*-------------------------------------------------------------------------*) + +REAL VAR next fetch cluster, + fetch rest; (* in Bytes *) + +PROC open fetch dos file (TEXT CONST file name): + IF log flag THEN dump ("open fetch dos file", file name) FI; + enable stop; + access dos disk; + file info (file name, next fetch cluster, fetch rest). + +END PROC open fetch dos file; + +BOOL PROC was last fetch cluster: + IF log flag THEN dump ("was last fetch cluster", "") FI; + is last fat chain entry (next fetch cluster) OR fetch rest <= 0.0. + +END PROC was last fetch cluster; + +PROC cat next fetch dos cluster (TEXT VAR buffer): + IF log flag THEN dump ("cat next fetch dos cluster", "") FI; + enable stop; + IF was last fetch cluster + THEN error stop ("fetch nach Dateiende") + FI; + IF fetch rest < real (cluster size) + THEN cat cluster text (next fetch cluster, buffer, int (fetch rest)); + fetch rest := 0.0 + ELSE cat cluster text (next fetch cluster, buffer, cluster size); + fetch rest DECR real (cluster size) + FI; + last access time := clock (1); + next fetch cluster := fat entry (next fetch cluster). + +END PROC cat next fetch dos cluster; + +PROC read next fetch dos cluster (DATASPACE VAR read ds, INT VAR start page): + IF log flag THEN dump ("read next fetch dos cluster", start page) FI; + enable stop; + IF was last fetch cluster + THEN error stop ("fetch nach Dateiende") + FI; + read disk cluster (read ds, start page, next fetch cluster); + last access time := clock (1); + start page INCR sectors per cluster; + next fetch cluster := fat entry (next fetch cluster); + IF fetch rest < real (cluster size) + THEN fetch rest := 0.0 + ELSE fetch rest DECR real (cluster size) + FI. + +END PROC read next fetch dos cluster; + +PROC close fetch dos file: + IF log flag THEN dump ("close fetch dos file", "") FI; + +END PROC close fetch dos file; + +(*-------------------------------------------------------------------------*) + +TEXT VAR save name; +REAL VAR first save cluster, + last save cluster, + save size; + +PROC open save dos file (TEXT CONST file name): + IF log flag THEN dump ("open save dos file", file name) FI; + enable stop; + access dos disk; + IF file exists (file name) OR subdir exists (file name) + THEN error stop ("die Datei """ + file name + """ gibt es schon") + FI; + save name := file name; + first save cluster := -1.0; + save size := 0.0. + +END PROC open save dos file; + +PROC write next save dos cluster (TEXT CONST buffer): + IF log flag THEN dump ("write next save dos cluster", "") FI; + enable stop; + REAL CONST save cluster := available fat entry; + write text to cluster (save cluster, buffer); + last access time := clock (1); + save size INCR real (LENGTH buffer); + IF first save cluster < 2.0 + THEN first save cluster := save cluster + ELSE fat entry (last save cluster, save cluster) + FI; + fat entry (save cluster, last fat chain entry); + last save cluster := save cluster. + +END PROC write next save dos cluster; + +PROC write next save dos cluster (DATASPACE CONST save ds, INT VAR start page): + IF log flag THEN dump ("write next save dos cluster", start page) FI; + enable stop; + REAL CONST save cluster := available fat entry; + write disk cluster (save ds, start page, save cluster); + last access time := clock (1); + start page INCR sectors per cluster; + save size INCR real (cluster size); + IF first save cluster < 2.0 + THEN first save cluster := save cluster + ELSE fat entry (last save cluster, save cluster) + FI; + fat entry (save cluster, last fat chain entry); + last save cluster := save cluster. + +END PROC write next save dos cluster; + +PROC close save dos file: + IF log flag THEN dump ("close save dos file", "") FI; + enable stop; + IF first save cluster < 2.0 + THEN LEAVE close save dos file + FI; + fat entry (last save cluster, last fat chain entry); + write fat; + insert dir entry (save name, first save cluster, save size); + last access time := clock (1). + +END PROC close save dos file; + +(*-------------------------------------------------------------------------*) + +PROC erase dos file (TEXT CONST file name): + IF log flag THEN dump ("erase dos file", file name) FI; + enable stop; + access dos disk; + REAL VAR first cluster, size; + file info (file name, first cluster, size); + delete dir entry (file name); + erase fat chain (first cluster); + write fat; + last access time := clock (1). + +END PROC erase dos file; + +(*-------------------------------------------------------------------------*) + +THESAURUS PROC all dosfiles: + IF log flag THEN dump ("all dosfile", "") FI; + enable stop; + access dos disk; + all files. + +END PROC all dosfiles; + +THESAURUS PROC all dossubdirs: + IF log flag THEN dump ("all subdirs", "") FI; + enable stop; + access dos disk; + all subdirs. + +END PROC all dossubdirs; + +BOOL PROC dos file exists (TEXT CONST file name): + IF log flag THEN dump ("dos file exists", file name) FI; + enable stop; + access dos disk; + file exists (file name). + +END PROC dos file exists; + +PROC dos list (DATASPACE VAR list ds): + IF log flag THEN dump ("dos list", "") FI; + enable stop; + access dos disk; + dir list (list ds). + +END PROC dos list; + +(*-------------------------------------------------------------------------*) + +PROC clear dos disk: + IF log flag THEN dump ("clear dos disk", "") FI; + enable stop; + IF hd version + THEN error stop ("nicht implementiert") + ELSE access dos disk; + format dir; + format fat; + last access time := clock (1) + FI. + +END PROC clear dos disk; + +PROC format dos disk (INT CONST format code): + + IF log flag THEN dump ("format dos disk (" + text (format code) + ")", "") FI; + enable stop; + IF NOT disk open + THEN error stop ("DOS-Arbeit nicht eröffnet") + FI; + IF hd version + THEN error stop ("nicht implementiert") + ELSE do format + FI. + +do format: + IF bpb exists (format code) + THEN close work; + format archive (format code); + open eu disk; + write bpb (format code); + open dos disk; + format dir; (* enthält 'open dir' *) + format fat; (* enthält 'read fat' *) + open work + ELSE error stop ("Format unzulässig") + FI; + last access time := clock (1). + +END PROC format dos disk; + +END PACKET dos get put; + diff --git a/system/dos/1.8.7/src/insert.dos b/system/dos/1.8.7/src/insert.dos new file mode 100644 index 0000000..14f98cd --- /dev/null +++ b/system/dos/1.8.7/src/insert.dos @@ -0,0 +1,14 @@ +dump +konvert +open +eu disk descriptor +disk descriptor.dos +block i/o +name conversion.dos +fat.dos +dir.dos +get put interface.dos +fetch save interface +fetch +save + diff --git a/system/dos/1.8.7/src/konvert b/system/dos/1.8.7/src/konvert new file mode 100644 index 0000000..c5c4c43 --- /dev/null +++ b/system/dos/1.8.7/src/konvert @@ -0,0 +1,75 @@ +PACKET konvert DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 28.10.86 *) + high byte, + low byte, + word, + change low byte, + change high byte, + dint, + high word, + low word: + +INT PROC high byte (INT CONST value): + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 2) + +END PROC high byte; + +INT PROC low byte (INT CONST value): + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 1) + +END PROC low byte; + +INT PROC word (INT CONST low byte, high byte): + TEXT CONST x :: code (low byte) + code (high byte); + x ISUB 1 + +END PROC word; + +PROC change low byte (INT VAR word, INT CONST low byte): + TEXT VAR x := " "; + replace (x, 1, word); + replace (x, 1, code (low byte)); + word := x ISUB 1 + +END PROC change low byte; + +PROC change high byte (INT VAR word, INT CONST high byte): + TEXT VAR x := " "; + replace (x, 1, word); + replace (x, 2, code (high byte)); + word := x ISUB 1 + +END PROC change high byte; + +REAL PROC dint (INT CONST low word, high word): + real low word + 65536.0 * real high word. + +real low word: + real (low byte (low word)) + 256.0 * real (high byte (low word)). + +real high word: + real (low byte (high word)) + 256.0 * real (high byte (high word)). + +END PROC dint; + +INT PROC high word (REAL CONST double precission int): + int (double precission int / 65536.0) + +END PROC high word; + +INT PROC low word (REAL CONST double precission int): + string of low bytes ISUB 1. + +string of low bytes: + code (int (double precission int MOD 256.0)) + + code (int ((double precission int MOD 65536.0) / 256.0)). + +END PROC low word; + +END PACKET konvert; + diff --git a/system/dos/1.8.7/src/manager-M.dos b/system/dos/1.8.7/src/manager-M.dos new file mode 100644 index 0000000..e27c513 --- /dev/null +++ b/system/dos/1.8.7/src/manager-M.dos @@ -0,0 +1,211 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + provide channel, (* 16.10.87 *) + dos manager: + +LET std archive channel = 31, + + ack = 0, + second phase ack = 5, + false code = 6, + + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + clear code = 18, + reserve code = 19, + free code = 20, + check read code = 22, + format code = 23, + + log code = 78, + + quote = """"; + +BOUND STRUCT (TEXT name, pass) VAR msg; + +TASK VAR order task; + +INT VAR dos channel; + +INT VAR fetch save modus; + +REAL VAR last access time := 0.0; + +TASK VAR disk owner := niltask; + +TEXT VAR save file name; + +PROC provide channel (INT CONST channel): + dos channel := channel + +END PROC provide channel; + +IF hd version + THEN provide channel (29) + ELSE provide channel (std archive channel) +FI; + +PROC dos manager: + dos manager (dos channel) + +END PROC dos manager; + +PROC dos manager (INT CONST channel): + dos channel := channel; + task password ("-"); + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) + +END PROC dos manager; + +PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase, + TASK CONST from task): + enable stop; + order task := from task; + msg := ds; + IF NOT (order task = disk owner) AND + order code <> free code AND order code <> reserve code + THEN errorstop ("DOS nicht angemeldet") + FI; + IF order task = disk owner + THEN last access time := clock (1) + FI; + SELECT order code OF + CASE fetch code : fetch file + CASE save code : save file + CASE erase code : erase file + CASE clear code : clear disk + CASE exists code : exists file + CASE list code : list disk + CASE all code : deliver directory + CASE reserve code : reserve + CASE free code : free + CASE check read code: check + CASE format code : format + CASE log code : send log + OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself)) + END SELECT. + +fetch file: + fetch (dos name (msg.name, read modus), ds, fetch save modus); + manager ok (ds). + +check: + check file (dos name (msg.name, read modus)); + manager message (expanded name (msg.name, read modus) + " ohne Fehler gelesen"). + +format: + IF phase = 1 + THEN manager question ("Diskette formatieren") + ELSE format dos disk (int (msg.name)); + manager ok (ds) + FI. + +save file: + IF phase = 1 + THEN save first phase + ELSE save second phase + FI. + +save first phase: + save file name := dos name (msg.name, write modus); + IF dos file exists (save file name) + THEN manager question (expanded name (msg.name, write modus) + " auf der MS-DOS Disk ueberschreiben") + ELSE send (order task, second phase ack, ds) + FI. + +save second phase: + IF dos file exists (save file name) + THEN erase dos file (save file name) + FI; + save (save file name, ds, fetch save modus); + forget (ds) ; + ds := nilspace ; + manager ok (ds). + +clear disk: + IF phase = 1 + THEN manager question ("Diskette loeschen") + ELSE clear dos disk; + manager ok (ds) + FI. + +erase file: + IF dos file exists (dos name (msg.name, read modus)) + THEN IF phase = 1 + THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen") + ELSE erase dos file (dos name (msg.name, read modus)); + manager ok (ds) + FI + ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk") + FI. + +exists file: + IF dos file exists (dos name (msg.name, read modus)) + THEN manager ok (ds) + ELSE send (order task, false code, ds) + FI. + +list disk: + dos list (ds); + manager ok (ds). + +send log: + forget (ds); + ds := old ("logbuch"); + manager ok (ds). + +deliver directory: + forget (ds); + ds := nilspace; + BOUND THESAURUS VAR all names := ds; + all names := all dos files; + manager ok (ds). + +reserve: + IF reserve or free permitted + THEN continue channel (dos channel); + disk owner := from task; + fetch save modus := save fetch mode (msg.name); + open dos disk (path (msg.name)); + forget ("logbuch", quiet); + manager ok (ds) + ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt") + FI. + +reserve or free permitted : + from task = disk owner OR last access more than five minutes ago + OR disk owner = niltask OR NOT + (exists (disk owner) OR station(disk owner) <> station (myself)). + +last access more than five minutes ago : + abs (last access time - clock (1)) > 300.0. + +free: + IF reserve or free permitted + THEN close dos disk; + disk owner := niltask; + break (quiet); + manager ok (ds) + ELSE manager message ("DOS nicht angemeldet") + FI. + +END PROC dos manager; + +PROC manager ok (DATASPACE VAR ds): + send (order task, ack, ds); + last access time := clock (1). + +END PROC manager ok; + +TEXT PROC expanded name (TEXT CONST name, BOOL CONST status): + text (quote + dos name (name, status) + quote, 14) + +END PROC expanded name; + +END PACKET dos manager multi; + diff --git a/system/dos/1.8.7/src/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos new file mode 100644 index 0000000..23885e6 --- /dev/null +++ b/system/dos/1.8.7/src/manager-S.dos @@ -0,0 +1,268 @@ +PACKET dos single DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 11.09.87 *) + /, + dos, + provide dos channel, + archive, + reserve, + release, + save, + fetch, + erase, + check, + exists, + ALL, + SOME, + clear, + list, + format: + +LET std archive channel = 31, + main channel = 1; + +INT VAR dos channel := std archive channel; +INT VAR fetch save modus; + +TYPE DOSTASK = TEXT; + +DOSTASK CONST dos := "DOS"; + +OP := (DOSTASK VAR d, TEXT CONST t): + CONCR (d) := t + +END OP :=; + +DOSTASK OP / (TEXT CONST text): + DOSTASK VAR d; + CONCR (d) := text; + d + +END OP /; + +BOOL PROC is dostask (DOSTASK CONST d): + CONCR (d) = "DOS" + +END PROC is dos task; + +PROC provide dos channel (INT CONST channel no): + dos channel := channel no + +END PROC provide dos channel; + +DATASPACE VAR space := nilspace; +forget (space); + +PROC reserve (TEXT CONST string, DOSTASK CONST task): + IF is dostask (task) + THEN fetch save modus := save fetch mode (string); + open dos disk (path (string)) + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC reserve; + +PROC archive (TEXT CONST string, DOSTASK CONST task): + reserve (string, task) + +END PROC archive; + +PROC release (DOSTASK CONST task): + IF is dos task (task) + THEN close dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC release; + +PROC fetch (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN fetch from dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +fetch from dos disk: + IF NOT exists (name) COR overwrite permitted + THEN do fetch + FI. + +overwrite permitted: + say ("eigene Datei """) ; + say (name) ; + yes (""" auf der Diskette ueberschreiben"). + +do fetch: + last param (name); + disable stop; + continue (dos channel); + fetch (dos name (name, read modus), space, fetch save modus); + continue (main channel); + IF NOT is error + THEN forget (name, quiet); + copy (space, name) + FI; + forget (space). + +END PROC fetch; + +PROC erase (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN do erase dos file + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +do erase dos file: + IF NOT exists (name, /"DOS") + THEN error stop ("die Datei """ + name + """ gibt es nicht") + ELIF yes ("""" + dos name (name, read modus)+ """ auf Der Diskette loeschen") + THEN disable stop; + continue (dos channel); + erase dos file (dos name (name, read modus)); + continue (main channel) + FI. + +END PROC erase; + +PROC save (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN save to dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +save to dos disk: + TEXT CONST save file name :: dos name (name, write modus); + disable stop; + continue (dos channel); + IF NOT dos file exists (save file name) COR overwrite permitted + THEN IF dos file exists (save file name) + THEN erase dos file (save file name) + FI; + save (save file name, old (name), fetch save modus); + FI; + continue (main channel). + +overwrite permitted: + continue (main channel); + BOOL CONST result :: yes ("""" + save file name + """ auf der Diskette ueberschreiben"); + continue (dos channel); + result. + +END PROC save; + +PROC check (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN disable stop; + continue (dos channel); + check file (dos name (name, read modus)); + continue (main channel) + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC check; + +BOOL PROC exists (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + BOOL VAR dummy := dos file exists (dos name (name, read modus)); + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); FALSE + FI. + +END PROC exists; + +PROC list (DOSTASK CONST from): + forget (space); + space := nilspace; + FILE VAR list file := sequential file (output, space); + list (list file, from); + modify (list file); + show (list file); + forget (space). + +ENDPROC list; + +PROC list (FILE VAR list file, DOSTASK CONST from): + IF is dos task (from) + THEN list dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +list dos disk: + disable stop; + continue (dos channel); + dos list (space); + continue (main channel); + enable stop; + output (list file); + FILE VAR list source := sequential file (output, space); + TEXT VAR line; + WHILE NOT eof (list source) REP + getline (list source, line); + putline (list file, line) + PER. + +END PROC list; + +THESAURUS OP ALL (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP ALL; + +THESAURUS OP SOME (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + SOME dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP SOME; + +PROC clear (DOSTASK CONST task): + IF is dos task (task) + THEN clear disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +clear disk: + disable stop; + IF yes ("Diskette loeschen") + THEN continue (dos channel); + clear dos disk; + continue (main channel) + FI. + +END PROC clear; + +PROC format (INT CONST format code, DOSTASK CONST task): + IF is dos task (task) + THEN format disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +format disk: + disable stop; + IF yes ("Diskette formatieren") + THEN continue (dos channel); + format dos disk (format code); + continue (main channel) + FI. + +END PROC format; + +END PACKET dos single; + diff --git a/system/dos/1.8.7/src/name conversion.dos b/system/dos/1.8.7/src/name conversion.dos new file mode 100644 index 0000000..e72d838 --- /dev/null +++ b/system/dos/1.8.7/src/name conversion.dos @@ -0,0 +1,77 @@ +PACKET name conversion DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + dos name, (* 31.12.86 *) + + read modus, + write modus: + +BOOL CONST read modus :: TRUE, + write modus :: NOT read modus; + +LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_", + lower case chars = "abcdefghijklmnopqrstuvwxyz"; + +TEXT PROC dos name (TEXT CONST eu name, BOOL CONST read write modus): + enable stop; + INT CONST point pos :: pos (eu name, "."); + IF name extension exists + THEN changed name with extension + ELSE changed name without extension + FI. + +name extension exists: + point pos > 0. + +changed name with extension: + TEXT CONST name pre :: compress (subtext (eu name, 1, point pos - 1)), + name post :: compress (subtext (eu name, point pos + 1)); + IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3 + THEN error + FI; + IF LENGTH name post = 0 + THEN new name (name pre, read write modus) + ELSE new name (name pre, read write modus) + "." + + new name (name post, read write modus) + FI. + +changed name without extension: + IF LENGTH eu name > 8 OR LENGTH euname < 1 + THEN error + FI; + new name (eu name, read write modus). + +error: + error stop ("Unzulässiger Name"). + +END PROC dos name; + +TEXT PROC new name (TEXT CONST old name, BOOL CONST read write modus): + TEXT VAR new := ""; + INT VAR count; + FOR count FROM 1 UPTO LENGTH old name REP + convert char + PER; + new. + +convert char: + TEXT CONST char :: old name SUB count; + IF is lower case char + THEN new CAT (upper case chars SUB string pos) + ELIF is upper case char OR read write modus + THEN new CAT char + ELSE error stop ("Unzulässiger Name") + FI. + +is lower case char: + pos (lower case chars, char) > 0. + +is upper case char: + pos (upper case chars, char) > 0. + +string pos: + pos (lower case chars, char). + +END PROC new name; + +END PACKET name conversion; + diff --git a/system/dos/1.8.7/src/open b/system/dos/1.8.7/src/open new file mode 100644 index 0000000..518c4b8 --- /dev/null +++ b/system/dos/1.8.7/src/open @@ -0,0 +1,66 @@ +PACKET open DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + open work, (* 05.01.87 *) + close work, + work opened, + work closed, + init check rerun, + check rerun, + + hd version: + +BOOL VAR open; +INT VAR old session; + +BOOL VAR hd flag := FALSE; + +INITFLAG VAR packet := FALSE; + +PROC open work: + open := TRUE + +END PROC open work; + +PROC close work: + open := FALSE + +END PROC close work; + +BOOL PROC work opened: + IF NOT initialized (packet) + THEN close work + FI; + open + +END PROC work opened; + +BOOL PROC work closed: + NOT work opened + +END PROC work closed; + +PROC init check rerun: + old session := session + +END PROC init check rerun; + +PROC check rerun: + IF session <> old session + THEN close work; + error stop ("Diskettenzugriff im RERUN") + FI. + +END PROC check rerun; + +PROC hd version (BOOL CONST status): + hd flag := status + +END PROC hd version; + +BOOL PROC hd version: + hd flag + +END PROC hd version; + +END PACKET open; + diff --git a/system/dos/1.8.7/src/save b/system/dos/1.8.7/src/save new file mode 100644 index 0000000..7e67e91 --- /dev/null +++ b/system/dos/1.8.7/src/save @@ -0,0 +1,233 @@ +PACKET save DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 27.04.87 *) + save: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + atari st = 10, + ibm = 11, + + ff = ""12"", + ctrl z = ""26"", + cr lf = ""13""10"", + + row text mode length = 4000; + +TEXT VAR buffer; + +BOUND STRUCT (INT size, + ROW row text mode length TEXT cluster row) VAR cluster struct; + +PROC save (TEXT CONST file name, DATASPACE CONST file ds, INT CONST mode): + + SELECT mode OF + CASE ascii, ascii german, atari st, ibm, transparent: + save filemode (file ds, filename, mode) + CASE row text : save row textmode (file ds, filename) + CASE ds : save dsmode (file ds, filename) + OTHERWISE error stop ("Unzulässige Betriebsart") + END SELECT. + +END PROC save; + +PROC save filemode (DATASPACE CONST file space, TEXT CONST name, INT CONST code type): + + enable stop; + open save dos file (name); + FILE VAR file := sequential file (modify, file space); + buffer := ""; + INT VAR line no; + FOR line no FROM 1 UPTO lines (file) REP + to line (file, line no); + buffer cat file line; + WHILE length (buffer) >= cluster size REP + write next save dos cluster (subtext (buffer, 1, cluster size)); + buffer := subtext (buffer, cluster size + 1) + PER + PER; + IF ascii code + THEN buffer CAT ctrl z + FI; + write rest; + close save dos file; + buffer := "". + +buffer cat file line: + exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type). + +ascii code: + (code type = ascii) OR (code type = ascii german). + +write rest: + WHILE buffer <> "" + REP write next save dos cluster (subtext (buffer, 1, cluster size)); + buffer := subtext (buffer, cluster size + 1) + PER. + +END PROC save filemode; + +PROC cat adapted line (TEXT VAR line, INT CONST code type): + + IF code type = transparent + THEN buffer CAT line + ELSE change esc sequences; + change eumel print chars; + SELECT code type OF + CASE ascii : ascii change + CASE ascii german: ascii german change + CASE atari st : atari st change + CASE ibm : ibm change + END SELECT; + buffer CAT line; + IF (line SUB length (line)) <> ff + THEN buffer CAT cr lf + FI + FI. + +change esc sequences: + change all (line, "#page#", ff); + INT VAR p := pos (line, "#"); + WHILE p > 0 REP + IF is esc sequence + THEN change (line, p, p+4, coded char) + FI; + p := pos (line, "#", p+1) + PER. + +is esc sequence: + LET digits = "0123456789"; + (line SUB (p+4)) = "#" CAND pos (digits, line SUB p+1) > 0 CAND + pos (digits, line SUB p+2) > 0 CAND pos (digits, line SUB p+3) > 0. + +coded char: + code (int (subtext (line, p+1, p+3))). + +change eumel print chars: + p := pos (line, ""220"", ""223"", 1); + WHILE p > 0 REP + replace (line, p, std char); + p := pos (line, ""220"", ""223"", p + 1) + PER. + +std char: + "k-# " SUB (code (line SUB p) - 219). + +ascii change: + change all (line, "ß", "#251#"); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + change (line, p, p, ersatzdarstellung (line SUB p)); + p := pos (line, "Ä", "ü", p + 1) + PER. + +ascii german change: + change all (line, "[", "#091#"); + change all (line, "\", "#092#"); + change all (line, "]", "#093#"); + change all (line, "{", "#123#"); + change all (line, "|", "#124#"); + change all (line, "}", "#125#"); + change all (line, "~", "#126#"); + change all (line, "ß", ""126""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ascii german); + p := pos (line, "Ä", "ü", p + 1) + PER. + +umlaut in ascii german: + "[\]{|}" SUB (code (line SUB p) - 213). + +ibm change: + change all (line, "ß", ""225""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ibm); + p := pos (line, "Ä", "ü", p + 1) + PER. + +atari st change: + change all (line, "ß", ""158""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ibm); + p := pos (line, "Ä", "ü", p + 1) + PER. + +umlaut in ibm: + ""142""153""154""132""148""129"" SUB (code (line SUB p) - 213). + +END PROC cat adapted line; + +TEXT PROC ersatzdarstellung (TEXT CONST char): + + TEXT CONST t :: text (code (char SUB 1)); + "#" + (3 - length (t)) * "0" + t + "#" + +END PROC ersatzdarstellung; + +PROC save rowtextmode (DATASPACE CONST space, TEXT CONST name): + + enable stop; + open save dos file (name); + init save row textmode; + WHILE line no < cluster struct.size REP + fill buffer; + write next save dos cluster (subtext (buffer, 1, cluster size)); + remember rest + PER; + write rest; + close save dos file; + buffer := "". + +init save rowtextmode: + cluster struct := space; + buffer := ""; + INT VAR line no := 0. + +fill buffer: + WHILE line no < cluster struct.size AND NOT buffer full REP + line no INCR 1; + buffer CAT cluster struct.cluster row [line no] + PER. + +buffer full: + LENGTH buffer >= cluster size. + +remember rest: + buffer := subtext (buffer, cluster size + 1). + +write rest: + WHILE buffer <> "" + REP write next save dos cluster (subtext (buffer, 1, cluster size)); + remember rest + PER. + +END PROC save rowtextmode; + +PROC save ds mode (DATASPACE CONST out ds, TEXT CONST name): + + enable stop; + open save dos file (name); + INT VAR page no := first non dummy ds page; + get last allocated ds page; + WHILE page no <= last allocated ds page REP + write next save dos cluster (out ds, page no); + PER; + close save dos file. + +get last allocated ds page: + INT VAR last allocated ds page := -1, + i; + FOR i FROM 1 UPTO ds pages (out ds) REP + last allocated ds page := next ds page (out ds, last allocated ds page) + PER. + +END PROC save ds mode; + +END PACKET save; + diff --git a/system/dos/1.8.7/src/shard interface b/system/dos/1.8.7/src/shard interface new file mode 100644 index 0000000..20d9b76 --- /dev/null +++ b/system/dos/1.8.7/src/shard interface @@ -0,0 +1,20 @@ +; ';' in Spalte 1 kennzeichnet eine Kommentarzeile +; alle Werte müssen durch Blanks getrennt werden +; +;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen +; negativ für seitenorientiertes Lesen +; +;size heads tracks first sectors last sector +;===================================================== +320 1 40 1 8 +360 1 40 1 9 +640 -2 40 1 8 +720 -2 40 1 9 +800 2 40 1 10 +1440 -2 80 1 9 +1600 2 80 1 10 +2400 -2 80 1 15 +1232 1 77 0 15 +2464 -2 77 0 15 +; END OF FILE + diff --git a/system/dos/1986/doc/DSKDOS.ELA b/system/dos/1986/doc/DSKDOS.ELA new file mode 100644 index 0000000..69bc714 --- /dev/null +++ b/system/dos/1986/doc/DSKDOS.ELA @@ -0,0 +1,967 @@ +#type ("17.klein")#
+prefix of extended fcb:
+
+ offset size name
+ -7 1 flag byte 255
+ -6 5 reserved
+ -1 1 attribute byte 2=hidden file, 4=system file
+
+normal fcb format:
+
+ offset size name
+ 0 1 drive number 0=default (for open), 1=A, 2=B
+ 1 8 filename 8 chars, left aligned and padded
+ (if necessary) with blanks
+ 9 3 extension 3 chars, left aligned and padded
+ (if necessary) with blanks
+ 12 2 current block pointer to the block of 128 records
+ containing the current record
+ (0 after open)
+ 14 2 record size logical record size in bytes
+ (128 after open, changed eventually)
+ 16 4 file size file size in bytes (1. byte low)
+ 20 2 date of last write 20:mmmddddd 21:yyyyyyym
+ 22 2 time of last write 22:mmmsssss 23:hhhhhmmm
+ 24 8 reserved
+ 32 1 current record pointer to one of the 128 records in
+ the block (not initialized by open)
+ must be set before sequential read/write
+ 33 4 relative record pointer to selected record
+ (counting from the beginning of file by 0)
+ not initialized by open
+ must be set before sequential read/write
+ record size less than
+ 64 bytes: both words used
+ else only first 3 bytes
+
+fields of directory entry:
+
+ offset size name
+ 0 8 filename 8 chars, left aligned and padded
+ (if necessary) with blanks
+ special use of first byte:
+ 0 : end of allocated directory
+ 229: free directory entry
+ 8 3 extension 3 chars, left aligned and padded
+ (if necessary) with blanks
+ 11 1 attributes 1: read only file
+ 2: hidden file
+ 4: system file
+ 8: entry is the volume's id
+ 16: entry is subdirectory's name
+ 32: archive bit (set, when written to)
+ 12 10 reserved
+ 22 2 time of last write 22:mmmsssss 23:hhhhhmmm
+ 24 2 date of last write 24:mmmddddd 25:yyyyyyym
+ 26 2 reserved
+ 28 4 file size file size in bytes (1. byte low)
+
+directory structure:
+
+ - the root directory has a fixed number of entries
+ - entries that represent a subdirectory have a special attribute in their
+ entry set
+ - the subdirectories are themselves files which records are of the same type
+ as those in the root directory
+ - the number of entries in subdirectories are not limited
+ - the length of a path to a subdirectory is not limited
+
+application of the directory entry fields on subdirectory entries:
+
+ volume id : present at root, only one entry has this attribute
+ directory : the directory entry represents itself an directory
+ read only : meaningless
+ archive : meaningless
+ hidden/system: prevents directories from beeing found, function $3B
+ will still work
+
+ms-dos interrupts:
+
+ $20 : program terminate
+ call:
+ CS: segment address
+ terminates process, returns control to parent process,
+ file handles are closed, disk cache cleaned, file buffers flushed
+ programm terminate, alt-c and critical error addresses are restored
+ new programs should use function $4C
+ $21 : function request
+ call:
+ AH: function number
+ other registers dependent on function
+ $22 to $24 :
+ address locations for msdos use
+ can be changed by function $25
+ $22 : terminate address
+ $23 : alt-c exit address
+ address of an alt-c routine
+ $24 : fatal error abort address
+ address of the error handler
+ BP:SI can contain further information
+ not called if error occurs during absolute disk operations (int $25,$26)
+ $25 : absolute disk read
+ call:
+ AL: drive number
+ DS:BX: disk transfer address
+ CX: number of sectors
+ DX: beginning relative sector
+ return:
+ CF: 0=successful
+ 1=unsuccessful
+ AL: error code if unsuccessful
+ $26 : absolute disk write
+ call:
+ AL: drive number
+ DS:BX: disk transfer address
+ CX: number of sectors
+ DX: beginning relative sector
+ return:
+ CF: 0=successful
+ 1=unsuccessful
+ AL: error code if unsuccessful
+ $27 : terminate but stay resident
+ call:
+ CS:DX: first byte following the code
+ new programms should use function $31
+
+ms-dos function requests:
+
+ $00 : terminate program
+ call:
+ AH: $00
+ CS: segment of programm prefix
+ $01 : read keyboard and echo
+ call:
+ AH: $01
+ return:
+ AL: character typed
+ waits for input, echos and returns it
+ alt-c will call interrupt
+ $02 : display character
+ call:
+ AH: $02
+ DL: character to be displayed
+ alt-c will call interrupt
+ $03 : auxiliary input
+ call:
+ AH: $03
+ return:
+ AL: character from auxiliary device
+ waits for input, alt-c will call interrupt
+ $04 : auxiliary output
+ call:
+ AH: $04
+ DL: character to output
+ alt-c will call interrupt
+ $05 : print character
+ call:
+ AH: $05
+ DL: character for printer
+ alt-c will call interrupt
+ $06 : direct console i/o
+ call:
+ AH: $06
+ DL: $FF: check for keyboard input
+ otherwise: display DL on screen
+ return:
+ ZF: 0=no char available
+ 1=char was read
+ AL: char if read
+ $07 : direct konsole input
+ call:
+ AH: $07
+ return:
+ AL: character from keyboard
+ waits for character
+ $08 : read keyboard
+ call:
+ AH: $08
+ return:
+ AL: character from keyboard
+ waits for character, alt-c will call interrupt
+ $09 : display string
+ call:
+ AH: $09
+ DS:DX: string, ending with '$'
+ $0A : buffered keyboard input
+ call:
+ AH: $0A
+ DS:DX: input buffer
+ byte 1: maximum number of chars in buffer (with CR)
+ 2: actual number of chars in buffer (set by function)
+ 3-n: must be at least as long as the max
+ waits for chars, allows editing, ignores overflow,
+ alt-c will call interrupt
+ $0B : check keyboard status
+ call:
+ AH: $0B
+ return:
+ AL: 0=no chars in type-ahead buffer
+ 255=chars available
+ $0C : flush buffer and read keyboard
+ call:
+ AH: $0C
+ AL: $01,$06,$07,$08 or $0A: corresponding function is called
+ other values: no further processing
+ return:
+ AL: 0=type ahead buffer was flushed, no processing performed
+ $0D : disk reset
+ call:
+ AH: $0D
+ all disk buffers are flushed, no directory updates performed
+ $0E : select disk
+ call:
+ AH: $0E
+ DL: drive number, 1=A, 2=B, ..
+ return:
+ AL: number of logical drives
+ $0F : open file
+ call:
+ AH: $0F
+ DS:DX: unopened fcb
+ return:
+ AL: 0=directory entry found
+ if drive code was 0, it is set to the default
+ current block is set to 0
+ record size is set to 128
+ file size, time and date of last modification are set
+ from directory
+ the default record size must be set, if not 128
+ before performing a sequential (random) operation,
+ current record (relative record) field must be set
+ 255=no directory entry found
+
+ $10 : close file
+ call:
+ AH: $10
+ DS:DX: opened fcb
+ return:
+ AL: 0=directory entry found
+ 255=no directory entry found
+ $11 : search for first entry
+ call:
+ AH: $11
+ DS:DX: unopened fcb
+ return:
+ 0=directory entry found
+ fcb (normal or extended) is created
+ at the disk transfer address
+ 255=no directory entry found
+ to search for hidden or system files, the fcb must be extended
+ see notes on search attributes
+ $12 : search for next entry
+ call:
+ AH: $12
+ DS:DX: unopened fcb
+ return:
+ AL: 0=directory entry found
+ fcb (normal or extended) is created
+ at the disk transfer address
+ 255=no directory entry found
+ the fcb must be one used previously in a call to $11
+ $13 : delete file
+ call:
+ AH: $13
+ DS:DX: unopened fcb
+ return:
+ AL: 0=directory entry found
+ 255=no directory entry found
+ deletes all files with matching names
+ $14 : sequential read
+ call:
+ AH: $14
+ DS:DX: opened fcb
+ return:
+ AL: 0=read completed successfully
+ 1=eof, no data in the record
+ 2=dta too small, not enough space to read without exceeding
+ the segment boundaries, read cancelled
+ 3=eof, partial record was read and padded to the record
+ length with zeros
+ the record pointed to by the current block and current record
+ is loaded to the disk transfer address and the fields are incremented
+ $15 : sequential write
+ call:
+ AH: $15
+ DS:DX: opened fcb
+ return:
+ AL: 0=write completed successfully
+ 1=disk full, write canceled
+ 2=dta too small to write one record without exceeding the
+ segment boundaries, write canceled
+ the record pointed to by the current block and current record
+ are written from the disk transfer address and the fields are incremented
+ $16 : create file
+ call:
+ AH: $16
+ DS:DX: unopened fcb
+ return:
+ AL: 0=empty directory entry found
+ 255=no empty entry available and file didn't exist before
+ if the file does already exist, it is made a zero length file
+ else it is created if an empty entry is found
+ $17 : rename file
+ call:
+ AH: $17
+ DS:DX: modified fcb
+ return:
+ AL: 0=directory entry found
+ 255=no directory entry found or destination already exists
+ the fcb must contain the search file name and another file name
+ at offset $11
+ $19 : current disk
+ call:
+ AH: $19
+ return:
+ AL: selected drive (0=A, 1=B, .. )
+ $1A : set disk transfer address
+ call:
+ AH: $1A
+ DS:DX: disk transfer address
+ default is $80 in the psp
+ $21 : random read
+ call:
+ AH: $21
+ DS:DX: opened fcb
+ return:
+ 0=read completed successfully
+ 1=eof, no data read
+ 2=dta too small, read canceled
+ 3=eof, partial record, padded with zeros
+ the current block and current record fields are set to match the
+ relative record field, then the record is loaded
+ $22 : random write
+ call:
+ AH: $22
+ DS:DX: opened fcb
+ return:
+ AL: 0=write completed successfully
+ 1=disk full
+ 2=dta too small, read canceled
+ $23 : file size
+ call:
+ AH: $23
+ DS:DX: unopened fcb
+ return:
+ AL: 0=directory entry found
+ the relative record field is set to the number
+ of records in the file
+ 255=no directory entry found
+ the record size field must be set
+ $24 : set relative record
+ call:
+ AH: $24
+ DS:DX: opened fcb
+ the relative record field is set to the same record as the current block
+ an the current record field
+ $25 : set vector
+ call:
+ AH: $25
+ AL: interrupt number
+ DS:DX: interrupt handling routine
+ $27 : random block read
+ call:
+ AH: $27
+ DS:DX: opened fcb
+ CX: number of blocks to read
+ return:
+ AL: 0=read completed successfully
+ 1=eof, no data read
+ 2=end of segment, read canceled
+ 3=eof, partial record, padded with zeros
+ CX: number of blocks read
+ the reading starts at the relative record
+ the current block, current record and relative record field are updated
+ $28 : random block write
+ call:
+ AH: $28
+ DS:DX: opened fcb
+ CX: number of records to write
+ 0=set file size
+ the file size field of thedirectory entry is set to the number
+ of records specified by the relative record field
+ return:
+ AL: 0=write completed successfully
+ 1=disk full, no records written
+ 2=end of dta-segment, read canceled
+ CX: number of blocks written
+ the writing starts at the relative record
+ the current block, current record and relative record field are updated
+ $29 : parse file name
+ call:
+ AH: $29
+ AL: controls parsing
+ bit 0: if file separators are encountered
+ (: . ; , = + / " [ ] \ < ] | blank tab)
+ 0: all parsing stops
+ 1: leading separators are ignored
+ bit 1: if the string does not contain a drive letter
+ 0: the fcb drive number is set to 0 (default)
+ 1: the fcb drive number is not changed
+ bit 2: if the string does not contain a filename
+ 0: the fcb filename is set to 8 blanks
+ 1: the fcb filename is not changed
+ bit 3: if the string does not contain an extension
+ 0: the fcb extension is set to three blanks
+ 1: the fcb extension is not changed
+ DS:SI: string to parse
+ filename terminators include all filename separators
+ plus any control character
+ ES:DI: if the string contained a valid filename,
+ it points to an unopened fcb
+ else ES:DI+1 points to a blank
+ return:
+ AL: 0=no wild card characters
+ 1=wild card characters used
+ 255=drive letter invalid
+ DS:SI: first byte past string that was parsed
+ if the filename contains an asterisk,
+ all folowing letters are set to question mark
+ ES:DI: unopened fcb
+ if filename is found, an unopened fcb is created here
+ $2A : get date
+ call:
+ AH: $2A
+ return:
+ CX: year (1980-2099)
+ DH: month (1-12)
+ DL: day (1-31)
+ AL: day of week (0=sun, .., 6=sat)
+ $2B : set date
+ call:
+ AH: $2B
+ CX: year (1980-2099)
+ DH: month (1-12)
+ DL: day (1-31)
+ return:
+ AL: 0=date was valid
+ 255=date was invalid
+ $2C : get time
+ call:
+ AH: $2C
+ return:
+ CH: hour (0-23)
+ CL: minutes (0-59)
+ DH: seconds (0-59)
+ DL: hundredths (0-99)
+ $2D : set time
+ call:
+ AH: $2D
+ CH: hour (0-23)
+ CL: minutes (0-59)
+ DH: seconds (0-59)
+ DL: hundredths (0-99)
+ return:
+ AL: 0=time was valid
+ 255=time was invalid
+ $2E : set/reset verify flag
+ call:
+ AH: $2E
+ AL: 0=do not verify
+ 1=verify
+ $2F : get disk transfer address
+ call:
+ AH: $2F
+ return:
+ ES:BX: points to disk transfer address
+ $30 : get dos version number
+ call:
+ AH: $30
+ return:
+ AL: major version number
+ AH: minor version number
+ $31 : keep process
+ call:
+ AH: $31
+ AL: exit code
+ DX: memory size in paragraphs
+ attemts to set the initial allocation block to a specific size
+ in paragraphs, will not free up other allocation blocks belonging
+ to that process, the exit code is available via function $4D
+ $33 : alt-c check
+ call:
+ AH: $33
+ AL: function
+ 0=request current state
+ 1=set state
+ DL: if setting
+ 0=off
+ 1=on
+ return:
+ AL: 255=al parameter was not in range 0..1
+ DL: if requesting current state
+ 0=off
+ 1=on
+ if check is on, every system call executes the check,
+ else only the device operations
+ $35 : get interrupt vector
+ call:
+ AH: $35
+ AL: interrupt number
+ return:
+ ES:BX: pointer to interrupt routine
+ $36 : get disk free space
+ call:
+ AH: $36
+ DL: drive (0=default, .....)
+ return:
+ BX: available clusters
+ DX: clusters per drive
+ CX: bytes per sector
+ AX: $FFFF=drive number invalid
+ otherwise sectors per cluster
+ $38 : return country-dependent information
+ call:
+ AH: $38
+ DS:DX: pointer to 32 byte memory area
+ area format:
+ size name
+ 2 date/time format
+ 0=usa standard h:m:s m/d/y
+ 1=europe standard h:m:s d/m/y
+ 2=japan standard y/m/d h:m:s
+ 5 asciz currency symbol
+ 2 asciz thousands separator
+ 2 asciz decimal separator
+ 2 asciz date separator
+ 2 asciz time separator
+ 1 bit field
+ bit 0: 0=currency symbol precedes amount
+ 1=symbol comes after amount
+ bit 1: 0=symbol immediately precedes the amount
+ 1=space between symbol and amount
+ 1 currency places
+ figures after decimal point of currency amounts
+ 1 time format
+ 0=12 hour time
+ 1=24 hour time
+ 4 case mapping call
+ FAR procedure performs country-specific
+ lower- to uppercase mapping
+ 2 asciz data list separator
+ if dx=-1 and the country code in AL is found,
+ the current country is set accordingly
+
+ AL: function code
+ 0=current country
+ or country code (usually international telephone prefix)
+ must be 0 in msdos 2.0 (only fully implemented after 2.01)
+ return:
+ CARRY: 1
+ AX: 2=file not found
+ CARRY: 0
+ DS:DX: filled with country data
+ $39 : create subdirectory
+ call:
+ AH: $39
+ DS:DX: pointer to pathname (asciz)
+ return:
+ CARRY: 1
+ AX: 3=path not found
+ 5=access denied
+ no room in parent,
+ directory already exists or device was specified
+ CARRY: 0=no error
+ $3A : remove a directory entry
+ call:
+ AH: $3A
+ DS:DX: pointer to pathname (asciz)
+ return:
+ CARRY: 1
+ AX: 3=path not found
+ 5=access denied
+ directory not empty, not a directory, root directory
+ 16=current directory
+ CARRY: 0=no error
+ $3B : change the current directory
+ call:
+ AH: $3B
+ DS:DX: pointer to pathname (asciz)
+ return:
+ CARRY: 1
+ AX: 3=path not found
+ CARRY: 0=no error
+ $3C : create a file
+ call:
+ AH: $3C
+ DS:DX: pointer to pathname
+ CX: file attribute
+ return:
+ CARRY: 1
+ AX: 3=path not found
+ 4=too many open files
+ file was created, but no room for handle
+ 5=access denied
+ uncreatable attribute (directory or volume id),
+ a file with a more inklusive attribute set exists,
+ or a directory with the same name exists
+ CARRY: 0
+ AX is handle number
+ handle is open for read/write
+ creates a new file or truncates existing to length 0
+ $3D : open a file
+ call:
+ AH: $3D
+ DS:DX: pointer to pathname (asciz)
+ AL: access
+ 0=open for reading
+ 1=open for writing
+ 2=open for both
+ return:
+ CARRY: 1
+ AX: 2=file not found
+ 4=too many open files
+ no file handles available
+ 5=access denied
+ attempted to open a directory, volume id or
+ a read only file for writing
+ 12=invalid access
+ AL was not in range 0..2
+ CARRY: 0
+ AX is handle number
+ read/write pointer is set to the first byte of the file
+ and the record size is set to 1
+ the returned file handle must be used in subsequent operations
+ $3E : close a file handle
+ call:
+ AH: $3E
+ BX: file handle
+ return:
+ CARRY: 1
+ 6=invalid handle (not currently open)
+ CARRY: 0=no error
+ the associated file is closed, buffers are flushed
+ $3F : read from file/device
+ call:
+ AH: $3F
+ DS:DX: pointer to buffer
+ CX: bytes to read
+ BX: file handle
+ return:
+ CARRY: 1
+ AX: 5=access denied
+ not opened for read
+ 6=invalid handle (not currently open)
+ CARRY: 0
+ AX: number of bytes read
+ 0=eof
+ $40 : write to file/device
+ call:
+ AH: $40
+ DS:DX: pointer to buffer
+ CX: bytes to write
+ if 0, the file size is set to the current position
+ BX: file handle
+ return:
+ CARRY: 1
+ AX: 5=access denied
+ 6=invalid handle
+ CARRY: 0
+ AX: number of bytes written
+ is error if not the same number as requested
+ $41 : delete a directory entry
+ call:
+ AH: $41
+ DS:DX: pointer to pathname
+ return:
+ CARRY: 1
+ AX: 2=file not found
+ 5=access denied
+ directory or read only
+ CARRY: 0=no error
+ $42 : move file pointer
+ call:
+ AH: $42
+ CX:DX: distance to move, in bytes
+ AL: method of moving
+ 0=move pointer to offset from beginning of file
+ 1=move to offset from current location
+ 2=move to offset from eof
+ BX: file handle
+ return:
+ CARRY: 1
+ AX: 1=invalid function
+ AL not in range 0..2
+ 6=invalid handle
+ CARRY 0:
+ DX:AX: new pointer location
+ moves the read/write file pointer
+ $43 : change attributes
+ call:
+ AH: $43
+ DS:DX: pointer to pathname (asciz)
+ AL: function
+ 0=return in CX
+ 1=set to CX
+ CX: if AL=1
+ attribute to be set
+ return:
+ CARRY: 1
+ AX: 1=invalid function
+ AL not in range 0..1
+ 3=path not found
+ 5=access denied
+ CX contained attributes that can not be changed
+ (directory, volume id)
+ CARRY: 0
+ if AL=0
+ CX: attributes
+ $44 : i/o control for devices
+ call:
+ AH: $44
+ BX: handle
+ BL: (for calls AL=4, 5) drive: 0=default, ..
+ DS:DX: data or buffer
+ CX: bytes to read or write
+ AL: function code
+ calls 0,1: bits of DX (DH must be 0 on a set call)
+ 0: iscin
+ 1: iscot
+ 2: isnul
+ 3: isclk
+ 4: specl
+ 5: raw
+ 6: eof
+ 7: isdev
+ 8-13: reserved
+ 14: ctrl
+ 15: res
+ if isdev=0 then channel is a disk file
+ eof: 0=channel has been written
+ bits 0-5 are block device number for the channel
+ (0=a, 1=b, ..)
+ if isdev=1 then channel is device
+ eof : 0=end of file on input
+ raw : 0=this device is cooked
+ 1=device in raw mode
+ isclk: 1=clock
+ isnul: 1=nul
+ iscot: 1=console output
+ iscin: 1=console input
+ specl: 1=device is special
+ ctrl : 0=device can not do control strings
+ via calls 2,3
+ 1=can do control
+ 0=get device information (returned in DX)
+ 1=set device information (according to DX)
+ calls 2,5: arbitrary control strings sent or received
+ to or from a device
+ call syntax is the same as in read/write calls,
+ except for 4 and 5, which take drive number in BL
+ instead of a handle in BX
+ an invalid function error is returned, if
+ the ctrl bit is 0
+ 2=read CX number of bytes to DS:DX from device control channel
+ 3=write CX number of bytes from DS:DX to device control channel
+ 4=read CX number of bytes to DS:DX from device control channel
+ drive number in BL (0=default, ..)
+ 5=write CX number of bytes from DS:DX to device control channel
+ drive number in BL (0=default, ..)
+ calls 6,7: check, if a file handle is ready for i/o
+ intended for status of handles associated with
+ devices, but checks of file handles are allowed
+ and defined: input: always ready (255), until eof
+ then always not ready (0)
+ output: always ready
+ 6=get input status
+ 7=get output status
+ return:
+ CARRY: 1
+ AX: 1=invalid function
+ 5=access denied
+ 6=invalid handle
+ 13=invalid data
+ CARRY: 0
+ AL: 2,3,4,5
+ AX: count transferred
+ AL: 6,7
+ 0=not ready
+ 255=ready
+ sets or gets device information associated with an open handle
+ or sends or receives a control string to or from a device handle or device
+ if the function is used for files, only functions 0,6,7 are defined
+ $45 : duplicate a file handle
+ call:
+ AH: $45
+ BX: file handle
+ return:
+ CARRY: 1
+ AX: 4=too many files open
+ 6=invalid handle
+ CARRY: 0
+ AX: new file handle
+ retruns a new handle that refers to the same file
+ $46 : force a duplicate of a handle
+ call:
+ AH: $46
+ BX: existing file handle
+ CX: new file handle
+ return:
+ CARRY: 1
+ AX: 4=too many open files
+ 6=invalid handle
+ CARRY: 0=no error
+ CX then refers to the same file as BX, eventually, CX is closed first
+ $47 : return text of current directory
+ call:
+ AH: $47
+ DS:SI: pointer to 64 byte area
+ DL: drive number (0=default, ..)
+ return:
+ CARRY: 1
+ AX: 15=invalid drive
+ CARRY: 0=no error
+ the path name does not contain the leading separators
+ $48 : allocate memory
+ call:
+ AH: $48
+ BX: size of memory to be allocated
+ return:
+ CARRY: 1
+ AX: 7=arena trashed
+ internal consistency has been destroyed
+ 8=not enough memory
+ BX: maximum size that could be allocated
+ CARRY: 0
+ AX:0: pointer to the allocated memory
+ $49 : free allocated memory
+ call:
+ AH: $49
+ ES: segment address of memory area to be freed
+ return:
+ CARRY: 1
+ AX: 7=arena trashed
+ internal consistency has been destroyed
+ 9=invalid block
+ the block was not allocated by $49
+ CARRY: 0=no error
+ returns a piece of memory to the system pool that was allocated with $49
+ $4A : modify allocated memory blocks
+ call:
+ AH: $4A
+ ES: segment address of memory area
+ BX: requested memory area
+ return:
+ CARRY: 1
+ AX: 7=arena trashed
+ internal consistency has been destroyed
+ 8=not enough memory
+ 9=invalid block
+ the block was not allocated by $49
+ BX: maximum size possible
+ CARRY: 0=no error
+ attempts to grow or shrink an allocated block
+ $4B : load and execute a program
+ call:
+ AH: $4B
+ DS:DX: pointer to pathname (asciz)
+ ES:BX: pointer to parameter block
+ for AL=0:
+ size name
+ 2 segment address of environment
+ 4 pointer to command line at $80
+ 4 pointer to default fcb to be passed at $5C
+ 4 pointer to default fcb to be passed at $6C
+ for AL=3:
+ size name
+ 2 segment address where file will be loaded
+ 2 relocation factor to be applied to the image
+ AL: 0=load and execute
+ 3=load (overlay)
+ return:
+ CARRY: 1
+ AX: 1=invalid function
+ AL was not in range 0,3
+ 2=file not found
+ 8=not enough memory
+ 10=bad environment
+ larger than 32K
+ 11=bad format
+ EXE file contained inconsistent information
+ CARRY: 0=no error
+ all open files of a parent are copied to the child process
+ also inherited is an environment (block of text strings less than 32K)
+ a zero environment address causes the child to inherit then parents
+ environment unchanged
+ $4C : terminate process
+ call:
+ AH: $4C
+ AL: return code
+ $4D : retrieve then return code of a child
+ call:
+ AH: $4D
+ return:
+ AX: exit code
+ high byte: 0=terminate/abort
+ 1=alt-c
+ 2=hard error
+ 3=terminate and stay resident
+ returns code only once
+ $4E : find match file
+ call:
+ AH: $4E
+ DS:DX: pointer to pathname
+ CX: search attributes
+ return:
+ CARRY: 1
+ AX: 2=file not found
+ 18=no more files
+ CARRY: 0=no error
+ data block is written to current dma address:
+ size name
+ 21 reserved for subsequent calls
+ 1 attribute found
+ 2 time
+ 2 date
+ 2 low(size)
+ 2 high(size)
+ 13 packed name
+ subsequent calls: see $4F
+ $4F : step through a directory matching files
+ call:
+ AH: $4F
+ return:
+ CARRY: 1
+ AX: 18=no more files
+ CARRY: 0=no error
+ only used for subsequent calls after $4E
+ dma address must point to the parablock
+ $54 : return current setting of verify after write flag
+ call:
+ AH: $54
+ return:
+ current verify flag value
+ $56 : move a directory entry
+ call:
+ AH: $56
+ DS:DX: pointer to pathname of existing file
+ ES:DI: pointer to new pathname
+ return:
+ CARRY: 1
+ AX: 2=file not found
+ 5=access denied
+ path is directory or new file exists
+ or directory entry could not be created
+ 17=not same device
+ CARRY: 0=no error
+ attempts to rename a file in the directory of one device
+ $57 : get/set date/time of file
+ call:
+ AH: $57
+ AL: 0=get date and time
+ 1=set date and time
+ BX: file handle
+ CX: if AL=1
+ time to be set
+ DX: if AL=1
+ date to be set
+ return:
+ CARRY: 1
+ AX: 1=invalid function
+ 6=invalid handle
+ CARRY: 0=no error
+ CX: if AL=0
+ time
+ DX: if AL=0
+ date
+ date and time are not recorded until file is closed
+
diff --git a/system/dos/1986/src/252 b/system/dos/1986/src/252 Binary files differnew file mode 100644 index 0000000..b4369b6 --- /dev/null +++ b/system/dos/1986/src/252 diff --git a/system/dos/1986/src/253 b/system/dos/1986/src/253 Binary files differnew file mode 100644 index 0000000..c7a4494 --- /dev/null +++ b/system/dos/1986/src/253 diff --git a/system/dos/1986/src/254 b/system/dos/1986/src/254 Binary files differnew file mode 100644 index 0000000..f71eeb6 --- /dev/null +++ b/system/dos/1986/src/254 diff --git a/system/dos/1986/src/255 b/system/dos/1986/src/255 Binary files differnew file mode 100644 index 0000000..d21b649 --- /dev/null +++ b/system/dos/1986/src/255 diff --git a/system/dos/1986/src/COND.TXT b/system/dos/1986/src/COND.TXT new file mode 100644 index 0000000..02cb949 --- /dev/null +++ b/system/dos/1986/src/COND.TXT @@ -0,0 +1,5 @@ +FLOPPY = TRUE
+HDU = FALSE
+TEST = FALSE
+DOS = TRUE
+CPM = FALSE
diff --git a/system/dos/1986/src/block i-o b/system/dos/1986/src/block i-o new file mode 100644 index 0000000..4336746 --- /dev/null +++ b/system/dos/1986/src/block i-o @@ -0,0 +1,104 @@ +PACKET disk block io DEFINES (* Copyright (C) 1986 *)
+ (* Frank Klapper *)
+ (* 25.03.86 *)
+ read disk block,
+ read disk cluster,
+ write disk block,
+ write disk cluster,
+ io error,
+ first non dummy ds page:
+
+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,
+ INT VAR error):
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error).
+
+END PROC read disk block;
+
+PROC read disk block (DATASPACE VAR ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ check rerun;
+ read block (ds, ds page no, eublock (block no), error);
+ IF error <> 0
+ THEN io error (error)
+ FI.
+
+END PROC read disk block;
+
+PROC read disk block (DATASPACE VAR ds,
+ INT CONST block no):
+ read disk block (ds, first non dummy ds page, block no)
+
+END PROC read disk block;
+
+PROC read disk cluster (DATASPACE VAR ds,
+ INT CONST first ds page no,
+ INT CONST cluster no):
+ INT VAR i;
+ FOR i FROM 0 UPTO sectors per cluster - 1 REP
+ read disk block (ds, first ds page no + i, block no + i)
+ PER.
+
+block no:
+ first block no of cluster (cluster no).
+
+END PROC read disk cluster;
+
+PROC write disk block (DATASPACE CONST ds,
+ INT CONST ds page no,
+ INT CONST block no,
+ INT VAR error):
+ check rerun;
+ write block (ds, ds page no, 0,eu block (block no), error).
+
+END PROC write disk block;
+
+PROC write disk block (DATASPACE CONST ds,
+ INT CONST ds page no,
+ INT CONST block no):
+ check rerun;
+ write block (ds, ds page no, 0, eu block (block no), error);
+ IF error <> 0
+ THEN io error (error)
+ FI.
+
+END PROC write disk block;
+
+PROC write disk block (DATASPACE CONST ds,
+ INT CONST block no):
+ write disk block (ds, first non dummy ds page, block no)
+
+END PROC write disk block;
+
+PROC write disk cluster (DATASPACE CONST ds,
+ INT CONST first ds page no,
+ INT CONST cluster no):
+ INT VAR i;
+ FOR i FROM 0 UPTO sectors per cluster - 1 REP
+ write disk block (ds, first ds page no + i, block no + i)
+ PER.
+
+block no:
+ first block no of cluster (cluster no).
+
+END PROC write disk cluster;
+
+PROC io error (INT CONST error code):
+ SELECT error code OF
+ CASE 1: errorstop ("Laufwerk nicht betriebsbereit")
+ CASE 2: errorstop ("Schreib-/Lesefehler")
+ CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)")
+ CASE 4: errorstop ("Block nicht lesbar")
+ OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error))
+ END SELECT.
+
+END PROC io error;
+
+END PACKET disk block io;
diff --git a/system/dos/1986/src/cluster b/system/dos/1986/src/cluster new file mode 100644 index 0000000..ef2720b --- /dev/null +++ b/system/dos/1986/src/cluster @@ -0,0 +1,109 @@ +PACKET cluster DEFINES (* Copyright (C) 1986 *)
+ (* Frank Klapper *)
+ (* 19.03.86 *)
+
+ CLUSTER,
+ :=,
+ text,
+ text 32, (* typical dir entry *)
+ write text,
+ write text 32,
+ reduce cluster buffer:
+
+LET max cluster size = 8192; (* 8192 * 8 = 64 KB *)
+
+TYPE CLUSTER = BOUND STRUCT (ALIGN dummy,
+ ROW max cluster size REAL cluster row);
+
+TEXT VAR string;
+INT VAR string length;
+
+INT VAR sector no, eight byte pos, index;
+
+reduce cluster buffer;
+
+.reals per sector: sector size DIV 8.
+.reals per std eu sector: 512 DIV 8.
+
+PROC reduce cluster buffer:
+ string := 32 * "*";
+ string length := 32.
+
+END PROC reduce cluster buffer;
+
+OP := (CLUSTER VAR cluster, DATASPACE VAR ds):
+ CONCR (cluster) := ds
+
+END OP :=;
+
+TEXT PROC text (CLUSTER CONST cluster, INT CONST from, to):
+ init string;
+ FOR sector no FROM 0 UPTO sectors per cluster - 1 REP
+ get text of sector
+ PER;
+ subtext (string, from, to).
+
+init string:
+ IF string length < cluster size
+ THEN string := cluster size * "*";
+ string length := cluster size
+ FI.
+
+get text of sector:
+ FOR eight byte pos FROM 1 UPTO reals per sector REP
+ replace (string, string index, cluster.cluster row [row index])
+ PER.
+
+string index:
+ reals per sector * sector no + eight byte pos.
+
+row index:
+ reals per std eu sector * sector no + eight byte pos.
+
+END PROC text;
+
+TEXT PROC text 32 (CLUSTER CONST cluster, INT CONST part):
+ FOR index FROM 1 UPTO 4 REP
+ replace (string, index, cluster.cluster row [index + 4 * part])
+ PER;
+ subtext (string, 1, 32).
+
+END PROC text 32;
+
+PROC write text (CLUSTER VAR cluster,
+ TEXT CONST string):
+ IF LENGTH string < cluster size
+ THEN execute write text (cluster, text (string, cluster size))
+ ELSE execute write text (cluster, string)
+ FI.
+
+END PROC write text;
+
+PROC execute write text (CLUSTER VAR cluster,
+ TEXT CONST string):
+ FOR sector no FROM 0 UPTO sectors per cluster - 1 REP
+ write text of sector
+ PER.
+
+write text of sector:
+ FOR eight byte pos FROM 1 UPTO reals per sector REP
+ cluster.cluster row [row index] := string RSUB (string index)
+ PER.
+
+row index:
+ reals per std eu sector * sector no + eight byte pos.
+
+string index:
+ reals per sector * sector no + eight byte pos.
+
+
+END PROC execute write text;
+
+PROC write text 32 (CLUSTER VAR cluster, TEXT CONST string, INT CONST part):
+ FOR index FROM 1 UPTO 4 REP
+ cluster.cluster row [index + 4 * part] := string RSUB (index)
+ PER;
+
+END PROC write text 32;
+
+END PACKET cluster;
diff --git a/system/dos/1986/src/disk descriptor.dos.fd b/system/dos/1986/src/disk descriptor.dos.fd new file mode 100644 index 0000000..9de8cf0 --- /dev/null +++ b/system/dos/1986/src/disk descriptor.dos.fd @@ -0,0 +1,290 @@ +PACKET dos disk DEFINES (* Copyright (C) 1985, 86 *)
+ (* Frank Klapper *)
+ first fat byte, (* 30.05.86 *)
+ begin of fat,
+ number of fat sectors,
+ number of fat entrys,
+ number of fat copies,
+ begin of dir,
+ number of dir sectors,
+ begin of data area,
+ sectors per cluster,
+ cluster size,
+ sector size,
+
+ eublock,
+ first block no of cluster,
+
+ reset disk attributes,
+ set disk attributes:
+
+LET dir entrys per block = 16,
+ first non dummy ds page = 2;
+
+LET DOSDISK = STRUCT (INT sectors per cluster,
+ number of reserved sectors,
+ number of fats,
+ number of dir sectors,
+ first fat byte,
+ number of fat sectors,
+ heads,
+ sectors per track,
+ tracks,
+ number of fat entrys,
+ REAL size);
+
+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);
+
+INT CONST sector size :: 512;
+
+TEXT VAR bpb := 32 * " ";
+
+INITFLAG VAR bpb ds used := FALSE;
+
+DATASPACE VAR bpb ds;
+
+BLOCK VAR bpb block;
+
+DOSDISK VAR disk format;
+BOUND DOSDISK VAR format table;
+
+INT VAR eu sectors,
+ xbegin of data area;
+
+INT PROC eublock (INT CONST nr):
+(*COND FLOPPY*)
+ IF page format
+ THEN head * eu sectors per head + trac * eu sectors + sector
+ ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector
+ FI.
+
+page format:
+ eu heads < 0.
+
+sector:
+ nr MOD disk format.sectors per track.
+
+trac:
+ (nr DIV disk format.sectors per track) DIV disk format.heads.
+
+head:
+ (nr DIV disk format.sectors per track) MOD disk format.heads.
+
+eu sectors per head:
+ eu sectors * eu tracks.
+
+(*ENDCOND*)
+(*COND HDU
+ nr
+
+ENDCOND*)
+
+END PROC eublock;
+
+INT PROC first block no of cluster (INT CONST cluster no):
+ IF cluster no < 2
+ THEN error stop ("interner Fehler")
+ FI;
+ begin of data area + (cluster no - 2) * sectors per cluster.
+
+END PROC first block no of cluster;
+
+INT PROC first fat byte:
+ disk format.first fat byte
+
+END PROC first fat byte;
+
+INT PROC number of fat copies:
+ disk format.number of fats
+
+END PROC number of fat copies;
+
+INT PROC number of fat sectors:
+ disk format.number of fat sectors
+
+END PROC number of fat sectors;
+
+INT PROC number of fat entrys:
+ disk format.number of fat entrys
+
+END PROC number of fat entrys;
+
+INT PROC number of dir sectors:
+ disk format.number of dir sectors
+
+END PROC number of dir sectors;
+
+INT PROC begin of fat (INT CONST no):
+ disk format.number of reserved sectors + no * disk format.number of fat sectors
+
+END PROC begin of fat;
+
+INT PROC begin of dir:
+ disk format.number of reserved sectors +
+ disk format.number of fats * disk format.number of fat sectors
+
+END PROC begin of dir;
+
+INT PROC begin of data area:
+ xbegin of data area
+
+END PROC begin of data area;
+
+INT PROC sectors per cluster:
+ disk format.sectors per cluster
+
+END PROC sectors per cluster;
+
+INT PROC cluster size:
+ disk format.sectors per cluster * 512
+
+END PROC cluster size;
+
+PROC set disk attributes (INT CONST first fat byte):
+ enable stop;
+(*COND FLOPPY*)
+ get bios parameter block;
+ IF is valid bpb
+ THEN load disk data from bpb
+ ELSE load disk disk data from ds
+ FI;
+ eu sectors := eu last sector - eu first sector +1;
+(*ENDCOND*)
+ xbegin of data area := disk format.number of reserved sectors +
+ disk format.number of fats * disk format.number of fat sectors +
+ disk format.number of dir sectors;
+(*COND FLOPPY*)
+ test compatibility
+
+.is valid bpb:
+ first fat byte < 252 OR code (bpb SUB 22) = first fat byte.
+
+load disk disk data from ds:
+ IF exists (text (first fat byte))
+ THEN format table := old (text (first fat byte));
+ copy values
+ ELSE error stop ("DOS-Diskettenformat nicht implementiert")
+ FI.
+
+copy values:
+ disk format.sectors per cluster := format table.sectors per cluster;
+ disk format.number of reserved sectors := format table.number of reserved sectors;
+ disk format.number of fats := format table.number of fats;
+ disk format.size := format table.size;
+ disk format.number of dir sectors := format table.number of dir sectors;
+ disk format.first fat byte := format table.first fat byte;
+ disk format.number of fat sectors := format table.number of fat sectors;
+ disk format.heads := format table.heads;
+ disk format.sectors per track := format table.sectors per track;
+ disk format.tracks := format table.tracks;
+ disk format.number of fat entrys := format table.number of fat entrys.
+
+test compatibility:
+ IF disk format.sectors per track > eu sectors
+ OR eu tracks <> disk format.tracks
+ OR abs (eu heads) < disk format.heads
+ OR disk format.number of reserved sectors <> 1
+ THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")
+ FI;
+(*ENDCOND*)
+
+END PROC set disk attributes;
+
+PROC reset disk attributes:
+(*COND FLOPPY*)
+ disk format.sectors per cluster := 1;
+ disk format.number of reserved sectors := 1;
+ disk format.number of fats := 1;
+ disk format.size := real (eu size);
+ disk format.number of dir sectors := 4;
+ disk format.first fat byte := 255;
+ disk format.number of fat sectors := 1;
+ disk format.heads := eu heads;
+ disk format.sectors per track := eu tracks;
+ disk format.tracks := eu sectors;
+ disk format.number of fat entrys := 100.
+
+(*ENDCOND*)
+(*COND HDU
+ get bios parameter block;
+ load disk data from bpb (248).
+
+ENDCOND*)
+
+END PROC reset disk attributes;
+
+PROC get bios parameter block:
+ init bpb ds;
+ read bpb;
+ copy bpb block to bpb text.
+
+init bpb ds:
+ IF NOT initialized (bpb ds used)
+ THEN bpb ds := nilspace;
+ bpb block := bpb ds
+ FI.
+
+read bpb:
+ INT VAR error;
+ read block (bpb ds, first non dummy ds page, 0, error);
+ IF error <> 0
+ THEN SELECT error OF
+ CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit")
+ CASE 2: errorstop ("Schreib-/Lesefehler")
+ CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)")
+ OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error))
+ END SELECT
+ FI.
+
+copy bpb block to bpb text:
+ replace (bpb, 1, bpb block. block row [1]);
+ replace (bpb, 2, bpb block. block row [2]);
+ replace (bpb, 3, bpb block. block row [3]);
+ replace (bpb, 4, bpb block. block row [4]).
+
+END PROC get bios parameter block;
+
+PROC load disk data from bpb:
+ disable stop;
+ enable load disk data from bpb;
+ IF is error
+ THEN clear error;
+ enable stop;
+ error stop ("Bios-Parameterblock ungültig")
+ FI.
+
+END PROC load disk data from bpb;
+
+PROC enable load disk data from bpb:
+ disk format.sectors per cluster := code (bpb SUB 14);
+ disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);
+ disk format.number of fats := code (bpb SUB 17);
+ disk format.number of dir sectors := dir entrys DIV dir entrys per block;
+ disk format.size := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));
+ disk format.first fat byte := code (bpb SUB 22);
+ disk format.number of fat sectors := code (bpb SUB 24) * 256 + code (bpb SUB 23);
+ disk format.heads := dos heads;
+ disk format.sectors per track := code (bpb SUB 26) * 256 + code (bpb SUB 25);
+ disk format.tracks :=
+ int(disk format.size / real(disk format.sectors per track * disk format.heads));
+ disk format.number of fat entrys := fat entrys.
+
+dir entrys:
+ code (bpb SUB 19) * 256 + code (bpb SUB 18).
+
+dos heads:
+ code (bpb SUB 28) * 256 + code (bpb SUB 27).
+
+fat entrys:
+ data clusters + 2.
+
+data clusters:
+ int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).
+
+no of table sectors:
+ disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +
+ disk format.number of dir sectors.
+
+END PROC enable load disk data from bpb;
+
+END PACKET dos disk;
diff --git a/system/dos/1986/src/disk descriptor.dos.hd b/system/dos/1986/src/disk descriptor.dos.hd new file mode 100644 index 0000000..0627b62 --- /dev/null +++ b/system/dos/1986/src/disk descriptor.dos.hd @@ -0,0 +1,290 @@ +PACKET dos disk DEFINES (* Copyright (C) 1985, 86 *)
+ (* Frank Klapper *)
+ first fat byte, (* 30.05.86 *)
+ begin of fat,
+ number of fat sectors,
+ number of fat entrys,
+ number of fat copies,
+ begin of dir,
+ number of dir sectors,
+ begin of data area,
+ sectors per cluster,
+ cluster size,
+ sector size,
+
+ eublock,
+ first block no of cluster,
+
+ reset disk attributes,
+ set disk attributes:
+
+LET dir entrys per block = 16,
+ first non dummy ds page = 2;
+
+LET DOSDISK = STRUCT (INT sectors per cluster,
+ number of reserved sectors,
+ number of fats,
+ number of dir sectors,
+ first fat byte,
+ number of fat sectors,
+ heads,
+ sectors per track,
+ tracks,
+ number of fat entrys,
+ REAL size);
+
+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);
+
+INT CONST sector size :: 512;
+
+TEXT VAR bpb := 32 * " ";
+
+INITFLAG VAR bpb ds used := FALSE;
+
+DATASPACE VAR bpb ds;
+
+BLOCK VAR bpb block;
+
+DOSDISK VAR disk format;
+BOUND DOSDISK VAR format table;
+
+INT VAR eu sectors,
+ xbegin of data area;
+
+INT PROC eublock (INT CONST nr):
+(*COND FLOPPY
+ IF page format
+ THEN head * eu sectors per head + trac * eu sectors + sector
+ ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector
+ FI.
+
+page format:
+ eu heads < 0.
+
+sector:
+ nr MOD disk format.sectors per track.
+
+trac:
+ (nr DIV disk format.sectors per track) DIV disk format.heads.
+
+head:
+ (nr DIV disk format.sectors per track) MOD disk format.heads.
+
+eu sectors per head:
+ eu sectors * eu tracks.
+
+ENDCOND*)
+(*COND HDU*)
+ nr
+
+(*ENDCOND*)
+
+END PROC eublock;
+
+INT PROC first block no of cluster (INT CONST cluster no):
+ IF cluster no < 2
+ THEN error stop ("interner Fehler")
+ FI;
+ begin of data area + (cluster no - 2) * sectors per cluster.
+
+END PROC first block no of cluster;
+
+INT PROC first fat byte:
+ disk format.first fat byte
+
+END PROC first fat byte;
+
+INT PROC number of fat copies:
+ disk format.number of fats
+
+END PROC number of fat copies;
+
+INT PROC number of fat sectors:
+ disk format.number of fat sectors
+
+END PROC number of fat sectors;
+
+INT PROC number of fat entrys:
+ disk format.number of fat entrys
+
+END PROC number of fat entrys;
+
+INT PROC number of dir sectors:
+ disk format.number of dir sectors
+
+END PROC number of dir sectors;
+
+INT PROC begin of fat (INT CONST no):
+ disk format.number of reserved sectors + no * disk format.number of fat sectors
+
+END PROC begin of fat;
+
+INT PROC begin of dir:
+ disk format.number of reserved sectors +
+ disk format.number of fats * disk format.number of fat sectors
+
+END PROC begin of dir;
+
+INT PROC begin of data area:
+ xbegin of data area
+
+END PROC begin of data area;
+
+INT PROC sectors per cluster:
+ disk format.sectors per cluster
+
+END PROC sectors per cluster;
+
+INT PROC cluster size:
+ disk format.sectors per cluster * 512
+
+END PROC cluster size;
+
+PROC set disk attributes (INT CONST first fat byte):
+ enable stop;
+(*COND FLOPPY
+ get bios parameter block;
+ IF is valid bpb
+ THEN load disk data from bpb
+ ELSE load disk disk data from ds
+ FI;
+ eu sectors := eu last sector - eu first sector +1;
+ENDCOND*)
+ xbegin of data area := disk format.number of reserved sectors +
+ disk format.number of fats * disk format.number of fat sectors +
+ disk format.number of dir sectors;
+(*COND FLOPPY
+ test compatibility
+
+.is valid bpb:
+ first fat byte < 252 OR code (bpb SUB 22) = first fat byte.
+
+load disk disk data from ds:
+ IF exists (text (first fat byte))
+ THEN format table := old (text (first fat byte));
+ copy values
+ ELSE error stop ("DOS-Diskettenformat nicht implementiert")
+ FI.
+
+copy values:
+ disk format.sectors per cluster := format table.sectors per cluster;
+ disk format.number of reserved sectors := format table.number of reserved sectors;
+ disk format.number of fats := format table.number of fats;
+ disk format.size := format table.size;
+ disk format.number of dir sectors := format table.number of dir sectors;
+ disk format.first fat byte := format table.first fat byte;
+ disk format.number of fat sectors := format table.number of fat sectors;
+ disk format.heads := format table.heads;
+ disk format.sectors per track := format table.sectors per track;
+ disk format.tracks := format table.tracks;
+ disk format.number of fat entrys := format table.number of fat entrys.
+
+test compatibility:
+ IF disk format.sectors per track > eu sectors
+ OR eu tracks <> disk format.tracks
+ OR abs (eu heads) < disk format.heads
+ OR disk format.number of reserved sectors <> 1
+ THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")
+ FI;
+ENDCOND*)
+
+END PROC set disk attributes;
+
+PROC reset disk attributes:
+(*COND FLOPPY
+ disk format.sectors per cluster := 1;
+ disk format.number of reserved sectors := 1;
+ disk format.number of fats := 1;
+ disk format.size := real (eu size);
+ disk format.number of dir sectors := 4;
+ disk format.first fat byte := 255;
+ disk format.number of fat sectors := 1;
+ disk format.heads := eu heads;
+ disk format.sectors per track := eu tracks;
+ disk format.tracks := eu sectors;
+ disk format.number of fat entrys := 100.
+
+ENDCOND*)
+(*COND HDU*)
+ get bios parameter block;
+ load disk data from bpb.
+
+(*ENDCOND*)
+
+END PROC reset disk attributes;
+
+PROC get bios parameter block:
+ init bpb ds;
+ read bpb;
+ copy bpb block to bpb text.
+
+init bpb ds:
+ IF NOT initialized (bpb ds used)
+ THEN bpb ds := nilspace;
+ bpb block := bpb ds
+ FI.
+
+read bpb:
+ INT VAR error;
+ read block (bpb ds, first non dummy ds page, 0, error);
+ IF error <> 0
+ THEN SELECT error OF
+ CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit")
+ CASE 2: errorstop ("Schreib-/Lesefehler")
+ CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)")
+ OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error))
+ END SELECT
+ FI.
+
+copy bpb block to bpb text:
+ replace (bpb, 1, bpb block. block row [1]);
+ replace (bpb, 2, bpb block. block row [2]);
+ replace (bpb, 3, bpb block. block row [3]);
+ replace (bpb, 4, bpb block. block row [4]).
+
+END PROC get bios parameter block;
+
+PROC load disk data from bpb:
+ disable stop;
+ enable load disk data from bpb;
+ IF is error
+ THEN clear error;
+ enable stop;
+ error stop ("Bios-Parameterblock ungültig")
+ FI.
+
+END PROC load disk data from bpb;
+
+PROC enable load disk data from bpb:
+ disk format.sectors per cluster := code (bpb SUB 14);
+ disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);
+ disk format.number of fats := code (bpb SUB 17);
+ disk format.number of dir sectors := dir entrys DIV dir entrys per block;
+ disk format.size := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));
+ disk format.first fat byte := code (bpb SUB 22);
+ disk format.number of fat sectors := code (bpb SUB 24) * 256 + code (bpb SUB 23);
+ disk format.heads := dos heads;
+ disk format.sectors per track := code (bpb SUB 26) * 256 + code (bpb SUB 25);
+ disk format.tracks :=
+ int(disk format.size / real(disk format.sectors per track * disk format.heads));
+ disk format.number of fat entrys := fat entrys.
+
+dir entrys:
+ code (bpb SUB 19) * 256 + code (bpb SUB 18).
+
+dos heads:
+ code (bpb SUB 28) * 256 + code (bpb SUB 27).
+
+fat entrys:
+ data clusters + 2.
+
+data clusters:
+ int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).
+
+no of table sectors:
+ disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +
+ disk format.number of dir sectors.
+
+END PROC enable load disk data from bpb;
+
+END PACKET dos disk;
diff --git a/system/dos/1986/src/disk manager b/system/dos/1986/src/disk manager new file mode 100644 index 0000000..5711ee7 --- /dev/null +++ b/system/dos/1986/src/disk manager @@ -0,0 +1,245 @@ +PACKET disk manager DEFINES (* Copyright (C) 1986 *)
+ (* Frank Klapper *)
+ disk fetch, (* 07.05.86 *)
+ disk check,
+ disk save first phase,
+ disk save second phase,
+ disk clear,
+ disk format,
+ disk erase,
+ disk exists,
+ disk list,
+ disk all,
+ disk reserve,
+ disk free:
+
+LET ascii = 1,
+ ascii german = 2,
+ transparent = 3,
+ ebcdic = 4,
+ row text = 5,
+ ds = 6,
+ atari st = 10;
+
+TEXT VAR file name;
+
+INT VAR mode := 0;
+TEXT VAR mode extension;
+
+REAL VAR last access time := 0.0;
+
+PROC disk fetch (TEXT CONST name, DATASPACE VAR file ds):
+ enable stop;
+ access disk;
+ file name := adapted name (name, TRUE);
+ IF dir contains (file name)
+ THEN do fetch
+ ELSE errorstop ("die Datei """ + file name + """ gibt es nicht")
+ FI;
+ last access time := clock (1).
+
+do fetch:
+ SELECT mode OF
+ CASE ascii, ascii german, atari st, ebcdic, transparent: fetch filemode (file ds, filename, mode)
+ CASE row text : fetch row textmode (file ds, filename)
+ CASE ds : fetch dsmode (file ds, filename)
+ OTHERWISE error stop ("Unzulssige Betriebsart")
+ END SELECT.
+
+END PROC disk fetch;
+
+PROC disk check (TEXT CONST name):
+ enable stop;
+ access disk;
+ file name := adapted name (name, TRUE);
+ IF dir contains (file name)
+ THEN disable stop;
+ check file (file name);
+ IF is error
+ THEN clear error;
+ error stop ("Fehler beim Prflesen der Datei """ + file name + """")
+ FI;
+ ELSE error stop ("""" + file name + """ gibt es nicht")
+ FI;
+ last access time := clock (1).
+
+END PROC disk check;
+
+PROC disk save first phase (TEXT CONST name, BOOL VAR overwrite question):
+ enable stop;
+ overwrite question := FALSE;
+ access disk;
+ file name := adapted name (name, FALSE);
+ IF dir contains (file name)
+ THEN overwrite question := TRUE
+ FI;
+ last access time := clock (1).
+
+END PROC disk save first phase;
+
+PROC disk save second phase (DATASPACE CONST file ds):
+ enable stop;
+ access disk;
+ erase file if necessary;
+ do save;
+ last access time := clock (1).
+
+erase file if necessary:
+ IF dir contains (file name)
+ THEN erase table entrys (file name)
+ FI.
+
+do save:
+ SELECT mode OF
+ CASE ascii, ascii german,atari st, ebcdic, transparent: save filemode (file ds, filename, mode)
+ CASE row text : save row textmode (file ds, filename)
+ CASE ds : save dsmode (file ds, filename)
+ OTHERWISE error stop ("Unzulssige Betriebsart")
+ END SELECT.
+
+END PROC disk save second phase;
+
+(* DOS bekommt die Tabellenparameter von der Diskette
+ CPM bekommt die Tabellenparameter ber 'reserve' *)
+
+PROC disk clear:
+ enable stop;
+(*COND DOS*)
+ access disk;
+(*ENDCOND*)
+(*COND CPM
+ open eu disk;
+ open action;
+ENDCOND*)
+ format disk;
+ last access time := clock (1).
+
+END PROC disk clear;
+
+PROC disk erase (TEXT CONST name):
+ enable stop;
+ access disk;
+ file name := adapted name (name, TRUE);
+ IF NOT dir contains (file name)
+ THEN errorstop ("die Datei """ + file name + """ gibt es nicht")
+ ELSE erase table entrys (file name);
+ FI;
+ last access time := clock (1).
+
+END PROC disk erase;
+
+BOOL PROC disk exists (TEXT CONST name):
+ enable stop;
+ access disk;
+ last access time := clock (1);
+ dir contains (adapted name (name, TRUE)).
+
+END PROC disk exists;
+
+PROC disk list (DATASPACE VAR list ds):
+ enable stop;
+ access disk;
+ dir list (list ds);
+ last access time := clock (1).
+
+END PROC disk list;
+
+THESAURUS PROC disk all:
+ enable stop;
+ access disk;
+ last access time := clock (1);
+ dir all.
+
+END PROC disk all;
+
+PROC disk format:
+
+(*COND DOS*)
+ error stop ("nicht implementiert")
+(*ENDCOND*)
+
+(*COND CPM
+ enable stop;
+ open eu disk;
+ open action;
+ format archive (eu disk format no);
+ format disk;
+ last access time := clock (1).
+ENDCOND*)
+
+END PROC disk format;
+
+PROC disk reserve (TEXT CONST reserve string):
+ enable stop;
+ close action;
+ last access time := clock (1);
+ get mode.
+
+get mode:
+ TEXT VAR mode text;
+ IF pos (reserve string, ":") = 0
+ THEN mode text := reserve string;
+ mode extension := ""
+ ELSE mode text := subtext (reserve string, 1, pos (reserve string, ":") - 1);
+ mode extension := subtext (reserve string, pos (reserve string, ":") + 1)
+ FI;
+ prepare modetext;
+ IF mode text = "FILEASCII"
+ THEN mode := ascii
+ ELIF mode text = "FILEASCIIGERMAN"
+ THEN mode := asciigerman
+ ELIF mode text = "FILEATARIST"
+ THEN mode := atari st
+ ELIF modetext = "FILEEBCDIC"
+ THEN mode := ebcdic
+ ELIF modetext = "FILETRANSPARENT"
+ THEN mode := transparent
+ ELIF mode text = "ROWTEXT"
+ THEN mode := row text
+ ELIF mode text = "DS"
+ THEN mode := ds
+ ELSE error stop ("Unzulssige Betriebsart")
+ FI.
+
+prepare modetext:
+ change all (mode text, " ", "");
+ INT VAR i;
+ FOR i FROM 1 UPTO LENGTH mode text REP
+ IF is lower case
+ THEN replace (mode text, i, upper case char)
+ FI
+ PER.
+
+is lower case:
+ code (mode text SUB i) > 96 AND code (mode text SUB i) < 123.
+
+upper case char:
+ code (code (mode text SUB i) - 32).
+
+END PROC disk reserve;
+
+PROC disk free:
+ disable stop;
+ close action;
+ close disk;
+ reduce cluster buffer.
+
+END PROC disk free;
+
+PROC access disk:
+ IF action closed COR (last access more than two seconds ago CAND disk changed)
+ THEN open disk archive
+ FI.
+
+open disk archive:
+ close action;
+ open eu disk;
+ open disk (mode extension);
+ open action.
+
+last access more than two seconds ago:
+ abs (clock (1) - last access time) > 2.0.
+
+END PROC access disk;
+
+END PACKET disk manager;
diff --git a/system/dos/1986/src/eu disk descriptor.fd b/system/dos/1986/src/eu disk descriptor.fd new file mode 100644 index 0000000..cd00175 --- /dev/null +++ b/system/dos/1986/src/eu disk descriptor.fd @@ -0,0 +1,102 @@ +PACKET eu disk DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ (* 25.03.86 *)
+ load shard interface table,
+ open eu disk,
+ eu size,
+ eu heads,
+ eu tracks,
+ eu first sector,
+ eu last sector:
+
+LET table length = 15,
+
+ size field = 1,
+ head field = 2,
+ track field = 3,
+ first sector field = 4,
+ last sector field = 5;
+
+ROW table length ROW 5 INT VAR format table;
+
+INT VAR table top,
+ table pointer;
+
+PROC open eu disk:
+ enable stop;
+ init check rerun;
+(*COND FLOPPY*)
+ INT VAR blocks := archive blocks;
+ search format table entry;
+(*ENDCOND*)
+.
+
+(*COND FLOPPY*)
+search format table entry:
+ table pointer := 1;
+ WHILE format table [table pointer][size field] <> blocks REP
+ table pointer INCR 1;
+ IF table pointer > table top
+ THEN error stop ("Diskettenformat nicht implementiert")
+ FI
+ PER.
+(*ENDCOND*)
+
+END PROC open eu disk;
+
+PROC load shard interface table:
+ FILE VAR f := sequential file (input, "shard interface");
+ TEXT VAR line;
+ table top := 0;
+ WHILE NOT eof (f) REP
+ get line (f, line);
+ IF (line SUB 1) <> ";"
+ THEN load line
+ FI
+ PER.
+
+load line:
+ table top INCR 1;
+ IF table top > table length
+ THEN error stop ("Shard Interface Tabelle zu groß")
+ FI;
+ INT VAR blank pos := 1;
+ format table [table top][size field] := next int;
+ format table [table top][head field] := next int;
+ format table [table top][track field] := next int;
+ format table [table top][first sector field] := next int;
+ format table [table top][last sector field] := next int.
+
+next int:
+ line := compress (subtext (line, blank pos)) + " ";
+ blank pos := pos (line, " ");
+ int (subtext (line, 1, blank pos - 1)).
+
+END PROC load shard interface table;
+
+INT PROC eu size:
+ format table [table pointer][size field]
+
+END PROC eu size;
+
+INT PROC eu heads:
+ format table [table pointer][head field]
+
+END PROC eu heads;
+
+INT PROC eu tracks:
+ format table [table pointer][track field]
+
+END PROC eu tracks;
+
+INT PROC eu first sector:
+ format table [table pointer][first sector field]
+
+END PROC eu first sector;
+
+INT PROC eu last sector:
+ format table [table pointer][last sector field]
+
+END PROC eu last sector;
+
+END PACKET eu disk;
diff --git a/system/dos/1986/src/eu disk descriptor.hd b/system/dos/1986/src/eu disk descriptor.hd new file mode 100644 index 0000000..caeef66 --- /dev/null +++ b/system/dos/1986/src/eu disk descriptor.hd @@ -0,0 +1,102 @@ +PACKET eu disk DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ (* 25.03.86 *)
+ load shard interface table,
+ open eu disk,
+ eu size,
+ eu heads,
+ eu tracks,
+ eu first sector,
+ eu last sector:
+
+LET table length = 15,
+
+ size field = 1,
+ head field = 2,
+ track field = 3,
+ first sector field = 4,
+ last sector field = 5;
+
+ROW table length ROW 5 INT VAR format table;
+
+INT VAR table top,
+ table pointer;
+
+PROC open eu disk:
+ enable stop;
+ init check rerun;
+(*COND FLOPPY
+ INT VAR blocks := archive blocks;
+ search format table entry;
+ENDCOND*)
+.
+
+(*COND FLOPPY
+search format table entry:
+ table pointer := 1;
+ WHILE format table [table pointer][size field] <> blocks REP
+ table pointer INCR 1;
+ IF table pointer > table top
+ THEN error stop ("Diskettenformat nicht implementiert")
+ FI
+ PER.
+ENDCOND*)
+
+END PROC open eu disk;
+
+PROC load shard interface table:
+ FILE VAR f := sequential file (input, "shard interface");
+ TEXT VAR line;
+ table top := 0;
+ WHILE NOT eof (f) REP
+ get line (f, line);
+ IF (line SUB 1) <> ";"
+ THEN load line
+ FI
+ PER.
+
+load line:
+ table top INCR 1;
+ IF table top > table length
+ THEN error stop ("Shard Interface Tabelle zu groß")
+ FI;
+ INT VAR blank pos := 1;
+ format table [table top][size field] := next int;
+ format table [table top][head field] := next int;
+ format table [table top][track field] := next int;
+ format table [table top][first sector field] := next int;
+ format table [table top][last sector field] := next int.
+
+next int:
+ line := compress (subtext (line, blank pos)) + " ";
+ blank pos := pos (line, " ");
+ int (subtext (line, 1, blank pos - 1)).
+
+END PROC load shard interface table;
+
+INT PROC eu size:
+ format table [table pointer][size field]
+
+END PROC eu size;
+
+INT PROC eu heads:
+ format table [table pointer][head field]
+
+END PROC eu heads;
+
+INT PROC eu tracks:
+ format table [table pointer][track field]
+
+END PROC eu tracks;
+
+INT PROC eu first sector:
+ format table [table pointer][first sector field]
+
+END PROC eu first sector;
+
+INT PROC eu last sector:
+ format table [table pointer][last sector field]
+
+END PROC eu last sector;
+
+END PACKET eu disk;
diff --git a/system/dos/1986/src/eumel-ebcdic + sub b/system/dos/1986/src/eumel-ebcdic + sub new file mode 100644 index 0000000..5a571cb --- /dev/null +++ b/system/dos/1986/src/eumel-ebcdic + sub @@ -0,0 +1,550 @@ +PACKET eumel ebcdic DEFINES (* Copyright (c) 1986 *)
+ (* Frank Klapper *)
+ (* 19.02.86 *)
+ ebcdic to eumel with substitution,
+ eumel to ebcdic with substitution:
+
+TEXT VAR bild;
+
+PROC eumel to ebcdic with substitution (TEXT VAR string):
+ bild := "";
+ INT VAR pos;
+ FOR pos FROM 1 UPTO LENGTH string REP
+ bild CAT conversion
+ PER;
+ string := bild.
+
+conversion:
+ SELECT code (string SUB pos) OF
+ CASE 0: "{"240""240""240"{"
+ CASE 1: "{"240""240""241"{"
+ CASE 2: "{"240""240""242"{"
+ CASE 3: "{"240""240""243"{"
+ CASE 4: "{"240""240""244"{"
+ CASE 5: "{"240""240""245"{"
+ CASE 6: "{"240""240""246"{"
+ CASE 7: "{"240""240""247"{"
+ CASE 8: "{"240""240""248"{"
+ CASE 9: "{"240""240""249"{"
+ CASE 10: "%"
+ CASE 11: "{"240""241""241"{"
+ CASE 12: ""12""
+ CASE 13: ""13""
+ CASE 14: "{"240""241""244"{"
+ CASE 15: "{"240""241""245"{"
+ CASE 16: "{"240""241""246"{"
+ CASE 17: "{"240""241""247"{"
+ CASE 18: "{"240""241""248"{"
+ CASE 19: "{"240""241""249"{"
+ CASE 20: "{"240""242""240"{"
+ CASE 21: "{"240""242""241"{"
+ CASE 22: "{"240""242""242"{"
+ CASE 23: "{"240""242""243"{"
+ CASE 24: "{"240""242""244"{"
+ CASE 25: "{"240""242""245"{"
+ CASE 26: "{"240""242""246"{"
+ CASE 27: "{"240""242""247"{"
+ CASE 28: "{"240""242""248"{"
+ CASE 29: "{"240""242""249"{"
+ CASE 30: "{"240""243""240"{"
+ CASE 31: "{"240""243""241"{"
+ CASE 32: "@"
+ CASE 33: "O"
+ CASE 34: ""
+ CASE 35: "{"
+ CASE 36: "{"240""243""246"{"
+ CASE 37: "l"
+ CASE 38: "P"
+ CASE 39: "}"
+ CASE 40: "M"
+ CASE 41: "]"
+ CASE 42: "\"
+ CASE 43: "N"
+ CASE 44: "k"
+ CASE 45: "`"
+ CASE 46: "K"
+ CASE 47: "a"
+ CASE 48: ""240""
+ CASE 49: ""241""
+ CASE 50: ""242""
+ CASE 51: ""243""
+ CASE 52: ""244""
+ CASE 53: ""245""
+ CASE 54: ""246""
+ CASE 55: ""247""
+ CASE 56: ""248""
+ CASE 57: ""249""
+ CASE 58: "z"
+ CASE 59: "^"
+ CASE 60: "L"
+ CASE 61: "~"
+ CASE 62: "n"
+ CASE 63: "o"
+ CASE 64: "|"
+ CASE 65: ""
+ CASE 66: ""
+ CASE 67: ""
+ CASE 68: ""
+ CASE 69: ""
+ CASE 70: ""
+ CASE 71: ""
+ CASE 72: ""
+ CASE 73: ""
+ CASE 74: ""
+ CASE 75: ""
+ CASE 76: ""
+ CASE 77: ""
+ CASE 78: ""
+ CASE 79: ""
+ CASE 80: ""
+ CASE 81: ""
+ CASE 82: ""
+ CASE 83: ""226""
+ CASE 84: ""227""
+ CASE 85: ""228""
+ CASE 86: ""229""
+ CASE 87: ""230""
+ CASE 88: ""231""
+ CASE 89: ""232""
+ CASE 90: ""233""
+ CASE 91: "J"
+ CASE 92: ""224""
+ CASE 93: "Z"
+ CASE 94: "{"240""249""244"{"
+ CASE 95: "m"
+ CASE 96: "y"
+ CASE 97: ""
+ CASE 98: ""
+ CASE 99: ""
+ CASE 100: ""
+ CASE 101: ""
+ CASE 102: ""
+ CASE 103: ""
+ CASE 104: ""
+ CASE 105: ""
+ CASE 106: ""
+ CASE 107: ""
+ CASE 108: ""
+ CASE 109: ""
+ CASE 110: ""
+ CASE 111: ""
+ CASE 112: ""
+ CASE 113: ""
+ CASE 114: ""
+ CASE 115: ""
+ CASE 116: ""
+ CASE 117: ""
+ CASE 118: ""
+ CASE 119: ""
+ CASE 120: ""
+ CASE 121: ""
+ CASE 122: ""
+ CASE 123: ""
+ CASE 124: "{"241""242""244"{"
+ CASE 125: ""
+ CASE 126: ""
+ CASE 127: "{"241""242""247"{"
+ CASE 128: "{"241""242""248"{"
+ CASE 129: "{"241""242""249"{"
+ CASE 130: "{"241""243""240"{"
+ CASE 131: "{"241""243""241"{"
+ CASE 132: "{"241""243""242"{"
+ CASE 133: "{"241""243""243"{"
+ CASE 134: "{"241""243""244"{"
+ CASE 135: "{"241""243""245"{"
+ CASE 136: "{"241""243""246"{"
+ CASE 137: "{"241""243""247"{"
+ CASE 138: "{"241""243""248"{"
+ CASE 139: "{"241""243""249"{"
+ CASE 140: "{"241""244""240"{"
+ CASE 141: "{"241""244""241"{"
+ CASE 142: "{"241""244""242"{"
+ CASE 143: "{"241""244""243"{"
+ CASE 144: "{"241""244""244"{"
+ CASE 145: "{"241""244""245"{"
+ CASE 146: "{"241""244""246"{"
+ CASE 147: "{"241""244""247"{"
+ CASE 148: "{"241""244""248"{"
+ CASE 149: "{"241""244""249"{"
+ CASE 150: "{"241""245""240"{"
+ CASE 151: "{"241""245""241"{"
+ CASE 152: "{"241""245""242"{"
+ CASE 153: "{"241""245""243"{"
+ CASE 154: "{"241""245""244"{"
+ CASE 155: "{"241""245""245"{"
+ CASE 156: "{"241""245""246"{"
+ CASE 157: "{"241""245""247"{"
+ CASE 158: "{"241""245""248"{"
+ CASE 159: "{"241""245""249"{"
+ CASE 160: "{"241""246""240"{"
+ CASE 161: "{"241""246""241"{"
+ CASE 162: "{"241""246""242"{"
+ CASE 163: "{"241""246""243"{"
+ CASE 164: "{"241""246""244"{"
+ CASE 165: "{"241""246""245"{"
+ CASE 166: "{"241""246""246"{"
+ CASE 167: "{"241""246""247"{"
+ CASE 168: "{"241""246""248"{"
+ CASE 169: "{"241""246""249"{"
+ CASE 170: "{"241""247""240"{"
+ CASE 171: "{"241""247""241"{"
+ CASE 172: "{"241""247""242"{"
+ CASE 173: "{"241""247""243"{"
+ CASE 174: "{"241""247""244"{"
+ CASE 175: "{"241""247""245"{"
+ CASE 176: "{"241""247""246"{"
+ CASE 177: "{"241""247""247"{"
+ CASE 178: "{"241""247""248"{"
+ CASE 179: "{"241""247""249"{"
+ CASE 180: "{"241""248""240"{"
+ CASE 181: "{"241""248""241"{"
+ CASE 182: "{"241""248""242"{"
+ CASE 183: "{"241""248""243"{"
+ CASE 184: "{"241""248""244"{"
+ CASE 185: "{"241""248""245"{"
+ CASE 186: "{"241""248""246"{"
+ CASE 187: "{"241""248""247"{"
+ CASE 188: "{"241""248""248"{"
+ CASE 189: "{"241""248""249"{"
+ CASE 190: "{"241""249""240"{"
+ CASE 191: "{"241""249""241"{"
+ CASE 192: "{"241""249""242"{"
+ CASE 193: "{"241""249""243"{"
+ CASE 194: "{"241""249""244"{"
+ CASE 195: "{"241""249""245"{"
+ CASE 196: "{"241""249""246"{"
+ CASE 197: "{"241""249""247"{"
+ CASE 198: "{"241""249""248"{"
+ CASE 199: "{"241""249""249"{"
+ CASE 200: "{"242""240""240"{"
+ CASE 201: "{"242""240""241"{"
+ CASE 202: "{"242""240""242"{"
+ CASE 203: "{"242""240""243"{"
+ CASE 204: "{"242""240""244"{"
+ CASE 205: "{"242""240""245"{"
+ CASE 206: "{"242""240""246"{"
+ CASE 207: "{"242""240""247"{"
+ CASE 208: "{"242""240""248"{"
+ CASE 209: "{"242""240""249"{"
+ CASE 210: "{"242""241""240"{"
+ CASE 211: "{"242""241""241"{"
+ CASE 212: "{"242""241""242"{"
+ CASE 213: "{"242""241""243"{"
+ CASE 214: "{"242""241""244"{"
+ CASE 215: "{"242""241""245"{"
+ CASE 216: "{"242""241""246"{"
+ CASE 217: "{"242""241""247"{"
+ CASE 218: "{"242""241""248"{"
+ CASE 219: "{"242""241""249"{"
+ CASE 220: ""
+ CASE 221: "`"
+ CASE 222: "{"
+ CASE 223: "@"
+ CASE 224: "{"242""242""244"{"
+ CASE 225: "{"242""242""245"{"
+ CASE 226: "{"242""242""246"{"
+ CASE 227: "{"242""242""247"{"
+ CASE 228: "{"242""242""248"{"
+ CASE 229: "{"242""242""249"{"
+ CASE 230: "{"242""243""240"{"
+ CASE 231: "{"242""243""241"{"
+ CASE 232: "{"242""243""242"{"
+ CASE 233: "{"242""243""243"{"
+ CASE 234: "{"242""243""244"{"
+ CASE 235: "{"242""243""245"{"
+ CASE 236: "{"242""243""246"{"
+ CASE 237: "{"242""243""247"{"
+ CASE 238: "{"242""243""248"{"
+ CASE 239: "{"242""243""249"{"
+ CASE 240: "{"242""244""240"{"
+ CASE 241: "{"242""244""241"{"
+ CASE 242: "{"242""244""242"{"
+ CASE 243: "{"242""244""243"{"
+ CASE 244: "{"242""244""244"{"
+ CASE 245: "{"242""244""245"{"
+ CASE 246: "{"242""244""246"{"
+ CASE 247: "{"242""244""247"{"
+ CASE 248: "{"242""244""248"{"
+ CASE 249: "{"242""244""249"{"
+ CASE 250: "{"242""245""240"{"
+ CASE 251: "{"242""245""241"{"
+ CASE 252: "{"242""245""242"{"
+ CASE 253: "{"242""245""243"{"
+ CASE 254: "{"242""245""244"{"
+ CASE 255: "{"242""245""245"{"
+ OTHERWISE ""
+ END SELECT.
+
+END PROC eumel to ebcdic with substitution;
+
+PROC ebcdic to eumel with substitution (TEXT VAR string):
+ bild := "";
+ INT VAR pos;
+ FOR pos FROM 1 UPTO LENGTH string REP
+ bild CAT conversion
+ PER;
+ string := bild.
+
+conversion:
+ SELECT code (string SUB pos) OF
+ CASE 0: "#000#"
+ CASE 1: "#001#"
+ CASE 2: "#002#"
+ CASE 3: "#003#"
+ CASE 4: "#004#"
+ CASE 5: "#005#"
+ CASE 6: "#006#"
+ CASE 7: "#007#"
+ CASE 8: "#008#"
+ CASE 9: "#009#"
+ CASE 10: "#010#"
+ CASE 11: "#011#"
+ CASE 12: "#012#"
+ CASE 13: "#013#"
+ CASE 14: "#014#"
+ CASE 15: "#015#"
+ CASE 16: "#016#"
+ CASE 17: "#017#"
+ CASE 18: "#018#"
+ CASE 19: "#019#"
+ CASE 20: "#020#"
+ CASE 21: "#021#"
+ CASE 22: "#022#"
+ CASE 23: "#023#"
+ CASE 24: "#024#"
+ CASE 25: "#025#"
+ CASE 26: "#026#"
+ CASE 27: "#027#"
+ CASE 28: "#028#"
+ CASE 29: "#029#"
+ CASE 30: "#030#"
+ CASE 31: "#031#"
+ CASE 32: "#032#"
+ CASE 33: "#033#"
+ CASE 34: "#034#"
+ CASE 35: "#035#"
+ CASE 36: "#036#"
+ CASE 37: "#037#"
+ CASE 38: "#038#"
+ CASE 39: "#039#"
+ CASE 40: "#040#"
+ CASE 41: "#041#"
+ CASE 42: "#042#"
+ CASE 43: "#043#"
+ CASE 44: "#044#"
+ CASE 45: "#045#"
+ CASE 46: "#046#"
+ CASE 47: "#047#"
+ CASE 48: "#048#"
+ CASE 49: "#049#"
+ CASE 50: "#050#"
+ CASE 51: "#051#"
+ CASE 52: "#052#"
+ CASE 53: "#053#"
+ CASE 54: "#054#"
+ CASE 55: "#055#"
+ CASE 56: "#056#"
+ CASE 57: "#057#"
+ CASE 58: "#058#"
+ CASE 59: "#059#"
+ CASE 60: "#060#"
+ CASE 61: "#061#"
+ CASE 62: "#062#"
+ CASE 63: "#063#"
+ CASE 64: "#064#"
+ CASE 65: "#065#"
+ CASE 66: "#066#"
+ CASE 67: "#067#"
+ CASE 68: "#068#"
+ CASE 69: "#069#"
+ CASE 70: "#070#"
+ CASE 71: "#071#"
+ CASE 72: "#072#"
+ CASE 73: "#073#"
+ CASE 74: "["
+ CASE 75: "."
+ CASE 76: "<"
+ CASE 77: "("
+ CASE 78: "+"
+ CASE 79: "!"
+ CASE 80: "&"
+ CASE 81: "#081#"
+ CASE 82: "#082#"
+ CASE 83: "#083#"
+ CASE 84: "#084#"
+ CASE 85: "#085#"
+ CASE 86: "#086#"
+ CASE 87: "#087#"
+ CASE 88: "#088#"
+ CASE 89: "#089#"
+ CASE 90: "]"
+ CASE 91: "$"
+ CASE 92: "*"
+ CASE 93: ")"
+ CASE 94: ";"
+ CASE 95: "^"
+ CASE 96: "-"
+ CASE 97: "/"
+ CASE 98: "#098#"
+ CASE 99: "#099#"
+ CASE 100: "#100#"
+ CASE 101: "#101#"
+ CASE 102: "#102#"
+ CASE 103: "#103#"
+ CASE 104: "#104#"
+ CASE 105: "#105#"
+ CASE 106: "|"
+ CASE 107: ","
+ CASE 108: "%"
+ CASE 109: "_"
+ CASE 110: ">"
+ CASE 111: "?"
+ CASE 112: "#112#"
+ CASE 113: "#113#"
+ CASE 114: "#114#"
+ CASE 115: "#115#"
+ CASE 116: "#116#"
+ CASE 117: "#117#"
+ CASE 118: "#118#"
+ CASE 119: "#119#"
+ CASE 120: "#120#"
+ CASE 121: "`"
+ CASE 122: ":"
+ CASE 123: "#"
+ CASE 124: "@"
+ CASE 125: "'"
+ CASE 126: "="
+ CASE 127: """"
+ CASE 128: "#128#"
+ CASE 129: "a"
+ CASE 130: "b"
+ CASE 131: "c"
+ CASE 132: "d"
+ CASE 133: "e"
+ CASE 134: "f"
+ CASE 135: "g"
+ CASE 136: "h"
+ CASE 137: "i"
+ CASE 138: "#138#"
+ CASE 139: "#139#"
+ CASE 140: "#140#"
+ CASE 141: "#141#"
+ CASE 142: "#142#"
+ CASE 143: "#143#"
+ CASE 144: "#144#"
+ CASE 145: "j"
+ CASE 146: "k"
+ CASE 147: "l"
+ CASE 148: "m"
+ CASE 149: "n"
+ CASE 150: "o"
+ CASE 151: "p"
+ CASE 152: "q"
+ CASE 153: "r"
+ CASE 154: "#154#"
+ CASE 155: "#155#"
+ CASE 156: "#156#"
+ CASE 157: "#157#"
+ CASE 158: "#158#"
+ CASE 159: "#159#"
+ CASE 160: "#160#"
+ CASE 161: "~"
+ CASE 162: "s"
+ CASE 163: "t"
+ CASE 164: "u"
+ CASE 165: "v"
+ CASE 166: "w"
+ CASE 167: "x"
+ CASE 168: "y"
+ CASE 169: "z"
+ CASE 170: "#170#"
+ CASE 171: "#171#"
+ CASE 172: "#172#"
+ CASE 173: "#173#"
+ CASE 174: "#174#"
+ CASE 175: "#175#"
+ CASE 176: "#176#"
+ CASE 177: "#177#"
+ CASE 178: "#178#"
+ CASE 179: "#179#"
+ CASE 180: "#180#"
+ CASE 181: "#181#"
+ CASE 182: "#182#"
+ CASE 183: "#183#"
+ CASE 184: "#184#"
+ CASE 185: "#185#"
+ CASE 186: "#186#"
+ CASE 187: "#187#"
+ CASE 188: "#188#"
+ CASE 189: "#189#"
+ CASE 190: "#190#"
+ CASE 191: "#191#"
+ CASE 192: "{"
+ CASE 193: "A"
+ CASE 194: "B"
+ CASE 195: "C"
+ CASE 196: "D"
+ CASE 197: "E"
+ CASE 198: "F"
+ CASE 199: "G"
+ CASE 200: "H"
+ CASE 201: "I"
+ CASE 202: "#202#"
+ CASE 203: "#203#"
+ CASE 204: "#204#"
+ CASE 205: "#205#"
+ CASE 206: "#206#"
+ CASE 207: "#207#"
+ CASE 208: "}"
+ CASE 209: "J"
+ CASE 210: "K"
+ CASE 211: "L"
+ CASE 212: "M"
+ CASE 213: "N"
+ CASE 214: "O"
+ CASE 215: "P"
+ CASE 216: "Q"
+ CASE 217: "R"
+ CASE 218: "#218#"
+ CASE 219: "#219#"
+ CASE 220: "#220#"
+ CASE 221: "#221#"
+ CASE 222: "#222#"
+ CASE 223: "#223#"
+ CASE 224: "\"
+ CASE 225: "#225#"
+ CASE 226: "S"
+ CASE 227: "T"
+ CASE 228: "U"
+ CASE 229: "V"
+ CASE 230: "W"
+ CASE 231: "X"
+ CASE 232: "Y"
+ CASE 233: "Z"
+ CASE 234: "#234#"
+ CASE 235: "#235#"
+ CASE 236: "#236#"
+ CASE 237: "#237#"
+ CASE 238: "#238#"
+ CASE 239: "#239#"
+ CASE 240: "0"
+ CASE 241: "1"
+ CASE 242: "2"
+ CASE 243: "3"
+ CASE 244: "4"
+ CASE 245: "5"
+ CASE 246: "6"
+ CASE 247: "7"
+ CASE 248: "8"
+ CASE 249: "9"
+ CASE 250: "#250#"
+ CASE 251: "#251#"
+ CASE 252: "#252#"
+ CASE 253: "#253#"
+ CASE 254: "#254#"
+ CASE 255: "#255#"
+ OTHERWISE ""
+ END SELECT.
+END PROC ebcdic to eumel with substitution;
+
+END PACKET eumel ebcdic;
diff --git a/system/dos/1986/src/fat and dir.dos.fd b/system/dos/1986/src/fat and dir.dos.fd new file mode 100644 index 0000000..35cf118 --- /dev/null +++ b/system/dos/1986/src/fat and dir.dos.fd @@ -0,0 +1,1190 @@ +PACKET dos fat and dir DEFINES (* Copyright (C) 1985, 86 *)
+ (* Frank Klapper *)
+ open disk, (* 30.05.86 *)
+ close disk,
+ format disk,
+ disk changed,
+ open fetch,
+ next fetch cluster no,
+ open save,
+ next save cluster no,
+ close save,
+ erase table entrys,
+(*COND TEST
+ dump fat,
+ENDCOND*)
+ dir all,
+ dir list,
+ dir contains:
+
+LET fat row size = 16384, (* 32 KB *)
+ max fat blocks = 25,
+ first fat entry no = 2,
+ last entry of fat chain = 4088,
+ dir entrys per block = 16,
+ max dir entrys = 1600, (* 100 KB *)
+ archive byte = " ";
+
+LET FAT = BOUND STRUCT (ALIGN dummy,
+ ROW 256 INT block row,
+ ROW fat row size INT fat row);
+
+LET LOCATION = STRUCT (INT msdos block no,
+ block entry no),
+
+ FILEENTRY = STRUCT (TEXT date and time,
+ REAL size,
+ INT first cluster,
+ LOCATION location),
+
+ DIRENTRY = INT,
+
+ FILELIST = STRUCT (THESAURUS thes,
+ ROW max dir entrys FILEENTRY entry,
+ INT no of entrys),
+
+ DIRLIST = STRUCT (THESAURUS thes,
+ ROW max dir entrys DIRENTRY entry,
+ INT no of entrys),
+
+ FREELIST = STRUCT (ROW max dir entrys LOCATION stack,
+ INT stacktop,
+ LOCATION begin of free area,
+ end of dir,
+ INT dir chain root),
+
+ DIR = BOUND STRUCT (FILELIST filelist,
+ DIRLIST dirlist,
+ FREELIST freelist,
+ TEXT disklabel,
+ path);
+
+INITFLAG VAR this packet := FALSE;
+
+DATASPACE VAR fat space,
+ dir ds,
+ block ds;
+
+BOOL VAR dataspaces open;
+
+FAT VAR fat struct;
+ROW max fat blocks BOOL VAR write access;
+INT VAR first possible available fat entry;
+
+DIR VAR dir;
+
+CLUSTER VAR block;
+
+INT VAR akt file cluster no,
+ first file cluster no;
+BOOL VAR no cluster saved;
+TEXT VAR save name;
+
+INT VAR count;
+
+TEXT VAR convert buffer := " ",
+ name,
+ dir entry;
+
+.fat:
+ fat struct.fat row.
+
+PROC open disk (TEXT CONST subdir path):
+ disable stop;
+ enable open disk (subdir path);
+ IF is error
+ THEN close action
+ FI
+
+END PROC open disk;
+
+PROC enable open disk (TEXT CONST subdir path):
+ enable stop;
+ init dataspaces;
+ open fat;
+ open dir.
+
+open fat:
+ reset disk attributes;
+ read first fat block;
+ set disk attributes (fat byte (0));
+ read other fat blocks;
+ define write access table (FALSE);
+ first possible available fat entry := first fat entry no.
+
+read first fat block:
+ read fat block (0, FALSE).
+
+read other fat blocks:
+ INT VAR block no;
+ FOR block no FROM 1 UPTO number of fat sectors - 1 REP
+ read fat block (block no, FALSE)
+ PER.
+
+open dir:
+ init dir struct (subdir path, -1);
+ load main dir blocks;
+ load subdirs if necessary.
+
+load main dir blocks:
+ BOOL VAR last block;
+ store end of dir (loc (end of main dir, dir entrys per block - 1));
+ FOR block no FROM begin of dir UPTO end of main dir REP
+ load dir block (block no, last block);
+ UNTIL last block
+ PER.
+
+end of main dir:
+ begin of dir + number of dir sectors - 1.
+
+load subdirs if necessary:
+ TEXT VAR path := subdir path;
+ WHILE path <> "" REP
+ load next subdir if possible
+ PER.
+
+load next subdir if possible:
+ INT VAR cluster no;
+ get next subdir name;
+ get first cluster no of subdir table;
+ clear dir entrys (cluster no);
+ WHILE cluster no >= 0 REP
+ load subdir entrys of cluster;
+ cluster no := next fetch cluster no
+ UNTIL last block
+ PER.
+
+get next subdir name:
+ TEXT VAR subdir name;
+ IF (path SUB 1) <> "\"
+ THEN error stop ("ungültige Pfadbezeichnung")
+ FI;
+ INT VAR backslash pos := pos (path, "\", "\", 2);
+ IF backslash pos = 0
+ THEN subdir name := subtext (path, 2);
+ path := ""
+ ELSE subdir name := subtext (path, 2, backslash pos - 1);
+ path := subtext (path, backslash pos)
+ FI;
+ subdir name := adapted name (subdir name, TRUE).
+
+get first cluster no of subdir table:
+ IF dir thes CONTAINS subdir name
+ THEN open fetch subdir (subdir name, cluster no);
+ ELSE error stop ("Subdirectory existiert nicht")
+ FI.
+
+load subdir entrys of cluster:
+ store end of dir (loc (last block no of cluster, dir entrys per block - 1));
+ FOR block no FROM 0 UPTO (sectors per cluster - 1) REP
+ load dir block (first block no of cluster (cluster no) + block no, last block)
+ UNTIL last block
+ PER.
+
+last block no of cluster:
+ first block no of cluster (cluster no) + sectors per cluster - 1.
+
+END PROC enable open disk;
+
+PROC init dataspaces:
+ enable stop;
+ IF NOT initialized (this packet)
+ THEN dataspaces open := FALSE
+ FI;
+ IF NOT dataspaces open
+ THEN disable stop;
+ dataspaces open := TRUE;
+ fat space := nilspace;
+ dir ds := nilspace;
+ block ds := nilspace;
+ fat struct := fat space;
+ dir := dir ds;
+ block := block ds
+ FI.
+
+END PROC init dataspaces;
+
+PROC init dir struct (TEXT CONST path string, INT CONST root):
+ clear dir entrys (root);
+ dir.path := path string;
+ dir.disk label := "".
+
+END PROC init dir struct;
+
+PROC clear dir entrys (INT CONST root):
+ init file list;
+ init dir list;
+ init free list (root).
+
+init file list:
+ dir.file list.thes := empty thesaurus;
+ dir.file list.no of entrys := 0.
+
+init dir list:
+ dir.dir list.thes := empty thesaurus;
+ dir.dir list.no of entrys := 0.
+
+END PROC clear dir entrys;
+
+PROC close disk:
+ enable stop;
+ IF NOT initialized (this packet)
+ THEN dataspaces open := FALSE
+ FI;
+ IF dataspaces open
+ THEN forget (dir ds);
+ forget (block ds);
+ forget (fat space);
+ dataspaces open := FALSE
+ FI.
+
+END PROC close disk;
+
+(*COND FLOPPY*)
+PROC format disk:
+ enable stop;
+ init dataspaces;
+ format fat;
+ format dir.
+
+format fat:
+ write first four fat bytes;
+ write other fat bytes;
+ define write access table (TRUE);
+ copy fat to disk.
+
+write first four fat bytes:
+ fat [1] := word (first fat byte, 255);
+ fat [2] := word (255, 0).
+
+write other fat bytes:
+ FOR count FROM 3 UPTO fat length REP
+ fat [count] := 0
+ PER.
+
+fat length:
+ INT VAR len := number of fat entrys + number of fat entrys DIV 2
+ + number of fat entrys MOD 2;
+ len DIV 2 + len MOD 2.
+
+format dir:
+ init dir struct ("", -1);
+ store begin of free area (loc (begin of dir, 0));
+ store end of dir (loc (end of dir, dir entrys per block - 1));
+ FOR count FROM 0 UPTO dir entrys per block - 1 REP
+ write text 32 (block, ""0"" + 31 * ""246"", count)
+ PER;
+ disable stop;
+ FOR count FROM begin of dir UPTO end of dir REP
+ write disk block (block ds, count);
+ PER.
+
+end of dir:
+ begin of dir + number of dir sectors - 1.
+
+END PROC format disk;
+(*ENDCOND*)
+
+(*COND HDU
+PROC disk clear:
+ error stop ("nicht implementiert")
+
+END PROC disk clear;
+
+PROC format disk:
+ error stop ("nicht implementiert")
+
+END PROC format disk;
+ENDCOND*)
+
+INT PROC word (INT CONST low byte, high byte):
+ convert buffer := code (low byte) + code (high byte);
+ convert buffer ISUB 1.
+
+END PROC word;
+
+BOOL PROC disk changed:
+(*COND FLOPPY*)
+ disable stop;
+ NOT first fat block ok COR is error (* must be COR *)
+(*ENDCOND*)
+(*COND HDU
+ FALSE
+ENDCOND*)
+
+END PROC disk changed;
+
+BOOL PROC first fat block ok:
+ enable stop;
+ read fat block (0, TRUE);
+ FOR count FROM 1 UPTO 256 REP
+ compare word
+ PER;
+ TRUE.
+
+compare word:
+ IF fat struct.fat row [count] <> fat struct.block row [count]
+ THEN LEAVE first fat block ok WITH FALSE
+ FI.
+
+END PROC first fat block ok;
+
+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):
+ enable stop;
+ first cluster no := dir.file list.entry [link index].first cluster;
+ size := dir.file list.entry [link index].size;
+ IF first cluster no >= 4088
+ THEN first cluster no := -1
+ FI;
+ akt file cluster no := first cluster no.
+
+link index:
+ link (file thes, name).
+
+END PROC open fetch;
+
+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):
+ first cluster no := dir.dir list.entry [link index];
+ IF first cluster no >= 4088
+ THEN first cluster no := -1
+ FI;
+ akt file cluster no := first cluster no.
+
+link index:
+ link (dir thes, subdir name).
+
+END PROC open fetch subdir;
+
+INT PROC next fetch cluster no:
+ enable stop;
+ akt file cluster no := fat entry (akt file cluster no);
+ IF akt file cluster no < 4088 (*ff8h *)
+ THEN akt file cluster no
+ ELSE -1
+ FI.
+
+END PROC next fetch cluster no;
+
+PROC open save (TEXT CONST file name):
+ enable stop;
+ save name := file name;
+ IF dir full
+ THEN error stop ("Directory voll")
+ FI;
+ IF dir thes CONTAINS file name
+ THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")
+ FI;
+ IF file thes CONTAINS file name
+ THEN error stop ("Datei mit gleichem Namen existiert bereits")
+ FI;
+ no cluster saved := TRUE.
+
+END PROC open save;
+
+INT PROC next save cluster no:
+ enable stop;
+ IF no cluster saved
+ THEN akt file cluster no := available fat entry;
+ first file cluster no := akt file cluster no;
+ no cluster saved := FALSE
+ ELSE INT VAR old cluster no := akt file cluster no;
+ akt file cluster no := available fat entry;
+ write fat entry (old cluster no, akt file cluster no)
+ FI;
+ write fat entry (akt file cluster no, last entry of fat chain);
+ akt file cluster no.
+
+END PROC next save cluster no;
+
+PROC close save (REAL CONST size):
+ enable stop;
+ IF no cluster saved
+ THEN insert dir entry (save name, 4088, 0.0)
+ ELSE copy fat to disk;
+ insert dir entry (save name, first file cluster no, size)
+ FI.
+
+END PROC close save;
+
+PROC erase table entrys (TEXT CONST name):
+ enable stop;
+ INT VAR first file cluster := first cluster;
+ delete dir entry (name);
+ erase fat chain (first file cluster);
+ copy fat to disk.
+
+first cluster:
+ dir.file list.entry [link index].first cluster.
+
+link index:
+ link (file thes, name).
+
+END PROC erase table entrys;
+
+INT PROC fat entry (INT CONST entry no):
+ fix bytes;
+ construct value.
+
+fix bytes:
+ INT VAR first byte no := entry no + entry no DIV 2.
+
+construct value:
+ IF entry no MOD 2 = 0
+ THEN (right byte MOD 16) * 256 + left byte
+ ELSE 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;
+
+INT PROC available fat entry:
+ FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP
+ IF is available entry (count)
+ THEN first possible available fat entry := count;
+ LEAVE available fat entry WITH count
+ FI;
+ PER;
+ close action; error stop ("MS-DOS Datentraeger voll"); maxint.
+
+END PROC available fat entry;
+
+BOOL PROC is available entry (INT CONST entry no):
+ is zero entry.
+
+is zero entry:
+ IF entry no MOD 2 = 0
+ THEN (left byte = 0) CAND ((right byte MOD 16) = 0)
+ ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)
+ FI.
+
+left byte:
+ fat byte (first byte no).
+
+right byte:
+ fat byte (first byte no + 1).
+
+first byte no:
+ entry no + entry no DIV 2.
+
+END PROC is available entry;
+
+PROC erase fat chain (INT CONST first entry):
+ INT VAR akt entry no := first entry,
+ entry := fat entry (akt entry no);
+ WHILE akt entry no not last chain entry no REP
+ erase akt entry;
+ akt entry no := entry;
+ entry := fat entry (akt entry no)
+ PER;
+ erase akt entry.
+
+akt entry no not last chain entry no:
+ (entry < last entry of fat chain) AND (entry > 1).
+
+erase akt entry:
+ write fat entry (akt entry no, 0).
+
+END PROC erase fat chain;
+
+PROC write fat entry (INT CONST entry no, value):
+ fix bytes;
+ remark write access (fat block of first byte);
+ remark write access (fat block of second byte);
+ write value;
+ update first possible available entry.
+
+fix bytes:
+ INT VAR first byte no := entry no + entry no DIV 2.
+
+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 first possible available fat entry :=
+ min (first possible available fat entry, entry no)
+ FI.
+
+END PROC write fat entry;
+
+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 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;
+
+PROC copy fat to disk:
+ INT VAR block no;
+ FOR block no FROM 0 UPTO number of fat sectors - 1 REP
+ IF was write access (block no)
+ THEN write fat block (block no)
+ FI
+ PER.
+
+END PROC copy fat to disk;
+
+PROC write fat block (INT CONST fat block no):
+ INT VAR fat copy no;
+ INT VAR return code;
+ disable stop;
+ FOR fat copy no FROM 0 UPTO number of fat copies -1 REP
+ write disk block (fat space, ds page no, block no, return code);
+ IF return code > 0
+ THEN close action
+ FI
+ PER;
+ remark no write access (block no);
+ enable stop.
+
+ds page no:
+ first non dummy ds page + fat block no + 1.
+
+block no:
+ begin of fat (fat copy no) + fat block no.
+
+END PROC write fat block;
+
+PROC read fat block (INT CONST fat block, BOOL CONST test block):
+ INT VAR fat copy no;
+ disable stop;
+ FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP
+ clear error;
+ read disk block (fat space, ds page no, fat block no)
+ UNTIL NOT is error
+ PER;
+ IF is error
+ THEN close action
+ FI;
+ enable stop.
+
+ds page no:
+ IF test block
+ THEN first non dummy ds page
+ ELSE fat block + first non dummy ds page + 1
+ FI.
+
+fat block no:
+ begin of fat (fat copy no) + fat block.
+
+END PROC read fat block;
+
+PROC define write access table (BOOL CONST status):
+ FOR count FROM 1 UPTO number of fat sectors REP
+ write access [count] := status
+ PER.
+
+END PROC define write access table;
+
+PROC remark write access (INT CONST fat block no):
+ write access [fat block no + 1] := TRUE
+
+END PROC remark write access;
+
+PROC remark no write access (INT CONST fat block no):
+ write access [fat block no + 1] := FALSE
+
+END PROC remark no write access;
+
+BOOL PROC was write access (INT CONST fat block no):
+ write access [fat block no + 1]
+
+END PROC was write access;
+
+(*COND TEST
+PROC dump fat:
+ IF NOT exists ("fat dump")
+ THEN open file
+ FI;
+ DATASPACE VAR ds := nilspace;
+ FILE VAR in := sequential file (input, "fat dump"),
+ out := sequential file (output, ds);
+ INT VAR i;
+ TEXT VAR line;
+ FOR i FROM 0 UPTO number of fat entrys - 1 REP
+ dump fat entry
+ PER;
+ forget ("fat dump", quiet);
+ copy (ds, "fat dump");
+ forget (ds).
+
+open file:
+ in := sequential file (output, "fat dump");
+ FOR i FROM 0 UPTO number of fat entrys - 1 REP
+ putline (in, text (i, 4) + ": ")
+ PER.
+
+dump fat entry:
+ cout (i);
+ getline (in, line);
+ putline (out, line + " " + text (fat entry (i), 4)).
+
+END PROC dump fat;
+ENDCOND*)
+
+PROC load dir block (INT CONST block no, BOOL VAR last block):
+ last block := FALSE;
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ INT VAR entry no,
+ thes index;
+ FOR entry no FROM 0 UPTO dir entrys per block - 1 REP
+ dir entry := text 32 (block, entry no);
+ process entry
+ PER.
+
+process entry:
+ SELECT pos (""0"."229"", dir entry SUB 1) OF
+ CASE 1: end of dir search
+ CASE 2: main dir entry
+ CASE 3: free entry
+ OTHERWISE file entry
+ END SELECT.
+
+end of dir search:
+ last block := TRUE;
+ store begin of free area (loc (block no, entry no));
+ LEAVE load dir block.
+
+main dir entry:
+ (* no operation *).
+
+free entry:
+ store in free list (loc (block no, entry no)).
+
+file entry:
+ SELECT code (dir entry SUB 12) OF
+ CASE 8: volume label
+ CASE 16: sub dir entry
+ OTHERWISE dos file entry
+ END SELECT.
+
+volume label:
+ dir.disk label := text (dir entry, 1, 11).
+
+sub dir entry:
+ dir.dir list.no of entrys INCR 1;
+ insert (dir thes, name, thes index);
+ dir list entry := first cluster no.
+
+dos file entry:
+ IF dir.file list.no of entrys >= max dir entrys
+ THEN error stop ("Directorytabelle voll")
+ FI;
+ dir.file list.no of entrys INCR 1;
+ insert (file thes, name, thes index);
+ file list entry.first cluster := first cluster no;
+ file list entry.date and time := dos date + " " + dos time;
+ file list entry.size := dos storage;
+ file list entry.location.msdos block no := block no;
+ file list entry.location.block entry no := entry no.
+
+name:
+ IF name post <> ""
+ THEN name pre + "." + name post
+ ELSE name pre
+ FI.
+
+name pre:
+ compress (subtext (dir entry, 1, 8)).
+
+name post:
+ compress (subtext (dir entry, 9, 11)).
+
+file list entry:
+ dir.file list.entry [thes index].
+
+dir list entry:
+ dir.dir list.entry [thes index].
+
+first cluster no:
+ code (dir entry SUB 27) + 256 * code (dir entry SUB 28).
+
+dos storage:
+ real (code (dir entry SUB 29)) +
+ real (code (dir entry SUB 30)) * 256.0 +
+ real (code (dir entry SUB 31)) * 65536.0 +
+ real (code (dir entry SUB 32)) * 16777216.0.
+
+dos date:
+ day + "." + month + "." + year.
+
+day:
+ IF code (dir entry SUB 25) MOD 32 < 10
+ THEN "0" + text (code (dir entry SUB 25) MOD 32)
+ ELSE text (code (dir entry SUB 25) MOD 32)
+ FI.
+
+month:
+ INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+year:
+ text (80 + code (dir entry SUB 26) DIV 2, 2).
+
+dos time:
+ hour + ":" + minute.
+
+hour:
+ dummy := code (dir entry SUB 24) DIV 8;
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+minute:
+ dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8);
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+END PROC load dir block;
+
+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):
+ (* name must be a dos name *)
+ LOCATION VAR ins pos := free location;
+ TEXT VAR akt date := date (clock (1)),
+ akt time := time of day (clock (1));
+ write disk entry;
+ write dir struct entry.
+
+write disk entry:
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ prepare name;
+ dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +
+ dos date + starting cluster + storage;
+ write text 32 (block, dir entry, ins pos.block entry no);
+ write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI.
+
+prepare name:
+ TEXT VAR name pre, name post;
+ IF point pos > 0
+ THEN name pre := subtext (name, 1, point pos - 1);
+ name post := subtext (name, point pos + 1);
+ name pre CAT (8 - LENGTH name pre) * " ";
+ name post CAT (3 - LENGTH name post) * " "
+ ELSE name pre := name + (8 - LENGTH name) * " ";
+ name post := " "
+ FI.
+
+point pos:
+ pos (name, ".").
+
+dos time:
+ code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).
+
+hour:
+ int (subtext (akt time, 1, 2)).
+
+minute:
+ int (subtext (akt time, 4, 5)).
+
+dos date:
+ code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).
+
+day:
+ int (subtext (akt date, 1, 2)).
+
+month:
+ int (subtext (akt date, 4, 5)).
+
+year:
+ int (subtext (akt date, 7, 8)).
+
+starting cluster:
+ code (start cluster MOD 256) + code (start cluster DIV 256).
+
+storage:
+ code (int (round (256.0 * frac (used storage / 256.0), 0))) +
+ code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +
+ code (int (floor (used storage / 65536.0))) +
+ code (0). (* maximal 16384 K *********************************)
+
+write dir struct entry:
+ INT VAR thes link;
+ insert (file thes, name, thes link);
+ file list entry.location := ins pos;
+ file list entry.first cluster := start cluster;
+ file list entry.date and time := akt date + " " + akt time;
+ file list entry.size := used storage.
+
+file list entry:
+ dir.filelist.entry [thes link].
+
+END PROC insert dir entry;
+
+PROC delete dir entry (TEXT CONST name):
+ LOCATION VAR del pos;
+ get del pos;
+ erase dir struct entry;
+ erase disk entry;
+ store in free list (del pos).
+
+get del pos:
+ del pos := dir.filelist.entry [link index].location.
+
+link index:
+ link (file thes, name).
+
+erase dir struct entry:
+ INT VAR i;
+ delete (file thes, name, i).
+
+erase disk entry:
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ dir entry := text 32 (block, del pos.block entry no);
+ replace (dir entry, 1, ""229"");
+ write text 32 (block, dir entry, del pos.block entry no);
+ write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI.
+
+END PROC delete dir entry;
+
+.
+file thes:
+ dir.filelist.thes.
+
+dir thes:
+ dir.dir list.thes.
+
+(*********************** dir information ******************************)
+
+THESAURUS PROC dir all:
+ file thes.
+
+END PROC dir all;
+
+BOOL PROC dir contains (TEXT CONST name):
+ file thes CONTAINS name
+
+END PROC dir contains;
+
+PROC dir list (DATASPACE VAR ds):
+ enable stop;
+ open list file;
+ list files;
+ list dirs;
+ write list head.
+
+open list file:
+ forget (ds);
+ ds := nilspace;
+ FILE VAR list file := sequential file (output, ds);
+ putline (list file, "").
+
+list files:
+ INT VAR number := 0;
+ get (file thes, name, number);
+ WHILE number > 0 REP
+ generate file list line;
+ get (file thes, name, number)
+ PER.
+
+generate file list line:
+ write (list file, centered name);
+ write (list file, " ");
+ write (list file, text (act file entry.size, 11, 0));
+ write (list file, " Bytes belegt ");
+ write (list file, act file entry.date and time);
+(*COND TEST
+ write (list file, " +++ ");
+ write (list file, text (act file entry.first cluster));
+ENDCOND*)
+ line (list file).
+
+list dirs:
+ number := 0;
+ get (dir thes, name, number);
+ WHILE number > 0 REP
+ generate dir list line;
+ get (dir thes, name, number)
+ PER.
+
+generate dir list line:
+ write (list file, centered name);
+ write (list file, " <DIR>");
+(*COND TEST
+ write (list file, " +++ ");
+ write (list file, text (dir.dir list.entry [number]));
+ENDCOND*)
+ line (list file).
+
+centered name:
+ INT VAR point pos := pos (name, ".");
+ IF point pos > 0
+ THEN name pre + "." + name post
+ ELSE text (name, 12)
+ FI.
+
+name pre:
+ text (subtext (name, 1, point pos - 1), 8).
+
+name post:
+ text (subtext (name, point pos + 1, point pos + 4), 3).
+
+act file entry:
+ dir.file list.entry [number].
+
+write list head:
+ head line (list file, head).
+
+head:
+ "DOS" + disk label string + path string.
+
+disk label string:
+ IF dir.disk label <> ""
+ THEN ": " + dir.disk label
+ ELSE ""
+ FI.
+
+path string:
+ IF dir.path <> ""
+ THEN " PATH: " + dir.path
+ ELSE ""
+ FI.
+
+END PROC dir list;
+
+(************ free list handling ******************************************)
+LOCATION PROC loc (INT CONST block, entry):
+ LOCATION : (block, entry)
+
+END PROC loc;
+
+BOOL OP > (LOCATION CONST l, r):
+ l.msdos block no > r.msdos block no
+ OR ((l.msdos block no = r.msdos block no) AND
+ (l.block entry no > r.block entry no) )
+
+END OP >;
+
+OP INCR (LOCATION VAR l):
+ IF l.block entry no = dir entrys per block -1
+ THEN l.block entry no := 0;
+ l.msdos block no INCR 1
+ ELSE l.block entry no INCR 1
+ FI.
+
+END OP INCR;
+
+PROC init free list (INT CONST dir root):
+ dir.freelist.stacktop := 0;
+ dir.freelist.begin of free area.msdos block no := maxint;
+ dir.freelist.end of dir.msdos block no := -1;
+ dir.freelist.dir chain root := dir root.
+
+END PROC init free list;
+
+BOOL PROC dir full:
+ stack empty AND free area empty AND NOT expansion alloweded.
+
+stack empty:
+ dir.freelist.stacktop < 1.
+
+free area empty:
+ dir.freelist.begin of free area > dir.freelist.end of dir.
+
+expansion alloweded:
+ dir.freelist.dir chain root >= 0.
+
+END PROC dir full;
+
+PROC store in free list (LOCATION CONST free):
+ dir.freelist.stacktop INCR 1;
+ dir.freelist.stack [top] := free.
+
+top:
+ dir.freelist.stacktop.
+
+END PROC store in free list;
+
+PROC store begin of free area (LOCATION CONST begin):
+ dir.freelist.begin of free area := begin
+
+END PROC store begin of free area;
+
+PROC store end of dir (LOCATION CONST end):
+ dir.freelist.end of dir := end
+
+END PROC store end of dir;
+
+LOCATION PROC free location:
+ LOCATION VAR result;
+ IF dir.freelist.stacktop > 0
+ THEN pop
+ ELIF NOT free area empty
+ THEN first of free area
+ ELIF expansion alloweded
+ THEN allocate new dir space;
+ result := free location
+ ELSE error stop ("Directorytabelle voll")
+ FI;
+ result.
+
+pop:
+ result := dir.freelist.stack [top];
+ top DECR 1.
+
+top:
+ dir.freelist.stack top.
+
+free area empty:
+ dir.freelist.begin of free area > dir.freelist.end of dir.
+
+first of free area:
+ result := dir.freelist.begin of free area;
+ INCR dir.freelist.begin of free area.
+
+expansion alloweded:
+ dir.freelist.dir chain root >= 0.
+
+END PROC free location;
+
+PROC allocate new dir space:
+ enable stop;
+ INT VAR new cluster no := available fat entry;
+ IF new cluster no < 0
+ THEN error stop ("MS-DOS Datentraeger voll")
+ FI;
+ INT VAR last entry no;
+ search last entry of fat chain;
+ write fat entry (new cluster no, 4095);
+ write fat entry (last entry no, new cluster no);
+ copy fat to disk;
+ store begin of free area (loc (first new block, 0));
+ store end of dir (loc (last new block, dir entrys per block - 1));
+ init new dir cluster.
+
+search last entry of fat chain:
+ last entry no := dir.freelist.dir chain root;
+ WHILE fat entry (last entry no) < last entry of fat chain REP
+ last entry no := fat entry (last entry no)
+ PER.
+
+init new dir cluster:
+ FOR count FROM 0 UPTO dir entrys per block - 1 REP
+ write text 32 (block, ""0"" + 31 * ""246"", count)
+ PER;
+ disable stop;
+ FOR count FROM first new block UPTO last new block REP
+ write disk block (block ds, count);
+ PER.
+
+first new block:
+ firstblock no of cluster (new cluster no).
+
+last new block:
+ first block no of cluster (new cluster no) + sectors per cluster - 1.
+
+END PROC allocate new dir space;
+
+(*COND TEST
+PROC dump freelist:
+ command dialogue (FALSE);
+ FILE VAR f := sequential file (output, "freelistdump");
+ INT VAR i;
+ putline (f, "STACKTOP: " + text (fl.stacktop));
+ putline (f, "STACK:");
+ FOR i FROM 1 UPTO 16 * number of dir sectors REP
+ putline (f, " " + text (i, 4) + ": " +
+ text (fl.stack [i].msdos block no) + ", " +
+ text (fl.stack [i].block entry no))
+ PER;
+ line (f);
+ putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) +
+ ", " + text (fl.begin of free area.block entry no));
+ putline (f, "END OF DIR: " + text (fl.end of dir.msdos block no) +
+ ", " + text (fl.end of dir.block entry no)).
+
+fl:
+ dir.freelist.
+
+END PROC dump free list;
+ENDCOND*)
+
+END PACKET dos fat and dir;
diff --git a/system/dos/1986/src/fat and dir.dos.hd b/system/dos/1986/src/fat and dir.dos.hd new file mode 100644 index 0000000..2612b25 --- /dev/null +++ b/system/dos/1986/src/fat and dir.dos.hd @@ -0,0 +1,1190 @@ +PACKET dos fat and dir DEFINES (* Copyright (C) 1985, 86 *)
+ (* Frank Klapper *)
+ open disk, (* 30.05.86 *)
+ close disk,
+ format disk,
+ disk changed,
+ open fetch,
+ next fetch cluster no,
+ open save,
+ next save cluster no,
+ close save,
+ erase table entrys,
+(*COND TEST
+ dump fat,
+ENDCOND*)
+ dir all,
+ dir list,
+ dir contains:
+
+LET fat row size = 16384, (* 32 KB *)
+ max fat blocks = 25,
+ first fat entry no = 2,
+ last entry of fat chain = 4088,
+ dir entrys per block = 16,
+ max dir entrys = 1600, (* 100 KB *)
+ archive byte = " ";
+
+LET FAT = BOUND STRUCT (ALIGN dummy,
+ ROW 256 INT block row,
+ ROW fat row size INT fat row);
+
+LET LOCATION = STRUCT (INT msdos block no,
+ block entry no),
+
+ FILEENTRY = STRUCT (TEXT date and time,
+ REAL size,
+ INT first cluster,
+ LOCATION location),
+
+ DIRENTRY = INT,
+
+ FILELIST = STRUCT (THESAURUS thes,
+ ROW max dir entrys FILEENTRY entry,
+ INT no of entrys),
+
+ DIRLIST = STRUCT (THESAURUS thes,
+ ROW max dir entrys DIRENTRY entry,
+ INT no of entrys),
+
+ FREELIST = STRUCT (ROW max dir entrys LOCATION stack,
+ INT stacktop,
+ LOCATION begin of free area,
+ end of dir,
+ INT dir chain root),
+
+ DIR = BOUND STRUCT (FILELIST filelist,
+ DIRLIST dirlist,
+ FREELIST freelist,
+ TEXT disklabel,
+ path);
+
+INITFLAG VAR this packet := FALSE;
+
+DATASPACE VAR fat space,
+ dir ds,
+ block ds;
+
+BOOL VAR dataspaces open;
+
+FAT VAR fat struct;
+ROW max fat blocks BOOL VAR write access;
+INT VAR first possible available fat entry;
+
+DIR VAR dir;
+
+CLUSTER VAR block;
+
+INT VAR akt file cluster no,
+ first file cluster no;
+BOOL VAR no cluster saved;
+TEXT VAR save name;
+
+INT VAR count;
+
+TEXT VAR convert buffer := " ",
+ name,
+ dir entry;
+
+.fat:
+ fat struct.fat row.
+
+PROC open disk (TEXT CONST subdir path):
+ disable stop;
+ enable open disk (subdir path);
+ IF is error
+ THEN close action
+ FI
+
+END PROC open disk;
+
+PROC enable open disk (TEXT CONST subdir path):
+ enable stop;
+ init dataspaces;
+ open fat;
+ open dir.
+
+open fat:
+ reset disk attributes;
+ read first fat block;
+ set disk attributes (fat byte (0));
+ read other fat blocks;
+ define write access table (FALSE);
+ first possible available fat entry := first fat entry no.
+
+ read first fat block:
+ read fat block (0, FALSE).
+
+read other fat blocks:
+ INT VAR block no;
+ FOR block no FROM 1 UPTO number of fat sectors - 1 REP
+ read fat block (block no, FALSE)
+ PER.
+
+open dir:
+ init dir struct (subdir path, -1);
+ load main dir blocks;
+ load subdirs if necessary.
+
+load main dir blocks:
+ BOOL VAR last block;
+ store end of dir (loc (end of main dir, dir entrys per block - 1));
+ FOR block no FROM begin of dir UPTO end of main dir REP
+ load dir block (block no, last block);
+ UNTIL last block
+ PER.
+
+end of main dir:
+ begin of dir + number of dir sectors - 1.
+
+load subdirs if necessary:
+ TEXT VAR path := subdir path;
+ WHILE path <> "" REP
+ load next subdir if possible
+ PER.
+
+load next subdir if possible:
+ INT VAR cluster no;
+ get next subdir name;
+ get first cluster no of subdir table;
+ clear dir entrys (cluster no);
+ WHILE cluster no >= 0 REP
+ load subdir entrys of cluster;
+ cluster no := next fetch cluster no
+ UNTIL last block
+ PER.
+
+get next subdir name:
+ TEXT VAR subdir name;
+ IF (path SUB 1) <> "\"
+ THEN error stop ("ungültige Pfadbezeichnung")
+ FI;
+ INT VAR backslash pos := pos (path, "\", "\", 2);
+ IF backslash pos = 0
+ THEN subdir name := subtext (path, 2);
+ path := ""
+ ELSE subdir name := subtext (path, 2, backslash pos - 1);
+ path := subtext (path, backslash pos)
+ FI;
+ subdir name := adapted name (subdir name, TRUE).
+
+get first cluster no of subdir table:
+ IF dir thes CONTAINS subdir name
+ THEN open fetch subdir (subdir name, cluster no);
+ ELSE error stop ("Subdirectory existiert nicht")
+ FI.
+
+load subdir entrys of cluster:
+ store end of dir (loc (last block no of cluster, dir entrys per block - 1));
+ FOR block no FROM 0 UPTO (sectors per cluster - 1) REP
+ load dir block (first block no of cluster (cluster no) + block no, last block)
+ UNTIL last block
+ PER.
+
+last block no of cluster:
+ first block no of cluster (cluster no) + sectors per cluster - 1.
+
+END PROC enable open disk;
+
+PROC init dataspaces:
+ enable stop;
+ IF NOT initialized (this packet)
+ THEN dataspaces open := FALSE
+ FI;
+ IF NOT dataspaces open
+ THEN disable stop;
+ dataspaces open := TRUE;
+ fat space := nilspace;
+ dir ds := nilspace;
+ block ds := nilspace;
+ fat struct := fat space;
+ dir := dir ds;
+ block := block ds
+ FI.
+
+END PROC init dataspaces;
+
+PROC init dir struct (TEXT CONST path string, INT CONST root):
+ clear dir entrys (root);
+ dir.path := path string;
+ dir.disk label := "".
+
+END PROC init dir struct;
+
+PROC clear dir entrys (INT CONST root):
+ init file list;
+ init dir list;
+ init free list (root).
+
+init file list:
+ dir.file list.thes := empty thesaurus;
+ dir.file list.no of entrys := 0.
+
+init dir list:
+ dir.dir list.thes := empty thesaurus;
+ dir.dir list.no of entrys := 0.
+
+END PROC clear dir entrys;
+
+PROC close disk:
+ enable stop;
+ IF NOT initialized (this packet)
+ THEN dataspaces open := FALSE
+ FI;
+ IF dataspaces open
+ THEN forget (dir ds);
+ forget (block ds);
+ forget (fat space);
+ dataspaces open := FALSE
+ FI.
+
+END PROC close disk;
+
+(*COND FLOPPY
+PROC format disk:
+ enable stop;
+ init dataspaces;
+ format fat;
+ format dir.
+
+format fat:
+ write first four fat bytes;
+ write other fat bytes;
+ define write access table (TRUE);
+ copy fat to disk.
+
+write first four fat bytes:
+ fat [1] := word (first fat byte, 255);
+ fat [2] := word (255, 0).
+
+write other fat bytes:
+ FOR count FROM 3 UPTO fat length REP
+ fat [count] := 0
+ PER.
+
+fat length:
+ INT VAR len := number of fat entrys + number of fat entrys DIV 2
+ + number of fat entrys MOD 2;
+ len DIV 2 + len MOD 2.
+
+format dir:
+ init dir struct ("", -1);
+ store begin of free area (loc (begin of dir, 0));
+ store end of dir (loc (end of dir, dir entrys per block - 1));
+ FOR count FROM 0 UPTO dir entrys per block - 1 REP
+ write text 32 (block, ""0"" + 31 * ""246"", count)
+ PER;
+ disable stop;
+ FOR count FROM begin of dir UPTO end of dir REP
+ write disk block (block ds, count);
+ PER.
+
+end of dir:
+ begin of dir + number of dir sectors - 1.
+
+END PROC format disk;
+ENDCOND*)
+
+(*COND HDU*)
+PROC disk clear:
+ error stop ("nicht implementiert")
+
+END PROC disk clear;
+
+PROC format disk:
+ error stop ("nicht implementiert")
+
+END PROC format disk;
+(*ENDCOND*)
+
+INT PROC word (INT CONST low byte, high byte):
+ convert buffer := code (low byte) + code (high byte);
+ convert buffer ISUB 1.
+
+END PROC word;
+
+BOOL PROC disk changed:
+(*COND FLOPPY
+ disable stop;
+ NOT first fat block ok COR is error (* must be COR *)
+ENDCOND*)
+(*COND HDU*)
+ FALSE
+(*ENDCOND*)
+
+END PROC disk changed;
+
+BOOL PROC first fat block ok:
+ enable stop;
+ read fat block (0, TRUE);
+ FOR count FROM 1 UPTO 256 REP
+ compare word
+ PER;
+ TRUE.
+
+compare word:
+ IF fat struct.fat row [count] <> fat struct.block row [count]
+ THEN LEAVE first fat block ok WITH FALSE
+ FI.
+
+END PROC first fat block ok;
+
+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):
+ enable stop;
+ first cluster no := dir.file list.entry [link index].first cluster;
+ size := dir.file list.entry [link index].size;
+ IF first cluster no >= 4088
+ THEN first cluster no := -1
+ FI;
+ akt file cluster no := first cluster no.
+
+link index:
+ link (file thes, name).
+
+END PROC open fetch;
+
+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):
+ first cluster no := dir.dir list.entry [link index];
+ IF first cluster no >= 4088
+ THEN first cluster no := -1
+ FI;
+ akt file cluster no := first cluster no.
+
+link index:
+ link (dir thes, subdir name).
+
+END PROC open fetch subdir;
+
+INT PROC next fetch cluster no:
+ enable stop;
+ akt file cluster no := fat entry (akt file cluster no);
+ IF akt file cluster no < 4088 (*ff8h *)
+ THEN akt file cluster no
+ ELSE -1
+ FI.
+
+END PROC next fetch cluster no;
+
+PROC open save (TEXT CONST file name):
+ enable stop;
+ save name := file name;
+ IF dir full
+ THEN error stop ("Directory voll")
+ FI;
+ IF dir thes CONTAINS file name
+ THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")
+ FI;
+ IF file thes CONTAINS file name
+ THEN error stop ("Datei mit gleichem Namen existiert bereits")
+ FI;
+ no cluster saved := TRUE.
+
+END PROC open save;
+
+INT PROC next save cluster no:
+ enable stop;
+ IF no cluster saved
+ THEN akt file cluster no := available fat entry;
+ first file cluster no := akt file cluster no;
+ no cluster saved := FALSE
+ ELSE INT VAR old cluster no := akt file cluster no;
+ akt file cluster no := available fat entry;
+ write fat entry (old cluster no, akt file cluster no)
+ FI;
+ write fat entry (akt file cluster no, last entry of fat chain);
+ akt file cluster no.
+
+END PROC next save cluster no;
+
+PROC close save (REAL CONST size):
+ enable stop;
+ IF no cluster saved
+ THEN insert dir entry (save name, 4088, 0.0)
+ ELSE copy fat to disk;
+ insert dir entry (save name, first file cluster no, size)
+ FI.
+
+END PROC close save;
+
+PROC erase table entrys (TEXT CONST name):
+ enable stop;
+ INT VAR first file cluster := first cluster;
+ delete dir entry (name);
+ erase fat chain (first file cluster);
+ copy fat to disk.
+
+first cluster:
+ dir.file list.entry [link index].first cluster.
+
+link index:
+ link (file thes, name).
+
+END PROC erase table entrys;
+
+INT PROC fat entry (INT CONST entry no):
+ fix bytes;
+ construct value.
+
+fix bytes:
+ INT VAR first byte no := entry no + entry no DIV 2.
+
+construct value:
+ IF entry no MOD 2 = 0
+ THEN (right byte MOD 16) * 256 + left byte
+ ELSE 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;
+
+INT PROC available fat entry:
+ FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP
+ IF is available entry (count)
+ THEN first possible available fat entry := count;
+ LEAVE available fat entry WITH count
+ FI;
+ PER;
+ close action; error stop ("MS-DOS Datentraeger voll"); maxint.
+
+END PROC available fat entry;
+
+BOOL PROC is available entry (INT CONST entry no):
+ is zero entry.
+
+is zero entry:
+ IF entry no MOD 2 = 0
+ THEN (left byte = 0) CAND ((right byte MOD 16) = 0)
+ ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)
+ FI.
+
+left byte:
+ fat byte (first byte no).
+
+right byte:
+ fat byte (first byte no + 1).
+
+first byte no:
+ entry no + entry no DIV 2.
+
+END PROC is available entry;
+
+PROC erase fat chain (INT CONST first entry):
+ INT VAR akt entry no := first entry,
+ entry := fat entry (akt entry no);
+ WHILE akt entry no not last chain entry no REP
+ erase akt entry;
+ akt entry no := entry;
+ entry := fat entry (akt entry no)
+ PER;
+ erase akt entry.
+
+akt entry no not last chain entry no:
+ (entry < last entry of fat chain) AND (entry > 1).
+
+erase akt entry:
+ write fat entry (akt entry no, 0).
+
+END PROC erase fat chain;
+
+PROC write fat entry (INT CONST entry no, value):
+ fix bytes;
+ remark write access (fat block of first byte);
+ remark write access (fat block of second byte);
+ write value;
+ update first possible available entry.
+
+fix bytes:
+ INT VAR first byte no := entry no + entry no DIV 2.
+
+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 first possible available fat entry :=
+ min (first possible available fat entry, entry no)
+ FI.
+
+END PROC write fat entry;
+
+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 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;
+
+PROC copy fat to disk:
+ INT VAR block no;
+ FOR block no FROM 0 UPTO number of fat sectors - 1 REP
+ IF was write access (block no)
+ THEN write fat block (block no)
+ FI
+ PER.
+
+END PROC copy fat to disk;
+
+PROC write fat block (INT CONST fat block no):
+ INT VAR fat copy no;
+ INT VAR return code;
+ disable stop;
+ FOR fat copy no FROM 0 UPTO number of fat copies -1 REP
+ write disk block (fat space, ds page no, block no, return code);
+ IF return code > 0
+ THEN close action
+ FI
+ PER;
+ remark no write access (block no);
+ enable stop.
+
+ds page no:
+ first non dummy ds page + fat block no + 1.
+
+block no:
+ begin of fat (fat copy no) + fat block no.
+
+END PROC write fat block;
+
+PROC read fat block (INT CONST fat block, BOOL CONST test block):
+ INT VAR fat copy no;
+ disable stop;
+ FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP
+ clear error;
+ read disk block (fat space, ds page no, fat block no)
+ UNTIL NOT is error
+ PER;
+ IF is error
+ THEN close action
+ FI;
+ enable stop.
+
+ds page no:
+ IF test block
+ THEN first non dummy ds page
+ ELSE fat block + first non dummy ds page + 1
+ FI.
+
+fat block no:
+ begin of fat (fat copy no) + fat block.
+
+END PROC read fat block;
+
+PROC define write access table (BOOL CONST status):
+ FOR count FROM 1 UPTO number of fat sectors REP
+ write access [count] := status
+ PER.
+
+END PROC define write access table;
+
+PROC remark write access (INT CONST fat block no):
+ write access [fat block no + 1] := TRUE
+
+END PROC remark write access;
+
+PROC remark no write access (INT CONST fat block no):
+ write access [fat block no + 1] := FALSE
+
+END PROC remark no write access;
+
+BOOL PROC was write access (INT CONST fat block no):
+ write access [fat block no + 1]
+
+END PROC was write access;
+
+(*COND TEST
+PROC dump fat:
+ IF NOT exists ("fat dump")
+ THEN open file
+ FI;
+ DATASPACE VAR ds := nilspace;
+ FILE VAR in := sequential file (input, "fat dump"),
+ out := sequential file (output, ds);
+ INT VAR i;
+ TEXT VAR line;
+ FOR i FROM 0 UPTO number of fat entrys - 1 REP
+ dump fat entry
+ PER;
+ forget ("fat dump", quiet);
+ copy (ds, "fat dump");
+ forget (ds).
+
+open file:
+ in := sequential file (output, "fat dump");
+ FOR i FROM 0 UPTO number of fat entrys - 1 REP
+ putline (in, text (i, 4) + ": ")
+ PER.
+
+dump fat entry:
+ cout (i);
+ getline (in, line);
+ putline (out, line + " " + text (fat entry (i), 4)).
+
+END PROC dump fat;
+ENDCOND*)
+
+PROC load dir block (INT CONST block no, BOOL VAR last block):
+ last block := FALSE;
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ INT VAR entry no,
+ thes index;
+ FOR entry no FROM 0 UPTO dir entrys per block - 1 REP
+ dir entry := text 32 (block, entry no);
+ process entry
+ PER.
+
+process entry:
+ SELECT pos (""0"."229"", dir entry SUB 1) OF
+ CASE 1: end of dir search
+ CASE 2: main dir entry
+ CASE 3: free entry
+ OTHERWISE file entry
+ END SELECT.
+
+end of dir search:
+ last block := TRUE;
+ store begin of free area (loc (block no, entry no));
+ LEAVE load dir block.
+
+main dir entry:
+ (* no operation *).
+
+free entry:
+ store in free list (loc (block no, entry no)).
+
+file entry:
+ SELECT code (dir entry SUB 12) OF
+ CASE 8: volume label
+ CASE 16: sub dir entry
+ OTHERWISE dos file entry
+ END SELECT.
+
+volume label:
+ dir.disk label := text (dir entry, 1, 11).
+
+sub dir entry:
+ dir.dir list.no of entrys INCR 1;
+ insert (dir thes, name, thes index);
+ dir list entry := first cluster no.
+
+dos file entry:
+ IF dir.file list.no of entrys >= max dir entrys
+ THEN error stop ("Directorytabelle voll")
+ FI;
+ dir.file list.no of entrys INCR 1;
+ insert (file thes, name, thes index);
+ file list entry.first cluster := first cluster no;
+ file list entry.date and time := dos date + " " + dos time;
+ file list entry.size := dos storage;
+ file list entry.location.msdos block no := block no;
+ file list entry.location.block entry no := entry no.
+
+name:
+ IF name post <> ""
+ THEN name pre + "." + name post
+ ELSE name pre
+ FI.
+
+name pre:
+ compress (subtext (dir entry, 1, 8)).
+
+name post:
+ compress (subtext (dir entry, 9, 11)).
+
+file list entry:
+ dir.file list.entry [thes index].
+
+dir list entry:
+ dir.dir list.entry [thes index].
+
+first cluster no:
+ code (dir entry SUB 27) + 256 * code (dir entry SUB 28).
+
+dos storage:
+ real (code (dir entry SUB 29)) +
+ real (code (dir entry SUB 30)) * 256.0 +
+ real (code (dir entry SUB 31)) * 65536.0 +
+ real (code (dir entry SUB 32)) * 16777216.0.
+
+dos date:
+ day + "." + month + "." + year.
+
+day:
+ IF code (dir entry SUB 25) MOD 32 < 10
+ THEN "0" + text (code (dir entry SUB 25) MOD 32)
+ ELSE text (code (dir entry SUB 25) MOD 32)
+ FI.
+
+month:
+ INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+year:
+ text (80 + code (dir entry SUB 26) DIV 2, 2).
+
+dos time:
+ hour + ":" + minute.
+
+hour:
+ dummy := code (dir entry SUB 24) DIV 8;
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+minute:
+ dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8);
+ IF dummy < 10
+ THEN "0" + text (dummy)
+ ELSE text (dummy)
+ FI.
+
+END PROC load dir block;
+
+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):
+ (* name must be a dos name *)
+ LOCATION VAR ins pos := free location;
+ TEXT VAR akt date := date (clock (1)),
+ akt time := time of day (clock (1));
+ write disk entry;
+ write dir struct entry.
+
+write disk entry:
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ prepare name;
+ dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +
+ dos date + starting cluster + storage;
+ write text 32 (block, dir entry, ins pos.block entry no);
+ write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI.
+
+prepare name:
+ TEXT VAR name pre, name post;
+ IF point pos > 0
+ THEN name pre := subtext (name, 1, point pos - 1);
+ name post := subtext (name, point pos + 1);
+ name pre CAT (8 - LENGTH name pre) * " ";
+ name post CAT (3 - LENGTH name post) * " "
+ ELSE name pre := name + (8 - LENGTH name) * " ";
+ name post := " "
+ FI.
+
+point pos:
+ pos (name, ".").
+
+dos time:
+ code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).
+
+hour:
+ int (subtext (akt time, 1, 2)).
+
+minute:
+ int (subtext (akt time, 4, 5)).
+
+dos date:
+ code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).
+
+day:
+ int (subtext (akt date, 1, 2)).
+
+month:
+ int (subtext (akt date, 4, 5)).
+
+year:
+ int (subtext (akt date, 7, 8)).
+
+starting cluster:
+ code (start cluster MOD 256) + code (start cluster DIV 256).
+
+storage:
+ code (int (round (256.0 * frac (used storage / 256.0), 0))) +
+ code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +
+ code (int (floor (used storage / 65536.0))) +
+ code (0). (* maximal 16384 K *********************************)
+
+write dir struct entry:
+ INT VAR thes link;
+ insert (file thes, name, thes link);
+ file list entry.location := ins pos;
+ file list entry.first cluster := start cluster;
+ file list entry.date and time := akt date + " " + akt time;
+ file list entry.size := used storage.
+
+file list entry:
+ dir.filelist.entry [thes link].
+
+END PROC insert dir entry;
+
+PROC delete dir entry (TEXT CONST name):
+ LOCATION VAR del pos;
+ get del pos;
+ erase dir struct entry;
+ erase disk entry;
+ store in free list (del pos).
+
+get del pos:
+ del pos := dir.filelist.entry [link index].location.
+
+link index:
+ link (file thes, name).
+
+erase dir struct entry:
+ INT VAR i;
+ delete (file thes, name, i).
+
+erase disk entry:
+ INT VAR return code;
+ read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI;
+ dir entry := text 32 (block, del pos.block entry no);
+ replace (dir entry, 1, ""229"");
+ write text 32 (block, dir entry, del pos.block entry no);
+ write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);
+ IF return code > 0
+ THEN close action;
+ io error (return code)
+ FI.
+
+END PROC delete dir entry;
+
+.
+file thes:
+ dir.filelist.thes.
+
+dir thes:
+ dir.dir list.thes.
+
+(*********************** dir information ******************************)
+
+THESAURUS PROC dir all:
+ file thes.
+
+END PROC dir all;
+
+BOOL PROC dir contains (TEXT CONST name):
+ file thes CONTAINS name
+
+END PROC dir contains;
+
+PROC dir list (DATASPACE VAR ds):
+ enable stop;
+ open list file;
+ list files;
+ list dirs;
+ write list head.
+
+open list file:
+ forget (ds);
+ ds := nilspace;
+ FILE VAR list file := sequential file (output, ds);
+ putline (list file, "").
+
+list files:
+ INT VAR number := 0;
+ get (file thes, name, number);
+ WHILE number > 0 REP
+ generate file list line;
+ get (file thes, name, number)
+ PER.
+
+generate file list line:
+ write (list file, centered name);
+ write (list file, " ");
+ write (list file, text (act file entry.size, 11, 0));
+ write (list file, " Bytes belegt ");
+ write (list file, act file entry.date and time);
+(*COND TEST
+ write (list file, " +++ ");
+ write (list file, text (act file entry.first cluster));
+ENDCOND*)
+ line (list file).
+
+list dirs:
+ number := 0;
+ get (dir thes, name, number);
+ WHILE number > 0 REP
+ generate dir list line;
+ get (dir thes, name, number)
+ PER.
+
+generate dir list line:
+ write (list file, centered name);
+ write (list file, " <DIR>");
+(*COND TEST
+ write (list file, " +++ ");
+ write (list file, text (dir.dir list.entry [number]));
+ENDCOND*)
+ line (list file).
+
+centered name:
+ INT VAR point pos := pos (name, ".");
+ IF point pos > 0
+ THEN name pre + "." + name post
+ ELSE text (name, 12)
+ FI.
+
+name pre:
+ text (subtext (name, 1, point pos - 1), 8).
+
+name post:
+ text (subtext (name, point pos + 1, point pos + 4), 3).
+
+act file entry:
+ dir.file list.entry [number].
+
+write list head:
+ head line (list file, head).
+
+head:
+ "DOS" + disk label string + path string.
+
+disk label string:
+ IF dir.disk label <> ""
+ THEN ": " + dir.disk label
+ ELSE ""
+ FI.
+
+path string:
+ IF dir.path <> ""
+ THEN " PATH: " + dir.path
+ ELSE ""
+ FI.
+
+END PROC dir list;
+
+(************ free list handling ******************************************)
+LOCATION PROC loc (INT CONST block, entry):
+ LOCATION : (block, entry)
+
+END PROC loc;
+
+BOOL OP > (LOCATION CONST l, r):
+ l.msdos block no > r.msdos block no
+ OR ((l.msdos block no = r.msdos block no) AND
+ (l.block entry no > r.block entry no) )
+
+END OP >;
+
+OP INCR (LOCATION VAR l):
+ IF l.block entry no = dir entrys per block -1
+ THEN l.block entry no := 0;
+ l.msdos block no INCR 1
+ ELSE l.block entry no INCR 1
+ FI.
+
+END OP INCR;
+
+PROC init free list (INT CONST dir root):
+ dir.freelist.stacktop := 0;
+ dir.freelist.begin of free area.msdos block no := maxint;
+ dir.freelist.end of dir.msdos block no := -1;
+ dir.freelist.dir chain root := dir root.
+
+END PROC init free list;
+
+BOOL PROC dir full:
+ stack empty AND free area empty AND NOT expansion alloweded.
+
+stack empty:
+ dir.freelist.stacktop < 1.
+
+free area empty:
+ dir.freelist.begin of free area > dir.freelist.end of dir.
+
+expansion alloweded:
+ dir.freelist.dir chain root >= 0.
+
+END PROC dir full;
+
+PROC store in free list (LOCATION CONST free):
+ dir.freelist.stacktop INCR 1;
+ dir.freelist.stack [top] := free.
+
+top:
+ dir.freelist.stacktop.
+
+END PROC store in free list;
+
+PROC store begin of free area (LOCATION CONST begin):
+ dir.freelist.begin of free area := begin
+
+END PROC store begin of free area;
+
+PROC store end of dir (LOCATION CONST end):
+ dir.freelist.end of dir := end
+
+END PROC store end of dir;
+
+LOCATION PROC free location:
+ LOCATION VAR result;
+ IF dir.freelist.stacktop > 0
+ THEN pop
+ ELIF NOT free area empty
+ THEN first of free area
+ ELIF expansion alloweded
+ THEN allocate new dir space;
+ result := free location
+ ELSE error stop ("Directorytabelle voll")
+ FI;
+ result.
+
+pop:
+ result := dir.freelist.stack [top];
+ top DECR 1.
+
+top:
+ dir.freelist.stack top.
+
+free area empty:
+ dir.freelist.begin of free area > dir.freelist.end of dir.
+
+first of free area:
+ result := dir.freelist.begin of free area;
+ INCR dir.freelist.begin of free area.
+
+expansion alloweded:
+ dir.freelist.dir chain root >= 0.
+
+END PROC free location;
+
+PROC allocate new dir space:
+ enable stop;
+ INT VAR new cluster no := available fat entry;
+ IF new cluster no < 0
+ THEN error stop ("MS-DOS Datentraeger voll")
+ FI;
+ INT VAR last entry no;
+ search last entry of fat chain;
+ write fat entry (new cluster no, 4095);
+ write fat entry (last entry no, new cluster no);
+ copy fat to disk;
+ store begin of free area (loc (first new block, 0));
+ store end of dir (loc (last new block, dir entrys per block - 1));
+ init new dir cluster.
+
+search last entry of fat chain:
+ last entry no := dir.freelist.dir chain root;
+ WHILE fat entry (last entry no) < last entry of fat chain REP
+ last entry no := fat entry (last entry no)
+ PER.
+
+init new dir cluster:
+ FOR count FROM 0 UPTO dir entrys per block - 1 REP
+ write text 32 (block, ""0"" + 31 * ""246"", count)
+ PER;
+ disable stop;
+ FOR count FROM first new block UPTO last new block REP
+ write disk block (block ds, count);
+ PER.
+
+first new block:
+ firstblock no of cluster (new cluster no).
+
+last new block:
+ first block no of cluster (new cluster no) + sectors per cluster - 1.
+
+END PROC allocate new dir space;
+
+(*COND TEST
+PROC dump freelist:
+ command dialogue (FALSE);
+ FILE VAR f := sequential file (output, "freelistdump");
+ INT VAR i;
+ putline (f, "STACKTOP: " + text (fl.stacktop));
+ putline (f, "STACK:");
+ FOR i FROM 1 UPTO 16 * number of dir sectors REP
+ putline (f, " " + text (i, 4) + ": " +
+ text (fl.stack [i].msdos block no) + ", " +
+ text (fl.stack [i].block entry no))
+ PER;
+ line (f);
+ putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) +
+ ", " + text (fl.begin of free area.block entry no));
+ putline (f, "END OF DIR: " + text (fl.end of dir.msdos block no) +
+ ", " + text (fl.end of dir.block entry no)).
+
+fl:
+ dir.freelist.
+
+END PROC dump free list;
+ENDCOND*)
+
+END PACKET dos fat and dir;
diff --git a/system/dos/1986/src/fetch b/system/dos/1986/src/fetch new file mode 100644 index 0000000..ad00ab6 --- /dev/null +++ b/system/dos/1986/src/fetch @@ -0,0 +1,333 @@ +PACKET fetch DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ (* 07.05.86 *)
+ fetch filemode,
+ fetch rowtextmode,
+ fetch dsmode,
+ check file:
+
+LET ascii = 1,
+ ascii german = 2,
+ transparent = 3,
+ ebcdic = 4,
+ atari st = 10;
+
+LET row text mode length = 4000,
+ row text type = 1000,
+
+ ctrl z = ""26"",
+ tab = ""9"",
+ page cmd = "#page#";
+
+CLUSTER VAR cluster;
+
+DATASPACE VAR cluster space;
+
+BOUND STRUCT (INT size,
+ ROW row text mode length TEXT cluster row) VAR cluster struct;
+
+INT VAR next cluster no;
+REAL VAR file rest;
+
+FILE VAR file;
+
+PROC fetch filemode (DATASPACE VAR file space,
+ TEXT CONST name, INT CONST code type):
+ disable stop;
+ cluster space := nilspace;
+ cluster := cluster space;
+ enabled fetch filemode (file space, name, code type);
+ forget (cluster space).
+
+END PROC fetch filemode;
+
+PROC enabled fetch filemode (DATASPACE VAR file space,
+ TEXT CONST name,
+ INT CONST code type):
+ enable stop;
+ initialize fetch filemode;
+ open fetch (name, file rest, next cluster no);
+ WHILE (next cluster no >= 0) AND (file rest > 0.0) REP
+ get text of act cluster;
+ write lines;
+(***************************************)
+ IF lines (file) > 3950
+ THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES KNNEN DATEN FEHLEN <<<");
+ LEAVE enabled fetch filemode
+ FI;
+(***************************************)
+ PER;
+ write last line if necessary.
+
+initialize fetch filemode:
+ REAL VAR real cluster size := real (cluster size);
+ TEXT VAR buffer := "";
+ forget (file space);
+ file space := nilspace;
+ file := sequential file (output, file space);
+ init cr lf ff const.
+
+init cr lf ff const:
+ TEXT VAR cr, lf, ff;
+ SELECT codetype OF
+ CASE ascii, ascii german, atari st: cr := ""13""; lf := ""10""; ff := ""12""
+ CASE transparent: cr := ""13""; lf := ""10""; ff := ""12""
+ CASE ebcdic: cr := ""13""; lf := "%"; ff := ""12""
+ END SELECT;
+ TEXT CONST select buffer := cr + lf + ff;
+ TEXT CONST min line end char := code (min (code (cr), min (code (lf), code (ff)))),
+ max line end char := code (max (code (cr), max (code (lf), code (ff)))).
+
+get text of act cluster:
+ fetch next cluster (cluster space, first non dummy ds page);
+ buffer CAT text (cluster, 1, valid buffer length);
+ file rest DECR real cluster size;
+ IF seven bit code
+ THEN cancel bit 8
+ FI;
+ IF ctrl z end
+ THEN test ctrl z
+ FI;
+ INT CONST bufferlength := LENGTH buffer.
+
+ctrl z end:
+ (code type = ascii) OR (code type = ascii german).
+
+seven bit code:
+ code type = ascii OR code type = ascii german.
+
+valid buffer length:
+ int (min (file rest, real cluster size)).
+
+cancel bit 8:
+ INT VAR set pos := pos (buffer, "", ""255"", 1);
+ WHILE set pos > 0 REP
+ replace (buffer, set pos, seven bit char);
+ set pos := pos (buffer, "", ""255"", set pos + 1)
+ PER.
+
+seven bit char:
+ code (code (buffer SUB set pos) AND 127).
+
+test ctrl z:
+ IF pos (buffer, ctrl z) > 0
+ THEN file rest := 0.0;
+ buffer := subtext (buffer, 1, pos (buffer, ctrl z) - 1)
+ FI.
+
+write lines:
+ INT VAR begin pos := 1, end pos;
+ next cr lf ff pos;
+ WHILE end pos > 0 REP
+ execute char and get new pos pointer;
+ next cr lf ff pos
+ PER;
+ compress buffer.
+
+next cr lf ff pos:
+ end pos := pos (buffer, min line end char, max line end char, begin pos);
+ WHILE no line end char REP
+ end pos := pos (buffer, min line end char, max line end char, end pos + 1)
+ PER.
+
+no line end char:
+ (end pos > 0) AND (pos (select buffer, buffer SUB end pos) = 0).
+
+compress buffer:
+ buffer := subtext (buffer, begin pos).
+
+execute char and get new pos pointer:
+ SELECT pos (select buffer, buffer SUB end pos) OF
+ CASE 1: execute cr
+ CASE 2: execute lf
+ CASE 3: execute ff
+ END SELECT.
+
+execute cr:
+ IF (end pos = bufferlength) AND (file rest > 0.0)
+ THEN compress buffer;
+ LEAVE write lines
+ FI;
+ write line (subtext (buffer, begin pos, end pos - 1), code type);
+ IF (buffer SUB (end pos + 1)) = lf
+ THEN begin pos := end pos + 2
+ ELSE begin pos := end pos + 1
+ FI.
+
+execute ff:
+ write line (subtext (buffer, begin pos, end pos - 1), code type);
+ putline (file, page cmd);
+ begin pos := end pos + 1.
+
+execute lf:
+ IF (end pos = bufferlength) AND (file rest > 0.0)
+ THEN compress buffer;
+ LEAVE write lines
+ FI;
+ write line (subtext (buffer, begin pos, end pos - 1), code type);
+ IF (buffer SUB (end pos + 1)) = cr
+ THEN begin pos := end pos + 2
+ ELSE begin pos := end pos + 1
+ FI.
+
+write last line if necessary:
+ IF buffer <> ""
+ THEN end pos := LENGTH buffer + 1;
+ write line (subtext (buffer, begin pos, end pos - 1), code type)
+ FI.
+
+END PROC enabled fetch filemode;
+
+PROC write line (TEXT CONST line, INT CONST code type):
+ TEXT VAR result;
+ SELECT code type OF
+ CASE ascii: ascii conversion
+ CASE ascii german: ascii german conversion
+ CASE atari st: atari st conversion
+ CASE transparent: putline (file, line)
+ CASE ebcdic: ebcdic conversion
+ END SELECT.
+
+ascii conversion:
+ expand tabs;
+ replace steuerzeichen;
+ putline (file, result).
+
+ascii german conversion:
+ expand tabs;
+ replace steuerzeichen;
+ replace ascii german umlaute;
+ putline (file, result).
+
+atari st conversion:
+ expand tabs;
+ replace steuerzeichen;
+ replace atari st umlaute;
+ putline (file, result).
+
+replace ascii german umlaute:
+ change all (result, "[", "");
+ change all (result, "\", "");
+ change all (result, "]", "");
+ change all (result, "{", "");
+ change all (result, "|", "");
+ change all (result, "}", "");
+ change all (result, "~", "").
+
+replace atari st umlaute:
+ change all (result, ""142"", "");
+ change all (result, ""153"", "");
+ change all (result, ""154"", "");
+ change all (result, ""132"", "");
+ change all (result, ""148"", "");
+ change all (result, ""129"", "");
+ change all (result, ""158"", "").
+
+expand tabs:
+ result := line;
+ INT VAR tab pos := pos (result, tab);
+ WHILE tab pos > 0 REP
+ expand tab;
+ tab pos := pos (result, tab)
+ PER.
+
+expand tab:
+ result := subtext (result, 1, tab pos - 1) + (8 - ((tab pos - 1)) MOD 8) * " "
+ + subtext (result, tab pos + 1).
+
+replace steuerzeichen:
+ INT VAR position := pos (result, ""0"", ""31"", 1);
+ WHILE position > 0 REP
+ TEXT VAR char := result SUB position;
+ change all (result, char, "#" + int code + "#");
+ position := pos (result, ""0"", ""31"", position)
+ PER.
+
+ebcdic conversion:
+ result := line;
+ ebcdic to eumel with substitution (result);
+ putline (file, result).
+
+int code:
+ (3 - LENGTH text (code (char))) * "0" + text (code (char)).
+
+END PROC write line;
+
+PROC fetch rowtextmode (DATASPACE VAR file space,
+ TEXT CONST name):
+ disable stop;
+ cluster space := nilspace;
+ cluster := cluster space;
+ enabled fetch rowtextmode (file space, name);
+ forget (cluster space).
+
+END PROC fetch rowtextmode;
+
+PROC enabled fetch rowtextmode (DATASPACE VAR file space,
+ TEXT CONST name):
+ enable stop;
+ open fetch (name, file rest, next cluster no);
+ initialize fetch rowtext mode;
+ WHILE next cluster no >= 0 REP
+ fetch next cluster (cluster space, first non dummy ds page);
+ cluster struct.size INCR 1;
+ IF file rest < real cluster size
+ THEN cluster struct.cluster row [cluster struct.size]
+ := text (cluster, 1, int (file rest));
+ file rest := 0.0
+ ELSE cluster struct.cluster row [cluster struct.size] := text (cluster, 1, cluster size);
+ file rest DECR real cluster size
+ FI
+ PER.
+
+initialize fetch row text mode:
+ forget (file space);
+ file space := nilspace;
+ cluster struct := file space;
+ type (file space, row text type);
+ REAL VAR real cluster size := real (cluster size);
+ cluster struct.size := 0.
+
+END PROC enabled fetch rowtext mode;
+
+PROC fetch ds mode (DATASPACE VAR ds, TEXT CONST name):
+ enable stop;
+ open fetch (name, file rest, next cluster no);
+ init fetch dsmode;
+ WHILE next cluster no >= 0 REP
+ fetch next cluster (ds, ds block no);
+ ds block no INCR sectors per cluster;
+ PER.
+
+init fetch dsmode:
+ forget (ds);
+ ds := nilspace;
+ INT VAR ds block no := 2.
+
+END PROC fetch ds mode;
+
+PROC check file (TEXT CONST name):
+ disable stop;
+ cluster space := nilspace;
+ cluster := cluster space;
+ enabled check file (name);
+ forget (cluster space).
+
+END PROC check file;
+
+PROC enabled check file (TEXT CONST name):
+ enable stop;
+ open fetch (name, file rest, next cluster no);
+ WHILE next cluster no >= 0 REP
+ fetch next cluster (cluster space, first non dummy ds page)
+ PER.
+
+END PROC enabled check file;
+
+PROC fetch next cluster (DATASPACE VAR fetch space, INT CONST first page):
+ read disk cluster (fetch space, first page, next cluster no);
+ next cluster no := next fetch cluster no.
+
+END PROC fetch next cluster;
+
+END PACKET fetch;
diff --git a/system/dos/1986/src/files.dos b/system/dos/1986/src/files.dos new file mode 100644 index 0000000..0dd792f --- /dev/null +++ b/system/dos/1986/src/files.dos @@ -0,0 +1,23 @@ +eumel-ebcdic + sub
+open
+block i/o
+cluster
+name conversion
+eu disk descriptor.fd
+disk descriptor.dos.fd
+fat and dir.dos.fd
+eu disk descriptor.hd
+disk descriptor.dos.hd
+fat and dir.dos.hd
+fetch
+save
+disk manager
+manager/M.dos.fd
+manager/M.dos.hd
+table thes.dos
+252
+253
+254
+255
+shard interface
+
diff --git a/system/dos/1986/src/gen.dos b/system/dos/1986/src/gen.dos new file mode 100644 index 0000000..5493272 --- /dev/null +++ b/system/dos/1986/src/gen.dos @@ -0,0 +1,99 @@ +(* 28.02.88, DOS Inserter HD/FD *)
+TASK VAR fd, hd ;
+IF NOT exists ("files.dos") THEN fetch ("files.dos", archive) FI ;
+IF highest entry (ALL "files.dos" - all) > 0
+ THEN fetch (ALL "files.dos" - all, archive) ;
+FI ;
+forget ("files.dos", quiet) ;
+forget ("gen.dos", quiet) ;
+release (archive) ;
+ins ("eumel-ebcdic + sub") ;
+ins ("open") ;
+ins ("name conversion") ;
+begin ("FD", PROC fd start, fd) ;
+begin ("HD", PROC hd start, hd) ;
+globalmanager ;
+
+PROC ins (TEXT CONST name) :
+ insert (name) ;
+ forget (name, quiet)
+ENDPROC ins ;
+
+PROC hd start :
+ command dialogue (FALSE) ;
+
+ fetch ("eu disk descriptor.hd") ;
+ erase ("eu disk descriptor.hd") ;
+ fetch ("disk descriptor.dos.hd") ;
+ erase ("disk descriptor.dos.hd") ;
+ fetch ("cluster") ;
+ fetch ("block i/o") ;
+ fetch ("fat and dir.dos.hd") ;
+ erase ("fat and dir.dos.hd") ;
+ fetch ("fetch") ;
+ fetch ("save") ;
+ fetch ("disk manager") ;
+ fetch ("manager/M.dos.hd") ;
+ erase ("manager/M.dos.hd") ; (* fetch beendet signalieren *)
+
+ IF NOT exists ("manager/M.dos.fd", father) (* FD auch fertig ? *)
+ THEN erase ("block i/o") ;
+ erase ("cluster") ;
+ erase ("fetch") ;
+ erase ("save") ;
+ erase ("disk manager")
+ FI ;
+
+ ins ("eu disk descriptor.hd") ;
+ ins ("disk descriptor.dos.hd") ;
+ ins ("cluster") ;
+ ins ("block i/o") ;
+ ins ("fat and dir.dos.hd") ;
+ ins ("fetch") ;
+ ins ("save") ;
+ ins ("disk manager") ;
+ ins ("manager/M.dos.hd") ;
+ do ("dos manager")
+ENDPROC hd start ;
+
+PROC fd start :
+ disablestop ;
+ command dialogue (FALSE) ;
+ fetch ("table thes.dos") ;
+ erase ("table thes.dos") ;
+ fetch (ALL "table thes.dos") ;
+ erase (ALL "table thes.dos") ;
+ fetch ("eu disk descriptor.fd") ;
+ erase ("eu disk descriptor.fd") ;
+ fetch ("disk descriptor.dos.fd") ;
+ erase ("disk descriptor.dos.fd") ;
+ fetch ("cluster") ;
+ fetch ("block i/o") ;
+ fetch ("fat and dir.dos.fd") ;
+ erase ("fat and dir.dos.fd") ;
+ fetch ("fetch") ;
+ fetch ("save") ;
+ fetch ("disk manager") ;
+ fetch ("manager/M.dos.fd") ;
+ erase ("manager/M.dos.fd") ; (* fetch beendet signalieren *)
+
+ IF NOT exists ("manager/M.dos.hd", father) (* HD auch fertig ? *)
+ THEN erase ("block i/o") ;
+ erase ("cluster") ;
+ erase ("fetch") ;
+ erase ("save") ;
+ erase ("disk manager")
+ FI ;
+
+ ins ("eu disk descriptor.fd") ;
+ ins ("disk descriptor.dos.fd") ;
+ ins ("cluster") ;
+ ins ("block i/o") ;
+ ins ("fat and dir.dos.fd") ;
+ ins ("fetch") ;
+ ins ("save") ;
+ ins ("disk manager") ;
+ ins ("manager/M.dos.fd") ;
+ do ("dos manager")
+ENDPROC fd start ;
+
diff --git a/system/dos/1986/src/manager-M.dos.fd b/system/dos/1986/src/manager-M.dos.fd new file mode 100644 index 0000000..1c59e01 --- /dev/null +++ b/system/dos/1986/src/manager-M.dos.fd @@ -0,0 +1,198 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ provide channel, (* 25.03.86 *)
+ dos manager:
+
+LET std archive channel = 31,
+
+ ack = 0,
+ second phase ack = 5,
+ false code = 6,
+
+ fetch code = 11,
+ save code = 12,
+ exists code = 13,
+ erase code = 14,
+ list code = 15,
+ all code = 17,
+ clear code = 18,
+ reserve code = 19,
+ free code = 20,
+ check read code = 22,
+
+ quote = """";
+
+BOUND STRUCT (TEXT name, pass) VAR msg;
+
+TASK VAR order task;
+
+INT VAR dos channel;
+
+REAL VAR last access time := 0.0;
+
+TASK VAR disk owner := niltask;
+
+PROC provide channel (INT CONST channel):
+ dos channel := channel
+
+END PROC provide channel;
+
+(*COND FLOPPY*)
+provide channel (std archive channel);
+(*ENDCOND*)
+
+(*COND HDU
+provide channel (29)
+ENDCOND*)
+
+PROC dos manager:
+ dos manager (dos channel)
+
+END PROC dos manager;
+
+PROC dos manager (INT CONST channel):
+(*COND FLOPPY*)
+ load shard interface table;
+(*ENDCOND*)
+ dos channel := channel;
+ task password ("-");
+ global manager
+ (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager)
+
+END PROC dos manager;
+
+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,
+ TASK CONST from task):
+ enable stop;
+ order task := from task;
+ msg := ds;
+ IF NOT (order task = disk owner) AND
+ order code <> free code AND order code <> reserve code
+ THEN errorstop ("DOS nicht angemeldet")
+ FI;
+ SELECT order code OF
+ CASE fetch code : fetch file
+ CASE save code : save file
+ CASE erase code : erase file
+ CASE clear code : clear disk
+ CASE exists code : exists file
+ CASE list code : list disk
+ CASE all code : deliver directory
+ CASE reserve code : reserve
+ CASE free code : free
+ CASE check read code: check
+ OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))
+ END SELECT.
+
+fetch file:
+ disk fetch (msg.name, ds);
+ manager ok (ds).
+
+check:
+ disk check (msg.name);
+ manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen").
+
+save file:
+ IF phase = 1
+ THEN save first phase
+ ELSE save second phase
+ FI.
+
+save first phase:
+ BOOL VAR overwrite question;
+ disk save first phase (msg.name, overwrite question);
+ IF overwrite question
+ THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")
+ ELSE send (order task, second phase ack, ds)
+ FI.
+
+save second phase:
+ disable stop;
+ disk save second phase (ds);
+ forget (ds) ;
+ ds := nilspace ;
+ enable stop;
+ manager ok (ds).
+
+clear disk:
+ IF NOT (from task = disk owner)
+ THEN error stop ("DOS nicht angemeldet")
+ FI;
+ IF phase = 1
+ THEN manager question ("Diskette loeschen")
+ ELSE disk clear;
+ manager ok (ds)
+ FI.
+
+erase file:
+ IF disk exists (msg.name)
+ THEN IF phase = 1
+ THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")
+ ELSE disk erase (msg.name);
+ manager ok (ds)
+ FI
+ ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")
+ FI.
+
+exists file:
+ IF disk exists (msg.name)
+ THEN manager ok (ds)
+ ELSE send (order task, false code, ds)
+ FI.
+
+list disk:
+ disk list (ds);
+ manager ok (ds).
+
+deliver directory:
+ forget (ds);
+ ds := nilspace;
+ BOUND THESAURUS VAR all names := ds;
+ all names := disk all;
+ manager ok (ds).
+
+reserve:
+ IF reserve or free permitted
+ THEN do continue channel;
+ disk owner := from task;
+ disk reserve (msg.name);
+ manager ok (ds)
+ ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")
+ FI.
+
+do continue channel:
+ IF channel <> dos channel
+ THEN continue channel (dos channel)
+ FI.
+
+reserve or free permitted :
+ from task = disk owner OR last access more than five minutes ago
+ OR disk owner = niltask OR NOT
+ (exists (disk owner) OR station(disk owner) <> station (myself)).
+
+last access more than five minutes ago :
+ abs (last access time - clock (1)) > 300.0.
+
+free:
+ IF reserve or free permitted
+ THEN disk free;
+ disk owner := niltask;
+ break (quiet);
+ manager ok (ds)
+ ELSE manager message ("DOS nicht angemeldet")
+ FI.
+
+END PROC dos manager;
+
+PROC manager ok (DATASPACE VAR ds):
+ send (order task, ack, ds);
+ last access time := clock (1).
+
+END PROC manager ok;
+
+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):
+ text (quote + adapted name (name, status) + quote, 14)
+
+END PROC expanded name;
+
+END PACKET dos manager multi;
diff --git a/system/dos/1986/src/manager-M.dos.hd b/system/dos/1986/src/manager-M.dos.hd new file mode 100644 index 0000000..70d9d9a --- /dev/null +++ b/system/dos/1986/src/manager-M.dos.hd @@ -0,0 +1,198 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ provide channel, (* 25.03.86 *)
+ dos manager:
+
+LET std archive channel = 31,
+
+ ack = 0,
+ second phase ack = 5,
+ false code = 6,
+
+ fetch code = 11,
+ save code = 12,
+ exists code = 13,
+ erase code = 14,
+ list code = 15,
+ all code = 17,
+ clear code = 18,
+ reserve code = 19,
+ free code = 20,
+ check read code = 22,
+
+ quote = """";
+
+BOUND STRUCT (TEXT name, pass) VAR msg;
+
+TASK VAR order task;
+
+INT VAR dos channel;
+
+REAL VAR last access time := 0.0;
+
+TASK VAR disk owner := niltask;
+
+PROC provide channel (INT CONST channel):
+ dos channel := channel
+
+END PROC provide channel;
+
+(*COND FLOPPY
+provide channel (std archive channel);
+ENDCOND*)
+
+(*COND HDU*)
+provide channel (29)
+(*ENDCOND*)
+
+PROC dos manager:
+ dos manager (dos channel)
+
+END PROC dos manager;
+
+PROC dos manager (INT CONST channel):
+(*COND FLOPPY
+ load shard interface table;
+ENDCOND*)
+ dos channel := channel;
+ task password ("-");
+ global manager
+ (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager)
+
+END PROC dos manager;
+
+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,
+ TASK CONST from task):
+ enable stop;
+ order task := from task;
+ msg := ds;
+ IF NOT (order task = disk owner) AND
+ order code <> free code AND order code <> reserve code
+ THEN errorstop ("DOS nicht angemeldet")
+ FI;
+ SELECT order code OF
+ CASE fetch code : fetch file
+ CASE save code : save file
+ CASE erase code : erase file
+ CASE clear code : clear disk
+ CASE exists code : exists file
+ CASE list code : list disk
+ CASE all code : deliver directory
+ CASE reserve code : reserve
+ CASE free code : free
+ CASE check read code: check
+ OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))
+ END SELECT.
+
+fetch file:
+ disk fetch (msg.name, ds);
+ manager ok (ds).
+
+check:
+ disk check (msg.name);
+ manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen").
+
+save file:
+ IF phase = 1
+ THEN save first phase
+ ELSE save second phase
+ FI.
+
+save first phase:
+ BOOL VAR overwrite question;
+ disk save first phase (msg.name, overwrite question);
+ IF overwrite question
+ THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")
+ ELSE send (order task, second phase ack, ds)
+ FI.
+
+save second phase:
+ disable stop;
+ disk save second phase (ds);
+ forget (ds) ;
+ ds := nilspace ;
+ enable stop;
+ manager ok (ds).
+
+clear disk:
+ IF NOT (from task = disk owner)
+ THEN error stop ("DOS nicht angemeldet")
+ FI;
+ IF phase = 1
+ THEN manager question ("Diskette loeschen")
+ ELSE disk clear;
+ manager ok (ds)
+ FI.
+
+erase file:
+ IF disk exists (msg.name)
+ THEN IF phase = 1
+ THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")
+ ELSE disk erase (msg.name);
+ manager ok (ds)
+ FI
+ ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")
+ FI.
+
+exists file:
+ IF disk exists (msg.name)
+ THEN manager ok (ds)
+ ELSE send (order task, false code, ds)
+ FI.
+
+list disk:
+ disk list (ds);
+ manager ok (ds).
+
+deliver directory:
+ forget (ds);
+ ds := nilspace;
+ BOUND THESAURUS VAR all names := ds;
+ all names := disk all;
+ manager ok (ds).
+
+reserve:
+ IF reserve or free permitted
+ THEN do continue channel;
+ disk owner := from task;
+ disk reserve (msg.name);
+ manager ok (ds)
+ ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")
+ FI.
+
+do continue channel:
+ IF channel <> dos channel
+ THEN continue channel (dos channel)
+ FI.
+
+reserve or free permitted :
+ from task = disk owner OR last access more than five minutes ago
+ OR disk owner = niltask OR NOT
+ (exists (disk owner) OR station(disk owner) <> station (myself)).
+
+last access more than five minutes ago :
+ abs (last access time - clock (1)) > 300.0.
+
+free:
+ IF reserve or free permitted
+ THEN disk free;
+ disk owner := niltask;
+ break (quiet);
+ manager ok (ds)
+ ELSE manager message ("DOS nicht angemeldet")
+ FI.
+
+END PROC dos manager;
+
+PROC manager ok (DATASPACE VAR ds):
+ send (order task, ack, ds);
+ last access time := clock (1).
+
+END PROC manager ok;
+
+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):
+ text (quote + adapted name (name, status) + quote, 14)
+
+END PROC expanded name;
+
+END PACKET dos manager multi;
diff --git a/system/dos/1986/src/name conversion b/system/dos/1986/src/name conversion new file mode 100644 index 0000000..3cdc202 --- /dev/null +++ b/system/dos/1986/src/name conversion @@ -0,0 +1,77 @@ +PACKET name conversion DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ adapted name: (* 20.02.86 *)
+
+LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&@!(){}",
+ lower case chars = "abcdefghijklmnopqrstuvwxyz";
+
+TEXT VAR name pre,
+ name post,
+ new,
+ char;
+
+INT VAR point pos,
+ count;
+
+TEXT PROC adapted name (TEXT CONST eu name, BOOL CONST read modus):
+ enable stop;
+ point pos := pos (eu name, ".");
+ IF name extension exists
+ THEN changed name with extension
+ ELSE changed name without extension
+ FI.
+
+name extension exists:
+ point pos > 0.
+
+changed name with extension:
+ name pre := compress (subtext (eu name, 1, point pos - 1));
+ name post := compress (subtext (eu name, point pos + 1));
+ IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3
+ THEN error
+ FI;
+ IF LENGTH name post = 0
+ THEN new name (name pre, read modus)
+ ELSE new name (name pre, read modus) + "."
+ + new name (name post, read modus)
+ FI.
+
+changed name without extension:
+ IF LENGTH eu name > 8 OR LENGTH euname < 1
+ THEN error
+ FI;
+ new name (eu name, read modus).
+
+error:
+ errorstop ("Unzulässiger Name").
+
+END PROC adapted name;
+
+TEXT PROC new name (TEXT CONST old name, BOOL CONST read modus):
+ new := "";
+ FOR count FROM 1 UPTO LENGTH old name REP
+ convert char
+ PER;
+ new.
+
+convert char:
+ char := old name SUB count;
+ IF is lower case char
+ THEN new CAT (upper case chars SUB string pos)
+ ELIF is upper case char OR read modus
+ THEN new CAT char
+ ELSE error stop ("Unzulässiger Name")
+ FI.
+
+is lower case char:
+ pos (lower case chars, char) > 0.
+
+is upper case char:
+ pos (upper case chars, char) > 0.
+
+string pos:
+ pos (lower case chars, char).
+
+END PROC new name;
+
+END PACKET name conversion;
diff --git a/system/dos/1986/src/open b/system/dos/1986/src/open new file mode 100644 index 0000000..92e81e9 --- /dev/null +++ b/system/dos/1986/src/open @@ -0,0 +1,51 @@ +PACKET open DEFINES (* Copyright (C) 1986 *)
+ (* Frank Klapper *)
+ open action, (* 20.03.86 *)
+ close action,
+ action opened,
+ action closed,
+ init check rerun,
+ check rerun:
+
+BOOL VAR open;
+INT VAR old session;
+
+INITFLAG VAR packet := FALSE;
+
+PROC open action:
+ open := TRUE
+
+END PROC open action;
+
+PROC close action:
+ open := FALSE
+
+END PROC close action;
+
+BOOL PROC action opened:
+ IF NOT initialized (packet)
+ THEN close action
+ FI;
+ open
+
+END PROC action opened;
+
+BOOL PROC action closed:
+ NOT action opened
+
+END PROC action closed;
+
+PROC init check rerun:
+ old session := session
+
+END PROC init check rerun;
+
+PROC check rerun:
+ IF session <> old session
+ THEN close action;
+ error stop ("Diskettenzugriff im RERUN")
+ FI.
+
+END PROC check rerun;
+
+END PACKET open;
diff --git a/system/dos/1986/src/save b/system/dos/1986/src/save new file mode 100644 index 0000000..903cfaa --- /dev/null +++ b/system/dos/1986/src/save @@ -0,0 +1,273 @@ +PACKET save DEFINES (* Copyright (C) 1985 *)
+ (* Frank Klapper *)
+ (* 07.05.86 *)
+ save filemode,
+ save rowtextmode,
+ save dsmode:
+
+LET ascii = 1,
+ ascii german = 2,
+ transparent = 3,
+ ebcdic = 4,
+ atari st = 10;
+
+LET ascii ctrl z = ""26"";
+
+LET row text mode length = 4000;
+
+CLUSTER VAR cluster;
+
+DATASPACE VAR cluster space;
+
+BOUND STRUCT (INT size,
+ ROW row text mode length TEXT cluster row) VAR cluster struct;
+
+REAL VAR storage;
+TEXT VAR cr lf, ff;
+TEXT VAR buffer;
+
+PROC save filemode (DATASPACE CONST file space,
+ TEXT CONST name,
+ INT CONST code type):
+ disable stop;
+ cluster space := nilspace;
+ cluster := cluster space;
+ enable save filemode (file space, name, code type);
+ buffer := "";
+ forget (cluster space).
+
+END PROC save filemode;
+
+PROC enable save filemode (DATASPACE CONST file space,
+ TEXT CONST name,
+ INT CONST code type):
+ enable stop;
+ open save (name);
+ init save filemode;
+ INT VAR line no;
+ FOR line no FROM 1 UPTO lines (file) REP
+ to line (file, line no);
+ buffer cat file line;
+ WHILE LENGTH buffer >= cluster size REP
+ copy buffer to cluster;
+ write disk cluster (cluster space, first non dummy ds page, next save cluster no);
+ remember rest
+ PER
+ PER;
+ cat ctrl z if necessary;
+ write rest;
+ close save (storage).
+
+init save filemode:
+ storage := 0.0;
+ FILE VAR file := sequential file (modify, file space);
+ SELECT code type OF
+ CASE ascii, ascii german, atari st, transparent: cr lf := ""13""10""; ff := ""12""
+ CASE ebcdic: cr lf := ""13"%"; ff := ""12""
+ END SELECT;
+ buffer := "".
+
+buffer cat file line:
+ exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type).
+
+copy buffer to cluster:
+ write text (cluster, buffer);
+ storage INCR real (min (cluster size, LENGTH buffer)).
+
+remember rest:
+ buffer := subtext (buffer, cluster size + 1).
+
+write rest:
+ WHILE buffer <> ""
+ REP copy buffer to cluster;
+ write disk cluster (cluster space, first non dummy ds page, next save cluster no);
+ remember rest
+ PER.
+
+cat ctrl z if necessary:
+ IF code type <> ebcdic
+ THEN buffer CAT ascii ctrl z
+ FI.
+
+END PROC enable save filemode;
+
+PROC cat adapted line (TEXT VAR line, INT CONST code type):
+ IF subtext (line, 1, 6) = "#page#"
+ THEN buffer CAT ff;
+ LEAVE cat adapted line
+ FI;
+ SELECT code type OF
+ CASE transparent: (* no operation *)
+ CASE ascii: change eumel print chars; ascii change
+ CASE ascii german: change eumel print chars; ascii german change
+ CASE atari st: change eumel print chars; atari st change
+ CASE ebcdic: change eumel print chars; eumel to ebcdic with substitution (line)
+ END SELECT;
+ buffer CAT line;
+ buffer CAT cr lf.
+
+change eumel print chars:
+ INT VAR char pos := pos (line, ""220"", ""223"", 1);
+ WHILE char pos > 0 REP
+ replace (line, char pos, std char);
+ char pos := pos (line, ""220"", ""223"", char pos + 1)
+ PER.
+
+std char:
+ SELECT code (line SUB char pos) OF
+ CASE 220: "k"
+ CASE 221: "-"
+ CASE 222: "#"
+ CASE 223: " "
+ OTHERWISE ""
+ END SELECT.
+
+ascii change:
+ change all (line, ""251"", "#251#");
+ char pos := pos (line, "Ä", "ü", 1);
+ WHILE char pos > 0 REP
+ line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);
+ char pos := pos (line, "Ä", "ü", char pos + 1)
+ PER.
+
+ascii german change:
+ char pos := pos (line, "[", "]", 1);
+ WHILE char pos > 0 REP
+ line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);
+ char pos := pos (line, "[", "]", char pos + 1)
+ PER;
+ char pos := pos (line, "{", "}", 1);
+ WHILE char pos > 0 REP
+ line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);
+ char pos := pos (line, "{", "}", char pos + 1)
+ PER;
+ change all (line, ""251"", "~");
+ char pos := pos (line, "Ä", "ü", 1);
+ WHILE char pos > 0 REP
+ replace (line, char pos, umlaut in ascii german);
+ char pos := pos (line, "Ä", "ü", char pos + 1)
+ PER.
+
+atari st change:
+ change all (line, "ß", ""158"");
+ char pos := pos (line, "Ä", "ü", 1);
+ WHILE char pos > 0 REP
+ replace (line, char pos, umlaut in atari st);
+ char pos := pos (line, "Ä", "ü", char pos + 1)
+ PER.
+
+ersatzdarstellung:
+ TEXT VAR char code := text (code (line SUB char pos));
+ "#" + (3 - LENGTH char code) * "0" + char code + "#".
+
+umlaut in ascii german:
+ SELECT code (line SUB char pos) OF
+ CASE 214: "["
+ CASE 215: "\"
+ CASE 216: "]"
+ CASE 217: "{"
+ CASE 218: "|"
+ CASE 219: "}"
+ OTHERWISE ""
+ END SELECT.
+
+umlaut in atari st:
+ SELECT code (line SUB char pos) OF
+ CASE 214: ""142""
+ CASE 215: ""153""
+ CASE 216: ""154""
+ CASE 217: ""132""
+ CASE 218: ""148""
+ CASE 219: ""129""
+ OTHERWISE ""
+ END SELECT.
+
+END PROC cat adapted line;
+
+PROC save rowtextmode (DATASPACE CONST space,
+ TEXT CONST name):
+ disable stop;
+ cluster space := nilspace;
+ cluster := cluster space;
+ enable save rowtext mode (space, name);
+ forget (cluster space).
+
+END PROC save rowtextmode;
+
+PROC enable save rowtextmode (DATASPACE CONST space,
+ TEXT CONST name):
+ enable stop;
+ open save (name);
+ init save row textmode;
+ WHILE line no < cluster struct.size REP
+ fill buffer;
+ copy buffer to cluster;
+ write disk cluster (cluster space, first non dummy ds page, next save cluster no);
+ remember rest
+ PER;
+ write rest;
+ close save (storage).
+
+init save rowtextmode:
+ storage := 0.0;
+ cluster struct := space;
+ INT VAR line no := 0;
+ TEXT VAR buffer := "".
+
+fill buffer:
+ WHILE line no < cluster struct.size AND NOT buffer full REP
+ line no INCR 1;
+ buffer CAT cluster struct.cluster row [line no]
+ PER.
+
+buffer full:
+ LENGTH buffer >= cluster size.
+
+copy buffer to cluster:
+ write text (cluster, buffer);
+ storage INCR real (min (cluster size, LENGTH buffer)).
+
+remember rest:
+ buffer := subtext (buffer, cluster size + 1).
+
+write rest:
+ WHILE buffer <> ""
+ REP copy buffer to cluster;
+ write disk cluster (cluster space, first non dummy ds page, next save cluster no);
+ remember rest
+ PER.
+
+END PROC enable save rowtextmode;
+
+PROC save ds mode (DATASPACE CONST ds,
+ TEXT CONST name):
+ disable stop;
+ enable save ds mode (ds, name).
+
+END PROC save ds mode;
+
+PROC enable save ds mode (DATASPACE CONST ds,
+ TEXT CONST name):
+ enable stop;
+ open save (name);
+ INT VAR page no := first non dummy ds page;
+ get last allocated ds page;
+ WHILE page no <= last allocated ds page REP
+ write disk cluster (ds, page no, next save cluster no);
+ page no INCR sectors per cluster
+ PER;
+ close save (size).
+
+get last allocated ds page:
+ INT VAR last allocated ds page := -1,
+ i;
+ FOR i FROM 1 UPTO ds pages (ds) REP
+ last allocated ds page := next ds page (ds, last allocated ds page)
+ PER.
+
+size:
+ real (last allocated ds page - first non dummy ds page + 1) * 512.0.
+
+END PROC enable save ds mode;
+
+END PACKET save;
diff --git a/system/dos/1986/src/shard interface b/system/dos/1986/src/shard interface new file mode 100644 index 0000000..c7fdac5 --- /dev/null +++ b/system/dos/1986/src/shard interface @@ -0,0 +1,19 @@ +; ';' in Spalte 1 kennzeichnet eine Kommentarzeile
+; alle Werte müssen durch Blanks getrennt werden
+;
+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen
+; negativ für seitenorientiertes Lesen
+;
+;size heads tracks first sectors last sector
+;=====================================================
+320 1 40 1 8
+360 1 40 1 9
+640 -2 40 1 8
+720 -2 40 1 9
+800 2 40 1 10
+1440 -2 80 1 9
+1600 2 80 1 10
+2400 -2 80 1 15
+1232 1 77 0 15
+2464 -2 77 0 15
+; END OF FILE
diff --git a/system/dos/1986/src/table thes.dos b/system/dos/1986/src/table thes.dos new file mode 100644 index 0000000..8b254cf --- /dev/null +++ b/system/dos/1986/src/table thes.dos @@ -0,0 +1,5 @@ +shard interface
+252
+253
+254
+255
|