head     1.2;
branch   ;
access   ;
symbols  Version_2_1:1.2 C_Demo_1:1.2;
locks    ; strict;
comment  @@;


1.2
date     89.09.05.17.16.49;  author mao;  state C_Demo_1;
branches ;
next     1.1;

1.1
date     89.02.16.00.15.13;  author dillon;  state Stab;
branches ;
next     ;


desc
@luis/ywang new libpqcl
@


1.2
log
@Working version of C-only demo
@
text
@;;;
;;; Object FADS interface to POSTGRES
;;;
;;; Copyright (c) 1986 Regents of the University of California
;;; 
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted,
;;; provided that the above copyright notice appear in all copies and
;;; that both that copyright notice and this permission notice appear in
;;; supporting documentation, and that the name of the University of
;;; California not be used in advertising or publicity pertaining to
;;; distribution of the software without specific, written prior
;;; permission.  The University of California makes no representations
;;; about the suitability of this software for any purpose.  It is
;;; provided "as is" without express or implied warranty.
;;; 
;;; $Author: dillon $
;;; $Source: RCS/pqcomm.cl,v $
;;; $Revision: 1.1 $
;;; $Date: 89/02/16 00:15:13 $
;;;

(in-package 'libpq :use '(lisp excl ff))

;;;
;;; Flag for determining if C object file is loaded
;;;
(defvar *libpq-loaded* nil
  "Used for determining if the libpq library object file is loaded")

;;;
;;; Load the C object files when being loaded or compiled
;;;
(eval-when (compile load eval)
	   ;; determine if C object file is already loaded
	   (when (or (not (boundp '*libpq-loaded*))
		     (null *libpq-loaded*))
		 ;; load the file
		 (format t "Loading C file ......~%")
		 (load "libpq.o")
		 ;; set the flag
		 (setq *libpq-loaded* t)))

;;;
;;; Remove extraneous extry points
;;;
#+ignore(
(remove-entry-point "__wrtchk")
(remove-entry-point "__findbuf")
(remove-entry-point "__xflsbuf")
(remove-entry-point "__bufsync")
(remove-entry-point "__findiop")
(remove-entry-point "__f_morefiles")
(remove-entry-point "__smbuf")
(remove-entry-point "_f_prealloc")
(remove-entry-point "__fwalk")
(remove-entry-point "__cleanup")
(remove-entry-point "__flsbuf")
(remove-entry-point "_fflush")
(remove-entry-point "_fclose")
(remove-entry-point "__iob")
)

;;;
;;; Argument checking flag
;;;
(defvar *libpq-argument-check* nil)

;;;
;;; libpq functions
;;;

(defforeign-list
  (list (list 'cpconnect 
	      :entry-point "_pconnect" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(string string)
	      :return-type :void)

	(list 'cpflush
	      :entry-point "_pflush"
	      :arg-checking *libpq-argument-check*
	      :arguments nil
	      :return-type :void)

	(list 'cpclose
	      :entry-point "_pclose"
	      :arg-checking *libpq-argument-check*
	      :arguments nil
	      :return-type :void)

	(list 'cputstr 
	      :entry-point "_putstr" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(string)
	      :return-type :void)

	(list 'cputnchar
	      :entry-point "_putnchar" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(string fixnum)
	      :return-type :void)

	(list 'cputint
	      :entry-point "_putint" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(integer fixnum)
	      :return-type :void)
	
	(list 'cgetpstr
	      :entry-point "_getpstr" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(string fixnum)
	      :return-type :fixnum)

	(list 'cgetpchar 
	      :entry-point "_getpchar" 
	      :arg-checking *libpq-argument-check*
	      :arguments '((array string-char) fixnum fixnum)
	      :return-type :void)

	(list 'cgetpbitmap 
	      :entry-point "_getpchar" 
	      :arg-checking *libpq-argument-check*
	      :arguments '((simple-array (unsigned-byte 8) (100)) 
			   fixnum fixnum)
	      :return-type :void)

	(list 'cgetpid
	      :entry-point "_getpchar" 
	      :arg-checking *libpq-argument-check*
	      :arguments '(string fixnum fixnum)
	      :return-type :void)

	(list 'cgetpint 
	      :entry-point "_getpint" 
	      :arguments '(fixnum) 
	      :arg-checking *libpq-argument-check*
	      :return-type :integer)))

;;; experiment by luis

(defforeign 'Cputsinglefloat
  :entry-point "_putsinglefloat" 
  :return-type :void
  :arguments '(single-float))

(defforeign 'Cputsinglefloat2
  :entry-point "_putsinglefloat_two" 
  :return-type :void
  :arguments '(single-float))

(defforeign 'Cputsinglefloat3
  :entry-point "_putsinglefloat_three" 
  :return-type :void
  :arguments '(single-float))

(defforeign 'Cputsinglefloat4
  :entry-point "_putsinglefloat_three" 
  :return-type :void
  :arguments '(single-float))

(defforeign 'Cputdoublefloat
  :entry-point "_putdoublefloat" 
  :return-type :void
  :arguments '(double-float))

(defforeign 'Cputdoublefloat2
  :entry-point "_putdoublefloat_two" 
  :return-type :void
  :arguments '(double-float fixnum))

(defforeign 'Cgetsinglefloat
  :entry-point  "_getsinglefloat"
  :arguments nil
  :return-type :single-float)

(defforeign 'Cgetdoublefloat
  :entry-point  "_getdoublefloat"
  :arguments nil
  :return-type :double-float)

(defforeign 'Cputnfloat
  :entry-point "_putnfloat" 
  :arguments '(float fixnum))

(defforeign 'Cgetpfloat
  :entry-point "_getpfloat"
  :return-type :double-float
  :arguments '((simple-array float) fixnum fixnum))

(defforeign 'Cputsinglefloatarray
  :entry-point "_putsinglefloatarray"
  :arguments '((simple-array single-float)))

(defforeign 'Cputsinglefloatarray2
  :entry-point "_putsinglefloatarray_two"
  :arguments '((simple-array single-float) fixnum))

(defforeign 'Cputsinglefloatarray3
  :entry-point "_putsinglefloatarray_three"
  :arguments '((simple-array single-float) fixnum))

(defforeign 'Cputsinglefloatarray4
  :entry-point "_putsinglefloatarray_four"
  :arguments '((simple-array single-float) fixnum))

@


1.1
log
@Initial revision
@
text
@d17 4
a20 4
;;; $Author: ywang $
;;; $Source: /b/users/ywang/work/libpq/RCS/pqcomm.cl,v $
;;; $Revision: 2.2 $
;;; $Date: 88/09/13 16:17:55 $
@