;=============================================================================

; Failure Handler Assembly Routines

;

; KNOWN LIMITATIONS

;

; Copyright © 1984-1990 Apple Computer, Inc.  All rights reserved.

;

; when     who  what

; -------- ---- --------------------------------------------------------------

; 88.07.28 srf  add header and includes for Macros

; ----------------------------------------------------------------------------

                Blanks      On

                String      AsIs

                Case        On

                Print       Off

                LOAD        'ProgStrucMacs.d'

                LOAD        'FlowCtlMacs.d'

                Print       On

;---------------------------------------------------------------------------------------------------

    Macro

    Head

        Link    A6,#0       ; These two instructions form a slow no-op

        Move.L  (SP)+,A6

    EndM

    Macro

    Procnam &theName

    String Asis

    LCLC        &DbgTemp

    LCLC        &DbgName                            ; name to generate for MacsBug

    &DbgTemp: SETC  &theName                        ; Generate new type symbols

    IF &Len(&theName) < 32 THEN                     ; If module name < 32 chars

        IF &Len(&theName) // 2 = 0 THEN             ; Add space if even so that...

            &DbgTemp: SETC &Concat(&theName,' ')    ; string length plus length byte...

        ENDIF                                       ; will align to word boundary

    &DbgName: SETC &Concat(&Chr($80 + &Len(&theName)), &DbgTemp)

    ELSE                                            ; Length is greater than 32 characters

        IF &Len(&theName) // 2 = 1 THEN             ; Add space if length is odd

            &DbgTemp: SETC &Concat(&theName,' ')

        ENDIF

    &DbgName: SETC &Concat(&Chr($80), &Chr(&Len(&theName)), &DbgTemp)

    ENDIF

    DC.B        '&DbgName'

    EndM

    Macro

    Tail &theName

        Unlk    A6

        Rts

        PROCNAM &theName

    EndM

;---------------------------------------------------------------------------------------------------

UFailureGlobals Record

                Export      gAskAboutAlloc, gAskFailure

gAskAboutAlloc  DC.W        0                   ; Boolean: ask about each allocation

gAskFailure     DC.W        0                   ; Boolean: ask about failures

                EndR

nSavedRegs      Equ         11

                Seg         'MAFailureRes'

;-------------------------------------------------------------------

;PROCEDURE CatchFailures(VAR fi: FailInfo; PROCEDURE Handler(e: INTEGER; m: LONGINT)); EXTERNAL;

;-------------------------------------------------------------------

CATCHFAILURES   Proc        Export

                DATA

                Export      gTopHandler:Data

gTopHandler     DC.L        0           ;Pointer to the top level (most recent) handler

                CODE

A6Link          Equ         4                       ; static link which the Pascal compiler

                                                    ; automatically pushes on the stack after

                                                    ; pushing a ProcPtr ("PROCEDURE Handler")

handler         Equ         A6Link + 4              ; the ProcPtr ("PROCEDURE Handler")

fiVAR           Equ         handler + 4

parmSize        Equ         fiVAR + 4 - A6Link

                Head

                Move.L      fiVAR(SP),A0            ; get pointer to FailInfo block

                MoveM.L     A2-A7/D3-D7,(A0)        ; save All regs first

                Add         #nSavedRegs*4,A0        ; advance pointer by # bytes regs

                Clr.W       (A0)+                   ; clear error field

                Clr.L       (A0)+                   ; clear message field

                Lea         A6Link(SP),A1           ; save the A6Link And Proc ptr

                Move.L      (A1)+,(A0)+             ; save the A6Link

                Move.L      (A1)+,(A0)+             ; save the Proc ptr

                Move.L      gTopHandler(A5),(A0)+   ; Link the FailInfo into the LIST

                Move.L      fiVAR(SP),gTopHandler(A5)

exit

                Move.L      (SP)+,A0

                Add.L       #parmSize,SP

                Jmp         (A0)

                Tail        CATCHFAILURES

                Seg         'MAFailureRes'

;-------------------------------------------------------------------

;PROCEDURE DoFailure(pf: PFailInfo); EXTERNAL;

;-------------------------------------------------------------------

DOFAILURE       Proc        Export

                Import      FAILURE

pf              Equ         4

                Head

                Move.L      pf(SP),A0               ; get pointer to FailInfo

                MoveM.L     (A0),A2-A7/D3-D7        ; restore regs (can't use A7 anymore)

                Add         #nSavedRegs*4,A0        ; advance pointer

                Move.W      (A0)+,D0                ; get error

                Move.L      (A0)+,D1                ; And message

                MoveM.L     D0/D1,-(SP)             ; save for later use

                Move.W      D0,-(SP)

                Move.L      D1,-(SP)                ; parameters to failure handler

                Move.L      (A0)+,D0                ; check the A6Link

                Beq.S       @1                      ; If NIL Then don't pass it

                Move.L      D0,-(SP)                ; Else Do pass it

@1

                Move.L      (A0)+,A0                ; get address of failure handler

                Jsr         (A0)                    ; call failure handler

                MoveM.L     (SP)+,D0/D1             ; get error & message back

                Move.W      D0,-(SP)

                Move.L      D1,-(SP)                ; parameters to Failure

                Jsr         FAILURE

                ; should Not return

                Tail    DOFAILURE

                End