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:
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)))
