Annotation of qemu/roms/openbios/forth/lib/64bit.fs, revision 1.1

1.1     ! root        1: \ 
        !             2: \ Copyright (C) 2009 Stefan Reinauer
        !             3: \ 
        !             4: \ See the file "COPYING" for further information about
        !             5: \ the copyright and warranty status of this work.
        !             6: \ 
        !             7: 
        !             8: \ Implementation of IEEE Draft Std P1275.6/D5
        !             9: \ Standard for Boot (Initialization Configuration) Firmware
        !            10: \ 64 Bit Extensions
        !            11: 
        !            12: 
        !            13: cell /x = constant 64bit?
        !            14: 
        !            15: 64bit? [IF] 
        !            16: 
        !            17: : 32>64 ( 32bitsigned -- 64bitsigned )
        !            18:   dup 80000000 and if          \ is it negative?
        !            19:     ffffffff00000000 or                \ then set all high bits
        !            20:   then
        !            21: ;
        !            22: 
        !            23: : 64>32 ( 64bitsigned -- 32bitsigned )
        !            24:   h# ffffffff and
        !            25: ;
        !            26: 
        !            27: : lxjoin ( quad.lo quad.hi -- o )
        !            28:   d# 32 lshift or
        !            29: ;
        !            30: 
        !            31: : wxjoin ( w.lo w.2 w.3 w.hi -- o )
        !            32:   wljoin >r wljoin r> lxjoin
        !            33: ;
        !            34: 
        !            35: : bxjoin ( b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi -- o )
        !            36:   bljoin >r bljoin r> lxjoin
        !            37: ;
        !            38: 
        !            39: : <l@ ( qaddr -- n )
        !            40:   l@ 32>64
        !            41: ;
        !            42: 
        !            43: : unaligned-x@ ( addr - o )
        !            44:   dup la1+ unaligned-l@ 64>32 swap unaligned-l@ 64>32 lxjoin
        !            45: ;
        !            46: 
        !            47: : unaligned-x! ( o oaddr -- )
        !            48:   >r dup d# 32 rshift r@ unaligned-l!
        !            49:   h# ffffffff and r> la1+ unaligned-l!
        !            50: ;
        !            51:   
        !            52: : x@ ( oaddr -- o )
        !            53:   unaligned-x@ \ for now
        !            54: ;
        !            55: 
        !            56: : x! ( o oaddr -- )
        !            57:   unaligned-x! \ for now
        !            58: ;
        !            59: 
        !            60: : (rx@) ( oaddr - o )
        !            61:   x@
        !            62: ;
        !            63: 
        !            64: : (rx!) ( o oaddr -- )
        !            65:   x!
        !            66: ;
        !            67: 
        !            68: : x, ( o -- )
        !            69:   here /x allot x!
        !            70: ;
        !            71: 
        !            72: : /x* ( nu1 -- nu2 )
        !            73:   /x *
        !            74: ;
        !            75: 
        !            76: : xa+ ( addr1 index -- addr2 )
        !            77:   /x* +
        !            78: ;
        !            79: 
        !            80: : xa1+ ( addr1 -- addr2 )
        !            81:   /x +
        !            82: ;
        !            83: 
        !            84: : xlsplit ( o -- quad.lo quad.hi )
        !            85:   dup h# ffffffff and swap d# 32 rshift
        !            86: ;
        !            87: 
        !            88: : xwsplit ( o -- w.lo w.2 w.3 w.hi )
        !            89:   xlsplit >r lwsplit r> lwsplit
        !            90: ;
        !            91: 
        !            92: : xbsplit ( o -- b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi )
        !            93:   xlsplit >r lbsplit r> lbsplit
        !            94: ;
        !            95: 
        !            96: : xlflip ( oct1 -- oct2 )
        !            97:   xlsplit swap lxjoin
        !            98: ;
        !            99: 
        !           100: : xlflips ( oaddr len -- )
        !           101:   bounds ?do 
        !           102:     i unaligned-x@ xlflip i unaligned-x!
        !           103:   /x +loop
        !           104: ;
        !           105: 
        !           106: : xwflip ( oct1 -- oct2 )
        !           107:   xlsplit lwflip swap lwflip lxjoin
        !           108: ;
        !           109: 
        !           110: : xwflips ( oaddr len -- )
        !           111:   bounds ?do
        !           112:     i unaligned-x@ xwflip i unaligned-x! /x
        !           113:   +loop
        !           114: ;
        !           115: 
        !           116: : xbflip ( oct1 -- oct2 )
        !           117:   xlsplit lbflip swap lbflip lxjoin
        !           118: ;
        !           119: 
        !           120: : xbflips ( oaddr len -- )
        !           121:   bounds ?do
        !           122:     i unaligned-x@ xbflip i unaligned-x!
        !           123:   /x +loop
        !           124: ;
        !           125: 
        !           126: \ : b(lit) b(lit) 32>64 ;
        !           127: 
        !           128: [THEN]

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.