tlaser.tcl

一个用在mips体系结构中的操作系统

#
# Copyright (C) 1998 by the Board of Trustees
#    of Leland Stanford Junior University.
# Copyright (C) 1998 Digital Equipment Corporation
#
# This file is part of the SimOS distribution.
# See LICENSE file for terms of the license.
#



####
#### tlaser.tcl:
####
####

FileSourced osf/tlaser.tcl


###
### die on error
###

handler {
    puts  "TCL ERROR:\n  $errorInfo \n"
    exit
}


###
### "symbol" files (use nm to build them)
###

#source "sym-tlaser.tcl"
#source "console.tcl"
#source "syscalls.tcl"



###
### utility procedures
###

proc Physical {x} { 
    global PHYSICAL
    if [catch {set y $PHYSICAL($x)} err] {
	return $err 
    } else {
	return $y
    }
}

###
### little endian!!!
###
proc Double {x} {
    global MEMORY
    if [catch {
	set lo $MEMORY($x)
	set hi $MEMORY([expr $x + 4])
    } err] {
	return $err
    } else {
	return [hex [expr ($hi<<32)|$lo]]
    }
}

proc Mark { x } {
     global CPU CYCLES INSTS pc ra
     console "XXX CPU $CPU at CYCLES=$CYCLES INSTS=$INSTS  $x \n"
}

proc MarkLog { x } {
     global CYCLES pc ra
     log "XXX At $CYCLES  $x \n"
}

proc MarkAnn {x} { 
   #  global KER
    annotation set pc [symbol read vmunix::$x] "Mark $x"
}



###########################################################
###                 Annotations                         ###
###########################################################

###
### REQUIRED ANNOTATION. The annotation on $KER(badaddr) has
### a side-effect and is currently required to boot the system
###

annotation set pre-pc vmunix::badaddr {
    set node [expr ($a0 >>20)&0xfffff] 
    if {($node != 0xff8a0) && ($node!=0xc7000)}  { 
       Mark "badaddr ra=$ra $a0 $a1 $a2 node=[hex $node]  BAD"
       set v0 1
       set pc $ra
    } else {
       Mark  "badaddr ra=$ra $a0 $a1 $a2 node=[hex $node] GOOD"
    }      
}

annotation set pre-pc vmunix::panic { 
           Mark "PANIC [readString $a0]  \n"
           debug
}


########################################################################
#### B-cache sizing support (optional annotation)
#### Function must be called at boot time or it will never fire
#### Cache size argument is in megabytes
#### ####################################################################

proc SetCacheSize { size } {
    global log2NumColors 
    #### convert from megabytes into log2 of NumColors
    
    if {$size == 1} { 
        set log2NumColors 7
    } elseif { $size == 2} { 
        set log2NumColors 8
    } elseif { $size ==4} {
        set log2NumColors 9
    } else {
        console "tlaser.tcl:: cache size not supported \n"
        exit
    } 
    annotation set pre-pc vmunix::secondary_cache_size {
        console "\nSimOS annotation to determine the cache size to 2 ** $log2NumColors colors\n"
        symbol set vmunix::log2secondary_cache_pages $log2NumColors
        set v0 $log2NumColors
        console "Confirmation that it is 2 ** [symbol read vmunix::log2secondary_cache_pages] colors \n"
        set pc $ra
    }
}



        

####
#### /etc/sysconfigtab patch
#### still very brittle. Among others cause no standard for
####


set sysConfigPatches 0
proc SysConfigPatch { entry value } {
    global sysConfigValue sysConfigPatches 
    set sysConfigValue($entry) $value
    if {!$sysConfigPatches} {
        annotation set pc vmunix::subsys_bootstrap {
            console "\n\nvmunix::syssys_bootstrap. sysconfigtab=$a0 \n"
            ProcessSubstituteSysConfigTab $a0
        }
    }
    incr sysConfigPatches
}


    
proc ProcessSubstituteSysConfigTab { addr } {
    global sysConfigValue sysConfigPatches
    set db [readString $addr]
    #console "ORIG $db\n"

    foreach i [array names sysConfigValue] {
        if {[regsub $i $db $sysConfigValue($i) new] !=1} {
            console "Could not regsub $i \n"
            exit
        } 
        console "Subsittuted $i for $sysConfigValue($i) \n"
        set db $new
    } 
    if {0} { 
        set numPatches 0
        for {set i 0} {$i < [llength $db]} { incr i} {
            set entry [lindex $db $i]
            console "SysConfigTab:  |$entry| \n"
            if [info exists sysConfigValue($entry)] {
                console "SysConfigTab. tag replacing $entry with $sysConfigValue($entry)\n"
                set db [ lreplace $db  $i $i $sysConfigValue($entry) ]
                set db [join  $db]
                
                incr numPatches
            }
        }
        if {$numPatches != $sysConfigPatches} {
            console "\n ERROR only $numPatches patches out of $sysConfigPatches\n"
            exit
        }
    }
    writeString $addr $db
    
    ###
    ### just for sanity check
    ###
    #set db [readString $addr]
    #console "PATCHED $db\n\n\n"
    #for {set i 0} {$i < [llength $db]} { incr i} {
    #    set entry [lindex $db $i]
    #    console "SysConfigTab PATHC:  $entry \n"
    #}
   
}
                                               
    



###
### This annotation exits if we fail to mount the root device
###

annotation set pre-pc vmunix::strcasecmp  { 
    if {[readString   $a0] == "MSCP"} { 
	console "XXX ROOT DEVICE MOUNT FAILED. Bye!\n"
	exit 
    } 
}            


####
#### Useful debugging annotations (OSF/1)
####

annotation set pc  vmunix::prom_getenv  {
    Mark "prom_getenv [readString $a0]"
}


annotation set pc vmunix::system_type { 
    Mark "system type $a0 $a1 ra=$ra"
}


annotation set pre-pc vmunix::intrsetvec { 
    Mark "intrsetvec $a0 $a1 $a2"
}

annotation set pre-pc  vmunix::allocvec { 
           Mark "allocvec"
}

####
#### Useful debugging annotations (palcode)
####

if {$detailLevel >2} { 
    annotation set pc 0x70c5  {
        set syscall_dec [expr $v0 + 0]
        if [catch {set syscall $osf1_syscall($syscall_dec)} msg] {
            set syscall "SYSCALL($v0)"
        }
        MarkLog "SYSCALL $syscall\t a0=$a0 a1=$a1 a2=$a2 a3=$a3 pc=$pc"
    }


    annotation set pc 0x6F41 {
        MarkLog "RETURN FROM SYSCALL v0=$v0 pc=$pc\n"
    }

}