commit a6efd51af02775651a897bdd29e468f369efbe96
parent 7887c58cd08a6ab3bacb7b7d69336b4034e78083
Author: Commit-Bot <unknown>
Date: Wed, 5 May 2010 15:31:25 +0000
Automatic commit from picoLisp.tgz, From: Wed, 05 May 2010 12:31:25 GMT
Diffstat:
11 files changed, 106 insertions(+), 105 deletions(-)
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 06mar10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
@@ -81,8 +81,8 @@
Move Instructions:
ld dst src # Load 'dst' from 'src'
- ld2 src # Load 'A' from two bytes 'src' (signed)
- ld4 src # Load 'A' from four bytes 'src' (signed)
+ ld2 src # Load 'A' from two bytes 'src' (unsigned)
+ ld4 src # Load 'A' from four bytes 'src' (unsigned)
ldc dst src # Load if Carry 'dst' from 'src'
ldnc dst src # Load if not Carry 'dst' from 'src'
ldz dst src # Load if Zero 'dst' from 'src'
@@ -121,8 +121,6 @@
div src # Division of 'D' by 'src' into 'A', 'C'
zxt # Zero-extend 'B' to 'A'
- sxt # Sign-extend 'B' to 'A'
- int # Sign-extend 32 bits to 64 bits in 'A'
setc # Set Carry flag
clrc # Clear Carry flag
diff --git a/lib/tags b/lib/tags
@@ -24,17 +24,17 @@ $ (2662 . "@src64/flow.l")
>= (2282 . "@src64/subr.l")
>> (2305 . "@src64/big.l")
abs (2395 . "@src64/big.l")
-accept (140 . "@src64/net.l")
+accept (139 . "@src64/net.l")
adr (511 . "@src64/main.l")
alarm (455 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1637 . "@src64/flow.l")
-any (3756 . "@src64/io.l")
+any (3758 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (581 . "@src64/apply.l")
-arg (1871 . "@src64/main.l")
-args (1847 . "@src64/main.l")
-argv (2492 . "@src64/main.l")
+arg (1873 . "@src64/main.l")
+args (1849 . "@src64/main.l")
+argv (2494 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2938 . "@src64/subr.l")
assoc (2903 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (2793 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1978 . "@src64/flow.l")
catch (2478 . "@src64/flow.l")
-cd (2247 . "@src64/main.l")
+cd (2249 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -82,24 +82,24 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1132 . "@src64/subr.l")
-char (3237 . "@src64/io.l")
+char (3240 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1784 . "@src64/subr.l")
-close (4144 . "@src64/io.l")
-cmd (2474 . "@src64/main.l")
+close (4146 . "@src64/io.l")
+cmd (2476 . "@src64/main.l")
cnt (1279 . "@src64/apply.l")
commit (1503 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
cond (1932 . "@src64/flow.l")
-connect (202 . "@src64/net.l")
+connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
-ctl (4084 . "@src64/io.l")
-ctty (2272 . "@src64/main.l")
+ctl (4086 . "@src64/io.l")
+ctty (2274 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
-date (1986 . "@src64/main.l")
+date (1988 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (551 . "@src64/flow.l")
dec (2003 . "@src64/big.l")
@@ -109,23 +109,23 @@ del (1850 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2561 . "@src64/subr.l")
-dir (2405 . "@src64/main.l")
+dir (2407 . "@src64/main.l")
dm (563 . "@src64/flow.l")
do (2152 . "@src64/flow.l")
e (2623 . "@src64/flow.l")
-echo (4164 . "@src64/io.l")
+echo (4166 . "@src64/io.l")
env (523 . "@src64/main.l")
-eof (3314 . "@src64/io.l")
-eol (3305 . "@src64/io.l")
+eof (3317 . "@src64/io.l")
+eol (3308 . "@src64/io.l")
errno (1206 . "@src64/main.l")
eval (208 . "@src64/flow.l")
-ext (4859 . "@src64/io.l")
+ext (4861 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
extra (1280 . "@src64/flow.l")
extract (1084 . "@src64/apply.l")
fifo (1961 . "@src64/sym.l")
-file (2352 . "@src64/main.l")
+file (2354 . "@src64/main.l")
fill (3165 . "@src64/subr.l")
filter (1027 . "@src64/apply.l")
fin (2018 . "@src64/subr.l")
@@ -134,13 +134,13 @@ find (1188 . "@src64/apply.l")
fish (1479 . "@src64/apply.l")
flg? (2417 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
-flush (4834 . "@src64/io.l")
+flush (4836 . "@src64/io.l")
fold (3341 . "@src64/sym.l")
for (2241 . "@src64/flow.l")
fork (2960 . "@src64/flow.l")
format (1769 . "@src64/big.l")
free (2034 . "@src64/db.l")
-from (3333 . "@src64/io.l")
+from (3336 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (378 . "@src64/gc.l")
@@ -152,36 +152,36 @@ glue (1232 . "@src64/sym.l")
gt0 (2382 . "@src64/big.l")
head (1805 . "@src64/subr.l")
heap (481 . "@src64/main.l")
-hear (3055 . "@src64/io.l")
-host (185 . "@src64/net.l")
+hear (3058 . "@src64/io.l")
+host (184 . "@src64/net.l")
id (1034 . "@src64/db.l")
idx (2035 . "@src64/sym.l")
if (1818 . "@src64/flow.l")
if2 (1837 . "@src64/flow.l")
ifn (1878 . "@src64/flow.l")
-in (3980 . "@src64/io.l")
+in (3982 . "@src64/io.l")
inc (1936 . "@src64/big.l")
index (2609 . "@src64/subr.l")
-info (2309 . "@src64/main.l")
+info (2311 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (2905 . "@src64/flow.l")
isa (976 . "@src64/flow.l")
job (1442 . "@src64/flow.l")
journal (977 . "@src64/db.l")
-key (3164 . "@src64/io.l")
+key (3167 . "@src64/io.l")
kill (2937 . "@src64/flow.l")
last (2029 . "@src64/subr.l")
length (2685 . "@src64/subr.l")
let (1492 . "@src64/flow.l")
let? (1553 . "@src64/flow.l")
lieu (1163 . "@src64/db.l")
-line (3489 . "@src64/io.l")
-lines (3642 . "@src64/io.l")
+line (3492 . "@src64/io.l")
+lines (3645 . "@src64/io.l")
link (1163 . "@src64/subr.l")
list (887 . "@src64/subr.l")
-listen (152 . "@src64/net.l")
+listen (151 . "@src64/net.l")
lit (183 . "@src64/flow.l")
-load (3957 . "@src64/io.l")
+load (3959 . "@src64/io.l")
lock (1191 . "@src64/db.l")
loop (2184 . "@src64/flow.l")
low? (3213 . "@src64/sym.l")
@@ -219,7 +219,7 @@ nand (1672 . "@src64/flow.l")
native (1214 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (850 . "@src64/flow.l")
-next (1854 . "@src64/main.l")
+next (1856 . "@src64/main.l")
nil (1755 . "@src64/flow.l")
nond (1955 . "@src64/flow.l")
nor (1693 . "@src64/flow.l")
@@ -231,31 +231,31 @@ offset (2649 . "@src64/subr.l")
on (1581 . "@src64/sym.l")
onOff (1611 . "@src64/sym.l")
one (1644 . "@src64/sym.l")
-open (4106 . "@src64/io.l")
+open (4108 . "@src64/io.l")
opid (2921 . "@src64/flow.l")
-opt (2595 . "@src64/main.l")
+opt (2597 . "@src64/main.l")
or (1653 . "@src64/flow.l")
-out (4000 . "@src64/io.l")
+out (4002 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2379 . "@src64/subr.l")
pass (620 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
path (1168 . "@src64/io.l")
-peek (3221 . "@src64/io.l")
+peek (3224 . "@src64/io.l")
pick (1235 . "@src64/apply.l")
pid (157 . "@src64/flow.l")
-pipe (4021 . "@src64/io.l")
-poll (3117 . "@src64/io.l")
+pipe (4023 . "@src64/io.l")
+poll (3120 . "@src64/io.l")
pool (657 . "@src64/db.l")
pop (1771 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (4948 . "@src64/io.l")
+pr (4950 . "@src64/io.l")
pre? (1409 . "@src64/sym.l")
-prin (4758 . "@src64/io.l")
-prinl (4772 . "@src64/io.l")
-print (4798 . "@src64/io.l")
-println (4829 . "@src64/io.l")
-printsp (4814 . "@src64/io.l")
+prin (4760 . "@src64/io.l")
+prinl (4774 . "@src64/io.l")
+print (4800 . "@src64/io.l")
+println (4831 . "@src64/io.l")
+printsp (4816 . "@src64/io.l")
prog (1773 . "@src64/flow.l")
prog1 (1781 . "@src64/flow.l")
prog2 (1798 . "@src64/flow.l")
@@ -266,7 +266,7 @@ push (1686 . "@src64/sym.l")
push1 (1722 . "@src64/sym.l")
put (2696 . "@src64/sym.l")
putl (2948 . "@src64/sym.l")
-pwd (2236 . "@src64/main.l")
+pwd (2238 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
quit (927 . "@src64/main.l")
quote (141 . "@src64/flow.l")
@@ -274,15 +274,15 @@ rand (2639 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2966 . "@src64/subr.l")
raw (433 . "@src64/main.l")
-rd (4876 . "@src64/io.l")
-read (2495 . "@src64/io.l")
+rd (4878 . "@src64/io.l")
+read (2498 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (1900 . "@src64/main.l")
+rest (1902 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
-rewind (4842 . "@src64/io.l")
+rewind (4844 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (4981 . "@src64/io.l")
+rpc (4983 . "@src64/io.l")
run (332 . "@src64/flow.l")
sect (2513 . "@src64/subr.l")
seed (2624 . "@src64/big.l")
@@ -292,36 +292,36 @@ seq (1090 . "@src64/db.l")
set (1480 . "@src64/sym.l")
setq (1513 . "@src64/sym.l")
size (2750 . "@src64/subr.l")
-skip (3291 . "@src64/io.l")
+skip (3294 . "@src64/io.l")
sort (3837 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4776 . "@src64/io.l")
+space (4778 . "@src64/io.l")
split (1579 . "@src64/subr.l")
state (2022 . "@src64/flow.l")
stem (1974 . "@src64/subr.l")
-str (3810 . "@src64/io.l")
+str (3812 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1563 . "@src64/subr.l")
sub? (1442 . "@src64/sym.l")
sum (1326 . "@src64/apply.l")
super (1233 . "@src64/flow.l")
-sym (3796 . "@src64/io.l")
+sym (3798 . "@src64/io.l")
sym? (2406 . "@src64/subr.l")
-sync (3017 . "@src64/io.l")
+sync (3020 . "@src64/io.l")
sys (2764 . "@src64/flow.l")
t (1764 . "@src64/flow.l")
tail (1896 . "@src64/subr.l")
-tell (3087 . "@src64/io.l")
+tell (3090 . "@src64/io.l")
text (1270 . "@src64/sym.l")
throw (2504 . "@src64/flow.l")
tick (2873 . "@src64/flow.l")
-till (3400 . "@src64/io.l")
-time (2119 . "@src64/main.l")
+till (3403 . "@src64/io.l")
+time (2121 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1187 . "@src64/flow.l")
type (929 . "@src64/flow.l")
-udp (269 . "@src64/net.l")
+udp (268 . "@src64/net.l")
unify (3810 . "@src64/subr.l")
unless (1914 . "@src64/flow.l")
until (2098 . "@src64/flow.l")
@@ -329,15 +329,15 @@ up (610 . "@src64/main.l")
upp? (3228 . "@src64/sym.l")
uppc (3292 . "@src64/sym.l")
use (1586 . "@src64/flow.l")
-usec (2224 . "@src64/main.l")
+usec (2226 . "@src64/main.l")
val (1461 . "@src64/sym.l")
-version (2609 . "@src64/main.l")
-wait (2979 . "@src64/io.l")
+version (2611 . "@src64/main.l")
+wait (2982 . "@src64/io.l")
when (1897 . "@src64/flow.l")
while (2074 . "@src64/flow.l")
wipe (3088 . "@src64/sym.l")
with (1343 . "@src64/flow.l")
-wr (4965 . "@src64/io.l")
+wr (4967 . "@src64/io.l")
xchg (1536 . "@src64/sym.l")
xor (1714 . "@src64/flow.l")
x| (2551 . "@src64/big.l")
diff --git a/src64/Makefile b/src64/Makefile
@@ -1,4 +1,4 @@
-# 03mar10abu
+# 03may10abu
# (c) Software Lab. Alexander Burger
.SILENT:
@@ -49,12 +49,15 @@ $(lib)/ht: $(ARCH).$(SYS).ht.o
as -o $*.o $*.s
$(ARCH).$(SYS).base.s: $(baseFiles)
+ test -x ../bin/picolisp || { echo "bin/picolisp not found"; exit 1; }
./mkAsm $(ARCH) $(SYS) $(OS) base $(lib)/tags $(baseFiles)
$(ARCH).$(SYS).ext.s: ext.l
+ test -x ../bin/picolisp || { echo "bin/picolisp not found"; exit 1; }
./mkAsm $(ARCH) $(SYS) $(OS) ext "" -fpic ext.l
$(ARCH).$(SYS).ht.s: ht.l
+ test -x ../bin/picolisp || { echo "bin/picolisp not found"; exit 1; }
./mkAsm $(ARCH) $(SYS) $(OS) ht "" -fpic ht.l
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 30apr10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -218,10 +218,10 @@
(prinst "mov" "%r10" Dst) ) ) )
(asm ld2 (Src S)
- (prinst "movswq" (src Src S) "%rax") )
+ (prinst "movzwq" (src Src S) "%rax") )
(asm ld4 (Src S)
- (prinst "movslq" (src Src S) "%rax") )
+ (prinst "movl" (src Src S) "%eax") ) # Clears upper word of %rax
(de _cmov (Cmd Jmp)
(setq Dst (dst Dst D) Src (src Src S))
@@ -377,12 +377,6 @@
(asm zxt () # 8 bit -> 64 bit
(prinst "movzx" "%al" "%rax") )
-(asm sxt () # 8 bit -> 64 bit
- (prinst "movsx" "%al" "%rax") )
-
-(asm int () # 32 bit -> 64 bit
- (prinst "movsx" "%eax" "%rax") )
-
(asm setc ()
(prinst "stc") )
@@ -709,7 +703,7 @@
(prinst "jnz" "ret") # Yes: Return
(prinst "test" "$0x08" "%bl") # Symbol?
(prinst "jz" 'evListE_E) # No: Evaluate list
- (prinst "movq" "(%rbx)" "%rbx") # Get value
+ (prinst "mov" "(%rbx)" "%rbx") # Get value
(prinst "ret") )
(asm exec (Reg)
@@ -751,7 +745,9 @@
# System
-(asm init ()
+(asm initData ())
+
+(asm initCode ()
(prinst "xor" "%r12" "%r12") # Init NULL register
(prinst "mov" "(%rsi)" "%r10") # Get command
(ifn *FPic
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 08mar10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
# 6 bytes in little endian format
@@ -860,7 +860,7 @@
else
do
ld2 (Buf) # Get file number (byte order doesn't matter)
- cmp A -1 # End marker?
+ cmp A (hex "FFFF") # End marker?
if eq # Yes
cc fprintf((stderr) RolbLog) # Rollback incomplete transaction
call rewindLog # Rewind transaction log
@@ -876,7 +876,7 @@
null A # Any?
jz jnlErrX # No
ld2 (Buf) # Get file number (byte order doesn't matter)
- cmp A -1 # End marker?
+ cmp A (hex "FFFF") # End marker?
while ne # No
call dbfBuf_AF # Read file number from 'Buf' to 'DbFile'
jc jnlErrX # No local file
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 26apr10abu
+# 02may10abu
# (c) Software Lab. Alexander Burger
(data 'Globals 0)
@@ -532,6 +532,8 @@
align 8 # Padding
: EnvEnd
+initData
+
: OrgTermio skip TERMIOS # Original termio structure
: Flock skip FLOCK # File lock structure
: Tms skip TMS # 'times' structure
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 28apr10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -1680,11 +1680,14 @@
ld C (EnvParseC)
call symByteCX_FACX # Extract next byte
if z # Done
- ld A (EnvParseEOF) # Yes
- ld B (hex "FF") # Fill upper bits
- ror A 8 # Get next eof byte in B
+ ld A (EnvParseEOF) # Get parser trail bytes
+ shr A 8 # More bytes?
ld (EnvParseEOF) A
- sxt # Extend B
+ if nz # Yes
+ zxt # Return next byte
+ else
+ sub A 1 # Return -1
+ end
end
ld (Chr) A
ld (EnvParseX) X # Save status
@@ -3693,11 +3696,10 @@
link
ld (EnvParseX) E # Set new parser status
ld (EnvParseC) 0
+ ld E 0
null C # Token?
if z # No
- ld E (hex "FFFFFFFFFF5D0A00") # linefeed, ']', EOF
- else
- ld E -1
+ ld E (hex "5D0A00") # linefeed, ']', EOF
end
ld (EnvParseEOF) E
ld (EnvGet_A) getParse_A # Set 'get' status
@@ -3776,7 +3778,7 @@
link
ld (EnvParseX) E # Set new parser status
ld (EnvParseC) 0
- ld (EnvParseEOF) (hex "FFFFFFFFFFFF2000") # Blank, EOF
+ ld (EnvParseEOF) (hex "2000") # Blank, EOF
ld (EnvGet_A) getParse_A # Set 'get' status
ld (Chr) 0
call getParse_A # Skip first char
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -1,4 +1,4 @@
-# 08mar10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
# *LittleEndian *Registers optimize
@@ -401,9 +401,9 @@
(eval/ret)
(exec (reg (read)))
(hx2 (read))
- (init)
+ (initCode)
+ (initData)
(initSym (read) (read) (operand (read)))
- (int)
(jc (address) "*Mode")
(jcz (address) "*Mode")
(jeq (address) "*Mode")
@@ -465,7 +465,6 @@
(st4 (destination) "*Mode")
(sub (destination) "*Mode" (source) "*Mode")
(subc (destination) "*Mode" (source) "*Mode")
- (sxt)
(sym (source) "*Mode")
(test (destination) "*Mode" (source) "*Mode")
(tuck (source) "*Mode")
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 27apr10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -28,7 +28,7 @@
### Main entry point ###
(code 'main)
- init
+ initCode
# Locate home directory
ld X (AV) # Command line vector
do
@@ -1424,9 +1424,11 @@
ld4 (C)
add C 4 # Size of int
end
- int # Integer
- ld E A
- null E # Negative?
+ ld E (hex "FFFFFFFF") # Sign-extend integer
+ and E A # into E
+ ld A (hex "80000000")
+ xor E A
+ sub E A # Negative?
if ns # No
shl E 4 # Make short number
or E CNT
diff --git a/src64/net.l b/src64/net.l
@@ -1,4 +1,4 @@
-# 30sep09abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
# (port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt
@@ -88,7 +88,6 @@
end
call needVarEX # Need variable
ld2 (Addr SIN_PORT) # Get port
- and A (hex "FFFF") # Unsigned
cc ntohs(A) # Convert to host byte order
shl A 4 # Make short number
or A CNT
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 30apr10abu
+# 05may10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 2 17)
+(de *Version 3 0 2 18)
# vi:et:ts=3:sw=3
