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 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:
Mdoc64/asm | 4++--
Mlib/tags | 76++++++++++++++++++++++++++++++++++++++--------------------------------------
Msrc64/arch/x86-64.l | 5++---
Msrc64/main.l | 136+++++++++++++++++++++++++++++--------------------------------------------------
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