Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
f4b6d8f4
Commit
f4b6d8f4
authored
24 years ago
by
dtc
Browse files
Options
Downloads
Patches
Plain Diff
Rework the code to allow file offsets greater than the most positive
fixnum which was only around 500Meg, as noted by Martin Cracauer.
parent
bfbe4f7e
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
code/fd-stream.lisp
+20
-18
20 additions, 18 deletions
code/fd-stream.lisp
with
20 additions
and
18 deletions
code/fd-stream.lisp
+
20
−
18
View file @
f4b6d8f4
...
@@ -5,7 +5,7 @@
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.5
0 1999/12/04
16:0
2
:3
4
dtc Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.5
1 2000/06/19
16:0
8
:3
8
dtc Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -207,7 +207,7 @@
...
@@ -207,7 +207,7 @@
)
)
(
let
((
length
(
-
end
start
)))
(
let
((
length
(
-
end
start
)))
(
multiple-value-bind
(
multiple-value-bind
(
count
errno
)
(
count
errno
)
(
unix:unix-write
(
fd-stream-fd
stream
)
base
start
length
)
(
unix:unix-write
(
fd-stream-fd
stream
)
base
start
length
)
(
cond
((
not
count
)
(
cond
((
not
count
)
(
if
(
=
errno
unix:ewouldblock
)
(
if
(
=
errno
unix:ewouldblock
)
...
@@ -399,7 +399,7 @@
...
@@ -399,7 +399,7 @@
(
defun
fd-sout
(
stream
thing
start
end
)
(
defun
fd-sout
(
stream
thing
start
end
)
(
let
((
start
(
or
start
0
))
(
let
((
start
(
or
start
0
))
(
end
(
or
end
(
length
(
the
vector
thing
)))))
(
end
(
or
end
(
length
(
the
vector
thing
)))))
(
declare
(
fixnum
start
end
))
(
declare
(
type
index
start
end
))
(
if
(
stringp
thing
)
(
if
(
stringp
thing
)
(
let
((
last-newline
(
and
(
find
#\newline
(
the
simple-string
thing
)
(
let
((
last-newline
(
and
(
find
#\newline
(
the
simple-string
thing
)
:start
start
:end
end
)
:start
start
:end
end
)
...
@@ -1033,9 +1033,9 @@
...
@@ -1033,9 +1033,9 @@
(
error
"Error fstating ~S: ~A"
(
error
"Error fstating ~S: ~A"
stream
stream
(
unix:get-unix-error-msg
dev
)))
(
unix:get-unix-error-msg
dev
)))
(
if
(
zerop
(
the
index
mode
)
)
(
if
(
zerop
mode
)
nil
nil
(
truncate
(
the
index
size
)
(
fd-stream-element-size
stream
)))))
(
truncate
size
(
fd-stream-element-size
stream
)))))
(
:file-position
(
:file-position
(
fd-stream-file-position
stream
arg1
))))
(
fd-stream-file-position
stream
arg1
))))
...
@@ -1044,16 +1044,15 @@
...
@@ -1044,16 +1044,15 @@
;;;
;;;
(
defun
fd-stream-file-position
(
stream
&optional
newpos
)
(
defun
fd-stream-file-position
(
stream
&optional
newpos
)
(
declare
(
type
fd-stream
stream
)
(
declare
(
type
fd-stream
stream
)
(
type
(
or
in
dex
(
member
nil
:start
:end
))
newpos
))
(
type
(
or
(
in
teger
0
)
(
member
nil
:start
:end
))
newpos
))
(
if
(
null
newpos
)
(
if
(
null
newpos
)
(
system:without-interrupts
(
system:without-interrupts
;; First, find the position of the UNIX file descriptor in the
;; First, find the position of the UNIX file descriptor in the file.
;; file.
(
multiple-value-bind
(
multiple-value-bind
(
posn
errno
)
(
posn
errno
)
(
unix:unix-lseek
(
fd-stream-fd
stream
)
0
unix:l_incr
)
(
unix:unix-lseek
(
fd-stream-fd
stream
)
0
unix:l_incr
)
(
declare
(
type
(
or
in
dex
null
)
posn
))
(
declare
(
type
(
or
(
in
teger
0
)
null
)
posn
))
(
cond
(
(
fixnump
posn
)
(
cond
(
posn
;; Adjust for buffered output:
;; Adjust for buffered output:
;; If there is any output buffered, the *real* file position
;; If there is any output buffered, the *real* file position
;; will be larger than reported by lseek because lseek
;; will be larger than reported by lseek because lseek
...
@@ -1081,8 +1080,9 @@
...
@@ -1081,8 +1080,9 @@
(
error
"Error lseek'ing ~S: ~A"
(
error
"Error lseek'ing ~S: ~A"
stream
stream
(
unix:get-unix-error-msg
errno
)))))))
(
unix:get-unix-error-msg
errno
)))))))
(
let
((
offset
0
)
origin
)
(
let
((
offset
0
)
(
declare
(
type
index
offset
))
origin
)
(
declare
(
type
(
integer
0
)
offset
))
;; Make sure we don't have any output pending, because if we move the
;; Make sure we don't have any output pending, because if we move the
;; file pointer before writing this stuff, it will be written in the
;; file pointer before writing this stuff, it will be written in the
;; wrong location.
;; wrong location.
...
@@ -1095,14 +1095,16 @@
...
@@ -1095,14 +1095,16 @@
(
setf
(
fd-stream-unread
stream
)
nil
)
(
setf
(
fd-stream-unread
stream
)
nil
)
(
setf
(
fd-stream-ibuf-head
stream
)
0
)
(
setf
(
fd-stream-ibuf-head
stream
)
0
)
(
setf
(
fd-stream-ibuf-tail
stream
)
0
)
(
setf
(
fd-stream-ibuf-tail
stream
)
0
)
;; Trash ca
s
hed value for listen, so that we check next time.
;; Trash ca
c
hed value for listen, so that we check next time.
(
setf
(
fd-stream-listen
stream
)
nil
)
(
setf
(
fd-stream-listen
stream
)
nil
)
;; Now move it.
;; Now move it.
(
cond
((
eq
newpos
:start
)
(
cond
((
eq
newpos
:start
)
(
setf
offset
0
origin
unix:l_set
))
(
setf
offset
0
origin
unix:l_set
))
((
eq
newpos
:end
)
((
eq
newpos
:end
)
(
setf
offset
0
origin
unix:l_xtnd
))
(
setf
offset
0
((
typep
newpos
'index
)
origin
unix:l_xtnd
))
((
typep
newpos
'
(
integer
0
))
(
setf
offset
(
*
newpos
(
fd-stream-element-size
stream
))
(
setf
offset
(
*
newpos
(
fd-stream-element-size
stream
))
origin
unix:l_set
))
origin
unix:l_set
))
(
t
(
t
...
@@ -1110,7 +1112,7 @@
...
@@ -1110,7 +1112,7 @@
(
multiple-value-bind
(
multiple-value-bind
(
posn
errno
)
(
posn
errno
)
(
unix:unix-lseek
(
fd-stream-fd
stream
)
offset
origin
)
(
unix:unix-lseek
(
fd-stream-fd
stream
)
offset
origin
)
(
cond
(
(
typep
posn
'fixnum
)
(
cond
(
posn
t
)
t
)
((
eq
errno
unix:espipe
)
((
eq
errno
unix:espipe
)
nil
)
nil
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment