home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 254b.lha / AMXLISP_v2.0 / interface-src / interface.c < prev    next >
C/C++ Source or Header  |  1989-05-09  |  2KB  |  98 lines
  1. /* interface -new functions to get this interface working */
  2. /* (C) Copyright Francois ROUAIX 1987 */
  3. #include "xlisp.h"
  4.  
  5.  
  6. /* peeks and pokes for bytes, words, and longs */
  7.  
  8. LVAL  xli_mem_b()
  9. {
  10.    unsigned char *ptr;
  11.    LVAL  val;
  12.  
  13.    ptr = (unsigned char *)getfixnum(xlgafixnum());
  14.    if (!moreargs())  /* read */
  15.       { return(cvfixnum((FIXTYPE)*ptr)) ; }
  16.    else
  17.       { val = xlgafixnum() ;
  18.         xllastarg();
  19.         *ptr = (unsigned char)(getfixnum(val));
  20.         return(val);
  21.       };
  22. }
  23.  
  24. LVAL  xli_mem_w()
  25. {
  26.    unsigned short *ptr;
  27.    LVAL  val;
  28.  
  29.    ptr = (unsigned short *)getfixnum(xlgafixnum());
  30.    if (!moreargs())  /* read */
  31.       { return(cvfixnum((FIXTYPE)*ptr));}
  32.    else
  33.       { val = xlgafixnum() ;
  34.         xllastarg();
  35.         *ptr = (unsigned short)(getfixnum(val));
  36.         return(val);
  37.       };
  38. }
  39.  
  40. LVAL  xli_mem_l()
  41. {
  42.    FIXTYPE *ptr;
  43.    LVAL  val;
  44.  
  45.    ptr = (FIXTYPE *)getfixnum(xlgafixnum());
  46.    if (!moreargs())  /* read */
  47.       { return(cvfixnum(*ptr));}
  48.    else
  49.       { val = xlgafixnum() ;
  50.         xllastarg();
  51.         *ptr = getfixnum(val);
  52.         return(val);
  53.       };
  54. }
  55.  
  56. /* callasm: we call this function with */
  57. /*   offset: the offset of the function in the library */
  58. /*   base:   the base of the library, to be put in A6  */
  59. /*   lreg:   where we shall put the arguments before calling */
  60. /*   larg:   the list of arguments : integers (ie pointers or integers) */
  61. /*                        and/or strings */
  62. /* callasm always returns an XLISP object of integer type */
  63. /*         this object in either a real integer or a pointer */
  64. /* in C, we can do all the argument handling (especially on strings) */
  65. /* but we'll have to call assembler to do the registers work */
  66. extern FIXTYPE doit();
  67.  
  68. LVAL  callasm()
  69.  
  70. {  FIXTYPE offset,base;
  71.    LVAL lreg,larg;
  72.    FIXTYPE result;
  73.    offset = (FIXTYPE)getfixnum(xlgafixnum()); /* get the offset */
  74.    base   = (FIXTYPE)getfixnum(xlgafixnum()); /* get the base */
  75.    if (moreargs())      /* there are arguments */
  76.       {   lreg = xlgalist();
  77.           larg = xlgalist();
  78.           xllastarg();
  79.           result = doit(offset,base,lreg,larg);
  80.       }
  81.    else {   /* no arguments */
  82.          result = doit(offset,base,NIL,NIL);
  83.         };
  84.    return(cvfixnum(result));
  85. }
  86.  
  87. LVAL  xli_ctos(args)
  88.    LVAL  args;
  89.  
  90. {
  91.    FIXTYPE ptr;
  92.    ptr = (FIXTYPE)getfixnum(xlgafixnum())  ; /* get the pointer */
  93.    xllastarg();
  94.    return(cvstring((char *)ptr));
  95. }
  96.  
  97.  
  98.