[comp.lang.lisp] KCL question

sawada@etl.go.jp (Toshimi sawada) (05/02/90)

| I received some requests to post my package.
|
| This is a package for (Austin)KCl which offers foreign data interface
| facilities. It is far from sofisticated, but it works well and is
| useful (at least for me). 

I forgot an example program showing how to use the package.
Thanks those who asked me "How should I use this pacage?"
Sorry, but there is not a documentation.

Comments, suggestions, and questions are welcom, mail me please.
-----------------------<cut here>--------------------------------
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-
(use-package :FI)

;;; NOTE: This test only works on AKCL 1.465 - ??

;;; defininig some internal data structures of AKCL

(def-foreign-struct FIRSTWORD
  (type 0 :type :short)
  (mark 0 :type :short))

(def-foreign-struct (%fixnum (:include firstword))
  (fixval 0 :type :int))

(def-foreign-struct (%long-float (:include firstword))
  (lfval 0.0 :type :double))

(def-foreign-struct (%symbol (:include firstword))
  (dbind 0 :type :object)
  (sfdef 0 :type :int)
  (fillp 0 :type :int)
  (self 0 :type :string)
  (gfdef 0 :type :object)
  (plist 0 :type :object)
  (hpack 0 :type :object)
  (stype 0 :type :short)
  (mflag 0 :type :short))

(def-foreign-struct (%package (:include firstword))
  (name 0 :type :object)
  (nickname 0 :type :object)
  (shadowings 0 :type :object)
  (uselist 0 :type :object)
  (usedbylist 0 :type :object)
  (internal 0 :type :object*)
  (external 0 :type :object*)
  (internal-size 0 :type :int)
  (external-size 0 :type :int)
  (internal-fp 0 :type :int)
  (external-fp 0 :type :int)
  (package 0 :type :pointer))

(def-foreign-struct (%cfdata (:include firstword))
  (start 0 :type :char*)
  (size 0 :type :int)
  (fillp 0 :type :int)
  (self 0 :type :object))

(def-foreign-struct (%cfun (:include firstword))
  (name  0 :type :object)
  (self 0 :type :int)
  (data 0 :type %cfdata))

(def-foreign-struct (%cclosure (:include firstword))
  (name 0 :type :object)
  (self 0 :type :int)
  (env 0 :type :object)
  (data 0 :type :object)
  (turbo 0 :type :object))

(def-foreign-struct (%sfun (:include firstword))
  (name 0 :type :object)
  (self 0 :type :int)
  (data 0 :type :object)
  (argd 0 :type :int))

(def-foreign-struct (%vfun (:include firstword))
  (name 0 :type :object)
  (self 0 :type :int)
  (data 0 :type :object)
  (minargs 0 :type :ushort)
  (maxargs 0 :type :ushort))


#| test tes test .....
(setq int (map-foreign-struct '%fixnum-struct 10))
(%fixnum-fixval int)

(setq float (map-foreign-struct %long-float 1.234))
(%long-floatl-fval float)

;;;; 
(setq car (map-foreign-struct %symbol 'car))
(%symbol-type car)
(%symbol-mark car)
(%symbol-dbind car)
(%symbol-sfdef car)
(%symbol-fillp car)
(%symbol-self car)
(%symbol-gfdef car)
(%symbol-plist car)
(%symbol-hpack car)
(%symbol-stype car)
(%symbol-mflag car)

(setq foo (map-foreign-struct '%symbol 'foo))
(setf (%symbol-gfdef  foo) (%symbol-gfdef car))
(foo '(1  2 3 4))

(setq bar (map-foreign-struct '%package (find-package "FI")))
(%package-name bar)
(%package-nickname bar)
(%package-shadowings bar)
(%package-uselist bar)
(%package-uselist bar)
(%package-usedbylist bar)
(%package-internal bar)
(%package-external bar)
(*%package-internal bar)
(*%package-external bar)
(%package-internal-size bar)
(%package-external-size bar)
(%package-internal-fp bar)
(%package-external-fp bar)
(%package-package bar)
(setq baz (make-foreign-struct* '%package (%package-package bar)))
(%package-name baz)
;;;
(setq x (map-foreign-struct '%cfun (symbol-function 'map-foreign-struct)))
(%cfun-name x)
(%cfun-self x)
(setq y (%cfun-data x))
(%cfdata-start y)
(%cfdata-size y)
(%cfdata-fillp y)
(%cfdata-self y)
|#

--
Toshimi Sawada
Software Reserach Associates Inc.
on leave at Computer Language Section, Electrotechnical Laboratory
1-1-4 Umezono, Tsukuba, Ibaraki 305, JAPAN
TEL: +81 298 58 5890
E-Mail: sawada@etl.go.jp