source: project/release/3/posix-extensions/trunk/4unix.scm @ 13129

Last change on this file since 13129 was 13129, checked in by Kon Lovett, 12 years ago

Added termios constants. Made sep err file.

File size: 39.3 KB
Line 
1;;;; 4unix.scm
2;;;; Kon Lovett, Jan '09
3;;;; Alaric Snell-Pym, Jan '09
4
5;; Issues
6;;
7;; - HP-UX, SunOS & Solaris support is spotty.
8;;
9;; - Assumes whitespace before & after C pre-processor leading '#' is legal.
10;;
11;; - Should have OS specific extension module for stuff like MacOS X 'prio/darwin-thread'.
12;;
13;; - Assumes id_t, pid_t, gid_t, & uid_t representable by FIXNUM!
14;;
15;; - The EINTR condition (system call interrupted) is not handled.
16;;
17;; Should retry operation until success/failure or retry count is exceeded.
18
19(declare
20  (usual-integrations)
21  (inline)
22  (fixnum)
23  (disable-interrupts) ; We have static data structures
24  (no-procedure-checks)
25  (no-bound-checks)
26  (bound-to-procedure
27    ##sys#null-pointer
28    ##sys#null-pointer?
29    ##sys#make-string
30    ##sys#make-c-string
31    ##sys#expand-home-path
32    ##sys#check-exact
33    ##sys#check-number
34    ##sys#check-string
35    ##sys#check-closure
36    ##sys#update-errno
37    ##sys#error
38    ##sys#posix-error
39    ##sys#signal-hook )
40  (export
41    ;
42    posix-errno
43    ;
44    stat/ifmt
45    stat/ififo
46    stat/ifchr
47    stat/ifdir
48    stat/ifblk
49    stat/ifreg
50    stat/iflnk
51    stat/ifsock
52    change-link-mode
53    change-link-owner
54    create-special-file
55    change-file-times
56    ;
57    prio/process
58    prio/process-group
59    prio/user
60    prio/darwin-thread
61    prio/darwin-bg
62    scheduling-priority
63    set-scheduling-priority!
64    ;
65    make-winsize
66    alloc-winsize
67    free-winsize
68    winsize-col
69    winsize-col-set!
70    winsize-row
71    winsize-row-set!
72    winsize-xpixel
73    winsize-xpixel-set!
74    winsize-ypixel
75    winsize-ypixel-set!
76    ;
77                termios/ignbrk
78                termios/brkint
79                termios/ignpar
80                termios/parmrk
81                termios/inpck
82                termios/istrip
83                termios/inlcr
84                termios/igncr
85                termios/icrnl
86                termios/iuclc
87                termios/ixon
88                termios/ixoff
89                termios/ixany
90                termios/iutf8
91                termios/imaxbel
92                termios/opost
93                termios/olcuc
94                termios/onlcr
95                termios/ocrnl
96                termios/onocr
97                termios/onlret
98                termios/ofill
99                termios/nldly
100                termios/nl0
101                termios/nl1
102                termios/nl2
103                termios/nl3
104                termios/tabdly
105                termios/tab0
106                termios/tab1
107                termios/tab2
108                termios/tab3
109                termios/crdly
110                termios/cr0
111                termios/cr1
112                termios/cr2
113                termios/cr3
114                termios/ffdly
115                termios/ff0
116                termios/ff1
117                termios/bsdly
118                termios/bs0
119                termios/bs1
120                termios/vtdly
121                termios/vt0
122                termios/vt1
123                termios/ofdel
124                termios/oxtabs
125                termios/onoeot
126                termios/cbaud
127                termios/cbaudx
128                termios/cibaud
129                termios/loblk
130                termios/csize
131                termios/cs5
132                termios/cs6
133                termios/cs7
134                termios/cs8
135                termios/cstopb
136                termios/cread
137                termios/parenb
138                termios/parodd
139                termios/hupcl
140                termios/clocal
141                termios/cignore
142                termios/mdmbuf
143                termios/crtscts
144                termios/ccts_oflow
145                termios/crts-oflow
146                termios/cdtr-oflow
147                termios/cdsr-oflow
148                termios/ccar-oflow
149                termios/isig
150                termios/isig
151                termios/icanon
152                termios/echoe
153                termios/echok
154                termios/echo
155                termios/echonl
156                termios/iexten
157                termios/tostop
158                termios/noflsh
159                termios/echoctl
160                termios/echoke
161                termios/echoprt
162                termios/pendin
163                termios/flusho
164                termios/altwerase
165                termios/nokerninfo
166                termios/extproc
167                termios/vswitch
168                termios/veof
169                termios/veol
170                termios/verase
171                termios/vkill
172                termios/vintr
173                termios/vquit
174                termios/vsusp
175                termios/vstart
176                termios/vstop
177                termios/vmin
178                termios/vtime
179                termios/veol2
180                termios/vwerase
181                termios/vreprint
182                termios/vdsusp
183                termios/vlnext
184                termios/vdiscard
185                termios/vstatus
186    termios/nccs
187    make-termios
188    alloc-termios
189    free-termios
190    termios-iflag
191    termios-iflag-set!
192    termios-oflag
193    termios-oflag-set!
194    termios-cflag
195    termios-cflag-set!
196    termios-lflag
197    termios-lflag-set!
198    termios-cc
199    termios-cc-set!
200    ;
201                termctl-baud/0
202                termctl-baud/50
203                termctl-baud/75
204                termctl-baud/110
205                termctl-baud/134
206                termctl-baud/150
207                termctl-baud/200
208                termctl-baud/300
209                termctl-baud/600
210                termctl-baud/1200
211                termctl-baud/1800
212                termctl-baud/2400
213                termctl-baud/4800
214                termctl-baud/7200
215                termctl-baud/9600
216                termctl-baud/14400
217                termctl-baud/19200
218                termctl-baud/28800
219                termctl-baud/38400
220                termctl-baud/57600
221                termctl-baud/76800
222                termctl-baud/115200
223                termctl-baud/230400
224                termctl-baud/460800
225    terminal-control-input-speed
226    terminal-control-output-speed
227    set-terminal-control-input-speed!
228    set-terminal-control-output-speed!
229    set-terminal-control-speed!
230    ;
231                termctl-action/now
232                termctl-action/drain
233                termctl-action/flush
234                termctl-action/soft
235    terminal-control-attributes
236    set-terminal-control-attributes!
237    ;
238                termctl-flush/input
239                termctl-flush/output
240                termctl-flush/input-output
241    terminal-control-flush
242    ;
243                termctl-flow/output-off
244                termctl-flow/output-on
245                termctl-flow/input-off
246                termctl-flow/input-on
247    terminal-control-flow
248    ;
249    terminal-control-drain
250    terminal-control-send-break
251    terminal-control-make-raw
252    ;
253    open-pseudo-tty
254    login-tty
255    fork-pseudo-tty
256    ;
257                terminal-device??
258                terminal-device-name
259                current-process-tty-number
260    ;
261    replace-fileno ) )
262
263(require-extension posix)
264(require-extension miscmacros)
265
266
267;;;
268
269;From "posixwin.scm"
270(cond-expand
271  [hygienic-macros
272
273    (define-syntax define-unimplemented
274      (syntax-rules ()
275        [(_ ?name)
276          (define (?name . _)
277            (error '?name
278                                (##core#immutable '"this function is not available on this platform")) ) ] ) )
279
280  ] [else
281
282    (define-macro (define-unimplemented name)
283      `(define (,name . _)
284         (error ',name
285           (##core#immutable '"this function is not available on this platform")) ) )
286
287  ] )
288
289
290;;;
291
292(include "standard-errors")
293
294
295;;; Pointer stuff
296
297#<
298#define C_locative_address( l ) (C_block_item( (l), 0 ))
299
300#define C_locative_cast( t, l ) ((t *)C_locative_address( l ))
301
302#define C_pointer_cast( t, p )  ((t *)C_pointer_address( p ))
303>#
304
305;; From Unit lolevel
306
307(define (##sys#tag-pointer ptr tag)
308  (let ([tp (##sys#make-tagged-pointer tag)])
309        (##core#inline "C_copy_pointer" ptr tp)
310    tp ) )
311
312(define _null (##sys#null-pointer))
313
314
315;;; Errno
316
317#>
318#include <errno.h>
319<#
320
321(define-foreign-variable _errno int "errno")
322
323(define posix-errno _errno)
324
325
326;;; File metadata
327
328#>
329#include <sys/stat.h>
330#include <utime.h>
331
332static struct utimbuf C_utime_buf;
333
334#define C_lchmod( fn, m )                 C_fix( lchmod( C_data_pointer( fn ), C_unfix( m ) ) )
335#define C_lchown( fn, u, g )  C_fix( lchown( C_data_pointer( fn ), C_unfix( u ), C_unfix( g ) ) )
336#define C_mknod( fn, m, d )       C_fix( mknod( C_data_pointer( fn ), C_unfix( m ), C_unfix( d ) ) )
337#define C_utime( fn )                             C_fix( utime( C_data_pointer( fn ), &C_utime_buf ) )
338<#
339
340(define-foreign-type time_t "time_t")
341
342(define-foreign-variable _utime_atime time_t "C_utime_buf.actime")
343(define-foreign-variable _utime_mtime time_t "C_utime_buf.modtime")
344
345(define stat/ifmt (foreign-value "S_IFMT" int))
346(define stat/ififo (foreign-value "S_IFIFO" int))
347(define stat/ifchr (foreign-value "S_IFCHR" int))
348(define stat/ifdir (foreign-value "S_IFDIR" int))
349(define stat/ifblk (foreign-value "S_IFBLK" int))
350(define stat/ifreg (foreign-value "S_IFREG" int))
351(define stat/iflnk (foreign-value "S_IFLNK" int))
352(define stat/ifsock (foreign-value "S_IFSOCK" int))
353
354(define (change-link-mode fname mode)
355  (##sys#check-string fname 'change-link-mode)
356  (##sys#check-exact mode 'change-link-mode)
357  (when (fx= -1 (##core#inline "C_lchmod" (##sys#make-c-string (##sys#expand-home-path fname)) mode))
358    (##sys#posix-error #:file-error 'change-link-mode "cannot change link mode" fname mode) ) )
359
360(define (change-link-owner fname uid gid)
361  (##sys#check-string fname 'change-link-owner)
362  (##sys#check-exact uid 'change-link-owner)
363  (##sys#check-exact gid 'change-link-owner)
364  (when (fx= -1 (##core#inline "C_lchown" (##sys#make-c-string (##sys#expand-home-path fname)) uid gid))
365    (##sys#posix-error #:file-error 'change-link-owner "cannot change link owner" fname uid gid) ) )
366
367(define (create-special-file fname mode devnum)
368  (##sys#check-string fname 'change-link-owner)
369  (##sys#check-exact mode 'change-link-owner)
370  (##sys#check-exact devnum 'change-link-owner)
371  (when (fx= -1 (##core#inline "C_mknod" (##sys#make-c-string (##sys#expand-home-path fname)) mode devnum))
372    (##sys#posix-error #:file-error 'make-special-file "cannot make special file" fname mode devnum) ) )
373
374(define (change-file-times fname atime mtime)
375  (##sys#check-string fname 'change-file-times)
376  (##sys#check-number atime 'change-file-times)
377  (##sys#check-number mtime 'change-file-times)
378  (set! _utime_atime atime)
379  (set! _utime_mtime mtime)
380  (when (fx= -1 (##core#inline "C_utime" (##sys#make-c-string (##sys#expand-home-path fname))))
381     (##sys#posix-error #:file-error 'change-file-times "cannot change file times" fname atime mtime) ) )
382
383
384;;; Process Priority
385
386#>
387#include <sys/time.h> /* for portability */
388#include <sys/resource.h>
389
390#define C_getpriority( wi, wo )     C_fix( getpriority( C_unfix( wi ), (id_t)C_unfix( wo ) ) )
391#define C_setpriority( wi, wo, pr ) C_fix( setpriority( C_unfix( wi ), (id_t)C_unfix( wo ), C_unfix( pr ) ) )
392<#
393
394(define prio/process (foreign-value "PRIO_PROCESS" int))
395(define prio/process-group (foreign-value "PRIO_PGRP" int))
396(define prio/user (foreign-value "PRIO_USER" int))
397(cond-expand
398  [macosx
399    (define prio/darwin-thread (foreign-value "PRIO_DARWIN_THREAD" int))
400    (define prio/darwin-bg (foreign-value "PRIO_DARWIN_BG" int))
401  ] [else
402    (define prio/darwin-thread 0)
403    (define prio/darwin-bg 0)
404  ] )
405
406(define (scheduling-priority which who)
407  (set! _errno 0)
408  (let ([res (##core#inline "C_getpriority" which who)])
409    (if (and (fx< res 0) (not (fx= 0 _errno)))
410      (##sys#posix-error #:process-error 'scheduling-priority "cannot get process priority" which who)
411      res ) ) )
412
413(define (set-scheduling-priority! which who prio)
414  (let ([res (##core#inline "C_setpriority" which who prio)])
415    (when (fx= -1 res 0)
416      (##sys#posix-error #:process-error 'set-scheduling-priority! "cannot set process priority" which who prio) ) ) )
417
418
419;;; Terminal Operations
420
421#>
422#include <termios.h>
423#include <unistd.h>
424<#
425
426;; Winsize
427
428; ws_row                                rows, in characters
429; ws_col                                columns, in characters
430; ws_xpixel                     horizontal size, in pixels
431; ws_ypixel                     vertical size, in pixels
432
433(define-foreign-record (winsize "struct winsize")
434  (rename: (cut string-translate* <> '(("ws_" . ""))))
435  (constructor: alloc-winsize)
436  (destructor: free-winsize)
437  (unsigned-short        ws_row)
438  (unsigned-short        ws_col)
439  (unsigned-short        ws_xpixel)
440  (unsigned-short        ws_ypixel) )
441
442(define (make-winsize #!key (rows 0) (columns 0) (xpixels 0) (ypixels 0))
443  (##sys#check-exact rows 'make-winsize)
444  (##sys#check-exact columns 'make-winsize)
445  (##sys#check-exact xpixels 'make-winsize)
446  (##sys#check-exact ypixels 'make-winsize)
447  (let ([ws (alloc-winsize)])
448    (winsize-row-set! ws rows)
449    (winsize-col-set! ws columns)
450    (winsize-xpixel-set! ws xpixels)
451    (winsize-ypixel-set! ws ypixels)
452    (set-finalizer! ws free-winsize)
453    (##sys#tag-pointer ws 'winsize) ) )
454
455;; Termios
456
457(define-foreign-type tcflag_t "tcflag_t")
458(define-foreign-type cc_t "cc_t")
459(define-foreign-type speed_t "speed_t")
460
461; Input Flags
462
463#>
464#ifndef IUCLC
465#       define IUCLC    0
466#endif
467
468#ifndef IXANY
469#       define IXANY    0
470#endif
471
472#ifndef IUTF8
473#       define IUTF8    0
474#endif
475
476#ifndef IMAXBEL
477#       define IMAXBEL  0
478#endif
479<#
480
481(define termios/ignbrk (foreign-value "IGNBRK" tcflag_t))
482(define termios/brkint (foreign-value "BRKINT" tcflag_t))
483(define termios/ignpar (foreign-value "IGNPAR" tcflag_t))
484(define termios/parmrk (foreign-value "PARMRK" tcflag_t))
485(define termios/inpck (foreign-value "INPCK" tcflag_t))
486(define termios/istrip (foreign-value "ISTRIP" tcflag_t))
487(define termios/inlcr (foreign-value "INLCR" tcflag_t))
488(define termios/igncr (foreign-value "IGNCR" tcflag_t))
489(define termios/icrnl (foreign-value "ICRNL" tcflag_t))
490(define termios/iuclc (foreign-value "IUCLC" tcflag_t))
491(define termios/ixon (foreign-value "IXON" tcflag_t))
492(define termios/ixoff (foreign-value "IXOFF" tcflag_t))
493(define termios/ixany (foreign-value "IXANY" tcflag_t))
494(define termios/iutf8 (foreign-value "IUTF8" tcflag_t))
495(define termios/imaxbel (foreign-value "IMAXBEL" tcflag_t))
496
497; Output Flags
498
499#>
500#ifndef OLCUC
501#       define OLCUC    0
502#endif
503
504#ifndef NLDLY
505#       define NLDLY    0
506#endif
507
508#ifndef NL0
509#       define NL0      0
510#endif
511
512#ifndef NL1
513#       define NL1      0
514#endif
515
516#ifndef NL3
517#       define NL3      0
518#endif
519
520#ifndef TABDLY
521#       define TABDLY   0
522#endif
523
524#ifndef TAB0
525#       define TAB0     0
526#endif
527
528#ifndef TAB1
529#       define TAB1     0
530#endif
531
532#ifndef TAB2
533#       define TAB2     0
534#endif
535
536#ifndef TAB3
537#       define TAB3     0
538#endif
539
540#ifndef CRDLY
541#       define CRDLY    0
542#endif
543
544#ifndef CR0
545#       define CR0      0
546#endif
547
548#ifndef CR1
549#       define CR1      0
550#endif
551
552#ifndef CR2
553#       define CR2      0
554#endif
555
556#ifndef CR3
557#       define CR3      0
558#endif
559
560#ifndef FFDLY
561#       define FFDLY    0
562#endif
563
564#ifndef FF0
565#       define FF0      0
566#endif
567
568#ifndef FF1
569#       define FF1      0
570#endif
571
572#ifndef BSDLY
573#       define BSDLY    0
574#endif
575
576#ifndef BS0
577#       define BS0      0
578#endif
579
580#ifndef BS1
581#       define BS1      0
582#endif
583
584#ifndef VTDLY
585#       define VTDLY    0
586#endif
587
588#ifndef VT0
589#       define VT0      0
590#endif
591
592#ifndef VT1
593#       define VT1      0
594#endif
595
596#ifndef OFDEL
597#       define OFDEL    0
598#endif
599
600#ifndef OXTABS
601#       define OXTABS   0
602#endif
603
604#ifndef ONOEOT
605#       define ONOEOT   0
606#endif
607<#
608
609(define termios/opost (foreign-value "OPOST" tcflag_t))
610(define termios/olcuc (foreign-value "OLCUC" tcflag_t))
611(define termios/onlcr (foreign-value "ONLCR" tcflag_t))
612(define termios/ocrnl (foreign-value "OCRNL" tcflag_t))
613(define termios/onocr (foreign-value "ONOCR" tcflag_t))
614(define termios/onlret (foreign-value "ONLRET" tcflag_t))
615(define termios/ofill (foreign-value "OFILL" tcflag_t))
616(define termios/nldly (foreign-value "NLDLY" tcflag_t))
617  (define termios/nl0 (foreign-value "NL0" tcflag_t))
618  (define termios/nl1 (foreign-value "NL1" tcflag_t))
619  (define termios/nl2 (foreign-value "NL2" tcflag_t))
620  (define termios/nl3 (foreign-value "NL3" tcflag_t))
621(define termios/tabdly (foreign-value "TABDLY" tcflag_t))
622  (define termios/tab0 (foreign-value "TAB0" tcflag_t))
623  (define termios/tab1 (foreign-value "TAB1" tcflag_t))
624  (define termios/tab2 (foreign-value "TAB2" tcflag_t))
625  (define termios/tab3 (foreign-value "TAB3" tcflag_t))
626(define termios/crdly (foreign-value "CRDLY" tcflag_t))
627  (define termios/cr0 (foreign-value "CR0" tcflag_t))
628  (define termios/cr1 (foreign-value "CR1" tcflag_t))
629  (define termios/cr2 (foreign-value "CR2" tcflag_t))
630  (define termios/cr3 (foreign-value "CR3" tcflag_t))
631(define termios/ffdly (foreign-value "FFDLY" tcflag_t))
632  (define termios/ff0 (foreign-value "FF0" tcflag_t))
633  (define termios/ff1 (foreign-value "FF1" tcflag_t))
634(define termios/bsdly (foreign-value "BSDLY" tcflag_t))
635  (define termios/bs0 (foreign-value "BS0" tcflag_t))
636  (define termios/bs1 (foreign-value "BS1" tcflag_t))
637(define termios/vtdly (foreign-value "VTDLY" tcflag_t))
638  (define termios/vt0 (foreign-value "VT0" tcflag_t))
639  (define termios/vt1 (foreign-value "VT1" tcflag_t))
640(define termios/ofdel (foreign-value "OFDEL" tcflag_t))
641(define termios/oxtabs (foreign-value "OXTABS" tcflag_t))
642(define termios/onoeot (foreign-value "ONOEOT" tcflag_t))
643
644; Control Flags
645
646#>
647#ifndef CBAUD
648#       define CBAUD    0
649#endif
650
651#ifndef CBAUDX
652#       define CBAUDX   0
653#endif
654
655#ifndef CIBAUD
656#       define CIBAUD   0
657#endif
658
659#ifndef LOBLK
660#       define LOBLK    0
661#endif
662
663#ifndef CIGNORE
664#       define CIGNORE  0
665#endif
666
667#ifndef MDMBUF
668#       define MDMBUF   0
669#endif
670
671#ifndef CRTSCTS
672#       define CRTSCTS  0
673#endif
674
675#ifndef CCTS_OFLOW
676#       define CCTS_OFLOW       0
677#endif
678
679#ifndef CRTS_OFLOW
680#       define CRTS_OFLOW       0
681#endif
682
683#ifndef CDTR_OFLOW
684#       define CDTR_OFLOW       0
685#endif
686
687#ifndef CDSR_OFLOW
688#       define CDSR_OFLOW       0
689#endif
690
691#ifndef CCAR_OFLOW
692#       define CCAR_OFLOW       0
693#endif
694<#
695
696(define termios/cbaud (foreign-value "CBAUD" tcflag_t))
697(define termios/cbaudx (foreign-value "CBAUDX" tcflag_t))
698(define termios/cibaud (foreign-value "CIBAUD" tcflag_t))
699(define termios/loblk (foreign-value "LOBLK" tcflag_t))
700(define termios/csize (foreign-value "CSIZE" tcflag_t))
701  (define termios/cs5 (foreign-value "CS5" tcflag_t))
702  (define termios/cs6 (foreign-value "CS6" tcflag_t))
703  (define termios/cs7 (foreign-value "CS7" tcflag_t))
704  (define termios/cs8 (foreign-value "CS8" tcflag_t))
705(define termios/cstopb (foreign-value "CSTOPB" tcflag_t))
706(define termios/cread (foreign-value "CREAD" tcflag_t))
707(define termios/parenb (foreign-value "PARENB" tcflag_t))
708(define termios/parodd (foreign-value "PARODD" tcflag_t))
709(define termios/hupcl (foreign-value "HUPCL" tcflag_t))
710(define termios/clocal (foreign-value "CLOCAL" tcflag_t))
711(define termios/cignore (foreign-value "CIGNORE" tcflag_t))
712(define termios/mdmbuf (foreign-value "MDMBUF" tcflag_t))
713(define termios/crtscts (foreign-value "CRTSCTS" tcflag_t))
714(define termios/ccts_oflow (foreign-value "CCTS_OFLOW" tcflag_t))
715(define termios/crts-oflow (foreign-value "CRTS_OFLOW" tcflag_t))
716(define termios/cdtr-oflow (foreign-value "CDTR_OFLOW" tcflag_t))
717(define termios/cdsr-oflow (foreign-value "CDSR_OFLOW" tcflag_t))
718(define termios/ccar-oflow (foreign-value "CCAR_OFLOW" tcflag_t))
719
720; Local Flags
721
722#>
723#ifndef XCASE
724#       define XCASE    0
725#endif
726
727#ifndef ECHOCTL
728#       define ECHOCTL  0
729#endif
730
731#ifndef ECHOKE
732#       define ECHOKE   0
733#endif
734
735#ifndef ECHOPRT
736#       define ECHOPRT  0
737#endif
738
739#ifndef PENDIN
740#       define PENDIN   0
741#endif
742
743#ifndef FLUSHO
744#       define FLUSHO   0
745#endif
746
747#ifndef ALTWERASE
748#       define ALTWERASE        0
749#endif
750
751#ifndef NOKERNINFO
752#       define NOKERNINFO       0
753#endif
754
755#ifndef EXTPROC
756#       define EXTPROC  0
757#endif
758<#
759
760(define termios/xcase (foreign-value "XCASE" tcflag_t))
761(define termios/isig (foreign-value "ISIG" tcflag_t))
762(define termios/icanon (foreign-value "ICANON" tcflag_t))
763(define termios/echoe (foreign-value "ECHOE" tcflag_t))
764(define termios/echok (foreign-value "ECHOK" tcflag_t))
765(define termios/echo (foreign-value "ECHO" tcflag_t))
766(define termios/echonl (foreign-value "ECHONL" tcflag_t))
767(define termios/iexten (foreign-value "IEXTEN" tcflag_t))
768(define termios/tostop (foreign-value "TOSTOP" tcflag_t))
769(define termios/noflsh (foreign-value "NOFLSH" tcflag_t))
770(define termios/echoctl (foreign-value "ECHOCTL" tcflag_t))
771(define termios/echoke (foreign-value "ECHOKE" tcflag_t))
772(define termios/echoprt (foreign-value "ECHOPRT" tcflag_t))
773(define termios/pendin (foreign-value "PENDIN" tcflag_t))
774(define termios/flusho (foreign-value "FLUSHO" tcflag_t))
775(define termios/altwerase (foreign-value "ALTWERASE" tcflag_t))
776(define termios/nokerninfo (foreign-value "NOKERNINFO" tcflag_t))
777(define termios/extproc (foreign-value "EXTPROC" tcflag_t))
778
779; Special Control Character Indicies
780
781#>
782#ifndef VSWTCH
783#       define VSWTCH   NCCS
784#endif
785
786#ifndef VEOL2
787#       define VEOL2    NCCS
788#endif
789
790#ifndef VWERASE
791#       define VWERASE  NCCS
792#endif
793
794#ifndef VREPRINT
795#       define VREPRINT NCCS
796#endif
797
798#ifndef VDSUSP
799#       define VDSUSP   NCCS
800#endif
801
802#ifndef VLNEXT
803#       define VLNEXT   NCCS
804#endif
805
806#ifndef VDISCARD
807#       define VDISCARD NCCS
808#endif
809
810#ifndef VSTATUS
811#       define VSTATUS  NCCS
812#endif
813<#
814
815(define termios/vswitch (foreign-value "VSWTCH" int))
816(define termios/veof (foreign-value "VEOF" int))
817(define termios/veol (foreign-value "VEOL" int))
818(define termios/verase (foreign-value "VERASE" int))
819(define termios/vkill (foreign-value "VKILL" int))
820(define termios/vintr (foreign-value "VINTR" int))
821(define termios/vquit (foreign-value "VQUIT" int))
822(define termios/vsusp (foreign-value "VSUSP" int))
823(define termios/vstart (foreign-value "VSTART" int))
824(define termios/vstop (foreign-value "VSTOP" int))
825(define termios/vmin (foreign-value "VMIN" int))
826(define termios/vtime (foreign-value "VTIME" int))
827(define termios/veol2 (foreign-value "VEOL2" int))
828(define termios/vwerase (foreign-value "VWERASE" int))
829(define termios/vreprint (foreign-value "VREPRINT" int))
830(define termios/vdsusp (foreign-value "VDSUSP" int))
831(define termios/vlnext (foreign-value "VLNEXT" int))
832(define termios/vdiscard (foreign-value "VDISCARD" int))
833(define termios/vstatus (foreign-value "VSTATUS" int))
834
835(define-foreign-variable _nccs cc_t "NCCS")
836(define termios/nccs _nccs)
837
838(define termios/posix-vdisable (foreign-value "_POSIX_VDISABLE" cc_t))
839
840; Special Control Characters
841
842#>
843#define CTRLCHAR( c )   ((c) & 31)
844
845#ifndef CEOF
846# ifdef EOF
847#   define CEOF EOF
848# else
849#   define CEOF CTRLCHAR( 'd' )
850#endif
851
852CERASE  CTRLCHAR( 'd' )
853CINTR CTRLCHAR( 'c' )
854CSTATUS CTRLCHAR( 't' )
855CKILL CTRLCHAR( 'u' )
856
857CMIN CTRLCHAR( 'd' )
858
859CQUIT CTRLCHAR( '\\' )
860CSUSP CTRLCHAR( 'z' )
861
862CTIME CTRLCHAR( '' )
863
864CDSUSP CTRLCHAR( 'y' )
865CSTART CTRLCHAR( 'q' )
866CSTOP CTRLCHAR( 's' )
867CLNEXT CTRLCHAR( 'v' )
868CDISCARD CTRLCHAR( 'o' )
869CWERASE CTRLCHAR( 'w' )
870CREPRINT CTRLCHAR( 'r' )
871
872CEOT CTRLCHAR( 'd' )
873
874<#
875
876(define termios-cc/eof (foreign-value "CEOF" cc_t))
877(define termios-cc/eol (foreign-value "CEOL" cc_t))
878(define termios-cc/erase (foreign-value "CERASE" cc_t))
879(define termios-cc/intr (foreign-value "CINTR" cc_t))
880(define termios-cc/status (foreign-value "CSTATUS" cc_t))
881(define termios-cc/kill (foreign-value "CKILL" cc_t))
882(define termios-cc/min (foreign-value "CMIN" cc_t))
883(define termios-cc/quit (foreign-value "CQUIT" cc_t))
884(define termios-cc/susp (foreign-value "CSUSP" cc_t))
885(define termios-cc/time (foreign-value "CTIME" cc_t))
886(define termios-cc/dsusp (foreign-value "CDSUSP" cc_t))
887(define termios-cc/start (foreign-value "CSTART" cc_t))
888(define termios-cc/stop (foreign-value "CSTOP" cc_t))
889(define termios-cc/lnext (foreign-value "CLNEXT" cc_t))
890(define termios-cc/discard (foreign-value "CDISCARD" cc_t))
891(define termios-cc/werase (foreign-value "CWERASE" cc_t))
892(define termios-cc/reprint (foreign-value "CREPRINT" cc_t))
893(define termios-cc/eot (foreign-value "CEOT" cc_t))
894(define termios-cc/brk (foreign-value "CBRK" cc_t))
895(define termios-cc/crprnt (foreign-value "CRPRINT" cc_t))
896(define termios-cc/flush (foreign-value "CFLUSH" cc_t))
897
898#|
899(define termios-default/iflag (foreign-value "TTYDEF_IFLAG" tcflag_t))
900(define termios-default/oflag (foreign-value "TTYDEF_OFLAG" tcflag_t))
901(define termios-default/lflag (foreign-value "TTYDEF_LFLAG" tcflag_t))
902(define termios-default/cflag (foreign-value "TTYDEF_CFLAG" tcflag_t))
903(define termios-default/speed (foreign-value "TTYDEF_SPEED" tcflag_t))
904|#
905
906; c_iflag                       input flags
907; c_oflag                       output flags
908; c_cflag                       control flags
909; c_lflag                       local flags
910; c_cc                          control chars
911
912(define-foreign-record (termios "struct termios")
913  (rename: (cut string-translate* <> '(("c_" . ""))))
914  (constructor: alloc-termios)
915  (destructor: free-termios)
916  (tcflag_t c_iflag)
917  (tcflag_t c_oflag)
918  (tcflag_t c_cflag)
919  (tcflag_t c_lflag)
920  (cc_t c_cc NCCS) )
921
922(define (make-termios #!key (iflags 0) (oflags 0) (cflags 0) (lflags 0) cc)
923  (let ([tr (alloc-termios)])
924
925    (define (flags obj)
926      (cond
927        [(list? obj)    (apply bitwise-ior obj)]
928        [(fixnum? obj)  obj]
929        [else
930          (##sys#signal-hook #:type-error 'make-termios "bad argument type - not a fixnum" obj) ] ) )
931
932    (define (setcc! len getter)
933      (dotimes (idx (fxmin _nccs len)) (termios-cc-set! tr idx (getter cc idx))) )
934
935    (termios-iflag-set! tr (flags iflags))
936    (termios-oflag-set! tr (flags oflags))
937    (termios-cflag-set! tr (flags cflags))
938    (termios-lflag-set! tr (flags lflags))
939    (set-finalizer! tr free-termios)
940    (cond
941      [(not cc)       (setcc! _nccs (lambda _ 0))]
942      [(list? cc)     (setcc! (length cc) list-ref)]
943      [(vector? cc)   (setcc! (vector-length cc) vector-ref)]
944      [(string? cc)   (setcc! (string-length cc) (lambda (x i) (char->integer (string-ref x i))))]
945      [else
946        (##sys#signal-hook #:type-error 'make-termios "bad argument type - not a sequence" cc) ] )
947    (##sys#tag-pointer tr 'termios) ) )
948
949;; Terminal Speed
950
951#<
952#ifndef B7200
953#       define B7200      B4800
954#endif
955
956#ifndef B14400
957#       define B14400     B9600
958#endif
959
960#ifndef B28800
961#       define B28800     B14400
962#endif
963
964#ifndef B57600
965#       define B57600     B28800
966#endif
967
968#ifndef B76800
969#       define B76800     B57600
970#endif
971
972#ifndef B115200
973#       define B115200  B76800
974#endif
975
976#ifndef B230400
977#       define B230400  B115200
978#endif
979
980#ifndef B460800
981#       define B460800  B230400
982#endif
983>#
984
985(define termctl-baud/0 (foreign-value "B0" speed_t))
986(define termctl-baud/50 (foreign-value "B50" speed_t))
987(define termctl-baud/75 (foreign-value "B75" speed_t))
988(define termctl-baud/110 (foreign-value "B110" speed_t))
989(define termctl-baud/134 (foreign-value "B134" speed_t))
990(define termctl-baud/150 (foreign-value "B150" speed_t))
991(define termctl-baud/200 (foreign-value "B200" speed_t))
992(define termctl-baud/300 (foreign-value "B300" speed_t))
993(define termctl-baud/600 (foreign-value "B600" speed_t))
994(define termctl-baud/1200 (foreign-value "B1200" speed_t))
995(define termctl-baud/1800 (foreign-value "B1800" speed_t))
996(define termctl-baud/2400 (foreign-value "B2400" speed_t))
997(define termctl-baud/4800 (foreign-value "B4800" speed_t))
998(define termctl-baud/7200 (foreign-value "B7200" speed_t))
999(define termctl-baud/9600 (foreign-value "B9600" speed_t))
1000(define termctl-baud/14400 (foreign-value "B14400" speed_t))
1001(define termctl-baud/19200 (foreign-value "B19200" speed_t))
1002(define termctl-baud/28800 (foreign-value "B28800" speed_t))
1003(define termctl-baud/38400 (foreign-value "B38400" speed_t))
1004(define termctl-baud/57600 (foreign-value "B57600" speed_t))
1005(define termctl-baud/76800 (foreign-value "B76800" speed_t))
1006(define termctl-baud/115200 (foreign-value "B115200" speed_t))
1007(define termctl-baud/230400 (foreign-value "B230400" speed_t))
1008(define termctl-baud/460800 (foreign-value "B460800" speed_t))
1009
1010#>
1011#define C_cfgetispeed( pt ) \
1012    C_fix( cfgetispeed( C_pointer_cast( pt, (struct termios) ) ) )
1013#define C_cfgetospeed( pt ) \
1014    C_fix( cfgetospeed( C_pointer_cast( pt, (struct termios) ) ) )
1015
1016#define C_cfsetispeed( pt, sp ) \
1017    C_fix( cfsetispeed( C_pointer_cast( pt, (struct termios) ), C_unfix( sp ) ) )
1018#define C_cfsetospeed( pt, sp ) \
1019    C_fix( cfsetospeed( C_pointer_cast( pt, (struct termios) ), C_unfix( sp ) ) )
1020<#
1021
1022(define (terminal-control-input-speed ptermios)
1023  (##sys#check-non-null-pointer ptermios 'terminal-control-input-speed)
1024
1025(define (terminal-control-output-speed ptermios)
1026  (##sys#check-non-null-pointer ptermios 'terminal-control-output-speed)
1027
1028(define (set-terminal-control-input-speed! ptermios speed)
1029  (##sys#check-non-null-pointer ptermios 'set-terminal-control-output-speed!)
1030  (##sys#check-exact speed 'set-terminal-control-input-speed!)
1031  (when (fx= -1 (##core#inline "C_cfsetispeed" ptermios speed))
1032    (##sys#posix-error #:file-error 'set-terminal-control-input-speed! "cannot change termios input speed" speed) ) )
1033
1034(define (set-terminal-control-output-speed! ptermios speed)
1035  (##sys#check-non-null-pointer ptermios 'set-terminal-control-output-speed!)
1036  (##sys#check-exact speed 'set-terminal-control-output-speed!)
1037  (when (fx= -1 (##core#inline "C_cfsetospeed" ptermios speed))
1038    (##sys#posix-error #:file-error 'set-terminal-control-output-speed! "cannot change termios output speed" speed) ) )
1039
1040(cond-expand
1041  [solaris
1042    #>
1043    static int
1044    cfsetspeed( struct termios * options, speed_t speed )
1045    {
1046        if (0 == cfsetispeed( options, speed ))
1047            return cfsetospeed( options, speed );
1048        else
1049            return -1;
1050    }
1051    <#
1052  ] [else] )
1053
1054#<
1055#define C_cfsetspeed( pt ) \
1056    C_fix( cfsetspeed( C_pointer_cast( pt, (struct termios) ), C_unfix( sp ) ) )
1057>#
1058
1059(define (set-terminal-control-speed! ptermios speed)
1060  (##sys#check-non-null-pointer ptermios 'set-terminal-control-speed!)
1061  (##sys#check-exact speed 'set-terminal-control-speed!)
1062  (when (fx= -1 (##core#inline "C_cfsetspeed" ptermios speed))
1063    (##sys#posix-error #:file-error 'set-terminal-control-speed! "cannot change termios speed" ptermios speed) ) )
1064
1065;; Terminal Attributes Get & Set
1066
1067#>
1068#ifndef TCSASOFT
1069# define TCSASOFT 0
1070#endif
1071<#
1072
1073(define termctl-action/now (foreign-value "TCSANOW" int))
1074(define termctl-action/drain (foreign-value "TCSADRAIN" int))
1075(define termctl-action/flush (foreign-value "TCSAFLUSH" int))
1076(define termctl-action/soft (foreign-value "TCSASOFT" int))
1077
1078#>
1079#define C_tcgetattr( fd, pt ) \
1080    C_fix( tcgetattr( C_unfix( fd ), C_pointer_cast( pt, (struct termios) ) ) )
1081#define C_tcsetattr( fd, act, pt ) \
1082    C_fix( tcsetattr( C_unfix( fd ), C_unfix( act ), C_pointer_cast( pt, (struct termios) ) ) )
1083<#
1084
1085(define (terminal-control-attributes fd #!optional ptermios)
1086  (##sys#check-exact fd 'terminal-control-attributes)
1087  (unless ptermios
1088    (set! ptermios (alloc-termios)) )
1089  (##sys#check-non-null-pointer ptermios 'terminal-control-attributes)
1090  (if (fx= -1 (##core#inline "C_tcgetattr" fd ptermios))
1091    (##sys#posix-error #:file-error 'terminal-control-attributes "cannot aquire terminal attributes" fd)
1092     ptermios ) )
1093
1094(define (set-terminal-control-attributes! fd act ptermios)
1095  (##sys#check-exact fd 'set-terminal-control-attributes!)
1096  (##sys#check-exact act 'set-terminal-control-attributes!)
1097  (##sys#check-non-null-pointer ptermios 'set-terminal-control-attributes!)
1098  (when (fx= -1 (##core#inline "C_tcsetattr" fd act ptermios))
1099    (##sys#posix-error #:file-error 'set-terminal-control-attributes! "cannot change terminal attributes" fd act) ) )
1100
1101;; Terminal Control Drain
1102
1103#>
1104#define C_tcdrain( fd )  C_fix( tcdrain( C_unfix( fd ) ) )
1105<#
1106
1107(define (terminal-control-drain fd)
1108  (##sys#check-exact fd 'terminal-control-drain)
1109  (when (fx= -1 (##core#inline "C_tcdrain" fd))
1110    (##sys#posix-error #:file-error 'terminal-control-drain "cannot drain terminal input" fd) ) )
1111
1112;; Terminal Flow
1113
1114(define termctl-flow/output-off (foreign-value "TCOOFF" int))
1115(define termctl-flow/output-on (foreign-value "TCOON" int))
1116(define termctl-flow/input-off (foreign-value "TCIOFF" int))
1117(define termctl-flow/input-on (foreign-value "TCION" int))
1118
1119#>
1120#define C_tcflow( fd, act )  C_fix( tcflow( C_unfix( fd ), C_unfix( act ) ) )
1121<#
1122
1123(define (terminal-control-flow fd act)
1124  (##sys#check-exact fd 'terminal-control-flow)
1125  (##sys#check-exact act 'terminal-control-flow)
1126  (when (fx= -1 (##core#inline "C_tcflow" fd act))
1127    (##sys#posix-error #:file-error 'terminal-control-flow "cannot control terminal flow" fd act) ) )
1128
1129;; Terminal Flush
1130
1131(define termctl-flush/input (foreign-value "TCIFLUSH" int))
1132(define termctl-flush/output (foreign-value "TCOFLUSH" int))
1133(define termctl-flush/input-output (foreign-value "TCIOFLUSH" int))
1134
1135#>
1136#define C_tcflush( fd, act )  C_fix( tcflush( C_unfix( fd ), C_unfix( act ) ) )
1137<#
1138
1139(define (terminal-control-flush fd act)
1140  (##sys#check-exact fd 'terminal-control-flush)
1141  (##sys#check-exact act 'terminal-control-flush)
1142  (when (fx= -1 (##core#inline "C_tcflush" fd act))
1143    (##sys#posix-error #:file-error 'terminal-control-flush "cannot perform terminal flush" fd act) ) )
1144
1145;; Terminal Send Break
1146
1147#>
1148#define C_tcsendbreak( fd, dur )  C_fix( tcsendbreak( C_unfix( fd ), C_unfix( dur ) ) )
1149<#
1150
1151(define (terminal-control-send-break fd dur)
1152  (##sys#check-exact fd 'terminal-control-send-break)
1153  (##sys#check-exact dur 'terminal-control-send-break)
1154  (when (fx= -1 (##core#inline "C_tcsendbreak" fd dur))
1155    (##sys#posix-error #:file-error 'terminal-control-send-break "cannot transmit terminal break" fd dur) ) )
1156
1157;; Terminal Raw Mode
1158
1159(cond-expand
1160  [solaris
1161    #>
1162    static void
1163    cfmakeraw( struct termios * options )
1164    {
1165        options->c_iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
1166        options->c_oflag &= ~OPOST;
1167        options->c_lflag &= ~(ECHO|ECHONL|ICANON|ISIG|IEXTEN);
1168        options->c_cflag &= ~(CSIZE|PARENB);
1169        options->c_cflag |= CS8;
1170
1171        return 0;
1172    }
1173    <#
1174  ] [else] )
1175
1176#<
1177#define C_cfmakeraw( pt ) C_fix( cfmakeraw( C_pointer_cast( pt, (struct termios) ) ) )
1178>#
1179
1180(define (terminal-control-make-raw ptermios)
1181  (##sys#check-non-null-pointer ptermios 'terminal-control-make-raw)
1182  (when (fx= -1 (##core#inline "C_cfmakeraw" ptermios))
1183    (##sys#posix-error #:file-error 'terminal-control-make-raw "cannot set terminal raw I/O path" ptermios) ) )
1184
1185
1186;;; Pseudo-tty
1187
1188#| Solaris open pty per pts(7D) manpage
1189
1190                int              fdm fds;
1191                char     *slavename;
1192                extern char *ptsname();
1193
1194                fdm = open("/dev/ptmx", O_RDWR);        /* open master */
1195                grantpt(fdm);                                                                                   /* change permission of slave */
1196                unlockpt(fdm);                                                                          /* unlock slave */
1197                slavename = ptsname(fdm);                                       /* get name of slave */
1198                fds = open(slavename, O_RDWR);          /* open slave */
1199                ioctl(fds, I_PUSH, "ptem");                             /* push ptem */
1200                ioctl(fds, I_PUSH, "ldterm");                   /* push ldterm*/
1201|#
1202
1203(cond-expand
1204        [solaris
1205
1206                (define-unimplemented open-pseudo-tty)
1207                (define-unimplemented login-tty)
1208                (define-unimplemented fork-pseudo-tty)
1209
1210        ] [else
1211
1212                #>
1213                #if defined(C_MACOSX) || defined(__NetBSD__) || defined(__OpenBSD__)
1214                # include <util.h>
1215                #elif defined(__FreeBSD__)
1216                # include <libutil.h>
1217                #else
1218                # include <pty.h>
1219                # include <utmp.h>
1220                #endif
1221
1222    #define C_openpty( pm, ps, pn, pt, pw ) \
1223        C_fix( openpty( C_locative_cast( pm, int ), C_locative_cast( ps, int ), \
1224                        C_pointer_cast( pn, char ), \
1225                        C_pointer_cast( pt, (struct termios) ), \
1226                        C_pointer_cast( pw, (struct winsize) ) ) )
1227
1228    #define C_login_tty( fd )   C_fix( login_tty( C_unfix( fd ) ) )
1229
1230    #define C_forkpty( pm, pn, pt, pw ) \
1231        C_fix( forkpty( C_locative_cast( pm, int ), \
1232                        C_pointer_cast( pn, char ), \
1233                        C_pointer_cast( pt, (struct termios) ), \
1234                        C_pointer_cast( pw, (struct winsize) ) ) )
1235                <#
1236
1237                (define (open-pseudo-tty #!optional ptermios pwinsize)
1238      (##sys#check-pointer-argument ptermios 'open-pseudo-tty)
1239      (##sys#check-pointer-argument pwinsize 'open-pseudo-tty)
1240      (let-location ([master int]
1241                     [slave int])
1242                    (if (fx= 0 (##core#inline "C_openpty" #$master #$slave _null (or ptermios _null) (or pwinsize _null)))
1243                      (values master slave)
1244                      (##sys#posix-error #:file-error 'open-pseudo-tty "cannot open pseudo-tty") ) ) )
1245
1246    (define (login-tty fd)
1247      (##sys#check-exact fd 'login-tty)
1248                        (when (fx= -1 (##core#inline "C_login_tty" fd))
1249                          (##sys#posix-error #:file-error 'login-tty "cannot login tty device" fd) ) )
1250
1251    (define (fork-pseudo-tty thunk #!optional ptermios pwinsize)
1252      (##sys#check-closure thunk 'fork-pseudo-tty)
1253      (##sys#check-pointer-argument ptermios 'fork-pseudo-tty)
1254      (##sys#check-pointer-argument pwinsize 'fork-pseudo-tty)
1255      (let-location ([master int])
1256        (let ([pid (##core#inline "C_forkpty" #$master _null (or ptermios _null) (or pwinsize _null))])
1257          (cond
1258            [(fx= -1 pid)
1259              (##sys#posix-error #:file-error 'fork-pseudo-tty "cannot create child process in pseudo-tty") ]
1260            [(fx= 0 pid)
1261              (thunk)
1262              ((foreign-lambda void "_exit" int) 0) ]
1263            [else
1264              (values pid master) ] ) ) ) )
1265
1266        ] )
1267
1268
1269;;; Terminal Information
1270
1271#>
1272#include <unistd.h>
1273#include <stdlib.h> /* for Solaris */
1274
1275#define C_isatty( fd )    (isatty( C_unfix( fd ) )  ? C_SCHEME_TRUE : C_SCHEME_FALSE)
1276
1277#define C_ttyname( fd, b, l ) \
1278  (strncpy( C_c_string( b ), (ttyname( C_unfix( fd ) ) || ""), (l) + 1 )[ (l) ] != '\0' \
1279    ? C_SCHEME_FALSE \
1280    : strlen( C_c_string( b ) ))
1281
1282#define C_ttyslot()   C_fix( ttyslot() )
1283<#
1284
1285(define (terminal-device?? fd)
1286  (##sys#check-exact fd 'terminal-device??)
1287  (##core#inline "C_isatty" fd) )
1288
1289(define-constant _devicename_max int 255) ; probably too generous
1290
1291#;
1292(define terminal-device-name
1293  (let ([string-length string-length]
1294        [defbuf (##sys#make-string (fx+ _devicename_max 1))] )
1295    (lambda (fd #!optional (buf defbuf))
1296      (##sys#check-exact fd 'terminal-device-name)
1297      (let ([buflen (if (eq? buf defbuf) _devicename_max (fx- (string-length buf) 1))])
1298        (let ([len (##core#inline "C_ttyname" fd buf buflen)])
1299          (cond
1300            [(not len)
1301              (##sys#signal-hook #:bounds-error 'terminal-device-name "buffer overflow" fd) ]
1302            [(fx= 0 len)
1303              ; Cannot find device or not a tty.
1304              #f ]
1305            [else
1306              (##sys#substring buf 0 len) ] ) ) ) ) ) )
1307
1308(define terminal-device-name
1309  (let ([defbuf (##sys#make-string (fx+ _devicename_max 1))] )
1310    (lambda (fd)
1311      (##sys#check-exact fd 'terminal-device-name)
1312      (let ([len (##core#inline "C_ttyname" fd defbuf _devicename_max)])
1313        (cond
1314          [(not len)
1315            (##sys#signal-hook #:bounds-error 'terminal-device-name "buffer overflow" fd) ]
1316          [(fx= 0 len)
1317            ; Cannot find device or not a tty.
1318            #f ]
1319          [else
1320            (##sys#substring buf 0 len) ] ) ) ) ) )
1321
1322(define (current-process-tty-number)
1323  (let ([fd (##core#inline "C_ttyslot")])
1324    (if (fx= 0 fd)
1325      (##sys#posix-error #:file-error 'current-process-tty-number "cannot fetch current process control terminal number")
1326      fd ) ) )
1327
1328
1329;;; Fileno
1330
1331(define (replace-fileno fd sfd)
1332        (unless (fx= sfd fd)
1333                (duplicate-fileno fd sfd)
1334                (file-close fd) ) )
1335
1336
1337;;; Spawn Stuff
1338
1339#|
1340;; process-spawn
1341
1342(define spawn/overlay           0)
1343(define spawn/wait                      1)
1344(define spawn/nowait            2)
1345(define spawn/nowaito           3)
1346(define spawn/detach            4)
1347
1348(define (process-spawn mode command #!optional arguments environment exact?)
1349  )
1350
1351|#
1352
1353#|
1354;; POSIX 'posix-spawn'
1355;; Solaris      -
1356;; Linux                -
1357
1358;;
1359
1360posix_spawn_file_actions_init(posix_spawn_file_actions_t *);
1361posix_spawn_file_actions_destroy(posix_spawn_file_actions_t *);
1362posix_spawn_file_actions_addclose(posix_spawn_file_actions_t *, int);
1363posix_spawn_file_actions_adddup2(posix_spawn_file_actions_t *, int, int);
1364posix_spawn_file_actions_addopen(posix_spawn_file_actions_t *restrict, int, const char *restrict, int, mode_t);
1365
1366; FILE-ACTIONS init
1367; FILE-ACTIONS destroy   FILE-ACTIONS
1368; FILE-ACTIONS add                       open FILE-ACTIONS FILENO PATH OPEN-FLAG MODE
1369; FILE-ACTIONS add                       close FILE-ACTIONS FILENO
1370; FILE-ACTIONS add                       dup2 FILE-ACTIONS FILENO1 NEW-FILENO
1371
1372(define (posix-spawn-file-actions operation . rest)
1373        )
1374
1375;;
1376
1377posix_spawnattr_posix_spawnattr_init(posix_spawnattr_t *);
1378posix_spawnattr_posix_spawnattr_destroy(posix_spawnattr_t *);
1379posix_spawnattr_getsigdefault(const posix_spawnattr_t *restrict, sigset_t *restrict);
1380posix_spawnattr_getflags(const posix_spawnattr_t *restrict, short *restrict);
1381posix_spawnattr_getpgroup(const posix_spawnattr_t *restrict, pid_t *restrict);
1382posix_spawnattr_getschedparam(const posix_spawnattr_t *restrict, struct sched_param *restrict);
1383posix_spawnattr_getschedpolicy(const posix_spawnattr_t *restrict, int *restrict);
1384posix_spawnattr_getsigmask(const posix_spawnattr_t *restrict, sigset_t *restrict);
1385posix_spawnattr_setsigdefault(posix_spawnattr_t *restrict, const sigset_t *restrict);
1386posix_spawnattr_setflags(posix_spawnattr_t *, short);
1387posix_spawnattr_setpgroup(posix_spawnattr_t *, pid_t);
1388posix_spawnattr_setschedparam(posix_spawnattr_t *restrict, const struct sched_param *restrict);
1389posix_spawnattr_setschedpolicy(posix_spawnattr_t *, int);
1390posix_spawnattr_setsigmask(posix_spawnattr_t *restrict, const sigset_t *restrict);
1391
1392; ATTRIBUTES            init
1393; ATTRIBUTES            destroy         ATTRIBUTES
1394; SIGNAL-SET            get                             sigmask ATTRIBUTES
1395; ATTRIBUTES            set                             sigmask ATTRIBUTES SIGNAL-SET
1396; SIGNAL-SET            get                             sigdefault ATTRIBUTES
1397; ATTRIBUTES            set                             sigdefault ATTRIBUTES SIGNAL-SET
1398; FLAGS                                 get                             flags ATTRIBUTES
1399; ATTRIBUTES            set                             flags ATTRIBUTES FLAGS
1400; PID                                           get                             pgroup ATTRIBUTES
1401; ATTRIBUTES            set                             pgroup ATTRIBUTES PID
1402; ATTRIBUTES            get                             schedparam ATTRIBUTES
1403; SCHEDPARAM            set                             schedparam ATTRIBUTES SCHEDPARAM
1404; SCHEDPOLICY           get                             schedpolicy ATTRIBUTES
1405; ATTRIBUTES            set                             schedpolicy ATTRIBUTES SCHEDPOLICY
1406
1407(define (posix-spawn-attributes operation . rest)
1408        )
1409
1410;;
1411
1412int
1413posix_spawn(
1414  pid_t *restrict pid,
1415  const char *restrict path,
1416  const posix_spawn_file_actions_t *file_actions,
1417  const posix_spawnattr_t *restrict attrp,
1418  char *const argv[restrict], char *const envp[restrict] );
1419
1420(define (posix-spawn command file-actions attributes arguments environment)
1421        )
1422
1423;;
1424
1425int
1426posix_spawnp(
1427  pid_t *restrict pid,
1428  const char *restrict file,
1429  const posix_spawn_file_actions_t *file_actions,
1430  const posix_spawnattr_t *restrict attrp,
1431  char *const argv[restrict], char * const envp[restrict] );
1432
1433(define (posix-spawnp command file-actions attributes arguments environment)
1434        )
1435|#
1436
1437#|
1438;; BSD 'rfork'
1439;; NetBSD               - not supplied?
1440;; FreeBSD      -
1441;; OpenBSD      -
1442;; MacOS X      - not supplied
1443|#
1444
1445#|
1446;; Linux 'clone'
1447|#
Note: See TracBrowser for help on using the repository browser.