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 32f007ae23f3a74ebfc46c8323d6d015319a2992..20f8532c43452111acd9b18ba1553736025e3a66 100644 (file)
--- 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 4690972ee0a60453113a6c18ffc821232de2104c..4258cc18524021a2a7bcf41537b763631975d093 100644 (file)
--- 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 a2b869b7b0cf653a47ee513f7a4df666489a0b6f..0d46623356a85859d219ed2f7de7e6f1146de750 100644 (file)
--- 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 da10a48c9d16e2a8d6be2c0c4888b4f9e7a0d516..7cefe3ffc926d6aca4a8ffb3fa5dce52af3c404b 100644 (file)
--- 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 66527d2d840ec4a9bb193cdd6579d11fad0859b8..d4b00528485d37e1d280c993bb6342a07bfe62a4 100644 (file)
--- 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 e56ee5c1badf0d520b82a5caaf40d2ab1246515d..a70d4a8c22b955916afae6e3d957ccf4c16237dc 100644 (file)
--- 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 e237664db52b29636c5e9f5c2d35f33ba2c89c2a..c92c00e1e7d2a0d54a0b3d471d16ccafada237d6 100644 (file)
--- 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 70d294c3770733473e2050eb1009877c58d84582..0b0222a5b3f896937384121814d9e106b1e215b3 100644 (file)
--- 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)
 \f
 (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 882ec21bfb396ad959322ed1c339cc3975029e77..28af935baa473bd17e18c3817b7d4aef838b8fc4 100644 (file)
--- 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)
 \f