commit 779c9770ac19438a2cc049a17aef212af518d503
parent a6efd51af02775651a897bdd29e468f369efbe96
Author: Commit-Bot <unknown>
Date: Wed, 12 May 2010 11:44:39 +0000
Automatic commit from picoLisp.tgz, From: Wed, 12 May 2010 08:44:39 GMT
Diffstat:
13 files changed, 1253 insertions(+), 123 deletions(-)
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,4 +1,4 @@
-30apr10abu
+12may10abu
(c) Software Lab. Alexander Burger
@@ -27,3 +27,18 @@ D. The 'format' number <-> string conversion function now also accepts a list
(format Lst)
will also do.
+
+E. There is a partially implemented 32-bit emulator of the 64-bit version in
+ "src64/arch/x86-32.l". It is intended as a demonstration of how to port the
+ assembler to a different CPU (not a very suitable demonstration, though), and
+ a way to thest 64-bit programs on a 32-bit machine. If it ever works, it will
+ be deadly slow, though.
+
+ In case somebody likes to grit his teeth on it, an exprimental executable
+ "bin/emu32" can be built with
+
+ (cd src64; ./mkEmu32)
+
+ Be warned, however, it builds something which doesn't run. Most instructions
+ that return CPU flags, and 128-bit multiplication/division are not right yet.
+ Besides this, there are probably a lot of bugs.
diff --git a/doc/refP.html b/doc/refP.html
@@ -468,7 +468,7 @@ href="refW.html#wr">wr</a></code>.
<dd>Executes <code>prg</code>, similar to <code><a
href="refR.html#run">run</a></code>, by evaluating all expressions in
<code>prg</code> (within the binding environment given by <code>cnt-1</code>).
-As a side effect, all atomics expression will be printed with <code><a
+As a side effect, all atomic expressions will be printed with <code><a
href="refP.html#prinl">prinl</a></code>. See also <code><a
href="refE.html#eval">eval</a></code>.
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 05may10abu
+# 11may10abu
# (c) Software Lab. Alexander Burger
@@ -80,7 +80,7 @@
nop # No operation
Move Instructions:
- ld dst src # Load 'dst' from 'src'
+ 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 dst src # Load if Carry 'dst' from 'src'
@@ -117,8 +117,8 @@
rcl dst src # Rotate 'dst' with Carry left by 'src' bits
rcr dst src # Rotate 'dst' with Carry right by 'src' bits
- mul src # Multiplication of 'A' and 'src' into 'D'
- div src # Division of 'D' by 'src' into 'A', 'C'
+ 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'
@@ -128,15 +128,15 @@
clrz # Clear Zero flag
Comparisons:
- cmp dst src # Compare 'dst' with 'src'
+ cmp dst src # Compare 'dst' with 'src' [z.c]
cmp4 src # Compare four bytes in 'A' with 'src'
cmpm dst src end # Compare 'dst' with with memory between 'src' and 'end'
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
- null src # Compare 'src' with 0
- zero src # 'z' if ZERO
- nul4 # Compare four bytes in 'A' with 0
+ null src # Compare 'src' with 0 [zs.]
+ zero src # Test if ZERO [z..]
+ nul4 # Compare four bytes in 'A' with 0 [zs.]
Byte addressing:
set dst src # Set 'dst' byte to 'src'
@@ -167,8 +167,8 @@
return src # Return to C-function
Stack Manipulations:
- push src # Push 'src'
- pop dst # Pop 'dst'
+ push src # Push 'src' [---]
+ pop dst # Pop 'dst' [---]
link # Setup frame
tuck src # Extend frame
drop # Drop frame
diff --git a/lib/tags b/lib/tags
@@ -1,13 +1,13 @@
! (2560 . "@src64/flow.l")
$ (2662 . "@src64/flow.l")
-% (2250 . "@src64/big.l")
-& (2471 . "@src64/big.l")
-* (2069 . "@src64/big.l")
-*/ (2126 . "@src64/big.l")
-+ (1851 . "@src64/big.l")
-- (1889 . "@src64/big.l")
+% (2251 . "@src64/big.l")
+& (2472 . "@src64/big.l")
+* (2070 . "@src64/big.l")
+*/ (2127 . "@src64/big.l")
++ (1852 . "@src64/big.l")
+- (1890 . "@src64/big.l")
-> (3788 . "@src64/subr.l")
-/ (2191 . "@src64/big.l")
+/ (2192 . "@src64/big.l")
: (2896 . "@src64/sym.l")
:: (2920 . "@src64/sym.l")
; (2822 . "@src64/sym.l")
@@ -22,8 +22,8 @@ $ (2662 . "@src64/flow.l")
=T (2166 . "@src64/subr.l")
> (2252 . "@src64/subr.l")
>= (2282 . "@src64/subr.l")
->> (2305 . "@src64/big.l")
-abs (2395 . "@src64/big.l")
+>> (2306 . "@src64/big.l")
+abs (2396 . "@src64/big.l")
accept (139 . "@src64/net.l")
adr (511 . "@src64/main.l")
alarm (455 . "@src64/main.l")
@@ -32,16 +32,16 @@ and (1637 . "@src64/flow.l")
any (3758 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (581 . "@src64/apply.l")
-arg (1873 . "@src64/main.l")
-args (1849 . "@src64/main.l")
-argv (2494 . "@src64/main.l")
+arg (1879 . "@src64/main.l")
+args (1855 . "@src64/main.l")
+argv (2500 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2938 . "@src64/subr.l")
assoc (2903 . "@src64/subr.l")
at (2122 . "@src64/flow.l")
atom (2370 . "@src64/subr.l")
bind (1375 . "@src64/flow.l")
-bit? (2412 . "@src64/big.l")
+bit? (2413 . "@src64/big.l")
bool (1737 . "@src64/flow.l")
box (839 . "@src64/flow.l")
box? (999 . "@src64/sym.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 (2249 . "@src64/main.l")
+cd (2255 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -87,7 +87,7 @@ chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
clip (1784 . "@src64/subr.l")
close (4146 . "@src64/io.l")
-cmd (2476 . "@src64/main.l")
+cmd (2482 . "@src64/main.l")
cnt (1279 . "@src64/apply.l")
commit (1503 . "@src64/db.l")
con (725 . "@src64/subr.l")
@@ -97,19 +97,19 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
ctl (4086 . "@src64/io.l")
-ctty (2274 . "@src64/main.l")
+ctty (2280 . "@src64/main.l")
cut (1795 . "@src64/sym.l")
-date (1988 . "@src64/main.l")
+date (1994 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (551 . "@src64/flow.l")
-dec (2003 . "@src64/big.l")
+dec (2004 . "@src64/big.l")
def (475 . "@src64/flow.l")
default (1659 . "@src64/sym.l")
del (1850 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2561 . "@src64/subr.l")
-dir (2407 . "@src64/main.l")
+dir (2413 . "@src64/main.l")
dm (563 . "@src64/flow.l")
do (2152 . "@src64/flow.l")
e (2623 . "@src64/flow.l")
@@ -119,13 +119,13 @@ eof (3317 . "@src64/io.l")
eol (3308 . "@src64/io.l")
errno (1206 . "@src64/main.l")
eval (208 . "@src64/flow.l")
-ext (4861 . "@src64/io.l")
+ext (4853 . "@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 (2354 . "@src64/main.l")
+file (2360 . "@src64/main.l")
fill (3165 . "@src64/subr.l")
filter (1027 . "@src64/apply.l")
fin (2018 . "@src64/subr.l")
@@ -134,22 +134,22 @@ find (1188 . "@src64/apply.l")
fish (1479 . "@src64/apply.l")
flg? (2417 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
-flush (4836 . "@src64/io.l")
+flush (4828 . "@src64/io.l")
fold (3341 . "@src64/sym.l")
for (2241 . "@src64/flow.l")
fork (2960 . "@src64/flow.l")
-format (1769 . "@src64/big.l")
+format (1770 . "@src64/big.l")
free (2034 . "@src64/db.l")
from (3336 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (378 . "@src64/gc.l")
-ge0 (2371 . "@src64/big.l")
+ge0 (2372 . "@src64/big.l")
get (2748 . "@src64/sym.l")
getd (742 . "@src64/sym.l")
getl (3030 . "@src64/sym.l")
glue (1232 . "@src64/sym.l")
-gt0 (2382 . "@src64/big.l")
+gt0 (2383 . "@src64/big.l")
head (1805 . "@src64/subr.l")
heap (481 . "@src64/main.l")
hear (3058 . "@src64/io.l")
@@ -160,9 +160,9 @@ if (1818 . "@src64/flow.l")
if2 (1837 . "@src64/flow.l")
ifn (1878 . "@src64/flow.l")
in (3982 . "@src64/io.l")
-inc (1936 . "@src64/big.l")
+inc (1937 . "@src64/big.l")
index (2609 . "@src64/subr.l")
-info (2311 . "@src64/main.l")
+info (2317 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (2905 . "@src64/flow.l")
isa (976 . "@src64/flow.l")
@@ -187,7 +187,7 @@ loop (2184 . "@src64/flow.l")
low? (3213 . "@src64/sym.l")
lowc (3243 . "@src64/sym.l")
lst? (2387 . "@src64/subr.l")
-lt0 (2360 . "@src64/big.l")
+lt0 (2361 . "@src64/big.l")
lup (2224 . "@src64/sym.l")
made (1098 . "@src64/subr.l")
make (1079 . "@src64/subr.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 (1856 . "@src64/main.l")
+next (1862 . "@src64/main.l")
nil (1755 . "@src64/flow.l")
nond (1955 . "@src64/flow.l")
nor (1693 . "@src64/flow.l")
@@ -233,7 +233,7 @@ onOff (1611 . "@src64/sym.l")
one (1644 . "@src64/sym.l")
open (4108 . "@src64/io.l")
opid (2921 . "@src64/flow.l")
-opt (2597 . "@src64/main.l")
+opt (2603 . "@src64/main.l")
or (1653 . "@src64/flow.l")
out (4002 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -249,13 +249,13 @@ poll (3120 . "@src64/io.l")
pool (657 . "@src64/db.l")
pop (1771 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (4950 . "@src64/io.l")
+pr (4942 . "@src64/io.l")
pre? (1409 . "@src64/sym.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")
+prin (4752 . "@src64/io.l")
+prinl (4766 . "@src64/io.l")
+print (4792 . "@src64/io.l")
+println (4823 . "@src64/io.l")
+printsp (4808 . "@src64/io.l")
prog (1773 . "@src64/flow.l")
prog1 (1781 . "@src64/flow.l")
prog2 (1798 . "@src64/flow.l")
@@ -266,26 +266,26 @@ push (1686 . "@src64/sym.l")
push1 (1722 . "@src64/sym.l")
put (2696 . "@src64/sym.l")
putl (2948 . "@src64/sym.l")
-pwd (2238 . "@src64/main.l")
+pwd (2244 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
quit (927 . "@src64/main.l")
quote (141 . "@src64/flow.l")
-rand (2639 . "@src64/big.l")
+rand (2640 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2966 . "@src64/subr.l")
raw (433 . "@src64/main.l")
-rd (4878 . "@src64/io.l")
+rd (4870 . "@src64/io.l")
read (2498 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (1902 . "@src64/main.l")
+rest (1908 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
-rewind (4844 . "@src64/io.l")
+rewind (4836 . "@src64/io.l")
rollback (1885 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (4983 . "@src64/io.l")
+rpc (4975 . "@src64/io.l")
run (332 . "@src64/flow.l")
sect (2513 . "@src64/subr.l")
-seed (2624 . "@src64/big.l")
+seed (2625 . "@src64/big.l")
seek (1141 . "@src64/apply.l")
send (1146 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
@@ -295,7 +295,7 @@ size (2750 . "@src64/subr.l")
skip (3294 . "@src64/io.l")
sort (3837 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
-space (4778 . "@src64/io.l")
+space (4770 . "@src64/io.l")
split (1579 . "@src64/subr.l")
state (2022 . "@src64/flow.l")
stem (1974 . "@src64/subr.l")
@@ -316,7 +316,7 @@ text (1270 . "@src64/sym.l")
throw (2504 . "@src64/flow.l")
tick (2873 . "@src64/flow.l")
till (3403 . "@src64/io.l")
-time (2121 . "@src64/main.l")
+time (2127 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1187 . "@src64/flow.l")
@@ -329,19 +329,19 @@ up (610 . "@src64/main.l")
upp? (3228 . "@src64/sym.l")
uppc (3292 . "@src64/sym.l")
use (1586 . "@src64/flow.l")
-usec (2226 . "@src64/main.l")
+usec (2232 . "@src64/main.l")
val (1461 . "@src64/sym.l")
-version (2611 . "@src64/main.l")
+version (2617 . "@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 (4967 . "@src64/io.l")
+wr (4959 . "@src64/io.l")
xchg (1536 . "@src64/sym.l")
xor (1714 . "@src64/flow.l")
-x| (2551 . "@src64/big.l")
+x| (2552 . "@src64/big.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1629 . "@src64/sym.l")
-| (2511 . "@src64/big.l")
+| (2512 . "@src64/big.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 28apr10abu
+/* 12may10abu
* (c) Software Lab. Alexander Burger
*/
@@ -2232,19 +2232,23 @@ void print1(any x) {
else if (isNil(x))
outString("NIL");
else if (isSym(x)) {
- int c, d;
+ int c;
+ any y;
- if (!(c = symByte(name(x))))
+ if (!(c = symByte(y = name(x))))
Env.put('$'), outWord(num(x)/sizeof(cell));
else if (isExt(x))
Env.put('{'), outSym(c), Env.put('}');
- else if (hashed(x, ihash(name(x)), Intern)) {
- do {
- d = symByte(NULL);
- if (strchr(Delim, c) || c == '.' && !d)
- Env.put('\\');
- Env.put(c);
- } while (c = d);
+ else if (hashed(x, ihash(y), Intern)) {
+ if (unDig(y) == '.')
+ Env.put('\\'), Env.put('.');
+ else {
+ do {
+ if (strchr(Delim, c))
+ Env.put('\\');
+ Env.put(c);
+ } while (c = symByte(NULL));
+ }
}
else {
bool tsm = isCell(val(Tsm)) && Env.put == putStdout && OutFile->tty;
@@ -2253,7 +2257,7 @@ void print1(any x) {
Env.put('"');
else {
outName(car(val(Tsm)));
- c = symByte(name(x));
+ c = symByte(y);
}
do {
if (c == '\\' || c == '^' || !tsm && c == '"')
diff --git a/src64/arch/x86-32.l b/src64/arch/x86-32.l
@@ -0,0 +1,1099 @@
+# 11may10abu
+# (c) Software Lab. Alexander Burger
+
+# Byte order
+(on *LittleEndian)
+
+# Register assignments
+(de *Registers
+ (A "HiA" . "%eax") (C "HiC" . "LoC") (E "HiE" . "%ebx")
+ (B . "%al") (D "HiC" "LoC" "HiA" . "%eax")
+ (X "HiX" . "LoX") (Y "HiY" . "LoY") (Z "HiZ" . "LoZ")
+ (L . "%ebp") (S . "%esp")
+ (F . T) )
+# NULL: %edx
+# Temporary + Block operations: %ecx %esi %edi
+
+# Addressing modes
+(de byteReg (Reg)
+ (cdr
+ (assoc Reg
+ (quote
+ (("HiA" . "%eax") . "%al")
+ ("%al" . "%al")
+ (("HiC" . "LoC") . "LoC")
+ (("HiE" . "%ebx") . "%bl")
+ (("%ecx" . "%ecx") . "%cl")
+ (("%edx" . "%edx") . "%dl")
+ (("HiX" . "LoX") . "LoX")
+ (("HiY" . "LoY") . "LoY")
+ (("HiZ" . "LoZ") . "LoZ")
+ ("%ebp" . "%bp")
+ ("%esp" . "%sp") ) ) ) ) # No %spl
+
+(de byteVal (Adr)
+ (or
+ (byteReg Adr) # Register
+ (fin Adr) ) ) # Byte address
+
+(de lowByte (Adr)
+ (or
+ (byteReg Adr) # Register
+ (fin Adr) ) ) # Word address
+
+(de highWord (S)
+ (cond
+ ((= `(char "(") (char S))
+ (pack "8" S) )
+ ((>= `(char "9") (char S) `(char "0"))
+ (pack "8+" S) )
+ (T (pack S "+8")) ) )
+
+(de immed32 (Src)
+ (and
+ (pair Src)
+ (member (car Src) '("%edx" "$0" "$~0"))
+ (setq Src (chop (cdr Src)))
+ (= "$" (pop 'Src))
+ (format
+ (if (= "~" (car Src)) (cdr Src) Src) ) ) )
+
+(de target (Adr F)
+ (if
+ (or
+ (not *FPic)
+ (= `(char ".") (char Adr)) # Local label ".1"
+ (use (@L @N)
+ (and
+ (match '(@L "_" @N) (chop Adr)) # Local jump "foo_22"
+ (= @L (chop *Label))
+ (format @N) ) ) )
+ Adr
+ (ifn F
+ (pack Adr "@plt")
+ (prinst "mov" (pack Adr "@GOTPCREL(%eip)") "%esi")
+ "(%esi)") ) )
+
+(de src (Src S)
+ (cond
+ ((=0 S) # Immediate
+ (setq Src (cdr (chop Src)))
+ (let (F (and (= "~" (car Src)) (pop 'Src)) N (format (chop Src)))
+ (and (lt0 N) (inc 'N `(** 2 64)))
+ (let (Hi (/ N `(** 2 32)) Lo (% N `(** 2 32)))
+ (cons
+ (if (and (=0 Hi) (not F)) "%edx" (pack "$" F Hi))
+ (if (and (=0 Lo) (not F)) "%edx" (pack "$" F Lo)) ) ) ) )
+ ((not S) Src) # Register
+ ((=T S) # Direct
+ (if (and *FPic (not (pre? "(" Src)))
+ (pack Src "@GOTPCREL(%eip)")
+ (cons "%edx" (pack "$" Src)) ) )
+ ((not (car S))
+ (let R (fin (car Src))
+ (ifn (and *FPic (=T (cdr S)))
+ (prog
+ (unless (pre? "%" R)
+ (prinst "mov" R (setq R "%esi")) )
+ (cons
+ (pack (cdr Src) (and (cdr Src) "+") "4(" R ")")
+ (pack (cdr Src) "(" R ")") ) )
+ (prinst "add" (pack (cdr Src) "@GOTPCREL(%eip)") R)
+ (cons "???" (pack "(" R ")")) ) ) )
+ ((=T (car S))
+ (ifn *FPic
+ (let Ofs (and (cdr S) (pack "+" (cdr Src)))
+ (cons (pack (car Src) Ofs "+4") (pack (car Src) Ofs)) )
+ (prinst "mov" (pack (car Src) "@GOTPCREL(%eip)") "%esi")
+ (cons
+ (pack (cdr Src) (and (cdr Src) "+") "4(%esi)")
+ (pack (cdr Src) "(%esi)") ) ) )
+ (T
+ (prinst "mov" (fin (src (car Src) (car S))) "%esi")
+ (ifn (and *FPic (=T (cdr S)))
+ (cons
+ (pack (cdr Src) (and (cdr Src) "+") "4(%esi)")
+ (pack (cdr Src) "(%esi)") )
+ (prinst "add" (pack (cdr Src) "@GOTPCREL(%eip)") "%esi")
+ (cons "4(%esi)" "(%esi)") ) ) ) )
+
+(de lea (Src S Reg)
+ (cond
+ ((not S) (prinst "mov" (fin Src) Reg)) # Register
+ ((=T S) (prinst "mov" (fin (src Src T)) Reg)) # Direct
+ ((not (car S))
+ (cond
+ ((and *FPic (=T (cdr S)))
+ (prinst "add" (pack (cdr Src) "@GOTPCREL(%eip)") (car Src))
+ (prinst "mov" (pack "(" (fin (car Src)) ")") Reg) )
+ ((cdr Src)
+ (let R (fin (car Src))
+ (if (pre? "%" R)
+ (prinst "lea" (pack (cdr Src) "(" R ")") Reg)
+ (prinst "mov" R Reg)
+ (prinst "lea" (pack (cdr Src) "(" Reg ")") Reg) ) ) )
+ (T (prinst "mov" (fin (car Src)) Reg)) ) )
+ ((=T (car S))
+ (ifn *FPic
+ (prinst "lea"
+ (if (cdr S)
+ (pack (car Src) "+" (cdr Src))
+ (car Src) )
+ Reg )
+ (prinst "mov" (pack (car Src) "@GOTPCREL(%eip)") Reg)
+ (prinst "lea" (pack (cdr Src) "(%esi)") Reg) ) )
+ (T
+ (if (cdr S)
+ (prinst "lea" (fin (src Src S)) Reg)
+ (prinst "mov" (fin (src (car Src) (car S))) Reg) ) ) ) )
+
+(de dst (Dst D)
+ (cond
+ ((not D) Dst) # Register
+ ((not (car D))
+ (let R (fin (car Dst))
+ (ifn (and *FPic (=T (cdr D)))
+ (prog
+ (unless (pre? "%" R)
+ (prinst "mov" R (setq R "%edi")) )
+ (cons
+ (pack (cdr Dst) (and (cdr Dst) "+") "4(" R ")")
+ (pack (cdr Dst) "(" R ")") ) )
+ (prinst "add" (pack (cdr Dst) "@GOTPCREL(%eip)") R)
+ (cons "???" (pack "(" R ")")) ) ) )
+ ((=T (car D))
+ (ifn *FPic
+ (let Ofs (and (cdr D) (pack "+" (cdr Dst)))
+ (cons (pack (car Dst) Ofs "+4") (pack (car Dst) Ofs)) )
+ (prinst "mov" (pack (car Dst) "@GOTPCREL(%eip)") "%edi")
+ (cons
+ (pack (cdr Dst) (and (cdr Dst) "+") "4(%edi)")
+ (pack (cdr Dst) "(%edi)") ) ) )
+ (T
+ (prinst "mov" (fin (dst (car Dst) (car D))) "%edi")
+ (ifn (and *FPic (=T (cdr D)))
+ (cons
+ (pack (cdr Dst) (and (cdr Dst) "+") "4(%edi)")
+ (pack (cdr Dst) "(%edi)") )
+ (prinst "add" (pack (cdr Dst) "@GOTPCREL(%eip)") "%edi")
+ (cons "4(%edi)" "(%edi)") ) ) ) )
+
+(de dstSrcByte (Cmd Dst Src)
+ (cond
+ ((>= 255 (immed32 Src) 0)
+ (prinst
+ (pack Cmd (unless (= "%esp" Dst) "b"))
+ (fin Src)
+ (lowByte Dst) ) )
+ ((= "%al" Dst)
+ (prinst Cmd (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst Cmd "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst Cmd (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst Cmd Src (fin Dst)) )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst (pack Cmd "l") (cdr Src) (cdr Dst))
+ (prinst Cmd (cdr Src) "%ecx")
+ (prinst Cmd "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst (pack Cmd "l") (car Src) (car Dst))
+ (prinst Cmd (car Src) "%ecx")
+ (prinst Cmd "%ecx" (car Dst)) ) ) ) )
+
+(de dstShift (Cmd Cmd2 Dst Src)
+ (if (= "%al" Dst)
+ (if (pre? "$" (fin Src))
+ (prinst Cmd (fin Src) "%al")
+ (prinst "mov" (byteVal Src) "%cl")
+ (prinst Cmd "%cl" "%al") )
+ (when (= "r" (last (chop Cmd)))
+ (setq Dst (cons (cdr Dst) (car Dst))) )
+ (unless (pre? "%" (cdr Dst))
+ (setq Cmd (pack Cmd "l")) )
+ (unless (pre? "%" (car Dst))
+ (setq Cmd2 (pack Cmd2 "l")) )
+ (if (>= 8 (immed32 Src) 1)
+ (do (immed32 Src)
+ (prinst Cmd "$1" (cdr Dst))
+ (prinst Cmd2 "$1" (car Dst)) )
+ (ifn (= "%al" (fin Src))
+ (prinst "mov" (fin Src) "%ecx")
+ (prinst "mov" "%dx" "%cx")
+ (prinst "mov" "%al" "%cl") )
+ (prinl "1:")
+ (prinst Cmd "$1" (cdr Dst))
+ (prinst Cmd2 "$1" (car Dst))
+ (prinst "loop" "1b") ) ) )
+
+
+### Instruction set ###
+(asm nop ()
+ (prinst "nop") )
+
+# Move data
+(asm ld (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst) # B
+ (prinst "mov" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "mov" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "mov" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "movl" Src (fin Dst))
+ (prinst "mov" "%edx" (car Dst)) )
+ ((pair (cdr Dst)) # D
+ (prinst "mov" (cdr Src) "%eax")
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)))
+ (prinst "movl" (car Src) "HiA")
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "mov" "%ecx" "HiA") )
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)))
+ (prinst "movl" (highWord (cdr Src)) "LoC")
+ (prinst "mov" (highWord (cdr Src)) "%ecx")
+ (prinst "mov" "%ecx" "LoC") )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)))
+ (prinst "movl" (highWord (car Src)) "HiC")
+ (prinst "mov" (highWord (car Src)) "%ecx")
+ (prinst "mov" "%ecx" "HiC") ) )
+ ((pair (cdr Src)) # D
+ (prinst "mov" "%eax" (cdr Dst))
+ (if (or (pre? "$" (car Dst)) (pre? "%" (car Dst)))
+ (prinst "movl" "HiA" (car Dst))
+ (prinst "mov" "HiA" "%ecx")
+ (prinst "mov" "%ecx" (car Dst)) )
+ (if (or (pre? "$" (cdr Dst)) (pre? "%" (cdr Dst)))
+ (prinst "movl" "LoC" (highWord (cdr Dst)))
+ (prinst "mov" "LoC" "%ecx")
+ (prinst "mov" "%ecx" (highWord (cdr Dst))) )
+ (if (or (pre? "$" (car Dst)) (pre? "%" (car Dst)))
+ (prinst "movl" "HiC" (highWord (car Dst)))
+ (prinst "mov" "HiC" "%ecx")
+ (prinst "mov" "%ecx" (highWord (car Dst))) ) )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "movl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "mov" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "movl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "mov" "%ecx" (car Dst)) ) ) ) )
+
+(asm ld2 (Src S)
+ (prinst "movzwl" (fin (src Src S)) "%eax")
+ (prinst "mov" "%edx" "HiA") )
+
+(asm ld4 (Src S)
+ (prinst "mov" (fin (src Src S)) "%eax")
+ (prinst "mov" "%edx" "HiA") )
+
+(de _cmov (Cmd Jmp)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (if (atom Dst)
+ (prinst Cmd (fin Src) Dst)
+ (prinst Jmp "1f")
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "movl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "mov" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "movl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "mov" "%ecx" (car Dst)) )
+ (prinl "1:") ) )
+
+(asm ldc (Dst D Src S)
+ (_cmov "cmovcl" "jnc") )
+
+(asm ldnc (Dst D Src S)
+ (_cmov "cmovncl" "jc") )
+
+(asm ldz (Dst D Src S)
+ (_cmov "cmovzl" "jnz") )
+
+(asm ldnz (Dst D Src S)
+ (_cmov "cmovnzl" "jz") )
+
+(asm lea (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((atom Dst)
+ (prinst "lea" (fin Src) Dst) )
+ ((pre? "%" (cdr Dst))
+ (prinst "lea" (cdr Src) (cdr Dst)) )
+ (T
+ (prinst "lea" (cdr Src) "%esi")
+ (prinst "mov" "%esi" (cdr Dst)) ) ) )
+
+(asm st2 (Dst D)
+ (prinst "mov" "%ax" (fin (dst Dst D))) )
+
+(asm st4 (Dst D)
+ (prinst "mov" "%eax" (fin (dst Dst D))) )
+
+(asm xchg (Dst D Dst2 D2)
+ (setq Dst (dst Dst D) Dst2 (src Dst2 D2))
+ (cond
+ ((= "%al" Dst)
+ (prinst "xchg" (byteVal Dst2) "%al") )
+ ((= "%al" Dst2)
+ (prinst "xchg" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "xchg" (fin Dst2) Dst) )
+ ((atom Dst2) # S or L
+ (prinst "xchg" Dst2 (fin Dst)) )
+ (T
+ (if (or (pre? "%" (cdr Dst)) (pre? "%" (cdr Dst2)))
+ (prinst "xchg" (cdr Dst) (cdr Dst2))
+ (prinst "mov" (cdr Dst) "%ecx")
+ (prinst "xchg" "%ecx" (cdr Dst2))
+ (prinst "mov" "%ecx" (cdr Dst)) )
+ (if (or (pre? "%" (car Dst)) (pre? "%" (car Dst2)))
+ (prinst "xchg" (car Dst) (car Dst2))
+ (prinst "mov" (car Dst) "%ecx")
+ (prinst "xchg" "%ecx" (car Dst2))
+ (prinst "mov" "%ecx" (car Dst)) ) ) ) )
+
+(asm movm (Dst D Src S End E)
+ (setq Dst (dst Dst D))
+ (unless (= "(%edi)" (fin Dst))
+ (prinst (if (pre? "%" (fin Dst)) "mov" "lea") (fin Dst) "%edi") )
+ (lea End E "%ecx")
+ (lea Src S "%esi")
+ (prinst "sub" "%esi" "%ecx")
+ (prinst "cld")
+ (prinst "rep movsb") )
+
+(asm movn (Dst D Src S Cnt C)
+ (lea Dst D "%edi")
+ (lea Src S "%esi")
+ (prinst "mov" (fin (src Cnt C)) "%ecx")
+ (prinst "cld")
+ (prinst "rep movsb") )
+
+(asm mset (Dst D Cnt C)
+ (setq Dst (dst Dst D))
+ (unless (= "(%edi)" (fin Dst))
+ (prinst (if (pre? "%" (fin Dst)) "mov" "lea") (fin Dst) "%edi") )
+ (prinst "mov" (fin (src Cnt C)) "%ecx")
+ (prinst "cld")
+ (prinst "rep stosb") )
+
+
+# Arithmetics
+(asm add (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "add" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "add" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "add" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "addl" Src (fin Dst)) )
+ ((pair (cdr Dst)) # D
+ (prinst "add" (cdr Src) "%eax")
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)))
+ (prinst "adcl" (car Src) "HiA")
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "adc" "%ecx" "HiA") )
+ (prinst "adc" "%edx" "LoC")
+ (prinst "adc" "%edx" "HiC") )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "addl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "add" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "adcl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "adc" "%ecx" (car Dst)) ) ) ) )
+
+(asm addc (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "adc" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "adc" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "adc" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "addl" Src (fin Dst)) )
+ ((pair (cdr Dst)) # D
+ (prinst "adc" (cdr Src) "%eax")
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)))
+ (prinst "adcl" (car Src) "HiA")
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "adc" "%ecx" "HiA") )
+ (prinst "adc" "%edx" "LoC")
+ (prinst "adc" "%edx" "HiC") )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "adcl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "adc" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "adcl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "adc" "%ecx" (car Dst)) ) ) ) )
+
+(asm sub (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "sub" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "sub" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "sub" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "subl" Src (fin Dst)) )
+ ((pair (cdr Dst)) # D
+ (prinst "sub" (cdr Src) "%eax")
+ (prinst "sbbl" (car Src) "HiA")
+ (prinst "sbb" "%edx" "LoC")
+ (prinst "sbb" "%edx" "HiC") )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "subl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "sub" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "sbbl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "sbb" "%ecx" (car Dst)) ) ) ) )
+
+(asm subc (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "sbb" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "sbb" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "sbb" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "sbbl" Src (fin Dst)) )
+ ((pair (cdr Dst)) # D
+ (prinst "sbb" (cdr Src) "%eax")
+ (prinst "sbbl" (car Src) "HiA")
+ (prinst "sbb" "%edx" "LoC")
+ (prinst "sbb" "%edx" "HiC") )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "sbbl" (cdr Src) (cdr Dst))
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "sbb" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "sbbl" (car Src) (car Dst))
+ (prinst "mov" (car Src) "%ecx")
+ (prinst "sbb" "%ecx" (car Dst)) ) ) ) )
+
+(asm not (Dst D)
+ (setq Dst (dst Dst D))
+ (if (atom Dst) # B
+ (prinst "not" Dst)
+ (prinst "notl" (cdr Dst))
+ (prinst "notl" (car Dst)) ) )
+
+(asm neg (Dst D)
+ (setq Dst (dst Dst D))
+ (if (atom Dst) # B
+ (prinst "neg" Dst)
+ (prinst "negl" (cdr Dst))
+ (prinst "adcl" "%edx" (car Dst))
+ (prinst "negl" (car Dst)) ) )
+
+(asm and (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "and" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "and" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "and" (fin Src) Dst) )
+ (T
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)) (pre? "%" (cdr Dst)))
+ (prinst "andl" (cdr Src) (cdr Dst))
+ (prinst "and" (cdr Src) "%ecx")
+ (prinst "and" "%ecx" (cdr Dst)) )
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)) (pre? "%" (car Dst)))
+ (prinst "andl" (car Src) (car Dst))
+ (prinst "and" (car Src) "%ecx")
+ (prinst "and" "%ecx" (car Dst)) ) ) ) )
+
+(asm or (Dst D Src S)
+ (dstSrcByte "or" (dst Dst D) (src Src S)) )
+
+(asm xor (Dst D Src S)
+ (dstSrcByte "xor" (dst Dst D) (src Src S)) )
+
+(asm off (Dst D Src S)
+ (dstSrcByte "and" (dst Dst D) (src Src S)) )
+
+(asm test (Dst D Src S)
+ (dstSrcByte "test" (dst Dst D) (src Src S)) )
+
+(asm shl (Dst D Src S)
+ (dstShift "shl" "rcl" (dst Dst D) (src Src S)) )
+
+(asm shr (Dst D Src S)
+ (dstShift "shr" "rcr" (dst Dst D) (src Src S)) )
+
+(asm rol (Dst D Src S)
+ (dstShift "rol" "rcl" (dst Dst D) (src Src S)) )
+
+(asm ror (Dst D Src S)
+ (dstShift "ror" "rcr" (dst Dst D) (src Src S)) )
+
+(asm rcl (Dst D Src S)
+ (dstShift "rcl" "rcl" (dst Dst D) (src Src S)) )
+
+(asm rcr (Dst D Src S)
+ (dstShift "rcr" "rcr" (dst Dst D) (src Src S)) )
+
+(asm mul (Src S)
+ (setq Src (src Src S))
+ (prinst "push" "%ebx")
+ (prinst "mov" "HiA" "%ebx") # MADA
+ (prinst "mov" (car Src) "%edx")
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "imul" "%eax" "%ecx")
+ (prinst "imul" "%edx" "%ebx")
+ (prinst "mul" "%edx")
+ (prinst "add" "%ebx" "%ecx")
+ (prinst "lea" "(%ecx,%edx)" "%edx")
+ (prinst "xor" "%edx" "%edx")
+ (prinst "pop" "%ebx") )
+
+(asm div (Src S)
+ (setq Src (fin (src Src S))) # MADA
+ (prinst "mov" Src (setq Src "%ecx"))
+ (prinst "divl" Src) )
+
+(asm zxt () # 8 bit -> 64 bit
+ (prinst "movzx" "%al" "%eax")
+ (prinst "mov" "%edx" "HiA") )
+
+(asm setc ()
+ (prinst "stc") )
+
+(asm clrc ()
+ (prinst "clc") )
+
+(asm setz ()
+ (prinst "or" "%edx" "%edx") )
+
+(asm clrz ()
+ (prinst "cmp" "%esp" "%edx") )
+
+
+# Comparisons
+(asm cmp (Dst D Src S)
+ (setq Dst (dst Dst D) Src (src Src S))
+ (cond
+ ((= "%al" Dst)
+ (prinst "cmp" (byteVal Src) "%al") )
+ ((= "%al" Src)
+ (prinst "cmp" "%al" (byteVal Dst)) )
+ ((atom Dst) # S or L
+ (prinst "cmp" (fin Src) Dst) )
+ ((atom Src) # Direct, S or L
+ (prinst "cmpl" Src (fin Dst)) )
+ (T
+ (prinst "mov" (cdr Src) "%ecx")
+ (prinst "sub" (cdr Dst) "%ecx")
+ (prinst "mov" (car Src) "%esi")
+ (prinst "sbb" (car Dst) "%esi")
+ (prinst "jnz" "1f")
+ (prinst "or" "%esi" "%ecx")
+ (prinl "1:") ) ) )
+
+
+(asm cmp4 (Src S)
+ (prinst "cmp" (fin (src Src S)) "%eax") )
+
+(asm cmpm (Dst D Src S End E)
+ (setq Dst (dst Dst D))
+ (unless (= "(%edi)" (fin Dst))
+ (prinst (if (pre? "%" (fin Dst)) "mov" "lea") (fin Dst) "%esi") )
+ (lea End E "%ecx")
+ (lea Src S "%edi")
+ (prinst "sub" "%esi" "%ecx")
+ (prinst "cld")
+ (prinst "repnz cmpsb") )
+
+(asm cmpn (Dst D Src S Cnt C)
+ (setq Dst (dst Dst D))
+ (unless (= "(%edi)" (fin Dst))
+ (prinst (if (pre? "%" (fin Dst)) "mov" "lea") (fin Dst) "%esi") )
+ (lea Src S "%edi")
+ (prinst "mov" (fin (src Cnt C)) "%ecx")
+ (prinst "cld")
+ (prinst "repnz cmpsb") )
+
+(asm slen (Dst D Src S)
+ (setq Dst (dst Dst D))
+ (prinst "cld")
+ (prinst "xor" "%ecx" "%ecx")
+ (prinst "not" "%ecx") # Infinite
+ (lea Src S "%edi")
+ (prinst "xchg" "%al" "%dl") # Save B
+ (prinst "repnz scasb")
+ (prinst "xchg" "%al" "%dl") # Restore B
+ (prinst "not" "%ecx")
+ (prinst "dec" "%ecx")
+ (prinst "mov" "%ecx" (fin Dst)) )
+
+(asm memb (Src S Cnt C)
+ (prinst "cld")
+ (lea Src S "%edi")
+ (setq Cnt (src Cnt C))
+ (prinst "mov" (fin Cnt) "%ecx")
+ (prinst "repnz scasb")
+ (unless (and S C)
+ (prinst "jnz" "1f")
+ (unless S
+ (prinst "mov" "%edi" (cdr Src)) )
+ (unless C
+ (prinst "mov" "%edx" (car Cnt))
+ (prinst "mov" "%ecx" (cdr Cnt)) )
+ (prinl "1:") ) )
+
+(asm null (Src S)
+ (setq Src (src Src S))
+ (prinst "cmp" "%edx" (car Src))
+ (prinst "jnz" "1f")
+ (prinst "cmp" "%edx" (cdr Src))
+ (prinst "jz" "1f")
+ (prinst "mov" "$1" "%cl") # nz, s
+ (prinst "or" "%cl" "%cl")
+ (prinl "1:") )
+
+(asm zero (Src S)
+ (setq Src (src Src S))
+ (prinst "cmp" "%edx" (car Src))
+ (prinst "jnz" "1f")
+ (prinst "cmpl" "$2" (cdr Src))
+ (prinl "1:") )
+
+(asm nul4 ()
+ (prinst "cmp" "%edx" "%eax") )
+
+
+# Byte addressing
+(asm set (Dst D Src S)
+ (setq Dst (lowByte (dst Dst D)) Src (fin (src Src S)))
+ (cond
+ ((= "%edx" Src)
+ (prinst "mov" "%dl" Dst) )
+ ((or (pre? "$" Src) (pre? "%" Src) (pre? "%" Dst))
+ (prinst "movb" Src Dst) )
+ (T
+ (prinst "mov" Src "%cl")
+ (prinst "mov" "%cl" Dst) ) ) )
+
+(asm nul (Src S)
+ (prinst "cmp" "%dl" (fin (src Src S))) )
+
+
+# Types
+(asm cnt (Src S)
+ (prinst
+ (if (= "%esp" Src) "test" "testb")
+ "$0x02"
+ (lowByte (src Src S)) ) )
+
+(asm big (Src S)
+ (prinst
+ (if (= "%esp" Src) "test" "testb")
+ "$0x04"
+ (lowByte (src Src S)) ) )
+
+(asm num (Src S)
+ (prinst
+ (if (= "%esp" Src) "test" "testb")
+ "$0x06"
+ (lowByte (src Src S)) ) )
+
+(asm sym (Src S)
+ (prinst
+ (if (= "%esp" Src) "test" "testb")
+ "$0x08"
+ (lowByte (src Src S)) ) )
+
+(asm atom (Src S)
+ (prinst
+ (if (= "%esp" Src) "test" "testb")
+ "$0x0E"
+ (lowByte (src Src S)) ) )
+
+
+# Flow Control
+(asm call (Adr A)
+ (nond
+ (A (prinst "call" (target Adr)))
+ ((=T A) (prinst "call" (pack "*" (cdr Adr))))
+ (NIL
+ (prinst "mov" (target Adr T) "%ecx")
+ (prinst "call" "*%ecx") ) ) )
+
+(asm jmp (Adr A)
+ (nond
+ (A (prinst "jmp" (target Adr)))
+ ((=T A) (prinst "jmp" (pack "*" (cdr Adr))))
+ (NIL
+ (prinst "mov" (target Adr T) "%ecx")
+ (prinst "jmp" "*%ecx") ) ) )
+
+(de _jmp (Opc Opc2)
+ (ifn A
+ (prinst Opc (target Adr))
+ (prinst Opc2 "1f")
+ (ifn (=T A)
+ (prinst "jmp" (pack "*" (cdr Adr)))
+ (prinst "mov" (target Adr T) "%ecx")
+ (prinst "jmp" "*%ecx") )
+ (prinl "1:") ) )
+
+(asm jz (Adr A)
+ (_jmp "jz" "jnz") )
+
+(asm jeq (Adr A)
+ (_jmp "jz" "jnz") )
+
+(asm jnz (Adr A)
+ (_jmp "jnz" "jz") )
+
+(asm jne (Adr A)
+ (_jmp "jnz" "jz") )
+
+(asm js (Adr A)
+ (_jmp "js" "jns") )
+
+(asm jns (Adr A)
+ (_jmp "jns" "js") )
+
+(asm jsz (Adr A)
+ (_jmp "jle" "jg") )
+
+(asm jnsz (Adr A)
+ (_jmp "jg" "jle") )
+
+(asm jc (Adr A)
+ (_jmp "jc" "jnc") )
+
+(asm jlt (Adr A)
+ (_jmp "jc" "jnc") )
+
+(asm jnc (Adr A)
+ (_jmp "jnc" "jc") )
+
+(asm jge (Adr A)
+ (_jmp "jnc" "jc") )
+
+(asm jcz (Adr A)
+ (_jmp "jbe" "ja") )
+
+(asm jle (Adr A)
+ (_jmp "jbe" "ja") )
+
+(asm jncz (Adr A)
+ (_jmp "ja" "jbe") )
+
+(asm jgt (Adr A)
+ (_jmp "ja" "jbe") )
+
+(asm cc (Adr A Arg M)
+ (if (lst? Arg)
+ (let Lea NIL
+ (prinst "mov" "%esp" "%edx")
+ (mapc
+ '((Src S)
+ (if (== '& Src)
+ (on Lea)
+ (cond
+ (Lea (lea Src S "%ecx"))
+ ((== 'pop Src) (prinst "pop" "%ecx"))
+ (T (prinst "mov" (fin (src Src S)) "%ecx")) )
+ (prinst "xchg" "%esp" "%edx")
+ (prinst "push" "%ecx")
+ (prinst "xchg" "%esp" "%edx")
+ (off Lea) ) )
+ Arg
+ M ) )
+ (prinl "1:")
+ (prinst "cmp" "%esp" Arg)
+ (prinst "jz" "2f")
+ (prinst "pop" "%ecx")
+ (prinst "xchg" "%esp" "%edx")
+ (prinst "push" "%ecx")
+ (prinst "xchg" "%esp" "%edx")
+ (prinl "2:") )
+ (prinst "xchg" "%esp" "%edi")
+ ((get 'call 'asm) Adr A)
+ (prinst "xchg" "%esp" "%edi")
+ (unless (lst? Arg)
+ (prinst "mov" Arg "%esp") ) )
+
+(asm ret ()
+ (prinst "ret") )
+
+(asm begin (N)
+ (prinst "push" "%ebx")
+ (prinst "push" "%esi")
+ (prinst "push" "%edi")
+ (prinst "xor" "%edx" "%edx") # NULL register
+ (when (>= N 6) # Z
+ (prinst "pushl" "HiZ")
+ (prinst "pushl" "LoZ")
+ (prinst "movl" "24(%esp)" "%ecx")
+ (prinst "movl" "%ecx" "LoZ") )
+ (when (>= N 5) # Y
+ (prinst "pushl" "HiY")
+ (prinst "pushl" "LoY")
+ (prinst "movl" "20(%esp)" "%ecx")
+ (prinst "movl" "%ecx" "LoY") )
+ (when (>= N 4) # X
+ (prinst "pushl" "HiX")
+ (prinst "pushl" "LoX")
+ (prinst "movl" "16(%esp)" "%ecx")
+ (prinst "movl" "%ecx" "LoX") )
+ (when (>= N 3) # E
+ (prinst "movl" "12(%esp)" "%ebx") )
+ (when (>= N 2) # C
+ (prinst "movl" "8(%esp)" "%ecx")
+ (prinst "movl" "%ecx" "LoC") )
+ (when (>= N 1) # A
+ (prinst "movl" "4(%esp)" "%eax") ) )
+
+(asm return (N)
+ (when (>= N 4)
+ (prinst "popl" "LoX")
+ (prinst "popl" "HiX") )
+ (when (>= N 5)
+ (prinst "popl" "LoY")
+ (prinst "popl" "HiY") )
+ (when (>= N 6)
+ (prinst "popl" "LoZ")
+ (prinst "popl" "HiZ") )
+ (prinst "pop" "%edi")
+ (prinst "pop" "%esi")
+ (prinst "pop" "%ebx")
+ (prinst "ret") )
+
+
+# Stack Manipulations
+(asm push (Src S)
+ (setq Src (src Src S))
+ (cond
+ ((=T Src)
+ (prinst "push" "%edx")
+ (prinst "pushf") )
+ ((atom Src) # S or L
+ (prinst "push" "%edx")
+ (prinst "push" Src) )
+ (T
+ (prinst (if (pre? "%" (car Src)) "push" "pushl") (car Src))
+ (prinst (if (pre? "%" (cdr Src)) "push" "pushl") (cdr Src)) ) ) )
+
+(asm pop (Dst D)
+ (setq Dst (dst Dst D))
+ (cond
+ ((=T Dst)
+ (prinst "popf")
+ (prinst "pop" "%edi") )
+ ((atom Dst) # S or L
+ (prinst "pop" Dst)
+ (prinst "pop" "%edi") )
+ (T
+ (prinst (if (pre? "%" (cdr Dst)) "pop" "popl") (cdr Dst))
+ (prinst (if (pre? "%" (car Dst)) "pop" "popl") (car Dst)) ) ) )
+
+(asm link ()
+ (prinst "push" "%edx")
+ (prinst "push" "%ebp")
+ (prinst "mov" "%esp" "%ebp") )
+
+(asm tuck (Src S)
+ (setq Src (src Src S))
+ (prinst "mov" "(%esp)" "%ebp")
+ (if (or (pre? "$" (car Src)) (pre? "%" (car Src)))
+ (prinst "movl" (car Src) "4(%esp)")
+ (prinst "mov" (car Src) "%esi")
+ (prinst "mov" "%esi" "4(%esp)") )
+ (if (or (pre? "$" (cdr Src)) (pre? "%" (cdr Src)))
+ (prinst "movl" (cdr Src) "(%esp)")
+ (prinst "mov" (cdr Src) "%esi")
+ (prinst "mov" "%esi" "(%esp)") ) )
+
+(asm drop ()
+ (prinst "mov" "(%ebp)" "%esp")
+ (prinst "pop" "%ebp")
+ (prinst "pop" "%edi") )
+
+# Evaluation
+(asm eval ()
+ (prinst "test" "$0x06" "%bl") # Number?
+ (prinst "jnz" "2f") # Yes: Skip
+ (prinst "test" "$0x08" "%bl") # Symbol?
+ (prinst "jz" "1f")
+ (prinst "mov" "4(%ebx)" "%ecx") # Yes: Get value
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov" "(%ebx)" "%ebx")
+ (prinst "jmp" "2f") # and skip
+ (prinl "1:")
+ (prinst "call" (target 'evListE_E)) # Else evaluate list
+ (prinl "2:") )
+
+(asm eval+ ()
+ (prinst "test" "$0x06" "%bl") # Number?
+ (prinst "jnz" "2f") # Yes: Skip
+ (prinst "test" "$0x08" "%bl") # Symbol?
+ (prinst "jz" "1f")
+ (prinst "mov" "4(%ebx)" "%ecx") # Yes: Get value
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov" "(%ebx)" "%ebx")
+ (prinst "jmp" "2f") # and skip
+ (prinst "push" "%edx") # Else 'link'
+ (prinst "push" "%ebp")
+ (prinst "mov" "%esp" "%ebp")
+ (prinl "1:")
+ (prinst "call" (target 'evListE_E)) # Evaluate list
+ (prinst "pop" "%ebp")
+ (prinst "pop" "%edi")
+ (prinl "2:") )
+
+(asm eval/ret ()
+ (prinst "test" "$0x06" "%bl") # Number?
+ (prinst "jnz" "ret") # Yes: Return
+ (prinst "test" "$0x08" "%bl") # Symbol?
+ (prinst "jz" 'evListE_E) # No: Evaluate list
+ (prinst "mov" "4(%ebx)" "%ecx") # Get value
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov" "(%ebx)" "%ebx")
+ (prinst "ret") )
+
+(asm exec (Reg)
+ (prinl "1:") # do
+ (prinst "mov" (cdr Reg) "%esi") # ld E (R)
+ (prinst "mov"
+ (pack "4(%esi)")
+ "%ecx" )
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov"
+ (pack "(%esi)")
+ "%ebx" )
+ (prinst "mov" # ld R (R CDR)
+ (pack "8(%esi)")
+ "%esi" )
+ (prinst "mov" "%esi" (cdr Reg))
+ (prinst "test" "$0x0E" "%bl") # atom E
+ (prinst "jnz" "2f")
+ (prinst "call" (target 'evListE_E)) # evList
+ (prinl "2:")
+ (prinst "testb" # atom R
+ "$0x0E"
+ (byteReg Reg) )
+ (prinst "jz" "1b") ) # until nz
+
+(asm prog (Reg)
+ (prinl "1:") # do
+ (prinst "mov" (cdr Reg) "%esi") # ld E (R)
+ (prinst "mov"
+ (pack "4(%esi)")
+ "%ecx" )
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov"
+ (pack "(%esi)")
+ "%ebx" )
+ (prinst "mov" # ld R (R CDR)
+ (pack "8(%esi)")
+ "%esi" )
+ (prinst "mov" "%esi" (cdr Reg))
+ (prinst "test" "$0x06" "%bl") # eval
+ (prinst "jnz" "3f")
+ (prinst "test" "$0x08" "%bl")
+ (prinst "jz" "2f")
+ (prinst "mov" "4(%ebx)" "%ecx")
+ (prinst "mov" "%ecx" "HiE")
+ (prinst "mov" "(%ebx)" "%ebx")
+ (prinst "jmp" "3f")
+ (prinl "2:")
+ (prinst "call" (target 'evListE_E))
+ (prinl "3:")
+ (prinst "testb" # atom R
+ "$0x0E"
+ (byteReg Reg) )
+ (prinst "jz" "1b") ) # until nz
+
+
+# System
+(asm initData ()
+ (prinl " .globl HiA")
+ (prinl "HiA: .long 0")
+ (prinl " .globl LoC")
+ (prinl "LoC: .long 0")
+ (prinl " .globl HiC")
+ (prinl "HiC: .long 0")
+ (prinl " .globl HiE")
+ (prinl "HiE: .long 0")
+ (prinl " .globl LoX")
+ (prinl "LoX: .long 0")
+ (prinl " .globl HiX")
+ (prinl "HiX: .long 0")
+ (prinl " .globl LoY")
+ (prinl "LoY: .long 0")
+ (prinl " .globl HiY")
+ (prinl "HiY: .long 0")
+ (prinl " .globl LoZ")
+ (prinl "LoZ: .long 0")
+ (prinl " .globl HiZ")
+ (prinl "HiZ: .long 0") )
+
+(asm initCode ()
+ (prinst "xor" "%edx" "%edx") # Init NULL register
+ (prinst "mov" "8(%esp)" "%esi") # Get second argument
+ (prinst "mov" "(%esi)" "%eax") # Get command
+ (ifn *FPic
+ (prinst "mov" "%eax" "AV0")
+ (prinst "mov" "AV0@GOTPCREL(%eip)" "%edi")
+ (prinst "mov" "%eax" "(%edi)") )
+ (prinst "lea" "4(%esi)" "%esi") # Get argument vector
+ (ifn *FPic
+ (prinst "mov" "%esi" "AV")
+ (prinst "mov" "AV@GOTPCREL(%eip)" "%edi")
+ (prinst "mov" "%esi" "(%edi)") ) )
+
+
+### Optimizer ###
+# Replace the the next 'cnt' elements with 'lst'
+(de optimize (L)) #> (cnt . lst)
+
+### Patch "src64/lib/asm.l" ###
+(patch (get 'word 'asm) '(prinst ".quad" N)
+ '(if (num? N)
+ (prinst ".quad" N)
+ (prinst ".long" N)
+ (prinst ".long" 0) ) )
+
+(patch (get 'initSym 'asm) '(prinst ".quad" Val)
+ '(if (num? Val)
+ (prinst ".quad" Val)
+ (prinst ".long" Val)
+ (prinst ".long" 0) ) )
+
+(patch (get 'initSym 'asm) '(prinst ".quad" ".+20")
+ '(prog
+ (prinst ".long" Val)
+ (prinst ".long" 0) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 05may10abu
+# 11may10abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -122,7 +122,10 @@
Reg )
(prinst "mov" (pack (car Src) "@GOTPCREL(%rip)") Reg)
(prinst "lea" (pack (cdr Src) "(%r10)") Reg) ) )
- (T (prinst "mov" (src (car Src) (car S)) Reg)) ) )
+ (T
+ (if (cdr S)
+ (prinst "lea" (src Src S) Reg)
+ (prinst "mov" (src (car Src) (car S)) Reg) ) ) ) )
(de dst (Dst D)
(cond
@@ -164,12 +167,9 @@
(prinst Cmd "%r10" Dst) ) ) )
(de dstSrcByte (Cmd Dst Src)
- (cond
- ((= "%r12" Src)
- (prinst Cmd "%r12b" (lowByte Dst)) )
- ((and (immediate Src) (>= 255 @ 0))
- (prinst (pack Cmd "b") Src (lowByte Dst)) )
- (T (dstSrc Cmd Dst Src)) ) )
+ (if (>= 255 (immediate Src) 0)
+ (prinst (pack Cmd "b") Src (lowByte Dst))
+ (dstSrc Cmd Dst Src) ) )
(de dstDst (Cmd Dst Dst2)
(cond
@@ -233,7 +233,7 @@
(warn "Using suboptimal emulation code")
(prinst Jmp "1f")
(if (pre? "%" Src)
- (prinst "movq" Src Dst)
+ (prinst "mov" Src Dst)
(prinst "mov" Src "%r10")
(prinst "mov" "%r10" Dst) )
(prinl "1:") ) )
@@ -254,14 +254,14 @@
(setq Dst (dst Dst D) Src (src Src S))
(if (pre? "%" Dst)
(prinst "lea" Src Dst)
- (prinst "lea" Src "%r11")
- (prinst "mov" "%r11" Dst) ) )
+ (prinst "lea" Src "%r10")
+ (prinst "mov" "%r10" Dst) ) )
(asm st2 (Dst D)
- (prinst "movw" "%ax" (dst Dst D)) )
+ (prinst "mov" "%ax" (dst Dst D)) )
(asm st4 (Dst D)
- (prinst "movl" "%eax" (dst Dst D)) )
+ (prinst "mov" "%eax" (dst Dst D)) )
(asm xchg (Dst D Dst2 D2)
(dstDst "xchg" (dst Dst D) (src Dst2 D2)) )
@@ -270,7 +270,7 @@
(setq Dst (dst Dst D))
(prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rdi")
(lea Src S "%rsi")
- (prinst "lea" (src End E) "%rcx")
+ (lea End E "%rcx")
(prinst "sub" "%rsi" "%rcx")
(prinst "cld")
(prinst "rep movsb") )
@@ -283,6 +283,7 @@
(prinst "rep movsb") )
(asm mset (Dst D Cnt C)
+ (setq Dst (dst Dst D))
(prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rdi")
(prinst "mov" (src Cnt C) "%rcx")
(prinst "cld")
@@ -304,7 +305,6 @@
(prinst "adc" Src (car Dst))
(prinst "adc" "%r12" (cdr Dst)) ) )
-
(asm sub (Dst D Src S)
(setq Dst (dst Dst D) Src (src Src S))
(ifn (pair Dst)
@@ -377,7 +377,6 @@
(asm zxt () # 8 bit -> 64 bit
(prinst "movzx" "%al" "%rax") )
-
(asm setc ()
(prinst "stc") )
@@ -402,7 +401,7 @@
(setq Dst (dst Dst D))
(prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rsi")
(lea Src S "%rdi")
- (prinst "lea" End "%rcx")
+ (lea End E "%rcx")
(prinst "sub" "%rsi" "%rcx")
(prinst "cld")
(prinst "repnz cmpsb") )
@@ -560,7 +559,7 @@
(prinst "mov" "%rdx" "%r12") )
(let Reg '("%rdi" "%rsi" "%rdx" "%rcx" "%r8" "%r9")
(if (lst? Arg)
- (let Lea NIL
+ (let Lea NIL
(when (nth Arg 7)
(setq # Maximally 6 args in registers
Arg (append (head 6 Arg) (reverse (tail -6 Arg)))
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 30apr10abu
+# 10may10abu
# (c) Software Lab. Alexander Burger
### Destructive primitives ###
@@ -866,7 +866,8 @@
xchg A E
shr A 4 # Normalize
mul E # Multiply
- if nc # Only lower word
+ null C # Only lower word?
+ if z # Yes
test A (hex "F000000000000000") # Fit in short number?
if z # Yes
shl A 4 # Make short number
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 02may10abu
+# 12may10abu
# (c) Software Lab. Alexander Burger
(data 'Globals 0)
@@ -16,6 +16,7 @@
word 0
: Stack0 word 0 # Initial stack pointer
+: Link word 0 # Saved link register
: Catch word 0 # Catch frames
: Termio word 0 # Raw mode terminal I/O
: Time word 0 # Pointer to time structure
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 05may10abu
+# 12may10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -1619,7 +1619,7 @@
add A Z # Fetch byte
ld B (A VII) # from buffer
cmp B 10 # Newline?
- if z # Yes
+ if eq # Yes
add (Z IV) 1 # Increment line
end
zxt # Extend into A
@@ -4557,35 +4557,27 @@
ld Y Intern
call isInternEXY_F # Internal symbol?
if eq # Yes
- ld C 0
- call symByteCX_FACX # Get first byte
- do
- memb Delim "(DelimEnd-Delim)" # Delimiter?
- if eq # Yes
- push A # Save char
- ld B (char "\\") # Print backslash
- call (EnvPutB)
- pop A
- else
- cmp B (char ".") # Dot?
+ cmp X (hex "2E2") # Dot?
+ if eq # Yes
+ ld B (char "\\") # Print backslash
+ call (EnvPutB)
+ ld B (char ".") # Print dot
+ call (EnvPutB)
+ else
+ ld C 0
+ call symByteCX_FACX # Get first byte
+ do
+ memb Delim "(DelimEnd-Delim)" # Delimiter?
if eq # Yes
- call symByteCX_FACX # Next byte?
- if z # No
- ld B (char "\\") # Print backslash
- call (EnvPutB)
- ld B (char ".") # Print dot
- call (EnvPutB)
- break T # Done
- end
push A # Save char
- ld B (char ".") # Print dot
+ ld B (char "\\") # Print backslash
call (EnvPutB)
pop A
end
- end
- call (EnvPutB) # Put byte
- call symByteCX_FACX # Next byte
- until z # Done
+ call (EnvPutB) # Put byte
+ call symByteCX_FACX # Next byte
+ until z # Done
+ end
else # Else transient symbol
ld Y 0 # 'tsm' flag in Y
atom (Tsm) # Transient symbol markup?
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 05may10abu
+# 12may10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -1382,7 +1382,10 @@
cc (Y) X # Call C-function
ld E (Z -II) # Get result specification
ld C 0 # No pointer yet
+ push (Link) # Save L
+ ld (Link) L
call natRetACE_CE # Extract return value
+ pop (Link)
ld (Z -II) E # Save result
lea Y (Z -III) # Clean up allocated C args
do
@@ -1598,6 +1601,8 @@
(code 'lisp 0)
begin 6 # Function name in A, arguments in C, E, X, Y and Z
+ push L # Save C frame pointer
+ ld L (Link) # Restore link register
link # Apply args
push ZERO # Space for 'fun'
xchg C E # First arg
@@ -1637,6 +1642,7 @@
neg A # Yes
end
drop
+ pop L # Restore C frame pointer
return 6
(code 'execE 0)
diff --git a/src64/mkEmu32 b/src64/mkEmu32
@@ -0,0 +1,13 @@
+# 11may10abu
+# (c) Software Lab. Alexander Burger
+
+./mkAsm x86-32 linux Linux base "" ../dbg.l version.l glob.l main.l sys/linux.code.l gc.l apply.l flow.l sym.l subr.l big.l io.l db.l net.l err.l
+as -o x86-32.linux.base.o x86-32.linux.base.s
+gcc -o ../bin/emu32 -rdynamic -lc -lm -ldl x86-32.linux.base.o
+strip ../bin/emu32
+
+#./mkAsm x86-32 linux Linux ext "" ../dbg.l -fpic ext.l
+
+#./mkAsm x86-32 linux Linux ht "" ../dbg.l -fpic ht.l
+
+mv x86-32.linux.* /tmp
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 05may10abu
+# 12may10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 2 18)
+(de *Version 3 0 2 19)
# vi:et:ts=3:sw=3
