1\ #ident "%Z%%M% %I% %E% SMI" 2\ purpose: 3\ copyright: Copyright 2005 Sun Microsystems, Inc. All rights reserved. 4\ copyright: Use is subject to license terms. 5\ copyright: 6\ copyright: CDDL HEADER START 7\ copyright: 8\ copyright: The contents of this file are subject to the terms of the 9\ copyright: Common Development and Distribution License, Version 1.0 only 10\ copyright: (the "License"). You may not use this file except in compliance 11\ copyright: with the License. 12\ copyright: 13\ copyright: You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 14\ copyright: or http://www.opensolaris.org/os/licensing. 15\ copyright: See the License for the specific language governing permissions 16\ copyright: and limitations under the License. 17\ copyright: 18\ copyright: When distributing Covered Code, include this CDDL HEADER in each 19\ copyright: file and include the License file at usr/src/OPENSOLARIS.LICENSE. 20\ copyright: If applicable, add the following below this CDDL HEADER, with the 21\ copyright: fields enclosed by brackets "[]" replaced with your own identifying 22\ copyright: information: Portions Copyright [yyyy] [name of copyright owner] 23\ copyright: 24\ copyright: CDDL HEADER END 25\ copyright: 26 27." Buffer: " 28 h# 20 buffer: my-unit-str 29 " abcd" my-unit-str pack drop 30 " pack.1" my-unit-str c@ 4 = .passed? 31 " pack.2" my-unit-str 1 + c@ ascii a = .passed? 32 " pack.3" my-unit-str 2 + c@ ascii b = .passed? 33 " pack.4" my-unit-str 3 + c@ ascii c = .passed? 34 " pack.5" my-unit-str 4 + c@ ascii d = .passed? 35 " count.1" my-unit-str count " abcd" $= .passed? 36cr 37 38." Formatting: " 39 " fmt.1" 1 h# 23 <# #s #> " 2300000001" $= .passed? 40 " fmt.2" 1 h# 23 <# # # #> " 01" $= .passed? 41 " fmt.3" h# 123 <# u#s u#> " 123" $= .passed? 42 " fmt.4" h# 123 <# u# ascii X hold u# u#> " 2X3" $= .passed? 43 d# 10 base ! 44 " fmt.5" d# -123 <# dup abs u#s swap sign u#> " -123" $= .passed? 45 " fmt.6" d# 123 <# dup abs u#s swap sign u#> " 123" $= .passed? 46 " fmt.7" " -123" $number invert swap d# -123 = and .passed? 47 d# 16 base ! 48 " fmt.8" " 32a" $number invert swap h# 32a = and .passed? 49 " fmt.9" " xyzzy" $number .passed? 50 : dnumber ( n -- str len ) 51 base @ >r d# 10 base ! 52 <# dup abs u#s swap sign u#> 53 r> base ! 54 ; 55 " fmt.10" d# 12345678 dnumber " 12345678" $= .passed? 56 " fmt.11" d# -87654321 dnumber " -87654321" $= .passed? 57 " fmt.12" #out @ space #out @ 1 - = .passed? 58 " fmt.13" #line @ cr #out @ #line @ rot 1 + = swap 0= and .passed? 59 " fmt.14" #line @ (cr #out @ #line @ rot = swap 0= and .passed? 60 " fmt.15" bs h# 8 = .passed? 61 " fmt.16" bell h# 7 = .passed? 62 " fmt.17" bl h# 20 = .passed? 63 " fmt.18" ascii 5 d# 10 digit swap 5 = and .passed? 64 " fmt.19" ascii x d# 16 digit invert swap ascii x = and .passed? 65cr 66 67." (is-user-word): " 68 : xyzzy 1 2 3 ; 69 " xx" ' xyzzy (is-user-word) 70 " xx" $find if .passed space execute else .failed then 71 " iuw.1" 2 pick 3 = .passed? 72 " iuw.2" 3 pick 2 = .passed? 73 " iuw.3" 4 pick 1 = .passed? 74 drop drop drop 75cr 76 77." Move/Fill/Upper/Lower:" 78 " xyzzy" my-unit-str swap move 79 " move.1" my-unit-str " xyzzy" comp 0= .passed? 80 my-unit-str 9 ascii A fill 81 my-unit-str 6 ascii X fill 82 " fill.1" my-unit-str " XXXXXXAAA" comp 0= .passed? 83 9 0 do my-unit-str i + dup c@ lcc swap c! loop 84 " lcc.1" my-unit-str " xxxxxxaaa" comp 0= .passed? 85 9 0 do my-unit-str i + dup c@ upc swap c! loop 86 " upc.1" my-unit-str " XXXXXXAAA" comp 0= .passed? 87cr 88 89." >body/body>: " 90external 91 : xx 1 2 3 ; 92headers 93 " >body" ' xx >body ' xx /n + = .passed? 94 " body>" ' xx dup >body body> = .passed? 95cr 96 97." Fcode-revision: " 98 " Fcode-revision" fcode-revision h# 30000 = .passed? 99cr 100 101." Defer/Behavior: " 102 defer defer-word 103 ' xx to defer-word 104 " defer.1" defer-word 3 = swap 2 = and swap 1 = and .passed? 105 " behavior.1" ' defer-word behavior ' xx = .passed? 106cr 107 108." Aligned: " 109 variable alvar 110 " align.1" alvar aligned alvar = .passed? 111 " align.2" alvar /c - aligned alvar = .passed? 112 " align.3" alvar char+ aligned alvar la1+ = .passed? 113cr 114 115." Field: " 116struct 117 /n field >x1 118 /l field >x2 119 /w field >x3 120 /c field >x4 121constant /field-test 122 " field.1" /field-test /n /l /w /c + + + = .passed? 123 " field.2" 0 >x1 0 = .passed? 124 " field.3" 0 >x2 /n = .passed? 125 " field.4" 0 >x3 /n /l + = .passed? 126 " field.5" 0 >x4 /n /l /w + + = .passed? 127cr 128 129 130." Properties: " 131 0 value root-phandle 132 " use-fake-handles" $find if execute else 2drop then 133 " /" " (cd)" $find if execute else 2drop then 134 " /" find-package if to root-phandle then 135 1 encode-int " int-prop" property 136 1 2 encode-phys " phys-prop" property 137 1 2 3 reg 138 " XYZZY" model 139 1 encode-int 2 encode-int encode+ " 2int-prop" property 140 " abcd" encode-string " string-prop" property 141 " wxyz" encode-bytes " bytes-prop" property 142 " prop.1" " bytes-prop" root-phandle get-package-property if 143 .failed 144 else 145 " wxyz" $= .passed? 146 then 147 " prop.2" " string-prop" root-phandle get-package-property if 148 .failed 149 else 150 decode-string " abcd" $= nip nip .passed? 151 then 152 " prop.3" " int-prop" root-phandle get-package-property if 153 .failed 154 else 155 decode-int 1 = nip nip .passed? 156 then 157 " prop.4" " phys-prop" root-phandle get-package-property if 158 .failed 159 else 160 decode-phys 2 = swap 1 = and nip nip .passed? 161 then 162 " prop.5" 0 0 root-phandle next-property if 163 " bytes-prop" $= .passed? 164 else 165 .failed 166 then 167 " prop.6" " string-prop" root-phandle next-property if 168 " 2int-prop" $= .passed? 169 else 170 .failed 171 then 172cr 173 " .properties" $find if execute else 2drop then 174cr 175 176." Timing/Alarm: " 177 " ms.1" get-msecs h# 100 ms get-msecs swap - h# 80 h# 150 between .passed? 178\ 0 value alarm-happened 179\ : alarm-word 1 to alarm-happened ." OK " ; 180\ ' alarm-word 10 alarm 181\ 0 182\ begin 183\ 1 + dup 1000000 > alarm-happened 0<> or 184\ until 185\ drop 186\ 0 0 alarm 187\ " alarm.1" alarm-happened .passed? 188cr 189