Thread: [Wisp-cvs] wisp/modules ia32.wrti,NONE,1.1 Makefile.am,1.57,1.58 io.wrti,1.10,1.11 linux.wrti,1.23,1
Status: Alpha
Brought to you by:
digg
Menu
▾
▴
wisp-cvs
|
From: <di...@us...> - 2002-09-30 18:24:58
|
Update of /cvsroot/wisp/wisp/modules
In directory usw-pr-cvs1:/tmp/cvs-serv25684/modules
Modified Files:
Makefile.am io.wrti linux.wrti universal.wrti wisptyp.wrti
Added Files:
ia32.wrti
Log Message:
Created the beginnings of Worth-level assemblying.
--- NEW FILE: ia32.wrti ---
;;;; ia32.wrti - an experiment at tangling Worth and an assembler
;;
;; Copyleft © 2002 by Andres Soolo (di...@us...)
;; This file is licensed under the GNU GPL v2. If you
;; don't know what that means, please do read the GPL.
;;
;;;; @(#) $Id: ia32.wrti,v 1.1 2002/09/30 18:24:55 digg Exp $
(ifndef _ia32.wrti_ (define _ia32.wrti_)
; Prefixes
(macro .a16. #o147 byte#)
(macro .a32.)
(macro .o16. #o146 byte#)
(macro .o32.)
(macro .lock. #o360 byte#)
(macro .rep. #o363 byte#)
(macro .repe. #o363 byte#)
(macro .repz. #o363 byte#)
(macro .repne. #o362 byte#)
(macro .repnz. #o362 byte#)
; "String" operations
(macro .ins.b. #o154 byte#)
(macro .ins.w. .o16. #o155 byte#)
(macro .ins.t. .o32. #o155 byte#)
(macro .outs.b. #o156 byte#)
(macro .outs.w. .o16. #o157 byte#)
(macro .outs.t. .o32. #o157 byte#)
(macro .movs.b. #o244 byte#)
(macro .movs.w. .o16. #o245 byte#)
(macro .movs.t. .o32. #o245 byte#)
(macro .cmps.b. #o246 byte#)
(macro .cmps.w. .o16. #o247 byte#)
(macro .cmps.t. .o32. #o247 byte#)
(macro .stos.b. #o252 byte#)
(macro .stos.w. .o16. #o253 byte#)
(macro .stos.t. .o32. #o253 byte#)
(macro .lods.b. #o254 byte#)
(macro .lods.w. .o16. #o255 byte#)
(macro .lods.t. .o32. #o255 byte#)
(macro .scas.b. #o256 byte#)
(macro .scas.w. .o16. #o257 byte#)
(macro .scas.t. .o32. #o257 byte#)
; Flag operations
(macro .cmc. #o365 byte#)
(macro .clc. #o370 byte#)
(macro .stc. #o371 byte#)
(macro .cli. #o372 byte#)
(macro .sti. #o373 byte#)
(macro .cld. #o374 byte#)
(macro .std. #o375 byte#)
; Privileged instructions
(macro .hlt. #o364 byte#)
(macro .clts. #o017 byte# #o006 byte#)
(macro .rdmsr. #o017 byte# #o062 byte#)
(macro .wrmsr. #o017 byte# #o060 byte#)
; Stack manipulation
(macro .enter. #o310 byte# swap wyde# byte#)
(macro .leave. #o311 byte#)
(macro .push.
cond dup register? if
decode-register swap
cond dup 0 = if drop .o32. #o120 + byte#
else dup 1 = if drop .o16. #o120 + byte#
else bug thens
else bug
thens)
(macro .pusha. #o140 byte#)
(macro .pusha.w. .o16. .pusha.)
(macro .pusha.t. .o32. .pusha.)
(macro .pushf. #o234 byte#)
(macro .pushf.w. .o16. .pushf.)
(macro .pushf.t. .o32. .pushf.)
(macro .pop.
cond dup register? if
decode-register swap
cond dup 0 = if drop .o32. #o130 + byte#
else dup 1 = if drop .o16. #o130 + byte#
else bug thens
else bug
thens)
(macro .popa. #o141 byte#)
(macro .popa.w. .o16. .popa.)
(macro .popa.t. .o32. .popa.)
(macro .popf. #o235 byte#)
(macro .popf.w. .o16. .popf.)
(macro .popf.t. .o32. .popf.)
; Floating point instructions: computation
(macro .fchs. #o331 byte# #o340 byte#)
(macro .fabs. #o331 byte# #o341 byte#)
(macro .f2xm1. #o331 byte# #o360 byte#)
(macro .fyl2x. #o331 byte# #o361 byte#)
(macro .fptan. #o331 byte# #o362 byte#)
(macro .fpatan. #o331 byte# #o363 byte#)
(macro .fprem1. #o331 byte# #o365 byte#)
(macro .fprem. #o331 byte# #o370 byte#)
(macro .fyl2xp1. #o331 byte# #o371 byte#)
(macro .fsqrt. #o331 byte# #o372 byte#)
(macro .fsincos. #o331 byte# #o373 byte#)
(macro .frndint. #o331 byte# #o374 byte#)
(macro .fscale. #o331 byte# #o375 byte#)
(macro .fsin. #o331 byte# #o376 byte#)
(macro .fcos. #o331 byte# #o377 byte#)
; Floating point instructions: computation control
(macro .fld.one. #o331 byte# #o350 byte#)
(macro .fld.l2t. #o331 byte# #o351 byte#)
(macro .fld.l2e. #o331 byte# #o352 byte#)
(macro .fld.pi. #o331 byte# #o353 byte#)
(macro .fld.lg2. #o331 byte# #o354 byte#)
(macro .fld.ln2. #o331 byte# #o355 byte#)
(macro .fld.zero. #o331 byte# #o356 byte#)
; Control flow
(macro .int. #o315 byte# byte#)
(macro .int1. #o361 byte#)
(macro .int3. #o314 byte#)
(macro .into. #o316 byte#)
(macro .iret. #o317 byte#)
(macro .iret.w. .o16. .iret.)
(macro .iret.t. .o32. .iret.)
(macro .ret. #o303 byte#)
(macro .ret.f. #o313 byte#))
; vim: ft=worth
Index: Makefile.am
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/Makefile.am,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -d -r1.57 -r1.58
--- Makefile.am 18 Sep 2002 21:16:38 -0000 1.57
+++ Makefile.am 30 Sep 2002 18:24:55 -0000 1.58
@@ -33,7 +33,7 @@
files.wid getopt.wid ini.wid lists.wid locale.wid random.wid \
strings.wid unicode.wid
-wrti_DATA = io.wrti linux.wrti universal.wrti wisptyp.wrti
+wrti_DATA = ia32.wrti io.wrti linux.wrti universal.wrti wisptyp.wrti
EXTRA_DIST = .cvsignore \
$(wisp_DATA) $(wim_DATA) $(wid_DATA) $(wrti_DATA)
Index: io.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/io.wrti,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- io.wrti 18 Sep 2002 20:58:04 -0000 1.10
+++ io.wrti 30 Sep 2002 18:24:55 -0000 1.11
@@ -27,6 +27,16 @@
(macro encode-digit
dup 10 >= if 7 + then #\0 +)
+ (macro decode-digit
+ dup #\a >= if #\a #\A - - then
+ cond
+ dup #\0 < if drop -1 else
+ dup #\9 <= if #\0 - else
+ dup #\A < if drop -1 else
+ dup #\Z <= if #\A 10 - - else
+ drop -1
+ thens)
+
(macro emit-digit
encode-digit emit)
Index: linux.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/linux.wrti,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- linux.wrti 18 Sep 2002 21:14:23 -0000 1.23
+++ linux.wrti 30 Sep 2002 18:24:55 -0000 1.24
@@ -6,37 +6,35 @@
;;
;;;; @(#) $Id$
-;;;; Note the unfortunate dependency on ia32.
+(include ia32) ; Note the unfortunate dependency on ia32.
(ifndef _linux.wrti_ (define _linux.wrti_)
; These are supposed to be used immediately in the start of |_start|.
- (macro argc-argv-envp (stack=! 1) sp@ 2dup swap cells + cell+)
+ (macro argc-argv-envp 1 stack=! sp@ 2dup swap cells + cell+)
(macro argv-envp argc-argv-envp rot drop)
- (macro \sys ,(mov %eax ,0) drop ,(int #x80))
- (macro \skt (stack=! 1) ,(mov %ebx ,0) drop
+ (macro \sys ,(mov %eax ,0) drop #x80 .int.)
+ (macro \skt 1 stack=! ,(mov %ebx ,0) drop
(flush) ,(mov %ecx %esp) 102 \sys)
(macro sys.exit (->reg 0 %ebx) 1 \sys ,(\skip))
(macro sys.write-char ; ( fd char )
- (flush)
- ,(pop %ecx)
- ,(pop %ebx)
+ $ %ebx %ecx conform
,(mov %edx 1)
,(push %ecx)
,(mov %ecx %esp)
4 \sys
,(add %esp 4)
- (believe %eax))
+ believe %eax)
; |sys.pipe| returns ( reading-part writing-part ) or ( -errno )
(macro sys.pipe
- (conform)
+ $ conform
,(sub %esp 8) ; allocate space for filedes[2]
,(mov %ebx %esp)
- 42 \sys (believe %eax)
+ 42 \sys believe %eax
dup 0 < if ; failed?
nip nip ; clean up
else
@@ -44,100 +42,100 @@
swap ; account for downwards-growing stack
then)
- (macro sys.fork (conform) 2 \sys (believe %eax))
- (macro sys.read (conform %ebx %ecx %edx) 3 \sys (believe %eax))
- (macro sys.write (conform %ebx %ecx %edx) 4 \sys (believe %eax))
- (macro sys.open (conform %ebx %ecx %edx) 5 \sys (believe %eax))
- (macro sys.close (conform %ebx) 6 \sys (believe %eax))
+ (macro sys.fork $ conform 2 \sys believe %eax)
+ (macro sys.read $ %ebx %ecx %edx conform 3 \sys believe %eax)
+ (macro sys.write $ %ebx %ecx %edx conform 4 \sys believe %eax)
+ (macro sys.open $ %ebx %ecx %edx conform 5 \sys believe %eax)
+ (macro sys.close $ %ebx conform 6 \sys believe %eax)
; |sys.waitpid| takes (pid options) and
; returns (status pid) or (-errno) or (0)
- (macro sys.waitpid (conform %ebx %edx) ,(sub %esp 4) ,(mov %ecx %esp)
- 7 \sys (believe %eax)
+ (macro sys.waitpid $ %ebx %edx conform ,(sub %esp 4) ,(mov %ecx %esp)
+ 7 \sys believe %eax
dup 0 <= if ; no status?
nip
then)
- (macro sys.creat (conform %ebx %ecx) 8 \sys (believe %eax))
- (macro sys.link (conform %ebx %ecx) 9 \sys (believe %eax))
- (macro sys.unlink (conform %ebx) 10 \sys (believe %eax))
- (macro sys.execve (conform %ebx %ecx %edx) 11 \sys (believe %eax))
- (macro sys.chdir (conform %ebx) 12 \sys (believe %eax))
+ (macro sys.creat $ %ebx %ecx conform 8 \sys believe %eax)
+ (macro sys.link $ %ebx %ecx conform 9 \sys believe %eax)
+ (macro sys.unlink $ %ebx conform 10 \sys believe %eax)
+ (macro sys.execve $ %ebx %ecx %edx conform 11 \sys believe %eax)
+ (macro sys.chdir $ %ebx conform 12 \sys believe %eax)
; |sys.time| takes no argument and returns the time
- (macro sys.time (conform) ,(mov %ebx 0) 13 \sys (believe %eax))
- (macro sys.chmod (conform %ebx %ecx) 15 \sys (believe %eax))
- (macro sys.lseek (conform %ebx %ecx %edx) 19 \sys (believe %eax))
- (macro sys.getpid (conform) 20 \sys (believe %eax))
- (macro sys.setuid (conform %ebx) 23 \sys (believe %eax))
- (macro sys.getuid (conform) 24 \sys (believe %eax))
- (macro sys.stime (conform %ebx) 25 \sys (believe %eax))
- (macro sys.alarm (conform %ebx) 27 \sys (believe %eax))
- (macro sys.pause (conform) 29 \sys (believe %eax))
- (macro sys.access (conform %ebx %ecx) 33 \sys (believe %eax))
- (macro sys.nice (conform %ebx) 34 \sys (believe %eax))
+ (macro sys.time $ conform ,(mov %ebx 0) 13 \sys believe %eax)
+ (macro sys.chmod $ %ebx %ecx conform 15 \sys believe %eax)
+ (macro sys.lseek $ %ebx %ecx %edx conform 19 \sys believe %eax)
+ (macro sys.getpid $ conform 20 \sys believe %eax)
+ (macro sys.setuid $ %ebx conform 23 \sys believe %eax)
+ (macro sys.getuid $ conform 24 \sys believe %eax)
+ (macro sys.stime $ %ebx conform 25 \sys believe %eax)
+ (macro sys.alarm $ %ebx conform 27 \sys believe %eax)
+ (macro sys.pause $ conform 29 \sys believe %eax)
+ (macro sys.access $ %ebx %ecx conform 33 \sys believe %eax)
+ (macro sys.nice $ %ebx conform 34 \sys believe %eax)
; since sync(2) never fails, |sys.sync| returns nothing
- (macro sys.sync (conform) 36 \sys (believe))
- (macro sys.kill (conform %ebx %ecx) 37 \sys (believe %eax))
- (macro sys.rename (conform %ebx %ecx) 38 \sys (believe %eax))
- (macro sys.mkdir (conform %ebx %ecx) 39 \sys (believe %eax))
- (macro sys.rmdir (conform %ebx) 40 \sys (believe %eax))
- (macro sys.dup (conform %ebx) 41 \sys (believe %eax))
- (macro sys.brk (conform %ebx) 45 \sys (believe %eax))
- (macro sys.setgid (conform %ebx) 46 \sys (believe %eax))
- (macro sys.getgid (conform) 47 \sys (believe %eax))
- (macro sys.geteuid (conform) 49 \sys (believe %eax))
- (macro sys.getegid (conform) 50 \sys (believe %eax))
- (macro sys.ioctl (conform %ebx %ecx %edx) 54 \sys (believe %eax))
- (macro sys.ioctl2 (conform %ebx %ecx %edx %esi) 54 \sys (believe %eax))
- (macro sys.setpgid (conform %ebx %ecx) 57 \sys (believe %eax))
- (macro sys.umask (conform %ebx) 60 \sys (believe %eax))
- (macro sys.chroot (conform %ebx) 61 \sys (believe %eax))
- (macro sys.dup2 (conform %ebx %ecx) 63 \sys (believe %eax))
- (macro sys.getppid (conform) 64 \sys (believe %eax))
- (macro sys.getpgrp (conform) 65 \sys (believe %eax))
- (macro sys.setsid (conform) 66 \sys (believe %eax))
- (macro sys.setreuid (conform %ebx %ecx) 70 \sys (believe %eax))
- (macro sys.setregid (conform %ebx %ecx) 71 \sys (believe %eax))
- (macro sys.symlink (conform %ebx %ecx) 83 \sys (believe %eax))
- (macro sys.swapon (conform %ebx %ecx) 87 \sys (believe %eax))
- (macro sys.truncate (conform %ebx %ecx) 92 \sys (believe %eax))
- (macro sys.ftruncate (conform %ebx %ecx) 93 \sys (believe %eax))
- (macro sys.fchmod (conform %ebx %ecx) 94 \sys (believe %eax))
- (macro sys.stat (conform %ebx %ecx) 106 \sys (believe %eax))
- (macro sys.lstat (conform %ebx %ecx) 107 \sys (believe %eax))
- (macro sys.fstat (conform %ebx %ecx) 108 \sys (believe %eax))
- (macro sys.vhangup (conform) 111 \sys (believe %eax))
- (macro sys.swapoff (conform %ebx) 115 \sys (believe %eax))
- (macro sys.fsync (conform %ebx) 118 \sys (believe %eax))
- (macro sys.getpgid (conform %ebx) 132 \sys (believe %eax))
- (macro sys.fchdir (conform %ebx) 133 \sys (believe %eax))
- (macro sys.getdents (conform %ebx %ecx %edx) 141 \sys (believe %eax))
+ (macro sys.sync $ conform 36 \sys believe)
+ (macro sys.kill $ %ebx %ecx conform 37 \sys believe %eax)
+ (macro sys.rename $ %ebx %ecx conform 38 \sys believe %eax)
+ (macro sys.mkdir $ %ebx %ecx conform 39 \sys believe %eax)
+ (macro sys.rmdir $ %ebx conform 40 \sys believe %eax)
+ (macro sys.dup $ %ebx conform 41 \sys believe %eax)
+ (macro sys.brk $ %ebx conform 45 \sys believe %eax)
+ (macro sys.setgid $ %ebx conform 46 \sys believe %eax)
+ (macro sys.getgid $ conform 47 \sys believe %eax)
+ (macro sys.geteuid $ conform 49 \sys believe %eax)
+ (macro sys.getegid $ conform 50 \sys believe %eax)
+ (macro sys.ioctl $ %ebx %ecx %edx conform 54 \sys believe %eax)
+ (macro sys.ioctl2 $ %ebx %ecx %edx %esi conform 54 \sys believe %eax)
+ (macro sys.setpgid $ %ebx %ecx conform 57 \sys believe %eax)
+ (macro sys.umask $ %ebx conform 60 \sys believe %eax)
+ (macro sys.chroot $ %ebx conform 61 \sys believe %eax)
+ (macro sys.dup2 $ %ebx %ecx conform 63 \sys believe %eax)
+ (macro sys.getppid $ conform 64 \sys believe %eax)
+ (macro sys.getpgrp $ conform 65 \sys believe %eax)
+ (macro sys.setsid $ conform 66 \sys believe %eax)
+ (macro sys.setreuid $ %ebx %ecx conform 70 \sys believe %eax)
+ (macro sys.setregid $ %ebx %ecx conform 71 \sys believe %eax)
+ (macro sys.symlink $ %ebx %ecx conform 83 \sys believe %eax)
+ (macro sys.swapon $ %ebx %ecx conform 87 \sys believe %eax)
+ (macro sys.truncate $ %ebx %ecx conform 92 \sys believe %eax)
+ (macro sys.ftruncate $ %ebx %ecx conform 93 \sys believe %eax)
+ (macro sys.fchmod $ %ebx %ecx conform 94 \sys believe %eax)
+ (macro sys.stat $ %ebx %ecx conform 106 \sys believe %eax)
+ (macro sys.lstat $ %ebx %ecx conform 107 \sys believe %eax)
+ (macro sys.fstat $ %ebx %ecx conform 108 \sys believe %eax)
+ (macro sys.vhangup $ conform 111 \sys believe %eax)
+ (macro sys.swapoff $ %ebx conform 115 \sys believe %eax)
+ (macro sys.fsync $ %ebx conform 118 \sys believe %eax)
+ (macro sys.getpgid $ %ebx conform 132 \sys believe %eax)
+ (macro sys.fchdir $ %ebx conform 133 \sys believe %eax)
+ (macro sys.getdents $ %ebx %ecx %edx conform 141 \sys believe %eax)
(macro sys.select
(->reg 0 %edi)
(->reg 1 %esi)
(->reg 2 %edx)
(->reg 3 %ecx)
(->reg 4 %ebx)
- 142 \sys (believe %eax))
- (macro sys.flock (conform %ebx %ecx) 143 \sys (believe %eax))
- (macro sys.getsid (conform %ebx) 147 \sys (believe %eax))
- (macro sys.fdatasync (conform %ebx) 148 \sys (believe %eax))
- (macro sys.mlock (conform %ebx %ecx) 150 \sys (believe %eax))
- (macro sys.munlock (conform %ebx %ecx) 151 \sys (believe %eax))
- (macro sys.mlockall (conform %ebx) 152 \sys (believe %eax))
- (macro sys.munlockall (conform) 153 \sys (believe %eax))
+ 142 \sys believe %eax)
+ (macro sys.flock $ %ebx %ecx conform 143 \sys believe %eax)
+ (macro sys.getsid $ %ebx conform 147 \sys believe %eax)
+ (macro sys.fdatasync $ %ebx conform 148 \sys believe %eax)
+ (macro sys.mlock $ %ebx %ecx conform 150 \sys believe %eax)
+ (macro sys.munlock $ %ebx %ecx conform 151 \sys believe %eax)
+ (macro sys.mlockall $ %ebx conform 152 \sys believe %eax)
+ (macro sys.munlockall $ conform 153 \sys believe %eax)
; |sys.nanosleep| takes ( sec nsec ) and returns ( sec nsec result ).
; The returned time is not always meaningful.
(macro sys.nanosleep swap (flush) ,(mov %ebx %esp) ,(mov %ecx %esp)
- 162 \sys (believe %eax) -rot swap rot)
- (macro sys.getcwd (conform %ebx %ecx) 183 \sys (believe %eax))
+ 162 \sys believe %eax -rot swap rot)
+ (macro sys.getcwd $ %ebx %ecx conform 183 \sys believe %eax)
- (macro sys.socket swap rot 1 \skt (believe %eax) nip nip nip)
- (macro sys.bind swap rot 2 \skt (believe %eax) nip nip nip)
- (macro sys.connect swap rot 3 \skt (believe %eax) nip nip nip)
- (macro sys.listen swap 4 \skt (believe %eax) nip nip)
- (macro sys.accept swap rot 5 \skt (believe %eax) nip nip nip)
- (macro sys.getsockname swap rot 6 \skt (believe %eax) nip nip nip)
- (macro sys.getpeername swap rot 7 \skt (believe %eax) nip nip nip)
- (macro sys.shutdown swap 13 \skt (believe %eax) nip nip)
+ (macro sys.socket swap rot 1 \skt believe %eax nip nip nip)
+ (macro sys.bind swap rot 2 \skt believe %eax nip nip nip)
+ (macro sys.connect swap rot 3 \skt believe %eax nip nip nip)
+ (macro sys.listen swap 4 \skt believe %eax nip nip)
+ (macro sys.accept swap rot 5 \skt believe %eax nip nip nip)
+ (macro sys.getsockname swap rot 6 \skt believe %eax nip nip nip)
+ (macro sys.getpeername swap rot 7 \skt believe %eax nip nip nip)
+ (macro sys.shutdown swap 13 \skt believe %eax nip nip)
;;;; <asm/errno.h>
(macro EPERM 1) ; Operation not permitted
Index: universal.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/universal.wrti,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- universal.wrti 30 Sep 2002 18:24:37 -0000 1.25
+++ universal.wrti 30 Sep 2002 18:24:55 -0000 1.26
@@ -6,24 +6,27 @@
;;
;;;; @(#) $Id$
-;; Note the unfortunate dependency on ia32.
+(include ia32) ; Note the unfortunate dependency on ia32.
(ifndef _universal.wrti_ (define _universal.wrti_)
;; Stack manipulation
(macro dup
- (copy 0))
+ (stack>=! 1)
+ 0 dig)
(macro drop
(delete 0))
(macro swap
- (copy 1)
+ (stack>=! 2)
+ 1 dig
(delete 2))
(macro rot
- (copy 2)
+ (stack>=! 3)
+ 2 dig
(delete 3))
(macro -rot
@@ -39,14 +42,15 @@
swap tuck)
(macro dig
- (stack=! 1)
+ ; NOTE: the macro will only be used if regstack is not deep enough
+ 1 stack=!
(->reg 0)
(register)
,(mov ,0 (tetra %esp ,1 \tetras))
nip)
(macro bury
- (stack=! 2)
+ 2 stack=!
(->reg 0)
,(mov (tetra %esp ,0 \tetras) ,1)
drop drop)
@@ -91,15 +95,17 @@
drop drop)
(macro 2swap
- (copy 3)
+ (stack>=! 4)
+ 3 dig
(delete 4)
- (copy 3)
+ 3 dig
(delete 4))
(macro 2rot
- (copy 5)
+ (stack>=! 6)
+ 5 dig
(delete 6)
- (copy 5)
+ 5 dig
(delete 6))
(macro -2rot
@@ -110,9 +116,8 @@
0 until)
(macro jump
- (if-empty
- (,(ret))
- (,(jmp ,0)))
+ (stack>=! 1)
+ ,(jmp ,0)
,(\skip)
drop)
@@ -347,16 +352,23 @@
;; Arithmetics
(macro /mod
- (conform %eax %ebx)
+ $ %eax %ebx conform
,(sex %edx:eax %eax)
,(idiv %ebx)
- (believe %edx %eax))
-
- ;; These *names* are special: if the translator determines that these
- ;; operations can be performed at compile-time, it will happily do so.
+ believe %edx %eax)
- (macro + (->ureg 1) (->/expr 0) ,(add ,1 ,0) drop)
- (macro - (->ureg 1) (->/expr 0) ,(sub ,1 ,0) drop)
+ (macro + (->ureg 1) (->/expr 0)
+ dup 1 is? if
+ ,(inc ,1) drop
+ else
+ ,(add ,1 ,0) drop
+ then)
+ (macro - (->ureg 1) (->/expr 0)
+ dup 1 is? if
+ ,(dec ,1) drop
+ else
+ ,(sub ,1 ,0) drop
+ then)
(macro * (->ureg 1) (->/expr 0) ,(imul ,1 ,0) drop)
(macro / /mod nip)
(macro mod /mod drop)
@@ -365,13 +377,8 @@
(->ureg 0)
,(neg ,0))
- (macro 1+
- (->ureg 0)
- ,(inc ,0))
-
- (macro 1-
- (->ureg 0)
- ,(dec ,0))
+ (macro 1+ 1 +)
+ (macro 1- 1 -)
(macro 2*
1 lshift)
@@ -446,49 +453,49 @@
;; Operations on bit vectors
(macro lshift
- (if-int-const 0
- ((->ureg 1)
- ,(shl ,1 ,0))
- ((->reg 0 %ecx)
- (->ureg 1)
- ,(shl ,1 %cl)))
- drop)
+ (->ureg 1)
+ dup literal-integer? if
+ ,(shl ,1 ,0)
+ else
+ (->reg 0 %ecx)
+ ,(shl ,1 %cl)
+ then drop)
(macro rshift
- (if-int-const 0
- ((->ureg 1)
- ,(shr ,1 ,0))
- ((->reg 0 %ecx)
- (->ureg 1)
- ,(shr ,1 %cl)))
- drop)
+ (->ureg 1)
+ dup literal-integer? if
+ ,(shr ,1 ,0)
+ else
+ (->reg 0 %ecx)
+ ,(shr ,1 %cl)
+ then drop)
(macro arshift
- (if-int-const 0
- ((->ureg 1)
- ,(sar ,1 ,0))
- ((->reg 0 %ecx)
- (->ureg 1)
- ,(sar ,1 %cl)))
- drop)
+ (->ureg 1)
+ dup literal-integer? if
+ ,(sar ,1 ,0)
+ else
+ (->reg 0 %ecx)
+ ,(sar ,1 %cl)
+ then drop)
(macro rol
- (if-int-const 0
- ((->ureg 1)
- ,(rol ,1 ,0))
- ((->reg 0 %ecx)
- (->ureg 1)
- ,(rol ,1 %cl)))
- drop)
+ (->ureg 1)
+ dup literal-integer? if
+ ,(rol ,1 ,0)
+ else
+ (->reg 0 %ecx)
+ ,(rol ,1 %cl)
+ then drop)
(macro ror
- (if-int-const 0
- ((->ureg 1)
- ,(ror ,1 ,0))
- ((->reg 0 %ecx)
- (->ureg 1)
- ,(ror ,1 %cl)))
- drop)
+ (->ureg 1)
+ dup literal-integer? if
+ ,(ror ,1 ,0)
+ else
+ (->reg 0 %ecx)
+ ,(ror ,1 %cl)
+ then drop)
(macro bsf
(->ureg 0)
@@ -511,49 +518,58 @@
;; Syntax
+ (macro $
+ syn $ synstack)
+
(macro if
0 = ; booleanize and negate the condition
1 stack=! ; force calling convention
- gen-label dup ->synstack <if> ; generate the label
+ gen-label dup ->synstack syn <if> ; generate the label
?jump) ; jump as necessary
(macro else
- <if> annihilate ; check context
+ syn <if> annihilate ; check context
0 stack=! ; force calling convention
gen-label dup ->synstack
jump
- <-synstack <-synstack swap ->synstack <if> ; fetch the else-label
+ <-synstack <-synstack swap ->synstack syn <if> ; fetch the else-label
stick-label)
(macro then
- <if> annihilate ; check context
+ syn <if> annihilate ; check context
0 stack=! ; force calling convention
<-synstack
stick-label)
+ (macro unless
+ 0 = if)
+
(macro begin
- 0 stack=! gen-label dup ->synstack stick-label <begin>)
+ 0 stack=! gen-label dup ->synstack stick-label syn <begin>)
(macro until
0 = ; booleanize and negate the condition
1 stack=! ; force calling convention
- <begin> annihilate ; check context
+ syn <begin> annihilate ; check context
<-synstack ?jump) ; jump
(macro while
0 = ; booleanize and negate the condition
1 stack=! ; force calling convention
- <begin> annihilate ; check context
+ syn <begin> annihilate ; check context
gen-label dup ->synstack ; generate exit label
?jump ; jump
- <while>) ; establish new context
+ syn <while>) ; establish new context
(macro repeat
- 0 stack=! <while> annihilate
+ 0 stack=! syn <while> annihilate
<-synstack ; exit label
<-synstack ; start label
jump
stick-label)
+ (macro cond
+ syn <cond>)
+
(macro fra
- gen-label dup ->synstack <fra>)
+ gen-label dup ->synstack syn <fra>)
(macro here
- <fra> annihilate <-synstack stick-label)
+ syn <fra> annihilate <-synstack stick-label)
;; Memory calculations
@@ -634,39 +650,25 @@
(macro cell! tetra!)
(macro bytefill
- (conform %edi %ecx %eax)
- ,(cld)
- ,(rep)
- ,(stos %al)
- (believe))
+ $ %edi %ecx %eax conform .cld. .rep. .stos.b. believe)
- (macro fill bytefill) ; FIXME: drop this
+ (macro wydefill
+ $ %edi %ecx %eax conform .cld. .rep. .stos.w. believe)
(macro tetrafill
- (conform %edi %ecx %eax)
- ,(cld)
- ,(rep)
- ,(stos %eax)
- (believe))
+ $ %edi %ecx %eax conform .cld. .rep. .stos.t. believe)
(macro cellfill tetrafill)
(macro bytemove
- (conform %esi %edi %ecx)
- ,(cld)
- ,(rep)
- ,(movs \byte)
- (believe))
+ $ %esi %edi %ecx conform .cld. .rep. .movs.b. believe)
- (macro move bytemove) ; FIXME: drop this
+ (macro wydemove
+ $ %esi %edi %ecx conform .cld. .rep. .movs.w. believe)
(macro tetramove
- (conform %esi %edi %ecx)
- ,(cld)
- ,(rep)
- ,(movs \tetra)
- (believe))
+ $ %esi %edi %ecx conform .cld. .rep. .movs.t. believe)
(macro cellmove tetramove))
-; vim:ft=worth
+; vim: ft=worth
Index: wisptyp.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/wisptyp.wrti,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- wisptyp.wrti 26 Sep 2002 18:21:38 -0000 1.19
+++ wisptyp.wrti 30 Sep 2002 18:24:55 -0000 1.20
@@ -8,6 +8,8 @@
;; "ut" prefix denotes operations on untagged nodes
+(include ia32)
+
(ifndef _wisptyp.wrti_ (define _wisptyp.wrti_)
;; Cons manipulation
@@ -113,9 +115,13 @@
3 arshift)
(macro get-type
- dup 3 and if drop FALSE else
- dup NULL = if drop FALSE else
- cell@ then then)
+ cond dup 3 and if
+ drop FALSE
+ else dup NULL = if
+ drop FALSE
+ else
+ cell@
+ thens)
;; Type tags
@@ -138,24 +144,24 @@
;; Wisp calling convention
(macro wisp-prologue
- (believe %ecx))
+ believe %ecx)
(macro wisp-epilogue
- (stack=! 1)
+ 1 stack=!
(->reg 0 %eax)
- ,(ret)
+ .ret.
,(\skip))
(macro <:
fra)
(macro :>
- here (believe %eax))
+ here believe %eax)
(extern N_signal_argcount)
(macro argc
- 0= if (stack=! 1) (->reg 0 %ecx) 'N_signal_argcount jump then)
+ 0= if 1 stack=! (->reg 0 %ecx) 'N_signal_argcount jump then)
(extern raise$2)
@@ -169,10 +175,10 @@
(extern binary_mul)
(extern binary_div)
- (macro w+ <: -rot 2 (conform %ecx) 'binary_add jump :> (believe %eax))
- (macro w- <: -rot 2 (conform %ecx) 'binary_sub jump :> (believe %eax))
- (macro w* <: -rot 2 (conform %ecx) 'binary_mul jump :> (believe %eax))
- (macro w/ <: -rot 2 (conform %ecx) 'binary_div jump :> (believe %eax))
+ (macro w+ <: -rot 2 $ %ecx conform 'binary_add jump :> believe %eax)
+ (macro w- <: -rot 2 $ %ecx conform 'binary_sub jump :> believe %eax)
+ (macro w* <: -rot 2 $ %ecx conform 'binary_mul jump :> believe %eax)
+ (macro w/ <: -rot 2 $ %ecx conform 'binary_div jump :> believe %eax)
;; Records
@@ -181,15 +187,15 @@
(extern slot_accessor_body)
(macro go-discriminate ; takes: arg ... count rectype
- (conform %ecx %edx)
+ $ %ecx %edx conform
'discriminator_body jump)
(macro go-construct-record ; takes: arg ... count rectype
- (conform %ecx %edx)
+ $ %ecx %edx conform
'record_constructor_body jump)
(macro go-access-slot ; takes: arg ... count rectype index
- (conform %ecx %edx %ebx)
+ $ %ecx %edx %ebx conform
'slot_accessor_body jump))
; vim: ft=worth
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X