Merge pull request #1444 from alex-s168/more-safe-alloc

use safe-alloc

Author: andrew-johnson-4

PLATFORM/C/LIB/array.lm

@@ -19,12 +19,6 @@ const-cons := λ: Blob(: v x)(: i L). (: (
    ))
 ) Array<x,CONST>);
 
-close := λ(: x p). (: (
-   (let r (as (malloc(sizeof p)) p[]))
-   (set[]( r 0_u64 x ))
-   r
-) p[]);
-
 #declare-binop( mov, raw-type(base[CONST+array-len]), raw-type(base[CONST+array-len]), raw-type(Nil), (
 #   l"({memcpy(&"; y;
 #   l","; x;

PLATFORM/C/LIB/array.lsts

@@ -64,3 +64,9 @@ let safe-realloc(ptr: t[], len: U64, ty: Type<t>): t[] = (
    mark-memory-as-safe(new_ptr, len);
    new_ptr
 );
+
+let close(x: p): p[] = (
+   let r = safe-alloc(1_u64, type(p));
+   r[0_u64] = x;
+   r
+);

PLATFORM/C/LIB/io.lm

@@ -24,24 +24,6 @@ fail := λ(: msg String). (: (
    (as (exit 1_u32) Never)
 ) Never);
 
-read-file := λ(: fp String). (: (
-   (let buff-sz 0_u64)
-   (let buff (as (malloc 1024_u64) U8[]))
-   (let f (fopen( (as fp U8[]) (as 'r_s U8[]) )))
-   (if (==( (as f U64) 0_u64 )) (
-      (print 'Unable\sTo\sRead\sFrom\sFile:\s_s)(print fp)(print '\n_s)(exit 1_u64)
-   ) ())
-   (let bytes-read 1_u64)
-   (while bytes-read (
-      (set bytes-read (fread( (+( buff buff-sz )) 1_u64 1023_u64 f )))
-      (set buff-sz (+( buff-sz bytes-read )))
-      (set buff (as (realloc( buff (+( buff-sz 1023_u64 )) )) U8[]))
-   ))
-   (fclose f)
-   (set[]( buff buff-sz 0_u8 ))
-   (as buff String)
-) String);
-
 write-file := λ(: fp String)(: contents String). (: (
    (let f (fopen( (as fp U8[]) (as 'w_s U8[]) )))
    (fwrite( (as contents U8[]) 1_u64 (.length contents) f ))

PLATFORM/C/LIB/io.lsts

@@ -5,3 +5,24 @@ let .file-extension(path: CString): CString = (
    };
    path
 );
+
+let read-binary-file-to(out: Vector<U8>, path: CString): Vector<U8> = (
+   let fp = fopen(path as U8[], untern("rb") as U8[]);
+   if (fp as U64) == 0_u64 {
+      fail("Unable to read from file: \{path}");
+   };
+   let by = 1_u64;
+   while by {
+      let increment = 1024_u64;
+      out = out.reserve-additional(increment);
+      by = fread(out.ptr(out.length), 1_u64, increment, fp);
+      out._length = (out.length + by) as U32;
+   };
+   fclose(fp);
+   out
+);
+
+let read-file(fp: CString): CString = (
+   let v = read-binary-file-to(mk-vector(type(U8)), fp);
+   v.into(type(CString))
+);

PLATFORM/C/LIB/smart-string.lm

@@ -147,6 +147,7 @@ head-string := λ(: x SmartString). (: (
 # Smart Strings may allocated a hidden null byte after the data to protect against any accidental CString coercions
 + := λ(: l SmartString)(: r SmartString). (: (
    (let length (+( (.length l) (.length r) )))
+   # when porting this to LSTS, replace malloc with safe-alloc
    (let data (as (malloc( (+( length 1_u64 )) )) U8[]))
    (let li 0_u64)
    (while (<( li (.length l) )) (

PLATFORM/C/LIB/u8.lsts

@@ -27,7 +27,7 @@ declare-unop( into-branch-conditional, raw-type(U8), raw-type(BranchConditional)
 let print(x: U8): Nil = print(x as U64);
 
 let clone-rope(s: U8): CString = (
-   let x = malloc(2) as U8[];
+   let x = safe-alloc(2, type(U8));
    x[0] = s;
    x[1] = 0_u8;
    x as CString;

PLATFORM/C/LIB/umbra.lsts

@@ -209,7 +209,7 @@ let new-umbra(length: U64): Umbra = (
         let cs = const-cons(0_u8, 4_l);
         Umbra(length as U32,
             UmbraLong(cs as U8[4],
-                malloc(length) as U8[]))
+                safe-alloc(length, type(U8))))
     }
 );
 

PLATFORM/C/LIB/vector.lsts

@@ -208,3 +208,10 @@ let .into(in: Vector<U8>, res: Type<CString>): CString = (
 let .into(self: Vector<U8>, res: Type<SmartString>): SmartString = (
    intern(self.into(type(CString)))
 );
+
+let .ptr(v: Vector<t>, toelem: U64): t[] = (
+   if toelem >= v.capacity {
+      fail("Vector.ptr() index out of capacity bounds");
+   };
+   ((v.data as U64) + sizeof(t) * toelem) as t[]
+);