rts/js/environment.js

   1 //#OPTIONS: CPP
   2
   3 #ifdef GHCJS_TRACE_ENV
   4 function h$logEnv() { h$log.apply(h$log,arguments); }
   5 #define TRACE_ENV(args...) h$logEnv(args)
   6 #else
   7 #define TRACE_ENV(args...)
   8 #endif
   9
  10 // set up debug logging for the current JS environment/engine
  11 // browser also logs to <div id="output"> if jquery is detected
  12 // the various debug tracing options use h$log
  13 #ifndef GHCJS_BROWSER
  14 var h$glbl;
  15 function h$getGlbl() { h$glbl = this; }
  16 h$getGlbl();
  17 #endif
  18 #ifdef GHCJS_LOG_BUFFER
  19 var h$logBufferSize = 6000;
  20 var h$logBufferShrink = 1000;
  21 var h$logBuffer = [];
  22 #endif
  23 function h$log() {
  24 #ifdef GHCJS_LOG_BUFFER
  25   if(!h$logBuffer) return;
  26   var s = '';
  27   for(var i=0;i<arguments.length;i++) { s = s + arguments[i]; }
  28   h$logBuffer.push(s);
  29   if(h$logBuffer.length > h$logBufferSize) h$logBuffer = h$logBuffer.slice(h$logBufferShrink);
  30 #else
  31   try {
  32 #ifndef GHCJS_BROWSER
  33     if(h$glbl) {
  34       if(h$glbl.console && h$glbl.console.log) {
  35         h$glbl.console.log.apply(h$glbl.console,arguments);
  36       } else {
  37         h$glbl.print.apply(this,arguments);
  38       }
  39     } else {
  40       if(typeof console !== 'undefined') {
  41 #endif
  42         console.log.apply(console, arguments);
  43 #ifndef GHCJS_BROWSER
  44       } else if(typeof print !== 'undefined') {
  45         print.apply(null, arguments);
  46       }
  47     }
  48 #endif
  49   } catch(ex) {
  50     // ignore console.log exceptions (for example for IE9 when console is closed)
  51   }
  52 #endif
  53 #ifdef GHCJS_LOG_JQUERY
  54   // if we have jquery, add to <div id='output'> element
  55   if(typeof(jQuery) !== 'undefined') {
  56     var x = '';
  57     for(var i=0;i<arguments.length;i++) { x = x + arguments[i]; }
  58     var xd = jQuery("<div></div>");
  59     xd.text(x);
  60     jQuery('#output').append(xd);
  61   }
  62 #endif
  63 }
  64
  65 function h$collectProps(o) {
  66   var props = [];
  67   for(var p in o) { props.push(p); }
  68   return("{"+props.join(",")+"}");
  69 }
  70
  71
  72
  73 // load the command line arguments in h$programArgs
  74 // the first element is the program name
  75 var h$programArgs_;
  76 var h$rtsArgs_;
  77
  78 function h$programArgs() {
  79   if (!h$programArgs_) {
  80     h$initArgs();
  81   }
  82   return h$programArgs_;
  83 }
  84
  85 function h$rtsArgs() {
  86   if (!h$rtsArgs_) {
  87     h$initArgs();
  88   }
  89   return h$rtsArgs_;
  90 }
  91
  92 function h$initArgs() {
  93   #ifdef GHCJS_BROWSER
  94   h$programArgs_ = [ "a.js" ];
  95   #else
  96   if(h$isNode()) {
  97       h$programArgs_ = process.argv.slice(1);
  98   } else if(h$isJvm()) {
  99       h$programArgs_ = h$getGlobal(this).arguments.slice(0);
 100       h$programArgs_.unshift("a.js");
 101   } else if(h$isJsShell() && typeof h$getGlobal(this).scriptArgs !== 'undefined') {
 102       h$programArgs_ = h$getGlobal(this).scriptArgs.slice(0);
 103       h$programArgs_.unshift("a.js");
 104   } else if((h$isJsShell() || h$isJsCore()) && typeof h$getGlobal(this).arguments !== 'undefined') {
 105       h$programArgs_ = h$getGlobal(this).arguments.slice(0);
 106       h$programArgs_.unshift("a.js");
 107   } else {
 108       h$programArgs_ = [ "a.js" ];
 109   }
 110   #endif
 111
 112   //filter RTS arguments
 113   {
 114       var prog_args = [];
 115       var rts_args = [];
 116       var in_rts = false;
 117       var i = 0;
 118       for(i=0;i<h$programArgs_.length;i++) {
 119           var a = h$programArgs_[i];
 120           // The '--RTS' argument disables all future
 121           // +RTS ... -RTS processing.
 122           if (a === "--RTS") {
 123               break;
 124           }
 125           // The '--' argument is passed through to the program, but
 126           // disables all further +RTS ... -RTS processing.
 127           else if (a === "--") {
 128               break;
 129           }
 130           else if (a === "+RTS") {
 131               in_rts = true;
 132           }
 133           else if (a === "-RTS") {
 134               in_rts = false;
 135           }
 136           else if (in_rts) {
 137               rts_args.push(a);
 138           }
 139           else {
 140               prog_args.push(a);
 141           }
 142       }
 143       // process remaining program arguments
 144       for (;i<h$programArgs_.length;i++) {
 145           prog_args.push(h$programArgs_[i]);
 146       }
 147       //set global variables
 148       h$programArgs_ = prog_args;
 149       h$rtsArgs_     = rts_args;
 150   }
 151 }
 152
 153 function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) {
 154   TRACE_ENV("getProgArgV")
 155   var c = h$programArgs().length;
 156   if(c === 0) {
 157     argc_v.dv.setInt32(argc_off, 0, true);
 158   } else {
 159     argc_v.dv.setInt32(argc_off, c, true);
 160     var argv = h$newByteArray(4*c);
 161     for(var i=0;i<h$programArgs().length;i++) {
 162       PUT_ADDR(argv,4*i,h$encodeUtf8(h$programArgs()[i]),0);
 163     }
 164     PUT_ADDR(argv_v,argv_off,argv,0);
 165   }
 166 }
 167
 168 function h$setProgArgv(n, ptr_d, ptr_o) {
 169   var args = [];
 170   for(var i=0;i<n;i++) {
 171     var off = ptr_o+4*i;
 172     GET_ADDR(ptr_d,off,p,o);
 173     var arg = h$decodeUtf8z(p, o);
 174     args.push(arg);
 175   }
 176   h$programArgs_ = args;
 177 }
 178
 179 function h$getpid() {
 180 #ifndef GHCJS_BROWSER
 181   if(h$isNode()) return process.id;
 182 #endif
 183   return 0;
 184 }
 185
 186 function h$cpuTimePrecision() {
 187   return 1000;
 188 }
 189
 190 var h$fakeCpuTime = 1.0;
 191
 192 function h$getCPUTime() {
 193 #ifndef GHCJS_BROWSER
 194 if(h$isNode()) {
 195   var t = process.cpuUsage();
 196   var cput = t.user + t.system;
 197   TRACE_ENV("getCPUTime: " + cput)
 198   return cput;
 199 }
 200 #endif
 201   // XXX this allows more testsuites to run
 202   //     but I don't really like returning a fake value here
 203   TRACE_ENV("getCPUTime: returning fake value")
 204   return ++h$fakeCpuTime;
 205   return -1;
 206 }
 207
 208 function h$__hscore_environ() {
 209     TRACE_ENV("hscore_environ")
 210 #ifndef GHCJS_BROWSER
 211     if(h$isNode()) {
 212         var env = [], i;
 213         for(i in process.env) {
 214           var envv = i + '=' + process.env[i];
 215           TRACE_ENV("hscore_environ: " + envv)
 216           env.push(envv);
 217         }
 218         if(env.length === 0) return null;
 219         var p = h$newByteArray(4*env.length+1);
 220         for(i=0;i<env.length;i++) {
 221           PUT_ADDR(p,4*i,h$encodeUtf8(env[i]),0);
 222         }
 223         PUT_ADDR(p,4*env.length,null,0);
 224         RETURN_UBX_TUP2(p, 0);
 225     }
 226 #endif
 227     RETURN_UBX_TUP2(null, 0);
 228 }
 229
 230 function h$__hsbase_unsetenv(name, name_off) {
 231     return h$unsetenv(name, name_off);
 232 }
 233
 234 function h$getenv(name, name_off) {
 235     TRACE_ENV("getenv")
 236 #ifndef GHCJS_BROWSER
 237     if(h$isNode()) {
 238         var n = h$decodeUtf8z(name, name_off);
 239         TRACE_ENV("getenv (node): " + n)
 240         if(typeof process.env[n] !== 'undefined') {
 241             TRACE_ENV("getenv (node): " + n + " -> " + process.env[n])
 242             RETURN_UBX_TUP2(h$encodeUtf8(process.env[n]), 0);
 243         }
 244     }
 245 #endif
 246     RETURN_UBX_TUP2(null, 0);
 247 }
 248
 249 function h$setenv(name, name_off, val, val_off, overwrite) {
 250   var n = h$decodeUtf8z(name, name_off);
 251   var v = h$decodeUtf8z(val, val_off);
 252   TRACE_ENV("setenv: " + n + " -> " + v)
 253   if(n.indexOf('=') !== -1) {
 254     h$setErrno("EINVAL");
 255     return -1;
 256   }
 257 #ifndef GHCJS_BROWSER
 258   if(h$isNode()) {
 259     if(overwrite || typeof process.env[n] !== 'undefined') process.env[n] = v;
 260   }
 261 #endif
 262   return 0;
 263 }
 264
 265 function h$unsetenv(name, name_off) {
 266   var n = h$decodeUtf8z(name, name_off);
 267   TRACE_ENV("unsetenv: " + n)
 268   if(n.indexOf('=') !== -1) {
 269     h$setErrno("EINVAL");
 270     return -1;
 271   }
 272 #ifndef GHCJS_BROWSER
 273   if(h$isNode()) delete process.env[n];
 274 #endif
 275   return 0;
 276 }
 277
 278 /*
 279   Note:
 280    SUSv2 specifies that the argument passed to putenv is made part
 281    of the environment. Later changes to the value will be reflected
 282    in the environment.
 283
 284    this implementation makes a copy instead.
 285  */
 286 function h$putenv(str, str_off) {
 287 #ifndef GHCJS_BROWSER
 288   var x = h$decodeUtf8z(str, str_off);
 289   var i = x.indexOf('=');
 290   TRACE_ENV("putenv: " + x)
 291   if(i === -1) { // remove the value
 292     TRACE_ENV("putenv unset: " + x)
 293     if(h$isNode()) delete process.env[x];
 294   } else { // set the value
 295     var name = x.substring(0, i)
 296     var val = x.substring(i+1);
 297     TRACE_ENV("putenv set: " + name + " -> " + val)
 298     if(h$isNode()) process.env[name] = val;
 299   }
 300 #endif
 301   return 0;
 302 }
 303
 304 function h$errorBelch() {
 305   h$log("### errorBelch: do we need to handle a vararg function here?");
 306 }
 307
 308 function h$errorBelch2(buf1, buf_offset1, buf2, buf_offset2) {
 309   var pat = h$decodeUtf8z(buf1, buf_offset1);
 310   h$errorMsg(h$append_prog_name(pat), h$decodeUtf8z(buf2, buf_offset2));
 311 }
 312
 313 // append program name to the given string if possible
 314 function h$append_prog_name(str) {
 315   // basename that only works with Unix paths for now...
 316   function basename(path) {
 317    return path.split('/').reverse()[0];
 318   }
 319
 320   // only works for node for now
 321   if(h$isNode()) {
 322     return basename(process.argv[1]) + ": " + str;
 323   }
 324
 325   return str;
 326 }
 327
 328 function h$debugBelch2(buf1, buf_offset1, buf2, buf_offset2) {
 329   h$errorMsg(h$decodeUtf8z(buf1, buf_offset1), h$decodeUtf8z(buf2, buf_offset2));
 330 }
 331
 332 function h$errorMsg(pat) {
 333 #ifndef GHCJS_BROWSER
 334   function stripTrailingNewline(xs) {
 335     return xs.replace(/\r?\n$/, "");
 336   }
 337 #endif
 338   // poor man's vprintf
 339   var str = pat;
 340   for(var i=1;i<arguments.length;i++) {
 341     str = str.replace(/%s/, arguments[i]);
 342   }
 343 #ifndef GHCJS_BROWSER
 344   if(h$isGHCJSi()) {
 345     // ignore message
 346   } else if(h$isNode()) {
 347     process.stderr.write(str);
 348   } else if (h$isJsShell() && typeof printErr !== 'undefined') {
 349     if(str.length) printErr(stripTrailingNewline(str));
 350   } else if (h$isJsShell() && typeof putstr !== 'undefined') {
 351     putstr(str);
 352   } else if (h$isJsCore()) {
 353     if(str.length) {
 354         if(h$base_stderrLeftover.val !== null) {
 355             debug(h$base_stderrLeftover.val + stripTrailingNewline(str));
 356             h$base_stderrLeftover.val = null;
 357         } else {
 358             debug(stripTrailingNewline(str));
 359         }
 360     }
 361   } else {
 362 #endif
 363     if(typeof console !== 'undefined') {
 364       console.log(str);
 365     }
 366 #ifndef GHCJS_BROWSER
 367   }
 368 #endif
 369 }
 370
 371 // this needs to be imported with foreign import ccall safe/interruptible
 372 function h$performMajorGC() {
 373     // save current thread state so we can enter the GC
 374     var t = h$currentThread, err = null;
 375     t.sp = h$sp;
 376     h$currentThread = null;
 377
 378     try {
 379         h$gc(t);
 380     } catch(e) {
 381         err = e;
 382     }
 383
 384     // restore thread state
 385     h$currentThread = t;
 386     h$sp = t.sp;
 387     h$stack = t.stack;
 388
 389     if(err) throw err;
 390 }
 391
 392
 393 function h$ghczminternalZCSystemziCPUTimeZCgetrusage() {
 394   return 0;
 395 }
 396
 397 function h$getrusage() {
 398   return 0;
 399 }
 400
 401
 402 // fixme need to fix these struct locations
 403
 404 function h$gettimeofday(tv_v,tv_o,tz_v,tz_o) {
 405   var now = Date.now();
 406   tv_v.dv.setInt32(tv_o,     (now / 1000)|0, true);
 407   tv_v.dv.setInt32(tv_o + 4, ((now % 1000) * 1000)|0, true);
 408   if(tv_v.len >= tv_o + 12) {
 409     tv_v.dv.setInt32(tv_o + 8, ((now % 1000) * 1000)|0, true);
 410   }
 411   return 0;
 412 }
 413
 414 var h$__hscore_gettimeofday = h$gettimeofday;
 415
 416 var h$myTimeZone = h$encodeUtf8("UTC");
 417 function h$localtime_r(timep_v, timep_o, result_v, result_o) {
 418   var t = timep_v.i3[timep_o];
 419   var d = new Date(t * 1000);
 420   result_v.dv.setInt32(result_o     , d.getSeconds(), true);
 421   result_v.dv.setInt32(result_o + 4 , d.getMinutes(), true);
 422   result_v.dv.setInt32(result_o + 8 , d.getHours(), true);
 423   result_v.dv.setInt32(result_o + 12, d.getDate(), true);
 424   result_v.dv.setInt32(result_o + 16, d.getMonth(), true);
 425   result_v.dv.setInt32(result_o + 20, d.getFullYear()-1900, true);
 426   result_v.dv.setInt32(result_o + 24, d.getDay(), true);
 427   result_v.dv.setInt32(result_o + 28, 0, true); // fixme yday 1-365 (366?)
 428   result_v.dv.setInt32(result_o + 32, -1, true); // dst information unknown
 429   result_v.dv.setInt32(result_o + 40, 0, true); // gmtoff?
 430   PUT_ADDR(result_v,result_o+40, h$myTimeZone, 0);
 431   PUT_ADDR(result_v,result_o+48, h$myTimeZone, 0);
 432   RETURN_UBX_TUP2(result_v, result_o);
 433 }
 434 var h$__hscore_localtime_r = h$localtime_r;
 435
 436 function h$checkForeignRefs(refs) {
 437   function argSize(t) {
 438     if(t === "ghc-internal:GHC.Internal.Prim.Word64#")    return 2;
 439     if(t === "ghc-internal:GHC.Internal.Prim.State#")     return 0;
 440     if(t === "ghc-internal:GHC.Internal.Prim.Void#")      return 0;
 441     if(t === "ghc-internal:GHC.Internal.Prim.Int#")       return 1;
 442     if(t === "ghc-internal:GHC.Internal.Prim.Int64#")     return 2;
 443     if(t === "ghc-internal:GHC.Internal.Prim.Weak#")      return 1;
 444     if(t === "ghc-internal:GHC.Internal.Prim.Addr#")      return 2;
 445     if(t === "ghc-internal:GHC.Internal.Prim.Word#")      return 1;
 446     if(t === "ghc-internal:GHC.Internal.Prim.Float#")     return 1;
 447     if(t === "ghc-internal:GHC.Internal.Prim.Double#")    return 1;
 448     if(t === "ghc-internal:GHC.Internal.Prim.ByteArray#") return 2;
 449     if(t === "ghc-internal:GHC.Internal.Prim.ThreadId#")  return 1;
 450     console.warn("unknown argument type: " + t);
 451     return 1;
 452   }
 453   function callStr(r) {
 454     return r.pattern + '(' + r.arguments.join(', ') + ') -> ' + r.result + ' ' + r.span;
 455   }
 456   function checkRef(r) {
 457     if(r.cconv === "ccall") {
 458       var f = null;
 459       try {
 460         f = eval(r.pattern);
 461       } catch(e) { }
 462       if(!f) {
 463         console.warn("referenced pattern does not exist: " + callStr(r));
 464         return;
 465       }
 466       if(typeof f !== 'function') {
 467         console.warn("referenced pattern is not a function: " + callStr(r));
 468         return;
 469       }
 470       var s = 0, ba = 0;
 471       for(var i = 0; i < r.arguments.length; i++) {
 472         var a = r.arguments[i];
 473         s  += argSize(a);
 474         ba += a === "ghc-internal:GHC.Internal.Prim.ByteArray#" ? 1 : 0;
 475       }
 476       if(f.length != s) {
 477         console.warn("number of arguments does not seem to match: " + callStr(r));
 478       }
 479       if(ba !== 0 && f.length === (s - ba)) {
 480         console.warn("number of arguments matches old ByteArray calling convention: " + callStr(r));
 481       }
 482     }
 483     // todo: check other calling conventions
 484   }
 485   for(var i=0;i<refs.length;i++) {
 486     checkRef(refs[i]);
 487   }
 488 }
 489
 490 var h$GHCConcSignalSignalHandlerStore_d = null;
 491 var h$GHCConcSignalSignalHandlerStore_o = 0;
 492
 493 function h$getOrSetGHCConcSignalSignalHandlerStore(d,o) {
 494   if(d) {
 495     h$GHCConcSignalSignalHandlerStore_d = d;
 496     h$GHCConcSignalSignalHandlerStore_o = o;
 497   }
 498   RETURN_UBX_TUP2(h$GHCConcSignalSignalHandlerStore_d, h$GHCConcSignalSignalHandlerStore_o);
 499 }