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 13cell /x = constant 64bit? 14 1564bit? [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] 129