!Revision history:
! 001 15-Jun-88 PSR checked top bit of SWI error number to invoke signal
!                   on fatal errors (e.g., FPE errors
!                 - Passed R14 on to signal in case error is inside %PRIM

%from IMP %include Mcode, SysSpecs, Console

%externalroutinespec Call Signal %alias "3L___signal"

%routine Trap Errors

     {This horror uses a word in the code sequence to hold}
     {the address of the buffer so that the return address}
     {can be found}

     %ownstring(255) Buffer
     %integer A = Addr(Buffer)
     %label Hit, Err, E1                      {001} 
     *BL _ Hit

{*** All errors come here - very unsafe ***}

     *LDR  _ R4,  [Pc, #16]               {pick up address of BUFFER} {001}
     *LDR  _ R3,  [R4, #4]                {error number}              {001}
     *TSTS _ R3, #16_80000000             {check for top bit}         {001}
     *BNE  _ Err                          {fatal error}               {001}
     *LDR  _ R14, [R4, #0]                {address of inst. after SWI}{001}
     *ORRS _ Pc, R14, #16_1000 0000       {return setting the V bit}

     !?????????????????
     *SWI _ 0   {DUMMY}                  {a hole for the address of BUFFER}
     !?????????????????

Hit: *MOV _ R0, R14                      {trap routine}
     *LDR _ R1, A                        {address of 256-byte buffer?}
     *STR _ R1, [Pc, #-20]               {plug in dummy SWI above}
     *MOV _ R2, #0
     *MOV _ R3, #0
     *SWI _ Brasil Control
     %return

Err: *TEQSP_ Pc, #0         {back to user, is this true?}             {001}
     *AND  _ R3, R3, #255                                             {001}
     *MOV  _ R1, #1                                                   {001}
     *MOV  _ R2, #2         {overflow?}                               {001}
     *CMPS _ R3, #1                                                   {001}
     *BEQ  _ E1             {yes, ->}                                 {001}
     *MOV  _ R1, #14                                                  {001}
     *MOV  _ R2, #2                                                   {001}
     *CMPS _ R3, #2         {divide by zero?}                         {001}
     *BEQ  _ E1             {yes, ->}                                 {001}
     *MOV  _ R2, #23        {function errors?}                        {001}
     *CMPS _ R3, #0                                                   {001}
     *MOVNE_ R2, #24        {no}                                      {001}
                                                                      {001}
E1:  *LDR  _ R6, [R4, #0]   {error PC ish}                            {001}
     *MOV  _ R5, Fp         {error FP}                                {001}
     *MOV  _ R4, Sb         {error SB}                                {001}
     *STMDB _ Sp!, <R1, R2, R3, R4, R5, R6, R14>                      {001}
                   {E,  S,  X,  Sb, Fp, Ra  PrimRa}                   {001}
     Call Signal                                                      {001}
%end

%externalroutine Set Traps %alias "3L___set_traps"
   %recordformat Trapfm(%integer X1, X2, X3, X4, X5, X6)
   %ownrecord(Trapfm) T1, T2, T3, T4
   %integer A1, A2, A3, A4
   %label Set
   Trap Errors

    T1_X1 = 16_E3CF 1003    {BIC R1, Pc, #3}
    T2_X1 = 16_E3CF 1003    {BIC R1, Pc, #3}
    T3_X1 = 16_E3CF 1003    {BIC R1, Pc, #3}
    T4_X1 = 16_E3CF 1003    {BIC R1, Pc, #3}

    T1_X2 = 16_E3C1 133F    {BIC R1, R1, #16_FC00 0000}
    T2_X2 = 16_E3C1 133F    {BIC R1, R1, #16_FC00 0000}
    T3_X2 = 16_E3C1 133F    {BIC R1, R1, #16_FC00 0000}
    T4_X2 = 16_E3C1 133F    {BIC R1, R1, #16_FC00 0000}

    T1_X3 = 16_E891 8181    {LDMIA R1, <R0, R7, R8, Pc>}
    T2_X3 = 16_E891 8181    {LDMIA R1, <R0, R7, R8, Pc>}
    T3_X3 = 16_E891 8181    {LDMIA R1, <R0, R7, R8, Pc>}
    T4_X3 = 16_E891 8181    {LDMIA R1, <R0, R7, R8, Pc>}

    T1_X5 = 1
    T2_X5 = 2
    T3_X5 = 3
    T4_X5 = 4

    A1 = Addr(T1)
    A2 = Addr(T2)
    A3 = Addr(T3)
    A4 = Addr(T4)

    *BL  _ Set

          {traps come here directly}

          *MOV  _ R1, #14
          *MOV  _ R2, #19
          *BIC  _ Link, Link, #16_FC00 0000
          *ORR  _ R3, Link, R8, %LSL #28
          *TEQSP_ Pc, #0         {back to user, is this true?}
          *SUB  _ R6, R3, #4     {error PC ish}
          *MOV  _ R5, Fp         {error FP}
          *MOV  _ R4, Sb         {error SB}
          *MOV  _ SB, R7         {restore this SB}
          *STMDB _ Sp!, <R1, R2, R3, R4, R5, R6>
                        {            Sb, Fp, Ra}
          Call Signal

Set:*LDR _ R4, A1
    *LDR _ R5, A2
    *LDR _ R6, A3
    *LDR _ R7, A4
    *STR _ R14, [R4, #20]
    *STR _ R14, [R5, #20]
    *STR _ R14, [R6, #20]
    *STR _ R14, [R7, #20]
    *STR _ R10, [R4, #12]
    *STR _ R10, [R5, #12]
    *STR _ R10, [R6, #12]
    *STR _ R10, [R7, #12]
    *MOV _ R0, #0
    *MOV _ R1, #0
    *MOV _ R2, #0
    *MOV _ R3, #255
    *SWI _ Brasil SetEnv
 %end