picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit fd8b5c9b81028d7050f2b6673aa958a1593cf237
parent fdddeb6a96fcbe55d05ba6e1eef41a8ec5c18d32
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri, 22 Apr 2011 15:59:22 +0200

ppc64 continued
Diffstat:
Mlib/tags | 2+-
Msrc64/arch/ppc64.l | 201++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------
2 files changed, 134 insertions(+), 69 deletions(-)

diff --git a/lib/tags b/lib/tags @@ -275,7 +275,7 @@ pwd (2631 . "@src64/main.l") queue (1918 . "@src64/sym.l") quit (1094 . "@src64/main.l") quote (139 . "@src64/flow.l") -rand (2973 . "@src64/big.l") +rand (2976 . "@src64/big.l") range (997 . "@src64/subr.l") rank (3033 . "@src64/subr.l") raw (454 . "@src64/main.l") diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l @@ -1,4 +1,4 @@ -# 21apr11abu +# 22apr11abu # (c) Software Lab. Alexander Burger # Byte order @@ -18,7 +18,6 @@ # TOC: 2 # C arguments: 3 - 10 -# Operands: 4, 5, 6 # NULL: 20 # ONE: 21 # Data: 22 @@ -375,13 +374,13 @@ ((not D) (ifn (= (3 . 14) Dst) (memory Src S Dst 0) - (let A (memory Src S 14 0) # D - (prinst "ld" 3 (pack "8+" (car A))) ) ) ) + (let A (memory Src S 3 0) # D + (prinst "ld" 14 (pack "8+" (car A))) ) ) ) ((not S) (ifn (= (3 . 14) Src) (memory Dst D Src T) - (let A (memory Dst D 14 T) # D - (prinst "std" 3 (pack "8+" (car A))) ) ) ) + (let A (memory Dst D 3 T) # D + (prinst "std" 14 (pack "8+" (car A))) ) ) ) ((= "0" Src) (memory Dst D 20 T)) ((= "1" Src) (memory Dst D 21 T)) (T @@ -1118,16 +1117,16 @@ (asm initCode () (unless *FPic - (prinst "mflr" 11) # Get return address - (prinst "lwa" 0 "0(11)") # Target offset - (prinst "add" 0 0 23) # Code-relative - (prinst "mtlr" 0) # Set target address - (prinst "addi" 0 11 4) # Update return address - (prinst "stdu" 0 "-8(1)") # Save it - (prinst "blrl") # Call target - (prinst "ld" 0 "0(1)") # Pop return address + (prinst "mflr" 11) # Get return address + (prinst "lwa" 0 "0(11)") # Target offset + (prinst "add" 0 0 23) # Code-relative + (prinst "mtlr" 0) # Set target address + (prinst "addi" 0 11 4) # Update return address + (prinst "stdu" 0 "-8(1)") # Save it + (prinst "blrl") # Call target + (prinst "ld" 0 "0(1)") # Pop return address (prinst "addi" 1 1 8) - (prinst "mtctr" 0) # Return + (prinst "mtctr" 0) # Return (prinst "bctr") (prinl) ) (label "callRel") @@ -1155,92 +1154,158 @@ (unless *FPic (prinl "# movn dst src cnt") (label "movn") - (prinst "subi" 4 4 1) # Adjust 'dst' - (prinst "subi" 5 5 1) # and 'src' + (prinst "subi" 4 4 1) # Adjust 'dst' + (prinst "subi" 5 5 1) # and 'src' (prinl "1:") - (prinst "subic." 6 6 1) # Decrement 'cnt' - (prinst "bltlr") # Return if done - (prinst "lbzu" 26 "1(5)") # Next byte from 'src' - (prinst "stbu" 26 "1(4)") # Write to 'dst' + (prinst "subic." 6 6 1) # Decrement 'cnt' + (prinst "bltlr") # Return if done + (prinst "lbzu" 7 "1(5)") # Next byte from 'src' + (prinst "stbu" 7 "1(4)") # Write to 'dst' (prinst "b" "1b") (prinl) (prinl "# mset dst src cnt") (label "mset") - (prinst "subi" 4 4 1) # Adjust 'dst' + (prinst "subi" 4 4 1) # Adjust 'dst' (prinl "1:") - (prinst "subic." 5 5 1) # Decrement 'cnt' - (prinst "bltlr") # Return if done - (prinst "stbu" 3 "1(4)") # Write B to 'dst' + (prinst "subic." 5 5 1) # Decrement 'cnt' + (prinst "bltlr") # Return if done + (prinst "stbu" 3 "1(4)") # Write B to 'dst' (prinst "b" "1b") (prinl) (prinl "# save src end dst") (label "save") - (prinst "ld" 26 "0(4)") # First word from 'src' - (prinst "std" 26 "0(6)") # Write to 'dst' + (prinst "ld" 7 "0(4)") # First word from 'src' + (prinst "std" 7 "0(6)") # Write to 'dst' (prinl "1:") - (prinst "ldu" 26 "8(4)") # Next word from 'src' - (prinst "cmpd" 4 5) # Done? - (prinst "beqlr-") # Yes: Return - (prinst "stdu" 26 "8(6)") # Write to 'dst' + (prinst "ldu" 7 "8(4)") # Next word from 'src' + (prinst "cmpd" 4 5) # Done? + (prinst "beqlr-") # Yes: Return + (prinst "stdu" 7 "8(6)") # Write to 'dst' (prinst "b" "1b") (prinl) (prinl "# load dst end src") (label "load") - (prinst "ld" 26 "0(6)") # First word from 'src' - (prinst "std" 26 "0(4)") # Write to 'dst' - (prinst "subi" 5 5 8) # Adjust 'end' + (prinst "ld" 7 "0(6)") # First word from 'src' + (prinst "std" 7 "0(4)") # Write to 'dst' + (prinst "subi" 5 5 8) # Adjust 'end' (prinl "1:") - (prinst "ldu" 26 "8(6)") # Next word from 'src' - (prinst "stdu" 26 "8(4)") # Write to 'dst' - (prinst "cmpd" 4 5) # Done? - (prinst "bne+" "1b") # No + (prinst "ldu" 7 "8(6)") # Next word from 'src' + (prinst "stdu" 7 "8(4)") # Write to 'dst' + (prinst "cmpd" 4 5) # Done? + (prinst "bne+" "1b") # No (prinst "blr") (prinl) (prinl "# cmpn dst src cnt") (label "cmpn") - (prinst "lbz" 26 "0(4)") # First byte from 'dst' - (prinst "lbz" 27 "0(5)") # First byte from 'src' + (prinst "lbz" 7 "0(4)") # First byte from 'dst' + (prinst "lbz" 8 "0(5)") # First byte from 'src' (prinl "1:") - (prinst "subc." 0 26 27) # Same bytes? - (prinst "bnelr-") # No: Return 'ne' - (prinst "subic." 6 6 1) # Decrement 'cnt' - (prinst "beqlr-") # Return 'eq' if done - (prinst "lbzu" 26 "1(4)") # Next bytes - (prinst "lbzu" 27 "1(5)") + (prinst "subc." 0 7 8) # Same bytes? + (prinst "bnelr-") # No: Return 'ne' + (prinst "subic." 6 6 1) # Decrement 'cnt' + (prinst "beqlr-") # Return 'eq' if done + (prinst "lbzu" 7 "1(4)") # Next bytes + (prinst "lbzu" 8 "1(5)") (prinst "b" "1b") (prinl) (prinl "# slen dst src") (label "slen") - (prinst "li" 4 0) # Init 'dst' counter - (prinst "lbz" 26 "0(5)") # First byte from 'src' + (prinst "li" 4 0) # Init 'dst' counter + (prinst "lbz" 7 "0(5)") # First byte from 'src' (prinl "1:") - (prinst "cmpdi" 26 0) # Done? - (prinst "beqlr-") # Yes: Return - (prinst "addi" 4 4 1) # Increment 'cnt' - (prinst "lbzu" 26 "1(5)") # Next byte + (prinst "cmpdi" 7 0) # Done? + (prinst "beqlr-") # Yes: Return + (prinst "addi" 4 4 1) # Increment 'cnt' + (prinst "lbzu" 7 "1(5)") # Next byte (prinst "b" "1b") (prinl) (prinl "# memb src cnt") (label "memb") - (prinst "mr" 6 4) # Get 'src' - (prinst "extrdi" 26 3 8 56) # and B + (prinst "mr" 6 4) # Get 'src' + (prinst "extrdi" 7 3 8 56) # and B (prinl "1:") - (prinst "subic." 5 5 1) # Decrement 'cnt' - (prinst "bltlr-") # Return 'ne' if done - (prinst "lbz" 27 "0(6)") # Next byte from 'src' - (prinst "addi" 6 6 1) # Increment 'src' - (prinst "cmpd" 27 26) # Found? - (prinst "bne+" "1b") # No - (prinst "mr" 4 6) # Else return 'eq' + (prinst "subic." 5 5 1) # Decrement 'cnt' + (prinst "bltlr-") # Return 'ne' if done + (prinst "lbz" 8 "0(6)") # Next byte from 'src' + (prinst "addi" 6 6 1) # Increment 'src' + (prinst "cmpd" 8 7) # Found? + (prinst "bne+" "1b") # No + (prinst "mr" 4 6) # Else return 'eq' (prinst "blr") (prinl) - (prinl "# div src") - (label "div") - (prinst "divdu" 5 3 4) # Only 64-bit division for now - (prinst "mulld" 14 5 4) # Remainder - (prinst "subf" 14 14 3) - (prinst "mr" 3 5) # Quotient - (prinst "blr") + (prinl "# div src") # From: http://hackers-delight.org.ua + (label "div") # 14:3 / 4 + (let + (@u1 14 @u0 3 @v 4 @s 5 # un21 = un32 = u1 + @un1 6 @un0 7 @vn1 8 @vn0 9 + @q1 26 @q0 27 @rhat 28 @tmp 29 ) + (macro + (prinst "cmpld" @u1 @v) # u1 >= v? + (prinst "bge-" "divOvfl") # Yes: Overflow + (prinst "li" @s 0) # Init 's' + (prinst "cmpldi" @v 0) # Normalize + (prinst "blt" "div2") + (prinl "div1:") + (prinst "addi" @s @s 1) # Increment 's' + (prinst "addc" @u0 @u0 @u0) # Shift dividend left + (prinst "adde" @u1 @u1 @u1) + (prinst "add." @v @v @v) # and divisor + (prinst "bge" "div1") + (prinl "div2:") + (prinst "extrdi" @vn1 @v 32 0) # Split divisor into high 32 bits + (prinst "extrdi" @vn0 @v 32 32) # and low 32 bits + (prinst "extrdi" @un1 @u0 32 0) # Split 'u0' into high 32 bits + (prinst "extrdi" @un0 @u0 32 32) # and low 32 bits + (prinst "divdu" @q1 @u1 @vn1) # First quotient digit + (prinst "mulld" 0 @q1 @vn1) + (prinst "sub" @rhat @u1 0) + (prinl "div3:") + (prinst "extrdi." 0 @q1 32 0) # q1 >= b? + (prinst "bne-" "div4") # Yes + (prinst "sldi" @tmp @rhat 32) # b*rhat + un1 + (prinst "add" @tmp @tmp @un1) + (prinst "mulld" 0 @q1 @vn0) + (prinst "cmpld" 0 @tmp) # q1 * vn0 > b*rhat + un1? + (prinst "ble+" "div5") # No + (prinl "div4:") + (prinst "subi" @q1 @q1 1) # Else decrement 'q1' + (prinst "add" @rhat @rhat @vn1) # Increment 'rhat' + (prinst "extrdi." 0 @rhat 32 0) # Less than 'b'? + (prinst "beq-" "div3") # Yes + (prinl "div5:") + (prinst "sldi" @u1 @u1 32) # (un32*b) + (prinst "add" @u1 @u1 @un1) # (un1 + un32*b) + (prinst "mulld" 0 @q1 @v) + (prinst "sub" @u1 @u1 0) # un21 = un1 + un32*b - q1*v + (prinst "divdu" @q0 @u1 @vn1) # Second quotient digit + (prinst "mulld" 0 @q0 @vn1) + (prinst "sub" @rhat @u1 0) + (prinl "div6:") + (prinst "extrdi." 0 @q0 32 0) # q0 >= b? + (prinst "bne-" "div7") # Yes + (prinst "sldi" @tmp @rhat 32) # b*rhat + un0 + (prinst "add" @tmp @tmp @un0) + (prinst "mulld" 0 @q0 @vn0) + (prinst "cmpld" 0 @tmp) # q0 * vn0 > b*rhat + un1? + (prinst "ble+" "div8") # No + (prinl "div7:") + (prinst "subi" @q0 @q0 1) # Else decrement 'q0' + (prinst "add" @rhat @rhat @vn1) # Increment 'rhat' + (prinst "extrdi." 0 @rhat 32 0) # Less than 'b'? + (prinst "beq-" "div6") # Yes + (prinl "div8:") + (prinst "sldi" @u0 @q1 32) # Quotient + (prinst "add" @u0 @u0 @q0) + (prinst "sldi" @u1 @u1 32) # Remainder: u1 = (un0 + un21*b - q0*v) >> s + (prinst "add" @u1 @u1 @un0) + (prinst "mulld" 0 @q0 @v) + (prinst "sub" @u1 @u1 0) + (prinst "srd" @u1 @u1 @s) + (prinst "blr") + (prinl "divOvfl:") + (prinst "li" @u0 -1) # Overflow + (prinst "li" @u1 -1) + (prinst "blr") ) ) (prinl) (prinl "# Begin entry") (label "begin")