[INHERIT('SYS$LIBRARY:STARLET')]
PROGRAM Handler(OUTPUT);

{ Example to decode OpenVMS Alpha signal and mechanism vectors }

TYPE
    Signal_Array    = CHF1$TYPE;
    Signal_Array_Ptr= ^CHF1$TYPE;
    Mechanism_Array = CHF2$TYPE;

var i : [volatile] integer;

[asynchronous]
FUNCTION Handler(
    VAR SigArgs : Signal_Array;
    VAR MechArgs : Mechanism_Array):INTEGER;

      TYPE Actual_Args = ARRAY [1..100] OF INTEGER;
	   Actual_Args_Ptr = ^Actual_Args;

      VAR F : text;
	  i : integer;
	  SigArgsPtr : Signal_Array_Ptr;
	  ActualArgsPtr : Actual_Args_Ptr;

      BEGIN
      open(F,'sys$output',history:=new);
      rewrite(F);

      { Decode signal argument vector }

      i := iaddress(SigArgs);
      writeln(F,'Address of SigArgs = ',hex(i));
      writeln(F,'SigArgs.CHF$IS_SIG_ARGS = ',SigArgs.CHF$IS_SIG_ARGS:1);
      writeln(F,'SigArgs.CHF$IS_SIG_NAME = ',hex(SigArgs.CHF$IS_SIG_NAME));
      ActualArgsPtr := (iaddress(SigArgs.CHF$IS_SIG_ARG1))::Actual_Args_Ptr;
      FOR i := 1 to SigArgs.CHF$IS_SIG_ARGS - 1 DO
         writeln(F,'SigArgs.CHF$IS_SIG_ARG',i:1,' = ',hex(ActualArgsPtr^[i]));

      { Decode mechanism vector }

      writeln(F);
      i := iaddress(MechArgs);
      writeln(F,'Address of MechArgs = ',hex(i));
      writeln(F,'MechArgs.CHF$IS_MCH_ARGS     = ', MechArgs.CHF$IS_MCH_ARGS:1);
      writeln(F,'MechArgs.CHF$IS_MCH_FLAGS    = ', hex(MechArgs.CHF$IS_MCH_FLAGS));
      writeln(F,'   MechArgs.CHF$V_FPREGS_VALID = ', MechArgs.CHF$V_FPREGS_VALID );
      writeln(F,'MechArgs.CHF$PH_MCH_FRAME    = ', hex(MechArgs.CHF$PH_MCH_FRAME.L0));
      writeln(F,'MechArgs.CHF$IS_MCH_DEPTH    = ', MechArgs.CHF$IS_MCH_DEPTH:1);
      writeln(F,'MechArgs.CHF$PH_MCH_DADDR    = ', hex(MechArgs.CHF$PH_MCH_DADDR.L0));
      writeln(F,'MechArgs.CHF$PH_MCH_ESF_ADDR = ', hex(MechArgs.CHF$PH_MCH_ESF_ADDR.L0));
      writeln(F,'MechArgs.CHF$PH_MCH_SIG_ADDR = ', hex(MechArgs.CHF$PH_MCH_SIG_ADDR.L0));

      { Decode signal argument vector again, this time via }
      { the pointer inside the mechanism vector.           }

      writeln(F);
      SigArgsPtr := MechArgs.CHF$PH_MCH_SIG_ADDR.L0::Signal_Array_Ptr;
      writeln(F,'SigArgsPtr^.CHF$IS_SIG_ARGS = ', SigArgsPtr^.CHF$IS_SIG_ARGS:1);
      writeln(F,'SigArgsPtr^.CHF$IS_SIG_NAME = ', hex(SigArgsPtr^.CHF$IS_SIG_NAME));
      ActualArgsPtr := (iaddress(SigArgsPtr^.CHF$IS_SIG_ARG1))::Actual_Args_Ptr;
      FOR i := 1 to SigArgsPtr^.CHF$IS_SIG_ARGS - 1 DO
         writeln(F,'SigArgsPtr^.CHF$IS_SIG_ARG',i:1,' = ',hex(ActualArgsPtr^[i]));

      close(F);

      IF SigArgs.CHF$IS_SIG_NAME <> SS$_UNWIND
      THEN
	Handler := SS$_CONTINUE
      ELSE
        Handler := SS$_RESIGNAL;

      END;

BEGIN
{ Establish handler and divide by zero }
ESTABLISH(Handler);
i := i div 0;
END.