mtl.h

Go to the documentation of this file.

/*********************************************************************
** Copyright (c) 1992-2025 MAK Technologies, Inc
** All rights reserved.
*********************************************************************/
#ifndef mtl_H_
#define mtl_H_

#include <stdio.h>
#include <vlutil/vlMachineTypes.h>
#include <vlutil/vlPrint.h>
#include <vlutil/vlList.h>
#include <vlutil/vlString.h>
#include <vlutil/vlDebug.h>
#include <vlutil/vlMutex.h>
#include "mtlstream.h"

#ifdef DtUSE_UTILITIES_NAMESPACE
namespace DtUSE_UTILITIES_NAMESPACE
{
#endif

#define DtlObjDebug(s)        do { if (DtLispDebugOn) DtlInfo s; } while (0)

#define DtlError(string, obj) do { if (DtNotifyLevel >= DtNlFatal)      \
      fprintf(stderr, "Lisp Error: %s", string), DtcErrPrint(obj); } while (0)

#define DtlWarn(string, obj)  do { if (DtNotifyLevel >= DtNlWarn)       \
      fprintf(stderr, "Lisp Warning: %s", string), DtcErrPrint(obj); } while (0)

#define DtlInfo(string, obj)  do { if (DtNotifyLevel >= DtNlInfo)       \
      printf(string), DtcPrint(obj); } while (0)

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

class DT_DLL_MTL DtlObj;
class DT_DLL_MTL DtlObjPtr;
class DT_DLL_MTL DtlHashTable;
class DT_DLL_MTL DtcParam;

#ifdef MEMCHK
extern DT_DLL_MTL int DtAllocObjCnt;
extern DT_DLL_MTL int DtMaxAllocObjCnt;
#endif

extern DT_DLL_MTL char* DtMtlReadEscapeChar;


enum DtlTagType
{
    DtpNull,
    DtpSymbol,
    DtpFix,
    DtpFlonum,
    DtpList,
    DtpSpecialForm,
    DtpCompiledC,
    DtpString,
    DtpLocative,
    DtpProcedure,
    DtpFrame
};

class DT_DLL_MTL DtlObjPtr 
{
   friend class DtlObj;

public:
   DtlObjPtr(); 
   DtlObjPtr(const DtlObjPtr&);
   DtlObjPtr(DtlTagType);
   DtlObjPtr(int);
   DtlObjPtr(double);
   DtlObjPtr(const char*);
   ~DtlObjPtr();
   DtlObjPtr& operator = (const DtlObjPtr&);
   bool operator == (const DtlObjPtr&) const; 
   operator void*() const; 
   DtlObj* operator -> () const;
   DtlObj& operator * () const;
   
   int isNull() const; 

public:

   static const DtlObjPtr& t();
   static const DtlObjPtr& nil();
   static const DtlObjPtr& unbound();

private:  

   DtlObj* ptr;
};

typedef DtlObjPtr (*DtlFcn) (const DtlObjPtr& args, const DtlObjPtr& env); 
typedef  DtlFcn DtlCompiledCFcnWithEnv;
typedef void* DtlPtrToNode; 

class DT_DLL_MTL DtlObj {
    friend class DtlObjPtr;
  public:
    DtlObj(DtlTagType);
    DtlObj(int);
    DtlObj(double);
    DtlObj(const char *);
    ~DtlObj();

    DtlTagType tag();
    void setTag(DtlTagType);

    int refcnt();
    void setRefcnt(int);

    char gone();
    void setGone(char);

    DtlObjPtr car();
    void setCar(const DtlObjPtr&);
    DtlObjPtr cdr();
    void setCdr(const DtlObjPtr&);

    char* pname();
    void setPname(const char*);

    int fixnum();
    void setFixnum(int);

    double flonum();
    void setFlonum(double);

    char* string();
    void setString(const char*);

    DtlPtrToNode nodeptr();
    void setNodeptr(DtlPtrToNode);

    char* fcnPname();
    void setFcnPname(const char*);

    DtlCompiledCFcnWithEnv fcnCode();
    void setFcnCode(DtlCompiledCFcnWithEnv);

    DtlObjPtr procParams();
    void setProcParams(const DtlObjPtr&);
    
    DtlObjPtr procBody();
    void setProcBody(const DtlObjPtr&);

    DtlObjPtr& procEnv();
    void setProcEnv(const DtlObjPtr&);

    DtlObjPtr frameParent();
    void setFrameParent(const DtlObjPtr&);

    DtlHashTable* frameBindings();
    void setFrameBindings(DtlHashTable*);

    int registerVal(DtcParam* param);

    DtList* params();

    void print();
    void DtcObjFprint(FILE* s);
    void DtcPrintList(FILE* s);

  private:
    DtlTagType tg;
    int rcnt;
    char gn; 

    DtlObjPtr ptr1;
    DtlObjPtr ptr2;
    DtlObjPtr ptr3;

    union vl
    { 
   char *symbname;      /* print name for symbol */
   int fixnum;       /* fixed point number (int) */
   double flonum;              /* floating point (double) */
   char *s;                    /* for strings */
   DtlPtrToNode ptr;         /* locatives */
   struct Fcn
   {
       char *pname;
       DtlCompiledCFcnWithEnv fcn;
   } compiled_c_fcn;
   /* struct cns
   {
      DtlObjPtr car;
      DtlObjPtr cdr;
   } cons;
   struct proc
   {
      DtlObjPtr params;
      DtlObjPtr body;
      DtlObjPtr p_env;
   } procedure;
   */
   struct frm
   {
      DtlHashTable* bindings;
           DtList* allParams;
   } frame;
    } val;
};

DT_DLL_MTL DtlObjPtr DtcLoadLispFile(const char *filename, 
   const DtlObjPtr& env, DtList* allParams, int complain = 1);
DT_DLL_MTL DtlObjPtr DtcLoadLispFile(const DtlObjPtr& pathlist, 
   const char *filename, const DtlObjPtr& env, DtList* allParams, int complain=1);
DT_DLL_MTL DtlObjPtr DtcLoadLispFileOrExpr(
   char *arg, const DtlObjPtr& env, DtList* allParams, int complain = 1);
DT_DLL_MTL DtlObjPtr DtcLoadLispExpr(
   const char *lispLine, const DtlObjPtr& env, DtList* allParams, int complain = 1);

DT_DLL_MTL DtlObjPtr DtcHaltAndCatchFire(const char *diagnostic);

DT_DLL_MTL DtlObjPtr DtcInternCompiledC(
   const char* name, DtlCompiledCFcnWithEnv fcn, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtcPtrToNode(
   DtlTagType t, DtlPtrToNode ptr);
DT_DLL_MTL DtlObjPtr DtcInternPtr(
   const char* name, const DtlObjPtr& value, const DtlObjPtr& env);

DT_DLL_MTL DtlObjPtr DtcInternSpecialForm(
   const char* name, DtlCompiledCFcnWithEnv fcn, const DtlObjPtr& env);


DT_DLL_MTL int DtcSetIfBoundp(
   char *lisp_var_name, int *cvar, const DtlObjPtr& env);
DT_DLL_MTL int DtcSetIfBoundp(
   char *lisp_var_name, double *cvar, const DtlObjPtr& env);
DT_DLL_MTL int DtcSetIfBoundp(
   char *lisp_var_name, char** cvar, const DtlObjPtr& env);

DT_DLL_MTL void IncObjRefCnt(DtlObj *obj);
DT_DLL_MTL void DecObjRefCnt(DtlObj *obj);
DT_DLL_MTL int EnvLocalProcRefcnt(DtlObj *env);
DT_DLL_MTL int EnvLocalProcRefcnt(const DtlObjPtr& env);

DT_DLL_MTL DtlObjPtr DtcCBooleanToLispBoolean(int i);
DT_DLL_MTL DtlObjPtr DtcCaddddddr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCadddddr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCaddddr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCadddr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCaddr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCadr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCar(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCdr(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcCons(const DtlObjPtr& car, const DtlObjPtr& cdr);
DT_DLL_MTL DtlObjPtr DtcAppend(const DtlObjPtr&, const DtlObjPtr&);
DT_DLL_MTL DtlObjPtr DtcAssoc(const DtlObjPtr& thing, const DtlObjPtr& alist);
DT_DLL_MTL DtlObjPtr DtcAssv(const DtlObjPtr& thing, const DtlObjPtr& alist);
DT_DLL_MTL DtlObjPtr DtcAssq(const DtlObjPtr& thing, const DtlObjPtr& alist);
DT_DLL_MTL DtlObjPtr DtcReverse(const DtlObjPtr&);
DT_DLL_MTL DtlObjPtr DtcEval(const DtlObjPtr& , const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtcIntern(const char *name, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtcMakeSymbol(const char *pname);
DT_DLL_MTL DtlObjPtr DtcPrint(const DtlObjPtr& c);
DT_DLL_MTL DtlObjPtr DtcRead(DtlInputStream *f, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtcSet(const DtlObjPtr& c, const DtlObjPtr& value, const DtlObjPtr& env);
#if DT_GLOBAL_ENV
DT_DLL_MTL int       DtcBoundp(const DtlObjPtr& sym);
DT_DLL_MTL DtlObjPtr DtcSet(const DtlObjPtr& c, const DtlObjPtr& value);
DT_DLL_MTL DtlObjPtr DtcIntern(char *name);
DT_DLL_MTL DtlObjPtr DtcRead(DtlInputStream *f);
#endif
#define DtcSet1Env   DtcSet
DT_DLL_MTL DtlObjPtr DtcSymeval(const DtlObjPtr& c, const DtlObjPtr& env);
DT_DLL_MTL int       DtcBoundp(const DtlObjPtr& sym, const DtlObjPtr& env);
DT_DLL_MTL int       DtcEq(const DtlObjPtr& a, const DtlObjPtr& b);
DT_DLL_MTL int       DtcEqual(const DtlObjPtr& c1, const DtlObjPtr& c2);
DT_DLL_MTL int       DtcEqualSign(const DtlObjPtr& c1, const DtlObjPtr& c2);
DT_DLL_MTL int       DtcLength(const DtlObjPtr& c);
DT_DLL_MTL int       DtcListp(const DtlObjPtr& c);
DT_DLL_MTL int       DtcNull(const DtlObjPtr& c);
DT_DLL_MTL int       DtcNumberp(const DtlObjPtr& c);
DT_DLL_MTL int       DtcStringEqual(const DtlObjPtr& s1, const DtlObjPtr& s2);
DT_DLL_MTL int       DtcStringp(const DtlObjPtr& c);
DT_DLL_MTL int       DtcLocativep(const DtlObjPtr& c);

DT_DLL_MTL DtlObjPtr DtcErrPrint(const DtlObjPtr& c);

DT_DLL_MTL DtlObjPtr DtlAbort(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAbs(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAnd(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAppend(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAssoc(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAssq(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlAssv(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlCond(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlCos(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlDescribe(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlDivide(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlEnvDump(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlEq(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlEqual(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlEqualSign(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlEval(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlExit(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlFormat(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlFrameBindings(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlFrameBound(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlFrameParent(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlGetenv(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlGreater(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlGreaterEqual(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlIf(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLCar(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLCdr(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLCons(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLambda(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLet(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLength(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLess(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLessEqual(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlList(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlListp(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLoad(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLogIOr(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlMem(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlMinus(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlMultiply(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlNewFrame(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlNotOrNull(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlNumberp(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlOr(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlPlus(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlPopen(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlPrin1(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlPutenv(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlReverse(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlQuote(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlSequence(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlSetq(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlSetqBoundVariable(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlSin(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlStringAppend(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlStringEqual(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlStringp(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlTheFrame(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlLocativep(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlSystem(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlTerpri(const DtlObjPtr& args, const DtlObjPtr& env);

DT_DLL_MTL DtlObjPtr DtlPrintRegistered(const DtlObjPtr&, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlPathCross(const DtlObjPtr&, const DtlObjPtr& env);

DT_DLL_MTL DtlObjPtr DtlStringToNumber(const DtlObjPtr& args, const DtlObjPtr& env);
DT_DLL_MTL DtlObjPtr DtlNumberToString(const DtlObjPtr& args, const DtlObjPtr& env);


DT_DLL_MTL void DtlAddLoadPath(const char* path);
DT_DLL_MTL void DtlClearLoadPaths();

/* ---------------------- REGISTER ---------------------- */
/* 
 * DtcRegister facilitates the setting of simple C variables 
 * (i.e. double, int, char *) from MTL files.
 * 
 * Each call to DtcRegister creates a lisp-variable "name" and
 * initializes it to the value pointed to by "addr".
 * It also adds the lisp-variable and C-address to a list of
 * "registered" variables.  
 * At the end of DtlLoadLispFile, every registered variable will have
 * its lisp value evaluated and copied to the registered C address.
 *
 * Note: Lisp evaluation and copy to C does not occur until the end of
 * DtlLoadLispFile, so modified values will not automatically be
 * visible to C functions called from within a lisp file.  To bring
 * a C value up-to-date from within such a function, call
 * DtcSetIfBoundp() or DtcLispToC().  
 *
 * The macro DtcREGISTER can be useful to ensure that corresponding C 
 * and Lisp variables share the same name.
 * 
 * Use of setqb (aka setq-bound-variable) is recommended for registered
 * variables because it will complain if the parameter is misspelled. 
 *
 * The registered address must be valid at the time DtlLoadLispFile is
 * called [i.e. be careful with automatic variables on the stack.]  
 *
 * All calls to DtcRegister() should be made between 
 * DtlGlobalEnvInit() and DtlLoadLispFile().
 */ 

DT_DLL_MTL void DtcGlobalEnvInit(DtlObjPtr& env);

#define DtcREGISTER(var, env, params) DtcRegister(#var, &var, env, params)
#define DtcDEFINE(type, var, dflt) type var = dflt; DtcREGISTER(var)

DT_DLL_MTL int DtcRegister(
   const char *name, float  *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, double *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, int* addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, unsigned long *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, char  **addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, DtString *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, long *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, short *addr, const DtlObjPtr& env, DtList* allParams);
DT_DLL_MTL int DtcRegister(
   const char *name, unsigned short *addr, const DtlObjPtr& env, DtList* allParams);
#if DT_HAVE_64BIT_LONGS
DT_DLL_MTL int DtcRegister(
   const char *name, unsigned int *addr, const DtlObjPtr& env, DtList* allParams);
#endif

DT_DLL_MTL void DtcLispToC(DtList* allParams);


DT_DLL_MTL void DtcCToLisp(DtList* allParams);

DT_DLL_MTL void DtcEmptyParamList(DtList* allParams);


inline int DtlObj::refcnt()
{
    return rcnt;
}

inline void DtlObj::setRefcnt(int r)
{
    rcnt = r;
}

inline DtlObjPtr::~DtlObjPtr()
{
    DecObjRefCnt(ptr);
}

#ifdef DtUSE_UTILITIES_NAMESPACE
} 
#endif

#endif /* _MTL_H_ */