commit f291e20848a797b97ca0771eafe43aba8160193d
parent 3bd2f9ee3ac8e4bc0e78d8d6b799fca1c659414a
Author: Commit-Bot <unknown>
Date: Thu, 29 Jul 2010 07:40:40 +0000
Automatic commit from picoLisp.tgz, From: Thu, 29 Jul 2010 07:40:40 GMT
Diffstat:
4 files changed, 91 insertions(+), 130 deletions(-)
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 27jul10abu
+# 29jul10abu
# (c) Software Lab. Alexander Burger
@@ -170,7 +170,7 @@
ret # Return
begin src # Called from C-function with 'src' arguments
- return src # Return to C-function
+ return src # Prepare to return to C-function
Stack Manipulations:
push src # Push 'src' [---]
diff --git a/lib/tags b/lib/tags
@@ -25,16 +25,16 @@ $ (2971 . "@src64/flow.l")
>> (2625 . "@src64/big.l")
abs (2715 . "@src64/big.l")
accept (139 . "@src64/net.l")
-adr (609 . "@src64/main.l")
-alarm (483 . "@src64/main.l")
+adr (613 . "@src64/main.l")
+alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1643 . "@src64/flow.l")
any (3792 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (597 . "@src64/apply.l")
-arg (2259 . "@src64/main.l")
-args (2235 . "@src64/main.l")
-argv (2880 . "@src64/main.l")
+arg (2221 . "@src64/main.l")
+args (2197 . "@src64/main.l")
+argv (2842 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2942 . "@src64/subr.l")
assoc (2907 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3102 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1984 . "@src64/flow.l")
catch (2484 . "@src64/flow.l")
-cd (2635 . "@src64/main.l")
+cd (2597 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -87,7 +87,7 @@ chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
close (4180 . "@src64/io.l")
-cmd (2862 . "@src64/main.l")
+cmd (2824 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
co (2566 . "@src64/flow.l")
commit (1503 . "@src64/db.l")
@@ -98,9 +98,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
ctl (4120 . "@src64/io.l")
-ctty (2660 . "@src64/main.l")
+ctty (2622 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2374 . "@src64/main.l")
+date (2336 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (549 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -110,15 +110,15 @@ del (1852 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2563 . "@src64/subr.l")
-dir (2793 . "@src64/main.l")
+dir (2755 . "@src64/main.l")
dm (561 . "@src64/flow.l")
do (2158 . "@src64/flow.l")
e (2932 . "@src64/flow.l")
echo (4211 . "@src64/io.l")
-env (621 . "@src64/main.l")
+env (625 . "@src64/main.l")
eof (3351 . "@src64/io.l")
eol (3342 . "@src64/io.l")
-errno (1354 . "@src64/main.l")
+errno (1358 . "@src64/main.l")
eval (208 . "@src64/flow.l")
ext (4936 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -126,7 +126,7 @@ extern (900 . "@src64/sym.l")
extra (1284 . "@src64/flow.l")
extract (1102 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2740 . "@src64/main.l")
+file (2702 . "@src64/main.l")
fill (3177 . "@src64/subr.l")
filter (1045 . "@src64/apply.l")
fin (2020 . "@src64/subr.l")
@@ -152,7 +152,7 @@ getl (3032 . "@src64/sym.l")
glue (1234 . "@src64/sym.l")
gt0 (2702 . "@src64/big.l")
head (1807 . "@src64/subr.l")
-heap (538 . "@src64/main.l")
+heap (542 . "@src64/main.l")
hear (3092 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1034 . "@src64/db.l")
@@ -163,7 +163,7 @@ ifn (1884 . "@src64/flow.l")
in (4016 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2611 . "@src64/subr.l")
-info (2697 . "@src64/main.l")
+info (2659 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3214 . "@src64/flow.l")
isa (978 . "@src64/flow.l")
@@ -179,15 +179,15 @@ lieu (1163 . "@src64/db.l")
line (3526 . "@src64/io.l")
lines (3679 . "@src64/io.l")
link (1163 . "@src64/subr.l")
-lisp1 (1797 . "@src64/main.l")
-lisp2 (1810 . "@src64/main.l")
-lisp3 (1818 . "@src64/main.l")
-lisp4 (1826 . "@src64/main.l")
-lisp5 (1834 . "@src64/main.l")
-lisp6 (1842 . "@src64/main.l")
-lisp7 (1850 . "@src64/main.l")
-lisp8 (1858 . "@src64/main.l")
-lisp9 (1866 . "@src64/main.l")
+lisp1 (1801 . "@src64/main.l")
+lisp2 (1817 . "@src64/main.l")
+lisp3 (1823 . "@src64/main.l")
+lisp4 (1829 . "@src64/main.l")
+lisp5 (1835 . "@src64/main.l")
+lisp6 (1841 . "@src64/main.l")
+lisp7 (1847 . "@src64/main.l")
+lisp8 (1853 . "@src64/main.l")
+lisp9 (1859 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
@@ -226,10 +226,10 @@ n== (2074 . "@src64/subr.l")
nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1678 . "@src64/flow.l")
-native (1362 . "@src64/main.l")
+native (1366 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (852 . "@src64/flow.l")
-next (2242 . "@src64/main.l")
+next (2204 . "@src64/main.l")
nil (1761 . "@src64/flow.l")
nond (1961 . "@src64/flow.l")
nor (1699 . "@src64/flow.l")
@@ -243,7 +243,7 @@ onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4142 . "@src64/io.l")
opid (3230 . "@src64/flow.l")
-opt (2983 . "@src64/main.l")
+opt (2945 . "@src64/main.l")
or (1659 . "@src64/flow.l")
out (4036 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -270,24 +270,24 @@ prog (1779 . "@src64/flow.l")
prog1 (1787 . "@src64/flow.l")
prog2 (1804 . "@src64/flow.l")
prop (2781 . "@src64/sym.l")
-protect (528 . "@src64/main.l")
+protect (532 . "@src64/main.l")
prove (3434 . "@src64/subr.l")
push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2624 . "@src64/main.l")
+pwd (2586 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1071 . "@src64/main.l")
+quit (1075 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2959 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2970 . "@src64/subr.l")
-raw (461 . "@src64/main.l")
+raw (465 . "@src64/main.l")
rd (4953 . "@src64/io.l")
read (2530 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (2288 . "@src64/main.l")
+rest (2250 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (4919 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
@@ -301,14 +301,14 @@ send (1150 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
-sigio (499 . "@src64/main.l")
+sigio (503 . "@src64/main.l")
size (2752 . "@src64/subr.l")
skip (3328 . "@src64/io.l")
sort (3869 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
space (4853 . "@src64/io.l")
split (1579 . "@src64/subr.l")
-stack (567 . "@src64/main.l")
+stack (571 . "@src64/main.l")
state (2028 . "@src64/flow.l")
stem (1976 . "@src64/subr.l")
str (3846 . "@src64/io.l")
@@ -328,7 +328,7 @@ text (1272 . "@src64/sym.l")
throw (2510 . "@src64/flow.l")
tick (3182 . "@src64/flow.l")
till (3437 . "@src64/io.l")
-time (2507 . "@src64/main.l")
+time (2469 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1191 . "@src64/flow.l")
@@ -337,13 +337,13 @@ udp (268 . "@src64/net.l")
unify (3842 . "@src64/subr.l")
unless (1920 . "@src64/flow.l")
until (2104 . "@src64/flow.l")
-up (708 . "@src64/main.l")
+up (712 . "@src64/main.l")
upp? (3232 . "@src64/sym.l")
uppc (3296 . "@src64/sym.l")
use (1592 . "@src64/flow.l")
-usec (2612 . "@src64/main.l")
+usec (2574 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (2997 . "@src64/main.l")
+version (2959 . "@src64/main.l")
wait (3016 . "@src64/io.l")
when (1903 . "@src64/flow.l")
while (2080 . "@src64/flow.l")
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 28jul10abu
+# 29jul10abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -690,8 +690,7 @@
(and (>= N 5) (prinst "pop" "%r14"))
(and (>= N 6) (prinst "pop" "%r15"))
(prinst "pop" "%r12")
- (prinst "pop" "%rbx")
- (prinst "ret") )
+ (prinst "pop" "%rbx") )
# Stack Manipulations
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 28jul10abu
+# 29jul10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -361,6 +361,7 @@
inc (Signal)
end
return 1
+ ret
(code 'sigTerm)
begin 0 # Ignore signal number
@@ -372,6 +373,7 @@
inc (Signal)
end
return 0
+ ret
(code 'sigChld)
begin 0 # Ignore signal number
@@ -393,6 +395,7 @@
pop C # Restore 'errno'
call errnoC
return 0
+ ret
: PidSigMsg asciz "%d SIG-%d\\n"
(code 'tcSetC)
@@ -423,6 +426,7 @@
ld C (Termio)
call tcSetC
return 0
+ ret
(code 'setRaw 0)
nul (Tio) # Terminal I/O?
@@ -1795,11 +1799,14 @@
# (lisp1 'fun) -> num
(code 'doLisp1 2)
+ push cbLisp1 # Callback function pointer
+ push Lisp1 # Address of callback function
+: lispN
ld E ((E CDR)) # Eval arg
eval
- ld (Lisp1) E # Set callback function
- ld E cbLisp1 # Return function pointer
-: boxPtr
+ pop A # Get address
+ ld (A) E # Set callback function
+ pop E # Return function pointer
test E (hex "F000000000000000") # Fit in short number?
jnz boxNumE_E # No
shl E 4 # Else make short number
@@ -1808,76 +1815,61 @@
# (lisp2 'fun) -> num
(code 'doLisp2 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp2) E # Set callback function
- ld E cbLisp2 # Return function pointer
- jmp boxPtr
+ push cbLisp2 # Callback function pointer
+ push Lisp2 # Address of callback function
+ jmp lispN
# (lisp3 'fun) -> num
(code 'doLisp3 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp3) E # Set callback function
- ld E cbLisp3 # Return function pointer
- jmp boxPtr
+ push cbLisp3 # Callback function pointer
+ push Lisp3 # Address of callback function
+ jmp lispN
# (lisp4 'fun) -> num
(code 'doLisp4 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp4) E # Set callback function
- ld E cbLisp4 # Return function pointer
- jmp boxPtr
+ push cbLisp4 # Callback function pointer
+ push Lisp4 # Address of callback function
+ jmp lispN
# (lisp5 'fun) -> num
(code 'doLisp5 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp5) E # Set callback function
- ld E cbLisp5 # Return function pointer
- jmp boxPtr
+ push cbLisp5 # Callback function pointer
+ push Lisp5 # Address of callback function
+ jmp lispN
# (lisp6 'fun) -> num
(code 'doLisp6 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp6) E # Set callback function
- ld E cbLisp6 # Return function pointer
- jmp boxPtr
+ push cbLisp6 # Callback function pointer
+ push Lisp6 # Address of callback function
+ jmp lispN
# (lisp7 'fun) -> num
(code 'doLisp7 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp7) E # Set callback function
- ld E cbLisp7 # Return function pointer
- jmp boxPtr
+ push cbLisp7 # Callback function pointer
+ push Lisp7 # Address of callback function
+ jmp lispN
# (lisp8 'fun) -> num
(code 'doLisp8 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp8) E # Set callback function
- ld E cbLisp8 # Return function pointer
- jmp boxPtr
+ push cbLisp8 # Callback function pointer
+ push Lisp8 # Address of callback function
+ jmp lispN
# (lisp9 'fun) -> num
(code 'doLisp9 2)
- ld E ((E CDR)) # Eval arg
- eval
- ld (Lisp9) E # Set callback function
- ld E cbLisp9 # Return function pointer
- jmp boxPtr
+ push cbLisp9 # Callback function pointer
+ push Lisp9 # Address of callback function
+ jmp lispN
(code 'cbLisp1 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
+ ld Z Lisp1 # Address of callback function
+: cbLisp
+ 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
push (Lisp1) # 'fun'
-: cbLisp
xchg A E # First arg
call boxCntE_E # Make number
push E
@@ -1904,79 +1896,48 @@
end
drop
pop L # Restore C frame pointer
- pop Z
return 5
+ pop Z
+ ret
(code 'cbLisp2 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp2) # 'fun'
+ ld Z Lisp2 # Address of callback function
jmp cbLisp
(code 'cbLisp3 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp3) # 'fun'
+ ld Z Lisp3 # Address of callback function
jmp cbLisp
(code 'cbLisp4 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp4) # 'fun'
+ ld Z Lisp4 # Address of callback function
jmp cbLisp
(code 'cbLisp5 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp5) # 'fun'
+ ld Z Lisp5 # Address of callback function
jmp cbLisp
(code 'cbLisp6 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp6) # 'fun'
+ ld Z Lisp6 # Address of callback function
jmp cbLisp
(code 'cbLisp7 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp7) # 'fun'
+ ld Z Lisp7 # Address of callback function
jmp cbLisp
(code 'cbLisp8 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp8) # 'fun'
+ ld Z Lisp8 # Address of callback function
jmp cbLisp
(code 'cbLisp9 0)
- begin 5 # Arguments in A, C, E, X and Y
push Z
- push L # Save C frame pointer
- ld L (Link) # Restore link register
- link # Apply args
- push (Lisp9) # 'fun'
+ ld Z Lisp9 # Address of callback function
jmp cbLisp
(code 'lisp 0)
@@ -2024,6 +1985,7 @@
drop
pop L # Restore C frame pointer
return 6
+ ret
(code 'execE 0)
push X
