        SUBT    Debugging routines and macros => &.Hdr.Debug

OldOpt  SETA    {OPT}
        OPT     OptNoList+OptNoP1List

; ***********************************
; ***    C h a n g e   L i s t    ***
; ***********************************

; Date       Name  Description
; ----       ----  -----------
; 23-Nov-87  SKS   Added $routine to DREG
; 11-Feb-88  SKS   Added integer printing code
; 19-Feb-88  SKS   Make $nonewline consistent
; 11-Mar-88  SKS   Added DSTRING macro, tweaked others
; 18-Mar-88  SKS   Fixed Tutu_PrintString
; 27-Apr-88  SKS   Fixed DLINE wrt. inversing, DSTRING wrt. r14_svc
; 27-Apr-88  SKS   Fixed DSTRING wrt. r14_svc properly (wrong offset before !)
; 05-May-88  SKS   Fixed DSTRING to give address in invalids
; 10-May-88  SKS   Added Host_Debug so you can switch to Host debug much easier
; 22-Jun-88  SKS   Error trapping for $cc field
; 20-Jul-88  SKS   Fixed DLINE with no arg

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Use of hdr.Debug: r13 MUST be a FD stack pointer. Do not use otherwise

;       GET     &.Hdr.Debug

; ... defs, etc ...

;       InsertDebugRoutines             ; ensure this is after module header !
;                                       ; conventional to have this just before
;       END

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Output a register with optional string, preserving all state in all modes

; eg. DREG r0,"register zero is "
;     DREG r1,"r1 is ",cc
;     DREG r2,,,Integer
;     DREG r0,,cc
;     DREG r0,,,Word
;     DREG r1,"Thing is ",,Byte

        MACRO
$label  DREG    $reg, $string, $cc, $routine
$label  Push    "r0, lr"
        Push    pc
 [ Host_Debug
        SWI     XHostFS_HostVdu
 ]
 [ $reg = r13
        ADD     r0, r13, #12    ; Correct for having stacked info on FD r13
 |
  [ :LNOT: ($reg = r0)
   [ ($reg = lr) :LAND: Host_Debug
        LDR     r0, [sp, #8]
   |
        MOV     r0, $reg
   ]
  ]
 ]
 [ "$string" = ""
        SWI     XOS_WriteI+" "
 |
        SWI     XOS_WriteS
        DCB     "$string", 0
        ALIGN
 ]
 [ "$cc" = ""
  [ "$routine" <> ""
        BL      Tutu_$routine
        SWI     XOS_NewLine
  |
        BL      Tutu_LongLine
  ]
 |
  [ "$cc" <> "cc"
  ! 1,"Error in DREG with 'cc': '$cc' used instead"
  MEXIT
  ]
  [ "$routine" <> ""
        BL      Tutu_$routine
  |
        BL      Tutu_LongWord
  ]
 ]
 [ Host_Debug
        SWI     XHostFS_TubeVdu
 ]
        Pull    lr
        TEQP    lr, #0
        Pull    "r0, lr"
        MEND


        MACRO
$label  BREG    $reg, $string, $cc
$label  Push    "r0, lr"
        Push    pc
 [ Host_Debug
        SWI     XHostFS_HostVdu
 ]
 [ $reg = r13
        ADD     r0, r13, #12    ; Correct for having stacked info on FD r13
 |
  [ :LNOT: ($reg = r0)
   [ ($reg = lr) :LAND: Host_Debug
        LDR     r0, [sp, #8]
   |
        MOV     r0, $reg
   ]
  ]
 ]
 [ "$string" = ""
        SWI     XOS_WriteI+" "
 |
        SWI     XOS_WriteS
        DCB     "$string", 0
        ALIGN
 ]
 [ "$cc" = ""
        BL      Tutu_ByteLine
 |
  [ "$cc" <> "cc"
  ! 1,"Error in BREG with 'cc': '$cc' used instead"
  MEXIT
  ]
        BL      Tutu_Byte
 ]
 [ Host_Debug
        SWI     XHostFS_TubeVdu
 ]
        Pull    lr
        TEQP    lr, #0
        Pull    "r0, lr"
        MEND

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Output a string, preserving all state in all modes

        MACRO
$label  DLINE   $string, $cc, $inverse
$label  Push    "r0, lr"
        Push    pc
 [ Host_Debug
        SWI     XHostFS_HostVdu
 ]
 [ "$string" <> ""
  [ "$inverse" <> ""
        BL      Tutu_DoInverse
  ]
        SWI     XOS_WriteS
        DCB     "$string"
  [ "$cc" = ""
   [ "$inverse" = ""
        DCB     10, 13
   ]
  |
   [ "$cc" <> "cc"
   ! 1,"Error in DLINE with 'cc': '$cc' used instead"
   MEXIT
   ]
  ]
        DCB     0
        ALIGN
 |
  [ "$cc" = ""
        SWI     XOS_NewLine
  ]
 ]
 [ "$inverse" <> ""
        BL      Tutu_DoInverse
  [ "$cc" = ""
        SWI     XOS_NewLine
  |
   [ "$cc" <> "cc"
   ! 1,"Error in DLINE with 'cc': '$cc' used instead"
   MEXIT
   ]
  ]
 ]
 [ Host_Debug
        SWI     XHostFS_TubeVdu
 ]
        Pull    lr
        TEQP    lr, #0
        Pull    "r0, lr"
        MEND


        MACRO
$label  DSTRING $reg, $string, $cc
$label  Push    "r0, lr"
        Push    pc
 [ Host_Debug
        SWI     XHostFS_HostVdu
 ]
 [ "$string" = ""
        SWI     XOS_WriteI+"'"
 |
        SWI     XOS_WriteS
        DCB     "$string", "'", 0
        ALIGN
 ]
 [ $reg <> r0
  [ $reg = lr
        LDR     r0, [sp, #8]
  |
        MOV     r0, $reg
  ]
 ]
        BL      Tutu_PrintString
        SWI     XOS_WriteI+"'"
 [ "$cc" = ""
        SWI     XOS_NewLine
 |
  [ "$cc" <> "cc"
  ! 1,"Error in DSTRING with 'cc': '$cc' used instead"
  MEXIT
  ]
 ]
 [ Host_Debug
        SWI     XHostFS_TubeVdu
 ]
        Pull    lr
        TEQP    lr, #0
        Pull    "r0, lr"
        MEND



        MACRO
        InsertDebugRoutines
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Tutu's infamous debugging routines

Tutu_LongLine
        Push    "r0, lr"      ; Get round LDM ^ bug in 3um ARM, XOS errors
        BL      Tutu_LongWord
        SWI     XOS_NewLine
        Pull    "r0, pc",,^

Tutu_ByteLine
        Push    "r0, lr"      ; Get round LDM ^ bug in 3um ARM, XOS errors
        BL      Tutu_Byte
        SWI     XOS_NewLine
        Pull    "r0, pc",,^

Tutu_LongWord
        Push    "r0, lr"
        MOV     r0, r0, ROR #16
        BL      Tutu_Word
        MOV     r0, r0, ROR #32-16
        BL      Tutu_Word
        Pull    "r0, pc",,^

Tutu_Word
        Push    "r0, lr"
        MOV     r0, r0, ROR #8
        BL      Tutu_Byte
        MOV     r0, r0, ROR #32-8
        BL      Tutu_Byte
        Pull    "r0, pc",,^

Tutu_Byte
        Push    "r0, lr"
        MOV     r0, r0, ROR #4
        BL      Tutu_Nibble
        MOV     r0, r0, ROR #32-4
        BL      Tutu_Nibble
        Pull    "r0, pc",,^

Tutu_Nibble
        Push    "r0, lr"
        AND     r0, r0, #15
        CMP     r0, #10
        ADDCC   r0, r0, #"0"
        ADDCS   r0, r0, #"A"-10
        SWI     XOS_WriteC              ; Errors set by this are ignored
        Pull    "r0, pc",,^

Tutu_Integer
        Push    "r0-r2, lr"
        SUB     r13, r13, #16
        MOV     r1, r13
        MOV     r2, #16
        SWI     XOS_ConvertInteger4
        SWIVC   XOS_Write0              ; Errors set by this are ignored
        ADD     r13, r13, #16
        Pull    "r0-r2, pc",,^


Tutu_DoInverse
        Push    "r0, r1, lr"
        ADR     r0, Tutu_InverseString
        MOV     r1, #?Tutu_InverseString
        SWI     XOS_WriteN              ; Errors set by this are ignored
        Pull    "r0, r1, pc",,^

Tutu_InverseString      DCB     23,17,5,0,0,0,0,0,0,0
Tutu_BadString          DCB     "--- Invalid Address ---", 0
Tutu_NullString         DCB     "<Null>", 0
                        ALIGN


Tutu_PrintString
        Push    "r0, r1, lr"
        MOV     r1, r0

        TST     r1, #&FC000000          ; Trying to cause address exception ?
        ADRNE   r1, Tutu_BadString
        BNE     %FT20

        CMP     r1, #&02000000          ; Or abort, or stiffo ?
        RSBCSS  r14, r1, #&03800000
        ADRCS   r1, Tutu_BadString
        BCS     %FT20

        CMP     r1, #0
        ADREQ   r1, Tutu_NullString

10      LDRB    r0, [r1], #1
        CMP     r0, #32
        Pull    "r0, r1, pc",CC,^
        SWI     XOS_WriteC              ; Errors set by this are ignored
        BVC     %BT10
        Pull    "r0, r1, pc",,^

20      LDRB    r0, [r1], #1
        CMP     r0, #32
        BCC     %FT30
        SWI     XOS_WriteC              ; Errors set by this are ignored
        BVC     %BT20
        Pull    "r0, r1, pc",,^

30      SWI     XOS_WriteI+" "
        SWIVC   XOS_WriteI+"("
        LDRVC   r0, [sp]
        BLVC    Tutu_LongWord
        SWIVC   XOS_WriteI+")"
        Pull    "r0, r1, pc",,^

; End of the debug routines
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        MEND

        GBLL    Host_Debug
Host_Debug SETL False

        OPT     OldOpt
        END
