/usr/share/scheme48-1.9/posix/errno.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber, Will Noble
; Error codes
(import-dynamic-externals "=scheme48external/posix")
(define-record-type unnamed-errno :unnamed-errno
(make-unnamed-errno resume-value os-number)
unnamed-errno?
(resume-value unnamed-errno-resume-value)
(os-number unnamed-errno-os-number))
(define-record-discloser :unnamed-errno
(lambda (u-s)
(list 'errno (unnamed-errno-os-number u-s))))
; These are not meaningful after a dump (because the value may not have the
; same meaning on the OS on which we are resumed).
(define-record-resumer :unnamed-errno #f)
(define *unnamed-errnos* #f)
(define-finite-type errno :named-errno ()
named-errno?
named-errnos
named-errno-name
named-errno-index
(os-number named-errno-os-number set-named-errno-os-number!)
( ; POSIX
(toobig) ; [E2BIG] Argument list too long.
(acces) ; Permission denied.
(addrinuse) ; Address in use.
(addrnotavail) ; Address not available.
(afnosupport) ; Address family not supported.
(again) ; Resource unavailable, try again (may be the same value as [EWOULDBLOCK]).
(already) ; Connection already in progress.
(badf) ; Bad file descriptor.
(badmsg) ; Bad message.
(busy) ; Device or resource busy.
(canceled) ; Operation canceled.
(child) ; No child processes.
(connaborted) ; Connection aborted.
(connrefused) ; Connection refused.
(connreset) ; Connection reset.
(deadlk) ; Resource deadlock would occur.
(destaddrreq) ; Destination address required.
(dom) ; Mathematics argument out of domain of function.
(dquot) ; Reserved.
(exist) ; File exists.
(fault) ; Bad address.
(fbig) ; File too large.
(hostunreach) ; Host is unreachable.
(idrm) ; Identifier removed.
(ilseq) ; Illegal byte sequence.
(inprogress) ; Operation in progress.
(intr) ; Interrupted function.
(inval) ; Invalid argument.
(io) ; I/O error.
(isconn) ; Socket is connected.
(isdir) ; Is a directory.
(loop) ; Too many levels of symbolic links.
(mfile) ; Too many open files.
(mlink) ; Too many links.
(msgsize) ; Message too large.
(multihop) ; Reserved.
(nametoolong) ; Filename too long.
(netdown) ; Network is down.
(netreset) ; Connection aborted by network.
(netunreach) ; Network unreachable.
(nfile) ; Too many files open in system.
(nobufs) ; No buffer space available.
(nodata) ; [XSR] No message is available on the STREAM head read queue.
(nodev) ; No such device.
(noent) ; No such file or directory.
(noexec) ; Executable file format error.
(nolck) ; No locks available.
(nolink) ; Reserved.
(nomem) ; Not enough space.
(nomsg) ; No message of the desired type.
(noprotoopt) ; Protocol not available.
(nospc) ; No space left on device.
(nosr) ; [XSR] No STREAM resources.
(nostr) ; [XSR] Not a STREAM.
(nosys) ; Function not supported.
(notconn) ; The socket is not connected.
(notdir) ; Not a directory.
(notempty) ; Directory not empty.
(notsock) ; Not a socket.
(notsup) ; Not supported.
(notty) ; Inappropriate I/O control operation.
(nxio) ; No such device or address.
(opnotsupp) ; Operation not supported on socket.
(overflow) ; Value too large to be stored in data type.
(perm) ; Operation not permitted.
(pipe) ; Broken pipe.
(proto) ; Protocol error.
(protonosupport) ; Protocol not supported.
(prototype) ; Protocol wrong type for socket.
(range) ; Result too large.
(rofs) ; Read-only file system.
(spipe) ; Invalid seek.
(srch) ; No such process.
(stale) ; Reserved.
(time) ; [XSR] Stream ioctl() timeout.
(timedout) ; Connection timed out.
(txtbsy) ; Text file busy.
(wouldblock) ; Operation would block (may be the same value as [EAGAIN]).
(xdev) ; Cross-device link.
))
(define-record-discloser :named-errno
(lambda (n-s)
(list 'errno (named-errno-name n-s))))
; Find the errno called `name'.
(define (name->errno name)
(if (not (symbol? name))
(assertion-violation 'name->errno "argument not a symbol" name)
(let loop ((i 0))
(cond ((= i (vector-length named-errnos))
#f)
((eq? name
(named-errno-name
(vector-ref named-errnos i)))
(vector-ref named-errnos i))
(else
(loop (+ i 1)))))))
(define (get-unnamed-errno num)
(call-with-current-continuation
(lambda (return)
(walk-population
(lambda (e)
(if (= num (unnamed-errno-os-number e)) (return e)))
*unnamed-errnos*)
(let ((e (make-unnamed-errno 'nonportable-signal num)))
(add-to-population! e *unnamed-errnos*)
e))))
(define (integer->errno num)
(let loop ((i 0))
(if (= i (vector-length named-errnos))
(get-unnamed-errno num)
(let ((e (vector-ref named-errnos i)))
(if (= num (named-errno-os-number e))
e
(loop (+ i 1)))))))
; Write the contents of the C array mapping canonical error numbers
; to os error numbers.
(define (write-c-errno-include-file filename)
(call-with-output-file filename
(lambda (out)
(do ((i 0 (+ i 1)))
((= i (vector-length named-errnos)))
(let* ((name (named-errno-name
(vector-ref named-errnos i)))
(posix-name (if (eq? name 'toobig)
"2BIG"
(symbol->string name))))
(display (string-append
"#ifdef E" (string-upcase posix-name) newline-string
" E" (string-upcase posix-name) "," newline-string
"#else" newline-string
" -1," newline-string
"#endif" newline-string)
out))))))
(define newline-string (list->string '(#\newline)))
;----------------
; Dispatching on the two kinds of errnos.
(define (errno? x)
(or (named-errno? x)
(unnamed-errno? x)))
(define (errno-name x)
(cond ((named-errno? x)
(named-errno-name x))
((unnamed-errno? x)
#f)
(else
(assertion-violation 'errno-name "argument not a errno" x))))
(define (errno-os-number x)
(cond ((named-errno? x)
(named-errno-os-number x))
((unnamed-errno? x)
(unnamed-errno-os-number x))
(else
(assertion-violation 'errno-os-number "argument not a errno" x))))
; Two errnos are the same if they are exactly the same or if they are
; both named errnos and have the same (non-#F) os number.
(define (errno=? s1 s2)
(or (eq? s1 s2)
(and (named-errno? s1)
(named-errno? s2)
(named-errno-os-number s1)
(eq? (named-errno-os-number s1)
(named-errno-os-number s2)))))
;----------------
; What we contribute to and receive from the C layer.
(define-exported-binding "posix-errnos-vector" named-errnos)
(import-lambda-definition-2 initialize-named-errnos ()
"posix_initialize_named_errnos")
;----------------
; A vector mapping os-errno numbers to errnos and add to it any errnos
; that have existing errno queues.
(define os-errno-map (make-session-data-slot! #f))
; Initializing the above vector.
(define (initialize-errnos)
(set! *unnamed-errnos* (make-population))
(let ((ints (set-enabled-interrupts! no-interrupts)))
(initialize-named-errnos)
(let* ((named (vector->list named-errnos))
(size (+ 1 (apply max
(map (lambda (errno)
(or (errno-os-number errno)
-1))
named))))
(mapper (make-vector size '())))
(for-each (lambda (errno)
(cond
((errno-os-number errno)
=> (lambda (number)
(let ((old (vector-ref mapper number)))
(vector-set! mapper number (cons errno old)))))))
named)
(session-data-set! os-errno-map mapper)
(set-enabled-interrupts! ints))))
;----------------
; Initialize errnos now ...
(initialize-errnos)
; ... and on later startups.
(define-reinitializer errno-reinitializer initialize-errnos)
|