Tcl 8.4 can kill Windows XP

From: Roy Terry (royterry_at_earthlink.net)
Date: 03/09/05 

Date: Wed, 09 Mar 2005 22:02:57 GMT

Hi folks,
I've been working this issue for several
days have a "reliable" windows XP
grinding-to-a-halt sample program.

This program simply tests intensive file creation
with some directories created too.
Any help appreciated very much as
this system is heading toward production
soon and needs to run 24x7. It would be
nice if it could run on both Windows and *nix
:^)

Roy

-------------

The following script will "freeze"
Windows XP on the several different
boxes I have available for testing.

--- TEST BOX: ----
1GB RAM
250GB hard disk (130GB+ free)
Windows XP Pro sp2
  Build 2600.xpsp_sp2_rtm040803-2158
Config:
    (Don't know if any of this matters at all)
    - 8dot3 generation was turned off on the disk
    - indexing service was turned off on the disk
     - the entire disk was made shared and writable
        from the network. (but no access is made during test)

ActiveTcl from www.ActiveState.com
version 8.4
(binary download and point-click install)

--- PROGRAM ---
The program starts 150 wakeups per
second (adjustable). On each wakeup it
creates and writes 1 file of 500 bytes and
1 file of 5000 bytes. For a total rate of 300
files per second.

The code also creates some directories to spread
out the files.

To run the code (assuming ActiveTcl is alread installed)

- Put killsXP.tcl in a new directory.
- Edit killsXP.tcl near line 7 so that
"datdir" is followed by a directory where the test data
files can be created. E.g:
       datdir /tmp/killsxp

- Run the test by starting a wish.exe program in the directory
where you put killsXP.tcl
- In the wish "Console" window type
> source killsXP.tcl
> iFake

Monitor the process with Task manager or
procexp.exe (www.sysinternals.com).
You should notice *stable* range of memory
and handle usage.

BEWARE - the system will probably slow down and
become resource depleted in about 40 minutes. After
this point you will not be able to start or use most
programs. Although the wish console may still
work (barely). You may not be able to shut the
machine down gracefully and this will mean that
chkdisk must run on reboot and chkdsk
could be lengthy.

ONLY run this on a test system.

The same Tcl code as been tested on RH Linux and runs error
free indefinitely using ActiveState Tcl binaries 8.4.9 for Linux

What's the issue? Can anyone solve this?

Tcl code is attached.

Thanks,
Roy Terry
Tcl developer since 1997
Unix since 1982

************************************** WHOLE PROGRAM FOLLOWS: killsXP.tcl,
141 lines *******************************

# 07Mar05RT - troubleshooting - just does dumb file i/o

if {![info exists is]} {
    array set is {
        FSIZE 5000
        TSIZE 500
        datdir /tmp/killsXP
        ccnt 150
    }
    set Fbytes [string repeat f $is(FSIZE)]
    set Tbytes [string repeat t $is(TSIZE)]
    set ecount 0
}
proc iFake {} {
    global is

    set log killsXP.log
    set is(logch) [open $log a]
    fconfigure $is(logch) -buffering line

    # setup timers to write some fake data
    for {set cnum 1} {$cnum <= $is(ccnt)} {incr cnum} {
        ifStart $cnum
    }
    isLog =====fake=== STARTUP ==fake========
    isLog ccnt=$is(ccnt) pid=[pid] dir=[pwd] datdir=$is(datdir)

    global tcl_interactive tk_version
    if {$tcl_interactive != 0} {
        if { ! [info exists tk_version]} {
            puts "Event processing START... (see $log)"
            flush stdout
            vwait forever
        } else {
            puts "Started.. (see $log)"
        }
    }
}
proc ifStop {} {
    # This only works from tkcon/wish
    isLog Stopped manually by ifStop
    foreach a [after info] {
        after cancel $a
    }
    puts stopped
}
proc ifStart {cnum} {
    global is
    set t [clock seconds]
    global errorCode ecount
    global Fbytes Tbytes

    # larger file
    if {[catch {
        set f [avFileName $is(datdir) $cnum $t f 1]
        set ch [open $f w]
        fconfigure $ch -translation binary
        puts -nonewline $ch $Fbytes
        close $ch
    } res ]} {
        isLog Error in create/write/close large errorCode=$errorCode
res=$res
        # set flop [open a:err.out a]
        # puts $flop "Full: EC=$errorCode res=$res"
        # close $flop
        incr ecount
    }

    # smaller file
    if {[catch {
        set f [avFileName $is(datdir) $cnum $t t 1]
        set ch [open $f w]
        fconfigure $ch -translation binary
        puts -nonewline $ch $Tbytes
        close $ch
    } res ]} {
        isLog Error in create/write/close small errorCode=$errorCode
res=$res
        # set flop [open a:err.out a]
        # puts $flop "Thumb: EC=$errorCode res=$res"
        # close $flop
        incr ecount
    }

    # Do it again after 1 sec (will be $is(ccnt) instances of this timer)
    if {$ecount < $is(ccnt)} {
        after 1000 [list ifStart $cnum]
    }

}
proc avFileName {root cnum t size {createdir 0} } {
    # SPREAD FILES OUT OVER DIRECTORIES
    set fmt dat
    global avFileLASTDIR

    set fbase [clock format $t -format %M.%S$size]
    set hrdir [clock format $t -format %H]
    set datedir [clock format $t -format %y%m%d]

    set dir $root/c$cnum/$datedir/$hrdir/$size

    if {$createdir} {
        set k $cnum,$size
        # Check info cache to decide if dir alread exists
        if { ! [info exists avFileLASTDIR($k)]
            || $dir ne $avFileLASTDIR($k)} {
            file mkdir $dir
            set avFileLASTDIR($k) $dir
        }
    }
    return $dir/$fbase.$fmt
}
proc isLogOpen {{fname ""}} {
    global is
    if {[info exists is(logch)]} return

    if {$fname eq ""} {
        set fname $is(logfile)
    }
    set is(logch) [open $fname a]
    fconfigure $is(logch) -buffering line
}
proc isLog args {
    global is
    # 27Dec04RT - use %s on ms to keep leading zeros
    set fmt %y%m%d-%T
    set dt [clock format [clock seconds] -format $fmt]
    set as [string trim [join $args]]
    puts $is(logch) "$dt $as"
}

# Can run in tclsh
if {[lindex [info command tkcon] 0] ne "tkcon" &&
    ! [info exists tk_version]} {

    if {$tcl_interactive == 0} {
        puts AUTOSTART
        iFake
        vwait forever
    }
}

Relevant Pages

  • Re: The Ulimate Editor
    ... order is reversed from the OS spec., the code can never be reliably exchanged between Windows Forth systems ... ... PROCs are not tied to libraries; every declared library is searched for the proc. ... Basically, I'll agree to anything that allows me to treat the name of a function as a normal Forth word, without too much declaration fluff; preferably just the name of the library it lives in, as I can do right now in Win32Forth. ...
    (comp.lang.forth)
  • Re: UK pound symbol and isql.exe
    ... isqlw and running and then creating the proc by piping in. ... > page installed with Windows XP appears correctly in a command prompt ...
    (microsoft.public.sqlserver.programming)
  • Re: how to interpret poolmon output, Proc tag.
    ... Task Manager and see if any process has a high value. ... 'Proc' tag is leaking in the tens of Megabytes. ... I'm running Windows XP Professional SP2, ...
    (microsoft.public.windowsxp.general)
  • Re: how to interpret poolmon output, Proc tag.
    ... I'm running Windows XP Professional SP2, ... The output of poolmon clearly shows that the leaking ... But what is 'Proc'? ... Can someone please explain to me what the 'Proc' tag means, ...
    (microsoft.public.windowsxp.general)
  • Re: transparency
    ... windows, windows with holes in them, and desktop widgets like this ... SetLayeredWindowAttributes to TWAPI. ... proc dragStart { ... # Set transparency color (red is 0x0000ff as per Windows COLORREF ...
    (comp.lang.tcl)
Loading