extra/mason/child/child.factor

   1 ! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays calendar combinators
   4 combinators.short-circuit continuations fry io.directories
   5 io.launcher io.pathnames kernel layouts macros make mason.config
   6 mason.notify mason.platform mason.report math.parser namespaces
   7 quotations sequences splitting system system-info ;
   8 IN: mason.child
   9
  10 : gnu-make-cmd ( -- args )
  11     gnu-make
  12     target-os get name>> target-cpu get name>> (platform)
  13     2array ;
  14
  15 HOOK: compile-factor-command os ( -- array )
  16 M: unix compile-factor-command ( -- array )
  17     gnu-make-cmd ;
  18
  19 ! Windows has separate 32/64 bit shells, so assuming the cell bits here is fine
  20 ! because it won't find the right toolchain otherwise.
  21 M: windows compile-factor-command ( -- array )
  22     { "nmake" "/f" "NMakefile" } cell-bits 64 = "x86-64-vista" "x86-32-vista" ? suffix ;
  23
  24 HOOK: factor-path os ( -- path )
  25 M: unix factor-path "./factor" ;
  26 M: windows factor-path "./factor.com" ;
  27
  28 : make-mason-child-vm ( -- )
  29     "factor" [
  30         <process>
  31             compile-factor-command >>command
  32             "../compile-log" >>stdout
  33             +stdout+ >>stderr
  34             +new-group+ >>group
  35         try-process
  36     ] with-directory ;
  37
  38 ! On windows, process launches relative to current process, ignoring
  39 ! current-directory variables. Must pass absolute-path of factor.com
  40 : mason-child-vm ( -- string )
  41     target-os get windows = [
  42         "./factor.com" absolute-path
  43     ] [
  44         "./factor"
  45     ] if ;
  46
  47 : mason-child-boot-cmd ( -- cmd )
  48     [
  49         mason-child-vm ,
  50         "-i=" target-boot-image-name append ,
  51         "-no-user-init" ,
  52         boot-flags get %
  53     ] { } make ;
  54
  55 : bootstrap-mason-child ( -- )
  56     "factor" [
  57         <process>
  58             mason-child-boot-cmd >>command
  59             +closed+ >>stdin
  60             "../boot-log" >>stdout
  61             +stdout+ >>stderr
  62             1 hours >>timeout
  63             +new-group+ >>group
  64         try-process
  65     ] with-directory ;
  66
  67 : mason-child-test-cmd ( -- cmd )
  68     [
  69         mason-child-vm ,
  70         os windows? cpu x86.64? and [ "-codeheap=200" , ] when
  71         "-run=mason.test" ,
  72     ] { } make ;
  73
  74 : test-mason-child ( -- )
  75     "factor" [
  76         <process>
  77             mason-child-test-cmd >>command
  78             +closed+ >>stdin
  79             "../test-log" >>stdout
  80             +stdout+ >>stderr
  81             6 hours >>timeout
  82             +new-group+ >>group
  83         try-process
  84     ] with-directory ;
  85
  86 : recover-else ( try catch else -- )
  87     [ [ '[ @ f t ] ] [ '[ @ f ] ] bi* recover ] dip '[ drop @ ] when ; inline
  88
  89 MACRO: recover-cond ( alist -- quot )
  90     dup { [ length 1 = ] [ first callable? ] } 1&&
  91     [ first ] [
  92         [ first first2 ] [ rest ] bi
  93         '[ _ _ [ _ recover-cond ] recover-else ]
  94     ] if ;
  95
  96 : build-child ( -- status )
  97     {
  98         { [ notify-make-vm make-mason-child-vm ] [ compile-failed ] }
  99         { [ notify-boot bootstrap-mason-child ] [ boot-failed ] }
 100         { [ notify-test test-mason-child ] [ test-failed ] }
 101         [ success ]
 102     } recover-cond ;