equal
deleted
inserted
replaced
18 \ |
18 \ |
19 \ CDDL HEADER END |
19 \ CDDL HEADER END |
20 \ |
20 \ |
21 \ |
21 \ |
22 \ ident "%Z%%M% %I% %E% SMI" |
22 \ ident "%Z%%M% %I% %E% SMI" |
23 \ Copyright 2007 Sun Microsystems, Inc. All rights reserved. |
23 \ Copyright 2008 Sun Microsystems, Inc. All rights reserved. |
24 \ Use is subject to license terms. |
24 \ Use is subject to license terms. |
25 \ |
25 \ |
26 |
26 |
27 id: %Z%%M% %I% %E% SMI |
27 id: %Z%%M% %I% %E% SMI |
28 purpose: utility words |
28 purpose: utility words |
72 \ advance str by 1 |
72 \ advance str by 1 |
73 : str++ ( adr len -- adr' len' ) |
73 : str++ ( adr len -- adr' len' ) |
74 swap 1+ swap 1- |
74 swap 1+ swap 1- |
75 ; |
75 ; |
76 |
76 |
|
77 : die ( str -- ) |
|
78 cr type cr abort |
|
79 ; |
|
80 |
77 : diag-cr? ( -- ) diagnostic-mode? if cr then ; |
81 : diag-cr? ( -- ) diagnostic-mode? if cr then ; |
78 |
82 |
79 |
83 |
80 : find-abort ( name$ -- ) |
84 : find-abort ( name$ -- ) |
81 ." Can't find " type abort |
85 cr ." Can't find " type cr abort |
82 ; |
86 ; |
83 |
87 |
84 : get-package ( pkg$ -- ph ) |
88 : get-package ( pkg$ -- ph ) |
85 2dup find-package 0= if |
89 2dup find-package 0= if |
86 find-abort |
90 find-abort |
190 \ (currently 244 bytes in size) |
194 \ (currently 244 bytes in size) |
191 d# 256 constant /rd-fcode |
195 d# 256 constant /rd-fcode |
192 d# 8192 /rd-fcode - constant rd-offset |
196 d# 8192 /rd-fcode - constant rd-offset |
193 |
197 |
194 : open-abort ( file$ -- ) |
198 : open-abort ( file$ -- ) |
195 ." Can't open " type abort |
199 cr ." Can't open " type cr abort |
196 ; |
200 ; |
197 |
201 |
198 /buf-len buffer: open-cstr |
202 /buf-len buffer: open-cstr |
199 |
203 |
200 : dev-open ( dev$ -- ih | 0 ) |
204 : dev-open ( dev$ -- ih | 0 ) |
208 cif-close |
212 cif-close |
209 ; |
213 ; |
210 |
214 |
211 : read-disk ( adr len off ih -- ) |
215 : read-disk ( adr len off ih -- ) |
212 dup >r 0 swap cif-seek if ( adr len r: ih ) |
216 dup >r 0 swap cif-seek if ( adr len r: ih ) |
213 ." seek failed" abort |
217 " seek failed" die |
214 then |
218 then |
215 |
219 |
216 tuck swap r> cif-read <> if ( ) |
220 tuck swap r> cif-read <> if ( ) |
217 ." read failed" abort |
221 " read failed" die |
218 then |
222 then |
219 ; |
223 ; |