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 7b792341cd588db9f4227749ebcde177212f1c58
parent 95fd604242ff8a626af4be932bfccde5703527ff
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon, 20 Jun 2011 12:58:49 +0200

Use full 64 bits in native arguments
Diffstat:
Mlib/tags | 36++++++++++++++++++------------------
Msrc64/big.l | 4++--
Msrc64/main.l | 97+++++++++++++++++++++++++++----------------------------------------------------
3 files changed, 53 insertions(+), 84 deletions(-)

diff --git a/lib/tags b/lib/tags @@ -32,9 +32,9 @@ and (1616 . "@src64/flow.l") any (3933 . "@src64/io.l") append (1338 . "@src64/subr.l") apply (713 . "@src64/apply.l") -arg (2342 . "@src64/main.l") -args (2318 . "@src64/main.l") -argv (2962 . "@src64/main.l") +arg (2311 . "@src64/main.l") +args (2287 . "@src64/main.l") +argv (2931 . "@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 (2717 . "@src64/main.l") +cd (2686 . "@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 (2944 . "@src64/main.l") +cmd (2913 . "@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 (2742 . "@src64/main.l") +ctty (2711 . "@src64/main.l") cut (1795 . "@src64/sym.l") -date (2456 . "@src64/main.l") +date (2425 . "@src64/main.l") dbck (2103 . "@src64/db.l") de (529 . "@src64/flow.l") dec (2323 . "@src64/big.l") @@ -111,7 +111,7 @@ del (1850 . "@src64/sym.l") delete (1401 . "@src64/subr.l") delq (1452 . "@src64/subr.l") diff (2589 . "@src64/subr.l") -dir (2875 . "@src64/main.l") +dir (2844 . "@src64/main.l") dm (541 . "@src64/flow.l") do (2133 . "@src64/flow.l") e (2914 . "@src64/flow.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 (2822 . "@src64/main.l") +file (2791 . "@src64/main.l") fill (3240 . "@src64/subr.l") filter (1161 . "@src64/apply.l") fin (2033 . "@src64/subr.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 (2779 . "@src64/main.l") +info (2748 . "@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 (2022 . "@src64/main.l") +lisp (1983 . "@src64/main.l") list (887 . "@src64/subr.l") listen (151 . "@src64/net.l") lit (155 . "@src64/flow.l") @@ -224,7 +224,7 @@ nand (1651 . "@src64/flow.l") native (1383 . "@src64/main.l") need (919 . "@src64/subr.l") new (830 . "@src64/flow.l") -next (2325 . "@src64/main.l") +next (2294 . "@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 (3065 . "@src64/main.l") +opt (3034 . "@src64/main.l") or (1632 . "@src64/flow.l") out (4176 . "@src64/io.l") pack (1142 . "@src64/sym.l") @@ -271,7 +271,7 @@ push (1686 . "@src64/sym.l") push1 (1722 . "@src64/sym.l") put (2696 . "@src64/sym.l") putl (2948 . "@src64/sym.l") -pwd (2706 . "@src64/main.l") +pwd (2675 . "@src64/main.l") queue (1918 . "@src64/sym.l") quit (1090 . "@src64/main.l") quote (139 . "@src64/flow.l") @@ -282,7 +282,7 @@ raw (450 . "@src64/main.l") rd (5112 . "@src64/io.l") read (2624 . "@src64/io.l") replace (1499 . "@src64/subr.l") -rest (2371 . "@src64/main.l") +rest (2340 . "@src64/main.l") reverse (1678 . "@src64/subr.l") rewind (5078 . "@src64/io.l") rollback (1888 . "@src64/db.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 (2589 . "@src64/main.l") +time (2558 . "@src64/main.l") touch (1047 . "@src64/sym.l") trim (1759 . "@src64/subr.l") try (1169 . "@src64/flow.l") @@ -335,9 +335,9 @@ up (698 . "@src64/main.l") upp? (3228 . "@src64/sym.l") uppc (3292 . "@src64/sym.l") use (1565 . "@src64/flow.l") -usec (2694 . "@src64/main.l") +usec (2663 . "@src64/main.l") val (1461 . "@src64/sym.l") -version (3079 . "@src64/main.l") +version (3048 . "@src64/main.l") wait (3118 . "@src64/io.l") when (1876 . "@src64/flow.l") while (2053 . "@src64/flow.l") diff --git a/src64/big.l b/src64/big.l @@ -1,4 +1,4 @@ -# 22apr11abu +# 20jun11abu # (c) Software Lab. Alexander Burger ### Destructive primitives ### @@ -3022,6 +3022,6 @@ add E C pop Y pop X - jmp boxCntE_E # Return short number + jmp boxE_E # Return short number # vi:et:ts=3:sw=3 diff --git a/src64/main.l b/src64/main.l @@ -1,4 +1,4 @@ -# 14jun11abu +# 20jun11abu # (c) Software Lab. Alexander Burger (code 'Code) @@ -1480,21 +1480,11 @@ neg E # Yes end else - test E SIGN # Get sign - push F # Save - off E (| SIGN BIG) # Get cell pointer - ld A (E CDR) # High word - ld E (E) # Low word - shr A 5 # Get highest four bits - rcr E 1 - shr A 1 - rcr E 1 - shr A 1 - rcr E 1 - shr A 1 - rcr E 1 - pop F # Negative - if nz # Yes + test E SIGN # Sign? + if z # No + ld E (E DIG) + else + ld E (E (- DIG SIGN)) neg E # Negate end end @@ -1573,21 +1563,11 @@ neg A # Yes end else - test A SIGN # Get sign - push F # Save - off A (| SIGN BIG) # Get cell pointer - ld X (A CDR) # High word - ld A (A) # Low word - shr X 5 # Get highest four bits - rcr A 1 - shr X 1 - rcr A 1 - shr X 1 - rcr A 1 - shr X 1 - rcr A 1 - pop F # Negative - if nz # Yes + test A SIGN # Sign? + if z # No + ld A (A DIG) + else + ld A (A (- DIG SIGN)) neg A # Negate end end @@ -1733,26 +1713,7 @@ add C 8 # Size of long/pointer end ld E A # Number - null E # Negative? - if ns # No - test E (hex "F000000000000000") # Fit in short? - if z # Yes - shl E 4 # Make short number - or E CNT - else - call boxNumE_E # Make bignum - end - else - neg E # Negate - test E (hex "F000000000000000") # Fit in short? - if z # Yes - shl E 4 # Make negative short number - or E (| SIGN CNT) - else - call boxNumE_E # Make bignum - or E SIGN # Set negative - end - end + call boxE_E else cmp E SSym # 'S'? if eq # Yes @@ -1894,19 +1855,19 @@ link # Apply args push (Z I) # 'fun' xchg A E # First arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E C # Second arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E A # Third arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E X # Fourth arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E Y # Fifth arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld Z S # Z on last argument link # Close frame @@ -2069,19 +2030,19 @@ link # Apply args push ZERO # Space for 'fun' xchg C E # First arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E C # Second arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E X # Third arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E Y # Fourth arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld E Z # Fifth arg - call boxCntE_E # Make number + call boxE_E # Make number push E ld Z S # Z on last argument link # Close frame @@ -2253,16 +2214,24 @@ end ret # 'z' if null, 's' if negative -(code 'boxCntE_E 0) +(code 'boxE_E 0) null E # Positive? if ns # Yes + test E (hex "F000000000000000") # Fit in short number? + jnz boxNumE_E # No shl E 4 # Make short number or E CNT ret end neg E # Else negate - shl E 4 # Make short number - or E 10 # with SIGN + test E (hex "F000000000000000") # Fit in short? + if z # Yes + shl E 4 # Make negative short number + or E (| SIGN CNT) + ret + end + call boxNumE_E # Make bignum + or E SIGN # Set negative ret (code 'putStringB 0)