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")