\ #ident "%Z%%M% %I% %E% SMI"

\ purpose:

\ copyright: Copyright 2005 Sun Microsystems, Inc. All rights reserved.

\ copyright: Use is subject to license terms.

\ copyright:

\ copyright: CDDL HEADER START

\ copyright:

\ copyright: The contents of this file are subject to the terms of the

\ copyright: Common Development and Distribution License, Version 1.0 only

\ copyright: (the "License"). You may not use this file except in compliance

\ copyright: with the License.

\ copyright:

\ copyright: You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE

\ copyright: or http://www.opensolaris.org/os/licensing.

\ copyright: See the License for the specific language governing permissions

\ copyright: and limitations under the License.

\ copyright:

\ copyright: When distributing Covered Code, include this CDDL HEADER in each

\ copyright: file and include the License file at usr/src/OPENSOLARIS.LICENSE.

\ copyright: If applicable, add the following below this CDDL HEADER, with the

\ copyright: fields enclosed by brackets "[]" replaced with your own identifying

\ copyright: information: Portions Copyright [yyyy] [name of copyright owner]

\ copyright:

\ copyright: CDDL HEADER END

\ copyright:

fcode-version1

." 64-bit Fcode operation tests" cr

: .failed ." failed!" ;

: .passed ." OK" ;

: .chkstk depth if ." Stack Changed: " .s cr then ;

: .passed? ( str,len flag )

if if then if then .passed space else cr type space .failed cr then

;

\ comparisons only 32-bit...

: xl= ( xv lh ll -- flag )

swap rot xlsplit rot = -rot = and

;

: x= ( xv1 xv2 -- flag )

xlsplit rot xlsplit rot = -rot = and

;

create test-64

h# 01020304 l,

h# 05060708 l,

h# 81121314 l,

h# 85161718 l,

h# ffffffff l,

h# 80000000 l,

." 64-bit access tests: "

" /x.1" /x 8 = .passed?

" xa1+.1" test-64 xa1+ test-64 /x + = .passed?

" xa+.1" test-64 2 xa+ test-64 /x 2 * + = .passed?

" x@.1" test-64 x@ h# 01020304 h# 05060708 xl= .passed?

" x@.2" test-64 xa1+ x@ h# 81121314 h# 85161718 xl= .passed?

" <l@.1" test-64 2 xa+ dup la1+ <l@ swap x@ x= .passed?

" bxjoin.1" 8 7 6 5 4 3 2 1 bxjoin test-64 x@ x= .passed?

" wxjoin.1" h# 0708 h# 0506 h# 0304 h# 0102 wxjoin test-64 x@ x= .passed?

" lxjoin.1" h# 05060708 h# 01020304 lxjoin test-64 x@ x= .passed?

" x!.1" h# 85161718 h# 81121314 lxjoin test-64 x!

test-64 x@ h# 81121314 h# 85161718 xl= .passed?

" x!.2" h# 05060708 h# 01020304 lxjoin test-64 x!

test-64 x@ h# 01020304 h# 05060708 xl= .passed?

cr

." 64-bit flips: "

" xbflip.1" test-64 x@ xbflip h# 08070605 h# 04030201 xl= .passed?

" xwflip.1" test-64 x@ xwflip h# 07080506 h# 03040102 xl= .passed?

" xlflip.1" test-64 x@ xlflip h# 05060708 h# 01020304 xl= .passed?

" xbsplit.1" test-64 x@ xbsplit bxjoin test-64 x@ x= .passed?

" xwsplit.1" test-64 x@ xwsplit wxjoin test-64 x@ x= .passed?

" xlsplit.1" test-64 x@ xlsplit lxjoin test-64 x@ x= .passed?

" xbflips.1" test-64 /x xbflips test-64 x@

h# 08070605 h# 04030201 xl= .passed?

" xbflips.2" test-64 /x xbflips test-64 x@

h# 01020304 h# 05060708 xl= .passed?

" xwflips.1" test-64 /x xwflips test-64 x@

h# 07080506 h# 03040102 xl= .passed?

" xwflips.2" test-64 /x xwflips test-64 x@

h# 01020304 h# 05060708 xl= .passed?

" xlflips.1" test-64 /x xlflips test-64 x@

h# 05060708 h# 01020304 xl= .passed?

" xlflips.2" test-64 /x xlflips test-64 x@

h# 01020304 h# 05060708 xl= .passed?

cr

0 value commatest-64-end

create commatest-64

h# 01020304 h# 05060708 swap lxjoin x,

h# 81121314 h# 85161718 swap lxjoin x,

h# ffffffff h# 80000000 swap lxjoin x,

here to commatest-64-end

." 64-bit xcomma: "

" x,.1" commatest-64 3 xa+ commatest-64-end = .passed?

" x,.2" test-64 x@ commatest-64 x@ x= .passed?

" x,.3" test-64 xa1+ x@ commatest-64 xa1+ x@ x= .passed?

" x,.4" test-64 2 xa+ x@ commatest-64 2 xa+ x@ x= .passed?

cr

." 64-bit constant/value/variable: "

1 2 lxjoin constant const-64

1 2 lxjoin value value-64

variable var-64

" const.1" const-64 2 1 xl= .passed?

" value.1" value-64 2 1 xl= .passed?

" value.2" 3 4 lxjoin to value-64 value-64 4 3 xl= .passed?

" var.1" const-64 var-64 ! var-64 @ 2 1 xl= .passed?

cr

." 64-bit comparisions: "

\ FCode comparators are 32-bit only, upper 32-bits are ignored.

" 64comp.1" 1 2 lxjoin 1 = .passed?

" 64comp.2" 1 2 lxjoin 2 < .passed?

" 64comp.3" 2 1 2 lxjoin > .passed?

" 64comp.4" 0 2 lxjoin 0= .passed?

" 64comp.5" 1 2 lxjoin 0> .passed?

cr

end0