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 e81f8705ceed139e077a3f088bb0aa16300ab87f
parent 644e32c9d80ce09bff51c929dcb0dd4035159b2c
Author: Alexander Burger <abu@software-lab.de>
Date:   Thu,  3 Feb 2011 10:35:20 +0100

Slight optimizations
Diffstat:
Mdoc64/structures | 25++++---------------------
Mlib/tags | 40++++++++++++++++++++--------------------
Msrc64/apply.l | 38++++++++++++++++++++------------------
3 files changed, 44 insertions(+), 59 deletions(-)

diff --git a/doc64/structures b/doc64/structures @@ -172,26 +172,7 @@ +---- LINK <-- L - Apply frame (SUBR): - ^ - Apply | - +---> LINK ----+ - | ... - | +-- cdr - | | fun <-- exe - | | val1 <-+ (gc) - | | zero | - | | cdr1 --|---+ (gc) - | +-> car1 --+ | - | ... | - | valN <-+ | (gc) - | zero | | - | NIL | | (gc) - | carN --+ <-+ - +---- LINK <-- L <-- Apply - - - Apply frame (FEXPR): + Apply frame: ^ Apply | +---> LINK ----+ @@ -204,7 +185,9 @@ | val1 <-+ | (gc) | zero | | | cdr1 --|---+ (gc) - | car1 --+ <-- args + | +-> car1 --+ + | +-- cdr (gc) + | fun <-- exe +---- LINK <-- L <-- Apply diff --git a/lib/tags b/lib/tags @@ -31,7 +31,7 @@ all (772 . "@src64/sym.l") and (1621 . "@src64/flow.l") any (3877 . "@src64/io.l") append (1338 . "@src64/subr.l") -apply (711 . "@src64/apply.l") +apply (713 . "@src64/apply.l") arg (2267 . "@src64/main.l") args (2243 . "@src64/main.l") argv (2888 . "@src64/main.l") @@ -45,7 +45,7 @@ bit? (2746 . "@src64/big.l") bool (1721 . "@src64/flow.l") box (822 . "@src64/flow.l") box? (999 . "@src64/sym.l") -by (1667 . "@src64/apply.l") +by (1669 . "@src64/apply.l") bye (3422 . "@src64/flow.l") caaaar (271 . "@src64/subr.l") caaadr (288 . "@src64/subr.l") @@ -89,7 +89,7 @@ circ? (2398 . "@src64/subr.l") clip (1795 . "@src64/subr.l") close (4265 . "@src64/io.l") cmd (2870 . "@src64/main.l") -cnt (1411 . "@src64/apply.l") +cnt (1413 . "@src64/apply.l") co (2544 . "@src64/flow.l") commit (1496 . "@src64/db.l") con (725 . "@src64/subr.l") @@ -125,15 +125,15 @@ ext (5026 . "@src64/io.l") ext? (1034 . "@src64/sym.l") extern (900 . "@src64/sym.l") extra (1263 . "@src64/flow.l") -extract (1216 . "@src64/apply.l") +extract (1218 . "@src64/apply.l") fifo (1963 . "@src64/sym.l") file (2748 . "@src64/main.l") fill (3236 . "@src64/subr.l") -filter (1159 . "@src64/apply.l") +filter (1161 . "@src64/apply.l") fin (2029 . "@src64/subr.l") finally (2520 . "@src64/flow.l") -find (1320 . "@src64/apply.l") -fish (1611 . "@src64/apply.l") +find (1322 . "@src64/apply.l") +fish (1613 . "@src64/apply.l") flg? (2441 . "@src64/subr.l") flip (1695 . "@src64/subr.l") flush (5001 . "@src64/io.l") @@ -195,24 +195,24 @@ lt0 (2680 . "@src64/big.l") lup (2226 . "@src64/sym.l") made (1107 . "@src64/subr.l") make (1088 . "@src64/subr.l") -map (847 . "@src64/apply.l") -mapc (889 . "@src64/apply.l") -mapcan (1099 . "@src64/apply.l") -mapcar (985 . "@src64/apply.l") -mapcon (1039 . "@src64/apply.l") -maplist (931 . "@src64/apply.l") -maps (788 . "@src64/apply.l") +map (849 . "@src64/apply.l") +mapc (891 . "@src64/apply.l") +mapcan (1101 . "@src64/apply.l") +mapcar (987 . "@src64/apply.l") +mapcon (1041 . "@src64/apply.l") +maplist (933 . "@src64/apply.l") +maps (790 . "@src64/apply.l") mark (1965 . "@src64/db.l") match (3121 . "@src64/subr.l") max (2323 . "@src64/subr.l") -maxi (1509 . "@src64/apply.l") +maxi (1511 . "@src64/apply.l") member (2451 . "@src64/subr.l") memq (2473 . "@src64/subr.l") meta (3135 . "@src64/sym.l") meth (1087 . "@src64/flow.l") method (1051 . "@src64/flow.l") min (2352 . "@src64/subr.l") -mini (1560 . "@src64/apply.l") +mini (1562 . "@src64/apply.l") mix (1260 . "@src64/subr.l") mmeq (2501 . "@src64/subr.l") n0 (2185 . "@src64/subr.l") @@ -242,11 +242,11 @@ or (1637 . "@src64/flow.l") out (4121 . "@src64/io.l") pack (1144 . "@src64/sym.l") pair (2390 . "@src64/subr.l") -pass (752 . "@src64/apply.l") +pass (754 . "@src64/apply.l") pat? (720 . "@src64/sym.l") path (1238 . "@src64/io.l") peek (3343 . "@src64/io.l") -pick (1367 . "@src64/apply.l") +pick (1369 . "@src64/apply.l") pipe (4142 . "@src64/io.l") poll (3232 . "@src64/io.l") pool (648 . "@src64/db.l") @@ -290,7 +290,7 @@ rpc (5142 . "@src64/io.l") run (313 . "@src64/flow.l") sect (2537 . "@src64/subr.l") seed (2958 . "@src64/big.l") -seek (1273 . "@src64/apply.l") +seek (1275 . "@src64/apply.l") send (1131 . "@src64/flow.l") seq (1083 . "@src64/db.l") set (1482 . "@src64/sym.l") @@ -309,7 +309,7 @@ str (3931 . "@src64/io.l") str? (1013 . "@src64/sym.l") strip (1572 . "@src64/subr.l") sub? (1444 . "@src64/sym.l") -sum (1458 . "@src64/apply.l") +sum (1460 . "@src64/apply.l") super (1218 . "@src64/flow.l") sym (3917 . "@src64/io.l") sym? (2430 . "@src64/subr.l") diff --git a/src64/apply.l b/src64/apply.l @@ -12,22 +12,23 @@ if nz push ZERO end - push Nil # Init CDR - push C # 'fun' - ld E S # 'exe in E + ld E Nil # Init 'args' list do - cmp Y Z # Any args? + cmp Z Y # Any args? while ne # Yes - sub Y I - push (Y) # Next arg + push (Z) # Next arg + ld A S # Value address push ZERO # Dummy symbol's tail - push Nil # Init CDR - lea A (S II) # Value address + push E # Dummy cell's CDR push A # CAR - ld (S V) S # Store CDR of previous cell cmp S (StkLimit) # Stack check jlt stkErrX + ld E S # Set 'args' list + add Z I loop + push E # 'args' list + push C # 'fun' + ld E S # Set 'exe' link ld (EnvApply) L # Close apply frame call (C) # Eval SUBR @@ -365,22 +366,23 @@ if nz push ZERO end - push Nil # Init CDR - push C # 'fun' - ld E S # 'exe in E + ld E Nil # Init 'args' list do - cmp Y Z # Any args? + cmp Z Y # Any args? while ne # Yes - sub Y I - push ((Y)) # CAR of next arg + push ((Z)) # Next arg + ld A S # Value address push ZERO # Dummy symbol's tail - push Nil # Init CDR - lea A (S II) # Value address + push E # Dummy cell's CDR push A # CAR - ld (S V) S # Store CDR of previous cell cmp S (StkLimit) # Stack check jlt stkErrX + ld E S # Set 'args' list + add Z I loop + push E # 'args' list + push C # 'fun' + ld E S # Set 'exe' link ld (EnvApply) L # Close apply frame call (C) # Eval SUBR