Skip to content

Commit

Permalink
Generic string implementation additions (bootstrap)
Browse files Browse the repository at this point in the history
  • Loading branch information
@manuel-serrano
manuel-serrano committed Jul 10, 2024
1 parent c2757d9 commit 0159aed
Show file tree
Hide file tree
Showing 5 changed files with 44 additions and 9 deletions.
14 changes: 12 additions & 2 deletions runtime/Ieee/string-generic.sch
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;* ------------------------------------------------------------- */
;* Author : Manuel Serrano */
;* Creation : Tue Jul 9 13:49:25 2024 */
;* Last change : Tue Jul 9 14:03:02 2024 (serrano) */
;* Last change : Wed Jul 10 08:29:12 2024 (serrano) */
;* Copyright : 2024 Manuel Serrano */
;* ------------------------------------------------------------- */
;* Generic portable string implementation. */
Expand All @@ -13,7 +13,8 @@
;* The directives */
;*---------------------------------------------------------------------*/
(directives
(export ($$substring=?::bool ::bstring ::bstring ::long)))
(export ($$substring=?::bool ::bstring ::bstring ::long)
($$string=?::bool ::bstring ::bstring)))

;*---------------------------------------------------------------------*/
;* $$substring=? ... */
Expand All @@ -30,3 +31,12 @@
(else
#f)))))

;*---------------------------------------------------------------------*/
;* $$string=? ... */
;*---------------------------------------------------------------------*/
(define ($$string=? string1 string2)
(let ((l1 (string-length string1))
(l2 (string-length string2)))
(and (=fx l1 l2) ($$substring=? string1 string2 l1))))


6 changes: 4 additions & 2 deletions runtime/Ieee/string.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;* ------------------------------------------------------------- */
;* Author : Manuel Serrano */
;* Creation : Mon Mar 20 19:17:18 1995 */
;* Last change : Tue Jul 9 14:02:12 2024 (serrano) */
;* Last change : Wed Jul 10 08:29:01 2024 (serrano) */
;* ------------------------------------------------------------- */
;* 6.7. Strings (page 25, r4) */
;* ------------------------------------------------------------- */
Expand Down Expand Up @@ -357,8 +357,10 @@
(let ((l1 (string-length string1)))
(when (=fx l1 (string-length string2))
(=fx ($memcmp string1 string2 l1) 0))))
(bigloo-jvm
($string=? string1 string2))
(else
($string=? string1 string2))))
($$string=? string1 string2))))

;*---------------------------------------------------------------------*/
;* @deffn substring=?@ ... */
Expand Down
23 changes: 21 additions & 2 deletions runtime/Ieee/symbol-generic.sch
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;* ------------------------------------------------------------- */
;* Author : Manuel Serrano */
;* Creation : Tue Jul 9 13:46:43 2024 */
;* Last change : Tue Jul 9 14:01:11 2024 (serrano) */
;* Last change : Wed Jul 10 08:26:36 2024 (serrano) */
;* Copyright : 2024 Manuel Serrano */
;* ------------------------------------------------------------- */
;* Symbol generic implementation */
Expand All @@ -13,7 +13,8 @@
;* The directives */
;*---------------------------------------------------------------------*/
(directives
(export ($$bstring->symbol::symbol ::bstring)))
(export ($$bstring->symbol::symbol ::bstring)
($$bkeyword->symbol::keyword ::bstring)))

;*---------------------------------------------------------------------*/
;* symbol table */
Expand All @@ -33,5 +34,23 @@
(set! *symbol-table* (cons (cons string sym) *symbol-table*))
sym)))))

;*---------------------------------------------------------------------*/
;* keyword table */
;*---------------------------------------------------------------------*/
(define *keyword-mutex* (make-mutex))
(define *keyword-table* '())

;*---------------------------------------------------------------------*/
;* $$bstring->keyword ... */
;*---------------------------------------------------------------------*/
(define ($$bstring->keyword string)
(synchronize *keyword-mutex*
(let ((old (assoc string *keyword-table*)))
(if (pair? old)
(cdr old)
(let ((sym ($make-keyword string)))
(set! *keyword-table* (cons (cons string sym) *keyword-table*))
sym)))))



2 changes: 1 addition & 1 deletion runtime/Jlib/foreign.java
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5753,7 +5753,7 @@ public static Object bgl_time( procedure p ) {
res = p.funcall0();
end = System.currentTimeMillis();

env.mvalues_number = 1;
env.mvalues_number = 4;
env.mvalues_values[ 1 ] = BINT( end - start );
env.mvalues_values[ 2 ] = BINT( 0 );
env.mvalues_values[ 3 ] = BINT( 0 );
Expand Down
8 changes: 6 additions & 2 deletions runtime/Llib/bigloo.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;* ------------------------------------------------------------- */
;* Author : Manuel Serrano */
;* Creation : Fri Jan 20 08:24:40 1995 */
;* Last change : Fri Jul 5 10:02:37 2024 (serrano) */
;* Last change : Wed Jul 10 08:31:14 2024 (serrano) */
;* ------------------------------------------------------------- */
;* The bigloo runtime utility functions */
;*=====================================================================*/
Expand Down Expand Up @@ -692,7 +692,11 @@
;*---------------------------------------------------------------------*/
(define (time proc)
(if (correct-arity? proc 0)
($time proc)
(cond-expand
((or bigloo-c bigloo-jvm)
($time proc))
(else
(values (proc) 0 0 0)))
(error 'time "Wrong procedure arity" proc)))

;*---------------------------------------------------------------------*/
Expand Down

0 comments on commit 0159aed

Please sign in to comment.