1,250c1,250
< //
< // interp.cpp
< // Interpreter class implementation
< // F.J. Alberti
< //
< // FA   17/05/2001   Alignment
< // FA   21/05/2001   Debugger support
< // FA   06/06/2001   Includes baselib.h
< // FA   15/06/2001   Call debugger handlers
< // FA   27/06/2001   #Define MSGEASSERT for developper and client versions
< // FA   02/07/2001   The fp and bp registers are defined as instance variables
< //                   in the debugger-aware version
< // FA   03/07/2001   The pc, fp and bp registers are initialised to 0. Set up
< //                   Interpreter::current to point to currently executing
< //                   instance
< // FA   06/08/2001   This file has been moved into 'vm' directory
< // FA   09/08/2001   Add the getCallStackRegisters() utility
< // FA   03/09/2001   The pc register is defined as an instance variable
< //                   in the debugger-aware version
< // FA   12/11/2001   Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER/RELEASE_DEVELOPER
< //                   Prints the call stack when an error occurs
< //
< 
< #include <stdio.h>
< #include <string.h>
< #include "include/except.h"
< #include "align.h"
< #include "base.h"                     // future types.h
< #include "baselib.h"
< #include "debug.h"
< #include "interp.h"
< #include "macros.h"
< #include "mbytec.h"
< 
< extern "C" {
< #include "listlab.h"                  // definition of OFFVNAME
< int MMneedMemory(mmachine, int, int);
< int SCKtestLife();
< }
< 
< /*
< class AssertException: public Exception {
< public:
<   AssertException(const char* text);
<   virtual ~AssertException();
< 
<   const char* what() const;
< };
< 
< 
< AssertException::AssertException(const char* text)
<   : Exception(MERRTYP, text)
< {
< }
< 
< 
< AssertException::~AssertException()
< {
< }
< 
< 
< const char* AssertException::what() const
< {
<   return Exception::what();
< }
< */
< 
< 
< // Current interpreter instance
< Interpreter* Interpreter::current = 0;
< 
< 
< // Probe life socket every 'kLifeSocketProbePeriod' iterations
< const uint kLifeSocketProbePeriod = 1000000;
< 
< 
< // Bytecode fetching should be as simple as possible. It is still a bit
< // complicated...
< #define fetch(pc)            (((byte*)&m->tape[(m->top[bp+OFFHCODE]>>1)+SizeHeader])[pc])
< #define checkUnderflow(m)    if ((m)->pp >= (m)->maxpp)\
<                                throw Exception(-1);
< #define checkOverflow(m, n)  if ((m)->pp+(m)->sizetape < (m)->topheap+(n)+(m)->sigGC)\
<                              { if (res = MMneedMemory(m, (n), (n)))\
<                                throw Exception(res); }
< 
< 
< 
< // Interpreter::exec() errors
< #define MSGIILLOPCODE           "Interpreter::exec(): Illegal opcode 0x%x"
< #define MSGIFUNRET              "Interpreter::exec(): Misbehaved function call"
< //#define MSGEDIVISIONBYZERO    "Division by zero"
< #define MSGEILLARRAYSIZE        "Size of new array is illegal (%d)"
< #define MSGEILLARRAYINDEX       "Array index (%d) is out of bounds. (Array size is %d.)"
< #if defined(RELEASE_DEVELOPER)
< #  define MSGEASSERT            "Package '%s', line #%d, function '%s' (0x%x): %s"
< #  define MSGWNATIVEISNULL      "Warning: Package '%s', function '%s': Native function is null"
< #  define MSGENATIVEMISBEHAVED  "Package '%s', function '%s': Native function unbehaved!"
< #else
< #  define MSGEASSERT            "Function 0x%x, line #%d: %s"
< #  define MSGENATIVEMISBEHAVED  "Function at address 0x%x (arity %d): Native function unbehaved!"
< #endif
< 
< 
< 
< Interpreter::Interpreter(mmachine _m)
<   : m(_m)
< {
< }
< 
< 
< Interpreter::~Interpreter()
< {
< }
< 
< 
< int Interpreter::_exec(int opcode)
< {
< #if !defined(RELEASE_DEVELOPER)
<   register int32 pc;                  // program counter
<   register int32 fp;                  // frame pointer
<   register int32 bp;                  // base pointer of operand stack
< #endif
<   int            res      = MERROK;   // resulting error
<   bool           tailcall = false;    // tail call flag
< 
<   // Initialise registers
<   pc = bp = fp = 0;
< 
<   try {
<     for (;;) {
<       for (int i = 0; i < kLifeSocketProbePeriod; i++) {
< #if defined(SCOL_DEBUG)
<         // Check that opcode is within range
<         if (opcode < 0 || opcode > kMaxOpcode)
<           throw Exception(MERRTYP, "(!) "MSGIILLOPCODE"\n", opcode);
< #endif
<       //MMechostr(MSKTRACE, "opcode = 0x%x\n", opcode);
<         switch (opcode) {
< #include "basic"
< #include "access"
< #include "array"
< #include "tuple"
< #include "integer"
< #include "float"
< #include "comm"
< #include "debug"
<         } // switch
< #if defined(INCLUDE_DEBUGGER)
<         // Handle break and kill requests
<         if (res = DBGHandleBreak(m))
< 	        return res;
< #endif
<         // Fetch next opcode and advance pc
<         opcode = fetch(pc);
<         pc += ALIGNMENT(1);
<       }  // inner for
< 	    // Probe master socket (to test if it's still alive)
<       if (SCKtestLife())
< 	      return MERRTYP;
< #if defined(INCLUDE_DEBUGGER)
<       // Handle possible service requests awaiting on debugger queue
<       if (res = DBGServiceDebugger(m))
< 	      return res;
< #endif
<     } // outer for
<   } // try
< 
<   catch (Exception e) {
<     // Print error message followed by call stack
<     if (e.what())
<       MMechostr(MSKRUNTIME, (char*)e.what());
< #if defined(RELEASE_DEVELOPER)
<     printCallStack();
< #endif
<     m->err = e.code();
<     return m->err;
<   }
< }
< 
< 
< int Interpreter::exec(int opcode)
< // Wrapper around Interpreter::_exec() to handle VM state changes
< // and callstack creation/destruction notification
< // Warning: This function will not work correctly in a multithreaded
< // environment, due to the fact that the static variable depth is
< // shared by all the Interpreter instances. The same remark holds for
< // the handling of Interpreter::current
< {
<   int res;
<   Interpreter* cur = current;
<   current = this;
< //MMechostr(MSKTRACE, "=> Interpreter::exec(): current = 0x%x\n", current);
< #if defined(INCLUDE_DEBUGGER)
<   static uint depth = 0;  // recursion depth
< 
<   DBGSetState(kVMRunning);
<   SECHECK(SEPUSH(m, SEI2W(depth++)));
<   if (res = DBGNotifyCallStackPushed(m))
<     return res;
< #endif
<   if ((res = _exec(opcode)) != MERROK && res != MERREND)
<     return res;
< #if defined(INCLUDE_DEBUGGER)
<   if (--depth == 0)
<     DBGSetState(kVMIdle);
<   SECHECK(SEPUSH(m, SEI2W(depth)));
<   if (res = DBGNotifyCallStackPopped(m))
<     return res;
< #endif
<   current = cur;
< //MMechostr(MSKTRACE, "<= Interpreter::exec(): current = 0x%x\n", current);
<   return MERREND;
< }
< 
< 
< #if defined(RELEASE_DEVELOPER)
< void Interpreter::printCallStack() const
< {
<   uint depth = 0;
<   // Walk through call stack till bp is 0
<   for (SEINT bp = getBP(); bp != 0; bp = SEW2I(SEGET(m, bp+OFFHBP))) {
<     SEPTR fun = SEW2P(SEFETCH(m, SEW2P(SEGET(m, bp+OFFHFUN)), OFFPVAR));
<     MMechostr(MSKTRACE, "[%d] %s#%s\n", 
<       depth++,
<       SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEFETCH(m, fun, OFFVPKG)), OFFPKNAME))),
<       SECSTR(m, SEW2P(SEFETCH(m, fun, OFFVNAME))));
<   }
< }
< 
< 
< // Utilities
< 
< bool Interpreter::getCallStackRegisters(const Interpreter* interp, uint frame, int32* pbp, int32* pfp)
< // Returns in 'pbp' and 'pfp' the values of the bp and fp registers of 
< // frame 'frame', respectively. A 'frame' of value 0 refers to the current 
< // frame. The function returns false if the frame requested is invalid or
< // if the interpreter instance 'interp' is null
< {
<   if (!interp)
<     return false;
<   int32 bp = interp->bp;
<   int32 fp = interp->fp;
<   while (bp != 0 && frame-- > 0) {
<     fp = SEW2I(SEGET(interp->m, bp+OFFHFP));
<     bp = SEW2I(SEGET(interp->m, bp+OFFHBP));
<   }
<   if (pbp) *pbp = bp;
<   if (pfp) *pfp = fp;
<   return bp != 0;
< }
---
> //
> // interp.cpp
> // Interpreter class implementation
> // F.J. Alberti
> //
> // FA   17/05/2001   Alignment
> // FA   21/05/2001   Debugger support
> // FA   06/06/2001   Includes baselib.h
> // FA   15/06/2001   Call debugger handlers
> // FA   27/06/2001   #Define MSGEASSERT for developper and client versions
> // FA   02/07/2001   The fp and bp registers are defined as instance variables
> //                   in the debugger-aware version
> // FA   03/07/2001   The pc, fp and bp registers are initialised to 0. Set up
> //                   Interpreter::current to point to currently executing
> //                   instance
> // FA   06/08/2001   This file has been moved into 'vm' directory
> // FA   09/08/2001   Add the getCallStackRegisters() utility
> // FA   03/09/2001   The pc register is defined as an instance variable
> //                   in the debugger-aware version
> // FA   12/11/2001   Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER/RELEASE_DEVELOPER
> //                   Prints the call stack when an error occurs
> //
> 
> #include <stdio.h>
> #include <string.h>
> #include "include/except.h"
> #include "align.h"
> #include "base.h"                     // future types.h
> #include "baselib.h"
> #include "debug.h"
> #include "interp.h"
> #include "macros.h"
> #include "mbytec.h"
> 
> extern "C" {
> #include "listlab.h"                  // definition of OFFVNAME
> int MMneedMemory(mmachine, int, int);
> int SCKtestLife();
> }
> 
> /*
> class AssertException: public Exception {
> public:
>   AssertException(const char* text);
>   virtual ~AssertException();
> 
>   const char* what() const;
> };
> 
> 
> AssertException::AssertException(const char* text)
>   : Exception(MERRTYP, text)
> {
> }
> 
> 
> AssertException::~AssertException()
> {
> }
> 
> 
> const char* AssertException::what() const
> {
>   return Exception::what();
> }
> */
> 
> 
> // Current interpreter instance
> Interpreter* Interpreter::current = 0;
> 
> 
> // Probe life socket every 'kLifeSocketProbePeriod' iterations
> const uint kLifeSocketProbePeriod = 1000000;
> 
> 
> // Bytecode fetching should be as simple as possible. It is still a bit
> // complicated...
> #define fetch(pc)            (((byte*)&m->tape[(m->top[bp+OFFHCODE]>>1)+SizeHeader])[pc])
> #define checkUnderflow(m)    if ((m)->pp >= (m)->maxpp)\
>                                throw Exception(-1);
> #define checkOverflow(m, n)  if ((m)->pp+(m)->sizetape < (m)->topheap+(n)+(m)->sigGC)\
>                              { if (res = MMneedMemory(m, (n), (n)))\
>                                throw Exception(res); }
> 
> 
> 
> // Interpreter::exec() errors
> #define MSGIILLOPCODE           "Interpreter::exec(): Illegal opcode 0x%x"
> #define MSGIFUNRET              "Interpreter::exec(): Misbehaved function call"
> //#define MSGEDIVISIONBYZERO    "Division by zero"
> #define MSGEILLARRAYSIZE        "Size of new array is illegal (%d)"
> #define MSGEILLARRAYINDEX       "Array index (%d) is out of bounds. (Array size is %d.)"
> #if defined(RELEASE_DEVELOPER)
> #  define MSGEASSERT            "Package '%s', line #%d, function '%s' (0x%x): %s"
> #  define MSGWNATIVEISNULL      "Warning: Package '%s', function '%s': Native function is null"
> #  define MSGENATIVEMISBEHAVED  "Package '%s', function '%s': Native function unbehaved!"
> #else
> #  define MSGEASSERT            "Function 0x%x, line #%d: %s"
> #  define MSGENATIVEMISBEHAVED  "Function at address 0x%x (arity %d): Native function unbehaved!"
> #endif
> 
> 
> 
> Interpreter::Interpreter(mmachine _m)
>   : m(_m)
> {
> }
> 
> 
> Interpreter::~Interpreter()
> {
> }
> 
> 
> int Interpreter::_exec(int opcode)
> {
> #if !defined(RELEASE_DEVELOPER)
>   register int32 pc;                  // program counter
>   register int32 fp;                  // frame pointer
>   register int32 bp;                  // base pointer of operand stack
> #endif
>   int            res      = MERROK;   // resulting error
>   bool           tailcall = false;    // tail call flag
> 
>   // Initialise registers
>   pc = bp = fp = 0;
> 
>   try {
>     for (;;) {
>       for (int i = 0; i < kLifeSocketProbePeriod; i++) {
> #if defined(SCOL_DEBUG)
>         // Check that opcode is within range
>         if (opcode < 0 || opcode > kMaxOpcode)
>           throw Exception(MERRTYP, "(!) "MSGIILLOPCODE"\n", opcode);
> #endif
>       //MMechostr(MSKTRACE, "opcode = 0x%x\n", opcode);
>         switch (opcode) {
> #include "basic"
> #include "access"
> #include "array"
> #include "tuple"
> #include "integer"
> #include "float"
> #include "comm"
> #include "debug"
>         } // switch
> #if defined(INCLUDE_DEBUGGER)
>         // Handle break and kill requests
>         if (res = DBGHandleBreak(m))
> 	        return res;
> #endif
>         // Fetch next opcode and advance pc
>         opcode = fetch(pc);
>         pc += ALIGNMENT(1);
>       }  // inner for
> 	    // Probe master socket (to test if it's still alive)
>       if (SCKtestLife())
> 	      return MERRTYP;
> #if defined(INCLUDE_DEBUGGER)
>       // Handle possible service requests awaiting on debugger queue
>       if (res = DBGServiceDebugger(m))
> 	      return res;
> #endif
>     } // outer for
>   } // try
> 
>   catch (Exception e) {
>     // Print error message followed by call stack
>     if (e.what())
>       MMechostr(MSKRUNTIME, (char*)e.what());
> #if defined(RELEASE_DEVELOPER)
>     printCallStack();
> #endif
>     m->err = e.code();
>     return m->err;
>   }
> }
> 
> 
> int Interpreter::exec(int opcode)
> // Wrapper around Interpreter::_exec() to handle VM state changes
> // and callstack creation/destruction notification
> // Warning: This function will not work correctly in a multithreaded
> // environment, due to the fact that the static variable depth is
> // shared by all the Interpreter instances. The same remark holds for
> // the handling of Interpreter::current
> {
>   int res;
>   Interpreter* cur = current;
>   current = this;
> //MMechostr(MSKTRACE, "=> Interpreter::exec(): current = 0x%x\n", current);
> #if defined(INCLUDE_DEBUGGER)
>   static uint depth = 0;  // recursion depth
> 
>   DBGSetState(kVMRunning);
>   SECHECK(SEPUSH(m, SEI2W(depth++)));
>   if (res = DBGNotifyCallStackPushed(m))
>     return res;
> #endif
>   if ((res = _exec(opcode)) != MERROK && res != MERREND)
>     return res;
> #if defined(INCLUDE_DEBUGGER)
>   if (--depth == 0)
>     DBGSetState(kVMIdle);
>   SECHECK(SEPUSH(m, SEI2W(depth)));
>   if (res = DBGNotifyCallStackPopped(m))
>     return res;
> #endif
>   current = cur;
> //MMechostr(MSKTRACE, "<= Interpreter::exec(): current = 0x%x\n", current);
>   return MERREND;
> }
> 
> 
> #if defined(RELEASE_DEVELOPER)
> void Interpreter::printCallStack() const
> {
>   uint depth = 0;
>   // Walk through call stack till bp is 0
>   for (SEINT bp = getBP(); bp != 0; bp = SEW2I(SEGET(m, bp+OFFHBP))) {
>     SEPTR fun = SEW2P(SEFETCH(m, SEW2P(SEGET(m, bp+OFFHFUN)), OFFPVAR));
>     MMechostr(MSKTRACE, "[%d] %s#%s\n", 
>       depth++,
>       SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEFETCH(m, fun, OFFVPKG)), OFFPKNAME))),
>       SECSTR(m, SEW2P(SEFETCH(m, fun, OFFVNAME))));
>   }
> }
> 
> 
> // Utilities
> 
> bool Interpreter::getCallStackRegisters(const Interpreter* interp, uint frame, int32* pbp, int32* pfp)
> // Returns in 'pbp' and 'pfp' the values of the bp and fp registers of 
> // frame 'frame', respectively. A 'frame' of value 0 refers to the current 
> // frame. The function returns false if the frame requested is invalid or
> // if the interpreter instance 'interp' is null
> {
>   if (!interp)
>     return false;
>   int32 bp = interp->bp;
>   int32 fp = interp->fp;
>   while (bp != 0 && frame-- > 0) {
>     fp = SEW2I(SEGET(interp->m, bp+OFFHFP));
>     bp = SEW2I(SEGET(interp->m, bp+OFFHBP));
>   }
>   if (pbp) *pbp = bp;
>   if (pfp) *pfp = fp;
>   return bp != 0;
> }