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 --- .../setup/3.1/src/setup eumel 4: dienstprogramme | 218 +++++++++++++++++++++ 1 file changed, 218 insertions(+) create mode 100644 system/setup/3.1/src/setup eumel 4: dienstprogramme (limited to 'system/setup/3.1/src/setup eumel 4: dienstprogramme') diff --git a/system/setup/3.1/src/setup eumel 4: dienstprogramme b/system/setup/3.1/src/setup eumel 4: dienstprogramme new file mode 100644 index 0000000..9ce9ca3 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 4: dienstprogramme @@ -0,0 +1,218 @@ + +(**************************************************************************) +(***** Dienstprogramme für Modulprogrammierer *****************) +(***** Copyright (c) 1987, 1988 *****************) +(***** Lutz Prechelt, Karlsruhe *****************) +(**************************************************************************) + +PACKET setup eumel dienstprogramme (* Copyright (c) 1987 by *) +DEFINES (* Lutz Prechelt, Karlsruhe *) + file as one text, (* Stand : 07.05.88 1.4 *) + ich schreibe jetzt ein neues shard modul, (* Eumel 1.8.1 *) + link shard module, + all modules: + +(* Dies sind Dienstprogramme, die der Modul-Programmierer braucht *) + +(* Das Format der Refinementdateien für den dtcb- und ccb-Setupdialog ist wie + folgt: + 1. Zeile: INT-Denoter für die Anzahl von Abfragerefinements, die drin sind + Rest der Zeile muß leer sein. + Danach : lauter ELAN-Refinements mit den Namen r1, r2 usw. + evtl. weitere Refinements zur Hilfe mit beliebigen Namen (es + gibt ein paar Ausnahmen, über die man beim ersten Test dann aber + stolpert.) + In den Refinements dürfen Variablen vereinbart werden. Vor dem ersten + refinement der Datei darf KEIN Punkt sein (es ist sowieso schlechter + Stil, die Punkte nicht hinter die vorherige Zeile zu setzen, sondern + vor den refinementnamen.), hingegen MUSS nach dem letzten Refinement der + Datei ein Punkt stehen. + Wer das für nötig hält, kann auch Prozeduren definieren und verwenden, + was allerdings nicht geht, sind Pakete. + Wenn man mit Kommentaren und sonstigen Bytefressern sparsam + umgeht, läuft der Dialog beim Setup später etwas schneller an. +*) + +LET modul namentyp = "SHardmodul *"; + +DATASPACE VAR ds; + +(***************************************************************************) + +THESAURUS PROC all modules (THESAURUS CONST th): + (* Hier wird schlabberig nach Namen ausgewählt, während der Setup Eumel + im Betrieb die Datenraumtypen als Auswahlkriterium verwendet. + Die Schwierigkeiten, die bei Nichteinhalten der Namenskonventionen + entstehen, veranlassen hoffentlich jeden zur nötigen Disziplin... + *) + (th LIKE "SHardmodul *") - (th LIKE "SHardmodul *.ccb") + - (th LIKE "SHardmodul *.dtcb") - (th LIKE "SHardmodul *.info") +END PROC all modules; + +(*****THESAURUS PROC all modules: wird sauber in Teil 2 realisiert + all modules (all) +END PROC all modules; +*****) + +(********************* link shard module *********************************) + +PROC link shard module: + TEXT VAR module :: std; + REPEAT + page; + putline (" L I N K S H A R D - M O D U L E"); line (2); + put ("Modulname:"); editget (module); line (2); + link shard module (module); line; + UNTIL NOT yes ("noch ein Modul linken", FALSE) PER +END PROC link shard module; + +PROC link shard module (THESAURUS CONST th): + do (PROC (TEXT CONST) link shard module, th); +END PROC link shard module; + +PROC link shard module (TEXT CONST module): + (* Ruft link shard module (modul, dtcb, ccb, info) unter Anwendung von + Namenskonventionen (nämlich entsprechende Suffixe ".dtcb" etc.) auf. + *) + TEXT VAR dtcb, ccb, info; + BOOL VAR elan neu; + dtcb := module + ".dtcb"; + ccb := module + ".ccb"; + info := module + ".info"; + perhaps change filenames; + elan neu := yes (module + ": neue Elan Teile machen", FALSE); + IF elan neu THEN neue elan teile machen FI; + link shard module (module, dtcb, ccb, info); + IF elan neu THEN check syntax FI. + +neue elan teile machen: + edit (dtcb); line (2); + edit (ccb); line (2); + edit (info); page. + +perhaps change filenames: +(*put ("Datei mit dtcb-refinements :"); editget (dtcb); line; + put ("Datei mit ccb-refinements :"); editget (ccb); line; + put ("Datei mit Infotext :"); editget (info); line (2)*) . + +check syntax : + line (2); put (module); putline (": Syntax-Check"); + forget (ds); + ds := nilspace; + BOUND MODUL VAR m :: old (module), old shard :: ds, new shard :: ds; + INT VAR offset dtcb table :: int (m, 0), + dtcb table entries :: int (m, offset dtcb table), + offset ccb table :: int (m, 2), + ccb table entries :: int (m, offset ccb table); + (* Jetzt einen total verkrüppelten automatischen "perform dialogue" für + die Probeübersetzung der .dtcb und .ccb refinements aufrufen. + *) + perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries, + new shard, 0.0, + old shard, 0.0, + FALSE, FALSE, + dtcb refinements (m), dtcb abfragen (m), + TRUE, FALSE); + putline ("dtcb refinements O.K."); + ROW 40 REAL VAR x :: ROW 40 REAL : (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0); + perform ccb dialogue (m, real (offset ccb table+2), ccb table entries, + new shard, x, + old shard, x, + 1, + FALSE, FALSE, + ccb refinements (m), ccb abfragen (m), + TRUE, FALSE); + putline ("ccb refinements O.K."); + forget (ds). +END PROC link shard module; + +PROC link shard module (TEXT CONST module, dtcb, ccb, infofile) : + IF type (old (module)) <> datenraumtyp modul CAND NOT typ aendern + THEN LEAVE link shard module + ELSE type (old (module), datenraumtyp modul) FI; + IF NOT (module LIKE modul namentyp) + THEN errorstop ("Module MÜSSEN Namen der Art """ + modul namentyp + + """ haben") + FI; + line; + BOUND MODUL VAR m :: old (module); + TEXT VAR dtcb ref :: file as one text (dtcb, FALSE), + ccb ref :: file as one text (ccb, FALSE), + info text:: file as one text (infofile, TRUE); + INT CONST pos dtcb :: pos (dtcb ref, " "), (* Ende der ersten Zeile, die *) + pos ccb :: pos (ccb ref, " "); (* die Abfragezahl enthält *) + INT VAR dtcb count, ccb count; + dtcb count := int (subtext (dtcb ref, 1, pos dtcb)); + IF NOT last conversion ok OR dtcb count < 0 OR dtcb count > 1000 + THEN errorstop ("keine vernünftige Zahl von dtcb Abfragen gefunden") FI; + ccb count := int (subtext (ccb ref, 1, pos ccb)); + IF NOT last conversion ok OR ccb count < 0 OR ccb count > 1000 + THEN errorstop ("keine vernünftige Zahl von ccb Abfragen gefunden") FI; + (* JETZT PASSIERTS : *) + dtcb abfragen (m, dtcb count); + dtcb refinements (m, subtext (dtcb ref, pos dtcb + 1)); + ccb abfragen (m, ccb count); + ccb refinements (m, subtext (ccb ref, pos ccb + 1)); + info (m, infotext); + line; + putline (""""+module+""" gelinkt. " + text (storage (old (module))) + + " K Datenraumgröße."). + +typ aendern : + IF type (old (module)) = 1003 (* file type *) + THEN putline ("(""" + module + """ hat den Typ FILE)") FI; + putline ("Achtung: """ + module + """ ist nicht vom Typ eines SHard-Moduls"); + yes ("Soll es dazu gemacht werden (Typ aufprägen)", FALSE). +END PROC link shard module; + +(******************** file as one text ************************************) + +TEXT PROC file as one text (TEXT CONST filename, BOOL CONST verbatim) : + FILE VAR f :: sequential file (input, filename); + TEXT VAR result :: "", t; + put ("Lese """ + filename + """ :"); + WHILE NOT eof (f) REP + cout (line no (f)); + getline (f, t); + work on t; + result CAT t + PER; + line; + result. + +work on t : + IF verbatim + THEN t CAT ""13""10"" + ELSE t := compress (t); t CAT " " FI. +END PROC file as one text; + +(****** ich schreibe jetzt ein neues shard modul ***************************) + +PROC ich schreibe jetzt ein neues shard modul : + line (2); + putline ("So so, Sie wollen also ein neues SHard-Modul schreiben."); line; + pause (20); + putline ("Mir kommt es so vor, als sei heute der " + date + + " und im Moment gerade " + time of day + " Uhr"); line; + IF NOT yes ("Stimmt das ungefähr (auf 5 Minuten kommt's nicht an)", TRUE) + THEN do ("set date"); line (2) FI; + putline ("Also gut. Schreiben Sie Ihr verdammtes Modul."); + putline ("Aber merken Sie sich die folgenden 4 Bytes als ihren Modultyp"); + put (""15" "); + REAL VAR x :: floor (clock (1) - date ("05.05.79") - time ("10:00:00")); + INT VAR i; + FOR i FROM 1 UPTO 4 REP + put (int (x MOD 256.0)); + x := floor (x / 256.0) + PER; + put (" "14""); line (2); + putline ("Also : die Dinger merken (schreiben Sie sie auf, sonst vergessen Sie"); + putline (" sie ja doch) und NICHT MEHR ÄNDERN !"); + line (3) +END PROC ich schreibe jetzt ein neues shard modul; + +END PACKET setup eumel dienstprogramme; + -- cgit v1.2.3