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