[OpenSPARC-T2-SAM] / obp / obp / dev / sun4v-devices / vcommon / vio-methods.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: vio-methods.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 ============================================
id: @(#)vio-methods.fth 1.3 06/12/21
purpose: This file contains methods shared by VIO devices
copyright: Copyright 2006 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless
fload ${BP}/dev/utilities/cif.fth
headerless
0 value		nego-good?
0 value		current-vio-dev
defer claim   ( align size virt -- base )     0 " claim" do-cif is claim
defer release ( size virt -- )  0 " release" do-cif is release

defer send-vio-ver-msg ( -- ok? )  ' false  is send-vio-ver-msg
defer send-vio-ack-msg ( buf ack -- ok? )   ' drop  is send-vio-ack-msg
defer vio-compatible-ver? ( buf - yes? )    ' noop  is vio-compatible-ver?
defer retrieve-packet ( buf len -- #bytes ) ' drop  is retrieve-packet
defer send-vio-attr ( -- ok? )    ' false  is send-vio-attr
defer send-vio-rdx  ( -- ok? )    ' false  is send-vio-rdx
defer update-vd-disk-type ( buf -- )  ' drop is update-vd-disk-type

\ Fill in buffer with VIO msg tag information
: set-vio-msg-tag  ( type subtype env buf -- )
   tuck >vio-subtype-env w!		( type subtype buf )
   tuck >vio-subtype c!			( type buf )
   >vio-msgtype c!			( )
;

\ Get VIO msg tags
: get-vio-msg-tag  ( buf -- env subtype type )
   dup >vio-subtype-env w@		( buf env )
   swap dup >vio-subtype c@		( env buf subtype )
   swap >vio-msgtype c@
;

\ Check if the tags match each other
: vio-tag-match?  ( env' stype' type' env stype type -- match? )
  3 pick = >r 3 pick = r> and >r 3 pick = r> and nip nip nip
;

\ Fill in version numbers
: set-vio-msg-ver  ( devt minor major buf -- )
   tuck >vio-ver-major w!		( devt minor buf )
   tuck >vio-ver-minor w!		( devt buf )
   >vio-dev-type c!			( )
;

: round-up   ( value mod -- value' )  1- tuck + swap invert and  ;

\ This word is called by version-negotiation
\ Return different status for different pkts received
: handle-ver-response  ( buf subtype --  ok? done? )
   case                                         ( buf subtype )
      vio-subtype-info of                       ( buf )
         nego-good? if 
            vio-subtype-ack send-vio-ack-msg    ( ok )
            drop true true exit 		( true true )
	 then

         dup vio-compatible-ver? if             ( buf )
            vio-subtype-ack send-vio-ack-msg    ( ok )
            drop true true
         else cmn-warn[ " Version incompatible!" ]cmn-end
            vio-subtype-nack send-vio-ack-msg	( ok )
            drop false true 			( false true )
	 then
      endof

      vio-subtype-ack  of                       ( buf )
         true to nego-good?
         drop true true 			( true true )
      endof

      vio-subtype-nack  of
         drop false true			( false true )
      endof

      ( default )
      \ Unknown subtype, skip
      nip false false rot			( false false subtype )
   endcase
;

\ Read from LDC channel
\    ACK -> set good version, continue
\    NACK -> exit with error status
\    VER-INFO ->
\       good version -> ack, exit with good status, otherwise:
\       = our version  -> ack, exit with good status
\       <> our version -> nack back msg, continue
\    no more msg -> exit with error status
: version-negotiation  ( buf -- ok? )
   send-vio-ver-msg 0= if
      cmn-warn[ " Version-negotiation: Can't send version message!"
      ]cmn-end
      drop false exit			( false ) 
   then
   0 to nego-good?
   begin                                ( buf )
      dup /vio-ver-msg retrieve-packet  ( buf alen )
      dup /vio-ver-msg = if             ( buf alen )
         drop dup >vio-msgtype c@       ( buf type )
         vio-msg-type-ctrl = if         ( buf )

            dup dup >vio-subtype c@     ( buf buf subtype )
            handle-ver-response         ( buf ok? done? )
            if nip exit then 		( ok? )

         \ Not control type of message, skip to next one
         else				( buf ) 
	    false 			( buf false )
	 then

      else \ received data len not good ( buf alen )

         \ Garbage, skip
         if 				( buf )
	    false                       ( buf false )

         \ No more pkts to receive
         else 				( buf )
	    drop false exit 		( !ok )
	 then				( ok? )
      then				( buf alen )
   until				( buf )
;

0 value received-rdx?		\ received RDX from server
0 value received-rdx-ack?	\ recieved ACK for our own RDX message

\ A full duplex channel is established when two conditions have been met:
\    1. We've received and RDX from the server and sent an ACK.
\    2. We're recieved an ACK for our own RDX packet.
\ VSW requires that both 1 and 2 be completed.
\ VDS requires only step 2 (in fact early versions do not send an RDX at all)
\ In order to support both old and new versions of VDS we set the recieved-rdx?
\ flag to true for VDS so that if we don't receive an RDX we will fall through
\ the begin-until loop once we've received our RDX-ACK and continue on.

\ Newer versions of VDS that require a full-duplex channel will hold off on
\ issuing an RDX-ACK until they've sent their own RDX and received an ACK thus
\ keeping OBP in this loop until the negotiation is complete.
: complete-rdx-handshake  ( buf -- yes? )
   0 to received-rdx?
   0 to received-rdx-ack?
   current-vio-dev vdev-disk-client = if		( buf )
      true to received-rdx?				( buf )
   then							( buf )
   begin						( buf )
      dup /vio-msg-tag retrieve-packet if		( buf )
         dup get-vio-msg-tag 				( buf env stype type )
	 vio-rdx vio-subtype-ack vio-msg-type-ctrl 
	 vio-tag-match? if				( buf )
	    true to received-rdx-ack?			( buf )
	 then						( buf )
         dup get-vio-msg-tag 				( buf env stype type )
	 vio-rdx vio-subtype-info vio-msg-type-ctrl 
	 vio-tag-match?  if 				( buf )
	    dup vio-subtype-ack send-vio-ack-msg drop	( buf )		
	    true to received-rdx?			( buf )
	 then
      else 		\ retrieve-packet returns 0, no more packets
         drop false exit				( false )
      then						( buf )
      received-rdx? received-rdx-ack? and		( buf done? )
   until						( buf )
   drop true						( true )
;

\ Send RDX and expect server side RDX
: handle-vio-rdx  ( buf -- ok? done? )
   dup send-vio-rdx  if                   	( buf )
      complete-rdx-handshake if				(  ) 
	 true true				( true true )
      else 
	 false true 				( false true )
      then
   else
      cmn-warn[ " Can't send RDX message!" ]cmn-end
      drop false true 				( false true )
   then
;

\ Read from LDC channel
\    ACK ->  continue
\    NACK -> exit with error status
\    ATTR-INFO -> ack 
\        -> send RDX, wait for responding RDX
\                    -> Arrived: exit with good status
\                    -> Not arrived: exit with error status
\    no more msg -> exit with error status
: handle-attr-response  ( buf subtype -- ok? done? )
   case							( buf subtype )
      vio-subtype-info of                      		( buf )
         dup vio-subtype-ack send-vio-ack-msg drop    	( buf )
         dup >vio-subtype-env  w@                       ( buf env )
         vio-attr-info = if				( buf )
            current-vio-dev vdev-disk-client = if               
               dup update-vd-disk-type 			( buf )
            then
         then
         handle-vio-rdx					( ok? done? )
         true to nego-good?
      endof

      vio-subtype-ack   of			( buf )
         dup >vio-subtype-env w@		( buf env )
         vio-attr-info = if 			( buf )
            current-vio-dev vdev-disk-client = if               
               dup update-vd-disk-type 		( buf )
            then

            \ Check if RDX not sent, send now
            nego-good? if			( buf )
               drop true true			( true true )
            else				( buf )
               handle-vio-rdx
            then
         else					( buf )
            drop false false			( false false )
         then
      endof

      vio-subtype-nack  of			( buf )
         drop false true			( false true )
      endof

      ( default ) \ skip unexpected types
      nip false false rot 			( false false subtype )
   endcase					
;

\ Send attr packet, handle responses
: vio-exchange-attr  ( buf len -- ok? )
   send-vio-attr 0= if                          ( buf len )
      cmn-warn[ " Can't send attribute message!" ]cmn-end
      2drop false exit				( false ) 
   then

   0 to nego-good?
   begin                                        ( buf len )
      2dup retrieve-packet 2dup               	( buf len alen len alen )
      =   if					( buf len alen )
         drop over >vio-msgtype c@		( buf len type )
         vio-msg-type-ctrl = if                 ( buf len )

            over dup >vio-subtype c@		( buf len buf subtype )
            handle-attr-response                ( buf len ok? done? )
            if nip nip exit then		( ok? )

         \ Not CTRL type of msg, skip to next one
         else 					( buf len )
	    false 				( buf len false )
	 then

      else \ received data len not good         ( buf len alen )

         \ Garbage, skip
         if 					( buf len )
	    false				( buf len false )

         \ No more pkts to receive, alen = 0
         else 					( buf len )
	    2drop false exit 			( !ok )
	 then
      then
   until
;

: fill-in-vio-cookie  ( cadr #ck len buf -- )
   2swap 0 do				( len buf cadr )
      swap dup rot                      ( len buf buf cadr )
      dup x@                            ( len buf buf cadr cookie )
      rot >ldc-mem-caddr x!             ( len buf cadr )
      over >ldc-mem-csize               ( len buf cadr buf' )
      3 pick pagesize min 8 round-up 	( len buf cadr buf' len' )
      dup >r 				( len buf cadr buf' len' ) ( R: len' )
      swap x!				( len buf cadr ) ( R: len' )
      rot r> - -rot			( len'' buf cadr )
      8 + swap /ldc-mem-cookie +        ( len'' cadr' buf'' )
      swap				( len'' buf'' cadr' )
   loop 2drop drop
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: vio-methods.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	id: @(#)vio-methods.fth 1.3 06/12/21
	43	purpose: This file contains methods shared by VIO devices
	44	copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	headerless
	48	fload ${BP}/dev/utilities/cif.fth
	49	headerless
	50	0 value nego-good?
	51	0 value current-vio-dev
	52	defer claim ( align size virt -- base ) 0 " claim" do-cif is claim
	53	defer release ( size virt -- ) 0 " release" do-cif is release
	54
	55	defer send-vio-ver-msg ( -- ok? ) ' false is send-vio-ver-msg
	56	defer send-vio-ack-msg ( buf ack -- ok? ) ' drop is send-vio-ack-msg
	57	defer vio-compatible-ver? ( buf - yes? ) ' noop is vio-compatible-ver?
	58	defer retrieve-packet ( buf len -- #bytes ) ' drop is retrieve-packet
	59	defer send-vio-attr ( -- ok? ) ' false is send-vio-attr
	60	defer send-vio-rdx ( -- ok? ) ' false is send-vio-rdx
	61	defer update-vd-disk-type ( buf -- ) ' drop is update-vd-disk-type
	62
	63	\ Fill in buffer with VIO msg tag information
	64	: set-vio-msg-tag ( type subtype env buf -- )
65	tuck >vio-subtype-env w! ( type subtype buf )
66	tuck >vio-subtype c! ( type buf )
67	>vio-msgtype c! ( )
68	;
69
70	\ Get VIO msg tags
71	: get-vio-msg-tag ( buf -- env subtype type )
72	dup >vio-subtype-env w@ ( buf env )
73	swap dup >vio-subtype c@ ( env buf subtype )
74	swap >vio-msgtype c@
75	;
76
77	\ Check if the tags match each other
78	: vio-tag-match? ( env' stype' type' env stype type -- match? )
79	3 pick = >r 3 pick = r> and >r 3 pick = r> and nip nip nip
80	;
81
82	\ Fill in version numbers
83	: set-vio-msg-ver ( devt minor major buf -- )
84	tuck >vio-ver-major w! ( devt minor buf )
85	tuck >vio-ver-minor w! ( devt buf )
86	>vio-dev-type c! ( )
87	;
88
89	: round-up ( value mod -- value' ) 1- tuck + swap invert and ;
90
91	\ This word is called by version-negotiation
92	\ Return different status for different pkts received
93	: handle-ver-response ( buf subtype -- ok? done? )
94	case ( buf subtype )
95	vio-subtype-info of ( buf )
96	nego-good? if
97	vio-subtype-ack send-vio-ack-msg ( ok )
98	drop true true exit ( true true )
99	then
100
101	dup vio-compatible-ver? if ( buf )
102	vio-subtype-ack send-vio-ack-msg ( ok )
103	drop true true
104	else cmn-warn[ " Version incompatible!" ]cmn-end
105	vio-subtype-nack send-vio-ack-msg ( ok )
106	drop false true ( false true )
107	then
108	endof
109
110	vio-subtype-ack of ( buf )
111	true to nego-good?
112	drop true true ( true true )
113	endof
114
115	vio-subtype-nack of
116	drop false true ( false true )
117	endof
118
119	( default )
120	\ Unknown subtype, skip
121	nip false false rot ( false false subtype )
122	endcase
123	;
124
125	\ Read from LDC channel
126	\ ACK -> set good version, continue
127	\ NACK -> exit with error status
128	\ VER-INFO ->
129	\ good version -> ack, exit with good status, otherwise:
130	\ = our version -> ack, exit with good status
131	\ <> our version -> nack back msg, continue
132	\ no more msg -> exit with error status
133	: version-negotiation ( buf -- ok? )
134	send-vio-ver-msg 0= if
135	cmn-warn[ " Version-negotiation: Can't send version message!"
136	]cmn-end
137	drop false exit ( false )
138	then
139	0 to nego-good?
140	begin ( buf )
141	dup /vio-ver-msg retrieve-packet ( buf alen )
142	dup /vio-ver-msg = if ( buf alen )
143	drop dup >vio-msgtype c@ ( buf type )
144	vio-msg-type-ctrl = if ( buf )
145
146	dup dup >vio-subtype c@ ( buf buf subtype )
147	handle-ver-response ( buf ok? done? )
148	if nip exit then ( ok? )
149
150	\ Not control type of message, skip to next one
151	else ( buf )
152	false ( buf false )
153	then
154
155	else \ received data len not good ( buf alen )
156
157	\ Garbage, skip
158	if ( buf )
159	false ( buf false )
160
161	\ No more pkts to receive
162	else ( buf )
163	drop false exit ( !ok )
164	then ( ok? )
165	then ( buf alen )
166	until ( buf )
167	;
168
169	0 value received-rdx? \ received RDX from server
170	0 value received-rdx-ack? \ recieved ACK for our own RDX message
171
172	\ A full duplex channel is established when two conditions have been met:
173	\ 1. We've received and RDX from the server and sent an ACK.
174	\ 2. We're recieved an ACK for our own RDX packet.
175	\ VSW requires that both 1 and 2 be completed.
176	\ VDS requires only step 2 (in fact early versions do not send an RDX at all)
177	\ In order to support both old and new versions of VDS we set the recieved-rdx?
178	\ flag to true for VDS so that if we don't receive an RDX we will fall through
179	\ the begin-until loop once we've received our RDX-ACK and continue on.
180
181	\ Newer versions of VDS that require a full-duplex channel will hold off on
182	\ issuing an RDX-ACK until they've sent their own RDX and received an ACK thus
183	\ keeping OBP in this loop until the negotiation is complete.
184	: complete-rdx-handshake ( buf -- yes? )
185	0 to received-rdx?
186	0 to received-rdx-ack?
187	current-vio-dev vdev-disk-client = if ( buf )
188	true to received-rdx? ( buf )
189	then ( buf )
190	begin ( buf )
191	dup /vio-msg-tag retrieve-packet if ( buf )
192	dup get-vio-msg-tag ( buf env stype type )
193	vio-rdx vio-subtype-ack vio-msg-type-ctrl
194	vio-tag-match? if ( buf )
195	true to received-rdx-ack? ( buf )
196	then ( buf )
197	dup get-vio-msg-tag ( buf env stype type )
198	vio-rdx vio-subtype-info vio-msg-type-ctrl
199	vio-tag-match? if ( buf )
200	dup vio-subtype-ack send-vio-ack-msg drop ( buf )
201	true to received-rdx? ( buf )
202	then
203	else \ retrieve-packet returns 0, no more packets
204	drop false exit ( false )
205	then ( buf )
206	received-rdx? received-rdx-ack? and ( buf done? )
207	until ( buf )
208	drop true ( true )
209	;
210
211	\ Send RDX and expect server side RDX
212	: handle-vio-rdx ( buf -- ok? done? )
213	dup send-vio-rdx if ( buf )
214	complete-rdx-handshake if ( )
215	true true ( true true )
216	else
217	false true ( false true )
218	then
219	else
220	cmn-warn[ " Can't send RDX message!" ]cmn-end
221	drop false true ( false true )
222	then
223	;
224
225	\ Read from LDC channel
226	\ ACK -> continue
227	\ NACK -> exit with error status
228	\ ATTR-INFO -> ack
229	\ -> send RDX, wait for responding RDX
230	\ -> Arrived: exit with good status
231	\ -> Not arrived: exit with error status
232	\ no more msg -> exit with error status
233	: handle-attr-response ( buf subtype -- ok? done? )
234	case ( buf subtype )
235	vio-subtype-info of ( buf )
236	dup vio-subtype-ack send-vio-ack-msg drop ( buf )
237	dup >vio-subtype-env w@ ( buf env )
238	vio-attr-info = if ( buf )
239	current-vio-dev vdev-disk-client = if
240	dup update-vd-disk-type ( buf )
241	then
242	then
243	handle-vio-rdx ( ok? done? )
244	true to nego-good?
245	endof
246
247	vio-subtype-ack of ( buf )
248	dup >vio-subtype-env w@ ( buf env )
249	vio-attr-info = if ( buf )
250	current-vio-dev vdev-disk-client = if
251	dup update-vd-disk-type ( buf )
252	then
253
254	\ Check if RDX not sent, send now
255	nego-good? if ( buf )
256	drop true true ( true true )
257	else ( buf )
258	handle-vio-rdx
259	then
260	else ( buf )
261	drop false false ( false false )
262	then
263	endof
264
265	vio-subtype-nack of ( buf )
266	drop false true ( false true )
267	endof
268
269	( default ) \ skip unexpected types
270	nip false false rot ( false false subtype )
271	endcase
272	;
273
274	\ Send attr packet, handle responses
275	: vio-exchange-attr ( buf len -- ok? )
276	send-vio-attr 0= if ( buf len )
277	cmn-warn[ " Can't send attribute message!" ]cmn-end
278	2drop false exit ( false )
279	then
280
281	0 to nego-good?
282	begin ( buf len )
283	2dup retrieve-packet 2dup ( buf len alen len alen )
284	= if ( buf len alen )
285	drop over >vio-msgtype c@ ( buf len type )
286	vio-msg-type-ctrl = if ( buf len )
287
288	over dup >vio-subtype c@ ( buf len buf subtype )
289	handle-attr-response ( buf len ok? done? )
290	if nip nip exit then ( ok? )
291
292	\ Not CTRL type of msg, skip to next one
293	else ( buf len )
294	false ( buf len false )
295	then
296
297	else \ received data len not good ( buf len alen )
298
299	\ Garbage, skip
300	if ( buf len )
301	false ( buf len false )
302
303	\ No more pkts to receive, alen = 0
304	else ( buf len )
305	2drop false exit ( !ok )
306	then
307	then
308	until
309	;
310
311	: fill-in-vio-cookie ( cadr #ck len buf -- )
312	2swap 0 do ( len buf cadr )
313	swap dup rot ( len buf buf cadr )
314	dup x@ ( len buf buf cadr cookie )
315	rot >ldc-mem-caddr x! ( len buf cadr )
316	over >ldc-mem-csize ( len buf cadr buf' )
317	3 pick pagesize min 8 round-up ( len buf cadr buf' len' )
318	dup >r ( len buf cadr buf' len' ) ( R: len' )
319	swap x! ( len buf cadr ) ( R: len' )
320	rot r> - -rot ( len'' buf cadr )
321	8 + swap /ldc-mem-cookie + ( len'' cadr' buf'' )
322	swap ( len'' buf'' cadr' )
323	loop 2drop drop
324	;
325