commit c94d0ae4e3defd1ccd7981ce9666b610ab48601f
parent 2068f012357e0d10d87244bab8f0192cc6475398
Author: Alexander Burger <abu@software-lab.de>
Date: Sun, 24 Apr 2011 07:53:33 +0200
Clean up begin/return handling
Diffstat:
9 files changed, 117 insertions(+), 121 deletions(-)
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 07apr11abu
+# 24apr11abu
# (c) Software Lab. Alexander Burger
@@ -169,8 +169,8 @@
fix # Convert double with scale 'E' to fixnum in 'E'
ret # Return
- begin src # Called from C-function with 'src' arguments
- return src # Prepare to return to C-function
+ begin # Called from foreign function
+ return # Return to foreign function
Stack Manipulations:
push src # Push 'src' [---]
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -25,16 +25,16 @@ $ (2953 . "@src64/flow.l")
>> (2625 . "@src64/big.l")
abs (2729 . "@src64/big.l")
accept (139 . "@src64/net.l")
-adr (599 . "@src64/main.l")
-alarm (476 . "@src64/main.l")
+adr (595 . "@src64/main.l")
+alarm (472 . "@src64/main.l")
all (770 . "@src64/sym.l")
and (1616 . "@src64/flow.l")
any (3933 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2267 . "@src64/main.l")
-args (2243 . "@src64/main.l")
-argv (2887 . "@src64/main.l")
+arg (2259 . "@src64/main.l")
+args (2235 . "@src64/main.l")
+argv (2879 . "@src64/main.l")
as (144 . "@src64/flow.l")
asoq (3005 . "@src64/subr.l")
assoc (2970 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3082 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1957 . "@src64/flow.l")
catch (2459 . "@src64/flow.l")
-cd (2642 . "@src64/main.l")
+cd (2634 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -88,7 +88,7 @@ circ (816 . "@src64/subr.l")
circ? (2402 . "@src64/subr.l")
clip (1799 . "@src64/subr.l")
close (4338 . "@src64/io.l")
-cmd (2869 . "@src64/main.l")
+cmd (2861 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2540 . "@src64/flow.l")
commit (1494 . "@src64/db.l")
@@ -99,9 +99,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
ctl (4216 . "@src64/io.l")
-ctty (2667 . "@src64/main.l")
+ctty (2659 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
-date (2381 . "@src64/main.l")
+date (2373 . "@src64/main.l")
dbck (2103 . "@src64/db.l")
de (529 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -111,16 +111,16 @@ del (1850 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2589 . "@src64/subr.l")
-dir (2800 . "@src64/main.l")
+dir (2792 . "@src64/main.l")
dm (541 . "@src64/flow.l")
do (2133 . "@src64/flow.l")
e (2914 . "@src64/flow.l")
echo (4369 . "@src64/io.l")
-env (611 . "@src64/main.l")
+env (607 . "@src64/main.l")
eof (3492 . "@src64/io.l")
eol (3483 . "@src64/io.l")
err (4196 . "@src64/io.l")
-errno (1379 . "@src64/main.l")
+errno (1375 . "@src64/main.l")
eval (180 . "@src64/flow.l")
ext (5095 . "@src64/io.l")
ext? (1032 . "@src64/sym.l")
@@ -128,7 +128,7 @@ extern (898 . "@src64/sym.l")
extra (1259 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (1961 . "@src64/sym.l")
-file (2747 . "@src64/main.l")
+file (2739 . "@src64/main.l")
fill (3240 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2033 . "@src64/subr.l")
@@ -154,7 +154,7 @@ getl (3030 . "@src64/sym.l")
glue (1232 . "@src64/sym.l")
gt0 (2716 . "@src64/big.l")
head (1820 . "@src64/subr.l")
-heap (531 . "@src64/main.l")
+heap (527 . "@src64/main.l")
hear (3196 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1025 . "@src64/db.l")
@@ -165,7 +165,7 @@ ifn (1857 . "@src64/flow.l")
in (4156 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2637 . "@src64/subr.l")
-info (2704 . "@src64/main.l")
+info (2696 . "@src64/main.l")
intern (873 . "@src64/sym.l")
ipid (3201 . "@src64/flow.l")
isa (956 . "@src64/flow.l")
@@ -182,7 +182,7 @@ lieu (1154 . "@src64/db.l")
line (3667 . "@src64/io.l")
lines (3820 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (1946 . "@src64/main.l")
+lisp (1939 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (155 . "@src64/flow.l")
@@ -221,10 +221,10 @@ n== (2087 . "@src64/subr.l")
nT (2198 . "@src64/subr.l")
name (497 . "@src64/sym.l")
nand (1651 . "@src64/flow.l")
-native (1387 . "@src64/main.l")
+native (1383 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (830 . "@src64/flow.l")
-next (2250 . "@src64/main.l")
+next (2242 . "@src64/main.l")
nil (1734 . "@src64/flow.l")
nond (1934 . "@src64/flow.l")
nor (1672 . "@src64/flow.l")
@@ -238,7 +238,7 @@ onOff (1611 . "@src64/sym.l")
one (1644 . "@src64/sym.l")
open (4300 . "@src64/io.l")
opid (3217 . "@src64/flow.l")
-opt (2990 . "@src64/main.l")
+opt (2982 . "@src64/main.l")
or (1632 . "@src64/flow.l")
out (4176 . "@src64/io.l")
pack (1142 . "@src64/sym.l")
@@ -265,24 +265,24 @@ prog (1752 . "@src64/flow.l")
prog1 (1760 . "@src64/flow.l")
prog2 (1777 . "@src64/flow.l")
prop (2779 . "@src64/sym.l")
-protect (521 . "@src64/main.l")
+protect (517 . "@src64/main.l")
prove (3527 . "@src64/subr.l")
push (1686 . "@src64/sym.l")
push1 (1722 . "@src64/sym.l")
put (2696 . "@src64/sym.l")
putl (2948 . "@src64/sym.l")
-pwd (2631 . "@src64/main.l")
+pwd (2623 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
-quit (1094 . "@src64/main.l")
+quit (1090 . "@src64/main.l")
quote (139 . "@src64/flow.l")
rand (2976 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3033 . "@src64/subr.l")
-raw (454 . "@src64/main.l")
+raw (450 . "@src64/main.l")
rd (5112 . "@src64/io.l")
read (2624 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2296 . "@src64/main.l")
+rest (2288 . "@src64/main.l")
reverse (1678 . "@src64/subr.l")
rewind (5078 . "@src64/io.l")
rollback (1888 . "@src64/db.l")
@@ -295,14 +295,14 @@ send (1128 . "@src64/flow.l")
seq (1081 . "@src64/db.l")
set (1480 . "@src64/sym.l")
setq (1513 . "@src64/sym.l")
-sigio (492 . "@src64/main.l")
+sigio (488 . "@src64/main.l")
size (2806 . "@src64/subr.l")
skip (3469 . "@src64/io.l")
sort (3962 . "@src64/subr.l")
sp? (709 . "@src64/sym.l")
space (5012 . "@src64/io.l")
split (1592 . "@src64/subr.l")
-stack (560 . "@src64/main.l")
+stack (556 . "@src64/main.l")
state (2001 . "@src64/flow.l")
stem (1989 . "@src64/subr.l")
str (3987 . "@src64/io.l")
@@ -322,7 +322,7 @@ text (1270 . "@src64/sym.l")
throw (2485 . "@src64/flow.l")
tick (3169 . "@src64/flow.l")
till (3578 . "@src64/io.l")
-time (2514 . "@src64/main.l")
+time (2506 . "@src64/main.l")
touch (1047 . "@src64/sym.l")
trim (1759 . "@src64/subr.l")
try (1169 . "@src64/flow.l")
@@ -331,13 +331,13 @@ udp (268 . "@src64/net.l")
unify (3935 . "@src64/subr.l")
unless (1893 . "@src64/flow.l")
until (2077 . "@src64/flow.l")
-up (702 . "@src64/main.l")
+up (698 . "@src64/main.l")
upp? (3228 . "@src64/sym.l")
uppc (3292 . "@src64/sym.l")
use (1565 . "@src64/flow.l")
-usec (2619 . "@src64/main.l")
+usec (2611 . "@src64/main.l")
val (1461 . "@src64/sym.l")
-version (3004 . "@src64/main.l")
+version (2996 . "@src64/main.l")
wait (3118 . "@src64/io.l")
when (1876 . "@src64/flow.l")
while (2053 . "@src64/flow.l")
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,6,4};
+static byte Version[4] = {3,0,6,5};
diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l
@@ -1,4 +1,4 @@
-# 22apr11abu
+# 23apr11abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -998,19 +998,13 @@
(asm ret ()
(prinst "blr") )
-(asm begin (N)
+(asm begin ()
(prinst ".quad" ".+24" ".TOC.@tocbase" 0)
(prinst "mflr" 0)
- (prinst "bl" "begin")
- (and (>= N 6) (prinst "mr" 18 8)) # Z
- (and (>= N 5) (prinst "mr" 17 7)) # Y
- (and (>= N 4) (prinst "mr" 16 6)) # X
- (and (>= N 3) (prinst "mr" 15 5)) # E
- (and (>= N 2) (prinst "mr" 14 4)) ) # C
+ (prinst "bl" "begin") )
-(asm return (N)
- (prinst "bl" "return")
- (prinst "mtlr" 0) )
+(asm return ()
+ (prinst "b" "return") )
# Stack Manipulations
(asm push (Src S)
@@ -1307,7 +1301,6 @@
(prinst "li" @u1 -1)
(prinst "blr") ) )
(prinl)
- (prinl "# Begin entry")
(label "begin")
(prinst "std" 14 "-144(1)")
(prinst "std" 15 "-136(1)")
@@ -1333,9 +1326,13 @@
(prinst "li" 21 1) # Init ONE register
(prinst "ld" 22 "Data@got(2)") # Globals bases
(prinst "ld" 23 "Code@got(2)")
+ (prinst "mr" 18 8) # Z
+ (prinst "mr" 17 7) # Y
+ (prinst "mr" 16 6) # X
+ (prinst "mr" 15 5) # E
+ (prinst "mr" 14 4) # C
(prinst "blr")
(prinl)
- (prinl "# Return entry")
(label "return")
(prinst "addi" 1 1 256)
(prinst "ld" 14 "-144(1)")
@@ -1357,6 +1354,7 @@
(prinst "ld" 30 "-16(1)")
(prinst "ld" 31 "-8(1)")
(prinst "ld" 0 "16(1)")
+ (prinst "mtlr" 0)
(prinst "blr") ) )
(asm initMain ()
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 21apr11abu
+# 23apr11abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -753,29 +753,11 @@
(prinst "rep") )
(prinst "ret") )
-(asm begin (N)
- (prinst "push" "%rbx")
- (prinst "push" "%r12")
- (prinst "xor" "%r12" "%r12") # NULL register
- (when (>= N 6) # Z
- (prinst "push" "%r15")
- (prinst "mov" "%r9" "%r15") )
- (when (>= N 5) # Y
- (prinst "push" "%r14")
- (prinst "mov" "%r8" "%r14") )
- (when (>= N 4) # X
- (prinst "push" "%r13")
- (prinst "mov" "%rcx" "%r13") )
- (and (>= N 3) (prinst "mov" "%rdx" "%rbx")) # E
- (and (>= N 2) (prinst "mov" "%rsi" "%rdx")) # C
- (and (>= N 1) (prinst "mov" "%rdi" "%rax")) ) # A
-
-(asm return (N)
- (and (>= N 4) (prinst "pop" "%r13"))
- (and (>= N 5) (prinst "pop" "%r14"))
- (and (>= N 6) (prinst "pop" "%r15"))
- (prinst "pop" "%r12")
- (prinst "pop" "%rbx") )
+(asm begin ()
+ (prinst "call" "begin") )
+
+(asm return ()
+ (prinst "jmp" "return") )
# Stack Manipulations
(asm push (Src S)
@@ -878,7 +860,31 @@
# System
(asm initData ())
-(asm initCode ())
+(asm initCode ()
+ (unless *FPic
+ (label "begin")
+ (prinst "pop" "%r10") # Get return address
+ (prinst "push" "%r15") # Z
+ (prinst "mov" "%r9" "%r15")
+ (prinst "push" "%r14") # Y
+ (prinst "mov" "%r8" "%r14")
+ (prinst "push" "%r13") # X
+ (prinst "mov" "%rcx" "%r13")
+ (prinst "push" "%r12")
+ (prinst "xor" "%r12" "%r12") # NULL register
+ (prinst "push" "%rbx")
+ (prinst "mov" "%rdx" "%rbx") # E
+ (prinst "mov" "%rsi" "%rdx") # C
+ (prinst "mov" "%rdi" "%rax") # A
+ (prinst "jmp" "*%r10") # Return
+ (prinl)
+ (label "return")
+ (prinst "pop" "%rbx")
+ (prinst "pop" "%r12")
+ (prinst "pop" "%r13")
+ (prinst "pop" "%r14")
+ (prinst "pop" "%r15")
+ (prinst "ret") ) )
(asm initMain ()
(prinst "xor" "%r12" "%r12") # Init NULL register
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -1,4 +1,4 @@
-# 20apr11abu
+# 23apr11abu
# (c) Software Lab. Alexander Burger
# *LittleEndian *AlignedCode *Registers optimize
@@ -395,7 +395,7 @@
(ascii (operand (read)))
(asciz (operand (read)))
(atom (source) "*Mode")
- (begin (operand (read)))
+ (begin)
(big (source) "*Mode")
(byte (operand (read)))
(bytes (mapcar operand (read)))
@@ -473,7 +473,7 @@
(rcl (destination) "*Mode" (source) "*Mode")
(rcr (destination) "*Mode" (source) "*Mode")
(ret)
- (return (operand (read)))
+ (return)
(rol (destination) "*Mode" (source) "*Mode")
(ror (destination) "*Mode" (source) "*Mode")
(save (source) "*Mode" (source) "*Mode" (destination) "*Mode")
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 20apr11abu
+# 23apr11abu
# (c) Software Lab. Alexander Burger
(code 'Code)
@@ -341,7 +341,7 @@
ret
(code 'sig)
- begin 1 # Signal number in A
+ begin # Signal number in A
null (TtyPid) # Kill terminal process?
if nz # Yes
cc kill((TtyPid) A)
@@ -350,11 +350,10 @@
inc (A Signal)
inc (Signal)
end
- return 1
- ret
+ return
(code 'sigTerm)
- begin 0 # Ignore signal number
+ begin # Ignore signal number
null (TtyPid) # Kill terminal process?
if nz # Yes
cc kill((TtyPid) SIGTERM)
@@ -362,11 +361,10 @@
inc (Signal (* I SIGTERM))
inc (Signal)
end
- return 0
- ret
+ return
(code 'sigChld)
- begin 0 # Ignore signal number
+ begin # Ignore signal number
call errno_A # Save 'errno'
push A
sub S I # 'stat'
@@ -384,8 +382,7 @@
add S I # Drop 'stat'
pop C # Restore 'errno'
call errnoC
- return 0
- ret
+ return
(code 'tcSetC)
null (Termio) # In raw mode?
@@ -401,7 +398,7 @@
ret
(code 'sigTermStop)
- begin 0 # Ignore signal number
+ begin # Ignore signal number
ld C OrgTermio # Set original terminal I/O
call tcSetC
sub S SIGSET_T # Create mask structure
@@ -414,8 +411,7 @@
cc signal(SIGTSTP sigTermStop)
ld C (Termio)
call tcSetC
- return 0
- ret
+ return
(code 'setRaw 0)
nul (Tio) # Terminal I/O?
@@ -1810,7 +1806,6 @@
ret
: cbl
- begin 5 # Arguments in A, C, E, X and Y
push L # Save C frame pointer
ld L (Link) # Restore link register
link # Apply args
@@ -1841,104 +1836,102 @@
end
drop
pop L # Restore C frame pointer
- return 5
- pop Z
- ret
+ return
(code 'cbl1 0)
- push Z
+ begin # Arguments in A, C, E, X and Y
lea Z (Lisp) # Address of callback function
jmp cbl
: cbl2
- push Z
+ begin
lea Z (Lisp II)
jmp cbl
: cbl3
- push Z
+ begin
lea Z (Lisp (* 2 II))
jmp cbl
: cbl4
- push Z
+ begin
lea Z (Lisp (* 3 II))
jmp cbl
: cbl5
- push Z
+ begin
lea Z (Lisp (* 4 II))
jmp cbl
: cbl6
- push Z
+ begin
lea Z (Lisp (* 5 II))
jmp cbl
: cbl7
- push Z
+ begin
lea Z (Lisp (* 6 II))
jmp cbl
: cbl8
- push Z
+ begin
lea Z (Lisp (* 7 II))
jmp cbl
: cbl9
- push Z
+ begin
lea Z (Lisp (* 8 II))
jmp cbl
: cbl10
- push Z
+ begin
lea Z (Lisp (* 9 II))
jmp cbl
: cbl11
- push Z
+ begin
lea Z (Lisp (* 10 II))
jmp cbl
: cbl12
- push Z
+ begin
lea Z (Lisp (* 11 II))
jmp cbl
: cbl13
- push Z
+ begin
lea Z (Lisp (* 12 II))
jmp cbl
: cbl14
- push Z
+ begin
lea Z (Lisp (* 13 II))
jmp cbl
: cbl15
- push Z
+ begin
lea Z (Lisp (* 14 II))
jmp cbl
: cbl16
- push Z
+ begin
lea Z (Lisp (* 15 II))
jmp cbl
: cbl17
- push Z
+ begin
lea Z (Lisp (* 16 II))
jmp cbl
: cbl18
- push Z
+ begin
lea Z (Lisp (* 17 II))
jmp cbl
: cbl19
- push Z
+ begin
lea Z (Lisp (* 18 II))
jmp cbl
: cbl20
- push Z
+ begin
lea Z (Lisp (* 19 II))
jmp cbl
: cbl21
- push Z
+ begin
lea Z (Lisp (* 20 II))
jmp cbl
: cbl22
- push Z
+ begin
lea Z (Lisp (* 21 II))
jmp cbl
: cbl23
- push Z
+ begin
lea Z (Lisp (* 22 II))
jmp cbl
: cbl24
- push Z
+ begin
lea Z (Lisp (* 23 II))
jmp cbl
@@ -1987,7 +1980,7 @@
jmp errEXYZ
(code 'lisp 0)
- begin 6 # Function name in A, arguments in C, E, X, Y and Z
+ begin # Function name in A, arguments in C, E, X, Y and Z
push L # Save C frame pointer
ld L (Link) # Restore link register
link # Apply args
@@ -2030,8 +2023,7 @@
end
drop
pop L # Restore C frame pointer
- return 6
- ret
+ return
(code 'execE 0)
push X
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 15apr11abu
+# 24apr11abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 6 4)
+(de *Version 3 0 6 5)
# vi:et:ts=3:sw=3
