From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 14 Feb 2008 03:34:11 +0000 (+0000)
Subject: Fix various places where variables defined with DEFINE-PRIMITIVES were
X-Git-Tag: 20090517-FFI~316
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=71a593c3c71ddfdf05d192716b0375495522da2e;p=mit-scheme.git

Fix various places where variables defined with DEFINE-PRIMITIVES were
assumed have primitive-procedure values.
---

diff --git a/v7/src/edwin/bios.scm b/v7/src/edwin/bios.scm
index 32f007ae2..20f8532c4 100644
--- a/v7/src/edwin/bios.scm
+++ b/v7/src/edwin/bios.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: bios.scm,v 1.10 2008/01/30 20:01:58 cph Exp $
+$Id: bios.scm,v 1.11 2008/02/14 03:34:03 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -57,7 +57,8 @@ USA.
 		 y-size)))
 
 (define (bios-available?)
-  (and (implemented-primitive-procedure? bios:can-use-bios?)
+  (and (implemented-primitive-procedure?
+	(ucode-primitive bios:can-use-bios? 0))
        (bios:can-use-bios?)
        (let ((term (get-environment-variable "TERM")))
 	 (and term
diff --git a/v7/src/edwin/termcap.scm b/v7/src/edwin/termcap.scm
index 4690972ee..4258cc185 100644
--- a/v7/src/edwin/termcap.scm
+++ b/v7/src/edwin/termcap.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: termcap.scm,v 1.12 2008/01/30 20:02:06 cph Exp $
+$Id: termcap.scm,v 1.13 2008/02/14 03:34:04 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -131,7 +131,8 @@ USA.
       (let ((x-size (output-port/x-size console-output-port))
 	    (y-size (output-port/y-size console-output-port)))
 	(make-ansi-terminal-description x-size y-size))
-      (and (implemented-primitive-procedure? termcap-initialize)
+      (and (implemented-primitive-procedure?
+	    (ucode-primitive termcap-initialize 1))
 	   (termcap-initialize terminal-type-name)
 	   (let ((supdup? (string=? terminal-type-name "supdup"))
 		 (tn-standout-marker-width (termcap-get-number "sg"))
diff --git a/v7/src/edwin/win32.scm b/v7/src/edwin/win32.scm
index a2b869b7b..0d4662335 100644
--- a/v7/src/edwin/win32.scm
+++ b/v7/src/edwin/win32.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: win32.scm,v 1.22 2008/01/30 20:02:07 cph Exp $
+$Id: win32.scm,v 1.23 2008/02/14 03:34:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -307,7 +307,7 @@ USA.
 (define previewer-registration)
 
 (define (win32-screen-available?)
-  (implemented-primitive-procedure? win32-screen-create!))
+  (implemented-primitive-procedure? (ucode-primitive win32-screen-create! 2)))
 
 (define (initialize-package!)
   (set! win32-screens '())
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index da10a48c9..7cefe3ffc 100644
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xterm.scm,v 1.82 2008/01/30 20:02:08 cph Exp $
+$Id: xterm.scm,v 1.83 2008/02/14 03:34:06 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1359,7 +1359,8 @@ Otherwise, it is copied from the primary selection."
   ;; X-OPEN-DISPLAY hangs, uninterruptibly, when the X server is
   ;; running the login loop of xdm.  Can this be fixed?
   (or x-display-data
-      (and (implemented-primitive-procedure? x-open-display)
+      (and (implemented-primitive-procedure?
+	    (ucode-primitive x-open-display 1))
 	   (or x-display-name (get-environment-variable "DISPLAY"))
 	   (let ((display (x-open-display x-display-name)))
 	     (set! x-display-data display)
diff --git a/v7/src/runtime/berkeley-db.scm b/v7/src/runtime/berkeley-db.scm
index 66527d2d8..d4b005284 100644
--- a/v7/src/runtime/berkeley-db.scm
+++ b/v7/src/runtime/berkeley-db.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: berkeley-db.scm,v 1.7 2008/01/30 20:02:28 cph Exp $
+$Id: berkeley-db.scm,v 1.8 2008/02/14 03:34:07 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -184,7 +184,7 @@ USA.
 
 (define (bdb-available?)
   (load-library-object-file "prdb4" #f)
-  (and (implemented-primitive-procedure? db4:db-create)
+  (and (implemented-primitive-procedure? (ucode-primitive db4:db-create 3))
        (begin
 	 (if (not interface-initialized?)
 	     (begin
diff --git a/v7/src/runtime/os2graph.scm b/v7/src/runtime/os2graph.scm
index e56ee5c1b..a70d4a8c2 100644
--- a/v7/src/runtime/os2graph.scm
+++ b/v7/src/runtime/os2graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2graph.scm,v 1.28 2008/01/30 20:02:33 cph Exp $
+$Id: os2graph.scm,v 1.29 2008/02/14 03:34:08 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -207,7 +207,7 @@ USA.
 ;;;; Standard Operations
 
 (define (os2-graphics/available?)
-  (implemented-primitive-procedure? os2win-open))
+  (implemented-primitive-procedure? (ucode-primitive os2win-open 2)))
 
 (define (os2-graphics/open descriptor->device #!optional width height)
   (if (not event-descriptor)
diff --git a/v7/src/runtime/pgsql.scm b/v7/src/runtime/pgsql.scm
index e237664db..c92c00e1e 100644
--- a/v7/src/runtime/pgsql.scm
+++ b/v7/src/runtime/pgsql.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pgsql.scm,v 1.14 2008/01/30 20:02:33 cph Exp $
+$Id: pgsql.scm,v 1.15 2008/02/14 03:34:09 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -148,7 +148,7 @@ USA.
 
 (define (pgsql-available?)
   (load-library-object-file "prpgsql" #f)
-  (and (implemented-primitive-procedure? pq-connect-db)
+  (and (implemented-primitive-procedure? (ucode-primitive pq-connect-db 2))
        (begin
 	 (if (not pgsql-initialized?)
 	     (begin
diff --git a/v7/src/runtime/starbase.scm b/v7/src/runtime/starbase.scm
index 70d294c37..0b0222a5b 100644
--- a/v7/src/runtime/starbase.scm
+++ b/v7/src/runtime/starbase.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: starbase.scm,v 1.23 2008/01/30 20:02:35 cph Exp $
+$Id: starbase.scm,v 1.24 2008/02/14 03:34:10 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -137,7 +137,7 @@ USA.
 (define-accessors-and-mutators text-rotation)
 
 (define (operation/available?)
-  (implemented-primitive-procedure? starbase-open-device))
+  (implemented-primitive-procedure? (ucode-primitive starbase-open-device 2)))
 
 (define (operation/open descriptor->device device-name driver-name)
   (let ((identifier (starbase-open-device device-name driver-name)))
diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index 882ec21bf..28af935ba 100644
--- a/v7/src/runtime/x11graph.scm
+++ b/v7/src/runtime/x11graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: x11graph.scm,v 1.61 2008/01/30 20:02:37 cph Exp $
+$Id: x11graph.scm,v 1.62 2008/02/14 03:34:11 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -208,7 +208,8 @@ USA.
   (initialize-colormap-datatype))
 
 (define (x-graphics/available?)
-  (implemented-primitive-procedure? x-graphics-open-window))
+  (implemented-primitive-procedure?
+   (ucode-primitive x-graphics-open-window 3)))
 
 (define x-graphics-device-type)