shithub: MicroHs

Download patch

ref: 9178d61c9ac8d3fec958215599c5021a090eeb65
parent: d87fa9fcb3cf363d91e90e5f1429ca28aeedd2ff
author: Lennart Augustsson <lennart@augustsson.net>
date: Wed Nov 8 16:22:42 EST 2023

Add some string marshaling.

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
-v4.1
-1543
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1284))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1370) ((A :22 ((B _1411) _21)) ((A :23 (((S' _1411) _21) I)) ((A :24 _1340) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1369) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1381) _170)) ((_258 (_34 _1383)) _169))) ((A :29 ((B ((S _1411) (_34 _1383))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1284)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1284))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1284)))) ((A :57 ((B (_256 _50)) (BK (P _1284)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
+v4.2
+1545
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1284))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1370) ((A :22 ((B _1413) _21)) ((A :23 (((S' _1413) _21) I)) ((A :24 _1340) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1369) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1383) _170)) ((_258 (_34 _1385)) _169))) ((A :29 ((B ((S _1413) (_34 _1385))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1284)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1284))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1284)))) ((A :57 ((B (_256 _50)) (BK (P _1284)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
--- /dev/null
+++ b/lib/Foreign/C/String.hs
@@ -1,0 +1,21 @@
+module Foreign.C.String(
+  CChar, CString,
+  newCAString, withCAString,
+  ) where
+import Primitives
+import Prelude
+
+type CChar = Char
+type CString = Ptr CChar
+
+newCAString :: String -> IO CString
+newCAString = primNewCAString
+
+withCAString :: forall a . String -> (CString -> IO a) -> IO a
+--withCAString s io =
+--  newCAString s `primBind` \ cs -> io cs `primBind` \ a -> primFree cs `primThen` primReturn a
+withCAString s io = do
+  cs <- newCAString s
+  a  <- io cs
+  primFree cs
+  return a
--- /dev/null
+++ b/lib/Foreign/Marshal/Alloc.hs
@@ -1,0 +1,5 @@
+module Foreign.Marshal.Alloc(free) where
+import Primitives
+
+free :: forall a . Ptr a -> IO ()
+free = primFree
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -16,6 +16,7 @@
 data Double
 data IO a
 data Word
+data Ptr a
 
 -- Type equality as a constraint.
 class a ~ b {-x | a -> b, b -> a-}
@@ -216,3 +217,9 @@
 
 primRnf          :: forall a . a -> ()
 primRnf           = primitive "rnf"
+
+primNewCAString :: [Char] -> IO (Ptr Char)
+primNewCAString = primitive "newCAString"
+
+primFree :: forall a . Ptr a -> IO ()
+primFree = primitive "free"
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -75,4 +75,4 @@
       putStrLn $ "final pass            " ++ padLeft 6 (show (t2-t1)) ++ "ms"
 
 version :: String
-version = "v4.1\n"
+version = "v4.2\n"
--- /dev/null
+++ b/src/MicroHs/MakeCArray.hs
@@ -1,0 +1,22 @@
+module MicroHs.MakeCArray(makeCArray) where
+import Prelude
+import Data.Char
+
+chunkify :: Int -> String -> [String]
+chunkify _ [] = []
+chunkify n xs =
+  let (as, bs) = splitAt n xs
+  in  as : chunkify n bs
+
+showChunk :: [Char] -> String
+showChunk = concatMap (\ c -> show (ord c) ++ ",")
+
+makeCArray :: String -> String
+makeCArray file =
+  let chunks = chunkify 20 file
+  in  unlines $ ["static char data[] = {"] ++
+                map showChunk chunks ++
+                ["0 };",
+                 "char *combexpr = data;",
+                 "int combexprlen = " ++ show (length file) ++ ";"
+                ]
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -136,5 +136,7 @@
   ("IO.performIO", primitive "IO.performIO"),
   ("IO.getTimeMilli", primitive "IO.getTimeMilli"),
   ("IO.catch", primitive "IO.catch"),
-  ("dynsym", primitive "dynsym")
+  ("dynsym", primitive "dynsym"),
+  ("newCAString", primitive "newCAString"),
+  ("free", primitive "free")
   ]
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -136,7 +136,7 @@
 
 /***************************************/
 
-#define VERSION "v4.1\n"
+#define VERSION "v4.2\n"
 
 /* Keep permanent nodes for LOW_INT <= i < HIGH_INT */
 #define LOW_INT (-10)
@@ -147,7 +147,7 @@
 
 #define ERR(s) do { fprintf(stderr, "ERR: %s\n", s); exit(1); } while(0)
 
-enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_DBL, T_HDL, T_S, T_K, T_I, T_B, T_C,
+enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_DBL, T_HDL, T_PTR, T_S, T_K, T_I, T_B, T_C,
                 T_A, T_Y, T_SS, T_BB, T_CC, T_P, T_R, T_O, T_T, T_BK,
                 T_ADD, T_SUB, T_MUL, T_QUOT, T_REM, T_SUBR, T_UQUOT, T_UREM, T_NEG,
                 T_AND, T_OR, T_XOR, T_INV, T_SHL, T_SHR, T_ASHR,
@@ -162,6 +162,7 @@
                 T_IO_PERFORMIO,
                 T_IO_GETTIMEMILLI, T_IO_PRINT, T_IO_CATCH,
                 T_IO_CCALL, T_IO_GETRAW, T_IO_FLUSH, T_DYNSYM,
+                T_NEWCASTRING, T_FREEPTR,
                 T_STR,
                 T_LAST_TAG,
 };
@@ -217,6 +218,7 @@
     double uudoublevalue;
     FILE *uufile;
     const char *uustring;
+    void *uuptr;
   } uarg;
 } node;
 typedef struct node* NODEPTR;
@@ -231,6 +233,7 @@
 #define FUN(p) (p)->ufun.uufun
 #define ARG(p) (p)->uarg.uuarg
 #define STR(p) (p)->uarg.uustring
+#define PTR(p) (p)->uarg.uuptr
 #define INDIR(p) ARG(p)
 #define HANDLE(p) (p)->uarg.uufile
 #define NODE_SIZE sizeof(node)
@@ -714,6 +717,8 @@
   { "IO.performIO", T_IO_PERFORMIO },
   { "IO.catch", T_IO_CATCH },
   { "dynsym", T_DYNSYM },
+  { "free", T_FREEPTR },
+  { "newCAString", T_NEWCASTRING },
 };
 
 void
@@ -954,12 +959,14 @@
  *   IIV  void name(int, int)
  *   III  int  name(int, int)
  *   DD   double name(double)
+ *   PI   int  name(void*)
+ *   PPI  int  name(void*, void*)
  * more can easily be added.
  */
 struct {
   const char *ffi_name;
   const funptr_t ffi_fun;
-  enum { FFI_V, FFI_I, FFI_IV, FFI_II, FFI_IIV, FFI_III, FFI_DD } ffi_how;
+  enum { FFI_V, FFI_I, FFI_IV, FFI_II, FFI_IIV, FFI_III, FFI_DD, FFI_PI, FFI_PPI } ffi_how;
 } ffi_table[] = {
   { "llabs", (funptr_t)llabs, FFI_II },
   { "log",   (funptr_t)log,   FFI_DD },
@@ -971,6 +978,7 @@
   { "asin",  (funptr_t)asin,  FFI_DD },
   { "acos",  (funptr_t)acos,  FFI_DD },
   { "atan",  (funptr_t)atan,  FFI_DD },
+  { "puts",  (funptr_t)puts,  FFI_PI },
 };
 
 /* Look up an FFI function by name */
@@ -1463,6 +1471,8 @@
   case T_IO_CCALL: fprintf(f, "^%s", ffi_table[GETVALUE(n)].ffi_name); break;
   case T_IO_CATCH: fprintf(f, "IO.catch"); break;
   case T_DYNSYM: fprintf(f, "dynsym"); break;
+  case T_NEWCASTRING: fprintf(f, "newCAString"); break;
+  case T_FREEPTR: fprintf(f, "free"); break;
   default: ERR("print tag");
   }
 }
@@ -1592,7 +1602,7 @@
   n = evali(n);
 #if SANITY
   if (GETTAG(n) != T_INT) {
-    fprintf(stderr, "bad tag %d\n", GETTAG(n));
+    fprintf(stderr, "bad int tag %d\n", GETTAG(n));
     ERR("evalint");
   }
 #endif
@@ -1606,7 +1616,7 @@
   n = evali(n);
   #if SANITY
   if (GETTAG(n) != T_DBL) {
-    fprintf(stderr, "bad tag %d\n", GETTAG(n));
+    fprintf(stderr, "bad double tag %d\n", GETTAG(n));
     ERR("evaldbl");
   }
   #endif
@@ -1620,7 +1630,7 @@
   n = evali(n);
 #if SANITY
   if (GETTAG(n) != T_HDL) {
-    fprintf(stderr, "bad tag %d\n", GETTAG(n));
+    fprintf(stderr, "bad handle tag %d\n", GETTAG(n));
     ERR("evalhandle");
   }
 #endif
@@ -1627,6 +1637,20 @@
   return HANDLE(n);
 }
 
+/* Evaluate to a T_PTR */
+void *
+evalptr(NODEPTR n)
+{
+  n = evali(n);
+#if SANITY
+  if (GETTAG(n) != T_PTR) {
+    fprintf(stderr, "bad ptr tag %d\n", GETTAG(n));
+    ERR("evalhandle");
+  }
+#endif
+  return PTR(n);
+}
+
 /* Evaluate to a T_HDL, and check for closed */
 FILE *
 evalhandle(NODEPTR n)
@@ -1836,6 +1860,7 @@
     case T_INT:  RET;
     case T_DBL:  RET;
     case T_HDL:  RET;
+    case T_PTR:  RET;
 
     case T_S:    GCCHECK(2); CHKARG3; GOAP(new_ap(x, z), new_ap(y, z));                     /* S x y z = x z (y z) */
     case T_SS:   GCCHECK(3); CHKARG4; GOAP(new_ap(x, new_ap(y, w)), new_ap(z, w));          /* S' x y z w = x (y w) (z w) */
@@ -2018,6 +2043,8 @@
     case T_IO_GETTIMEMILLI:
     case T_IO_CCALL:
     case T_IO_CATCH:
+    case T_FREEPTR:
+    case T_NEWCASTRING:
       RET;
 
     case T_DYNSYM:
@@ -2233,7 +2260,9 @@
         funptr_t f = ffi_table[a].ffi_fun;
         value_t r, x, y;
         double rd, xd;
+        void *xp, *yp;
 #define INTARG(n) evalint(ARG(TOP(n)))
+#define PTRARG(n) evalptr(ARG(TOP(n)))
 #define DBLARG(n) evaldbl(ARG(TOP(n)))
 #define FFIV(n) CHECKIO(n)
 #define FFI(n) CHECKIO(n); GCCHECK(1)
@@ -2246,6 +2275,8 @@
         case FFI_IIV: FFIV(2); x = INTARG(1); y = INTARG(2);     (*(void    (*)(value_t, value_t))f)(x,y);               RETIO(combUnit);
         case FFI_III: FFI (2); x = INTARG(1); y = INTARG(2); r = (*(value_t (*)(value_t, value_t))f)(x,y); n = mkInt(r); RETIO(n);
         case FFI_DD:  FFI (1); xd = DBLARG(1);               rd= (*(double  (*)(double          ))f)(xd);  n = mkDouble(rd); RETIO(n);
+        case FFI_PI:  FFI (1); xp = PTRARG(1);               r = (*(value_t (*)(void*           ))f)(xp);  n = mkInt(r); RETIO(n);
+        case FFI_PPI: FFI (2); xp = PTRARG(1);yp = PTRARG(2);r = (*(value_t (*)(void*, void*    ))f)(xp,yp); n = mkInt(r); RETIO(n);
         default: ERR("T_IO_CCALL");
         }
       }
@@ -2278,6 +2309,20 @@
           RETIO(n);             /* return result */
         }
       }
+
+    case T_FREEPTR:
+      CHECKIO(1);
+      hdl = evalptr(ARG(TOP(1)));
+      free(hdl);
+      RETIO(combUnit);
+
+    case T_NEWCASTRING:
+      CHECKIO(1);
+      name = evalstring(ARG(TOP(1)));
+      GCCHECK(1);
+      n = alloc_node(T_PTR);
+      PTR(n) = name;
+      RETIO(n);
 
     default:
       fprintf(stderr, "bad tag %d\n", GETTAG(n));
--