commit a444432a4a739b22884a451934f493d50658a828
parent 61c182cc7d59978c87a332fa39ca859e2433eed3
Author: Alexander Burger <abu@software-lab.de>
Date: Sun, 7 Oct 2012 10:50:56 +0200
First prototype of 64-bit emulator
Diffstat:
24 files changed, 2110 insertions(+), 514 deletions(-)
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 28jul12abu
+# 02oct12abu
# (c) Software Lab. Alexander Burger
@@ -82,21 +82,21 @@
Move Instructions:
ld dst src # Load 'dst' from 'src' [---]
- ld2 src # Load 'A' from two bytes 'src' (unsigned)
- ld4 src # Load 'A' from four bytes 'src' (unsigned)
- ldc reg src # Load if Carry 'reg' from 'src'
- ldnc reg src # Load if not Carry 'reg' from 'src'
- ldz reg src # Load if Zero 'reg' from 'src'
- ldnz reg src # Load if not Zero 'reg' from 'src'
+ ld2 src # Load 'A' from two bytes 'src' (unsigned) [---]
+ ld4 src # Load 'A' from four bytes 'src' (unsigned) [---]
+ ldc reg src # Load if Carry 'reg' from 'src' [---]
+ ldnc reg src # Load if not Carry 'reg' from 'src' [---]
+ ldz reg src # Load if Zero 'reg' from 'src' [---]
+ ldnz reg src # Load if not Zero 'reg' from 'src' [---]
lea dst src # Load 'dst' with effective address of 'src' [---]
- st2 dst # Store two bytes from 'A' into 'dst'
- st4 dst # Store four bytes from 'A' into 'dst'
- xchg dst dst # Exchange 'dst's
+ st2 dst # Store two bytes from 'A' into 'dst' [---]
+ st4 dst # Store four bytes from 'A' into 'dst' [---]
+ xchg dst dst # Exchange 'dst's [---]
movn dst src cnt # Move 'cnt' bytes from 'src' to 'dst' (non-overlapping)
mset dst cnt # Set 'cnt' bytes of memory to B
- movm dst src end # Move memory 'src'..'end' to 'dst' (aligned)
- save src end dst # Save 'src'..'end' to 'dst' (non-overlapping)
- load dst end src # Load 'dst'..'end' from 'src' (non-overlapping)
+ movm dst src end # Move memory 'src'..'end' to 'dst' (aligned, non-overlapping)
+ save src end dst # Save 'src'..'end' to 'dst' (aligned, non-overlapping)
+ load dst end src # Load 'dst'..'end' from 'src' (aligned, non-overlapping)
Arithmetics:
add dst src # Add 'src' to 'dst' [zsc]
@@ -106,26 +106,26 @@
inc dst # Increment 'dst' [zs.]
dec dst # Increment 'dst' [zs.]
- not dst # One's complement negation of 'dst'
- neg dst # Two's complement negation of 'dst'
-
- and dst src # Bitwise AND 'dst' with 'src'
- or dst src # Bitwise OR 'dst' with 'src'
- xor dst src # Bitwise XOR 'dst' with 'src'
- off dst src # Clear 'src' bits in 'dst'
- test dst src # Bit-test 'dst' with 'src' [z._]
-
- shl dst src # Shift 'dst' left into Carry by 'src' bits
- shr dst src # Shift 'dst' right into Carry by 'src' bits
- rol dst src # Rotate 'dst' left by 'src' bits
- ror dst src # Rotate 'dst' right by 'src' bits
- rcl dst src # Rotate 'dst' with Carry left by 'src' bits
- rcr dst src # Rotate 'dst' with Carry right by 'src' bits
+ not dst # One's complement negation of 'dst' [z..]
+ neg dst # Two's complement negation of 'dst' [zs.]
+
+ and dst src # Bitwise AND 'dst' with 'src' [zs.]
+ or dst src # Bitwise OR 'dst' with 'src' [zs.]
+ xor dst src # Bitwise XOR 'dst' with 'src' [zs.]
+ off dst src # Clear 'src' bits in 'dst' [zs.]
+ test dst src # Bit-test 'dst' with 'src' [zs.]
+
+ shl dst src # Shift 'dst' left into Carry by 'src' bits [zsc]
+ shr dst src # Shift 'dst' right into Carry by 'src' bits [zsc]
+ rol dst src # Rotate 'dst' left by 'src' bits [...]
+ ror dst src # Rotate 'dst' right by 'src' bits [...]
+ rcl dst src # Rotate 'dst' with Carry left by 'src' bits [zsc]
+ rcr dst src # Rotate 'dst' with Carry right by 'src' bits [zsc]
mul src # Multiplication of 'A' and 'src' into 'D' [...]
div src # Division of 'D' by 'src' into 'A', 'C' [...]
- zxt # Zero-extend 'B' to 'A'
+ zxt # Zero-extend 'B' to 'A' [...]
setz # Set Zero flag [z__]
clrz # Clear Zero flag [z..]
@@ -133,33 +133,32 @@
clrc # Clear Carry flag [--c]
Comparisons:
- cmp dst src # Compare 'dst' with 'src' [z.c]
- cmp4 src # Compare four bytes in 'A' with 'src'
- cmpn dst src cnt # Compare 'cnt' bytes 'dst' with 'src'
- slen dst src # Set 'dst' to the string length of 'src'
- memb src cnt # Find B in 'cnt' bytes of memory [z..]
+ cmp dst src # Compare 'dst' with 'src' [zsc]
+ cmpn dst src cnt # Compare 'cnt' bytes 'dst' with 'src' [z..]
+ slen dst src # Set 'dst' to the string length of 'src' [...]
+ memb src cnt # Find B in 'cnt' bytes of 'src' memory [z..]
null src # Compare 'src' with 0 [zs_]
nul4 # Compare four bytes in 'A' with 0 [zs_]
Byte addressing:
- set dst src # Set 'dst' byte to 'src'
+ set dst src # Set 'dst' byte to 'src' [---]
nul src # Compare byte 'src' with 0 [zs_]
Types:
- cnt src # Non-'z' if small number
- big src # Non-'z' if bignum
- num src # Non-'z' if number
- sym src # Non-'z' if symbol
- atom src # Non-'z' if atom
+ cnt src # Non-'z' if small number [z..]
+ big src # Non-'z' if bignum [z..]
+ num src # Non-'z' if number [z..]
+ sym src # Non-'z' if symbol [z..]
+ atom src # Non-'z' if atom [z..]
Flow Control:
- jmp adr # Jump to 'adr'
- jz adr # Jump to 'adr' if Zero
- jnz adr # Jump to 'adr' if not Zero
- js adr # Jump to 'adr' if Sign
- jns adr # Jump to 'adr' if not Sign
- jc adr # Jump to 'adr' if Carry
- jnc adr # Jump to 'adr' if not Carry
+ jmp adr # Jump to 'adr' [---]
+ jz adr # Jump to 'adr' if Zero [---]
+ jnz adr # Jump to 'adr' if not Zero [---]
+ js adr # Jump to 'adr' if Sign [---]
+ jns adr # Jump to 'adr' if not Sign [---]
+ jc adr # Jump to 'adr' if Carry [---]
+ jnc adr # Jump to 'adr' if not Carry [---]
call adr # Call 'adr'
cc adr(src ..) # C-Call to 'adr' with 'src' arguments
@@ -171,15 +170,15 @@
std # Store double value at address 'Z'
stf # Store float value at address 'Z'
- ret # Return
+ ret # Return [---]
begin # Called from foreign function
return # Return to foreign function
Stack Manipulations:
push src # Push 'src' [---]
pop dst # Pop 'dst' [---]
- link # Setup frame
- tuck src # Extend frame
+ link # Setup frame [---]
+ tuck src # Extend frame [---]
drop # Drop frame [---]
Evaluation:
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 17jul12abu
+# 03oct12abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
@@ -1468,10 +1468,12 @@ for (i w x y z bnd)
bnd.Data[1].Car = (y = y.Cdr).Car.eval();
z = y.Cdr;
for2:
- for (y = Nil; (w = z.Car.eval()) != Nil;) {
- At.Car = w;
+ for (y = Nil;;) {
if (bnd.Cnt == 4)
bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One);
+ if ((w = z.Car.eval()) == Nil)
+ break;
+ At.Car = w;
x = ex.Cdr;
do {
if (!((y = x.Car) instanceof Cell))
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/map b/lib/map
@@ -25,16 +25,16 @@ $ (2950 . "@src64/flow.l")
>> (2627 . "@src64/big.l")
abs (2731 . "@src64/big.l")
accept (145 . "@src64/net.l")
-adr (585 . "@src64/main.l")
-alarm (471 . "@src64/main.l")
+adr (587 . "@src64/main.l")
+alarm (473 . "@src64/main.l")
all (788 . "@src64/sym.l")
and (1613 . "@src64/flow.l")
-any (3964 . "@src64/io.l")
+any (3965 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2365 . "@src64/main.l")
-args (2341 . "@src64/main.l")
-argv (2985 . "@src64/main.l")
+arg (2367 . "@src64/main.l")
+args (2343 . "@src64/main.l")
+argv (2990 . "@src64/main.l")
as (139 . "@src64/flow.l")
asoq (3008 . "@src64/subr.l")
assoc (2973 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3079 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1954 . "@src64/flow.l")
catch (2456 . "@src64/flow.l")
-cd (2740 . "@src64/main.l")
+cd (2742 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -82,13 +82,13 @@ cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
chain (1141 . "@src64/subr.l")
-char (3446 . "@src64/io.l")
+char (3447 . "@src64/io.l")
chop (1219 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
circ? (2402 . "@src64/subr.l")
clip (1799 . "@src64/subr.l")
-close (4377 . "@src64/io.l")
-cmd (2967 . "@src64/main.l")
+close (4378 . "@src64/io.l")
+cmd (2972 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2537 . "@src64/flow.l")
commit (1498 . "@src64/db.l")
@@ -98,10 +98,10 @@ cond (1908 . "@src64/flow.l")
connect (224 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
-ctl (4250 . "@src64/io.l")
-ctty (2765 . "@src64/main.l")
+ctl (4251 . "@src64/io.l")
+ctty (2767 . "@src64/main.l")
cut (1922 . "@src64/sym.l")
-date (2479 . "@src64/main.l")
+date (2481 . "@src64/main.l")
dbck (2113 . "@src64/db.l")
de (532 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -111,24 +111,24 @@ del (1977 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2589 . "@src64/subr.l")
-dir (2898 . "@src64/main.l")
+dir (2902 . "@src64/main.l")
dm (545 . "@src64/flow.l")
do (2130 . "@src64/flow.l")
e (2911 . "@src64/flow.l")
-echo (4408 . "@src64/io.l")
-env (597 . "@src64/main.l")
-eof (3523 . "@src64/io.l")
-eol (3514 . "@src64/io.l")
-err (4230 . "@src64/io.l")
-errno (1368 . "@src64/main.l")
+echo (4409 . "@src64/io.l")
+env (599 . "@src64/main.l")
+eof (3524 . "@src64/io.l")
+eol (3515 . "@src64/io.l")
+err (4231 . "@src64/io.l")
+errno (1370 . "@src64/main.l")
eval (175 . "@src64/flow.l")
-ext (5142 . "@src64/io.l")
+ext (5143 . "@src64/io.l")
ext? (1157 . "@src64/sym.l")
extern (1023 . "@src64/sym.l")
extra (1258 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (2088 . "@src64/sym.l")
-file (2845 . "@src64/main.l")
+file (2849 . "@src64/main.l")
fill (3243 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2033 . "@src64/subr.l")
@@ -137,13 +137,13 @@ find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2445 . "@src64/subr.l")
flip (1699 . "@src64/subr.l")
-flush (5117 . "@src64/io.l")
+flush (5118 . "@src64/io.l")
fold (3512 . "@src64/sym.l")
for (2219 . "@src64/flow.l")
fork (3253 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2055 . "@src64/db.l")
-from (3542 . "@src64/io.l")
+from (3543 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (750 . "@src64/sym.l")
gc (435 . "@src64/gc.l")
@@ -155,24 +155,24 @@ glue (1360 . "@src64/sym.l")
gt0 (2718 . "@src64/big.l")
hash (2976 . "@src64/big.l")
head (1820 . "@src64/subr.l")
-heap (517 . "@src64/main.l")
-hear (3227 . "@src64/io.l")
+heap (519 . "@src64/main.l")
+hear (3228 . "@src64/io.l")
host (190 . "@src64/net.l")
id (1028 . "@src64/db.l")
idx (2162 . "@src64/sym.l")
if (1794 . "@src64/flow.l")
if2 (1813 . "@src64/flow.l")
ifn (1854 . "@src64/flow.l")
-in (4190 . "@src64/io.l")
+in (4191 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2637 . "@src64/subr.l")
-info (2802 . "@src64/main.l")
+info (2804 . "@src64/main.l")
intern (998 . "@src64/sym.l")
ipid (3198 . "@src64/flow.l")
isa (961 . "@src64/flow.l")
job (1418 . "@src64/flow.l")
journal (971 . "@src64/db.l")
-key (3375 . "@src64/io.l")
+key (3376 . "@src64/io.l")
kill (3230 . "@src64/flow.l")
last (2044 . "@src64/subr.l")
le0 (2693 . "@src64/big.l")
@@ -180,14 +180,14 @@ length (2741 . "@src64/subr.l")
let (1468 . "@src64/flow.l")
let? (1529 . "@src64/flow.l")
lieu (1157 . "@src64/db.l")
-line (3698 . "@src64/io.l")
-lines (3851 . "@src64/io.l")
+line (3699 . "@src64/io.l")
+lines (3852 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (2037 . "@src64/main.l")
+lisp (2039 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (157 . "@src64/net.l")
lit (150 . "@src64/flow.l")
-load (4167 . "@src64/io.l")
+load (4168 . "@src64/io.l")
lock (1185 . "@src64/db.l")
loop (2162 . "@src64/flow.l")
low? (3378 . "@src64/sym.l")
@@ -222,10 +222,10 @@ n== (2087 . "@src64/subr.l")
nT (2198 . "@src64/subr.l")
name (502 . "@src64/sym.l")
nand (1648 . "@src64/flow.l")
-native (1376 . "@src64/main.l")
+native (1378 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (835 . "@src64/flow.l")
-next (2348 . "@src64/main.l")
+next (2350 . "@src64/main.l")
nil (1731 . "@src64/flow.l")
nond (1931 . "@src64/flow.l")
nor (1669 . "@src64/flow.l")
@@ -237,55 +237,55 @@ offset (2677 . "@src64/subr.l")
on (1708 . "@src64/sym.l")
onOff (1738 . "@src64/sym.l")
one (1771 . "@src64/sym.l")
-open (4334 . "@src64/io.l")
+open (4335 . "@src64/io.l")
opid (3214 . "@src64/flow.l")
-opt (3088 . "@src64/main.l")
+opt (3093 . "@src64/main.l")
or (1629 . "@src64/flow.l")
-out (4210 . "@src64/io.l")
+out (4211 . "@src64/io.l")
pack (1270 . "@src64/sym.l")
pair (2394 . "@src64/subr.l")
pass (754 . "@src64/apply.l")
pat? (736 . "@src64/sym.l")
-path (1244 . "@src64/io.l")
-peek (3430 . "@src64/io.l")
+path (1245 . "@src64/io.l")
+peek (3431 . "@src64/io.l")
pick (1369 . "@src64/apply.l")
-pipe (4271 . "@src64/io.l")
-poll (3319 . "@src64/io.l")
+pipe (4272 . "@src64/io.l")
+poll (3320 . "@src64/io.l")
pool (651 . "@src64/db.l")
pop (1898 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5225 . "@src64/io.l")
+pr (5226 . "@src64/io.l")
pre? (1536 . "@src64/sym.l")
-prin (5041 . "@src64/io.l")
-prinl (5055 . "@src64/io.l")
-print (5081 . "@src64/io.l")
-println (5112 . "@src64/io.l")
-printsp (5097 . "@src64/io.l")
+prin (5042 . "@src64/io.l")
+prinl (5056 . "@src64/io.l")
+print (5082 . "@src64/io.l")
+println (5113 . "@src64/io.l")
+printsp (5098 . "@src64/io.l")
prior (2713 . "@src64/subr.l")
prog (1749 . "@src64/flow.l")
prog1 (1757 . "@src64/flow.l")
prog2 (1774 . "@src64/flow.l")
prop (2925 . "@src64/sym.l")
-protect (507 . "@src64/main.l")
+protect (509 . "@src64/main.l")
prove (3530 . "@src64/subr.l")
push (1813 . "@src64/sym.l")
push1 (1849 . "@src64/sym.l")
put (2835 . "@src64/sym.l")
putl (3113 . "@src64/sym.l")
-pwd (2729 . "@src64/main.l")
+pwd (2731 . "@src64/main.l")
queue (2045 . "@src64/sym.l")
-quit (1083 . "@src64/main.l")
+quit (1085 . "@src64/main.l")
quote (134 . "@src64/flow.l")
rand (3003 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3036 . "@src64/subr.l")
-raw (449 . "@src64/main.l")
-rd (5159 . "@src64/io.l")
-read (2655 . "@src64/io.l")
+raw (451 . "@src64/main.l")
+rd (5160 . "@src64/io.l")
+read (2656 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2394 . "@src64/main.l")
+rest (2396 . "@src64/main.l")
reverse (1678 . "@src64/subr.l")
-rewind (5125 . "@src64/io.l")
+rewind (5126 . "@src64/io.l")
rollback (1898 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (306 . "@src64/flow.l")
@@ -296,36 +296,36 @@ send (1127 . "@src64/flow.l")
seq (1084 . "@src64/db.l")
set (1607 . "@src64/sym.l")
setq (1640 . "@src64/sym.l")
-sigio (487 . "@src64/main.l")
+sigio (489 . "@src64/main.l")
size (2809 . "@src64/subr.l")
-skip (3500 . "@src64/io.l")
+skip (3501 . "@src64/io.l")
sort (3965 . "@src64/subr.l")
sp? (727 . "@src64/sym.l")
-space (5059 . "@src64/io.l")
+space (5060 . "@src64/io.l")
split (1592 . "@src64/subr.l")
-stack (546 . "@src64/main.l")
+stack (548 . "@src64/main.l")
state (1998 . "@src64/flow.l")
stem (1989 . "@src64/subr.l")
-str (4018 . "@src64/io.l")
+str (4019 . "@src64/io.l")
str? (1136 . "@src64/sym.l")
strip (1576 . "@src64/subr.l")
-struct (1828 . "@src64/main.l")
+struct (1830 . "@src64/main.l")
sub? (1569 . "@src64/sym.l")
sum (1460 . "@src64/apply.l")
super (1214 . "@src64/flow.l")
-sym (4004 . "@src64/io.l")
+sym (4005 . "@src64/io.l")
sym? (2434 . "@src64/subr.l")
symbols (942 . "@src64/sym.l")
-sync (3187 . "@src64/io.l")
+sync (3188 . "@src64/io.l")
sys (3050 . "@src64/flow.l")
t (1740 . "@src64/flow.l")
tail (1911 . "@src64/subr.l")
-tell (3259 . "@src64/io.l")
+tell (3260 . "@src64/io.l")
text (1398 . "@src64/sym.l")
throw (2482 . "@src64/flow.l")
tick (3166 . "@src64/flow.l")
-till (3609 . "@src64/io.l")
-time (2612 . "@src64/main.l")
+till (3610 . "@src64/io.l")
+time (2614 . "@src64/main.l")
touch (1172 . "@src64/sym.l")
trim (1759 . "@src64/subr.l")
try (1168 . "@src64/flow.l")
@@ -334,19 +334,19 @@ udp (301 . "@src64/net.l")
unify (3938 . "@src64/subr.l")
unless (1890 . "@src64/flow.l")
until (2074 . "@src64/flow.l")
-up (691 . "@src64/main.l")
+up (693 . "@src64/main.l")
upp? (3393 . "@src64/sym.l")
uppc (3460 . "@src64/sym.l")
use (1562 . "@src64/flow.l")
-usec (2717 . "@src64/main.l")
+usec (2719 . "@src64/main.l")
val (1588 . "@src64/sym.l")
-version (3102 . "@src64/main.l")
-wait (3149 . "@src64/io.l")
+version (3107 . "@src64/main.l")
+wait (3150 . "@src64/io.l")
when (1873 . "@src64/flow.l")
while (2050 . "@src64/flow.l")
wipe (3253 . "@src64/sym.l")
with (1321 . "@src64/flow.l")
-wr (5242 . "@src64/io.l")
+wr (5243 . "@src64/io.l")
xchg (1663 . "@src64/sym.l")
xor (1690 . "@src64/flow.l")
x| (2887 . "@src64/big.l")
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,0,10};
+static byte Version[4] = {3,1,0,11};
diff --git a/src64/Makefile b/src64/Makefile
@@ -1,4 +1,4 @@
-# 01nov11abu
+# 07oct12abu
# (c) Software Lab. Alexander Burger
.SILENT:
@@ -6,100 +6,123 @@
bin = ../bin
lib = ../lib
-ifneq ($(filter x86-64.linux, $(MAKECMDGOALS)),)
+ifeq ($(MAKECMDGOALS), x86-64.linux)
UNAME = Linux
MACHINE = x86_64
else
- ifneq ($(filter x86-64.sunOs, $(MAKECMDGOALS)),)
+ ifeq ($(MAKECMDGOALS), x86-64.sunOs)
UNAME = SunOS
MACHINE = x86_64
else
- ifneq ($(filter ppc64.linux, $(MAKECMDGOALS)),)
- UNAME = Linux
- MACHINE = ppc64
- else
- UNAME = $(shell uname)
- MACHINE = $(shell uname -m)
- endif
+ ifeq ($(MAKECMDGOALS), ppc64.linux)
+ UNAME = Linux
+ MACHINE = ppc64
+ else
+ UNAME = $(shell uname)
+ ifeq ($(MAKECMDGOALS), emu)
+ MACHINE = emu
+ else
+ MACHINE = $(shell uname -m)
+ endif
+ endif
endif
endif
+SYS =
+FMT = .c
+ARCH = emu
+
ifeq ($(UNAME), Linux)
OS = Linux
- SYS = linux
ifeq ($(MACHINE), x86_64)
+ SYS = .linux
+ FMT = .s
ARCH = x86-64
MKASM-BASE =
MKASM-LIB = -fpic
AS = as
else
- ifeq ($(MACHINE), ppc64)
- ARCH = ppc64
- MKASM-BASE = -'prSym "ppc64.symtab"'
- MKASM-LIB = -fpic -'rdSym "ppc64.symtab"'
- AS = as -mppc64 -a64
- endif
+ ifeq ($(MACHINE), ppc64)
+ SYS = .linux
+ FMT = .s
+ ARCH = ppc64
+ MKASM-BASE = -'prSym "ppc64.symtab"'
+ MKASM-LIB = -fpic -'rdSym "ppc64.symtab"'
+ AS = as -mppc64 -a64
+ endif
endif
- LD-MAIN = -m64 -rdynamic -lc -lm -ldl
- LD-SHARED = -m64 -shared -export-dynamic
+ LD-MAIN = -rdynamic -lc -lm -ldl
+ LD-SHARED = -shared -export-dynamic
STRIP = strip
else
-ifeq ($(UNAME), SunOS)
- OS = SunOS
- SYS = sunOs
- ARCH = x86-64
- MKASM-BASE =
- MKASM-LIB = -fpic
- AS = gas --64
- LD-MAIN = -m64 -lc -lm -ldl -lsocket -lnsl
- LD-SHARED = -m64 -shared
- STRIP = strip
-endif
+ ifeq ($(UNAME), SunOS)
+ OS = SunOS
+ SYS = .sunOs
+ FMT = .s
+ ARCH = x86-64
+ MKASM-BASE =
+ MKASM-LIB = -fpic
+ AS = gas --64
+ LD-MAIN = -m64 -lc -lm -ldl -lsocket -lnsl
+ LD-SHARED = -m64 -shared
+ STRIP = strip
+ endif
endif
baseFiles = version.l glob.l main.l \
gc.l apply.l flow.l sym.l subr.l big.l io.l db.l net.l err.l
-sFiles = $(ARCH).$(SYS).base.s $(ARCH).$(SYS).ext.s $(ARCH).$(SYS).ht.s
+sFiles = \
+ $(ARCH)$(SYS).base$(FMT) \
+ $(ARCH)$(SYS).ext$(FMT) \
+ $(ARCH)$(SYS).ht$(FMT)
all: picolisp
x86-64.linux: $(sFiles)
x86-64.sunOs: $(sFiles)
ppc64.linux: $(sFiles)
+emu: $(sFiles)
picolisp: $(bin)/picolisp $(lib)/ext $(lib)/ht
-$(bin)/picolisp: $(ARCH).$(SYS).base.o
- mkdir -p $(bin) $(lib)
- gcc -o $(bin)/picolisp $(ARCH).$(SYS).base.o -Wl,--no-as-needed $(LD-MAIN)
+$(bin)/picolisp: $(ARCH)$(SYS).base.o
+ $(CC) -o $(bin)/picolisp $(ARCH)$(SYS).base.o -Wl,--no-as-needed $(LD-MAIN)
$(STRIP) $(bin)/picolisp
-$(lib)/ext: $(ARCH).$(SYS).ext.o
- gcc -o $(lib)/ext $(ARCH).$(SYS).ext.o $(LD-SHARED)
+$(lib)/ext: $(ARCH)$(SYS).ext.o
+ $(CC) -o $(lib)/ext $(ARCH)$(SYS).ext.o $(LD-SHARED)
$(STRIP) $(lib)/ext
-$(lib)/ht: $(ARCH).$(SYS).ht.o
- gcc -o $(lib)/ht $(ARCH).$(SYS).ht.o $(LD-SHARED)
+$(lib)/ht: $(ARCH)$(SYS).ht.o
+ $(CC) -o $(lib)/ht $(ARCH)$(SYS).ht.o $(LD-SHARED)
$(STRIP) $(lib)/ht
-.s.o:
- $(AS) -o $*.o $*.s
+# Explicit builds for cross-assembly
+$(ARCH)$(SYS).base$(FMT): sysdefs arch/$(ARCH).l $(baseFiles) sys/$(ARCH)$(SYS).code.l
+ ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) base $(lib)/map $(baseFiles) sys/$(ARCH)$(SYS).code.l $(MKASM-BASE)
+$(ARCH)$(SYS).ext$(FMT): sysdefs arch/$(ARCH).l ext.l $(ARCH)$(SYS).base$(FMT)
+ ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ext "" $(MKASM-LIB) ext.l
-# Explicit builds for cross-assembly
-$(ARCH).$(SYS).base.s: lib/asm.l arch/$(ARCH).l $(baseFiles) sys/$(ARCH).$(SYS).code.l
- ./mkAsm $(ARCH) $(SYS) $(OS) base $(lib)/map $(baseFiles) sys/$(ARCH).$(SYS).code.l $(MKASM-BASE)
+$(ARCH)$(SYS).ht$(FMT): sysdefs arch/$(ARCH).l ht.l $(ARCH)$(SYS).base$(FMT)
+ ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ht "" $(MKASM-LIB) ht.l
-$(ARCH).$(SYS).ext.s: lib/asm.l arch/$(ARCH).l ext.l $(ARCH).$(SYS).base.s
- ./mkAsm $(ARCH) $(SYS) $(OS) ext "" $(MKASM-LIB) ext.l
+sysdefs: sysdefs.c
+ $(CC) -o sysdefs -D_FILE_OFFSET_BITS=64 sysdefs.c
+ $(STRIP) sysdefs
-$(ARCH).$(SYS).ht.s: lib/asm.l arch/$(ARCH).l ht.l $(ARCH).$(SYS).base.s
- ./mkAsm $(ARCH) $(SYS) $(OS) ht "" $(MKASM-LIB) ht.l
+.s.o:
+ $(AS) -o $*.o $*.s
+.c.o:
+ $(CC) -c -O \
+ -fomit-frame-pointer -Wunused -Wformat -Wuninitialized \
+ -D_FILE_OFFSET_BITS=64 \
+ $*.c
# Clean up
clean:
- rm -f *.s *.o *.symtab
+ rm -f emu.*.c *.s *.o *.symtab
# vi:noet:ts=4:sw=4
diff --git a/src64/arch/emu.l b/src64/arch/emu.l
@@ -0,0 +1,1244 @@
+# 07oct12abu
+# (c) Software Lab. Alexander Burger
+
+# *AsmOpcodes *AsmCode *AsmPos *Labels *AsmData *SysFun
+
+# Byte order
+(in '("./sysdefs")
+ (case (read)
+ ("L" (on *LittleEndian))
+ ("B" (off *LittleEndian))
+ (T (quit "Bad endianess")) )
+ (case (read)
+ (32 (on *Bits32) (off *Bits64))
+ (64 (on *Bits64) (off *Bits32))
+ (T (quit "Bad wordsize")) ) )
+
+(zero *AsmPos)
+(off *AlignedCode)
+
+# Register assignments
+(de *Registers
+ (A . "A") (C . "C") (E . "E")
+ (B . "A.b[0]") (D "A" . "C")
+ (X . "X") (Y . "Y") (Z . "Z")
+ (L . "L") (S . "S")
+ (F . T) )
+
+# Direct address expressions
+(de directExpr (Str)
+ (let (Lst (str Str "_") A (_aggr))
+ (or
+ (num? A)
+ (pack
+ "(uint8_t*)"
+ (if (cdr A)
+ (pack "(Code+" (car A) ")")
+ (pack "Data+" (car A)) ) ) ) ) )
+
+(de _aggr ()
+ (let X (_prod)
+ (while (member (car Lst) '("+" "-"))
+ (let (Op (intern (pop 'Lst)) Y (_prod))
+ (if2 (pair X) (pair Y)
+ (if (= '+ Op)
+ (quit "Bad direct expression")
+ (setq X (- (car X) (car Y))) )
+ (set X (Op (car X) Y))
+ (setq X (cons (Op X (car Y))))
+ (and (sym? X) (absCode X) (setq X @))
+ (and (sym? Y) (absCode Y) (setq Y @))
+ (setq X (Op X Y)) ) ) )
+ X ) )
+
+(de _prod ()
+ (let X (_term)
+ (while (member (car Lst) '("*" "/"))
+ (setq X ((intern (pop 'Lst)) X (_term))) )
+ X ) )
+
+(de _term ()
+ (let X (pop 'Lst)
+ (cond
+ ((num? X) X)
+ ((assoc X *AsmData) (cons (cadr @)))
+ ((absCode X) (cons @ T))
+ ((= "+" X) (_term))
+ ((= "-" X) (- (_term)))
+ ((= "(" X) (prog1 (_aggr) (pop 'Lst)))
+ (T (quit "Bad term" X)) ) ) )
+
+(de sysFun (S O)
+ (cond
+ ((=0 O) (pack "(void(*)())" S))
+ ((absCode S)
+ (push1 '*SysFun
+ (pack
+ "void fun"
+ @
+ "(int a, int c, int e, int x, int y, int z) {begin("
+ @
+ ", a, c, e, x, y, z);}" ) )
+ (pack "(void(*)())fun" @) )
+ (T (quit "Bad function address" S)) ) )
+
+# Addressing modes
+(de op.p (Arg M)
+ (cond
+ ((=0 M) (pack "(uint8_t*)" Arg)) # Immediate
+ ((not M) (pack Arg ".p")) # Register
+ ((get Arg 'sys) @)
+ ((=T M) # Direct
+ (let E (directExpr Arg)
+ (if (num? E)
+ (pack "(uint8_t*)" E)
+ (pack "(" E ")") ) ) )
+ ((get Arg 1 'sys) @)
+ ((=T (cdr M))
+ (let E (directExpr (cdr Arg))
+ (pack
+ "(*(ptr)("
+ ((if (num? E) op.p op.n) (car Arg) (car M))
+ " + "
+ E
+ ")).p" ) ) )
+ ((cdr Arg)
+ (pack "(*(ptr)(" (op.p (car Arg) (car M)) " + " @ ")).p") )
+ (T (pack "(*(ptr)" (op.p (car Arg) (car M)) ").p")) ) )
+
+(de op.n (Arg M)
+ (cond
+ ((=0 M) # Immediate
+ (let N (format Arg)
+ (if (>= N `(** 2 31))
+ (pack "0x" (hex N) "LL")
+ Arg ) ) )
+ ((not M) # Register
+ (if (= "A.b[0]" Arg)
+ Arg
+ (pack Arg ".n") ) )
+ ((=T M) # Direct
+ (if (get Arg 'sys)
+ (pack "(uint64_t)(unsigned long)" (sysFun @ T))
+ (let E (directExpr Arg)
+ (if (num? E)
+ (pack "(uint64_t)" E)
+ (pack "((uint64_t)(unsigned long)(" E "))") ) ) ) )
+ ((=T (cdr M))
+ (let E (directExpr (cdr Arg))
+ (pack
+ "((ptr)("
+ ((if (num? E) op.p op.n) (car Arg) (car M))
+ " + "
+ E
+ "))->n" ) ) )
+ ((cdr Arg)
+ (pack "((ptr)(" (op.p (car Arg) (car M)) " + " @ "))->n") )
+ (T (pack "((ptr)" (op.p (car Arg) (car M)) ")->n")) ) )
+
+(de op.i (S O)
+ (if (and (format (setq S (op.n S O))) (>= 32767 (abs @)))
+ S
+ (pack "(int)" S) ) )
+
+(de op.b (Arg M)
+ (cond
+ ((=0 M) Arg) # Immediate
+ ((not M) # Register
+ (if (= "A.b[0]" Arg)
+ Arg
+ (pack Arg ".b[0]") ) )
+ ((=T M) # Direct
+ (let E (directExpr Arg)
+ (if (num? E)
+ (pack "(uint8_t)" E)
+ (pack "*(" E ")") ) ) )
+ ((=T (cdr M))
+ (let E (directExpr (cdr Arg))
+ (pack
+ "*("
+ ((if (num? E) op.p op.n) (car Arg) (car M))
+ " + "
+ E
+ ")" ) ) )
+ ((cdr Arg)
+ (pack "*(" (op.p (car Arg) (car M)) " + " @ ")") )
+ (T (pack "*" (op.p (car Arg) (car M)))) ) )
+
+(de op.a (Arg M)
+ (cond
+ ((atom M) # Immediate, Register or Direct
+ (quit "Can't take address" Arg) )
+ ((=T (cdr M))
+ (let E (directExpr (cdr Arg))
+ (pack
+ "("
+ ((if (num? E) op.p op.n) (car Arg) (car M))
+ " + "
+ E
+ ")" ) ) )
+ ((cdr Arg)
+ (pack "(" (op.p (car Arg) (car M)) " + " @ ")") )
+ (T (op.p (car Arg) (car M))) ) )
+
+(de highWord (Arg M)
+ (if (atom M) # Immediate, Register or Direct
+ 0
+ (if (cdr Arg)
+ (pack "((ptr)(" (op.p (car Arg) (car M)) " + " @ " + 8))->n")
+ (pack "((ptr)(" (op.p (car Arg) (car M)) " + 8))->n") ) ) )
+
+### Instruction set ###
+(de fmtInstruction (Lst)
+ (replace (chop (str Lst)) "\"") )
+
+(de opcode ("X" "Args" "Body")
+ (cond
+ ((= "X" '(nop)) 0)
+ ((assoc "X" *AsmOpcodes) (index @ *AsmOpcodes))
+ (T
+ (queue '*AsmOpcodes
+ (cons "X"
+ ~(as *Dbg
+ (pack
+ "fprintf(stderr, \"%d: %s\\n\", PC-Code-1, \""
+ (fmtInstruction "X")
+ "\");" ) )
+ (mapcar '((S) (apply text "Args" S)) "Body") ) )
+ (length *AsmOpcodes) ) ) )
+
+(de addCode (C)
+ (if (and *AsmCode (not (caar @)))
+ (set (car *AsmCode) C)
+ (push '*AsmCode (cons C)) )
+ (inc '*AsmPos) )
+
+(de genCode Args
+ (addCode (cons (env (pop 'Args)) Args)) )
+
+(de absCode (Lbl)
+ (val (car (idx '*Labels Lbl))) )
+
+(de relCode (Adr)
+ (- (absCode Adr) 1 *AsmPos) )
+
+
+(asm nop ()
+ (addCode '(NIL '(nop))) )
+
+(asm align (N)
+ (if (== 'data *Section)
+ (when (gt0 (% (asmDataLength) N))
+ (conc (car *AsmData) (need (- N @) 0)) )
+ (setq N (/ N 2))
+ (while (gt0 (% *AsmPos N))
+ (addCode '(NIL '(nop))) ) ) )
+
+(asm skip (N)
+ (if (== 'data *Section)
+ (conc (car *AsmData) (need N 0))
+ (do (/ N 2) (addCode '(NIL '(nop)))) ) )
+
+# Move data
+(asm ld (Dst D Src S)
+ (cond
+ ((= "A.b[0]" Dst)
+ (genCode (Dst Src S) (list 'ld Dst Src) ((op.b Src S))
+ "A.b[0] = @1;" ) )
+ ((= "A.b[0]" Src)
+ (genCode (Dst Src D) (list 'ld Dst Src) ((op.b Dst D))
+ "@1 = A.b[0];" ) )
+ ((and (not D) (pair Dst))
+ (genCode (Src S) (list 'ld 'D Src) ((op.n Src S) (highWord Src S))
+ "A.n = @1, C.n = @2;" ) )
+ ((and (not S) (pair Src))
+ (genCode (Dst D) (list 'ld Dst 'D) ((op.n Dst D) (highWord Dst D))
+ "@1 = A.n, @2 = C.n;" ) )
+ (T
+ (genCode (Dst D Src S) (list 'ld Dst Src) ((op.n Dst D) (op.n Src S))
+ "@1 = @2;" ) ) ) )
+
+(asm ld2 (Src S)
+ (genCode (Src S) (list 'ld2 Src) ((op.a Src S))
+ "A.n = (uint64_t)*(uint16_t*)@1;" ) )
+
+(asm ld4 (Src S)
+ (genCode (Src S) (list 'ld4 Src) ((op.a Src S))
+ "A.n = (uint64_t)*(uint32_t*)@1;" ) )
+
+(asm ldc (Dst D Src S)
+ (genCode (Dst D Src S) (list 'ldc Dst Src) ((op.n Dst D) (op.n Src S))
+ "if (Carry())"
+ " @1 = @2;" ) )
+
+(asm ldnc (Dst D Src S)
+ (genCode (Dst D Src S) (list 'ldnc Dst Src) ((op.n Dst D) (op.n Src S))
+ "if (!Carry())"
+ " @1 = @2;" ) )
+
+(asm ldz (Dst D Src S)
+ (genCode (Dst D Src S) (list 'ldz Dst Src) ((op.n Dst D) (op.n Src S))
+ "if (!Result)"
+ " @1 = @2;" ) )
+
+(asm ldnz (Dst D Src S)
+ (genCode (Dst D Src S) (list 'ldnz Dst Src) ((op.n Dst D) (op.n Src S))
+ "if (Result)"
+ " @1 = @2;" ) )
+
+(asm lea (Dst D Src S)
+ (genCode (Dst D Src S) (list 'lea Dst Src) ((op.n Dst D) (op.a Src S))
+ "@1 = (uint64_t)(unsigned long)@2;" ) )
+
+(asm st2 (Dst D)
+ (genCode (Dst D) (list 'st2 Dst) ((op.a Dst D))
+ "*(uint16_t*)@1 = (uint16_t)A.l;" ) )
+
+(asm st4 (Dst D)
+ (genCode (Dst D) (list 'st4 Dst) ((op.a Dst D))
+ "*(uint32_t*)@1 = (uint32_t)A.l;" ) )
+
+(asm xchg (Dst D Dst2 D2)
+ (genCode (Dst D Dst2 D2) (list 'xchg Dst Dst2) ((op.n Dst D) (op.n Dst2 D2))
+ "tmp.n = @1, @1 = @2, @2 = tmp.n;" ) )
+
+(asm movn (Dst D Src S Cnt C)
+ (genCode (Dst D Src S Cnt C) (list 'movn Dst Src Cnt) ((op.a Dst D) (op.a Src S) (op.i Cnt C))
+ "memcpy(@1, @2, @3);" ) )
+
+(asm mset (Dst D Cnt C)
+ (genCode (Dst D Cnt C) (list 'mset Dst Cnt) ((op.a Dst D) (op.i Cnt C))
+ "memset(@1, (int)A.b[0], @2);" ) )
+
+(asm movm (Dst D Src S End E)
+ (genCode (Dst D Src S End E) (list 'movm Dst Src End) ((op.a Dst D) (op.a Src S) (op.a End E))
+ "memcpy(@1, @2, @3 - @2);" ) )
+
+(asm save (Src S End E Dst D)
+ (genCode (Dst D Src S End E) (list 'save Dst Src End) ((op.a Dst D) (op.a Src S) (op.a End E))
+ "memcpy(@1, @2, @3 - @2);" ) )
+
+(asm load (Dst D End E Src S)
+ (genCode (Dst D Src S End E) (list 'load Dst Src End) ((op.a Dst D) (op.a Src S) (op.a End E))
+ "memcpy(@1, @2, @3 - @1);" ) )
+
+# Arithmetics
+(asm add (Dst D Src S)
+ (if (or D (atom Dst))
+ (genCode (Dst D Src S) (list 'add Dst Src) ((op.n Dst D) (op.n Src S))
+ "Carry = cfAdd, Result = @1 += Source = @2;" )
+ (genCode (Src S) (list 'add 'D Src) ((op.n Src S))
+ "Result = A.n += Source = @1;"
+ "Carry = Result < Source && ++C.n == 0? cfSet : cfClr;"
+ "Result = C.n;" ) ) ) # 'z' only for upper word
+
+(asm addc (Dst D Src S)
+ (if (or D (atom Dst))
+ (genCode (Dst D Src S) (list 'addc Dst Src) ((op.n Dst D) (op.n Src S))
+ "if ((tmp.n = (Source = @2) + Carry()) == 0)"
+ " Carry = cfSet, Result = Source;"
+ "else"
+ " Carry = cfAdd, Result = @1 += tmp.n;" )
+ (genCode (Src S) (list 'addc 'D Src) ((op.n Src S))
+ "if ((tmp.n = (Source = @1) + Carry()) == 0)"
+ " ++C.n;"
+ "else if ((A.n += tmp.n) < tmp.n)"
+ " ++C.n;"
+ "Result = C.n;" ) ) ) # 'z' only for upper word
+
+(asm sub (Dst D Src S)
+ (genCode (Dst D Src S) (list 'sub Dst Src) ((op.n Dst D) (op.n Src S))
+ "Carry = cfSub, Result = @1 -= Source = @2;" ) )
+
+(asm subc (Dst D Src S)
+ (genCode (Dst D Src S) (list 'subc Dst Src) ((op.n Dst D) (op.n Src S))
+ "i = Carry();"
+ "if ((tmp.n = @1 - i) > MAX64 - i)"
+ " Carry = cfSet, Result = @1 = MAX64 - @2;"
+ "else"
+ " Carry = cfSub, Result = @1 = tmp.n - (Source = @2);" ) )
+
+(asm inc (Dst D)
+ (genCode (Dst D) (list 'inc Dst) ((op.n Dst D))
+ "Result = ++@1;" ) )
+
+(asm dec (Dst D)
+ (genCode (Dst D) (list 'dec Dst) ((op.n Dst D))
+ "Result = --@1;" ) )
+
+(asm not (Dst D)
+ (genCode (Dst D) (list 'not Dst) ((op.n Dst D))
+ "Result = @1 = ~@1;" ) )
+
+(asm neg (Dst D)
+ (genCode (Dst D) (list 'neg Dst) ((op.n Dst D))
+ "Result = @1 = -@1;" ) )
+
+(asm and (Dst D Src S)
+ (genCode (Dst D Src S) (list 'and Dst Src) ((op.n Dst D) (op.n Src S))
+ "Result = @1 &= @2;" ) )
+
+(asm or (Dst D Src S)
+ (genCode (Dst D Src S) (list 'or Dst Src) ((op.n Dst D) (op.n Src S))
+ "Result = @1 |= @2;" ) )
+
+(asm xor (Dst D Src S)
+ (genCode (Dst D Src S) (list 'xor Dst Src) ((op.n Dst D) (op.n Src S))
+ "Result = @1 \^= @2;" ) )
+
+(asm off (Dst D Src S)
+ (genCode (Dst D Src S) (list 'off Dst (pack (cdr (chop Src)))) ((op.n Dst D) (op.n Src S))
+ "Result = @1 &= @2;" ) )
+
+(asm test (Dst D Src S)
+ (genCode (Dst D Src S) (list 'test Dst Src) ((op.n Dst D) (op.n Src S))
+ "Result = @1 & @2;" ) )
+
+(asm shl (Dst D Src S)
+ (if (=0 S)
+ (genCode (Dst D Src) (list 'shl Dst Src) ((op.n Dst D) Src)
+ "Carry = cfMsb, Result = @1 = (Source = @1 << @2-1) << 1;" )
+ (genCode (Dst D Src S) (list 'shl Dst Src) ((op.n Dst D) (op.i Src S))
+ "if (@2)"
+ " Carry = cfMsb, Result = @1 = (Source = @1 << @2-1) << 1;" ) ) )
+
+(asm shr (Dst D Src S)
+ (if (=0 S)
+ (genCode (Dst D Src) (list 'shr Dst Src) ((op.n Dst D) Src)
+ "Carry = cfLsb, Result = @1 = (Source = @1 >> @2-1) >> 1;" )
+ (genCode (Dst D Src S) (list 'shr Dst Src) ((op.n Dst D) (op.i Src S))
+ "if (@2)"
+ " Carry = cfLsb, Result = @1 = (Source = @1 >> @2-1) >> 1;" ) ) )
+
+(asm rol (Dst D Src S)
+ (genCode (Dst D Src S) (list 'rol Dst Src) ((op.n Dst D) (op.i Src S))
+ "i = @2, @1 = @1 << i | @1 >> (64 - i);" ) )
+
+(asm ror (Dst D Src S)
+ (genCode (Dst D Src S) (list 'ror Dst Src) ((op.n Dst D) (op.i Src S))
+ "i = @2, @1 = @1 >> i | @1 << (64 - i);" ) )
+
+(asm rcl (Dst D Src S)
+ (if (=0 S)
+ (genCode (Dst D Src) (list 'rcl Dst Src) ((op.n Dst D) Src)
+ "Carry = cfMsb, i = @2-1, Result = @1 = (Source = @1 << i | @1 >> (64 - i)) << 1;" )
+ (genCode (Dst D Src S) (list 'rcl Dst Src) ((op.n Dst D) (op.i Src S))
+ "if (@2)"
+ " Carry = cfMsb, i = @2-1, Result = @1 = (Source = @1 << i | @1 >> (64 - i)) << 1;" ) ) )
+
+(asm rcr (Dst D Src S)
+ (if (=0 S)
+ (genCode (Dst D Src) (list 'rcr Dst Src) ((op.n Dst D) Src)
+ "Carry = cfLsb, i = @2-1, Result = @1 = (Source = @1 >> i | @1 << (64 - i)) >> 1;" )
+ (genCode (Dst D Src S) (list 'rcr Dst Src) ((op.n Dst D) (op.i Src S))
+ "if (@2)"
+ " Carry = cfLsb, i = @2-1, Result = @1 = (Source = @1 >> i | @1 << (64 - i)) >> 1;" ) ) )
+
+(asm mul (Src S)
+ (genCode (Src S) (list 'mul Src) ((op.n Src S))
+ "mul2(@1);" ) )
+
+(asm div (Src S)
+ (genCode (Src S) (list 'div Src) ((op.n Src S))
+ "div2(@1);" ) )
+
+(asm zxt () # 8 bit -> 64 bit
+ (genCode NIL '(zxt) NIL
+ "A.n &= 0xFF;" ) )
+
+(asm setz ()
+ (genCode NIL '(setz) NIL
+ "Carry = cfClr, Result = 0;" ) )
+
+(asm clrz ()
+ (genCode NIL '(clrz) NIL
+ "Result = 1;" ) )
+
+(asm setc ()
+ (genCode NIL '(setc) NIL
+ "Carry = cfSet;" ) )
+
+(asm clrc ()
+ (genCode NIL '(clrc) NIL
+ "Carry = cfClr;" ) )
+
+# Comparisons
+(asm cmp (Dst D Src S)
+ (if (or (= Dst "A.b[0]") (= Src "A.b[0]"))
+ (genCode (Dst D Src S) (list 'cmp Dst Src) ((op.b Dst D) (op.b Src S))
+ "Carry = cfSub, Result = @1 - (Source = @2);" )
+ (genCode (Dst D Src S) (list 'cmp Dst Src) ((op.n Dst D) (op.n Src S))
+ "Carry = cfSub, Result = @1 - (Source = @2);" ) ) )
+
+(asm cmpn (Dst D Src S Cnt C)
+ (genCode (Dst D Src S Cnt C) (list 'cmpn Dst Src Cnt) ((op.a Dst D) (op.a Src S) (op.i Cnt C))
+ "Result = (uint64_t)memcmp(@1, @2, @3);" ) )
+
+(asm slen (Dst D Src S)
+ (genCode (Dst D Src S) (list 'slen Dst Src) ((op.n Dst D) (op.p Src S))
+ "@1 = (uint64_t)strlen(@2);" ) )
+
+(asm memb (Src S Cnt C)
+ (if S
+ (genCode (Src S Cnt C) (list 'memb Src Cnt) ((op.p Src S) (op.i Cnt C))
+ "Result = !(uint64_t)(unsigned long)memchr(@1, (int)A.b[0], @2);" )
+ (genCode (Src S Cnt C) (list 'memb Src Cnt) ((op.p Src S) (op.i Cnt C) Cnt)
+ "if (!(Result = !(tmp.p = (uint8_t*)memchr(@1, (int)A.b[0], @2))))"
+ " @3.n -= tmp.p - @1 + 1, @1 = tmp.p + 1;" ) ) )
+
+(asm null (Src S)
+ (genCode (Src S) (list 'null Src) ((op.n Src S))
+ "Carry = cfClr, Result = @1;" ) )
+
+(asm nul4 ()
+ (genCode NIL '(nul4) NIL
+ "Carry = cfClr, Result = A.n << 32;" ) )
+
+# Byte addressing
+(asm set (Dst D Src S)
+ (genCode (Dst D Src S) (list 'set Dst Src) ((op.b Dst D) (op.b Src S))
+ "@1 = @2;" ) )
+
+(asm nul (Src S)
+ (genCode (Src S) (list 'nul Src) ((op.b Src S))
+ "Carry = cfClr, Result = @1;" ) )
+
+# Types
+(asm cnt (Src S)
+ (genCode (Src S) (list 'cnt Src) ((op.b Src S))
+ "Result = @1 & 2;" ) )
+
+(asm big (Src S)
+ (genCode (Src S) (list 'big Src) ((op.b Src S))
+ "Result = @1 & 4;" ) )
+
+(asm num (Src S)
+ (genCode (Src S) (list 'num Src) ((op.b Src S))
+ "Result = @1 & 6;" ) )
+
+(asm sym (Src S)
+ (genCode (Src S) (list 'sym Src) ((op.b Src S))
+ "Result = @1 & 8;" ) )
+
+(asm atom (Src S)
+ (genCode (Src S) (list 'atom Src) ((op.b Src S))
+ "Result = @1 & 14;" ) )
+
+# Flow Control
+(de localAddr (Adr)
+ (or
+ (pre? "." Adr) # Local label ".1"
+ (and
+ (cdr (setq Adr (split (chop Adr) "_"))) # Local jump "foo_22"
+ (= *Label (pack (glue "_" (head -1 Adr))))
+ (format (last Adr)) ) ) )
+
+(asm call (Adr A)
+ (nond
+ (A # Absolute
+ (genCode (Adr) (list 'call Adr) ((absCode Adr))
+ "S.p -= 8, *(uint16_t**)S.p = PC;"
+ "PC = Code + @1;" ) )
+ ((=T A) # Indexed: Ignore SUBR
+ (genCode (Adr A) (list 'call (list Adr)) (Adr)
+ "S.p -= 8, *(uint16_t**)S.p = PC;"
+ "PC = (uint16_t*)@1.p;" ) )
+ (NIL # Indirect
+ (genCode (Adr A) (list 'call (list Adr)) ((op.p Adr A))
+ "S.p -= 8, *(uint16_t**)S.p = PC;"
+ "PC = *(uint16_t**)@1;" ) ) ) )
+
+(asm jmp (Adr A)
+ (nond
+ (A # Absolute
+ (if (localAddr Adr)
+ (genCode (Adr) (list 'jmp (relCode Adr)) ((relCode Adr))
+ "PC += @1;" )
+ (genCode (Adr) (list 'jmp Adr) ((absCode Adr))
+ "PC = Code + @1;" ) ) )
+ ((=T A) # Indexed: Ignore SUBR
+ (genCode (Adr A) (list 'jmp (list Adr)) (Adr)
+ "PC = (uint16_t*)@1.p;" ) )
+ (NIL # Indirect
+ (genCode (Adr A) (list 'jmp (list Adr)) ((op.p Adr A))
+ "PC = *(uint16_t**)@1;" ) ) ) )
+
+(de _jmp (Opc Test)
+ (nond
+ (A # Absolute
+ (if (localAddr Adr)
+ (genCode (Adr Opc Test) (list Opc (relCode Adr)) ((relCode Adr) Test)
+ "if (@2)"
+ " PC += @1;" )
+ (genCode (Adr Opc Test) (list Opc Adr) ((absCode Adr) Test)
+ "if (@2)"
+ " PC = Code + @1;") ) )
+ ((=T A) # Indexed: Ignore SUBR
+ (genCode (Adr Opc Test) (list Opc Adr) (Adr Test)
+ "if (@2)"
+ " PC = (uint16_t*)@1.p;" ) )
+ (NIL # Indirect
+ (genCode (Adr A Opc Test) (list Opc (list Adr)) ((op.p Adr A) Test)
+ "if (@2)"
+ " PC = (uint16_t**)@1;" ) ) ) )
+
+(asm jz (Adr A)
+ (_jmp "jz" "!Result") )
+
+(asm jeq (Adr A)
+ (_jmp "jz" "!Result") )
+
+(asm jnz (Adr A)
+ (_jmp "jnz" "Result") )
+
+(asm jne (Adr A)
+ (_jmp "jnz" "Result") )
+
+(asm js (Adr A)
+ (_jmp "js" "(int64_t)Result < 0") )
+
+(asm jns (Adr A)
+ (_jmp "jns" "(int64_t)Result >= 0") )
+
+(asm jsz (Adr A)
+ (_jmp "jsz" "(int64_t)Result <= 0") )
+
+(asm jnsz (Adr A)
+ (_jmp "jnsz" "(int64_t)Result > 0") )
+
+(asm jc (Adr A)
+ (_jmp "jc" "Carry()") )
+
+(asm jlt (Adr A)
+ (_jmp "jc" "Carry()") )
+
+(asm jnc (Adr A)
+ (_jmp "jnc" "!Carry()") )
+
+(asm jge (Adr A)
+ (_jmp "jnc" "!Carry()") )
+
+(asm jcz (Adr A)
+ (_jmp "jcz" "!Result || Carry()") )
+
+(asm jle (Adr A)
+ (_jmp "jcz" "!Result || Carry()") )
+
+(asm jncz (Adr A)
+ (_jmp "jncz" "Result && !Carry()") )
+
+(asm jgt (Adr A)
+ (_jmp "jncz" "Result && !Carry()") )
+
+(asm ret ()
+ (genCode NIL '(ret) NIL
+ "PC = *(uint16_t**)S.p, S.p += 8;" ) )
+
+# Floating point
+(asm ldd ()
+ #{!}# )
+
+(asm ldf ()
+ #{!}# )
+
+(asm fixnum ()
+ #{!}# )
+
+(asm float ()
+ #{!}# )
+
+(asm std ()
+ #{!}# )
+
+(asm stf ()
+ #{!}# )
+
+# C-Calls
+(de *C-Params # Function return value and parameters
+ (getpid i)
+ (getenv p p)
+ (setenv i p p i)
+ (isatty i i)
+ (tcgetattr i i v)
+ (tcsetattr i i i v)
+ (tcsetpgrp - i i)
+ (signal p i f)
+ (sigfillset - v)
+ (sigemptyset - v)
+ (sigaddset - v i)
+ (sigprocmask - i v v)
+ (sigaction - i v v)
+ (gettimeofday - -2 v)
+ (malloc p i)
+ (realloc p p i)
+ (fork i)
+ (getpgrp i)
+ (setpgid - i i)
+ (execvp i p 0)
+ (kill i i i)
+ (raise - i)
+ (alarm i i)
+ (waitpid i i p i)
+ (free - p)
+ (stat i p v)
+ (fcntl i i)
+ (pipe i v)
+ (select i i v v v 2)
+ (open i p i i)
+ (dup i i)
+ (dup2 - i i)
+ (read n i p i)
+ (write n i p i)
+ (lseek n i n i)
+ (pread n i p i n)
+ (pwrite n i p i n)
+ (close i i)
+ (fopen p p p)
+ (freopen p p p p)
+ (getc_unlocked i v)
+ (putc_unlocked - i v)
+ (fread i p i i v)
+ (fwrite i p i i v)
+ (fileno i v)
+ (fseek i v n i)
+ (ftruncate i i n)
+ (fflush - v)
+ (fsync i i)
+ (feof i v)
+ (fclose - v)
+ (socket i i i i)
+ (setsockopt i i i i p i)
+ (htons i i)
+ (ntohs i i)
+ (inet_ntop - i p p i)
+ (bind i i v i)
+ (listen i i i)
+ (getsockname i i v v)
+ (getaddrinfo i p p v v)
+ (getnameinfo i v i p i p i i)
+ (freeaddrinfo - v)
+ (accept i i v v)
+ (connect i i v i)
+ (recv i i p i i)
+ (sendto - i p i i v i)
+ (strdup p p)
+ (dlopen p p i)
+ (dlsym p v p)
+ (getcwd p p)
+ (chdir i p)
+ (opendir p p)
+ (readdir p v)
+ (closedir - v)
+ (time - v)
+ (times - v)
+ (usleep - i)
+ (gmtime p v)
+ (localtime p v)
+ (printf - p)
+ (fprintf - v p)
+ (snprintf - p i p)
+ (strerror p i)
+ (dlerror p)
+ (exit - i)
+ # src64/sys/emu.code.l
+ (errno_A -)
+ (errnoC -)
+ (wifstoppedS_F -)
+ (wifsignaledS_F -)
+ (wtermsigS_A n) )
+
+(de ccArg (P S O)
+ (case P
+ (p (op.p S O))
+ (n (op.n S O))
+ (i (op.i S O))
+ (f (sysFun S O))
+ (a (pack "(void*)" (op.a S O)))
+ (v (pack "(void*)" (op.p S O)))
+ (T
+ (nond
+ (P (op.i S O))
+ ((num? P) (quit "Bad parameter type" P))
+ ((ge0 P) (pack "(void*)" (op.p S O)))
+ (NIL (pack "argv(" @ ", (ptr)" (op.p S O) ")")) ) ) ) )
+
+(de _genCC Body
+ (addCode
+ (cons
+ (env '(Adr A Arg M Par))
+ '(list 'cc Adr Arg)
+ (list
+ 'Adr
+ (list 'glue ", " Args)
+ (list 'extract
+ ''((A P)
+ (when (lt0 P)
+ (pack " retv(" (abs @) ", " A ");") ) )
+ Args
+ '(cdr Par) ) )
+ Body ) ) )
+
+(asm cc (Adr A Arg M)
+ (if (lst? Arg)
+ (let
+ (Par (cdr (assoc Adr *C-Params))
+ Args
+ '(let (P (cdr Par) Lea)
+ (mapcan
+ '((S O)
+ (cond
+ ((== '& S) (on Lea))
+ ((== 'pop S)
+ (cons
+ (pack
+ "(S.p += 8, "
+ (ccArg (pop 'P) '("S" . -8) '(NIL . 0))
+ ")" ) ) )
+ (Lea
+ (pop 'P)
+ (off Lea)
+ (cons (ccArg 'a S O)) )
+ (T (cons (ccArg (pop 'P) S O))) ) )
+ Arg
+ M ) ) )
+ (case (car Par)
+ (- (_genCC "@1(@2);@3"))
+ (p (_genCC "A.p = (uint8_t*)@1(@2);@3"))
+ (n (_genCC "A.n = (uint64_t)@1(@2);@3"))
+ (i (_genCC "A.l = (uint32_t)@1(@2);@3"))
+ (T (quit "Unknown C function" Adr)) ) )
+ ) )
+
+(asm begin ())
+
+(asm return ()
+ (genCode NIL '(return) NIL
+ "return;" ) ) # Terminate 'run'
+
+# Stack Manipulations
+(asm push (Src S)
+ (cond
+ ((=T Src)
+ (genCode NIL '(push F) NIL
+ "S.p -= 8, ((ptr)S.p)->n = (Result & ~3) | (Result != 0) << 1 | Carry();" ) )
+ ((= "S" Src)
+ (genCode (Src S) '(push S) NIL
+ "tmp.n = S.n, S.p -= 8, ((ptr)S.p)->n = tmp.n;" ) )
+ (T
+ (genCode (Src S) (list 'push Src) ((op.n Src S))
+ "S.p -= 8, ((ptr)S.p)->n = @1;" ) ) ) )
+
+(asm pop (Dst D)
+ (if (=T Dst)
+ (genCode NIL '(pop F) NIL
+ "Carry = cfLsb, Source = ((ptr)S.p)->n, Result = Source & ~1, S.p += 8;" )
+ (genCode (Dst D) (list 'pop Dst) ((op.n Dst D))
+ "@1 = ((ptr)S.p)->n, S.p += 8;" ) ) )
+
+(asm link ()
+ (genCode NIL '(link) NIL
+ "S.p -= 8, ((ptr)S.p)->n = L.n, L.p = S.p;" ) )
+
+(asm tuck (Src S)
+ (genCode (Src S) (list 'tuck Src) ((op.n Src S))
+ "L.p = ((ptr)S.p)->p, ((ptr)S.p)->n = @1;" ) )
+
+(asm drop ()
+ (genCode NIL '(drop) NIL
+ "S.p = ((ptr)L.p)->p, L.p = ((ptr)S.p)->p, S.p += 8;" ) )
+
+# Evaluation
+(asm eval ()
+ (genCode NIL '(eval) ((absCode "evListE_E"))
+ "if (!(E.b[0] & 6))"
+ " if (E.b[0] & 8)"
+ " E = *(ptr)E.p;"
+ " else {"
+ " S.p -= 8, *(uint16_t**)S.p = PC;"
+ " PC = Code + @1;"
+ " }" ) )
+
+(asm eval+ ()
+ (genCode NIL '(eval+) ((absCode "evListE_E"))
+ "if (!(E.b[0] & 6))"
+ " if (E.b[0] & 8)"
+ " E = *(ptr)E.p;"
+ " else {"
+ " S.p -= 8, ((ptr)S.p)->n = L.n, L.p = S.p;"
+ " S.p -= 8, *(uint16_t**)S.p = PC;"
+ " S.p -= 8, *(uint16_t**)S.p = Code + 0;" # <eval+>
+ " PC = Code + @1;"
+ " }" ) )
+
+(asm eval/ret ()
+ (genCode NIL '(eval/ret) ((absCode "evListE_E"))
+ "if (E.b[0] & 14) {"
+ " if (E.b[0] & 8)"
+ " E = *(ptr)E.p;"
+ " PC = *(uint16_t**)S.p, S.p += 8;"
+ "}"
+ "else"
+ " PC = Code + @1;" ) )
+
+(asm exec (Reg)
+ (let Ofs (case Reg (X 1) (Y 2) (Z 3))
+ (con
+ (cdddr (caar (tail (inc Ofs) *AsmCode)))
+ (cons (text "goto exec@1;" Reg)) )
+ (genCode (Reg Ofs) (list 'exec Reg) ((absCode "evListE_E") Reg Ofs)
+ "do {"
+ " E = *(ptr)@2.p;"
+ " if (!(E.b[0] & 14)) {"
+ " S.p -= 8, *(uint16_t**)S.p = PC;"
+ " S.p -= 8, *(uint16_t**)S.p = Code + 1;" # <exec>
+ " PC = Code + @1;"
+ " break;"
+ " }"
+ "exec@2:"
+ " @2.p = ((ptr)(@2.p + 8))->p;"
+ "} while (!(@2.b[0] & 14));" ) ) )
+
+(asm prog (Reg)
+ (let Ofs (case Reg (X 4) (Y 5) (Z 6))
+ (con
+ (cdddr (caar (tail (inc Ofs) *AsmCode)))
+ (cons (text "goto prog@1;" Reg)) )
+ (genCode (Reg Ofs) (list 'prog Reg) ((absCode "evListE_E") Reg Ofs)
+ "do {"
+ " E = *(ptr)@2.p;"
+ " if (!(E.b[0] & 6)) {"
+ " if (E.b[0] & 8)"
+ " E = *(ptr)E.p;"
+ " else {"
+ " S.p -= 8, *(uint16_t**)S.p = PC;"
+ " S.p -= 8, *(uint16_t**)S.p = Code + @3;" # <progN>
+ " PC = Code + @1;"
+ " break;"
+ " }"
+ " }"
+ "prog@2:"
+ " @2.p = ((ptr)(@2.p + 8))->p;"
+ "} while (!(@2.b[0] & 14));" ) ) )
+
+# System
+(asm initData ())
+
+(asm initCode ())
+
+(asm initMain ()) # Done explicitly in 'main'
+
+### Optimizer ###
+# Replace the the next 'cnt' elements with 'lst'
+(de optimize (Lst)) #> (cnt . lst)
+
+### Decoration ###
+(de prolog (File)
+ (genCode NIL '(<eval+>) NIL # Code + 0
+ "PC = *(uint16_t**)S.p, S.p += 8;"
+ "L.p = ((ptr)S.p)->p, S.p += 8;" )
+ (genCode NIL '(<execX>) NIL # Code + 1
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (genCode NIL '(<execY>) NIL # Code + 2
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (genCode NIL '(<execZ>) NIL # Code + 3
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (genCode NIL '(<progX>) NIL # Code + 4
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (genCode NIL '(<progY>) NIL # Code + 5
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (genCode NIL '(<progZ>) NIL # Code + 6
+ "PC = *(uint16_t**)S.p, S.p += 8;" )
+ (mapc prinl
+ (quote
+ NIL
+ "#include <stdio.h>"
+ "#include <stdint.h>"
+ "#include <stdlib.h>"
+ "#include <unistd.h>"
+ "#include <limits.h>"
+ "#include <string.h>"
+ "#include <math.h>"
+ "#include <errno.h>"
+ "#include <fcntl.h>"
+ "#include <dirent.h>"
+ "#include <signal.h>"
+ "#include <dlfcn.h>"
+ "#include <time.h>"
+ "#include <sys/types.h>"
+ "#include <sys/time.h>"
+ "#include <sys/times.h>"
+ "#include <sys/stat.h>"
+ NIL
+ "#define MAX8 ((uint8_t)-1)"
+ "#define MAX64 ((uint64_t)-1)"
+ "#define STACK (16 * 1024 * 1024)"
+ NIL
+ "typedef union op {"
+ " uint64_t n;" ) )
+ (if (or *LittleEndian *Bits64)
+ (prinl " uint8_t *p;")
+ (mapc prinl
+ (quote
+ " struct {"
+ " uint32_t u;"
+ " uint8_t *p;"
+ " };" ) ) )
+ (prinl " uint8_t b[8];")
+ (if *LittleEndian
+ (prinl " struct {uint32_t l, h;};")
+ (prinl " struct {uint32_t h, l;};") )
+ (mapc prinl
+ (quote
+ "} op, *ptr;"
+ NIL
+ ~(if *FPic
+ (quote
+ "extern uint16_t *PC;"
+ "extern uint8_t *Stack;"
+ "extern op A, C, E, X, Y, Z, L, S;"
+ "extern uint64_t Source, Result;"
+ "extern int cfClr(void);"
+ "extern int cfSet(void);"
+ "extern int cfAdd(void);"
+ "extern int cfSub(void);"
+ "extern int cfMsb(void);"
+ "extern int cfLsb(void);"
+ "extern int (*Carry)(void);"
+ "extern void mul2(uint64_t);"
+ "extern void div2(uint64_t);"
+ "extern void begin(int,int,int,int,int,int,int);"
+ "extern void *argv(int,ptr);"
+ "extern void retv(int,ptr);" )
+ (quote
+ "uint16_t *PC;"
+ "uint8_t *Stack;"
+ "op A, C, E, X, Y, Z, L, S;"
+ "uint64_t Source, Result;"
+ NIL
+ "static void run(int);"
+ "int cfClr(void) {return 0;}"
+ "int cfSet(void) {return 1;}"
+ "int cfAdd(void) {return Result < Source;}"
+ "int cfSub(void) {return Result > MAX64-Source;}"
+ "int cfMsb(void) {return (int64_t)Source < 0;}"
+ "int cfLsb(void) {return Source & 1;}"
+ NIL
+ "int (*Carry)(void) = cfClr;"
+ NIL
+ "void mul2(uint64_t src) {"
+ " uint32_t h = src >> 32;"
+ " uint32_t l = (uint32_t)src;"
+ " op a, b;"
+ NIL
+ " a.n = (uint64_t)A.l * l;"
+ " b.n = (uint64_t)A.h * l;"
+ " C.n = (uint64_t)b.h + ((a.h += b.l) < b.l);"
+ " b.n = (uint64_t)A.l * h;"
+ " C.n += (uint64_t)b.h + ((a.h += b.l) < b.l);"
+ " C.n += (uint64_t)A.h * h;"
+ " A.n = a.n;"
+ "}"
+ NIL
+ "void div2(uint64_t src) {"
+ " uint64_t vn0, vn1, q1, q0, rhat;"
+ " int s;"
+ NIL
+ " if (C.n >= src)"
+ " A.n = C.n = MAX64;" # Overflow
+ " else {"
+ " s = 0;"
+ " while ((int64_t)src > 0) {" # Normalize
+ " C.n = (C.n << 1) + ((int64_t)A.n < 0);" # Shift dividend left
+ " A.n <<= 1;"
+ " src <<= 1;" # and divisor
+ " ++s;"
+ " }"
+ " vn1 = src >> 32;" # Split divisor into high
+ " vn0 = (uint32_t)src;" # and low 32 bits
+ " q1 = C.n / vn1;" # First quotient digit
+ " rhat = C.n - q1 * vn1;"
+ NIL
+ " while (q1 >> 32 || q1 * vn0 > (rhat << 32) + A.h) {"
+ " --q1;"
+ " if ((rhat += vn1) >> 32)"
+ " break;"
+ " }"
+ " C.n = (C.n << 32) + A.h - q1 * src;"
+ " q0 = C.n / vn1;" # Second quotient digit
+ " rhat = C.n - q0 * vn1;"
+ NIL
+ " while (q0 >> 32 || q0 * vn0 > (rhat << 32) + A.l) {"
+ " --q0;"
+ " if ((rhat += vn1) >> 32)"
+ " break;"
+ " }"
+ " C.n = ((C.n << 32) + A.l - q0 * src) >> s;" # Remainder
+ " A.n = (q1 << 32) + q0;" # Quotient
+ " }"
+ "}"
+ NIL
+ "void begin(int i, int a, int c, int e, int x, int y, int z) {"
+ " S.p -= 8, *(uint16_t**)S.p = PC;"
+ " S.p -= 8, ((ptr)S.p)->n = Source;"
+ " S.p -= 8, ((ptr)S.p)->n = Result;"
+ " S.p -= 8, *(ptr)S.p = Z, Z.n = z;"
+ " S.p -= 8, *(ptr)S.p = Y, Y.n = y;"
+ " S.p -= 8, *(ptr)S.p = X, X.n = x;"
+ " S.p -= 8, *(ptr)S.p = E, E.n = e;"
+ " S.p -= 8, *(ptr)S.p = C, C.n = c;"
+ " S.p -= 8, *(ptr)S.p = A, A.n = a;"
+ " run(i);"
+ " A = *(ptr)S.p, S.p += 8;"
+ " C = *(ptr)S.p, S.p += 8;"
+ " E = *(ptr)S.p, S.p += 8;"
+ " X = *(ptr)S.p, S.p += 8;"
+ " Y = *(ptr)S.p, S.p += 8;"
+ " Z = *(ptr)S.p, S.p += 8;"
+ " Result = ((ptr)S.p)->n, S.p += 8;"
+ " Source = ((ptr)S.p)->n, S.p += 8;"
+ " PC = *(uint16_t**)S.p, S.p += 8;"
+ "}"
+ NIL
+ "void *argv(int i, ptr p) {"
+ " if (p) {"
+ " if (i == 0)"
+ " while (((uint8_t**)p)[i] = p[i].p)"
+ " ++i;"
+ " else"
+ " while (--i >= 0)"
+ " ((uint8_t**)p)[i] = p[i].p;"
+ " }"
+ " return p;"
+ "}"
+ NIL
+ "void retv(int i, ptr p) {"
+ " if (p)"
+ " while (--i >= 0)"
+ " p[i].n = (uint64_t)(unsigned long)((uint8_t**)p)[i];"
+ "}"
+ NIL ) )
+ "uint16_t Code[];"
+ NIL
+ "op Data[] = {" ) ) )
+
+(de epilog (File)
+ (setq
+ *AsmData (flip *AsmData)
+ *AsmCode (flip *AsmCode) )
+ (let *AsmPos 0
+ (for X *AsmCode
+ (set X
+ (job (env (caar X))
+ (opcode
+ (eval (cadar X))
+ (mapcar eval (caddar X))
+ (cdddar X) ) ) )
+ (inc '*AsmPos) ) )
+ (let Bytes NIL
+ (for D *AsmData
+ (prin
+ " /* "
+ (align -10 (car D))
+ (align 5 (cadr D))
+ " */" )
+ (and Bytes (cddr D) (space 8))
+ (for (I . X) (cddr D)
+ (cond
+ ((pair X)
+ (and Bytes (quit "Unaligned word" (car D)))
+ (prin " {.n = " (car X) "},") )
+ ((sym? X)
+ (and Bytes (quit "Unaligned word" (car D)))
+ (cond
+ ((pre? ".+" X)
+ (let N (+ (cadr D) (format (cddr (chop X))))
+ (for ((J . L) (cddr D) (> I J) (cdr L))
+ (NIL (> I J)) # Temporary (03oct12abu)
+ (inc 'N (if (num? (car L)) 1 8)) )
+ (prin " {.p = (uint8_t*)Data+" N "},") ) )
+ ((asoq X *AsmData)
+ (prin " {.p = (uint8_t*)Data+" (cadr @) "},") )
+ ((absCode X)
+ (prin " {.p = (uint8_t*)(Code+" @ ")},") )
+ (T (quit "No value" X)) ) )
+ (Bytes
+ (prin (and (> I 1) ", ") X)
+ (when (= 8 (inc 'Bytes))
+ (prin "}},")
+ (off Bytes) ) )
+ (T
+ (prin " {.b = {" X)
+ (one Bytes) ) ) )
+ (and Bytes (cddr D) (prin ","))
+ (prinl) )
+ (when Bytes
+ (space 26)
+ (prinl "}}") ) )
+ (prinl "};")
+ (prinl)
+ (mapc prinl (flip *SysFun))
+ (prinl)
+ (prinl "uint16_t Code[] = {")
+ (for (I . X) *AsmCode
+ (when (pair X)
+ (for C (cdr X)
+ (unless (pre? "." C) # Omit local labels
+ (prinl " // " C ":") ) )
+ (setq X (car X)) )
+ (prinl
+ (align 7 X)
+ ", // "
+ (align 7 (dec I))
+ ": "
+ (if (=0 X)
+ "nop"
+ (fmtInstruction (get *AsmOpcodes X 1)) ) ) )
+ (mapc prinl
+ (quote
+ "};"
+ NIL ) )
+ (mapc prinl
+ (quote
+ NIL
+ "static void run(int i) {"
+ " op tmp;"
+ NIL
+ " PC = Code + i;"
+ " for (;;) {"
+ " switch (*PC++) {"
+ " case 0: // nop"
+ " break;" ) )
+ (for (C . L) *AsmOpcodes
+ (prinl " case " C ": // " (fmtInstruction (car L)))
+ (for S (cdr L)
+ (prinl " " S) )
+ (prinl " break;") )
+ (mapc prinl
+ (quote
+ " default:"
+ " fprintf(stderr, \"Illegal instruction\\n\");"
+ " exit(112);"
+ " }"
+ ~(as *Dbg
+ " fprintf(stderr, \" %llX %llX %llX %llX %llX %llX %d%d%d %llX %llX\\n\","
+ " A.n, C.n, E.n, X.n, Y.n, Z.n,"
+ " !Result, (int64_t)Result<0, Carry(),"
+ " L.n, S.n );" )
+ " }"
+ "}"
+ NIL
+ "void main(int ac, char *av[]) {"
+ " int i;"
+ NIL
+ " S.p = (Stack = malloc(STACK)) + STACK;"
+ " Y.p = malloc((ac + 1) * sizeof(op));"
+ " i = 0; do"
+ " ((ptr)Y.p)[i].n = (uint64_t)(unsigned long)av[i];"
+ " while (++i < ac);"
+ " ((ptr)Y.p)[i].n = 0;"
+ " X.p = ((ptr)Y.p)->p, Y.p += 8;"
+ " Z.p = Y.p + (ac - 2) * sizeof(op);" ) )
+ (prinl (pack " run(" (absCode "main") ");"))
+ (prinl "}") )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l
@@ -1,4 +1,4 @@
-# 30apr12abu
+# 04oct12abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -803,12 +803,6 @@
(prinst "subc." 0 (caddr A) (car A)) ) )
(prinst "subfme" 31 21) ) # Set inverted carry
-(asm cmp4 (Src S)
- (let R (tmpReg)
- (memory Src S R "lwz")
- (prinst "subc." 0 3 R) )
- (prinst "subfme" 31 21) ) # Set inverted carry
-
(asm cmpn (Dst D Src S Cnt C)
(memory Dst D 4)
(memory Src S 5)
@@ -828,11 +822,11 @@
(unless C (prinst "mr" Cnt 5)) )
(asm null (Src S)
- (prinst "li" 31 -2) # Clear carry
+ ##? (prinst "li" 31 -2) # Clear carry
(prinst "cmpdi" (srcReg Src S) 0) )
(asm nul4 ()
- (prinst "li" 31 -2) # Clear carry
+ ##? (prinst "li" 31 -2) # Clear carry
(prinst "sldi" 3 3 32)
(prinst "sradi." 3 3 32) )
@@ -841,7 +835,7 @@
(memory Dst D (srcByteReg Src S) "stb") )
(asm nul (Src S)
- (prinst "li" 31 -2) # Clear carry
+ ##? (prinst "li" 31 -2) # Clear carry
(prinst "cmpdi" (srcByteReg Src S) 0) )
# Types
@@ -1035,6 +1029,10 @@
(("bne" + "cr1" ".+12") ("beq" + ".+8") ("b" NIL @Lbl))
(("bne" + "cr1" ".+8") ("bnectr" NIL)) ) )
+(asm ret ()
+ (prinst "blr") )
+
+# Floating point
(asm ldd ()
(prinst "lfd" 1 "0(14)") )
@@ -1081,6 +1079,7 @@
(asm stf ()
(prinst "stfs" 1 "0(14)") )
+# C-Calls
(asm cc (Adr A Arg M)
(let Reg (3 4 5 6 7 8 9 10) # Support only max. 8 parameters
(if (lst? Arg)
@@ -1152,9 +1151,6 @@
(gt0 (- (length Arg) 8))
(prinst "addi" 1 1 (* @ 8)) ) )
-(asm ret ()
- (prinst "blr") )
-
(asm begin ()
(prinst ".quad" ".+24" ".TOC.@tocbase" 0)
(prinst "mflr" 0)
@@ -1437,7 +1433,7 @@
(prinst "sldi" @tmp @rhat 32) # b*rhat + un0
(prinst "add" @tmp @tmp @un0)
(prinst "mulld" 0 @q0 @vn0)
- (prinst "cmpld" 0 @tmp) # q0 * vn0 > b*rhat + un1?
+ (prinst "cmpld" 0 @tmp) # q0 * vn0 > b*rhat + un0?
(prinst "ble+" "div8") # No
(prinl "div7:")
(prinst "subi" @q0 @q0 1) # Else decrement 'q0'
@@ -1567,4 +1563,9 @@
(when (noCC L)
(cons 1 (cons (cons @ (cdar L)))) ) )
+### Decoration ###
+(de prolog (File))
+
+(de epilog (File))
+
# vi:et:ts=3:sw=3
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 30apr12abu
+# 24sep12abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -63,12 +63,12 @@
(if
(or
(not *FPic)
- (= `(char ".") (char Adr)) # Local label ".1"
- (use (@L @N)
+ (= `(char ".") (char Adr)) # Local label ".1"
+ (let A (split (chop Adr) "_") # Local jump "foo_22"
(and
- (match '(@L "_" @N) (chop Adr)) # Local jump "foo_22"
- (= @L (chop *Label))
- (format @N) ) ) )
+ (cdr A)
+ (= *Label (pack (glue "_" (head -1 A))))
+ (format (last A)) ) ) )
Adr
(ifn F
(pack Adr "@plt")
@@ -216,8 +216,8 @@
((= "%al" Src)
(prinst "mov" "%al" (byteVal Dst)) )
((pair Dst)
- (prinst "mov" (if (= "$0" Src) "%r12" Src) (car Dst))
- (prinst "mov" (if (= "$0" Src) "%r12" (highWord Src)) (cdr Dst)) )
+ (prinst "mov" Src (car Dst))
+ (prinst "mov" (if (=0 S) "%r12" (highWord Src)) (cdr Dst)) )
((pair Src)
(prinst "mov" (car Src) Dst)
(prinst "mov" (cdr Src) (highWord Dst)) )
@@ -432,9 +432,6 @@
(asm cmp (Dst D Src S)
(dstSrc "cmp" (dst Dst D) (src Src S)) )
-(asm cmp4 (Src S)
- (prinst "cmp" (src Src S) "%eax") )
-
(asm cmpn (Dst D Src S Cnt C)
(setq Dst (dst Dst D))
(prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rsi")
@@ -505,10 +502,11 @@
# Flow Control
(asm call (Adr A)
(nond
- (A (prinst "call" (target Adr)))
+ (A # Absolute
+ (prinst "call" (target Adr)) )
((=T A) # Ignore SUBR
(prinst "call" (pack "*" Adr)) )
- (NIL
+ (NIL # Indirect
(prinst "mov" (target Adr T) "%r10")
(prinst "call" "*%r10") ) ) )
@@ -579,6 +577,15 @@
(asm jgt (Adr A)
(_jmp "ja" "jbe") )
+(asm ret ()
+ (unless
+ (and
+ (seek '((L) (== (cadr L) *Statement)) *Program)
+ (not (memq (caar @) '`(cons ': (cdr *Transfers)))) )
+ (prinst "rep") )
+ (prinst "ret") )
+
+# Floating point
(asm ldd ()
(prinst "movsd" "(%rdx)" "%xmm0") )
@@ -670,6 +677,7 @@
(asm stf ()
(prinst "movss" "%xmm0" "(%r15)") )
+# C-Calls
(asm cc (Adr A Arg M)
(unless (== 'cc (caar (seek '((L) (== (cadr L) *Statement)) *Program)))
(prinst "mov" "%rdx" "%r12") )
@@ -813,14 +821,6 @@
(prinst "mov" "%r12" "%rdx")
(prinst "xor" "%r12" "%r12") ) )
-(asm ret ()
- (unless
- (and
- (seek '((L) (== (cadr L) *Statement)) *Program)
- (not (memq (caar @) '`(cons ': (cdr *Transfers)))) )
- (prinst "rep") )
- (prinst "ret") )
-
(asm begin ()
(prinst "call" "begin") )
@@ -964,4 +964,9 @@
# Replace the the next 'cnt' elements with 'lst'
(de optimize (Lst)) #> (cnt . lst)
+### Decoration ###
+(de prolog (File))
+
+(de epilog (File))
+
# vi:et:ts=3:sw=3
diff --git a/src64/err.l b/src64/err.l
@@ -1,4 +1,4 @@
-# 07jun12abu
+# 05oct12abu
# (c) Software Lab. Alexander Burger
# Debug print routine
@@ -35,7 +35,7 @@
push E # <L I> Save reason
link
sub S (+ 240 IV) # <S> Message buffer, <S 240> outFrame
- cc sprintf(S Y Z) # Build message
+ cc snprintf(S 240 Y Z) # Build message
null X # Error context?
ld A Nil
ldnz A X # Yes
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 17jul12abu
+# 24sep12abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -223,7 +223,8 @@
if z # Closed
dec (C I) # 'ix' = 'cnt' = -1
dec (C II)
- ret # z
+ setz # Return 'z'
+ ret
end
call errno_A
cmp A EAGAIN # No data available?
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -1,4 +1,4 @@
-# 16apr12abu
+# 29sep12abu
# (c) Software Lab. Alexander Burger
# *LittleEndian *AlignedCode *Registers optimize
@@ -44,7 +44,9 @@
(off *Section *Tags *Map *IfStack *DoStack)
(out "File"
(prinl "/* " (datSym (date)) " */")
- (run "Prg") )
+ (prolog "File")
+ (run "Prg")
+ (epilog "File") )
(when "Map"
(out "tags"
(for Lbl (idx '*Tags)
@@ -77,14 +79,10 @@
(de section (Fun @Sym)
(def Fun
(curry (@Sym) (Lbl Align)
- (unless (== *Section '@Sym)
- (prinl)
- (prinl " ." '@Sym)
- (setq *Section '@Sym) )
- (prinl)
+ (newSection '@Sym)
(when Align
- ((get 'align 'asm) 16)
- ((get 'skip 'asm) Align) )
+ ((; 'align asm) 16)
+ ((; 'skip asm) Align) )
(when (reg Lbl)
(quit "Register" Lbl) )
(when Lbl
@@ -108,7 +106,7 @@
((num? Atom)
(link (cons ': (pack *Label "_" Atom))) )
((lup *FlowControl Atom)
- ((get Atom 'asm) (eval (cadr @))) )
+ ((; Atom asm) (eval (cadr @))) )
((lup *Instructions Atom)
(link (cons Atom (mapcar eval (cdr @)))) )
(T (quit "Bad instruction" Atom)) ) ) ) ) )
@@ -125,7 +123,7 @@
(for *Statement *Program
(if (== ': (car *Statement))
(label (cdr *Statement))
- (apply (get (car *Statement) 'asm) (cdr *Statement)) ) ) ) ) )
+ (apply (; (car *Statement) asm) (cdr *Statement)) ) ) ) ) )
# (data 'lbl)
# (data 'lbl 0)
@@ -214,12 +212,6 @@
(cdr *Conditions) ) )
(cadr (pop '*Program)) ) ) ) ) ) ) ) )
-# Print instruction
-(de prinst (Name . @)
- (if (rest)
- (tab (3 -9 0) NIL Name (glue ", " @))
- (tab (3 -9) NIL Name) ) )
-
# Registers
(de reg (X)
(cdr (asoq X *Registers)) )
@@ -231,7 +223,7 @@
((sym? X)
(cond
((asoq X *Registers) X)
- ((get X 'equ) @)
+ ((; X equ) @)
(T X) ) )
((asoq (car X) *Registers)
(cons (car X) (operand (cadr X))) )
@@ -266,7 +258,7 @@
(pack (and F "~") X) )
((reg X) (off "*Mode") @) # Register
((atom X) (on "*Mode") X) # Direct
- ((or (num? (cdr X)) (get (cdr X) 'equ))
+ ((or (num? (cdr X)) (; (cdr X) equ))
(prog1 (cons ("source" (car X) F) @)
(setq "*Mode" (cons "*Mode" 0)) ) )
((cdr X)
@@ -300,7 +292,7 @@
(or F (quit "Bad destination" X))
(on "*Mode")
X )
- ((or (num? (cdr X)) (get (cdr X) 'equ))
+ ((or (num? (cdr X)) (; (cdr X) equ))
(prog1 (cons ("destination" (car X) T) @)
(setq "*Mode" (cons "*Mode" 0)) ) )
((cdr X)
@@ -425,7 +417,6 @@
(clrc)
(clrz)
(cmp (destination) "*Mode" (source) "*Mode")
- (cmp4 (source) "*Mode")
(cmpn (destination) "*Mode" (source) "*Mode" (source) "*Mode")
(cnt (source) "*Mode")
(dec (destination) "*Mode")
@@ -521,32 +512,11 @@
# Directives
-(de label (Lbl Flg)
- (and Flg (prinl " .globl " Lbl))
- (prinl Lbl ':) )
(asm :: (Src Lbl)
(idxTags Lbl Src)
(label Lbl T) )
-(asm word (N)
- (prinst ".quad" N) )
-
-(asm byte (N)
- (prinst ".byte" N) )
-
-(asm bytes (Lst)
- (prinst ".byte" (glue ", " Lst)) )
-
-(asm hx2 (Lst)
- (prinst ".short" (glue ", " (mapcar hex Lst))) )
-
-(asm ascii (Str)
- (prinst ".ascii" (pack "\"" Str "\"")) )
-
-(asm asciz (Str)
- (prinst ".asciz" (pack "\"" Str "\"")) )
-
(asm initFun (Src Lbl Name Val)
(initSym Src Lbl Name Val (pack Val (and *AlignedCode "+2"))) )
@@ -575,14 +545,14 @@
(setq L (flip L)) )
(chain L) ) ) ) )
(if (nth Name 9)
- (prinst ".quad" ".+20")
- (prinst ".byte" (glue ", " Name))
+ ((; 'word asm) ".+20")
+ ((; 'bytes asm) Name)
(off Name) )
(when Lbl
(label Lbl T) )
- (prinst ".quad" Val)
+ ((; 'word asm) Val)
(while Name
- (prinst ".byte" (glue ", " (cut 8 'Name))) ) )
+ ((; 'bytes asm) (cut 8 'Name)) ) )
# Condition code optimizations
@@ -608,7 +578,7 @@
movn mset movm save load
add sub inc dec not neg and or xor off test shl shr rol ror
mul div zxt setz clrz
- cmp cmp4 cmpn slen memb null nul4 nul cnt big num sym atom
+ cmp cmpn slen memb null nul4 nul cnt big num sym atom
call cc return
eval eval+ eval/ret exec prog )
@@ -618,8 +588,8 @@
(: noCC)
(loop
(NIL (setq Lst (cdr Lst)))
- (T (get Lst 1 1 'useCC))
- (T (get Lst 1 1 'chgCC) T)
+ (T (; Lst 1 1 useCC))
+ (T (; Lst 1 1 chgCC) T)
(T (= '(push T NIL) (car Lst)))
(T (= '(pop T NIL) (car Lst)) T)
(T (== 'ret (caar Lst))
diff --git a/src64/lib/fmt.c.l b/src64/lib/fmt.c.l
@@ -0,0 +1,63 @@
+# 30sep12abu
+# (c) Software Lab. Alexander Burger
+
+(de newSection (Sym)
+ (setq *Section Sym) )
+
+(de asmDataLength ()
+ (+
+ (or (cadar *AsmData) 0)
+ (sum '((X) (if (num? X) 1 8))
+ (cddar *AsmData)) ) )
+
+# Directives
+(de label (Lbl Flg)
+ (if (== 'data *Section)
+ (push '*AsmData
+ (list Lbl (asmDataLength)) )
+ (if (and *AsmCode (not (caar @)))
+ (conc (car *AsmCode) (cons Lbl))
+ (push '*AsmCode (list NIL Lbl)) )
+ (idx '*Labels (def (name Lbl) *AsmPos) T) ) )
+
+(asm word (X)
+ (conc (cdar *AsmData)
+ (cons (if (sym? X) X (cons X))) ) )
+
+(asm byte (N)
+ (conc (cdar *AsmData) (cons N)) )
+
+(asm bytes (Lst)
+ (conc (cdar *AsmData) (copy Lst)) )
+
+(asm hx2 (Lst)
+ (conc (cdar *AsmData)
+ (mapcan
+ '((S)
+ (let (N (hex S) Hi (& (>> 8 N) 255) Lo (& N 255))
+ (if *LittleEndian
+ (list Lo Hi)
+ (list Hi Lo) ) ) )
+ Lst ) ) )
+
+(de escCstr (Str)
+ (make
+ (for (L (chop Str) L)
+ (let C (pop 'L)
+ (link
+ (char
+ (ifn (= "\\" C)
+ C
+ (case (pop 'L)
+ ("t" "^I")
+ ("n" "^J")
+ ("r" "^M")
+ (T @) ) ) ) ) ) ) ) )
+
+(asm ascii (Str)
+ (conc (cdar *AsmData) (escCstr Str)) )
+
+(asm asciz (Str)
+ (conc (cdar *AsmData) (escCstr Str) (cons 0)) )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/lib/fmt.s.l b/src64/lib/fmt.s.l
@@ -0,0 +1,39 @@
+# 03aug12abu
+# (c) Software Lab. Alexander Burger
+
+(de newSection (Sym)
+ (unless (== *Section Sym)
+ (prinl)
+ (prinl " ." (setq *Section Sym)) )
+ (prinl) )
+
+# Print instruction
+(de prinst (Name . @)
+ (if (rest)
+ (tab (3 -9 0) NIL Name (glue ", " @))
+ (tab (3 -9) NIL Name) ) )
+
+# Directives
+(de label (Lbl Flg)
+ (and Flg (prinl " .globl " Lbl))
+ (prinl Lbl ':) )
+
+(asm word (N)
+ (prinst ".quad" N) )
+
+(asm byte (N)
+ (prinst ".byte" N) )
+
+(asm bytes (Lst)
+ (prinst ".byte" (glue ", " Lst)) )
+
+(asm hx2 (Lst)
+ (prinst ".short" (glue ", " (mapcar hex Lst))) )
+
+(asm ascii (Str)
+ (prinst ".ascii" (pack "\"" Str "\"")) )
+
+(asm asciz (Str)
+ (prinst ".asciz" (pack "\"" Str "\"")) )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 05sep12abu
+# 02oct12abu
# (c) Software Lab. Alexander Burger
(code 'Code)
@@ -216,8 +216,10 @@
# Allocate cell heap
(code 'heapAlloc 0) # AEX
ld A 0 # NULL pointer
- ld E (+ HEAP I) # Heap allocation size
+ ld E (+ HEAP I II) # Heap size + link + space
call allocAE_A
+ add A 15 # Align to cell boundary
+ off B 15
ld E A # Heap pointer
ld (A HEAP) (Heaps) # Set heap link
ld (Heaps) A
@@ -2824,7 +2826,9 @@
ld (X) E # Set date
pop (X CDR) # and time
call consX_E # New cell
- call s_isdirS_F # Directory?
+ ld4 (S ST_MODE) # Get 'st_mode' from 'stat'
+ and A S_IFMT
+ cmp A S_IFDIR # Directory?
if eq # Yes
ld (E) TSym # CAR is T
else
diff --git a/src64/mkAsm.l b/src64/mkAsm.l
@@ -1,12 +1,19 @@
-# 25mar11abu
+# 08aug12abu
# (c) Software Lab. Alexander Burger
-(setq *Architecture (opt) *System (opt) *TargetOS (opt) *Module (opt))
+(setq
+ *Architecture (opt)
+ *System (opt)
+ *Format (opt)
+ *TargetOS (opt)
+ *Module (opt) )
-(load "lib/asm.l" (pack "arch/" *Architecture ".l"))
+(load "lib/asm.l"
+ (pack "lib/fmt" *Format ".l")
+ (pack "arch/" *Architecture ".l") )
-(build (pack *Architecture "." *System "." *Module ".s") (opt)
- (load "defs.l" (pack "sys/" *Architecture "." *System ".defs.l") T) )
+(build (pack *Architecture *System "." *Module *Format) (opt)
+ (load (pack "sys/" *Architecture *System ".defs.l") "defs.l" T) )
(bye)
diff --git a/src64/sys/emu.code.l b/src64/sys/emu.code.l
@@ -0,0 +1,44 @@
+# 05oct12abu
+# (c) Software Lab. Alexander Burger
+
+# System macros
+(push '*SysFun
+ "void errno_A(void) {A.n = (uint64_t)errno;}" )
+
+(code 'errno_A 0)
+ cc errno_A() # Get 'errno' into A
+ ret
+
+
+(push '*SysFun
+ "void errnoC(void) {errno = (int)C.n;}" )
+
+(code 'errnoC 0)
+ cc errnoC() # Store 'errno'
+ ret
+
+
+(push '*SysFun
+ '"void wifstoppedS_F(void) {Result = !WIFSTOPPED(*(int*)(S.p + 8));}" )
+
+(code 'wifstoppedS_F 0) # WIFSTOPPED
+ cc wifstoppedS_F()
+ ret
+
+
+(push '*SysFun
+ '"void wifsignaledS_F(void) {Result = !WIFSIGNALED(*(int*)(S.p + 8));}" )
+
+(code 'wifsignaledS_F 0) # WIFSIGNALED
+ cc wifsignaledS_F()
+ ret
+
+
+(push '*SysFun
+ '"int wtermsigS_A(void) {return WTERMSIG(*(int*)(S.p + 8));}" )
+
+(code 'wtermsigS_A 0) # WTERMSIG
+ cc wtermsigS_A()
+ ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/sys/emu.defs.l b/src64/sys/emu.defs.l
@@ -0,0 +1,15 @@
+# 05oct12abu
+# (c) Software Lab. Alexander Burger
+
+(load '("./sysdefs"))
+
+# Standard I/O
+(def 'stdin 'sys 'stdin)
+(def 'stdout 'sys 'stdout)
+(def 'stderr 'sys 'stderr)
+
+# Function pointers
+(def 'sig 'sys 'sig)
+(def 'sigTerm 'sys 'sigTerm)
+
+# vi:et:ts=3:sw=3
diff --git a/src64/sys/ppc64.linux.code.l b/src64/sys/ppc64.linux.code.l
@@ -1,4 +1,4 @@
-# 22apr11abu
+# 30sep12abu
# (c) Software Lab. Alexander Burger
# System macros
@@ -13,12 +13,6 @@
st4 (C) # Store new value
ret
-(code 's_isdirS_F 0) # S_ISDIR
- ld4 (S `(+ I ST_MODE)) # Get 'st_mode' from 'stat'
- and A `S_IFMT
- cmp A `S_IFDIR
- ret
-
(code 'wifstoppedS_F 0) # WIFSTOPPED
ld4 (S I) # Get status
cmp B `(hex "7F") # (((status) & 0xff) == 0x7f)
diff --git a/src64/sys/x86-64.linux.code.l b/src64/sys/x86-64.linux.code.l
@@ -1,4 +1,4 @@
-# 19apr11abu
+# 30sep12abu
# (c) Software Lab. Alexander Burger
# System macros
@@ -13,12 +13,6 @@
st4 (C) # Store new value
ret
-(code 's_isdirS_F 0) # S_ISDIR
- ld4 (S `(+ I ST_MODE)) # Get 'st_mode' from 'stat'
- and A `S_IFMT
- cmp A `S_IFDIR
- ret
-
(code 'wifstoppedS_F 0) # WIFSTOPPED
ld A (S I) # Get status
cmp B `(hex "7F") # (((status) & 0xff) == 0x7f)
diff --git a/src64/sys/x86-64.sunOs.code.l b/src64/sys/x86-64.sunOs.code.l
@@ -13,12 +13,6 @@
ld (A) C # Store new value
ret
-(code 's_isdirS_F 0) # S_ISDIR
- ld4 (S `(+ I ST_MODE)) # Get 'st_mode' from 'stat'
- and A `S_IFMT
- cmp A `S_IFDIR
- ret
-
(code 'wifstoppedS_F 0) # WIFSTOPPED
ld A (S I) # Get status
cmp B `(hex "7F") # (((status) & 0xff) == 0x7f)
diff --git a/src64/sysdefs.c b/src64/sysdefs.c
@@ -0,0 +1,198 @@
+/* 08aug12abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <limits.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <dirent.h>
+#include <signal.h>
+#include <dlfcn.h>
+#include <termio.h>
+#include <time.h>
+#include <poll.h>
+#include <termios.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/times.h>
+#include <sys/resource.h>
+#include <netdb.h>
+#include <sys/socket.h>
+#include <netinet/tcp.h>
+
+static int SigNums[] = {
+ SIGHUP, SIGINT, SIGUSR1, SIGUSR2, SIGPIPE, SIGALRM, SIGTERM,
+ SIGCHLD, SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGIO
+};
+
+static char *SigNames[] = {
+ "SIGHUP", "SIGINT", "SIGUSR1", "SIGUSR2", "SIGPIPE", "SIGALRM", "SIGTERM",
+ "SIGCHLD", "SIGCONT", "SIGSTOP", "SIGTSTP", "SIGTTIN", "SIGTTOU", "SIGIO"
+};
+
+static void comment(char *s) {
+ printf("\n# %s\n", s);
+}
+
+static void equ(char *sym, long val) {
+ printf("(equ %s %ld)\n", sym, val);
+}
+
+int main(void) {
+ int i, n;
+ struct flock fl;
+ struct stat st;
+ struct tms tim;
+ struct termios term;
+ struct sigaction act;
+ fd_set rdSet;
+ struct tm tm;
+ struct dirent dir;
+ struct sockaddr_in6 addr;
+ struct addrinfo ai;
+
+ i = 1;
+ printf("# Endianess\n%c\n# Wordsize\n%d\n",
+ *(char*)&i == 1? 'L' : 'B', (int)sizeof(char*) * 8 );
+
+ comment("errno");
+ equ("ENOENT", ENOENT);
+ equ ("EINTR", EINTR);
+ equ ("EBADF", EBADF);
+ equ ("EAGAIN", EAGAIN);
+ equ ("EACCES", EACCES);
+ equ ("EPIPE", EPIPE);
+ equ ("ECONNRESET", ECONNRESET);
+
+ comment("open/fcntl");
+ equ ("O_RDONLY", O_RDONLY);
+ equ ("O_WRONLY", O_WRONLY);
+ equ ("O_RDWR", O_RDWR);
+ equ ("O_CREAT", O_CREAT);
+ equ ("O_EXCL", O_EXCL);
+ equ ("O_TRUNC", O_TRUNC);
+ equ ("O_APPEND", O_APPEND);
+ equ ("F_GETFD", F_GETFD);
+ equ ("F_SETFD", F_SETFD);
+ equ ("FD_CLOEXEC", FD_CLOEXEC);
+
+ comment ("stdio");
+ equ("BUFSIZ", BUFSIZ);
+ equ("PIPE_BUF", PIPE_BUF);
+ equ("MAXPATHLEN", 0); // getcwd(NULL,0)
+
+ comment ("dlfcn");
+ equ("RTLD_LAZY", RTLD_LAZY);
+ equ("RTLD_GLOBAL", RTLD_GLOBAL);
+
+ comment ("fcntl");
+ equ("FLOCK", sizeof(fl));
+ equ("L_TYPE", (char*)&fl.l_type - (char*)&fl);
+ equ("L_WHENCE", (char*)&fl.l_whence - (char*)&fl);
+ equ("L_START", (char*)&fl.l_start - (char*)&fl);
+ equ("L_LEN", (char*)&fl.l_len - (char*)&fl);
+ equ("L_PID", (char*)&fl.l_pid - (char*)&fl);
+ equ("SEEK_SET", SEEK_SET);
+ equ("SEEK_CUR", SEEK_CUR);
+ equ("F_RDLCK", F_RDLCK);
+ equ("F_WRLCK", F_WRLCK);
+ equ("F_UNLCK", F_UNLCK);
+ equ("F_GETFL", F_GETFL);
+ equ("F_SETFL", F_SETFL);
+ equ("F_GETLK", F_GETLK);
+ equ("F_SETLK", F_SETLK);
+ equ("F_SETLKW", F_SETLKW);
+ equ("F_SETOWN", F_SETOWN);
+ equ("O_NONBLOCK", O_NONBLOCK);
+ equ("O_ASYNC", O_ASYNC);
+
+ comment ("stat");
+ equ("STAT", sizeof(st));
+ equ("ST_MODE", (char*)&st.st_mode - (char*)&st);
+ equ("ST_SIZE", (char*)&st.st_size - (char*)&st);
+ equ("ST_MTIME", (char*)&st.st_mtime - (char*)&st);
+ equ("S_IFMT", S_IFMT);
+ equ("S_IFDIR", S_IFDIR);
+
+ comment ("times");
+ equ("TMS", sizeof(tim));
+ equ("TMS_UTIME", (char*)&tim.tms_utime - (char*)&tim);
+ equ("TMS_STIME", (char*)&tim.tms_stime - (char*)&tim);
+
+ comment ("termios");
+ equ("TERMIOS", sizeof(term));
+ equ("C_IFLAG", (char*)&term.c_iflag - (char*)&term);
+ equ("C_LFLAG", (char*)&term.c_lflag - (char*)&term);
+ equ("C_CC", (char*)&term.c_cc - (char*)&term);
+ equ("ISIG", ISIG);
+ equ("VMIN", VMIN);
+ equ("VTIME", VTIME);
+ equ("TCSADRAIN", TCSADRAIN);
+
+ comment ("signal");
+ equ("SIGACTION", sizeof(act));
+ equ("SIGSET_T", sizeof(sigset_t));
+ equ("SA_HANDLER", (char*)&act.sa_handler - (char*)&act);
+ equ("SA_MASK", (char*)&act.sa_mask - (char*)&act);
+ equ("SA_FLAGS", (char*)&act.sa_flags - (char*)&act);
+
+ equ("SIG_DFL", (long)SIG_DFL);
+ equ("SIG_IGN", (long)SIG_IGN);
+ equ("SIG_UNBLOCK", SIG_UNBLOCK);
+
+ for (i = n = 0; i < sizeof(SigNums)/sizeof(int); ++i) {
+ equ(SigNames[i], SigNums[i]);
+ if (SigNums[i] > n)
+ n = SigNums[i];
+ }
+ equ("SIGNALS", n + 1); // Highest used signal number plus 1
+
+ comment ("wait");
+ equ("WNOHANG", WNOHANG);
+ equ("WUNTRACED", WUNTRACED);
+
+ comment ("select");
+ equ("FD_SET", sizeof(rdSet));
+
+ comment ("time");
+ equ("TM_SEC", (char*)&tm.tm_sec - (char*)&tm);
+ equ("TM_MIN", (char*)&tm.tm_min - (char*)&tm);
+ equ("TM_HOUR", (char*)&tm.tm_hour - (char*)&tm);
+ equ("TM_MDAY", (char*)&tm.tm_mday - (char*)&tm);
+ equ("TM_MON", (char*)&tm.tm_mon - (char*)&tm);
+ equ("TM_YEAR", (char*)&tm.tm_year - (char*)&tm);
+
+ comment ("dir");
+ equ("D_NAME", (char*)&dir.d_name - (char*)&dir);
+
+ comment ("Sockets");
+ equ("SOCK_STREAM", SOCK_STREAM);
+ equ("SOCK_DGRAM", SOCK_DGRAM);
+ equ("AF_UNSPEC", AF_UNSPEC);
+ equ("AF_INET6", AF_INET6);
+ equ("SOL_SOCKET", SOL_SOCKET);
+ equ("SO_REUSEADDR", SO_REUSEADDR);
+ equ("IPPROTO_IPV6", IPPROTO_IPV6);
+ equ("IPV6_V6ONLY", IPV6_V6ONLY);
+ equ("INET6_ADDRSTRLEN", INET6_ADDRSTRLEN);
+
+ equ("NI_MAXHOST", NI_MAXHOST);
+ equ("NI_NAMEREQD", NI_NAMEREQD);
+
+ equ("SOCKADDR_IN6", sizeof(addr));
+ equ("SIN6_FAMILY", (char*)&addr.sin6_family - (char*)&addr);
+ equ("SIN6_PORT", (char*)&addr.sin6_port - (char*)&addr);
+ equ("SIN6_ADDR", (char*)&addr.sin6_addr - (char*)&addr);
+
+ equ("ADDRINFO", sizeof(ai));
+ equ("AI_FAMILY", (char*)&ai.ai_family - (char*)&ai);
+ equ("AI_SOCKTYPE", (char*)&ai.ai_socktype - (char*)&ai);
+ equ("AI_ADDRLEN", (char*)&ai.ai_addrlen - (char*)&ai);
+ equ("AI_ADDR", (char*)&ai.ai_addr - (char*)&ai);
+ equ("AI_NEXT", (char*)&ai.ai_next - (char*)&ai);
+}
diff --git a/src64/tags b/src64/tags
@@ -413,7 +413,7 @@ adduAE_A big.l 540
allocAE_A main.l 207
allocC_A main.l 202
anduAE_A big.l 325
-anonymousX_FE io.l 2084
+anonymousX_FE io.l 2085
applyVarXYZ_E apply.l 358
applyXYZ_E apply.l 4
argErrAX err.l 406
@@ -425,12 +425,12 @@ badFdErrEX err.l 525
badInputErrB err.l 545
balanceCEY sym.l 910
balanceXY sym.l 892
-begString main.l 2303
-binPrintEZ io.l 730
-binReadZ_FE io.l 519
+begString main.l 2305
+binPrintEZ io.l 731
+binReadZ_FE io.l 520
blkPeekCEZ db.l 392
blkPokeCEZ db.l 403
-boxE_E main.l 2271
+boxE_E main.l 2273
boxNumA_A gc.l 872
boxNumE_E gc.l 886
boxNum_A gc.l 824
@@ -440,43 +440,43 @@ boxNum_X gc.l 860
brkErrX err.l 494
brkLoadE_E flow.l 2856
bufAoAC_C db.l 956
-bufStringE_SZ io.l 1142
+bufStringE_SZ io.l 1143
byeE flow.l 3439
-byteNumBCX_CX io.l 463
-byteSymBCX_CX io.l 1291
+byteNumBCX_CX io.l 464
+byteSymBCX_CX io.l 1292
caseDataA_AC sym.l 3366
caught flow.l 2472
-cbl main.l 1906
-cbl1 main.l 1939
-cbl10 main.l 1975
-cbl11 main.l 1979
-cbl12 main.l 1983
-cbl13 main.l 1987
-cbl14 main.l 1991
-cbl15 main.l 1995
-cbl16 main.l 1999
-cbl17 main.l 2003
-cbl18 main.l 2007
-cbl19 main.l 2011
-cbl2 main.l 1943
-cbl20 main.l 2015
-cbl21 main.l 2019
-cbl22 main.l 2023
-cbl23 main.l 2027
-cbl24 main.l 2031
-cbl3 main.l 1947
-cbl4 main.l 1951
-cbl5 main.l 1955
-cbl6 main.l 1959
-cbl7 main.l 1963
-cbl8 main.l 1967
-cbl9 main.l 1971
-charSymACX_CX io.l 1256
+cbl main.l 1908
+cbl1 main.l 1941
+cbl10 main.l 1977
+cbl11 main.l 1981
+cbl12 main.l 1985
+cbl13 main.l 1989
+cbl14 main.l 1993
+cbl15 main.l 1997
+cbl16 main.l 2001
+cbl17 main.l 2005
+cbl18 main.l 2009
+cbl19 main.l 2013
+cbl2 main.l 1945
+cbl20 main.l 2017
+cbl21 main.l 2021
+cbl22 main.l 2025
+cbl23 main.l 2029
+cbl24 main.l 2033
+cbl3 main.l 1949
+cbl4 main.l 1953
+cbl5 main.l 1957
+cbl6 main.l 1961
+cbl7 main.l 1965
+cbl8 main.l 1969
+cbl9 main.l 1973
+charSymACX_CX io.l 1257
checkVarAX err.l 365
checkVarEX err.l 381
checkVarYX err.l 373
chopExtNmX_E db.l 133
-circE_YF main.l 738
+circE_YF main.l 740
cleanUpY db.l 570
closeAX io.l 5
closeErrEX err.l 506
@@ -484,7 +484,7 @@ closeErrX err.l 504
closeInFileA io.l 142
closeOnExecAX io.l 43
closeOutFileA io.l 164
-clsChildY io.l 341
+clsChildY io.l 342
cmpDfltA_F subr.l 4120
cmpLongAX_F sym.l 5
cmpNumAE_F big.l 1567
@@ -493,7 +493,7 @@ cmpuAE_F big.l 1587
cntErrAX err.l 418
cntErrCX err.l 420
cntErrEX err.l 422
-compareAE_F main.l 903
+compareAE_F main.l 905
consAC_E gc.l 786
consA_A gc.l 530
consA_C gc.l 594
@@ -528,11 +528,11 @@ cons_E gc.l 482
cons_X gc.l 494
cons_Y gc.l 506
cons_Z gc.l 518
-ctOpenEXY io.l 1670
-currFdX_C io.l 1333
-currFd_C io.l 1337
+ctOpenEXY io.l 1671
+currFdX_C io.l 1334
+currFd_C io.l 1338
cutLocalCX flow.l 2824
-dateXYZ_E main.l 2418
+dateXYZ_E main.l 2420
dbAEX db.l 1331
dbFetchEX db.l 1319
dbFileBlkY_AC db.l 246
@@ -555,16 +555,16 @@ dlErrX err.l 697
doAbs big.l 2731
doAccept net.l 145
doAdd big.l 2171
-doAdr main.l 585
-doAlarm main.l 471
+doAdr main.l 587
+doAlarm main.l 473
doAll sym.l 788
doAnd flow.l 1613
-doAny io.l 3964
+doAny io.l 3965
doAppend subr.l 1338
doApply apply.l 713
-doArg main.l 2365
-doArgs main.l 2341
-doArgv main.l 2985
+doArg main.l 2367
+doArgs main.l 2343
+doArgv main.l 2990
doArrow subr.l 3916
doAs flow.l 139
doAsoq subr.l 3008
@@ -600,7 +600,7 @@ doCall flow.l 3079
doCar subr.l 5
doCase flow.l 1954
doCatch flow.l 2456
-doCd main.l 2740
+doCd main.l 2742
doCdaaar subr.l 464
doCdaadr subr.l 487
doCdaar subr.l 179
@@ -617,13 +617,13 @@ doCdddr subr.l 245
doCddr subr.l 79
doCdr subr.l 17
doChain subr.l 1141
-doChar io.l 3446
+doChar io.l 3447
doChop sym.l 1219
doCirc subr.l 816
doCircQ subr.l 2402
doClip subr.l 1799
-doClose io.l 4377
-doCmd main.l 2967
+doClose io.l 4378
+doCmd main.l 2972
doCnt apply.l 1413
doCo flow.l 2537
doCol sym.l 3051
@@ -634,10 +634,10 @@ doCond flow.l 1908
doConnect net.l 224
doCons subr.l 747
doCopy subr.l 1225
-doCtl io.l 4250
-doCtty main.l 2765
+doCtl io.l 4251
+doCtty main.l 2767
doCut sym.l 1922
-doDate main.l 2479
+doDate main.l 2481
doDbck db.l 2113
doDe flow.l 532
doDec big.l 2323
@@ -647,29 +647,29 @@ doDel sym.l 1977
doDelete subr.l 1401
doDelq subr.l 1452
doDiff subr.l 2589
-doDir main.l 2898
+doDir main.l 2902
doDiv big.l 2513
doDm flow.l 545
doDo flow.l 2130
doE flow.l 2911
-doEcho io.l 4408
-doEnv main.l 597
-doEof io.l 3523
-doEol io.l 3514
+doEcho io.l 4409
+doEnv main.l 599
+doEof io.l 3524
+doEol io.l 3515
doEq subr.l 2059
doEq0 subr.l 2173
doEqT subr.l 2181
doEqual subr.l 2115
-doErr io.l 4230
-doErrno main.l 1368
+doErr io.l 4231
+doErrno main.l 1370
doEval flow.l 175
-doExt io.l 5142
+doExt io.l 5143
doExtQ sym.l 1157
doExtern sym.l 1023
doExtra flow.l 1258
doExtract apply.l 1218
doFifo sym.l 2088
-doFile main.l 2845
+doFile main.l 2849
doFill subr.l 3243
doFilter apply.l 1161
doFin subr.l 2033
@@ -678,13 +678,13 @@ doFind apply.l 1322
doFish apply.l 1613
doFlgQ subr.l 2445
doFlip subr.l 1699
-doFlush io.l 5117
+doFlush io.l 5118
doFold sym.l 3512
doFor flow.l 2219
doFork flow.l 3253
doFormat big.l 2089
doFree db.l 2055
-doFrom io.l 3542
+doFrom io.l 3543
doFull subr.l 1075
doFunQ sym.l 750
doGc gc.l 435
@@ -698,8 +698,8 @@ doGt subr.l 2267
doGt0 big.l 2718
doHash big.l 2976
doHead subr.l 1820
-doHeap main.l 517
-doHear io.l 3227
+doHeap main.l 519
+doHear io.l 3228
doHide sym.l 1090
doHost net.l 190
doId db.l 1028
@@ -707,16 +707,16 @@ doIdx sym.l 2162
doIf flow.l 1794
doIf2 flow.l 1813
doIfn flow.l 1854
-doIn io.l 4190
+doIn io.l 4191
doInc big.l 2256
doIndex subr.l 2637
-doInfo main.l 2802
+doInfo main.l 2804
doIntern sym.l 998
doIpid flow.l 3198
doIsa flow.l 961
doJob flow.l 1418
doJournal db.l 971
-doKey io.l 3375
+doKey io.l 3376
doKill flow.l 3230
doLast subr.l 2044
doLe subr.l 2237
@@ -725,14 +725,14 @@ doLength subr.l 2741
doLet flow.l 1468
doLetQ flow.l 1529
doLieu db.l 1157
-doLine io.l 3698
-doLines io.l 3851
+doLine io.l 3699
+doLines io.l 3852
doLink subr.l 1172
-doLisp main.l 2037
+doLisp main.l 2039
doList subr.l 887
doListen net.l 157
doLit flow.l 150
-doLoad io.l 4167
+doLoad io.l 4168
doLock db.l 1185
doLoop flow.l 2162
doLowQ sym.l 3378
@@ -771,10 +771,10 @@ doNEqT subr.l 2198
doNEqual subr.l 2144
doName sym.l 502
doNand flow.l 1648
-doNative main.l 1376
+doNative main.l 1378
doNeed subr.l 919
doNew flow.l 835
-doNext main.l 2348
+doNext main.l 2350
doNil flow.l 1731
doNond flow.l 1931
doNor flow.l 1669
@@ -786,57 +786,57 @@ doOffset subr.l 2677
doOn sym.l 1708
doOnOff sym.l 1738
doOne sym.l 1771
-doOpen io.l 4334
+doOpen io.l 4335
doOpid flow.l 3214
-doOpt main.l 3088
+doOpt main.l 3093
doOr flow.l 1629
-doOut io.l 4210
+doOut io.l 4211
doPack sym.l 1270
doPair subr.l 2394
doPass apply.l 754
doPatQ sym.l 736
-doPath io.l 1244
-doPeek io.l 3430
+doPath io.l 1245
+doPeek io.l 3431
doPick apply.l 1369
-doPipe io.l 4271
-doPoll io.l 3319
+doPipe io.l 4272
+doPoll io.l 3320
doPool db.l 651
doPop sym.l 1898
doPort net.l 5
-doPr io.l 5225
+doPr io.l 5226
doPreQ sym.l 1536
-doPrin io.l 5041
-doPrinl io.l 5055
-doPrint io.l 5081
-doPrintln io.l 5112
-doPrintsp io.l 5097
+doPrin io.l 5042
+doPrinl io.l 5056
+doPrint io.l 5082
+doPrintln io.l 5113
+doPrintsp io.l 5098
doPrior subr.l 2713
doProg flow.l 1749
doProg1 flow.l 1757
doProg2 flow.l 1774
doProp sym.l 2925
doPropCol sym.l 3075
-doProtect main.l 507
+doProtect main.l 509
doProve subr.l 3530
doPush sym.l 1813
doPush1 sym.l 1849
doPut sym.l 2835
doPutl sym.l 3113
-doPwd main.l 2729
+doPwd main.l 2731
doQueue sym.l 2045
-doQuit main.l 1083
+doQuit main.l 1085
doQuote flow.l 134
doRand big.l 3003
doRange subr.l 997
doRank subr.l 3036
-doRaw main.l 449
-doRd io.l 5159
-doRead io.l 2655
+doRaw main.l 451
+doRd io.l 5160
+doRead io.l 2656
doRem big.l 2572
doReplace subr.l 1499
-doRest main.l 2394
+doRest main.l 2396
doReverse subr.l 1678
-doRewind io.l 5125
+doRewind io.l 5126
doRollback db.l 1898
doRot subr.l 848
doRun flow.l 306
@@ -850,37 +850,37 @@ doSet sym.l 1607
doSetCol sym.l 2999
doSetq sym.l 1640
doShift big.l 2627
-doSigio main.l 487
+doSigio main.l 489
doSize subr.l 2809
-doSkip io.l 3500
+doSkip io.l 3501
doSort subr.l 3965
doSpQ sym.l 727
-doSpace io.l 5059
+doSpace io.l 5060
doSplit subr.l 1592
-doStack main.l 546
+doStack main.l 548
doState flow.l 1998
doStem subr.l 1989
-doStr io.l 4018
+doStr io.l 4019
doStrQ sym.l 1136
doStrip subr.l 1576
-doStruct main.l 1828
+doStruct main.l 1830
doSub big.l 2209
doSubQ sym.l 1569
doSum apply.l 1460
doSuper flow.l 1214
-doSym io.l 4004
+doSym io.l 4005
doSymQ subr.l 2434
doSymbols sym.l 942
-doSync io.l 3187
+doSync io.l 3188
doSys flow.l 3050
doT flow.l 1740
doTail subr.l 1911
-doTell io.l 3259
+doTell io.l 3260
doText sym.l 1398
doThrow flow.l 2482
doTick flow.l 3166
-doTill io.l 3609
-doTime main.l 2612
+doTill io.l 3610
+doTime main.l 2614
doTouch sym.l 1172
doTrace flow.l 2950
doTrim subr.l 1759
@@ -890,53 +890,53 @@ doUdp net.l 301
doUnify subr.l 3938
doUnless flow.l 1890
doUntil flow.l 2074
-doUp main.l 691
+doUp main.l 693
doUppQ sym.l 3393
doUppc sym.l 3460
doUse flow.l 1562
-doUsec main.l 2717
+doUsec main.l 2719
doVal sym.l 1588
-doVersion main.l 3102
-doWait io.l 3149
+doVersion main.l 3107
+doWait io.l 3150
doWhen flow.l 1873
doWhile flow.l 2050
doWipe sym.l 3253
doWith flow.l 1321
-doWr io.l 5242
+doWr io.l 5243
doXchg sym.l 1663
doXor flow.l 1690
doYield flow.l 2706
doYoke subr.l 1196
doZap sym.l 1186
doZero sym.l 1756
-endString_E main.l 2314
+endString_E main.l 2316
eofErr err.l 534
-eolA_F io.l 3683
-equalAE_F main.l 770
-erOpenEXY io.l 1628
+eolA_F io.l 3684
+equalAE_F main.l 772
+erOpenEXY io.l 1629
errEXYZ err.l 33
errnoC sys/x86-64.linux.code.l 10
errnoEXY err.l 24
errno_A sys/x86-64.linux.code.l 5
-evCntEX_FE main.l 2242
-evCntXY_FE main.l 2240
-evExprCE_E main.l 1101
-evListE_E main.l 1245
+evCntEX_FE main.l 2244
+evCntXY_FE main.l 2242
+evExprCE_E main.l 1103
+evListE_E main.l 1247
evMethodACXYZ_E flow.l 645
-evSymE_E main.l 2217
-evSymX_E main.l 2212
-evSymY_E main.l 2215
-execE main.l 2126
+evSymE_E main.l 2219
+evSymX_E main.l 2214
+evSymY_E main.l 2217
+execE main.l 2128
execErrS main.l 187
extErrEX err.l 434
extNmCE_X db.l 64
externX_E sym.l 266
extraXY_FCYZ flow.l 1285
-fdRdSetCZL io.l 2717
-fdSetCL_X io.l 2705
-fdSetC_Y io.l 3308
-fdWrSetCZL io.l 2724
-fetchCharC_AC main.l 1871
+fdRdSetCZL io.l 2718
+fdSetCL_X io.l 2706
+fdSetC_Y io.l 3309
+fdWrSetCZL io.l 2725
+fetchCharC_AC main.l 1873
fileObjE_AC db.l 237
fileObjX_AC db.l 211
fillE_FE subr.l 3261
@@ -945,8 +945,8 @@ finishE flow.l 3451
firstByteA_B sym.l 673
firstCharE_A sym.l 688
fishAXY apply.l 1640
-flushA_F io.l 391
-flushAll io.l 411
+flushA_F io.l 392
+flushAll io.l 412
fmtNum0AE_E big.l 1794
fmtNumAE_E big.l 1797
fmtScaleCX_CX big.l 2061
@@ -954,15 +954,15 @@ fmtWordACX_CX big.l 2046
forkErrX err.l 515
forkLispX_FE flow.l 3266
fsyncDB db.l 932
-funqE_FE main.l 2150
+funqE_FE main.l 2152
gc gc.l 65
getAdrZ_A db.l 6
-getBinaryZ_FB io.l 447
+getBinaryZ_FB io.l 448
getBlockZ_FB db.l 596
-getChar_A io.l 1975
+getChar_A io.l 1976
getEC_E sym.l 2675
-getParse_A io.l 1795
-getStdin_A io.l 1724
+getParse_A io.l 1796
+getStdin_A io.l 1725
getUdpZ_FB net.l 370
getnECX_E sym.l 2634
giveupX main.l 180
@@ -974,7 +974,7 @@ idxDelXY_E sym.l 2292
idxGetXY_E sym.l 2205
idxPutXY_E sym.l 2222
ignLog db.l 924
-inReadyC_F io.l 2693
+inReadyC_F io.l 2694
incE_A big.l 1491
initInFileAC_A io.l 65
initInFileA_A io.l 63
@@ -996,9 +996,9 @@ isaCE_F flow.l 1012
jnlErrX err.l 618
jnlFileno_A db.l 344
joinLocalCX flow.l 2837
-lisp main.l 2080
+lisp main.l 2082
loadAllX_E main.l 162
-loadBEX_E io.l 4071
+loadBEX_E io.l 4072
lockErr err.l 607
lockFileAC io.l 28
lockJnl db.l 352
@@ -1014,13 +1014,13 @@ main main.l 33
makeErrX err.l 471
markE gc.l 5
matchCE_F subr.l 3147
-memberXY_FY main.l 1065
+memberXY_FY main.l 1067
metaCX_E sym.l 3340
methodEY_FCYZ flow.l 791
mkCharA_A sym.l 573
mkStrEZ_A sym.l 650
mkStrE_E sym.l 623
-msec_A main.l 2328
+msec_A main.l 2330
msgErrAX err.l 488
msgErrEX err.l 490
msgErrYX err.l 486
@@ -1029,8 +1029,8 @@ nameA_A sym.l 469
nameE_E sym.l 477
nameX_X sym.l 485
nameY_Y sym.l 493
-natBufACZ_CZ main.l 1580
-natRetACE_CE main.l 1679
+natBufACZ_CZ main.l 1582
+natRetACE_CE main.l 1681
needC gc.l 54
needSymAX err.l 323
needSymEX err.l 335
@@ -1038,7 +1038,7 @@ needVarAX err.l 346
needVarEX err.l 356
newBlock_X db.l 449
newIdEX_X db.l 492
-newline io.l 4664
+newline io.l 4665
noFdErrX err.l 529
nonblockingA_A io.l 51
numErrAX err.l 412
@@ -1046,66 +1046,66 @@ numErrEX err.l 414
oct3C_CA db.l 180
openErrEX err.l 500
oruAE_A big.l 394
-outAoA io.l 4713
-outNameE io.l 4737
-outNumE io.l 4673
-outOctA io.l 4700
-outStringC io.l 4727
-outStringS io.l 4725
-outWordA io.l 4680
+outAoA io.l 4714
+outNameE io.l 4738
+outNumE io.l 4674
+outOctA io.l 4701
+outStringC io.l 4728
+outStringS io.l 4726
+outWordA io.l 4681
packAoACX_CX db.l 108
packECX_CX sym.l 1303
packExtNmX_E db.l 87
packOctACX_CX db.l 120
pairErrAX err.l 438
pairErrEX err.l 440
-parseBCE_E io.l 3892
-pathStringE_SZ io.l 1172
+parseBCE_E io.l 3893
+pathStringE_SZ io.l 1173
pico glob.l 142
pipeErrX err.l 510
-popCtlFiles io.l 1961
-popErrFiles io.l 1954
-popInFiles io.l 1863
-popOutFiles io.l 1914
-prByteCEXY io.l 680
-prCntCE io.l 703
-prE io.l 728
-prExtNmX io.l 4692
-prNameX io.l 4745
-prTellEZ io.l 722
+popCtlFiles io.l 1962
+popErrFiles io.l 1955
+popInFiles io.l 1864
+popOutFiles io.l 1915
+prByteCEXY io.l 681
+prCntCE io.l 704
+prE io.l 729
+prExtNmX io.l 4693
+prNameX io.l 4746
+prTellEZ io.l 723
preCEXY_F sym.l 1470
-prinE io.l 4986
-prinE_E io.l 4977
-printE io.l 4764
-printE_E io.l 4755
+prinE io.l 4987
+prinE_E io.l 4978
+printE io.l 4765
+printE_E io.l 4756
propEC_E sym.l 2745
protErrEX err.l 386
-pushCtlFilesY io.l 1858
-pushErrFilesY io.l 1853
-pushInFilesY io.l 1818
-pushOutFilesY io.l 1842
+pushCtlFilesY io.l 1859
+pushErrFilesY io.l 1854
+pushInFilesY io.l 1819
+pushOutFilesY io.l 1843
putACE sym.l 2491
putBlockBZ db.l 612
putSrcEC_E flow.l 25
-putStdoutB io.l 4621
-putStringB main.l 2291
-putTellBZ io.l 996
+putStdoutB io.l 4622
+putStringB main.l 2293
+putTellBZ io.l 997
putUdpBZ net.l 377
-rdAtomBY_E io.l 2117
+rdAtomBY_E io.l 2118
rdBlockIndexAZ_Z db.l 377
rdBlockLinkZ_Z db.l 375
rdBlockZ_Z db.l 380
-rdBytesCEX_F io.l 246
-rdBytesNbCEX_F io.l 267
-rdHear_FE io.l 1075
-rdList_E io.l 2169
+rdBytesCEX_F io.l 247
+rdBytesNbCEX_F io.l 268
+rdHear_FE io.l 1076
+rdList_E io.l 2170
rdLockDb db.l 255
rdLockFileC io.l 26
-rdOpenEXY io.l 1354
-rdSetCL_F io.l 2731
-rdSetRdyCL_F io.l 2741
-readA_E io.l 2307
-readC_E io.l 2491
+rdOpenEXY io.l 1355
+rdSetCL_F io.l 2732
+rdSetRdyCL_F io.l 2742
+readA_E io.l 2308
+readC_E io.l 2492
redefMsgEC flow.l 4
redefineCE flow.l 109
reentErrEX err.l 476
@@ -1125,33 +1125,32 @@ retnc err.l 710
retnz err.l 716
retz err.l 713
rewindLog db.l 928
-runE_E main.l 2138
+runE_E main.l 2140
rwUnlockDbA db.l 269
-s_isdirS_F sys/x86-64.linux.code.l 16
selectErrX err.l 558
serverCEY_FE net.l 273
setAdrAS db.l 36
setAdrAZ db.l 22
setBlkAC_Z db.l 366
setBlockAC_Z db.l 364
-setCooked main.l 441
-setRaw main.l 415
-sharedLibC_FA main.l 1298
+setCooked main.l 443
+setRaw main.l 417
+sharedLibC_FA main.l 1300
shluA_A big.l 201
shruA_A big.l 247
-sig main.l 342
-sigChld main.l 365
-sigTerm main.l 354
-sigTermStop main.l 399
-sighandler0 main.l 236
-sighandlerE main.l 250
-sighandlerX main.l 243
+sig main.l 344
+sigChld main.l 367
+sigTerm main.l 356
+sigTermStop main.l 401
+sighandler0 main.l 238
+sighandlerE main.l 252
+sighandlerX main.l 245
sizeCE_C subr.l 2929
-skipC_A io.l 2007
+skipC_A io.l 2008
slowNbC_FA io.l 207
slowZ_F io.l 185
-space io.l 4668
-stdinByte_A io.l 425
+space io.l 4669
+stdinByte_A io.l 426
stkErr err.l 395
stkErrE err.l 397
stkErrEX err.l 401
@@ -1160,24 +1159,24 @@ subAE_A big.l 1542
subStrAE_F sym.l 1485
subuAE_A big.l 682
suparErrE err.l 540
-symByteCX_FACX io.l 1088
-symCharCX_FACX io.l 1109
+symByteCX_FACX io.l 1089
+symCharCX_FACX io.l 1110
symErrAX err.l 426
symErrEX err.l 430
symErrYX err.l 428
symNsErrEX err.l 390
symToNumXA_FE big.l 1681
-tcSetC main.l 386
+tcSetC main.l 388
tcpAcceptA_FE net.l 109
-tellBegZ_Z io.l 1004
-tellEndAZ io.l 1011
+tellBegZ_Z io.l 1005
+tellEndAZ io.l 1012
tellErr err.l 646
tenfoldA_A big.l 157
-testEscA_F io.l 2050
+testEscA_F io.l 2051
throwErrZX flow.l 2507
-tmDateC_E main.l 2408
-tmTimeY_E main.l 2595
-tokenCE_E io.l 2521
+tmDateC_E main.l 2410
+tmTimeY_E main.l 2597
+tokenCE_E io.l 2522
trSyncErrX err.l 602
traceCY flow.l 3022
trimE_E subr.l 1769
@@ -1195,32 +1194,32 @@ undefinedEX err.l 693
uniFillE_E subr.l 3886
unifyCEYZ_F subr.l 3364
uninternEXY sym.l 356
-unsync io.l 1058
+unsync io.l 1059
unwindC_Z err.l 165
varErrAX err.l 456
varErrEX err.l 458
-waitFdCEX_A io.l 2763
+waitFdCEX_A io.l 2764
waitPidErrX err.l 520
-wifsignaledS_F sys/x86-64.linux.code.l 27
-wifstoppedS_F sys/x86-64.linux.code.l 22
+wifsignaledS_F sys/x86-64.linux.code.l 21
+wifstoppedS_F sys/x86-64.linux.code.l 16
wipeE sym.l 3275
wrBlockZ db.l 398
-wrBytesCEX_F io.l 316
+wrBytesCEX_F io.l 317
wrBytesErr err.l 563
-wrChildCXY io.l 352
+wrChildCXY io.l 353
wrChildErr err.l 569
wrJnlErr err.l 580
wrLockDb db.l 262
wrLockFileC io.l 23
wrLogErr err.l 586
-wrOpenEXY io.l 1495
-wrSetCL_F io.l 2736
+wrOpenEXY io.l 1496
+wrSetCL_F io.l 2737
wrSyncErrX err.l 575
-wtermsigS_A sys/x86-64.linux.code.l 34
-xCntAX_FA main.l 2262
-xCntCX_FC main.l 2253
-xCntEX_FE main.l 2244
-xSymE_E main.l 2219
+wtermsigS_A sys/x86-64.linux.code.l 28
+xCntAX_FA main.l 2264
+xCntCX_FC main.l 2255
+xCntEX_FE main.l 2246
+xSymE_E main.l 2221
xoruAE_A big.l 465
yieldErrEX err.l 482
yieldErrX err.l 480
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 17jul12abu
+# 07oct12abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 1 0 10)
+(de *Version 3 1 0 11)
# vi:et:ts=3:sw=3
