From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 15 Sep 2006 03:23:16 +0000 (+0000)
Subject: r11157: add sbcl gc
X-Git-Tag: v2006ac.2~56
X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=3624cc56e888df9ff9398810dc2b404cb0a1ce79

r11157: add sbcl gc
---

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index ad9105a..20e58b4 100644
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -51,27 +51,32 @@
     (when (and *preparse-hash-init?* (not force-read))
       (return-from ensure-preparse 'already-done))
     (make-preparse-hash-table)
-    (with-umls-file (line "MRCONSO.RRF")
-      (let ((cui (parse-ui (nth 0 line)))
-            (lui (parse-ui (nth 3 line)))
-            (sui (parse-ui (nth 5 line)))
-            (sab (nth 11 line))
-            (srl (parse-integer (nth 15 line))))
-        ;; pfstr deprecated by KPKENG field in MRCONSO
-        #+nil
-        (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
+    (let ((counter 0))
+      (declare (fixnum counter))
+      (with-umls-file (line "MRCONSO.RRF")
+        (let ((cui (parse-ui (nth 0 line)))
+              (lui (parse-ui (nth 3 line)))
+              (sui (parse-ui (nth 5 line)))
+              (sab (nth 11 line))
+              (srl (parse-integer (nth 15 line))))
+          #+sbcl
+          (when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t))
+
+          ;; pfstr deprecated by KPKENG field in MRCONSO
+          #+nil
+          (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
             (when (and (string-equal (nth 1 line) "ENG") ; LAT
                        (string-equal (nth 2 line) "P") ; ts
                        (string-equal (nth 4 line) "PF")) ; stt
 	      (setf (gethash cui pfstr-hash) (nth 14 line))))
-        (set-lrl-hash cui srl cui-lrl-hash)
-        (set-lrl-hash lui srl lui-lrl-hash)
-        (set-lrl-hash sui srl sui-lrl-hash)
-        (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
-        (multiple-value-bind (val found) (gethash sab sab-srl-hash)
-          (declare (ignore val))
-          (unless found
-            (setf (gethash sab sab-srl-hash) srl)))))
+          (set-lrl-hash cui srl cui-lrl-hash)
+          (set-lrl-hash lui srl lui-lrl-hash)
+          (set-lrl-hash sui srl sui-lrl-hash)
+          (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
+          (multiple-value-bind (val found) (gethash sab sab-srl-hash)
+            (declare (ignore val))
+            (unless found
+              (setf (gethash sab sab-srl-hash) srl))))))
     (setq *preparse-hash-init?* t)
     t)