lib/ack/libm2/Traps.mod

   1 (*
   2   (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3   See the copyright notice in the ACK home directory, in the file "Copyright".
   4 *)
   5
   6 (*$R-*)
   7 IMPLEMENTATION MODULE Traps;
   8 (*
   9   Module:       Facility for handling traps
  10   Author:       Ceriel J.H. Jacobs
  11   Version:      $Header$
  12 *)
  13
  14   FROM  EM IMPORT       SIG, LINO, FILN, TRP;
  15   FROM  Unix IMPORT     write;
  16   FROM  SYSTEM IMPORT   ADDRESS, ADR;
  17   FROM  Arguments IMPORT
  18                         Argv;
  19
  20   PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler;
  21   (* Install a new trap handler, and return the previous one.
  22      Parameter of trap handler is the trap number.
  23   *)
  24   BEGIN
  25         RETURN SIG(t);
  26   END InstallTrapHandler;
  27
  28   PROCEDURE Message(str: ARRAY OF CHAR);
  29   (* Write message "str" on standard error, preceeded by filename and
  30      linenumber if possible
  31   *)
  32   VAR   p: POINTER TO CHAR;
  33         l: CARDINAL;
  34         lino: INTEGER;
  35         buf, buf2: ARRAY [0..255] OF CHAR;
  36         i, j: CARDINAL;
  37   BEGIN
  38         p := FILN();
  39         IF p # NIL THEN
  40                 i := 1;
  41                 buf[0] := '"';
  42                 WHILE p^ # 0C DO
  43                         buf[i] := p^;
  44                         INC(i);
  45                         p := ADDRESS(p) + 1;
  46                 END;
  47                 buf[i] := '"';
  48                 INC(i);
  49                 IF write(2, ADR(buf), i) < 0 THEN END;
  50         ELSE
  51                 l := Argv(0, buf);
  52                 IF write(2, ADR(buf), l-1) < 0 THEN END;
  53         END;
  54         lino := LINO();
  55         i := 0;
  56         IF lino # 0 THEN
  57                 i := 7;
  58                 buf[0] := ','; buf[1] := ' ';
  59                 buf[2] := 'l'; buf[3] := 'i'; buf[4] := 'n'; buf[5] := 'e';
  60                 buf[6] := ' ';
  61                 IF lino < 0 THEN
  62                         buf[7] := '-';
  63                         i := 8;
  64                         lino := - lino;
  65                 END;
  66                 j := 0;
  67                 REPEAT
  68                         buf2[j] := CHR(CARDINAL(lino) MOD 10 + ORD('0'));
  69                         lino := lino DIV 10;
  70                         INC(j);
  71                 UNTIL lino = 0;
  72                 WHILE j > 0 DO
  73                         DEC(j);
  74                         buf[i] := buf2[j];
  75                         INC(i);
  76                 END;
  77         END;
  78         buf[i] := ':';
  79         buf[i+1] := ' ';
  80         IF write(2, ADR(buf), i+2) < 0 THEN END;
  81         i := 0;
  82         WHILE (i <= HIGH(str)) AND (str[i] # 0C) DO
  83                 INC(i);
  84         END;
  85         IF write(2, ADR(str), i) < 0 THEN END;
  86         buf[0] := 12C;
  87         IF write(2, ADR(buf), 1) < 0 THEN END;
  88   END Message;
  89
  90   PROCEDURE Trap(n: INTEGER);
  91   (* cause trap number "n" to occur *)
  92   BEGIN
  93         TRP(n);
  94   END Trap;
  95
  96 END Traps.