1\
2\ CDDL HEADER START
3\
4\ The contents of this file are subject to the terms of the
5\ Common Development and Distribution License (the "License").
6\ You may not use this file except in compliance with the License.
7\
8\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9\ or http://www.opensolaris.org/os/licensing.
10\ See the License for the specific language governing permissions
11\ and limitations under the License.
12\
13\ When distributing Covered Code, include this CDDL HEADER in each
14\ file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15\ If applicable, add the following below this CDDL HEADER, with the
16\ fields enclosed by brackets "[]" replaced with your own identifying
17\ information: Portions Copyright [yyyy] [name of copyright owner]
18\
19\ CDDL HEADER END
20\
21\
22\ Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
23\ Use is subject to license terms.
24\
25
26purpose: utility words
27copyright: Copyright 2009 Sun Microsystems, Inc. All Rights Reserved
28
29
30d# 256  constant  /buf-len
31
32\
33\	useful counting words
34\
35: roundup ( x y -- x' )  1- tuck +  swap invert and  ;
36
37
38\
39\	various useful string manipulation words
40\
41
42: cstrlen ( cstr -- len )
43   dup begin
44      dup c@
45   while
46      char+
47   repeat swap -
48;
49
50: cscount ( cstr -- adr,len )  dup cstrlen  ;
51
52\ Append str1 to the end of str2
53: $append ( adr,len1 adr,len2 -- )
54   2over 2over  ca+ swap move   ( adr,len1 adr,len2 )
55   rot + ca+ 0 swap c!  drop    (  )
56;
57
58: $=  ( str1$ str2$ -- same? )
59   rot tuck <>  if
60      3drop false exit
61   then  comp 0=
62;
63
64\ advance str by 1
65: str++  ( adr len --  adr' len' )
66   swap 1+  swap 1-
67;
68
69: die  ( str -- )
70   cr  type  cr abort
71;
72
73: diag-cr?  ( -- )  diagnostic-mode?  if  cr  then  ;
74
75
76: find-abort ( name$ -- )
77   cr  ." Can't find " type  cr abort
78;
79
80: get-package ( pkg$ -- ph )
81   2dup  find-package 0=  if
82      find-abort
83   then                       ( pkg$ ph )
84   nip nip                    ( ph )
85;
86
87
88\
89\	CIF words for I/O and memory
90\
91" /openprom/client-services" get-package  constant cif-ph
92
93instance defer cif-open     ( dev$ -- ihandle|0 )
94instance defer cif-close    ( ihandle -- )
95instance defer cif-read     ( len adr ihandle -- #read )
96instance defer cif-seek     ( low high ihandle -- -1|0|1 )
97instance defer cif-release  ( size virt -- )
98
99: find-cif-method ( adr,len -- acf )
100   2dup  cif-ph find-method 0=  if    ( adr,len )
101      find-abort
102   then                               ( adr,len acf )
103   nip nip                            ( acf )
104;
105
106" open"     find-cif-method to cif-open
107" close"    find-cif-method to cif-close
108" read"     find-cif-method to cif-read
109" seek"     find-cif-method to cif-seek
110" release"  find-cif-method to cif-release
111
112
113" /chosen" get-package  constant chosen-ph
114
115: get-property  ( name$ ph -- prop$ )
116   >r 2dup  r>  get-package-property  if   ( name$ )
117      find-abort
118   then                                    ( name$ prop$ )
119   2swap  2drop                            ( prop$ )
120;
121
122: get-string-prop  ( name$ ph -- val$ )
123   get-property decode-string            ( prop$' val$ )
124   2swap 2drop                           ( val$ )
125;
126
127: get-int-prop  ( name$ ph -- n )
128   get-property decode-int               ( prop$' n )
129   nip nip                               ( n )
130;
131
132\
133\	memory allocation
134\	we bypass cif claim so we can do large page
135\	allocations like promif can
136\
137
138" mmu"    chosen-ph  get-int-prop  constant mmu-ih
139
140" memory" chosen-ph  get-int-prop  constant mem-ih
141
142: mmu-claim  ( [ virt ] size align -- base )
143   " claim" mmu-ih $call-method
144;
145
146: mmu-map  ( phys.lo phys.hi virt size -- )
147   -1  " map" mmu-ih $call-method
148;
149
150: mem-claim  ( size align -- phys.lo phys.hi )
151   " claim" mem-ih $call-method
152;
153
154: (mem-alloc)   ( size virt align -- virt )
155   \ claim memory first since it may throw if fragmented
156   rot  2dup swap  mem-claim           ( virt align size phys.lo phys.hi )
157   >r >r  rot ?dup  if                 ( align size virt  r: phys.lo phys.hi )
158      \ we picked virt - zero alignment
159      over 0  mmu-claim                ( align size virt  r: phys.lo phys.hi )
160   else                                ( align size  r: phys.lo phys.hi )
161      \ OBP picks virt - pass alignment
162      2dup swap  mmu-claim             ( align size virt  r: phys.lo phys.hi )
163   then                                ( align size virt  r: phys.lo phys.hi )
164   r> r>  2over swap  mmu-map          ( align size virt )
165   nip nip                             ( virt )
166;
167
168: vmem-alloc ( size virt -- virt )
169   swap  h# 2000 roundup  swap
170   1 (mem-alloc)
171;
172
173: mem-alloc ( size -- virt )
174   h# 2000  roundup
175   0 1 (mem-alloc)
176;
177
178: mem-free  ( virt size -- )
179   h# 2000  roundup
180   swap  cif-release    (  )
181;
182
183
184
185\ put ramdisk fcode 256 bytes from end of bootblk
186\ (currently 244 bytes in size)
187d# 256               constant /rd-fcode
188d# 8192 /rd-fcode -  constant rd-offset
189
190: open-abort  ( file$ -- )
191   cr  ." Can't open "  type  cr abort
192;
193
194/buf-len  buffer: open-cstr
195
196: dev-open ( dev$ -- ih | 0 )
197   \ copy to C string for open
198   0  over open-cstr +  c!
199   open-cstr swap  move
200   open-cstr  cif-open
201;
202
203: dev-close ( ih -- )
204   cif-close
205;
206
207: read-disk    ( adr len off ih -- )
208   dup >r  0 swap  cif-seek  if     ( adr len  r: ih )
209      " seek failed"  die
210   then
211
212   tuck  swap r>  cif-read  <>  if  (  )
213      " read failed"  die
214   then
215;
216