1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
;;
;; gpib.scm - guile binding for LinuxGpib
;;
;; Copyright (C) 2003 Stefan Jahn <stefan@lkcc.org>
;;
;; LinuxGpib is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; LinuxGpib is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with LinuxGpib; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;
(define (println . args) (for-each display args) (newline))
(define gpib:handle '())
(define (gpib:init)
(catch 'misc-error
(lambda ()
(if (not (feature? 'gpib))
(begin
(set! gpib:handle (dynamic-link "libgpib-guile.so"))
(dynamic-call "gpib_init" gpib:handle))))
(lambda args #f)))
(define (gpib:halt)
(if (dynamic-object? gpib:handle)
(begin (dynamic-unlink gpib:handle)
(set! gpib:handle '()))))
(define (gpib:open index pad sad timeout eoi eos)
(ibdev index pad sad timeout eoi eos))
(define (gpib:command fd list)
(let* ((clist '()))
(for-each (lambda (c)
(set! clist (cons (integer->char c) clist)))
list)
(ibcmd fd (list->string (reverse clist)))))
(define (gpib:write fd string)
(ibwrt fd string))
(define (gpib:read fd bytes)
(ibrd fd bytes))
(define (gpib:find name)
(ibfind name))
(define (gpib:remote-enable fd enable)
(ibsre fd enable))
(define (gpib:interface-clear fd)
(ibsic fd))
(define (gpib:device-clear fd)
(ibclr fd))
(define (gpib:reset fd)
(ibonl fd 1))
(define (gpib:close fd)
(ibonl fd 0))
(define (gpib:wait fd status)
(ibwait fd status))
(define (gpib:serial-poll fd)
(ibrsp fd))
(define (gpib:trigger fd)
(ibtrg fd))
(define (gpib:request-service fd service)
(ibrsv fd service))
(define (gpib:error-code)
(iberr))
(define (gpib:counter)
(ibcnt))
(define (gpib:error)
(let* ((error (iberr)))
(cond
((equal? error EDVR) "<OS Error>")
((equal? error ECIC) "<Not CIC>")
((equal? error ENOL) "<No Listener>")
((equal? error EADR) "<Adress Error>")
((equal? error ECIC) "<Invalid Argument>")
((equal? error ESAC) "<No Sys Ctrlr>")
((equal? error EABO) "<Operation Aborted>")
((equal? error ENEB) "<No Gpib Board>")
((equal? error EOIP) "<Async I/O in prg>")
((equal? error ECAP) "<No Capability>")
((equal? error EFSO) "<File sys. error>")
((equal? error EBUS) "<Command error>")
((equal? error ESTB) "<Status byte lost>")
((equal? error ESRQ) "<SRQ stuck on>")
((equal? error ETAB) "<Device Table Overflow>"))))
(export
;; public Gpib procedures
gpib:init
gpib:halt
gpib:open
gpib:command
gpib:write
gpib:read
gpib:find
gpib:remote-enable
gpib:interface-clear
gpib:device-clear
gpib:close
gpib:reset
gpib:wait
gpib:serial-poll
gpib:trigger
gpib:request-service
gpib:error-code
gpib:counter
gpib:error
;; status byte
DCAS DTAS LACS TACS ATN CIC REM LOK CMPL EVENT SPOLL RQS SRQI END TIMO ERR
;; public Gpib commands
GTL SDC PPC GET TCT LLO DCL PPU SPE SPD UNL UNT PPD
;; timeout constants
TNONE T10us T30us T100us T300us T1ms T3ms T10ms T30ms T100ms T300ms T1s
T3s T10s T30s T100s T300s T1000s
;; end-of-string constants
REOS XEOS BIN
)
|
