Gambit-C 4.0 beta 19
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Gambit-C 4.0 beta 19 is now available. The source tarball is here: http://www.iro.umontreal.ca/~gambit/download/gambit/4.0/source/ gambc-4.0b19.tar.gz A prebuilt installation for Microsoft Windows is available here: http://www.iro.umontreal.ca/~gambit/download/gambit/4.0/prebuilt/ gambc-4.0b19-win.zip Just unzip it in C: to get C:\Gambit-C\4.0b19, then add C:\Gambit-C\4.0b19\bin to your path. Here are the highlights of this release: - The compiler incorrectly transformed (and X Y) when Y was a non-boolean constant. This has been fixed. - The runtime system contained C++ style comments. This caused problems on finicky C compilers (such as xlC on AIX). The comments have been replaced by C style comments. - Some changes were applied to gambit.h to support the ARM processor. - The predefined procedures "finite?", "infinite?", and "nan?" are now implemented. - The fixnum specific procedures "fxbitcount", "fxlength", and "fxfirst-bit-set" now conform to the R6RS draft. - Miscellaneous bug fixes. Marc -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.3 (Darwin) iD8DBQFFGFkk//V9Zc2T/v4RAkseAJ44iAS4mvn4tsZT4VV7aqIk96/wnwCgttFy AsZZh9zHkwoBb2iEvSWILxE= =5vs9 -----END PGP SIGNATURE-----
Afficher les réponses par date
Marc: Thanks again. I've included some suggested changes for _num.scm. They change "first-set-bit" to "first-bit-set" consistently; they use the fixnum routines ##fxbit-count, ##fx-length, and ##fxfirst-bit-set in ##bit- count, ##integer-length, and ##first-bit-set. The changes to ##bit- count, ##integer-length, and ##first-bit-set have been tested rather thoroughly, and I think the name changes in the rest are fairly straightforward to check. I've also removed one optional clause in the computation of bignum multiplication. That clause just substituted one O(N\log N) algorithm for another and I want to simplify bignum multiplication in the short term. Brad
I have a Scheme program (about 1500 lines long) I've run under gsi over & over again with great results. But I get segfaults if I use gsc/gcc instead, even with drastically simpler version of the program. My guess is that it's a mutation problem, involving my function Val-set! So first the bad gsc/gcc output, the good gsi output, and then the program, which is unfortunately about 500 lines long. At least there are very few Val-set! occurences. % ll gambit.h libgambc.so lrwxrwxrwx 1 richter users 46 Sep 25 20:45 gambit.h -> /rhome/richter/Gambit/current/include/gambit.h lrwxrwxrwx 1 richter users 45 Sep 25 20:46 libgambc.so -> /rhome/richter/Gambit/current/lib/libgambc.so % echo $LD_LIBRARY_PATH /rhome/richter/Gambit/current/lib My beta 19 installation look OK? Now let's run the offending program: % gsc trymutate.scm; gcc -O2 -L. -I. trymutate.c trymutate_.c -lgambc; ./a.out Show Possibles Check for Solved Cells cell B9 set to 3 A | 8 37 357 | 237 235 1 | 35679 4 236 B | 2 347 6 | 378 9 34578 | 357 1 3 C | 3457 1347 9 | 237 2345 6 | 357 8 23 +-------------------------+-------------------------+------------------------- D | 1 2 4 | 3678 3568 3578 | 3567 3567 9 E | 3567 367 3578 | 1236789 1234568 2345789 | 3567 3567 136 F | 9 367 357 | 1367 1356 357 | 8 2 4 +-------------------------+-------------------------+------------------------- G | 367 5 237 | 4 2368 2389 | 1 369 368 H | 346 8 13 | 1369 7 39 | 2 369 5 J | 346 9 123 | 5 12368 238 | 346 36 7 Show Possibles #t8 #f00 #t5678 #t12 #t96 #t1 #t5679 #t4 #t26 #t2 #t47 #t6 #t78 #t9 #t4578 #t57 #t1 #t3 #t24514514951415142514751451451455149 #f5514 #t9 #f514514251492568536870909238514 #f8514 #t6 #t57 #t8 #t2 #t1 #t2 #t4 #f514 #f51495141514 #f2514 #f7514 #f5145145514 #t9 #f5148 #f5149 #f5141 #f514 #f514 #f514 #f5146 #f5146 #t16 #t9 #f5140 #f5145 #f5148 #t514514806Segmentation fault ******************************************************* Every #f should've been #t. Here's the nice output from gsi: % gsi trymutate.scm ******************************************************* Show Possibles Check for Solved Cells cell B9 set to 3 A | 8 37 357 | 237 235 1 | 35679 4 236 B | 2 347 6 | 378 9 34578 | 357 1 3 C | 3457 1347 9 | 237 2345 6 | 357 8 23 +-------------------------+-------------------------+------------------------- D | 1 2 4 | 3678 3568 3578 | 3567 3567 9 E | 3567 367 3578 | 1236789 1234568 2345789 | 3567 3567 136 F | 9 367 357 | 1367 1356 357 | 8 2 4 +-------------------------+-------------------------+------------------------- G | 367 5 237 | 4 2368 2389 | 1 369 368 H | 346 8 13 | 1369 7 39 | 2 369 5 J | 346 9 123 | 5 12368 238 | 346 36 7 Show Possibles Check for Solved Cells cell C9 set to 2 A | 8 37 357 | 237 235 1 | 5679 4 26 B | 2 47 6 | 78 9 4578 | 57 1 3 C | 3457 1347 9 | 237 2345 6 | 57 8 2 +-------------------------+-------------------------+------------------------- D | 1 2 4 | 3678 3568 3578 | 3567 3567 9 E | 3567 367 3578 | 1236789 1234568 2345789 | 3567 3567 16 F | 9 367 357 | 1367 1356 357 | 8 2 4 +-------------------------+-------------------------+------------------------- G | 367 5 237 | 4 2368 2389 | 1 369 68 H | 346 8 13 | 1369 7 39 | 2 369 5 J | 346 9 123 | 5 12368 238 | 346 36 7 Show Possibles A | 8 37 357 | 237 235 1 | 5679 4 6 B | 2 47 6 | 78 9 4578 | 57 1 3 C | 3457 1347 9 | 37 345 6 | 57 8 2 +-------------------------+-------------------------+------------------------- D | 1 2 4 | 3678 3568 3578 | 3567 3567 9 E | 3567 367 3578 | 1236789 1234568 2345789 | 3567 3567 16 F | 9 367 357 | 1367 1356 357 | 8 2 4 +-------------------------+-------------------------+------------------------- G | 367 5 237 | 4 2368 2389 | 1 369 68 H | 346 8 13 | 1369 7 39 | 2 369 5 J | 346 9 123 | 5 12368 238 | 346 36 7 #t8 #t37 #t357 #t237 #t235 #t1 #t5679 #t4 #t6 #t2 #t47 #t6 #t78 #t9 #t4578 #t57 #t1 #t3 #t3457 #t1347 #t9 #t37 #t345 #t6 #t57 #t8 #t2 #t1 #t2 #t4 #t3678 #t3568 #t3578 #t3567 #t3567 #t9 #t3567 #t367 #t3578 #t1236789 #t1234568 #t2345789 #t3567 #t3567 #t16 #t9 #t367 #t357 #t1367 #t1356 #t357 #t8 #t2 #t4 #t367 #t5 #t237 #t4 #t2368 #t2389 #t1 #t369 #t68 #t346 #t8 #t13 #t1369 #t7 #t39 #t2 #t369 #t5 #t346 #t9 #t123 #t5 #t12368 #t238 #t346 #t36 #t7 A | 8 37 357 | 237 235 1 | 5679 4 6 B | 2 47 6 | 78 9 4578 | 57 1 3 C | 3457 1347 9 | 37 345 6 | 57 8 2 +-------------------------+-------------------------+------------------------- D | 1 2 4 | 3678 3568 3578 | 3567 3567 9 E | 3567 367 3578 | 1236789 1234568 2345789 | 3567 3567 16 F | 9 367 357 | 1367 1356 357 | 8 2 4 +-------------------------+-------------------------+------------------------- G | 367 5 237 | 4 2368 2389 | 1 369 68 H | 346 8 13 | 1369 7 39 | 2 369 5 J | 346 9 123 | 5 12368 238 | 346 36 7 ******************************************************* *******trymutate.scm ******************************************************* (declare (standard-bindings) (fixnum) (not safe) (run-time-bindings) (inline) (inlining-limit 1000) (block)) ;Import U#7: 800001040206090010009006080124000009000000000900000824050400100080070205090500007 ;http://www.scanraid.com/sudoku.htm?bd=80000104020609001000900608012400000900... (define U#7 '#(0 #(0 8 0 0 0 0 1 0 4 0) #(0 2 0 6 0 9 0 0 1 0) #(0 0 0 9 0 0 6 0 8 0) #(0 1 2 4 0 0 0 0 0 9) #(0 0 0 0 0 0 0 0 0 0) #(0 9 0 0 0 0 0 8 2 4) #(0 0 5 0 4 0 0 1 0 0) #(0 0 8 0 0 7 0 2 0 5) #(0 0 9 0 5 0 0 0 0 7))) (define empty '()) (define empty? null?) (define true #t) (define false #f) (define first car) (define rest cdr) (define second cadr) (define third caddr) (define fourth cadddr) (define (fifth alist) (first (cddddr alist))) (define (add1 x) (+ x 1)) (define (sub1 x) (- x 1)) (define (symbol=? x y) (and (symbol? x) (symbol? y) (equal? x y))) ;;nlist : N -> (listof N) ;; to construct list (0 1 2 .... n-1) (define (nlist n) (let loop ([n (sub1 n)] [accum empty]) (if (< n 0) accum (loop (sub1 n) (cons n accum))))) ;; build-list : N (N -> X) -> (listof X) ;; to construct (list (f 0) ... (f (- n 1))) (define (build-list n f) (map f (nlist n))) ; ;; filter : (X -> boolean) (listof X) -> (listof X) ; ;; to construct a list from all those items on aloX for which p holds (define (filter p aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (p x) (cons x (filter p (rest aloX))) (filter p (rest aloX)))))) ; (define (build-vector n f) ; (do ((vec (make-vector n)) ; (i 0 (+ i 1))) ; ((= i n) vec) ; (vector-set! vec i (f i)))) ; ;; remove : X (listof X) -> (listof X) ; ;; to construct a list by removing from `aloX' the first instance of ; ;; `item', where an instance is found by comparing `item' to the ; ;; elements of the list `aloX' items using `equal?'. (define (remove item aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (equal? item x) (rest aloX) (cons x (remove item (rest aloX))))))) ; ;; remove* : (listof X) (listof X) -> (listof X) ; ;; to construct a list by removing from `aloX' all instances of the ; ;; list `items', where an instance is found by comparing `item' to the ; ;; elements of the list `aloX' items using `equal?'. (define (remove* items aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (member x items) (remove* items (rest aloX)) (cons x (remove* items (rest aloX))))))) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;;; General purpose HtDP-type functions ; ;; union : (listof (listof X)) -> (listof X) ; ;; to take the union of a B1 union ... Bn of a collection of lists B = ; ;; (B1 ... Bn), with no repetitions. (define (union B) (if (empty? B) empty (let ([b (first B)]) (append b (remove* b (union (rest B))))))) ; ;; intersect : (listof X)^2 -> (listof X) ; ;; to intersect 2 lists A and B. If A is sorted, then (intersect A B) ; ;; will be sorted too, given transitivity of the less-than? function. (define (intersect A B) (if (empty? A) empty (let ([a (first A)]) (if (member a B) (cons a (intersect (rest A) B)) (intersect (rest A) B))))) ; ;; forall : (X -> boolean) (listof X) -> boolean ; ;; to test if (F x) is true for all elements x in X. ; ;; So if X is empty, return true. (define (forall F X) (or (empty? X) (and (F (first X)) (forall F (rest X))))) ; ;; forallv : (X -> void) (listof X) -> void ; ;; like forall or map, but don't test, and don't return a value. (define (forallv F X) (if (not (empty? X)) (begin (F (first X)) (forallv F (rest X))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Basic Sudoku functions involving points & grids etc. ;;; Points are lists (1--9 1--9), Sudokus are vector^2s of either numbers or lists of numbers (define (digit? x) (member x '(1 2 3 4 5 6 7 8 9))) (define (Val Sudoku Point) (vector-ref (vector-ref Sudoku (first Point)) (second Point))) (define (Val-set! Sudoku Point new-value) (vector-set! (vector-ref Sudoku (first Point)) (second Point) new-value)) (define (make-Point i j) (list i j)) (define (Point-first Point) (first Point)) (define (Point-second Point) (second Point)) (define Grid (apply append (build-list 9 (lambda (i) (build-list 9 (lambda (j) (make-Point (add1 i) (add1 j)))))))) (define (cell? P) (member P Grid)) (define (Rowlist Sudoku i) (filter number? (build-list 9 (lambda (j) (Val Sudoku (make-Point i (add1 j))))))) (define (Columnlist Sudoku j) (filter number? (build-list 9 (lambda (i) (Val Sudoku (make-Point (add1 i) j)))))) (define (Boxlist Sudoku i j) (filter number? (let ([qi (* 3 (quotient (sub1 i) 3))] [qj (* 3 (quotient (sub1 j) 3))]) (apply append (build-list 3 (lambda (i) (build-list 3 (lambda (j) (Val Sudoku (make-Point (+ qi i 1) (+ qj j 1))))))))))) (define Rows (build-list 9 (lambda (i) (build-list 9 (lambda (j) (make-Point (add1 i) (add1 j))))))) (define Cols (build-list 9 (lambda (j) (build-list 9 (lambda (i) (make-Point (add1 i) (add1 j))))))) (define Boxes (apply append (build-list 3 (lambda (qi) (build-list 3 (lambda (qj) (apply append (build-list 3 (lambda (i) (build-list 3 (lambda (j) (make-Point (+ (* 3 qi) i 1) (+ (* 3 qj) j 1))))))))))))) (define Units (append Rows Cols Boxes)) (define (EmptyCells Sudoku) (filter (lambda (P) (list? (Val Sudoku P))) Grid)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Printing & other basic setup chores. (define (print-Sudoku Sudoku) (define (list->number alon) (let loop ([ralon (reverse alon)] [index 0] [accum 0]) (if (empty? ralon) accum (loop (rest ralon) (add1 index) (+ accum (* (expt 10 index) (first ralon))))))) (define (list/num-size entry) (if (number? entry) 1 (if (string? entry) (string-length entry) (if (not (list? entry)) (display entry) (length entry))))) (define (biggest Sudoku) (define (PointSize P) (list/num-size (Val Sudoku P))) (apply max (append (map PointSize Grid)))) (define (print-char char n) ;; print n spaces (do ([i 0 (add1 i)]) ([= i n]) (display char))) (let* ([entry-width (biggest Sudoku)] [print-entry (lambda (i j) (let ([entry (Val Sudoku (make-Point i j))]) (if (list? entry) (display (list->number entry)) (display entry)) ;; print a number of spaces: biggest - list/num-size (print-char " " (- entry-width (list/num-size entry))) (display " ")))] [print-ith-row (lambda (i) (newline) (displayASbeg i) (print-entry i 1) (print-entry i 2) (print-entry i 3) (display "| ") (print-entry i 4) (print-entry i 5) (print-entry i 6) (display "| ") (print-entry i 7) (print-entry i 8) (print-entry i 9))] [print-block-divider (lambda () (newline) (display " +-") (print-char "-" (+ 3 (* entry-width 3))) (display "+-") (print-char "-" (+ 3 (* entry-width 3))) (display "+-") (print-char "-" (+ 3 (* entry-width 3))))]) (print-ith-row 1) (print-ith-row 2) (print-ith-row 3) (print-block-divider) (print-ith-row 4) (print-ith-row 5) (print-ith-row 6) (print-block-divider) (print-ith-row 7) (print-ith-row 8) (print-ith-row 9) (newline))) (define (displayASbeg x) (cond [(= x 1) (display 'A)] [(= x 2) (display 'B)] [(= x 3) (display 'C)] [(= x 4) (display 'D)] [(= x 5) (display 'E)] [(= x 6) (display 'F)] [(= x 7) (display 'G)] [(= x 8) (display 'H)] [(= x 9) (display 'J)]) (display " | ")) (define (displayAS-cell cell) ;; to turn a list (x y) to Andrew's Solver Notation. ;; so (5 8) turns to E8 (let ([x (first cell)] [y (second cell)]) (cond [(= x 1) (display 'A)] [(= x 2) (display 'B)] [(= x 3) (display 'C)] [(= x 4) (display 'D)] [(= x 5) (display 'E)] [(= x 6) (display 'F)] [(= x 7) (display 'G)] [(= x 8) (display 'H)] [(= x 9) (display 'J)]) (display y))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Stepper Technique Scheduler, and initial moves (define status 'new) ;; first we print the puzzle, and it looks nice to not show the 0s. (define (Zero->Space Sudoku) (forallv (lambda (P) (let ([entry (Val Sudoku P)]) (if (zero? entry) (Val-set! Sudoku P " ")))) Grid) (print-Sudoku Sudoku)) (define (UnSpace Sudoku) (forallv (lambda (P) (if (zero? (Val Sudoku P)) (Val-set! Sudoku P '(1 2 3 4 5 6 7 8 9)))) Grid)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Actual Techniques! (define (CheckSolvedCell Sudoku) ;; upgrades every singleton candidate list to a big number (newline) (display "Check for Solved Cells") (forallv (lambda (P) (let ([val (Val Sudoku P)]) (if (list? val) (let ([x (first val)]) (if (equal? val (list x)) (begin (set! status 'solved-cell) (Val-set! Sudoku P x) (newline) (display "cell ") (displayAS-cell P) (display " set to ") (display x))))))) Grid) (if (forall (lambda (P) (number? (Val Sudoku P))) Grid) (set! status 'finished))) (define (ShowPossibles Sudoku) ;; recalculate candidate lists, to take new numbers into account. (newline);(newline) (display "Show Possibles") (forallv (lambda (P) (let ([i (Point-first P)] [j (Point-second P)] [our-list (Val Sudoku P)]) (if (list? our-list) (let* ([incoming (union (list (Rowlist Sudoku i) (Columnlist Sudoku j) (Boxlist Sudoku i j)))] [rule-these-out (intersect incoming our-list)]) (if (not (empty? rule-these-out)) (begin (set! status 'need-check) (Val-set! Sudoku P (remove* rule-these-out our-list)))))))) Grid)) ;(Zero->Space U#7) (UnSpace U#7) (ShowPossibles U#7) (CheckSolvedCell U#7) (print-Sudoku U#7) (ShowPossibles U#7) (CheckSolvedCell U#7) (print-Sudoku U#7) (ShowPossibles U#7) (print-Sudoku U#7) ;(display U#7) (forallv (lambda (P) (newline) (let ([Plist (Val U#7 P)]) (display (or (number? Plist) (string? Plist) (list? Plist))) (display Plist))) Grid) (print-Sudoku U#7) ; (CheckSolvedCell U#7) ; (print-Sudoku U#7) ; gcc -O2 -L. -I. MC.c MC_.c -lgambc ; gcc -O2 -L. -I. trygamb.c trygamb_.c -lgambc
At 15:05 Uhr -0500 27.09.2006, Bill Richter wrote:
I have a Scheme program (about 1500 lines long) I've run under gsi over & over again with great results. But I get segfaults if I use gsc/gcc instead, even with drastically simpler version of the program.
FWIW, I've tried the equivalent of (through chjmodule) (compile-file "sudoku.scm" '(debug)) (load "sudoku") and it ran without segfault for me. This is on Gambit b17 on Linux x86 gcc 3.3.5. Maybe try compiling without the fixnum and not safe directives (and try compile-file, which should use compilation options that work). Christian.
participants (4)
-
Bill Richter -
Bradley Lucier -
Christian -
Marc Feeley