/*****************************************************************************\
*                           Systems Research Group                            *
*******************************************************************************


                ######    ########  #######   ##    ##   ######  
                #######   ########  ########  ##    ##  ######## 
                ##    ##  ##        ##    ##  ##    ##  ##       
                ##    ##  ######    #######   ##    ##  ##  #### 
                ##    ##  ##        ##    ##  ##    ##  ##    ## 
                ##    ##  ##        ##    ##  ##    ##  ##    ## 
                #######   ########  ########  ########  ######## 
                ######    ########  #######    ######    ######  


*******************************************************************************
*   I. D. Wilson           Last Modified   -   IDW   -   14/02/85             *
\*****************************************************************************/



SECTION "DEBUG"



GET "LIBHDR"



MANIFEST
$(
    e.rst00     =  0
    e.rst08     =  1
    e.rst10     =  2
    e.rst18     =  3
    e.rst20     =  4
    e.rst28     =  5
    e.rst30     =  6
    e.rst38     =  7

    e.nmi       =  8

    rdump       =  #X2000 / bytesperword

    r.hl        =  rdump + 0
    r.de        =  rdump + 1
    r.bc        =  rdump + 2
    r.af        =  rdump + 3
    r.hl.       =  rdump + 4
    r.de.       =  rdump + 5
    r.bc.       =  rdump + 6
    r.af.       =  rdump + 7
    r.ix        =  rdump + 8
    r.iy        =  rdump + 9
    r.sp        =  rdump + 10
    r.pc        =  rdump + 11
$)



LET debug( exception )  BE
$(
//  Stand alone debugger.  We are entered here whenever some sort of exception
//  occurs.  On restart, we are call with the "RST00" exception, so that
//  we can re-initialise.

    IF  exception = e.rst00  THEN
    $(
        //  Initialisation.  Set up the stand alone I/O routines.

        rdch    :=  debug.rdch
        wrch    :=  debug.wrch
        unrdch  :=  debug.unrdch

        RETURN
    $)

    //  Otherwise, we have been called in anger, and so we should print out
    //  a message corresponding to the error.

    writef( "*N****** DEBUG [%N] at %X4  SP:%X4*N*N", exception, !r.pc, !r.sp )

    writef( "Main    HL:%X4  DE:%X4  BC:%X4  AF:%X4    IX:%X4*N", 
            !r.hl,  !r.de,  !r.bc,  !r.af,  !r.ix )

    writef( "Alt     HL:%X4  DE:%X4  BC:%X4  AF:%X4    IY:%X4*N",
            !r.hl., !r.de., !r.bc., !r.af., !r.iy )

    newline()

    $(  //  Enter main debugging loop.  Read commands, and act on them.

        LET ch  =  0

        writes( "** " )

        ch  :=  capitalch( rdch() )
        
        IF  ch = '?'  THEN  $(  writes( "Help*N" )      ;  help()      $)
        IF  ch = 'D'  THEN  $(  writes( "Dump*N" )      ;  dump()      $)
        IF  ch = 'U'  THEN  $(  writes( "Update*N" )    ;  update()    $)
        IF  ch = 'R'  THEN  $(  writes( "Register*N" )  ;  register()  $)
        IF  ch = 'L'  THEN  $(  writes( "Load*N" )      ;  load()      $)
        IF  ch = 'C'  THEN  $(  writes( "Continue*N" )  ;  RETURN      $)
        IF  ch = '*N' THEN  $(  newline()               ;  LOOP        $)

        writef( "%C*B", ch )
    $)
    REPEAT
$)



AND help()  BE
$(
//  Print out some rudimentary help.

    newline()

    writes( "D     Dump memory*N" )
    writes( "U     Update memory*N" )
    writes( "R     Update registers*N" )
    writes( "L     Load memory*N" )
    writes( "C     Continue*N" )

    newline()
$)



AND dump()  BE
$(
//  Dump memory starting at an address given.

    LET address  =  0

    UNLESS  readhex( "Address: ", @address )  DO  RETURN

    $(  //  Repeat loop to dump the memory.

        FOR  i = 1  TO  20  DO
        $(
            writef( "%X4:  ", address )

            FOR  j = address  TO  address+15  DO  writef( "%X2 ", 0 % j )

            writes( "  " )

            FOR  j = address  TO  address+15  DO  wrch( c( 0 % j ) )

            newline()
            
            address  :=  address + 16
        $)

        UNLESS  rdch() = '*S'  DO  RETURN
    $)
    REPEAT
$)



AND update()  BE
$(
//  Update memory with values typed in.

    LET address  =  0

    UNLESS  readhex( "Address: ", @address )  DO  RETURN

    $(  //  Loop to write the current contents of the locations.

        LET byte  =  0 % address
        
        writef( "%X4: %X2  ", address, byte )
        
        UNLESS  readhex( "", @byte )  DO  RETURN
        
        0 % address  :=  byte
        address      :=  address + 1
    $)
    REPEAT
$)



AND register()  BE
$(
//  Update a register to be a particular value.

    FOR  r = r.hl  TO  r.pc  DO
    $(
        writef( "%S %X4  ", regname( r ), !r )
        
        UNLESS  readhex( "", r )  DO  BREAK
    $)
$)



AND load()  BE
$(
//  Load memory with a series of hex values.

    LET address  =  0
    LET value    =  0

    UNLESS  readhex( "Address: ", @address )  DO  RETURN
    
    WHILE  readhex( "", @value )  DO
    $(
        //  Update the address with the value.
        
        0 % address  :=  value
        address      :=  address + 1
    $)

    writef( "Final address used: %X4*N", address )
$)

    

AND readhex( string, ptr )  =  VALOF
$(
    LET value  =  0
    LET ch     =  0

    writes( string )

    ch  :=  capitalch( rdch() )

    IF  ch = '*S'  THEN  
    $(
        //  Leave the value as it was, and return TRUE.
        
        newline()
        
        RESULTIS  TRUE
    $)
    
    IF  ch = '*N'  THEN
    $(
        //  Leave the value as it was, and return FALSE.
        
        newline()
        
        RESULTIS  FALSE
    $)

    UNTIL  ch = '*N'  |  ch = '*S'  DO
    $(
        TEST  '0' <= ch <= '9'  THEN  value  :=  (value << 4) + ch - '0'       ELSE
        TEST  'A' <= ch <= 'F'  THEN  value  :=  (value << 4) + ch - 'A' + 10

        ELSE
        $(
            writef( "%C??*N", ch )
            
            RESULTIS  FALSE
        $)
        
        wrch( ch )
        
        ch  :=  capitalch( rdch() )
    $)

    newline()

    !ptr  :=  value

    RESULTIS  TRUE
$)



AND c( char )  =
    ( "................................ !*"#$%&'()**+,-./0123456789:;<=>?*
      *@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]\^_`abcdefghijklmnopqrstuvwxyz{|}~."
    ) % ((char & #X7F) + 1)

  

AND debug.rdch()  =  VALOF
$(
    LET ch  =  sardch()

    IF  ch = '*C'  THEN  ch  :=  '*N'

    RESULTIS  ch
$)



AND debug.wrch( ch )  BE
$(
    IF  ch = '*N'  THEN  sawrch( '*C' )

    sawrch( ch )
$)



AND debug.unrdch()  =  FALSE



AND regname( r )  =  VALOF
$(
//  Return the string representation of the register "r".

    SWITCHON  r  INTO
    $(
        CASE r.hl   :  RESULTIS  "HL "     
        CASE r.de   :  RESULTIS  "DE "   
        CASE r.bc   :  RESULTIS  "BC "
        CASE r.af   :  RESULTIS  "AF "   
        CASE r.hl.  :  RESULTIS  "HL'"     
        CASE r.de.  :  RESULTIS  "DE'"  
        CASE r.bc.  :  RESULTIS  "BC'"   
        CASE r.af.  :  RESULTIS  "AF'"   
        CASE r.ix   :  RESULTIS  "IX "   
        CASE r.iy   :  RESULTIS  "IY "   
        CASE r.sp   :  RESULTIS  "SP "   
        CASE r.pc   :  RESULTIS  "PC "
        
        DEFAULT     :  RESULTIS  "???"
    $)
$)


