tools/imagechecker/imagecheck.st

   1 "run this with -Z to write clean image"
   2 "Requires [ disasm ]"
   3
   4
   5
   6 {| doclass totalwin file srcsize |
   7   srcsize := 0.
   8   doclass := [:cls |
   9     "cls printNl."
  10     cls methods do: [:m :mn :msgs :p |
  11       "cls print. '>>' print. m name printNl."
  12       srcsize := srcsize + m text size.
  13       msgs := List new.
  14       p := LstCompiler new.
  15       p warningBlock: [:msg :line |
  16         msgs addLast: 'WARNING near line ' + line asString + ': ' + msg.
  17       ].
  18       p errorBlock: [:msg :line |
  19         msgs addLast: 'ERROR near line ' + line asString + ': ' + msg.
  20       ].
  21       mn := cls compileMethod: m text withCompiler: p.
  22       msgs isEmpty ifTrue: [
  23         p := (m byteCodes size) - (mn byteCodes size).
  24         totalwin := totalwin + p.
  25         p > 0 ifTrue: [
  26           cls print. '>>' print. m name print. '  win: ' print. p printNl.
  27         ].
  28         cls replaceMethod: m name with: mn.
  29       ] ifFalse: [
  30         cls print. '>>' print. m name print. '  win: ' print.
  31         mn ifNotNil: [
  32             p := (m byteCodes size) - (mn byteCodes size).
  33             totalwin := totalwin + p.
  34             p printNl.
  35             cls replaceMethod: m name with: mn.
  36            ] ifNil: [ 'unknown' printNl. ].
  37         msgs reverseDo: [:i |
  38           System isStdOutTTY ifTrue: [
  39             (i firstChar = $W ifTrue: [ '\e[31m' ] ifFalse: [ '\e[41m' ]) print.
  40           ].
  41           '***' print. i print.
  42           System isStdOutTTY ifTrue: [ '\e[0m' printNl ] ifFalse: [ '\n' print ].
  43         ].
  44       ].
  45     ].
  46   ].
  47
  48   totalwin := 0.
  49
  50   globals keysAndValuesDo: [:name :value |
  51     ((value isKindOf: Class) and: [ (name asString from: 1 to: 4) ~= 'Meta' ]) ifTrue: [
  52       doclass value: (value class).
  53       doclass value: value.
  54     ].
  55   ].
  56
  57   'total source code size: ' print. srcsize print. ' (' print. (srcsize / 1024) print. 'kb)' printNl.
  58   'total bytecode win: ' print. totalwin printNl.
  59
  60   cliArgs size > 1 ifTrue: [
  61     doclass := cliArgs at: 2.
  62     'MESSAGE: writing image to ' print. doclass printNl.
  63     file := File openWrite: doclass.
  64     file opened ifFalse: [ ^self error: 'cannot open image file' ].
  65     file writeImage.
  66     file close.
  67   ].
  68 }