Annotation of qemu/roms/openbios/forth/lib/64bit.fs, revision 1.1.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.