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 6c1d07b8ab58860a58b43c45f81a7ee0053271d5
parent 16f46913dbd5689ebba9c15073f82a9cb70db34f
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon,  6 May 2013 16:48:13 +0200

Move 'sys' to the "System" realm
Diffstat:
Mdoc/ref.html | 2+-
Mersatz/fun.src | 10+++++-----
Mersatz/picolisp.jar | 0
Mlib/map | 60++++++++++++++++++++++++++++++------------------------------
Msrc/flow.c | 23+----------------------
Msrc/main.c | 23++++++++++++++++++++++-
Msrc64/flow.l | 31+------------------------------
Msrc64/glob.l | 4++--
Msrc64/main.l | 31++++++++++++++++++++++++++++++-
Msrc64/tags | 182++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mtest/src/flow.l | 7+------
Mtest/src/main.l | 7++++++-
12 files changed, 190 insertions(+), 190 deletions(-)

diff --git a/doc/ref.html b/doc/ref.html @@ -2220,7 +2220,6 @@ abbreviations: <a href="ref_.html#!">!</a> <a href="refE.html#e">e</a> <a href="ref_.html#$">$</a> - <a href="refS.html#sys">sys</a> <a href="refC.html#call">call</a> <a href="refT.html#tick">tick</a> <a href="refI.html#ipid">ipid</a> @@ -2558,6 +2557,7 @@ abbreviations: <a href="refE.html#env">env</a> <a href="refT.html#trail">trail</a> <a href="refU.html#up">up</a> + <a href="refS.html#sys">sys</a> <a href="refD.html#date">date</a> <a href="refT.html#time">time</a> <a href="refU.html#usec">usec</a> diff --git a/ersatz/fun.src b/ersatz/fun.src @@ -1,4 +1,4 @@ -# 17mar13abu +# 06may13abu # (c) Software Lab. Alexander Burger # Ersatz PicoLisp Functions @@ -68,6 +68,10 @@ up (i j k x) q.Data[j] = ex.Car.eval(); return q == null? x.Car : q.Data[j]; +# (sys 'any) -> sym +sys () + return mkStr(System.getenv(evString(ex.Cdr))); + # (quit ['any ['any]]) quit (str) str = evString(ex = ex.Cdr); @@ -1616,10 +1620,6 @@ $ (i x) StdErr.newline(); return x; -# (sys 'any) -> sym -sys () - return mkStr(System.getenv(evString(ex.Cdr))); - # (call 'any ..) -> flg call (i j x) ArrayList<String> cmd = new ArrayList<String>(); diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar Binary files differ. diff --git a/lib/map b/lib/map @@ -32,9 +32,9 @@ and (1624 . "@src64/flow.l") any (3999 . "@src64/io.l") append (1339 . "@src64/subr.l") apply (713 . "@src64/apply.l") -arg (2576 . "@src64/main.l") -args (2552 . "@src64/main.l") -argv (3204 . "@src64/main.l") +arg (2605 . "@src64/main.l") +args (2581 . "@src64/main.l") +argv (3233 . "@src64/main.l") as (139 . "@src64/flow.l") asoq (3021 . "@src64/subr.l") assoc (2986 . "@src64/subr.l") @@ -46,7 +46,7 @@ bool (1724 . "@src64/flow.l") box (828 . "@src64/flow.l") box? (1131 . "@src64/sym.l") by (1669 . "@src64/apply.l") -bye (3444 . "@src64/flow.l") +bye (3415 . "@src64/flow.l") bytes (2973 . "@src64/subr.l") caaaar (271 . "@src64/subr.l") caaadr (288 . "@src64/subr.l") @@ -62,11 +62,11 @@ caddar (409 . "@src64/subr.l") cadddr (435 . "@src64/subr.l") caddr (156 . "@src64/subr.l") cadr (45 . "@src64/subr.l") -call (3096 . "@src64/flow.l") +call (3067 . "@src64/flow.l") car (5 . "@src64/subr.l") case (1965 . "@src64/flow.l") catch (2467 . "@src64/flow.l") -cd (2956 . "@src64/main.l") +cd (2985 . "@src64/main.l") cdaaar (464 . "@src64/subr.l") cdaadr (487 . "@src64/subr.l") cdaar (179 . "@src64/subr.l") @@ -89,7 +89,7 @@ circ (817 . "@src64/subr.l") circ? (2403 . "@src64/subr.l") clip (1800 . "@src64/subr.l") close (4412 . "@src64/io.l") -cmd (3186 . "@src64/main.l") +cmd (3215 . "@src64/main.l") cnt (1413 . "@src64/apply.l") co (2548 . "@src64/flow.l") commit (1403 . "@src64/db.l") @@ -100,9 +100,9 @@ connect (227 . "@src64/net.l") cons (747 . "@src64/subr.l") copy (1226 . "@src64/subr.l") ctl (4285 . "@src64/io.l") -ctty (2981 . "@src64/main.l") +ctty (3010 . "@src64/main.l") cut (1931 . "@src64/sym.l") -date (2690 . "@src64/main.l") +date (2719 . "@src64/main.l") dbck (2018 . "@src64/db.l") de (532 . "@src64/flow.l") dec (2323 . "@src64/big.l") @@ -112,7 +112,7 @@ del (1986 . "@src64/sym.l") delete (1402 . "@src64/subr.l") delq (1453 . "@src64/subr.l") diff (2590 . "@src64/subr.l") -dir (3116 . "@src64/main.l") +dir (3145 . "@src64/main.l") dm (545 . "@src64/flow.l") do (2141 . "@src64/flow.l") e (2928 . "@src64/flow.l") @@ -121,7 +121,7 @@ env (600 . "@src64/main.l") eof (3558 . "@src64/io.l") eol (3549 . "@src64/io.l") err (4265 . "@src64/io.l") -errno (1576 . "@src64/main.l") +errno (1605 . "@src64/main.l") eval (175 . "@src64/flow.l") ext (5177 . "@src64/io.l") ext? (1166 . "@src64/sym.l") @@ -129,7 +129,7 @@ extern (1032 . "@src64/sym.l") extra (1269 . "@src64/flow.l") extract (1218 . "@src64/apply.l") fifo (2097 . "@src64/sym.l") -file (3063 . "@src64/main.l") +file (3092 . "@src64/main.l") fill (3256 . "@src64/subr.l") filter (1161 . "@src64/apply.l") fin (2034 . "@src64/subr.l") @@ -141,7 +141,7 @@ flip (1700 . "@src64/subr.l") flush (5152 . "@src64/io.l") fold (3521 . "@src64/sym.l") for (2230 . "@src64/flow.l") -fork (3270 . "@src64/flow.l") +fork (3241 . "@src64/flow.l") format (2089 . "@src64/big.l") free (1960 . "@src64/db.l") from (3577 . "@src64/io.l") @@ -167,14 +167,14 @@ ifn (1865 . "@src64/flow.l") in (4225 . "@src64/io.l") inc (2256 . "@src64/big.l") index (2638 . "@src64/subr.l") -info (3018 . "@src64/main.l") +info (3047 . "@src64/main.l") intern (1007 . "@src64/sym.l") -ipid (3215 . "@src64/flow.l") +ipid (3186 . "@src64/flow.l") isa (967 . "@src64/flow.l") job (1429 . "@src64/flow.l") journal (971 . "@src64/db.l") key (3410 . "@src64/io.l") -kill (3247 . "@src64/flow.l") +kill (3218 . "@src64/flow.l") last (2045 . "@src64/subr.l") le0 (2693 . "@src64/big.l") length (2742 . "@src64/subr.l") @@ -184,7 +184,7 @@ lieu (1157 . "@src64/db.l") line (3733 . "@src64/io.l") lines (3886 . "@src64/io.l") link (1173 . "@src64/subr.l") -lisp (2245 . "@src64/main.l") +lisp (2274 . "@src64/main.l") list (888 . "@src64/subr.l") listen (160 . "@src64/net.l") lit (150 . "@src64/flow.l") @@ -223,10 +223,10 @@ n== (2088 . "@src64/subr.l") nT (2199 . "@src64/subr.l") name (502 . "@src64/sym.l") nand (1659 . "@src64/flow.l") -native (1584 . "@src64/main.l") +native (1613 . "@src64/main.l") need (920 . "@src64/subr.l") new (839 . "@src64/flow.l") -next (2559 . "@src64/main.l") +next (2588 . "@src64/main.l") nil (1742 . "@src64/flow.l") nond (1942 . "@src64/flow.l") nor (1680 . "@src64/flow.l") @@ -239,8 +239,8 @@ on (1717 . "@src64/sym.l") onOff (1747 . "@src64/sym.l") one (1780 . "@src64/sym.l") open (4369 . "@src64/io.l") -opid (3231 . "@src64/flow.l") -opt (3307 . "@src64/main.l") +opid (3202 . "@src64/flow.l") +opt (3336 . "@src64/main.l") or (1640 . "@src64/flow.l") out (4245 . "@src64/io.l") pack (1279 . "@src64/sym.l") @@ -273,9 +273,9 @@ push (1822 . "@src64/sym.l") push1 (1858 . "@src64/sym.l") put (2844 . "@src64/sym.l") putl (3122 . "@src64/sym.l") -pwd (2945 . "@src64/main.l") +pwd (2974 . "@src64/main.l") queue (2054 . "@src64/sym.l") -quit (1286 . "@src64/main.l") +quit (1315 . "@src64/main.l") quote (134 . "@src64/flow.l") rand (3003 . "@src64/big.l") range (998 . "@src64/subr.l") @@ -284,7 +284,7 @@ raw (452 . "@src64/main.l") rd (5194 . "@src64/io.l") read (2674 . "@src64/io.l") replace (1500 . "@src64/subr.l") -rest (2605 . "@src64/main.l") +rest (2634 . "@src64/main.l") reverse (1679 . "@src64/subr.l") rewind (5160 . "@src64/io.l") rollback (1803 . "@src64/db.l") @@ -310,7 +310,7 @@ stem (1990 . "@src64/subr.l") str (4053 . "@src64/io.l") str? (1145 . "@src64/sym.l") strip (1577 . "@src64/subr.l") -struct (2036 . "@src64/main.l") +struct (2065 . "@src64/main.l") sub? (1578 . "@src64/sym.l") sum (1460 . "@src64/apply.l") super (1225 . "@src64/flow.l") @@ -318,15 +318,15 @@ sym (4039 . "@src64/io.l") sym? (2435 . "@src64/subr.l") symbols (942 . "@src64/sym.l") sync (3222 . "@src64/io.l") -sys (3067 . "@src64/flow.l") +sys (847 . "@src64/main.l") t (1751 . "@src64/flow.l") tail (1912 . "@src64/subr.l") tell (3294 . "@src64/io.l") text (1407 . "@src64/sym.l") throw (2493 . "@src64/flow.l") -tick (3183 . "@src64/flow.l") +tick (3154 . "@src64/flow.l") till (3644 . "@src64/io.l") -time (2823 . "@src64/main.l") +time (2852 . "@src64/main.l") touch (1181 . "@src64/sym.l") trail (699 . "@src64/main.l") trim (1760 . "@src64/subr.l") @@ -340,9 +340,9 @@ up (767 . "@src64/main.l") upp? (3402 . "@src64/sym.l") uppc (3469 . "@src64/sym.l") use (1573 . "@src64/flow.l") -usec (2927 . "@src64/main.l") +usec (2956 . "@src64/main.l") val (1597 . "@src64/sym.l") -version (3321 . "@src64/main.l") +version (3350 . "@src64/main.l") wait (3184 . "@src64/io.l") when (1884 . "@src64/flow.l") while (2061 . "@src64/flow.l") diff --git a/src/flow.c b/src/flow.c @@ -1,4 +1,4 @@ -/* 02oct12abu +/* 06may13abu * (c) Software Lab. Alexander Burger */ @@ -1482,27 +1482,6 @@ any doTrace(any x) { return Pop(c1); } -// (sys 'any ['any]) -> sym -any doSys(any x) { - any y; - - y = evSym(x = cdr(x)); - { - char nm[bufSize(y)]; - - bufString(y,nm); - if (!isCell(x = cdr(x))) - return mkStr(getenv(nm)); - y = evSym(x); - { - char val[bufSize(y)]; - - bufString(y,val); - return setenv(nm,val,1)? Nil : y; - } - } -} - // (call 'any ..) -> flg any doCall(any ex) { pid_t pid; diff --git a/src/main.c b/src/main.c @@ -1,4 +1,4 @@ -/* 04jan13abu +/* 06may13abu * (c) Software Lab. Alexander Burger */ @@ -344,6 +344,27 @@ any doUp(any x) { return *val; } +// (sys 'any ['any]) -> sym +any doSys(any x) { + any y; + + y = evSym(x = cdr(x)); + { + char nm[bufSize(y)]; + + bufString(y,nm); + if (!isCell(x = cdr(x))) + return mkStr(getenv(nm)); + y = evSym(x); + { + char val[bufSize(y)]; + + bufString(y,val); + return setenv(nm,val,1)? Nil : y; + } + } +} + /*** Primitives ***/ any circ(any x) { any y = x; diff --git a/src64/flow.l b/src64/flow.l @@ -1,4 +1,4 @@ -# 13nov12abu +# 06may13abu # (c) Software Lab. Alexander Burger (code 'redefMsgEC) @@ -3063,35 +3063,6 @@ pop E ret -# (sys 'any ['any]) -> sym -(code 'doSys 2) - push X - push Z - ld X (E CDR) # X on args - call evSymX_E # Evaluate first symbol - call bufStringE_SZ # Write to stack buffer - ld X (X CDR) # Next arg? - atom X - if nz # No - cc getenv(S) # Get value from system - ld E A - call mkStrE_E # Make transient symbol - else - push Z - call evSymX_E # Evaluate second symbol - lea X (S I) # Keep pointer to first buffer - call bufStringE_SZ # Write to stack buffer - cc setenv(X S 1) # Set system value - nul4 # OK? - ldnz E Nil # No - ld S Z # Drop buffer - pop Z - end - ld S Z # Drop buffer - pop Z - pop X - ret - # (call 'any ..) -> flg (code 'doCall 2) push X diff --git a/src64/glob.l b/src64/glob.l @@ -1,4 +1,4 @@ -# 12jan13abu +# 06may13abu # (c) Software Lab. Alexander Burger (data 'Data) @@ -193,6 +193,7 @@ initFun NIL "env" doEnv initFun NIL "trail" doTrail initFun NIL "up" doUp + initFun NIL "sys" doSys initFun NIL "quit" doQuit initFun NIL "errno" doErrno initFun NIL "native" doNative @@ -299,7 +300,6 @@ initFun NIL "!" doBreak initFun NIL "e" doE initFun NIL "$" doTrace - initFun NIL "sys" doSys initFun NIL "call" doCall initFun NIL "tick" doTick initFun NIL "ipid" doIpid diff --git a/src64/main.l b/src64/main.l @@ -1,4 +1,4 @@ -# 25apr13abu +# 06may13abu # (c) Software Lab. Alexander Burger (code 'Code) @@ -843,6 +843,35 @@ pop X ret +# (sys 'any ['any]) -> sym +(code 'doSys 2) + push X + push Z + ld X (E CDR) # X on args + call evSymX_E # Evaluate first symbol + call bufStringE_SZ # Write to stack buffer + ld X (X CDR) # Next arg? + atom X + if nz # No + cc getenv(S) # Get value from system + ld E A + call mkStrE_E # Make transient symbol + else + push Z + call evSymX_E # Evaluate second symbol + lea X (S I) # Keep pointer to first buffer + call bufStringE_SZ # Write to stack buffer + cc setenv(X S 1) # Set system value + nul4 # OK? + ldnz E Nil # No + ld S Z # Drop buffer + pop Z + end + ld S Z # Drop buffer + pop Z + pop X + ret + (code 'circE_YF) ld Y E # Keep list in Y do diff --git a/src64/tags b/src64/tags @@ -409,7 +409,7 @@ sys/x86-64.linux.defs.l,1959 UndefErr1246,85370 DlErr1247,85399 -./main.l,2225 +./main.l,2242 Code4,51 Ret8,106 Retc10,127 @@ -449,84 +449,85 @@ sys/x86-64.linux.defs.l,1959 doEnv600,15046 doTrail699,17756 doUp767,19354 -circE_YF846,21042 -equalAE_F878,21782 -compareAE_F1011,24991 -binSizeX_A1173,28467 -memberXY_FY1268,31077 -doQuit1286,31428 -evExprCE_E1304,31845 -evListE_E1452,35479 -sharedLibC_FA1505,36615 -doErrno1576,38259 -doNative1584,38423 -natBufACZ_CZ1788,44225 -natRetACE_CE1887,46710 -doStruct2036,52110 -fetchCharC_AC2079,52990 -cbl2114,53859 -cbl12147,54575 -cbl22151,54691 -cbl32155,54737 -cbl42159,54789 -cbl52163,54841 -cbl62167,54893 -cbl72171,54945 -cbl82175,54997 -cbl92179,55049 -cbl102183,55101 -cbl112187,55154 -cbl122191,55208 -cbl132195,55262 -cbl142199,55316 -cbl152203,55370 -cbl162207,55424 -cbl172211,55478 -cbl182215,55532 -cbl192219,55586 -cbl202223,55640 -cbl212227,55694 -cbl222231,55748 -cbl232235,55802 -cbl242239,55856 -doLisp2245,55939 -lisp2289,56965 -execE2335,58079 -runE_E2347,58234 -funqE_FE2359,58386 -evSymX_E2421,59809 -evSymY_E2424,59867 -evSymE_E2426,59909 -xSymE_E2428,59946 -evCntXY_FE2449,60311 -evCntEX_FE2451,60355 -xCntEX_FE2453,60394 -xCntCX_FC2462,60571 -xCntAX_FA2471,60748 -boxE_E2480,60925 -putStringB2500,61382 -begString2512,61596 -endString_E2523,61822 -doArgs2552,62479 -doNext2559,62593 -doArg2576,62909 -doRest2605,63551 -tmDateC_E2619,63798 -dateXYZ_E2629,63975 -doDate2690,65336 -tmTimeY_E2806,68947 -doTime2823,69280 -doUsec2927,72258 -doPwd2945,72675 -doCd2956,72930 -doCtty2981,73546 -doInfo3018,74480 -doFile3063,75575 -doDir3116,76811 -doCmd3186,78429 -doArgv3204,78888 -doOpt3307,81434 -doVersion3321,81765 +doSys847,21069 +circE_YF875,21728 +equalAE_F907,22468 +compareAE_F1040,25677 +binSizeX_A1202,29153 +memberXY_FY1297,31763 +doQuit1315,32114 +evExprCE_E1333,32531 +evListE_E1481,36165 +sharedLibC_FA1534,37301 +doErrno1605,38945 +doNative1613,39109 +natBufACZ_CZ1817,44911 +natRetACE_CE1916,47396 +doStruct2065,52796 +fetchCharC_AC2108,53676 +cbl2143,54545 +cbl12176,55261 +cbl22180,55377 +cbl32184,55423 +cbl42188,55475 +cbl52192,55527 +cbl62196,55579 +cbl72200,55631 +cbl82204,55683 +cbl92208,55735 +cbl102212,55787 +cbl112216,55840 +cbl122220,55894 +cbl132224,55948 +cbl142228,56002 +cbl152232,56056 +cbl162236,56110 +cbl172240,56164 +cbl182244,56218 +cbl192248,56272 +cbl202252,56326 +cbl212256,56380 +cbl222260,56434 +cbl232264,56488 +cbl242268,56542 +doLisp2274,56625 +lisp2318,57651 +execE2364,58765 +runE_E2376,58920 +funqE_FE2388,59072 +evSymX_E2450,60495 +evSymY_E2453,60553 +evSymE_E2455,60595 +xSymE_E2457,60632 +evCntXY_FE2478,60997 +evCntEX_FE2480,61041 +xCntEX_FE2482,61080 +xCntCX_FC2491,61257 +xCntAX_FA2500,61434 +boxE_E2509,61611 +putStringB2529,62068 +begString2541,62282 +endString_E2552,62508 +doArgs2581,63165 +doNext2588,63279 +doArg2605,63595 +doRest2634,64237 +tmDateC_E2648,64484 +dateXYZ_E2658,64661 +doDate2719,66022 +tmTimeY_E2835,69633 +doTime2852,69966 +doUsec2956,72944 +doPwd2974,73361 +doCd2985,73616 +doCtty3010,74232 +doInfo3047,75166 +doFile3092,76261 +doDir3145,77497 +doCmd3215,79115 +doArgv3233,79574 +doOpt3336,82120 +doVersion3350,82451 ./big.l,1059 zapZeroA_A6,106 @@ -1037,7 +1038,7 @@ sys/x86-64.linux.defs.l,1959 consNumEA_E1023,23487 consNumEC_E1041,23863 -./flow.l,1650 +./flow.l,1632 redefMsgEC4,51 putSrcEC_E25,589 redefineCE109,3406 @@ -1113,17 +1114,16 @@ sys/x86-64.linux.defs.l,1959 doE2928,70452 doTrace2967,71218 traceCY3039,73133 -doSys3067,73624 -doCall3096,74307 -doTick3183,76499 -doIpid3215,77496 -doOpid3231,77784 -doKill3247,78079 -doFork3270,78514 -forkLispX_FE3283,78735 -doBye3444,83295 -byeE3456,83467 -finishE3468,83778 +doCall3067,73621 +doTick3154,75813 +doIpid3186,76810 +doOpid3202,77098 +doKill3218,77393 +doFork3241,77828 +forkLispX_FE3254,78049 +doBye3415,82609 +byeE3427,82781 +finishE3439,83092 ./subr.l,2147 doCar5,71 diff --git a/test/src/flow.l b/test/src/flow.l @@ -1,4 +1,4 @@ -# 14jul12abu +# 06may13abu # (c) Software Lab. Alexander Burger ### quote ### @@ -429,11 +429,6 @@ (yield (link 3)) ) ) ) ) ) ) ) -### sys ### -(test "PicoLisp" (sys "TEST" "PicoLisp")) -(test "PicoLisp" (sys "TEST")) - - ### call ### (test T (call 'test "-d" (path "@test"))) (test NIL (call 'test "-f" (path "@test"))) diff --git a/test/src/main.l b/test/src/main.l @@ -1,4 +1,4 @@ -# 17nov12abu +# 06may13abu # (c) Software Lab. Alexander Burger ### Evaluation ### @@ -71,6 +71,11 @@ N ) ) +### sys ### +(test "PicoLisp" (sys "TEST" "PicoLisp")) +(test "PicoLisp" (sys "TEST")) + + ### args next arg rest #### (test '(T 1 1 3 (2 3 4)) (let foo '(@ (list (args) (next) (arg) (arg 2) (rest)))