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 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:
Mdoc64/asm | 6+++---
Mersatz/picolisp.jar | 0
Mlib/tags | 60++++++++++++++++++++++++++++++------------------------------
Msrc/vers.h | 2+-
Msrc64/arch/ppc64.l | 24+++++++++++-------------
Msrc64/arch/x86-64.l | 56+++++++++++++++++++++++++++++++-------------------------
Msrc64/lib/asm.l | 6+++---
Msrc64/main.l | 80++++++++++++++++++++++++++++++++++++-------------------------------------------
Msrc64/version.l | 4++--
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