Pr 20210430 bugfixes

libraries/libgambit/0001-Fix-incorrect-space-allocation-report-by-time-specia.patch

@@ -0,0 +1,50 @@
+From e529b1d6d5b7bae2fcc3e9cd8e7f3e11a1318193 Mon Sep 17 00:00:00 2001
+From: Marc Feeley <feeley@iro.umontreal.ca>
+Date: Sun, 28 Mar 2021 19:29:54 -0400
+Subject: [PATCH] Fix incorrect space allocation report by time special form
+
+---
+ lib/_kernel.scm | 6 ++++--
+ lib/mem.c       | 3 ++-
+ 2 files changed, 6 insertions(+), 3 deletions(-)
+
+diff --git a/lib/_kernel.scm b/lib/_kernel.scm
+index 59b9e41..2d827dd 100644
+--- lib/_kernel.scm
++++ lib/_kernel.scm
+@@ -4346,7 +4346,9 @@ end-of-code
+
+     if (!___FIXNUMP(result))
+     {
+-      n = ___bytes_allocated (___PSPNC) - n;
++      ___F64 ba = ___bytes_allocated (___PSPNC);
++
++      n = ba - n;
+
+       ___process_times (&user, &sys, &real);
+       ___vm_stats (&minflt, &majflt);
+@@ -4358,7 +4360,7 @@ end-of-code
+       ___F64VECTORSET(result,___FIX(4),___vms->mem.gc_sys_time_)
+       ___F64VECTORSET(result,___FIX(5),___vms->mem.gc_real_time_)
+       ___F64VECTORSET(result,___FIX(6),___vms->mem.nb_gcs_)
+-      ___F64VECTORSET(result,___FIX(7),___bytes_allocated (___PSPNC))
++      ___F64VECTORSET(result,___FIX(7),ba)
+       ___F64VECTORSET(result,___FIX(8),(2*(1+2)<<___LWS))
+       ___F64VECTORSET(result,___FIX(9),n)
+       ___F64VECTORSET(result,___FIX(10),minflt)
+diff --git a/lib/mem.c b/lib/mem.c
+index 2c6cafd..9223da1 100755
+--- lib/mem.c
++++ lib/mem.c
+@@ -7080,7 +7080,8 @@ ___PSDKR)
+   alloc_stack_ptr = ___ps->fp;
+   alloc_heap_ptr  = ___ps->hp;
+
+-  return bytes_allocated_minus_occupied + bytes_occupied(___ps);
++  return bytes_allocated_minus_occupied + bytes_occupied(___ps) +
++         ___CAST(___F64,occupied_words_still) * ___WS;
+ }
+
+
+--
+2.20.1

loaders/win32/win32_microgl.c

@@ -95,6 +95,8 @@ static int _microgl_key(WPARAM wParam, LPARAM lParam, int modifier, int action)
     case VK_DOWN:   return EVENT_KEYDOWN;
     case VK_HOME:   return EVENT_KEYHOME;
     case VK_END:    return EVENT_KEYEND;
+    case VK_PRIOR:  return 0xff55;
+    case VK_NEXT:   return 0xff56;
     default:
       // if CTRL is down, ToAscii puts ^A to ^Z (0x01 to 0x1a) in char_buf
       // if ALT  is down, ToAscii puts  a to  z (lowercase)    in char_buf

loaders/x11/x11_microgl.c

@@ -111,6 +111,7 @@ void microgl_refresh()
   event.type       = Expose;
   event.xany.window     = win.Win;
   XSendEvent(Dpy, win.Win, False, Expose, &event);
+  XSync(Dpy, 0);
 }
 
 // https://tronche.com/gui/x/xlib/events/keyboard-pointer/keyboard-pointer.html
@@ -139,6 +140,9 @@ int _microgl_key( XKeyEvent *event )
     case XK_Right:        return EVENT_KEYRIGHT;
     case XK_Down:         return EVENT_KEYDOWN;
     case XK_Up:           return EVENT_KEYUP;
+    case XK_Page_Up: /* 0xff55 */
+    case XK_Page_Down: /* 0xff56 */
+      return keysym;
   }
   // Printable chars (Latin 1)
   if( (keysym >= 0x0020 && keysym <= 0x007e) || // Basic Latin 1 charset
@@ -180,7 +184,7 @@ void _microgl_sendCopyStringEvent(XSelectionRequestEvent* selReqEv) {
     .time      = CurrentTime
   };
   if (copiedString && selReqEv->target == format && selReqEv->property != None) {
-    XChangeProperty(Dpy, selReqEv->requestor, selReqEv->property, format, 8, PropModeReplace, copiedString, copiedStringLen + 1);
+    XChangeProperty(Dpy, selReqEv->requestor, selReqEv->property, format, 8, PropModeReplace, copiedString, copiedStringLen);
   } else {
     selEv.property = None;
   }
@@ -246,7 +250,7 @@ void microgl_pollevents(void)
         motion=1;
         break;
       case Expose:
-        expose=1;
+        expose = expose || (event.xexpose.width && event.xexpose.height) ? 1 : 0;
         break;
       case ClientMessage:  
         if( (Atom) event.xclient.data.l[ 0 ] == win.WMDeleteWindow )

make.sh

@@ -378,6 +378,7 @@ compile_payload()
   hookhash=`stringhash "apps/$SYS_APPNAME/hook.c"`
   hctgt="$SYS_PREFIX/build/$hookhash.c"
   hotgt=`echo "$hctgt" | sed 's/c$/o/'`
+  rmifexists "$hotgt"
   cp loaders/hook/hook.c "$hctgt"
   veval "$SYS_ENV $SYS_CC $payload_cdefs $languages_def -c -o $hotgt $hctgt -I$SYS_PREFIX/include"
   assertfile $hotgt

modules/clipboard/ANDROID_java_activityadditions

@@ -1,11 +1,10 @@
 private String getClipboardContent(){
   if (!(mClipboardManager.hasPrimaryClip())) {
     return "";
-  } else if (mClipboardManager.getPrimaryClipDescription().hasMimeType(ClipDescription.MIMETYPE_TEXT_PLAIN)) {
+  } else /* if (mClipboardManager.getPrimaryClipDescription().hasMimeType(ClipDescription.MIMETYPE_TEXT_PLAIN)) */ {
     ClipData.Item item = mClipboardManager.getPrimaryClip().getItemAt(0);
-    return item.getText().toString(); 
+    return item.coerceToText(this).toString();
   }
-  return "";
 }
 
 private int setClipboardContent(String str){

modules/clipboard/clipboard.scm

@@ -36,6 +36,8 @@ OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |#
 
+(c-declare "#include <stdio.h>") ;; debug
+
 (c-declare  #<<end-of-c-declare
 
 #ifdef IOS
@@ -99,16 +101,23 @@ int clipboard_copy(char *str, int len){
   Window window = microgl_getWindow();
   Atom selection = XInternAtom(display, "CLIPBOARD", 0);
   XSetSelectionOwner (display, selection, window, 0);
-  if (XGetSelectionOwner (display, selection) != window)
+  if( XGetSelectionOwner(display, selection) != window ) {
+    fprintf(stderr, "QUESTION: Why fail here in `clipboard_copy`?\n");
     return 0;
+  }
   microgl_setCopiedString(str, len);
-  return 0;
+  return 1;
 #endif
   return 0;
 }
 
 // Clipboard pasting
-char *clipboard_paste(){
+
+#ifdef LINUX
+static void* clipboard_data = NULL;
+#endif
+
+char* clipboard_paste(){
 #ifdef ANDROID
   return android_clipboard_paste();
 #endif
@@ -152,45 +161,55 @@ char *clipboard_paste(){
   Window window = microgl_getWindow();
   Atom selection = XInternAtom(display, "CLIPBOARD", 0);
   Window owner = XGetSelectionOwner(display, selection);
-  if (owner == window) {
+  if( clipboard_data != NULL ) {
+    log_c("usage error fixed: clipboard_data was not freed!\n");
+    XFree(clipboard_data);
+    clipboard_data = NULL;
+  }
+  if( owner == window ) {
     microgl_getCopiedString(&str);
     return str;
-  }
+  } else {
 
-  Atom type = XInternAtom(display, "STRING", 0);
-  Atom propid = XInternAtom(display, "XSEL_DATA", 0);
-  Atom incrid = XInternAtom(display, "INCR", 0);
-  XEvent event;
-
-  XConvertSelection(display, selection, type, propid, window, CurrentTime);
-  do {
-    XNextEvent(display, &event);
-  } while (event.type != SelectionNotify || event.xselection.selection != selection);
-
-  if (event.xselection.property){
-    unsigned long ressize, restail;
-    int resbits;
-    XGetWindowProperty(display, window, propid, 0, LONG_MAX/4, 0, AnyPropertyType,
-        &type, &resbits, &ressize, &restail, (unsigned char**)&str);
-
-    if (type == incrid){
-      log_c("Buffer is too large");
-      str="";
+    Atom type = XInternAtom(display, "STRING", 0);
+    Atom propid = XInternAtom(display, "XSEL_DATA", 0);
+    Atom incrid = XInternAtom(display, "INCR", 0);
+    XEvent event;
+
+    XConvertSelection(display, selection, type, propid, window, CurrentTime);
+    XSync(display, 0);
+    do {
+      XNextEvent(display, &event);
+    } while (event.type != SelectionNotify || event.xselection.selection != selection);
+
+    if( event.xselection.property ) {
+      unsigned long ressize, restail;
+      int resbits;
+      XGetWindowProperty(display, window, propid, 0, LONG_MAX/4, 0, AnyPropertyType,
+          &type, &resbits, &ressize, &restail, (unsigned char**)&clipboard_data);
+
+      if( type == incrid ) {
+        log_c("Buffer is too large");
+      }
     }
-  }else{
-    str="";
-  }
-  return str;
+    return (char*)clipboard_data;
+ }
 #endif
-  char* buf="";
-  return buf;
+  /* Not implemented on this platform - return the same as it was empty */
+  return NULL;
 }
 
 // Releases reference to string fetched during paste
 void clipboard_release(){
 #ifdef ANDROID
   android_clipboard_release();
 #endif
+#ifdef LINUX
+  if( clipboard_data != NULL ) {
+    XFree(clipboard_data);
+    clipboard_data = NULL;
+  }
+#endif
 }
 
 // Clipboard Clearing
@@ -240,13 +259,13 @@ end-of-c-declare
 ;; Function prototypes/bindings
 (define clipboard-clear (c-lambda (char-string) bool "clipboard_clear"))
 (define (clipboard-copy str)
-  ((c-lambda (char-string int) bool "___result=
-    clipboard_copy(___arg1,___arg2);")
-    str (string-length str)))
+  ((c-lambda (char-string int) bool "clipboard_copy")
+   str (string-length str)))
 (define (clipboard-paste)
-  (let ((str ((c-lambda () char-string "___result=clipboard_paste();"))))
-    ((c-lambda () void "clipboard_release();"))
+  (declare (not interrupts-enabled)) ;; important! no thread switch here
+  (let ((str ((c-lambda () char-string "clipboard_paste"))))
+    ((c-lambda () void "clipboard_release"))
     str))
-(define clipboard-hascontent (c-lambda () bool "___result=clipboard_hascontent();"))
+(define clipboard-hascontent (c-lambda () bool "clipboard_hascontent"))
 
 ;; eof

modules/json/json#.scm

@@ -42,6 +42,7 @@ json-read
 json-write
 json-error
 json-error?
+json-set-options!
 
 ))
 

modules/json/json.scm

@@ -52,6 +52,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (define use-symbols? #f) ;; how to encode JS true, false and null
 (define use-tables? #f)  ;; how to encode JS objects
+(define use-symbols-for-keys? #f) ;; how to encode JS object slot names
 
 (define debug? #f)
 
@@ -64,6 +65,16 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                  (cons 'TABLE (table->list obj))
                  obj)))))
 
+(define (json-set-options! #!key (symbols #f) (tables #f) (keys #f))
+  (set! use-symbols? symbols)
+  (set! use-tables? tables)
+  (set! use-symbols-for-keys? keys))
+
+(define-macro (->string obj)
+  `(cond
+    ((symbol? ,obj) (symbol->string ,obj))
+    (else ,obj)))
+
 (define (json-decode str)
   (call-with-input-string str json-read))
 
@@ -175,7 +186,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                           (if (json-error? val)
                               val
                               (let ((new-rev-elements
-                                     (cons (cons str val) rev-elements)))
+                                     (cons (cons (if use-symbols-for-keys?
+                                                     (string->symbol str)
+                                                     str) val)
+                                           rev-elements)))
                                 (space)
                                 (let ((c (pk)))
                                   (cond ((eqv? c #\})
@@ -350,7 +364,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
             (display #\" port)))))
 
   (define (wr-prop prop)
-    (wr-string (car prop))
+    (wr-string (->string (car prop)))
     (display ":" port)
     (wr (cdr prop)))
 

modules/ln_core/time.scm

@@ -258,9 +258,10 @@ end-of-c-declare
 ;; thanks, Martin Gasbichler ...
 
 (define (copy-time time)
-  (make-srfi19:time (srfi19:time-type time)
-	     (srfi19:time-second time)
-	     (srfi19:time-nanosecond time)))
+  (make-srfi19:time
+   (srfi19:time-type time)
+   (srfi19:time-nanosecond time)
+   (srfi19:time-second time)))
 
 
 ;;; current-time

modules/ln_glcore/glcore-ffi.scm

@@ -169,6 +169,16 @@ ___result = GL_CLAMP_TO_EDGE;
   ((c-lambda (float float float) void "glTranslatef") 
      (flo a) (flo b) (flo c)))
 
+(define glTranslatef//checks (c-lambda (float float float) void "glTranslatef"))
+
+
+(define glTranslatef/f32vector//checks
+  ;; call site argument checks are supposed to ensure type and length
+  (c-lambda
+   (scheme-object) void "
+___F32* args = ___CAST(___F32*, ___BODY_AS(___arg1, ___tSUBTYPED));
+glTranslatef(args[0], args[1], args[2]);"))
+
 (define (glScalef a b c) 
   ((c-lambda (float float float) void "glScalef") 
      (flo a) (flo b) (flo c)))