[OpenSPARC-T2-SAM] / obp / obp / fm / kernel / disk.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: disk.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
\ disk.fth 2.11 01/04/06
\ Copyright 1985-1994 Bradley Forthware
\ copyright: Copyright 1994-2001 Sun Microsystems, Inc.  All Rights Reserved

\ High level interface to disk files.

headerless

\ If the underlying operating system requires that files be accessed
\ in fixed-length records, then /fbuf must be a multiple of that length.
\ Even if the system allows arbitrary length file accesses, there is probably
\ a length that is particularly efficient, and /fbuf should be a multiple
\ of that length for best performance.  1K works well for many systems.

td 1024 constant /fbuf

headerless

\ An implementation factor which gets a file descriptor and attaches a
\ file buffer to it
headerless
: get-fd  ( -- )
   (get-fd  dup 0= ( ?? ) abort" all fds used "  ( fd )
   file !
   /fbuf alloc-mem  /fbuf initbuf     ( )
;
headers
\ Amount of space needed:
\   #fds * /fd     for automatically allocated file descriptors
\   1 * /fd        for "accept" descriptor
\   tib            for "accept" buffer
\
\ #fds = 8, so total of 9 * /fd  = 9 * 56 = 486 for fds
\ 8 * 1024 +  3 * 128  +  tib
\ Total is ~9K

\ Returns the current position within the current file

: dftell  ( fd -- d.byte# )
   file @ >r  file !  fstart 2@  bfcurrent @ bfbase @ -  0 d+  r> file !
;
: ftell  ( fd -- byte# )  dftell drop  ;

\ Updates the disk copy of the file to match the buffer
headerless
: fflush  ( fd -- )  file @ >r  file !  ?flushbuf  r> file !  ;
headers
\ Starting here, some stuff doesn't have to be in the kernel

\ Sets the position within the current file to "d.byte#".
: dfseek  ( d.byte# fd -- )
   file @ >r  file !
   bfsync

   \ See if the desired byte is in the buffer
   \ The byte is in the buffer iff offset.high is 0 and offset.low
   \ is less than the number of bytes in the buffer
   2dup fstart 2@ d-                   ( d.byte# offset.low offset.high )
   over bfend @ bfbase @ -  u>= or  if ( d.byte# offset )
      \ Not in buffer
      \ Flush the buffer and get the one containing the desired byte.
      drop ?flushbuf 2dup fillbuf      ( d.byte# )
      >bufaddr                         ( bufaddr )
   else
      \ The desired byte is already in the buffer.
      nip nip  bfbase @ +           ( bufaddr )
   then

   \ Seeking past end of file actually goes to the end of the file
   bftop @  umin   bfcurrent !
   r> file !
;
: fseek  ( byte# fd -- )  0 swap dfseek  ;

\ Returns true if the current file has reached the end.
\ XXX This may only be valid after fseek or shortseek
headerless
: (feof?  ( -- f )   bfcurrent @  bftop @  u>=  ;

headers
\ Gets the next byte from the current file
: fgetc  ( fd -- byte )
   file @ >r  file !   bfcurrent @  bftop @  u<
   if   \ desired character is in the buffer
      bfcurrent @c@++
   else \ end of buffer has been reached
      bfcurrent @ shortseek
      (feof?  if  eof  else  bfcurrent @c@++  then
   then
   r> file !
;

\ Stores a byte into the current file at the next position
: fputc  ( byte fd -- )
   file @ >r  file !
   bfcurrent @   bfend @ u>=     ( byte flag )  \ Is the buffer full?
   if  bfcurrent @ shortseek  then     ( byte ) \ If so advance to next buffer
   bfcurrent @c!++  bfdirty on
   r> file !
;

\ An implementation factor
\ Copyin copies bytes starting at current into the file buffer at
\ bfcurrent.  The number of bytes copied is either all the bytes from
\ current to end, if the buffer has enough room, or all the bytes the
\ buffer will hold, if not.
\ newcurrent is left pointing to the first byte not copied.
headerless
: copyin  ( end current -- end newcurrent )
   2dup -                      ( end current remaining )
   bfend @  bfcurrent @  -     ( end current remaining bfremaining )
   min                         ( end current #bytes-to-copy )
   dup if  bfdirty on  then    ( end current #bytes-to-copy )
   2dup  bfcurrent @ swap      ( end current #bytes  current bfcurrent #bytes)
   move                        ( end current #bytes )
   dup bfcurrent +!            ( end current #bytes )
   +                           ( end newcurrent)
;

\ Copyout copies bytes from the file buffer into memory starting at current.
\ The number of bytes copied is either enough to fill memory up to end,
\ if the buffer has enough characters, or all the bytes the
\ buffer has left, if not.
\ newcurrent is left pointing to the first byte not filled.
headerless
: copyout  ( end current -- end newcurrent )
   2dup -                      ( end current remaining )
   bftop @  bfcurrent @  -     ( end current remaining bfrem )
   min                         ( end current #bytes-to-copy)
   2dup bfcurrent @ rot rot    ( end current #bytes  current bfcurrent #bytes)
   move                        ( end current #bytes)
   dup  bfcurrent +!           ( end current #bytes)
   +                           ( end newcurrent )
;
headers
\ Writes count bytes from memory starting at "adr" to the current file
: fputs  ( adr count fd -- )
   file @ >r  file !
   over + swap  ( endaddr startaddr )
   begin  copyin  2dup u>
   while
      \ Here there should be some code to see if there are enough remaining
      \ bytes in the request to justify bypassing the file buffer and writing
      \ directly from the user's buffer.  'Enough' = more than one file buffer
      bfsync  bfcurrent @ shortseek ( endaddr curraddr )
   repeat
   2drop
   r> file !
;

\ Reads up to count characters from the file into memory starting
\ at "adr"

: fgets  ( adr count fd -- #read )
   file @ >r  file !
   bfsync
   over + over  ( startaddr endaddr startaddr )
   begin  copyout  2dup u>
   while
      \ Here there should be some code to see if there are enough remaining
      \ bytes in the request to justify bypassing the file buffer and reading
      \ directly to the user's buffer.  'Enough' = more than one file buffer
      bfcurrent @ shortseek ( startaddr endaddr curraddr )
      (feof?  if  nip swap -  r> file !  exit then
   repeat
   nip swap -
   r> file !
;

\ Returns the current length of the file
: dfsize  ( fd -- d.size )
   file @ >r  file !
   fstart 2@  bftop @  bfbase @  -  0 d+  ( buffered-position )
   fid @  sizeop @  execute               ( buffered-position file-size )
   dmax
   r> file !
;
: fsize  ( fd -- size )  dfsize drop  ;


\ End of stuff that doesn't have to be in the kernel

defer do-fopen

\ Prepares a file for later access, returning "fd" which is subsequently
\ used to refer to the file.

: fopen  ( name mode -- fd )
   2 ?enough
   get-fd   ( name mode )  over >r
   do-fopen  if
      setupfd  file @  r> count set-name
   else
      not-open fmode !  0  r> drop
   then
;

headers

\ Closes all the open files and reclaims their file descriptors.
\ Use this if you see an "all fds used" message.

: close-files ( -- )  fds @  /fds  bounds   do   i fclose   /fd +loop  ;

: create-file  ( name$ mode -- fileid ior )  create-flag or  open-file  ;

: make  ( name-pstr -- flag )	\ Creates an empty file
   count  r/w  create-file  if  drop false  else  close-file drop true  then
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: disk.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	\ disk.fth 2.11 01/04/06
	43	\ Copyright 1985-1994 Bradley Forthware
	44	\ copyright: Copyright 1994-2001 Sun Microsystems, Inc. All Rights Reserved
	45
	46	\ High level interface to disk files.
	47
	48	headerless
	49
	50	\ If the underlying operating system requires that files be accessed
	51	\ in fixed-length records, then /fbuf must be a multiple of that length.
	52	\ Even if the system allows arbitrary length file accesses, there is probably
	53	\ a length that is particularly efficient, and /fbuf should be a multiple
	54	\ of that length for best performance. 1K works well for many systems.
	55
	56	td 1024 constant /fbuf
	57
	58	headerless
	59
	60	\ An implementation factor which gets a file descriptor and attaches a
	61	\ file buffer to it
	62	headerless
	63	: get-fd ( -- )
	64	(get-fd dup 0= ( ?? ) abort" all fds used " ( fd )
65	file !
66	/fbuf alloc-mem /fbuf initbuf ( )
67	;
68	headers
69	\ Amount of space needed:
70	\ #fds * /fd for automatically allocated file descriptors
71	\ 1 * /fd for "accept" descriptor
72	\ tib for "accept" buffer
73	\
74	\ #fds = 8, so total of 9 * /fd = 9 * 56 = 486 for fds
75	\ 8 * 1024 + 3 * 128 + tib
76	\ Total is ~9K
77
78	\ Returns the current position within the current file
79
80	: dftell ( fd -- d.byte# )
81	file @ >r file ! fstart 2@ bfcurrent @ bfbase @ - 0 d+ r> file !
82	;
83	: ftell ( fd -- byte# ) dftell drop ;
84
85	\ Updates the disk copy of the file to match the buffer
86	headerless
87	: fflush ( fd -- ) file @ >r file ! ?flushbuf r> file ! ;
88	headers
89	\ Starting here, some stuff doesn't have to be in the kernel
90
91	\ Sets the position within the current file to "d.byte#".
92	: dfseek ( d.byte# fd -- )
93	file @ >r file !
94	bfsync
95
96	\ See if the desired byte is in the buffer
97	\ The byte is in the buffer iff offset.high is 0 and offset.low
98	\ is less than the number of bytes in the buffer
99	2dup fstart 2@ d- ( d.byte# offset.low offset.high )
100	over bfend @ bfbase @ - u>= or if ( d.byte# offset )
101	\ Not in buffer
102	\ Flush the buffer and get the one containing the desired byte.
103	drop ?flushbuf 2dup fillbuf ( d.byte# )
104	>bufaddr ( bufaddr )
105	else
106	\ The desired byte is already in the buffer.
107	nip nip bfbase @ + ( bufaddr )
108	then
109
110	\ Seeking past end of file actually goes to the end of the file
111	bftop @ umin bfcurrent !
112	r> file !
113	;
114	: fseek ( byte# fd -- ) 0 swap dfseek ;
115
116	\ Returns true if the current file has reached the end.
117	\ XXX This may only be valid after fseek or shortseek
118	headerless
119	: (feof? ( -- f ) bfcurrent @ bftop @ u>= ;
120
121	headers
122	\ Gets the next byte from the current file
123	: fgetc ( fd -- byte )
124	file @ >r file ! bfcurrent @ bftop @ u<
125	if \ desired character is in the buffer
126	bfcurrent @c@++
127	else \ end of buffer has been reached
128	bfcurrent @ shortseek
129	(feof? if eof else bfcurrent @c@++ then
130	then
131	r> file !
132	;
133
134	\ Stores a byte into the current file at the next position
135	: fputc ( byte fd -- )
136	file @ >r file !
137	bfcurrent @ bfend @ u>= ( byte flag ) \ Is the buffer full?
138	if bfcurrent @ shortseek then ( byte ) \ If so advance to next buffer
139	bfcurrent @c!++ bfdirty on
140	r> file !
141	;
142
143	\ An implementation factor
144	\ Copyin copies bytes starting at current into the file buffer at
145	\ bfcurrent. The number of bytes copied is either all the bytes from
146	\ current to end, if the buffer has enough room, or all the bytes the
147	\ buffer will hold, if not.
148	\ newcurrent is left pointing to the first byte not copied.
149	headerless
150	: copyin ( end current -- end newcurrent )
151	2dup - ( end current remaining )
152	bfend @ bfcurrent @ - ( end current remaining bfremaining )
153	min ( end current #bytes-to-copy )
154	dup if bfdirty on then ( end current #bytes-to-copy )
155	2dup bfcurrent @ swap ( end current #bytes current bfcurrent #bytes)
156	move ( end current #bytes )
157	dup bfcurrent +! ( end current #bytes )
158	+ ( end newcurrent)
159	;
160
161	\ Copyout copies bytes from the file buffer into memory starting at current.
162	\ The number of bytes copied is either enough to fill memory up to end,
163	\ if the buffer has enough characters, or all the bytes the
164	\ buffer has left, if not.
165	\ newcurrent is left pointing to the first byte not filled.
166	headerless
167	: copyout ( end current -- end newcurrent )
168	2dup - ( end current remaining )
169	bftop @ bfcurrent @ - ( end current remaining bfrem )
170	min ( end current #bytes-to-copy)
171	2dup bfcurrent @ rot rot ( end current #bytes current bfcurrent #bytes)
172	move ( end current #bytes)
173	dup bfcurrent +! ( end current #bytes)
174	+ ( end newcurrent )
175	;
176	headers
177	\ Writes count bytes from memory starting at "adr" to the current file
178	: fputs ( adr count fd -- )
179	file @ >r file !
180	over + swap ( endaddr startaddr )
181	begin copyin 2dup u>
182	while
183	\ Here there should be some code to see if there are enough remaining
184	\ bytes in the request to justify bypassing the file buffer and writing
185	\ directly from the user's buffer. 'Enough' = more than one file buffer
186	bfsync bfcurrent @ shortseek ( endaddr curraddr )
187	repeat
188	2drop
189	r> file !
190	;
191
192	\ Reads up to count characters from the file into memory starting
193	\ at "adr"
194
195	: fgets ( adr count fd -- #read )
196	file @ >r file !
197	bfsync
198	over + over ( startaddr endaddr startaddr )
199	begin copyout 2dup u>
200	while
201	\ Here there should be some code to see if there are enough remaining
202	\ bytes in the request to justify bypassing the file buffer and reading
203	\ directly to the user's buffer. 'Enough' = more than one file buffer
204	bfcurrent @ shortseek ( startaddr endaddr curraddr )
205	(feof? if nip swap - r> file ! exit then
206	repeat
207	nip swap -
208	r> file !
209	;
210
211	\ Returns the current length of the file
212	: dfsize ( fd -- d.size )
213	file @ >r file !
214	fstart 2@ bftop @ bfbase @ - 0 d+ ( buffered-position )
215	fid @ sizeop @ execute ( buffered-position file-size )
216	dmax
217	r> file !
218	;
219	: fsize ( fd -- size ) dfsize drop ;
220
221
222	\ End of stuff that doesn't have to be in the kernel
223
224	defer do-fopen
225
226	\ Prepares a file for later access, returning "fd" which is subsequently
227	\ used to refer to the file.
228
229	: fopen ( name mode -- fd )
230	2 ?enough
231	get-fd ( name mode ) over >r
232	do-fopen if
233	setupfd file @ r> count set-name
234	else
235	not-open fmode ! 0 r> drop
236	then
237	;
238
239	headers
240
241	\ Closes all the open files and reclaims their file descriptors.
242	\ Use this if you see an "all fds used" message.
243
244	: close-files ( -- ) fds @ /fds bounds do i fclose /fd +loop ;
245
246	: create-file ( name$ mode -- fileid ior ) create-flag or open-file ;
247
248	: make ( name-pstr -- flag ) \ Creates an empty file
249	count r/w create-file if drop false else close-file drop true then
250	;