commit e4204ea591b661ea6155309d954393543719c82b
parent 18ad4d3201116b558f7bfad6be5789bfd78b8b7d
Author: Alexander Burger <abu@software-lab.de>
Date: Mon, 18 Apr 2011 16:45:36 +0200
ppc64 continued
Diffstat:
5 files changed, 271 insertions(+), 200 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -29,7 +29,7 @@ adr (602 . "@src64/main.l")
alarm (479 . "@src64/main.l")
all (770 . "@src64/sym.l")
and (1616 . "@src64/flow.l")
-any (3930 . "@src64/io.l")
+any (3933 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
arg (2267 . "@src64/main.l")
@@ -82,12 +82,12 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1141 . "@src64/subr.l")
-char (3412 . "@src64/io.l")
+char (3415 . "@src64/io.l")
chop (1091 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
circ? (2398 . "@src64/subr.l")
clip (1795 . "@src64/subr.l")
-close (4335 . "@src64/io.l")
+close (4338 . "@src64/io.l")
cmd (2869 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2540 . "@src64/flow.l")
@@ -98,7 +98,7 @@ cond (1911 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
-ctl (4213 . "@src64/io.l")
+ctl (4216 . "@src64/io.l")
ctty (2667 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
date (2381 . "@src64/main.l")
@@ -115,14 +115,14 @@ dir (2800 . "@src64/main.l")
dm (541 . "@src64/flow.l")
do (2133 . "@src64/flow.l")
e (2914 . "@src64/flow.l")
-echo (4366 . "@src64/io.l")
+echo (4369 . "@src64/io.l")
env (614 . "@src64/main.l")
-eof (3489 . "@src64/io.l")
-eol (3480 . "@src64/io.l")
-err (4193 . "@src64/io.l")
+eof (3492 . "@src64/io.l")
+eol (3483 . "@src64/io.l")
+err (4196 . "@src64/io.l")
errno (1379 . "@src64/main.l")
eval (180 . "@src64/flow.l")
-ext (5096 . "@src64/io.l")
+ext (5099 . "@src64/io.l")
ext? (1032 . "@src64/sym.l")
extern (898 . "@src64/sym.l")
extra (1259 . "@src64/flow.l")
@@ -137,13 +137,13 @@ find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2441 . "@src64/subr.l")
flip (1695 . "@src64/subr.l")
-flush (5071 . "@src64/io.l")
+flush (5074 . "@src64/io.l")
fold (3341 . "@src64/sym.l")
for (2222 . "@src64/flow.l")
fork (3256 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2045 . "@src64/db.l")
-from (3508 . "@src64/io.l")
+from (3511 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (732 . "@src64/sym.l")
gc (432 . "@src64/gc.l")
@@ -155,14 +155,14 @@ glue (1232 . "@src64/sym.l")
gt0 (2716 . "@src64/big.l")
head (1816 . "@src64/subr.l")
heap (534 . "@src64/main.l")
-hear (3193 . "@src64/io.l")
+hear (3196 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1025 . "@src64/db.l")
idx (2035 . "@src64/sym.l")
if (1797 . "@src64/flow.l")
if2 (1816 . "@src64/flow.l")
ifn (1857 . "@src64/flow.l")
-in (4153 . "@src64/io.l")
+in (4156 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2633 . "@src64/subr.l")
info (2704 . "@src64/main.l")
@@ -171,7 +171,7 @@ ipid (3201 . "@src64/flow.l")
isa (956 . "@src64/flow.l")
job (1421 . "@src64/flow.l")
journal (968 . "@src64/db.l")
-key (3341 . "@src64/io.l")
+key (3344 . "@src64/io.l")
kill (3233 . "@src64/flow.l")
last (2040 . "@src64/subr.l")
le0 (2691 . "@src64/big.l")
@@ -179,14 +179,14 @@ length (2737 . "@src64/subr.l")
let (1471 . "@src64/flow.l")
let? (1532 . "@src64/flow.l")
lieu (1154 . "@src64/db.l")
-line (3664 . "@src64/io.l")
-lines (3817 . "@src64/io.l")
+line (3667 . "@src64/io.l")
+lines (3820 . "@src64/io.l")
link (1172 . "@src64/subr.l")
lisp (1946 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (155 . "@src64/flow.l")
-load (4130 . "@src64/io.l")
+load (4133 . "@src64/io.l")
lock (1182 . "@src64/db.l")
loop (2165 . "@src64/flow.l")
low? (3213 . "@src64/sym.l")
@@ -236,30 +236,30 @@ offset (2673 . "@src64/subr.l")
on (1581 . "@src64/sym.l")
onOff (1611 . "@src64/sym.l")
one (1644 . "@src64/sym.l")
-open (4297 . "@src64/io.l")
+open (4300 . "@src64/io.l")
opid (3217 . "@src64/flow.l")
opt (2990 . "@src64/main.l")
or (1632 . "@src64/flow.l")
-out (4173 . "@src64/io.l")
+out (4176 . "@src64/io.l")
pack (1142 . "@src64/sym.l")
pair (2390 . "@src64/subr.l")
pass (754 . "@src64/apply.l")
pat? (718 . "@src64/sym.l")
path (1237 . "@src64/io.l")
-peek (3396 . "@src64/io.l")
+peek (3399 . "@src64/io.l")
pick (1369 . "@src64/apply.l")
-pipe (4234 . "@src64/io.l")
-poll (3285 . "@src64/io.l")
+pipe (4237 . "@src64/io.l")
+poll (3288 . "@src64/io.l")
pool (648 . "@src64/db.l")
pop (1771 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5179 . "@src64/io.l")
+pr (5182 . "@src64/io.l")
pre? (1409 . "@src64/sym.l")
-prin (4995 . "@src64/io.l")
-prinl (5009 . "@src64/io.l")
-print (5035 . "@src64/io.l")
-println (5066 . "@src64/io.l")
-printsp (5051 . "@src64/io.l")
+prin (4998 . "@src64/io.l")
+prinl (5012 . "@src64/io.l")
+print (5038 . "@src64/io.l")
+println (5069 . "@src64/io.l")
+printsp (5054 . "@src64/io.l")
prior (2709 . "@src64/subr.l")
prog (1752 . "@src64/flow.l")
prog1 (1760 . "@src64/flow.l")
@@ -279,12 +279,12 @@ rand (2973 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3029 . "@src64/subr.l")
raw (457 . "@src64/main.l")
-rd (5113 . "@src64/io.l")
+rd (5116 . "@src64/io.l")
read (2624 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
rest (2296 . "@src64/main.l")
reverse (1674 . "@src64/subr.l")
-rewind (5079 . "@src64/io.l")
+rewind (5082 . "@src64/io.l")
rollback (1888 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (311 . "@src64/flow.l")
@@ -297,31 +297,31 @@ set (1480 . "@src64/sym.l")
setq (1513 . "@src64/sym.l")
sigio (495 . "@src64/main.l")
size (2802 . "@src64/subr.l")
-skip (3466 . "@src64/io.l")
+skip (3469 . "@src64/io.l")
sort (3958 . "@src64/subr.l")
sp? (709 . "@src64/sym.l")
-space (5013 . "@src64/io.l")
+space (5016 . "@src64/io.l")
split (1588 . "@src64/subr.l")
stack (563 . "@src64/main.l")
state (2001 . "@src64/flow.l")
stem (1985 . "@src64/subr.l")
-str (3984 . "@src64/io.l")
+str (3987 . "@src64/io.l")
str? (1011 . "@src64/sym.l")
strip (1572 . "@src64/subr.l")
sub? (1442 . "@src64/sym.l")
sum (1460 . "@src64/apply.l")
super (1215 . "@src64/flow.l")
-sym (3970 . "@src64/io.l")
+sym (3973 . "@src64/io.l")
sym? (2430 . "@src64/subr.l")
-sync (3153 . "@src64/io.l")
+sync (3156 . "@src64/io.l")
sys (3053 . "@src64/flow.l")
t (1743 . "@src64/flow.l")
tail (1907 . "@src64/subr.l")
-tell (3225 . "@src64/io.l")
+tell (3228 . "@src64/io.l")
text (1270 . "@src64/sym.l")
throw (2485 . "@src64/flow.l")
tick (3169 . "@src64/flow.l")
-till (3575 . "@src64/io.l")
+till (3578 . "@src64/io.l")
time (2514 . "@src64/main.l")
touch (1047 . "@src64/sym.l")
trim (1755 . "@src64/subr.l")
@@ -338,12 +338,12 @@ use (1565 . "@src64/flow.l")
usec (2619 . "@src64/main.l")
val (1461 . "@src64/sym.l")
version (3004 . "@src64/main.l")
-wait (3115 . "@src64/io.l")
+wait (3118 . "@src64/io.l")
when (1876 . "@src64/flow.l")
while (2053 . "@src64/flow.l")
wipe (3088 . "@src64/sym.l")
with (1322 . "@src64/flow.l")
-wr (5196 . "@src64/io.l")
+wr (5199 . "@src64/io.l")
xchg (1536 . "@src64/sym.l")
xor (1693 . "@src64/flow.l")
x| (2885 . "@src64/big.l")
diff --git a/src64/Makefile b/src64/Makefile
@@ -1,4 +1,4 @@
-# 09apr11abu
+# 18apr11abu
# (c) Software Lab. Alexander Burger
.SILENT:
@@ -69,13 +69,13 @@ x86-64.linux.ht.s: lib/asm.l arch/x86-64.l ht.l
ppc64.linux.base.s: lib/asm.l arch/ppc64.l $(baseFiles) sys/ppc64.linux.code.l
- ./mkAsm ppc64 linux Linux base $(lib)/tags $(baseFiles) sys/ppc64.linux.code.l
+ ./mkAsm ppc64 linux Linux base $(lib)/tags $(baseFiles) sys/ppc64.linux.code.l -'prSym "ppc64.symtab"'
-ppc64.linux.ext.s: lib/asm.l arch/ppc64.l ext.l
- ./mkAsm ppc64 linux Linux ext "" -fpic ext.l
+ppc64.linux.ext.s: lib/asm.l arch/ppc64.l ext.l ppc64.linux.base.s
+ ./mkAsm ppc64 linux Linux ext "" -fpic -'rdSym "ppc64.symtab"' ext.l
-ppc64.linux.ht.s: lib/asm.l arch/ppc64.l ht.l
- ./mkAsm ppc64 linux Linux ht "" -fpic ht.l
+ppc64.linux.ht.s: lib/asm.l arch/ppc64.l ht.l ppc64.linux.base.s
+ ./mkAsm ppc64 linux Linux ht "" -fpic -'rdSym "ppc64.symtab"' ht.l
x86-64.sunOs.base.s: lib/asm.l arch/x86-64.l $(baseFiles) sys/x86-64.sunOs.code.l
diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l
@@ -1,4 +1,4 @@
-# 14apr11abu
+# 18apr11abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -17,10 +17,10 @@
# TOC: 2
# C arguments: 3 - 10
+# Operands: 4, 5, 6
# NULL: 20
# ONE: 21
# Data: 22
-# Operands: 23, 24, 25
# Carry flag: 31
# Temporary register
@@ -31,15 +31,75 @@
R ) ) )
# Machine specific
+(zero *DataPos *TextPos)
+(off *DataLabels *TextLabels *DataIndex *TextIndex)
+
+(redef label (Lbl Flg)
+ (label Lbl Flg)
+ (unless *FPic
+ (cond
+ ((== *Section 'data)
+ (push '*DataLabels (cons Lbl *DataPos)) )
+ ((== *Section 'text)
+ (unless (pre? "." Lbl)
+ (push '*TextLabels (cons Lbl *TextPos)) ) ) ) ) )
+
+(de asciiLen (Str)
+ (- (size (pack (replace (chop Str) "\\"))) 2) ) # Don't count double quotes
+
+(redef prinst (Name . @)
+ (pass prinst Name)
+ (cond
+ ((== *Section 'data)
+ (inc '*DataPos
+ (case Name
+ (".balign"
+ (if (gt0 (% *DataPos (next)))
+ (- (arg) @)
+ 0 ) )
+ (".quad" 8)
+ (".byte"
+ (if (num? (next))
+ 1
+ (length (split (chop (arg)) ",")) ) )
+ (".short"
+ (if (num? (next))
+ 2
+ (* 2 (length (split (chop (arg)) ","))) ) )
+ (".space" (next))
+ (".ascii" (asciiLen (next)))
+ (".asciz" (inc (asciiLen (next))))
+ (T (quit "Unknown data directive")) ) ) )
+ ((== *Section 'text)
+ (if (= Name ".quad")
+ (inc '*TextPos 24) # In 'main'
+ (unless (= Name ".balign")
+ (inc '*TextPos 4) ) ) ) ) )
+
+(de prSym (File)
+ (out File
+ (println (sort *DataLabels))
+ (println (sort *TextLabels)) ) )
+
+(de rdSym (File)
+ (in File
+ (balance '*DataIndex (read))
+ (balance '*TextIndex (read)) ) )
+
+(de dataOffset (Sym)
+ (if (lup *DataIndex Sym)
+ (cdr @)
+ (pack Sym "-Data") ) )
+
+(de dataGot (Reg Sym)
+ (if (lup *DataIndex Sym)
+ (prinst "la" Reg (pack (cdr @) "(22)"))
+ (prinst "ld" Reg (pack Sym "@got(2)")) ) )
+
(de boxfun (Adr)
(pack Adr "+2") )
# Addressing modes
-(de uimm16 (N)
- (or
- (ge0 (setq N (format N)))
- (+ 65536 N) ) )
-
(de checkOp (Fun)
(unless (Fun Op)
(quit "Illegal operation" *Statement) ) )
@@ -142,40 +202,40 @@
(prinst "li" Reg Mem)
NIL )
((or *FPic (low? Mem)) # -fpic or code label
- (prinst "ld" Reg (pack Mem "@got(2)")) )
- (T (opReg NIL Reg (pack Mem "-Data") 22)) ) )
+ (dataGot Reg Mem) )
+ (T (opReg NIL Reg (dataOffset Mem) 22)) ) )
((not (car M)) # Indexed
(cond
((not (cdr M)) (opReg Op Reg 0 (car Mem)))
((=0 (cdr M))
(if (>= 32767 (cdr Mem) -32768)
(opReg Op Reg (cdr Mem) (car Mem))
- (prinst "lis" (abs Reg) (>> 16 (cdr Mem)))
- (unless (=0 (& 65535 (cdr Mem)))
- (prinst "ori" (abs Reg) (abs Reg) (& 65535 (cdr Mem))) )
- (opxReg Op Reg Reg (car Mem)) ) )
+ (let R (or Tmp (tmpReg))
+ (prinst "lis" R (>> 16 (cdr Mem)))
+ (unless (=0 (& 65535 (cdr Mem)))
+ (prinst "ori" R R (& 65535 (cdr Mem))) )
+ (opxReg Op Reg R (car Mem)) ) ) )
((=T (cdr M))
(cond
((sub? "-" (cdr Mem)) # Label difference
(opReg Op Reg (cdr Mem) (car Mem)) )
((or *FPic (low? (cdr Mem))) # -fpic or code label
(let R (if (lt0 Reg) (tmpReg) Reg)
- (prinst "ld" R (pack (cdr Mem) "@got(2)"))
+ (dataGot R (cdr Mem))
(opxReg Op Reg R (car Mem)) ) )
(T
(let R (if (lt0 Reg) (tmpReg) Reg)
- (prinst "la" R (pack (cdr Mem) "-Data(22)"))
+ (prinst "la" R (pack (dataOffset (cdr Mem)) "(22)"))
(opxReg Op Reg R (car Mem)) ) ) ) ) ) )
((=T (car M)) # Indirect
(if (or *FPic (low? (car Mem))) # -fpic or code label
(let R (if (lt0 Reg) (tmpReg) Reg)
- (prinst "ld" R (pack (car Mem) "@got(2)"))
+ (dataGot R (car Mem))
(opReg 0 Reg 0 R) )
(opReg Op Reg
(pack
(and (cdr M) (pack (cdr Mem) "+"))
- (car Mem)
- "-Data" )
+ (dataOffset (car Mem)) )
22 ) ) )
(T # Combined
(let R (or Tmp (tmpReg))
@@ -215,7 +275,7 @@
(cond
((not S)
(prog1 (tmpReg)
- (prinst "insrdi" @ (abs Src) 8 56) ) )
+ (prinst "extrdi" @ (abs Src) 8 56) ) )
((n0 S)
(prog1 (tmpReg)
(memory Src S @ "lbz") ) )
@@ -274,25 +334,28 @@
(prinst "nop") )
(asm align (N)
- (prinst ".balign" N) )
+ (unless (== *Section 'text)
+ (prinst ".balign" N) ) )
(asm skip (N)
(when (== 'data *Section)
(or (=0 N) (prinst ".space" N)) ) )
(asm ld (Dst D Src S)
- (nond
- (D
+ (cond
+ ((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))) ) ) )
- (S
+ ((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))) ) ) )
- (NIL
+ ((= "0" Src) (memory Dst D 20 T))
+ ((= "1" Src) (memory Dst D 21 T))
+ (T
(let R (tmpReg)
(memory Src S R 0)
(memory Dst D R T) ) ) ) )
@@ -354,36 +417,36 @@
(memory2 "std" Tmp B) ) ) ) ) )
(asm movn (Dst D Src S Cnt C)
- (memory Dst D 23)
- (memory Src S 24)
- (memory Cnt C 25 0)
+ (memory Dst D 4)
+ (memory Src S 5)
+ (memory Cnt C 6 0)
(prinst "bl" "call")
(prinst ".int" "movn-.") )
(asm mset (Dst D Cnt C)
- (memory Dst D 23)
- (memory Cnt C 24 0)
+ (memory Dst D 4)
+ (memory Cnt C 5 0)
(prinst "bl" "call")
(prinst ".int" "mset-.") )
(asm movm (Dst D Src S End E)
- (memory Dst D 25)
- (memory Src S 23)
- (memory End E 24)
+ (memory Dst D 6)
+ (memory Src S 4)
+ (memory End E 5)
(prinst "bl" "call")
(prinst ".int" "save-.") )
(asm save (Src S End E Dst D)
- (memory Src S 23)
- (memory End E 24)
- (memory Dst D 25)
+ (memory Src S 4)
+ (memory End E 5)
+ (memory Dst D 6)
(prinst "bl" "call")
(prinst ".int" "save-.") )
(asm load (Dst D End E Src S)
- (memory Dst D 23)
- (memory End E 24)
- (memory Src S 25)
+ (memory Dst D 4)
+ (memory End E 5)
+ (memory Src S 6)
(prinst "bl" "call")
(prinst ".int" "load-.") )
@@ -460,9 +523,9 @@
(regDst A) ) )
(asm and (Dst D Src S)
- (if (and (=0 S) (>= 32767 (format Src) -32768))
+ (if (and (=0 S) (>= 65535 (format Src) 0))
(let A (dstReg Dst D)
- (prinst "andi." (cadr A) (cadr A) (uimm16 Src))
+ (prinst "andi." (cadr A) (cadr A) (format Src))
(regDst A) )
(let A (dstSrcReg Dst D Src S)
(prinst "and." (caddr A) (caddr A) (car A))
@@ -479,15 +542,15 @@
(regDst (cdr A)) ) )
(asm off (Dst D Src S)
- (let A (dstReg Dst D)
- (prinst "andi." (cadr A) (cadr A)
- (x| `(hex "FFFF") (format (cdr (chop Src)))) )
+ (let (A (dstReg Dst D) R (tmpReg))
+ (prinst "li" R Src)
+ (prinst "and" (cadr A) (cadr A) R)
(regDst A) ) )
(asm test (Dst D Src S)
- (if (and (=0 S) (>= 32767 (format Src) -32768))
+ (if (and (=0 S) (>= 65535 (format Src) 0))
(let A (dstReg Dst D)
- (prinst "andi." 0 (cadr A) (uimm16 Src)) )
+ (prinst "andi." 0 (cadr A) (format Src)) )
(let A (dstSrcReg Dst D Src S)
(prinst "and." 0 (caddr A) (car A)) ) ) )
@@ -512,7 +575,7 @@
(when (gt0 (dec (format Src)))
(prinst "srdi" (cadr A) (cadr A) @) )
(prinst "li" 31 -2) # Set carry from LSB
- (prinst "insrdi" 31 (cadr A) 1 0)
+ (prinst "insrdi" 31 (cadr A) 1 63)
(prinst "srdi." (cadr A) (cadr A) 1)
(regDst A) ) ) )
@@ -560,7 +623,7 @@
(prinst "mulld" 3 3 R) ) )
(asm div (Src S)
- (srcReg Src S 23)
+ (srcReg Src S 4)
(prinst "bl" "call")
(prinst ".int" "div-.") )
@@ -595,31 +658,32 @@
(prinst "subfme" 31 21) ) # Set inverted carry
(asm cmpn (Dst D Src S Cnt C)
- (memory Dst D 23)
- (memory Src S 24)
- (memory Cnt C 25 0)
+ (memory Dst D 4)
+ (memory Src S 5)
+ (memory Cnt C 6 0)
(prinst "bl" "call")
(prinst ".int" "cmpn-.") )
(asm slen (Dst D Src S)
- (memory Src S 24)
+ (memory Src S 5)
(prinst "bl" "call")
(prinst ".int" "slen-.")
- (memory Dst D 23 T) )
+ (memory Dst D 4 T) )
(asm memb (Src S Cnt C)
- (memory Src S 23)
- (memory Cnt C 24 0)
+ (memory Src S 4)
+ (memory Cnt C 5 0)
(prinst "bl" "call")
(prinst ".int" "memb-.")
- (unless S (prinst "mr" Src 23))
- (unless C (prinst "mr" Cnt 24)) )
+ (unless S (prinst "mr" Src 4))
+ (unless C (prinst "mr" Cnt 5)) )
(asm null (Src S)
(prinst "cmpdi" (srcReg Src S) 0) )
(asm nul4 ()
- (prinst "extldi." 3 3 32 32) )
+ (prinst "sldi" 3 3 32)
+ (prinst "sradi." 3 3 32) )
# Byte addressing
(asm set (Dst D Src S)
@@ -652,12 +716,11 @@
(prinst ".int" (pack Adr "-.")) )
((=T A) # Indexed: Ignore SUBR
(prinst "mtctr" Adr)
- (prinst "bctrl") )
+ (prinst "bl" "callCtr") )
(NIL # Indirect
- (let R (tmpReg)
- (prinst "ld" R (pack Adr "-Data(22)"))
- (prinst "mtctr" R)
- (prinst "bctrl") ) ) ) )
+ (prinst "ld" 11 (pack (dataOffset Adr) "(22)"))
+ (prinst "mtctr" 11)
+ (prinst "bl" "callCtr") ) ) )
(de _jmp Args
(nond
@@ -676,7 +739,7 @@
(= `(char ".") (char Adr)) # Local label
(and
(cdr (split (chop Adr) "_"))
- (format @) ) )
+ (format (last @)) ) )
car
cadr )
Args ) )
@@ -693,11 +756,10 @@
(for E (fill (caddr Args))
(apply prinst (cons (pack (pop 'E) (pop 'E)) E)) ) )
(NIL
- (let R (tmpReg)
- (prinst "ld" R (pack Adr "-Data(22)"))
- (prinst "mtctr" R)
- (for E (fill (caddr Args))
- (apply prinst (cons (pack (pop 'E) (pop 'E)) E)) ) ) ) ) )
+ (prinst "ld" 11 (pack (dataOffset Adr) "(22)"))
+ (prinst "mtctr" 11)
+ (for E (fill (caddr Args))
+ (apply prinst (cons (pack (pop 'E) (pop 'E)) E)) ) ) ) )
(asm jmp (Adr A)
(_jmp
@@ -852,12 +914,12 @@
#{MADA}# ) )
(nond
(A # Absolute
- (prinst "mflr" 23)
+ (prinst "mflr" 26)
(prinst "stdu" 1 "-112(1)")
(prinst "bl" Adr)
(prinst "nop")
(prinst "addi" 1 1 112)
- (prinst "mtlr" 23) )
+ (prinst "mtlr" 26) )
((=T A) # Indexed
(prinst "mtctr" Adr)
(prinst "bctrl") ) )
@@ -912,7 +974,7 @@
((=T Dst)
(let R (tmpReg)
(prinst "ld" R "0(1)")
- (prinst "insrdi" 31 R 1 0) # Set carry from LSB
+ (prinst "insrdi" 31 R 1 63) # Set carry from LSB
(prinst "mtocrf" 128 R) ) ) # Set CR[0] (LT, GT, EQ, SO)
(T (prinst "ld" Dst "0(1)")) )
(prinst "addi" 1 1 8) )
@@ -932,10 +994,10 @@
# Evaluation
(asm eval ()
- (prinst "rldicl." 0 15 63 62) # Number?
+ (prinst "andi." 0 15 "0x06") # Number?
(prinst "bne-" "2f") # Yes: Skip
- (prinst "rldicl." 0 15 61 63) # Symbol?
- (prinst "bne-" "1f") # Yes: Get value
+ (prinst "andi." 0 15 "0x08") # Symbol?
+ (prinst "beq-" "1f") # Yes: Get value
(prinst "ld" 15 "0(15)")
(prinst "b" "2f") # and skip
(prinl "1:")
@@ -944,10 +1006,10 @@
(prinl "2:") )
(asm eval+ ()
- (prinst "rldicl." 0 15 63 62) # Number?
+ (prinst "andi." 0 15 "0x06") # Number?
(prinst "bne-" "2f") # Yes: Skip
- (prinst "rldicl." 0 15 61 63) # Symbol?
- (prinst "bne-" "1f") # Yes: Get value
+ (prinst "andi." 0 15 "0x08") # Symbol?
+ (prinst "beq-" "1f") # Yes: Get value
(prinst "ld" 15 "0(15)")
(prinst "b" "2f") # and skip
(prinl "1:")
@@ -960,46 +1022,42 @@
(prinl "2:") )
(asm eval/ret ()
- (prinst "rldicl." 0 15 63 62) # Number?
+ (prinst "andi." 0 15 "0x06") # Number?
(prinst "bnelr") # Yes: Return
- (prinst "rldicl." 0 15 61 63) # Symbol?
- (prinst "bne-" "1f") # No: Evaluate list
+ (prinst "andi." 0 15 "0x08") # Symbol?
+ (prinst "beq-" "1f") # No: Evaluate list
(prinst "ld" 15 "0(15)") # Get value
(prinst "blr")
(prinl "1:")
(prinst "b" "evListE_E") )
(asm exec (Reg)
- (prinl "1:") # do
- (prinst "ld" 15 # ld E (R)
- (pack "0(" Reg ")") )
- (prinst "andi." 0 15 "0x0E") # atom E
+ (prinl "1:") # do
+ (prinst "ld" 15 (pack "0(" Reg ")")) # ld E (R)
+ (prinst "andi." 0 15 "0x0E") # atom E
(prinst "bne+" "2f")
- (prinst "bl" "call") # Evaluate list
+ (prinst "bl" "call") # Evaluate list
(prinst ".int" "evListE_E-.")
(prinl "2:")
- (prinst "ld" Reg # ld R (R CDR)
- (pack "8(" Reg ")") )
- (prinst "andi." 0 Reg "0x0E") # atom R
- (prinst "beq+" "1b") ) # until nz
+ (prinst "ld" Reg (pack "8(" Reg ")")) # ld R (R CDR)
+ (prinst "andi." 0 Reg "0x0E") # atom R
+ (prinst "beq+" "1b") ) # until nz
(asm prog (Reg)
- (prinl "1:") # do
- (prinst "ld" 15 # ld E (R)
- (pack "0(" Reg ")") )
- (prinst "andi." 0 15 "0x06") # eval
+ (prinl "1:") # do
+ (prinst "ld" 15 (pack "0(" Reg ")")) # ld E (R)
+ (prinst "andi." 0 15 "0x06") # eval
(prinst "bne-" "2f")
(prinst "andi." 0 15 "0x08")
- (prinst "bne-" "2f")
+ (prinst "beq-" ".+12")
(prinst "ld" 15 "0(15)")
(prinst "b" "2f")
- (prinst "bl" "call") # Evaluate list
+ (prinst "bl" "call") # Evaluate list
(prinst ".int" "evListE_E-.")
(prinl "2:")
- (prinst "ld" Reg # ld R (R CDR)
- (pack "8(" Reg ")") )
- (prinst "andi." 0 Reg "0x0E") # atom R
- (prinst "beq+" "1b") ) # until nz
+ (prinst "ld" Reg (pack "8(" Reg ")")) # ld R (R CDR)
+ (prinst "andi." 0 Reg "0x0E") # atom R
+ (prinst "beq+" "1b") ) # until nz
# System
@@ -1007,104 +1065,113 @@
(asm initCode ()
(prinl "# Subroutine-call emulation")
- (prinl "call:")
+ (label "call")
(prinst "mflr" 11) # Get return address
- (prinst "stdu" 11 "-8(1)") # Save it
(prinst "lwa" 0 "0(11)") # Target offset
(prinst "add" 0 0 11)
- (prinst "mtlr" 0) # Call target
- (prinst "blrl")
- (prinst "ld" 11 "0(1)") # Pop return address
- (prinst "addi" 1 1 8)
+ (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 "bctr")
+ (prinl)
+ (label "callCtr")
+ (prinst "mflr" 11) # Get return address
+ (prinst "stdu" 11 "-8(1)") # Save it
+ (prinst "bctrl") # Call target
+ (prinst "ld" 0 "0(1)") # Pop return address
+ (prinst "addi" 1 1 8)
(prinst "mtctr" 0) # Return
(prinst "bctr")
(prinl)
(prinl "# movn dst src cnt")
- (prinl "movn:")
- (prinst "subi" 23 23 1) # Adjust 'dst'
- (prinst "subi" 24 24 1) # and 'src'
+ (label "movn")
+ (prinst "subi" 4 4 1) # Adjust 'dst'
+ (prinst "subi" 5 5 1) # and 'src'
(prinl "1:")
- (prinst "subic." 25 25 1) # Decrement 'cnt'
+ (prinst "subic." 6 6 1) # Decrement 'cnt'
(prinst "bltlr") # Return if done
- (prinst "lbzu" 26 "1(24)") # Next byte from 'src'
- (prinst "stbu" 26 "1(23)") # Write to 'dst'
+ (prinst "lbzu" 26 "1(5)") # Next byte from 'src'
+ (prinst "stbu" 26 "1(4)") # Write to 'dst'
(prinst "b" "1b")
(prinl)
(prinl "# mset dst src cnt")
- (prinl "mset:")
- (prinst "subi" 23 23 1) # Adjust 'dst'
+ (label "mset")
+ (prinst "subi" 4 4 1) # Adjust 'dst'
(prinl "1:")
- (prinst "subic." 24 24 1) # Decrement 'cnt'
+ (prinst "subic." 5 5 1) # Decrement 'cnt'
(prinst "bltlr") # Return if done
- (prinst "stbu" 3 "1(23)") # Write B to 'dst'
+ (prinst "stbu" 3 "1(4)") # Write B to 'dst'
(prinst "b" "1b")
(prinl)
(prinl "# save src end dst")
- (prinl "save:")
- (prinst "subi" 23 23 8) # Adjust 'src'
- (prinst "subi" 25 25 8) # and 'dst'
+ (label "save")
+ (prinst "subi" 4 4 8) # Adjust 'src'
+ (prinst "subi" 6 6 8) # and 'dst'
(prinl "1:")
- (prinst "ldu" 26 "8(23)") # Next word from 'src'
- (prinst "cmpd" 23 24) # Done?
+ (prinst "ldu" 26 "8(4)") # Next word from 'src'
+ (prinst "cmpd" 4 5) # Done?
(prinst "beqlr") # Yes: Return
- (prinst "stdu" 26 "8(25)") # Write to 'dst'
+ (prinst "stdu" 26 "8(6)") # Write to 'dst'
(prinst "b" "1b")
(prinl)
(prinl "# load dst end src")
- (prinl "load:")
- (prinst "subi" 23 23 8) # Adjust 'dst'
- (prinst "subi" 25 25 8) # and 'src'
+ (label "load")
+ (prinst "subi" 4 4 8) # Adjust 'dst'
+ (prinst "subi" 6 6 8) # and 'src'
(prinl "1:")
- (prinst "ldu" 26 "8(25)") # Next word from 'src'
- (prinst "cmpd" 25 24) # Done?
+ (prinst "ldu" 26 "8(6)") # Next word from 'src'
+ (prinst "cmpd" 6 5) # Done?
(prinst "beqlr") # Yes: Return
- (prinst "stdu" 26 "8(23)") # Write to 'dst'
+ (prinst "stdu" 26 "8(4)") # Write to 'dst'
(prinst "b" "1b")
(prinl)
(prinl "# cmpn dst src cnt")
- (prinl "cmpn:")
- (prinst "lbz" 26 "0(23)") # First byte from 'dst'
- (prinst "lbz" 27 "0(24)") # First byte from 'src'
+ (label "cmpn")
+ (prinst "lbz" 26 "0(4)") # First byte from 'dst'
+ (prinst "lbz" 27 "0(5)") # First byte from 'src'
(prinl "1:")
(prinst "subc." 0 26 27) # Same bytes?
(prinst "bnelr") # No: Return 'ne'
- (prinst "subic." 25 25 1) # Decrement 'cnt'
+ (prinst "subic." 6 6 1) # Decrement 'cnt'
(prinst "beqlr") # Return 'eq' if done
- (prinst "lbzu" 26 "1(23)") # Next bytes
- (prinst "lbzu" 27 "1(24)")
+ (prinst "lbzu" 26 "1(4)") # Next bytes
+ (prinst "lbzu" 27 "1(5)")
(prinst "b" "1b")
(prinl)
(prinl "# slen dst src")
- (prinl "slen:")
- (prinst "li" 23 0) # Init 'dst' counter
- (prinst "lbz" 26 "0(24)") # First byte from 'src'
+ (label "slen")
+ (prinst "li" 4 0) # Init 'dst' counter
+ (prinst "lbz" 26 "0(5)") # First byte from 'src'
(prinl "1:")
(prinst "cmpdi" 26 0) # Done?
(prinst "beqlr") # Yes: Return
- (prinst "addi" 23 23 1) # Increment 'cnt'
- (prinst "lbzu" 26 "1(24)") # Next byte
+ (prinst "addi" 4 4 1) # Increment 'cnt'
+ (prinst "lbzu" 26 "1(5)") # Next byte
(prinst "b" "1b")
(prinl)
(prinl "# memb src cnt")
- (prinl "memb:")
- (prinst "lbz" 26 "0(23)") # First byte from 'src'
- (prinst "insrdi" 25 3 8 56) # Get B
+ (label "memb")
+ (prinst "lbz" 26 "0(4)") # First byte from 'src'
+ (prinst "extrdi" 6 3 8 56) # Get B
(prinl "1:")
- (prinst "subic." 24 24 1) # Decrement 'cnt'
+ (prinst "subic." 5 5 1) # Decrement 'cnt'
(prinst "bltlr") # Return 'ne' if done
- (prinst "cmpd" 26 25) # Found?
+ (prinst "cmpd" 26 6) # Found?
(prinst "beqlr") # Yes: Return 'eq'
- (prinst "lbzu" 26 "1(23)") # Next byte
+ (prinst "lbzu" 26 "1(4)") # Next byte
(prinst "b" "1b")
(prinl)
(prinl "# div src")
- (prinl "div:")
- (prinst "divdu" 24 3 23) # Only 64-bit division for now
- (prinst "mr" 3 24) # Quotient
- (prinst "mulld" 14 24 23) # Remainder
+ (label "div")
+ (prinst "divdu" 5 3 4) # Only 64-bit division for now
+ (prinst "mulld" 14 5 4) # Remainder
(prinst "subf" 14 14 3)
- (prinl "blr") )
+ (prinst "mr" 3 5) # Quotient
+ (prinst "blr") )
(asm initMain ()
(prinst ".quad" "main1" ".TOC.@tocbase" 0)
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 06apr11abu
+# 15apr11abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -2677,6 +2677,9 @@
ld B 1 # Bit mask
shl B C # Shift it
shr X 3 # Offset
+? (not *LittleEndian)
+ xor X 7 # Invert byte offset
+=
add X L # Point to byte
ret
diff --git a/src64/sys/ppc64.linux.code.l b/src64/sys/ppc64.linux.code.l
@@ -1,15 +1,16 @@
-# 27mar11abu
+# 16apr11abu
# (c) Software Lab. Alexander Burger
# System macros
(code 'errno_A 0)
- call __errno_location # Get address of 'errno'
- ld A (A) # Load value
+ cc __errno_location() # Get address of 'errno'
+ ld4 (A) # Load value
ret
(code 'errnoC 0)
- call __errno_location # Get address of 'errno'
- ld (A) C # Store new value
+ cc __errno_location() # Get address of 'errno'
+ xchg A C
+ st4 (C) # Store new value
ret
(code 's_isdirS_F 0) # S_ISDIR
