├── README.md
├── dispatch.lsp
├── editor-commands.lsp
├── file-response.lsp
├── get-from-vax.sh
├── load.lsp
├── parameters.lsp
├── public
├── index.html
├── rasselbock.jpg
└── styles.css
├── rasselbock.lsp
├── response.lsp
├── sys
├── inetdef.lsp
├── rmsdef.lsp
├── rmsusr.lsp
├── stardeffl.lsp
├── stardefqz.lsp
└── starlet.lsp
├── utils.lsp
└── vms.lsp
/README.md:
--------------------------------------------------------------------------------
1 | # rasselbock - A http server written in VAX LISP
2 |
3 | 
4 |
5 | rasselbock is a web server written in VAX LISP. I wrote it for fun,
6 | to learn how to program in VAX LISP and in particular how to interface
7 | with VMS system services and the Record Management Services (RMS).
8 |
9 | # Prerequisites
10 |
11 | * OpenVMS V5.5-2 on VAX
12 | * VAX LISP V3.1
13 | * TCP/IP Services for OpenVMS (UCX) V4.2
14 |
15 | # Features
16 |
17 | * Implements HTTP/1.0 (no persistent connections)
18 | * Request routing based on HTTP method and URI
19 | * Serves binary and text files from the file system
20 |
21 | # Code tour
22 |
23 | ## rasselbock.lsp
24 |
25 | Implements listening to a TCP socket, accepting connections, reading
26 | of request line and headers and writing of response headers.
27 |
28 | ## response.lsp
29 |
30 | Defines the structure of a response as returned from a handler.
31 |
32 | ## file-response.lsp
33 |
34 | Implements reading of files from the VMS file system and writing to
35 | the client socket. As VAX LISP does not provide efficient routines to
36 | access binary files, such files are read using direct calls to the VMS
37 | Record Management System (RMS).
38 |
39 | ## dispatch.lsp
40 |
41 | Routing of http requests to handlers. This is where requests to "/"
42 | are rerouted to the index.html file.
43 |
44 | ## utils.lsp
45 |
46 | Utility functions and macros not specific to Rasselbock.
47 |
48 | ## vms.lsp
49 |
50 | Structures, functions and macros to help interacting with VMS system
51 | services.
52 |
53 | ## parameters.lsp
54 |
55 | Parameters global to Rasselbock (i.e. buffer sizes).
56 |
57 | ## editor-commands.lsp
58 |
59 | Customizations to the VAX LISP editor to add features that I have
60 | missed.
61 |
--------------------------------------------------------------------------------
/dispatch.lsp:
--------------------------------------------------------------------------------
1 | ;; http request routing
2 |
3 | ;; The function DISPATCH-REQUEST receives an incoming http REQUEST structure
4 | ;; as argument and returns a RESPONSE structure, using the method and URI
5 | ;; fields to route the request to the designated handler.
6 |
7 | (in-package :rasselbock)
8 |
9 | (require 'response)
10 | (require 'file-response)
11 |
12 | (provide 'dispatch)
13 |
14 | ;; Handling functions for fixed functionalities
15 |
16 | (defun redirect-to-index (request)
17 | "Return redirect response to the top-level HTML file, called index.html"
18 | (make-response :status 301
19 | :status-string "Moved"
20 | :header `(:location "/index.html")))
21 |
22 | (defun not-found (request)
23 | "Return \"Resource not found\" response"
24 | (make-response :status 404
25 | :status-string "Not found"
26 | :body "The requested resource was not found"))
27 |
28 | ;; Define the default routing table. Routes are searched from the front to
29 | ;; the back of the route list until a matching route is found (i.e. the
30 | ;; method and URI matches and the handling function returned a response).
31 |
32 | (defparameter *default-routes*
33 | `((GET "/" redirect-to-index)
34 | (GET "/*" route-as-file)
35 | (* "/*" not-found)))
36 |
37 | (defparameter *routes* *default-routes*)
38 |
39 | (defun validate-uri-pattern (pattern)
40 | "Ensure that the PATTERN argument is a valid URI pattern string, starting
41 | with a slash and having at most one * wildcard at the end."
42 | (unless (plusp (length pattern))
43 | (error "Invalid URI pattern ~S: Must not be empty"
44 | pattern))
45 | (unless (eql (aref pattern 0) #\/)
46 | (error "Invalid URI pattern ~S: Must begin with a slash"
47 | pattern))
48 | (let ((star-position (position #\* pattern)))
49 | (unless (or (null star-position)
50 | (= star-position (1- (length pattern))))
51 | (error "Invalid URI pattern ~S: Wildcard is allowed only at the end"
52 | pattern))))
53 |
54 | (defun uri-match (uri pattern)
55 | "Return a true value if the URI argument matches the PATTERN. PATTERN is
56 | validated using VALIDATE-URI-PATTERN before matching."
57 | (validate-uri-pattern pattern)
58 | (let ((star-position (1- (length pattern))))
59 | (if (eql (aref pattern star-position) #\*)
60 | (and (>= (length uri) star-position)
61 | (string= uri pattern
62 | :end1 star-position
63 | :end2 star-position))
64 | (string= uri pattern))))
65 |
66 | (defun dispatch-request (request)
67 | "Route the REQUEST argument a handler based on the routes defined in
68 | the *ROUTES* special variable. Returns a RESPONSE structure which
69 | contains the header and possible information about the body."
70 | (or (dolist (route *routes*)
71 | (when (and (or (string= (request-method request) (first route))
72 | (string= (first route) "*"))
73 | (uri-match (request-uri request) (second route)))
74 | (let ((response (funcall (third route) request)))
75 | (when response
76 | (assert (typep response 'response))
77 | (return response)))))
78 | (error "No route matched incoming request ~A" request)))
79 |
--------------------------------------------------------------------------------
/editor-commands.lsp:
--------------------------------------------------------------------------------
1 | ;; Editor extensions unrelated to the HTTP server itself
2 |
3 | ;; In this file, you'll find some editor commands that I have implemented
4 | ;; while writing the http server, to add some features that I am used to
5 | ;; having from GNU Emacs.
6 |
7 | (in-package :editor)
8 |
9 | (define-command (delete-matching-lines-command
10 | :display-name "Delete Matching Lines")
11 | (prefix)
12 | (declare (ignore prefix))
13 | (let* ((match-string (simple-prompt-for-input "Delete lines containing:"))
14 | (search-pattern (make-search-pattern :case-insensitive
15 | :forward
16 | match-string)))
17 | (do* ((match (locate-pattern (current-buffer-point) search-pattern)
18 | (locate-pattern (current-buffer-point) search-pattern)))
19 | ((null match))
20 | (setf (line-string (mark-line (current-buffer-point))) ""))))
21 |
22 | (define-command (toggle-read-only-command
23 | :display-name "Toggle Read Only")
24 | (prefix)
25 | (declare (ignore prefix))
26 | (setf (buffer-read-only (current-buffer))
27 | (not (buffer-read-only (current-buffer)))))
28 |
29 | (bind-command "Toggle Read Only" '#(#\escape #\r) '(:style emacs))
30 |
31 | (defmacro save-excursion (&body body)
32 | (let ((saved-position (gensym)))
33 | `(with-mark ((,saved-position (current-buffer-point)))
34 | (prog1
35 | (progn ,@body)
36 | (move-mark (current-buffer-point) ,saved-position)))))
37 |
38 | (define-command (evaluate-top-level-form-command
39 | :display-name "Evaluate Top Level Form")
40 | (prefix)
41 | (declare (ignore prefix))
42 | (save-excursion
43 | (select-outermost-form-command nil)
44 | (evaluate-lisp-region-command nil)))
45 |
46 | (bind-command "Evaluate Top Level Form" '#(#\escape #\^X) '(:style emacs))
47 |
48 | (define-command (evaluate-buffer-command
49 | :display-name "Evaluate Buffer")
50 | (prefix)
51 | (declare (ignore prefix))
52 | (let ((current-package-name (package-name *package*)))
53 | (save-excursion
54 | (with-mark ((start (current-buffer-point))
55 | (end (current-buffer-point)))
56 | (buffer-start start)
57 | (buffer-end end)
58 | (evaluate-lisp-region-command nil (make-region start end))))
59 | (in-package current-package-name)))
60 |
61 | (bind-command "Evaluate Buffer" '#(#\^X #\^L) '(:style emacs))
62 |
63 | (define-command (only-one-space-command
64 | :display-name "Only One Space")
65 | (prefix)
66 | (declare (ignore prefix))
67 | (if (or (eq (next-character (current-buffer-point)) #\space)
68 | (eq (previous-character (current-buffer-point)) #\space))
69 | (with-mark ((point (current-buffer-point))
70 | (start (current-buffer-point)))
71 | ;; goto beginning of spaces
72 | (loop
73 | (if (eq (previous-character point) #\space)
74 | (character-offset point -1)
75 | (return)))
76 | (move-mark start point)
77 | ;; look for end of spaces
78 | (loop
79 | (if (eq (next-character point) #\space)
80 | (character-offset point 1)
81 | (return)))
82 | ;; remove spaces
83 | (character-offset point -1)
84 | (delete-region (make-region start point)))
85 | (editor-error "Not looking at space")))
86 |
87 | (bind-command "Only One Space" '#(#\escape #\space))
88 |
89 | (unbind-command #\^g '(:style emacs))
90 | (bind-command "Pause Editor" '#(#\^X #\^Z) '(:style emacs))
91 | (bind-command "Pause Editor" #\^Z '(:style emacs))
92 | (bind-command "Prompt Show Alternatives" '#(#\escape #\^I) :global)
93 |
94 | (bind-keyboard-function #\^E 'ed)
95 |
--------------------------------------------------------------------------------
/file-response.lsp:
--------------------------------------------------------------------------------
1 | ;; File responses
2 |
3 | ;; Serving VMS files as http responses is not quite as straightforward as
4 | ;; one would be used from Unix as one has to deal with the various file
5 | ;; structures that the VMS file system provides. We have to distinguish
6 | ;; between binary and text files and treat them separately. Binary files
7 | ;; are sent to the client as-is, i.e. the data is read block-wise from
8 | ;; the file and sent to the client unmodified. As VAX LISP provides no
9 | ;; facilities for efficient block-wise binary I/O, we're using the VMS
10 | ;; Record Management System (RMS) directly. For text files, we use the
11 | ;; VAX LISP file I/O system and read files line-by-line and send them
12 | ;; to the client with some intermediate buffering.
13 |
14 | (in-package :rasselbock)
15 |
16 | (provide 'file-response)
17 |
18 | (eval-when (compile load eval)
19 | (require 'rmsdef)
20 | (require 'rmsusr)
21 | (require 'utils)
22 | (require 'vms)
23 | (require 'response))
24 |
25 | (defun make-subdirectory (pathname subdirectory)
26 | (apply #'concatenate 'string
27 | (directory-namestring pathname)
28 | (when subdirectory
29 | (list "." subdirectory))))
30 |
31 | ;; Document root directory - This is set at run time from either the logical
32 | ;; name RASSELBOCK$DOCUMENT_ROOT or, if that is not defined, to the [.PUBLIC]
33 | ;; subdirectory of the process' default directory.
34 | (defparameter *document-root* nil)
35 |
36 | (defun get-document-root ()
37 | (let ((translations (translate-logical-name "RASSELBOCK$DOCUMENT_ROOT"))
38 | (default-document-root (make-pathname
39 | :directory (make-subdirectory
40 | (default-directory) "PUBLIC"))))
41 | (cond
42 | ((> (length translations) 1)
43 | (error "RASSELBOCK$DOCUMENT_ROOT translates to multiple directories, ~
44 | which is not supported."))
45 | ((= (length translations) 1)
46 | (pathname (first translations)))
47 | (t
48 | (warn "RASSELBOCK$DOCUMENT_ROOT not defined, serving files from ~A"
49 | (namestring default-document-root))
50 | default-document-root))))
51 |
52 | (defun ensure-document-root ()
53 | (unless *document-root*
54 | (setf *document-root* (get-document-root))))
55 |
56 | (defun document-root ()
57 | (c sys$dclast
58 | common-ast-address
59 | (instate-interrupt-function #'ensure-document-root :once-only-p t)
60 | 0)
61 | *document-root*)
62 |
63 | ;; Provide some syntactic sugar to make using the GET-FILE-INFORMATION
64 | ;; function more pleasant.
65 |
66 | (defmacro with-file-information ((file &rest fields) &body body)
67 | "Call GET-FILE-INFORMATION with FILE and FIELDS as arguments. FIELDS
68 | must be one or more symbols that will be bound during the evaluation of
69 | BODY. They specify what fields of file information should be retrieved
70 | and are converted to keywords when GET-FILE-INFORMATION is invoked."
71 | (let ((keywords (mapcar #'make-keyword fields))
72 | (result (gensym)))
73 | `(let* ((,result (get-file-information ,file ,@keywords))
74 | ,@(mapcar #'(lambda (variable keyword)
75 | (list variable `(getf ,result ,keyword)))
76 | fields (mapcar #'make-keyword fields)))
77 | ,@body)))
78 |
79 | ;; Map from file type (extension) to content type
80 | (defparameter *content-types* (list :jpg "image/jpeg"
81 | :jpeg "image/jpeg"
82 | :html "text/html"
83 | :xml "text/xml"
84 | :js "text/javascript"))
85 |
86 | (defun make-content-type-map ()
87 | (let ((map (make-hash-table)))
88 | (doplist (type content-type *content-types*)
89 | (setf (gethash type map) content-type))
90 | map))
91 |
92 | (defparameter *content-type-map* (make-content-type-map))
93 |
94 | ;; The FILE structure contains information about the file being served. When
95 | ;; a request is found to refer to a file, the body field of the response
96 | ;; returned by the file handler will contain a FILE structure that is then
97 | ;; used when writing the body to the client.
98 |
99 | (defstruct file pathname size textp content-type)
100 |
101 | (defun file-information (pathname)
102 | "Return information about the given file in a file structure. FILE-SIZE
103 | is the size of the file in bytes. PATHNAME is the pathname argument passed
104 | to this function. FILE-TEXTP has a true value if the file is a
105 | text file, based on RMS attribute heuristics. FILE-CONTENT-TYPE is the content
106 | type to report to the client."
107 | ;; FIXME: file-size only works for fixed-block-size, non-indexed files
108 | (with-file-information (pathname organization record-format record-attributes
109 | block-size end-of-file-block first-free-byte)
110 | (when organization
111 | (let ((textp (and (= organization FAB$C_SEQ)
112 | (or (= record-format FAB$C_VAR)
113 | (= record-format FAB$C_VFC))
114 | (not (zerop (logand record-attributes
115 | (logior FAB$M_CR FAB$M_PRN)))))))
116 | (make-file :pathname pathname
117 | :size (+ (* block-size (1- end-of-file-block)) first-free-byte)
118 | :textp textp
119 | :content-type (or (gethash (make-keyword (pathname-type pathname))
120 | *content-type-map*)
121 | (if textp
122 | "text/plain"
123 | "application/binary")))))))
124 |
125 | (defun write-binary-file-to-socket (channel filename)
126 | "Serve a binary file to the client, using RMS to read blocks of file data
127 | directly into the buffer sent to the client using $QIOW."
128 | (let* ((namestring (namestring filename))
129 | (filename-buffer (make-filename-buffer :allocation :static
130 | :filename namestring))
131 | (fab (make-fab :allocation :static
132 | :FAB$V_GET 1
133 | :FAB$V_BIO 1
134 | :FAB$V_SHRGET 1
135 | :FAB$L_FNA filename-buffer
136 | :FAB$B_FNS (length namestring)))
137 | (buffer (make-string-buffer :allocation :static))
138 | (rab (make-rab :allocation :static
139 | :RAB$L_FAB fab
140 | :RAB$L_UBF buffer
141 | :RAB$W_USZ +buffer-size+)))
142 | (c SYS$OPEN fab 0 0)
143 | (c SYS$CONNECT rab 0 0)
144 | (loop
145 | (let ((status (call-out SYS$READ rab 0 0)))
146 | (when (= status RMS$_EOF)
147 | (return))
148 | (check-status status 'SYS$READ)
149 | ($QIOW/check-iosb channel IO$_WRITEVBLK
150 | :p1 buffer
151 | :p2 (RAB$W_RSZ rab))))
152 | (c SYS$CLOSE fab 0 0)))
153 |
154 | (defun write-text-file-to-socket (channel filename)
155 | "Serve a text file to the client. The file is read line-wise into a
156 | statically allocated string buffer. Whenever the buffer would be overflown
157 | by the next line read from the file, it is flushed to the client. This
158 | is supposed to reduce the number of packets sent to the client under the
159 | assumption that user-level buffering is cheaper than leaving this up to
160 | the TCP stack."
161 | (let* ((buffer (make-array +buffer-size+
162 | :allocation :static
163 | :fill-pointer 0
164 | :adjustable t
165 | :element-type 'character)))
166 | (with-open-file (in filename)
167 | (with-output-to-string (*standard-output* buffer)
168 | (loop
169 | (let ((line (read-line in nil)))
170 | (when (null line)
171 | (return))
172 | (when (> (length line) (- +buffer-size+ 2))
173 | (error "line in file ~A too long, cannot serve as text file" filename))
174 | (when (> (+ (length buffer) (length line) 2) +buffer-size+)
175 | ($QIOW/check-iosb channel IO$_WRITEVBLK
176 | :p1 buffer
177 | :p2 (length buffer))
178 | (setf (fill-pointer buffer) 0)
179 | (get-output-stream-string *standard-output*))
180 | (format t "~A~C~C" line #\return #\linefeed)))))
181 | (when (plusp (length buffer))
182 | ($QIOW/check-iosb channel IO$_WRITEVBLK
183 | :p1 buffer
184 | :p2 (length buffer)))))
185 |
186 | (defun write-file-response (channel file)
187 | "Write a file response body, dispatching to binary and text file writing
188 | as appropriate."
189 | (funcall (if (file-textp file)
190 | #'write-text-file-to-socket
191 | #'write-binary-file-to-socket)
192 | channel (file-pathname file)))
193 |
194 | (defun uri-to-pathname (uri)
195 | "Return pathname represented by URI"
196 | (let ((dot-position (position #\. uri :from-end t))
197 | (slash-position (position #\/ uri :from-end t)))
198 | (when (and dot-position
199 | (> dot-position slash-position))
200 | (make-pathname
201 | :name (subseq uri (1+ slash-position) dot-position)
202 | :type (subseq uri (1+ dot-position))
203 | :directory (make-subdirectory (document-root)
204 | (when (plusp slash-position)
205 | (substitute #\. #\/
206 | (subseq uri 1 slash-position))))
207 | :defaults (document-root)))))
208 |
209 | (defstruct (file-response (:include response
210 | (write-body #'write-file-response))))
211 |
212 | (defun route-as-file (request)
213 | "If URI in the given REQUEST structure refers to a file in the file system,
214 | return a FILE-RESPONSE structure."
215 | (let* ((pathname (probe-file (uri-to-pathname (request-uri request))))
216 | (file (file-information pathname)))
217 | (when pathname
218 | (make-file-response :status 200
219 | :status-string "OK"
220 | :header (list :content-type (file-content-type file))
221 | :body file))))
222 |
223 |
--------------------------------------------------------------------------------
/get-from-vax.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | set -e
4 |
5 | vax_path=/mnt/hans/rasselbock
6 | repo_path=$(pwd)
7 |
8 | if ! [ -z "$(git status -s)" ]
9 | then
10 | echo repository not clean, please commit first
11 | exit 1
12 | fi
13 |
14 |
15 | df > /dev/null
16 |
17 | cd $vax_path
18 |
19 | if ! [ -z "$(find . -name '*.lsp.*')" ]
20 | then
21 | echo multiple .lsp file versions found, please purge first
22 | exit 1
23 | fi
24 |
25 | find . -name '*.lsp' | while read file
26 | do
27 | perl -pe 's/\0//g' < $file > $repo_path/$file
28 | done
29 |
30 | cd $repo_path
31 | git status
32 |
--------------------------------------------------------------------------------
/load.lsp:
--------------------------------------------------------------------------------
1 | ;; load the rasselbock system
2 |
3 | (in-package :rasselbock :use '(:sys :lisp))
4 |
5 | (defun fas-file (lisp-file)
6 | (make-pathname :type "FAS" :version nil :defaults lisp-file))
7 |
8 | (defun needs-recompile-p (lisp-file)
9 | (let* ((lisp-file (pathname lisp-file))
10 | (fas-file (fas-file lisp-file)))
11 | (or (not (probe-file fas-file))
12 | (> (file-write-date lisp-file) (file-write-date fas-file)))))
13 |
14 | (defun ensure-sys-modules ()
15 | (dolist (lisp-file (directory "[.sys]*.lsp;"))
16 | (let ((needs-recompile-p (needs-recompile-p lisp-file))
17 | (fas-file (fas-file lisp-file)))
18 | (when needs-recompile-p
19 | (format t "~&;; Compiling ~A~%" (namestring lisp-file))
20 | (compile-file lisp-file))
21 | (when (or needs-recompile-p
22 | (not (find (pathname-name lisp-file) *modules* :test #'string-equal)))
23 | (format t "~&;; Loading ~A~%" (namestring fas-file))
24 | (load fas-file :verbose nil)))))
25 |
26 | (ensure-sys-modules)
27 |
28 | (dolist (file '(utils vms response file-response rasselbock))
29 | (load (compile-file file)))
30 |
31 |
--------------------------------------------------------------------------------
/parameters.lsp:
--------------------------------------------------------------------------------
1 | (in-package :rasselbock)
2 |
3 | (provide 'parameters)
4 |
5 | (eval-when (compile load eval)
6 |
7 | ;; String to report in Server: response header
8 | (defparameter *server-string* "VAX LISP HTTP Server 0.0")
9 |
10 | ;; Size of I/O buffers to read and write TCP data
11 | (defconstant +buffer-size+ 4096)
12 | ;; Size of a file name
13 | (defconstant +filename-size+ 255)
14 |
15 | ;; Maximum size of one HTTP header
16 | (defconstant +header-buffer-size+ 16384)
17 |
18 | ;; Maximum number of HTTP headers
19 | (defconstant +header-count+ 32)
20 |
21 | ;; Maximum number of pending incoming connections
22 | (defconstant +server-backlog+ 5)
23 |
24 | ;; HTTP version to report in responses
25 | (defparameter *response-http-version* "HTTP/1.0"))
26 |
27 |
--------------------------------------------------------------------------------
/public/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | rasselbock - A http server written in VAX LISP
4 |
5 |
6 |
7 | rasselbock
8 | 
9 |
10 | Welcome to rasselbock - a http server written in VAX LISP, running
11 | on VAX/VMS V5.5-2.
12 |
13 | Links
14 |
51 |
52 |
53 |
--------------------------------------------------------------------------------
/public/rasselbock.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/hanshuebner/rasselbock/ce01ce441efb134531ae5e8edaf6d84422df8ee1/public/rasselbock.jpg
--------------------------------------------------------------------------------
/public/styles.css:
--------------------------------------------------------------------------------
1 | * {
2 | font-family: Verdana;
3 | font-size: 16pt;
4 | }
5 | body {
6 | margin: 2em;
7 | }
8 | H1 {
9 | font-family: Georgia, serif;
10 | font-size: 180%;
11 | font-weight: bold;
12 | }
13 | H2 {
14 | font-family: Georgia, serif;
15 | font-size: 130%;
16 | font-weight: bold;
17 | }
18 | .bunny {
19 | float: right;
20 | margin-left: 1em;
21 | }
22 |
--------------------------------------------------------------------------------
/rasselbock.lsp:
--------------------------------------------------------------------------------
1 | ;; top-level http server functionality
2 |
3 | ;; This file implements the top-level server functionality of the
4 | ;; rasselbock http server. Set up of the TCP listening socket, acceptance
5 | ;; of incoming connections and reading of the client requests is implemented
6 | ;; here.
7 |
8 | (in-package :rasselbock :use '(:lisp :sys))
9 |
10 | (eval-when (compile load eval)
11 | (require 'parameters)
12 | (require 'inetdef)
13 | (require 'starlet)
14 | (require 'stardeffl)
15 | (require 'vms)
16 | (require 'dispatch))
17 |
18 | (define-alien-structure sockchar
19 | (prot :unsigned-integer 0 2)
20 | (type :unsigned-integer 2 3)
21 | (af :unsigned-integer 3 4))
22 |
23 | (define-alien-structure sockaddr-in
24 | (SIN$W_FAMILY :unsigned-integer 0 2 :default 0)
25 | (SIN$W_PORT :unsigned-integer 2 4 :default 0)
26 | (SIN$L_ADDR :unsigned-integer 4 8 :default 0)
27 | (SIN$T_ZERO :unsigned-integer 8 16 :default 0))
28 |
29 | (define-external-routine (UCX$INET_ADDR
30 | :file "UCX$IPC_SHR"
31 | :result (:lisp-type integer
32 | :vax-type :unsigned-longword))
33 | (address-string :lisp-type string
34 | :vax-type :asciz
35 | :access :in))
36 |
37 | (defstruct raw-request
38 | (lines (make-array +header-count+ :fill-pointer 0))
39 | (buffer "")
40 | completep)
41 |
42 | (defun read-line* (stream)
43 | (let ((*standard-output* (make-string-output-stream))
44 | (chars-read 0))
45 | (loop
46 | (let ((char (read-char stream nil)))
47 | (if char
48 | (progn
49 | (incf chars-read)
50 | (case char
51 | (#\return)
52 | ((#\linefeed #\newline)
53 | (return (values (get-output-stream-string *standard-output*)
54 | nil
55 | chars-read)))
56 | (otherwise (write-char char))))
57 | (return (values (unless (zerop chars-read)
58 | (get-output-stream-string *standard-output*))
59 | t
60 | chars-read)))))))
61 |
62 | (defun raw-request-add-buffer (raw-request new-buffer)
63 | (assert (not (raw-request-completep raw-request)))
64 | (let ((input-buffer (concatenate 'string
65 | (raw-request-buffer raw-request)
66 | new-buffer))
67 | (characters-consumed 0))
68 | (with-input-from-string (input input-buffer)
69 | (loop
70 | (multiple-value-bind (line missing-newline-p chars-read) (read-line* input)
71 | (incf characters-consumed chars-read)
72 | (when (equal line "")
73 | (setf (raw-request-completep raw-request) t
74 | (raw-request-buffer raw-request) (subseq input-buffer characters-consumed))
75 | (return))
76 | (when (or (null line)
77 | missing-newline-p)
78 | (unless (< (length line) +header-buffer-size+)
79 | (error "Maximum header length ~A exceeded by input"
80 | +header-buffer-size+))
81 | (setf (raw-request-buffer raw-request) (or line ""))
82 | (return))
83 | ;; Support header continuations (now obsolete, but wth)
84 | (if (whitespacep (aref line 0))
85 | (if (zerop (length (raw-request-lines raw-request)))
86 | (error "unsyntactic header (first lines starts with whitespace)")
87 | ;; This is a continued header
88 | (let ((last-index (1- (length (raw-request-lines raw-request)))))
89 | (setf (aref (raw-request-lines raw-request) last-index)
90 | (concatenate 'string
91 | (aref (raw-request-lines raw-request) last-index)
92 | " "
93 | (subseq line (position-if-not #'whitespacep line))))))
94 | ;; This is a new header
95 | (unless (vector-push line
96 | (raw-request-lines raw-request))
97 | (error "Too many header lines (max ~A)"
98 | +header-count+))))))))
99 |
100 | (defun parse-request-line (line)
101 | (let* ((uri-position (position #\space line))
102 | (http-version-position (and uri-position
103 | (position #\space line
104 | :start (1+ uri-position)))))
105 | (unless (and uri-position http-version-position)
106 | (error "unsyntactic request line ~S" line))
107 | (list :method (make-keyword (subseq line 0 uri-position))
108 | :uri (subseq line (1+ uri-position) http-version-position)
109 | :http-version (make-keyword (subseq line (1+ http-version-position))))))
110 |
111 | (defun parse-header-line (line)
112 | (let* ((colon-position (position #\: line))
113 | (content-position (when colon-position
114 | (position-if-not #'whitespacep line
115 | :start (1+ colon-position)))))
116 | (unless (and colon-position content-position)
117 | (error "unsyntactic header line ~S" line))
118 | (values (make-keyword (subseq line 0 colon-position))
119 | (subseq line content-position))))
120 |
121 | (defstruct request method uri http-version header raw-request)
122 |
123 | (defun parse-request-and-header (lines)
124 | (let ((i 1)
125 | header)
126 | (loop
127 | (when (= i (length lines))
128 | (return))
129 | (multiple-value-bind (key value)
130 | (parse-header-line (aref lines i))
131 | (push value header)
132 | (push key header))
133 | (incf i))
134 | (apply #'make-request
135 | :header (nreverse header)
136 | (parse-request-line (aref lines 0)))))
137 |
138 | (defmacro with-ucx-channel ((channel) &body body)
139 | `(let ((,channel 0))
140 | (unwind-protect
141 | (progn
142 | (c SYS$ASSIGN "UCX$DEVICE" ,channel nil nil)
143 | ,@body)
144 | (unless (zerop ,channel)
145 | (c SYS$DASSGN ,channel)))))
146 |
147 | (defun setup-listen-socket (channel port)
148 | ;; Open TCP socket
149 | ($QIOW/check-iosb channel IO$_SETMODE
150 | :p1 (make-sockchar :allocation :static
151 | :prot TCPIP$C_TCP
152 | :type TCPIP$C_STREAM
153 | :af TCPIP$C_AF_INET))
154 |
155 | ;; Enable reuseaddr option
156 | (let* ((optval (make-long :allocation :static
157 | :value 1))
158 | (reuseaddr (make-itemlst-2 :allocation :static
159 | :type TCPIP$C_REUSEADDR
160 | :length (alien-structure-length optval)
161 | :address optval)))
162 | ($QIOW/check-iosb channel IO$_SETMODE
163 | :p5 (make-itemlst-2 :allocation :static
164 | :type TCPIP$C_SOCKOPT
165 | :length (alien-structure-length reuseaddr)
166 | :address reuseaddr)))
167 |
168 | ;; Set local address
169 | (let ((sockaddr-in (make-sockaddr-in :allocation :static
170 | :SIN$W_FAMILY INET$C_AF_INET
171 | :SIN$W_PORT (swab port)
172 | :SIN$L_ADDR 0)))
173 | ($QIOW/check-iosb channel IO$_SETMODE
174 | :p3 (make-itemlst-2 :allocation :static
175 | :length (alien-structure-length sockaddr-in)
176 | :address sockaddr-in)))
177 |
178 | ;; Listen for incoming connections
179 | ($QIOW/check-iosb channel IO$_SETMODE
180 | :p4 +server-backlog+))
181 |
182 | (defvar *last-raw-request* nil)
183 |
184 | (defun read-request (channel)
185 | (let ((raw-request (make-raw-request))
186 | (buffer (make-string-buffer :allocation :static)))
187 | (loop
188 | ($QIOW/check-iosb channel IO$_READVBLK
189 | :p1 buffer
190 | :p2 +buffer-size+)
191 | (raw-request-add-buffer raw-request (string-buffer-string buffer))
192 | (setf *last-raw-request* raw-request)
193 | (when (raw-request-completep raw-request)
194 | (return)))
195 | (parse-request-and-header (raw-request-lines raw-request))))
196 |
197 | (defun write-string-to-socket (channel string)
198 | ($QIOW/check-iosb channel IO$_WRITEVBLK
199 | :p1 (make-string-buffer :allocation :static
200 | :string string)
201 | :p2 (length string)))
202 |
203 | (defun write-response-status-and-header (channel response)
204 | ;; Send response status and header
205 | (with-output-to-string (*standard-output*)
206 | (format t "~A ~D ~A~C~C"
207 | *response-http-version*
208 | (response-status response)
209 | (response-status-string response)
210 | #\Return #\Linefeed)
211 | (format t "Server: ~A~C~C"
212 | *server-string* #\Return #\Linefeed)
213 | (doplist (key value (response-header response))
214 | (format t "~:(~A~): ~A~C~C"
215 | key value #\Return #\Linefeed))
216 | (format t "~C~C" #\Return #\Linefeed)
217 | (finish-output *standard-output*)
218 | (write-string-to-socket channel
219 | (get-output-stream-string *standard-output*))))
220 |
221 | (defun write-response-body (channel response)
222 | (funcall (response-write-body response) channel (response-body response)))
223 |
224 | (defun handle-error-during-request (function-name
225 | error-signalling-function
226 | format &rest args)
227 | (format *error-output* "~&~:(~A~) in function ~A processing client request: ~?~%"
228 | error-signaling-function function-name format args)
229 | (throw 'error nil))
230 |
231 | (defun process-requests (channel client-sockaddr-in)
232 | (catch 'error
233 | (let* ((*universal-error-handler* #'handle-error-during-request)
234 | (request (read-request channel))
235 | (response (dispatch-request request)))
236 | (format t "~&~A ~A ~A ~A~%"
237 | (format-ip-address (sockaddr-in-SIN$L_ADDR client-sockaddr-in))
238 | (request-method request)
239 | (request-uri request)
240 | (response-status response))
241 | (write-response-status-and-header channel response)
242 | (write-response-body channel response))))
243 |
244 | (defun http-server (&key (port 2002))
245 | (with-ucx-channel (server-channel)
246 | (setup-listen-socket server-channel port)
247 | (loop
248 | ;; Accept one connection
249 | (let* ((client-channel (make-short :allocation :static))
250 | (client-sockaddr-in (make-sockaddr-in :allocation :static))
251 | (client-address-length (make-short :allocation :static)))
252 | (with-ucx-channel (channel)
253 | (setf (short-value client-channel) channel)
254 | ($QIOW/check-iosb server-channel (logior IO$_ACCESS IO$M_ACCEPT)
255 | :p3 (make-itemlst-3 :allocation :static
256 | :length (alien-structure-length client-sockaddr-in)
257 | :address client-sockaddr-in
258 | :retlen client-address-length)
259 | :p4 client-channel)
260 | (process-requests channel client-sockaddr-in))))))
261 |
--------------------------------------------------------------------------------
/response.lsp:
--------------------------------------------------------------------------------
1 | ;; Define the RESPONSE structure. Instances of this structure are returned
2 | ;; by request handlers so that the web server can write the HTTP response
3 | ;; and header. The WRITE-BODY field of the structure defines how the body
4 | ;; is written to the client. By default, the BODY field is assumed to be
5 | ;; a string and written to the client as the body. When serving files,
6 | ;; a different function is used to read from the file and write to the client
7 | ;; instead.
8 |
9 | (in-package :rasselbock)
10 |
11 | (require 'parameters)
12 |
13 | (provide 'response)
14 |
15 | (defstruct response
16 | (write-body #'write-string-to-socket)
17 | (status 200)
18 | (status-string "OK")
19 | header
20 | body)
21 |
--------------------------------------------------------------------------------
/sys/inetdef.lsp:
--------------------------------------------------------------------------------
1 | (in-package :rasselbock)
2 |
3 | (defconstant ARP$M_IN_USE #x1)
4 | (defconstant ARP$M_COM #x2)
5 | (defconstant ARP$M_PERM #x4)
6 | (defconstant ARP$M_PUBL #x8)
7 | (defconstant ARP$M_USETRAILERS #x10)
8 | (defconstant ARP$C_LENGTH 34)
9 | (defconstant ARP$K_LENGTH 34)
10 |
11 | ;; struct ARPREQDEF {
12 | ;; char ARP$T_PA [16]; ; IP address
13 | ;; ; $SOCKADDRINDEF defines offsets
14 | ;; char ARP$T_HA [16]; ; Ethernet hardware address
15 | ;; ; $SOCKADDRDEF defines offsets
16 | ;; union { ;
17 | ;; unsigned short int ARP$W_FLAGS; ; flags
18 | ;; struct { ;
19 | ;; unsigned ARP$V_IN_USE : 1; ; ARP entry is in use
20 | ;; unsigned ARP$V_COM : 1; ; ARP entry is complete
21 | ;; unsigned ARP$V_PERM : 1; ; ARP entry is pemanent
22 | ;; unsigned ARP$V_PUBL : 1; ; ARP entry is public
23 | ;; unsigned ARP$V_USETRAILERS : 1; ; hosts uses trailers
24 | ;; unsigned ARP$V_FILL_0 : 3;
25 | ;; } ARP$R_O_FLAGS;
26 | ;; } ARP$R_OVLY;
27 | ;; } ;
28 |
29 | (defconstant IFR$M_IFF_UP #x1)
30 | (defconstant IFR$M_IFF_BROADCAST #x2)
31 | (defconstant IFR$M_IFF_DEBUG #x4)
32 | (defconstant IFR$M_IFF_LOOPBACK #x8)
33 | (defconstant IFR$M_IFF_POINTOPOINT #x10)
34 | (defconstant IFR$M_IFF_NOTRAILERS #x20)
35 | (defconstant IFR$M_IFF_RUNNING #x40)
36 | (defconstant IFR$M_IFF_NOARP #x80)
37 | (defconstant IFR$M_IFF_PROMISC #x100)
38 | (defconstant IFR$M_IFF_ALLMULTI #x200)
39 | (defconstant IFR$M_IFF_MULTICAST #x400)
40 | (defconstant IFR$M_IFF_SIMPLEX #x800)
41 | (defconstant IFR$M_IFF_OACTIVE #x1000)
42 | (defconstant IFR$M_IFF_PFCOPYALL #x2000)
43 | (defconstant IFR$M_IFF_D1 #x4000)
44 | (defconstant IFR$M_IFF_D2 #x8000)
45 | (defconstant IFR$M_IFF_UIOMOVE #x10000)
46 | (defconstant IFR$M_IFF_PKTOK #x20000)
47 | (defconstant IFR$M_IFF_SOCKBUF #x40000)
48 | (defconstant IFR$M_IFF_VAR_MTU #x80000)
49 | (defconstant IFR$M_IFF_NOCHECKSUM #x100000)
50 | (defconstant IFR$M_IFF_DYNPROTO #x200000)
51 | (defconstant IFR$M_IFF_MOP #x400000)
52 | (defconstant IFR$M_IFF_SLIP #x800000)
53 | (defconstant IFR$M_IFF_DELETE #x1000000)
54 | (defconstant IFR$M_IFF_NONAME #x2000000)
55 | (defconstant IFR$M_IFF_CLUSTER #x4000000)
56 | (defconstant IFR$C_LENGTH 32)
57 | (defconstant IFR$K_LENGTH 32)
58 |
59 | ;; struct IFREQDEF {
60 | ;; char IFR$T_NAME [16]; ; device name
61 | ;; union {
62 | ;; char IFR$T_ADDR [16]; ; SOCKADDRIN structure
63 | ;; char IFR$T_DSTADDR [16]; ; SOCKADDRIN structure
64 | ;; char IFR$T_BROADADDR [16]; ; SOCKADDRIN structure
65 | ;; union {
66 | ;; unsigned short int IFR$W_FLAGS; ; flags
67 | ;; struct {
68 | ;; unsigned IFR$V_IFF_UP : 1; ; Interface is up
69 | ;; unsigned IFR$V_IFF_BROADCAST : 1; ; Broadcast address valid
70 | ;; unsigned IFR$V_IFF_DEBUG : 1; ; Turn on tracing
71 | ;; unsigned IFR$V_IFF_LOOPBACK : 1; ; Interface set to loopback
72 | ;; unsigned IFR$V_IFF_POINTOPOINT : 1; ; Interface is point-to-point link
73 | ;; unsigned IFR$V_IFF_NOTRAILERS : 1; ; Avoid use of trailers
74 | ;; unsigned IFR$V_IFF_RUNNING : 1; ; Resources are allocated
75 | ;; unsigned IFR$V_IFF_NOARP : 1; ; No address resolution protocol
76 | ;; unsigned IFR$V_IFF_PROMISC : 1; ; Receive all packets
77 | ;; unsigned IFR$V_IFF_ALLMULTI : 1; ; Receive all multicasting packets
78 | ;; unsigned IFR$V_IFF_MULTICAST : 1; ; supports multicast
79 | ;; unsigned IFR$V_IFF_SIMPLEX : 1; ; can't hear own transmissions
80 | ;; unsigned IFR$V_IFF_OACTIVE : 1; ; transmission in progress
81 | ;; unsigned IFR$V_IFF_PFCOPYALL : 1; ; pfilt gets packets to this host
82 | ;; unsigned IFR$V_IFF_D1 : 1; ; IFF_SNAP Ethernet driver outputs
83 | ;; ; SNAP hdr
84 | ;; unsigned IFR$V_IFF_D2 : 1;
85 | ;; unsigned IFR$V_IFF_UIOMOVE : 1; ; DART
86 | ;; unsigned IFR$V_IFF_PKTOK : 1; ; DART
87 | ;; unsigned IFR$V_IFF_SOCKBUF : 1; ; DART
88 | ;; unsigned IFR$V_IFF_VAR_MTU : 1; ; interface supports variable MTUs
89 | ;; unsigned IFR$V_IFF_NOCHECKSUM : 1; ; no checksums need reliable media
90 | ;; unsigned IFR$V_IFF_DYNPROTO : 1; ; Support dynamic proto dispatching
91 | ;; unsigned IFR$V_IFF_MOP : 1; ; Device in MOP mode; not in use
92 | ;; unsigned IFR$V_IFF_SLIP : 1; ; Interface is a SLIP IFNET
93 | ;; unsigned IFR$V_IFF_DELETE : 1; ; Started DELETE on this interface
94 | ;; unsigned IFR$V_IFF_NONAME : 1; ; Interface does not hold the cluster
95 | ;; ; name
96 | ;; unsigned IFR$V_IFF_CLUSTER : 1; ; Interface is a cluster IFNET
97 | ;; unsigned IFR$V_FILL_1 : 5;
98 | ;; } IFR$R_DUMMY_1_BITS;
99 | ;; } IFR$R_DUMMY_1_OVRL;
100 | ;; int *IFR$L_DATA; ; pointer to data
101 | ;; } IFR$R_DUMMY;
102 | ;; } ;
103 |
104 | (defconstant EPERM 1) ; Not owner
105 | (defconstant ENOENT 2) ; No such file or directory
106 | (defconstant ESRCH 3) ; No such process
107 | (defconstant EINTR 4) ; Interrupted system call
108 | (defconstant EIO 5) ; I/O error
109 | (defconstant ENXIO 6) ; No such device or address
110 | (defconstant E2BIG 7) ; Arg list too long
111 | (defconstant ENOEXEC 8) ; Exec format error
112 | (defconstant EBADF 9) ; Bad file number
113 | (defconstant ECHILD 10) ; No children
114 | (defconstant EAGAIN 11) ; No more processes
115 | (defconstant ENOMEM 12) ; Not enough core
116 | (defconstant EACCES 13) ; Permission denied
117 | (defconstant EFAULT 14) ; Bad address
118 | (defconstant ENOTBLK 15) ; Block device required
119 | (defconstant EBUSY 16) ; Mount device busy
120 | (defconstant EEXIST 17) ; File exists
121 | (defconstant EXDEV 18) ; Cross-device link
122 | (defconstant ENODEV 19) ; No such device
123 | (defconstant ENOTDIR 20) ; Not a directory
124 | (defconstant EISDIR 21) ; Is a directory
125 | (defconstant EINVAL 22) ; Invalid argument
126 | (defconstant ENFILE 23) ; File table overflow
127 | (defconstant EMFILE 24) ; Too many open files
128 | (defconstant ENOTTY 25) ; Not a typewriter
129 | (defconstant ETXTBSY 26) ; Text file busy
130 | (defconstant EFBIG 27) ; File too large
131 | (defconstant ENOSPC 28) ; No space left on device
132 | (defconstant ESPIPE 29) ; Illegal seek
133 | (defconstant EROFS 30) ; Read-only file system
134 | (defconstant EMLINK 31) ; Too many links
135 | (defconstant EPIPE 32) ; Broken pipe
136 | ; math software
137 | (defconstant EDOM 33) ; Argument too large
138 | (defconstant ERANGE 34) ; Result too large
139 | ; non-blocking and interrupt i/o
140 | (defconstant EWOULDBLOCK 35) ; Operation would block
141 | (defconstant EINPROGRESS 36) ; Operation now in progress
142 | (defconstant EALREADY 37) ; Operation already in progress
143 | ; ipc/network software
144 | ; argument errors
145 | (defconstant ENOTSOCK 38) ; Socket operation on non-socket
146 | (defconstant EDESTADDRREQ 39) ; Destination address required
147 | (defconstant EMSGSIZE 40) ; Message too long
148 | (defconstant EPROTOTYPE 41) ; Protocol wrong type for socket
149 | (defconstant ENOPROTOOPT 42) ; Protocol not available
150 | (defconstant EPROTONOSUPPORT 43) ; Protocol not supported
151 | (defconstant ESOCKTNOSUPPORT 44) ; Socket type not supported
152 | (defconstant EOPNOTSUPP 45) ; Operation not supported on socket
153 | (defconstant EPFNOSUPPORT 46) ; Protocol family not supported
154 | (defconstant EAFNOSUPPORT 47) ; Address family not supported by protocol family
155 | (defconstant EADDRINUSE 48) ; Address already in use
156 | (defconstant EADDRNOTAVAIL 49) ; Can't assign requested address
157 | ; operational errors
158 | (defconstant ENETDOWN 50) ; Network is down
159 | (defconstant ENETUNREACH 51) ; Network is unreachable
160 | (defconstant ENETRESET 52) ; Network dropped connection on reset
161 | (defconstant ECONNABORTED 53) ; Software caused connection abort
162 | (defconstant ECONNRESET 54) ; Connection reset by peer
163 | (defconstant ENOBUFS 55) ; No buffer space available
164 | (defconstant EISCONN 56) ; Socket is already connected
165 | (defconstant ENOTCONN 57) ; Socket is not connected
166 | (defconstant ESHUTDOWN 58) ; Can't send after socket shutdown
167 | (defconstant ETOOMANYREFS 59) ; Too many references: can't splice
168 | (defconstant ETIMEDOUT 60) ; Connection timed out
169 | (defconstant ECONNREFUSED 61) ; Connection refused
170 | (defconstant ELOOP 62) ; Too many levels of symbolic links
171 | (defconstant ENAMETOOLONG 63) ; File name too long
172 | ; should be rearranged
173 | (defconstant EHOSTDOWN 64) ; Host is down
174 | (defconstant EHOSTUNREACH 65) ; No route to host
175 | ; quotas & mush
176 | (defconstant EPROCLIM 67) ; Too many processes
177 | (defconstant EUSERS 68) ; Too many users
178 | (defconstant EDQUOT 69) ; Disc quota exceeded
179 |
180 | (defconstant DVI$_ACP_TCP 10)
181 | (defconstant INET$C_IP 0)
182 | (defconstant INET$C_ICMP 1)
183 | (defconstant INET$C_IGMP 2)
184 | (defconstant INET$C_GGP 3)
185 | (defconstant INET$C_IPIP 4)
186 | (defconstant INET$C_IPV4 4)
187 | (defconstant INET$C_TCP 6)
188 | (defconstant INET$C_EGP 8)
189 | (defconstant INET$C_PUP 12)
190 | (defconstant INET$C_UDP 17)
191 | (defconstant INET$C_IDP 22)
192 | (defconstant INET$C_TP 29)
193 | (defconstant INET$C_RSVP 46)
194 | (defconstant INET$C_IPV6 41)
195 | (defconstant INET$C_ROUTING 43)
196 | (defconstant INET$C_FRAG 44)
197 | (defconstant INET$C_ESP 50)
198 | (defconstant INET$C_AUTH 51)
199 | (defconstant INET$C_ICMPV6 58)
200 | (defconstant INET$C_NONEXTHDR 59)
201 | (defconstant INET$C_DESTNODE 60)
202 | (defconstant INET$C_EON 80)
203 | (defconstant INET$C_AUXS 127)
204 | (defconstant INET$C_REXEC 128)
205 | (defconstant INET$C_RAW_IP 255)
206 | (defconstant INET$C_MAX 256)
207 | (defconstant IPPROTO$C_IP 0)
208 | (defconstant IPPROTO$C_ICMP 1)
209 | (defconstant IPPROTO$C_IGMP 2)
210 | (defconstant IPPROTO$C_GGP 3)
211 | (defconstant IPPROTO$C_IPIP 4)
212 | (defconstant IPPROTO$C_IPV4 4)
213 | (defconstant IPPROTO$C_TCP 6)
214 | (defconstant IPPROTO$C_EGP 8)
215 | (defconstant IPPROTO$C_PUP 12)
216 | (defconstant IPPROTO$C_UDP 17)
217 | (defconstant IPPROTO$C_IDP 22)
218 | (defconstant IPPROTO$C_TP 29)
219 | (defconstant IPPROTO$C_RSVP 46)
220 | (defconstant IPPROTO$C_IPV6 41)
221 | (defconstant IPPROTO$C_ROUTING 43)
222 | (defconstant IPPROTO$C_FRAG 44)
223 | (defconstant IPPROTO$C_ESP 50)
224 | (defconstant IPPROTO$C_AUTH 51)
225 | (defconstant IPPROTO$C_ICMPV6 58)
226 | (defconstant IPPROTO$C_NONEXTHDR 59)
227 | (defconstant IPPROTO$C_DESTNODE 60)
228 | (defconstant IPPROTO$C_EON 80)
229 | (defconstant IPPROTO$C_AUXS 127)
230 | (defconstant IPPROTO$C_REXEC 128)
231 | (defconstant IPPROTO$C_RAW_IP 255)
232 | (defconstant IPPROTO$C_MAX 256)
233 | (defconstant TCPIP$C_IP 0)
234 | (defconstant TCPIP$C_ICMP 1)
235 | (defconstant TCPIP$C_IGMP 2)
236 | (defconstant TCPIP$C_GGP 3)
237 | (defconstant TCPIP$C_IPIP 4)
238 | (defconstant TCPIP$C_IPV4 4)
239 | (defconstant TCPIP$C_TCP 6)
240 | (defconstant TCPIP$C_EGP 8)
241 | (defconstant TCPIP$C_PUP 12)
242 | (defconstant TCPIP$C_UDP 17)
243 | (defconstant TCPIP$C_IDP 22)
244 | (defconstant TCPIP$C_TP 29)
245 | (defconstant TCPIP$C_RSVP 46)
246 | (defconstant TCPIP$C_IPV6 41)
247 | (defconstant TCPIP$C_ROUTING 43)
248 | (defconstant TCPIP$C_FRAG 44)
249 | (defconstant TCPIP$C_ESP 50)
250 | (defconstant TCPIP$C_AUTH 51)
251 | (defconstant TCPIP$C_ICMPV6 58)
252 | (defconstant TCPIP$C_NONEXTHDR 59)
253 | (defconstant TCPIP$C_DESTNODE 60)
254 | (defconstant TCPIP$C_EON 80)
255 | (defconstant TCPIP$C_AUXS 127)
256 | (defconstant TCPIP$C_REXEC 128)
257 | (defconstant TCPIP$C_RAW_IP 255)
258 | (defconstant TCPIP$C_MAX 256)
259 | ;
260 | ; Ports < IP_PROTO$C_RESERVED are reserved for
261 | ; privileged processes (e.g. root).
262 | ;
263 | (defconstant IP_PROTO$C_RESERVED 1024)
264 | (defconstant INET_PROTYP$C_STREAM 1) ; stream type
265 | (defconstant INET_PROTYP$C_DGRAM 2) ; datagram type
266 | (defconstant INET_PROTYP$C_RAW 3) ; raw type
267 | ;
268 | (defconstant TCPIP$C_STREAM 1)
269 | (defconstant TCPIP$C_DGRAM 2)
270 | (defconstant TCPIP$C_RAW 3)
271 | (defconstant INET$C_IPOPT 0) ; IP opt type parameter
272 | (defconstant INET$C_SOCKOPT 1) ; setsockopt type parameter
273 | (defconstant INET$C_IOCTL 2) ; ioctl type parameter
274 | (defconstant INET$C_DATA 3) ; data
275 | (defconstant INET$C_SOCK_NAME 4) ; socket name
276 | (defconstant INET$C_RESERVE_1 5)
277 | (defconstant INET$C_TCPOPT 6) ; TCP option type
278 | ;
279 | (defconstant INET$C_IPV6OPT 41)
280 | (defconstant TCPIP$C_IPV6OPT 41)
281 | (defconstant INET$C_ICMPV6OPT 58)
282 | (defconstant TCPIP$C_ICMPV6OPT 58)
283 | (defconstant TCPIP$C_IPOPT 0)
284 | (defconstant TCPIP$C_SOCKOPT 1)
285 | (defconstant TCPIP$C_TCPOPT 6)
286 | (defconstant TCPIP$C_IOCTL 2)
287 | (defconstant TCPIP$C_DATA 3)
288 | (defconstant TCPIP$C_SOCK_NAME 4)
289 | (defconstant INET$C_DSC_RCV 0) ; discard received messages
290 | (defconstant INET$C_DSC_SND 1) ; discard sent messages
291 | (defconstant INET$C_DSC_ALL 2) ; discard all messages
292 | (defconstant TCPIP$C_DSC_RCV 0)
293 | (defconstant TCPIP$C_DSC_SND 1)
294 | (defconstant TCPIP$C_DSC_ALL 2)
295 | (defconstant TCPIP$C_SO_SNDBUF 4097) ; #x1001 send buffer size
296 | (defconstant TCPIP$C_SO_RCVBUF 4098) ; #x1002 receive buffer size
297 | (defconstant TCPIP$C_SO_SNDLOWAT 4099) ; #x1003 send low-water mark
298 | (defconstant TCPIP$C_SO_RCVLOWAT 4100) ; #x1004 receive low-water mark
299 | (defconstant TCPIP$C_SO_SNDTIMEO 4101) ; #x1005 send timeout
300 | (defconstant TCPIP$C_SO_RCVTIMEO 4102) ; #x1006 receive timeout
301 | (defconstant TCPIP$C_SO_ERROR 4103) ; #x1007 get error status and clear
302 | (defconstant TCPIP$C_SO_TYPE 4104) ; #x1008 get socket type
303 | (defconstant TCPIP$C_SO_SHARE 4105) ; #x1009 ovms Share between processes
304 | (defconstant TCPIP$C_SO_CCL 4106) ; #x100a ovms Carriage Control socket
305 | (defconstant TCPIP$C_SO_STATE 4107) ; #x100b get socket state bits
306 | (defconstant TCPIP$C_SO_FAMILY 4108) ; #x100c get socket address family
307 | (defconstant TCPIP$C_SO_XSE 4109) ; #x100d _XOPEN_SOURCE_EXTENDED socket
308 | (defconstant TCPIP$C_SO_NO_RCV_CHKSUM 16384)
309 | (defconstant TCPIP$C_SO_NO_SND_CHKSUM 32768)
310 | (defconstant TCPIP$C_SO_NO_CHKSUM 49152)
311 | (defconstant INET$C_TCPOPT_EOL 0)
312 | (defconstant INET$C_TCPOPT_NOP 1)
313 | (defconstant INET$C_TCPOPT_MAXSEG 2)
314 | (defconstant INET$C_TCP_NODELAY 1) ; don't delay send to coalesce packets
315 | (defconstant INET$C_TCP_MAXSEG 2) ; set maximum segment size
316 | (defconstant INET$C_TCP_PROBE_IDLE 128) ; probe idle timer
317 | (defconstant INET$C_TCP_DROP_IDLE 129) ; drop idle timer
318 | (defconstant TCPIP$C_TCPOPT_EOL 0)
319 | (defconstant TCPIP$C_TCPOPT_NOP 1)
320 | (defconstant TCPIP$C_TCPOPT_MAXSEG 2)
321 | (defconstant TCPIP$C_TCP_NODELAY 1)
322 | (defconstant TCPIP$C_TCP_MAXSEG 2)
323 | (defconstant TCPIP$C_TCP_PROBE_IDLE 128)
324 | (defconstant TCPIP$C_TCP_DROP_IDLE 129)
325 | (defconstant INET$C_IP_TOS 3)
326 | (defconstant INET$C_IP_TTL 4)
327 | (defconstant INET$C_IP_MULTICAST_IF 16) ; set/get IP multicast interface
328 | (defconstant INET$C_IP_MULTICAST_TTL 17) ; set/get IP multicast timetolive
329 | (defconstant INET$C_IP_MULTICAST_LOOP 18) ; set/get IP multicast loopback
330 | (defconstant INET$C_IP_ADD_MEMBERSHIP 19) ; add an IP group membership
331 | (defconstant INET$C_IP_DROP_MEMBERSHIP 20) ; drop an IP group membership
332 | (defconstant INET$C_IP_MULTICAST_VIF 21) ; set/get IP mcast vir. interface
333 | (defconstant TCPIP$C_IP_TOS 3)
334 | (defconstant TCPIP$C_IP_TTL 4)
335 | (defconstant TCPIP$C_IP_MULTICAST_IF 16) ; set/get IP multicast interface
336 | (defconstant TCPIP$C_IP_MULTICAST_TTL 17) ; set/get IP multicast timetolive
337 | (defconstant TCPIP$C_IP_MULTICAST_LOOP 18) ; set/get IP multicast loopback
338 | (defconstant TCPIP$C_IP_ADD_MEMBERSHIP 19) ; add an IP group membership
339 | (defconstant TCPIP$C_IP_DROP_MEMBERSHIP 20) ; drop an IP group membership
340 | (defconstant TCPIP$C_IP_MULTICAST_VIF 21) ; set/get IP mcast vir. interface
341 | (defconstant INET$C_AF_UNSPEC 0) ; unspecified
342 | (defconstant INET$C_AF_UNIX 1) ; local to host (pipes, portals)
343 | (defconstant INET$C_AF_INET 2) ; internetwork: UDP, TCP, etc.
344 | (defconstant INET$C_AF_IMPLINK 3) ; 3 arpanet imp addresses
345 | (defconstant INET$C_AF_PUP 4) ; 4 pup protocols: e.g. BSP
346 | (defconstant INET$C_AF_CHAOS 5) ; 5 mit CHAOS protocols
347 | (defconstant INET$C_AF_NS 6) ; 6 XEROX NS protocols
348 | (defconstant INET$C_AF_ISO 7) ; 7 ISO protocols
349 | (defconstant INET$C_AF_ECMA 8) ; 8 european computer manufacturers
350 | (defconstant INET$C_AF_DATAKIT 9) ; 9 datakit protocols
351 | (defconstant INET$C_AF_CCITT 10) ; 10 CCITT protocols, X.25 etc
352 | (defconstant INET$C_AF_SNA 11) ; 11 IBM SNA
353 | (defconstant INET$C_AF_DECnet 12) ; 12 DECnet
354 | (defconstant INET$C_AF_DLI 13) ; 13 DEC Direct data link interface
355 | (defconstant INET$C_AF_LAT 14) ; 14 LAT
356 | (defconstant INET$C_AF_HYLINK 15) ; 15 NSC Hyperchannel
357 | (defconstant INET$C_AF_APPLETALK 16) ; 16 Apple Talk
358 | (defconstant INET$C_AF_ROUTE 17) ; 17 Internal Routing Protocol
359 | (defconstant INET$C_AF_LINK 18) ; 18 Link layer interface
360 | (defconstant INET$C_pseudo_AF_XTP 19) ; 19 eXpress Transfer Protocol (no AF)
361 | (defconstant INET$C_AF_NETMAN 20) ; 20 DNA Network Management
362 | (defconstant INET$C_AF_X25 21) ; 21 X25 protocol
363 | (defconstant INET$C_AF_CTF 22) ; 22 Common Trace Facility
364 | (defconstant INET$C_AF_WAN 23) ; 23 Wide Area Network protocols
365 | (defconstant INET$C_AF_USER 24) ; 24 Wild card (user defined) protocol
366 | (defconstant INET$C_AF_LAST 25) ; 25 Local Area System Transport protocol
367 | (defconstant INET$C_AF_INET6 26) ; 26 IPV6: UDP, TCP, etc.
368 | (defconstant INET$C_AF_AAL 27) ; 27 Native AAL ATM
369 | (defconstant INET$C_AF_KEY 28) ; 28 Key management
370 | (defconstant INET$C_AF_UNUSED1 29)
371 | (defconstant INET$C_AF_UNUSED2 30)
372 | (defconstant INET$C_AF_UNUSED3 31)
373 | (defconstant INET$C_AF_UNUSED4 32)
374 | (defconstant INET$C_AF_UNUSED5 33)
375 | (defconstant INET$C_AF_UNUSED6 34)
376 | (defconstant INET$C_AF_MAX 35) ; 35 maximum value
377 | (defconstant INET$C_INADDR_ANY 0)
378 | (defconstant INET$C_INADDR_BROADCAST -1)
379 |
380 | (defconstant TCPIP$C_AF_UNSPEC 0)
381 | (defconstant TCPIP$C_AF_UNIX 1)
382 | (defconstant TCPIP$C_AF_INET 2)
383 | (defconstant TCPIP$C_AF_INET6 26)
384 | (defconstant TCPIP$C_AF_MAX 35)
385 | (defconstant TCPIP$C_INADDR_ANY 0)
386 | (defconstant TCPIP$C_INADDR_BROADCAST -1)
387 |
388 | (defconstant INET$M_MSG_OOB #x1)
389 | (defconstant INET$M_MSG_PEEK #x2)
390 | (defconstant INET$M_MSG_DONTROUTE #x4)
391 | (defconstant INET$M_DUMMYN_4 #x8)
392 | (defconstant INET$M_DUMMYN_5 #x10)
393 | (defconstant INET$M_MSG_PURGE #x20)
394 | (defconstant INET$M_MSG_NBIO #x40)
395 | (defconstant INET$M_MSG_BLOCKALL #x80)
396 |
397 | ;; struct MSGBITS {
398 | ;; struct {
399 | ;; ;
400 | ;; unsigned INET$V_MSG_OOB : 1; ; turn on event logging, not used
401 | ;; unsigned INET$V_MSG_PEEK : 1; ; socket has had LISTEN
402 | ;; unsigned INET$V_MSG_DONTROUTE : 1; ; use only the interface addr
403 | ;; ;
404 | ;; unsigned INET$V_DUMMYN_4 : 1; ; reserve space
405 | ;; ;
406 | ;; unsigned INET$V_DUMMYN_5 : 1; ; reserve space
407 | ;; ;
408 | ;; unsigned INET$V_MSG_PURGE : 1; ; Purge I/O
409 | ;; unsigned INET$V_MSG_NBIO : 1; ; NON-block I/O
410 | ;; unsigned INET$V_MSG_BLOCKALL : 1; ; record TCP I/O
411 | ;; } INET$R_MSG_BITS;
412 | ;; } ;
413 |
414 | (defconstant INET$C_MSG_OOB 1) ; process out-of-band data
415 | (defconstant INET$C_MSG_PEEK 2) ; peek at incoming message
416 | (defconstant INET$C_MSG_DONTROUTE 4) ; send without
417 | ; using routing tables
418 | (defconstant INET$C_MSG_PURGE 32) ; block read until fill buffer
419 | (defconstant INET$C_MSG_NBIO 64) ; block read until fill buffer
420 | (defconstant INET$C_MSG_BLOCKALL 128) ; block read until fill buffer
421 | (defconstant INET$C_MSG_MAXIOVLEN 16)
422 | ;
423 | (defconstant TCPIP$C_MSG_OOB 1) ; process out-of-band data
424 | (defconstant TCPIP$C_MSG_PEEK 2) ; peek at incoming message
425 | (defconstant TCPIP$C_MSG_DONTROUTE 4) ; send without
426 | ; using routing tables
427 | (defconstant TCPIP$C_MSG_PURGE 32) ; block read until fill buffer
428 | (defconstant TCPIP$C_MSG_NBIO 64) ; block read until fill buffer
429 | (defconstant TCPIP$C_MSG_BLOCKALL 128) ; block read until fill buffer
430 | (defconstant TCPIP$C_MSG_MAXIOVLEN 16)
431 | (defconstant TCPIP$M_MSG_OOB #x1)
432 | (defconstant TCPIP$M_MSG_PEEK #x2)
433 | (defconstant TCPIP$M_MSG_DONTROUTE #x4)
434 | (defconstant TCPIP$M_DUMMYX_4 #x8)
435 | (defconstant TCPIP$M_DUMMYX_5 #x10)
436 | (defconstant TCPIP$M_MSG_PURGE #x20)
437 | (defconstant TCPIP$M_MSG_NBIO #x40)
438 | (defconstant TCPIP$M_MSG_BLOCKALL #x80)
439 |
440 | ;; struct MSGBITS_1 {
441 | ;; struct {
442 | ;; ;
443 | ;; unsigned TCPIP$V_MSG_OOB : 1; ; turn on event logging, not used
444 | ;; unsigned TCPIP$V_MSG_PEEK : 1; ; socket has had LISTEN
445 | ;; unsigned TCPIP$V_MSG_DONTROUTE : 1; ; use only the interface addr
446 | ;; ;
447 | ;; unsigned TCPIP$V_DUMMYX_4 : 1; ; reserve space
448 | ;; ;
449 | ;; unsigned TCPIP$V_DUMMYX_5 : 1; ; reserve space
450 | ;; ;
451 | ;; unsigned TCPIP$V_MSG_PURGE : 1; ; Purge I/O
452 | ;; unsigned TCPIP$V_MSG_NBIO : 1; ; NON-block I/O
453 | ;; unsigned TCPIP$V_MSG_BLOCKALL : 1; ; record TCP I/O
454 | ;; } TCPIP$R_MSG_BITS;
455 | ;; } ;
456 |
457 | (defconstant OPT$L_ADDRESS 4)
458 | (defconstant OPT$C_SET_LENGTH 8)
459 | (defconstant OPT$K_SET_LENGTH 8)
460 | (defconstant OPT$C_GET_LENGTH 12)
461 | (defconstant OPT$K_GET_LENGTH 12)
462 |
463 | ;; struct OPTDEF {
464 | ;; unsigned short int OPT$W_LENGTH; ; length
465 | ;; unsigned short int OPT$W_NAME; ; name
466 | ;; int *OPT$L_ADDR; ; address
467 | ;; int *OPT$L_RET_LENGTH; ; address
468 | ;; } ;
469 |
470 | ;
471 | ; We distinguish between routes to hosts and routes to networks,
472 | ; preferring the former if available. For each route we infer
473 | ; the interface to use from the gateway address supplied when
474 | ; the route was entered. Routes that forward packets through
475 | ; gateways are marked so that the output routines know to address the
476 | ; gateway rather than the ultimate destination.
477 | ;
478 | (defconstant ORT$M_RTF_UP #x1)
479 | (defconstant ORT$M_RTF_GATEWAY #x2)
480 | (defconstant ORT$M_RTF_HOST #x4)
481 | (defconstant ORT$M_RTF_DYNAMIC #x8)
482 | (defconstant ORT$M_RTF_MODIFIED #x10)
483 | (defconstant ORT$C_LENGTH 48)
484 | (defconstant ORT$K_LENGTH 48)
485 |
486 | ;; struct ORTENTRYDEF {
487 | ;; unsigned int ORT$L_HASH; ; Hash link
488 | ;; union {
489 | ;; struct {
490 | ;; unsigned short int ORT$W_DST_SIN_FAMILY; ; Address type
491 | ;; unsigned short int ORT$W_DST_SIN_PORT; ; Port number
492 | ;; unsigned int ORT$L_DST_SIN_ADDR; ; Internet address
493 | ;; char ORT$T_DST_SIN_ZERO [8]; ; Unused space
494 | ;; } ORT$R_DST_FIELDS;
495 | ;; char ORT$T_DST [16]; ; Destination SOCKADDR structure
496 | ;; } ORT$R_DST_OVRLY;
497 | ;; union {
498 | ;; struct {
499 | ;; unsigned short int ORT$W_GATEWAY_SIN_FAMILY; ; Address type
500 | ;; unsigned short int ORT$W_GATEWAY_SIN_PORT; ; Port number
501 | ;; unsigned int ORT$L_GATEWAY_SIN_ADDR; ; Internet address
502 | ;; char ORT$T_GATEWAY_SIN_ZERO [8]; ; Unused space
503 | ;; } ORT$R_GATEWAY_FIELDS;
504 | ;; char ORT$T_GATEWAY [16]; ; Gateway SOCKADDR structure
505 | ;; } ORT$R_GATEWAY_OVRLY;
506 | ;; union {
507 | ;; unsigned short int ORT$W_FLAGS; ; up/down?, host/net
508 | ;; struct {
509 | ;; unsigned ORT$V_RTF_UP : 1; ; route useable
510 | ;; unsigned ORT$V_RTF_GATEWAY : 1; ; destination is a gateway
511 | ;; unsigned ORT$V_RTF_HOST : 1; ; host entry (net otherwise)
512 | ;; unsigned ORT$V_RTF_DYNAMIC : 1; ; created dynamically (by redirect)
513 | ;; unsigned ORT$V_RTF_MODIFIED : 1; ; changed by redirect
514 | ;; unsigned ORT$V_FILL_2 : 3;
515 | ;; } ORT$R_FLAGS_BITS;
516 | ;; } ORT$R_FLAGS_OVRLY;
517 | ;; unsigned short int ORT$W_REFCNT; ; # held references
518 | ;; unsigned int ORT$L_USE; ; raw # packets forwarded
519 | ;; unsigned int ORT$L_IFP; ; pointer to the IFNET interface to use
520 | ;; } ;
521 |
522 | ;
523 | ; Only defined here for backward compatibility
524 | ;
525 | (defconstant FIONREAD 1074030207) ; Get # bytes to read
526 | (defconstant OFIONREAD -2147195265) ; Get # bytes to read
527 | (defconstant FIONBIO -2147195266) ; non block I/O
528 | (defconstant FIOASYNC -2147195267) ; asynch I/O
529 | (defconstant SIOCSHIWAT -2147192064) ; high water mark
530 | (defconstant SIOCGHIWAT 1074033409) ; high water mark
531 | (defconstant SIOCSLOWAT -2147192062) ; low water mark
532 | (defconstant SIOCGLOWAT 1074033411) ; low water mark
533 | (defconstant SIOCATMARK 1074033415) ; at OOB mark
534 | (defconstant SIOCSPGRP -2147192056) ; Process group
535 | (defconstant SIOCGPGRP 1074033417) ; Process group
536 | (defconstant SIOCADDRT -2144308726) ; add RT
537 | (defconstant SIOCDELRT -2144308725) ; delete RT
538 | (defconstant SIOCGETRT -1070566869) ; get RT
539 | (defconstant SIOCSIFADDR -2145359604) ; set IF address
540 | (defconstant SIOCGIFADDR -1071617779) ; Get IF address
541 | (defconstant SIOCSIFDSTADDR -2145359602) ; Destination addr
542 | (defconstant SIOCGIFDSTADDR -1071617777) ; BDestination addr
543 | (defconstant SIOCSIFFLAGS -2145359600) ; IF flags
544 | (defconstant SIOCGIFFLAGS -1071617775) ; IF flags
545 | (defconstant SIOCGIFBRDADDR -1071617774) ; Broadcast addr
546 | (defconstant SIOCSIFBRDADDR -2145359597) ; Broadcats addr
547 | (defconstant SIOCGIFCONF -1073190636) ; IF configuration
548 | (defconstant SIOCGIFNETMASK -1071617771) ; Network mask
549 | (defconstant SIOCSIFNETMASK -2145359594) ; Network mask
550 | (defconstant SIOCSARP -2145097442) ; set ARP
551 | (defconstant SIOCGARP -1071355617) ; get ARP
552 | (defconstant SIOCDARP -2145097440) ; delete ARP
553 | (defconstant SIOCARPREQ -1071355608) ; ARP request
554 | (defconstant SIOCENABLBACK -2145359583) ; enable loopback
555 | (defconstant SIOCDISABLBACK -2145359582) ; disable loopback
556 | (defconstant SIOCSTATE -1072273117) ; state
557 | (defconstant I_STR 536892168)
558 |
559 | ;
560 | ; Socket options data structure.
561 | ;
562 | (defconstant TCPIP$W_OPTIONS 0)
563 | (defconstant INET$W_OPTIONS 0)
564 | (defconstant SOCKOPT$M_SO_DEBUG #x1)
565 | (defconstant SOCKOPT$M_ACCEPTCONN #x2)
566 | (defconstant SOCKOPT$M_REUSEADDR #x4)
567 | (defconstant SOCKOPT$M_KEEPALIVE #x8)
568 | (defconstant SOCKOPT$M_DONTROUTE #x10)
569 | (defconstant SOCKOPT$M_BROADCAST #x20)
570 | (defconstant SOCKOPT$M_USELOOPBACK #x40)
571 | (defconstant SOCKOPT$M_LINGER #x80)
572 | (defconstant SOCKOPT$M_OOBINLINE #x100)
573 | (defconstant SOCKOPT$M_DUMMYB_2 #x200)
574 | (defconstant SOCKOPT$M_DUMMYB_3 #x400)
575 | (defconstant SOCKOPT$M_DUMMYB_4 #x800)
576 | (defconstant SOCKOPT$M_DUMMYB_5 #x1000)
577 | (defconstant SOCKOPT$M_FULL_DUPLEX_CLOSE #x2000)
578 | (defconstant SOCKOPT$M_NO_RCV_CHKSUM #x4000)
579 | (defconstant SOCKOPT$M_NO_SND_CHKSUM #x8000)
580 | (defconstant SOCKOPT$M_NO_CHKSUM 49152) ; no checksum calculation
581 | (defconstant SOCKOPT$C_NO_CHKSUM 49152) ; no checksum calculation
582 | (defconstant TCPIP$M_SO_DEBUG #x1)
583 | (defconstant TCPIP$M_ACCEPTCONN #x2)
584 | (defconstant TCPIP$M_REUSEADDR #x4)
585 | (defconstant TCPIP$M_KEEPALIVE #x8)
586 | (defconstant TCPIP$M_DONTROUTE #x10)
587 | (defconstant TCPIP$M_BROADCAST #x20)
588 | (defconstant TCPIP$M_USELOOPBACK #x40)
589 | (defconstant TCPIP$M_LINGER #x80)
590 | (defconstant TCPIP$M_OOBINLINE #x100)
591 | (defconstant TCPIP$M_DUMMYB_2 #x200)
592 | (defconstant TCPIP$M_DUMMYB_3 #x400)
593 | (defconstant TCPIP$M_DUMMYB_4 #x800)
594 | (defconstant TCPIP$M_DUMMYB_5 #x1000)
595 | (defconstant TCPIP$M_FULL_DUPLEX_CLOSE #x2000)
596 | (defconstant TCPIP$M_NO_RCV_CHKSUM #x4000)
597 | (defconstant TCPIP$M_NO_SND_CHKSUM #x8000)
598 | (defconstant TCPIP$M_NO_CHKSUM 49152) ; no checksum calculation
599 | (defconstant TCPIP$C_NO_CHKSUM 49152) ; no checksum calculation
600 | (defconstant INET$M_SO_DEBUG #x1)
601 | (defconstant INET$M_ACCEPTCONN #x2)
602 | (defconstant INET$M_REUSEADDR #x4)
603 | (defconstant INET$M_KEEPALIVE #x8)
604 | (defconstant INET$M_DONTROUTE #x10)
605 | (defconstant INET$M_BROADCAST #x20)
606 | (defconstant INET$M_USELOOPBACK #x40)
607 | (defconstant INET$M_LINGER #x80)
608 | (defconstant INET$M_OOBINLINE #x100)
609 | (defconstant INET$M_DUMMYB_2 #x200)
610 | (defconstant INET$M_DUMMYB_3 #x400)
611 | (defconstant INET$M_DUMMYB_4 #x800)
612 | (defconstant INET$M_DUMMYB_5 #x1000)
613 | (defconstant INET$M_FULL_DUPLEX_CLOSE #x2000)
614 | (defconstant INET$M_NO_RCV_CHKSUM #x4000)
615 | (defconstant INET$M_NO_SND_CHKSUM #x8000)
616 | (defconstant INET$M_NO_CHKSUM 49152) ; no checksum calculation
617 | (defconstant INET$C_NO_CHKSUM 49152) ; no checksum calculation
618 | (defconstant SOCKOPT$C_SNDBUF 4097) ; send buffer size
619 | (defconstant SOCKOPT$C_RCVBUF 4098) ; receive buffer size
620 | (defconstant SOCKOPT$C_SNDLOWAT 4099) ; send low-water mark
621 | (defconstant SOCKOPT$C_RCVLOWAT 4100) ; receive low-water mark
622 | (defconstant SOCKOPT$C_SNDTIMEO 4101) ; send timeout
623 | (defconstant SOCKOPT$C_RCVTIMEO 4102) ; receive timeout
624 | (defconstant SOCKOPT$C_ERROR 4103) ; get error status and clear
625 | (defconstant SOCKOPT$C_TYPE 4104) ; get socket type
626 | (defconstant SOCKOPT$C_SHARE 4105) ; shared between processes
627 | (defconstant SOCKOPT$C_CCL 4106) ; carriage control added
628 | (defconstant SOCKOPT$C_STATE 4107) ; get socket state bits
629 | (defconstant SOCKOPT$C_FAMILY 4108) ; get socket address family
630 | (defconstant SOCKOPT$C_XSE 4109) ; _XOPEN_SOURCE_EXTENDED socket
631 | (defconstant SOCKOPT$M_SNDBUF 4097) ; send buffer size
632 | (defconstant SOCKOPT$M_RCVBUF 4098) ; receive buffer size
633 | (defconstant SOCKOPT$M_SNDLOWAT 4099) ; send low-water mark
634 | (defconstant SOCKOPT$M_RCVLOWAT 4100) ; receive low-water mark
635 | (defconstant SOCKOPT$M_SNDTIMEO 4101) ; send timeout
636 | (defconstant SOCKOPT$M_RCVTIMEO 4102) ; receive timeout
637 | (defconstant SOCKOPT$M_ERROR 4103) ; get error status and clear
638 | (defconstant SOCKOPT$M_TYPE 4104) ; get socket type
639 | (defconstant SOCKOPT$M_STATE 4105) ; get socket state bits
640 | (defconstant SOCKOPT$M_FAMILY 4106) ; get socket address family
641 | (defconstant SOCKOPT$M_XSE 4107) ; _XOPEN_SOURCE_EXTENDED socket
642 | (defconstant SOCKOPT$M_SHARE 4105) ; shared between processes
643 | (defconstant SOCKOPT$M_CCL 4106) ; carriage control added
644 | (defconstant TCPIP$C_SNDBUF 4097) ; send buffer size
645 | (defconstant TCPIP$C_RCVBUF 4098) ; receive buffer size
646 | (defconstant TCPIP$C_SNDLOWAT 4099) ; send low-water mark
647 | (defconstant TCPIP$C_RCVLOWAT 4100) ; receive low-water mark
648 | (defconstant TCPIP$C_SNDTIMEO 4101) ; send timeout
649 | (defconstant TCPIP$C_RCVTIMEO 4102) ; receive timeout
650 | (defconstant TCPIP$C_ERROR 4103) ; get error status and clear
651 | (defconstant TCPIP$C_TYPE 4104) ; get socket type
652 | (defconstant TCPIP$C_SHARE 4105) ; shared between processes
653 | (defconstant TCPIP$C_CCL 4106) ; carriage control added
654 | (defconstant TCPIP$C_STATE 4107) ; get socket state bits
655 | (defconstant TCPIP$C_FAMILY 4108) ; get socket address family
656 | (defconstant TCPIP$C_XSE 4109) ; _XOPEN_SOURCE_EXTENDED socket
657 | (defconstant TCPIP$M_SNDBUF 4097) ; send buffer size
658 | (defconstant TCPIP$M_RCVBUF 4098) ; receive buffer size
659 | (defconstant TCPIP$M_SNDLOWAT 4099) ; send low-water mark
660 | (defconstant TCPIP$M_RCVLOWAT 4100) ; receive low-water mark
661 | (defconstant TCPIP$M_SNDTIMEO 4101) ; send timeout
662 | (defconstant TCPIP$M_RCVTIMEO 4102) ; receive timeout
663 | (defconstant TCPIP$M_ERROR 4103) ; get error status and clear
664 | (defconstant TCPIP$M_TYPE 4104) ; get socket type
665 | (defconstant TCPIP$M_SHARE 4105) ; shared between processes
666 | (defconstant TCPIP$M_CCL 4106) ; carriage control added
667 | (defconstant TCPIP$M_STATE 4107) ; get socket state bits
668 | (defconstant TCPIP$M_FAMILY 4108) ; get socket address family
669 | (defconstant TCPIP$M_XSE 4109) ; _XOPEN_SOURCE_EXTENDED socket
670 | (defconstant INET$C_SNDBUF 4097) ; send buffer size
671 | (defconstant INET$C_RCVBUF 4098) ; receive buffer size
672 | (defconstant INET$C_SNDLOWAT 4099) ; send low-water mark
673 | (defconstant INET$C_RCVLOWAT 4100) ; receive low-water mark
674 | (defconstant INET$C_SNDTIMEO 4101) ; send timeout
675 | (defconstant INET$C_RCVTIMEO 4102) ; receive timeout
676 | (defconstant INET$C_ERROR 4103) ; get error status and clear
677 | (defconstant INET$C_TYPE 4104) ; get socket type
678 | (defconstant INET$C_SHARE 4105) ; shared between processes
679 | (defconstant INET$C_CCL 4106) ; carriage control added
680 | (defconstant INET$C_STATE 4107) ; get socket state bits
681 | (defconstant INET$C_FAMILY 4108) ; get socket address family
682 | (defconstant INET$C_XSE 4109) ; _XOPEN_SOURCE_EXTENDED socket
683 | (defconstant INET$M_SNDBUF 4097) ; send buffer size
684 | (defconstant INET$M_RCVBUF 4098) ; receive buffer size
685 | (defconstant INET$M_SNDLOWAT 4099) ; send low-water mark
686 | (defconstant INET$M_RCVLOWAT 4100) ; receive low-water mark
687 | (defconstant INET$M_SNDTIMEO 4101) ; send timeout
688 | (defconstant INET$M_RCVTIMEO 4102) ; receive timeout
689 | (defconstant INET$M_ERROR 4103) ; get error status and clear
690 | (defconstant INET$M_TYPE 4104) ; get socket type
691 | (defconstant INET$M_SHARE 4105) ; shared between processes
692 | (defconstant INET$M_CCL 4106) ; carriage control added
693 | (defconstant INET$M_STATE 4107) ; get socket state bits
694 | (defconstant INET$M_FAMILY 4108) ; get socket address family
695 | (defconstant INET$M_XSE 4109) ; _XOPEN_SOURCE_EXTENDED socket
696 | (defconstant SOCKOPT$C_SO_DEBUG 1) ; turn on event logging, not used
697 | (defconstant SOCKOPT$C_ACCEPTCONN 2) ; socket has had LISTEN
698 | (defconstant SOCKOPT$C_REUSEADDR 4) ; allow local address reuse
699 | (defconstant SOCKOPT$C_KEEPALIVE 8) ; keep connection alive
700 | (defconstant SOCKOPT$C_DONTROUTE 16) ; use only the interface addr
701 | (defconstant SOCKOPT$C_BROADCAST 32) ; allow broadcasting
702 | (defconstant SOCKOPT$C_USELOOPBACK 64) ; loopback interface, not used
703 | (defconstant SOCKOPT$C_LINGER 128) ; linger at close
704 | (defconstant SOCKOPT$C_OOBINLINE 256) ; leave received OOB data in line
705 | (defconstant SOCKOPT$C_FULL_DUPLEX_CLOSE 8192) ; full duplex close
706 | (defconstant SOCKOPT$C_NO_RCV_CHKSUM 16384) ; no receive checksum calculation
707 | (defconstant SOCKOPT$C_NO_SND_CHKSUM 32768) ; no send checksum calculation
708 | (defconstant TCPIP$C_SO_DEBUG 1) ; turn on event logging, not used
709 | (defconstant TCPIP$C_ACCEPTCONN 2) ; socket has had LISTEN
710 | (defconstant TCPIP$C_REUSEADDR 4) ; allow local address reuse
711 | (defconstant TCPIP$C_KEEPALIVE 8) ; keep connection alive
712 | (defconstant TCPIP$C_DONTROUTE 16) ; use only the interface addr
713 | (defconstant TCPIP$C_BROADCAST 32) ; allow broadcasting
714 | (defconstant TCPIP$C_USELOOPBACK 64) ; loopback interface, not used
715 | (defconstant TCPIP$C_LINGER 128) ; linger at close
716 | (defconstant TCPIP$C_OOBINLINE 256) ; leave received OOB data in line
717 | (defconstant TCPIP$C_FULL_DUPLEX_CLOSE 8192) ; full duplex close
718 | (defconstant TCPIP$C_NO_RCV_CHKSUM 16384) ; no receive checksum calculation
719 | (defconstant TCPIP$C_NO_SND_CHKSUM 32768) ; no send checksum calculation
720 | (defconstant INET$C_SO_DEBUG 1) ; turn on event logging, not used
721 | (defconstant INET$C_ACCEPTCONN 2) ; socket has had LISTEN
722 | (defconstant INET$C_REUSEADDR 4) ; allow local address reuse
723 | (defconstant INET$C_KEEPALIVE 8) ; keep connection alive
724 | (defconstant INET$C_DONTROUTE 16) ; use only the interface addr
725 | (defconstant INET$C_BROADCAST 32) ; allow broadcasting
726 | (defconstant INET$C_USELOOPBACK 64) ; loopback interface, not used
727 | (defconstant INET$C_LINGER 128) ; linger at close
728 | (defconstant INET$C_OOBINLINE 256) ; leave received OOB data in line
729 | (defconstant INET$C_FULL_DUPLEX_CLOSE 8192) ; full duplex close
730 | (defconstant INET$C_NO_RCV_CHKSUM 16384) ; no receive checksum calculation
731 | (defconstant INET$C_NO_SND_CHKSUM 32768) ; no send checksum calculation
732 | (defconstant SOCKOPT$C_LENGTH 2)
733 | (defconstant SOCKOPT$K_LENGTH 2)
734 | (defconstant INET$C_LENGTH 2)
735 | (defconstant INET$K_LENGTH 2)
736 |
737 | ;; struct SOCKETOPTDEF {
738 | ;; union { ;
739 | ;; unsigned short int SOCKOPT$W_OPTIONS; ; Socket options, see socket.h
740 | ;; union {
741 | ;; struct {
742 | ;; ;
743 | ;; ; Socket options bits.
744 | ;; ;
745 | ;; unsigned SOCKOPT$V_SO_DEBUG : 1; ; turn on event logging, not used
746 | ;; unsigned SOCKOPT$V_ACCEPTCONN : 1; ; socket has had LISTEN
747 | ;; unsigned SOCKOPT$V_REUSEADDR : 1; ; allow local address reuse
748 | ;; unsigned SOCKOPT$V_KEEPALIVE : 1; ; keep connection alive
749 | ;; unsigned SOCKOPT$V_DONTROUTE : 1; ; use only the interface addr
750 | ;; unsigned SOCKOPT$V_BROADCAST : 1; ; allow broadcasting
751 | ;; unsigned SOCKOPT$V_USELOOPBACK : 1; ; loopback interface, not used
752 | ;; unsigned SOCKOPT$V_LINGER : 1; ; linger at close
753 | ;; unsigned SOCKOPT$V_OOBINLINE : 1; ; leave received OOB data in line
754 | ;; ;
755 | ;; ;
756 | ;; unsigned SOCKOPT$V_DUMMYB_2 : 1; ; reserve space
757 | ;; unsigned SOCKOPT$V_DUMMYB_3 : 1; ; reserve space
758 | ;; unsigned SOCKOPT$V_DUMMYB_4 : 1; ; reserve space
759 | ;; unsigned SOCKOPT$V_DUMMYB_5 : 1; ; reserve space
760 | ;; ;
761 | ;; unsigned SOCKOPT$V_FULL_DUPLEX_CLOSE : 1; ; full duplex close
762 | ;; unsigned SOCKOPT$V_NO_RCV_CHKSUM : 1; ; no receive checksum calculation
763 | ;; unsigned SOCKOPT$V_NO_SND_CHKSUM : 1; ; no send checksum calculation
764 | ;; } SOCKOPT$R_SOCKOPT_OPT_BITS;
765 | ;; struct {
766 | ;; ;
767 | ;; ; Socket options bits.
768 | ;; ;
769 | ;; unsigned TCPIP$V_SO_DEBUG : 1; ; turn on event logging, not used
770 | ;; unsigned TCPIP$V_ACCEPTCONN : 1; ; socket has had LISTEN
771 | ;; unsigned TCPIP$V_REUSEADDR : 1; ; allow local address reuse
772 | ;; unsigned TCPIP$V_KEEPALIVE : 1; ; keep connection alive
773 | ;; unsigned TCPIP$V_DONTROUTE : 1; ; use only the interface addr
774 | ;; unsigned TCPIP$V_BROADCAST : 1; ; allow broadcasting
775 | ;; unsigned TCPIP$V_USELOOPBACK : 1; ; loopback interface, not used
776 | ;; unsigned TCPIP$V_LINGER : 1; ; linger at close
777 | ;; unsigned TCPIP$V_OOBINLINE : 1; ; leave received OOB data in line
778 | ;; ;
779 | ;; ;
780 | ;; unsigned TCPIP$V_DUMMYB_2 : 1; ; reserve space
781 | ;; unsigned TCPIP$V_DUMMYB_3 : 1; ; reserve space
782 | ;; unsigned TCPIP$V_DUMMYB_4 : 1; ; reserve space
783 | ;; unsigned TCPIP$V_DUMMYB_5 : 1; ; reserve space
784 | ;; ;
785 | ;; unsigned TCPIP$V_FULL_DUPLEX_CLOSE : 1; ; full duplex close
786 | ;; unsigned TCPIP$V_NO_RCV_CHKSUM : 1; ; no receive checksum calculation
787 | ;; unsigned TCPIP$V_NO_SND_CHKSUM : 1; ; no send checksum calculation
788 | ;; } SOCKOPT$R_TCPIP_OPT_BITS;
789 | ;; struct {
790 | ;; ;
791 | ;; ; Socket options bits.
792 | ;; ;
793 | ;; unsigned INET$V_SO_DEBUG : 1; ; turn on event logging, not used
794 | ;; unsigned INET$V_ACCEPTCONN : 1; ; socket has had LISTEN
795 | ;; unsigned INET$V_REUSEADDR : 1; ; allow local address reuse
796 | ;; unsigned INET$V_KEEPALIVE : 1; ; keep connection alive
797 | ;; unsigned INET$V_DONTROUTE : 1; ; use only the interface addr
798 | ;; unsigned INET$V_BROADCAST : 1; ; allow broadcasting
799 | ;; unsigned INET$V_USELOOPBACK : 1; ; loopback interface, not used
800 | ;; unsigned INET$V_LINGER : 1; ; linger at close
801 | ;; unsigned INET$V_OOBINLINE : 1; ; leave received OOB data in line
802 | ;; ;
803 | ;; ;
804 | ;; unsigned INET$V_DUMMYB_2 : 1; ; reserve space
805 | ;; unsigned INET$V_DUMMYB_3 : 1; ; reserve space
806 | ;; unsigned INET$V_DUMMYB_4 : 1; ; reserve space
807 | ;; unsigned INET$V_DUMMYB_5 : 1; ; reserve space
808 | ;; ;
809 | ;; unsigned INET$V_FULL_DUPLEX_CLOSE : 1; ; full duplex close
810 | ;; unsigned INET$V_NO_RCV_CHKSUM : 1; ; no receive checksum calculation
811 | ;; unsigned INET$V_NO_SND_CHKSUM : 1; ; no send checksum calculation
812 | ;; } SOCKOPT$R_INET_OPT_BITS;
813 | ;; } SOCKOPT$R_OPTIONS_UNION;
814 | ;; } SOCKOPT$R_OPT_OVRLY;
815 | ;;
816 | ;; ;
817 | ;; ; Additional options, not kept in so_options.
818 | ;; ;
819 | ;; } ;
820 |
821 | (defconstant AF_UNSPEC 0) ; unspecified socket family
822 | (defconstant AF_INET 2) ; INET socket family
823 | (defconstant SA$C_LENGTH 16)
824 | (defconstant SA$K_LENGTH 16)
825 |
826 | ;; struct SOCKADDR {
827 | ;; union {
828 | ;; unsigned short int SA$W_FAMILY; ; address family
829 | ;; struct {
830 | ;; unsigned char SA$B_LEN;
831 | ;; unsigned char SA$B_FAMILY;
832 | ;; } SA$R_SA_STRUCT;
833 | ;; } SA$R_SA_UNION;
834 | ;; char SA$T_DATA [14]; ; up to 14 bytes of address
835 | ;; } ;
836 |
837 | (defconstant SIN$C_LENGTH 16)
838 | (defconstant SIN$K_LENGTH 16)
839 |
840 | ;; typedef struct _SOCKADDRIN {
841 | ;; unsigned short int SIN$W_FAMILY; ; address family
842 | ;; unsigned short int SIN$W_PORT; ; 2 bytes specifying a port
843 | ;; unsigned int SIN$L_ADDR; ; 4 bytes specifying an IP address
844 | ;; char SIN$T_ZERO [8]; ; 8 bytes
845 | ;; } SOCKADDRIN;
846 |
847 | (defconstant SIN44$C_LENGTH 16)
848 | (defconstant SIN44$K_LENGTH 16)
849 |
850 | ;; typedef struct _SOCKADDRIN44 {
851 | ;; unsigned char SIN44$B_LEN;
852 | ;; unsigned char SIN44$B_FAMILY;
853 | ;; unsigned short int SIN44$W_PORT; ; 2 bytes specifying a port
854 | ;; unsigned int SIN44$L_ADDR; ; 4 bytes specifying an IP address
855 | ;; char SIN44$T_ZERO [8]; ; 8 bytes
856 | ;; } SOCKADDRIN44;
857 |
858 | (defconstant SIN6$K_LENGTH 24) ; Structure size
859 | (defconstant SIN6$C_LENGTH 24) ; Structure size
860 |
861 | ;; typedef struct _SOCKADDRIN6 {
862 | ;; unsigned char SIN6$B_LEN; ; length of this struct
863 | ;; unsigned char SIN6$B_FAMILY; ; AF_INET6
864 | ;; unsigned short int SIN6$W_PORT; ; Transport layer port #
865 | ;; unsigned int SIN6$L_FLOWLABEL; ; IPv6 flow information
866 | ;; union {
867 | ;; char SIN6$T_ADDR [16];
868 | ;; unsigned char SIN6$B_SA6_ADDR [16];
869 | ;; unsigned short int SIN6$W_SA6_WADDR [8];
870 | ;; unsigned int SIN6$L_SA6_LADDR [4];
871 | ;; unsigned int SIN6$Q_SA6_QADDR [2] [2];
872 | ;; } SIN6$R_ADDR_OVERLAY;
873 | ;; } SOCKADDRIN6;
874 |
875 | ; Define ACP HOST/NET data base subroutine calls subfunction codes
876 | ;
877 |
878 | (defconstant INETACP$C_ALIASES 1) ; aliases
879 | (defconstant INETACP$C_TRANS 2) ; translate ASCII string in binary
880 | (defconstant INETACP$C_HOSTENT 3) ; get back a HOSTENT
881 | (defconstant INETACP$C_NETENT 4) ; get back a NETENT
882 | (defconstant INETACP$C_HOSTENT_OFFSET 5) ; get back a HOSTENT
883 | (defconstant INETACP$C_NETENT_OFFSET 6) ; get back a NETENT
884 | (defconstant INETACPC$C_ALIASES 1) ; aliases
885 | (defconstant INETACPC$C_TRANS 2) ; translate ASCII string in binary
886 | (defconstant INETACPC$C_HOSTENT 3) ; get back a HOSTENT
887 | (defconstant INETACPC$C_NETENT 4) ; get back a NETENT
888 | (defconstant INETACPC$C_HOSTENT_OFFSET 5) ; get back a HOSTENT
889 | (defconstant INETACPC$C_NETENT_OFFSET 6) ; get back a NETENT
890 |
891 | ; Define ACP control subfunction codes
892 | ;
893 |
894 | (defconstant INETACP_FUNC$C_GETHOSTBYNAME 1) ; Subroutine call of GET_HOST_BY_NAME
895 | (defconstant INETACP_FUNC$C_GETHOSTBYADDR 2) ; Subroutine call of GET_HOST_BY_ADDR
896 | (defconstant INETACP_FUNC$C_GETNETBYNAME 3) ; Subroutine call of GET_NET_BY_NAME
897 | (defconstant INETACP_FUNC$C_GETNETBYADDR 4) ; Subroutine call of GET_NET_BY_ADDR
898 |
899 | (defconstant NET$C_LENGTH 16) ;
900 | (defconstant NET$K_LENGTH 16) ;
901 |
902 | ;; struct NETENTDEF {
903 | ;; int *NET$L_N_NAME; ; pointer to the network name
904 | ;; int *NET$L_N_ALIASES; ; pointer to array of pointers to aliases
905 | ;; unsigned int NET$L_N_ADDRTYPE; ; Network address type
906 | ;; unsigned int NET$L_N_NET; ; Network address
907 | ;; } ;
908 |
909 | ;
910 | ; Structures returned by network
911 | ; data base library. All addresses
912 | ; are supplied in host order, and
913 | ; returned in network order (suitable
914 | ; for use in system calls).
915 | ;
916 |
917 | (defconstant HOST$L_H_ADDR 16)
918 | (defconstant HOST$C_LENGTH 20)
919 | (defconstant HOST$K_LENGTH 20)
920 |
921 | ;; struct HOSTENTDEF {
922 | ;; int *HOST$L_H_NAME; ; pointer to the host name
923 | ;; int *HOST$L_H_ALIASES; ; pointer to array of pointers to aliases
924 | ;; unsigned int HOST$L_H_ADDRTYPE; ; Host address type
925 | ;; unsigned int HOST$L_H_LENGTH; ; Length of address
926 | ;; int *HOST$L_H_ADDR_LIST; ; Pointer to array of pointers to addresses
927 | ;; } ;
928 |
--------------------------------------------------------------------------------
/sys/rmsdef.lsp:
--------------------------------------------------------------------------------
1 | (in-package :rasselbock)
2 |
3 | ; ********************************************************************************************************************************
4 | ; Created 1-NOV-1989 13:46:32 by VAX SDL V3.1-7 Source: 1-NOV-1989 13:38:02 LISPW$1:[FOSTER.SDL.FILES]RMSDEF.SDI;2
5 | ; ********************************************************************************************************************************
6 | ;;;(proclaim '(optimize (speed 3) (safety 0)))
7 |
8 | ;;;*** MODULE $RMSDEF ***
9 |
10 | ;;;
11 | ;;; This SDL File Generated by VAX-11 Message V04-00 on 10-MAY-1989 13:39:20.38
12 | ;;;
13 | ;;; .TITLE RMSDEF -RMS COMPLETION CODES
14 | ;;;****************************************************************************
15 | ;;;* *
16 | ;;;* COPYRIGHT (C) 1978, 1980, 1982, 1984 BY *
17 | ;;;* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. *
18 | ;;;* ALL RIGHTS RESERVED. *
19 | ;;;* *
20 | ;;;* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED *
21 | ;;;* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE *
22 | ;;;* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER *
23 | ;;;* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY *
24 | ;;;* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY *
25 | ;;;* TRANSFERRED. *
26 | ;;;* *
27 | ;;;* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE *
28 | ;;;* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT *
29 | ;;;* CORPORATION. *
30 | ;;;* *
31 | ;;;* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS *
32 | ;;;* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. *
33 | ;;;* *
34 | ;;;* *
35 | ;;;****************************************************************************
36 | ;;;++
37 | ;;; FACILITY: RMS
38 | ;;;
39 | ;;; ABSTRACT:
40 | ;;;
41 | ;;; THIS MODULE DEFINES ALL RMS COMPLETION CODES.
42 | ;;;
43 | ;;; ENVIRONMENT:
44 | ;;;
45 | ;;; THE MESSAGE TRANSLATOR MUST BE USED TO CONVERT RMSDEF.MSG INTO
46 | ;;; RMSDEF.SDL. THE SDL TRANSLATOR MUST THEN BE USED TO CONVERT
47 | ;;; RMSDEF.SDL INTO RMSDEF.MAR (AND RMSDEF.B32).
48 | ;;;
49 | ;;; AUTHOR: LEO F. LAVERDURE, CREATION DATE: 10-DEC-1976
50 | ;;;
51 | ;;; MODIFIED BY:
52 | ;;;
53 | ;;; X-30 LSS0080 LEONARD S. SZUBOWICZ 06-OCT-1988
54 | ;;; ADD RMS$_OK_ACT MESSAGE FOR USE BY FUTURE WORK TO $DISPLAY.
55 | ;;; THIS IS PART OF LATENT SUPPORT FOR RMS/DDTM.
56 | ;;;
57 | ;;; X-29 GJA0080 GARY J. ALLISON 06-JUN-1988
58 | ;;; CHANGE TEXT OF SEMANTICS MESSAGE.
59 | ;;;
60 | ;;; X-28 GJA0072 GARY J. ALLISON 02-MAR-1988
61 | ;;; ADD EXT_ERR, OPNOTSUP, EXTNOTFOU, AND SEMANTICS MESSAGES.
62 | ;;;
63 | ;;; X-27 PMV0072 PETER M. VATNE 08-OCT-1987
64 | ;;; CHANGE RMS$_NOJNLLIC TO RMS$_JNLNOTAUTH.
65 | ;;;
66 | ;;; X-26 LSS0057 LEONARD S. SZUBOWICZ 15-SEP-1987
67 | ;;; CHANGE TEXT FOR THE RMS$_OK_DUP STATUS SUCH THAT THE MESSAGE
68 | ;;; IS APPLICABLE TO $GET AS WELL AS $PUT.
69 | ;;;
70 | ;;; X-25 PMV0068 PETER M. VATNE 11-SEP-1987
71 | ;;; ADD RMS$_NOJNLLIC, NO RMS JOURNALING LICENSE, FOR LMF.
72 | ;;;
73 | ;;; X-24 RNM0026 RUSSELL N. MURRAY 15-AUG-1987
74 | ;;; ADD RMS$_SYNCH MESSAGE FOR NOTIFICATION OF SYNCHRONOUS
75 | ;;; COMPLETION.
76 | ;;;
77 | ;;; X-23 JEJ0479 JAMES E JOHNSON 13-AUG-1987
78 | ;;; ADD RMS$_IVATRACE MESSAGE.
79 | ;;;
80 | ;;; X-22 PMV0061 PETER M. VATNE 03-AUG-1987
81 | ;;; CHANGE RESERVED MESSAGE RMS$_BUG_XX5 TO RMS$_BUG_RU_COMMIT_FAIL
82 | ;;; TO CORRESPOND TO POSITIVE RMS BUGCHECK FTL$_RU_COMMIT_FAIL.
83 | ;;;
84 | ;;; X-21 LSS0042 LEONARD S. SZUBOWICZ 13-MAY-1987
85 | ;;; CHANGE RESERVED MESSAGE RMS$_BUG_XX4 TO RMS$_BUG_RU_ABORT_FAIL
86 | ;;; TO CORRESPOND TO POSITIVE RMS BUGCHECK FTL$_RU_ABORT_FAIL
87 | ;;;
88 | ;;; X-20 SAD0034 STUART A. DAVIDSON 12-MAR-1987
89 | ;;; DROP QUOTES FROM SNADTF MESSAGE TEXT.
90 | ;;;
91 | ;;; X-19 PJH PAUL J. HOULIHAN 19-JAN-1987
92 | ;;; MERGE IN 17J1.
93 | ;;;
94 | ;;; X-17J1 PJH PAUL J. HOULIHAN 15-JAN-1987
95 | ;;; FIX SEVERAL SMALL JNL PROBLEMS.
96 | ;;; ADD RMS$_BUG_FLUSH_JNL_FAILED CODE.
97 | ;;;
98 | ;;; X-18 KPS0148 KENNETH P. SIEGEL 04-DEC-1986
99 | ;;; ADDED SNPPF (STATISTICS MONITORING NOT SUPPORTED FOR
100 | ;;; PROCESS PERMANENT FILES) ERROR MESSAGE.
101 | ;;;
102 | ;;; X-17 PMV0025 PETER M. VATNE 24-NOV-1986
103 | ;;; ADD NEW MESSAGE, RMS$_NOTSAMEJNL. THIS STATUS IS
104 | ;;; USED TO RESTRICT AI/BI WITH RU JOURNALING TO A
105 | ;;; SINGLE LONG-TERM JOURNAL FILE.
106 | ;;;
107 | ;;; X-16 DAS DAVID A. SOLOMON 18-NOV-1986
108 | ;;; ADD NEW MESSAGE, RMS$_DELJNS. REMOVE RMS$_XCR (BY REPLACING IT
109 | ;;; WITH A PLACEHOLDER), AS JOURNALING BITS ARE NO LONGER
110 | ;;; SPECIFIED IN THE $XABJNL. SLIGHT WORDING CHANGE ON DETACHED
111 | ;;; RU RECOVERY ERROR MESSAGES.
112 | ;;;
113 | ;;; X-15 DAS DAVID A. SOLOMON 12-NOV-1986
114 | ;;; FIX ERROR IN X-5/X-6: JOURNALING VARIANT NOT MERGED
115 | ;;; CORRECTLY, RESULTING IN SEVERAL JOURNALING MESSAGES NUMBERS
116 | ;;; BEING DIFFERENT IN THE MAININE THAN WHAT THEY WERE ON THE
117 | ;;; JOURNALING VARIANT. ALSO, MOVE NEW SNADTF MESSAGES TO RE-USE
118 | ;;; AVAILABLE UNUSED MESSAGE NUMBERS, INSTEAD OF GENERATING NEW
119 | ;;; ONES. FINALLY, CHANGE RMS$_BUG_ABORT TO RMS$_BUG_RU_ACTIVE.
120 | ;;;
121 | ;;; X-14 SAD0014 STUART A. DAVIDSON 4-NOV-1986
122 | ;;; SNADTF - FIX TYPO IN DTFACC, DTFCRE
123 | ;;;
124 | ;;; X-13 SAD0014 STUART A. DAVIDSON 3-NOV-1986
125 | ;;; SNADTF - FIX TYPO, ADD 2 ADDITIONAL MESSAGES.
126 | ;;;
127 | ;;; X-12 JEJ0377 JAMES E JOHNSON 29-OCT-1986
128 | ;;; ADD NOEXTEND ERROR CODE TO FLAG FAILED RELATIVE FILE
129 | ;;; EXTENDS DUE TO PREVIOUS FAILURES.
130 | ;;;
131 | ;;; X-11 KPS0131 KENNETH P. SIEGEL 25-OCT-1986
132 | ;;; ADDED SNS ERROR CODE FOR STATISTICS NOT SUPPORT ON
133 | ;;; NON-DISK DEVICES.
134 | ;;;
135 | ;;; X-10 SAD009 STUART A. DAVIDSON 06-OCT-1986
136 | ;;; ADD COMPLETION CODES FOR SNADTF (IBM DATA XFER)
137 | ;;;
138 | ;;; X-9 GJA0003 GARY J. ALLISON 29-SEP-1986
139 | ;;; ADD DETACHED RECOVERY ERROR MESSAGES
140 | ;;;
141 | ;;; X-8 PMV0008 PETER M. VATNE 24-SEP-1986
142 | ;;; MODIFY RMS$_ACC_AIJ, RMS$_ACC_BIJ, AND RMS$_ACC_ATJ
143 | ;;; TO ALSO OUTPUT THE STV.
144 | ;;;
145 | ;;; X-7 JWT0243 JIM TEAGUE 2-SEP-1986
146 | ;;; ADD NEW ERRORS FOR COLLATED KEYS.
147 | ;;;
148 | ;;; X-6 GJA GARY J. ALLISON 29-JUL-1986
149 | ;;; REMOVE DUPS FROM JNL MERGE.
150 | ;;;
151 | ;;; X-5 GJA GARY J. ALLISON 29-JUL-1986
152 | ;;; MERGE JOURNALING INTO MAINLINE
153 | ;;;
154 | ;;; X-3J6 DAS DAVID A. SOLOMON 14-APR-1986
155 | ;;; REMOVE RMS$_RUH_FILE (USING A GENERAL RUF MESSAGE INSTEAD).
156 | ;;; CHANGE RMS$_RUH TEXT TO NOT HAVE FAO PARAMETERS. ADD
157 | ;;; RMS$_BUG_RURECERR.
158 | ;;;
159 | ;;; X-3J5 JEJ0302 JAMES E JOHNSON 4-APR-1986
160 | ;;; ADD RMS$_RRF (ERROR DURING RU RECOVERY) AND
161 | ;;; RMS$_RUH/RMS$_RUH_FILE (USED TO FORM TEXT OF RU HANDLER ERRORS
162 | ;;; SENT TO OPCOM).
163 | ;;;
164 | ;;; X-3J4 JEJ0272 JAMES E JOHNSON 11-FEB-1986
165 | ;;; ADD RMS$_RUF, RMS$_BUG_ABORT CODES.
166 | ;;;
167 | ;;; X-3J3 JEJ0237 JAMES E JOHNSON 16-DEC-1985
168 | ;;; ADD RMS$_RUNDOWN CODE
169 | ;;;
170 | ;;; X-3J2 JEJ0205 JAMES E JOHNSON 25-OCT-1985
171 | ;;; ADD JOURNAL SPECIFIC WRTJNL_XXJ ERROR CODES TO REPLACE
172 | ;;; THE GENERIC ERRWRTJNL CODE.
173 | ;;;
174 | ;;; X-4 JEJ0216 JAMES E JOHNSON 18-NOV-1985
175 | ;;; MERGE X-3J2 INTO MAIN LINE FOR V4.4.
176 | ;;;
177 | ;;; X-3J2 JEJ0205 JAMES E JOHNSON 25-OCT-1985
178 | ;;; ADD JOURNAL SPECIFIC WRTJNL_XXJ ERROR CODES TO REPLACE
179 | ;;; THE GENERIC ERRWRTJNL CODE.
180 | ;;;
181 | ;;; X-3 JEJ0161 JAMES E JOHNSON 9-SEP-1985
182 | ;;; UPDATE RMS JOURNALING MESSAGES.
183 | ;;;
184 | ;;; X-2 JWT0212 JIM TEAGUE 4-SEP-1985
185 | ;;; ADD (WHAT IS FOR NOW) AN INTERNAL STATUS CODE TO
186 | ;;; DIFFERENTIATE BETWEEN FINDING A DELETED RECORD (DEL)
187 | ;;; AND FINDING IT BUT WITH A DIFFERENT KEY (KEY_MISMATCH).
188 | ;;;
189 | ;;; V03-024 RAS0314 RON SCHAEFER 21-JUN-1984
190 | ;;; WORK OVER THE MESSAGES ONE MORE TIME: FIX TYPO IN OK_RNF,
191 | ;;; DELETE ACPEOF ERROR, DELETE WSF ERROR.
192 | ;;;
193 | ;;; V03-023 RAS0282 RON SCHAEFER 28-MAR-1984
194 | ;;; MINOR TEXT CHANGES AND COMMENTS ADDED.
195 | ;;; DELETE RMS$_COP ERROR.
196 | ;;;
197 | ;;; V03-022 DAS0005 DAVID SOLOMON 19-MAR-1984
198 | ;;; REMOVE RMS$_ECHO (NO LONGER NEEDED AS A RESULT OF NEW
199 | ;;; IMPLEMENTATION FOR ECHO SYS$INPUT -> SYS$OUTPUT).
200 | ;;;
201 | ;;; V03-021 JWT0150 JIM TEAGUE 01-FEB-1984
202 | ;;; ADD RMS$_IFF FOR TRYING TO WRITE-ACCESS A FILE ON
203 | ;;; MAGTAPE THAT HAS NON-0 VALUE FOR ANSI BUFFER OFFSET.
204 | ;;;
205 | ;;; V03-020 RAS0233 RON SCHAEFER 9-JAN-1984
206 | ;;; ADD RMS$_NOVALPRS ERROR FOR $SEARCH NOT PRECEDED BY
207 | ;;; VALID $PARSE.
208 | ;;;
209 | ;;; V03-019 JWT0148 JIM TEAGUE 20-DEC-1983
210 | ;;; ADD A JNL XAB ERROR FOR CONFLICTING RU ATTRIBUTES
211 | ;;; ON $CREATE: RMS$_XCR.
212 | ;;;
213 | ;;; V03-018 RAS0171 RON SCHAEFER 28-JUL-1983
214 | ;;; ADD RMS$_BUSY; A STRUCTURE-LESS ERROR (R0-ONLY STATUS)
215 | ;;; REPLACING TEMP3.
216 | ;;;
217 | ;;; V03-017 DAS0004 DAVID SOLOMON 28-JUN-1983
218 | ;;; ADD RMS$_FILEPURGED; ADD RMS$_ACPEOF FOR ZALEWSKI.
219 | ;;;
220 | ;;; V03-016 KPL0007 PETER LIEBERWIRTH 8-JUN-1983
221 | ;;; FIX SPELLING IN JNL ERROR MESSAGES, ADD CJF ERROR WHICH
222 | ;;; WILL SOON SUBSUME COP AND CQE.
223 | ;;;
224 | ;;; V03-015 DAS0003 DAVID SOLOMON 18-FEB-1983
225 | ;;; ADD XNF (REPLACING TEMP9), TMR (NEW), LWC (NEW).
226 | ;;;
227 | ;;; V03-014 KBT0497 KEITH B. THOMPSON 18-FEB-1983
228 | ;;; ADD INCOMPSHR ERROR (REUSE OF TEMP1 SLOT)
229 | ;;;
230 | ;;; V03-013 RAS0120 RON SCHAEFER 2-FEB-1983
231 | ;;; ADD ECHO PSEUDO-STATUS TO SUPPORT ECHO OF SYS$INPUT
232 | ;;; TO SYS$OUTPUT.
233 | ;;;
234 | ;;; V03-012 JWH0174 JEFFRY W. HORN 24-JAN-1983
235 | ;;; ADD CQE AND COP ERRORS.
236 | ;;;
237 | ;;; V03-011 KPL0006 PETER LIEBERWIRTH 7-JAN-1983
238 | ;;; ADD OK_RULK FOR RECOVERY UNIT SUPPORT.
239 | ;;;
240 | ;;; ADD REENT ERROR FOR $RENAME.
241 | ;;;
242 | ;;; V03-009 JWH0153 JEFFREY W. HORN 8-DEC-1982
243 | ;;; ADD NRU ERROR.
244 | ;;;
245 | ;;; V03-008 JWH0152 JEFFREY W. HORN 8-DEC-1982
246 | ;;; ADD JNS ERROR.
247 | ;;;
248 | ;;; V03-007 MCN0002 MARIA DEL C. NASR 15-NOV-1982
249 | ;;; REPLACE ORD ERROR CODE ELIMINATED BY MCN0001, SINCE
250 | ;;; THE NETWORK CODE REFERENCES IT.
251 | ;;;
252 | ;;; V03-006 MCN0001 MARIA DEL C. NASR 26-OCT-1982
253 | ;;; PRINT KEY OF REFERENCE OR AREA IDENTIFICATION NUMBER
254 | ;;; INSTEAD OF XAB ADDRESS FOR ERRORS RETURNED DURING
255 | ;;; INDEXED FILE CREATION. ALSO RENAME ALL UNUSED ERROR
256 | ;;; CODES TO TEMP.
257 | ;;;
258 | ;;; V03-005 JWH0102 JEFFREY W. HORN 24-SEP-1982
259 | ;;; ADD RUP ERROR.
260 | ;;;
261 | ;;; V03-004 RAS0095 RON SCHAEFER 7-SEP-1982
262 | ;;; ADD OVRDSKQUOTA ERROR.
263 | ;;;
264 | ;;; V03-002 JWH0002 JEFFREY W. HORN 26-JUL-1982
265 | ;;; CONVERT TO .MSG FORMAT. ADD RUM ERROR.
266 | ;;;
267 | ;;; V03-001 JWH0001 JEFFREY W. HORN 20-JUL-1982
268 | ;;; ADD JNF, JOP, AND NOJ ERRORS.
269 | ;;;
270 | ;;; V02-042 KPL0005 PETER LIEBERWIRTH 4-FEB-1982
271 | ;;; ADD ERROR MESSAGES RMS$_EXENQLM AND RMS$_DEADLOCK
272 | ;;; CORRECTLY.
273 | ;;;
274 | ;;; V02-041 CDS0001 C D SAETHER 24-JAN-1982
275 | ;;; ADD GBC AND CRMP ERRORS.
276 | ;;;
277 | ;;; V02-040 JAK0069 J A KRYCKA 15-JAN-1982
278 | ;;; ADD SUPPORT AND NETFAIL ERROR CODES.
279 | ;;;
280 | ;;; V02-039 JAK0068 J A KRYCKA 31-DEC-1981
281 | ;;; MODIFY TEXT FOR SUP, NET, BUG_DAP, AND ENV ERROR MESSAGES.
282 | ;;;
283 | ;;; V02-038 LJA0001 LAURIE ANDERSON 20-DEC-1981
284 | ;;; MODIFIED SOME MESSAGES TO READ BETTER.
285 | ;;;
286 | ;;; V02-037 JAK0063 J A KRYCKA 31-AUG-1981
287 | ;;; ADD CRE_STM SUCCESS CODE.
288 | ;;;
289 | ;;; V02-036 KPL0004 PETER LIEBERWIRTH 13-JAN-1981
290 | ;;; ADD ENQ SEVERE ERROR MESSAGE, TO INDICATE $ENQ/$DEQ FAILURE.
291 | ;;; ALSO ADD SUCCESS CODES OK_RRL, AND OK_WAT.
292 | ;;;
293 | ;;; V02-035 REFORMAT J A KRYCKA 30-JUL-1980
294 | ;;;
295 | ;;;--
296 | (defconstant RMS$_FACILITY 1)
297 | (defconstant RMS$V_STVSTATUS 14) ; MOVE TO BIT 14 OF THE
298 | ;;; STATUS CODE IT INDICATES
299 | ;;; THAT STV CONTAINS A SECONDARY
300 | ;;; STATUS CODE.
301 | (defconstant RMS$_SUC 65537)
302 | (defconstant RMS$_NORMAL 65537)
303 | ;;;+
304 | ;;;
305 | ;;; SUCCESS CODES
306 | ;;;
307 | ;;;-
308 | ;;; BIT 16 = BIT 15 = 1
309 | (defconstant RMS$_STALL 98305)
310 | ;;; (NOTE: USER NEVER RECEIVES THIS CODE)
311 | (defconstant RMS$_PENDING 98313)
312 | (defconstant RMS$_OK_DUP 98321)
313 | (defconstant RMS$_OK_IDX 98329)
314 | ;;; (RECORD HAS BEEN INSERTED, BUT INDEX STRUCTURE IS NO LONGER
315 | ;;; OPTIMAL.)
316 | (defconstant RMS$_OK_RLK 98337)
317 | ;;; (BECAUSE LOCKER SET RLK IN ROP FIELD WHEN RECORD WAS LOCKED.)
318 | (defconstant RMS$_OK_RRL 98345)
319 | ;;; (BECAUSE READER SET RRL IN ROP FIELD WHEN ACCESSING RECORD.)
320 | ;;; (THIS CODE USED TO BE OK_RRV)
321 | ;;;OK_RRV ;MSG
322 | ;;; (BUT IT MAY NOT BE ACCESSIBLE VIA ONE-OR-MORE SECONDARY KEYS,
323 | ;;; AND NOT BY RFA ADDRESSING. FILE RE-ORGANIZATION RECOMMENDED!)
324 | (defconstant RMS$_KFF 98353)
325 | (defconstant RMS$_OK_ALK 98361)
326 | (defconstant RMS$_OK_DEL 98369)
327 | (defconstant RMS$_OK_RNF 98377)
328 | (defconstant RMS$_OK_LIM 98385)
329 | (defconstant RMS$_OK_NOP 98393)
330 | (defconstant RMS$_OK_WAT 98401)
331 | ;;; (BECAUSE WAT BIT IN ROP WAS SET AND RECORD WAS ALREADY
332 | ;;; LOCKED.)
333 | (defconstant RMS$_CRE_STM 98409)
334 | (defconstant RMS$_OK_RULK 98417)
335 | (defconstant RMS$_SYNCH 98425)
336 | (defconstant RMS$_OK_ACT 98433)
337 | ;;;+
338 | ;;;
339 | ;;; SUCCESS CODES PASSED THRU FROM DRIVERS AND ACP - BIT 15 = 0
340 | ;;;
341 | ;;;-
342 | (defconstant RMS$_CONTROLC 67153) ; TERMINAL I/O ABORTED DUE TO CTRL/C
343 | (defconstant RMS$_CONTROLO 67081)
344 | ;;; TERMINAL I/O ABORTED DUE TO CTRL/O
345 | (defconstant RMS$_CONTROLY 67089)
346 | ;;; TERMINAL I/O ABORTED DUE TO CTRL/Y
347 | (defconstant RMS$_CREATED 67097)
348 | ;;; FILE WAS CREATED, NOT OPENED
349 | (defconstant RMS$_SUPERSEDE 67121)
350 | ;;; CREATED FILE SUPERSEDED EXISTING VERSION
351 | (defconstant RMS$_OVRDSKQUOTA 67177)
352 | ;;; DISK USAGE EXCEEDS DISK QUOTA
353 | (defconstant RMS$_FILEPURGED 67193)
354 | ;;; CREATE FILE CAUSED OLDEST FILE
355 | ;;; VERSION TO BE PURGED
356 | ;;;+
357 | ;;;
358 | ;;; WARNING CODES
359 | ;;;
360 | ;;;-
361 | ;;; BIT 16 = BIT 15 = 1, BIT 14 = 0
362 | (defconstant RMS$_BOF 98712)
363 | (defconstant RMS$_RNL 98720)
364 | (defconstant RMS$_RTB 98728)
365 | (defconstant RMS$_TMO 98736)
366 | (defconstant RMS$_TNS 98744)
367 | (defconstant RMS$_BES 98752)
368 | (defconstant RMS$_PES 98760)
369 | ;;;+
370 | ;;;
371 | ;;; ERROR CODES - WITHOUT STV
372 | ;;;
373 | ;;;-
374 | ;;; BIT 16 = BIT 15 = 1, BIT 14 = 0
375 | (defconstant RMS$_ACT 98906)
376 | (defconstant RMS$_DEL 98914)
377 | (defconstant RMS$_INCOMPSHR 98922)
378 | (defconstant RMS$_DNR 98930)
379 | (defconstant RMS$_EOF 98938)
380 | (defconstant RMS$_FEX 98946)
381 | (defconstant RMS$_FLK 98954)
382 | (defconstant RMS$_FNF 98962)
383 | (defconstant RMS$_PRV 98970)
384 | (defconstant RMS$_REX 98978)
385 | (defconstant RMS$_RLK 98986)
386 | (defconstant RMS$_RNF 98994)
387 | ;;; (RECORD NEVER WAS IN FILE, OR HAS BEEN DELETED.)
388 | (defconstant RMS$_WLK 99002)
389 | (defconstant RMS$_EXP 99010)
390 | (defconstant RMS$_NMF 99018)
391 | (defconstant RMS$_SUP 99026)
392 | ;;; (NOTE THAT SUPPORT HAS REPLACED SUP EXCEPT WHEN RMS CANNOT
393 | ;;; MAP THE DAP STATUS CODE INTO A FAL STATUS CODE.)
394 | ;;; (NOTE ALSO THAT SUP SHOULD HAVE BEEN DEFINED AS A SEVERE
395 | ;;; ERROR CODE. HOWEVER, SUPPORT IS A SEVERE ERROR CODE.)
396 | (defconstant RMS$_RSA 99034)
397 | (defconstant RMS$_CRC 99042)
398 | (defconstant RMS$_WCC 99050)
399 | (defconstant RMS$_IDR 99058)
400 | (defconstant RMS$_LWC 99066)
401 | (defconstant RMS$_UNUSED1 99074)
402 | (defconstant RMS$_NOVALPRS 99082)
403 | (defconstant RMS$_KEY_MISMATCH 99090)
404 | (defconstant RMS$_RUH 99098)
405 | (defconstant RMS$_JND 99106)
406 | (defconstant RMS$_BADPHASE 99114)
407 | (defconstant RMS$_TOWDR 99122)
408 | (defconstant RMS$_NEXDR 99130)
409 | (defconstant RMS$_INVDRMSG 99138)
410 | (defconstant RMS$_RU_ACTIVE 99146)
411 | (defconstant RMS$_UNKRUFAC 99154)
412 | (defconstant RMS$_LIMBO 99162)
413 | (defconstant RMS$_IVATRACE 99170)
414 | (defconstant RMS$_OPNOTSUP 99178)
415 | (defconstant RMS$_EXTNOTFOU 99186)
416 | (defconstant RMS$_EXT_ERR 99194)
417 | (defconstant RMS$_SEMANTICS 99202)
418 | ;;;+
419 | ;;;
420 | ;;; ERROR CODES - WITH STV ERROR CODE
421 | ;;;
422 | ;;;-
423 | ;;; BIT 16 = BIT 15 = BIT 14 = 1
424 | (defconstant RMS$_ACC 114690)
425 | (defconstant RMS$_CRE 114698)
426 | (defconstant RMS$_DAC 114706)
427 | (defconstant RMS$_ENT 114714)
428 | (defconstant RMS$_EXT 114722)
429 | (defconstant RMS$_FND 114730)
430 | (defconstant RMS$_MKD 114738)
431 | (defconstant RMS$_DPE 114746)
432 | (defconstant RMS$_SPL 114754)
433 | (defconstant RMS$_DNF 114762)
434 | (defconstant RMS$_RUF 114770)
435 | (defconstant RMS$_WRTJNL_AIJ 114778)
436 | (defconstant RMS$_WRTJNL_BIJ 114786)
437 | (defconstant RMS$_WRTJNL_ATJ 114794)
438 | (defconstant RMS$_WRTJNL_RUJ 114802)
439 | (defconstant RMS$_RRF 114810)
440 | ;;;+
441 | ;;;
442 | ;;; SEVERE ERROR CODES - WITHOUT STV
443 | ;;;
444 | ;;;-
445 | ;;; BIT 16 = BIT 15 = 1, BIT 14 = 0
446 | (defconstant RMS$_DTFCDDREC 99308)
447 | (defconstant RMS$_AID 99316)
448 | (defconstant RMS$_ALN 99324)
449 | (defconstant RMS$_ALQ 99332)
450 | (defconstant RMS$_ANI 99340)
451 | (defconstant RMS$_AOP 99348)
452 | (defconstant RMS$_BKS 99356)
453 | (defconstant RMS$_BKZ 99364)
454 | (defconstant RMS$_BLN 99372)
455 | (defconstant RMS$_BUG 99380)
456 | (defconstant RMS$_BUG_DDI 99388)
457 | (defconstant RMS$_BUG_DAP 99396)
458 | (defconstant RMS$_BUG_RU_ACTIVE 99404)
459 | (defconstant RMS$_BUG_RURECERR 99412)
460 | (defconstant RMS$_BUG_FLUSH_JNL_FAILED 99420)
461 | (defconstant RMS$_BUG_RU_ABORT_FAIL 99428)
462 | (defconstant RMS$_BUG_RU_COMMIT_FAIL 99436)
463 | (defconstant RMS$_BUG_XX6 99444)
464 | (defconstant RMS$_BUG_XX7 99452)
465 | (defconstant RMS$_BUG_XX8 99460)
466 | (defconstant RMS$_BUSY 99468)
467 | (defconstant RMS$_CCR 99476)
468 | (defconstant RMS$_CHG 99484)
469 | (defconstant RMS$_CHK 99492)
470 | (defconstant RMS$_COD 99500)
471 | (defconstant RMS$_CUR 99508)
472 | (defconstant RMS$_DAN 99516)
473 | (defconstant RMS$_DEV 99524)
474 | (defconstant RMS$_DIR 99532)
475 | (defconstant RMS$_DME 99540)
476 | (defconstant RMS$_DNA 99548)
477 | (defconstant RMS$_DTP 99556)
478 | (defconstant RMS$_DUP 99564)
479 | (defconstant RMS$_DVI 99572)
480 | (defconstant RMS$_ESA 99580)
481 | (defconstant RMS$_ESS 99588)
482 | (defconstant RMS$_FAB 99596)
483 | (defconstant RMS$_FAC 99604)
484 | (defconstant RMS$_FLG 99612)
485 | (defconstant RMS$_FNA 99620)
486 | (defconstant RMS$_FNM 99628)
487 | (defconstant RMS$_FSZ 99636)
488 | (defconstant RMS$_FOP 99644)
489 | (defconstant RMS$_FUL 99652)
490 | (defconstant RMS$_IAL 99660)
491 | (defconstant RMS$_IAN 99668)
492 | (defconstant RMS$_IDX 99676)
493 | (defconstant RMS$_IFI 99684)
494 | (defconstant RMS$_IMX 99692)
495 | (defconstant RMS$_IOP 99700)
496 | (defconstant RMS$_IRC 99708)
497 | (defconstant RMS$_ISI 99716)
498 | (defconstant RMS$_KBF 99724)
499 | (defconstant RMS$_KEY 99732)
500 | (defconstant RMS$_KRF 99740)
501 | (defconstant RMS$_KSZ 99748)
502 | (defconstant RMS$_LAN 99756)
503 | (defconstant RMS$_RUNDOWN 99764)
504 | (defconstant RMS$_LNE 99772)
505 | (defconstant RMS$_DTFCVT 99780)
506 | (defconstant RMS$_MRN 99788)
507 | (defconstant RMS$_MRS 99796)
508 | (defconstant RMS$_NAM 99804)
509 | (defconstant RMS$_NEF 99812)
510 | (defconstant RMS$_DTFQUASYN 99820)
511 | (defconstant RMS$_NOD 99828)
512 | (defconstant RMS$_NPK 99836)
513 | (defconstant RMS$_ORD 99844) ; ! NOT USED AS OF V4
514 | (defconstant RMS$_ORG 99852)
515 | (defconstant RMS$_PBF 99860)
516 | (defconstant RMS$_PLG 99868)
517 | (defconstant RMS$_POS 99876)
518 | (defconstant RMS$_DTFQUAVAL 99884)
519 | (defconstant RMS$_QUO 99892)
520 | (defconstant RMS$_RAB 99900)
521 | (defconstant RMS$_RAC 99908)
522 | (defconstant RMS$_RAT 99916)
523 | (defconstant RMS$_RBF 99924)
524 | (defconstant RMS$_RFA 99932)
525 | (defconstant RMS$_RFM 99940)
526 | (defconstant RMS$_RHB 99948)
527 | (defconstant RMS$_RLF 99956)
528 | (defconstant RMS$_ROP 99964)
529 | (defconstant RMS$_RRV 99972)
530 | (defconstant RMS$_RVU 99980)
531 | (defconstant RMS$_RSS 99988)
532 | (defconstant RMS$_RST 99996)
533 | (defconstant RMS$_RSZ 100004)
534 | (defconstant RMS$_SEQ 100012)
535 | (defconstant RMS$_SHR 100020)
536 | (defconstant RMS$_SIZ 100028)
537 | (defconstant RMS$_SQO 100036)
538 | (defconstant RMS$_DTFSESEST 100044)
539 | (defconstant RMS$_SYN 100052)
540 | (defconstant RMS$_TRE 100060)
541 | (defconstant RMS$_TYP 100068)
542 | (defconstant RMS$_UBF 100076)
543 | (defconstant RMS$_USZ 100084)
544 | (defconstant RMS$_VER 100092)
545 | (defconstant RMS$_XNF 100100)
546 | (defconstant RMS$_XAB 100108)
547 | (defconstant RMS$_ESL 100116)
548 | (defconstant RMS$_DTFSESTER 100124)
549 | (defconstant RMS$_ENV 100132)
550 | (defconstant RMS$_PLV 100140)
551 | (defconstant RMS$_MBC 100148)
552 | (defconstant RMS$_RSL 100156)
553 | (defconstant RMS$_WLD 100164)
554 | (defconstant RMS$_NET 100172) ; (NOTE THAT NETFAIL HAS REPLACED NET EXCEPT WHEN RMS CANNOT
555 | ;;; MAP THE DAP STATUS CODE INTO A FAL STATUS CODE.)
556 | (defconstant RMS$_IBF 100180)
557 | (defconstant RMS$_REF 100188)
558 | (defconstant RMS$_IFL 100196)
559 | (defconstant RMS$_DFL 100204)
560 | (defconstant RMS$_KNM 100212)
561 | (defconstant RMS$_IBK 100220)
562 | (defconstant RMS$_KSI 100228)
563 | (defconstant RMS$_LEX 100236)
564 | (defconstant RMS$_SEG 100244)
565 | (defconstant RMS$_SNE 100252) ; ! NOT USED AS OF V4
566 | (defconstant RMS$_SPE 100260) ; ! NOT USED AS OF V4
567 | (defconstant RMS$_UPI 100268)
568 | (defconstant RMS$_ACS 100276)
569 | (defconstant RMS$_STR 100284)
570 | (defconstant RMS$_FTM 100292)
571 | (defconstant RMS$_GBC 100300)
572 | (defconstant RMS$_DEADLOCK 100308)
573 | (defconstant RMS$_EXENQLM 100316)
574 | (defconstant RMS$_JOP 100324)
575 | (defconstant RMS$_RUM 100332)
576 | (defconstant RMS$_JNS 100340)
577 | (defconstant RMS$_NRU 100348)
578 | (defconstant RMS$_IFF 100356)
579 | (defconstant RMS$_DTFTRATBL 100364)
580 | (defconstant RMS$_DTFUNSTYP 100372)
581 | (defconstant RMS$_DTFVERMIS 100380)
582 | (defconstant RMS$_DTFACC 100388)
583 | (defconstant RMS$_BOGUSCOL 100396)
584 | (defconstant RMS$_ERRREADCOL 100404)
585 | (defconstant RMS$_ERRWRITECOL 100412)
586 | (defconstant RMS$_SNS 100420)
587 | (defconstant RMS$_NOEXTEND 100428)
588 | (defconstant RMS$_DTFCRE 100436)
589 | (defconstant RMS$_DELJNS 100444)
590 | (defconstant RMS$_NOTSAMEJNL 100452)
591 | (defconstant RMS$_SNPPF 100460) ; +
592 | ;;;
593 | ;;; SEVERE ERRORS - WITH STV ERROR CODE
594 | ;;;
595 | ;;;-
596 | ;;; BIT 16 = BIT 15 = BIT 14 = 1
597 | (defconstant RMS$_ATR 114892)
598 | (defconstant RMS$_ATW 114900)
599 | (defconstant RMS$_CCF 114908)
600 | (defconstant RMS$_CDA 114916)
601 | (defconstant RMS$_CHN 114924)
602 | (defconstant RMS$_RER 114932)
603 | (defconstant RMS$_RMV 114940)
604 | (defconstant RMS$_RPL 114948)
605 | (defconstant RMS$_SYS 114956)
606 | (defconstant RMS$_WER 114964)
607 | (defconstant RMS$_WPL 114972)
608 | (defconstant RMS$_IFA 114980)
609 | (defconstant RMS$_WBE 114988)
610 | (defconstant RMS$_ENQ 114996)
611 | (defconstant RMS$_NETFAIL 115004)
612 | (defconstant RMS$_SUPPORT 115012)
613 | (defconstant RMS$_CRMP 115020)
614 | (defconstant RMS$_DTFCFGFIL 115028)
615 | (defconstant RMS$_REENT 115036)
616 | (defconstant RMS$_ACC_RUJ 115044)
617 | (defconstant RMS$_TMR 115052)
618 | (defconstant RMS$_ACC_AIJ 115060)
619 | (defconstant RMS$_ACC_BIJ 115068)
620 | (defconstant RMS$_ACC_ATJ 115076)
621 | (defconstant RMS$_DTFDEFFIL 115084)
622 | (defconstant RMS$_DTFREGFIL 115092)
623 | (defconstant RMS$_JNLNOTAUTH 115100)
624 |
--------------------------------------------------------------------------------
/sys/rmsusr.lsp:
--------------------------------------------------------------------------------
1 | (in-package :rasselbock)
2 |
3 | ;;; rab$l_fab has been typed :POINTER by hand!
4 | (provide 'rmsusr)
5 |
6 | ; ********************************************************************************************************************************
7 | ; Created 25-FEB-1987 12:19:46 by VAX-11 SDL V3.0-2 Source: 25-FEB-1987 12:19:30 LISPW$:[MILLER.TEMP]RMSUSR.TXT;1
8 | ; ********************************************************************************************************************************
9 |
10 | ;;;*** MODULE $FABDEF ***
11 |
12 | ;;;+++++*****
13 | ;;; the fields thru ctx must not be modified due to
14 | ;;; commonality between fab/rab/xab
15 | (defconstant FAB$C_BID 3) ; code for fab
16 | (defconstant FAB$M_PPF_RAT #b00000000000000000011111111000000)
17 | (defconstant FAB$M_PPF_IND #b00000000000000000100000000000000)
18 | (defconstant FAB$M_ASY #b00000000000000000000000000000001)
19 | (defconstant FAB$M_MXV #b00000000000000000000000000000010)
20 | (defconstant FAB$M_SUP #b00000000000000000000000000000100)
21 | (defconstant FAB$M_TMP #b00000000000000000000000000001000)
22 | (defconstant FAB$M_TMD #b00000000000000000000000000010000)
23 | (defconstant FAB$M_DFW #b00000000000000000000000000100000)
24 | (defconstant FAB$M_SQO #b00000000000000000000000001000000)
25 | (defconstant FAB$M_RWO #b00000000000000000000000010000000)
26 | (defconstant FAB$M_POS #b00000000000000000000000100000000)
27 | (defconstant FAB$M_WCK #b00000000000000000000001000000000)
28 | (defconstant FAB$M_NEF #b00000000000000000000010000000000)
29 | (defconstant FAB$M_RWC #b00000000000000000000100000000000)
30 | (defconstant FAB$M_DMO #b00000000000000000001000000000000)
31 | (defconstant FAB$M_SPL #b00000000000000000010000000000000)
32 | (defconstant FAB$M_SCF #b00000000000000000100000000000000)
33 | (defconstant FAB$M_DLT #b00000000000000001000000000000000)
34 | (defconstant FAB$M_NFS #b00000000000000010000000000000000)
35 | (defconstant FAB$M_UFO #b00000000000000100000000000000000)
36 | (defconstant FAB$M_PPF #b00000000000001000000000000000000)
37 | (defconstant FAB$M_INP #b00000000000010000000000000000000)
38 | (defconstant FAB$M_CTG #b00000000000100000000000000000000)
39 | (defconstant FAB$M_CBT #b00000000001000000000000000000000)
40 | (defconstant FAB$M_RCK #b00000000100000000000000000000000)
41 | (defconstant FAB$M_NAM #b00000001000000000000000000000000)
42 | (defconstant FAB$M_CIF #b00000010000000000000000000000000)
43 | (defconstant FAB$M_ESC #b00001000000000000000000000000000)
44 | (defconstant FAB$M_TEF #b00010000000000000000000000000000)
45 | (defconstant FAB$M_OFP #b00100000000000000000000000000000)
46 | (defconstant FAB$M_KFO #b01000000000000000000000000000000)
47 | (defconstant FAB$M_PUT #b00000000000000000000000000000001)
48 | (defconstant FAB$M_GET #b00000000000000000000000000000010)
49 | (defconstant FAB$M_DEL #b00000000000000000000000000000100)
50 | (defconstant FAB$M_UPD #b00000000000000000000000000001000)
51 | (defconstant FAB$M_TRN #b00000000000000000000000000010000)
52 | (defconstant FAB$M_BIO #b00000000000000000000000000100000)
53 | (defconstant FAB$M_BRO #b00000000000000000000000001000000)
54 | (defconstant FAB$M_EXE #b00000000000000000000000010000000)
55 | (defconstant FAB$M_SHRPUT #b00000000000000000000000000000001)
56 | (defconstant FAB$M_SHRGET #b00000000000000000000000000000010)
57 | (defconstant FAB$M_SHRDEL #b00000000000000000000000000000100)
58 | (defconstant FAB$M_SHRUPD #b00000000000000000000000000001000)
59 | (defconstant FAB$M_MSE #b00000000000000000000000000010000)
60 | (defconstant FAB$M_NIL #b00000000000000000000000000100000)
61 | (defconstant FAB$M_UPI #b00000000000000000000000001000000)
62 | (defconstant FAB$C_SEQ 0) ; sequential
63 | (defconstant FAB$C_REL 16) ; relative
64 | (defconstant FAB$C_IDX 32) ; indexed
65 | (defconstant FAB$C_HSH 48) ; hashed
66 | (defconstant FAB$M_FTN #b00000000000000000000000000000001)
67 | (defconstant FAB$M_CR #b00000000000000000000000000000010)
68 | (defconstant FAB$M_PRN #b00000000000000000000000000000100)
69 | (defconstant FAB$M_BLK #b00000000000000000000000000001000)
70 | (defconstant FAB$C_RFM_DFLT 2) ; var len is default
71 | (defconstant FAB$C_UDF 0) ; undefined (also stream binary)
72 | (defconstant FAB$C_FIX 1) ; fixed length records
73 | (defconstant FAB$C_VAR 2) ; variable length records
74 | (defconstant FAB$C_VFC 3) ; variable fixed control
75 | (defconstant FAB$C_STM 4) ; RMS-11 stream (valid only for sequential org)
76 | (defconstant FAB$C_STMLF 5) ; LF stream (valid only for sequential org)
77 | (defconstant FAB$C_STMCR 6) ; CR stream (valid only for sequential org)
78 | (defconstant FAB$C_MAXRFM 6) ; maximum rfm supported
79 | (defconstant FAB$M_ONLY_RU #b00000000000000000000000000000001)
80 | (defconstant FAB$M_RU #b00000000000000000000000000000010)
81 | (defconstant FAB$M_BI #b00000000000000000000000000000100)
82 | (defconstant FAB$M_AI #b00000000000000000000000000001000)
83 | (defconstant FAB$M_AT #b00000000000000000000000000010000)
84 | (defconstant FAB$M_NEVER_RU #b00000000000000000000000000100000)
85 | (defconstant FAB$M_JOURNAL_FILE #b00000000000000000000000001000000)
86 | (defconstant FAB$M_RCF_RU #b00000000000000000000000000000001)
87 | (defconstant FAB$M_RCF_AI #b00000000000000000000000000000010)
88 | (defconstant FAB$M_RCF_BI #b00000000000000000000000000000100)
89 | (defconstant FAB$K_BLN 80) ; length of fab
90 | (defconstant FAB$C_BLN 80) ; length of fab
91 |
92 | (define-alien-structure (FAB ( :conc-name nil))
93 | ; block id
94 | (FAB$B_BID :unsigned-integer 0 1 :default FAB$C_BID)
95 | ; block len
96 | (FAB$B_BLN :unsigned-integer 1 2 :default FAB$C_BLN)
97 | ; internal file index
98 | (FAB$W_IFI :unsigned-integer 2 4)
99 | ; move to bit 6
100 | (FABDEF$$_FILL_1 :unsigned-integer #.(+ 2 0/8) #.(+ 2 6/8))
101 | ; rat value for process-permanent files
102 | (FAB$V_PPF_RAT :unsigned-integer #.(+ 2 6/8) #.(+ 2 14/8))
103 | ; indirect access to process-permanent file
104 | (FAB$V_PPF_IND :unsigned-integer #.(+ 2 14/8) #.(+ 2 15/8))
105 | ; (i.e., restricted operations)
106 | (FAB$V_fill_0 :unsigned-integer #.(+ 2 15/8) #.(+ 2 16/8))
107 | ; file options
108 | (FAB$L_FOP :unsigned-integer 4 8)
109 | ; asynchronous operations (not implemented)
110 | (FAB$V_ASY :unsigned-integer #.(+ 4 0/8) #.(+ 4 1/8))
111 | ; maximize version number
112 | (FAB$V_MXV :unsigned-integer #.(+ 4 1/8) #.(+ 4 2/8))
113 | ; supersede existing file
114 | (FAB$V_SUP :unsigned-integer #.(+ 4 2/8) #.(+ 4 3/8))
115 | ; create temporary file
116 | (FAB$V_TMP :unsigned-integer #.(+ 4 3/8) #.(+ 4 4/8))
117 | ; create temp file marked for delete
118 | (FAB$V_TMD :unsigned-integer #.(+ 4 4/8) #.(+ 4 5/8))
119 | ; deferred write (rel and idx)
120 | (FAB$V_DFW :unsigned-integer #.(+ 4 5/8) #.(+ 4 6/8))
121 | ; sequential access only
122 | (FAB$V_SQO :unsigned-integer #.(+ 4 6/8) #.(+ 4 7/8))
123 | ; rewind mt on open
124 | (FAB$V_RWO :unsigned-integer #.(+ 4 7/8) #.(+ 4 8/8))
125 | ; use next magtape position
126 | (FAB$V_POS :unsigned-integer #.(+ 4 8/8) #.(+ 4 9/8))
127 | ; write checking
128 | (FAB$V_WCK :unsigned-integer #.(+ 4 9/8) #.(+ 4 10/8))
129 | ; inhibit end of file positioning
130 | (FAB$V_NEF :unsigned-integer #.(+ 4 10/8) #.(+ 4 11/8))
131 | ; rewind mt on close
132 | (FAB$V_RWC :unsigned-integer #.(+ 4 11/8) #.(+ 4 12/8))
133 | ; dismount mt on close (not implemented)
134 | (FAB$V_DMO :unsigned-integer #.(+ 4 12/8) #.(+ 4 13/8))
135 | ; spool file on close
136 | (FAB$V_SPL :unsigned-integer #.(+ 4 13/8) #.(+ 4 14/8))
137 | ; submit command file on close
138 | (FAB$V_SCF :unsigned-integer #.(+ 4 14/8) #.(+ 4 15/8))
139 | ; delete sub-option
140 | (FAB$V_DLT :unsigned-integer #.(+ 4 15/8) #.(+ 4 16/8))
141 | ; non-file structured operation
142 | (FAB$V_NFS :unsigned-integer #.(+ 4 16/8) #.(+ 4 17/8))
143 | ; user file open - no rms operations
144 | (FAB$V_UFO :unsigned-integer #.(+ 4 17/8) #.(+ 4 18/8))
145 | ; process permanent file (pio segment)
146 | (FAB$V_PPF :unsigned-integer #.(+ 4 18/8) #.(+ 4 19/8))
147 | ; process-permanent file is 'input'
148 | (FAB$V_INP :unsigned-integer #.(+ 4 19/8) #.(+ 4 20/8))
149 | ; contiguous extension
150 | (FAB$V_CTG :unsigned-integer #.(+ 4 20/8) #.(+ 4 21/8))
151 | ; contiguous best try
152 | (FAB$V_CBT :unsigned-integer #.(+ 4 21/8) #.(+ 4 22/8))
153 | ; reserved (not implemented)
154 | (FABDEF$$_FILL_2 :unsigned-integer #.(+ 4 22/8) #.(+ 4 23/8))
155 | ; read checking
156 | (FAB$V_RCK :unsigned-integer #.(+ 4 23/8) #.(+ 4 24/8))
157 | ; use name block dvi, did, and/or fid fields for open
158 | (FAB$V_NAM :unsigned-integer #.(+ 4 24/8) #.(+ 4 25/8))
159 | ; create if non-existent
160 | (FAB$V_CIF :unsigned-integer #.(+ 4 25/8) #.(+ 4 26/8))
161 | ; reserved (was UFM bitfield)
162 | (FABDEF$$_FILL_3 :unsigned-integer #.(+ 4 26/8) #.(+ 4 27/8))
163 | ; 'escape' to non-standard function ($modify)
164 | (FAB$V_ESC :unsigned-integer #.(+ 4 27/8) #.(+ 4 28/8))
165 | ; truncate at eof on close (write-accessed seq. disk file only)
166 | (FAB$V_TEF :unsigned-integer #.(+ 4 28/8) #.(+ 4 29/8))
167 | ; output file parse (only name type sticky)
168 | (FAB$V_OFP :unsigned-integer #.(+ 4 29/8) #.(+ 4 30/8))
169 | ; known file open (image activator only release 1)
170 | (FAB$V_KFO :unsigned-integer #.(+ 4 30/8) #.(+ 4 31/8))
171 | ; reserved (not implemented)
172 | (FABDEF$$_FILL_4 :unsigned-integer #.(+ 4 31/8) #.(+ 4 32/8))
173 | ; status
174 | (FAB$L_STS :unsigned-integer 8 12)
175 | ; status value
176 | (FAB$L_STV :unsigned-integer 12 16)
177 | ; allocation quantity
178 | (FAB$L_ALQ :unsigned-integer 16 20)
179 | ; default allocation quantity
180 | (FAB$W_DEQ :unsigned-integer 20 22)
181 | ; file access
182 | (FAB$B_FAC :unsigned-integer 22 23)
183 | ; put access
184 | (FAB$V_PUT :unsigned-integer #.(+ 22 0/8) #.(+ 22 1/8))
185 | ; get access
186 | (FAB$V_GET :unsigned-integer #.(+ 22 1/8) #.(+ 22 2/8))
187 | ; delete access
188 | (FAB$V_DEL :unsigned-integer #.(+ 22 2/8) #.(+ 22 3/8))
189 | ; update access
190 | (FAB$V_UPD :unsigned-integer #.(+ 22 3/8) #.(+ 22 4/8))
191 | ; truncate access
192 | (FAB$V_TRN :unsigned-integer #.(+ 22 4/8) #.(+ 22 5/8))
193 | ; block i/o access
194 | (FAB$V_BIO :unsigned-integer #.(+ 22 5/8) #.(+ 22 6/8))
195 | ; block and record i/o access
196 | (FAB$V_BRO :unsigned-integer #.(+ 22 6/8) #.(+ 22 7/8))
197 | ; execute access (caller must be exec or kernel mode,
198 | (FAB$V_EXE :unsigned-integer #.(+ 22 7/8) #.(+ 22 8/8))
199 | ; ufo must also be set)
200 | ; file sharing
201 | (FAB$B_SHR :unsigned-integer 23 24)
202 | ; put access
203 | (FAB$V_SHRPUT :unsigned-integer #.(+ 23 0/8) #.(+ 23 1/8))
204 | ; get access
205 | (FAB$V_SHRGET :unsigned-integer #.(+ 23 1/8) #.(+ 23 2/8))
206 | ; delete access
207 | (FAB$V_SHRDEL :unsigned-integer #.(+ 23 2/8) #.(+ 23 3/8))
208 | ; update access
209 | (FAB$V_SHRUPD :unsigned-integer #.(+ 23 3/8) #.(+ 23 4/8))
210 | ; multi-stream connects enabled
211 | (FAB$V_MSE :unsigned-integer #.(+ 23 4/8) #.(+ 23 5/8))
212 | ; no sharing
213 | (FAB$V_NIL :unsigned-integer #.(+ 23 5/8) #.(+ 23 6/8))
214 | ; user provided interlocking (allows multiple
215 | (FAB$V_UPI :unsigned-integer #.(+ 23 6/8) #.(+ 23 7/8))
216 | ; writers to seq. files)
217 | (FAB$V_fill_1 :unsigned-integer #.(+ 23 7/8) #.(+ 23 8/8))
218 | ; user context
219 | (FAB$L_CTX :unsigned-integer 24 28)
220 | ;-----*****
221 | ; retrieval window size
222 | (FAB$B_RTV :signed-integer 28 29)
223 | ; file organization
224 | (FAB$B_ORG :unsigned-integer 29 30)
225 | (FABDEF$$_FILL_5 :unsigned-integer #.(+ 29 0/8) #.(+ 29 4/8))
226 | (FAB$V_ORG :unsigned-integer #.(+ 29 4/8) #.(+ 29 8/8))
227 | ; record format
228 | (FAB$B_RAT :unsigned-integer 30 31)
229 | ; fortran carriage-ctl
230 | (FAB$V_FTN :unsigned-integer #.(+ 30 0/8) #.(+ 30 1/8))
231 | ; lf-record-cr carriage ctl
232 | (FAB$V_CR :unsigned-integer #.(+ 30 1/8) #.(+ 30 2/8))
233 | ; print-file carriage ctl
234 | (FAB$V_PRN :unsigned-integer #.(+ 30 2/8) #.(+ 30 3/8))
235 | ; records don't cross block boundaries
236 | (FAB$V_BLK :unsigned-integer #.(+ 30 3/8) #.(+ 30 4/8))
237 | (FAB$V_fill_2 :unsigned-integer #.(+ 30 4/8) #.(+ 30 8/8))
238 | ; record format
239 | (FAB$B_RFM :unsigned-integer 31 32)
240 | ; journaling options (from FH2$B_JOURNAL)
241 | (FAB$B_JOURNAL :unsigned-integer 32 33)
242 | ; note: only one of RU, ONLY_RU, NEVER_RU
243 | ; may be set at a time
244 | ; file is accessible only in recovery unit
245 | (FAB$V_ONLY_RU :unsigned-integer #.(+ 32 0/8) #.(+ 32 1/8))
246 | ; enable recovery unit journal
247 | (FAB$V_RU :unsigned-integer #.(+ 32 1/8) #.(+ 32 2/8))
248 | ; enable before image journal
249 | (FAB$V_BI :unsigned-integer #.(+ 32 2/8) #.(+ 32 3/8))
250 | ; enable after image journal
251 | (FAB$V_AI :unsigned-integer #.(+ 32 3/8) #.(+ 32 4/8))
252 | ; enable audit trail journal
253 | (FAB$V_AT :unsigned-integer #.(+ 32 4/8) #.(+ 32 5/8))
254 | ; file is never accessible in recovery unit
255 | (FAB$V_NEVER_RU :unsigned-integer #.(+ 32 5/8) #.(+ 32 6/8))
256 | ; this is a journal file
257 | (FAB$V_JOURNAL_FILE :unsigned-integer #.(+ 32 6/8) #.(+ 32 7/8))
258 | (FAB$V_fill_3 :unsigned-integer #.(+ 32 7/8) #.(+ 32 8/8))
259 | ; recoverable facility id number
260 | (FAB$B_RU_FACILITY :unsigned-integer 33 34)
261 | ; (spare)
262 | (FABDEF$$_FILL_7 :signed-integer 34 36)
263 | ; xab address
264 | (FAB$L_XAB :pointer 36 40)
265 | ; nam block address
266 | (FAB$L_NAM :pointer 40 44)
267 | ; file name string address
268 | (FAB$L_FNA :pointer 44 48)
269 | ; default file name string addr
270 | (FAB$L_DNA :pointer 48 52)
271 | ; file name string size
272 | (FAB$B_FNS :unsigned-integer 52 53)
273 | ; default name string size
274 | (FAB$B_DNS :unsigned-integer 53 54)
275 | ; maximum record size
276 | (FAB$W_MRS :unsigned-integer 54 56)
277 | ; maximum record number
278 | (FAB$L_MRN :unsigned-integer 56 60)
279 | ; blocksize for tape
280 | (FAB$W_BLS :unsigned-integer 60 62)
281 | ; bucket size
282 | (FAB$B_BKS :unsigned-integer 62 63)
283 | ; fixed header size
284 | (FAB$B_FSZ :unsigned-integer 63 64)
285 | ; device characteristics
286 | (FAB$L_DEV :unsigned-integer 64 68)
287 | ; spooling device characteristics
288 | (FAB$L_SDC :unsigned-integer 68 72)
289 | ; Global buffer count
290 | (FAB$W_GBC :unsigned-integer 72 74)
291 | ; agent access modes
292 | (FAB$B_ACMODES :unsigned-integer 74 75)
293 | ; ACMODE for log nams
294 | (FAB$V_LNM_MODE :unsigned-integer #.(+ 74 0/8) #.(+ 74 2/8))
295 | ; ACMODE for channel
296 | (FAB$V_CHAN_MODE :unsigned-integer #.(+ 74 2/8) #.(+ 74 4/8))
297 | ; ACMODE to use for determining file accessibility
298 | (FAB$V_FILE_MODE :unsigned-integer #.(+ 74 4/8) #.(+ 74 6/8))
299 | ; ACMODE for user structure probing;
300 | (FAB$V_CALLERS_MODE :unsigned-integer #.(+ 74 6/8) #.(+ 74 8/8))
301 | ; maximized with actual mode of caller
302 | ; recovery control flags
303 | ; (only for use by RMS Recovery)
304 | (FAB$B_RCF :unsigned-integer 75 76)
305 | ; recovery unit recovery
306 | (FAB$V_RCF_RU :unsigned-integer #.(+ 75 0/8) #.(+ 75 1/8))
307 | ; after image recovery
308 | (FAB$V_RCF_AI :unsigned-integer #.(+ 75 1/8) #.(+ 75 2/8))
309 | ; before image recovery
310 | (FAB$V_RCF_BI :unsigned-integer #.(+ 75 2/8) #.(+ 75 3/8))
311 | (FAB$V_fill_4 :unsigned-integer #.(+ 75 3/8) #.(+ 75 8/8))
312 | ; (spare)
313 | (FABDEF$$_FILL_9 :signed-integer 76 80)) ; (spare)
314 |
315 | ;;;-----*****
316 |
317 | ;;;*** MODULE $RABDEF ***
318 |
319 | ;;;
320 | ;;; record access block (rab) definitions
321 | ;;;
322 | ;;; there is one rab per connected stream
323 | ;;; it is used for all communications between the user
324 | ;;; and rms concerning operations on the stream
325 | ;;;
326 | ;;;+++++*****
327 | ;;; the fields thru ctx cannot be changed due to commonality
328 | ;;; with the fab
329 | ;;;
330 | (defconstant RAB$C_BID 1) ; code for rab
331 | (defconstant RAB$M_PPF_RAT #b00000000000000000011111111000000)
332 | (defconstant RAB$M_PPF_IND #b00000000000000000100000000000000)
333 | (defconstant RAB$M_ASY #b00000000000000000000000000000001)
334 | (defconstant RAB$M_TPT #b00000000000000000000000000000010)
335 | (defconstant RAB$M_REA #b00000000000000000000000000000100)
336 | (defconstant RAB$M_RRL #b00000000000000000000000000001000)
337 | (defconstant RAB$M_UIF #b00000000000000000000000000010000)
338 | (defconstant RAB$M_MAS #b00000000000000000000000000100000)
339 | (defconstant RAB$M_FDL #b00000000000000000000000001000000)
340 | (defconstant RAB$M_HSH #b00000000000000000000000010000000)
341 | (defconstant RAB$M_EOF #b00000000000000000000000100000000)
342 | (defconstant RAB$M_RAH #b00000000000000000000001000000000)
343 | (defconstant RAB$M_WBH #b00000000000000000000010000000000)
344 | (defconstant RAB$M_BIO #b00000000000000000000100000000000)
345 | (defconstant RAB$M_LV2 #b00000000000000000001000000000000)
346 | (defconstant RAB$M_LOA #b00000000000000000010000000000000)
347 | (defconstant RAB$M_LIM #b00000000000000000100000000000000)
348 | (defconstant RAB$M_LOC #b00000000000000010000000000000000)
349 | (defconstant RAB$M_WAT #b00000000000000100000000000000000)
350 | (defconstant RAB$M_ULK #b00000000000001000000000000000000)
351 | (defconstant RAB$M_RLK #b00000000000010000000000000000000)
352 | (defconstant RAB$M_NLK #b00000000000100000000000000000000)
353 | (defconstant RAB$M_KGE #b00000000001000000000000000000000)
354 | (defconstant RAB$M_KGT #b00000000010000000000000000000000)
355 | (defconstant RAB$M_NXR #b00000000100000000000000000000000)
356 | (defconstant RAB$M_RNE #b00000001000000000000000000000000)
357 | (defconstant RAB$M_TMO #b00000010000000000000000000000000)
358 | (defconstant RAB$M_CVT #b00000100000000000000000000000000)
359 | (defconstant RAB$M_RNF #b00001000000000000000000000000000)
360 | (defconstant RAB$M_ETO #b00010000000000000000000000000000)
361 | (defconstant RAB$M_PTA #b00100000000000000000000000000000)
362 | (defconstant RAB$M_PMT #b01000000000000000000000000000000)
363 | (defconstant RAB$M_CCO #b10000000000000000000000000000000)
364 | (defconstant RAB$M_EQNXT #b00000000001000000000000000000000)
365 | (defconstant RAB$M_NXT #b00000000010000000000000000000000)
366 | (defconstant RAB$C_SEQ 0) ; sequential access
367 | (defconstant RAB$C_KEY 1) ; keyed access
368 | (defconstant RAB$C_RFA 2) ; rfa access
369 | (defconstant RAB$C_STM 3) ; stream access (valid only for sequential org)
370 | (defconstant RAB$K_BLN 68) ; length of rab
371 | (defconstant RAB$C_BLN 68) ; length of rab
372 |
373 | (define-alien-structure (RAB ( :conc-name nil))
374 | ; block id
375 | (RAB$B_BID :unsigned-integer 0 1 :default RAB$C_BID)
376 | ; block length
377 | (RAB$B_BLN :unsigned-integer 1 2 :default RAB$C_BLN)
378 | ; internal stream index
379 | (RAB$W_ISI :unsigned-integer 2 4)
380 | ; (ifi in fab)
381 | ; move to bit 6
382 | (RABDEF$$_FILL_1 :unsigned-integer #.(+ 2 0/8) #.(+ 2 6/8))
383 | ; rat value for process-permanent files
384 | (RAB$V_PPF_RAT :unsigned-integer #.(+ 2 6/8) #.(+ 2 14/8))
385 | ; indirect access to process-permanent file
386 | (RAB$V_PPF_IND :unsigned-integer #.(+ 2 14/8) #.(+ 2 15/8))
387 | ; (i.e., restricted operations)
388 | (RAB$V_fill_5 :unsigned-integer #.(+ 2 15/8) #.(+ 2 16/8))
389 | ; record options
390 | (RAB$L_ROP :unsigned-integer 4 8)
391 | ; asynchronous operations
392 | (RAB$V_ASY :unsigned-integer #.(+ 4 0/8) #.(+ 4 1/8))
393 | ; truncate put - allow sequential put not at
394 | (RAB$V_TPT :unsigned-integer #.(+ 4 1/8) #.(+ 4 2/8))
395 | ; eof, thus truncating file (seq. org only)
396 | ;
397 | ; these next two should be in the byte for bits
398 | ; input to $find or $get, but there is no room there
399 | ;
400 | ; lock record for read only, allow other readers
401 | (RAB$V_REA :unsigned-integer #.(+ 4 2/8) #.(+ 4 3/8))
402 | ; read record regardless of lock
403 | (RAB$V_RRL :unsigned-integer #.(+ 4 3/8) #.(+ 4 4/8))
404 | ;
405 | ; update if existent
406 | (RAB$V_UIF :unsigned-integer #.(+ 4 4/8) #.(+ 4 5/8))
407 | ; mass-insert mode
408 | (RAB$V_MAS :unsigned-integer #.(+ 4 5/8) #.(+ 4 6/8))
409 | ; fast record deletion
410 | (RAB$V_FDL :unsigned-integer #.(+ 4 6/8) #.(+ 4 7/8))
411 | ; use hash code in bkt
412 | (RAB$V_HSH :unsigned-integer #.(+ 4 7/8) #.(+ 4 8/8))
413 | ;
414 | ; connect to eof
415 | (RAB$V_EOF :unsigned-integer #.(+ 4 8/8) #.(+ 4 9/8))
416 | ; read ahead
417 | (RAB$V_RAH :unsigned-integer #.(+ 4 9/8) #.(+ 4 10/8))
418 | ; write behind
419 | (RAB$V_WBH :unsigned-integer #.(+ 4 10/8) #.(+ 4 11/8))
420 | ; connect for bio only
421 | (RAB$V_BIO :unsigned-integer #.(+ 4 11/8) #.(+ 4 12/8))
422 | ; level 2 RU lock consistancy
423 | (RAB$V_LV2 :unsigned-integer #.(+ 4 12/8) #.(+ 4 13/8))
424 | ; use bucket fill percentage
425 | (RAB$V_LOA :unsigned-integer #.(+ 4 13/8) #.(+ 4 14/8))
426 | ; compare for key limit reached on $get/$find seq. (idx only)
427 | (RAB$V_LIM :unsigned-integer #.(+ 4 14/8) #.(+ 4 15/8))
428 | ; (1 spare)
429 | (RABDEF$$_FILL_2 :unsigned-integer #.(+ 4 15/8) #.(+ 4 16/8))
430 | ;
431 | ; the following bits are input to
432 | ; $find or $get, (see above also REA and RRL)
433 | ; (separate byte)
434 | ;
435 | ; use locate mode
436 | (RAB$V_LOC :unsigned-integer #.(+ 4 16/8) #.(+ 4 17/8))
437 | ; wait if record not available
438 | (RAB$V_WAT :unsigned-integer #.(+ 4 17/8) #.(+ 4 18/8))
439 | ; manual unlocking
440 | (RAB$V_ULK :unsigned-integer #.(+ 4 18/8) #.(+ 4 19/8))
441 | ; allow readers for this locked record
442 | (RAB$V_RLK :unsigned-integer #.(+ 4 19/8) #.(+ 4 20/8))
443 | ; do not lock record
444 | (RAB$V_NLK :unsigned-integer #.(+ 4 20/8) #.(+ 4 21/8))
445 | ; key > or =
446 | (RAB$V_KGE :unsigned-integer #.(+ 4 21/8) #.(+ 4 22/8))
447 | ; key greater than
448 | (RAB$V_KGT :unsigned-integer #.(+ 4 22/8) #.(+ 4 23/8))
449 | ; get non-existent record
450 | (RAB$V_NXR :unsigned-integer #.(+ 4 23/8) #.(+ 4 24/8))
451 | ;
452 | ; the following bits are terminal qualifiers only
453 | ; (separate byte)
454 | ;
455 | ; read no echo
456 | (RAB$V_RNE :unsigned-integer #.(+ 4 24/8) #.(+ 4 25/8))
457 | ; use time-out period
458 | (RAB$V_TMO :unsigned-integer #.(+ 4 25/8) #.(+ 4 26/8))
459 | ; convert to upper case
460 | (RAB$V_CVT :unsigned-integer #.(+ 4 26/8) #.(+ 4 27/8))
461 | ; read no filter
462 | (RAB$V_RNF :unsigned-integer #.(+ 4 27/8) #.(+ 4 28/8))
463 | ; extended terminal operation
464 | (RAB$V_ETO :unsigned-integer #.(+ 4 28/8) #.(+ 4 29/8))
465 | ; purge type ahead
466 | (RAB$V_PTA :unsigned-integer #.(+ 4 29/8) #.(+ 4 30/8))
467 | ; use prompt buffer
468 | (RAB$V_PMT :unsigned-integer #.(+ 4 30/8) #.(+ 4 31/8))
469 | ; cancel control o on output
470 | (RAB$V_CCO :unsigned-integer #.(+ 4 31/8) #.(+ 4 32/8))
471 | (RABDEF$$_FILL_6 :unsigned-integer #.(+ 4 0/8) #.(+ 4 21/8))
472 | ; Synonyms for KGE and
473 | (RAB$V_EQNXT :unsigned-integer #.(+ 4 21/8) #.(+ 4 22/8))
474 | ; KGT
475 | (RAB$V_NXT :unsigned-integer #.(+ 4 22/8) #.(+ 4 23/8))
476 | (RAB$V_fill_6 :unsigned-integer #.(+ 4 23/8) #.(+ 4 24/8))
477 | ; the following bits may be
478 | ; input to various rab-related
479 | ; operations
480 | ;
481 | (RABDEF$$_FILL_3 :signed-integer 4 5)
482 | ; various options
483 | (RAB$B_ROP1 :unsigned-integer 5 6)
484 | ; get/find options (use of this field discouraged
485 | (RAB$B_ROP2 :unsigned-integer 6 7)
486 | ; due to REA and RRL being in a different byte)
487 | ; terminal read options
488 | (RAB$B_ROP3 :unsigned-integer 7 8)
489 | ;
490 | ; status
491 | (RAB$L_STS :unsigned-integer 8 12)
492 | ; status value
493 | (RAB$L_STV :unsigned-integer 12 16)
494 | ; low word of stv
495 | (RAB$W_STV0 :unsigned-integer 12 14)
496 | ; high word of stv
497 | (RAB$W_STV2 :unsigned-integer 14 16)
498 | ; record's file address
499 | (RAB$W_RFA :unsigned-integer 16 18 :occurs 3)
500 | (RAB$L_RFA0 :unsigned-integer 16 20)
501 | (RAB$W_RFA4 :unsigned-integer 20 22)
502 | ; (reserved - rms release 1 optimizes stores
503 | (RABDEF$$_FILL_4 :signed-integer 22 24)
504 | ; to the rfa field to be a move quad, overwriting
505 | ; this reserved word)
506 | ; user context
507 | (RAB$L_CTX :unsigned-integer 24 28)
508 | ;-----*****
509 | ; (spare)
510 | (RABDEF$$_FILL_5 :signed-integer 28 30)
511 | ; record access
512 | (RAB$B_RAC :unsigned-integer 30 31)
513 | ; time-out period
514 | (RAB$B_TMO :unsigned-integer 31 32)
515 | ; user buffer size
516 | (RAB$W_USZ :unsigned-integer 32 34)
517 | ; record buffer size
518 | (RAB$W_RSZ :unsigned-integer 34 36)
519 | ; user buffer address
520 | (RAB$L_UBF :pointer 36 40)
521 | ; record buffer address
522 | (RAB$L_RBF :pointer 40 44)
523 | ; record header buffer addr
524 | (RAB$L_RHB :pointer 44 48)
525 | ; key buffer address
526 | (RAB$L_KBF :pointer 48 52)
527 | ; prompt buffer addr
528 | (RAB$L_PBF :pointer 48 52)
529 | ; key buffer size
530 | (RAB$B_KSZ :unsigned-integer 52 53)
531 | ; prompt buffer size
532 | (RAB$B_PSZ :unsigned-integer 52 53)
533 | ; key of reference
534 | (RAB$B_KRF :unsigned-integer 53 54)
535 | ; multi-buffer count
536 | (RAB$B_MBF :signed-integer 54 55)
537 | ; multi-block count
538 | (RAB$B_MBC :unsigned-integer 55 56)
539 | ; bucket hash code, vbn, or rrn
540 | (RAB$L_BKT :unsigned-integer 56 60)
541 | ; duplicates count on key accessed on alternate key
542 | (RAB$L_DCT :unsigned-integer 56 60)
543 | ; related fab for connect !!!!!!! :POINTER edited in by hand !!!!!!!
544 | (RAB$L_FAB :pointer 60 64)
545 | ; XAB address
546 | (RAB$L_XAB :pointer 64 68)) ; XAB address
547 |
548 | ;;; (ifi in fab)
549 | ;;; eof, thus truncating file (seq. org only)
550 | ;;;
551 | ;;; these next two should be in the byte for bits
552 | ;;; input to $find or $get, but there is no room there
553 | ;;;
554 | ;;;
555 | ;;;
556 | ;;;
557 | ;;; the following bits are input to
558 | ;;; $find or $get, (see above also REA and RRL)
559 | ;;; (separate byte)
560 | ;;;
561 | ;;;
562 | ;;; the following bits are terminal qualifiers only
563 | ;;; (separate byte)
564 | ;;;
565 | ;;; the following bits may be
566 | ;;; input to various rab-related
567 | ;;; operations
568 | ;;;
569 | ;;; to the rfa field to be a move quad, overwriting
570 | ;;; this reserved word)
571 | ;;;-----*****
572 |
573 |
574 | ;;;*** MODULE $XABDEF ***
575 |
576 | ;;;
577 | ;;; definitions for all xabs
578 | ;;; $xabdef
579 | ;;;
580 | ;;;
581 | ;;;
582 | ;;; the first four fields are shared in common between all xabs
583 | ;;; and hence are defined only once
584 | ;;; (the only exception is that the spare word may be used by some xabs)
585 | ;;;
586 |
587 | (define-alien-structure (XAB ( :conc-name nil))
588 | ; xab id code
589 | (XAB$B_COD :unsigned-integer 0 1)
590 | ; block length
591 | (XAB$B_BLN :unsigned-integer 1 2)
592 | ; (spare)
593 | (XABDEF$$_FILL_1 :signed-integer 2 4)
594 | ; xab chain link
595 | (XAB$L_NXT :unsigned-integer 4 8)
596 | ;WITH POSSIBLE EXCEPTION OF SPARE FIELD
597 | (XAB$W_RVN :unsigned-integer 8 10)
598 | (XABDEF$$_FILL_2 :signed-integer 10 12)
599 | (XAB$Q_RDT :signed-integer 12 20)
600 | (XAB$L_RDT0 :unsigned-integer 12 16)
601 | (XAB$L_RDT4 :signed-integer 16 20))
602 | ;COMMON AMONG DAT AND RDT XABS
603 |
604 | ;;;WITH POSSIBLE EXCEPTION OF SPARE FIELD
605 |
606 | ;;;*** MODULE $XABKEYDEF ***
607 |
608 | ;;;--
609 | ;;;++
610 | ;;;
611 | ;;; key definition xab field definitions
612 | ;;; $xabkeydef
613 | ;;;
614 | ;;;
615 | (defconstant XAB$C_KEY 21) ; xabkey id code
616 | (defconstant XAB$M_DUP #b00000000000000000000000000000001)
617 | (defconstant XAB$M_CHG #b00000000000000000000000000000010)
618 | (defconstant XAB$M_NUL #b00000000000000000000000000000100)
619 | (defconstant XAB$M_IDX_NCMPR #b00000000000000000000000000001000)
620 | (defconstant XAB$M_KEY_NCMPR #b00000000000000000000000001000000)
621 | (defconstant XAB$M_DAT_NCMPR #b00000000000000000000000010000000)
622 | (defconstant XAB$C_STG 0) ; string
623 | (defconstant XAB$C_IN2 1) ; signed 15 bit integer (2 bytes)
624 | (defconstant XAB$C_BN2 2) ; 2 byte binary
625 | (defconstant XAB$C_IN4 3) ; signed 31 bit integer (4 bytes)
626 | (defconstant XAB$C_BN4 4) ; 4 byte binary
627 | (defconstant XAB$C_PAC 5) ; packed decimal (1-16 bytes)
628 | (defconstant XAB$C_IN8 6) ; signed 63 bit integer (4 bytes)
629 | (defconstant XAB$C_BN8 7) ; 8 byte binary
630 | (defconstant XAB$C_DSTG 32) ; descending string
631 | (defconstant XAB$C_DIN2 33) ; " signed word
632 | (defconstant XAB$C_DBN2 34) ; " unsigned word
633 | (defconstant XAB$C_DIN4 35) ; " signed longword
634 | (defconstant XAB$C_DBN4 36) ; " unsigned longword
635 | (defconstant XAB$C_DPAC 37) ; " packed decimal
636 | (defconstant XAB$C_DIN8 38) ; " signed quadword
637 | (defconstant XAB$C_DBN8 39) ; " unsigned quadword
638 | (defconstant XAB$C_MAXDTP 39) ; max. legal data type
639 | (defconstant XAB$K_KEYLEN_V2 64) ; old xabkey length
640 | (defconstant XAB$C_KEYLEN_V2 64) ; old xabkey length
641 | ;;;
642 | (defconstant XAB$C_PRG3 3) ; Prologue version three
643 | (defconstant XAB$C_PRG2 2) ; Prologue version two
644 | (defconstant XAB$C_PRG1 1) ; Prologue versoin one
645 | (defconstant XAB$K_KEYLEN 76) ; xabkey length
646 | (defconstant XAB$C_KEYLEN 76) ; xabkey length
647 | ;;;--
648 |
649 | (define-alien-structure (XABKEY ( :conc-name nil))
650 | (XABKEYDEF$$_FILL_1 :signed-integer 0 1)
651 | (XABKEYDEF$$_FILL_2 :signed-integer 1 2)
652 | (XABKEYDEF$$_FILL_3 :signed-integer 2 4)
653 | ;HAS SAME COD, BLN, SPARE AND NXT FIELD
654 | (XABKEYDEF$$_FILL_4 :signed-integer 4 8)
655 | ;THESE 4 FIELDS ARE COMMON TO ALL XABS AND
656 | ;HAVE BEEN DEFINED BY $XABDEF
657 | ;
658 | ; the field layout of the key xab is such that it matchs as
659 | ; closely as possible the layout of a key decriptor in the
660 | ; index file prologue. this is so the contents may be moved
661 | ; between the two structures as efficiently as possible.
662 | ;
663 | ; index level area number
664 | (XAB$B_IAN :unsigned-integer 8 9)
665 | ; lowest index level area number
666 | (XAB$B_LAN :unsigned-integer 9 10)
667 | ; data level area number
668 | (XAB$B_DAN :unsigned-integer 10 11)
669 | ; level of root bucket
670 | (XAB$B_LVL :unsigned-integer 11 12)
671 | ; size of index buckets in virtual blocks
672 | (XAB$B_IBS :unsigned-integer 12 13)
673 | ; size of data buckets in virtual blocks
674 | (XAB$B_DBS :unsigned-integer 13 14)
675 | ; root bucket start vbn
676 | (XAB$L_RVB :unsigned-integer 14 18)
677 | ; key option flags
678 | (XAB$B_FLG :unsigned-integer 18 19)
679 | ; duplicate key values allowed
680 | (XAB$V_DUP :unsigned-integer #.(+ 18 0/8) #.(+ 18 1/8))
681 | ; alt key only --key field may change on update
682 | (XAB$V_CHG :unsigned-integer #.(+ 18 1/8) #.(+ 18 2/8))
683 | ; alt key only --null key value enable
684 | (XAB$V_NUL :unsigned-integer #.(+ 18 2/8) #.(+ 18 3/8))
685 | ; indicate index records for given key are not compressed
686 | (XAB$V_IDX_NCMPR :unsigned-integer #.(+ 18 3/8) #.(+ 18 4/8))
687 | ; spare
688 | (XABKEYDEF$$_FILL_5 :unsigned-integer #.(+ 18 4/8) #.(+ 18 6/8))
689 | ; indicates key is not compressed in data record
690 | (XAB$V_KEY_NCMPR :unsigned-integer #.(+ 18 6/8) #.(+ 18 7/8))
691 | (XAB$V_fill_11 :unsigned-integer #.(+ 18 7/8) #.(+ 18 8/8))
692 | ; space over dup
693 | (XABKEYDEF$$_FILL_6 :unsigned-integer #.(+ 18 0/8) #.(+ 18 1/8))
694 | ; spare
695 | (XABKEYDEF$$_FILL_7 :unsigned-integer #.(+ 18 1/8) #.(+ 18 3/8))
696 | ; space over idx_ncmpr
697 | (XABKEYDEF$$_FILL_8 :unsigned-integer #.(+ 18 3/8) #.(+ 18 4/8))
698 | ; spare
699 | (XABKEYDEF$$_FILL_9 :unsigned-integer #.(+ 18 4/8) #.(+ 18 6/8))
700 | ; space over key_ncmpr
701 | (XABKEYDEF$$_FILL_10 :unsigned-integer #.(+ 18 6/8) #.(+ 18 7/8))
702 | ; data record is not compressed
703 | (XAB$V_DAT_NCMPR :unsigned-integer #.(+ 18 7/8) #.(+ 18 8/8))
704 | ; key field data type
705 | (XAB$B_DTP :unsigned-integer 19 20)
706 | ; number of key segments
707 | (XAB$B_NSG :unsigned-integer 20 21)
708 | ; nul key character
709 | (XAB$B_NUL :unsigned-integer 21 22)
710 | ; total key field size (bytes)
711 | (XAB$B_TKS :unsigned-integer 22 23)
712 | ; key of reference (0=prim key,
713 | (XAB$B_REF :unsigned-integer 23 24)
714 | ; 1-254 = alternate keys)
715 | ; minimun record length to contain key field
716 | (XAB$W_MRL :unsigned-integer 24 26)
717 | ; index bucket fill size (bytes)
718 | (XAB$W_IFL :unsigned-integer 26 28)
719 | ; data bucket fil size (bytes)
720 | (XAB$W_DFL :unsigned-integer 28 30)
721 | ; key field record offset positions
722 | (XAB$W_POS :unsigned-integer 30 32 :occurs 8)
723 | ; segment 0
724 | (XAB$W_POS0 :unsigned-integer 30 32)
725 | ; segment 1
726 | (XAB$W_POS1 :unsigned-integer 32 34)
727 | ; segment 2
728 | (XAB$W_POS2 :unsigned-integer 34 36)
729 | ; segment 3
730 | (XAB$W_POS3 :unsigned-integer 36 38)
731 | ; segment 4
732 | (XAB$W_POS4 :unsigned-integer 38 40)
733 | ; segment 5
734 | (XAB$W_POS5 :unsigned-integer 40 42)
735 | ; segment 6
736 | (XAB$W_POS6 :unsigned-integer 42 44)
737 | ; segment 7
738 | (XAB$W_POS7 :unsigned-integer 44 46)
739 | ; key field segment sizes
740 | (XAB$B_SIZ :unsigned-integer 46 47 :occurs 8)
741 | ; segment 0
742 | (XAB$B_SIZ0 :unsigned-integer 46 47)
743 | ; segment 1
744 | (XAB$B_SIZ1 :unsigned-integer 47 48)
745 | ; segment 2
746 | (XAB$B_SIZ2 :unsigned-integer 48 49)
747 | ; segment 3
748 | (XAB$B_SIZ3 :unsigned-integer 49 50)
749 | ; segment 4
750 | (XAB$B_SIZ4 :unsigned-integer 50 51)
751 | ; segment 5
752 | (XAB$B_SIZ5 :unsigned-integer 51 52)
753 | ; segment 6
754 | (XAB$B_SIZ6 :unsigned-integer 52 53)
755 | ; segment 7
756 | (XAB$B_SIZ7 :unsigned-integer 53 54)
757 | ; spare
758 | (XABKEYDEF$$_FILL_11 :signed-integer 54 56)
759 | ;
760 | ; the positions of the above fields are dictated by the key descriptor
761 | ; record layout in the index file prologue.
762 | ;
763 | ; pointer to 32 character key name buffer
764 | (XAB$L_KNM :pointer 56 60)
765 | ; first data bucket start vbn
766 | (XAB$L_DVB :unsigned-integer 60 64)
767 | ; Additions for prologue 3 files
768 | ;
769 | ; key field segment types
770 | (XAB$B_TYP :unsigned-integer 64 65 :occurs 8)
771 | ; segment 0
772 | (XAB$B_TYP0 :unsigned-integer 64 65)
773 | ; segment 1
774 | (XAB$B_TYP1 :unsigned-integer 65 66)
775 | ; segment 2
776 | (XAB$B_TYP2 :unsigned-integer 66 67)
777 | ; segment 3
778 | (XAB$B_TYP3 :unsigned-integer 67 68)
779 | ; segment 4
780 | (XAB$B_TYP4 :unsigned-integer 68 69)
781 | ; segment 5
782 | (XAB$B_TYP5 :unsigned-integer 69 70)
783 | ; segment 6
784 | (XAB$B_TYP6 :unsigned-integer 70 71)
785 | ; segment 7
786 | (XAB$B_TYP7 :unsigned-integer 71 72)
787 | ; indicate prologue version desired (primary key only)
788 | (XAB$B_PROLOG :unsigned-integer 72 73)
789 | ; spare
790 | (XABKEYDEF$$_FILL_12 :signed-integer 73 74)
791 | (XABKEYDEF$$_FILL_13 :signed-integer 74 76)) ; spare
792 | ;++
793 |
--------------------------------------------------------------------------------
/utils.lsp:
--------------------------------------------------------------------------------
1 | ;; Various utility functions
2 |
3 | (in-package :rasselbock)
4 |
5 | (defmacro doplist ((key value plist) &body body)
6 | "Iterate over PLIST, binding KEY and VALUE to each value in it."
7 | (let ((current (gensym)))
8 | `(do* ((,current ,plist (cddr ,current))
9 | (,key (first ,current) (first ,current))
10 | (,value (second ,current) (second ,current)))
11 | ((not ,current))
12 | ,@body)))
13 |
14 | (defun swab (in)
15 | "Swap the two bytes in a short to convert between VAX and network byte order"
16 | (let ((out 0))
17 | (setf (ldb (byte 8 0) out) (ldb (byte 8 8) in)
18 | (ldb (byte 8 8) out) (ldb (byte 8 0) in))
19 | out))
20 |
21 | (defun format-ip-address (address)
22 | "Format an IP address in network byte order as x.y.z.a"
23 | (format nil "~D.~D.~D.~D"
24 | (ldb (byte 8 0) address)
25 | (ldb (byte 8 8) address)
26 | (ldb (byte 8 16) address)
27 | (ldb (byte 8 24) address)))
28 |
29 | (defun quote-string (string)
30 | "Convert all non-printable characters in STRING to their VAX LISP character
31 | literals Streaks of printable characters are returned enclosed in double
32 | quotes."
33 | (with-output-to-string (*standard-output*)
34 | (let (in-printable-p)
35 | (dotimes (i (length string))
36 | (let ((char (aref string i)))
37 | (if (graphic-char-p char)
38 | (progn
39 | (unless in-printable-p
40 | (setf in-printable-p t)
41 | (unless (zerop i)
42 | (write-char #\space))
43 | (write-char #\"))
44 | (write-char char))
45 | (progn
46 | (when in-printable-p
47 | (setf in-printable-p nil)
48 | (write-char #\"))
49 | (unless (zerop i)
50 | (write-char #\space))
51 | (format t "#\\~:(~A~)" (char-name char))))))
52 | (when in-printable-p
53 | (write-char #\")))))
54 |
55 | (defun whitespacep (c)
56 | "Return a true value for whitespace characters (Space, Tab, Linefeed and
57 | Return)"
58 | (or (eq c #\space)
59 | (eq c #\tab)
60 | (eq c #\linefeed)
61 | (eq c #\return)))
62 |
63 | (defun make-keyword (string)
64 | "Convert the given string designator to an all-uppercase keyword"
65 | (intern (string-upcase string) :keyword))
66 |
67 | (defun urldecode (string)
68 | "Perform URL-decoding of the given string."
69 | (with-output-to-string (*standard-output*)
70 | (with-input-from-string (*standard-input* string)
71 | (loop
72 | (let ((char (read-char nil nil)))
73 | (case char
74 | ((nil) (return))
75 | (#\+ (write-char #\space))
76 | (#\% (let ((string (make-string 2)))
77 | (setf (aref string 0) (read-char)
78 | (aref string 1) (read-char))
79 | (write-char (code-char (parse-integer string :radix 16)))))
80 | (otherwise
81 | (write-char char))))))))
82 |
83 |
--------------------------------------------------------------------------------
/vms.lsp:
--------------------------------------------------------------------------------
1 | ;; Structures and utility functions to interact with VMS system services
2 |
3 | (in-package :rasselbock)
4 |
5 | (eval-when (compile load eval)
6 | (load 'parameters :verbose nil :print nil))
7 |
8 | (define-alien-structure iosb
9 | (status :unsigned-integer 0 2)
10 | (bytecnt :unsigned-integer 2 4)
11 | (details :pointer 4 8))
12 |
13 | (define-alien-structure itemlst-2
14 | (length :unsigned-integer 0 2)
15 | (type :unsigned-integer 2 4 :default 0)
16 | (address :pointer 4 8))
17 |
18 | (define-alien-structure itemlst-3
19 | (length :unsigned-integer 0 2)
20 | (type :unsigned-integer 2 4 :default 0)
21 | (address :pointer 4 8)
22 | (retlen :pointer 8 12 :default 0))
23 |
24 | (define-alien-structure string-buffer
25 | (string :asciz 0 #.+buffer-size+))
26 |
27 | (define-alien-structure filename-buffer
28 | (filename :asciz 0 #.+filename-size+))
29 |
30 | (define-alien-structure short
31 | (value :unsigned-integer 0 2 :default 0))
32 |
33 | (define-alien-structure long
34 | (value :unsigned-integer 0 4 :default 0))
35 |
36 | (defun successp (status)
37 | (plusp (logand status sts$m_success)))
38 |
39 | (defun check-status (status caller)
40 | "Call ERROR with a format string that include CALLER and the VMS message
41 | if STATUS does not indicate success."
42 | (unless (successp status)
43 | (error (format nil "Error in ~A:~%~A"
44 | caller
45 | (get-vms-message status)))))
46 |
47 | ;; All VMS system calls return a status value, and most of the time it
48 | ;; is an error if a system call is not successful. To avoid having to
49 | ;; explicitly check the status all the time, the C macro does it implicitly
50 | ;; and calls ERROR if the status does not indicate success.
51 | (defmacro c (&rest call)
52 | (let ((status (gensym)))
53 | `(let ((,status (call-out ,@call)))
54 | (check-status ,status ',call))))
55 |
56 | ;; The $QIOW macro turns the 12 arguments that need to be supplied to
57 | ;; the SYS$QIOW system service into keyword parameters. This makes
58 | ;; the call sites much cleaner.
59 | (defmacro $QIOW (chan func iosb
60 | &key
61 | (efn 0)
62 | astadr
63 | astprm
64 | p1 p2 p3 p4 p5 p6)
65 | `(c SYS$QIOW
66 | ,efn ,chan ,func ,iosb ,astadr ,astprm
67 | ,p1 ,p2 ,p3 ,p4 ,p5 ,p6))
68 |
69 | ;; Often, we need to invoke SYS$QIOW and check the status in the I/O status
70 | ;; block in addition to the status returned by the system call itself. This
71 | ;; macro creates and IOSB, invokes SYS$QIOW checking its return value and
72 | ;; checks the IOSB status as well.
73 | (defmacro $QIOW/check-iosb (chan func
74 | &key
75 | (efn 0)
76 | astadr
77 | astprm
78 | p1 p2 p3 p4 p5 p6)
79 | (let ((iosb (gensym)))
80 | `(let ((,iosb (make-iosb :allocation :static)))
81 | (c SYS$QIOW
82 | ,efn ,chan ,func ,iosb ,astadr ,astprm
83 | ,p1 ,p2 ,p3 ,p4 ,p5 ,p6)
84 | (check-status (iosb-status ,iosb) ',func))))
85 |
--------------------------------------------------------------------------------