From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- devel/misc/unknown/src/COPYDS.ELA | 294 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 devel/misc/unknown/src/COPYDS.ELA (limited to 'devel/misc/unknown/src/COPYDS.ELA') diff --git a/devel/misc/unknown/src/COPYDS.ELA b/devel/misc/unknown/src/COPYDS.ELA new file mode 100644 index 0000000..c0bd83c --- /dev/null +++ b/devel/misc/unknown/src/COPYDS.ELA @@ -0,0 +1,294 @@ +LET systemanker = 2 , (* Wird bei 'blockin' durch 2 geteilt *) + channel field = 4 , + hg channel = 0 ; + +ROW 256 INT VAR block ; +INT VAR return ; + +PROC pcb (TASK CONST id, INT CONST field, value) : + EXTERNAL 105 +ENDPROC pcb ; + +PROC copy ds (INT CONST task nr, ds nr, TEXT CONST destination) : + DATASPACE VAR ds ; + ROW 8 INT VAR dr eintrag ; + INT VAR old channel := channel, link, i, seite ; + + system channel ; + zugriff ueber drdr ; + IF ist nilspace + THEN ds := nilspace + ELIF ist kleindatenraum + THEN lese kleindatenraum + ELSE lese grossdatenraum + FI ; + user channel ; + forget (destination, quiet) ; + copy (ds, destination) ; + forget (ds) . + +user channel : + disablestop ; + continue (old channel) ; + IF iserror + THEN forget (ds) ; + FI ; + enablestop . + +system channel : + break (quiet) ; (* Offiziell abmelden *) + pcb (myself, channel field, hg channel) . (* Inoffiziell anmelden *) + +zugriff ueber drdr : + systemanker lesen ; + drdr taskwurzel lesen ; + drdr dataspacewurzel lesen . + +erste seite im dreintrag : + link := 8 * (dsnr MOD 32) + 1 ; + FOR i FROM link UPTO link + 7 REP + IF block (i) <> -1 + THEN LEAVE erste seite im dreintrag WITH i + FI + PER ; + user channel ; + errorstop ("Der Datenraum existiert nicht (DR-Eintrag = 8 mal FFFF)") ; 0 . + +ist nilspace : + block (erste seite im dreintrag) = -255 . + +ist kleindatenraum : + block (link) > -255 AND block (link) < 0 . + +lese kleindatenraum : + ds := nilspace ; + IF seite eins existiert + THEN blockin (ds, 1, block (link + 1)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite 1 des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI ; + IF seite zwei existiert + THEN blockin (ds, 2, block (link + 2)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite 2 des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI ; + IF mehr als zwei seiten + THEN FOR i FROM 0 UPTO 4 REP + IF hoehere seite existiert + THEN blockin (ds, i + basisseite, block (link + i + 3)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite " + text (i + basisseite) + + " des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI + PER + FI . + +seite eins existiert : + exists (block (link + 1)) . + +seite zwei existiert : + exists (block (link + 2)) . + +mehr als zwei seiten : + exists (block (link)) . + +hoehere seite existiert : + exists (block (link + i + 3)) . + +basisseite : + block (link) AND 255 . + +lese grossdatenraum : + ds := nilspace ; + dreintrag kopieren ; + seite := 0 ; + FOR i FROM 1 UPTO 8 REP + IF seitenblocktabelle existiert + THEN seitenblocktabelle lesen ; + seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind + ELSE seite INCR 256 + FI + PER . + +seitenblocktabelle lesen : + blockin (dr eintrag (i)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seitenblocktabelle " + text (i-1) + + " des Datenraums nicht lesbar: " + text (return)) ; + putline ("Damit fehlen die Seiten " + text (max (1, seite)) + + " bis " + text (seite + 255)) ; + system channel + FI . + +seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind : + FOR link FROM 1 UPTO 256 REP + IF seite vorhanden + THEN blockin (ds, seite, block (link)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite " + text (seite) + + " des Datenraums nicht lesbar: " + text (return)) ; + system channel + FI ; + user channel ; + cout (seite) ; + system channel + FI ; + seite INCR 1 + PER . + +seite vorhanden : + exists (block (link)) . + +seitenblocktabelle existiert : + exists (dreintrag (i)) . + +dreintrag kopieren : + FOR i FROM 0 UPTO 7 REP + dreintrag (i + 1) := block (link + i) + PER . + +systemanker lesen : + blockin (systemanker) ; + IF return <> 0 + THEN user channel ; + errorstop ("Systemanker nicht lesbar: " + text (return)) + FI . + +drdr taskwurzel lesen : + link := block (tasknr DIV 32 + 1) ; + IF link = -1 + THEN user channel ; + errorstop ("Die Task existiert nicht") + FI ; + blockin (link) ; + IF return <> 0 + THEN user channel ; + errorstop ("Taskwurzel des DRDR nicht lesbar: " + text (return)) + FI . + +drdr dataspacewurzel lesen : + link := block (8 * (tasknr MOD 32) + dsnr DIV 32 + 1) ; + IF NOT exists (link) + THEN user channel ; + errorstop ("Der Datenraum (und weitere 31) existiert nicht") + FI ; + blockin (link) ; + IF return <> 0 + THEN user channel ; + errorstop ("Dataspacewurzel des DRDR nicht lesbar: " + + text (return)) + FI . + +ENDPROC copy ds ; + +BOOL PROC exists (INT CONST blocknr) : + blocknr <> -1 AND blocknr <> -255 +ENDPROC exists ; + +PROC blockin (INT CONST blocknr) : + blockin (block, 0, blocknr DIV 2, return) ; (* ggf COPBIT ausblenden *) +ENDPROC blockin ; + +PROC blockin (DATASPACE VAR ds, INT CONST page, blocknr) : + blockin (ds, page, 0, blocknr DIV 2, return) (* ggf COPBIT ausblenden *) +ENDPROC blockin ; + +PROC dump (TEXT CONST datei) : + edit dump (datei, FALSE) +ENDPROC dump ; + +PROC edit dump (TEXT CONST datei, BOOL CONST write access) : + BOUND STRUCT (ROW 252 INT page1, ROW 2047 ROW 256 INT blocks) VAR b ; + b := old (datei) ; + INT VAR blocknr := 1, i ; + TEXT VAR esc char, t ; + BOOL VAR clear := TRUE , modified ; + ROW 256 INT VAR page 1 ; + page 1 (1) := 0 ; + page 1 (2) := 0 ; + page 1 (3) := type (old (datei)) ; + page 1 (4) := -1 ; + page ; + put ("Info mit 'ESC ?'") ; + dump cursor (4, 3) ; + REP + out (""1""5"Datei: """) ; out (datei) ; put ("""") ; + put (", Page:") ; put (text (blocknr, 5)) ; + put (", Dspages:") ; put (text (dspages (old (datei)), 5)) ; + put (", Type:") ; put (type (old (datei))) ; + IF blocknr = 1 + THEN FOR i FROM 1 UPTO 252 REP + page1 (i + 4) := b.page1 (i) + PER ; + edit dump (page 1, 1, 256, clear, write access, modified, esc char); + IF modified + THEN FOR i FROM 1 UPTO 252 REP + b.page1 (i) := page 1 (i + 4) + PER ; + type (old (datei), page 1 (3)) + FI + ELSE edit dump (b.blocks (blocknr), 1, 256, clear, write access, modified, esc char) + FI ; + clear := TRUE ; + IF esc char = ""1""10"" + THEN blocknr INCR 1 + ELIF esc char = ""1""3"" + THEN IF blocknr > 1 + THEN blocknr DECR 1 + ELSE clear := FALSE ; + out (""1""15"E r s t e S e i t e "14""5"") + FI + ELIF esc char = ""27"q" + THEN LEAVE edit dump + ELIF esc char = ""27"?" + THEN clear := FALSE ; + putline (""1"ESC:?,p,q,w,F,0; HOP:HOP,LEFT,UP,DOWN,RIGHT; DEL,INS,LEFT,UP,RIGHT") ; + ELIF esc char = ""27"p" + THEN REP + put(""1""5"Neue Pagenr:") ; + t := text (blocknr) ; + editget (t) ; + blocknr := int (t) + UNTIL blocknr >= 0 AND blocknr < 2048 PER + ELSE clear := FALSE + FI ; + PER +ENDPROC edit dump ; + +INT VAR task index, ds nr ; +TEXT VAR task id ; +page ; +put ("""Taskname"" oder Taskindex:") ; +getline (task id) ; +IF pos (task id, """") > 0 + THEN scan (task id) ; + nextsymbol (task id) ; + task index := index (task (task id)) + ELSE task index := int (task id) +FI ; +put ("Dataspacenummer in der Task:") ; +get (ds nr) ; +IF ds nr < 4 + THEN errorstop ("Es gibt nur DATASPACE-Nummern >= 4") +FI ; +IF yes ("Soll vorher ein Fixpoint gesetzt werden") + THEN fixpoint +FI ; +forget ("new ds", quiet) ; +copy ds (task index, ds nr, "new ds") ; +putline ("Der kopierte Datenraum steht in der Datei ""new ds""") ; +dump ("new ds") -- cgit v1.2.3