toctave

toctave.jitter (4762B)

---

 # toctave VM specification
 
 # Copyright (C) 2020-2021, Mohammad-Reza Nabipoor
 # SPDX-License-Identifier: GPL-3.0-or-later
 
 vm
   set prefix "toctave"
 end
 
 stack s
   long-name "mainstack"
   c-element-type "double"
   c-initial-value "0.0"
   element-no 4096
   guard-underflow
   guard-overflow
   tos-optimized
 end
 
 wrapped-functions
   pow
   toctave_var
   toctave_var_set
 end
 
 state-struct-runtime-c
   code
     double result;
 
     jitter_program_point point;
     int status;
     void* env;
   end
 end
 
 state-initialization-c
   code
     jitter_state_runtime->result = 0.0 / 0.0; // NaN
     jitter_state_runtime->point = NULL;
     jitter_state_runtime->status = -1;
   end
 end
 
 early-header-c
   code
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
 #include <stdint.h>
 
 _Bool toctave_var(void* env, const char* name, double* val);
 void toctave_var_set(void* env, const char* name, double val);
 
 union double_uint64
 {
   double d;
   uint64_t u64;
 };
 
 #define TOCTAVE_STATUS_DONE 0
 #define TOCTAVE_STATUS_YIELD 1
   end
 end
 
 initial-vm1-c
   code
 #define nan_unbox_uint(p) (((p) & /*mask*/(((uint64_t)1 << 51) - 1)) << 3)
 #define nan_unbox(dbl) nan_unbox_uint(((union double_uint64){ .d = (dbl) }).u64)
   end
 end
 
 initial-vm2-c
   code
 #define nan_unbox_uint(p) (((p) & /*mask*/(((uint64_t)1 << 51) - 1)) << 3)
 #define nan_unbox(dbl) nan_unbox_uint(((union double_uint64){ .d = (dbl) }).u64)
   end
 end
 
 printer-c
   code
 
 // Jitter uses this function to print literal values in instructions (like
 // push instruction)
 static void
 double_literal_printer(jitter_print_context ctx, uintptr_t n)
 {
   union double_uint64 x;
 
   x.u64 = n;
   jitter_print_double(ctx, x.d);
 }
 
 static void
 var_literal_printer(jitter_print_context ctx, uintptr_t n)
 {
   union double_uint64 x;
 
   x.u64 = n;
   n = nan_unbox(x.d); // reusing `n`
   jitter_print_char_star(ctx, (const char*)n);
 }
 
   end
 end
 
 # Stack manipulation
 
 # Push a double on the stack
 # Stack: ( -- a)
 instruction push (?n double_literal_printer)
   code
     union double_uint64 x;
 
     x.u64 = JITTER_ARGN0;
     TOCTAVE_PUSH_MAINSTACK(x.d);
   end
 end
 
 # Pop the value on stack and save it into `result` field
 # Stack: (a -- )
 instruction pop ()
   code
     TOCTAVE_STATE_RUNTIME_FIELD(result) = TOCTAVE_TOP_MAINSTACK();
     TOCTAVE_DROP_MAINSTACK();
   end
 end
 
 # Drop the value on stack
 # Stack: (a -- )
 instruction drop ()
   code
     TOCTAVE_DROP_MAINSTACK();
   end
 end
 
 # Push the value of variable onto the stack
 # Stack: ( -- a)
 instruction pushvar (?n var_literal_printer) # , ?f)
   code
     const char* name = (const char*)nan_unbox_uint(JITTER_ARGN0);
     // For simplicity, we assume the variable is defined
     double d;
     _Bool found = toctave_var(TOCTAVE_STATE_RUNTIME_FIELD(env), name, &d);
 
     // JITTER_BRANCH_FAST_IF_NONZERO(found, JITTER_ARGF1);
     if (!found)
       d = 0.0 / 0.0; // Put a NaN there
     TOCTAVE_PUSH_MAINSTACK(d);
   end
 end
 
 # Pop the value on the stack and save it into variable
 # Stack: (a -- )
 instruction popvar (?n var_literal_printer)
   code
     const char* name = (const char*)nan_unbox_uint(JITTER_ARGN0);
 
     toctave_var_set(
       TOCTAVE_STATE_RUNTIME_FIELD(env), name, TOCTAVE_TOP_MAINSTACK());
     TOCTAVE_DROP_MAINSTACK();
   end
 end
 
 instruction pushnan ()
   code
     TOCTAVE_PUSH_MAINSTACK(0.0 / 0.0);
   end
 end
 
 # Arithmetic
 
 # Stack: (a b -- a^b)
 instruction pow ()
   code
     TOCTAVE_TOP_MAINSTACK() =
       pow(/* a */ TOCTAVE_UNDER_TOP_MAINSTACK(),
           /* b */ TOCTAVE_TOP_MAINSTACK()); /* Stack: (a a^b) */
     TOCTAVE_NIP_MAINSTACK();                /* Stack: (a^b) */
   end
 end
 
 # Stack: (a b -- a*b)
 instruction mul ()
   code
     TOCTAVE_TOP_MAINSTACK() =
       /* a */ TOCTAVE_UNDER_TOP_MAINSTACK() *
       /* b */ TOCTAVE_TOP_MAINSTACK(); /* Stack: (a a*b) */
     TOCTAVE_NIP_MAINSTACK();           /* Stack: (a*b) */
   end
 end
 
 # Stack: (a b -- a/b)
 instruction div ()
   non-relocatable
   code
     TOCTAVE_TOP_MAINSTACK() =
       /* a */ TOCTAVE_UNDER_TOP_MAINSTACK() /
       /* b */ TOCTAVE_TOP_MAINSTACK(); /* Stack: (a a*b) */
   end
 end
 
 # Stack: (a b -- a+b)
 instruction add ()
   code
     TOCTAVE_TOP_MAINSTACK() =
       /* a */ TOCTAVE_UNDER_TOP_MAINSTACK() +
       /* b */ TOCTAVE_TOP_MAINSTACK(); /* Stack: (a a*b) */
   end
 end
 
 # Stack: (a b -- a-b)
 instruction sub ()
   code
     TOCTAVE_TOP_MAINSTACK() =
       /* a */ TOCTAVE_UNDER_TOP_MAINSTACK() -
       /* b */ TOCTAVE_TOP_MAINSTACK(); /* Stack: (a a*b) */
   end
 end
 
 # Control Flow
 
 instruction yield (?l)
   code
     TOCTAVE_STATE_RUNTIME_FIELD(point) = JITTER_ARGP0;
     TOCTAVE_STATE_RUNTIME_FIELD(status) = TOCTAVE_STATUS_YIELD;
   end
 end
 
 instruction done ()
   code
     TOCTAVE_STATE_RUNTIME_FIELD(point) = NULL;
     TOCTAVE_STATE_RUNTIME_FIELD(status) = TOCTAVE_STATUS_DONE;
   end
 end