// Disclaimer: JS-Forth is delivered as-is. No warranties,
// implicit or explicit, towards its function, usability, fitness
// for any purpose are given. It is distributed for educative
// purposes, you may study it to your hearts delight. Should 
// you plan to execute JS-Forth on any computer, you declare
// to not hold the programmer liable in any way for any damage
// JS-Forth may cause, be it to that computer, peripherals, or any
// other object in the range of several thousand kilometers, or
// more. The person initiating execution of JS-Forth is the one
// carrying sole responsibility for all and any damage resulting
// from this action. Also, you do not hold the programmer liable
// for any damage resulting from the study of JS-Forth.  Please
// do not stick your tongue into the power supply of the computer
// which is running JS-Forth.
// By opening JS-Forth for reading or execution, you make a full
// statement that you have read and understood all of the above
// disclaimer, and proceed willingly, volunteerily, and of your
// own choice on your own risk and responsability.
//
// Having said that, i can assure you that JS-Forth has not been
// written to perform any malicious action on your computer or 
// anyone elses. I run Js-Forth frequently, and no damage has
// occured from doing so, though no extensive testing has been
// done on it as a whole yet. Those parts which work do so in a
// pretty stable manner. A major version jump to v0.01 may be imminent.


var version    = "0" ;
var subversion = "5200804171342" ;
var title      = "## JS-Forth " + version + "." + subversion + " ##" ;



// if (document.captureEvents) document.captureEvents(Event.KEYPRESS) ;
// if (window.captureEvents)   window.captureEvents(Event.CLICK) ;
   if (document.domain.indexOf("forthfreak.net") == -1)  { version = -1 ; location.replace("http://forthfreak.net/jsforth80x25.html") ; }
// document.getElementById('status').contentDocument.designMode = "on";



// --------------------------------------------- vars you may wish to customize ---------------------------------------------------

var memend               = 0x100000 ;                         // memory allocated to jsforth (1 megacells is more than plenty)
var maxcookies           = 4                                  // number of disk sectors. >4 may be unsafe.
var cookiebasename       = "jsfblk" ;                         // cookie name for saved blocks (blk number gets appended)
var cookieexpirationdate = "Fri, 31 Dec 2015 23:59:59 GMT" ;  // the date your hard disk will get erased.
var infolines            = 1000 ;                             // backscroll buffer size of info screen
var paddistance          = 512  ;                             // space between here and pad.
var padsize              = 512 ;                              // remaining space above pad until dictionary overflow error
var maxbufs              = 2                                  // number of buffers. works with any between 1 ... maxmem
                                                              // default=2, more may be useful if working with many remote blocks
var blocktimeout         = 5000                               // file i/o error if request not completed with this time (ms)
                                                           
// --------------------------------------------------------------------------------------------------------------------------------





// --- character codes
var backspace      =   8 ;
var tab            =   9 ;
var carriagereturn =  13 ;
var esc            =  27 ;
var bl             =  32 ;


var suspended      =  -1 ;              // reason for suspending interpreter (event type)
                                        // -1: never started (helps source locator in see)
var dp             =   0 ;              // dictionary pointer
var catchframe     =   0 ;              // for catch/throw
var wc             =   0 ;              // header count
var inbuf          =  new Array()  ;    // accumulated input characters


var linelen        =  80 ;              // main screen 
var lines          =  30 ;

var linelen2       =  55 ;              // info screen
var lines2         =  lines ;              


var screensize     = lines * linelen ;
var tibsize        = linelen + 1 ;
var dictionaryfull = memend - (paddistance + padsize) ;

// heap memory tracking
var usedchunk      = new Array() ;
var freechunk      = new Array() ;
var heapend        = memend ;

// word header bit masks
var immediate      =  1 ;
var smudgebit      =  2 ;
var precedencebit  =  immediate ;

var dp_cold ;                           // allows "cold" to restore dp and wc to
var wc_cold ;                           // initial settings
var heap_cold ;


var s              = new Array();       // data stack 
var r              = new Array();       // return stack
var m              = new Array();       // main memory
var h              = new Array();       // headers
var hf             = new Array();       // header flags (precendence bit, hide/reveal)
var x              = new Array();       // execution tokens
var t              = new Array();       // word type - accelerated execution because no
var sourceid       = new Array();       // nested loads/evaluate stack previous source id here
                                        // conditional branching to the corresponding
                                        // code for next per wordtype. this array contains
                                        // the proper next to use. this should also
                                        // simplify does>
h[0] = "" ;                             // in case header 0 gets accidently requested 
var f              = new Array();       // float stack
var ip;                                 // forth vm instruction pointer
var w;                                  // forth vm word register
var sp             = 0;                 // forth vm parameter stack pointer
var rp             = 0;                 // forth vm return stack pointer
var tos;                                // stack cache
var ftos;                               // float stack cache





// constants for standard compliance bit masks
// a combination of those are written to the description of each word
// through variable COMPLIANCE, subsets of provided words are masked
var standard = new Array() ;

// standard selection and vocabularies share the same mechanism. therefore,
// using both concepts is a bit of a mix here now.
// standards and vocabularies use bit masks

var nextvocabulary = 1 ;  var uncertain =  nextvocabulary ;  standard[uncertain] = "   possibly other, need to look that up first" ;
nextvocabulary <<= 1   ;  var fig       =  nextvocabulary ;  standard[fig]       = "fig" ;
nextvocabulary <<= 1   ;  var f79       =  nextvocabulary ;  standard[f79]       = "f79" ;
nextvocabulary <<= 1   ;  var f83       =  nextvocabulary ;  standard[f83]       = "f83" ;
nextvocabulary <<= 1   ;  var ans       =  nextvocabulary ;  standard[ans]       = "dpans94" ;
nextvocabulary <<= 1   ;  var foerthchen=  nextvocabulary ;  standard[foerthchen]= "FOeRTHchen" ;
nextvocabulary <<= 1   ;  var jsf       =  nextvocabulary ;  standard[jsf]       = "JS-Forth" ;
                    var higheststandard =  nextvocabulary ;
                          var any       =  ans | f83 | f79 | fig | jsf ;       // but not foerthchen


// --- no more standards, vocabularies follow ---
nextvocabulary <<= 1   ;  var only      =  nextvocabulary ;
nextvocabulary <<= 1 ;    var forth     =  nextvocabulary  ;
nextvocabulary <<= 1 ;    var hidden    =  nextvocabulary  ;
nextvocabulary <<= 1 ;    var teststuff =  nextvocabulary  ;
                          var lastsystemvocabulary =  nextvocabulary  ;


var vocstack = new Array() ;                        // top element is in m[context] 
var vocname = new Array() ;                         // contains xt of all vocs


function printvocname(n)  {
   var temp = 0 ;
   for (var i=only ; i != 0x40000000 ; i <<=1 ) {
      if (i == n)  {
         type(h[vocname[temp]] + " ") ;
         break ;
      }
      temp++ ;
   }
}



function jscomma(n)   { m[dp++] = n ;  return (dp-1) ;}

function jshiallot0(n)  {      // heap (buffers, allocate)
   for (var i=n ; i ; i--)  m[heapend++] = 0 ;
   return (heapend-n) ;
}

// variables, shared between javascript and forth:
// addressed by m[varname] from javascript, define a constant
// with value of address for access from forth. 
var casesensitive = jscomma(0) ;      // switch case sensitive/insensitive dictionary search
var debugging     = jscomma(0) ;      // get spilled with output on info display
var popups        = jscomma(0) ;      // errors to terminal or popup alert
var warnings      = jscomma(-1) ;     // meant to disable javascript warnings, but hides only error messages
var compliance    = jscomma(jsf) ;    // cause find, words to scope only those words complying with the selected standard 
var fittype       = jscomma(0) ;      // ALLOCATE chunk matching:    0: first, other: best fit
var outfile       = jscomma(-1) ;     // switch between output routines:
                                      //  -1 : fast terminal
                                      //  -2 : slow terminal
                                      //  >=0 : output to consecutive blocks  ( not implemented )
var blk           = jscomma(-1) ;     // currently accessed block, as set by load
var scr           = jscomma(0) ;      // last block accessed through list or user tools
var context       = jscomma(forth) ;  // first searched vocabulary on vocabulary stack
var current       = jscomma(forth) ;  // the vocabulary compiled to
var lastxt        = jscomma(0) ;      // contains execution token of most recently compiled word
var base          = jscomma(10) ;     // radix for i/o number conversion
var state         = jscomma(0) ;      // switch interpret/compile
var innerloop     = jscomma(0) ;      // compile time helper variable for loops
var innercase     = jscomma(0) ;      // of counter for inner case
var span          = jscomma(0) ;      // obsolete -- expect stores string len in here
var toin          = jscomma(0) ;      // input buffer handling
var hashtib       = jscomma(0) ;      // obsolescent - contains # chars in tib
var tib           = jshiallot0(tibsize) // input buffer

var parsebuf ;                        // usually address of tib, but can be block address
var parsebuflen ;                     // number of chars in parse buffer




// ----------------------------------------------- mass memory buffers ---------------------------------------------


var nextbuf       = 0 ;               // index of next buffer to use
var buf           = new Array() ;     // buffer addresses
var bufdirty      = new Array() ;     // buffer dirty flag
var bufblk        = new Array() ;     // block in this buf, or -1

var blockstat     = new Array()       // -1: indexed by blk, gives -1 for unbuffered, or, if buffered, buffer id







// ----- data storage for descriptions, stack effects -----
// also trying to use these for vocabularies
// "standard" is printed along with help. As this information is supplied
// anyway, the compiler could use it, by making sure only words which belong
// to a user specified standard are used, or printing warning otherwise. 


var ds            = new Array();      // bitmask for compliancy and vocs
var dse           = new Array();      // stack effect, text



var lineofspaces  = "" ;
for ( var i=0 ; i<linelen ; i++ ) lineofspaces += " " ;



var linesonscreen = 1 ;
var terminal      = new Array() ;   terminal[0]     = "" ;
var charsperline  = new Array() ;   charsperline[0] = 0 ;


function describe(string1,bitmask)  {
   dse[wc] = string1 ;
   ds[wc]  = 0 | m[current] ; if (bitmask) ds[wc] = bitmask | m[current];
}



var infoline = new Array() ;
var allinfos = 0 ;



// =================================================================================================
//                                     dumb terminal emulator
// =================================================================================================





// ---- infos screen ----

function printinfos()  {
   for (var i=infoline.length ; i>infolines ; i--) infoline.shift() ;              // limit #lines in buffer
   if (allinfos) {
      temp = infoline.join("\n") ;                                                 // want to see all lines
   } else {
      var temp="" ;
      for (i=Math.max(0,infoline.length-lines2); i<infoline.length ; i++)  {
         temp += (infoline[i] + "\n") ;                                            // want to see only last x lines
      }
   }
   document.terminal.status.value = temp ;                                         // flush
}



function clsinfo()      { for (i=infoline.length ; i ; i--) infoline.shift() ; }
function info(string)   { infoline.push((string+"").substr(0,linelen2)) ; }
function debug(string)  { if (m[debugging]) info(string) ; }




function moreinfo(string)  {              // appends to last info line
   var temp  = infoline.length - 1 ;
   var temp2 = infoline[temp] + string ;
   infoline[temp] = temp2.substr(0,linelen2) ;
}


function seperator()  {
   info("----------------------------------------------------------------") ;
}








// ---- interactive terminal screen ----
function flushscreen()  {
   document.terminal.dialog.value = terminal.join("\n") ;
   printinfos() ;
 }


function show() { flushscreen() } ;

function type(string)  {
   terminal[--linesonscreen] += string ;                                          // add output text to cursorline
   charsperline[linesonscreen++] += string.length ;                               // update chars/line accordingly
   if (charsperline[linesonscreen-1] <= linelen) return ;
   for ( var lastline = --linesonscreen ; charsperline[lastline] > linelen ; ) {  // line longer than terminal wide ?
      if (lastline >= lines) {                                                    // need to scroll ?
         terminal.shift() ;                                                       // remove top line
         charsperline.shift() ;
         lastline-- ;                                                             // unregister top line
      }
      terminal.push(terminal[lastline].substr(linelen)) ;                         // break line, adding a new one
      terminal[lastline] = terminal[lastline].substr(0,linelen) ;                 // move part beyond linelen to next line
      charsperline.push(charsperline[lastline]-linelen) ;                         // calculate count chars on new line
      charsperline[lastline++] = linelen ;                                        // set line len for cut line
      if (m[outfile]==-2) flushscreen() ;                                         // update screen
   }
   linesonscreen = ++lastline ;
}



function write(string)  {
   type(string) ;
   flushscreen() ;
}



function cr()  {
   terminal.push("") ;                                              // add new empty line
   charsperline.push(0) ;                                           // add new chars per line
   linesonscreen++ ;
   if (linesonscreen<lines)  {                                      // no scrolling, need to update only last line
      document.terminal.dialog.value += terminal[linesonscreen-1] ;
   } else {
      for ( ; linesonscreen > lines ; linesonscreen-- ) {           // scrolling necessary ?
         terminal.shift() ;                                         // remove top line
         charsperline.shift() ;                                     // remove top line length
      }
      if (m[outfile]==-2) flushscreen() ;                           // update screen
   }
}



function cls()     {
   for ( ; linesonscreen > 1 ; linesonscreen-- )  {                 // remove all but one lines
      terminal.pop()  ;
      charsperline.pop() ;
   }
   terminal[0]="" ;                                                 // empty the one remaining line
   charsperline[0] = 0 ;
   flushscreen() ;
}



function backspaces(n)    {
   if (n>0)  {
      var lastline = linesonscreen - 1 ;
      var charstoremain = charsperline[lastline] - n ;
      if (charstoremain < 0) {
         charstoremain = 0 ;
      }
      terminal[lastline] = terminal[lastline].substr(0,charstoremain) ;
      charsperline[lastline] = charstoremain ;
   }
}


function emit(asc)     { type(String.fromCharCode(asc)); }



function querytype(string)  {    // breaks line if string won't fit
   if ((charsperline[linesonscreen-1] + string.length) > linelen)  cr() ;
   type(string) ;
}





// =================================================================================================
//                                   primitives constructor
// =================================================================================================



var src = new Array() ;
// -2: script file
// -1: interactive console
//  0... blk*1024+charpos


function from()  {
   if (suspended)    return -2 ;
   if (m[blk] >= 0)  return m[blk]*1024+m[toin] ;
   return -1 ;
}



function newheader(name,flags)  {            // wc = word count
   h[++wc]   = name ;                        // header name
   src[wc]   = from() ;
   hf[wc]    = flags ;                       // immediate/reveal
   x[wc]     = dp ;                          // pointer to word body (was: xt)
   m[lastxt] = wc ;                          // last
   ds[wc]    = any | foerthchen | m[current] ;  // new words standard compliance
   dse[wc]   = "" ;                          // new word stack effect
   debug("compiling: " + name);
}


function nextprimitive()  { x[w]() ; }
function nexthilevel()    { w = x[w]    ;  x[m[w]]() ; }
function nextconstant()   { s[++sp]=tos ; tos=m[x[w]+1] ; }
function nextvariable()   { s[++sp]=tos ; tos=x[w]+1 ; }

// function nexthilevel()    { r[++rp] = ip ; ip = x[w]+1 ; }   // slower ...
// there's a dovocabulary further below, and a dodoes











function primitive(name,code,flags)  {
   newheader(name,flags|smudgebit) ;
   x[wc] = code ;
   t[wc] = nextprimitive ;
   return wc ;
}


function headerless()  {  h[wc] = "" ;  }





// =================================================================================================
//                                       misc helper words
// =================================================================================================




primitive("cls2",clsinfo) ;                 // clear info window
describe("--",jsf) ;


definitions(hidden) ;

function pack(a,n)   {
   w = "" ;
   for ( var i=n ; i; i--)  w += String.fromCharCode(m[a++]) ;
   return w;
}

function forthpack()   { tos=pack(s[sp--],tos) ; }
var x_pack=primitive("pack",forthpack) ;
describe("a n -- x",jsf) ;



function unpackstring(string,address)   {  // returns len
   var stringlen = string.length ;
   var destaddr = address + stringlen ;
   for (var i=stringlen; i; m[--destaddr]=string.charCodeAt(--i) )  {} ;
   return stringlen ;
}



// unpack packed string x to address, return number of characters 
// can reuse the function above
function unpack()   {                                     // ( x a -- n )
   var string = s[sp--] ;                                 // string
   w = string.length ;                                    // string len
   tos += w ;                                             // last dest address + 1
   for (var i=w; i; m[--tos]=string.charCodeAt(--i) )  {} ;
   tos = w ;
}
var x_unpack = primitive("unpack",unpack) ;
describe("x a -- n",jsf) ;



function definitions(vocabulary) { m[current] = vocabulary ; }
definitions(forth) ;



function forthstackeffect()  {              // ( xt -- a n )
   s[++sp] = dp ;
   if (dse[tos]) {
      tos = unpackstring("( " + dse[tos] + " )",dp) ;
   } else {
      tos = 0 ;
   }
}
primitive("stackeffect",forthstackeffect) ;
describe("xt -- a n",jsf) ;



definitions(hidden)
function forthstorestackeffect()  {          // ( a n -- )
   forthpack() ;
   dse[m[lastxt]] = tos ;
   tos = s[sp--]
}
var x_storestackeffect = primitive("stackeffect!",forthstorestackeffect) ;
describe("a n --",jsf) ;



definitions(forth)
function forthinfo() {   // ( a n -- )                   info 
   info(pack(s[sp--],tos)) ;
   tos = m[sp--] ;
}
primitive("info",forthinfo) ;
describe("a n --",jsf) ;


function forthmoreinfo() {   // ( a n -- )                ...info 
   moreinfo(pack(s[sp--],tos)) ;
   tos = m[sp--] ;
}
primitive("...info",forthmoreinfo) ;
describe("a n --",jsf) ;





var clock ;

function forthstartclock() {
  clock = new Date().getTime();
}
primitive("startclock",forthstartclock) ;
describe("--",jsf) ;



function forthelapsed()    {
   w = new Date().getTime();
   s[++sp] = tos ;
   tos = w - clock ;
}
primitive("elapsed",forthelapsed) ;
describe("-- u",jsf) ;









// ----- multi standard selection ----- 

definitions(forth) ;

function forthfig()  { m[compliance] = fig ; }
primitive("fig",forthfig) ;
describe("--",jsf) ;


function forthfoerthchen()  { m[compliance] = foerthchen ; }
primitive("foerthchen",forthfoerthchen) ;
describe("--",jsf) ;


function forthf79()  { m[compliance] = f79 ; }
primitive("f79",forthf79) ;
describe("--",jsf) ;


function forthf83()  { m[compliance] = f83 ; }
primitive("f83",forthf83) ;
describe("--",f83|jsf) ;


function forthans()  { m[compliance] = ans ; }
primitive("ans",forthans) ;
describe("--",jsf) ;

function forthjsforth()  { m[compliance] = jsf ; }
primitive("jsf",forthjsforth) ;
describe("--",any|foerthchen) ;








// =================================================================================================
//                                         virtual machine
// =================================================================================================

definitions(hidden) ;
function forthnest()     {  r[++rp] = ip ; ip = ++w ; }
var x_nest=primitive("(nest)",forthnest) ;
describe("--",jsf) ;



definitions(forth) ;
function forthunnest()   { ip = r[rp--] ; }
var x_unnest=primitive("exit",forthunnest) ;
describe("--",any) ;








// =================================================================================================
//                                           catch, throw
// =================================================================================================
var customerror = new Array() ;
var systemerror = new Array() ;
systemerror[1] = "aborted" ;
systemerror[2] = "aborted" ;
systemerror[3] = "stack overflow" ;
systemerror[4] = "stack underflow" ;
systemerror[5] = "return stack overflow" ;
systemerror[6] = "return stack underflow" ;
systemerror[7] = "do loops nested too deeply" ;
systemerror[8] = "dictionary overflow" ;
systemerror[9] = "invalid memory address" ;
systemerror[10] = "division by zero" ;
systemerror[11] = "result out of range" ;
systemerror[12] = "argument type mismatch" ;
systemerror[13] = "word not found" ;
systemerror[14] = "use only during compilation" ;
systemerror[15] = "invalid forget" ;
systemerror[16] = "attempt to use zero-length string as name" ;
systemerror[17] = "pictured numeric ouput string overflow" ;
systemerror[18] = "pictured numeric ouput string overflow" ;
systemerror[19] = "word name too long" ;
systemerror[20] = "write to a read-only location" ;
systemerror[21] = "unsupported operation" ;
systemerror[22] = "unstructured" ;
systemerror[23] = "address alignment exception" ;
systemerror[24] = "invalid numeric argument" ;
systemerror[25] = "return stack imbalance" ;
systemerror[26] = "loop parameters unavailable" ;
systemerror[27] = "invalid recursion" ;
systemerror[28] = "user interrupt" ;
systemerror[29] = "compiler nesting" ;
systemerror[30] = "obsolescent feature" ;
systemerror[31] = ">BODY used on non-CREATEd definition" ;
systemerror[32] = "invalid name argument" ;
systemerror[33] = "Block read exception" ;
systemerror[34] = "Block write exception" ;
systemerror[35] = "Invalid block number" ;
systemerror[36] = "Invalid file position" ;
systemerror[37] = "File I/O exception" ;
systemerror[38] = "File not found" ;

// additional jsforth error messages:
systemerror[64] = "use only while interpreting" ;
systemerror[65] = "executed BODY> on a non-body address" ;
systemerror[66] = "unstructured" ;                // message gets overwritten for more detail
systemerror[67] = "TO must be used on a VALUE" ;
systemerror[68] = "JavaScript boo, mostly the result of uninitialized memory access" ;
systemerror[69] = "Too many vocabularies" ;
systemerror[70] = "No cookie by that name found" ;
systemerror[71] = "Can't write to read-only block" ;
systemerror[72] = "Invalid memory region specifier, or heap corrupted" ;




function errordialog(x)   {
   if (x < 0)  {
      if (systemerror[-x]) return ("error(" + x + "): " + systemerror[-x]) ;
      return ("error #" + x) ;
   }
   if (customerror[x]) return ("error: " + customerror[x]) ;
   return ("error #" + x) ;
}





// throw without catch frame - top level error handler
function exception(x)  {
   cr() ;

   if (m[blk]>=0)   {
      var temp = m[toin] % 64 ;
      write(pack(parsebuf + m[toin] - temp,temp)) ;
   } else {
      write(pack(parsebuf,m[toin])) ;
   }
   cr() ;
   if (m[popups]) {
      alert(errordialog(x)) ;
    } else {
      type("=== " + errordialog(x) + " ===") ; cr() ;
    }
// just calling the virtual machine won't do, as that would require more and more javascript return stack.
//  stopping the interpreter, and have it restart with a one-time event at the warm start point solves this.
    debug("issuing timed event 'warmstart vm in 1 ms'") ; 
    suspended = warm ;
    setTimeout(virtualmachine,1,warm) ;
    tos = s[sp--] ;
}





definitions(hidden) ;
function forththrow0()  {
   catchframe = r[rp] ;
   sp = r[--rp] ;
   ip = r[--rp] ;
   rp-- ;  
   tos = 0 ;
}
var brthrow0 = dp
m[dp++] = primitive("throw0",forththrow0) ;


definitions(forth) ;
function forthcatch() {
   r[++rp] = ip ;  
   r[++rp] = sp ;
   r[++rp] = catchframe ;    
   catchframe = rp ;   
   r[++rp] = brthrow0 ;
   forthexecute() ;
}
var x_catch = primitive("catch",forthcatch) ;
describe("xn ... x0 a -- xn ... x0 n",ans|jsf) ;


function throwerror(x)  {
   if (catchframe)  {
      tos = x
      rp = catchframe ;
      catchframe = r[rp--] ;
      sp = r[rp--] ;
      ip = r[rp--] ;
   } else {
      exception(x) ;
   }
}


function forththrow() {
   if (tos != 0)  {
      throwerror(tos) ;
   } else {
      tos = s[sp--] ;
   }
}
var x_throw = primitive("throw",forththrow) ;
describe("n --",ans|jsf|f83) ;


function forthnewerror() {
   if (tos<0)  {
      systemerror[-tos] = pack(s[sp-1],s[sp]) ;
   } else {
      customerror[tos] = pack(s[sp-1],s[sp]) ;
   }
   sp -= 2 ;
   tos = s[sp--] ;
}
primitive("newerror",forthnewerror) ;
describe("a n1 n2 --",jsf) ;







// =================================================================================================
//                                       run time words
// =================================================================================================


definitions(hidden) ;
function forthdolit()      { s[++sp]=tos ; tos=m[ip++] ; } 
var x_lit=primitive("(lit)",forthdolit) ;


function forthbrsquote()  { s[++sp]=tos ; tos=m[ip++] ; s[++sp]=ip ; ip+=tos ; }
var x_brsquote=primitive('(s")',forthbrsquote) ;


function forthbrcquote()  { s[++sp]=tos ; tos=ip++ ; ip += m[tos] }
var x_brcquote=primitive('(c")',forthbrcquote) ;



function forthbrdotquote()  { 
   forthbrsquote() ;
    forthpack() ;
    type(tos) ;
    tos=s[sp--] ;
 }
var x_brdotquote=primitive('(.")',forthbrdotquote) ;



function forthdovar()      { s[++sp] = tos ; tos = ++w ; }
var x_dovar=primitive("(var)",forthdovar) ;


function forthdoconst()    { s[++sp]=tos ; tos=m[++w] ; }
var x_doconst = primitive("(const)",forthdoconst) ;
var x_dovalue = primitive("(value)",forthdoconst) ;

function forthdofconst()    { f.push(ftos) ; ; ftos = m[++w] ; }
var x_dofconst = primitive("(fconst)",forthdofconst) ;


// function forthdodefer()    { ip=++w ; }


// branch 1  works as nop,  branch -1 is infinite loop
function forthbranch()     { ip+=m[ip] ; }
var x_branch=primitive("(branch)",forthbranch) ;


function forth0branch()   { 
   if (tos)  { 
      ip++ ;
   } else    {
      ip+=m[ip] ;
   }
   tos=s[sp--] ;
 }
var x_0branch=primitive("(0branch)",forth0branch) ;


function forthwarminit() {      // not for interactive use
    tos     = r[rp] ; rp = 0 ; r[rp+1] = 0 ; r[rp] = tos ;
    tos     = 0     ; sp = 0 ; s[sp+1] = 0 ; s[sp] = tos ;
    ftos    = 0 ;
    for ( ; f.length ; f.pop() ) ;
    catchframe = 0 ;
    m[state] = 0 ;
    m[innerloop] = 0 ;
    m[innercase] = 0 ;
    m[blk] = -1 ;
    m[outfile] = -1 ;
    for ( ; inbuf.length ; inbuf.pop() ) ;
  }
var x_warminit = primitive("warminit",forthwarminit) ;




function forthcoldinit() {                                        // not for interactive use
    window.onerror = ErrorEvent ;
    window.onwarning = ErrorEvent ;
    window.offscreenBuffering = false ;
    for ( ; sourceid.length ; sourceid.pop() ) ;
    for ( ; nextvocabulary>lastsystemvocabulary ; nextvocabulary>>=1 )  vocname.pop()  ;

    dp = dp_cold ;
    wc = wc_cold ;
    heapend = heap_cold ;

    for ( ; usedchunk.length; usedchunk.pop()) ;
    nusedchunks = 0 ;
    for ( ; i=freechunk.length ; freechunk.pop() ) ;
    nfreechunks = 0 ;

    for (i=0 ; i<maxbufs ; i++  )  {                              // for each buffer:
       buf[i] = jshiallot0(1024) ;                                // allocate and initialize buffer
       info("buffer " + i + " allocated at addr " + buf[i]) ; 
       bufdirty[i] = 0 ;                                          //  set flushed
       bufblk[i] = -1 ;                                           //  contains no block
    }
    for (i=0 ; i<capacity() ; blockstat[i++] = -1 ) ;             // mark all blocks unbuffered

    coldstartinfo() ;
    m[base] = 10 ;

    forthonly() ;
    forthforth() ;
    forthalso() ;
    m[current] = forth ;

    forthwarminit() ;
  }
var x_coldinit = primitive("coldinit",forthcoldinit) ;




function forthbrabortquote()   {
   if (tos)   {
      forthbrsquote() ;
      forthpack() ;
      systemerror[2] = tos ;
      throwerror(-2) ; 
   } else {
      tos = s[sp--] ;
      ip += m[ip]+1 ;
   }
}
var x_brabortquote = primitive('(abort")',forthbrabortquote) ;


function forthbrto()  {
    m[m[ip++]] = tos ;
    tos = s[sp--] ;
}
var x_brto = primitive("(to)",forthbrto) ;



// --- not portable: output packed string literal ---
function jsdotquote() { type(m[ip++])} ;
var dotquote = primitive("",jsdotquote) ;









// =================================================================================================
//                                        stack operators
// =================================================================================================

definitions(forth) ;

function forthdup()      { s[++sp] = tos ; }                     // dup
var x_dup=primitive("dup",forthdup) ;
describe("x -- x x",any|foerthchen) ;


function forthqdup()     { if (tos) s[++sp]=tos ; }              // ?dup
var x_qdup=primitive("?dup",forthqdup) ;
describe("x -- 0 | x x",any) ;


function forthdrop()     { tos = s[sp--] ; }                     // drop
var x_drop=primitive("drop",forthdrop) ;
describe("x --",any|foerthchen) ;


function forthswap()     { w = s[sp] ; s[sp] = tos ; tos = w ; } // swap
var x_swap=primitive("swap",forthswap) ;
describe("x1 x2 -- x2 x1",any|foerthchen) ;


function forthover()     { s[++sp]= tos ; tos=s[sp-1] ; }        // over
var x_over=primitive("over",forthover) ;
describe("x1 x2 -- x1 x2 x1",any) ;


function forthrot()     {                                        // rot
   w = s[sp] ;
   s[sp] = tos ;
   tos = s[sp-1] ;
   s[sp-1] = w ;
}
var x_rot = primitive("rot",forthrot) ;
describe("x1 x2 x3 -- x2 x3 x1",any) ;


function forthminrot()     {                                     // -rot
   w = s[sp-1] ;
   s[sp-1] = tos ;
   tos = s[sp] ;
   s[sp] = w ;
}
primitive("-rot",forthminrot) ;
describe("x1 x2 x3 -- x3 x1 x2",jsf) ;


function forthtuck()   { w = s[sp] ; s[sp] = tos ; s[++sp] = w ; }
var x_tuck = primitive("tuck",forthtuck) ;                       // tuck
describe("x1 x2 -- x2 x1 x2",ans|jsf) ;


function forthnip()      { sp-- ; }                              // nip
var x_nip=primitive("nip",forthnip) ;
describe("x1 x2 -- x2",ans|jsf) ;


function forth2dup()   { s[++sp]=tos ; s[++sp]=s[sp-2] ; }       // 2dup
var x_2dup=primitive("2dup",forth2dup) ;
describe("x1 x2 -- x1 x2 x1 x2",any) ;


function forth2drop()  { sp-- ; tos=s[sp--] ; }                  // 2drop
var x_2drop=primitive("2drop",forth2drop) ;
describe("x1 x2 --",any) ;


function forth2swap()  {                                         // 2swap
   w       = s[sp-1] ;
   s[sp-1] = tos ;
   tos     = w ;
   w       = s[sp-2] ;
   s[sp-2] = s[sp] ;
   s[sp]   = w ;
}
primitive("2swap",forth2swap) ;
describe("x1 x2 x3 x4 -- x3 x4 x1 x2",any) ;


function forth2over()  {                                         // 2over
   s[++sp] = tos ;
   tos     = s[sp-3] ;
   s[++sp] = tos ;
   tos     = s[sp-3] ;
}
primitive("2over",forth2over) ;
describe("x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2",any) ;


function forthmin()   { tos = Math.min(s[sp--],tos) }            // min
var x_min = primitive("min",forthmin) ;
describe("n1 n2 -- n3",any)


function forthmax()   { tos = Math.max(s[sp--],tos) }            // max
primitive("max",forthmax) ;
describe("n1 n2 -- n3",any)


function forthtor()      { r[++rp] = tos ; tos = s[sp--] ; }     // >r
var x_tor=primitive(">r",forthtor) ;
describe("x --",any|foerthchen)


function forthrfrom()    { s[++sp] = tos ; tos = r[rp--] ; }     // r>
var x_rfrom=primitive("r>",forthrfrom) ;
describe("-- x",any|foerthchen)


function forthrfetch()   { s[++sp] = tos ; tos = r[rp] ; }       // r@
var x_rfetch=primitive("r@",forthrfetch) ;
describe("-- x",any)


function forthrdrop()    { rp-- ; }                              // rdrop
var x_rdrop=primitive("rdrop",forthrdrop) ;
describe("-- x",jsf)



function forth2tor()     {                                       // 2>r
    r[++rp] = s[sp--] ;
    r[++rp] = tos ;
    tos = s[sp--] ;
}
var x_2tor=primitive("2>r",forth2tor) ;
describe("x1 x2 --",ans|jsf|uncertain)



function forth2rfrom()   {                                       // 2r>
   s[++sp] = tos ;
   tos = r[rp--] ;
   s[++sp] = r[rp--] ;
}
var x_2rfrom=primitive("2r>",forth2rfrom) ;
describe("-- x1 x2",ans|jsf|uncertain)



function forth2rfetch()   {                                      // 2r@
   s[++sp] = tos ;
   tos = r[rp] ;
   s[++sp] = r[rp-1] ;
}
var x_2rfetch=primitive("2r@",forth2rfetch) ;
describe("-- x1 x2",ans|jsf|uncertain)



function forthdepth()    { s[++sp]=tos ; tos=sp-1 ; }            // depth
var x_depth=primitive("depth",forthdepth) ;
describe("-- n",ans|f83|jsf|uncertain) ;



function forthpick()  { tos = s[sp-tos] ; }                      // pick
primitive("pick",forthpick) ;
describe("xu ... x1 x0 u -- xu ... x1 x0 xu",any) ;



function forthroll()  {                                          // roll
   w = s[sp-tos] ;
   for ( ; tos ; --tos )  s[sp-tos] = s[sp-tos+1] ;
   sp-- ;
   tos = w
}
primitive("roll",forthroll) ;
describe("xu xu-1 ... x0 u -- xu-1 ... x0 xu",any) ;









// =================================================================================================
//                                        memory operators
// =================================================================================================


function forthfetch()    { tos = m[tos] ; }                      // @
var x_fetch=primitive("@",forthfetch) ;
describe("a -- x",any|foerthchen) ;


function forthstore()    { m[tos] = s[sp--] ; tos = s[sp--] ; }  // !
var x_store=primitive("!",forthstore) ;
describe("x a --",any|foerthchen) ;


function forth2fetch()    { s[++sp] = m[tos+1] ; tos = m[tos] ; } // 2@
var x_2fetch=primitive("2@",forth2fetch) ;
describe("a -- d",any) ;


function forth2store()    {                                      // 2!
   m[tos++] = s[sp--] ; 
   m[tos] = s[sp--] ; 
   tos = s[sp--] ;
}
var x_2store=primitive("2!",forth2store) ;
describe("d a --",any) ;


function forthcfetch()   { tos = m[tos]&255 ; }                  // c@
var x_cfetch=primitive("c@",forthcfetch) ;
describe("a -- c",any) ;


function forthcstore()   { m[tos] = s[sp--]&255 ; tos = s[sp--] ; } // c!
var x_cstore=primitive("c!",forthcstore) ;
describe("c a --",any) ;


function forthcount()    { s[++sp]=tos+1 ; tos=m[tos]&255 ; }     // count
var x_count=primitive("count",forthcount) ;
describe("a1 -- a2 c",any) ; 


function forthskim()     { s[++sp]=tos+1 ; tos=m[tos] ; }        // skim
var x_skim=primitive("skim",forthskim) ;
describe("a1 -- a2 x",jsf) ; 


function forthexchange() { w = m[tos] ; m[tos] = s[sp--] ; tos = w ; }  // exchange
var x_exchange=primitive("exchange",forthexchange) ;
describe("x1 a -- x2",jsf) ; 


function forthon()  { m[tos] = -1 ; tos = s[sp--] ; }            // on
primitive("on",forthon) ;
describe("a --",jsf) ;


function forthoff()  { m[tos] = 0 ; tos = s[sp--] ; }            // off
var x_off = primitive("off",forthoff) ;
describe("a --",jsf) ;


function forthfill()     {                                       // fill
   i = s[sp--]   ;
   var dest=s[sp--]
   for ( ; i ; i-- ) m[dest++]=tos ;
   tos = s[sp--] ;
}
var x_fill=primitive("fill",forthfill) ;
describe("a u c --",any) ; 


function fortherase()    { s[++sp] = tos ; tos = 0 ; forthfill() ; }
primitive("erase",fortherase) ;
describe("a u --",any) ;


function forthslashstring()  {                                   //  /string
   w = tos ;
   tos = s[sp--] ;
   if ( tos < w ) w = tos ;
   s[sp] += w ;
   tos -= w ;
}
var x_slashstring=primitive("/string",forthslashstring) ;
describe("a1 n1 u -- a2 n2",ans|jsf|uncertain) ; 



function noop()  { }    

primitive("align",noop|immediate) ;                                 // align
describe("--",ans|jsf) ;


primitive("aligned",noop|immediate) ;                               // aligned
describe("a1 -- a2",ans|jsf) 


function forthpad()   { s[++sp] = tos ; tos = dp + paddistance ; }
primitive("pad",forthpad) ;                                         // pad
describe("-- a",any) ;







// =================================================================================================
//                                               i/o
// =================================================================================================







var x_cr=primitive("cr",cr) ;                                    // cr
describe("--",any) ;




definitions(forth) ;

function forthspaces()   {                                       // spaces
   for ( ; tos>linelen ; tos-=linelen )  type(lineofspaces) ;
   type(lineofspaces.substring(0,tos)) ;
   tos = s[sp--] ;
}
var x_spaces=primitive("spaces",forthspaces) ;
describe("n --",any) ;



definitions(hidden) ;


// --- messages written to info screen ---
function coldstartinfo() {
    clsinfo();
    seperator();
    info("COLD START");
    seperator();
    info("this window is output only.");
    info("terminal size has been set to " + linelen + "x" + lines +".") ;
    info("heap is at addr " + heapend) ;
    info("blocks 0 .. " + (cookiedrivecapacity()-1) + " mapped to cookiedrive.") ;
    info("blocks " + cookiedrivecapacity() + " .. " +  (cookiedrivecapacity() + ramdrivecapacity() - 1) + " mapped to ramdrive.") ;
    info("blocks " + localcapacity() + " .. " + (capacity()-1) + " mapped to webdrive (read/only)") ; 
    seperator();
    info(cookiedrivecapacity() + " LOAD      to add more block words, like LS W") ; 
    seperator();
    info("Next steps work with \"best viewed with\" browsers only:");
    info("21 LOAD   loads the decompiler SEE"); 
    info("Use it like SEE word, some words are in the HIDDEN voc"); 
    
    seperator();
}




// --- messages written to dialog screen ---
function center(string)  {  type(lineofspaces.substring(0,Math.max((linelen - string.length),0)/2) + string ) ; }
function forthhello()    {                                       // hello
   var home = -1 ;
          center("================================================================================");
   cr() ; center(title) ; 
   cr() ; center("This program is published under the GPL.");
   cr() ; center("To read the licence, type GPL <enter>")
   cr() ; center("================================================================================");
   cr() ; type("  ok");
}  

var x_hello=primitive("hello",forthhello) ;
describe("--",jsf) ;



definitions(forth) ;
function forthspace()    { type(" ") ; }                         // space
var x_space=primitive("space",forthspace) ;
describe("--",any) ;





function forthemit()      { emit(tos) ; tos = s[sp--] ; }        // emit
var x_emit=primitive("emit",forthemit) ;
describe("c --",any|foerthchen) ;



function forthtype()     {                                       // type
   forthpack() ;
   type(tos) ;
   tos = s[sp--] ;
}
var x_type=primitive("type",forthtype) ;
describe("--",any) ;



var x_page= primitive("page",cls) ;                              // page
describe("--",ans|f83|jsf) ;



primitive("cls",cls) ;
describe("--",jsf) ;


function forthprompt()   {                                       // prompt
   if (m[state])   {
      cr() ; type("|  ") ;
   } else {
      type(" ok") ;
      if (sp>0) {
          for ( var i=Math.min(sp,16) ; i ; i-- )  type(".") ;
      }
      cr();
   }
}
var x_prompt=primitive("prompt",forthprompt) ;
describe("--",any) ;



function forthdots()  {                                          // .s
   s[++sp] = tos;
   for (var i=1 ; i < sp ; type(s[++i].toString(m[base]) + " ")) ;
   sp-- ;
}
var x_dots = primitive(".s",forthdots) ;
describe("--",any) ;







// read string, delimited by c. return address and len
// updates source

function forthparse()  {                                          // parse
   var delimiter = tos ;
   w = m[toin] + parsebuf ;                    //  parse address
   var bufend = parsebuf + parsebuflen ;
   var nxtchar = m[w] ;
   if (delimiter == bl) {
      for ( ; w < bufend ; )  {
         if (nxtchar != delimiter) break ;
         nxtchar = m[++w] ;
      }
   }
   s[++sp] = w ;
   for ( ; w < bufend; ) {
      nxtchar = m[w] ;
      if (nxtchar == delimiter)   break ;
      w++ ;
   }
   tos = w - s[sp] ;
   if (nxtchar == delimiter) w++ ;
   m[toin] = w - parsebuf  ;
}
var x_parse = primitive("parse",forthparse) ;
describe("c -- a n",ans|jsf) ;






definitions(hidden) ;

// key and key?  come in two parts:
//  part 1 signals to virtual machine to stop execution,
//  part 2 will be executed after the input event occured
// the high level key and key? word call both parts, and, at the
// same time, provide the after-event reentry point.

function forthkey1()    { if (!inbuf.length)  suspended = w ; }
var x_key1 = primitive("key1",forthkey1) ;
describe("--",jsf)

function forthkey2()    { s[++sp] = tos ;  tos = inbuf.shift() ; }
var x_key2 = primitive("key2",forthkey2) ;
describe("-- c",jsf)




function forthkey1query()    {
   if (!inbuf.length)  {                                    // key buffered - no need for event
      suspended = w ;                                       // stop interpreter shortly to allow possible key event
      setTimeout(virtualmachine,0,ip) ;                     // restart short time later 
   }
}
var x_key1query = primitive("key1?",forthkey1query) ;
describe("--",jsf)


function forthkey2query()    {
   s[++sp] = tos ;
   tos = 0 ;                                                // assume "no key"
   if (inbuf.length) tos-- ;                                // flag "key available"
}
var x_key2query = primitive("key2?",forthkey2query) ;
describe("-- f",jsf)






// ( bufaddr editaddr nkeys ascii -- bufaddr editaddr nkeys )
function forthacceptprintable()  { 
   w = tos ;
   tos = s[sp--] ;        // w:asc,  tos:n keys to go, s[sp]:editing address, s[sp-1]: buffer start 
   if (tos>1)  {
      m[s[sp]] = w ;
      emit(w) ;           // echo one char
      s[sp]++ ;
      tos-- ;
   }
}




// ( bufaddr editaddr nkeys ascii -- bufaddr editaddr nkeys )
function forthacceptescape()     { 
   tos = s[sp--] ;        // tos:n keys to go, s[sp]:editing address, s[sp-1]: buffer start 
   tos += (s[sp] - s[sp-1]) ;
   backspaces(s[sp]-s[sp-1]) ;
   s[sp] = s[sp-1] ;
 }




// ( bufaddr editaddr nkeys ascii -- bufaddr editaddr nkeys )
// attempt internet explorer workaround
function forthacceptbackspace()  {
   tos = s[sp--]
   if (s[sp] > s[sp-1]) {
      tos++ ;
      s[sp]-- ;
      backspaces(1);
   }
}




function forthacceptreturn()       { sp-- ; tos = 0 }
function forthaccepttab()          { tos=bl ; forthacceptprintable() ; }



// ( bufaddr editaddr nkeys ascii -- bufaddr editaddr nkeys )
function forthacceptcontrolchar(ctrlchar)  {
   if (ctrlchar == esc)            { forthacceptescape()    ; return ; }
   if (ctrlchar == backspace)      { forthacceptbackspace() ; return ; }
   if (ctrlchar == 17)             { forthacceptbackspace() ; return ; }  // ctrl-q for IE
   if (ctrlchar == carriagereturn) { forthacceptreturn()    ; return ; }
   if (ctrlchar == tab)            { forthaccepttab()       ; return ; }
   tos = s[sp--] ;
}






function forthdecode()  {         // ( bufaddr editaddr nkeys ascii -- bufaddr editaddr nkeys )
   if (tos<bl)  {
       forthacceptcontrolchar(tos) ;
   } else {
   forthacceptprintable(tos) ;
   }
   debug(s[sp-1] + " " + s[sp] + " " + tos) ;
}
var x_decode = primitive("decode",forthdecode) ;
describe("a1 a2 n1 c -- a1 a3 n2 f",jsf)



definitions(forth) ;

function forthfast() {  m[outfile] = -1 ; }  ; primitive("fast",forthfast) ;
describe("--",jsf) ;
function forthslow() {  m[outfile] = -2 ; }  ; primitive("slow",forthslow) ;
describe("--",jsf) ;







function forthsource()  {
   s[++sp] = tos ;
   s[++sp] = parsebuf ;
   tos = parsebuflen ;
}
var x_source = primitive("source",forthsource) ;
describe("-- a n",any) ;



function forthstoresource()  {
   parsebuflen = tos ;
   parsebuf = s[sp--]   ;
   tos = s[sp--] ;
//   m[toin] = 0 ;
}
var x_storesource = primitive("!source",forthstoresource) ;
describe("a n --",jsf) ;



definitions(hidden) ;

function forthpushsource()  { sourceid.push(m[toin],parsebuf,parsebuflen) ; }
var x_pushsource = primitive("pushsource",forthpushsource) ;





function forthpopsource()  {
   parsebuflen = sourceid.pop() ;
   parsebuf    = sourceid.pop() ;
   m[toin]     = sourceid.pop() ;
}
var x_popsource = primitive("popsource",forthpopsource) ;








// ------------- cookies ------------

var translatedchar = new Array() ;       // each ascii requiring translation flags it here

for (i=0 ; i<256 ; i++)  translatedchar[i] = "" ;              // assume no translation required

translatedchar[0]  = "A" ;
translatedchar[9]  = "B" ;
translatedchar[10] = "C" ;
translatedchar[13] = "D" ;
translatedchar[32] = "E" ;
translatedchar[37] = "F" ;
translatedchar[59] = "G" ;

var translatechar = new Array(0,9,10,13,32,37,59) ;
 


function encoded(text)  {
   var result = "" ;
   var asc;
   for (i=0 ; i<text.length ; i++) {
      asc = text.charCodeAt(i) ;
      if (translatedchar[asc])  {
         result += ("%" + translatedchar[asc]) ;
      } else {
         result += text.charAt(i) ;
      }
   }
   return result ;
}




function decoded(text)  {
   var result = "" ;
   var asc;
   for (i=0; i<text.length ; i++)  {
      asc = text.charAt(i) ;
      if (asc == "%")  asc = String.fromCharCode(translatechar[text.charCodeAt(++i) - 65]) ;
      result += asc ;
   }
   return result ;
}






function setcookie(name, value, domain, expires, path, secure)  {
   var cook = name + "=" + encoded(value.substr(0,2048)) ;
   cook += (domain)  ? "; domain="  + domain  : "" ;
   cook += (expires) ? "; expires=" + expires : "" ;
   cook += (path)    ? "; path="    + domain  : "" ;
   cook += (secure)  ? "; secure="  + domain  : "" ;
   document.cookie = cook ;
}




function readcookie(name)  {
   var cookiebegin = document.cookie.indexOf(name + "=") ;
   if (cookiebegin == -1) return null ;
   var temp = document.cookie.substr(cookiebegin + name.length + 1) ;
   var cookieend = temp.indexOf(";") ;
   if (cookieend != -1)  return decoded(temp.substr(0,cookieend)) ;
   return decoded(temp) ;
}  





definitions(forth) ;


function forthsetcookie()  {
   setcookie((pack(s[sp-2],s[sp-1])),(pack(s[sp],tos))) ;
   sp -= 3 ;
   tos = s[sp--]
}
primitive("cookie!",forthsetcookie) ;
describe("a1 n1 a2 n2 --",jsf) ;




function forthreadcookie() {
   w = readcookie(pack(s[sp-1], s[sp])) ;
   if (w)  {
      s[--sp] = w ;
      unpack() ;
   } else {
      throwerror(-70) ;
   }
}
primitive("cookie@",forthreadcookie) ;
describe("a1 n1 a2 -- n2",jsf) ;





// =================================================================================================
//                                          arithmetics
// =================================================================================================

definitions(forth) ;


function forth1plus()     { tos++ ; }                                // 1+
var x_1plus=primitive("1+",forth1plus) ;
describe("x -- x+1",ans|f83|jsf) ;
primitive("cell+",forth1plus) ;                                      // cell+
describe("x -- x+cell",ans|f83|jsf) ;
primitive("char+",forth1plus) ;                                      // char+
describe("x -- x+char",ans|jsf) ;


function forth1minus()     { tos-- ; }                               // 1-
var x_1minus=primitive("1-",forth1minus) ;
describe("x -- x-1",any) ;
primitive("cell-",forth1minus) ;                                     // cell-
describe("x -- x-cell",ans|f83|jsf) ;


function forth2mul()     { tos <<= 1 ; }                             // 2*
var x_2mul=primitive("2*",forth2mul) ;
describe("x1 -- x2",any) ;


function forth2div()     { tos >>= 1 ; }                             // 2/
var x_2div=primitive("2/",forth2div) ;
describe("n1 -- n2",any) ;


function forthplus()     { tos += s[sp--] ; }                        // +


var x_plus=primitive("+",forthplus) ;
describe("x1 x2 -- x1+x2",any|foerthchen) ;


function forthminus()    { tos = s[sp--] - tos ; }                   // -
var x_minus=primitive("-",forthminus) ;
describe("x1 x2 -- x1-x2",any) ;


function forthmul()      { tos = (tos*s[sp--]) & 0xffffffff ; }      // *
var x_mul=primitive("*",forthmul) ;
describe("x1 x2 -- x1*x2",any|foerthchen) ;


var floorfix = 1 - 1e-16 ;
function forthdiv()      {                                           // /
   if (tos)  {
      tos = s[sp--] / tos ;
      if (tos<0)  tos += floorfix ;
      tos = Math.floor(tos) ;
      return ;
   }
   throwerror(-10) ;
}
var x_div=primitive("/",forthdiv)
describe("x1 x2 -- x1/x2",any) ;


function forthstarslash() {                                          // */
   if (tos) {
      tos = (s[sp--] * s[sp--]) / tos;
      if (tos<0)  tos += floorfix ;
      tos = Math.floor(tos) ;
      return ;
   }
   throwerror(-10) ;
}
var x_starslash = primitive("*/",forthstarslash) ;
describe("x1 x2 x3 -- x1*x2/x3",any) ;


function forthmod()      {                                           // mod
   if (tos)  {
      tos= (s[sp--] % tos) ;
      return ;
   }
   throwerror(-10) ;
}
var x_mod=primitive("mod",forthmod) ;
describe("x1 x2 -- x3",any) ;


function forthslashmod()      {                                      // /mod
   if (tos)  {
      w = s[sp] % tos ;
      tos = s[sp] / tos ;
      if (tos<0)  tos += floorfix ;
      tos = Math.floor(tos) ;
      s[sp] = w ;
      return ;
   }
   throwerror(-10) ;
}
var x_slashmod = primitive("/mod",forthslashmod) ;
describe("x1 x2 -- x3 x4",any|foerthchen) ;


function forthstarslashmod()      {                                  // */mod
   if (tos)  {
      w = s[sp--] * s[sp] ;
      s[sp] = w % tos ; 
      tos = w / tos ;
      if (tos<0)  tos += floorfix ;
      tos = Math.floor(tos) ;
      return ;
   }
   throwerror(-10) ;
}
var x_starslashmod = primitive("*/mod",forthstarslashmod) ;
describe("x1 x2 x3 -- x4 x5",any) ;


function forthnegate()   { tos= -tos ; }                             // negate
var x_negate=primitive("negate",forthnegate) ;
describe("n -- -n",any) ;


function forthabs()   { tos = Math.abs(tos) ; }                      // abs
var x_abs=primitive("abs",forthabs) ;
describe("n -- u",any) ;


function forthlshift()     { 
   if (tos>31) {
      tos=0;
      sp--;
   } else {
      tos = s[sp--] << tos;                 // lshift
   }
}
var x_lshift = primitive("lshift",forthlshift) ;
describe("x1 u --x2",ans|f83|jsf) ;
primitive("<<",forthlshift) ;
describe("x1 u -- x2",jsf) ;


function forthrshift()     { 
   if (tos>31) {
      tos=0;
      sp--;
   } else {
      tos = s[sp--] >>> tos ;               // rshift
   }
}
var x_rshift = primitive("rshift",forthrshift) ;
describe("u1 u2 -- x3",ans|f83|jsf) ;
primitive(">>",forthrshift) ;
describe("u1 u2 -- u3",jsf) ;


function forthplusstore()   { m[tos]+=s[sp--] ; tos=s[sp--] ; }      // +!
var x_plusstore=primitive("+!",forthplusstore) ;
describe("x a --",any) ;


primitive("cells",noop,immediate)
describe("x1 -- x2",ans|f83|jsf) ;


primitive("chars",noop,immediate)                                    // chars
describe("x1 -- x2",ans|jsf) ;


function forthrange()  {
   var temp = tos ;
   tos = s[sp] ;
   s[sp] += temp ;
}
var x_range = primitive("range",forthrange) ;
describe("x n -- x+n x",ans|jsf|f83) ; 




// ----- double and mixed len math -----


function forthstod()  {                                              // s>d
   s[++sp] = tos ;
   tos &= 0x80000000 ;
   if (tos)   tos = -1 ;
}
var x_stod = primitive("s>d",forthstod) ;
describe("x -- d",any) ;



function forthdnegate()  {                                           // dnegate
   tos = -tos
   s[sp] = -(s[sp]) ;
   if (s[sp])  tos-- ;
}
primitive("dnegate",forthdnegate) ;
describe("d1 -- -d1",any) ;



function forthdabs()  {                                              // dabs
   if (tos<0) {
      tos = -tos
      s[sp] = -(s[sp]) ;
      if (s[sp])  tos--;
   }
}
var x_dabs = primitive("dabs",forthdabs)
describe("d -- ud",any) ;



function forthdplus()  {                                             // d+
   if (tos<0) tos += 0x100000000 ; 
   var low2 = s[sp--] ; if (low2<0)  low2 += 0x100000000 ;
   var high1 = s[sp--] ; if (high1<0) high1 += 0x100000000 ;
   var low1 = s[sp]   ; if (low1<0)  low1 += 0x100000000 ;
   tos += high1 ;
   w = low1+low2 ;
   if (w > 0x100000000) {     // detect carry 
      w &= 0xffffffff ;
      tos++ ;                 // apply carry
   }
   s[sp] = w ;
   tos &= 0xffffffff ;
}
var x_dplus = primitive("d+",forthdplus)
describe("d1 d2 -- d1+d2",any) ;




function forthummul()  {     // ( u1 u2 -- ud )                       // um*
   var resultlo = 0 ;
   var resulthi = 0 ;
   var temp = s[sp] ;
   for ( var i=32 ; i ; --i )  {
      resulthi <<= 1 ;
      if (resultlo & 0x80000000)  resulthi++ ;
      resultlo <<= 1 ;
      if (tos & 0x80000000)  { 
         if ((resultlo + temp) > 0xffffffff)  resulthi++ ;
         resultlo += temp ;
      }
      tos <<= 1 ;
   }
   s[sp] = resultlo ;
   tos = resulthi ;
}
var x_ummul = primitive("um*",forthummul)
describe("n1 n2 -- ud",any) ;




function forthmmul()  {                                              // m*
   var temp = ((tos<0) ^ (s[sp]<0)) ;
   tos = Math.abs(tos) ;
   s[sp] = Math.abs(s[sp]) ;
   forthummul() ;
   if (temp)  forthdnegate() ;
}
var x_mmul = primitive("m*",forthmmul)
describe("n1 n2 -- d",any) ;




function forthdless()  {                                             // d<
   w = tos ;
   tos = 0 ;
   if (s[sp-1] < w)  {
      tos = -1 ;
   } else {
      if (s[sp-1] == w)  {
         if (s[sp-2] < s[sp])  tos = -1 ;
      }
   }
   sp -= 3 ;
}
primitive("d<",forthdless) ;
describe("d1 d2 -- f",any) ;



function forthdequ()  {                                                 // d=
  tos = -((tos == s[sp-1]) & (s[sp] == s[sp-2]))  
   sp -= 3 ;
}
primitive("d=",forthdequ) ;
describe("d1 d2 -- f",any) ;







function forthumslashmod()  {    //    ( d u1 -- u2 u3 )
// skip leading zeroes  (not done)
// shift-and-subtract division
// tos = divisor

   var quotient = 0 ;
   var remainder  = 0 ;                                      // portion of divident         
   var divbit = 0 ;
   if (tos)  {                                               // hi part not 0 ?
      divbit = 0x80000000 ;
      for ( ; divbit ; divbit>>>=1 )  {                      // skip trailinz zeroes
         if ((tos & divbit) == 0)   break;                   // "late in" in contrast to "early out"
      }
   }
   for (var j=2 ; j ; j--)  {                                // crunch 2x 32 bit
      var divident = s[sp--] ;                               // next divident portion        
      for ( ; divbit ; divbit>>>=1)  { 
         remainder <<= 1 ;
         if (divident & divbit) remainder++ ;
         quotient<<=1 ;
         if (remainder>=tos)  {
            remainder-=tos ;
            quotient++ 
         }
      }
   divbit = 0x80000000 ;
   }
   tos = quotient ;
   s[++sp] = remainder ;
}
primitive("um/mod",forthumslashmod) ;
describe("d u1 -- u2 u3",any) ; 



function forthudslashmod()  {    //    ( d1 u1 -- u2 d2 ) 
   w = tos ;
   s[++sp] = 0 ;
   forthumslashmod() ;
   s[++sp] = w ;
   w = tos ;
   tos = s[sp--] ;
   forthumslashmod() ;
   s[++sp] = tos ;
   tos = w ;
}
var x_udslashmod = primitive("ud/mod",forthudslashmod) ;
describe("d1 u1 -- u2 d2",jsf) ; 





// =================================================================================================
//                                               bool
// =================================================================================================


definitions(forth) ;

function forthor()       { tos |= s[sp--] ; }                        // or
var x_or = primitive("or",forthor) ;
describe("x1 x2 -- x3",any|foerthchen) ;


function forthand()      { tos &= s[sp--] ; }                        // and
var x_and = primitive("and",forthand) ;
describe("x1 x2 -- x3",any|foerthchen) ;


function forthxor()      { tos ^= s[sp--] ; }                        // xor
primitive("xor",forthxor) ;
describe("x1 x2 -- x3",any|foerthchen) ;


function forthinvert()   { tos ^= -1 ; }                             // invert
primitive("invert",forthinvert) ;
describe("x1 -- x2",ans|jsf) ;


primitive("not",forthinvert) ;                                       // not
describe("x1 -- x2",fig|f79) ;







// =================================================================================================
//                                              logic
// =================================================================================================
function forthequ()        { tos = -(tos == s[sp--]) ; }             // = 
var x_equ = primitive("=",forthequ) ;
describe("x1 x2 -- f",any) ;


function forthnequ()       { tos = -(tos != s[sp--]) ; }             // <>
var x_nequ = primitive("<>",forthnequ) ;
describe("x1 x2 -- f",any) ;


function forthmore()        { tos = -(tos < s[sp--]) ; }             // >
var x_more = primitive(">",forthmore) ;
describe("n1 n2 -- f",any) ;


function forthless()        { tos = -(tos > s[sp--]) ; }             // < 
var x_less = primitive("<",forthless) ;
describe("n1 n2 -- f",any) ;


function forth0equ()     { tos = -(tos == 0) ;  }                    // 0= 
var x_0equ = primitive("0=",forth0equ) ;
describe("x -- f",any) ;


function forth0nequ()     { tos = -(tos != 0) ;  }                   // 0<>
primitive("0<>",forth0nequ) ;
describe("x -- f",any) ;


function forth0less()     { tos = -(tos < 0) ;  }                    // 0<
var x_0less = primitive("0<",forth0less) ;
describe("n -- f",any) ;


function forth0greater()  { tos = -(tos > 0) ;  }                    // 0>
var x_0greater = primitive("0>",forth0greater) ;
describe("n -- f",any) ;



function forthuless()        {                                       // u< 
   w = s[sp--] ;
   if (tos<0)    tos += 0x100000000 ;
   if (w<0)      w   += 0x100000000 ;
   tos = -(w<tos) ;
}
primitive("u<",forthuless) ;
describe("u1 u2 -- f",any) ;


function forthumore()        {                                       // u> 
   w = s[sp--] ;
   if (tos<0)    tos += 0x100000000 ;
   if (w<0)      w   += 0x100000000 ;
   tos = -(w>tos) ;
}
primitive("u>",forthumore) ;
describe("u1 u2 -- f",any) ;




function forthwithin()  {       // ( x1 x2 x3 -- flag )              // within
   w = s[sp--] ;
   var temp = s[sp--] ;
   var temp2 = tos ; 
   tos = -1 ;
   if (w < temp2)  {
      if (w <= temp)  {
         if (temp < temp2)  return ;
      }
   }
   if (w > temp2)  {
      if (w <= temp)     return ;
      if (temp < temp2)  return ;
   }
   tos++ ;
}
primitive("within",forthwithin) ;
describe("x1 x2 x3 -- f",any) ;








// =================================================================================================
//                                    pictured number conversion
// =================================================================================================

// non standard stack: does currently not expect double, but single number 
// that's why further implementation has been postponed - need double math first.
// ( d -- d )

var picturedoutpos ;
var picturedoutlen ;

function forthlesshash()  {                                          // <#
   picturedoutpos = dp + paddistance ;
   picturedoutlen = 0 ;                                              // avoiding len calc allow to allot
}                                                                    // during pic num conv
var x_lesshash = primitive("<#",forthlesshash) ;  
describe("--",any) ;



function forthhold()  {
   m[--picturedoutpos] = tos ;
   picturedoutlen++ ;
   tos = s[sp--]  ;
}
var x_hold = primitive("hold",forthhold) ;  
describe("c --",any) ;



function forthsign()  {
   if (tos<0) {
      m[--picturedoutpos] = 45 ;
      picturedoutlen++ ;
   }
   tos = s[sp--]
}
var x_sign = primitive("sign",forthsign) ;  
describe("n --",any) ;




function forthhashmore()  {                                          // #>
   s[sp] = picturedoutpos ;
   tos = picturedoutlen ;
}                                                                    // during pic num conv
var x_hashmore = primitive("#>",forthhashmore) ;  
describe("-- a n",any) ;










// =================================================================================================
//                                               does>
// =================================================================================================

definitions(hidden) ;

// linkage code for word, created by defining word.
function dodoes()  {
   s[++sp] = tos  ;  tos = x[w] ;              // push words address of defined word
   r[++rp] = ip   ;                            // nest
   ip = m[tos++]  ;                            // set ip to does> part, and tos to body of defined word
   w = m[ip++]    ;  t[w]() ;                  // next                     
}



// compiled to end of create part by does>
// executed during execution of defining word 
function setdoes()  {                                                 // tos: xt of does> part
  m[x[wc]] = ip+1 ;                                                   // created word points to does> 
  t[wc] = dodoes ;                                                    // created word linkage code is dodoes
}
var x_setdoes = primitive("setdoes",setdoes) ;








// =================================================================================================
//                                             flow control
// =================================================================================================

definitions(hidden) ;


function forthbrfor()  {
   r[++rp]=tos ;
   r[++rp]=tos ; 
   ip++  ;
   tos=s[sp--] ;
}
var x_brfor=primitive("(for)",forthbrfor) ;


function forthbrnext() {
   r[rp]-- ;
   if (r[rp]) {
      ip+=m[ip] ;
   } else {
      ip++ ;
      rp-=2 ;
   }
}
var x_brnext=primitive("(next)",forthbrnext) ;


function forthbrdo()  {
   r[++rp]=s[sp--] ;
   r[++rp]=tos ;
   ip++  ;
   tos=s[sp--] ;
}
var x_brdo=primitive("(do)",forthbrdo) ;


function forthbrqdo() {
   if ( tos == s[sp] ) {
      sp-- ;
      ip+=m[ip] ;
   } else {
      r[++rp]=s[sp--] ;
      r[++rp]=tos ;
      ip++ ;
   }
   tos=s[sp--] ;
}
var x_brqdo=primitive("(?do)",forthbrqdo) ;



// fig/f79 leave
function forthbrleave79()    {  r[rp] = r[rp-1]-1 ; }
var x_brleave79 = primitive("(leave)",forthbrleave79) ;



// ans/f83 leave
function forthbrleave() {
   rp -= 2 ;
   ip = m[ip] ;
   ip += m[ip] ;
}
var x_brleave=primitive("(leave)",forthbrleave) ;




function forthbrqleave() {
   if (tos)  {
      rp -= 2 ;
      ip = m[ip] ;
      ip += m[ip] ;
   } else {
      ip++ ;
   }
   tos=s[sp--] ;
}
var x_brqleave=primitive("(?leave)",forthbrqleave) ;




function forthbrloop() {
   r[rp]++ ;
   if ( r[rp] != r[rp-1] )  {
      ip+=m[ip] ;
   } else {
      ip++ ;
      rp-=2 ;
   }
}
var x_brloop=primitive("(loop)",forthbrloop) ;
describe("--",jsf) ;
 


function forthbrplusloop()   {                         // (+loop)
   w = r[rp] - r[rp-1] ;
   r[rp] += tos ;
   tos=s[sp--] ;
   if (  (( r[rp] - r[rp-1]) ^ w ) > 0 )  {
      ip+=m[ip] ;
   }  else  {
      ip++  ;
      rp-=2 ;
   }
}
var x_brplusloop=primitive("(+loop)",forthbrplusloop) ;
describe("n --",jsf) ;




function forthbrunloop()  { rp-=2 ; }
var x_brunloop = primitive("(unloop)",forthbrunloop) ;
describe("--",jsf) ;




function forthbrof()   {                               // (of)
   w = tos ;
   tos = s[sp--] ;
   if (w == tos)  {
      tos = s[sp--]
      ip++
   } else {
      ip+=m[ip] ;
   }
}
var x_brof = primitive("(of)",forthbrof) ;
describe("x1 x2 -- x1 |",jsf) ;






definitions(forth) ;

function forthexecute()  { w=tos ; tos=s[sp--] ; t[w]() ; }
var x_execute = primitive("execute",forthexecute) ;
describe("xt --",any) ;


function forthperform()  { w=m[tos] ; tos=s[sp--] ; t[w]() ; }
var x_perform = primitive("perform",forthperform) ;
describe("a --",jsf) ;




function forthi() {  s[++sp]=tos  ;  tos=r[rp] ; }
var x_i=primitive("i",forthi) ;
describe("-- x",any) ;

 
function forthj() {  s[++sp]=tos  ;  tos=r[rp-2] ; }
var x_j=primitive("j",forthj) ;
describe("-- x",any) ;
 


definitions(hidden) ;

var controlflow     = new Array("","if",          "",    "begin",               "while", "do or ?do",     "for",  "case",    "of")
var controlflowwant = new Array("","else or then","then","while,until or again","repeat","loop or +loop", "next", "endcase", "endof")
function forthunstructured()  {
   systemerror[66] = "unstructured, missing " + controlflow[tos] + ", expected " + controlflowwant[s[sp]] ;
   throwerror(-66) ;
}
var x_unstructured = primitive("unstructured",forthunstructured) 





// =================================================================================================
//                                             strings
// =================================================================================================


definitions(forth) ;

function forthmove()   {                                  // move
   if ( s[sp] > s[sp+1] )  { 
      dest = s[sp--] + tos ;
      src = s[sp--] + tos ;
      for ( ; tos ; tos-- ) m[--dest] = m[--src] ;
   } else {   
      var dest = s[sp--] ;
      var src = s[sp--] ;
      for ( ; tos ; tos-- ) m[dest++] = m[src++] ;
   }
   tos = s[sp--] ;
}   
var x_move = primitive("move",forthmove) ;
describe("a1 a2 u --",any) ;

primitive("cmove",forthmove) ;
describe("a1 a2 u",any) ;



definitions(hidden) ;

function forthmovestr()   {        // ( a1 n a2 -- )      // move$
   w = s[sp] ;
   m[tos++] = w ;
   s[sp] = tos ;
   tos = w ;
   forthmove() ;
}
var x_movestr = primitive("move$",forthmovestr) ;
describe("a1 n a2 --",jsf) ;



definitions(forth) ;

function forthmintrailing()  {                           // a1 n1 -- a2 n2 )
   var temp = s[sp] + tos ;
   for ( i=tos ; i ; i-- )  {
      if (m[--temp] != 32)  break ;
      tos-- ;
   }
}
var x_mintrailing = primitive("-trailing",forthmintrailing) ;
describe("a1 u1 -- a2 u2",any) ;








// ----- number input conversion -----



function forthdigit()  {    // ( c -- u | -1 )
   tos -= 48 ;
   if ( tos > 9 )  {
      if ( tos < 17)  tos = -1 ;
      tos -= 7 ;
   }
   if ( tos > 41 )     tos -= 32 ;
   if ( tos >= 0)  {
      if  (tos < m[base]) return ;
   }
  tos = -1 ;
}
var x_digit = primitive("digit",forthdigit);
describe("c -- u|-1",jsf) ;



definitions(hidden) ;

function forthqsinglenumber()  {        // a n -- x -1 | 0 )
   var digit ;
   var  sign=0 ;
   var radix=m[base] ;
   i = tos ;                            // number of digits to test/convert
   tos = -1 ;                           // assume valid number     
   w = s[sp] ;                          // addr of next digit
   s[sp] = 0 ;                          // accumulator
   if ( m[w] == 45 ) {                  // leading -
      sign = -1 ;
      w++ ;                             // strip
      i-- ; 
   }
   for ( var i ; i ; i-- )  {           // for all digits
      digit = m[w++] - 48 ;             // read digit
      if ( digit == -2 )   info("no input support for floating point numbers yet") ;
      if ( digit > 9 )    {
         if ( digit < 17)  { tos = 0 ; break ; }
         digit -= 7 ;
      }
      if ( digit > 41 )    digit -= 32 ;
      if ( digit < 0 )     { tos = 0 ; break ; }
      if  (digit >= radix) { tos = 0 ; break ; }
      s[sp] *= radix ;                   
      s[sp] += digit ;
   }
   if (tos)  {
      if (sign)  s[sp] = -s[sp] ;
      s[sp] &= 0xffffffff ;
   }  else  {
      sp--  ;                           // drop string address
   }
}

// parseFloat(string) ;


function forthqnumber()  {        // a n -- x -1 | 0 )
   if (m[s[sp]+tos-1]==46) {
      info("no input support for double length numbers yet")
      sp-- ; tos=0 ;
   } else {
      forthqsinglenumber()  
   }
}
var x_qnumber = primitive("?number",forthqnumber) ;




function forthinterpretnumber()  {    // ( a n -- x -1 | d -1 | r -1 | -1 | 0 )
   forthqnumber() ;
   if (tos)  {
      if (m[state])  {
         m[dp++] = x_lit ;
         m[dp++] = s[sp--] ;
         tos = -1 ;
      }
   }
}
var x_interpretnumber = primitive("interpretnumber",forthinterpretnumber) ; 




// function forthinterpretnumber()
//    first char = - ?
//    if remember skip then
//    for all chars in string:
//       next char = digit ?
//      if accumulate
//      else
//        char = . ?
//        if
//           
//        else
//          otherlegalchars? none if NaN then
//        then
//      then
//    next
//    negate? 
//    state @ if
//      compile lit
//    then  ;



// =================================================================================================
//                                      dictionary, compiling
// =================================================================================================



definitions(forth) ;


// this has been speeded up a lot, by using an
// improvement suggested by TheBlueWizard.
function forthwords()  {                                          // words
   for (var i=wc; i; i--)  {
      if (h[i])  {
         if (m[context] & ds[i]) {
            if (m[compliance] & ds[i])  querytype(h[i]+" ") ;  
         }
      }
   }
}
var x_words = primitive("words",forthwords) ;
describe("--",f83|ans|jsf|foerthchen|only) ;


function forthvlist()  {  forthwords() ; }
primitive("vlist",forthvlist) ;
describe("--",f79|fig) ;



function forthhere() { s[++sp]=tos ; tos=dp ; }                   // here
var x_here= primitive("here",forthhere) ;
describe("-- a",any) ;




function forthallot() {                                           // allot
   if ((dp+tos)>dictionaryfull)  {
      throwerror(-8) ;
   } else {
      dp+=tos ;
      tos=s[sp--] ;
   }
}
var x_allot= primitive("allot",forthallot) ;
describe("n --",any) ;


function forthhide() { hf[wc] &= (!smudgebit) ; }                 // hide
var x_hide= primitive("hide",forthhide) ;
describe("--",f83) ;


function forthreveal() { hf[wc] |= smudgebit ; }                  // reveal
var x_reveal= primitive("reveal",forthreveal) ;
describe("--",f83) ;



function comma(x)     {
   if ((dp+1) >= dictionaryfull)  {
      throwerror(-8) ;
   } else {
      m[dp++] = x ;
   }
}
function forthcomma() { comma(tos) ; tos = s[sp--] ; }            // ,
var x_comma  = primitive(",",forthcomma) ;
describe("x --",any) ;
var x_ccomma = primitive("c,",forthcomma) ;                       // c,
describe("c --",any) ;




function compile()  { for (var i=0 ; i<arguments.length ; jscomma(arguments[i++])) ; }



definitions(hidden) ;


// non-standard function, internal use.   find (more standard) builds on this one.
// return header number = xt
function forthsearch1()  {                              // ( packedname -- a2 | 0 )
   for (var i=wc; i; i--)  {                            // loop through headers last first
      w = h[i] ;
      if (w)  {                                         // header exists
         if (m[context] & ds[i]) {                      // header in context dir
            if (hf[i] & smudgebit) {                    // smudge bit set too ?
               if (!m[casesensitive])  w = w.toLowerCase() ;
               if (w == tos)  {                         // header match ?
                  if (m[compliance] & ds[i]) {          // complies with standard ?
                     tos = i;                           // yes, return xt
                     return;
                  }
               }
            }
         }
      }
   }
   tos = 0;                                             // all tried, no match
}




// this can be done better, but works for now.
function forthsearch()  {                               // ( a1 n -- a2 | 0 )
   forthpack();
   if (!m[casesensitive]) tos = tos.toLowerCase() ;
   var packedname = tos ;
   var orgcontext = m[context] ;
   forthsearch1() ;                                     // search context voc first
   if (!tos)  {                                         // go on, search voc stack if not found
      for ( var i=vocstack.length ; i ; )  {
         tos = 0 ;                                      // assume "not found"
         i-- ;
         if (m[context] != vocstack[i]) {               // don't search voc, if already searched
            m[context] = vocstack[i] ;                  // make next voc context
            tos = packedname ;
            forthsearch1() ;
         }
         if (tos)  break ;                              // found ? escape
      }
   }
   m[context] = orgcontext ;                            // restore original context
}
var x_search= primitive("search",forthsearch) ;





definitions(forth) ;

function forthfind()  {                                 // ( a -- a 0 | x1 1 | xt -1 )   (1=immediate)
   s[++sp] = tos ;
   s[++sp] = tos+1 ;
   tos = m[tos] & 255 ;
   forthsearch() ;                                      // ( a 0 | a xt )
   if (tos)  {
      s[sp] = tos;
      if (hf[tos] & precedencebit) {
         tos = 1 ;
      } else {
         tos = -1 ;
      }
   }
 }
var x_find= primitive("find",forthfind) ;
describe("a1 -- a2 0 | a2 xt",ans|f83|jsf) ;


function forthtobody()  {                               // ( a1 -- a2 )
   if (tos <= primitives)  throwerror(-31) ;
   tos = x[tos] + 1 ;
}
var x_tobody = primitive(">body",forthtobody) ;
describe("a1 -- a2",any) ;


function forthbodyfrom()  {                             // ( a1 -- a2 )
   tos-- ;
   for (var i=wc; i; i--)  {                            // loop through headers last first
      if (h[i])  {
         if (x[i] == tos)  {                            // word pointer match ?
            tos = i;                                    // yes, return xt
            return;
         }   
      }      
   }
   throwerror(-65) ;
}
primitive("body>",forthbodyfrom) ;
describe("a1 -- a2",jsf) ;




definitions(hidden) ;


function forthqimm()  { tos = -(hf[tos] & precedencebit) ; }              // ( xt -- f )
var x_qimm = primitive("?immediate",forthqimm) ;                          // ?immediate



function forthcompiling()  { s[++sp] = tos ; tos = m[state] ; }           // compiling
var x_compiling = primitive("compiling",forthcompiling) ;


definitions(forth) ;


function forthimmediate()  { hf[wc] |= precedencebit ; }                  // immediate
primitive("immediate",forthimmediate) ;
describe("--",any) ;






function forthbrclose()  { m[state] = true ; }                            // ]
var x_brclose = primitive("]",forthbrclose) ;
describe("--",any) ;


function forthbropen()  { m[state] = false ; }                            // [
var x_bropen = primitive("[",forthbropen,immediate) ;
describe("--",any) ;


definitions(hidden) ;

function forthnewheader()  {                                              // newheader
   forthpack() ;
   newheader(tos) ;
   tos=s[sp--] ;
}
var x_newheader = primitive("newheader",forthnewheader) ;


definitions(forth) ;


function forthdotname()    {    // ( xt -- )                              // .name
   type(h[tos]) ;
    tos = s[sp--] ;
}
var x_dotname = primitive(".name",forthdotname) ;
describe("xt --",jsf) ;


function forthname()    {       // ( xt -- a n )                          // name
    sp++ ;
    s[++sp] = h[tos] ;
    tos = dp ;
    s[sp-1] = tos ;
    unpack() ;
}
primitive("name",forthname) ;
describe("x1 -- a u",jsf) ;



definitions(hidden) ;

function forthcreateheader()  {
   s[++sp] = tos ;
   tos = bl ;
   forthparse() ;
   forthnewheader() ;
}
var x_createheader = primitive("createheader",forthcreateheader) ;


function forthuse()  {
   forthcreateheader() ;
   forthcomma() ;
   t[wc] = nexthilevel ;
}
var x_use = primitive("use",forthuse) ;



definitions(forth) ;

function forthcolonnoname()  {                                            // :noname
   s[++sp] = tos ;
   newheader("") ;
   tos = wc ;
   comma(x_nest) ;
   m[state] = -1 ;
   t[wc] = nexthilevel ;
}
primitive(":noname",forthcolonnoname)
describe("-- a",ans|jsf) ;




function forthunused()  {
   s[++sp] = tos ;
   tos = dictionaryfull - dp ;
}
primitive("unused",forthunused) ;
describe("-- u",ans|jsf) ;



primitive("seperator",seperator) ;
describe("--",jsf) ;


function forthheap()  {         // ( -- a )
   s[++sp] = tos ;
   tos = heapend ;
}
primitive("heap",forthheap) ;
describe("-- a",jsf) ;


function forthbrmarker()  {     // ( wc dp -- )
   dp        = tos ;
   wc        = s[sp--] ;
   m[lastxt] = wc    ;
   tos       = s[sp--] ;
}
primitive("(marker)",forthbrmarker) ;
describe("wc dp heap --",jsf) ;





// =================================================================================================
//                                          mass storage
// =================================================================================================







// ------------------------------------------- memory drive --------------------------------------------

var ramblock = new Array() ;
var screenline ;

function saveblock()  {
   for (i=screenline.length ; i<16 ; i++)  screenline.push("") ;
   for (i=screenline.length ; i>16 ; i--)  screenline.pop() ;
   ramblock.push(screenline) ;
}



screenline = new Array() ;
screenline.push("( ramdrive block 0 - essential block words      -load- )") ;
screenline.push(": copy (s u1 u2 -- ) swap block swap buffer c/s move update ;") ;
screenline.push(": clear (s u -- ) buffer c/s blank update ;") ; 
screenline.push(": index1 (s u -- )  dup scr ! 2 .r space 0 .line ;") ;
screenline.push(": index (s u1 u2 -- ) 1+ swap ?do cr i index1 loop ;") ;
screenline.push(": ls (s -- ) 0 capacity 1- index ;") ;
screenline.push(": w (s -- ) last @ 1+ 1 do i name dup if ") ;
screenline.push("      2dup info s\"   \" ...info  i stackeffect ...info") ;
screenline.push("   then 2drop loop ;") ;
screenline.push(": -->  (s -- ) blk @ 1+ block c/s !source >in off ; immediate") ;
screenline.push(": uppercase dup char a char z 1+ within 32 and - ;") ;
screenline.push(": p  (s -- )  scr @ 1-  0 max  scr ! ;") ;
screenline.push(": n  (s -- )  scr @ 1+ capacity 1- min scr ! ;") ;
screenline.push(": view (s -- ) begin key dup esc <> while uppercase") ;
screenline.push("  dup char N = if n else dup char P = if p then then") ;
screenline.push("  drop cls l repeat drop ;") ;
saveblock() ;



screenline = new Array() ;
screenline.push("( ramdrive block 1 - MARKER + info screen words -load- )") ;
screenline.push(": marker here last @ create , ,") ;
screenline.push("         does> skim swap @ (marker) ;") ;
screenline.push("") ;
screenline.push(": cr2  (s -- ) s\" \" info ;") ;
screenline.push("") ;
screenline.push(": .line2 (s u -- ) c/l * screen + c/l -trailing info ;") ;
screenline.push("") ;
screenline.push("( list screen on info window )") ;
screenline.push(": list2 (s u -- ) scr ! seperator l/s 0 do i .line2 loop ;") ;
screenline.push("") ;
screenline.push("( list all screens on info, enable backscroll )") ;
screenline.push(": sources (s -- )  capacity 0 do i list2 loop all ;") ;
saveblock() ;



screenline = new Array() ;
screenline.push("( ramdrive block 2 - hex dump                   -load- )") ;
screenline.push("hidden definitions  6 constant dumps/line");
screenline.push(": safe-emit (s c -- ) dup bl 128 within 0=") ;
screenline.push("      if drop char . then emit ;") ;
screenline.push(": ######## (s u -- ) 0 <# 8 for # next #> type ;") ;
screenline.push(": .cell (s u -- ) 16 base exchange swap ######## space base ! ;") ;
screenline.push(": .addr (s u -- ) .cell ;") ;
screenline.push(": pad_dump1 (s n -- ) 4 swap - 3 * spaces ;") ;
screenline.push(": dump_cells (s a n -- ) for skim .cell next drop ;") ;
screenline.push(": dump_chars (s a n -- ) for count safe-emit next drop ;") ;
screenline.push(": dump1line (s a n -- ) dumps/line min dup if over .addr") ;
screenline.push("     2 spaces 2dup dump_cells dup pad_dump1 2 spaces") ;
screenline.push("   2dup dump_chars then 2drop ;") ;
screenline.push("forth definitions hidden") ;
screenline.push(": dump (s a n -- ) begin ?dup while 2dup cr dump1line") ;
screenline.push("  dumps/line /string repeat drop ; forth") ;
saveblock() ;



screenline = new Array();
screenline.push("( ramdrive block 3 - modified retro editor )") ;
screenline.push(": line (s u -- a )  c/l * screen + ;") ;
screenline.push(": s    (s u -- )    scr ! ;") ;
screenline.push(": ia (s a u -- )    line + >r 0 parse r> swap cmove ;") ;
screenline.push(": r  (s u -- )      0 swap ia ;") ;
screenline.push(": d  (s u -- )      line c/l blank ;") ;
screenline.push(": x (s -- )         clear ;") ;
screenline.push(": v (s -- )         l ;") ;
screenline.push("( extensions: bubble up and down lines )") ;
screenline.push(": >pad (s a n -- )  pad swap move ;") ;
screenline.push(": pad> (s a n -- )  pad -rot move ;") ;
screenline.push(": lines (s u1 u2 -- a1 a2 ) line swap line swap ;") ;
screenline.push(": xchg lines over >r dup c/l >pad c/l move r> c/l pad> ;") ;
screenline.push(": bu (s u1 -- )    ?dup if dup 1- xchg then ;") ;
screenline.push(": bd (s u1 -- )    dup l/s 1- < if dup 1+ bu then drop ;") ;
saveblock() ;



screenline = new Array("( ramdrive block 4 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 5 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 6 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 7 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 8 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 9 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 10 - empty )") ; saveblock() ;
screenline = new Array("( ramdrive block 11 - empty )") ; saveblock() ;





// ---------------------------- ram drive ----------------------------


function loadblockfromram(n,a)  {                 // unpack block n to address
   debug("ram drive: block " + n + " to addr " + a) ;
   var temp = a ;
   for ( i=0; i<16; i++ )  {
      s[++sp] = lineofspaces.substr(0,64) ;  tos = temp ; unpack() ;
      s[++sp] = ramblock[n][i].substr(0,64) ; tos = temp ; unpack() ;
      temp += 64 ;
   }
   return a ;
}



function savebuftoram(addr,blocknum)  {
   debug("ram drive: from " + addr + " to ramblock " + blocknum)
   for ( i=0; i<16; i++ )  {
      ramblock[blocknum][i] = pack(addr,64) ;
      addr += 64 ;
   }
}







function ramdrivecapacity()     { return ramblock.length } ;



// ------------------------- cookie drive ------------------------------


var cookiesectorsize = 1024                      // decrease size to spread block across multiple cookies

function loadblockfromcookie(blknum,destaddr)  {       // unpack block to address
   debug("cookie drive: block " + blknum + " to addr " + destaddr) ;
   for (var i=0 ; i<1024 ; i+=cookiesectorsize)  {
      var cookiename = (cookiebasename + blknum + "_" + i) ;
      var temp = (readcookie(cookiename, destaddr+i))
      if (temp) {
         unpackstring(temp.substr(0,cookiesectorsize),destaddr+i) ;
      } else {
         temp = destaddr+i ;
         for (var j=0 ; j<cookiesectorsize ; j++) m[temp++] = bl ;
      }
   }
   return destaddr ;
} 


function savebuftocookie(addr,blknum)  {
   debug("cookie drive: from " + addr + " to block " + blknum)
   for (var i=0 ; i<1024 ; i+=cookiesectorsize)  setcookie((cookiebasename + blknum + "_" + i), pack(addr+i,cookiesectorsize), null, cookieexpirationdate) ;
}



function cookiedrivecapacity()  { return maxcookies ; }   // for now

function localcapacity()        { return (ramdrivecapacity() + cookiedrivecapacity()) } ;










// ------------------------ remote web server drive ------------------------


// the quest for getting to the contents of the data has been elegantly solved by
// molily from #selfhtml, and my gratitude for taking this load off me goes fully to him.
// Thank you very much, molily !


// server know different block types. only public are supported first.
// public      ( read-only )
// private     ( read/write in user sandbox )
// exported    ( read/write in specific server block range, copied from private )




var requesting_load = 0 ;
var waitingforblock = wc ;                            // suspension id
var bufferforrequest = new Array() ;                  // buffer queue
var blockwatchdog ;                                   // carry event id across functions             



function blockreadtimeout() {
   info("file transaction not completed in time") ;
   requesting_load = 0 ;
   throwerror(-37)  ;   // general i/o error
}



function unpackfiletobuffer(remotefile)  {
   var bufaddr = bufferforrequest.shift() ;                                 // full file buffer from queue
   var contents ;                                                           // retrieve block data and buffer address
   if (remotefile.contentDocument.getElementsByTagName("pre")[0]) {
      contents = remotefile.contentDocument.getElementsByTagName("pre")[0].firstChild.nodeValue ;
   }
   if (contents)  {
      var inpointer = 0 ;
      var outpointer = 0;
      var i=contents.length ;
      debug("unpacking " + i + " chars to addr " + bufaddr) ;
      for ( ; i ; i-- )  {
         var temp = contents.charCodeAt(inpointer++) ;
         if (temp == 0x0a) {
            for (var j = 64 - (outpointer % 64) ; j ; j--)   m[bufaddr+outpointer++] = bl;     // pad line remainder with spaces
         } else {
            m[bufaddr+outpointer++] = temp ;    
         } 
         if (outpointer >= 1024)  break ;         
      }
      for ( ; outpointer<1024 ; outpointer++ )  m[bufaddr+outpointer] = bl ; 
   }
}







// --- event handler, gets called when block transfer to iframe has completed
function LoadingCompleteEvent(remotefile) {
   if(requesting_load) {                                                       // only take action if i/o requested 
      debug("iframe event handler executes: suspended=" + suspended) ;
      if (suspended == waitingforblock)  {                                     // vm has been stopped, waiting for block completion
         window.clearTimeout(blockwatchdog) ;
         debug("cancelled block watchdog because load completed in time. restarting vm") ;
         suspended = 0 ;
         unpackfiletobuffer(remotefile)
         requesting_load-- ;                                                   // counter of pending requests
         virtualmachine(ip);                                                   // restart vm where we left it
      } else {                                                                 // imframe load complete without vm suspend
         unpackfiletobuffer(remotefile)
         requesting_load-- ;
         debug("unsuspended file request completed") ;
      }
   } else {
      debug("iframe onload handler executed without request")
   }
   return true ;
}




function readfilefromweb(filename,destaddr) {
   bufferforrequest.push(destaddr) ;                                          // queue buffer address
   debug("server file " + filename + " requested") ;
   requesting_load++ ;
   window.frames['dataframe'].window.location.replace(filename);              // trigger iframe load
   suspended = waitingforblock ;                                              // suspend until timeout of block complete
   debug("issuing timed event 'blockreadtimeout in " + blocktimeout + " ms, suspend code=" + suspended) ;
   blockwatchdog = window.setTimeout(blockreadtimeout,blocktimeout) ;         // start block timeout
}


// - - - - -



function loadblockfromweb(blknum,destaddr)  {
   if (requesting_load)  { 
      info("previous request not completed") ;
      throwerror(-37)  ;                                                      // general i/o error
   } else {
      readfilefromweb(('webdrive/blk' + blknum),destaddr) ;
   }
   return destaddr ;
}



function savebuftoweb(addr,blknum)  { throwerror(-71) ; }




var storedremotecapacity = 20 ;

function remotecapacity()       {
   return storedremotecapacity ;
}






// ------------------------------ peer drives ------------------------------







// -------------------------------------------------------------------------



function capacity()             { return localcapacity() + remotecapacity() ; }


function forthcapacity()        {  s[++sp] = tos ;  tos = capacity() ; }
primitive("capacity",forthcapacity) ;  
describe("-- u",jsf) ;


function forthlocalcapacity()  { s[++sp] = tos ; tos = localcapacity() } ;
primitive("localcapacity",forthlocalcapacity) ;
describe("-- u",jsf) ;



// ------------------------ buffers ------------------------


// block mapping hardcoded in here
function savebuf(buffer)    {
   var starttime = new Date().getTime();
   var bufaddr = buf[buffer] ;
   var blknum = bufblk[buffer] ;
   if (blknum<maxcookies) {
      savebuftocookie(bufaddr,blknum) ;
   } else {
      var temp = localcapacity() ;
      if (blknum<temp)  {
         savebuftoram(bufaddr,blknum-maxcookies) ;
      } else {
         savebuftoweb(bufaddr,blknum-temp) ;
      }
   }
   bufdirty[buffer] = 0 ;                      // set clean
   var stoptime = new Date().getTime();
   debug("block " + blknum + " write took " + (stoptime-starttime) + "ms") ;
}




function loadblock(blknum,buffer)  {
   var starttime = new Date().getTime();
   if (blknum<maxcookies) {
      var blockdata = loadblockfromcookie(blknum,buffer) ; 
   } else {
      var temp = localcapacity() ;
      if (blknum<temp)  {
         blockdata = loadblockfromram(blknum-maxcookies,buffer) ;
      } else {
         blockdata = loadblockfromweb(blknum-temp,buffer) ;
      }
   }
   var stoptime = new Date().getTime();
   debug("block " + blknum + " read took " + (stoptime-starttime) + "ms") ;
   return blockdata ;
}



// --------------------------------------------------------------

var hotbuffer ;                                        // for update

function forthblockorbuffer(flag) {                    // ( u -- a )  /  flag=true:block    false:buffer
   if ((tos>=capacity()) || (tos<0))  throwerror(-35) ;
   if (blockstat[tos] >= 0) {                       // block already mapped: 
      hotbuffer = blockstat[tos] ;
      tos = buf[hotbuffer] ;                        // return buffer address
   } else {                                         // block not mapped:
      nextbuf++ ;                                   // next available buffer
      nextbuf %= maxbufs ;
      if (bufblk[nextbuf] >= 0)  {                  // buffer used for another block
         if (bufdirty[nextbuf]) savebuf(nextbuf) ;  // dirty ?
         blockstat[bufblk[nextbuf]] = -1;           // write block info "unbuffered"
      }
      var temp = tos ;
      if (flag) {
         tos = loadblock(tos,buf[nextbuf]) ;        // block: fill block with data from mass memory.
      } else {
         tos = buf[nextbuf] ;                       // buffer: indefinite buffer contents.
      }
      hotbuffer = nextbuf ;
      bufblk[nextbuf] = temp ;                      // associate buf with block#
      blockstat[temp] = nextbuf ;                   // set block info "buffered in ..."
   }
}




function forthbuffer() { forthblockorbuffer(false) ; }   // ( u -- a )
var x_buffer = primitive("buffer",forthbuffer) ;  
describe("u -- a",any) ;



function forthblock()  { forthblockorbuffer(true) ; }    // ( u -- a )
var x_block = primitive("block",forthblock) ;  
describe("u -- a",any) ;



function forthupdate()   { bufdirty[hotbuffer] = -1 ; }
primitive("update",forthupdate) ;  
describe("--",any) ;




function forthsavebuffers()  {
   for (var i=0 ; i<maxbufs ; i++ ) {          // for all buffers
      if (bufdirty[i])  savebuf(i) ;           // save if dirty
      blockstat[bufblk[i]] = -1;               // write block info "unbuffered"
   }
}
primitive("save-buffers",forthsavebuffers) ;  
describe("--",any) ;




function forthemptybuffers()  {
   for (var i=0 ; i<maxbufs ; i++ ) {
      if (bufblk[i]>=0)  {                     // buffer has block in ?
         blockstat[bufblk[i]] = -1 ;           // mark block as not buffered anymore
         bufblk[i] = -1 ;                      // mark buffer as not containing a block
         bufdirty[i] = 0 ;                     // set clean 
      }
   }
}
primitive("empty-buffers",forthemptybuffers) ;  
describe("--",any) ;





function forthblockstats() {
   cr() ; type("checking blocks:") ;
   var temp = capacity()
   for (var i=0 ; i<temp ; i++)  {
      if (blockstat[i] != -1)  {
         cr() ;
         type("   blk #" + i + ": buf " + blockstat[i]);
      }
   }
}


function forthbufstats() {
   cr() ; type("checking buffers:")
   for ( i=0 ; i<maxbufs ; i++ )  {
      cr() ;
      type("   buf #" + i + ":") ;
      if (bufblk[i] < 0)  {
         type(" empty") ;
      } else {
         type( " blk " + bufblk[i]) ;
      }
      if (bufdirty[i])  type(" dirty") ;
   }
  forthblockstats() ;
}
primitive("bufstats",forthbufstats) ;  
describe("--",jsf) ;
















// =================================================================================================
//                                          vocabularies                            
// =================================================================================================

// i'll try to use the standards selector to implement conventional vocabularies 


definitions(forth) ;

function dovocabulary()  {
   w = x[w] ;
   m[context] = m[w] ;
   standard = ((standard & (higheststandard<<1)-1)) | m[context] ;
}

function forthvocabulary()  {
   if (nextvocabulary>=0x20000000)  {
      throwerror(-69) ;
   } else {
      forthcreateheader() ;
      vocname.push(wc) ;
      t[wc] = dovocabulary ;
      nextvocabulary <<= 1 ;
      m[dp++] = nextvocabulary ;
      forthreveal() ;
   }
}
primitive("vocabulary",forthvocabulary) ;
describe("<new vocabulary name> --",any) ;









function forthonly()  {
   for ( var i=vocstack.length ; i ; i--)  vocstack.pop() ;
   m[context] = only ;
   vocstack.push(only) ;   }
primitive("only",forthonly) ;
describe("--",any) ;
vocname.push(wc) ;



function forthforth() { m[context] = forth ; }
primitive("forth",forthforth) ;
describe("--",any|only) ;
vocname.push(wc) ;



function forthhidden() { m[context] = hidden ; }
primitive("hidden",forthhidden) ;
describe("--",jsf|f83|ans) ;
vocname.push(wc) ;




function forthteststuff() { m[context] = teststuff ; }
primitive("teststuff",forthteststuff) ;
describe("--",jsf) ;
vocname.push(wc) ;





function forthdefinitions()  { m[current] = m[context] ; }
primitive("definitions",forthdefinitions) ;
describe("--",any) ;




function forthorder()  {
   printvocname(m[context]) ;
   for (var i=vocstack.length ; i ; i--)  printvocname(vocstack[i-1]) ;
   type("      ") ; printvocname(m[current]) ;
}
primitive("order",forthorder) ;
describe("--",ans|jsf|only) ;


function forthalso()  { vocstack.push(m[context]) ; }
primitive("also",forthalso) ;
describe("--",ans|jsf) ;


function forthprevious()  { m[context] = vocstack.pop() ; }
primitive("previous",forthprevious) ;
describe("--",ans|jsf) ;



function forthvocs()  { for (i=vocname.length ; i ; type(h[vocname[--i]] + " ")) ; }
primitive("vocs",forthvocs) ;
describe("--",fig|f79|f83|jsf) ;




// =================================================================================================
//                                        floating point
// =================================================================================================


definitions(teststuff) ;
// fconstants, testing
function forth1point5()     { f.push(ftos) ; ftos=1.5 ;  } ;  primitive("1.5",forth1point5) ;
function forthmin1point5()  { f.push(ftos) ; ftos=-1.5 ; } ;  primitive("-1.5",forthmin1point5) ;
function forth2point8()     { f.push(ftos) ; ftos=2.8 ;  } ;  primitive("2.8",forth2point8) ;
function forthmin2point8()  { f.push(ftos) ; ftos=-2.8 ; } ;  primitive("-2.8",forthmin2point8) ;



definitions(forth) ;
function forthfdots()  {                                              // f.s
   f.push(ftos) ;
   for (var i=1 ; i < f.length ; type(f[i++] + " ")) ;
   ftos = f.pop() ;
}
primitive("f.s",forthfdots) ;
describe("--",any) ;




function forthfdrop()      { ftos = f.pop() ; }                        // fdrop
primitive("fdrop",forthfdrop) ;
describe("r --",any) ;



function forthfdup()      { f.push(ftos) ; }                           // fdup
primitive("fdup",forthfdup) ;
describe("r -- r r",any) ;


 
function forthfswap()     {                                            // fswap
    w = f.pop() ;
    f.push(ftos) ;
    ftos = w ;
}
primitive("fswap",forthfswap) ;
describe("r1 r2 -- r2 r1",any) ;



function forthfover()      {                                           // fover
   f.push(ftos) ;
   ftos = f[f.length-2] ;
}
primitive("fover",forthfover) ;
describe("r1 r2 -- r1 r2 r1",any) ;



function forthffetch()      {                                          // f@
   f.push(ftos) ;
   ftos = (m[tos]) ;
   tos = s[sp--] ;
}
primitive("f@",forthffetch) ;
describe("a -- r",any) ;



function forthfstore()      {                                          // f!
   m[tos] = ftos ;
   ftos = f.pop() ;
   tos = s[sp--] ;
}
primitive("f!",forthfstore) ;
describe("r a --",any) ;






function forthfequ()      {                                            // f=
   s[++sp] = tos ;
   tos =  -(ftos == f.pop()) ;
}
primitive("f=",forthfequ) ;
describe("r1 r2 -- f",any) ;




function forthfnequ()       {                                          // f<>
   s[++sp] = tos ;
   tos =  -(ftos != f.pop()) ;
}
primitive("f<>",forthfnequ) ;
describe("r1 r2 -- f",any) ;



function forthfmore()       {                                          // f>
   s[++sp] = tos ;
   tos =  -(f.pop() > ftos) ;
}
primitive("f>",forthfmore) ;
describe("r1 r2 -- f",any) ;



function forthfless()       {                                         // f<
   s[++sp] = tos ;
   tos =  -(f.pop() < ftos) ;
}
primitive("f<",forthfless) ;
describe("r1 r2 -- f",any) ;



function forthf0equ()       {                                         // f0=
   s[++sp] = tos ;
   tos = -(ftos == 0) ;
   ftos = f.pop() ;
}
primitive("f0=",forthf0equ) ;
describe("r -- f",any) ;



function forthf0nequ()       {                                        // f0<>
   s[++sp] = tos ;
   tos = -(ftos != 0) ;
   ftos = f.pop() ;
}
primitive("f0<>",forthf0nequ) ;
describe("r -- f",any) ;



function forthf0less()       {                                        // f0<
   s[++sp] = tos ;
   tos = -(ftos < 0) ;
   ftos = f.pop() ;
}
primitive("f0<",forthf0less) ;
describe("r -- f",any) ;



function forthf0greater()     {                                       // f0>
   s[++sp] = tos ;
   tos = -(ftos > 0) ;
   ftos = f.pop() ;
}
primitive("f0>",forthf0greater) ;
describe("r -- f",any) ;



function forthfnegate()       {                                       // fnegate
   ftos = -ftos ;
}
primitive("fnegate",forthfnegate) ;
describe("r1 -- r2",any) ;



function forthfabs()               {                                  // fabs
   ftos = Math.abs(ftos) ;
}
primitive("fabs",forthfabs) ;
describe("r1 -- r2",any)



function forthfround()               {                                 // fround
   ftos = Math.round(ftos) ;
}
primitive("fround",forthfround) ;
describe("r1 -- r2",any)





function forthfdepth()               {                                  // fdepth
   s[sp++] = tos ;
   tos = f.length ;
}
primitive("fdepth",forthfdepth) ;
describe(" -- u",any)



function forthdtof()  {                                                 // d>f
   f.push(ftos) ;
   ftos =  tos * 0x100000000 + s[sp--] ;
   tos = s[sp--] ;
}
primitive("d>f",forthdtof) ;
describe("d --",jsf|ans) ;


function forthftod()  {                                                 // f>d
   s[++sp] = tos ;
   tos = ftos ;
   ftos = f.pop() ;
   s[++sp] = tos & 0xffffffff ;
   tos = tos/0x100000000
   if (tos<0) tos+=floorfix ;
   tos = Math.floor(tos) ;
}
primitive("f>d",forthftod) ;
describe("r -- d",jsf|ans) ;



function forthstof()  {                                                 // s>f
   f.push(ftos) ;
   ftos = tos ;
   tos = s[sp--] ;
}
primitive("s>f",forthstof) ;
describe("x --",jsf) ;



function forthfplus()  {                                                // f+
   ftos += f.pop() ;
}
primitive("f+",forthfplus) ;
describe("r1 r2 -- r3",jsf|ans) ;



function forthfminus()  {                                               // f-
   ftos = f.pop()-ftos ;
}
primitive("f-",forthfminus) ;
describe("r1 r2 -- r3",jsf|ans) ;



function forthfmul()  {                                                 // f*
   ftos *= f.pop() ;
}
primitive("f*",forthfmul) ;
describe("r1 r2 -- r3",jsf|ans) ;


function forthfdiv()  {                                                 // f/
   var temp = f.pop() ;
   ftos = temp/ftos ;
}
primitive("f/",forthfdiv) ;
describe("r1 r2 -- r3",jsf|ans) ;



function forthfsin()  {                                                 // fsin
   ftos = Math.sin(ftos) ;
}
primitive("fsin",forthfsin) ;
describe("r1 -- r2",jsf|ans) ;



function forthfcos()  {                                                 // fcos
   ftos = Math.cos(ftos) ;
}
primitive("fcos",forthfcos) ;
describe("r1 -- r2",jsf|ans) ;



function forthftan()  {                                                 // ftan
   ftos = Math.tan(ftos) ;
}
primitive("ftan",forthftan) ;
describe("r1 -- r2",jsf|ans) ;




function forthfasin()  {                                                // fasin
   ftos = Math.asin(ftos) ;
}
primitive("fasin",forthfasin) ;
describe("r1 -- r2",jsf|ans) ;




function forthfatan()  {                                                // fatan
   ftos = Math.atan(ftos) ;
}
primitive("fatan",forthfatan) ;
describe("r1 -- r2",jsf|ans) ;



function forthfatan2()  {                                               // fatan2
   ftos = Math.atan2(f.pop(),ftos) ;
}
primitive("fatan2",forthfatan2) ;
describe("r1 r2 -- r3",jsf|ans) ;




function forthfacos()  {                                                // facos
   ftos = Math.acos(ftos) ;
}
primitive("facos",forthfacos) ;
describe("r1 -- r2",jsf|ans) ;




function forthfpower()  {                                               // f**
   ftos = Math.pow(f.pop(),ftos) ;
}
primitive("f**",forthfpower) ;
describe("r1 r2 -- r3",jsf|ans) ;



function forthfln()  {                                                // fln
   ftos = Math.log(ftos) ;
}
primitive("fln",forthfln) ;
describe("r1 -- r2",jsf|ans) ;




// function forthflog()  {                                                // flog
//   ftos = Math.log(10,ftos) ;
// }
// primitive("flog",forthflog) ;
// describe("r1 -- r2",jsf|ans) ;



// (Math.log) : e based



function forthfalog()  {                                               // falog
   ftos = Math.pow(10,ftos) ;
}
primitive("falog",forthfalog) ;
describe("r1 -- r2",jsf|ans) ;






function forthfsqrt()  {                                               // fsqrt
   ftos = Math.sqrt(ftos) ;
}
primitive("fsqrt",forthfsqrt) ;
describe("r1 -- r2",jsf|ans) ;




function forthfmin()  {                                                 // fmin
   ftos = Math.min(ftos,f.pop()) ;
}
primitive("fmin",forthfmin) ;
describe("r1 r2 -- r3",jsf|ans) ;



function forthfmax()  {                                                 // fmax
   ftos = Math.max(ftos,f.pop()) ;
}
primitive("fmax",forthfmax) ;
describe("r1 r2 -- r3",jsf|ans) ;




function forthfdot()  {                                                 // f.
   type(ftos + " ") ;
   ftos = f.pop() ;
}
primitive("f.",forthfdot) ;
describe("r --",jsf|ans) ;


function forthpi()  {                                                   // pi
   f.push(ftos) ;
   ftos = Math.PI ;
}
primitive("pi",forthpi) ;
describe("-- r",jsf|ans) ;



function forthreciproc()  {                                              // 1/F
   ftos = 1/ftos ;
}
primitive("1/f",forthreciproc) ;
describe("r1 -- r2",jsf|ans) ;




function forthfcomma() { m[dp++] = ftos ; ftos = f.pop() ; }               // f,
var x_fcomma  = primitive("f,",forthfcomma) ;
describe("r --",any) ;


primitive("falign",noop,immediate)                                         // falign
describe("--",ans) ;

primitive("faligned",noop,immediate)                                       // faligned  
describe("--",ans) ;





// =================================================================================================
//                                             heap
// =================================================================================================


var nusedchunks  = 0 ;
var nfreechunks  = 0 ;



// return data address of chunk
function newchunk(size)  {
   m[heapend++] = nusedchunks ;
   m[heapend++] = size ;
   usedchunk[nusedchunks++] = heapend ;
   var temp = heapend ;
   heapend += tos ;
   return temp ;
}



// return data address of chunk
function splitchunk(fit,newsize)  {
   var chunkaddr = freechunk[fit] ;
   var chunksizeleft = m[chunkaddr-1] - (newsize+2) ;
   if ((chunksizeleft) > 0)  {                         // split chunk into two:
      m[chunkaddr-1] = chunksizeleft++ ;               // new size old chunk
      chunkaddr += chunksizeleft ;                     // new addr new chunk
      m[chunkaddr++] = newsize ;                       // new size new chunk
   } else {                                            // use chunk completely:
      freechunk[fit] = freechunk[--nfreechunks] ;      // last chunk takes place of used chunk
      freechunk.pop() ;                                // shorten array of freed chunks
   }
   m[chunkaddr-2] = nusedchunks ;                      // index into usedchunks array to this chunk
   usedchunk[nusedchunks++] = chunkaddr ;              // move new chunk to usedchunks
   return chunkaddr ;
}




function searchfit(size)  {
   var fit = -1 ;
   if (nfreechunks)  {
      var temp = 0xffffffff ;                     // any chunk is better
      for (var i=0 ; i<nfreechunks ; i++)  {
         var slack = m[freechunk[i]-1] - size ;
         if (slack == 0)  return i 
         if (slack > 2 )  {
            if (!fittype) return i ;
            if ( slack < temp )  {
               fit = i ;
               temp = slack ;
            }
         }
      }
   }
   return fit ;
}



function forthallocate()  {  // ( u -- a 0 | err )
   var fit = searchfit(tos) ;
   if (fit<0) {
      s[++sp] = newchunk(tos) ;
   } else {
      s[++sp] = splitchunk(fit,tos) ;
   }
   tos = 0 ;
}
primitive("allocate",forthallocate) ;
describe("u -- a 0 | err",ans|jsf) ;




function forthfree()  {    // ( a -- 0 | err )
   var temp = Math.min(m[tos-2],nusedchunks-1) ;
   var chunkaddr = usedchunk[temp] ; 
   if (chunkaddr != tos)  {
      throwerror(-72) ;
   } else {
      freechunk[nfreechunks++] = chunkaddr ;
      nusedchunks-- ;
      var lastchunk = usedchunk.pop() ;
      if (temp < nusedchunks) {
         m[lastchunk-2] = temp ;
         usedchunk[temp] = lastchunk ;
      }
   }
   freechunk.sort()
   chunkaddr = freechunk[0] + m[freechunk[0]-1] + 2;

// combining from end of memory towards lower addresses may be quicker .
   for (temp = 1 ; temp < nfreechunks ; temp++)  {
      if (freechunk[temp] == chunkaddr)  {                      // merge chunks 
         chunksize = m[freechunk[temp]-1] + 2 ;
         m[freechunk[temp-1]-1] += chunksize ;
         chunkaddr +=  chunksize ;
         nfreechunks-- ;
         for (var i=temp ; i<nfreechunks ; freechunk[i++] = freechunk[i]) ;
         freechunk.pop() ;
         temp--;
      } else {
         chunkaddr = freechunk[temp] + m[freechunk[temp]-1] + 2;
      }
   }
   temp = freechunk[nfreechunks-1] ;
   if (( temp + m[temp-1]) == heapend )  {
      nfreechunks-- ;
      heapend = (freechunk.pop() - 2 ) ; 
   }
   tos = 0 ;
}
primitive("free",forthfree) ;
describe("a -- 0 | err",ans|jsf) ;





// RESIZE
//    freed areas appendable ?
//    yes: append
//    no: allocate new, copy 




function forthdotallocated()  {
   type("allocated:") ;
   for (var i=0 ; i<nusedchunks ; i++ )  {
      cr() ;
      type(i + "/" + m[usedchunk[i]-2] + ": " + (usedchunk[i]) + " " + m[usedchunk[i]-1]) ;
   }
   cr() ; type("freed:") ;
   for (i=0 ; i<nfreechunks ; i++ )  {
      cr() ;
      type(i + ": " + (freechunk[i]) + " " + m[freechunk[i]-1]) ;
   }
}
primitive(".allocated",forthdotallocated) ;
describe("--",jsf) ;




// =================================================================================================
//                                     peephole optimizer
// =================================================================================================


// function forthpeephole()  {                   \\ ( xt1 -- xt2 )
// }
// var x_peephole = primitive("peephole",forthpeephole) ;
// describe("xt1 -- xt2",jsf) ;





// =================================================================================================
//                                             utility
// =================================================================================================

definitions(forth) ;

function forthbye()  {
   forthsavebuffers();
   window.close() ;
}
primitive("bye",forthbye) ;
describe("--",any|foerthchen) ;


function forthdecimal() { m[base] = 10 ; }
var x_decimal = primitive("decimal",forthdecimal) ;
describe("--",any) ;


function forthhex() { m[base] = 16 ; }
var x_hex = primitive("hex",forthhex) ;
describe("--",any) ;




// ( a n -- )   execute as javascript
function fortheval()     {  forthpack();  eval(tos) ;   tos=s[sp--]; }
var x_eval = primitive("eval",fortheval)
describe("a n --",jsf) ;




// ----------- javascript popup dialogs ------------




// pops up an alert
function forthalert()   {                                 // ( a n -- )
   forthpack() ;
   alert(tos) ;
   tos = s[sp--] ;
}
primitive("alert",forthalert) ;
describe("a n --",jsf) ;




// pops up a confirm window
function forthconfirm()   {                                 // ( a n -- f )
   forthpack() ;
   tos = -confirm(tos) ;
}
primitive("confirm",forthconfirm) ;
describe("a n -- d",jsf) ;




function forthenter()   {                                 // ( a1 n1 a2 -- n2 )
   tos = unpackstring(prompt(pack(s[sp-1],s[sp])),tos) ;
   sp -= 2 ;
}
primitive("enter",forthenter) ;
describe("a1 n1 a2 -- n2",jsf) ;




// --------------- time ----------------




function forthms()  {
   suspended = w ;
   setTimeout(virtualmachine,tos,ip) ;
   tos = s[sp--] ;
}   
var x_ms = primitive("ms",forthms) ;
describe("u --",jsf) ;



function forthepoch()  {                                  // ( -- u )
   s[++sp] = tos ;
   w = new Date().getTime() ;
   tos = Math.floor(w/1000) ;    
}
primitive("epoch",forthepoch)
describe("-- u",jsf) ;


// ------------- random ---------------

function forthrandom()  {
   tos = Math.floor(Math.random() * tos) ;
}
primitive("random",forthrandom) ;
describe("u1 -- u2",jsf)





// ------------- http loading -------------



function loadurl(url)  {
   if (url.substr(0,7) != "http://")   url = ("http://" + url);
   window.frames['help'].window.location.replace(url);
}


function forthurl()  {      // ( a n -- )   open the url in a new window
   forthpack();
   loadurl(tos);
   tos=s[sp--];
}
primitive("url",forthurl)
describe("a n ",jsf);


function wiki(pagename)  {
   loadurl("wiki.forthfreak.net/index.cgi?" + pagename);
 }


function forthwiki()  {
   wiki(pack(s[sp],tos)) ;
   sp-- ;
   tos = s[sp--] ;
}
primitive("wiki",forthwiki) ;



function forthgpl()  { loadurl("www.gnu.org/licenses/gpl.txt")  }
primitive("gpl",forthgpl) ;
describe("--",jsf) ;


function forthquickref()  { wiki("JavaScriptForthQuickReference")  }
primitive("quickref",forthquickref) ;
describe("--",jsf) ;


function tutorials() { wiki("ForthTutorials") }
primitive("tutorials",tutorials) ;
describe("--",jsf) ;


function andsoforth() { loadurl("http://www.xs4all.nl/~thebeez/ForthPrimer/Forth_primer.html#tth_chAp2") }
primitive("AndSoForth",andsoforth) ;
describe("--",jsf) ;



function startingforth() { window.open("http://wiki.forthfreak.net/index.cgi/?StartingForth") }
primitive("starting",startingforth) ;
describe("--",jsf) ;




// ------------ "direct screen" -------------




function forthreadline()  {   //   ( n1 a -- n2 )  forth "direct" screen access 
   w = s[sp] ;
   s[sp] = terminal[tos] ;
   tos = w ;
   unpack() ;   
}
primitive("readline",forthreadline) ;
describe("a n1 -- n2",jsf) ;



function forthwriteline()  {   //   ( a n1 n2 -- )  forth "direct" screen access 
   for ( ; linesonscreen<=tos ; )  cr() ;
   w = s[sp--] ;
   terminal[tos] = pack(s[sp--],w) ;
   tos = s[sp--]
}
primitive("writeline",forthwriteline) ;
describe("a n1 n2 --",jsf) ;





// --------- helpers for see -----------




definitions(hidden) ;

// where is source ?  -1:console   -2: script   0..: blk*1024+charpos
function forthlocate()  { tos = src[tos] ; }      // ( xt -- n )
primitive("locate",forthlocate) ;
describe("xt -- n",jsf) ;

// fails with does> words
function forthwordtype()  {                       // ( xt1 -- xt2 )
   if (tos <= primitives)  {
      tos = 0 ;                       // primitive
   } else {
      tos = m[x[tos]] ;               // other
   }
}
primitive("wordtype",forthwordtype) ;
describe("xt1 -- xt2",jsf) ;


// returns source of a primitive
function forthdisassemble()  {                    // ( xt a -- n )
   var temp = (x[s[sp--]]) + " " ;
   tos = unpackstring(temp,tos) ;
}
primitive("disassemble",forthdisassemble) ;
describe("xt a -- n",jsf) ;
 
definitions(forth) ;




// ----- info screen tools -----




function infosall()  { allinfos = -1 } ; primitive("all",infosall) ;
describe("--",jsf) ;

function infostail() { allinfos = 0  } ; primitive("tail",infostail) ;
describe("--",jsf) ;



function setinfoslines()  { 
   infolines = tos ;
   info("* buffer size set to " + tos + " lines.") ;
   tos = s[sp--] ;
}
primitive("infolines",setinfoslines) ;
describe("u --",jsf) ;




// --------------------------------------




function forthloadhelp()  {    //  ( a n -- )
   var temp = "docs/jsforth.html" + "#" + pack(s[sp],tos);
   window.frames['help'].window.location.replace(temp.toUpperCase()) ;
   sp-- ;
   tos = s[sp--] ;
}
var x_loadhelp = primitive("loadhelp",forthloadhelp) ;








// =================================================================================================
// =================================================================================================
// =================================================================================================
// =================================================================================================
// =================================================================================================
//                               no more primitives below this point                                    
// =================================================================================================
// =================================================================================================
// =================================================================================================
// =================================================================================================
// =================================================================================================


var primitives = wc ;









// =================================================================================================
//                               builders for non-primitive words
// =================================================================================================

// could speed this up with proper linkage code in t[wc]
function constant(name,value)  {
   newheader(name,smudgebit) ;
   comma(x_doconst) ;
   comma(value) ;
   t[wc] = nextconstant ;
   return wc ;
}


function variable(name)  {
   newheader(name,smudgebit);
   comma(x_dovar);
   comma(0);
   t[wc] = nextvariable ;
   return wc;
}




function colon(name,flags)  {
   newheader(name,flags|smudgebit);
   comma(x_nest);
   t[wc] = nexthilevel ;
   return wc;
}


function alias(name,flags)  {
   newheader(name,flags|smudgebit);
   x[wc] = x[wc-1] ;
   t[wc] = t[wc-1] ;
   return wc;
}


function semicolon()  { jscomma(x_unnest)  }



// =================================================================================================
//                               control flow for using in this script
// =================================================================================================



function IF()        { m[dp++] = x_0branch ; s[++sp] = tos ; tos = dp ; dp++ ; }
function ELSE()      { m[dp++] = x_branch ; s[++sp] = dp ; dp++ ; m[tos] = dp-tos ; tos = s[sp--] ; }
function THEN()      { m[tos]  = dp-tos ; tos = s[sp--] ; }
function BEGIN()     { s[++sp] = tos ; tos = dp ; }
function UNTIL()     { m[dp++] = x_0branch ; m[dp] = tos-dp++ ; tos = s[sp--]; }
function WHILE()     { IF() ; }
function REPEAT()    { m[dp++] = x_branch  ; m[dp] = s[sp--]-dp++ ; m[tos] = dp-tos ; tos = s[sp--]; }
function AGAIN()     { m[dp++] = x_branch  ; m[dp] = tos-dp++ ; tos = s[sp--]; }
function makeDO(xt)  { m[dp++] = xt; s[++sp] = m[innerloop]; m[innerloop] = dp; s[++sp] = dp ; dp++ ; } 
function DO()        { makeDO(x_brdo)  ; }
function QDO()       { makeDO(x_brqdo) ; }
function LOOP()      { m[dp++] = x_brloop; m[dp++] = s[sp]+2-dp; m[s[sp]] = dp-s[sp--]; m[innerloop] = s[sp--]; }
function LEAVE()     { m[dp++] = x_brleave  ; m[dp++] = m[innerloop] ; }
function QLEAVE()    { m[dp++] = x_brqleave ; m[dp++] = m[innerloop] ; }






// =================================================================================================
//                           forth-visible constants and variables
// =================================================================================================


definitions(hidden) ;
var x_innerloop = constant("innerloop",innerloop) ;
var x_innercase = constant("innercase",innercase) ;


definitions(forth) ;
var x_minus1    = constant("-1",-1) ;                         describe("-- -1",jsf|foerthchen);
var x_0         = constant("0",0) ;                           describe("-- 0",any) ;
var x_1         = constant("1",1) ;                           describe("-- 1",any) ;
                  constant("cell",1) ;                        describe("-- u",ans|jsf) ;
var x_2         = constant("2",2) ;                           describe("-- 2",any) ;
var x_bl        = constant("bl",bl);                          describe("-- c",any) ;
var x_esc       = constant("esc",esc) ;                       describe("-- c",jsf) ;
                  constant("compliance",compliance) ;         describe("-- a",jsf) ;
                  constant("true",-1) ;                       describe("-- -1",any) ;
                  constant("false",0) ;                       describe("-- 0",any) ;
                  constant("casesensitive",casesensitive) ;   describe("-- a",jsf) ;
                  constant("popups",popups) ;                 describe("-- a",jsf) ;
                  constant("warnings",warnings) ;             describe("-- a",jsf) ;
                  constant("debugger",debugging) ;            describe("-- a",jsf) ;
var x_xontext   = constant("context",context) ;               describe("-- a",jsf) ;
var x_current   = constant("current",current) ;               describe("-- a",jsf) ;
var x_blk       = constant("blk",blk) ;                       describe("-- a",any) ;
var x_scr       = constant("scr",scr) ;                       describe("-- a",any) ;
var x_lastxt    = constant("last",lastxt) ;                   describe("-- a",jsf) ;
var x_base      = constant("base",base) ;                     describe("-- a",any) ;
var x_tib       = constant("tib",tib) ;                       describe("-- a",any) ;
var x_span      = constant("span",span) ;                     describe("-- a",fig|f79|f83|ans) ;
var x_hashtib   = constant("#tib",hashtib) ;                  describe("-- a","obsolete, variable containing #chars in tib",fig|f79|f83|ans) ;
var x_in        = constant(">in",toin) ;                      describe("-- a",any) ;
var x_state     = constant("state",state) ;                   describe("-- a",any) ;
                  constant("outfile",outfile) ;               describe("-- a",jsf) ;
                  constant("fit",fittype) ;                   describe("-- a",jsf) ;
                  constant("c/l",64) ;                        describe("-- u",jsf) ;
                  constant("l/s",16) ;                        describe("-- u",jsf) ;
                  constant("c/s",1024) ;                      describe("-- u",jsf) ;



var x_literal = colon("literal",immediate) ;
   compile(x_lit,x_lit,x_comma,x_comma) ;
semicolon() ;
 describe("x --",any) ;




// =================================================================================================
//                                             errors
// =================================================================================================

definitions(hidden) ;
var x_stackunderflow = colon("underflow")   ;   compile(x_lit,-4,x_throw) ;
var x_notfound       = colon("notfound")    ;   compile(x_lit,-13,x_throw) ;
definitions(hidden) ;

definitions(forth) ;
var x_abort          = colon("abort")       ;   compile(x_lit,-1,x_throw) ;
describe("--",any)   ;







// =================================================================================================
//                                          compilation
// =================================================================================================


var x_qcomp = colon("?comp") ;
   compile(x_compiling,x_0equ) ;
   IF() ;
      compile(x_lit,-14,x_throw) ;
   THEN() ;
semicolon() ;
describe("--",jsf) ;


var x_qexec = colon("?exec") ;
   compile(x_compiling) ;
   IF() ;
      compile(x_lit,-64,x_throw) ;
   THEN() ;
semicolon() ;
describe("--",jsf) ;


var x_compilecomma = colon("compile,",immediate) ;
   compile(x_qcomp,x_comma) ;
semicolon() ;
describe("xt --",any) ;







// =================================================================================================
//                                             strings
// =================================================================================================


definitions(hidden) ;

var x_commastr = colon(",$") ; 
     compile(x_here,x_over,x_1plus,x_allot,x_movestr);
semicolon()
describe("a n --",jsf) ;


definitions(forth) ;

// # ( <stream> -- ) compile a string from input stream
var x_commaquote = colon(',"');
   compile(x_lit,34,x_parse,x_commastr);
semicolon();
describe("--",jsf) ;


// # ( <stream> -- ) compile a string from input stream
var x_commatick = colon(",'");
   compile(x_lit,39,x_parse,x_commastr);
semicolon();
describe("--",jsf) ;


function forthscan()  {    // ( a1 n2 c -- a2 n2 )
   var temp = s[sp--] ;
   for ( ; temp ; temp--)  {
      if (m[s[sp]] == tos)  break ;
      s[sp]++ ;
   }
   tos = temp ;
}
primitive("scan",forthscan) ;
describe("a1 n2 c -- a2 n2",any) ;




function forthskip()  {    // ( a1 n2 c -- a2 n2 )
   var temp = s[sp--] ;
   for ( ; temp ; temp--)  {
      if (m[s[sp]] != tos)  break ;
      s[sp]++ ;
   }
   tos = temp ;
}
primitive("skip",forthskip) ;
describe("a1 n2 c -- a2 n2",any) ;




definitions(hidden) ;

var x_compilestringword = colon('string\",') ;
   compile(x_qcomp,x_comma,x_commaquote) ;
semicolon() ;

var x_compiletickstringword = colon("string',") ;
   compile(x_qcomp,x_comma,x_commatick) ;
semicolon() ;


definitions(forth) ;

var x_squote = colon('s"',immediate) ;
   compile(x_lit,x_brsquote,x_compilestringword);
semicolon();
describe("--",any) ;



var x_cquote = colon('c"',immediate);
   compile(x_lit,x_brcquote,x_compilestringword);
semicolon();
describe("--",ans|jsf) ;



var x_dotquote = colon('."',immediate);
   compile(x_lit,x_brdotquote,x_compilestringword);
semicolon();
describe("--",any|foerthchen) ;





colon("s'",immediate) ;
   compile(x_lit,x_brsquote,x_compiletickstringword);
semicolon();
describe("--",any) ;


colon(".'",immediate);
   compile(x_lit,x_brdotquote,x_compiletickstringword);
semicolon();
describe("--",any|foerthchen) ;


var x_dumul = colon("du*")     // ( ud1 u -- ud2 )
   compile(x_tuck,x_2tor,x_ummul,x_0,x_2rfrom,x_mul,x_dplus)
semicolon() ;



colon(">number") ;
   compile(x_2dup,x_plus,x_tor);
   compile(x_0) ;
   QDO() ;
      compile(x_count,x_digit,x_dup,x_0less) ;
      IF() ;
         compile(x_drop,x_1minus) ;
         LEAVE() ;
      THEN() ;
      compile(x_swap,x_tor,x_tor);
      compile(x_base,x_fetch,x_dumul);
      compile(x_rfrom,x_0,x_dplus);
      compile(x_rfrom) ;
   LOOP() ;
   compile(x_rfrom,x_over,x_minus);

semicolon() ;
describe("ud1 a1 u1 -- ud2 a2 u2",ans|jsf)




// function forthtonumber()  {              // ( ud1 a1 u1 -- ud2 a2 u2 )
//   var digit ;
//   var radix = m[base] ;
//   w = s[sp] ;
//   for ( ; tos ; tos-- )   {
//      digit = m[w] - 48 ;
//      if ( digit > 16 )  digit -= 7 ;
//      if ( digit > 36 )  digit -= 32 ;
//      if ( (digit >= 0) && (digit < radix) )  {

//         s[sp-2] *= radix ;                   
//         s[sp-2] += digit ;

//         w++ ;
//      } else  {
//         s[sp] = w ;
//         break ;
//      }
//   }
// }
// primitive(">number",forthtonumber) ;
// describe("d1 a1 n1 -- d2 a2 n2",ans|jsf) ;







var x_abortquote = colon('abort"',immediate);
   compile(x_lit,x_brabortquote,x_compilestringword);
semicolon();
describe("--",any) ;







// =================================================================================================
//                                         defining words
// =================================================================================================


// ( a <stream> -- )
var x_create = colon("create") ;    compile(x_lit,x_dovar,x_use,x_reveal) ; semicolon() ;
describe("--",any) ;


var x_const  = colon("constant") ;
   compile(x_lit,x_doconst,x_use,x_comma,x_reveal) ;    // which is left in here for the moment. doesn't hurt.
semicolon() ;
describe("x --",any) ;


colon("fconstant")   ;              compile(x_lit,x_dofconst,x_use,x_fcomma,x_reveal) ; semicolon() ;
describe("r -- ) ( -- r )",ans|jsf) ;


colon("value")      ;               compile(x_lit,x_dovalue,x_use,x_comma,x_reveal) ; semicolon() ;
describe("x --",ans|jsf) ;


colon("variable")   ;               compile(x_create,x_0,x_comma) ; semicolon() ;
describe("--",any) ;

alias("fvariable") ;
describe("-- ) ( -- a",any) ;


colon(";",immediate) ;              compile(x_lit,x_unnest,x_comma,x_bropen,x_reveal) ; semicolon() ;
describe("--",any|foerthchen) ;


colon(":") ;                        compile(x_lit,x_nest,x_use,x_brclose) ; semicolon() ;
describe("<wordname> --",any|foerthchen) ;


colon("does>",immediate) ;
   compile(x_lit,x_setdoes,x_compilecomma) ;
   compile(x_lit,x_unnest,x_compilecomma)  ;
semicolon() ;
describe("--",any) ;




// =================================================================================================
//                                                i/o
// =================================================================================================


var x_keyq = colon("key?") ;   compile(x_key1query,x_key2query) ; semicolon() ;
describe("-- f",jsf) ;


colon("?terminal") ; compile(x_keyq) ; semicolon() ;
describe("-- f",fig|f79) ;


var x_key = colon("key") ;   compile(x_key1,x_key2) ; semicolon() ;
describe("-- c",any) ;



var x_word = colon("word") ;
   compile(x_parse,x_here,x_movestr,x_here) ;
semicolon() ;
describe("c -- a",any|foerthchen) ;



var x_accept = colon("accept") ;                                  // ( a n1 -- n2 )
   compile(x_over,x_swap,x_1plus) ;
   BEGIN() ;
      compile(x_qdup) ;
   WHILE() ;
      compile(x_key,x_decode) ;
   REPEAT() ;
   compile(x_swap,x_minus) ;
semicolon() ;
describe("a n1 -- n2",ans|jsf) ;



colon("expect")
   compile(x_accept,x_span,x_store) ;
semicolon() ;
describe("a n --",fig|f79|f83|ans) ;




var x_query = colon("query") ;
   compile(x_tib,x_dup,x_lit,tibsize,x_accept) ;
   compile(x_dup,x_hashtib,x_store,x_storesource) ;
   compile(x_in,x_off,x_space) ;
semicolon() ;
describe("--",any) ;



var x_sbr = colon("s(") ;
   compile(x_lit,41,x_parse) ;
semicolon() ;
describe("-- a n",jsf) ;



colon(".(",immediate) ;
   compile(x_sbr,x_type) ;
semicolon() ;
describe("<stream> --",ans|jsf) ;



var x_char = colon("char",immediate) ;                                       // char
   compile(x_bl,x_parse,x_drop,x_cfetch);
   compile(x_compiling) ;
   IF() ;
      compile(x_literal) ;
   THEN() ;
semicolon() ;
describe("<stream> -- c",ans|jsf) ;
alias("[char]",immediate) ;                                                  // [char]
describe("<stream> -- c",ans|jsf) ;



colon("\\",immediate) ;
   compile(x_0,x_parse,x_2drop) ;
semicolon() ;
describe("<stream> --",any) ;



colon("(",immediate) ;
   compile(x_lit,41,x_parse,x_2drop) ;
semicolon() ;
describe("<stream> --",any) ;



colon("(s",immediate) ;
   compile(x_lit,41,x_parse,x_mintrailing,x_storestackeffect) ;
semicolon() ;
describe("<stream> --",any) ;



var x_hash = colon("#")  ;
   compile(x_base,x_fetch,x_udslashmod,x_rot,x_lit,9,x_over,x_less)
   IF() ;
      compile(x_lit,39,x_plus) ;
   THEN() ;
   compile(x_lit,48,x_plus,x_hold) ;
semicolon() ;
describe("d1 -- d2",any) ;



var x_hashs = colon("#s") ;
   BEGIN() ;
      compile(x_hash,x_2dup,x_or,x_0equ)
   UNTIL() ;
semicolon() ;
describe("d1 -- d2",any) ;






var x_parenddot = colon("(d.)") ;
   compile(x_dup,x_tor,x_dabs,x_lesshash,x_hashs,x_rfrom,x_sign,x_hashmore,x_type) ;
semicolon() ;
describe("d --",any) ;



var x_ddot = colon("d.")  ;                                              // d.
   compile(x_parenddot,x_space) ;
semicolon() ;
describe("d --",any) ;



var x_ddotr = colon("d.r")  ;                                            // d.r
   compile(x_tor) ;
   compile(x_dup,x_tor,x_dabs,x_lesshash,x_hashs,x_rfrom,x_sign,x_hashmore) ;
   compile(x_rfrom,x_2dup,x_more) ; 
   IF() ;
      BEGIN() ;
         compile(x_qdup) ;
      WHILE() ;
         compile(x_1minus,x_lit,42,x_emit)
      REPEAT() ;
      compile(x_2drop) ;
   ELSE() ;
      compile(x_over,x_minus,x_spaces,x_type) ;
   THEN() ;
semicolon() ;
describe("d --",any) ;



var x_udot = colon("u.")  ;                                              // u.
   compile(x_0,x_ddot) ;
semicolon() ;
describe("u --",any) ;



var x_dot = colon(".")  ;                                                // .
   compile(x_stod,x_ddot) ;
semicolon() ;
describe("n --",any) ;



colon("(.)") ;
   compile(x_stod,x_parenddot) ;
semicolon() ;
describe("n --",foerthchen) ;




colon("u.r")  ;                                                          // u.r  ( u1 u2 -- )
   compile(x_0,x_swap,x_ddotr) ;
semicolon() ;
describe("u1 u2 --",any) ;



var x_dotr = colon(".r")  ;                                              // .r  ( n u -- )
   compile(x_tor,x_stod,x_rfrom,x_ddotr) ;
semicolon() ;
describe("n u --",any) ;






// =================================================================================================
//                                        flow control
// =================================================================================================



definitions(hidden) ;

var x_structured = colon("structured") ;
   compile(x_2dup,x_nequ) ;
   IF() ;
      compile(x_unstructured)
   THEN() ;
   compile(x_2drop) ;
semicolon() ;

var x_resolve = colon("resolve") ;
   compile(x_here,x_minus,x_comma) ;
semicolon() ;

var x_resolveback = colon("<resolve") ;
   compile(x_here,x_over,x_minus,x_swap,x_store) ;
semicolon() ;

var x_qclause = colon("?clause") ;
   compile(x_lit,x_0branch,x_comma) ;
semicolon() ;

var x_clause = colon("clause") ;
   compile(x_lit,x_branch,x_comma) ;
semicolon() ;

var x_mark = colon("mark") ;
   compile(x_here,x_0,x_comma) ;
semicolon() ;


definitions(forth) ;


var x_for = colon("for",immediate) ;
   compile(x_qcomp,x_lit,x_brfor,x_comma) ;
   compile(x_here,x_innerloop,x_exchange) ;
   compile(x_here,x_0,x_comma) ;
   compile(x_lit,6) ;
semicolon() ;
describe("n --",jsf) ;


var x_next = colon("next",immediate) ;
   compile(x_qcomp,x_lit,6,x_structured) ;
   compile(x_lit,x_brnext,x_comma) ;
   compile(x_dup,x_1plus,x_resolve) ;
   compile(x_resolveback,x_innerloop,x_store) ;
semicolon() ;
describe("--",jsf) ;



var x_if = colon("if",immediate) ;
   compile(x_qcomp,x_qclause,x_mark,x_1) ;
semicolon() ;
describe("f --",any) ;



var x_else = colon("else",immediate) ;
   compile(x_qcomp,x_1,x_structured,x_clause,x_mark) ;
   compile(x_swap,x_resolveback,x_2) ;
semicolon() ;
describe("--",any) ;



var x_then = colon("then",immediate) ;
   compile(x_qcomp,x_dup,x_2,x_equ,x_plus) ;
   compile(x_1,x_structured,x_resolveback) ;
semicolon() ;
describe("--",any) ;

alias("endif",immediate) ;
describe("-- ) ( --",jsf) ;



var x_begin = colon("begin",immediate) ;
   compile(x_qcomp,x_here,x_lit,3) ;
semicolon() ;
describe("--",any) ;



var x_while = colon("while",immediate) ;
   compile(x_qcomp,x_lit,3,x_structured) ;
   compile(x_qclause,x_mark,x_lit,4) ;
semicolon() ;
describe("f --",any) ;



var x_repeat = colon("repeat",immediate) ;
   compile(x_qcomp,x_lit,4,x_structured) ;
   compile(x_swap,x_clause,x_resolve) ;
   compile(x_resolveback) ;
semicolon() ;
describe("--",any) ;



var x_again = colon("again",immediate) ;
  compile(x_qcomp,x_lit,3,x_structured,x_clause,x_resolve) ;
semicolon() ;
describe("--",any) ;



var x_until = colon("until",immediate) ;
  compile(x_qcomp,x_lit,3,x_structured,x_qclause,x_resolve) ;
semicolon() ;
describe("f --",any) ;



var x_do = colon("do",immediate)
  compile(x_qcomp,x_lit,x_brdo,x_comma) ;
  compile(x_here,x_innerloop,x_exchange) ;
  compile(x_here,x_0,x_comma) ;
  compile(x_lit,5) ;
semicolon() ;
describe("x1 x2 --",any) ;


var x_qdo = colon("?do",immediate)
  compile(x_qcomp,x_lit,x_brqdo,x_comma) ;
  compile(x_here,x_innerloop,x_exchange) ;
  compile(x_here,x_0,x_comma) ;
  compile(x_lit,5) ;
semicolon() ;
describe("x1 x2 --",any) ;


var x_loop = colon("loop",immediate)
  compile(x_qcomp,x_lit,5,x_structured) ;
  compile(x_lit,x_brloop,x_comma) ;
  compile(x_dup,x_1plus,x_resolve) ;
  compile(x_resolveback);
  compile(x_innerloop,x_store) ;
semicolon() ;
describe("--",any) ;



var x_plusloop = colon("+loop",immediate) ;
  compile(x_qcomp,x_lit,5,x_structured) ;
  compile(x_lit,x_brplusloop,x_comma) ;
  compile(x_dup,x_1plus,x_resolve) ;
  compile(x_resolveback) ;
  compile(x_innerloop,x_store) ;
semicolon() ;
describe("n --",any) ;



definitions(hidden) ;

var x_leavecomma = colon("leave,") ;
  compile(x_qcomp,x_innerloop,x_fetch,x_qdup,x_0equ) ;
  IF() ;
     compile(x_lit,-26,x_throw) ;
  THEN() ;
  compile(x_swap,x_comma,x_comma) ;
semicolon() ;
describe("xt --",any) ;


definitions(forth) ;

// fig/f79 leave is different from later leave:
// leaving loop was only done when loop was reached,
// statements between leave and loop were still executed.
colon("leave",immediate) ;
   compile(x_lit,x_brleave79,x_comma) ;
semicolon() ;
describe("--",f79|fig) ;


var x_leave = colon("leave",immediate) ;
   compile(x_lit,x_brleave,x_leavecomma) ;
semicolon() ;
describe("--",ans|f83|jsf) ;



var x_qleave = colon("?leave",immediate) ;
   compile(x_lit,x_brqleave,x_leavecomma) ;
semicolon() ;
describe("f --",jsf) ;



colon("unloop",immediate) ;
   compile(x_qcomp,x_innerloop,x_fetch,x_0equ) ;
   IF() ;
      compile(x_lit,-26,x_throw) ;
   THEN() ;
   compile(x_lit,x_brunloop,x_comma,x_unnest) ;
semicolon() ;
describe("--",ans|f83|jsf) ;





// structure check is still limited.
// doesn't complain when of .. endof is used outside of case .. endcase
colon("case",immediate) ;
   compile(x_qcomp) ;
   compile(x_0,x_innercase,x_exchange) ;
   compile(x_lit,7) ;
semicolon() ;
describe("--",ans|f83|jsf) ;


colon("of",immediate) ;
   compile(x_qcomp) ;
   compile(x_lit,x_brof,x_comma,x_mark) ;
   compile(x_1,x_innercase,x_plusstore) ;
   compile(x_lit,8) ;
semicolon() ;
describe("--",ans|f83|jsf) ;


colon("endof",immediate) ;
   compile(x_qcomp,x_lit,8,x_structured) ;
   compile(x_clause,x_mark) ;
   compile(x_swap,x_resolveback) ;
semicolon() ;
describe("--",ans|f83|jsf) ;


colon("endcase",immediate) ;
   compile(x_qcomp) ;
   compile(x_lit,x_drop,x_comma) ;
   compile(x_innercase,x_fetch) ;
   BEGIN() ;
      compile(x_qdup)
   WHILE() ;
      compile(x_1minus,x_swap,x_resolveback) ;
   REPEAT() ;
   compile(x_lit,7,x_structured) ;
   compile(x_innercase,x_store) ;
semicolon() ;
describe("--",ans|f83|jsf) ;





// =================================================================================================
//                                   dictionary + compiling
// =================================================================================================

definitions(forth) ;


var x_tick = colon("'") ;
   compile(x_bl,x_parse,x_search,x_qdup,x_0equ) ;
   IF() ;
      compile(x_notfound) ;   
   THEN() ;
semicolon() ;
describe("<stream> -- xt",ans|f83|jsf) ;



colon("'") ;
   compile(x_tick,x_tobody) ;
semicolon() ;
describe("<stream> -- a",fig|f79) ;



var x_brtick = colon("[']",immediate) ;
   compile(x_tick,x_literal) ;
semicolon() ;
describe("-- a",any) ;



colon("[compile]",immediate) ;
   compile(x_tick,x_comma) ;
semicolon() ;
describe("--",any) ;



colon("recurse",immediate) ;
   compile(x_lastxt,x_fetch,x_comma) ;
semicolon() ;
describe("--",ans|f83|jsf) ;



colon("to",immediate)
   compile(x_tick,x_tobody,x_dup,x_1minus,x_fetch,x_lit,x_dovalue,x_nequ,x_lit,-67,x_and,x_throw) ;
   compile(x_compiling) ;
   IF() ;
      compile(x_lit,x_brto,x_comma,x_comma) ;
   ELSE() ;
      compile(x_store) ;
   THEN() ;
semicolon() ;
describe("<stream> x --",ans|jsf) ;





// =================================================================================================
//                                          interpreter
// =================================================================================================


definitions(hidden);

var x_interpret = colon("interpret") ;                     // ( -- )
   BEGIN() ;
      compile(x_bl,x_parse,x_dup) ;
   WHILE() ;
      compile(x_2dup,x_search,x_qdup) ;
      IF() ;
         compile(x_nip,x_nip,x_dup,x_qimm) ;
         IF() ;
            compile(x_execute) ;
         ELSE() ;
            compile(x_compiling) ;
            IF() ;
               compile(x_comma) ;
            ELSE() ;
               compile(x_execute) ;
            THEN() ;
         THEN() ;
         compile(x_depth,x_0less) ;
         IF() ;
            compile(x_stackunderflow) ;
         THEN() ;
      ELSE() ;
         compile(x_interpretnumber,x_0equ) ;
         IF() ;
            compile(x_notfound);
         THEN() ;
      THEN() ;
   REPEAT() ;
   compile(x_2drop) ;
semicolon();
describe("--",jsf) ;






definitions(forth) ;

var x_evaluate = colon("evaluate") ;                      // ( a n -- )
   compile(x_pushsource) ;
   compile(x_in,x_off) ;
   compile(x_storesource);
   compile(x_interpret)  ;
   compile(x_popsource)  ;
semicolon() ;
describe("a n --",ans|jsf) ;




var x_load = colon("load") ;
   compile(x_dup,x_blk,x_exchange,x_tor) ;
   compile(x_block,x_lit,1024,x_evaluate) ;
   compile(x_rfrom,x_dup,x_blk,x_store) ;
   compile(x_dup,x_0less,x_0equ)
   IF() ;
      compile(x_dup,x_block,x_lit,1024,x_storesource) ;
   THEN() ;
   compile(x_drop) ;
semicolon() ;
describe("u --",any)




var x_screen = colon("screen") ;
   compile(x_scr,x_fetch,x_block) ;
semicolon() ;
describe("-- a",jsf) ;



var x_dotline = colon(".line") ;
   compile(x_lit,64,x_mul,x_screen,x_plus,x_lit,64,x_mintrailing,x_type) ;
semicolon() ;
describe("u --",jsf) ;



var x_plusload = colon("+load") ;
     compile(x_blk,x_fetch,x_plus,x_load) ;
semicolon() ;
describe("u --",any) ;



colon("thru") ;
   compile(x_1plus,x_swap) ;
   QDO() ;
      compile(x_i,x_load) ;
   LOOP();
semicolon() ;
describe("u1 u2 --",any) ;



colon("+thru") ;
   compile(x_1plus,x_swap) ;
   QDO() ;
      compile(x_i,x_plusload) ;
   LOOP();
semicolon() ;
describe("u1 u2 --",any) ;



var x_l = colon("l") ;
   compile(x_lit,16,x_0) ;
   DO() ;
      compile(x_cr,x_i,x_2,x_dotr,x_lit,124,x_emit,x_i,x_dotline) ;
   LOOP() ;
semicolon() ;
describe("--",jsf) ;



colon("list") ;
   compile(x_scr,x_store,x_l) ;
semicolon() ;
describe("u --",any) ;



colon("blank") ;
   compile(x_bl,x_fill) ;
semicolon() ;
describe("a u --",any) ;



// =================================================================================================
//                                              utility
// =================================================================================================


colon("help") ;
   compile(x_bl,x_parse,x_loadhelp) ;
semicolon() ;


definitions(teststuff) ;
var x_x = colon("x") ;   // execute rest of line as javscript
   compile(x_0,x_parse,x_eval) ;
semicolon() ;
describe("<stream> --",jsf) ;


var x_jsconsole = colon("") ;
   BEGIN() ;
      compile(x_cr,x_lit,62,x_emit,x_query,x_x) ;
   AGAIN() ;
semicolon() ;


colon("js") ;                                 // javascript console
   BEGIN() ;
      compile(x_lit,x_jsconsole,x_catch,x_drop) ;
   AGAIN() ;
semicolon() ;
describe("--",jsf) ;






// =================================================================================================
//                                     interpreter entry points
// =================================================================================================


definitions(forth) ;
var x_quit = colon("quit") ;
   BEGIN() ;
      compile(x_query,x_source,x_qdup)
      IF() ;
         compile(x_cr,x_evaluate) ;
         compile(x_space,x_0) ;
      THEN() ;
      compile(x_drop,x_prompt) ;
   AGAIN() ;
describe("??? --",any) ;
semicolon() ;

var x_warm = colon("warm") ; compile(x_warminit,x_quit) ;
describe("??? --",jsf) ;


var x_cold = colon("cold") ; compile(x_coldinit,x_page,x_hello,x_cr,x_warm) ;
describe("??? --",jsf) ;

definitions(hidden) ;

var x_error = colon("error") ;
   compile(x_throw) ;
describe("??? n --",jsf) ;

definitions(forth) ;


var warm    = dp ; comma(x_warm)  ;   // called with  virtualmachine(warm)
var cold    = dp ; comma(x_cold)  ;   // called with  virtualmachine(cold)
var error   = dp ; comma(x_error) ;   // called from  javascript onError

dp_cold = dp ;
wc_cold = wc ;
heap_cold = heapend ;


function virtualmachine(entrypoint)  {
   suspended = 0 ;
   ip=entrypoint ;
   do {
      w=m[ip++] ;                                 // read next xt from address list
      t[w]();                                     // execute
   } while (!suspended)
   write("") ;                                    // flush output buffer
}


if (version != -1)  virtualmachine(cold)          // initialize interpreter





// =================================================================================================
//                                        input events
// =================================================================================================



// The new set of i/o routines implement query in forth, by calling upon accept, which in turn calls key. 

function KeyEvent(e)  {
   inbuf.push((e.keyCode | e.which)) ;            // read and buffer key
   if (suspended == x_key1) virtualmachine(ip) ;  // reenter interpreter
   return false ;                                 // char not echoed - accept handles this.
}



function FocusEvent(e)  {
   document.terminal.dialog.focus();
   return true ;
}



function PasteEvent(e)  {
//   inbuf.push(window.getSelection) ;             // read and buffer key
//   if (suspended == x_key1) virtualmachine(ip) ; // reenter interpreter
//     info("PasteEvent: " + window.getSelection(e)) ;
   return false ;                                // char not echoed - accept handles this.
}




function getHelp(e)  { 
   return true ;
}



function SelectEvent(e)  { 
   allinfos = allinfos ^ -1 ;                     // mouse click toggle backscroll
   printinfos() ;
   return false ; 
}




function ErrorEvent(msg,url,line)  {
   if (msg.substr(0,8) == "uncaught")    {       // can't handle these
      info("uncaught javascript exception ignored") ;
      return true ; 
   }
   systemerror[68] = (msg + " (line " + line + ")") ;
   tos = -68 ;
   virtualmachine(error) ;
   return !(m[warnings]) ;
}






// =================================================================================================
//                                        end of program
// =================================================================================================


// unsolved:
//   have getSelection actually return the marked string (for HELP on doubleclick)