PACKET error handling DEFINES
 
    enable stop ,
    disable stop ,
    is error ,
    clear error ,
    errormessage ,
    error code ,
    error line ,
    put error ,
    errorstop ,
    stop :
 
 
LET cr lf            = ""13""10"" ,
    line nr field    = 1 ,
    error line field = 2 ,
    error code field = 3 ,
    syntax error code= 100 ,

    error pre        = ""7""13""10""5"FEHLER : " ;


TEXT VAR errortext := "" ;
 
 
PROC enable stop :
  EXTERNAL 75
ENDPROC enable stop ;

PROC disable stop :
  EXTERNAL 76
ENDPROC disable stop ;

PROC set error stop (INT CONST code) :
  EXTERNAL 77
ENDPROC set error stop ;
 
BOOL PROC is error : 
  EXTERNAL 78
ENDPROC is error ; 
 
PROC clear error :
  EXTERNAL 79
ENDPROC clear error ;

PROC select error message :

  SELECT error code OF
    CASE 1 : error text := "'halt' vom Terminal"
    CASE 2 : error text := "Stack-Ueberlauf"
    CASE 3 : error text := "Heap-Ueberlauf"
    CASE 4 : error text := "INT-Ueberlauf"
    CASE 5 : error text := "DIV durch 0"
    CASE 6 : error text := "REAL-Ueberlauf"
    CASE 7 : error text := "TEXT-Ueberlauf"
    CASE 8 : error text := "zu viele DATASPACEs"
    CASE 9 : error text := "Ueberlauf bei Subskription"
    CASE 10: error text := "Unterlauf bei Subskription"
    CASE 11: error text := "falscher DATASPACE-Zugriff"
    CASE 12: error text := "INT nicht initialisiert"
    CASE 13: error text := "REAL nicht initialisiert"
    CASE 14: error text := "TEXT nicht initialisiert"
    CASE 15: error text := "nicht implementiert"
    CASE 16: error text := "Block unlesbar"
    CASE 17: error text := "Codefehler"
  END SELECT 

ENDPROC select error message ;

TEXT PROC error message : 
 
  select error message ;
  error text
 
ENDPROC error message ;
 
INT PROC error code :

  pcb (error code field) 

ENDPROC error code ;

INT PROC error line :
 
  IF is error
    THEN pcb (error line field)
    ELSE 0
  FI
 
ENDPROC error line ;
 
PROC syntax error (TEXT CONST message) :

  INTERNAL 259 ;
  errorstop (syntax error code, message) .

ENDPROC syntax error ;

PROC errorstop (TEXT CONST message) :

  errorstop (0, message) ;

ENDPROC errorstop ;

PROC errorstop (INT CONST code, TEXT CONST message) :

  IF NOT is error
    THEN error text := message ;
         set error stop (code)
  FI

ENDPROC errorstop ;
 
PROC put error :
 
  IF is error
    THEN select error message ;
         IF error text <> ""
           THEN put error message
         FI
  FI .
 
put error message :
  out (error pre) ;
  out (error text) ;
  IF error line > 0
    THEN out (" bei Zeile "); out (text (error line)) ;
  FI ; 
  out (cr lf) .

ENDPROC put error ;
 
PROC stop :

  errorstop ("stop")

ENDPROC stop ;

ENDPACKET error handling ;