From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- system/dos/1.8.7/doc/dos-dat-handbuch | 650 +++++++++++++++++++++++++++ system/dos/1.8.7/source-disk | 1 + system/dos/1.8.7/src/block i-o | 180 ++++++++ system/dos/1.8.7/src/bpb ds | Bin 0 -> 2048 bytes system/dos/1.8.7/src/dir.dos | 693 +++++++++++++++++++++++++++++ system/dos/1.8.7/src/disk descriptor.dos | 339 ++++++++++++++ system/dos/1.8.7/src/dos hd inserter | 41 ++ system/dos/1.8.7/src/dos inserter | 59 +++ system/dos/1.8.7/src/dump | 49 ++ system/dos/1.8.7/src/eu disk descriptor | 107 +++++ system/dos/1.8.7/src/fat.dos | 369 +++++++++++++++ system/dos/1.8.7/src/fetch | 371 +++++++++++++++ system/dos/1.8.7/src/fetch save interface | 70 +++ system/dos/1.8.7/src/get put interface.dos | 368 +++++++++++++++ system/dos/1.8.7/src/insert.dos | 14 + system/dos/1.8.7/src/konvert | 75 ++++ system/dos/1.8.7/src/manager-M.dos | 211 +++++++++ system/dos/1.8.7/src/manager-S.dos | 268 +++++++++++ system/dos/1.8.7/src/name conversion.dos | 77 ++++ system/dos/1.8.7/src/open | 66 +++ system/dos/1.8.7/src/save | 233 ++++++++++ system/dos/1.8.7/src/shard interface | 20 + 22 files changed, 4261 insertions(+) create mode 100644 system/dos/1.8.7/doc/dos-dat-handbuch create mode 100644 system/dos/1.8.7/source-disk create mode 100644 system/dos/1.8.7/src/block i-o create mode 100644 system/dos/1.8.7/src/bpb ds create mode 100644 system/dos/1.8.7/src/dir.dos create mode 100644 system/dos/1.8.7/src/disk descriptor.dos create mode 100644 system/dos/1.8.7/src/dos hd inserter create mode 100644 system/dos/1.8.7/src/dos inserter create mode 100644 system/dos/1.8.7/src/dump create mode 100644 system/dos/1.8.7/src/eu disk descriptor create mode 100644 system/dos/1.8.7/src/fat.dos create mode 100644 system/dos/1.8.7/src/fetch create mode 100644 system/dos/1.8.7/src/fetch save interface create mode 100644 system/dos/1.8.7/src/get put interface.dos create mode 100644 system/dos/1.8.7/src/insert.dos create mode 100644 system/dos/1.8.7/src/konvert create mode 100644 system/dos/1.8.7/src/manager-M.dos create mode 100644 system/dos/1.8.7/src/manager-S.dos create mode 100644 system/dos/1.8.7/src/name conversion.dos create mode 100644 system/dos/1.8.7/src/open create mode 100644 system/dos/1.8.7/src/save create mode 100644 system/dos/1.8.7/src/shard interface (limited to 'system/dos') 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 Archiv­Operation). Ä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 new file mode 100644 index 0000000..dabf721 Binary files /dev/null and b/system/dos/1.8.7/src/bpb ds differ 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, " "); +(*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 + -- cgit v1.2.3