(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *) 
 
(* 
EUMEL0: 
modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1 
3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0 
3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710 
32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32666 
1 16 17 18 32592 17 19 32666 1 22 18 0 32667 2 22 19 0 3090 3091 3092 11284 
21 28750 32587 32583 1 32512 endc pbase: -256 0 0 0 0 1792 -256 1 0 0 3 256 
0 5 0 -32768 9999 7 25 0 0 0 4 1 endp 
*) 
PACKET ds accesses DEFINES 
  do, 
  ds nr, 
  forget all but not, 
  set modul start ic, 
  read ds, 
  write ds, 
: 
INT CONST stdds := 4 + index(myself) * 256;  
INT PROC read ds (INT CONST drid, add hi, add lo): 
  EXTERNAL 154 
END PROC read ds; 
INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo): 
  EXTERNAL 154 
END PROC read ds; 
PROC write ds (INT CONST drid, add hi, add lo, data): 
  EXTERNAL 155 
END PROC write ds; 
PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data): 
  EXTERNAL 155 
END PROC write ds; 
PROC forget (INT CONST ds): 
  EXTERNAL 71 
END PROC forget; 
OP := (INT VAR left, DATASPACE CONST right): 
   EXTERNAL 260 
END OP :=; 
PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 
           INT VAR modul nr, BOOL CONST ins, lst, rt check, ser): 
  EXTERNAL 256 
END PROC elan; 
PROC do (INT CONST modul nr): 
  INT VAR modul no:= modul nr; 
  DATASPACE VAR source; 
  elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE); 
END PROC do; 
INT PROC ds nr (TEXT CONST name): 
  INT VAR nr := old (name); nr 
END PROC ds nr; 
PROC forget all but not (INT CONST ds): 
  INT VAR i, a; 
  FOR i FROM 5 UPTO 255 REP 
    a := i + 256 * index (myself); 
    IF i <> ds MOD 256 THEN 
      cout (i); forget (a); 
    FI; 
  PER 
END PROC forget all but not; 
PROC set modul start ic (INT CONST modul nr, ic hi, ic lo): 
  IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI; 
  IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN 
    write ds (stdds, 0, modul nr + 512, ic lo); 
  ELSE 
    error stop ("Falsche Modulnummer: " + text (modul nr)); 
  FI; 
END PROC set modul start ic; 
END PACKET ds accesses; 
PACKET lader DEFINES 
  lade, 
: 
INT CONST stdds := 4 + index (myself) * 256; 
PROC check task index (TEXT CONST name): 
  IF index (myself) = index copytask (old(name)) THEN 
    putline ("Leider haben sie den gleichen Taskindex wie bei der Quelltask erwischt!"); 
    errorstop("Bitte versuchen sie es mit einer neuen Task!"); 
  FI; 
END PROC check task index; 
INT PROC index copytask (DATASPACE CONST ds): 
  read ds (ds, 7, 9) 
END PROC index copytask; 
PROC get ic (FILE VAR f, INT VAR ic hi, ic lo): 
  find text (f,"start:"); 
  get int (f,ic hi); get int (f,ic lo); 
  IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI; 
END PROC get ic; 
PROC get pbase (FILE VAR f, INT VAR ps): 
  find text (f, "pbase:"); 
  get int (f, ps); 
  IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI; 
END PROC get pbase; 
PROC get modul (FILE VAR f, INT VAR modul nr): 
  find text (f, "modul:"); 
  get int (f, modul nr); 
END PROC get modul; 
PROC load code (FILE VAR f): 
  INT VAR add hi, add lo, code wert; 
  TEXT VAR code ende; 
  check end code (f); 
  get code add (f, add hi, add lo); 
  REP 
    get code (f, code wert, code ende); 
    IF code ende = "end" THEN LEAVE load code FI; 
    write ds (stdds, add hi, add lo, code wert); 
    add lo INCR 1; 
  PER 
END PROC load code; 
PROC load pbase (FILE VAR f): 
  INT VAR  pbase add, pbase wert; 
  TEXT VAR pbase ende; 
  check end pbase (f); 
  get pbase (f, pbase add); 
  REP 
    get pbase (f, pbase wert, pbase ende); 
    IF pbase ende = "end" THEN LEAVE load pbase FI; 
    write ds (stdds, 0, pbase add, pbase wert); 
    pbase add INCR 1; 
  PER 
END PROC load pbase; 
INT PROC read pbase var (FILE VAR f, INT CONST index): 
  INT VAR pbase add; 
  get pbase (f, pbase add); 
  read ds (stdds, 0, pbase add+index) 
END PROC read pbase var; 
PROC write pbase var (FILE VAR f, INT CONST index, var): 
  INT VAR pbase add; 
  get pbase (f, pbase add); 
  write ds (stdds, 0, pbase add+index, var); 
END PROC write pbase var; 
PROC get code add (FILE VAR f, INT VAR add hi, add lo): 
  find text (f, "code:"); 
  get int (f, add hi); get int (f, add lo); 
  IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI; 
END PROC get code add; 
PROC get int (FILE VAR f, INT VAR value): 
  IF eof (f) THEN error stop ("Daten fehlen") FI; 
  TEXT VAR daten; 
  get (f, daten); 
  IF daten = "-32768" THEN 
    value := -maxint-1; 
  ELSE 
    value := int (daten); 
  ENDIF; 
END PROC get int; 
PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ): 
  IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI; 
  TEXT VAR daten ; 
  get (f, daten); 
  IF daten = "endc" THEN 
    ende := "end" 
  ELSE 
    IF daten = "-32768" THEN 
      value := -maxint-1; 
    ELSE 
      value := int (daten); 
    ENDIF; 
    ende := "no end" 
  FI; 
END PROC get code; 
PROC check end code (FILE VAR f): 
  find text (f, "endc"); 
END PROC check end code; 
PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende): 
  IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI; 
  TEXT VAR daten ; 
  get (f, daten); 
  IF daten = "endp" THEN 
    ende := "end" 
  ELSE 
    IF daten = "-32768" THEN 
      value := -maxint-1; 
    ELSE 
      value := int (daten); 
    ENDIF; 
    ende := "no end" 
  FI; 
END PROC get pbase; 
PROC check end pbase (FILE VAR f): 
  find text (f, "endp"); 
END PROC check end pbase; 
PROC find text (FILE VAR f, TEXT CONST suchtext): 
  TEXT VAR t; 
  go start (f); 
  WHILE NOT eof (f) REP 
    get (f, t); 
    IF t = suchtext THEN LEAVE find text FI; 
  PER; 
  error stop (suchtext + " fehlt") 
END PROC find text; 
PROC go start (FILE VAR f): 
  TEXT VAR t; 
  reset (f); 
  WHILE NOT eof (f) REP 
    get (f, t); 
    IF t = "EUMEL0:" THEN LEAVE go start FI 
  PER; 
  error stop ("EUMEL0-Code nicht gefunden"); 
END PROC go start; 
PROC run code (INT VAR ic hi, ic lo, modul nr): 
  set modul start ic (modul nr, ic hi, ic lo); 
  do push (modul nr); 
END PROC run code; 
PROC do push (INT CONST modul nr): 
  IF lbase < 30000 THEN 
    do push (modul nr); 
  ELSE 
    do (modul nr); LEAVE do push; 
  FI; 
END PROC do push; 
INT PROC lbase: 
  pcb (25) 
END PROC lbase; 
PROC lade (TEXT CONST datei name): 
  INT VAR ic hi, ic lo, modul nr; 
  line; 
  putline ("Achtung: ALLE bis jetzt insertierten Packete der Task gehen verloren!"); 
  IF NOT yes ("Wollen sie den Standarddatenraum ersetzen") THEN LEAVE lade FI; 
  check task index (datei name); 
  FILE VAR f := sequentialfile (input, dateiname); 
  get ic (f, ic hi, ic lo); 
  get modul (f, modul nr); 
  load code (f); 
  load pbase (f); 
  load pbase var (f); 
  run code (ic hi, ic lo, modul nr); 
END PROC lade; 
PROC load pbase var (FILE VAR f): 
  INT VAR dss, dst; TEXT VAR name := "STD DS4"; 
  line; 
  put ("Wie heißt der Quelldatenraum:"); 
  editget (name); 
  line; 
  IF NOT exists (name) THEN errorstop("Datei " + name + " gibt es nicht."); FI; 
  dst := 4 + 256 * index (myself); 
  dss := ds nr (name); 
  write pbase var (f, 1, dss); 
  write pbase var (f, 2, dst); 
  forget all but not (dss); 
END PROC load pbase var; 
PROC lade: 
  lade ("RUN load ds4"); 
END PROC lade; 
END PACKET lader; 
lade;