2N/A\ #ident "%Z%%M% %I% %E% SMI"
2N/A\ purpose:
2N/A\ copyright: Copyright 2005 Sun Microsystems, Inc. All rights reserved.
2N/A\ copyright: Use is subject to license terms.
2N/A\ copyright:
2N/A\ copyright: CDDL HEADER START
2N/A\ copyright:
2N/A\ copyright: The contents of this file are subject to the terms of the
2N/A\ copyright: Common Development and Distribution License, Version 1.0 only
2N/A\ copyright: (the "License"). You may not use this file except in compliance
2N/A\ copyright: with the License.
2N/A\ copyright:
2N/A\ copyright: You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
2N/A\ copyright: or http://www.opensolaris.org/os/licensing.
2N/A\ copyright: See the License for the specific language governing permissions
2N/A\ copyright: and limitations under the License.
2N/A\ copyright:
2N/A\ copyright: When distributing Covered Code, include this CDDL HEADER in each
2N/A\ copyright: file and include the License file at usr/src/OPENSOLARIS.LICENSE.
2N/A\ copyright: If applicable, add the following below this CDDL HEADER, with the
2N/A\ copyright: fields enclosed by brackets "[]" replaced with your own identifying
2N/A\ copyright: information: Portions Copyright [yyyy] [name of copyright owner]
2N/A\ copyright:
2N/A\ copyright: CDDL HEADER END
2N/A\ copyright:
2N/A
2N/A." Buffer: "
2N/A h# 20 buffer: my-unit-str
2N/A " abcd" my-unit-str pack drop
2N/A " pack.1" my-unit-str c@ 4 = .passed?
2N/A " pack.2" my-unit-str 1 + c@ ascii a = .passed?
2N/A " pack.3" my-unit-str 2 + c@ ascii b = .passed?
2N/A " pack.4" my-unit-str 3 + c@ ascii c = .passed?
2N/A " pack.5" my-unit-str 4 + c@ ascii d = .passed?
2N/A " count.1" my-unit-str count " abcd" $= .passed?
2N/Acr
2N/A
2N/A." Formatting: "
2N/A " fmt.1" 1 h# 23 <# #s #> " 2300000001" $= .passed?
2N/A " fmt.2" 1 h# 23 <# # # #> " 01" $= .passed?
2N/A " fmt.3" h# 123 <# u#s u#> " 123" $= .passed?
2N/A " fmt.4" h# 123 <# u# ascii X hold u# u#> " 2X3" $= .passed?
2N/A d# 10 base !
2N/A " fmt.5" d# -123 <# dup abs u#s swap sign u#> " -123" $= .passed?
2N/A " fmt.6" d# 123 <# dup abs u#s swap sign u#> " 123" $= .passed?
2N/A " fmt.7" " -123" $number invert swap d# -123 = and .passed?
2N/A d# 16 base !
2N/A " fmt.8" " 32a" $number invert swap h# 32a = and .passed?
2N/A " fmt.9" " xyzzy" $number .passed?
2N/A : dnumber ( n -- str len )
2N/A base @ >r d# 10 base !
2N/A <# dup abs u#s swap sign u#>
2N/A r> base !
2N/A ;
2N/A " fmt.10" d# 12345678 dnumber " 12345678" $= .passed?
2N/A " fmt.11" d# -87654321 dnumber " -87654321" $= .passed?
2N/A " fmt.12" #out @ space #out @ 1 - = .passed?
2N/A " fmt.13" #line @ cr #out @ #line @ rot 1 + = swap 0= and .passed?
2N/A " fmt.14" #line @ (cr #out @ #line @ rot = swap 0= and .passed?
2N/A " fmt.15" bs h# 8 = .passed?
2N/A " fmt.16" bell h# 7 = .passed?
2N/A " fmt.17" bl h# 20 = .passed?
2N/A " fmt.18" ascii 5 d# 10 digit swap 5 = and .passed?
2N/A " fmt.19" ascii x d# 16 digit invert swap ascii x = and .passed?
2N/Acr
2N/A
2N/A." (is-user-word): "
2N/A : xyzzy 1 2 3 ;
2N/A " xx" ' xyzzy (is-user-word)
2N/A " xx" $find if .passed space execute else .failed then
2N/A " iuw.1" 2 pick 3 = .passed?
2N/A " iuw.2" 3 pick 2 = .passed?
2N/A " iuw.3" 4 pick 1 = .passed?
2N/A drop drop drop
2N/Acr
2N/A
2N/A." Move/Fill/Upper/Lower:"
2N/A " xyzzy" my-unit-str swap move
2N/A " move.1" my-unit-str " xyzzy" comp 0= .passed?
2N/A my-unit-str 9 ascii A fill
2N/A my-unit-str 6 ascii X fill
2N/A " fill.1" my-unit-str " XXXXXXAAA" comp 0= .passed?
2N/A 9 0 do my-unit-str i + dup c@ lcc swap c! loop
2N/A " lcc.1" my-unit-str " xxxxxxaaa" comp 0= .passed?
2N/A 9 0 do my-unit-str i + dup c@ upc swap c! loop
2N/A " upc.1" my-unit-str " XXXXXXAAA" comp 0= .passed?
2N/Acr
2N/A
2N/A." >body/body>: "
2N/Aexternal
2N/A : xx 1 2 3 ;
2N/Aheaders
2N/A " >body" ' xx >body ' xx /n + = .passed?
2N/A " body>" ' xx dup >body body> = .passed?
2N/Acr
2N/A
2N/A." Fcode-revision: "
2N/A " Fcode-revision" fcode-revision h# 30000 = .passed?
2N/Acr
2N/A
2N/A." Defer/Behavior: "
2N/A defer defer-word
2N/A ' xx to defer-word
2N/A " defer.1" defer-word 3 = swap 2 = and swap 1 = and .passed?
2N/A " behavior.1" ' defer-word behavior ' xx = .passed?
2N/Acr
2N/A
2N/A." Aligned: "
2N/A variable alvar
2N/A " align.1" alvar aligned alvar = .passed?
2N/A " align.2" alvar /c - aligned alvar = .passed?
2N/A " align.3" alvar char+ aligned alvar la1+ = .passed?
2N/Acr
2N/A
2N/A." Field: "
2N/Astruct
2N/A /n field >x1
2N/A /l field >x2
2N/A /w field >x3
2N/A /c field >x4
2N/Aconstant /field-test
2N/A " field.1" /field-test /n /l /w /c + + + = .passed?
2N/A " field.2" 0 >x1 0 = .passed?
2N/A " field.3" 0 >x2 /n = .passed?
2N/A " field.4" 0 >x3 /n /l + = .passed?
2N/A " field.5" 0 >x4 /n /l /w + + = .passed?
2N/Acr
2N/A
2N/A
2N/A." Properties: "
2N/A 0 value root-phandle
2N/A " use-fake-handles" $find if execute else 2drop then
2N/A " /" " (cd)" $find if execute else 2drop then
2N/A " /" find-package if to root-phandle then
2N/A 1 encode-int " int-prop" property
2N/A 1 2 encode-phys " phys-prop" property
2N/A 1 2 3 reg
2N/A " XYZZY" model
2N/A 1 encode-int 2 encode-int encode+ " 2int-prop" property
2N/A " abcd" encode-string " string-prop" property
2N/A " wxyz" encode-bytes " bytes-prop" property
2N/A " prop.1" " bytes-prop" root-phandle get-package-property if
2N/A .failed
2N/A else
2N/A " wxyz" $= .passed?
2N/A then
2N/A " prop.2" " string-prop" root-phandle get-package-property if
2N/A .failed
2N/A else
2N/A decode-string " abcd" $= nip nip .passed?
2N/A then
2N/A " prop.3" " int-prop" root-phandle get-package-property if
2N/A .failed
2N/A else
2N/A decode-int 1 = nip nip .passed?
2N/A then
2N/A " prop.4" " phys-prop" root-phandle get-package-property if
2N/A .failed
2N/A else
2N/A decode-phys 2 = swap 1 = and nip nip .passed?
2N/A then
2N/A " prop.5" 0 0 root-phandle next-property if
2N/A " bytes-prop" $= .passed?
2N/A else
2N/A .failed
2N/A then
2N/A " prop.6" " string-prop" root-phandle next-property if
2N/A " 2int-prop" $= .passed?
2N/A else
2N/A .failed
2N/A then
2N/Acr
2N/A " .properties" $find if execute else 2drop then
2N/Acr
2N/A
2N/A." Timing/Alarm: "
2N/A " ms.1" get-msecs h# 100 ms get-msecs swap - h# 80 h# 150 between .passed?
2N/A\ 0 value alarm-happened
2N/A\ : alarm-word 1 to alarm-happened ." OK " ;
2N/A\ ' alarm-word 10 alarm
2N/A\ 0
2N/A\ begin
2N/A\ 1 + dup 1000000 > alarm-happened 0<> or
2N/A\ until
2N/A\ drop
2N/A\ 0 0 alarm
2N/A\ " alarm.1" alarm-happened .passed?
2N/Acr