!Revision history:
! 24-FEB-88 PSR  Modified to follow change to ARM calling stack frame
!             -  Changed signal report to print extra in hex
! 28-JAN-88 PSR  Replaced call on EXIT(1) with an explicit SWI _ Brasil Exit
!                as signal failure result from general corruption. This can
!                leave files open.
!
%from IMP %include Console, Mcode, SysSpecs

%externalrecord(Eventfm) EVENT %alias "3L_EVENT" = 0
%externalroutinespec Show Event %alias "3L_IMP_SHOW_EVENT" -
                                  (%record(Eventfm)%name E, %integer Language)
%externalinteger Diag Ep %alias "3L___diagnose_ep" = 0

%constinteger PSb=R9, PFp=R10

%externalroutine Signal %alias "3L___signal"
   {                -20       -16  -12  -8   -4   0        }
   {Stack frame is: [display] [SB] [FP] [SP] [RA] [PC]     }
   {                                              ^        }
   {                                              |        }
   {                                              Fp       }
   ! The following parameters are assumed to be stacked:
     {%integer Ev, Sub, Ext, Sig Sb, Sig Fp, Sig Ra, PrimRa?}
     {         4   8    12   16      20      24      28     }

   %owninteger Marker = 16_F82F0000

   %label Top, F1, Magic, De
   %constinteger Ib = 0,     {code block pionter}
                 Cb = 1,     {code base}
                 Em = 2,     {event mask = 1<<Event}
                 W1 = 3,     {work register}
                 W2 = 4,     {work register}
                 W3 = 5,     {work register}
                 Sb = 6,     {internal static base}
                 Fp = 7,     {internal frame pointer}
                 Ra = 8,     {signal address}
                 F  = 14     {block flags}

   %integer X, PrimRa, MdiagRa
   %string(127) File

   %on * %start
      Console("signal failure: event ". -
              itos(Event_Event, 0).itos(Event_Sub, 1)." ".xtos(Event_Extra, 8))
      *SWI   _ Brasil Exit     {Give up immediately}
   %finish

   {%integer Ev, Sub, Ext, Sig Sb, Sig Fp, Sig Ra, PrimRa}
   { Fp+     4   8    12   16      20      24      28    }

   *STR _ R10, X       {Fp}

   Event_Event = Integer(X+ 4) {Ev}
   Event_Sub   = Integer(X+ 8) {Sub}
   Event_Extra = Integer(X+12) {Ext}
   Event_Sb    = Integer(X+16) {Sig Sb}
   Event_Fp    = Integer(X+20) {Sig Fp}
   Event_Ra    = Integer(X+24) {Sig Ra}
   MdiagRa     = Event_Ra
   PrimRa      = Integer(X+28) {Prim Ra - may be rubbish}

!   Console("Event ".ItoS(Event_Event, 0) -
!                   .ItoS(Event_Sub,1)." ".XtoS(Event_Extra,8))
!   Console("Pc: ".XtoS(Event_Ra, 8))
!   Console("Fp: ".XtoS(Event_Fp, 8))
!   Console("Sb: ".XtoS(Event_Sb, 8))

      *LDR    _ Em, [R10, #4]      {Ev}            {event}
      *MOV    _ W1, #1
      *MOV    _ Em, W1, %LSL Em    {Em = 1<<Ev}
      *LDR    _ Sb, [R10, #16]     {Sig Sb}
      *LDR    _ Fp, [R10, #20]     {Sig Fp}
      *LDR    _ Ra, [R10, #24]     {Sig Ra}        {signal Address}

      {Search back through the code for the magic marker at}
      {the head of the block list for that module}

Top:  *BIC    _ W1, Ra, #16_FC00 0000 {Failure Address (without top bits)}
      *MOV    _ Ra, W1                {remember without top bits}
      *LDR    _ W2, Marker            {magic marker}
Magic:*LDR    _ W3, [W1, #-4]!        {previous instruction}
      *CMPS   _ W2, W3
      *BNE    _ Magic                 {keep going until marker found}
      *ADD    _ Cb, W1, #4            {onto first block}

F1:   *LDRB   _ W1, [Cb, #0]          {low byte of link}
      *LDRB   _ W2, [Cb, #1]          {high byte of link}
      *ORRS   _ W1, W1, W2, %LSL #8   {complete link (zero=end)}
      *ADDNE  _ Cb, Cb, W1, %LSL #2   {onto next block}
      *CMPNES _ Cb, Ra                {compare with return address}
      *BLT    _ F1                    {not far enough, try again}
      *SUB    _ Cb, Cb, W1, %LSL #2   {back to actual block}

      {the block has been located, check for events}

      *LDR    _ F, [Cb]               {Link ! Flags<<16 ! Display<<24}
      *TSTS   _ F, #16_1 0000         {events trapped bit}

      {an event block has been found, does it catch the event?}

      *LDMNEIB_ Cb, <W1, W2, W3>      {pick up event mask & limit & entry point}
                                      {        W1           W2      W3}
      *TSTNES _ W1, Em                {test all masked bits}

      {correct event, are we within the event block?}

      *ADDNE  _ W2, W2, Cb            {limit, relative -> absolute limit}
      *CMPNES _ Ra, W2

      {reenter the program if GT}

      *MOVGT  _ Psb, Sb               {reset user's static base}
      *MOVGT  _ Pfp, Fp               {reset user's frame pointer}
      *ADDGT  _ Pc, W3, Cb            { -> (W2+Cb) }

      {no event trapped, back off}
      {                -20       -16  -12  -8   -4   0        }
      {Stack frame is: [display] [SB] [FP] [SP] [RA] [PC]     }
      {                                              ^        }
      {                                              |        }
      {                                              Fp       }

      *TSTS   _ F, #16_10 0000        {in prim?}
      *LDRNE  _ Ra, PrimRa            {restore old R14}
      *STRNE  _ Ra, MdiagRa           {Remember in case of diags}
      *BNE    _ Top                   {and try again}

      *TSTS   _ F, #16_4 0000         {display updated?}
      *LDRNE  _ W2, [Fp, #-20]        {saved display value}
      *MOVNE  _ W1, F, %ASR #24       {get signed displacement (in words)}
      *STRNE  _ W2, [Sb, W1, %LSL #2]

      *TSTS   _ F, #16_20 0000        {main program?}
      *LDREQ  _ Sb, [Fp, #-16]        {previous static base}
      *LDREQ  _ Ra, [Fp, #-4]         {previous return address}
      *LDREQ  _ Fp, [Fp, #-12]        {previous stack frame}
      *BEQ    _ Top                   {round again}

      {at the main program - give up}

      Event_Ra = MdiagRa
      Exit(0) %if Event_Event = 0 = Event_Sub
      Select Output(0)
      Printstring("Execution error -- ")
      Show Event(Event, 0)
      Newline
      *LDR  _ 0, Diag Ep
      *BLNE _ DE
      Exit(1)
   DE:*MOV _ Pc, 0
%end