diff options
| author | Andy Wingo <wingo@pobox.com> | 2009-08-13 18:48:20 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2009-08-13 18:48:20 +0200 |
| commit | 66ff15e2f0afa2d2ecd4e7de484acf7324c3b0f1 (patch) | |
| tree | d31881900e8f715d8afd07521497c81101b3fedf | |
| parent | d785171115bb35c6e3cc3663a0023ff4e88536d5 (diff) | |
| download | guile-66ff15e2f0afa2d2ecd4e7de484acf7324c3b0f1.tar.gz | |
add the sassy x86 assembler
* module/Makefile.am: Add language/sassy.scm. Probably EXTRA_DIST the
dependant files, too.
* module/language/sassy.scm: New file, the sassy loader. Sassy is
originally R5RS code that loads a number of files. I've converted that
toplevel file to be a Guile module that *includes* the subfiles, so
that it all gets compiled together. It's a pretty bad hack though,
because what I should be doing is including them relative to the
sassy.scm source location, but we don't know that at expansion time.
Something to fix.
really bad hack in it so that it will compile correctly -- p
* module/language/sassy/: All the sassy files and some changelog
information. All of these files are LGPLv2.1+, so they can be included
in Guile.
* test-suite/standalone/sassy/tests/: Add the sassy unit tests.
* test-suite/standalone/Makefile.am:
* test-suite/standalone/test-sassy: Hook the sassy unit tests up to our
test suite.
479 files changed, 12853 insertions, 0 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index 5ef00be37..f5c264bef 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -51,6 +51,7 @@ SOURCES = \ $(OOP_SOURCES) \ $(SYSTEM_SOURCES) \ $(SCRIPTS_SOURCES) \ + $(SASSY_LANG_SOURCES) \ $(GHIL_LANG_SOURCES) \ $(ECMASCRIPT_LANG_SOURCES) \ $(BRAINFUCK_LANG_SOURCES) @@ -106,6 +107,9 @@ OBJCODE_LANG_SOURCES = \ VALUE_LANG_SOURCES = \ language/value/spec.scm +SASSY_LANG_SOURCES = \ + language/sassy.scm + ECMASCRIPT_LANG_SOURCES = \ language/ecmascript/parse-lalr.scm \ language/ecmascript/tokenize.scm \ diff --git a/module/language/sassy.scm b/module/language/sassy.scm new file mode 100644 index 000000000..3e3dc596b --- /dev/null +++ b/module/language/sassy.scm @@ -0,0 +1,125 @@ +;;; Sassy + +;; Copyright (C) 2009 Free Software Foundation, Inc. +;; Copyright (C) 2005 Jonathan Kraut + +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;; Contact: +;; Jonathan Kraut +;; 4130 43 ST #C2 +;; Sunnyside, NY 11104 +;; jak76@columbia.edu + +;;; Code: + +(define-module (language sassy) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-60) + #:use-module (rnrs bytevector) + #:use-module (rnrs io ports) + + #:export (sassy + sassy-data-align + sassy-data-list + sassy-data-size + sassy-data-stack + sassy-entry-point + sassy-expand + sassy-heap-align + sassy-heap-size + sassy-hexdump + sassy-make-bin + sassy-make-elf + sassy-print-relocs + sassy-print-symbols + sassy-reloc-list + sassy-reloc-name + sassy-reloc-offset + sassy-reloc-patcher + sassy-reloc-section + sassy-reloc-type + sassy-reloc-value + sassy-reloc-width + sassy-symbol-exists? + sassy-symbol-name + sassy-symbol-offset + sassy-symbol-scope + sassy-symbol-section + sassy-symbol-size + sassy-symbol-table + sassy-symbol-unres + sassy-text-align + sassy-text-list + sassy-text-org + sassy-text-size + sassy-text-stack)) + + +(define (write-byte b . port) + (put-u8 (if (null? port) (current-output-port) (car port)) + b)) +(define (read-byte . port) + (get-u8 (if (null? port) (current-input-port) (car port)))) + +(define (hash-table-ref t k . th) + (cond ((hash-ref t k)) + (else (if (null? t) #f ((car th)))))) + +(define hash-table-set! hash-set!) + +(define (alist->hash-table lst) + (let ((t (make-hash-table))) + (for-each (lambda (itm) + (hash-table-set! t (car itm) (cdr itm))) + lst) + t)) + +(define (hash-table-values t) + (hash-map->list (lambda (k v) v) t)) + +;; HACK: we know we're compiling from a certain dir, so encode like +;; this. Nasty. +(include "language/sassy/extras.scm") +(include "language/sassy/meta-lambda.scm") +(include "language/sassy/push-stacks.scm") +(include "language/sassy/api.scm") +(include "language/sassy/intern.scm") +(include "language/sassy/macros.scm") +(include "language/sassy/numbers.scm") + +;; The original sassy included other/srfi-56-pieces, but we can use +;; bytevectors for that. +(define (float32->byte-list float) + (let ((bv (make-bytevector 4))) + (bytevector-ieee-single-native-set! bv 0 float) + (bytevector->u8-list bv))) +(define (float64->byte-list float) + (let ((bv (make-bytevector 8))) + (bytevector-ieee-double-native-set! bv 0 float) + (bytevector->u8-list bv))) + +(include "language/sassy/operands.scm") +(include "language/sassy/text-block.scm") +(include "language/sassy/opcodes.scm") +(include "language/sassy/text.scm") +(include "language/sassy/parse.scm") +(include "language/sassy/main.scm") + +(include "language/sassy/flat-bin.scm") +(include "language/sassy/elf.scm") + +; (load "tests/run-tests.scm") +; (sassy-run-tests 'all) diff --git a/module/language/sassy/api.scm b/module/language/sassy/api.scm new file mode 100644 index 000000000..dd05789da --- /dev/null +++ b/module/language/sassy/api.scm @@ -0,0 +1,166 @@ +; api.scm - access Sassy's output +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module api +; import srfi-9 push-stacks +; export all + +(define-record-type sassy-output + (make-sassy-output a b c d e f g h i j k) + sassy-output? + (a sassy-symbol-table sassy-symbol-table-set!) + (b sassy-reloc-list sassy-reloc-list-set!) + (c sassy-entry-point sassy-entry-point-set!) + (d sassy-data-stack sassy-data-stack-set!) + (e sassy-text-stack sassy-text-stack-set!) + (f sassy-heap-align sassy-heap-align-set!) + (g sassy-data-align sassy-data-align-set!) + (h sassy-text-align sassy-text-align-set!) + (i sassy-heap-size sassy-heap-size-set!) + (j sassy-text-org sassy-text-org-set!) + (k sassy-bits sassy-bits-set!)) + +(define-record-type sassy-symbol + (make-sassy-symbol a b c d e f g) + sassy-symbol? + (a sassy-symbol-name sassy-symbol-name-set!) + (b sassy-symbol-scope sassy-symbol-scope-set!) + (c sassy-symbol-section sassy-symbol-section-set!) + (d sassy-symbol-offset sassy-symbol-offset-set!) + (e sassy-symbol-size sassy-symbol-size-set!) + (f sassy-symbol-unres sassy-symbol-unres-set!) + (g sassy-symbol-exp sassy-symbol-exp-set!)) + +(define-record-type sassy-reloc + (make-sassy-reloc a b c d e f g) + sassy-reloc? + (a sassy-reloc-name sassy-reloc-name-set!) + (b sassy-reloc-section sassy-reloc-section-set!) + (c sassy-reloc-offset sassy-reloc-offset-set!) + (d sassy-reloc-type sassy-reloc-type-set!) + (e sassy-reloc-patcher sassy-reloc-patcher-set!) + (f sassy-reloc-value sassy-reloc-value-set!) + (g sassy-reloc-width sassy-reloc-width-set!)) + +(define (sassy-data-list sassy-output) + (push-stack-items (sassy-data-stack sassy-output))) +(define (sassy-text-list sassy-output) + (push-stack-items (sassy-text-stack sassy-output))) + +(define (sassy-text-size sassy-output) + (push-stack-size (sassy-text-stack sassy-output))) +(define (sassy-data-size sassy-output) + (push-stack-size (sassy-data-stack sassy-output))) + +(define (sassy-symbol-exists? sassy-output name) + (hash-table-ref (sassy-symbol-table sassy-output) name (lambda () #f))) + +(define (sassy-hexdump list-of-bytes) + (let ((print-count (lambda (count) + (let ((n (number->string count 16))) + (display (make-string (- 8 (string-length n)) #\0)) + (display n) + (display #\space)))) + (byte->azkey (lambda (byte) + (if (and (>= byte 32) (<= byte 126)) + (integer->char byte) + #\.))) + (print-hex (lambda (byte) + (let ((tmp (number->string byte 16))) + (if (= 1 (string-length tmp)) + (display "0")) + (display tmp) + (display #\space)))) + (print-string (lambda (string) + (display "|") + (display (list->string (reverse string))) + (display "|") + (newline)))) + (define string '()) + (define col 1) + (newline) + (do ((rest list-of-bytes (cdr rest)) + (count 0 (+ count 1))) + ((null? rest) + (if (not (zero? (modulo count 16))) + (begin + (display (make-string (- 61 col) #\space)) + (print-string string)))) + (if (zero? (modulo count 16)) + (begin (print-count count) (set! col 10))) + (if (zero? (modulo count 8)) + (begin (display #\space) (set! col (+ col 1)))) + (print-hex (car rest)) + (set! col (+ col 3)) + (set! string (cons (byte->azkey (car rest)) string)) + (if (= 15 (modulo count 16)) + (begin (display #\space) + (print-string string) + (set! string '())))))) + + +(define sassy-print-relocs #f) + +(define sassy-print-symbols #f) + +(let ((print-field (lambda (t v record) + (display t) + (display ": ") + (let ((t (v record))) + (display (or t "#<undefined>"))) + (newline))) + (make-num (lambda (x) + (if x + (string-append "#x" (number->string x 16)) + "#<undefined>")))) + (set! sassy-print-relocs + (lambda (sassy-output) + (for-each + (lambda (reloc) + (newline) + (print-field "name " sassy-reloc-name reloc) + (print-field "section" sassy-reloc-section reloc) + (print-field "offset " (lambda (x) + (make-num (sassy-reloc-offset x))) reloc) + (print-field "type " sassy-reloc-type reloc) + (print-field "value " (lambda (x) + (make-num (sassy-reloc-value x))) reloc) + (print-field "width " (lambda (x) + (make-num (sassy-reloc-width x))) reloc)) + (sassy-reloc-list sassy-output)))) + (set! sassy-print-symbols + (lambda (sassy-output) + (for-each + (lambda (sym) + (newline) + (print-field "name " sassy-symbol-name sym) + (print-field "scope " sassy-symbol-scope sym) + (print-field "section" sassy-symbol-section sym) + (print-field "offset " (lambda (x) + (make-num (sassy-symbol-offset x))) sym) + (print-field "size " (lambda (x) + (make-num (sassy-symbol-size x))) sym)) + (hash-table-values (sassy-symbol-table sassy-output)))))) diff --git a/module/language/sassy/elf.scm b/module/language/sassy/elf.scm new file mode 100644 index 000000000..6d760c257 --- /dev/null +++ b/module/language/sassy/elf.scm @@ -0,0 +1,457 @@ +; elf.scm - create ELF files from Sassy's output +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module elf +; import api push-stacks numbers +; export all + +(define (sassy-make-elf output-file sassy-output) + +; the elf constants used + (define sht-progbits 1) + (define sht-symtab 2) + (define sht-strtab 3) + (define sht-nobits 8) + (define sht-rel 9) + (define shf-write 1) + (define shf-alloc 2) + (define shf-execinstr 4) + (define stn-undef 0) + (define stb-local 0) + (define stb-global 1) + (define stt-notype 0) + (define stt-object 1) + (define stt-func 2) + (define stt-section 3) + (define shn-abs #xfff1) + (define r-386-32 1) + (define r-386-pc32 2) + (define r-386-got32 3) + (define r-386-plt32 4) + (define r-386-gotpc 10) + (define r-386-gotoff 9) + (define shn-undef 0) + +; wrappers for symbols that begin with a period, since r5rs doesn't +; allow you to actually write such symbols literally + (define dot-text (string->symbol ".text")) + (define dot-data (string->symbol ".data")) + (define dot-bss (string->symbol ".bss")) + (define dot-symtab (string->symbol ".symtab")) + (define dot-shstrtab (string->symbol ".shstrtab")) + (define dot-rel-data (string->symbol ".rel.data")) + (define dot-rel-text (string->symbol ".rel.text")) + (define dot-strtab (string->symbol ".strtab")) + + (define empty-symbol (string->symbol "")) + + (define (symbol<=? x y) + (string<=? (symbol->string x) (symbol->string y))) + +; Sort some of the things to ensure identical orders of entries regardless of the particular scheme implementation (hash-table-values) + (define (quicksort-records lst acc pred) + (if (or (null? lst) (null? (cdr lst))) + lst + (let ((p (car lst))) + (let iter ((r (cdr lst)) (l '()) (g '())) + (cond ((null? r) (append (quicksort-records l acc pred) + (cons p (quicksort-records g acc pred)))) + ((pred (acc (car r)) (acc p)) + (iter (cdr r) (cons (car r) l) g)) + (else (iter (cdr r) l (cons (car r) g)))))))) + +; Return a new empty elf string table. Elf string tables consists of +; \nul, followed by \nul-terminated strings. + (define (make-string-table) + (let ((table (make-pushdown-stack))) + (push-stack-push table 0) + table)) + +; Enter a symbol in a string-table and return its index + (define (string-table-set! table symbol) + (let ((return-ndx (push-stack-size table))) + (push-stack-push table (map char->integer + (string->list (symbol->string symbol)))) + (push-stack-push table 0) + return-ndx)) + +; Entries-tables map symbols or section-names to their row in the +; appropriate table (sym-table or sh-table) in the image + (define (make-entries-table) (cons 0 (make-hash-table))) + + (define (entry-set! entries-table symbol) + (hash-table-set! (cdr entries-table) symbol (car entries-table)) + (set-car! entries-table (+ (car entries-table) 1))) + + (define (entry-ref entries-table symbol) + (hash-table-ref (cdr entries-table) symbol)) + + (define number-of-entries car) + + (let ((image (make-pushdown-stack)) + (strtab (make-string-table)) + (sh-strtab (make-string-table)) + (e-shoff-patcher #f) + (e-shnum-patcher #f) + (e-shstrndx-patcher #f) + (sh-table (make-pushdown-stack)) + (sh-table-entries (make-entries-table)) + (sym-table (make-pushdown-stack)) + (sym-table-entries (make-entries-table))) + + +; Add a section header. There should 10 fields: sh-name sh-type +; sh-flags sh-addr sh-offset sh-size sh-link sh-info sh-addralign and +; sh-entsize + (define (section-header-set! name . fields) + (for-each (lambda (field) + (push-stack-push sh-table (number->byte-list field 4))) + fields) + (entry-set! sh-table-entries name)) + +; Add a symbol + (define (sym-table-set! name + strtab-ndx value size info other ndx) + (for-each (lambda (field) + (push-stack-push sym-table + (number->byte-list field 4))) + (list strtab-ndx value size)) + (for-each (lambda (field) + (push-stack-push sym-table field)) + (list info other)) + (push-stack-push sym-table (number->byte-list ndx 2)) + (entry-set! sym-table-entries name)) + +; Add a list of symbols + (define (make-sym-entries sym-lst scope) + (for-each + (lambda (symbol) + (sym-table-set! (sassy-symbol-name symbol) + (string-table-set! strtab (sassy-symbol-name symbol)) + (or (sassy-symbol-offset symbol) stn-undef) + (or (sassy-symbol-size symbol) 0) + (+ (ash scope 4) + (case (sassy-symbol-section symbol) + ((data) stt-object) + ((text) stt-func) + (else stt-notype))) + 0 + (case (sassy-symbol-section symbol) + ((heap) (entry-ref sh-table-entries dot-bss)) + ((data) (entry-ref sh-table-entries dot-data)) + ((text) (entry-ref sh-table-entries dot-text)) + (else shn-undef)))) + sym-lst)) + +; Filter a list of records into two separate lists according to +; (getter field-val). Return 2 values (lists) + (define (split-list-of-records list-of-records getter field-val) + (let iter ((rest list-of-records) + (win '()) + (lose '())) + (cond ((null? rest) (values win lose)) + ((eq? field-val (getter (car rest))) + (iter (cdr rest) + (cons (car rest) win) + lose)) + (else (iter (cdr rest) + win + (cons (car rest) lose)))))) + +; Dispatch on the reloc type and name to push an elf-reloc on to the image + (define (push-reloc reloc) + (let ((get-reloc-name + (lambda (name) + (case (sassy-symbol-section + (hash-table-ref (sassy-symbol-table sassy-output) + name)) + ((text) dot-text) + ((data) dot-data) + ((heap) dot-bss) + (else name)))) + (make-reloc-info + (lambda (name type) + (+ (if name + (ash (entry-ref sym-table-entries name) 8) + 0) + (case type + ((abs) r-386-32) + ((rel) r-386-pc32) + ((gotpc) r-386-gotpc) + ((gotoff) r-386-gotoff) + ((got32) r-386-got32) + ((plt32) r-386-plt32)))))) + (push-stack-push image (number->byte-list (sassy-reloc-offset reloc) 4)) + (push-stack-push + image + (number->byte-list + (case (sassy-reloc-type reloc) + ((abs) + (make-reloc-info (if (not (sassy-reloc-name reloc)) + (case (sassy-reloc-section reloc) + ((data) dot-data) + ((text) dot-text)) +; dot-text + (get-reloc-name (sassy-reloc-name reloc))) + 'abs)) + ((rel) + ((sassy-reloc-patcher reloc) -4) + (make-reloc-info (sassy-reloc-name reloc) 'rel)) + ((gotoff) (make-reloc-info (get-reloc-name (sassy-reloc-name reloc)) + 'gotoff)) + ((gotpc) (make-reloc-info (sassy-reloc-name reloc) 'gotpc)) + ((got32) (make-reloc-info (sassy-reloc-name reloc) 'got32)) + ((sym32) (make-reloc-info (sassy-reloc-name reloc) 'abs)) + ((plt32) + ((sassy-reloc-patcher reloc) -4) + (make-reloc-info (sassy-reloc-name reloc) 'plt32))) + 4)))) + +; All setup - now to start building: + +; Create some null entries + + (section-header-set! empty-symbol 0 0 0 0 0 0 0 0 0 0) + (sym-table-set! empty-symbol 0 0 0 0 0 0) + (sym-table-set! 'sh-null 0 0 0 stt-section stb-local shn-abs) + +; Build elf-header and patchers for later, and pad it. + + (push-stack-push image (list 127 69 76 70 1 1 1 0 0 0 0 0 0 0 0 + 0 1 0 3 0 1 0 0 0 0 0 0 0 0 0 0 0)) + + (set! e-shoff-patcher (push-stack-push->patcher image (list 0 0 0 0))) + + (push-stack-push image (list 0 0 0 0 52 0 0 0 0 0 40 0)) + + (set! e-shnum-patcher + (push-stack-push->patcher image (number->byte-list 0 2))) + + (set! e-shstrndx-patcher + (push-stack-push->patcher image (number->byte-list 0 2))) + + (push-stack-align image 16 0) + +; Handle the heap section + + (if (not (zero? (sassy-heap-size sassy-output))) + (begin + (section-header-set! dot-bss + (string-table-set! sh-strtab dot-bss) + sht-nobits + (+ shf-write shf-alloc) + 0 + (push-stack-size image) + (sassy-heap-size sassy-output) + 0 + 0 + (sassy-heap-align sassy-output) + 0) + (sym-table-set! dot-bss 0 0 0 stt-section stb-local + (entry-ref sh-table-entries dot-bss)))) + +; Handle the data section + + (if (not (zero? (sassy-data-size sassy-output))) + (begin + (section-header-set! dot-data + (string-table-set! sh-strtab dot-data) + sht-progbits + (+ shf-write shf-alloc) + 0 + (push-stack-size image) + (sassy-data-size sassy-output) + 0 + 0 + (sassy-data-align sassy-output) + 0) + (sym-table-set! dot-data 0 0 0 stt-section stb-local + (entry-ref sh-table-entries dot-data)) + (push-stack-append! image (sassy-data-stack sassy-output)) + (push-stack-align image 16 0))) + +; Handle the text section + + (if (not (zero? (sassy-text-size sassy-output))) + (begin + (section-header-set! dot-text + (string-table-set! sh-strtab dot-text) + sht-progbits + (+ shf-execinstr shf-alloc) + 0 + (push-stack-size image) + (sassy-text-size sassy-output) + 0 + 0 + (sassy-text-align sassy-output) + 0) + (sym-table-set! dot-text 0 0 0 stt-section stb-local + (entry-ref sh-table-entries dot-text)) + (push-stack-append! image (sassy-text-stack sassy-output)) + (push-stack-align image 16 0))) + +; Handle the symbol table + + (call-with-values + (lambda () (split-list-of-records + (hash-table-values (sassy-symbol-table sassy-output)) + sassy-symbol-scope + 'local)) + (lambda (locals globals) + (define last-local (number-of-entries sym-table-entries)) + (make-sym-entries (quicksort-records locals sassy-symbol-name symbol<=?) + stb-local) + (set! last-local (number-of-entries sym-table-entries)) + (make-sym-entries (quicksort-records globals + sassy-symbol-name + symbol<=?) + stb-global) + (section-header-set! dot-symtab + (string-table-set! sh-strtab dot-symtab) + sht-symtab + 0 + 0 + (push-stack-size image) + (push-stack-size sym-table) + ;strtab up next + (+ 1 (number-of-entries sh-table-entries)) + last-local + 4 + 16) + (push-stack-append! image sym-table) + (push-stack-align image 16 0))) + +; Handle strtab + + (section-header-set! dot-strtab + (string-table-set! sh-strtab dot-strtab) + sht-strtab + 0 + 0 + (push-stack-size image) + (push-stack-size strtab) + 0 + 0 + 1 + 0) + (push-stack-append! image strtab) + (push-stack-align image 16 0) + +; Handle the relocations table + + (call-with-values + (lambda () (split-list-of-records (sassy-reloc-list sassy-output) + sassy-reloc-section + 'data)) + (lambda (datas texts) + (if (not (null? datas)) + (let ((current-offset (push-stack-size image))) + (for-each push-reloc (quicksort-records datas sassy-reloc-offset + <=)) + (section-header-set! dot-rel-data + (string-table-set! sh-strtab dot-rel-data) + sht-rel + 0 + 0 + current-offset + (- (push-stack-size image) current-offset) + (entry-ref sh-table-entries dot-symtab) + (entry-ref sh-table-entries dot-data) + 4 + 8) + (push-stack-align image 16 0))) + (if (not (null? texts)) + (let ((current-offset (push-stack-size image))) + (for-each + (lambda (reloc) +; skip 'rel relocs in the text section unless their targets are +; symbols with an unknown offset (imported, or undefined and exported, +; like _GLOBAL_OFFSET_TABLE) + (when (not (and (eq? 'rel (sassy-reloc-type reloc)) + (or (and (sassy-reloc-name reloc) + (sassy-symbol-offset + (hash-table-ref (sassy-symbol-table + sassy-output) + (sassy-reloc-name + reloc) + (lambda () #f)))) + (not (sassy-reloc-name reloc))))) + (push-reloc reloc))) + (quicksort-records texts sassy-reloc-offset <=)) + (section-header-set! dot-rel-text + (string-table-set! sh-strtab dot-rel-text) + sht-rel + 0 + 0 + current-offset + (- (push-stack-size image) current-offset) + (entry-ref sh-table-entries dot-symtab) + (entry-ref sh-table-entries dot-text) + 4 + 8) + (push-stack-align image 16 0))))) + +; Handle sh-strtab + + (let ((index (string-table-set! sh-strtab dot-shstrtab))) + (section-header-set! dot-shstrtab + index + sht-strtab + 0 + 0 + (push-stack-size image) + (push-stack-size sh-strtab) + 0 + 0 + 1 + 0) + (push-stack-append! image sh-strtab) + (push-stack-align image 16 0)) + +; Patch the elf-header + + (e-shoff-patcher (number->byte-list (push-stack-size image) 4)) + (e-shnum-patcher (number->byte-list (number-of-entries sh-table-entries) 2)) + (e-shstrndx-patcher (number->byte-list (entry-ref sh-table-entries + dot-shstrtab) + 2)) + +; Handle the section-header table ... + + (push-stack-append! image sh-table) + +; ... and A-WAY-YAY we go!!!! + + (if (file-exists? output-file) + (delete-file output-file)) + + (with-output-to-file output-file + (lambda () + (for-each (lambda (byte) + (write-byte byte)) + (push-stack-items image)))) + + )) ;end sassy-make-elf diff --git a/module/language/sassy/extras.scm b/module/language/sassy/extras.scm new file mode 100644 index 000000000..1b5b32d31 --- /dev/null +++ b/module/language/sassy/extras.scm @@ -0,0 +1,43 @@ +; extras.scm - utility procedures for Sassy +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +;==============; +; ; +; Extras ; +; ; +;==============; +(define-syntax when + (syntax-rules () + ((_ test conseq ...) (if test (begin conseq ...))))) + +(define (read-file file) + (with-input-from-file file + (lambda () + (let iter ((next (read))) + (if (eof-object? next) + '() + (cons next (iter (read)))))))) + diff --git a/module/language/sassy/flat-bin.scm b/module/language/sassy/flat-bin.scm new file mode 100644 index 000000000..410f4573b --- /dev/null +++ b/module/language/sassy/flat-bin.scm @@ -0,0 +1,163 @@ +; flat-bin.scm - create bin files from Sassy's output +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module flat-bin +; import api +; export all + + + +; This is a good demonstration of how to use the output API, and we +; should probably include it in chapter 7 of the docs. + +; usage: + +; procedure: +; (sassy-make-bin output-file sassy-output opts ...) => unspecified + +; Combines the text and data sections of sassy-output and writes a +; flat binary file to output-file. If the file already exists it is +; deleted. Any (org) directive is taken into account, and relocations +; are performed on absolute references in the data section. The data +; segment is placed (and aligned properly) immediately after the text +; segment. + +; opts can be none, one or both of the following quoted symbols: + +; 'boot : Make the file be an x86 boot-sector. That is, zero-fill the +; remainder of the file to 510 bytes, and add the x86 boot-sector +; signature #x55aa to bytes 511 and 512. + +; 'stats : Display some stats about the output. + + + +(define (sassy-make-bin output-file sassy-output . opts) + + (define boot-sector? (memq 'boot opts)) + (define stats? (memq 'stats opts)) + + (define data? (not (zero? (sassy-data-size sassy-output)))) + + ; Grap some info for printout stats later. + + (define text-size (sassy-text-size sassy-output)) + (define data-size (sassy-data-size sassy-output)) + (define text-pad 0) + + (define (display-stat . itms) + (for-each display itms) + (newline)) + + (define (needed-reloc? x) + (and (eq? 'abs (sassy-reloc-type x)) + (let ((name (sassy-reloc-name x))) + (if name + (let ((symbol (sassy-symbol-exists? sassy-output name))) + (and (eq? 'data (sassy-symbol-section symbol)) + (not (eq? 'import (sassy-symbol-scope symbol))))) + (eq? 'data (sassy-reloc-section x)))))) + + ; Align the end of the text-section to the align of the data section. + ; The data section will begin at this point in the file. + ; (nop) is used as the filler. + + (when data? + (push-stack-align (sassy-text-stack sassy-output) + (sassy-data-align sassy-output) + #x90)) + + (set! text-pad (- (sassy-text-size sassy-output) text-size)) + + ; Since the text-section is going to be loaded at whatever the given + ; (org) was, all absolute relocations in the text section that refer + ; to other locations in the text section already have the offset of + ; (org) added to them, so we don't have to apply relocations to + ; those. And we don't need to relocate relative addresses in the + ; text section (and relative relocations aren't allowed in the data + ; section). + + ; So, we only need to relocate references to symbols defined in the data + ; section, or anonymous relocs in the data section + + ; Also, we need to grab all those references both from the + ; text-section _and_ the _data_ section + + (when data? + (let ((data-relocs-to-do + (filter needed-reloc? (sassy-reloc-list sassy-output)))) + + ; Now we get ready to apply the relocations taking into account the new + ; end of the text-section (or beginning of the data-section). + + ; For each reloc-to-do, we're going to apply it's patcher + ; to the the data-offset plus the value already there + + (let* ((text-offset (sassy-text-org sassy-output)) + (data-offset (+ text-offset (sassy-text-size sassy-output)))) + (for-each (lambda (reloc) + ((sassy-reloc-patcher reloc) + (+ data-offset (sassy-reloc-value reloc)))) + data-relocs-to-do)) + + ; Now all we have to to is append the data to the text, mark it as + ; a boot sectior, and spit it out. + + ; The fastest way to tack a data section on to a text section is + ; the following + ; !!!!NOTE: This actually alters the text section (append!) + (push-stack-append! (sassy-text-stack sassy-output) + (sassy-data-stack sassy-output)))) + + (when boot-sector? + ; sanity check + (if (> (sassy-text-size sassy-output) 510) + (error "segment too big for a boot sector") + (begin + ; mark it as a boot sector + (push-stack-align (sassy-text-stack sassy-output) 510 0) + (push-stack-push (sassy-text-stack sassy-output) + (list #x55 #xaa))))) + + ; dump to file + (when (file-exists? output-file) + (delete-file output-file)) + (with-output-to-file output-file + (lambda () + (for-each write-byte (sassy-text-list sassy-output)))) + + (when stats? + (display-stat "Text size: " text-size " bytes") + (display-stat "Data size: " data-size " bytes") + (display-stat "Data align: " + (sassy-data-align sassy-output) + " byte boundary") + (display-stat + "Total size: " + (+ text-size data-size text-pad) + " bytes, with " text-pad " bytes of padding in the text section.") + (when boot-sector? + (display-stat "Made a boot sector")))) diff --git a/module/language/sassy/intern.scm b/module/language/sassy/intern.scm new file mode 100644 index 000000000..cffa611ec --- /dev/null +++ b/module/language/sassy/intern.scm @@ -0,0 +1,140 @@ +; intern.scm - private api functions for Sassy +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module intern +; import api push-stacks srfi-69 +; export all + + + + +; Looks up symbol-name (a scheme symbol) in the symbol-table of +; sassy-output. If no record exists for that name, it creates a fresh +; one, in the table. Then for each item in the list of field-value +; pairs, it sets the corresponding field of the sassy-symbol to the +; value (or in the case of the 'unres field, adds the value to the +; list stored there). The pairs must be proper lists. The result is +; the sassy-symbol that was modified. + +; Anytime a new offset is given via the field-pair '(offset <value>), +; all the back-patchers stored in the unres field of the sassy-symbol are +; applied to the <value>. +(define (sassy-symbol-set! sassy-output symbol-name . list-of-field-pairs) + (let ((exists (sassy-symbol-exists-env? sassy-output symbol-name))) + (when (not exists) + (set! exists (make-sassy-symbol symbol-name 'local #f #f #f '() #f)) + (let iter ((t (sassy-symbol-table sassy-output))) + (if (hash-table? (car t)) + (hash-table-set! (car t) symbol-name exists) + (iter (cdr t))))) + (for-each + (lambda (field-pair) + (case (car field-pair) + ((name) (sassy-symbol-name-set! exists (cadr field-pair))) + ((scope) (sassy-symbol-scope-set! exists (cadr field-pair))) + ((section) (sassy-symbol-section-set! exists (cadr field-pair))) + ((size) (sassy-symbol-size-set! exists (cadr field-pair))) + ((offset) + (sassy-symbol-offset-set! exists (cadr field-pair)) + (for-each (lambda (back-patcher) + (back-patcher (cadr field-pair))) + (sassy-symbol-unres exists))) + ((unres) + (sassy-symbol-unres-set! + exists (cons (cadr field-pair) (sassy-symbol-unres exists)))) + ((exp) (sassy-symbol-exp-set! exists (cadr field-pair))))) + list-of-field-pairs) + exists)) + +(define (sassy-symbol-exists-env? sassy-output name) + (let iter ((rst (sassy-symbol-table sassy-output))) + (cond ((hash-table? (car rst)) + (hash-table-ref (car rst) name (lambda () #f))) + ((eq? name (sassy-symbol-name (car rst))) (car rst)) + (else (iter (cdr rst)))))) + +(define (sassy-symbol-defined? sassy-output name) + (let ((maybe (sassy-symbol-exists-env? sassy-output name))) + (cond ((not maybe) #f) + ((eq? 'import (sassy-symbol-scope maybe)) #t) + ((sassy-symbol-offset maybe) #t) + (else #f)))) + +(define (sassy-symbol-def-error sassy-output name) + (or (not (sassy-symbol-defined? sassy-output name)) + (error "re-definition of a previously defined/imported symbol" name))) + +(define new-block + (let ((c 0)) + (lambda () ; should use native gensym + (let ((n (string->symbol (string-append "%!%!%!block" + (number->string c))))) + (set! c (+ c 1)) + n)))) + +; extra-proc is a proc of one argument that does something with each +; new sassy-symbol record, or #f +(define (setup-locals locals outp extra-proc) + (let* ((newb (new-block)) + (old-env (sassy-symbol-table outp)) + (restore! (lambda () + (sassy-symbol-table-set! outp old-env)))) + (sassy-symbol-table-set! + outp + (let iter ((rest locals)) + (if (null? rest) + old-env + (let ((new-sym (make-sassy-symbol + (valid-label (car rest)) newb 'text #f #f '() #f))) + (if extra-proc + (extra-proc new-sym)) + (cons new-sym (iter (cdr rest))))))) + restore!)) + +(define valid-label + (let ((keywords '(seq begin inv if iter while with-win + with-lose with-win-lose esc + mark leap label))) + (lambda (x) (or (and (symbol? x) + (not (member x keywords)) + x) + (error "sassy: invalid label" x))))) + +(define (get-reloc-target target outp) + (if (symbol? target) + (let ((s (sassy-symbol-exists-env? outp target))) + (if s + (case (sassy-symbol-scope s) + ((local import export) target) + (else #f)) + target)) + #f)) + +(define (check-label-size size cur-byte-size key label) + (if (not (= size cur-byte-size)) + (error + "wrong data size for label or custom reloc under " + `(bits ,(* 8 cur-byte-size)) (list key label)))) diff --git a/module/language/sassy/macros.scm b/module/language/sassy/macros.scm new file mode 100644 index 000000000..ea586d9b4 --- /dev/null +++ b/module/language/sassy/macros.scm @@ -0,0 +1,136 @@ +; macros.scm - Sassy's macro system +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module macros +; import srfi-69 intern +; import-syntax meta-lambda +; export sassy-expand + +(define sassy-expand + (let + ((sassy-internal-macros ; permanent macros + (alist->hash-table + `((< . ,(lambda (a b) `(seq (cmp ,a ,b) l!))) + (<= . ,(lambda (a b) `(seq (cmp ,a ,b) le!))) + (> . ,(lambda (a b) `(seq (cmp ,a ,b) g!))) + (>= . ,(lambda (a b) `(seq (cmp ,a ,b) ge!))) + (= . ,(lambda (a b) `(seq (cmp ,a ,b) e!))) + (!= . ,(lambda (a b) `(seq (cmp ,a ,b) ne!))) + (zero? . ,(lambda (x) `(seq (test ,x ,x) z!))) + (asciiz . ,(lambda (x) `(bytes ,x 0))) + (alt . ,(lambda x `(inv (seq ,@(map (lambda (y) + `(inv ,y)) + x))))) + (times . ,(lambda (num e) + (cons 'begin (make-list num e)))) + (until . ,(lambda (test body) `(while (inv ,test) ,body))) + + (cs: . ,(lambda rst `(cs (& ,@rst)))) + (ds: . ,(lambda rst `(ds (& ,@rst)))) + (ss: . ,(lambda rst `(ss (& ,@rst)))) + (es: . ,(lambda rst `(es (& ,@rst)))) + (fs: . ,(lambda rst `(fs (& ,@rst)))) + (gs: . ,(lambda rst `(gs (& ,@rst)))) + + (_global_offset_table_ . ,(string->symbol "_GLOBAL_OFFSET_TABLE_")) + (get-got . (seq (call $eip) + (pop ebx) + (add ebx (reloc gotpc _global_offset_table_ 3)))) + (got-offset . ,(lambda (sym . vals) + `(reloc gotoff ,sym ,(if (null? vals) + 0 + (apply + vals))))) + (got . ,(lambda (symbol) `(reloc got32 ,symbol))) + (plt . ,(lambda (symbol) `(reloc plt32 ,symbol))) + (sym . ,(lambda (symbol) `(reloc sym32 ,symbol))))))) + + (letrec + ;sassy-user-macros is updated with a new hash-table every time + ;sassy is called, but since it keeps the last table around, + ;you can call sassy-expand yourself to see how something got + ;expanded + ((sassy-user-macros (make-hash-table)) + + (make-sassy-macro + (meta-lambda + (or (and 'lambda __ (lambda x + (eval `(lambda ,@x) + (interaction-environment)))) + ,@?))) + + (macro? (lambda (x) + (and (symbol? x) + (or (hash-table-ref + sassy-user-macros x (lambda () #f)) + (hash-table-ref + sassy-internal-macros x (lambda () #f)))))) + + (call-macro (lambda (macro-call args) + (expand (if (procedure? macro-call) + (apply macro-call args) + (cons macro-call args))))) + (do-scheme-call (lambda (scheme-call) + (expand + (eval scheme-call + (interaction-environment))))) + + (symbol-or-expand (lambda (x) (if (pair? x) (expand x) x))) + (atom? (lambda (x) (not (pair? x)))) + + (expand + (meta-lambda + (or (and ,@macro? (lambda (constant) (expand constant))) + ,@atom? + (and 'label symbol-or-expand (* expand) + (lambda (label rest) + `(label ,label ,@rest))) + (and 'locals ((* symbol-or-expand)) (* expand) + (lambda (decs rest) + `(locals ,decs ,@rest))) + (and '! ? (lambda (scheme-call) (do-scheme-call scheme-call))) + (and 'macro symbol? ? + (lambda (macro-name macro-body) + (hash-table-set! sassy-user-macros macro-name + (make-sassy-macro macro-body)) + 'void)) + (and macro? (* expand) (lambda (macro-call args) + (call-macro macro-call args))) + (and ((and '! ?)) (* expand) + (lambda (scheme-call tail) + (let ((new-head (do-scheme-call scheme-call))) + (cond ((macro? new-head) => + (lambda (mac) + (call-macro mac tail))) + ((procedure? new-head) + (call-macro new-head tail)) + (else (cons new-head tail)))))) + (and ? (* expand) (lambda (head tail) (cons head tail))) + )))) + + (lambda (list-or-hashtable) + (if (hash-table? list-or-hashtable) + (set! sassy-user-macros list-or-hashtable) + (expand list-or-hashtable)))))) diff --git a/module/language/sassy/main.scm b/module/language/sassy/main.scm new file mode 100644 index 000000000..2eff0ebac --- /dev/null +++ b/module/language/sassy/main.scm @@ -0,0 +1,58 @@ +; main.scm - Sassy's main +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module parse +; import macros api parse +; export sassy + +;=======================; +; ; +; Sassy Main ; +; ; +;=======================; +(define (sassy input) + (let ((output (make-sassy-output + (list (make-hash-table)) ; empty symbol table + '() ; empty reloc list + #f ; no entry point + (make-pushdown-stack) ; empty data stack + (make-pushdown-stack) ; empty text stack + 4 ; default heap align + 4 ; default data align + 16 ; default text align + 0 ; initial heap size + 0 ; default text org + 32))) ; default bits size + + (sassy-expand (make-hash-table)) ; install fresh macro table + + (cond ((string? input) (parse-directives (read-file input) output)) + ((pair? input) (parse-directives input output)) + (else (error "sassy: bad input" input))) + + (sassy-symbol-table-set! output (car (sassy-symbol-table output))) + + output)) diff --git a/module/language/sassy/meta-lambda.scm b/module/language/sassy/meta-lambda.scm new file mode 100644 index 000000000..3b19c57fa --- /dev/null +++ b/module/language/sassy/meta-lambda.scm @@ -0,0 +1,491 @@ +; meta-lambda.scm - A simple parser generator +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module meta-lambda +; export-syntax meta-lambda case-meta-lambda memoize + +; Meta-lambda +; Another Henry Baker-inspired hack. see: +; http://home.pipeline.com/~hbaker1/Prag-Parse.html + +; See after the code for documentation + + +(define-syntax meta-expand + (syntax-rules (or and lambda begin quote unquote + unquote-splicing __ ? + * ?* else) + ((_ p i r (quote a)) (and (not (null? i)) + (pair? i) + (equal? 'a (car i)) + (begin (set! i (cdr i)) #t))) + ((_ p i r (unquote a)) (and (not (null? i)) + (pair? i) + (equal? a (car i)) + (begin (set! i (cdr i)) #t))) + ((_ p i r (unquote-splicing a)) (begin (set! i (list i)) + (meta-expand p i r a))) + ((_ p i r (or a ...)) (let ((ti i) (tp p)) + (or (or (meta-expand p i r a) + (begin (set! i ti) + (set-cdr! tp '()) + (set! p tp) + #f)) + ...))) + ((_ p i r (and a ...)) (and (meta-expand p i r a) ...)) + ((_ p i r (lambda a b ...)) (and (null? i) + (apply (lambda a b ...) (cdr r)))) + ((_ p i r (begin a b ...)) (and (null? i) (begin a b ...))) + ((_ p i r (else a)) (let ((tmp (a i))) + (set! i '()) + tmp)) + ((_ p i r (+ a)) (let* ((nr (list #t)) + (np nr)) + (and (meta-expand np i nr a) + (do () ((not (meta-expand np i nr a)) + (set! nr (list (cdr nr))) + (set-cdr! p nr) + (set! p nr) + #t))))) + ((_ p i r (* a)) (let* ((nr (list #t)) + (np nr)) + (do () ((not (meta-expand np i nr a)) + (set! nr (list (cdr nr))) + (set-cdr! p nr) + (set! p nr) + #t)))) + ((_ p i r (?* a)) (or (meta-expand p i r a) + #t)) + ((_ p i r ()) (null? i)) + ((_ p i r (a)) (and (not (null? i)) + (pair? i) + (cond (((meta-lambda a) (car i)) => + (lambda (res) + (if (not (eq? #t res)) + (begin (set! res (list res)) + (set-cdr! p res) + (set! p res))) + (set! i (cdr i)) + #t)) + (else #f)))) + ((_ p i r __) (if (or (pair? i) (null? i)) + (begin (set-cdr! p i) (set! p i) (set! i '()) '__tail) + #f)) + ((_ p i r ?) (and (not (null? i)) + (pair? i) + (let ((t (list (car i)))) + (set-cdr! p t) + (set! p t) + (set! i (cdr i)) + #t))) + ((_ p i r x) (let-syntax ((test (syntax-rules () + ((test x w l) w) + ((test y w l) l)))) + (test __fubar__ + (and (not (null? i)) + (pair? i) + (cond ((x (car i)) => + (lambda (res) + (let ((tmp (if (eq? res #t) + (list (car i)) + (list res)))) + (set-cdr! p tmp) + (set! p tmp) + (set! i (cdr i)) #t))) + (else #f))) + (and (not (null? i)) + (pair? i) + (equal? x (car i)) + (begin (set! i (cdr i)) #t))))))) + +(define-syntax meta-lambda + (syntax-rules () + ((meta-lambda grammar) + (lambda (i) + (let* ((r (list #t)) + (p r)) + (cond ((meta-expand p i r grammar) + => (lambda (res) + (if (null? i) + (if (eq? res #t) + (cond ((null? (cdr r)) #t) + ((null? (cddr r)) (cadr r)) + (else (cdr r))) + (if (eq? res '__tail) (cdr r) res)) + #f))) + (else #f))))))) + +; var-arity meta-lambda +(define-syntax meta-lambda-dot + (syntax-rules () + ((_ x y ...) (lambda args + (let ((tmp (meta-lambda x y ...))) + (tmp args)))))) + +; Something useful to wrap meta-lambda in to hurry things along. +; Of course only use this when not using side-effects. +(define-syntax memoize + (syntax-rules () + ((_ proc) + (let ((the-proc proc)) + (let ((last-in '%#$%#%#$%) + (last-out #f)) + (lambda (arg2) + (if (eq? arg2 last-in) + last-out + (begin (set! last-in arg2) + (set! last-out (the-proc arg2)) + last-out)))))))) + +; |===========| +; |Meta-lambda| +; |===========| + +; Meta-lambda is a macro for building parsers and pattern matchers +; over lists or single items. You can also specify "actions" to be +; performed when a list has been successfully parsed, so it can also +; function as a very rudimentary compiler-generator or +; attribute-grammar-generator (using synthesized attributes). + +; It's really for constructing simple embedded langauges, and it has its +; limitations if your're not willing to factor out tougher grammars by +; hand. But I've found it useful. + +; Here's a simple example so you can see where this is going: + +; |=====| +; |Usage| +; |=====| + +; meta-lambda grammer -> procedure + +; Grammars are described below. The procedure generated is a procedure +; of one argument. When applied to an item (usually a list), it attempts +; to match the grammar with the list and perform any actions specified +; if it was able to completely match all the items in the list (to the +; end of the list). If the list or item can not be matched completely, +; the procedure returns #f. + +; |==============| +; |The Basic Idea| +; |==============| + +; Meta-lambda distinguishes between literals, and identifiers it expects +; to be bound to "predicate-like" procedures. These are procedures of one +; argument that return either #t or #f (like the usual scheme +; predicates like symbol? or number?), or another value. + +; As it processes each input-item and the accompanying grammar-item, if +; the grammar-item is a literal that is equal? to the input-item, then +; meta-lambda accepts the match but discards the input item. + +; If the grammar-item is a predicate-procedure, then meta-lambda applies +; that procedure to the input-item. If the result is #f, the match +; fails. If the result is #t, meta-lambda saves the input item in an +; internal accumulator-stack. If the result is any other value, +; meta-lambda saves that value in the stack, instead of the input item. + +; Then, when and if the list is empty and meta-lambda encounters an +; action (expressed as a lambda expression in the grammar), meta-lambda +; applies that lambda expression to the items in the stack, and returns +; the result. (The "stack" is a list). Thus if a lambda-expression is +; supplied as an action it must contain as many arguments as there were +; predicate-procedures preceeding it. + +; Since lambda-expression's denote actions to be taken at the end of a +; match (when the input-list is null), predicate procedures must be +; expressed by writing the identifier they are bound to. (No anonymous +; predicates!) + +; You don't have to supply an action. In that case, if the stack is +; empty, meta-lambda returns true. If there is one item on the stack, +; meta-lambda returns that item. Otherwise, it returns the whole stack +; (as a list). + +; There are other options, but that's the gist of it. + +; (define match-foo-bar +; (meta-lambda +; (and 'foo 'bar (lambda () 'tada)))) + +; (match-foo-bar '(foo bar)) => 'tada +; (match-foo-bar '(3 cat dog)) => #f + +; (define match-symbol-number-foo +; (meta-lambda +; (and symbol? number? 'foo (lambda (sym num) +; (string-append (symbol->string sym) +; (number->string num)))))) + +; (match-symbol-number-foo '(cat 3 foo)) => "cat3" +; (match-symbol-number-foo '(cat foo foo)) => #f + +; (define both-of-em +; (meta-lambda +; (and match-foo-bar match-symbol-number-foo))) + +; (both-of-em '((foo bar) (cat 3 foo))) => '(tada "cat3") + +; |========| +; |Grammars| +; |========| + +; grammar = (or <grammar> ...) ;choice +; | (and <grammer> ...) ;sequence +; | (+ <grammar>) ;kleene+ +; | (* <grammar>) ;kleene* +; | (?* <grammar>) ;kleene? +; | <literal> ;literals +; | <identifier> ;predicate-binding +; | () ;end-of-list +; | ? ;anything +; | __ ;rest-of-list +; | (<grammar>) ;sublist +; | (unquote <identifier>) ;location +; | (unquote-splicing <grammer>) ;not-a-list +; | <action> ;result action +; | (else <procedure>) ;else-clause + +; action = (lambda <formals> <body>) +; | (begin <sequence>) + +; literal = (quote <scheme datum>) +; | <char> +; | <number> +; | <string> + +; |==================| +; |The usual suspects| +; |==================| + +; choice +; ====== + +; (or <grammar> ...) + +; Try to match each grammar against the input in order. If a match +; fails, backtrack on the input and revert the stack. + +; sequence +; ======== + +; (and <grammer> ...) + +; Match each grammar against an item in the input, failing as soon as a +; match fails + +; literals +; ======== + +; 'cat 'dog "three" 34 #\a '(a b c) etc. + +; Compare the input item with the literal using equal?, and discard the +; input and proceed if the result is #t, otherwise fail + +; identifier +; ========== + +; symbol? number? boolean? match-and-do-something + +; The identifier should be bound to a procedure of one argument that +; returns one value. If the result of applying the procedure to the next +; input item is #f, then fail. If the result is #t, then save the +; input-item on the stack and proceed. If the result is any other value, +; save that value on the stack in place of the input item, and proceed. + +; action +; ====== + +; (lambda (x y) <stuff>) +; (begin (display "foo") (narfle! garthaks)) + +; If there is any input remaining, these immediately fail. Otherwise, if +; a "lambda", apply the lambda to the accumulated stack of +; predicate-matched items and return the result. If a "begin", ignore +; the stack and perform the sequence, returning the result. + +; |================| +; |Useful additions| +; |================| + +; kleene-star +; =========== + +; (* <grammar>) + +; Match zero or more occurrences of the grammar, and place the list of +; the results on the stack. + +; kleene-plus +; =========== + +; (* <grammar>) + +; Match one or more occurrences of the grammar, and place the list of +; the results on the stack. (If no results than '() is placed on the +; stack). + +; kleene? +; =========== + +; (?* <grammar>) + +; Match zero or one occurrences of the grammar, and place the list of +; the results on the stack, or do nothing. + +; anything +; ======== + +; ? + +; Automatically match anything and put it on the input stack. + +; rest-of-list +; ============ + +; __ + +; Automatically match the rest of a list and place it on the input stack. +; If followed by a lambda-action, it should be a variable arity lambda in order to bind the result of the match of __. + +; (define number-and-rest +; (meta-lambda +; (and number? __ (lambda (num . rest) +; (cons num (cadr rest)))))) + +; (number-and-rest '(3 cat dog foo)) => '(3 . dog) + +; |=============| +; |Weirder stuff| +; |=============| + +; end-of-list +; =========== + +; () + +; Explicitly match the end of list and proceed. + +; sub-lists +; ========= + +; (<grammar>) + +; Ah, trees. Wrapping a parens around a grammar causes meta-lambda to +; expect a sublist. It itself can contain actions that return +; values. The sublist is matched and returns results as if you had +; written a separte meta-lambda for the sublist, and whatever it returns +; is placed on the stack as a single item. + +; (define match-lambda-one +; (meta-lambda +; (and 'lambda (symbol?) ? (lambda (formals body) +; `(forms ,@formals))))) + +; (match-lambda-one '(lambda (a) (foo a (bar b c)))) => '(forms . a) + +; (define match-lambda +; (meta-lambda +; (and 'lambda ((* symbol?)) ? (lambda (formals body) +; `(forms ,@formals))))) + +; (match-lambda '(lambda (a b c) (foo a (bar b c)))) => '(forms a b c) + +; location +; ======== + +; (unquote <identifier>) + +; This means match the literal that is bound to the identifier against +; the next input. Useful for parameterizing. + +; (define (make-foo-matcher x) +; (meta-lambda +; (and 'foo ,x))) + +; (define foo-3 (make-foo-matcher 3)) +; (define foo-cat (make-foo-matcher 'cat)) + +; (foo-3 '(foo 3)) => #t +; (foo-3 '(foo 4)) => #f + +; (foo-cat '(foo cat)) => #t +; (foo-cat '(foo 3)) => #f + +; not-a-list +; ========== + +; (unquote-splicing <grammar>) + +; Wrap the input (or the next item in the input) in a list, and then +; match. This way meta-lambda can match lists or single items. + +; (define infix +; (let ((op? (meta-lambda ;doing this for demo purposes. (case ...) +; ;is better here +; (or (and ,@'+ (begin +)) +; (and ,@'- (begin -)) +; (and ,@'* (begin *)))))) +; (meta-lambda +; (or ,@integer? +; (and infix op? infix (lambda (a op b) (op a b))))))) + +; (infix '((3 + 4) * ((6 - 3) + 4))) => 49 + +; else +; ==== + +; (else <procedure>) + +; If an else-clause is encountered, the rest of the input is immediately +; accepted, but instead of being accepted on the stack, it is +; immediately passed to <procedure>, which should be variable arity. The +; proedure's result, if it returns at all, becomes the result of the +; whole meta-lambda. + +; (define infix2 +; (let ((op? (lambda (y) +; (case y +; ((+) +) +; ((-) -) +; ((*) *))))) +; (meta-lambda +; (or ,@integer? +; (and infix op? infix (lambda (a op b) (op a b))) +; (else (lambda x (error "bad input" x))))))) + +; (infix2 '((3 + 4) * ((foo - 3) + 4))) => &error bad input (foo) + +; |======| +; |Extras| +; |======| + +; meta-lambda-dot grammer -> procedure + +; Like meta-lambda, but the procedure returned is variable arity as in: + +; (lambda x ...) + +; The match procedure is applied to the list "x" diff --git a/module/language/sassy/numbers.scm b/module/language/sassy/numbers.scm new file mode 100644 index 000000000..c2cd6f5d2 --- /dev/null +++ b/module/language/sassy/numbers.scm @@ -0,0 +1,108 @@ +; numbers.scm - Sassy's number predicates +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module numbers +; import srfi-60 +; import-syntax meta-lambda +; export all + +; also loads "other/srfi-56-pieces.scm" + +(define s-byte #f) +(define s-word #f) +(define s-dword #f) +(define s-qword #f) +(define u-byte #f) +(define u-word #f) +(define u-dword #f) +(define u-qword #f) + +(let ((signed-x (lambda (bitfield) + (lambda (number) + (and (integer? number) + (let ((tester (logand number bitfield))) + (or (zero? tester) (= tester bitfield))))))) + (unsigned-x (lambda (bitfield) + (lambda (number) + (and (integer? number) + (= bitfield (logior number bitfield))))))) + (define s-byte-x (signed-x (- (expt 2 7)))) + (define s-word-x (signed-x (- (expt 2 15)))) + (define s-dword-x (signed-x (- (expt 2 31)))) + (define s-qword-x (signed-x (- (expt 2 63)))) + (define u-byte-x (unsigned-x (- (expt 2 8) 1))) + (define u-word-x (unsigned-x (- (expt 2 16) 1))) + (define u-dword-x (unsigned-x (- (expt 2 32) 1))) + (define u-qword-x (unsigned-x (- (expt 2 64) 1))) + (let ((num-x (lambda (pred key) + (meta-lambda + (or ,@pred + (and ,key pred)))))) + (set! s-byte (memoize (num-x s-byte-x 'byte))) + (set! s-word (memoize (num-x s-word-x 'word))) + (set! s-dword (memoize (num-x s-dword-x 'dword))) + (set! s-qword (memoize (num-x s-qword-x 'qword))) + (set! u-byte (memoize (num-x u-byte-x 'byte))) + (set! u-word (memoize (num-x u-word-x 'word))) + (set! u-dword (memoize (num-x u-dword-x 'dword))) + (set! u-qword (memoize (num-x u-qword-x 'qword))))) + + +(define (u/s-byte x) (or (s-byte x) (u-byte x))) +(define (u/s-word x) (or (s-word x) (u-word x))) +(define (u/s-dword x) (or (s-dword x) (u-dword x) (real? x))) +(define (u/s-qword x) (or (s-qword x) (u-qword x) (real? x))) + + + ; The byte-list returned is little-endian +(define (number->byte-list number size) + (cond ((integer? number) (integer->byte-list number size)) + ((real? number) + (cond ((= 4 size) (float32->byte-list number)) + ((= 8 size) (float64->byte-list number)) + (else (error "bad size for float" number size)))) + (else (error "not a number sassy can assemble" number)))) + + + ; The following all return little-endian byte-lists + + ; Very few scheme implementations provide something like + ; integer->bytes or float->bytes. Those that do (including slib) + ; return a string, so I would have write: + ; (map char->integer (string->list (integer/float->bytes ...))) + ; which is less efficient for sassy. So I'm using these instead... + +(define (integer->byte-list orig-int orig-size) + (let iter ((int orig-int) (size orig-size)) + (if (zero? size) + (if (or (zero? orig-int) + (and (positive? orig-int) (zero? int)) + (and (negative? orig-int) (= -1 int))) + '() + (error "integer too big for field width" orig-int orig-size)) + (cons (logand int 255) (iter (ash int -8) (- size 1)))))) + +; (load "other/srfi-56-pieces.scm") diff --git a/module/language/sassy/opcodes.scm b/module/language/sassy/opcodes.scm new file mode 100644 index 000000000..ed8cbb994 --- /dev/null +++ b/module/language/sassy/opcodes.scm @@ -0,0 +1,1732 @@ +; opcodes.scm - Sassy's opcode parsers and code generators +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module opcodes +; import operands numbers api text-block push-stacks +; import-syntax meta-lambda +; export opcode? emit-direct emit-direct2 + + +; At first the shared vars w l t r were a quick fix to get around some +; scoping issues but lookie-lookie: this speeds things up from 4 to 10 +; times (in mzscheme, at least) so hooray local-global vars!!! +; Anywho, these are here because handle-text-symbol and +; handle-rel-symbol need them. Otherwise they would have to be passed +; through the opcode parsers and through the sub-emitters until, for +; instance handle-imm could pass them to handle-text-symbol. + +(define emit-direct #f) +(define emit-direct2 #f) +(define opcode? #f) + +(let ((w #f) ;win + (l #f) ;lose + (t #f) ;text-block + (r #f) ;output + (addr-flag #f) ;flag to emit address-size prefix + (seg-flag #f)) ;flag to emit segment override prefix + + ; only used for internally generated instructions, no error check + (define (%emit-direct instr win lose textb outp) + (set! w win) + (set! l lose) + (set! t textb) + (set! r outp) + (set! addr-flag #f) + (set! seg-flag #f) + ((hash-table-ref the-opcodes (car instr)) (cdr instr)) + (push-stack-size (t-text t))) + + ; this is the used for instructions the user wrote + (define (%emit-direct2 name opcode args win lose textb outp) + (set! w win) + (set! l lose) + (set! t textb) + (set! r outp) + (set! addr-flag #f) + (set! seg-flag #f) + (or (and (opcode args) + (push-stack-size (t-text t))) + (error "sassy: bad operands" (cons name args)))) + + (define (outc itm) (push-stack-push (t-text t) itm)) + + (define (outc-maybe-quoted-list itm) + (push-stack-push (t-text t) (if (pair? itm) (apply list itm) itm))) + + (define (check-size sizer) + (when addr-flag (outc #x67)) + (when (and (not (= sizer 1)) + (not (= sizer (/ (sassy-bits r) 8)))) + (outc #x66)) + (when seg-flag (outc seg-flag))) + + (define (handle-r/r eff-add reg) (outc (+ 192 eff-add (* 8 reg)))) + + (define (handle-imm sizer imm-value) + (cond ((number? imm-value) (outc (number->byte-list imm-value sizer))) + ((symbol? imm-value) (handle-text-symbol 'abs imm-value 0 sizer)) + (else (apply handle-text-symbol (cdr imm-value))))) + + (define (handle-text-symbol type target value . maybe-size) + (define current-byte-size (if (not (null? maybe-size)) + (car maybe-size) + (/ (sassy-bits r) 8))) + (define k? #f) + (define (setup x) + (set! k? #t) + (if (pair? x) + (if (opcode? (car x)) + (error "sassy: bad context for instruction as continuation" x) + (begin (set! type (cadr x)) + (set! target (caddr x)) + (set! value (cadddr x)))) + (set! target x))) + (case target + (($win) (setup w)) + (($lose) (setup l)) + (($eip) (setup (push-stack-size (t-text t))))) + (let* ((pnt (push-stack-push->patcher + (t-text t) + (number->byte-list value current-byte-size))) + (offs (push-stack-size (t-text t))) + (t-val (cond ((sassy-symbol-exists-env? r target) => + (lambda (x) (sassy-symbol-offset x))) + (else target))) + (a-reloc (make-sassy-reloc (get-reloc-target target r) + 'text offs type #f value + current-byte-size)) + (patcher (lambda (new) + (pnt (number->byte-list new current-byte-size)) + (sassy-reloc-value-set! a-reloc new)))) + (sassy-reloc-patcher-set! a-reloc patcher) + (push-t-reloc! t a-reloc) + (if (not k?) + (if (number? t-val) + (patcher (+ t-val value)) + (sassy-symbol-set! + r target `(unres ,(lambda (n) (patcher (+ n value)))))) + (push-t-res! + t (cons t-val (lambda (n) (patcher (+ n value)))))))) + + (define (handle-rel-symbol sizer type target value) + (define k? #f) + (define (setup x) + (set! k? #t) + (if (pair? x) + (if (opcode? (car x)) + (error "sassy: bad context for instruction as continuation" x) + (begin (set! type (cadr x)) + (set! target (caddr x)) + (set! value (cadddr x)))) + (set! target x))) + (case target + (($win) (setup w)) + (($lose) (setup l)) + (($eip) (setup (push-stack-size (t-text t))))) + (let* ((offs (push-stack-size (t-text t))) + (pnt (push-stack-push->patcher (t-text t) + (number->byte-list value sizer))) + (t-val (cond ((sassy-symbol-exists-env? r target) + => sassy-symbol-offset) + (else target))) + (a-reloc (make-sassy-reloc + (get-reloc-target target r) + 'text (+ offs sizer) type #f value sizer)) + (patcher (lambda (new) + (if (not ((case sizer + ((1) s-byte) + ((2) s-word) + ((4) s-dword)) + new)) + (error "sassy: out of range" (+ new sizer 1)) + (begin (pnt (number->byte-list new sizer)) + (sassy-reloc-value-set! a-reloc new)))))) + (when (= 4 sizer) + (sassy-reloc-patcher-set! a-reloc patcher) + (push-t-reloc! t a-reloc)) + (when (and (= 2 sizer) (= 16 (sassy-bits r))) + (sassy-reloc-patcher-set! a-reloc patcher) + (push-t-reloc! t a-reloc)) + (if (not k?) + (if (and (number? t-val) (eqv? 'rel type)) + (push-t-res! + t (cons offs (lambda (n) (patcher (- t-val n))))) + (push-t-unres! + t (list target offs (lambda (from) + (lambda (to) + (patcher (- to from)))) + (cond ((sassy-symbol-exists-env? r target) => + sassy-symbol-scope) + (else #f))))) + (patcher (- offs t-val))))) + + + (define (handle-mem ref reg) + (letrec + ((bad-mem (lambda () (error "sassy: bad memory-ref" (cons '& ref)))) + (base #f) (ix #f) (sk 0) (mod 0) (r/m #f) + (symb #f) (disp #f) (type 'abs) + (comp-mod + (lambda () (if (or disp symb) + (cond ((and (u/s-byte disp) (not symb)) (set! mod 64)) + ((or (u/s-dword disp) symb) (set! mod 128)) + (else (bad-mem)))))) + (fix-disp + (lambda () (if (or disp symb) + (cond ((and (u/s-byte disp) (not symb)) + (set! disp `(byte ,disp))) + ((or (u/s-dword disp) symb) + (set! disp (if disp `(dword ,disp) '(dword 0)))) + (else (bad-mem)))))) + (skale (meta-lambda (or ,@1 + (and ,@2 (begin (set! sk 64))) + (and ,@4 (begin (set! sk 128))) + (and ,@8 (begin (set! sk 192)))))) + (mem-i + (meta-lambda + (or + (and ,@r32 (lambda (x) (cond ((not r/m) (set! r/m x)) + ((not ix) (if (not (= x 4)) + (set! ix (* 8 x)) + (begin (set! ix + (* 8 r/m)) + (set! r/m 4)))) + (else (bad-mem))))) + (and ,@symbol (lambda (x) + (if (not symb) + (if (symbol? x) + (set! symb x) + (begin (set! type (cadr x)) + (set! symb (caddr x)) + (if (not disp) + (set! disp (cadddr x)) + (set! disp (+ disp + (cadddr x)))))) + (bad-mem)))) + (and ,@integer? (lambda (x) (if (not disp) + (set! disp x) + (set! disp (+ x disp))))) + (and '* (or (and skale r32-not-esp (lambda (x y) + (set! ix (* 8 y)))) + (and r32-not-esp skale (lambda (x y) + (set! ix (* 8 x)))))) + (else (lambda (x) (bad-mem))))))) + (or (and (case (car ref) + ((cs) (set! seg-flag #x2e)) + ((ss) (set! seg-flag #x36)) + ((ds) (set! seg-flag #x3e)) + ((es) (set! seg-flag #x26)) + ((fs) (set! seg-flag #x64)) + ((gs) (set! seg-flag #x65)) + (else #f)) + (for-each mem-i (cadr ref))) + (for-each mem-i ref)) +;ok...here we go... + (cond ((and (not r/m) (not ix)) + (if (and (not symb) (not (u/s-dword disp))) + (bad-mem) + (begin (set! disp (if disp `(dword ,disp) '(dword 0))) + (set! r/m 5)))) + (r/m (if (and (= r/m 5) (not disp) (not symb)) + (begin (set! mod 64) + (set! disp '(byte 0)) + (if ix + (begin (set! base r/m) + (set! r/m 4)) + (set! base r/m))) + (begin (comp-mod) + (fix-disp) + (cond ((and (= r/m 4) (not ix)) + (set! ix 32) + (set! base r/m)) + (ix (set! base r/m) + (set! r/m 4)))))) + ((or (= sk 128) (= sk 192)) + (if (or symb (and disp (u/s-dword disp))) + (set! disp (if disp `(dword ,disp) '(dword 0))) + (set! disp `(dword 0))) + (set! r/m 4) + (set! base 5)) + (else (if (and (not disp) + (not symb) + (= ix 40)) + (set! disp 0)) + (comp-mod) + (if (zero? sk) + (begin (set! r/m (/ ix 8)) + (set! ix #f)) + (begin (set! r/m 4) + (set! base (/ ix 8)) + (set! sk 0))) + (fix-disp))) +;whew! + (when symb + (handle-text-symbol type symb (or (and disp (cadr disp)) 0) 4)) + (when (and disp (not symb)) + (outc (number->byte-list (cadr disp) (case (car disp) + ((byte) 1) + ((dword) 4))))) + (when (= 16 (sassy-bits r)) + (set! addr-flag #t)) + (when ix (outc (+ sk ix base))) + (outc (+ mod r/m (* 8 reg))))) + + (define (%opcode? x) (hash-table-ref the-opcodes x (lambda () #f))) + + (define the-opcodes + (let ((rep-able + (lambda (x) + (and (pair? x) + (member (car x) '(insb insw insd outsb outsw outsd movsb + movsw movsd lodsb lodsw lodsd stosb + stosw stosd)) + (null? (cdr x)) ;check for null due to ambiguity of movsd + x))) + (rep-e-able + (lambda (x) + (and (pair? x) + (member (car x) '(cmpsb cmpsw cmpsd scasb scasw scasd)) + (null? (cdr x)) ;check for null due to ambiguity of cmpsd + x))) + (lock-able + (lambda (x) + (and (pair? x) + (member (car x) '(add adc and btc btr bts cmpxchg cmpxchg8b + dec inc neg not or sbb sub xor xadd + xchg)) + (mem-any (cadr x)) + x))) + (branch-predict-able + (lambda (x) + (and (pair? x) + (member (car x) '(jo jno jb jc jnae jnb jnc jae je jz jne + jnz jbe jna ja jnbe js jns jp jpe jnp + jpo jl jnge jge jnl jle jng jnle jg)) + x)))) + (letrec + ((just-c (lambda (sizer opcode) + (outc-maybe-quoted-list opcode) + (check-size sizer))) + (just-i (lambda (sizer opcode imm-value . prefix?) + (if (null? prefix?) + (begin (handle-imm sizer imm-value) + (just-c sizer opcode)) + (begin (handle-imm sizer imm-value) + (outc-maybe-quoted-list opcode))))) + (just-i8 (lambda (sizer opcode imm-value) + (handle-imm 1 imm-value) + (just-c sizer opcode))) + (just-i32 (lambda (sizer opcode imm-value) ; only used by mov mi + (if (= 16 (sassy-bits r)) + (set! addr-flag #t)) + (handle-imm 4 imm-value) + (just-c sizer opcode))) + (just-r2 (lambda (sizer partial-code-a partial-code-b reg) + (outc (+ partial-code-b reg)) + (outc partial-code-a) + (check-size sizer))) + (just-r (lambda (sizer partial-code reg) + (outc (+ partial-code reg)) + (check-size sizer))) + (just-r-i (lambda (sizer partial-code reg imm-value) + (handle-imm sizer imm-value) + (just-r sizer partial-code reg))) + (just-i-rel (lambda (sizer opcode rel-value) + (cond ((or (symbol? rel-value) (number? rel-value)) + (handle-rel-symbol sizer 'rel rel-value 0)) + (else + (apply handle-rel-symbol + (cons sizer (cdr rel-value))))) + (just-c sizer opcode))) + (just-m (lambda (sizer opcode dest reg-field) + (handle-mem dest reg-field) + (just-c sizer opcode))) + (r/m (lambda (sizer opcode dest reg-field) + (if (number? dest) + (handle-r/r dest reg-field) + (handle-mem dest reg-field)) + (just-c sizer opcode))) + (r/m-i (lambda (sizer opcode dest reg-field imm-value) + (handle-imm sizer imm-value) + (r/m sizer opcode dest reg-field))) + (r/m-i8 (lambda (sizer opcode dest reg-field imm-value) + (outc imm-value) + (r/m sizer opcode dest reg-field))) + (r/m-r (lambda (sizer opcode dest src) + (if (number? dest) + (handle-r/r dest src) + (handle-mem dest src)) + (just-c sizer opcode))) + (r-r/m (lambda (sizer opcode dest src) + (r/m-r sizer opcode src dest))) + (r/m-r-i (lambda (sizer opcode dest src imm) + (handle-imm sizer imm) + (r/m-r sizer opcode dest src))) + (r-r/m-i (lambda (sizer opcode dest src imm) + (r/m-r-i sizer opcode src dest imm))) + (r/m-r-i8 (lambda (sizer opcode dest src imm) + (handle-imm 1 imm) + (r/m-r sizer opcode dest src))) + (r-r/m-i8 (lambda (sizer opcode dest src imm) + (r/m-r-i8 sizer opcode src dest imm))) + (i16-i8 (lambda (sizer opcode imm1 imm2) + (handle-imm 1 imm2) + (handle-imm 2 imm1) + (just-c sizer opcode))) + (i16-i16 (lambda (sizer opcode imm1 imm2) + (handle-imm 2 imm2) + (handle-imm 2 imm1) + (just-c sizer opcode))) + (i16-i32 (lambda (sizer opcode imm1 imm2) + (handle-imm 2 imm2) + (handle-imm 4 imm1) + (just-c sizer opcode)))) + (let + ( + (gen-non + (lambda (sizer opcode) + (meta-lambda + (begin (just-c sizer opcode))))) + + (gen-alu + (lambda (rm-op-b rm-op-dw rm/r-op-b + rm/r-op-dw i-op-b i-op-dw reg-field) + (meta-lambda + (or + (and 'eax (or (and i8 (lambda (y) + (r/m-i8 4 131 0 reg-field y))) + (and i32 (lambda (y) (just-i 4 i-op-dw y))))) + (and r32 (or (and r32 (lambda (x y) (r/m-r 4 rm-op-dw x y))) + (and i8 (lambda (x y) + (r/m-i8 4 131 x reg-field y))) + (and i32 (lambda (x y) + (r/m-i 4 129 x reg-field y))) + (and m32 (lambda (x y) + (r-r/m 4 rm/r-op-dw x y))))) + (and 'al i8 (lambda (y) (just-i 1 i-op-b y))) + (and r8 (or (and i8 (lambda (x y) + (r/m-i 1 128 x reg-field y))) + (and r8 (lambda (x y) (r/m-r 1 rm-op-b x y))) + (and m8 (lambda (x y) (r-r/m 1 rm/r-op-b x y))))) + (and 'ax i16 (lambda (y) (just-i 2 i-op-dw y))) + (and r16 (or (and r16 (lambda (x y) + (r/m-r 2 rm-op-dw x y))) + (and i8 (lambda (x y) + (r/m-i8 2 131 x reg-field y))) + (and i16 (lambda (x y) + (r/m-i 2 129 x reg-field y))) + (and m16 (lambda (x y) + (r-r/m 2 rm/r-op-dw x y))))) + (and m32 r32 (lambda (x y) (r/m-r 4 rm-op-dw x y))) + (and m16 r16 (lambda (x y) (r/m-r 2 rm-op-dw x y))) + (and m8 r8 (lambda (x y) (r/m-r 1 rm-op-b x y))) + (and em8 i8 (lambda (x y) (r/m-i 1 #x80 x reg-field y))) + (and em32 (or (and i8 (lambda (x y) + (r/m-i8 4 #x83 x reg-field y))) + (and i32 (lambda (x y) + (r/m-i 4 #x81 x reg-field y))))) + (and em16 (or (and i8 (lambda (x y) + (r/m-i8 2 #x83 x reg-field y))) + (and i16 (lambda (x y) + (r/m-i 2 #x81 x reg-field y))))) + (and um32 + (or (and i8 (lambda (x y) + (if (= 16 (sassy-bits r)) + (r/m-i8 2 #x83 x reg-field y) + (r/m-i8 4 #x83 x reg-field y)))) + (and ei32 (lambda (x y) + (r/m-i 4 #x81 x reg-field y))) + (and ei16 (lambda (x y) + (r/m-i 2 #x81 x reg-field y))) + (and ui32 + (lambda (x y) + (if (and (ui16 y) (= 16 (sassy-bits r))) + (r/m-i 2 #x81 x reg-field y) + (r/m-i 4 #x81 x reg-field y)))))))))) + (gen-bt + (lambda (opcode1 opcode2 reg-field) + (meta-lambda + (or (and (or r32 em32) + (or (and r32 (lambda (x y) (r/m-r 4 opcode1 x y))) + (and i8 (lambda (x y) + (r/m-i8 4 opcode2 x reg-field y))))) + (and (or r16 em16) + (or (and r16 (lambda (x y) (r/m-r 2 opcode1 x y))) + (and i8 + (lambda (x y) + (r/m-i8 2 opcode2 x reg-field y))))) + (and um16 r16 (lambda (x y) (r/m-r 2 opcode1 x y))) + (and um32 r32 (lambda (x y) (r/m-r 4 opcode1 x y))) + (and um32 i8 (lambda (x y) + (if (= 16 (sassy-bits r)) + (r/m-i8 2 opcode2 x reg-field y) + (r/m-i8 4 opcode2 x reg-field y)))))))) + (gen-shift + (lambda (reg-field) + (meta-lambda + (or + (and (or r32 em32) + (or (and 1 (lambda (x) (r/m 4 #xd1 x reg-field))) + (and 'cl (lambda (x) (r/m 4 #xd3 x reg-field))) + (and i8 (lambda (x y) + (r/m-i8 4 #xc1 x reg-field y))))) + (and (or r8 em8) + (or (and 1 (lambda (x) (r/m 1 #xd0 x reg-field))) + (and 'cl (lambda (x) (r/m 1 #xd2 x reg-field))) + (and i8 (lambda (x y) + (r/m-i 1 #xc0 x reg-field y))))) + (and (or r16 em16) + (or (and 1 (lambda (x) (r/m 2 #xd1 x reg-field))) + (and 'cl (lambda (x) (r/m 2 #xd3 x reg-field))) + (and i8 (lambda (x y) + (r/m-i8 2 #xc1 x reg-field y))))) + (and um32 ? + (lambda (x y) + (let ((sizer (/ (sassy-bits r) 8))) + (cond ((eq? 1 y) (r/m sizer #xd1 x reg-field)) + ((eq? 'cl y) (r/m sizer #xd3 x reg-field)) + ((i8 y) => + (lambda (y) + (r/m-i8 sizer #xc1 x reg-field y))) + (else #f))))))))) + (gen-jcc + (lambda (cc-code) + (meta-lambda + (or + (and (or erel8 (and 'short (or rel32 rel16 rel8))) + (lambda (x) (just-i-rel 1 (+ #x70 cc-code) x))) + (and (?* 'near) + (or (and erel32 + (lambda (x) + (just-i-rel 4 `(#x0f ,(+ #x80 cc-code)) x))) + (and erel16 + (lambda (x) + (just-i-rel 2 `(#x0f ,(+ #x80 cc-code)) x))) + (and urel32 + (lambda (x) + (if (and (urel16 x) + (= 16 (sassy-bits r))) + (just-i-rel 2 `(#x0f ,(+ #x80 cc-code)) x) + (just-i-rel + 4 `(#x0f ,(+ #x80 cc-code)) x)))))))))) + (gen-setcc + (lambda (cc-code) + (meta-lambda + (and (or r8 m8) (lambda (x) + (r/m 1 `(#x0f ,(+ #x90 cc-code)) + x #b000)))))) + (gen-cmovcc + (lambda (cc-code) + (meta-lambda + (or (and r32 (or r32 m32) + (lambda (x y) + (r-r/m 4 `(#x0f ,(+ #x40 cc-code)) x y))) + (and r16 (or r16 m16) + (lambda (x y) + (r-r/m 2 `(#x0f ,(+ #x40 cc-code)) x y))))))) + (gen-decinc + (lambda (partial-code reg-field) + (meta-lambda + (or (and r32 (lambda (x) (just-r 4 partial-code x))) + (and r16 (lambda (x) (just-r 2 partial-code x))) + (and em32 (lambda (x) (r/m 4 #xff x reg-field))) + (and em16 (lambda (x) (r/m 2 #xff x reg-field))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (r/m 2 #xff x reg-field) + (r/m 4 #xff x reg-field)))) + (and (or r8 em8) (lambda (x) (r/m 1 #xfe x reg-field))))))) + (gen-plier + (lambda (reg-field) + (meta-lambda + (or (and (or r32 em32) (lambda (x) (r/m 4 #xf7 x reg-field))) + (and (or r16 em16) (lambda (x) (r/m 2 #xf7 x reg-field))) + (and (or r8 em8) (lambda (x) (r/m 1 #xf6 x reg-field))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (r/m 2 #xf7 x reg-field) + (r/m 4 #xf7 x reg-field)))))))) + (gen-load + (lambda (opcode) + (meta-lambda + (or (and r32 m32 (lambda (x y) (r-r/m 4 opcode x y))) + (and r16 m16 (lambda (x y) (r-r/m 2 opcode x y))))))) + (gen-movx + (lambda (opcode1 opcode2) + (meta-lambda + (or (and r32 (or (and (or r8 em8) + (lambda (x y) + (r-r/m 4 `(#x0f ,opcode1) x y))) + (and (or r16 m16) + (lambda (x y) + (r-r/m 4 `(#x0f ,opcode2) x y))))) + (and r16 (or r8 m8) + (lambda (x y) (r-r/m 2 `(#x0f ,opcode1) x y))))))) + (gen-r/rm + (lambda (opcodes) + (meta-lambda + (or (and r32 (or r32 m32) (lambda (x y) (r-r/m 4 opcodes x y))) + (and r16 (or r16 m16) (lambda (x y) + (r-r/m 2 opcodes x y))))))) + (gen-rm + (lambda (opc reg-field) + (meta-lambda + (and m32 (lambda (x) (r/m 1 `(#x0f ,opc) x reg-field)))))) + (gen-rm8 + (lambda (opc reg-field) + (meta-lambda + (and m8 (lambda (x) (r/m 1 `(#x0f ,opc) x reg-field)))))) + (gen-rm2 + (lambda (opcodes reg-field) + (meta-lambda + (and (or r16 m16) (lambda (x) (r/m 1 opcodes x reg-field)))))) + (gen-aa + (lambda (opcodes-none opcodes-1) + (meta-lambda + (or (begin (just-c 1 opcodes-none)) + (and i8 (lambda (x) (just-i 1 opcodes-1 x))))))) + (gen-ret + (lambda (opcodes-none opcodes-1) + (meta-lambda + (or (begin (just-c 1 opcodes-none)) + (and i16 (lambda (x) (just-i 2 opcodes-1 x #f))))))) + (gen-doub-shift + (lambda (code1 code2) + (meta-lambda + (or (and (or r32 m32) r32 + (or (and i8 (lambda (x y z) + (r/m-r-i8 4 `(#x0f ,code1) x y z))) + (and 'cl (lambda (x y) + (r/m-r 4 `(#x0f ,code2) x y))))) + (and (or r16 m16) r16 + (or (and i8 (lambda (x y z) + (r/m-r-i8 2 `(#x0f ,code1) x y z))) + (and 'cl (lambda (x y) + (r/m-r 2 `(#x0f ,code2) x y))))))))) + (gen-loop + (lambda (opcode) + (meta-lambda + (and rel8 (or (lambda (x) (just-i-rel 1 opcode x)) + (and 'cx + (lambda (x) + (if (= 16 (sassy-bits r)) + (just-i-rel 1 opcode x) + (just-i-rel 1 `(#x67 ,opcode) x)))) + (and 'ecx + (lambda (x) + (if (= 16 (sassy-bits r)) + (just-i-rel 1 `(#x67 ,opcode) x) + (just-i-rel 1 opcode x))))))))) + + (gen-cmpx + (lambda (opcode1 opcode2) + (meta-lambda + (or (and (or r8 m8) r8 (lambda (x y) (r/m-r 1 opcode1 x y))) + (and (or r16 m16) r16 (lambda (x y) (r/m-r 2 opcode2 x y))) + (and (or r32 m32) r32 (lambda (x y) + (r/m-r 4 opcode2 x y))))))) + (gen-fpmath-1 + (lambda (reg-field to-0-c from-0-c) + (meta-lambda + (or (and em64 (lambda (x) (r/m 1 #xdc x reg-field))) + (and m32 (lambda (x) (r/m 1 #xd8 x reg-field))) + (and 'st0 st (lambda (x) (just-r2 1 #xd8 to-0-c x))) + (and st 'st0 (lambda (x) (just-r2 1 #xdc from-0-c x))))))) + (gen-fpmath-2 + (lambda (with w/o) + (meta-lambda + (or (begin (just-c 1 `(#xde ,w/o))) + (and st 'st0 (lambda (x) (just-r2 1 #xde with x))))))) + (gen-fpmath-3 + (lambda (reg-field) + (meta-lambda + (or (and em16 (lambda (x) (r/m 1 #xde x reg-field))) + (and m32 (lambda (x) (r/m 1 #xda x reg-field))))))) + (gen-fcmovcc + (lambda (p-code-1 p-code-2) + (meta-lambda + (and 'st0 st (lambda (x) (just-r2 1 p-code-1 p-code-2 x)))))) + (gen-fp-reg/non + (lambda (op1-a op1-b opcode2) + (meta-lambda + (or (begin (just-c 1 opcode2)) + (and st (lambda (x) (just-r2 1 op1-a op1-b x))))))) + (gen-fp-3m/st + (lambda (reg-field1 reg-field2 st-opcode-a st-opcode-b) + (meta-lambda + (or (and em64 (lambda (x) (r/m 1 #xdd x reg-field1))) + (and em80 (lambda (x) (r/m 1 #xdb x reg-field2))) + (and m32 (lambda (x) (r/m 1 #xd9 x reg-field1))) + (and st (lambda (x) + (just-r2 1 st-opcode-a st-opcode-b x))))))) + (gen-fp-3int + (lambda (reg-field1 reg-field2) + (meta-lambda + (or (and em64 (lambda (x) (r/m 1 '#xdf x reg-field2))) + (and em16 (lambda (x) (r/m 1 '#xdf x reg-field1))) + (and m32 (lambda (x) (r/m 1 '#xdb x reg-field1))))))) + (gen-fp-2int + (lambda (opcode1 opcode2 reg-field) + (meta-lambda + (or (and em16 (lambda (x) (r/m 1 opcode1 x reg-field))) + (and m32 (lambda (x) (r/m 1 opcode2 x reg-field))))))) + (gen-fp-com + (lambda (pcode1 pcode2 reg-field) + (meta-lambda + (or (begin (just-c 1 `(#xd8 ,pcode2))) + (and em64 (lambda (x) (r/m 1 #xdc x reg-field))) + (and m32 (lambda (x) (r/m 1 #xd8 x reg-field))) + (and st (lambda (x) (just-r2 1 #xd8 pcode1 x))))))) + (gen-mmx-log + (lambda (opcode) + (meta-lambda + (or (and mm (or mm m64) + (lambda (x y) (r-r/m 1 `(#x0f ,opcode) x y))) + (and xmm (or xmm m128) + (lambda (x y) (r-r/m 1 `(#x66 #x0f ,opcode) x y))))))) + (gen-mmx-unplow + (lambda (opcode) + (meta-lambda + (or (and mm (or mm m32) + (lambda (x y) (r-r/m 1 `(#x0f ,opcode) x y))) + (and xmm (or xmm m128) + (lambda (x y) (r-r/m 1 `(#x66 #x0f ,opcode) x y))))))) + (gen-mmx-shr + (lambda (opcode1 opcode2 reg-field) + (meta-lambda + (or + (and mm (or (and (or mm m64) + (lambda (x y) + (r-r/m 1 `(#x0f ,opcode1) x y))) + (and i8 + (lambda (x y) + (r/m-i8 1 `(#x0f ,opcode2) + x reg-field y))))) + (and xmm (or (and (or xmm m128) + (lambda (x y) + (r-r/m 1 `(#x66 #x0f ,opcode1) x y))) + (and i8 + (lambda (x y) + (r/m-i8 1 `(#x66 #x0f ,opcode2) + x reg-field y))))))))) + (gen-sse1-mov + (lambda (opcode1 opcode2) + (meta-lambda + (or (and xmm (or xmm m128) (lambda (x y) + (r-r/m 1 opcode1 x y))) + (and m128 xmm (lambda (x y) (r/m-r 1 opcode2 x y))))))) + (gen-sse-ps/pd + (lambda (opcode) + (meta-lambda + (and xmm (or xmm m128) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse1-ss + (lambda (opcode) + (meta-lambda + (and xmm (or xmm m32) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse2-sd + (lambda (opcode) + (meta-lambda + (and xmm (or xmm m64) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse1-mov2 + (lambda (opcode1 opcode2) + (meta-lambda + (or (and xmm m64 (lambda (x y) (r-r/m 1 opcode1 x y))) + (and m64 xmm (lambda (x y) (r/m-r 1 opcode2 x y))))))) + (gen-xmm-r/r + (lambda (opcode) + (meta-lambda + (and xmm xmm (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse-cmp + (lambda (opcode) + (meta-lambda + (and xmm (or xmm m128) i8 + (lambda (x y z) (r-r/m-i 1 opcode x y z)))))) + (gen-sse1-ps2pi + (lambda (opc) + (meta-lambda + (and mm (or xmm m64) (lambda (x y) + (r-r/m 1 `(#x0f ,opc) x y)))))) + (gen-sse1-ss2si + (lambda (opc) + (meta-lambda + (and r32 (or xmm m32) (lambda (x y) + (r-r/m 1 `(#xf3 #x0f ,opc) x y)))))) + (gen-sse2-sd2si + (lambda (opcode) + (meta-lambda + (and r32 (or xmm m64) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse-movmsk + (lambda (opcode) + (meta-lambda + (and r32 xmm (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse-pd2pi + (lambda (opcode) + (meta-lambda + (and mm (or xmm m128) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse-pi2pds + (lambda (opcode) + (meta-lambda + (and xmm (or mm m64) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse-si2sssd + (lambda (opcode) + (meta-lambda + (and xmm (or r32 m32) (lambda (x y) (r-r/m 1 opcode x y)))))) + (gen-sse2-sr + (lambda (reg-field) + (meta-lambda + (and xmm i8 (lambda (x y) + (r/m-i 1 '(#x66 #x0f #x73) x reg-field y)))))) + (gen-sse-movnt + (lambda (opcode) + (meta-lambda + (and m128 xmm (lambda (x y) (r/m-r 1 opcode x y)))))) + (gen-prefix + (lambda (pred code) + (meta-lambda + (and pred (lambda (x) + (and ((hash-table-ref the-opcodes (car x)) (cdr x)) + (outc code)))))))) + (alist->hash-table + `( + (rep . ,(gen-prefix rep-able #xf3)) + (repe . ,(gen-prefix rep-e-able #xf3)) + (repz . ,(gen-prefix rep-e-able #xf3)) + (repne . ,(gen-prefix rep-e-able #xf2)) + (repnz . ,(gen-prefix rep-e-able #xf2)) + (lock . ,(gen-prefix lock-able #xf0)) + (brt . ,(gen-prefix branch-predict-able #x3e)) + (brnt . ,(gen-prefix branch-predict-able #x2e)) + (aaa . ,(gen-non 1 #x37)) + (aas . ,(gen-non 1 #x3f)) + (cbw . ,(gen-non 2 #x98)) + (cdq . ,(gen-non 4 #x99)) + (clc . ,(gen-non 1 #xf8)) + (cld . ,(gen-non 1 #xfc)) + (cli . ,(gen-non 1 #xfa)) + (clts . ,(gen-non 1 '(#x0f #x06))) + (cmc . ,(gen-non 1 #xf5)) + (cmpsb . ,(gen-non 1 #xa6)) + (cmpsw . ,(gen-non 2 #xa7)) ;cmpsd in sse2 + (cpuid . ,(gen-non 1 '(#x0f #xa2))) + (cwde . ,(gen-non 4 #x98)) + (cwd . ,(gen-non 2 #x99)) + (daa . ,(gen-non 1 #x27)) + (das . ,(gen-non 1 #x2f)) + (hlt . ,(gen-non 1 #xf4)) + (insb . ,(gen-non 1 #x6c)) + (insw . ,(gen-non 2 #x6d)) + (insd . ,(gen-non 4 #x6d)) + (int3 . ,(gen-non 1 #xcc)) + (into . ,(gen-non 1 #xce)) + (invd . ,(gen-non 1 '(#x0f #x08))) + (iret . ,(gen-non 1 #xcf)) + (iretw . ,(gen-non 2 #xcf)) + (iretd . ,(gen-non 4 #xcf)) + (lahf . ,(gen-non 1 #x9f)) + (leave . ,(gen-non 1 #xc9)) + (lodsb . ,(gen-non 1 #xac)) + (lodsw . ,(gen-non 2 #xad)) + (lodsd . ,(gen-non 4 #xad)) + (movsb . ,(gen-non 1 #xa4)) + (movsw . ,(gen-non 2 #xa5)) ;movsd in sse2 + (nop . ,(gen-non 1 #x90)) + (outsb . ,(gen-non 1 #x6e)) + (outsw . ,(gen-non 2 #x6f)) + (outsd . ,(gen-non 4 #x6f)) + (popa . ,(gen-non 1 #x61)) + (popaw . ,(gen-non 2 #x61)) + (popad . ,(gen-non 4 #x61)) + (popf . ,(gen-non 1 #x9d)) + (popfw . ,(gen-non 2 #x9d)) + (popfd . ,(gen-non 4 #x9d)) + (pusha . ,(gen-non 1 #x60)) + (pushaw . ,(gen-non 2 #x60)) + (pushad . ,(gen-non 4 #x60)) + (pushf . ,(gen-non 1 #x9c)) + (pushfw . ,(gen-non 2 #x9c)) + (pushfd . ,(gen-non 4 #x9c)) + (rdmsr . ,(gen-non 1 '(#x0f #x32))) + (rdpmc . ,(gen-non 1 '(#x0f #x33))) + (rdtsc . ,(gen-non 1 '(#x0f #x31))) + (rsm . ,(gen-non 1 '(#x0f #xaa))) + (sahf . ,(gen-non 1 #x9e)) + (scasb . ,(gen-non 1 #xae)) + (scasw . ,(gen-non 2 #xaf)) + (scasd . ,(gen-non 4 #xaf)) + (stc . ,(gen-non 1 #xf9)) + (std . ,(gen-non 1 #xfd)) + (sti . ,(gen-non 1 #xfb)) + (stosb . ,(gen-non 1 #xaa)) + (stosw . ,(gen-non 2 #xab)) + (stosd . ,(gen-non 4 #xab)) + (sysenter . ,(gen-non 1 '(#x0f #x34))) + (sysexit . ,(gen-non 1 '(#x0f #x35))) + (ud2 . ,(gen-non 1 '(#x0f #x0b))) + (wbinvd . ,(gen-non 1 '(#x0f #x09))) + (wrmsr . ,(gen-non 1 '(#x0f #x30))) + (xlat . ,(gen-non 1 #xd7)) + (xlatb . ,(gen-non 1 #xd7)) + (fld1 . ,(gen-non 1 '(#xd9 #xe8))) + (fldl2t . ,(gen-non 1 '(#xd9 #xe9))) + (fldl2e . ,(gen-non 1 '(#xd9 #xea))) + (fldpi . ,(gen-non 1 '(#xd9 #xeb))) + (fldlg2 . ,(gen-non 1 '(#xd9 #xec))) + (fldln2 . ,(gen-non 1 '(#xd9 #xed))) + (fldz . ,(gen-non 1 '(#xd9 #xee))) + (fsin . ,(gen-non 1 '(#xd9 #xfe))) + (fcos . ,(gen-non 1 '(#xd9 #xff))) + (fsincos . ,(gen-non 1 '(#xd9 #xfb))) + (fptan . ,(gen-non 1 '(#xd9 #xf2))) + (fpatan . ,(gen-non 1 '(#xd9 #xf3))) + (f2xm1 . ,(gen-non 1 '(#xd9 #xf0))) + (fyl2x . ,(gen-non 1 '(#xd9 #xf1))) + (fyl2xp1 . ,(gen-non 1 '(#xd9 #xf9))) + (fincstp . ,(gen-non 1 '(#xd9 #xf7))) + (fdecstp . ,(gen-non 1 '(#xd9 #xf6))) + (finit . ,(gen-non 1 '(#x9b #xdb #xe3))) + (fninit . ,(gen-non 1 '(#xdb #xe3))) + (fclex . ,(gen-non 1 '(#x9b #xdb #xe2))) + (fnclex . ,(gen-non 1 '(#xdb #xe2))) + (fnop . ,(gen-non 1 '(#xd9 #xd0))) + (fcompp . ,(gen-non 1 '(#xde #xd9))) + (fucompp . ,(gen-non 1 '(#xda #xe9))) + (ftst . ,(gen-non 1 '(#xd9 #xe4))) + (fxam . ,(gen-non 1 '(#xd9 #xe5))) + (fprem . ,(gen-non 1 '(#xd9 #xf8))) + (fprem1 . ,(gen-non 1 '(#xd9 #xf5))) + (fabs . ,(gen-non 1 '(#xd9 #xe1))) + (fchs . ,(gen-non 1 '(#xd9 #xe0))) + (frndint . ,(gen-non 1 '(#xd9 #xfc))) + (fscale . ,(gen-non 1 '(#xd9 #xfd))) + (fsqrt . ,(gen-non 1 '(#xd9 #xfa))) + (fxtract . ,(gen-non 1 '(#xd9 #xf4))) + (fwait . ,(gen-non 1 #x9b)) + (wait . ,(gen-non 1 #x9b)) + (emms . ,(gen-non 1 '(#x0f #x77))) + (adc . ,(gen-alu #x10 #x11 #x12 #x13 #x14 #x15 #b010)) + (add . ,(gen-alu #x00 #x01 #x02 #x03 #x04 #x05 #b000)) + (and . ,(gen-alu #x20 #x21 #x22 #x23 #x24 #x25 #b100)) + (cmp . ,(gen-alu #x38 #x39 #x3a #x3b #x3c #x3d #b111)) + (or . ,(gen-alu #x08 #x09 #x0a #x0b #x0c #x0d #b001)) + (sbb . ,(gen-alu #x18 #x19 #x1a #x1b #x1c #x1d #b011)) + (sub . ,(gen-alu #x28 #x29 #x2a #x2b #x2c #x2d #b101)) + (xor . ,(gen-alu #x30 #x31 #x32 #x33 #x34 #x35 #b110)) + (bt . ,(gen-bt '(#x0f #xa3) '(#x0f #xba) #b100)) + (btc . ,(gen-bt '(#x0f #xbb) '(#x0f #xba) #b111)) + (btr . ,(gen-bt '(#x0f #xb3) '(#x0f #xba) #b110)) + (bts . ,(gen-bt '(#x0f #xab) '(#x0f #xba) #b101)) + (rcl . ,(gen-shift #b010)) + (rcr . ,(gen-shift #b011)) + (rol . ,(gen-shift #b000)) + (ror . ,(gen-shift #b001)) + (sal . ,(gen-shift #b100)) + (sar . ,(gen-shift #b111)) + (shl . ,(gen-shift #b100)) + (shr . ,(gen-shift #b101)) + (jo . ,(gen-jcc #x00)) + (jno . ,(gen-jcc #x01)) + (jb . ,(gen-jcc #x02)) + (jc . ,(gen-jcc #x02)) + (jnae . ,(gen-jcc #x02)) + (jnb . ,(gen-jcc #x03)) + (jnc . ,(gen-jcc #x03)) + (jae . ,(gen-jcc #x03)) + (je . ,(gen-jcc #x04)) + (jz . ,(gen-jcc #x04)) + (jne . ,(gen-jcc #x05)) + (jnz . ,(gen-jcc #x05)) + (jbe . ,(gen-jcc #x06)) + (jna . ,(gen-jcc #x06)) + (ja . ,(gen-jcc #x07)) + (jnbe . ,(gen-jcc #x07)) + (js . ,(gen-jcc #x08)) + (jns . ,(gen-jcc #x09)) + (jp . ,(gen-jcc #x0a)) + (jpe . ,(gen-jcc #x0a)) + (jnp . ,(gen-jcc #x0b)) + (jpo . ,(gen-jcc #x0b)) + (jl . ,(gen-jcc #x0c)) + (jnge . ,(gen-jcc #x0c)) + (jge . ,(gen-jcc #x0d)) + (jnl . ,(gen-jcc #x0d)) + (jle . ,(gen-jcc #x0e)) + (jng . ,(gen-jcc #x0e)) + (jnle . ,(gen-jcc #x0f)) + (jg . ,(gen-jcc #x0f)) + (cmovo . ,(gen-cmovcc #x00)) + (cmovno . ,(gen-cmovcc #x01)) + (cmovb . ,(gen-cmovcc #x02)) + (cmovc . ,(gen-cmovcc #x02)) + (cmovnae . ,(gen-cmovcc #x02)) + (cmovnb . ,(gen-cmovcc #x03)) + (cmovnc . ,(gen-cmovcc #x03)) + (cmovae . ,(gen-cmovcc #x03)) + (cmove . ,(gen-cmovcc #x04)) + (cmovz . ,(gen-cmovcc #x04)) + (cmovne . ,(gen-cmovcc #x05)) + (cmovnz . ,(gen-cmovcc #x05)) + (cmovbe . ,(gen-cmovcc #x06)) + (cmovna . ,(gen-cmovcc #x06)) + (cmova . ,(gen-cmovcc #x07)) + (cmovnbe . ,(gen-cmovcc #x07)) + (cmovs . ,(gen-cmovcc #x08)) + (cmovns . ,(gen-cmovcc #x09)) + (cmovp . ,(gen-cmovcc #x0a)) + (cmovpe . ,(gen-cmovcc #x0a)) + (cmovnp . ,(gen-cmovcc #x0b)) + (cmovpo . ,(gen-cmovcc #x0b)) + (cmovl . ,(gen-cmovcc #x0c)) + (cmovnge . ,(gen-cmovcc #x0c)) + (cmovge . ,(gen-cmovcc #x0d)) + (cmovnl . ,(gen-cmovcc #x0d)) + (cmovle . ,(gen-cmovcc #x0e)) + (cmovng . ,(gen-cmovcc #x0e)) + (cmovnle . ,(gen-cmovcc #x0f)) + (cmovg . ,(gen-cmovcc #x0f)) + (seto . ,(gen-setcc #x00)) + (setno . ,(gen-setcc #x01)) + (setb . ,(gen-setcc #x02)) + (setc . ,(gen-setcc #x02)) + (setnae . ,(gen-setcc #x02)) + (setnb . ,(gen-setcc #x03)) + (setnc . ,(gen-setcc #x03)) + (setae . ,(gen-setcc #x03)) + (sete . ,(gen-setcc #x04)) + (setz . ,(gen-setcc #x04)) + (setne . ,(gen-setcc #x05)) + (setnz . ,(gen-setcc #x05)) + (setbe . ,(gen-setcc #x06)) + (setna . ,(gen-setcc #x06)) + (seta . ,(gen-setcc #x07)) + (setnbe . ,(gen-setcc #x07)) + (sets . ,(gen-setcc #x08)) + (setns . ,(gen-setcc #x09)) + (setp . ,(gen-setcc #x0a)) + (setpe . ,(gen-setcc #x0a)) + (setnp . ,(gen-setcc #x0b)) + (setpo . ,(gen-setcc #x0b)) + (setl . ,(gen-setcc #x0c)) + (setnge . ,(gen-setcc #x0c)) + (setge . ,(gen-setcc #x0d)) + (setnl . ,(gen-setcc #x0d)) + (setle . ,(gen-setcc #x0e)) + (setng . ,(gen-setcc #x0e)) + (setnle . ,(gen-setcc #x0f)) + (setg . ,(gen-setcc #x0f)) + (dec . ,(gen-decinc #x48 #b001)) + (inc . ,(gen-decinc #x40 #b000)) + (div . ,(gen-plier #b110)) + (idiv . ,(gen-plier #b111)) + (mul . ,(gen-plier #b100)) + (neg . ,(gen-plier #b011)) + (not . ,(gen-plier #b010)) + (lds . ,(gen-load #xc5)) + (les . ,(gen-load #xc4)) + (lea . ,(gen-load #x8d)) + (lfs . ,(gen-load '(#x0f #xb4))) + (lgs . ,(gen-load '(#x0f #xb5))) + (lss . ,(gen-load '(#x0f #xb2))) + (movsx . ,(gen-movx #xbe #xbf)) + (movzx . ,(gen-movx #xb6 #xb7)) + (lldt . ,(gen-rm2 '(#x0f #x00) #b010)) + (sldt . ,(gen-rm2 '(#x0f #x00) #b000)) + (lmsw . ,(gen-rm2 '(#x0f #x01) #b110)) + (smsw . ,(gen-rm2 '(#x0f #x01) #b100)) + (ltr . ,(gen-rm2 '(#x0f #x00) #b011)) + (str . ,(gen-rm2 '(#x0f #x00) #b001)) + (verr . ,(gen-rm2 '(#x0f #x00) #b100)) + (verw . ,(gen-rm2 '(#x0f #x00) #b101)) + (invlpg . ,(gen-rm #x01 #b111)) + (lgdt . ,(gen-rm #x01 #b010)) + (sgdt . ,(gen-rm #x01 #b000)) + (lidt . ,(gen-rm #x01 #b011)) + (sidt . ,(gen-rm #x01 #b001)) + (bsf . ,(gen-r/rm '(#x0f #xbc))) + (bsr . ,(gen-r/rm '(#x0f #xbd))) + (lar . ,(gen-r/rm '(#x0f #x02))) + (lsl . ,(gen-r/rm '(#x0f #x03))) + (aad . ,(gen-aa '(#xd5 #x0a) #xd5)) + (aam . ,(gen-aa '(#xd4 #x0a) #xd4)) + (ret . ,(gen-ret #xc3 #xc2)) + (retn . ,(gen-ret #xc3 #xc2)) + (retf . ,(gen-ret #xcb #xca)) + (shld . ,(gen-doub-shift #xa4 #xa5)) + (shrd . ,(gen-doub-shift #xac #xad)) + (loop . ,(gen-loop #xe2)) + (loope . ,(gen-loop #xe1)) + (loopz . ,(gen-loop #xe1)) + (loopne . ,(gen-loop #xe0)) + (loopnz . ,(gen-loop #xe0)) + (cmpxchg . ,(gen-cmpx '(#x0f #xb0) '(#x0f #xb1))) + (xadd . ,(gen-cmpx '(#x0f #xc0) '(#x0f #xc1))) + (arpl . ,(meta-lambda + (and (or r16 m16) r16 (lambda (x y) + (r/m-r 1 #x63 x y))))) + (bound . ,(meta-lambda + (or (and r16 m16 (lambda (x y) (r-r/m 2 #x62 x y))) + (and r32 m32 (lambda (x y) (r-r/m 4 #x62 x y)))))) + (bswap . ,(meta-lambda + (and r32 (lambda (x) (just-r2 4 #x0f #xc8 x))))) + (cmpxchg8b . ,(meta-lambda + (and m32 (lambda (x) + (just-m 1 '(#x0f #xc7) x #b001))))) + (xchg . ,(meta-lambda + (or + (and 'eax (or (and r32 (lambda (y) (just-r 4 #x90 y))))) + (and r32 (or (and 'eax (lambda (y) (just-r 4 #x90 y))) + (and (or r32 m32) + (lambda (x y) (r-r/m 4 #x87 x y))))) + (and 'ax r16 (lambda (y) (just-r 2 #x90 y))) + (and r16 (or (and 'ax (lambda (y) (just-r 2 #x90 y))) + (and (or r16 m16) + (lambda (x y) (r-r/m 2 #x87 x y))))) + (and r8 (or r8 m8) (lambda (x y) (r-r/m 1 #x86 x y))) + (and m8 r8 (lambda (x y) (r/m-r 1 #x86 x y))) + (and m16 r16 (lambda (x y) (r/m-r 2 #x87 x y))) + (and m32 r32 (lambda (x y) (r/m-r 4 #x87 x y)))))) + (enter . ,(meta-lambda + (and i16 i8 (lambda (x y) (i16-i8 1 #xc8 x y))))) + (jcxz . ,(meta-lambda + (and rel8 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-i-rel 1 #xe3 x) + (just-i-rel 1 '(#x67 #xe3) x)))))) + (jecxz . ,(meta-lambda + (and rel8 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-i-rel 1 '(#x67 #xe3) x) + (just-i-rel 1 #xe3 x)))))) + (in . ,(meta-lambda + (or + (and 'al (or (and i8 (lambda (y) (just-i8 1 #xe4 y))) + (and 'dx (begin (just-c 1 #xec))))) + (and 'ax (or (and i8 (lambda (y) (just-i8 2 #xe5 y))) + (and 'dx (begin (just-c 2 #xed))))) + (and 'eax (or (and i8 (lambda (y) (just-i8 4 #xe5 y))) + (and 'dx (begin (just-c 4 #xed)))))))) + (out . ,(meta-lambda + (or + (and i8 (or (and 'al (lambda (x) (just-i8 1 #xe6 x))) + (and 'ax (lambda (x) (just-i8 2 #xe7 x))) + (and 'eax (lambda (x) (just-i8 4 #xe7 x))))) + (and 'dx (or (and 'al (begin (just-c 1 #xee))) + (and 'ax (begin (just-c 2 #xef))) + (and 'eax (begin (just-c 4 #xef)))))))) + (int . ,(meta-lambda + (and i8 (lambda (x) (just-i8 1 #xcd x))))) + (pop . ,(meta-lambda + (or (and r16 (lambda (x) (just-r 2 #x58 x))) + (and r32 (lambda (x) (just-r 4 #x58 x))) + (and em32 (lambda (x) (just-m 4 #x8f x #b000))) + (and em16 (lambda (x) (just-m 2 #x8f x #b000))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-m 2 #x8f x #b000) + (just-m 4 #x8f x #b000)))) + (and 'ds (begin (just-c 1 #x1f))) + (and 'es (begin (just-c 1 #x07))) + (and 'ss (begin (just-c 1 #x17))) + (and 'fs (begin (just-c 1 '(#x0f #xa1)))) + (and 'gs (begin (just-c 1 '(#x0f #xa9))))))) + (push . ,(meta-lambda + (or (and r32 (lambda (x) (just-r 4 #x50 x))) + (and r16 (lambda (x) (just-r 2 #x50 x))) + (and i8 (lambda (x) (just-i 1 #x6a x))) + (and ei32 (lambda (x) (just-i 4 #x68 x))) + (and ei16 (lambda (x) (just-i 2 #x68 x))) + (and ui32 (lambda (x) + (if (and (ui16 x) + (= 16 (sassy-bits r))) + (just-i 2 #x68 x) + (just-i 4 #x68 x)))) + (and em32 (lambda (x) (just-m 4 #xff x #b110))) + (and em16 (lambda (x) (just-m 2 #xff x #b110))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-m 2 #xff x #b110) + (just-m 4 #xff x #b110)))) + (and 'cs (begin (just-c 1 #x0e))) + (and 'ds (begin (just-c 1 #x1e))) + (and 'es (begin (just-c 1 #x06))) + (and 'ss (begin (just-c 1 #x16))) + (and 'fs (begin (just-c 1 '(#x0f #xa0)))) + (and 'gs (begin (just-c 1 '(#x0f #xa8))))))) + (imul . ,(meta-lambda + (or + (and r32 + (or (lambda (x) (r/m 4 247 x 5)) + (and (or r32 m32) + (or (lambda (x y) (r-r/m 4 '(15 175) x y)) + (and i8 (lambda (x y z) + (r-r/m-i8 4 107 x y z))) + (and i32 (lambda (x y z) + (r-r/m-i 4 105 x y z))))) + (and i8 (lambda (x y) + (r-r/m-i8 4 107 x x y))) + (and i32 (lambda (x y) + (r-r/m-i 4 105 x x y))))) + (and r16 + (or (lambda (x) (r/m 2 247 x 5)) + (and (or r16 m16) + (or (lambda (x y) (r-r/m 2 '(15 175) x y)) + (and i8 (lambda (x y z) + (r-r/m-i8 2 107 x y z))) + (and i16 (lambda (x y z) + (r-r/m-i 2 105 x y z))))) + (and i8 (lambda (x y) + (r-r/m-i8 2 107 x x y))) + (and i16 (lambda (x y) + (r-r/m-i 2 105 x x y))))) + (and em32 (lambda (x) (r/m 4 #xf7 x #b101))) + (and em16 (lambda (x) (r/m 2 #xf7 x #b101))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (r/m 2 #xf7 x #b101) + (r/m 4 #xf7 x #b101)))) + (and (or r8 m8) (lambda (x) (r/m 1 #xf6 x #b101)))))) + (test . ,(meta-lambda + (or + (and 'eax i32 (lambda (y) (just-i 4 #xa9 y))) + (and 'al i8 (lambda (y) (just-i 1 #xa8 y))) + (and 'ax i16 (lambda (y) (just-i 2 #xa9 y))) + (and (or r8 em8) + (or (and r8 (lambda (x y) (r/m-r 1 #x84 x y))) + (and i8 (lambda (x y) + (r/m-i 1 #xf6 x #b000 y))))) + (and um8 r8 (lambda (x y) (r/m-r 1 #x84 x y))) + (and (or r32 em32) + (or (and r32 (lambda (x y) (r/m-r 4 #x85 x y))) + (and i32 (lambda (x y) + (r/m-i 4 #xf7 x #b000 y))))) + (and (or r16 em16) + (or (and r16 (lambda (x y) (r/m-r 2 #x85 x y))) + (and i16 (lambda (x y) + (r/m-i 2 #xf7 x #b000 y))))) + (and um32 r32 (lambda (x y) (r/m-r 4 #x85 x y))) + (and um16 r16 (lambda (x y) (r/m-r 2 #x85 x y))) + (and um32 ei32 (lambda (x y) (r/m-i 4 #xf7 x #b000 y))) + (and um16 ei16 (lambda (x y) (r/m-i 2 #xf7 x #b000 y))) + (and um32 ui32 (lambda (x y) + (if (and (ui16 y) + (= 16 (sassy-bits r))) + (r/m-i 2 #xf7 x #b000 y) + (r/m-i 4 #xf7 x #b000 y))))))) + (mov . ,(meta-lambda + (or + (and 'eax mi32 (lambda (y) (just-i32 4 #xa1 y))) + (and mi32 'eax (lambda (x) (just-i32 4 #xa3 x))) + (and 'al mi8 (lambda (y) (just-i32 1 #xa0 y))) + (and mi8 'al (lambda (x) (just-i32 1 #xa2 x))) + (and 'ax mi16 (lambda (y) (just-i32 2 #xa1 y))) + (and mi16 'ax (lambda (x) (just-i32 2 #xa3 x))) + (and r32 (or (and r32 (lambda (x y) (r/m-r 4 137 x y))) + (and m32 (lambda (x y) (r-r/m 4 139 x y))) + (and i32 (lambda (x y) + (just-r-i 4 184 x y))) + (and sreg-not-cs (lambda (x y) + (r/m-r 4 140 x y))) + (and creg (lambda (x y) + (r/m-r 1 '(15 32) x y))) + (and dreg (lambda (x y) + (r/m-r 1 '(15 33) x y))))) + (and r16 (or (and r16 (lambda (x y) (r/m-r 2 137 x y))) + (and m16 (lambda (x y) (r-r/m 2 139 x y))) + (and i16 (lambda (x y) + (just-r-i 2 184 x y))) + (and sreg-not-cs (lambda (x y) + (r/m-r 2 140 x y))))) + (and r8 (or (and r8 (lambda (x y) (r/m-r 1 136 x y))) + (and m8 (lambda (x y) (r-r/m 1 138 x y))) + (and i8 (lambda (x y) + (just-r-i 1 176 x y))))) + (and creg r32 (lambda (x y) (r/m-r 1 '(#x0f #x22) y x))) + (and dreg r32 (lambda (x y) (r/m-r 1 '(#x0f #x23) y x))) + (and m32 (or (and r32 (lambda (x y) (r/m-r 4 #x89 x y))) + (and i32 (lambda (x y) + (r/m-i 4 #xc7 x #b000 y))))) + (and m8 (or (and r8 (lambda (x y) (r/m-r 1 #x88 x y))) + (and i8 (lambda (x y) + (r/m-i 1 #xc6 x #b000 y))))) + (and m16 (or (and r16 (lambda (x y) (r/m-r 2 #x89 x y))) + (and i16 (lambda (x y) + (r/m-i 2 #xc7 x #b000 y))))) + (and sreg-not-cs + (or (and (or r32 r16 em32 em16) + (lambda (x y) (r-r/m 1 #x8e x y))) + (and um32 (lambda (x y) + (if (= 16 (sassy-bits r)) + (r-r/m 2 #x8e x y) + (r-r/m 4 #x8e x y)))))) + (and em32 sreg-not-cs (lambda (x y) (r/m-r 4 #x8c x y))) + (and em16 sreg-not-cs (lambda (x y) (r/m-r 2 #x8c x y))) + (and um32 sreg-not-cs (lambda (x y) + (if (= 16 (sassy-bits r)) + (r/m-r 2 #x8c x y) + (r/m-r 4 #x8c x y))))))) + (jmp . ,(meta-lambda + (or + (and (or erel8 (and 'short (or rel32 rel16 rel8))) + (lambda (x) (just-i-rel 1 #xeb x))) + (and (?* 'near) + (or (and erel32 (lambda (x) (just-i-rel 4 #xe9 x))) + (and erel16 (lambda (x) (just-i-rel 2 #xe9 x))) + (and urel32 + (lambda (x) + (if (and (urel16 x) + (= 16 (sassy-bits r))) + (just-i-rel 2 #xe9 x) + (just-i-rel 4 #xe9 x)))))) + (and r32 (lambda (x) (r/m 4 #xff x #b100))) + (and r16 (lambda (x) (r/m 2 #xff x #b100))) + (and em32 (lambda (x) (r/m 4 #xff x #b100))) + (and em16 (lambda (x) (r/m 2 #xff x #b100))) + (and m32 (lambda (x) + (if (= 16 (sassy-bits r)) + (r/m 2 #xff x #b100) + (r/m 4 #xff x #b100)))) + (and i16 + (or (and ei32 (lambda (x y) (i16-i32 4 #xea y x))) + (and ei16 (lambda (x y) (i16-i16 2 #xea y x))) + (and ui32 (lambda (x y) + (if (and (ui16 y) + (= 16 (sassy-bits r))) + (i16-i16 2 #xea y x) + (i16-i32 4 #xea y x)))))) + (and 'far + (or (and em32 (lambda (x) (just-m 4 #xff x #b101))) + (and em16 (lambda (x) (just-m 2 #xff x #b101))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-m 2 #xff x #b101) + (just-m 4 #xff x #b101))))))))) + (call . ,(meta-lambda + (or + (and erel32 (lambda (x) (just-i-rel 4 #xe8 x))) + (and erel16 (lambda (x) (just-i-rel 2 #xe8 x))) + (and urel32 (lambda (x) + (if (and (urel16 x) + (= 16 (sassy-bits r))) + (just-i-rel 2 #xe8 x) + (just-i-rel 4 #xe8 x)))) + (and i16 + (or (and ei32 (lambda (x y) (i16-i32 4 #x9a y x))) + (and ei16 (lambda (x y) (i16-i16 2 #x9a y x))) + (and ui32 (lambda (x y) + (if (and (ui16 y) + (= 16 (sassy-bits r))) + (i16-i16 2 #x9a y x) + (i16-i32 4 #x9a y x)))))) + (and 'far + (or (and em32 (lambda (x) (just-m 4 #xff x #b011))) + (and em16 (lambda (x) (just-m 2 #xff x #b011))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (just-m 2 #xff x #b011) + (just-m 4 #xff x #b011)))))) + (and r32 (lambda (x) (r/m 4 #xff x #b010))) + (and r16 (lambda (x) (r/m 2 #xff x #b010))) + (and em32 (lambda (x) (r/m 4 #xff x #b010))) + (and em16 (lambda (x) (r/m 2 #xff x #b010))) + (and um32 (lambda (x) + (if (= 16 (sassy-bits r)) + (r/m 2 #xff x #b010) + (r/m 4 #xff x #b010))))))) + (fadd . ,(gen-fpmath-1 #b000 #xc0 #xc0)) + (fsub . ,(gen-fpmath-1 #b100 #xe0 #xe8)) + (fsubr . ,(gen-fpmath-1 #b101 #xe8 #xe0)) + (fmul . ,(gen-fpmath-1 #b001 #xc8 #xc8)) + (fdiv . ,(gen-fpmath-1 #b110 #xf0 #xf8)) + (fdivr . ,(gen-fpmath-1 #b111 #xf8 #xf0)) + (fdivrp . ,(gen-fpmath-2 #xf0 #xf1)) + (fdivp . ,(gen-fpmath-2 #xf8 #xf9)) + (fmulp . ,(gen-fpmath-2 #xc8 #xc9)) + (fsubp . ,(gen-fpmath-2 #xe8 #xe9)) + (fsubrp . ,(gen-fpmath-2 #xe0 #xe1)) + (faddp . ,(gen-fpmath-2 #xc0 #xc1)) + (fimul . ,(gen-fpmath-3 #b001)) + (fiadd . ,(gen-fpmath-3 #b000)) + (fidiv . ,(gen-fpmath-3 #b110)) + (fidivr . ,(gen-fpmath-3 #b111)) + (fisub . ,(gen-fpmath-3 #b100)) + (fisubr . ,(gen-fpmath-3 #b101)) + (fcmovb . ,(gen-fcmovcc #xda #xc0)) + (fcmove . ,(gen-fcmovcc #xda #xc8)) + (fcmovbe . ,(gen-fcmovcc #xda #xd0)) + (fcmovu . ,(gen-fcmovcc #xda #xd8)) + (fcmovnb . ,(gen-fcmovcc #xdb #xc0)) + (fcmovne . ,(gen-fcmovcc #xdb #xc8)) + (fcmovnbe . ,(gen-fcmovcc #xdb #xd0)) + (fcmovnu . ,(gen-fcmovcc #xdb #xd8)) + (fxch . ,(gen-fp-reg/non #xd9 #xc8 '(#xd9 #xc9))) + (fucom . ,(gen-fp-reg/non #xdd #xe0 '(#xdd #xe1))) + (fucomp . ,(gen-fp-reg/non #xdd #xe8 '(#xdd #xe9))) + (fld . ,(gen-fp-3m/st #b000 #b101 #xd9 #xc0)) + (fstp . ,(gen-fp-3m/st #b011 #b111 #xdd #xd8)) + (fst . ,(meta-lambda + (or (and em64 (lambda (x) (r/m 1 #xdd x #b010))) + (and m32 (lambda (x) (r/m 1 #xd9 x #b010))) + (and st (lambda (x) (just-r2 1 #xdd #xd0 x)))))) + (fild . ,(gen-fp-3int #b000 #b101)) + (fistp . ,(gen-fp-3int #b011 #b111)) + (fist . ,(gen-fp-2int #xdf #xdb #b010)) + (ficom . ,(gen-fp-2int #xde #xda #b010)) + (ficomp . ,(gen-fp-2int #xde #xda #b011)) + (fcom . ,(gen-fp-com #xd0 #xd1 #b010)) + (fcomp . ,(gen-fp-com #xd8 #xd9 #b011)) + (fcomi . ,(meta-lambda + (and 'st0 st (lambda (x) + (just-r2 1 #xdb #xf0 x))))) + (fcomip . ,(meta-lambda + (and 'st0 st (lambda (x) + (just-r2 1 #xdf #xf0 x))))) + (fucomi . ,(meta-lambda + (and 'st0 st (lambda (x) + (just-r2 1 #xdb #xe8 x))))) + (fucomip . ,(meta-lambda + (and 'st0 st (lambda (x) + (just-r2 1 #xdf #xe8 x))))) + (fbld . ,(meta-lambda + (and m80 (lambda (x) (r/m 1 #xdf x #b100))))) + (fbstp . ,(meta-lambda + (and m80 (lambda (x) (r/m 1 #xdf x #b110))))) + (ffree . ,(meta-lambda + (and st (lambda (x) + (just-r2 1 #xdd #xc0 x))))) + (fstcw . ,(meta-lambda + (and m16 (lambda (x) + (r/m 1 '(#x9b #xd9) x #b111))))) + (fnstcw . ,(meta-lambda + (and m16 (lambda (x) (r/m 1 #xd9 x #b111))))) + (fldcw . ,(meta-lambda + (and m16 (lambda (x) (r/m 1 #xd9 x #b101))))) + (fstenv . ,(meta-lambda + (and (or em16 m32) + (lambda (x) (r/m 1 '(#x9b #xd9) x #b110))))) + (fnstenv . ,(meta-lambda + (and (or em16 m32) (lambda (x) + (r/m 1 #xd9 x #b110))))) + (fldenv . ,(meta-lambda + (and (or em16 m32) (lambda (x) + (r/m 1 #xd9 x #b100))))) + (fsave . ,(meta-lambda + (and mem-any + (lambda (x) (r/m 1 '(#x9b #xdd) x #b110))))) + (fnsave . ,(meta-lambda + (and mem-any (lambda (x) (r/m 1 #xdd x #b110))))) + (frstor . ,(meta-lambda + (and mem-any + (lambda (x) (r/m 1 #xdd x #b100))))) + (fxsave . ,(meta-lambda + (and mem-any + (lambda (x) (r/m 1 '(#x0f #xae) x #b000))))) + (fxrstor . ,(meta-lambda + (and mem-any + (lambda (x) (r/m 1 '(#x0f #xae) x #b001))))) + (fstsw . ,(meta-lambda + (or (and 'ax (begin (just-c 1 '(#x9b #xdf #xe0)))) + (and m16 (lambda (x) + (r/m 1 '(#x9b #xdd) x #b111)))))) + (fnstsw . ,(meta-lambda + (or (and 'ax (begin (just-c 1 '(#xdf #xe0)))) + (and m16 (lambda (x) (r/m 1 '#xdd x #b111)))))) + (movd . ,(meta-lambda + (or (and mm (or r32 m32) + (lambda (x y) (r-r/m 1 '(#x0f #x6e) x y))) + (and xmm (or r32 m32) + (lambda (x y) (r-r/m 1 '(#x66 #x0f #x6e) x y))) + (and + (or r32 m32) (or (and mm + (lambda (x y) + (r/m-r 1 '(#x0f #x7e) x y))) + (and xmm + (lambda (x y) + (r/m-r 1 '(#x66 #x0f #x7e) + x y)))))))) + (movq . ,(meta-lambda + (or (and mm (or mm m64) + (lambda (x y) (r-r/m 1 '(#x0f #x6f) x y))) + (and xmm (or xmm m64) + (lambda (x y) + (r-r/m 1 '(#xf3 #x0f #x7e) x y))) + (and m64 (or (and mm (lambda (x y) + (r/m-r 1 '(#x0f #x7f) x y))) + (and xmm + (lambda (x y) + (r/m-r 1 '(#x66 #x0f #xd6) + x y)))))))) + (pand . ,(gen-mmx-log #xdb)) + (pandn . ,(gen-mmx-log #xdf)) + (por . ,(gen-mmx-log #xeb)) + (pxor . ,(gen-mmx-log #xef)) + (packsswb . ,(gen-mmx-log #x63)) + (packssdw . ,(gen-mmx-log #x6b)) + (packuswb . ,(gen-mmx-log #x67)) + (punpckhbw . ,(gen-mmx-log #x68)) + (punpckhwd . ,(gen-mmx-log #x69)) + (punpckhdq . ,(gen-mmx-log #x6a)) + (paddb . ,(gen-mmx-log #xfc)) + (paddw . ,(gen-mmx-log #xfd)) + (paddd . ,(gen-mmx-log #xfe)) + (paddsb . ,(gen-mmx-log #xec)) + (paddsw . ,(gen-mmx-log #xed)) + (paddusb . ,(gen-mmx-log #xdc)) + (paddusw . ,(gen-mmx-log #xdd)) + (psubb . ,(gen-mmx-log #xf8)) + (psubw . ,(gen-mmx-log #xf9)) + (psubd . ,(gen-mmx-log #xfa)) + (psubsb . ,(gen-mmx-log #xe8)) + (psubsw . ,(gen-mmx-log #xe9)) + (psubusb . ,(gen-mmx-log #xd8)) + (psubusw . ,(gen-mmx-log #xd9)) + (pmullw . ,(gen-mmx-log #xd5)) + (pmulhw . ,(gen-mmx-log #xe5)) + (pmaddwd . ,(gen-mmx-log #xf5)) + (pcmpeqb . ,(gen-mmx-log #x74)) + (pcmpeqw . ,(gen-mmx-log #x75)) + (pcmpeqd . ,(gen-mmx-log #x76)) + (pcmpgtb . ,(gen-mmx-log #x64)) + (pcmpgtw . ,(gen-mmx-log #x65)) + (pcmpgtd . ,(gen-mmx-log #x66)) + (pavgb . ,(gen-mmx-log #xe0)) + (pavgw . ,(gen-mmx-log #xe3)) + (pmaxub . ,(gen-mmx-log #xde)) + (pmaxsw . ,(gen-mmx-log #xee)) + (pminub . ,(gen-mmx-log #xda)) + (pminsw . ,(gen-mmx-log #xea)) + (pmulhuw . ,(gen-mmx-log #xe4)) + (psadbw . ,(gen-mmx-log #xf6)) + (punpcklbw . ,(gen-mmx-unplow #x60)) + (punpcklwd . ,(gen-mmx-unplow #x61)) + (punpckldq . ,(gen-mmx-unplow #x62)) + (psrlw . ,(gen-mmx-shr #xd1 #x71 #b010)) + (psrld . ,(gen-mmx-shr #xd2 #x72 #b010)) + (psrlq . ,(gen-mmx-shr #xd3 #x73 #b010)) + (psllw . ,(gen-mmx-shr #xf1 #x71 #b110)) + (pslld . ,(gen-mmx-shr #xf2 #x72 #b110)) + (psllq . ,(gen-mmx-shr #xf3 #x73 #b110)) + (psraw . ,(gen-mmx-shr #xe1 #x71 #b100)) + (psrad . ,(gen-mmx-shr #xe2 #x72 #b100)) + (movaps . ,(gen-sse1-mov '(#x0f #x28) '(#x0f #x29))) + (movups . ,(gen-sse1-mov '(#x0f #x10) '(#x0f #x11))) + (addps . ,(gen-sse-ps/pd '(#x0f #x58))) + (subps . ,(gen-sse-ps/pd '(#x0f #x5c))) + (mulps . ,(gen-sse-ps/pd '(#x0f #x59))) + (divps . ,(gen-sse-ps/pd '(#x0f #x5e))) + (rcpps . ,(gen-sse-ps/pd '(#x0f #x53))) + (sqrtps . ,(gen-sse-ps/pd '(#x0f #x51))) + (rsqrtps . ,(gen-sse-ps/pd '(#x0f #x52))) + (maxps . ,(gen-sse-ps/pd '(#x0f #x5f))) + (minps . ,(gen-sse-ps/pd '(#x0f #x5d))) + (andps . ,(gen-sse-ps/pd '(#x0f #x54))) + (andnps . ,(gen-sse-ps/pd '(#x0f #x55))) + (orps . ,(gen-sse-ps/pd '(#x0f #x56))) + (xorps . ,(gen-sse-ps/pd '(#x0f #x57))) + (unpckhps . ,(gen-sse-ps/pd '(#x0f #x15))) + (unpcklps . ,(gen-sse-ps/pd '(#x0f #x14))) + (addpd . ,(gen-sse-ps/pd '(#x66 #x0f #x58))) + (subpd . ,(gen-sse-ps/pd '(#x66 #x0f #x5c))) + (mulpd . ,(gen-sse-ps/pd '(#x66 #x0f #x59))) + (divpd . ,(gen-sse-ps/pd '(#x66 #x0f #x5e))) + (sqrtpd . ,(gen-sse-ps/pd '(#x66 #x0f #x51))) + (maxpd . ,(gen-sse-ps/pd '(#x66 #x0f #x5f))) + (minpd . ,(gen-sse-ps/pd '(#x66 #x0f #x5d))) + (andpd . ,(gen-sse-ps/pd '(#x66 #x0f #x54))) + (andnpd . ,(gen-sse-ps/pd '(#x66 #x0f #x55))) + (orpd . ,(gen-sse-ps/pd '(#x66 #x0f #x56))) + (xorpd . ,(gen-sse-ps/pd '(#x66 #x0f #x57))) + (unpckhpd . ,(gen-sse-ps/pd '(#x66 #x0f #x15))) + (unpcklpd . ,(gen-sse-ps/pd '(#x66 #x0f #x14))) + (cvtpd2dq . ,(gen-sse-ps/pd '(#xf2 #x0f #xe6))) + (cvttpd2dq . ,(gen-sse-ps/pd '(#x66 #x0f #xe6))) + (cvtdq2ps . ,(gen-sse-ps/pd '(#x0f #x5b))) + (cvtps2dq . ,(gen-sse-ps/pd '(#x66 #x0f #x5b))) + (cvttps2dq . ,(gen-sse-ps/pd '(#xf3 #x0f #x5b))) + (cvtpd2ps . ,(gen-sse-ps/pd '(#x66 #x0f #x5a))) + (punpckhqdq . ,(gen-sse-ps/pd '(#x66 #x0f #x6d))) + (punpcklqdq . ,(gen-sse-ps/pd '(#x66 #x0f #x6c))) + (addsubps . ,(gen-sse-ps/pd '(#xf2 #x0f #xd0))) + (addsubpd . ,(gen-sse-ps/pd '(#x66 #x0f #xd0))) + (haddps . ,(gen-sse-ps/pd '(#xf2 #x0f #x7c))) + (hsubps . ,(gen-sse-ps/pd '(#xf2 #x0f #x7d))) + (haddpd . ,(gen-sse-ps/pd '(#x66 #x0f #x7c))) + (hsubpd . ,(gen-sse-ps/pd '(#x66 #x0f #x7d))) + (movshdup . ,(gen-sse-ps/pd '(#xf3 #x0f #x16))) + (movsldup . ,(gen-sse-ps/pd '(#xf3 #x0f #x12))) + (addss . ,(gen-sse1-ss '(#xf3 #x0f #x58))) + (subss . ,(gen-sse1-ss '(#xf3 #x0f #x5c))) + (mulss . ,(gen-sse1-ss '(#xf3 #x0f #x59))) + (divss . ,(gen-sse1-ss '(#xf3 #x0f #x5e))) + (rcpss . ,(gen-sse1-ss '(#xf3 #x0f #x53))) + (sqrtss . ,(gen-sse1-ss '(#xf3 #x0f #x51))) + (rsqrtss . ,(gen-sse1-ss '(#xf3 #x0f #x52))) + (maxss . ,(gen-sse1-ss '(#xf3 #x0f #x5f))) + (minss . ,(gen-sse1-ss '(#xf3 #x0f #x5d))) + (comiss . ,(gen-sse1-ss '(#x0f #x2f))) + (ucomiss . ,(gen-sse1-ss '(#x0f #x2e))) + (movhps . ,(gen-sse1-mov2 '(#x0f #x16) '(#x0f #x17))) + (movlps . ,(gen-sse1-mov2 '(#x0f #x12) '(#x0f #x13))) + (movhlps . ,(gen-xmm-r/r '(#x0f #x12))) + (movlhps . ,(gen-xmm-r/r '(#x0f #x16))) + (cmpss . ,(meta-lambda + (and xmm (or xmm m32) i8 + (lambda (x y z) + (r-r/m-i 1 '(#xf3 #x0f #xc2) x y z))))) + (shufps . ,(gen-sse-cmp '(#x0f #xc6))) + (cmpps . ,(gen-sse-cmp '(#x0f #xc2))) + (movmskps . ,(gen-sse-movmsk '(#x0f #x50))) + (movss . ,(meta-lambda + (or (and xmm (or xmm m32) + (lambda (x y) + (r-r/m 1 '(#xf3 #x0f #x10) x y))) + (and m32 xmm + (lambda (x y) + (r/m-r 1 '(#xf3 #x0f #x11) x y)))))) + (cvtpi2ps . ,(gen-sse-pi2pds '(#x0f #x2a))) + (cvtsi2ss . ,(gen-sse-si2sssd '(#xf3 #x0f #x2a))) + (cvtps2pi . ,(gen-sse1-ps2pi #x2d)) + (cvttps2pi . ,(gen-sse1-ps2pi #x2c)) + (cvttss2si . ,(gen-sse1-ss2si #x2c)) + (cvtss2si . ,(gen-sse1-ss2si #x2d)) + (ldmxcsr . ,(gen-rm #xae #b010)) + (stmxcsr . ,(gen-rm #xae #b011)) + (pextrw . ,(meta-lambda + (and r32 + (or (and mm i8 (lambda (x y z) + (r-r/m-i 1 '(#x0f #xc5) x y z))) + (and xmm i8) + (lambda (x y z) + (r-r/m-i 1 '(#x66 #x0f #xc5) x y z)))))) + (pinsrw . ,(meta-lambda + (or (and mm (or r32 m16) i8 + (lambda (x y z) + (r-r/m-i 1 '(#x0f #xc4) x y z))) + (and xmm (or r32 m16) i8 + (lambda (x y z) + (r-r/m-i 1 '(#x66 #x0f #xc4) x y z)))))) + (pmovmskb . ,(meta-lambda + (and r32 + (or (and mm (lambda (x y) + (r-r/m 1 '(#x0f #xd7) x y))) + (and xmm + (lambda (x y) + (r-r/m 1 '(#x66 #x0f #xd7) x y))))))) + (pshufw . ,(meta-lambda + (and mm (or mm m64) i8 + (lambda (x y z) (r-r/m-i 1 '(#x0f #x70) x y z))))) + (maskmovq . ,(meta-lambda + (and mm mm + (lambda (x y) (r-r/m 1 '(#x0f #xf7) x y))))) + (movntq . ,(meta-lambda + (and m64 mm + (lambda (x y) (r/m-r 1 '(#x0f #xe7) x y))))) + (movntps . ,(gen-sse-movnt '(#x0f #x2b))) + (prefetcht0 . ,(gen-rm8 #x18 #b001)) + (prefetcht1 . ,(gen-rm8 #x18 #b010)) + (prefetcht2 . ,(gen-rm8 #x18 #b011)) + (prefetchnta . ,(gen-rm8 #x18 #b000)) + (sfence . ,(gen-non 1 '(#x0f #xae #xf8))) + (movapd . ,(gen-sse1-mov '(#x66 #x0f #x28) '(#x66 #x0f #x29))) + (movupd . ,(gen-sse1-mov '(#x66 #x0f #x10) '(#x66 #x0f #x11))) + (movdqa . ,(gen-sse1-mov '(#x66 #x0f #x6f) '(#x66 #x0f #x7f))) + (movdqu . ,(gen-sse1-mov '(#xf3 #x0f #x6f) '(#xf3 #x0f #x7f))) + (movhpd . ,(gen-sse1-mov2 '(#x66 #x0f #x16) '(#x66 #x0f #x17))) + (movlpd . ,(gen-sse1-mov2 '(#x66 #x0f #x12) '(#x66 #x0f #x13))) + (movmskpd . ,(gen-sse-movmsk '(#x66 #x0f #x50))) + (movsd . ,(meta-lambda + (or (begin (just-c 4 #xa5)) ;string instruction + (and xmm (or xmm m64) + (lambda (x y) + (r-r/m 1 '(#xf2 #x0f #x10) x y))) + (and m64 xmm + (lambda (x y) + (r/m-r 1 '(#xf2 #x0f #x11) x y)))))) + (addsd . ,(gen-sse2-sd '(#xf2 #x0f #x58))) + (subsd . ,(gen-sse2-sd '(#xf2 #x0f #x5c))) + (mulsd . ,(gen-sse2-sd '(#xf2 #x0f #x59))) + (divsd . ,(gen-sse2-sd '(#xf2 #x0f #x5e))) + (maxsd . ,(gen-sse2-sd '(#xf2 #x0f #x5f))) + (minsd . ,(gen-sse2-sd '(#xf2 #x0f #x5d))) + (sqrtsd . ,(gen-sse2-sd '(#xf2 #x0f #x51))) + (comisd . ,(gen-sse2-sd '(#x66 #x0f #x2f))) + (ucomisd . ,(gen-sse2-sd '(#x66 #x0f #x2e))) + (cvtdq2pd . ,(gen-sse2-sd '(#xf3 #x0f #xe6))) + (cvtps2pd . ,(gen-sse2-sd '(#x0f #x5a))) + (cvtsd2ss . ,(gen-sse2-sd '(#xf2 #x0f #x5a))) + (cmppd . ,(gen-sse-cmp '(#x66 #x0f #xc2))) + (shufpd . ,(gen-sse-cmp '(#x66 #x0f #xc6))) + (pshuflw . ,(gen-sse-cmp '(#xf2 #x0f #x70))) + (pshufhw . ,(gen-sse-cmp '(#xf3 #x0f #x70))) + (pshufd . ,(gen-sse-cmp '(#x66 #x0f #x70))) + (cmpsd . ,(meta-lambda + (or (begin (just-c 4 #xa7)) ;string version + (and xmm (or xmm m64) i8 + (lambda (x y z) + (r-r/m-i 1 '(#xf2 #x0f #xc2) x y z)))))) + (cvttpd2pi . ,(gen-sse-pd2pi '(#x66 #x0f #x2c))) + (cvtpd2pi . ,(gen-sse-pd2pi '(#x66 #x0f #x2d))) + (cvtpi2pd . ,(gen-sse-pi2pds '(#x66 #x0f #x2a))) + (cvtss2sd . ,(gen-sse1-ss '(#xf3 #x0f #x5a))) + (cvtsd2si . ,(gen-sse2-sd2si '(#xf2 #x0f #x2d))) + (cvttsd2si . ,(gen-sse2-sd2si '(#xf2 #x0f #x2c))) + (cvtsi2sd . ,(gen-sse-si2sssd '(#xf2 #x0f #x2a))) + (movq2dq . ,(meta-lambda + (and xmm mm (lambda (x y) + (r-r/m 1 '(#xf3 #x0f #xd6) x y))))) + (movdq2q . ,(meta-lambda + (and mm xmm (lambda (x y) + (r-r/m 1 '(#xf2 #x0f #xd6) x y))))) + (pmuludq . ,(gen-mmx-log #xf4)) + (paddq . ,(gen-mmx-log #xd4)) + (psubq . ,(gen-mmx-log #xfb)) + (pslldq . ,(gen-sse2-sr #b111)) + (psrldq . ,(gen-sse2-sr #b011)) + (pause . ,(gen-non 1 '(#xf3 #x90))) + (lfence . ,(gen-non 1 '(#x0f #xae #xe8))) + (mfence . ,(gen-non 1 '(#x0f #xae #xf0))) + (clflush . ,(gen-rm8 #xae #b111)) + (maskmovdqu . ,(gen-xmm-r/r '(#x66 #x0f #xf7))) + (movntpd . ,(gen-sse-movnt '(#x66 #x0f #x2b))) + (movntdq . ,(gen-sse-movnt '(#x66 #x0f #xe7))) + (movnti . ,(meta-lambda + (and m32 r32 + (lambda (x y) (r/m-r 1 '(#x0f #xc3) x y))))) + (fisttp . ,(meta-lambda + (or (and m32 (lambda (x) (r/m 1 #xdb x #b001))) + (and m64 (lambda (x) (r/m 1 #xdd x #b001))) + (and m16 (lambda (x) (r/m 1 #xdf x #b001)))))) + (lddqu . ,(meta-lambda + (and xmm mem-any + (lambda (x y) (r-r/m 1 '(#xf2 #x0f #xf0) x y))))) + (movddup . ,(gen-sse2-sd '(#xf2 #x0f #x12))) + (monitor . ,(gen-non 1 '(#x0f #x01 #xc8))) + (mwait . ,(gen-non 1 '(#x0f #x01 #xc9))) + )))))) ;end the-opcodes + + (set! emit-direct %emit-direct) + (set! emit-direct2 %emit-direct2) + (set! opcode? %opcode?)) + diff --git a/module/language/sassy/operands.scm b/module/language/sassy/operands.scm new file mode 100644 index 000000000..0c5ff844c --- /dev/null +++ b/module/language/sassy/operands.scm @@ -0,0 +1,244 @@ +; operands.scm - Sassy's operand predicates +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module operands +; import numbers srfi-69 +; import-syntax meta-lambda +; export all + + +; register type operands +(define r8 #f) +(define r16 #f) +(define r32 #f) +(define mm #f) +(define st #f) +(define xmm #f) +(define creg #f) +(define dreg #f) +(define sreg #f) +(define (r32-not-esp x) (and (not (eq? x 'esp)) (r32 x))) +(define (sreg-not-cs x) (and (not (eq? x 'cs)) (sreg x))) + +(define symbol #f) +(let + ((the-registers + (alist->hash-table + '((eax . (32 . 0)) (ecx . (32 . 1)) (edx . (32 . 2)) (ebx . (32 . 3)) + (esp . (32 . 4)) (ebp . (32 . 5)) (esi . (32 . 6)) (edi . (32 . 7)) + (ax . (16 . 0)) (cx . (16 . 1)) (dx . (16 . 2)) (bx . (16 . 3)) + (sp . (16 . 4)) (bp . (16 . 5)) (si . (16 . 6)) (di . (16 . 7)) + (al . (8 . 0)) (cl . (8 . 1)) (dl . (8 . 2)) (bl . (8 . 3)) + (ah . (8 . 4)) (ch . (8 . 5)) (dh . (8 . 6)) (bh . (8 . 7)) + (st0 . (80 . 0)) (st1 . (80 . 1)) (st2 . (80 . 2)) (st3 . (80 . 3)) + (st4 . (80 . 4)) (st5 . (80 . 5)) (st6 . (80 . 6)) (st7 . (80 . 7)) + (mm0 . (64 . 0)) (mm1 . (64 . 1)) (mm2 . (64 . 2)) (mm3 . (64 . 3)) + (mm4 . (64 . 4)) (mm5 . (64 . 5)) (mm6 . (64 . 6)) (mm7 . (64 . 7)) + (xmm0 . (128 . 0)) (xmm1 . (128 . 1)) (xmm2 . (128 . 2)) + (xmm3 . (128 . 3)) (xmm4 . (128 . 4)) (xmm5 . (128 . 5)) + (xmm6 . (128 . 6)) (xmm7 . (128 . 7)) + (es . (1 . 0)) (cs . (1 . 1)) (ss . (1 . 2)) + (ds . (1 . 3)) (fs . (1 . 4)) (gs . (1 . 5)) + (cr0 . (2 . 0)) (cr2 . (2 . 2)) (cr3 . (2 . 3)) (cr4 . (2 . 4)) + (dr0 . (3 . 0)) (dr1 . (3 . 1)) (dr2 . (3 . 2)) + (dr3 . (3 . 3)) (dr6 . (3 . 6)) (dr7 . (3 . 7)) + )))) ;sreg type-code = 1 creg type-code = 2 dreg type-code = 3 + (let ((reg-x (lambda (reg-type-code) + (memoize + (lambda (x) + (cond ((hash-table-ref the-registers x (lambda () #f)) => + (lambda (found) + (and (= reg-type-code (car found)) (cdr found)))) + (else #f))))))) + (set! r8 (reg-x 8)) + (set! r16 (reg-x 16)) + (set! r32 (reg-x 32)) + (set! mm (reg-x 64)) + (set! st (reg-x 80)) + (set! xmm (reg-x 128)) + (set! creg (reg-x 2)) + (set! dreg (reg-x 3)) + (set! sreg (reg-x 1)) + (set! symbol (memoize + (lambda (x) + (or (and (symbol? x) + (not (hash-table-ref the-registers + x (lambda () #f))) + x) + (custom-reloc x))))))) + +; For the remainder of the following, every operand is either an e_ u_ +; or general. The u-types are for unexplicit operand sizes. The +; e-types are for the cases where the operand size if explicit, and +; the general is either of those. + +; mem type operands - the actual parsing happens in proc-mem in operands +(define um8 + (memoize + (let ((segger (lambda (x) (and (memq x '(cs ss ds es fs gs)) x))) + (mem (meta-lambda (and '& __)))) + (meta-lambda + (or ,@mem + (and segger mem)))))) +(define um16 um8) +(define um32 um8) +(define um64 um8) +(define um80 um8) +(define um128 um8) + +(define em8 (memoize (meta-lambda (and 'byte um8)))) +(define em16 (memoize (meta-lambda (and 'word um16)))) +(define em32 (memoize (meta-lambda (and 'dword um32)))) +(define em64 (memoize (meta-lambda (and 'qword um64)))) +(define em80 (memoize (meta-lambda (and 'tword um80)))) +(define em128 (memoize (meta-lambda (and 'dqword um128)))) + +(define (m8 x) (or (um8 x) (em8 x))) +(define (m16 x) (or (um16 x) (em16 x))) +(define (m32 x) (or (um32 x) (em32 x))) +(define (m64 x) (or (um64 x) (em64 x))) +(define (m80 x) (or (um80 x) (em80 x))) +(define (m128 x) (or (um128 x) (em128 x))) + +(define (mem-any x) + (or (m32 x) (m16 x) (m8 x) (m64 x) (m80 x) (m128 x))) + + +; NOTE: This needs fixing. The current bit-size should be checked to +; make sure that "target" and "value", if specified, fit within the +; current bit size. +(define custom-reloc + (meta-lambda + (and 'reloc + (or (and 'rel + (or symbol? u-dword) + (or (lambda (target) (list 'reloc 'rel target 0)) + (else (lambda x (error "sassy: bad rel reloc" x))))) + (and symbol? + (or (lambda (type) (list 'reloc type #f 0)) + (and (or symbol? u-dword) + (or (lambda (type target) (list 'reloc type target 0)) + (and s-dword + (lambda (type target value) + (list 'reloc type target value))))))))))) + +; rel type operands are used by branches + +(define urel8 (memoize (meta-lambda (or ,@u-byte ,@symbol)))) +(define urel16 (memoize (meta-lambda (or ,@u-word ,@symbol)))) +(define urel32 (memoize (meta-lambda (or ,@u-dword ,@symbol)))) + +(define erel8 (memoize (meta-lambda (and 'byte urel8)))) +(define erel16 (memoize (meta-lambda (and 'word urel16)))) +(define erel32 (memoize (meta-lambda (and 'dword urel32)))) + +(define (rel8 x) (or (urel8 x) (erel8 x))) +(define (rel16 x) (or (urel16 x) (erel16 x))) +(define (rel32 x) (or (urel32 x) (erel32 x))) + +; mi type operand is used by mov instruction only with eax +(define umi8 #f) +(define umi16 #f) +(define umi32 #f) + +(define emi8 (memoize (meta-lambda (and 'byte umi8)))) +(define emi16 (memoize (meta-lambda (and 'word umi16)))) +(define emi32 (memoize (meta-lambda (and 'dword umi32)))) + +(define (mi8 x) (or (umi8 x) (emi8 x))) +(define (mi16 x) (or (umi16 x) (emi16 x))) +(define (mi32 x) (or (umi32 x) (emi32 x))) + +(let ((mi (lambda (x) + (let ((asym #f) + (acc 0)) + (let ((a-rest + (meta-lambda + (or (and ,@symbol + (lambda (x) (and (not asym) (set! asym x)))) + (and ,@integer? + (lambda (x) (set! acc (+ x acc)))))))) + (let ((go (meta-lambda + (and '& (+ a-rest) + (begin + (cond ((pair? asym) + (list 'reloc (car asym) (cadr asym) + (+ acc (caddr asym)))) + ((symbol? asym) + (list 'reloc 'abs asym acc)) + ((not asym) acc))))))) +; (list 'reloc 'abs acc 0)))))))) + (go x))))))) + (set! umi8 mi) + (set! umi16 mi) + (set! umi32 mi)) + +; immediate type operands +; unexplicit +(define ui8 #f) +(define ui16 #f) +(define ui32 #f) + +; explicit eg (dword N) +(define ei8 (memoize (meta-lambda (and 'byte ui8)))) +(define ei16 (memoize (meta-lambda (and 'word ui16)))) +(define ei32 (memoize (meta-lambda (and 'dword ui32)))) + +; any +(define (i8 x) (or (ui8 x) (ei8 x))) +(define (i16 x) (or (ui16 x) (ei16 x))) +(define (i32 x) (or (ui32 x) (ei32 x))) + +(let ((string-able + (lambda (z) + (lambda (x) + (and (string? x) + (<= (string-length x) z) + (let ((tmp (string-append x (make-string (- z (string-length x)) + (integer->char 0))))) + (do ((i (- z 1) (- i 1)) + (r 0 (+ (ash r 8) (char->integer (string-ref tmp i))))) + ((< i 0) r)))))))) + (let ((str1 (string-able 1)) + (str2 (string-able 2)) + (str4 (string-able 4)) + (u/s-byte u/s-byte) + (u/s-word u/s-word) + (u/s-dword u/s-dword)) + (let ((imm16/32 + (lambda (num-pred str-pred) + (meta-lambda + (or ,@num-pred + ,@symbol + ,@str-pred + (and ,@char? (lambda (x) (char->integer x)))))))) + (set! ui8 (memoize + (meta-lambda + (or ,@u/s-byte + ,@str1 + (and ,@char? (lambda (x) (char->integer x))))))) + (set! ui16 (memoize (imm16/32 u/s-word str2))) + (set! ui32 (memoize (imm16/32 u/s-dword str4)))))) diff --git a/module/language/sassy/parse.scm b/module/language/sassy/parse.scm new file mode 100644 index 000000000..1301fc915 --- /dev/null +++ b/module/language/sassy/parse.scm @@ -0,0 +1,282 @@ +; parse.scm - Sassy's top level parser +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module parse +; import macros api text numbers opcodes push-stacks operands intern +; import-syntax meta-lambda +; export all + +(define parse-directives + + (let () + + (define (process-bits int output) + (if (or (= 16 int) (= 32 int)) + (sassy-bits-set! output int) + (error "sassy: bad bits" int))) + + (define (process-org text-base output) + (if (and (integer? text-base) + (zero? (sassy-text-size output)) + (positive? text-base)) + (sassy-text-org-set! output text-base) + (error "sassy: bad org" text-base))) + + (define (process-entry entry-label output) + (if (symbol? entry-label) + (begin (sassy-symbol-set! output entry-label '(scope export)) + (sassy-entry-point-set! output entry-label)) + (error "sassy: bad entry" entry-label))) + + (define (process-include include-list output) + (for-each + (lambda (x) + (cond ((string? x) (parse-directives (read-file x) output)) + ((symbol? x) (parse-directives (eval x + (interaction-environment)) + output)) + (else (error "sassy: bad include" x)))) + include-list)) + + (define (process-scopes scope-list scope output) + (for-each (lambda (x) + (if (eq? 'import scope) + (sassy-symbol-def-error output x)) + (if (symbol? x) + (sassy-symbol-set! output x `(scope ,scope)) + (error "sassy: bad scope" scope x))) + scope-list)) + + (define (align-to count align) + (let ((diff (modulo count align))) + (if (zero? diff) + 0 + (- align diff)))) + + (define aligner + (let ((power-of-2 (lambda (x) + (and (integer? x) (positive? x) + (zero? (logand x (- x 1))) + x)))) + (meta-lambda + (and 'align power-of-2)))) + + (define (process-heap heap-list output) + (letrec + ((heap-sizer + (meta-lambda + (or (and 'bytes u-dword) + (and 'words u-dword (lambda (units) (* units 2))) + (and 'dwords u-dword (lambda (units) (* units 4))) + (and 'qwords u-dword (lambda (units) (* units 8)))))) + (heap-item + (meta-lambda + (or + (and ,@aligner (lambda (align) + (let ((size (sassy-heap-size output))) + (sassy-heap-size-set! + output (+ size (align-to size align))) + (when (> align (sassy-heap-align output)) + (sassy-heap-align-set! output align))))) + (and ,@heap-sizer (lambda (sizer) + (sassy-heap-size-set! + output (+ sizer (sassy-heap-size output))))) + (and 'label valid-label __ + (lambda (label . rst) + (let ((current-size (sassy-heap-size output))) + (sassy-symbol-def-error output label) + (sassy-symbol-set! output label '(section heap) + `(offset ,current-size) '(size 0)) + (for-each heap-item rst) + (sassy-symbol-set! output label + `(size ,(- (sassy-heap-size output) + current-size)))))) + (and 'begin (* heap-item)) + (else (lambda (h) (error "sassy: bad heap item" h))))))) + (for-each heap-item heap-list))) + + (define (process-text text-list output) + (letrec ((text-item + (meta-lambda + (or + (and ,@aligner (lambda (align) + (push-stack-align (sassy-text-stack output) + align #x90 + (sassy-text-org output)) + (if (> align (sassy-text-align output)) + (sassy-text-align-set! output align)))) + (and 'label valid-label __ + (lambda (label . opcodes-or-prims) + (sassy-symbol-def-error output label) + (sassy-symbol-set! + output label + '(section text) + `(offset ,(+ (sassy-text-org output) + (sassy-text-size output)))) + (sassy-symbol-set! + output label + `(size ,(handle-text-block `(begin ,@opcodes-or-prims) + output (t-make)))))) + (else (lambda (opcode-or-prim) + (handle-text-block opcode-or-prim output + (t-make)))))))) + (for-each text-item text-list))) + + (define (sassy-reloc-set! output name section offset type patcher) + (sassy-reloc-list-set! + output (cons (make-sassy-reloc name section offset type patcher) + (sassy-reloc-list output)))) + + (define (process-data data-list output) + (letrec + ((current-byte-size (/ (sassy-bits output) 8)) + (char/str/num + (lambda (item size) + (let ((data-stack (sassy-data-stack output))) + (cond ((char? item) + (push-stack-push data-stack (char->integer item)) + (push-stack-align data-stack size 0)) + ((string? item) + (push-stack-push data-stack + (map char->integer (string->list item))) + (push-stack-align data-stack size 0)) + ((number? item) + (push-stack-push data-stack + (number->byte-list item size))) + (else (lambda (i) (error "sassy: bad data" i))))))) + + (handle-data-symbol + (lambda (type target value) + (when (eqv? 'rel type) + (error "no rel relocations in data section right now" + (list 'reloc type target value))) + (when (eqv? '$here target) + (set! target (sassy-data-size output))) + (let* ((offset (sassy-data-size output)) + (target-value (cond ((sassy-symbol-exists-env? + output target) + => + (lambda (x) (sassy-symbol-offset x))) + (else target))) + (a-reloc (make-sassy-reloc + (get-reloc-target target output) + 'data offset type #f value current-byte-size)) + (patcher (let ((p (push-stack-push->patcher + (sassy-data-stack output) + (number->byte-list value + current-byte-size)))) + (lambda (new) + (p (number->byte-list new current-byte-size)) + (sassy-reloc-value-set! a-reloc new))))) + (sassy-reloc-patcher-set! a-reloc patcher) + (sassy-reloc-list-set! output + (cons a-reloc (sassy-reloc-list output))) + (if (number? target-value) + (patcher (+ target-value value)) + (sassy-symbol-set! + output target + `(unres ,(lambda (n) (patcher (+ n value))))))))) + (data4 + (meta-lambda + (or + (and ,@symbol? (lambda (label) + (check-label-size 4 current-byte-size 'dwords + label) + (handle-data-symbol 'abs label 0))) + (and ,@custom-reloc (lambda (a-reloc) + (check-label-size 4 current-byte-size + 'dwords a-reloc) + (apply handle-data-symbol (cdr a-reloc)))) + (else (lambda (data) (char/str/num data 4)))))) + (data2 + (meta-lambda + (or + (and ,@symbol? (lambda (label) + (check-label-size 2 current-byte-size 'words + label) + (handle-data-symbol 'abs label 0))) + (and ,@custom-reloc (lambda (a-reloc) + (check-label-size 2 current-byte-size + 'words a-reloc) + (apply handle-data-symbol (cdr a-reloc)))) + (else (lambda (data) (char/str/num data 2)))))) + (data-item + (meta-lambda + (or + (and ,@aligner (lambda (align) + (push-stack-align (sassy-data-stack output) + align 0) + (if (> align (sassy-data-align output)) + (sassy-data-align-set! output align)))) + (and 'label valid-label __ + (lambda (label . things) + (sassy-symbol-def-error output label) + (let ((offset (sassy-data-size output))) + (sassy-symbol-set! output label '(section data) + `(offset ,offset)) + (for-each data-item things) + (sassy-symbol-set! output label + `(size ,(- (sassy-data-size output) + offset)))))) + (and 'locals pair? __ + (lambda (locals . body) + (let ((reset! (setup-locals locals output #f))) + (for-each data-item body) + (reset!)))) + (and 'dwords __ (lambda datas (for-each data4 datas))) + (and 'bytes __ (lambda datas (for-each + (lambda (x) (char/str/num x 1)) + datas))) + (and 'words __ (lambda datas (for-each data2 datas))) + (and 'qwords __ (lambda datas (for-each + (lambda (x) (char/str/num x 8)) + datas))) + (and 'begin (* data-item)) + (else (lambda (i) (error "sassy: bad data items" i))))))) + (for-each data-item data-list))) + + (lambda (directives-list output) + (letrec + ((parse-expand (lambda (itm) (parse (sassy-expand itm)))) + (parse + (meta-lambda + (or + ,@'void + (and 'text __ (lambda lst (process-text lst output))) + (and 'heap __ (lambda lst (process-heap lst output))) + (and 'data __ (lambda lst (process-data lst output))) + (and 'import __ (lambda lst (process-scopes + lst 'import output))) + (and 'export __ (lambda lst (process-scopes + lst 'export output))) + (and 'include __ (lambda lst (process-include lst output))) +; (and 'direcs __ (lambda lst (parse-directives lst output))) + (and 'entry ? (lambda (symb) (process-entry symb output))) + (and 'org ? (lambda (int ) (process-org int output))) + (and 'bits ? (lambda (int ) (process-bits int output))) + (and 'begin (* parse-expand)) + (else (lambda (err) (error "sassy: bad directive" err))))))) + (for-each parse-expand directives-list))))) diff --git a/module/language/sassy/push-stacks.scm b/module/language/sassy/push-stacks.scm new file mode 100644 index 000000000..cb9b7511e --- /dev/null +++ b/module/language/sassy/push-stacks.scm @@ -0,0 +1,187 @@ +; push-stacks.scm - A stack-like data-type +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module sassy-push-stacks +; import-syntax meta-lambda +; export all + +(define make-pushdown-stack #f) +(define make-pushup-stack #f) + +(let ((make-push-stack + (lambda (direc) + (define size 0) + (define items '()) + (define pointer '()) + (define down-stack-base '()) + + (define (cycle lst siz) + (do ((ls lst (cdr ls)) + (c siz (+ c 1))) + ((null? (cdr ls)) (set! size c) ls))) + + (define push-gs + (if (eqv? 'up direc) + (lambda (itm-or-pr) + (and (not (pair? itm-or-pr)) + (set! itm-or-pr (list itm-or-pr))) + (if (null? pointer) + (begin (set! items itm-or-pr) + (set! pointer (cycle itm-or-pr (+ size 1))) + items) + (begin (set-cdr! pointer itm-or-pr) + (let ((old (cdr pointer))) + (set! pointer (cycle pointer size)) + old)))) + (lambda (itm-or-pr) + (let ((push-one (lambda () ; fast path for non-pairs + (set! items (cons itm-or-pr items)) + (set! pointer items) + (set! size (+ size 1))))) + (if (null? pointer) + (if (not (pair? itm-or-pr)) + (begin (push-one) + (set! down-stack-base pointer) + pointer) + (begin (set! items itm-or-pr) + (set! down-stack-base + (cycle itm-or-pr (+ size 1))) + (set! pointer items) + pointer)) + (if (not (pair? itm-or-pr)) + (begin (push-one) + pointer) + (begin (set-cdr! (cycle itm-or-pr (+ size 1)) items) + (set! items itm-or-pr) + (set! pointer itm-or-pr) + pointer))))))) +; (and (not (pair? lst)) +; (set! lst (list lst))) +; (if (null? pointer) +; (begin (set! items lst) +; (set! down-stack-base (cycle lst (+ size 1))) +; (set! pointer items) +; pointer) +; (begin (set-cdr! (cycle lst (+ size 1)) items) +; (set! items lst) +; (set! pointer lst) +; pointer))))) + + (define (patch-gs pnt lst) + (do ((rst lst (cdr rst)) + (loc pnt (cdr loc))) + ((null? rst)) + (set-car! loc (car rst)))) + + (define previous '()) + + (define append-gs + (if (eqv? 'up direc) + (lambda (stk2) + (if (memq stk2 previous) + (error "tried to append! the same stacks twice" stk2) + (begin (set! previous (cons stk2 previous)) + (set! size (+ size (stk2 'size))) + (if (null? pointer) + (set! items (stk2 'items)) + (set-cdr! pointer (stk2 'items))) + (let ((p (if (eqv? 'up (stk2 'direc)) + (stk2 'pointer) + (stk2 'down-base)))) + (if (and (not (eq? pointer p)) + (not (null? p))) + (set! pointer p)))))) + (lambda (stk2) + (if (memq stk2 previous) + (error "tried to append! the same stacks twice" stk2) + (begin (set! previous (cons stk2 previous)) + (set! size (+ size (stk2 'size))) + (if (null? pointer) + (begin (set! items (stk2 'items)) + (set! pointer items)) + (set-cdr! down-stack-base (stk2 'items))) + (let ((d (if (eqv? 'up (stk2 'direc)) + (stk2 'pointer) + (stk2 'down-base)))) + (if (and (not (eq? down-stack-base d)) + (not (null? d))) + (set! down-stack-base d)))))))) + + (meta-lambda-dot + (or (and 'push ? (lambda (x) (push-gs x))) + (and 'size (begin size)) + (and 'patch pair? (or (and pair? (lambda (x y) (patch-gs x y))) + (and ? (lambda (x y) (set-car! x y))))) + (and 'append procedure? (lambda (x) (append-gs x))) + (and 'set-previous procedure? (lambda (x) (set! previous + (cons x previous)))) + (and 'pointer (begin pointer)) + (and 'down-base (begin down-stack-base)) + (and 'items (begin items)) + (and 'save (begin + (let ((os size) (op pointer) (oi items)) + (lambda () + (set! size os) + (set! pointer op) + (set! items oi) + (if (and (not (null? pointer)) (eqv? direc 'up)) + (set-cdr! pointer '())))))) + (and 'push-proc ? (lambda (x) (let ((t (push-gs x))) + (lambda (new) (patch-gs t new))))) + (and 'direc (begin direc)) + ; last because it may return #f + (and 'empty (begin (null? items)))))))) + + (set! make-pushdown-stack (lambda () (make-push-stack 'up))) + (set! make-pushup-stack (lambda () (make-push-stack 'down)))) + +(define (push-stack-push stk itm) (stk 'push itm)) +(define (push-stack-pointer stk) (stk 'pointer)) +(define (push-stack-items stk) (stk 'items)) +(define (push-stack-patch stk pnt itm) (stk 'patch pnt itm)) +(define (push-stack-push->patcher stk itm) (stk 'push-proc itm)) +(define (push-stack-save stk) (stk 'save)) +(define (push-stack-direction stk) (stk 'direc)) +(define (push-stack-size stk) (stk 'size)) +(define (push-stack-append! stk1 stk2) + (stk2 'set-previous stk1) + (stk1 'append stk2)) +(define (push-stack-empty? stk) (stk 'empty)) +(define push-stack-align + (let ((align-to (lambda (count align) + (let ((diff (modulo count align))) + (if (zero? diff) + 0 + (- align diff)))))) + (lambda (stk align fill . offset) + (let ((amount (align-to (+ (stk 'size) + (if (null? offset) 0 (car offset))) + align))) + (if (pair? fill) + (error "can not fill a push-stack with a pair" fill) + (when (not (zero? amount)) + (stk 'push (make-list amount fill)))))))) + diff --git a/module/language/sassy/text-block.scm b/module/language/sassy/text-block.scm new file mode 100644 index 000000000..a65a27031 --- /dev/null +++ b/module/language/sassy/text-block.scm @@ -0,0 +1,72 @@ +; text-block.scm - an internal data type for Sassy +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module text-blocks +; import push-stacks srfi-9 +; export all + +(define-record-type text-block + (make-text-block a b c d e f g) text-block? + (a t-text) + (b t-reloc t-reloc-set!) + (c t-res t-res-set!) + (d t-unres t-unres-set!) + (e t-mark t-mark-set!) + (f t-label t-label-set!) + (g t-env t-env-set!)) + +(define (push-t-reloc! t i) (t-reloc-set! t (cons i (t-reloc t)))) +(define (push-t-res! t i) (t-res-set! t (cons i (t-res t)))) +(define (push-t-unres! t i) (t-unres-set! t (cons i (t-unres t)))) +(define (push-t-mark! t i) (t-mark-set! t (cons i (t-mark t)))) +(define (pop-t-mark! t) (let ((z (t-mark t))) + (if (not (null? z)) + (begin (t-mark-set! t (cdr z)) + (car z)) + #f))) +(define (push-t-label! t i) (t-label-set! t (cons i (t-label t)))) +(define (push-t-env! t env) (t-env-set! t (cons env (t-env t)))) + +(define (t-make) (make-text-block (make-pushup-stack) '() '() '() '() '() '())) +(define (t-save! t) + (let ((restore-text-block (push-stack-save (t-text t))) + (orig-reloc (t-reloc t)) + (orig-res (t-res t)) + (orig-unres (t-unres t)) + (orig-mark (t-mark t)) + (orig-label (t-label t)) + (orig-env (t-env t))) + (lambda () + (restore-text-block) + (t-reloc-set! t orig-reloc) + (t-res-set! t orig-res) + (t-unres-set! t orig-unres) + (t-mark-set! t orig-mark) + (t-label-set! t orig-label) + (t-env-set! t orig-env)))) + + + diff --git a/module/language/sassy/text.scm b/module/language/sassy/text.scm new file mode 100644 index 000000000..48d45b40e --- /dev/null +++ b/module/language/sassy/text.scm @@ -0,0 +1,445 @@ +; text.scm - Sassy's compiler, based on COMFY-65 +; (see http://home.pipeline.com/~hbaker1/sigplannotices/CFYCMP1.LSP) +; Copyright (C) 2005 Jonathan Kraut + +; This library is free software; you can redistribute it and/or +; modify it under the terms of the GNU Lesser General Public +; License as published by the Free Software Foundation; either +; version 2.1 of the License, or (at your option) any later version. + +; This library is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; Lesser General Public License for more details. + +; You should have received a copy of the GNU Lesser General Public +; License along with this library; if not, write to the Free Software +; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +; Contact: +; Jonathan Kraut +; 4130 43 ST #C2 +; Sunnyside, NY 11104 +; jak76@columbia.edu + +; see file COPYING in the top of Sassy's distribution directory + + +; module text +; import push-stacks operands opcodes numbers api text-block +; import-syntax meta-lambda +; export all + + +(define (handle-text-block text-item outp textb) + + (define rel-adjust (if (= 16 (sassy-bits outp)) + 3 + 5)) + (define current-byte-size (/ (sassy-bits outp) 8)) + + (define (fix-body-labels! new-text-size list-of-label-pairs) + (for-each + (lambda (label-pair) + (case (cadr label-pair) + ((local import export) + (sassy-symbol-set! outp (car label-pair) + `(offset ,(- new-text-size (caddr label-pair))))))) + list-of-label-pairs)) + + (define (fix-block-labels! new-text-size list-of-label-pairs env) + (for-each + (lambda (exists) + (let* ((scope (sassy-symbol-scope exists)) + (name (sassy-symbol-name exists)) + (offs (let iter ((rst list-of-label-pairs)) + (cond ((null? rst) #f) + ((and (eq? scope (cadr (car rst))) + (eq? name (car (car rst)))) + (caddr (car rst))) + (else (iter (cdr rst))))))) + (if offs + (let ((new-offs (- new-text-size offs))) + (sassy-symbol-offset-set! exists new-offs) + (for-each (lambda (back-patcher) + (back-patcher new-offs)) + (sassy-symbol-unres exists)))))) + env)) + + (define (fix-relocations! new-text-size list-of-new-relocs) + (for-each + (lambda (new-reloc) + (sassy-reloc-offset-set! new-reloc (- new-text-size + (sassy-reloc-offset new-reloc))) + (sassy-reloc-list-set! outp (cons new-reloc (sassy-reloc-list outp)))) + list-of-new-relocs)) + + (define (fix-backward-refs! new-text-size list-of-patcher-pairs) + ; patcher-pair: car = flipped eip, cdr = patcher-procedure + (for-each + (lambda (patcher-pair) + ((cdr patcher-pair) (- new-text-size (car patcher-pair)))) + list-of-patcher-pairs)) + + (define (make-block-f-ref-patchers! new-text-size list-of-unres-lists env) + (for-each + (lambda (unres-list) + (let ((exists (let iter ((rst env)) + (cond ((null? rst) #f) + ((and (eq? (car unres-list) + (sassy-symbol-name (car rst))) + (eq? (cadddr unres-list) + (sassy-symbol-scope (car rst)))) + (car rst)) + (else (iter (cdr rst))))))) + (when exists + (sassy-symbol-unres-set! + exists + (cons ((caddr unres-list) + (- new-text-size (cadr unres-list))) + (sassy-symbol-unres exists)))))) + list-of-unres-lists)) + + (define (make-forward-ref-patchers! new-text-size list-of-unres-lists) + ; unres-list: car = symbol, cadr flipped eip, caddr = patcher-generator + ; cadddr scope + (for-each + (lambda (unres-list) + (let ((scope (cadddr unres-list))) + (when (or (case scope + ((import local global) #t) + (else #f)) + (not (cadddr unres-list))) + (sassy-symbol-set! + outp (car unres-list) + `(unres ,((caddr unres-list) (- new-text-size + (cadr unres-list)))))))) + list-of-unres-lists)) + + (define the-assertions + (alist->hash-table + '((o! . 0) (no! . 1) + (b! . 2) (c! . 2) (nae! . 2) (nb! . 3) (nc! . 3) (ae! . 3) + (e! . 4) (z! . 4) (ne! . 5) (nz! . 5) + (be! . 6) (na! . 6) (nbe! . 7) (a! . 7) + (s! . 8) (ns! . 9) + (p! . 10) (pe! . 10) (np! . 11) (po! . 11) + (l! . 12) (nge! . 12) (nl! . 13) (ge! . 13) + (le! . 14) (ng! . 14) (g! . 15) (nle! . 15)))) + + (define (assertion? x) + (hash-table-ref the-assertions x (lambda () #f))) + + (define (flip x) ; flip an assertion cc-code + (if (even? x) (+ x 1) (- x 1))) + + (define get-assert-name + (let ((the-names '#(jo jno jb jnb je jne jbe jnbe + js jns jp jpo jl jnl jle jg))) + (lambda (cc) + (vector-ref the-names cc)))) + + (define (gen-short-assert cc amount) + (let ((stack (t-text textb))) + (push-stack-push stack (cons (+ #x70 cc) (integer->byte-list amount 1))) + (push-stack-size stack))) + + (define (gen-near-assert cc amount) + (let ((stack (t-text textb))) + (push-stack-push stack (cons #x0f (cons (+ #x80 cc) + (integer->byte-list + amount + current-byte-size)))) + (push-stack-size stack))) + + (define (gen-assert cc amount) + (if (s-byte amount) + (gen-short-assert cc amount) + (gen-near-assert cc amount))) + + (define (gen-short-jmp amount) + (let ((stack (t-text textb))) + (push-stack-push stack (cons #xeb (integer->byte-list amount 1))) + (push-stack-size stack))) + + (define (gen-near-jmp amount) + (let ((stack (t-text textb))) + (push-stack-push stack (cons #xe9 (integer->byte-list + amount + current-byte-size))) + (push-stack-size stack))) + + (define (gen-jmp amount) + (if (s-byte amount) + (gen-short-jmp amount) + (gen-near-jmp amount))) + + ; Eeek!! Optimize cc-branches for size. May have to rework to work + ; nicely with P4 static branch prediction. + (define (gen-opt-jcc cc win lose) + (let* ((current (push-stack-size (t-text textb)))) + (cond ((and (number? win) (number? lose)) + (let ((win-rel (- current win)) + (lose-rel (- current lose))) + (cond ((and (zero? win-rel) (zero? lose-rel)) win) + ((= win lose) (gen-jmp win-rel)) + ((zero? lose-rel) (gen-assert cc win-rel)) + ((zero? win-rel) (gen-assert (flip cc) lose-rel)) + ((and (s-byte lose-rel) (s-byte (+ win-rel 2))) + (gen-short-jmp lose-rel) + (gen-short-assert cc (+ win-rel 2))) + ((and (s-byte win-rel) (s-byte (+ lose-rel 2))) + (gen-short-jmp win-rel) + (gen-short-assert (flip cc) (+ lose-rel 2))) + ((s-byte (+ lose-rel rel-adjust)) + (gen-near-jmp win-rel) + (gen-short-assert (flip cc) (+ lose-rel rel-adjust))) + (else (gen-opt-jmp lose win lose) + (gen-assert + cc (- (push-stack-size (t-text textb)) win)))))) + ((and (or (symbol win) (number? win)) + (or (symbol lose) (number? lose))) + (cond ((equal? win lose) (emit-direct `(jmp ,win) + win lose textb outp)) + ((and (symbol win) (symbol lose)) + (emit-direct `(jmp ,lose) win lose textb outp) + (emit-direct `(,(get-assert-name cc) ,win) + win lose textb outp)) + ((and (symbol win) (= lose current)) + (emit-direct `(,(get-assert-name cc) ,win) + win lose textb outp)) + ((symbol win) + (emit-direct `(jmp ,win) win lose textb outp) + (gen-assert (flip cc) (+ (- current lose) rel-adjust))) + ((and (symbol lose) (= win current)) + (emit-direct `(,(get-assert-name (flip cc)) ,lose) + win lose textb outp)) + (else (emit-direct `(jmp ,lose) win lose textb outp) + (gen-assert cc (+ (- current win) rel-adjust))))) + ((number? win) + (emit-direct lose win lose textb outp) + (gen-assert cc (- (push-stack-size (t-text textb)) win))) + ((number? lose) + (emit-direct win win lose textb outp) + (gen-assert (flip cc) (- (push-stack-size (t-text textb)) lose))) + ((symbol win) + (emit-direct lose win lose textb outp) + (emit-direct `(,(get-assert-name cc) ,win) + win lose textb outp)) + ((symbol lose) + (emit-direct win win lose textb outp) + (emit-direct `(,(get-assert-name (flip cc)) ,lose) + win lose textb outp)) + ((equal? win lose) (emit-direct win win lose textb outp)) + (else (emit-direct lose win lose textb outp) + (let ((new-lose (push-stack-size (t-text textb)))) + (emit-direct win win lose textb outp) + (gen-assert (flip cc) (- (push-stack-size (t-text textb)) + new-lose))))))) + + (define (gen-opt-jmp to win lose) + (cond ((symbol to) => (lambda (x) + (emit-direct2 'jmp (opcode? 'jmp) (list x) + win lose textb outp))) + (else (let ((current (push-stack-size (t-text textb)))) + (if (= to current) + current + (gen-jmp (- current to))))))) + + ; Iterative closure to get the backward branches right. Same with + ; handle-while. Looks good on the page, but can be exponential in + ; time when there are inner loops. Maybe a user option should + ; exist to do this Baker's way (one pass only), but with no jump + ; size optimization. Maybe it won't matter anyway too much. TBD. + (define (handle-iter exp win lose) + (let ((reset! (t-save! textb)) + (old-env (sassy-symbol-table outp))) + (let iter ((new (compile exp + (+ 2 (push-stack-size (t-text textb))) + lose)) + (count (+ 3 (push-stack-size (t-text textb))))) + (if (not (= count new)) + (begin (reset!) + (sassy-symbol-table-set! outp old-env) + (iter (compile `(with-win $win ,exp) new lose) + new)) + new)))) + + (define (handle-while test body win lose) + (let ((reset! (t-save! textb)) + (old-env (sassy-symbol-table outp))) + (let iter ((new (compile body + (compile `(mark ,test) + (+ 2 (push-stack-size + (t-text textb))) + win) + lose)) + (count (+ 3 (push-stack-size (t-text textb))))) + (if (not (= count new)) + (begin (reset!) + (sassy-symbol-table-set! outp old-env) + (iter (compile body + (compile `(mark ,test) new win) + lose) + new)) + (compile '(leap $win) new lose))))) + + ; The core dispatch procedure - this is where the Comfy65 based + ; stuff happens. + (define (compile exp win lose) + + (define (symbol2 x) + (let ((z (symbol x))) + (and z (not (memq z '($win $lose))) z))) + + (define (branch-or-compile e) + (if (and (pair? e) + (or (eqv? (car e) 'jmp) + (eqv? (car e) 'ret))) + (emit-direct e win lose textb outp) + (really-compile e))) + + (define really-compile + (meta-lambda + (or + (and opcode? __ (lambda (opcode . rands) + (and (or (symbol win) + (not (= win (push-stack-size + (t-text textb))))) + (gen-opt-jmp win win lose)) + (emit-direct2 (car exp) + opcode rands win lose textb outp))) + (and 'seq (or (begin win) ; allowed to write (seq) + (and ? (lambda (tail) (really-compile tail))) + (and __ (lambda body + (compile (car body) + (really-compile `(seq ,@(cdr body))) + lose))))) + (and 'begin + (or (begin win) + (and ? (lambda (tail) (really-compile tail))) + (and __ (lambda body + (let ((w (really-compile `(begin ,@(cdr body))))) + (compile (car body) w w)))))) + + (and 'inv ? (lambda (e) (compile e lose win))) + (and 'if ? ? ? (lambda (test conseq altern) + (let* ((loser (really-compile altern)) + (winner (really-compile conseq))) + (compile test winner loser)))) + (and ,@assertion? (lambda (cc) (gen-opt-jcc cc win lose))) + (and ,@'$eip (begin (push-stack-size (t-text textb)))) + (and ,@'$win (begin win)) + (and ,@'$lose (begin lose)) + + (and 'iter ? (lambda (loop) (handle-iter loop win lose))) + (and 'while ? ? (lambda (test body) (handle-while test body win lose))) + (and 'label valid-label __ + (lambda (label . body) + (sassy-symbol-def-error outp label) + (let ((scope (sassy-symbol-scope + (sassy-symbol-set! outp label '(section text))))) + (really-compile (cons 'begin body)) + (let ((pnt (push-stack-size (t-text textb)))) + (push-t-label! textb (list label scope pnt)) + pnt)))) + (and 'locals pair? __ + (lambda (locals . body) + (let ((reset! (setup-locals locals outp + (lambda (new-sym) + (push-t-env! textb new-sym))))) + (really-compile (cons 'begin body)) + (reset!) + (push-stack-size (t-text textb))))) + (and 'esc pair? ? (lambda (list-of-escapes body) + (really-compile body) + (for-each (lambda (escape) + (emit-direct + escape win lose textb outp)) + (reverse list-of-escapes)) + (push-stack-size (t-text textb)))) + (and 'mark ? (lambda (body) (let ((z (really-compile body))) + (push-t-mark! textb z) + z))) + (and 'leap ? (lambda (body) (let ((z (really-compile body))) + (or (pop-t-mark! textb) z)))) + (and 'with-win + (or (and ? (lambda (only-one) + (really-compile `(with-win ,only-one (seq))))) + (and assertion? ? + (lambda (cc body) + (compile body (gen-opt-jcc cc win lose) lose))) + (and symbol2 ? (lambda (new-win body) + (compile body new-win lose))) + (and ? ? (lambda (win-b body) + (compile body (branch-or-compile win-b) lose))))) + (and 'with-lose + (or (and ? (lambda (only-one) + (really-compile `(with-lose ,only-one (seq))))) + (and assertion? ? + (lambda (cc body) + (compile body win (gen-opt-jcc cc win lose)))) + (and symbol2 ? (lambda (new-lose body) + (compile body win new-lose))) + (and ? ? (lambda (lose-b body) + (compile body win (branch-or-compile lose-b)))))) + (and 'with-win-lose + (or (and ? ? (lambda (one two) + (really-compile `(with-win-lose ,one ,two (seq))))) + (and assertion? + (or (and assertion? ? + (lambda (cc1 cc2 body) + (let ((new-lose (gen-opt-jcc cc2 win lose))) + (compile body (gen-opt-jcc cc1 win lose) + new-lose)))) + (and symbol2 ? + (lambda (cc new-lose body) + (compile body (gen-opt-jcc cc win lose) + new-lose))) + (and ? ? + (lambda (cc lose-b body) + (let ((new-lose (branch-or-compile lose-b))) + (compile body (gen-opt-jcc cc win lose) + new-lose)))))) + (and symbol2 + (or (and assertion? ? + (lambda (new-win cc body) + (compile body new-win + (gen-opt-jcc cc win lose)))) + (and symbol2 ? (lambda (new-win new-lose body) + (compile body new-win new-lose))) + (and ? ? (lambda (new-win lose-b body) + (compile body new-win + (branch-or-compile lose-b)))))) + (and ? + (or (and assertion? ? + (lambda (win-b cc body) + (let ((new-lose (gen-opt-jcc cc win lose))) + (compile body (branch-or-compile win-b) + new-lose)))) + (and symbol2 ? (lambda (win-b new-lose body) + (compile body + (branch-or-compile win-b) + new-lose))) + (and ? ? + (lambda (win-b lose-b body) + (let ((new-lose (branch-or-compile lose-b))) + (compile body (branch-or-compile win-b) + new-lose)))))))) + (else (lambda (i) (error "sassy: bad text item" i)))))) + (really-compile exp)) + + (let ((win (compile text-item 0 0))) + (when (not (= win (push-stack-size (t-text textb)))) ; in case there was + (gen-opt-jmp win win 0)) ; a top-level "leap" + (let ((new-text-size (+ (sassy-text-size outp) + (sassy-text-org outp) + (push-stack-size (t-text textb))))) + (fix-relocations! new-text-size (t-reloc textb)) + (fix-backward-refs! new-text-size (t-res textb)) + (make-forward-ref-patchers! new-text-size (t-unres textb)) + (make-block-f-ref-patchers! new-text-size (t-unres textb) (t-env textb)) + (fix-body-labels! new-text-size (t-label textb)) + (fix-block-labels! new-text-size (t-label textb) (t-env textb)) + (push-stack-append! (sassy-text-stack outp) (t-text textb)) + (push-stack-size (t-text textb))))) diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 37b9cb5e6..c36c1dd7e 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -154,4 +154,7 @@ EXTRA_DIST += test-with-guile-module.c test-scm-with-guile.c endif +check_SCRIPTS += test-sassy +TESTS += test-sassy + EXTRA_DIST += ${check_SCRIPTS} diff --git a/test-suite/standalone/sassy/tests/aa b/test-suite/standalone/sassy/tests/aa new file mode 100644 index 000000000..52628af8d --- /dev/null +++ b/test-suite/standalone/sassy/tests/aa @@ -0,0 +1,2 @@ +ี +ิ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/aa.asm b/test-suite/standalone/sassy/tests/aa.asm new file mode 100644 index 000000000..cfb4d7dab --- /dev/null +++ b/test-suite/standalone/sassy/tests/aa.asm @@ -0,0 +1,5 @@ +BITS 32 +section .text +foo: +aad +aam 9 diff --git a/test-suite/standalone/sassy/tests/aa.scm b/test-suite/standalone/sassy/tests/aa.scm new file mode 100644 index 000000000..f1c14e423 --- /dev/null +++ b/test-suite/standalone/sassy/tests/aa.scm @@ -0,0 +1,5 @@ +( +(aad) +(aam 9) +) + diff --git a/test-suite/standalone/sassy/tests/all b/test-suite/standalone/sassy/tests/all Binary files differnew file mode 100644 index 000000000..f44fa957d --- /dev/null +++ b/test-suite/standalone/sassy/tests/all diff --git a/test-suite/standalone/sassy/tests/all.asm b/test-suite/standalone/sassy/tests/all.asm new file mode 100644 index 000000000..97ca08acc --- /dev/null +++ b/test-suite/standalone/sassy/tests/all.asm @@ -0,0 +1,870 @@ +BITS 32 +section .text +foo: +loop foo +loope foo, cx +loopz foo, ecx +loopne foo +loopnz foo, cx +jcxz foo +jecxz foo +call dword 0 +call word 0 +call dword 1000:1000 +call word 1000:1000 +call far dword [ecx] +call far word [ecx] +call ecx +call dword [ecx] +call cx +call word [ecx] +jmp dword 0 +jmp near dword 0 +jmp word 0 +jmp near word 0 +jmp dword 1000:1000 +jmp word 1000:1000 +jmp far dword [ecx] +jmp far word [ecx] +jmp ecx +jmp dword [ecx] +jmp cx +jmp word [ecx] +add eax, [ecx] +add eax, [ebp] +add eax, [esp] +add eax, [100] +add eax, [1600] +add eax, [ecx*1] +add eax, [ecx*2] +add eax, [ecx*4] +add eax, [ecx*8] +add eax, [ebp*1] +add eax, [ebp*2] +add eax, [ebp*4] +add eax, [ebp*8] +add eax, [ecx+100] +add eax, [ecx+1600] +add eax, [ebp+100] +add eax, [ebp+1600] +add eax, [esp+100] +add eax, [esp+1600] +add eax, [100+ecx] +add eax, [1600+ecx] +add eax, [100+ebp] +add eax, [1000+ebp+600] +add eax, [100+esp] +add eax, [1600+esp] +add eax, [ecx+edx*1] +add eax, [ebp*1+ecx] +add eax, [ecx+edx*2] +add eax, [ebp*2+ecx] +add eax, [ecx+edx*4] +add eax, [ebp*4+ecx] +add eax, [ecx+edx*8] +add eax, [ecx+ebp*8] +add eax, [edx*1+ebp] +add eax, [ebp+ebp*1] +add eax, [ebp+edx*2] +add eax, [ebp+ebp*2] +add eax, [ebp+edx*4] +add eax, [ebp*4+ebp] +add eax, [ebp+edx*8] +add eax, [ebp+ebp*8] +add eax, [esp+edx*1] +add eax, [esp+ebp*1] +add eax, [esp+edx*2] +add eax, [ebp*2+esp] +add eax, [esp+edx*4] +add eax, [esp+ebp*4] +add eax, [esp+edx*8] +add eax, [esp+ebp*8] +add eax, [ecx*1+100] +add eax, [ecx*2+100] +add eax, [100+ecx*4] +add eax, [ecx*8+100] +add eax, [100+ebp*1] +add eax, [ebp*2+100] +add eax, [100+ebp*4] +add eax, [ebp*8+100] +add eax, [1600+ecx*1] +add eax, [ecx*2+1600] +add eax, [ecx*4+1600] +add eax, [1600+ecx*8] +add eax, [ebp*1+1600] +add eax, [1600+ebp*2] +add eax, [ebp*4+1600] +add eax, [ebp*8+1600] +add eax, [ecx+100+edx*1] +add eax, [ecx+edx*2+100] +add eax, [edx*4+ecx+100] +add eax, [ecx+edx*8+100] +add eax, [ecx+ebp*1+100] +add eax, [ecx+ebp*2+100] +add eax, [ecx+ebp*4+100] +add eax, [100+ecx+ebp*8] +add eax, [ebp+edx*1+100] +add eax, [ebp+edx*2+100] +add eax, [ebp+edx*4+100] +add eax, [ebp+edx*8+100] +add eax, [ebp+ebp*1+100] +add eax, [100+ebp*2+ebp] +add eax, [ebp+ebp*4+100] +add eax, [ebp+ebp*8+100] +add eax, [esp+edx*1+100] +add eax, [esp+edx*2+100] +add eax, [esp+edx*4+100] +add eax, [esp+edx*8+100] +add eax, [esp+ebp*1+100] +add eax, [esp+ebp*2+100] +add eax, [esp+ebp*4+100] +add eax, [esp+ebp*8+100] +add eax, [ecx+edx*1+1600] +add eax, [ecx+edx*2+1600] +add eax, [ecx+edx*4+1600] +add eax, [ecx+edx*8+1600] +add eax, [ecx+ebp*1+1600] +add eax, [ecx+ebp*2+1600] +add eax, [ecx+ebp*4+1600] +add eax, [ecx+ebp*8+1600] +add eax, [ebp+edx*1+1600] +add eax, [ebp+edx*2+1600] +add eax, [ebp+edx*4+1600] +add eax, [ebp+edx*8+1600] +add eax, [ebp+ebp*1+1600] +add eax, [ebp+ebp*2+1600] +add eax, [ebp+ebp*4+1600] +add eax, [ebp+ebp*8+1600] +add eax, [esp+edx*1+1600] +add eax, [esp+edx*2+1600] +add eax, [esp+edx*4+1600] +add eax, [esp+edx*8+1600] +add eax, [esp+ebp*1+1600] +add eax, [esp+ebp*2+1600] +add eax, [esp+ebp*4+1600] +add eax, [esp+ebp*8+1600] +aaa +aas +cbw +cdq +clc +cld +cli +clts +cmc +cmpsb +cmpsw +cmpsd +cpuid +cwde +cwd +daa +das +hlt +insb +insw +insd +int3 +into +invd +iret +iretw +iretd +lahf +leave +lodsb +lodsw +lodsd +movsb +movsw +movsd +nop +outsb +outsw +outsd +popa +popaw +popad +popf +popfw +popfd +pusha +pushaw +pushad +pushf +pushfw +pushfd +rdmsr +rdpmc +rdtsc +rsm +sahf +scasb +scasw +scasd +stc +std +sti +stosb +stosw +stosd +ud2 +wbinvd +wrmsr +xlat +xlatb +sysenter +sysexit +adc al, 100 +add ax, 1000 +and eax, 50000 +cmp bl, 100 +sbb cx, word 1000 +xor edx, dword 50000 +add cx, byte 100 +cmp edx, byte 100 +adc dword [eax+edx*4+100], dword 50000 +or dword [edx], byte 100 +sub word [eax+edx], word 1000 +and word [eax+edx], byte 100 +or byte [eax+edx*4+100], byte 100 +sbb bl, bl +sub [ebx], bl +xor cx, cx +adc [eax+edx], cx +add edx, edx +and [eax+edx*4+100], edx +cmp bl, [ebx] +or cx, [eax+edx] +sbb edx, [eax+edx*4+100] +bt si, si +btc [100+200+edx], si +btr [8*eax], edi +bts edi, edi +bt si, 9 +btc word [100+200+edx], byte 9 +btr edi, 9 +bts dword [8*eax], byte 9 +rcl ebp, 1 +rcr dword [eax+1000], 1 +seto ah +setno [eax+esi*1] +setb ah +setc [eax+esi*1] +setnae ah +setnb [eax+esi*1] +setnc ah +setae [eax+esi*1] +sete ah +setz [eax+esi*1] +setne ah +setnz [eax+esi*1] +setbe ah +setna [eax+esi*1] +seta ah +setnbe [eax+esi*1] +sets ah +setns [eax+esi*1] +setp ah +setpe [eax+esi*1] +setnp ah +setpo [eax+esi*1] +setl ah +setnge [eax+esi*1] +setge ah +setnl [eax+esi*1] +setle ah +setng [eax+esi*1] +setnle ah +setg [eax+esi*1] +cmovo cx, bx +cmovno bx, [edx+esi*4] +cmovb edx, eax +cmovc ebp, [esp+eax*4] +cmovnae cx, bx +cmovnb bx, [edx+esi*4] +cmovnc edx, eax +cmovae ebp, [esp+eax*4] +cmove cx, bx +cmovz bx, [edx+esi*4] +cmovne edx, eax +cmovnz ebp, [esp+eax*4] +cmovbe cx, bx +cmovna bx, [edx+esi*4] +cmova edx, eax +cmovnbe ebp, [esp+eax*4] +cmovs cx, bx +cmovns bx, [edx+esi*4] +cmovp edx, eax +cmovpe ebp, [esp+eax*4] +cmovnp cx, bx +cmovpo bx, [edx+esi*4] +cmovl edx, eax +cmovnge ebp, [esp+eax*4] +cmovge cx, bx +cmovnl bx, [edx+esi*4] +cmovle edx, eax +cmovng ebp, [esp+eax*4] +cmovnle cx, bx +cmovg bx, [edx+esi*4] +dec dword [eax] +inc word [eax] +dec byte [eax] +inc ch +dec esp +inc dx +div dword [ebx] +idiv word [ebx] +mul byte [ebx] +neg edi +not edi +div edi +lds edi, [esi] +les di, [esi] +lea edi, [esi] +lfs di, [esi] +lgs edi, [esi] +lss di, [esi] +movsx ebp, ax +movzx ebp, word [edi] +movsx ebp, al +movzx ebp, byte [edi] +movsx bp, ah +movzx bp, [edi] +bsf bx, ax +bsr bx, [eax] +lar ebx, eax +lsl ebx, [eax] +invlpg [200+8*esi+esp+100] +lgdt [200+8*esi+esp+100] +sgdt [200+8*esi+esp+100] +lidt [200+8*esi+esp+100] +sidt [200+8*esi+esp+100] +lldt sp +sldt [esp] +lmsw sp +smsw [esp] +ltr sp +str [esp] +verr sp +verw [esp] +aad +aam 9 +ret +retn 1000 +retf +shld bx, ax, 9 +shrd [ebx], ax, 9 +shld ebx, eax, 9 +shrd [ebx], eax, 9 +shld bx, ax, cl +shrd [ebx], ax, cl +shld ebx, eax, cl +shrd [ebx], eax, cl +cmpxchg al, bh +xadd [eax], bh +cmpxchg ax, bx +xadd [eax], bx +cmpxchg eax, ebx +xadd [eax], ebx +arpl cx, bx +arpl [ecx], bx +bound ax, [edi] +bound eax, [edi] +bswap edx +cmpxchg8b [edx+ecx] +enter 1000, 100 +xchg ax, bx +xchg bx, ax +xchg eax, ebx +xchg ebx, eax +xchg al, ah +xchg [ebx], ah +xchg cx, bx +xchg [ecx], bx +xchg ecx, ebx +xchg [ecx], ebx +xchg al, [edi] +xchg ax, [edi] +xchg eax, [edi] +in al, 9 +in ax, 9 +in eax, 9 +in al, dx +in ax, dx +in eax, dx +out 9, al +out 9, ax +out 9, eax +out dx, al +out dx, ax +out dx, eax +int 128 +pop cx +pop ecx +pop dword [ecx] +pop word [ecx] +pop ds +pop es +pop ss +pop fs +pop gs +push cx +push edx +push dword 100 +push word 100 +push byte 100 +push word [esi] +push dword [esi] +push cs +push ds +push es +push ss +push fs +push gs +imul ax, bx, word 100 +imul ax, [ebx], word 100 +imul ax, bx, byte 100 +imul ax, [ebx], byte 100 +imul eax, ebx, dword 100 +imul eax, [ebx], dword 100 +imul eax, ebx, byte 100 +imul eax, [ebx], byte 100 +imul eax, dword 100 +imul eax, byte 100 +imul ax, word 100 +imul ax, byte 100 +imul ax, bx +imul ax, [ebx] +imul eax, ebx +imul eax, [ebx] +imul al +imul byte [eax] +imul ax +imul word [eax] +imul eax +imul dword [eax] +test al, 9 +test ax, 9 +test eax, 9 +test bl, cl +test [ebx], cl +test bx, cx +test [ebx], cx +test ebx, ecx +test [ebx], ecx +test bl, 9 +test dword [ebx], 9 +test bx, 9 +test word [ebx], 9 +test ebx, 9 +test byte [ebx], 9 +mov bl, cl +mov [edx], cl +mov bx, dx +mov [esi], dx +mov ebx, edi +mov [eax], edi +mov bl, cl +mov bl, [edx] +mov bx, dx +mov bx, [esi] +mov ebx, edi +mov ebx, [eax] +mov bl, 9 +mov bx, 9 +mov ebx, 9 +mov [edx], byte 9 +mov [esi], word 9 +mov [eax], dword 9 +mov al, [9] +mov ax, [9] +mov eax, [9] +mov [9], al +mov [9], ax +mov [9], eax +mov bx, ds +mov [esi], ss +mov ebx, fs +mov [eax], es +mov gs, dx +mov ds, [esi] +mov fs, edi +mov ss, [eax] +mov ecx, cr2 +mov ecx, dr1 +mov cr0, edx +mov dr0, edx +jo near dword 0 +jno near word 0 +jb 0 +jc near dword 0 +jnae near word 0 +jnb 0 +jnc near dword 0 +jae near word 0 +je 0 +jz near dword 0 +jne near word 0 +jnz 0 +jbe near dword 0 +jna near word 0 +ja 0 +jnbe near dword 0 +js near word 0 +jns 0 +jp near dword 0 +jpe near word 0 +jnp 0 +jpo near dword 0 +jl near word 0 +jnge 0 +jge near dword 0 +jnl near word 0 +jle 0 +jng near dword 0 +jnle near word 0 +jg 0 +rep insd +rep outsw +rep lodsb +rep stosd +rep movsb +repe cmpsb +repz cmpsd +repne scasd +repnz scasb +lock add byte [eax], 1 +lock dec dword [edx] +lock xor [ecx], ecx +fld1 +fldl2t +fldl2e +fldpi +fldlg2 +fldln2 +fldz +fsin +fcos +fsincos +fptan +fpatan +f2xm1 +fyl2x +fyl2xp1 +fincstp +fdecstp +finit +fninit +fclex +fnclex +fwait +wait +fnop +fcompp +fucompp +ftst +fxam +fprem +fprem1 +fabs +fchs +frndint +fscale +fsqrt +fxtract +fadd dword [eax] +fsub qword [ebx] +fsubr st0, st4 +fmul st7, st0 +fdiv dword [eax] +fdivr qword [ebx] +fdivrp st2, st0 +fdivp st2, st0 +fmulp st2, st0 +fsubp st3, st0 +fsubrp st2, st0 +faddp st4, st0 +fimul dword [eax] +fiadd word [ebx] +fidiv word [ebx] +fidivr dword [eax] +fisub word [ebx] +fisubr dword [eax] +fcmovb st0, st2 +fcmove st0, st3 +fcmovbe st0, st4 +fcmovu st0, st5 +fcmovnb st0, st6 +fcmovne st0, st7 +fcmovnbe st0, st1 +fcmovnu st0, st2 +fxch +fucom st3 +fld tword [eax] +fstp qword [ebx] +fld dword [ecx] +fstp st4 +fst dword [edx] +fst qword [ebx] +fst st3 +fild word [ebx] +fistp dword [ebx] +fild qword [ebx] +fist word [ecx] +ficom dword [ecx] +ficomp word [ecx] +fcomp dword [edi] +fcom qword [edi] +fcomp st0 +fcomi st0, st7 +fcomip st0, st6 +fucomi st0, st5 +fucomip st0, st4 +fbld tword [eax] +fbstp tword [eax] +fstcw word [ebx] +fldcw word [ebx] +fnstcw word [ebx] +fstenv [eax] +fnstenv [ebx] +ffree st2 +fldenv [edx] +fsave [edx] +fnsave [edx] +frstor [edx] +fxsave [edx] +fxrstor [edx] +fstsw ax +fstsw word [ebx] +fnstsw ax +fnstsw word [ebx] +emms +movd mm1, ebx +movd mm1, [edx] +movd ebx, mm1 +movd [edx], mm1 +movd xmm0, ebx +movd xmm0, [edx] +movd ebx, xmm0 +movd [edx], xmm0 +movq mm1, mm0 +movq mm1, [edx] +movq mm0, mm1 +movq [edx], mm1 +movq xmm0, xmm1 +movq xmm0, [edx] +movq xmm1, xmm0 +movq [edx], xmm0 +pand mm0, mm1 +pandn mm1, [edx] +por xmm2, xmm3 +pxor xmm4, [ecx] +packsswb mm0, mm1 +packssdw mm1, [edx] +packuswb xmm2, xmm3 +punpckhbw xmm4, [ecx] +punpckhwd mm0, mm1 +punpckhdq mm1, [edx] +paddb xmm2, xmm3 +paddw xmm4, [ecx] +paddd mm0, mm1 +paddsb mm1, [edx] +paddsw xmm2, xmm3 +paddusb xmm4, [ecx] +paddusw mm0, mm1 +psubb mm1, [edx] +psubw xmm2, xmm3 +psubd xmm4, [ecx] +psubsb mm0, mm1 +psubsw mm1, [edx] +psubusb xmm2, xmm3 +psubusw xmm4, [ecx] +pmullw mm0, mm1 +pmulhw mm1, [edx] +pmaddwd xmm2, xmm3 +pcmpeqb xmm4, [ecx] +pcmpeqw mm0, mm1 +pcmpeqd mm1, [edx] +pcmpgtb xmm2, xmm3 +pcmpgtw xmm4, [ecx] +pcmpgtd mm0, mm1 +punpcklbw mm2, mm3 +punpcklwd mm4, [ebx] +punpckldq xmm5, xmm6 +punpcklbw xmm7, [edx] +psrlw mm7, mm6 +psrld mm5, [edx] +psrlq xmm7, xmm6 +psllw xmm5, [edx] +pslld mm4, 100 +psllq xmm4, 100 +psraw mm7, mm6 +psrad mm5, [edx] +movaps xmm5, xmm4 +movups xmm3, [edx] +movaps [edx], xmm2 +movups xmm5, xmm4 +addps xmm3, xmm0 +subps xmm0, [edx] +mulps xmm3, xmm0 +divps xmm0, [edx] +rcpps xmm3, xmm0 +sqrtps xmm0, [edx] +rsqrtps xmm3, xmm0 +maxps xmm0, [edx] +minps xmm3, xmm0 +andps xmm0, [edx] +andnps xmm3, xmm0 +orps xmm0, [edx] +xorps xmm3, xmm0 +unpckhps xmm0, [edx] +unpcklps xmm3, xmm0 +addss xmm0, xmm1 +subss xmm0, [eax] +mulss xmm0, xmm1 +divss xmm0, [eax] +rcpss xmm0, xmm1 +sqrtss xmm0, [eax] +rsqrtss xmm0, xmm1 +maxss xmm0, [eax] +minss xmm0, xmm1 +comiss xmm0, [eax] +ucomiss xmm0, xmm1 +pavgb mm0, mm1 +pavgw mm2, [edx] +pmaxub xmm3, xmm4 +pmaxsw xmm5, [edx] +pminub mm0, mm1 +pminsw mm2, [edx] +pmulhuw xmm3, xmm4 +psadbw xmm5, [edx] +movhps xmm0, [edx] +movlps [edx], xmm6 +movhlps xmm0, xmm1 +movlhps xmm1, xmm0 +shufps xmm0, xmm6, 10 +cmpps xmm5, [ecx], 20 +prefetcht0 [eax] +prefetcht1 [eax] +prefetcht2 [eax] +prefetchnta [eax] +sfence +movntps [ecx], xmm3 +maskmovq mm3, mm4 +movntq [ebx], mm7 +pmovmskb eax, mm0 +pmovmskb ecx, xmm5 +pshufw mm0, mm1, 40 +pshufw mm0, [ebx], 30 +ldmxcsr [ebx] +stmxcsr [edx] +pinsrw mm1, eax, 4 +pinsrw mm0, [edx], 5 +pinsrw xmm4, ebx, 6 +pinsrw xmm3, [ecx], 7 +pextrw edx, mm3, 28 +pextrw esi, mm0, 14 +cvtsi2ss xmm3, edi +cvtsi2ss xmm3, [edi] +cvtpi2ps xmm4, mm2 +cvtpi2ps xmm4, [edi+100] +movss xmm1, [edx] +movss xmm1, xmm6 +movss [edx], xmm3 +movmskps ebx, xmm3 +cmpss xmm3, xmm4, 10 +cmpss xmm3, [edx], 20 +cvttss2si ebx, xmm3 +cvtss2si eax, [ecx] +cvtps2pi mm3, xmm1 +cvttps2pi mm4, [edx] +movapd xmm0, xmm1 +movupd xmm2, [edx] +movdqa [eax], xmm3 +movdqu xmm0, xmm1 +movhpd xmm0, [ecx] +movmskpd ebx, xmm4 +movlpd [ecx], xmm0 +movsd xmm5, xmm6 +movsd xmm7, [esi] +movsd [esi], xmm7 +addpd xmm0, xmm1 +subpd xmm2, [ecx] +mulpd xmm0, xmm1 +divpd xmm2, [ecx] +sqrtpd xmm0, xmm1 +maxpd xmm2, [ecx] +minpd xmm0, xmm1 +andpd xmm2, [ecx] +andnpd xmm0, xmm1 +orpd xmm2, [ecx] +xorpd xmm0, xmm1 +unpckhpd xmm2, [ecx] +unpcklpd xmm0, xmm1 +cvtpd2dq xmm2, [ecx] +cvttpd2dq xmm0, xmm1 +cvtdq2ps xmm2, [ecx] +cvtps2dq xmm0, xmm1 +cvttps2dq xmm2, [ecx] +cvtpd2ps xmm0, xmm1 +punpckhqdq xmm2, [ecx] +punpcklqdq xmm0, xmm1 +addsd xmm2, xmm3 +subsd xmm4, [edi] +mulsd xmm2, xmm3 +divsd xmm4, [edi] +maxsd xmm2, xmm3 +minsd xmm4, [edi] +sqrtsd xmm2, xmm3 +comisd xmm4, [edi] +ucomisd xmm2, xmm3 +cvtdq2pd xmm4, [edi] +cvtps2pd xmm2, xmm3 +cvtsd2ss xmm4, [edi] +cmppd xmm0, xmm1, 10 +shufpd xmm2, [ebx], 20 +pshuflw xmm0, xmm1, 10 +pshufhw xmm2, [ebx], 20 +pshufd xmm0, xmm1, 10 +cmpsd xmm4, xmm5, 20 +cmpsd xmm6, [eax], 30 +cvttpd2pi mm0, xmm1 +cvtpd2pi mm0, [ebp] +pause +lfence +mfence +clflush [ebx] +pmuludq mm0, mm1 +paddq mm0, [edx] +psubq xmm3, xmm1 +pmuludq xmm3, [edx] +maskmovdqu xmm1, xmm2 +movnti [edx], eax +movq2dq xmm3, mm4 +movdq2q mm5, xmm7 +movntpd [eax], xmm3 +movntdq [ebx], xmm4 +pslldq xmm3, 20 +psrldq xmm3, 20 +cvtpi2pd xmm3, mm4 +cvtpi2pd xmm3, [ecx] +cvtss2sd xmm3, xmm6 +cvtss2sd xmm3, [edx] +cvtsd2si ecx, xmm3 +cvttsd2si edx, [edx] +cvtsi2sd xmm3, eax +cvtsi2sd xmm3, [eax] +monitor +mwait +lddqu xmm0, [edx] +movddup xmm0, xmm1 +addsubps xmm0, xmm1 +addsubpd xmm2, [edx] +haddps xmm0, xmm1 +hsubps xmm2, [edx] +haddpd xmm0, xmm1 +hsubpd xmm2, [edx] +movshdup xmm0, xmm1 +movsldup xmm2, [edx] +movddup xmm0, [edx] diff --git a/test-suite/standalone/sassy/tests/alu b/test-suite/standalone/sassy/tests/alu Binary files differnew file mode 100644 index 000000000..d0ca27e4b --- /dev/null +++ b/test-suite/standalone/sassy/tests/alu diff --git a/test-suite/standalone/sassy/tests/alu.asm b/test-suite/standalone/sassy/tests/alu.asm new file mode 100644 index 000000000..fbb9bf15b --- /dev/null +++ b/test-suite/standalone/sassy/tests/alu.asm @@ -0,0 +1,25 @@ +BITS 32 +section .text +foo: +adc al, 100 +add ax, 1000 +and eax, 50000 +cmp bl, 100 +or cx, word 1000 +sbb edx, dword 50000 +sub cx, byte 100 +xor edx, byte 100 +adc dword [100+eax+edx*4], dword 50000 +add dword [edx], byte 100 +and word [eax+edx], word 1000 +cmp word [eax+edx], byte 100 +or byte [100+eax+edx*4], byte 100 +sbb bl, bl +sub [ebx], bl +xor cx, cx +adc [eax+edx], cx +add edx, edx +and [100+eax+edx*4], edx +cmp bl, [ebx] +or cx, [eax+edx] +sbb edx, [100+eax+edx*4] diff --git a/test-suite/standalone/sassy/tests/alu.scm b/test-suite/standalone/sassy/tests/alu.scm new file mode 100644 index 000000000..3c3308377 --- /dev/null +++ b/test-suite/standalone/sassy/tests/alu.scm @@ -0,0 +1,24 @@ +( +(adc al 100) +(add ax 1000) +(and eax 50000) +(cmp bl 100) +(or cx (word 1000)) +(sbb edx (dword 50000)) +(sub cx (byte 100)) +(xor edx (byte 100)) +(adc (dword (& eax (* edx 4) 100)) (dword 50000)) +(add (dword (& edx)) (byte 100)) +(and (word (& eax edx)) (word 1000)) +(cmp (word (& eax edx)) (byte 100)) +(or (byte (& eax (* edx 4) 100)) (byte 100)) +(sbb bl bl) +(sub (& ebx) bl) +(xor cx cx) +(adc (& eax edx) cx) +(add edx edx) +(and (& eax (* edx 4) 100) edx) +(cmp bl (& ebx)) +(or cx (& eax edx)) +(sbb edx (& eax (* edx 4) 100)) +) diff --git a/test-suite/standalone/sassy/tests/alu16 b/test-suite/standalone/sassy/tests/alu16 Binary files differnew file mode 100644 index 000000000..03cc55b5f --- /dev/null +++ b/test-suite/standalone/sassy/tests/alu16 diff --git a/test-suite/standalone/sassy/tests/alu16.asm b/test-suite/standalone/sassy/tests/alu16.asm new file mode 100644 index 000000000..750150d21 --- /dev/null +++ b/test-suite/standalone/sassy/tests/alu16.asm @@ -0,0 +1,25 @@ +BITS 16 +section .text +foo: +adc al, 100 +add ax, 1000 +and eax, 50000 +cmp bl, 100 +or cx, word 1000 +sbb edx, dword 50000 +sub cx, byte 100 +xor edx, byte 100 +adc dword [100+eax+edx*4], dword 50000 +add dword [edx], byte 100 +and word [eax+edx], word 1000 +cmp word [eax+edx], byte 100 +or byte [100+eax+edx*4], byte 100 +sbb bl, bl +sub [ebx], bl +xor cx, cx +adc [eax+edx], cx +add edx, edx +and [100+eax+edx*4], edx +cmp bl, [ebx] +or cx, [eax+edx] +sbb edx, [100+eax+edx*4] diff --git a/test-suite/standalone/sassy/tests/brt b/test-suite/standalone/sassy/tests/brt new file mode 100644 index 000000000..4c90f91c7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/brt @@ -0,0 +1 @@ +>
๙.๒
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/brt.scm b/test-suite/standalone/sassy/tests/brt.scm new file mode 100644 index 000000000..31c957f2d --- /dev/null +++ b/test-suite/standalone/sassy/tests/brt.scm @@ -0,0 +1,4 @@ +( +(brt (jnz 0)) +(brnt (jae 0)) +) diff --git a/test-suite/standalone/sassy/tests/bt b/test-suite/standalone/sassy/tests/bt Binary files differnew file mode 100644 index 000000000..cbac11b88 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bt diff --git a/test-suite/standalone/sassy/tests/bt.asm b/test-suite/standalone/sassy/tests/bt.asm new file mode 100644 index 000000000..cc36979a9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bt.asm @@ -0,0 +1,11 @@ +BITS 32 +section .text +foo: +bt si, si +btc [dword 300+edx], si +btr [8*eax], edi +bts edi, edi +bt si, 9 +btc word [dword 300+edx], byte 9 +btr edi, 9 +bts dword [8*eax], byte 9 diff --git a/test-suite/standalone/sassy/tests/bt.scm b/test-suite/standalone/sassy/tests/bt.scm new file mode 100644 index 000000000..d81485c92 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bt.scm @@ -0,0 +1,10 @@ +( +(bt si si) +(btc (& 100 200 edx) si) +(btr (& (* 8 eax)) edi) +(bts edi edi) +(bt si 9) +(btc (word (& 100 200 edx)) (byte 9)) +(btr edi 9) +(bts (dword (& (* 8 eax))) (byte 9)) +) diff --git a/test-suite/standalone/sassy/tests/bt16 b/test-suite/standalone/sassy/tests/bt16 Binary files differnew file mode 100644 index 000000000..1d6a4ebb1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bt16 diff --git a/test-suite/standalone/sassy/tests/bt16.asm b/test-suite/standalone/sassy/tests/bt16.asm new file mode 100644 index 000000000..3e2d749aa --- /dev/null +++ b/test-suite/standalone/sassy/tests/bt16.asm @@ -0,0 +1,11 @@ +BITS 16 +section .text +foo: +bt si, si +btc [dword 300+edx], si +btr [8*eax], edi +bts edi, edi +bt si, 9 +btc word [dword 300+edx], byte 9 +btr edi, 9 +bts dword [8*eax], byte 9 diff --git a/test-suite/standalone/sassy/tests/bye b/test-suite/standalone/sassy/tests/bye Binary files differnew file mode 100644 index 000000000..a86c1d709 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bye diff --git a/test-suite/standalone/sassy/tests/bye.scm b/test-suite/standalone/sassy/tests/bye.scm new file mode 100644 index 000000000..c2cc96778 --- /dev/null +++ b/test-suite/standalone/sassy/tests/bye.scm @@ -0,0 +1,19 @@ +(export _global_offset_table_) +(import a-string) +(macro stdout 1) +(macro write (lambda (fd buffer amount) + `(begin (mov ecx ,buffer) + (mov ebx ,fd) + (mov edx ,amount) + (mov eax ,4) + (int #x80)))) +(macro exit (lambda (exit-code) + `(begin (mov eax 1) + (mov ebx ,exit-code) + (int #x80)))) +(entry _start) +(text (label _start get-got + (write stdout (& ebx (got a-string)) 9) + (exit 0))) + + diff --git a/test-suite/standalone/sassy/tests/cell b/test-suite/standalone/sassy/tests/cell Binary files differnew file mode 100755 index 000000000..2892e1efa --- /dev/null +++ b/test-suite/standalone/sassy/tests/cell diff --git a/test-suite/standalone/sassy/tests/cell.scm b/test-suite/standalone/sassy/tests/cell.scm new file mode 100644 index 000000000..d7064ce75 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cell.scm @@ -0,0 +1,15 @@ +(macro define-cell + (lambda (name init) + `(begin (macro cell-tag "CELL") + (data (label ,name (dwords cell-tag ,init))) + (macro ,(string->symbol + (string-append (symbol->string name) "-ref")) + (& ,name 4))))) +(define-cell foo 100) + +(entry _start) + +(text (label _start (mov ebx foo-ref) + (mov eax 1) + (int #x80))) + diff --git a/test-suite/standalone/sassy/tests/cmovcc b/test-suite/standalone/sassy/tests/cmovcc new file mode 100644 index 000000000..ab1260599 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmovcc @@ -0,0 +1 @@ +f@หfA ฒBะB,fBหfC ฒCะC,fDหfD ฒEะE,fFหfF ฒGะG,fHหfI ฒJะJ,fKหfK ฒLะL,fMหfM ฒNะN,fOหfO ฒ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/cmovcc.asm b/test-suite/standalone/sassy/tests/cmovcc.asm new file mode 100644 index 000000000..5c5e77b8e --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmovcc.asm @@ -0,0 +1,33 @@ +BITS 32 +section .text +foo: +cmovo cx, bx +cmovno bx, [edx+esi*4] +cmovb edx, eax +cmovc ebp, [esp+eax*4] +cmovnae cx, bx +cmovnb bx, [edx+esi*4] +cmovnc edx, eax +cmovae ebp, [esp+eax*4] +cmove cx, bx +cmovz bx, [edx+esi*4] +cmovne edx, eax +cmovnz ebp, [esp+eax*4] +cmovbe cx, bx +cmovna bx, [edx+esi*4] +cmova edx, eax +cmovnbe ebp, [esp+eax*4] +cmovs cx, bx +cmovns bx, [edx+esi*4] +cmovp edx, eax +cmovpe ebp, [esp+eax*4] +cmovnp cx, bx +cmovpo bx, [edx+esi*4] +cmovl edx, eax +cmovnge ebp, [esp+eax*4] +cmovge cx, bx +cmovnl bx, [edx+esi*4] +cmovle edx, eax +cmovng ebp, [esp+eax*4] +cmovnle cx, bx +cmovg bx, [edx+esi*4] diff --git a/test-suite/standalone/sassy/tests/cmovcc.scm b/test-suite/standalone/sassy/tests/cmovcc.scm new file mode 100644 index 000000000..254ee59b0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmovcc.scm @@ -0,0 +1,35 @@ +( +(cmovo cx bx) +(cmovno bx (& edx (* esi 4))) +(cmovb edx eax) +(cmovc ebp (& esp (* eax 4))) +(cmovnae cx bx) +(cmovnb bx (& edx (* esi 4))) +(cmovnc edx eax) +(cmovae ebp (& esp (* eax 4))) +(cmove cx bx) +(cmovz bx (& edx (* esi 4))) +(cmovne edx eax) +(cmovnz ebp (& esp (* eax 4))) +(cmovbe cx bx) +(cmovna bx (& edx (* esi 4))) +(cmova edx eax) +(cmovnbe ebp (& esp (* eax 4))) +(cmovs cx bx) +(cmovns bx (& edx (* esi 4))) +(cmovp edx eax) +(cmovpe ebp (& esp (* eax 4))) +(cmovnp cx bx) +(cmovpo bx (& edx (* esi 4))) +(cmovl edx eax) +(cmovnge ebp (& esp (* eax 4))) +(cmovge cx bx) +(cmovnl bx (& edx (* esi 4))) +(cmovle edx eax) +(cmovng ebp (& esp (* eax 4))) +(cmovnle cx bx) +(cmovg bx (& edx (* esi 4))) +) + + + diff --git a/test-suite/standalone/sassy/tests/cmpx b/test-suite/standalone/sassy/tests/cmpx new file mode 100644 index 000000000..df3918141 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmpx @@ -0,0 +1 @@ +ฐ๘ภ8fฑุfมฑุม
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/cmpx.asm b/test-suite/standalone/sassy/tests/cmpx.asm new file mode 100644 index 000000000..71f733a06 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmpx.asm @@ -0,0 +1,9 @@ +BITS 32 +section .text +foo: +cmpxchg al, bh +xadd [eax], bh +cmpxchg ax, bx +xadd [eax], bx +cmpxchg eax, ebx +xadd [eax], ebx diff --git a/test-suite/standalone/sassy/tests/cmpx.scm b/test-suite/standalone/sassy/tests/cmpx.scm new file mode 100644 index 000000000..c9dc76056 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmpx.scm @@ -0,0 +1,8 @@ +( +(cmpxchg al bh) +(xadd (& eax) bh) +(cmpxchg ax bx) +(xadd (& eax) bx) +(cmpxchg eax ebx) +(xadd (& eax) ebx) +) diff --git a/test-suite/standalone/sassy/tests/cmpx16 b/test-suite/standalone/sassy/tests/cmpx16 new file mode 100644 index 000000000..582930690 --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmpx16 @@ -0,0 +1 @@ +ฐ๘gภ8ฑุgมfฑุfgม
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/cmpx16.asm b/test-suite/standalone/sassy/tests/cmpx16.asm new file mode 100644 index 000000000..a654eb57b --- /dev/null +++ b/test-suite/standalone/sassy/tests/cmpx16.asm @@ -0,0 +1,9 @@ +BITS 16 +section .text +foo: +cmpxchg al, bh +xadd [eax], bh +cmpxchg ax, bx +xadd [eax], bx +cmpxchg eax, ebx +xadd [eax], ebx diff --git a/test-suite/standalone/sassy/tests/count b/test-suite/standalone/sassy/tests/count Binary files differnew file mode 100755 index 000000000..4dada3370 --- /dev/null +++ b/test-suite/standalone/sassy/tests/count diff --git a/test-suite/standalone/sassy/tests/count.scm b/test-suite/standalone/sassy/tests/count.scm new file mode 100644 index 000000000..6c44b8c26 --- /dev/null +++ b/test-suite/standalone/sassy/tests/count.scm @@ -0,0 +1,28 @@ +(entry _start) + +(import exit mybuff) + +(export exit-code) + +(data (label exit-code (bytes 0))) + +(macro stdout 1) + +(macro write (lambda (fd buffer amount) + `(begin (mov ebx ,fd) + (mov ecx ,buffer) + (mov edx ,amount) + (mov eax ,4) + (int #x80)))) + +(text + (label _start (mov ecx 0) + (mov eax "0") + (while (<= eax #\9) + (begin (push eax) + (mov (& mybuff) al) + (write stdout mybuff 1) + (pop eax) + (add eax 1))) + (jmp exit))) + diff --git a/test-suite/standalone/sassy/tests/decinc b/test-suite/standalone/sassy/tests/decinc Binary files differnew file mode 100644 index 000000000..59125c2cf --- /dev/null +++ b/test-suite/standalone/sassy/tests/decinc diff --git a/test-suite/standalone/sassy/tests/decinc.asm b/test-suite/standalone/sassy/tests/decinc.asm new file mode 100644 index 000000000..fdbd5fa49 --- /dev/null +++ b/test-suite/standalone/sassy/tests/decinc.asm @@ -0,0 +1,9 @@ +BITS 32 +section .text +foo: +dec dword [eax] +inc word [eax] +dec byte [eax] +inc ch +dec esp +inc dx diff --git a/test-suite/standalone/sassy/tests/decinc.scm b/test-suite/standalone/sassy/tests/decinc.scm new file mode 100644 index 000000000..f66d050b7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/decinc.scm @@ -0,0 +1,9 @@ +( +(dec (dword (& eax))) +(inc (word (& eax))) +(dec (byte (& eax))) +(inc ch) +(dec esp) +(inc dx) +) + diff --git a/test-suite/standalone/sassy/tests/decinc16 b/test-suite/standalone/sassy/tests/decinc16 Binary files differnew file mode 100644 index 000000000..cf10d4586 --- /dev/null +++ b/test-suite/standalone/sassy/tests/decinc16 diff --git a/test-suite/standalone/sassy/tests/decinc16.asm b/test-suite/standalone/sassy/tests/decinc16.asm new file mode 100644 index 000000000..02ccbb76f --- /dev/null +++ b/test-suite/standalone/sassy/tests/decinc16.asm @@ -0,0 +1,9 @@ +BITS 16 +section .text +foo: +dec dword [eax] +inc word [eax] +dec byte [eax] +inc ch +dec esp +inc dx diff --git a/test-suite/standalone/sassy/tests/doub-shift b/test-suite/standalone/sassy/tests/doub-shift new file mode 100644 index 000000000..de8e6620d --- /dev/null +++ b/test-suite/standalone/sassy/tests/doub-shift @@ -0,0 +1 @@ +fคร fฌ คร ฌ fฅรfญฅรญ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/doub-shift.asm b/test-suite/standalone/sassy/tests/doub-shift.asm new file mode 100644 index 000000000..0551fee48 --- /dev/null +++ b/test-suite/standalone/sassy/tests/doub-shift.asm @@ -0,0 +1,11 @@ +BITS 32 +section .text +foo: +shld bx, ax, 9 +shrd [ebx], ax, 9 +shld ebx, eax, 9 +shrd [ebx], eax, 9 +shld bx, ax, cl +shrd [ebx], ax, cl +shld ebx, eax, cl +shrd [ebx], eax, cl diff --git a/test-suite/standalone/sassy/tests/doub-shift.scm b/test-suite/standalone/sassy/tests/doub-shift.scm new file mode 100644 index 000000000..580ad9ee6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/doub-shift.scm @@ -0,0 +1,10 @@ +( +(shld bx ax 9) +(shrd (& ebx) ax 9) +(shld ebx eax 9) +(shrd (& ebx) eax 9) +(shld bx ax cl) +(shrd (& ebx) ax cl) +(shld ebx eax cl) +(shrd (& ebx) eax cl) +) diff --git a/test-suite/standalone/sassy/tests/doub-shift16 b/test-suite/standalone/sassy/tests/doub-shift16 new file mode 100644 index 000000000..31666f1d2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/doub-shift16 @@ -0,0 +1 @@ +คร gฌ fคร gfฌ ฅรgญfฅรgfญ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/doub-shift16.asm b/test-suite/standalone/sassy/tests/doub-shift16.asm new file mode 100644 index 000000000..b6ed696d3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/doub-shift16.asm @@ -0,0 +1,11 @@ +BITS 16 +section .text +foo: +shld bx, ax, 9 +shrd [ebx], ax, 9 +shld ebx, eax, 9 +shrd [ebx], eax, 9 +shld bx, ax, cl +shrd [ebx], ax, cl +shld ebx, eax, cl +shrd [ebx], eax, cl diff --git a/test-suite/standalone/sassy/tests/eip.scm b/test-suite/standalone/sassy/tests/eip.scm new file mode 100644 index 000000000..21a2603b5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/eip.scm @@ -0,0 +1,18 @@ +*(call rel32) +*(call rel16) +*(call i16 i16 +*(call i16 i32 +*(call 'far m16 +*(call 'far m32 +(call r16) +*(call m16) +(call r32) +*(call m32) + +jmp + +jcc + +loop + +jcxz/jecxz diff --git a/test-suite/standalone/sassy/tests/fac5 b/test-suite/standalone/sassy/tests/fac5 Binary files differnew file mode 100755 index 000000000..1974086dc --- /dev/null +++ b/test-suite/standalone/sassy/tests/fac5 diff --git a/test-suite/standalone/sassy/tests/fac5.scm b/test-suite/standalone/sassy/tests/fac5.scm new file mode 100644 index 000000000..f79b5081c --- /dev/null +++ b/test-suite/standalone/sassy/tests/fac5.scm @@ -0,0 +1,12 @@ +(export _start) + +(text + (label _start + (mov eax 1) + (mov ecx 5) + (while (> ecx 0) + (begin (mul ecx) + (sub ecx 1)))) + (mov ebx eax) + (mov eax 1) + (int #x80)) diff --git a/test-suite/standalone/sassy/tests/fp0 b/test-suite/standalone/sassy/tests/fp0 new file mode 100644 index 000000000..a29043d28 --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp0 @@ -0,0 +1 @@ +ููููู่้๊๋์ูํู๎ููู๛ู๒ู๓ู๐ู๑ู๙ู๗ู๖ใใโโูะฺูู้ไูๅู๘ู๕ูแูเููู๚ู๔
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/fp0.asm b/test-suite/standalone/sassy/tests/fp0.asm new file mode 100644 index 000000000..f1f4877cf --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp0.asm @@ -0,0 +1,39 @@ +BITS 32 +section .text +foo: +fld1 +fldl2t +fldl2e +fldpi +fldlg2 +fldln2 +fldz +fsin +fcos +fsincos +fptan +fpatan +f2xm1 +fyl2x +fyl2xp1 +fincstp +fdecstp +finit +fninit +fclex +fnclex +fwait +wait +fnop +fcompp +fucompp +ftst +fxam +fprem +fprem1 +fabs +fchs +frndint +fscale +fsqrt +fxtract diff --git a/test-suite/standalone/sassy/tests/fp0.scm b/test-suite/standalone/sassy/tests/fp0.scm new file mode 100644 index 000000000..ec9adafa1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp0.scm @@ -0,0 +1,39 @@ +( +(fld1) +(fldl2t) +(fldl2e) +(fldpi) +(fldlg2) +(fldln2) +(fldz) +(fsin) +(fcos) +(fsincos) +(fptan) +(fpatan) +(f2xm1) +(fyl2x) +(fyl2xp1) +(fincstp) +(fdecstp) +(finit) +(fninit) +(fclex) +(fnclex) +(fwait) +(wait) +(fnop) +(fcompp) +(fucompp) +(ftst) +(fxam) +(fprem) +(fprem1) +(fabs) +(fchs) +(frndint) +(fscale) +(fsqrt) +(fxtract) +) +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/fp1 b/test-suite/standalone/sassy/tests/fp1 Binary files differnew file mode 100644 index 000000000..f928a75bc --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp1 diff --git a/test-suite/standalone/sassy/tests/fp1.asm b/test-suite/standalone/sassy/tests/fp1.asm new file mode 100644 index 000000000..384bb750c --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp1.asm @@ -0,0 +1,21 @@ +BITS 32 +section .text +foo: +fadd dword [eax] +fsub qword [ebx] +fsubr st0, st4 +fmul st7, st0 +fdiv dword [eax] +fdivr qword [ebx] +fdivrp st2, st0 +fdivp st2, st0 +fmulp st2, st0 +fsubp st3, st0 +fsubrp st2, st0 +faddp st4, st0 +fimul dword [eax] +fiadd word [ebx] +fidiv word [ebx] +fidivr dword [eax] +fisub word [ebx] +fisubr dword [eax] diff --git a/test-suite/standalone/sassy/tests/fp1.scm b/test-suite/standalone/sassy/tests/fp1.scm new file mode 100644 index 000000000..8a70fd7f2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp1.scm @@ -0,0 +1,20 @@ +( +(fadd (dword (& eax))) +(fsub (qword (& ebx))) +(fsubr st0 st4) +(fmul st7 st0) +(fdiv (dword (& eax))) +(fdivr (qword (& ebx))) +(fdivrp st2 st0) +(fdivp st2 st0) +(fmulp st2 st0) +(fsubp st3 st0) +(fsubrp st2 st0) +(faddp st4 st0) +(fimul (dword (& eax))) +(fiadd (word (& ebx))) +(fidiv (word (& ebx))) +(fidivr (dword (& eax))) +(fisub (word (& ebx))) +(fisubr (dword (& eax))) +) diff --git a/test-suite/standalone/sassy/tests/fp2 b/test-suite/standalone/sassy/tests/fp2 new file mode 100644 index 000000000..2bcf538fd --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp2 @@ -0,0 +1 @@ +ฺยฺหฺิฺฦฯัฺูษใ(ููำ฿฿+฿ฺุ ุุ๗฿๖ํ฿์
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/fp2.asm b/test-suite/standalone/sassy/tests/fp2.asm new file mode 100644 index 000000000..180a4dbfb --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp2.asm @@ -0,0 +1,33 @@ +BITS 32 +section .text +foo: +fcmovb st0, st2 +fcmove st0, st3 +fcmovbe st0, st4 +fcmovu st0, st5 +fcmovnb st0, st6 +fcmovne st0, st7 +fcmovnbe st0, st1 +fcmovnu st0, st2 +fxch +fucom st3 +fld tword [eax] +fstp qword [ebx] +fld dword [ecx] +fstp st4 +fst dword [edx] +fst qword [ebx] +fst st3 +fild word [ebx] +fistp dword [ebx] +fild qword [ebx] +fist word [ecx] +ficom dword [ecx] +ficomp word [ecx] +fcomp dword [edi] +fcom qword [edi] +fcomp st0 +fcomi st0, st7 +fcomip st0, st6 +fucomi st0, st5 +fucomip st0, st4 diff --git a/test-suite/standalone/sassy/tests/fp2.scm b/test-suite/standalone/sassy/tests/fp2.scm new file mode 100644 index 000000000..95fc13b2a --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp2.scm @@ -0,0 +1,32 @@ +( +(fcmovb st0 st2) +(fcmove st0 st3) +(fcmovbe st0 st4) +(fcmovu st0 st5) +(fcmovnb st0 st6) +(fcmovne st0 st7) +(fcmovnbe st0 st1) +(fcmovnu st0 st2) +(fxch) +(fucom st3) +(fld (tword (& eax))) +(fstp (qword (& ebx))) +(fld (dword (& ecx))) +(fstp st4) +(fst (dword (& edx))) +(fst (qword (& ebx))) +(fst st3) +(fild (word (& ebx))) +(fistp (dword (& ebx))) +(fild (qword (& ebx))) +(fist (word (& ecx))) +(ficom (dword (& ecx))) +(ficomp (word (& ecx))) +(fcomp (dword (& edi))) +(fcom (qword (& edi))) +(fcomp st0) +(fcomi st0 st7) +(fcomip st0 st6) +(fucomi st0 st5) +(fucomip st0 st4) +) diff --git a/test-suite/standalone/sassy/tests/fp3 b/test-suite/standalone/sassy/tests/fp3 new file mode 100644 index 000000000..9d94f132b --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp3 @@ -0,0 +1,2 @@ +฿ ฿0ู;ู+ู;ู0ู3ยู"22"ฎฎ +฿เ;฿เ;
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/fp3.asm b/test-suite/standalone/sassy/tests/fp3.asm new file mode 100644 index 000000000..aa541ec75 --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp3.asm @@ -0,0 +1,21 @@ +BITS 32 +section .text +foo: +fbld tword [eax] +fbstp tword [eax] +fstcw word [ebx] +fldcw word [ebx] +fnstcw word [ebx] +fstenv [eax] +fnstenv [ebx] +ffree st2 +fldenv [edx] +fsave [edx] +fnsave [edx] +frstor [edx] +fxsave [edx] +fxrstor [edx] +fstsw ax +fstsw word [ebx] +fnstsw ax +fnstsw word [ebx] diff --git a/test-suite/standalone/sassy/tests/fp3.scm b/test-suite/standalone/sassy/tests/fp3.scm new file mode 100644 index 000000000..fdcac679c --- /dev/null +++ b/test-suite/standalone/sassy/tests/fp3.scm @@ -0,0 +1,20 @@ +( +(fbld (tword (& eax))) +(fbstp (tword (& eax))) +(fstcw (word (& ebx))) +(fldcw (word (& ebx))) +(fnstcw (word (& ebx))) +(fstenv (& eax)) +(fnstenv (& ebx)) +(ffree st2) +(fldenv (& edx)) +(fsave (& edx)) +(fnsave (& edx)) +(frstor (& edx)) +(fxsave (& edx)) +(fxrstor (& edx)) +(fstsw ax) +(fstsw (word (& ebx))) +(fnstsw ax) +(fnstsw (word (& ebx))) +) diff --git a/test-suite/standalone/sassy/tests/generate-nasm.scm b/test-suite/standalone/sassy/tests/generate-nasm.scm new file mode 100644 index 000000000..baa924e39 --- /dev/null +++ b/test-suite/standalone/sassy/tests/generate-nasm.scm @@ -0,0 +1,224 @@ +;loading this file populates the tests directory with .asm files and +;calls nasm to assemble them + +;note: the files for seg.scm brt.scm isn't included with this + +; ,open c-system-function + +(define (andmap p lst) + (call-with-current-continuation + (lambda (lose) + (let iter ((lst lst)) + (cond ((null? lst) '()) + ((p (car lst)) => (lambda (this) (cons this (iter (cdr lst))))) + (else (lose #f))))))) + +(define opcode-files + (list + "tests/mem-ref.scm" + "tests/non.scm" + "tests/alu.scm" + "tests/bt.scm" + "tests/shift.scm" + "tests/setcc.scm" + "tests/cmovcc.scm" + "tests/decinc.scm" + "tests/plier.scm" + "tests/load.scm" + "tests/movx.scm" + "tests/r-rm.scm" + "tests/rm.scm" + "tests/rm2.scm" + "tests/aa.scm" + "tests/ret.scm" + "tests/doub-shift.scm" + "tests/cmpx.scm" + "tests/misc1.scm" + "tests/misc2.scm" + "tests/misc3.scm" + "tests/jcc.scm" + "tests/jumps.scm" + "tests/prefix.scm" + "tests/fp0.scm" + "tests/fp1.scm" + "tests/fp2.scm" + "tests/fp3.scm" + "tests/mmx.scm" + "tests/sse1.scm" + "tests/sse2.scm" + "tests/sse3.scm" + "tests/seg.scm" + )) + +(define opcode16-files + (list + "tests/alu.scm" + "tests/bt.scm" + "tests/cmpx.scm" + "tests/decinc.scm" + "tests/doub-shift.scm" + "tests/jcc.scm" + "tests/jumps.scm" + "tests/load.scm" + "tests/mem-ref.scm" + "tests/misc1.scm" + "tests/misc2.scm" + "tests/movx.scm" + "tests/non.scm" + "tests/plier.scm" + "tests/prefix.scm" + "tests/ret.scm" + "tests/rm2.scm" + "tests/rm.scm" + "tests/r-rm.scm" + "tests/setcc.scm" + "tests/shift.scm" + "tests/seg.scm")) + +(define (list-fill lst filler) + (cond ((null? lst) '()) + ((null? (cdr lst)) lst) + (else (cons (car lst) (cons filler (list-fill (cdr lst) filler)))))) + +(define (sassy->nasm file lst bits) + (with-output-to-file file + (lambda () + (letrec + ((outs (lambda x (for-each display x) (newline))) + (i16 (meta-lambda + (or ,@num + ,@symb + (and 'word num) + (and 'word symb)))) + (i32 (meta-lambda + (or ,@num + ,@symb + (and 'dword num) + (and 'dword symb)))) + (prefix? (lambda (x) + (and (memq x '(rep repe repne repz repnz lock)) + (symbol->string x)))) + + (a-sassy + (meta-lambda + (or + (and 'jmp num i32 (lambda (x y) (outs "jmp dword " x ":" y))) + (and 'jmp num i16 (lambda (x y) (outs "jmp word " x ":" y))) + (and 'call num i32 (lambda (x y) (outs "call dword " x ":" y))) + (and 'call num i16 (lambda (x y) (outs "call word " x ":" y))) + (and prefix? pair? (lambda (x y) (begin (outs x " ") + (a-sassy y)))) + (and symb 'near rand (lambda (x y) (outs x " near " y))) + (and symb 'short rand (lambda (x y) (outs x " short " y))) + (and symb 'far rand (lambda (x y) (outs x " far " y))) + (and symb (lambda (x) (outs x))) + (and symb rand (lambda (x y) (outs x " " y))) + (and symb rand rand (lambda (x y z) (outs x " " y ", " z))) + (and symb rand rand rand (lambda (u v w x) + (outs u " " v ", " w ", " x)))))) + (reg (lambda (x) + (and (memq x '(mm7 mm6 mm5 mm4 mm3 dr7 mm2 dr6 mm1 mm0 cr4 + dr3 cr3 dr2 cr2 dr1 dr0 cr0 xmm7 xmm6 + xmm5 xmm4 xmm3 xmm2 xmm1 xmm0 ss sp dx si + cx bx gs ax fs es ds cs bp dl cl bl al di + dh ch bh ah esp edx esi ecx ebx eax ebp + edi st7 st6 st5 st4 st3 st2 st1 st0)) + (symbol->string x)))) + (symb (lambda (x) (and (symbol? x) (not (reg x)) + (symbol->string x)))) + (num (lambda (x) (and (number? x) (number->string x)))) + (segp (lambda (x) + (and (memq x '(cs ds ss es fs gs)) + (string-append (symbol->string x) ":")))) + (skale + (meta-lambda + (or (and '* num reg (lambda (x y) (string-append x "*" y))) + (and '* reg num (lambda (x y) (string-append x "*" y)))))) + (mem + (meta-lambda + (or + (and segp mem + (lambda (x y) + (if (and (> (string-length y) 7) + (string=? "[dword " (substring y 0 7))) + (string-append "[dword " x + (substring y 7 (string-length y))) + (string-append "[" x + (substring y 1 (string-length y)))))) + (and '& __ + (lambda x + (cond ((andmap (lambda (i) (or (num i) (symb i))) x) => + (lambda (lst) + (apply string-append + "[dword " + (append (list-fill lst "+") (list "]"))))) + (else + (let* ((nums (fold (lambda (f r) + (if (number? f) + (if (number? r) + (+ f r) + f) + r)) + '() + x)) + (dword (or (and (not (null? nums)) + (not (u/s-byte nums))) + (any symb x))) + (itms (fold-right (lambda (x r) + (cond + ((or (reg x) + (skale x) (symb x)) + => (lambda (i) + (cons i r))) + (else r))) + '() + x)) + (lst (if (null? nums) + itms + (cons (number->string nums) itms)))) + (if dword + (apply string-append + "[dword " + (append (list-fill lst "+") + (list "]"))) + (apply string-append + "[" (append (list-fill lst "+") + (list "]"))) + ))))))))) + (sizer (lambda (x) + (and (memv x '(byte word dword qword tword dqword)) + (symbol->string x)))) + (rand + (meta-lambda + (or ,@reg + ,@num + ,@mem + ,@symb + (and sizer (or num mem reg symb) + (lambda (x y) + (string-append x " " y))))))) + (display bits) + (newline) + (display "section .text") + (newline) + (display "foo:") + (newline) + (for-each a-sassy lst))))) + +(define (gen-file x bits32?) + (let* ((nasm-asm (string-append + (substring x 0 (- (string-length x) 4)) + (if bits32? ".asm" "16.asm"))) + (nasm-out (string-append + (substring x 0 (- (string-length x) 4)) + (if bits32? "" "16"))) + (the-codes (with-input-from-file x (lambda () (read)))) + (nasm-com (string-append "nasm -f bin " nasm-asm))) + (and (file-exists? nasm-asm) (delete-file nasm-asm)) + (and (file-exists? nasm-out) (delete-file nasm-out)) + (sassy->nasm nasm-asm the-codes (if bits32? "BITS 32" "BITS 16")) + (system nasm-com))) + +; (for-each (lambda (x) (gen-file x #t)) opcode-files) +; (for-each (lambda (x) (gen-file x #f)) opcode16-files) + diff --git a/test-suite/standalone/sassy/tests/generate-prim.scm b/test-suite/standalone/sassy/tests/generate-prim.scm new file mode 100644 index 000000000..a9dea4db2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/generate-prim.scm @@ -0,0 +1,161 @@ +;really these files should never be re-generated unless you're prepared +;to inspect everyone of them for correctness. (Since they've already been inspected by hand). + +(define the-prims + (list "tests/prims/seq1.scm" + "tests/prims/seq2.scm" + "tests/prims/seq3.scm" + "tests/prims/alt1.scm" + "tests/prims/alt2.scm" + "tests/prims/alt3.scm" + "tests/prims/alt4.scm" + "tests/prims/begin1.scm" + "tests/prims/begin2.scm" + "tests/prims/begin3.scm" + "tests/prims/begin4.scm" + "tests/prims/begin5.scm" + "tests/prims/if1.scm" + "tests/prims/if2.scm" + "tests/prims/if3.scm" + "tests/prims/if4.scm" + "tests/prims/inv1.scm" + "tests/prims/inv2.scm" + "tests/prims/inv3.scm" + "tests/prims/inv4.scm" + "tests/prims/inv5.scm" + "tests/prims/inv6.scm" + "tests/prims/iter1.scm" + "tests/prims/iter2.scm" + "tests/prims/iter3.scm" + "tests/prims/iter4.scm" + "tests/prims/iter5.scm" + "tests/prims/iter6.scm" + "tests/prims/leap-mark1.scm" + "tests/prims/leap-mark2.scm" + "tests/prims/leap-mark3.scm" + "tests/prims/while1.scm" + "tests/prims/while2.scm" + "tests/prims/while3.scm" + "tests/prims/with-win1.scm" + "tests/prims/with-win2.scm" + "tests/prims/with-win3.scm" + "tests/prims/with-win4.scm" + "tests/prims/with-win5.scm" + "tests/prims/with-lose1.scm" + "tests/prims/with-lose2.scm" + "tests/prims/with-lose3.scm" + "tests/prims/with-win-lose1.scm" + "tests/prims/with-win-lose2.scm" + "tests/prims/with-win-lose3.scm" + "tests/prims/with-win-lose4.scm" + "tests/prims/with-win-lose5.scm" + "tests/prims/exp-k1.scm" + "tests/prims/exp-k2.scm" + "tests/prims/exp-k3.scm" + "tests/prims/exp-k4.scm" + "tests/prims/esc1.scm" + "tests/prims/esc2.scm" + "tests/prims/esc3.scm" + "tests/prims/esc4.scm" + "tests/prims/esc5.scm" + "tests/prims/esc6.scm" + "tests/prims/esc7.scm" + "tests/prims/label1.scm" + "tests/prims/label2.scm" + "tests/prims/label3.scm" + "tests/prims/label4.scm" + "tests/prims/locals1.scm" + "tests/prims/locals2.scm" + "tests/prims/locals3.scm" + "tests/prims/locals4.scm" + "tests/prims/locals5.scm" + "tests/prims/locals6.scm" + "tests/prims/locals7.scm" + "tests/prims/locals8.scm" + )) + +(define prims16 + (list "tests/prims16/16seq1.scm" + "tests/prims16/16seq2.scm" + "tests/prims16/16seq3.scm" + "tests/prims16/16alt1.scm" + "tests/prims16/16alt2.scm" + "tests/prims16/16alt3.scm" + "tests/prims16/16alt4.scm" + "tests/prims16/16begin1.scm" + "tests/prims16/16begin2.scm" + "tests/prims16/16begin3.scm" + "tests/prims16/16begin4.scm" + "tests/prims16/16begin5.scm" + "tests/prims16/16if1.scm" + "tests/prims16/16if2.scm" + "tests/prims16/16if3.scm" + "tests/prims16/16if4.scm" + "tests/prims16/16inv1.scm" + "tests/prims16/16inv2.scm" + "tests/prims16/16inv3.scm" + "tests/prims16/16inv4.scm" + "tests/prims16/16inv5.scm" + "tests/prims16/16inv6.scm" + "tests/prims16/16iter1.scm" + "tests/prims16/16iter2.scm" + "tests/prims16/16iter3.scm" + "tests/prims16/16iter4.scm" + "tests/prims16/16iter5.scm" + "tests/prims16/16iter6.scm" + "tests/prims16/16leap-mark1.scm" + "tests/prims16/16leap-mark2.scm" + "tests/prims16/16leap-mark3.scm" + "tests/prims16/16while1.scm" + "tests/prims16/16while2.scm" + "tests/prims16/16while3.scm" + "tests/prims16/16with-win1.scm" + "tests/prims16/16with-win2.scm" + "tests/prims16/16with-win3.scm" + "tests/prims16/16with-win4.scm" + "tests/prims16/16with-win5.scm" + "tests/prims16/16with-lose1.scm" + "tests/prims16/16with-lose2.scm" + "tests/prims16/16with-lose3.scm" + "tests/prims16/16with-win-lose1.scm" + "tests/prims16/16with-win-lose2.scm" + "tests/prims16/16with-win-lose3.scm" + "tests/prims16/16with-win-lose4.scm" + "tests/prims16/16with-win-lose5.scm" + "tests/prims16/16exp-k1.scm" + "tests/prims16/16exp-k2.scm" + "tests/prims16/16exp-k3.scm" + "tests/prims16/16exp-k4.scm" + "tests/prims16/16esc1.scm" + "tests/prims16/16esc2.scm" + "tests/prims16/16esc3.scm" + "tests/prims16/16esc4.scm" + "tests/prims16/16esc5.scm" + "tests/prims16/16esc6.scm" + "tests/prims16/16esc7.scm" + "tests/prims16/16label1.scm" + "tests/prims16/16label2.scm" + "tests/prims16/16label3.scm" + "tests/prims16/16label4.scm" + "tests/prims16/16locals1.scm" + "tests/prims16/16locals2.scm" + "tests/prims16/16locals3.scm" + "tests/prims16/16locals4.scm" + "tests/prims16/16locals5.scm" + "tests/prims16/16locals6.scm" + "tests/prims16/16locals7.scm" + "tests/prims16/16locals8.scm" + )) + + +(define (go-gen lst) + (for-each + (lambda (x) + (let ((outp (substring x 0 (- (string-length x) 4)))) + (and (file-exists? outp) + (delete-file outp)) + (sassy-make-bin outp (sassy x)))) + lst)) + +; (go-gen the-prims) +; (go-gen prims16)
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/hello b/test-suite/standalone/sassy/tests/hello Binary files differnew file mode 100644 index 000000000..d92f3c990 --- /dev/null +++ b/test-suite/standalone/sassy/tests/hello diff --git a/test-suite/standalone/sassy/tests/hello.scm b/test-suite/standalone/sassy/tests/hello.scm new file mode 100644 index 000000000..85ecb38b9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/hello.scm @@ -0,0 +1,9 @@ +(export _global_offset_table_) + +(import say-hello) + +(entry _start) + +(text (label _start (jmp (plt say-hello)))) + + diff --git a/test-suite/standalone/sassy/tests/include.scm b/test-suite/standalone/sassy/tests/include.scm new file mode 100644 index 000000000..af199986d --- /dev/null +++ b/test-suite/standalone/sassy/tests/include.scm @@ -0,0 +1,2 @@ +(text (align 32)
+ (label foo (push eax)))
diff --git a/test-suite/standalone/sassy/tests/jcc b/test-suite/standalone/sassy/tests/jcc new file mode 100644 index 000000000..df8011659 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jcc @@ -0,0 +1 @@ +๚f๕๏้fไุfำอวf
ย
ผถfฑซฅf ff~xrfmgaf\V
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/jcc.asm b/test-suite/standalone/sassy/tests/jcc.asm new file mode 100644 index 000000000..0c7845688 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jcc.asm @@ -0,0 +1,33 @@ +BITS 32 +section .text +foo: +jo near dword foo +jno near word foo +jb 0 +jc near dword foo +jnae near word foo +jnb 0 +jnc near dword foo +jae near word foo +je 0 +jz near dword foo +jne near word foo +jnz 0 +jbe near dword foo +jna near word foo +ja 0 +jnbe near dword foo +js near word foo +jns 0 +jp near dword foo +jpe near word foo +jnp 0 +jpo near dword foo +jl near word foo +jnge 0 +jge near dword foo +jnl near word foo +jle 0 +jng near dword foo +jnle near word foo +jg 0 diff --git a/test-suite/standalone/sassy/tests/jcc.scm b/test-suite/standalone/sassy/tests/jcc.scm new file mode 100644 index 000000000..bdef0ad6e --- /dev/null +++ b/test-suite/standalone/sassy/tests/jcc.scm @@ -0,0 +1,32 @@ +( +(jo near (dword foo)) +(jno near (word foo)) +(jb 0) +(jc near (dword foo)) +(jnae near (word foo)) +(jnb 0) +(jnc near (dword foo)) +(jae near (word foo)) +(je 0) +(jz near (dword foo)) +(jne near (word foo)) +(jnz 0) +(jbe near (dword foo)) +(jna near (word foo)) +(ja 0) +(jnbe near (dword foo)) +(js near (word foo)) +(jns 0) +(jp near (dword foo)) +(jpe near (word foo)) +(jnp 0) +(jpo near (dword foo)) +(jl near (word foo)) +(jnge 0) +(jge near (dword foo)) +(jnl near (word foo)) +(jle 0) +(jng near (dword foo)) +(jnle near (word foo)) +(jg 0) +) diff --git a/test-suite/standalone/sassy/tests/jcc16 b/test-suite/standalone/sassy/tests/jcc16 new file mode 100644 index 000000000..983865714 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jcc16 @@ -0,0 +1 @@ +f๙๕๑f๊ๆโfืำfฬ
ศ
ฤfฝนตfฎชฆfff}yfrnj
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/jcc16.asm b/test-suite/standalone/sassy/tests/jcc16.asm new file mode 100644 index 000000000..860c05ac3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jcc16.asm @@ -0,0 +1,33 @@ +BITS 16 +section .text +foo: +jo near dword foo +jno near word foo +jb 0 +jc near dword foo +jnae near word foo +jnb 0 +jnc near dword foo +jae near word foo +je 0 +jz near dword foo +jne near word foo +jnz 0 +jbe near dword foo +jna near word foo +ja 0 +jnbe near dword foo +js near word foo +jns 0 +jp near dword foo +jpe near word foo +jnp 0 +jpo near dword foo +jl near word foo +jnge 0 +jge near dword foo +jnl near word foo +jle 0 +jng near dword foo +jnle near word foo +jg 0 diff --git a/test-suite/standalone/sassy/tests/jumps b/test-suite/standalone/sassy/tests/jumps Binary files differnew file mode 100644 index 000000000..9ea377c2b --- /dev/null +++ b/test-suite/standalone/sassy/tests/jumps diff --git a/test-suite/standalone/sassy/tests/jumps.asm b/test-suite/standalone/sassy/tests/jumps.asm new file mode 100644 index 000000000..3ee17e2a6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jumps.asm @@ -0,0 +1,36 @@ +BITS 32 +section .text +foo: +loop foo +loope foo, cx +loopz foo, ecx +loopne foo +loopnz foo, cx +jcxz foo +jecxz foo +call dword 0 +call word 0 +call dword 1000:1000 +call word 1000:1000 +call dword 1000:1000 +call word 1000:1000 +call far dword [ecx] +call far word [ecx] +call ecx +call dword [ecx] +call cx +call word [ecx] +jmp dword 0 +jmp near dword 0 +jmp word 0 +jmp near word 0 +jmp dword 1000:1000 +jmp word 1000:1000 +jmp dword 1000:foo +jmp word 1000:foo +jmp far dword [ecx] +jmp far word [ecx] +jmp ecx +jmp dword [ecx] +jmp cx +jmp word [ecx] diff --git a/test-suite/standalone/sassy/tests/jumps.scm b/test-suite/standalone/sassy/tests/jumps.scm new file mode 100644 index 000000000..e0396e9a6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jumps.scm @@ -0,0 +1,35 @@ +( +(loop foo) +(loope foo cx) +(loopz foo ecx) +(loopne foo) +(loopnz foo cx) +(jcxz foo) +(jecxz foo) +(call (dword 0)) +(call (word 0)) +(call 1000 (dword 1000)) +(call 1000 (word 1000)) +(call 1000 (dword 1000)) +(call 1000 (word 1000)) +(call far (dword (& ecx))) +(call far (word (& ecx))) +(call ecx) +(call (dword (& ecx))) +(call cx) +(call (word (& ecx))) +(jmp (dword 0)) +(jmp near (dword 0)) +(jmp (word 0)) +(jmp near (word 0)) +(jmp 1000 (dword 1000)) +(jmp 1000 (word 1000)) +(jmp 1000 (dword foo)) +(jmp 1000 (word foo)) +(jmp far (dword (& ecx))) +(jmp far (word (& ecx))) +(jmp ecx) +(jmp (dword (& ecx))) +(jmp cx) +(jmp (word (& ecx))) +) diff --git a/test-suite/standalone/sassy/tests/jumps16 b/test-suite/standalone/sassy/tests/jumps16 Binary files differnew file mode 100644 index 000000000..e2c2c0e62 --- /dev/null +++ b/test-suite/standalone/sassy/tests/jumps16 diff --git a/test-suite/standalone/sassy/tests/jumps16.asm b/test-suite/standalone/sassy/tests/jumps16.asm new file mode 100644 index 000000000..4e307aaeb --- /dev/null +++ b/test-suite/standalone/sassy/tests/jumps16.asm @@ -0,0 +1,36 @@ +BITS 16 +section .text +foo: +loop foo +loope foo, cx +loopz foo, ecx +loopne foo +loopnz foo, cx +jcxz foo +jecxz foo +call dword 0 +call word 0 +call dword 1000:1000 +call word 1000:1000 +call dword 1000:1000 +call word 1000:1000 +call far dword [ecx] +call far word [ecx] +call ecx +call dword [ecx] +call cx +call word [ecx] +jmp dword 0 +jmp near dword 0 +jmp word 0 +jmp near word 0 +jmp dword 1000:1000 +jmp word 1000:1000 +jmp dword 1000:foo +jmp word 1000:foo +jmp far dword [ecx] +jmp far word [ecx] +jmp ecx +jmp dword [ecx] +jmp cx +jmp word [ecx] diff --git a/test-suite/standalone/sassy/tests/libgoodbye.scm b/test-suite/standalone/sassy/tests/libgoodbye.scm new file mode 100644 index 000000000..eaa10d359 --- /dev/null +++ b/test-suite/standalone/sassy/tests/libgoodbye.scm @@ -0,0 +1,6 @@ +(export _global_offset_table_) + +(data (label a-string (bytes "Goodbye." #\newline))) + +(export a-string) + diff --git a/test-suite/standalone/sassy/tests/libgoodbye.so b/test-suite/standalone/sassy/tests/libgoodbye.so Binary files differnew file mode 100644 index 000000000..4536f6f03 --- /dev/null +++ b/test-suite/standalone/sassy/tests/libgoodbye.so diff --git a/test-suite/standalone/sassy/tests/libhello.scm b/test-suite/standalone/sassy/tests/libhello.scm new file mode 100644 index 000000000..d92a2219f --- /dev/null +++ b/test-suite/standalone/sassy/tests/libhello.scm @@ -0,0 +1,30 @@ +(export _global_offset_table_ say-hello the-string1) +(import a-string) + +(data (label the-string1 (bytes "Hello ")) + (label the-string2 (bytes "World." #\newline)) + (label boxed-one (dwords (sym the-string1)))) + +(macro stdout 1) + +(macro write (lambda (fd buffer amount) + `(begin (mov ecx ,buffer) + (mov ebx ,fd) + (mov edx ,amount) + (mov eax ,4) + (int #x80)))) +(text + (label exit (mov eax 1) + (mov ebx 0) + (int #x80)) + (label say-hello get-got + (push ebx) + (lea eax (& ebx (got-offset boxed-one))) + (write stdout (& eax) 6) + (mov ebx (& esp)) + (lea eax (& ebx (got-offset the-string2))) + (write stdout eax 7) + (mov ebx (& esp)) + (write stdout (& ebx (got a-string)) 9) + (jmp exit))) + diff --git a/test-suite/standalone/sassy/tests/libhello.so b/test-suite/standalone/sassy/tests/libhello.so Binary files differnew file mode 100644 index 000000000..103e9c3ef --- /dev/null +++ b/test-suite/standalone/sassy/tests/libhello.so diff --git a/test-suite/standalone/sassy/tests/liblocaldata3.so b/test-suite/standalone/sassy/tests/liblocaldata3.so Binary files differnew file mode 100755 index 000000000..ac38cb6b9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/liblocaldata3.so diff --git a/test-suite/standalone/sassy/tests/load b/test-suite/standalone/sassy/tests/load new file mode 100644 index 000000000..bc766c6be --- /dev/null +++ b/test-suite/standalone/sassy/tests/load @@ -0,0 +1 @@ +ล>fฤ>>fด>ต>fฒ>
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/load.asm b/test-suite/standalone/sassy/tests/load.asm new file mode 100644 index 000000000..71f694cd1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/load.asm @@ -0,0 +1,9 @@ +BITS 32 +section .text +foo: +lds edi, [esi] +les di, [esi] +lea edi, [esi] +lfs di, [esi] +lgs edi, [esi] +lss di, [esi] diff --git a/test-suite/standalone/sassy/tests/load.scm b/test-suite/standalone/sassy/tests/load.scm new file mode 100644 index 000000000..9be8d391a --- /dev/null +++ b/test-suite/standalone/sassy/tests/load.scm @@ -0,0 +1,9 @@ +( +(lds edi (& esi)) +(les di (& esi)) +(lea edi (& esi)) +(lfs di (& esi)) +(lgs edi (& esi)) +(lss di (& esi)) +) + diff --git a/test-suite/standalone/sassy/tests/load16 b/test-suite/standalone/sassy/tests/load16 new file mode 100644 index 000000000..c2b70471e --- /dev/null +++ b/test-suite/standalone/sassy/tests/load16 @@ -0,0 +1 @@ +fgล>gฤ>fg>gด>fgต>gฒ>
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/load16.asm b/test-suite/standalone/sassy/tests/load16.asm new file mode 100644 index 000000000..73550b499 --- /dev/null +++ b/test-suite/standalone/sassy/tests/load16.asm @@ -0,0 +1,9 @@ +BITS 16 +section .text +foo: +lds edi, [esi] +les di, [esi] +lea edi, [esi] +lfs di, [esi] +lgs edi, [esi] +lss di, [esi] diff --git a/test-suite/standalone/sassy/tests/local-data-static b/test-suite/standalone/sassy/tests/local-data-static Binary files differnew file mode 100755 index 000000000..361a6f1bd --- /dev/null +++ b/test-suite/standalone/sassy/tests/local-data-static diff --git a/test-suite/standalone/sassy/tests/localdata1.scm b/test-suite/standalone/sassy/tests/localdata1.scm new file mode 100644 index 000000000..99eae79ee --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata1.scm @@ -0,0 +1,9 @@ +(export foo) + +(data + (label foo + (dwords "abcd" #\newline) + (locals (foo) + (label foo + (dwords "defg" #\newline foo))) + (dwords foo))) diff --git a/test-suite/standalone/sassy/tests/localdata2.scm b/test-suite/standalone/sassy/tests/localdata2.scm new file mode 100644 index 000000000..60d2cb995 --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata2.scm @@ -0,0 +1,34 @@ +(import foo) + +(entry _start) + +(macro stdout 1) + +(text (label write ; fd buffer amount + (mov ebx (& esp 4)) + (mov ecx (& esp 8)) + (mov edx (& esp 12)) + (mov eax 4) + (int #x80) + (ret))) + +(text (label exit + (mov eax 1) + (mov ebx 0) + (int #x80))) + +(text (label _start + (push 5) ;fd + (push foo) ;buffer + (push stdout) ;amount + (call write) + (add esp 12) + (push 5) ;fd + (push (& foo 16));buffer - in this case its the pointer to the local foo + (push stdout) + (call write) + (call exit))) + + + + diff --git a/test-suite/standalone/sassy/tests/localdata3.scm b/test-suite/standalone/sassy/tests/localdata3.scm new file mode 100644 index 000000000..74348d90b --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata3.scm @@ -0,0 +1,12 @@ +(export _global_offset_table_ foo) + +(data + (label foo + (locals (foo) + (dwords "abcd" #\newline foo) + (label foo + (dwords "defg" #\newline))))) + + + + diff --git a/test-suite/standalone/sassy/tests/localdata3.so b/test-suite/standalone/sassy/tests/localdata3.so Binary files differnew file mode 100755 index 000000000..7052044b4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata3.so diff --git a/test-suite/standalone/sassy/tests/localdata4 b/test-suite/standalone/sassy/tests/localdata4 Binary files differnew file mode 100755 index 000000000..05086755d --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata4 diff --git a/test-suite/standalone/sassy/tests/localdata4.scm b/test-suite/standalone/sassy/tests/localdata4.scm new file mode 100644 index 000000000..a8d6d619b --- /dev/null +++ b/test-suite/standalone/sassy/tests/localdata4.scm @@ -0,0 +1,37 @@ +(export _global_offset_table_) + +(import foo) + +(entry _start) + +(macro stdout 1) + +(text (label write ; fd buffer amount + (mov ebx (& esp 4)) + (mov ecx (& esp 8)) + (mov edx (& esp 12)) + (mov eax 4) + (int #x80) + (ret))) + +(text (label exit + (mov eax 1) + (mov ebx 0) + (int #x80))) + +(text (label _start + get-got + (push ebx) + (push 5) + (push (& ebx (got foo))) + (push stdout) + (call write) + (add esp 12) + (pop ebx) + (push 5) ;fd + (mov eax (& ebx (got foo))) + (add eax 8) + (push (& eax)) + (push stdout) + (call write) + (call exit))) diff --git a/test-suite/standalone/sassy/tests/mem-ref b/test-suite/standalone/sassy/tests/mem-ref Binary files differnew file mode 100644 index 000000000..166496075 --- /dev/null +++ b/test-suite/standalone/sassy/tests/mem-ref diff --git a/test-suite/standalone/sassy/tests/mem-ref.asm b/test-suite/standalone/sassy/tests/mem-ref.asm new file mode 100644 index 000000000..e03d6bead --- /dev/null +++ b/test-suite/standalone/sassy/tests/mem-ref.asm @@ -0,0 +1,116 @@ +BITS 32 +section .text +foo: +add eax, [ecx] +add eax, [ebp] +add eax, [esp] +add eax, [dword 100] +add eax, [dword 1600] +add eax, [ecx*1] +add eax, [ecx*2] +add eax, [ecx*4] +add eax, [ecx*8] +add eax, [ebp*1] +add eax, [ebp*2] +add eax, [ebp*4] +add eax, [ebp*8] +add eax, [100+ecx] +add eax, [dword 1600+ecx] +add eax, [100+ebp] +add eax, [dword 1600+ebp] +add eax, [100+esp] +add eax, [dword 1600+esp] +add eax, [100+ecx] +add eax, [dword 1600+ecx] +add eax, [100+ebp] +add eax, [dword 1600+ebp] +add eax, [100+esp] +add eax, [dword 1600+esp] +add eax, [ecx+edx*1] +add eax, [ebp*1+ecx] +add eax, [ecx+edx*2] +add eax, [ebp*2+ecx] +add eax, [ecx+edx*4] +add eax, [ebp*4+ecx] +add eax, [ecx+edx*8] +add eax, [ecx+ebp*8] +add eax, [edx*1+ebp] +add eax, [ebp+ebp*1] +add eax, [ebp+edx*2] +add eax, [ebp+ebp*2] +add eax, [ebp+edx*4] +add eax, [ebp*4+ebp] +add eax, [ebp+edx*8] +add eax, [ebp+ebp*8] +add eax, [esp+edx*1] +add eax, [esp+ebp*1] +add eax, [esp+edx*2] +add eax, [ebp*2+esp] +add eax, [esp+edx*4] +add eax, [esp+ebp*4] +add eax, [esp+edx*8] +add eax, [esp+ebp*8] +add eax, [100+ecx*1] +add eax, [100+ecx*2] +add eax, [100+ecx*4] +add eax, [100+ecx*8] +add eax, [100+ebp*1] +add eax, [100+ebp*2] +add eax, [100+ebp*4] +add eax, [100+ebp*8] +add eax, [dword 1600+ecx*1] +add eax, [dword 1600+ecx*2] +add eax, [dword 1600+ecx*4] +add eax, [dword 1600+ecx*8] +add eax, [dword 1600+ebp*1] +add eax, [dword 1600+ebp*2] +add eax, [dword 1600+ebp*4] +add eax, [dword 1600+ebp*8] +add eax, [100+ecx+edx*1] +add eax, [100+ecx+edx*2] +add eax, [100+edx*4+ecx] +add eax, [100+ecx+edx*8] +add eax, [100+ecx+ebp*1] +add eax, [100+ecx+ebp*2] +add eax, [100+ecx+ebp*4] +add eax, [100+ecx+ebp*8] +add eax, [100+ebp+edx*1] +add eax, [100+ebp+edx*2] +add eax, [100+ebp+edx*4] +add eax, [100+ebp+edx*8] +add eax, [100+ebp+ebp*1] +add eax, [100+ebp*2+ebp] +add eax, [100+ebp+ebp*4] +add eax, [100+ebp+ebp*8] +add eax, [100+esp+edx*1] +add eax, [100+esp+edx*2] +add eax, [100+esp+edx*4] +add eax, [100+esp+edx*8] +add eax, [100+esp+ebp*1] +add eax, [100+esp+ebp*2] +add eax, [100+esp+ebp*4] +add eax, [100+esp+ebp*8] +add eax, [dword 1600+ecx+edx*1] +add eax, [dword 1600+ecx+edx*2] +add eax, [dword 1600+ecx+edx*4] +add eax, [dword 1600+ecx+edx*8] +add eax, [dword 1600+ecx+ebp*1] +add eax, [dword 1600+ecx+ebp*2] +add eax, [dword 1600+ecx+ebp*4] +add eax, [dword 1600+ecx+ebp*8] +add eax, [dword 1600+ebp+edx*1] +add eax, [dword 1600+ebp+edx*2] +add eax, [dword 1600+ebp+edx*4] +add eax, [dword 1600+ebp+edx*8] +add eax, [dword 1600+ebp+ebp*1] +add eax, [dword 1600+ebp+ebp*2] +add eax, [dword 1600+ebp+ebp*4] +add eax, [dword 1600+ebp+ebp*8] +add eax, [dword 1600+esp+edx*1] +add eax, [dword 1600+esp+edx*2] +add eax, [dword 1600+esp+edx*4] +add eax, [dword 1600+esp+edx*8] +add eax, [dword 1600+esp+ebp*1] +add eax, [dword 1600+esp+ebp*2] +add eax, [dword 1600+esp+ebp*4] +add eax, [dword 1600+esp+ebp*8] diff --git a/test-suite/standalone/sassy/tests/mem-ref.scm b/test-suite/standalone/sassy/tests/mem-ref.scm new file mode 100644 index 000000000..fe6e0c74a --- /dev/null +++ b/test-suite/standalone/sassy/tests/mem-ref.scm @@ -0,0 +1,115 @@ +(
+(add eax (& ecx))
+(add eax (& ebp))
+(add eax (& esp))
+(add eax (& #x64))
+(add eax (& #x640))
+(add eax (& (* ecx 1)))
+(add eax (& (* ecx 2)))
+(add eax (& (* ecx 4)))
+(add eax (& (* ecx 8)))
+(add eax (& (* ebp 1)))
+(add eax (& (* ebp 2)))
+(add eax (& (* ebp 4)))
+(add eax (& (* ebp 8)))
+(add eax (& ecx 100))
+(add eax (& ecx 1600))
+(add eax (& ebp 100))
+(add eax (& ebp 1600))
+(add eax (& esp 100))
+(add eax (& esp 1600))
+(add eax (& 100 ecx))
+(add eax (& 1600 ecx))
+(add eax (& 100 ebp))
+(add eax (& 1000 ebp 600))
+(add eax (& 100 esp))
+(add eax (& 1600 esp))
+(add eax (& ecx (* edx 1)))
+(add eax (& (* ebp 1) ecx))
+(add eax (& ecx (* edx 2)))
+(add eax (& (* ebp 2) ecx))
+(add eax (& ecx (* edx 4)))
+(add eax (& (* ebp 4) ecx))
+(add eax (& ecx (* edx 8)))
+(add eax (& ecx (* ebp 8)))
+(add eax (& (* edx 1) ebp))
+(add eax (& ebp (* ebp 1)))
+(add eax (& ebp (* edx 2)))
+(add eax (& ebp (* ebp 2)))
+(add eax (& ebp (* edx 4)))
+(add eax (& (* ebp 4) ebp))
+(add eax (& ebp (* edx 8)))
+(add eax (& ebp (* ebp 8)))
+(add eax (& esp (* edx 1)))
+(add eax (& esp (* ebp 1)))
+(add eax (& esp (* edx 2)))
+(add eax (& (* ebp 2) esp))
+(add eax (& esp (* edx 4)))
+(add eax (& esp (* ebp 4)))
+(add eax (& esp (* edx 8)))
+(add eax (& esp (* ebp 8)))
+(add eax (& (* ecx 1) 100))
+(add eax (& (* ecx 2) 100))
+(add eax (& 100 (* ecx 4)))
+(add eax (& (* ecx 8) 100))
+(add eax (& 100 (* ebp 1)))
+(add eax (& (* ebp 2) 100))
+(add eax (& 100 (* ebp 4)))
+(add eax (& (* ebp 8) 100))
+(add eax (& 1600 (* ecx 1)))
+(add eax (& (* ecx 2) 1600))
+(add eax (& (* ecx 4) 1600))
+(add eax (& 1600 (* ecx 8)))
+(add eax (& (* ebp 1) 1600))
+(add eax (& 1600 (* ebp 2)))
+(add eax (& (* ebp 4) 1600))
+(add eax (& (* ebp 8) 1600))
+(add eax (& ecx 100 (* edx 1)))
+(add eax (& ecx (* edx 2) 100))
+(add eax (& (* edx 4) ecx 100))
+(add eax (& ecx (* edx 8) 100))
+(add eax (& ecx (* ebp 1) 100))
+(add eax (& ecx (* ebp 2) 100))
+(add eax (& ecx (* ebp 4) 100))
+(add eax (& 100 ecx (* ebp 8)))
+(add eax (& ebp (* edx 1) 100))
+(add eax (& ebp (* edx 2) 100))
+(add eax (& ebp (* edx 4) 100))
+(add eax (& ebp (* edx 8) 100))
+(add eax (& ebp (* ebp 1) 100))
+(add eax (& 100 (* ebp 2) ebp))
+(add eax (& ebp (* ebp 4) 100))
+(add eax (& ebp (* ebp 8) 100))
+(add eax (& esp (* edx 1) 100))
+(add eax (& esp (* edx 2) 100))
+(add eax (& esp (* edx 4) 100))
+(add eax (& esp (* edx 8) 100))
+(add eax (& esp (* ebp 1) 100))
+(add eax (& esp (* ebp 2) 100))
+(add eax (& esp (* ebp 4) 100))
+(add eax (& esp (* ebp 8) 100))
+(add eax (& ecx (* edx 1) 1600))
+(add eax (& ecx (* edx 2) 1600))
+(add eax (& ecx (* edx 4) 1600))
+(add eax (& ecx (* edx 8) 1600))
+(add eax (& ecx (* ebp 1) 1600))
+(add eax (& ecx (* ebp 2) 1600))
+(add eax (& ecx (* ebp 4) 1600))
+(add eax (& ecx (* ebp 8) 1600))
+(add eax (& ebp (* edx 1) 1600))
+(add eax (& ebp (* edx 2) 1600))
+(add eax (& ebp (* edx 4) 1600))
+(add eax (& ebp (* edx 8) 1600))
+(add eax (& ebp (* ebp 1) 1600))
+(add eax (& ebp (* ebp 2) 1600))
+(add eax (& ebp (* ebp 4) 1600))
+(add eax (& ebp (* ebp 8) 1600))
+(add eax (& esp (* edx 1) 1600))
+(add eax (& esp (* edx 2) 1600))
+(add eax (& esp (* edx 4) 1600))
+(add eax (& esp (* edx 8) 1600))
+(add eax (& esp (* ebp 1) 1600))
+(add eax (& esp (* ebp 2) 1600))
+(add eax (& esp (* ebp 4) 1600))
+(add eax (& esp (* ebp 8) 1600))
+)
diff --git a/test-suite/standalone/sassy/tests/mem-ref16 b/test-suite/standalone/sassy/tests/mem-ref16 Binary files differnew file mode 100644 index 000000000..9cf340b9c --- /dev/null +++ b/test-suite/standalone/sassy/tests/mem-ref16 diff --git a/test-suite/standalone/sassy/tests/mem-ref16.asm b/test-suite/standalone/sassy/tests/mem-ref16.asm new file mode 100644 index 000000000..8e6d13634 --- /dev/null +++ b/test-suite/standalone/sassy/tests/mem-ref16.asm @@ -0,0 +1,116 @@ +BITS 16 +section .text +foo: +add eax, [ecx] +add eax, [ebp] +add eax, [esp] +add eax, [dword 100] +add eax, [dword 1600] +add eax, [ecx*1] +add eax, [ecx*2] +add eax, [ecx*4] +add eax, [ecx*8] +add eax, [ebp*1] +add eax, [ebp*2] +add eax, [ebp*4] +add eax, [ebp*8] +add eax, [100+ecx] +add eax, [dword 1600+ecx] +add eax, [100+ebp] +add eax, [dword 1600+ebp] +add eax, [100+esp] +add eax, [dword 1600+esp] +add eax, [100+ecx] +add eax, [dword 1600+ecx] +add eax, [100+ebp] +add eax, [dword 1600+ebp] +add eax, [100+esp] +add eax, [dword 1600+esp] +add eax, [ecx+edx*1] +add eax, [ebp*1+ecx] +add eax, [ecx+edx*2] +add eax, [ebp*2+ecx] +add eax, [ecx+edx*4] +add eax, [ebp*4+ecx] +add eax, [ecx+edx*8] +add eax, [ecx+ebp*8] +add eax, [edx*1+ebp] +add eax, [ebp+ebp*1] +add eax, [ebp+edx*2] +add eax, [ebp+ebp*2] +add eax, [ebp+edx*4] +add eax, [ebp*4+ebp] +add eax, [ebp+edx*8] +add eax, [ebp+ebp*8] +add eax, [esp+edx*1] +add eax, [esp+ebp*1] +add eax, [esp+edx*2] +add eax, [ebp*2+esp] +add eax, [esp+edx*4] +add eax, [esp+ebp*4] +add eax, [esp+edx*8] +add eax, [esp+ebp*8] +add eax, [100+ecx*1] +add eax, [100+ecx*2] +add eax, [100+ecx*4] +add eax, [100+ecx*8] +add eax, [100+ebp*1] +add eax, [100+ebp*2] +add eax, [100+ebp*4] +add eax, [100+ebp*8] +add eax, [dword 1600+ecx*1] +add eax, [dword 1600+ecx*2] +add eax, [dword 1600+ecx*4] +add eax, [dword 1600+ecx*8] +add eax, [dword 1600+ebp*1] +add eax, [dword 1600+ebp*2] +add eax, [dword 1600+ebp*4] +add eax, [dword 1600+ebp*8] +add eax, [100+ecx+edx*1] +add eax, [100+ecx+edx*2] +add eax, [100+edx*4+ecx] +add eax, [100+ecx+edx*8] +add eax, [100+ecx+ebp*1] +add eax, [100+ecx+ebp*2] +add eax, [100+ecx+ebp*4] +add eax, [100+ecx+ebp*8] +add eax, [100+ebp+edx*1] +add eax, [100+ebp+edx*2] +add eax, [100+ebp+edx*4] +add eax, [100+ebp+edx*8] +add eax, [100+ebp+ebp*1] +add eax, [100+ebp*2+ebp] +add eax, [100+ebp+ebp*4] +add eax, [100+ebp+ebp*8] +add eax, [100+esp+edx*1] +add eax, [100+esp+edx*2] +add eax, [100+esp+edx*4] +add eax, [100+esp+edx*8] +add eax, [100+esp+ebp*1] +add eax, [100+esp+ebp*2] +add eax, [100+esp+ebp*4] +add eax, [100+esp+ebp*8] +add eax, [dword 1600+ecx+edx*1] +add eax, [dword 1600+ecx+edx*2] +add eax, [dword 1600+ecx+edx*4] +add eax, [dword 1600+ecx+edx*8] +add eax, [dword 1600+ecx+ebp*1] +add eax, [dword 1600+ecx+ebp*2] +add eax, [dword 1600+ecx+ebp*4] +add eax, [dword 1600+ecx+ebp*8] +add eax, [dword 1600+ebp+edx*1] +add eax, [dword 1600+ebp+edx*2] +add eax, [dword 1600+ebp+edx*4] +add eax, [dword 1600+ebp+edx*8] +add eax, [dword 1600+ebp+ebp*1] +add eax, [dword 1600+ebp+ebp*2] +add eax, [dword 1600+ebp+ebp*4] +add eax, [dword 1600+ebp+ebp*8] +add eax, [dword 1600+esp+edx*1] +add eax, [dword 1600+esp+edx*2] +add eax, [dword 1600+esp+edx*4] +add eax, [dword 1600+esp+edx*8] +add eax, [dword 1600+esp+ebp*1] +add eax, [dword 1600+esp+ebp*2] +add eax, [dword 1600+esp+ebp*4] +add eax, [dword 1600+esp+ebp*8] diff --git a/test-suite/standalone/sassy/tests/misc1 b/test-suite/standalone/sassy/tests/misc1 new file mode 100644 index 000000000..108693f98 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc1 @@ -0,0 +1,2 @@ +fbbสว +ศ่dffฤ#fหfหf
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/misc1.asm b/test-suite/standalone/sassy/tests/misc1.asm new file mode 100644 index 000000000..cf5722b55 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc1.asm @@ -0,0 +1,21 @@ +BITS 32 +section .text +foo: +bound ax, [edi] +bound eax, [edi] +bswap edx +cmpxchg8b [edx+ecx] +enter 1000, 100 +xchg ax, bx +xchg bx, ax +xchg eax, ebx +xchg ebx, eax +xchg al, ah +xchg [ebx], ah +xchg cx, bx +xchg [ecx], bx +xchg ecx, ebx +xchg [ecx], ebx +xchg al, [edi] +xchg ax, [edi] +xchg eax, [edi] diff --git a/test-suite/standalone/sassy/tests/misc1.scm b/test-suite/standalone/sassy/tests/misc1.scm new file mode 100644 index 000000000..07a9f0a22 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc1.scm @@ -0,0 +1,20 @@ +( +(bound ax (& edi)) +(bound eax (& edi)) +(bswap edx) +(cmpxchg8b (& edx ecx)) +(enter 1000 100) +(xchg ax bx) +(xchg bx ax) +(xchg eax ebx) +(xchg ebx eax) +(xchg al ah) +(xchg (& ebx) ah) +(xchg cx bx) +(xchg (& ecx) bx) +(xchg ecx ebx) +(xchg (& ecx) ebx) +(xchg al (& edi)) +(xchg ax (& edi)) +(xchg eax (& edi)) +) diff --git a/test-suite/standalone/sassy/tests/misc116 b/test-suite/standalone/sassy/tests/misc116 new file mode 100644 index 000000000..6a4acfe3d --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc116 @@ -0,0 +1,2 @@ +gbfgbfสgว +ศ่dffฤg#หgfหfgggfg
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/misc116.asm b/test-suite/standalone/sassy/tests/misc116.asm new file mode 100644 index 000000000..4e201ee1e --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc116.asm @@ -0,0 +1,21 @@ +BITS 16 +section .text +foo: +bound ax, [edi] +bound eax, [edi] +bswap edx +cmpxchg8b [edx+ecx] +enter 1000, 100 +xchg ax, bx +xchg bx, ax +xchg eax, ebx +xchg ebx, eax +xchg al, ah +xchg [ebx], ah +xchg cx, bx +xchg [ecx], bx +xchg ecx, ebx +xchg [ecx], ebx +xchg al, [edi] +xchg ax, [edi] +xchg eax, [edi] diff --git a/test-suite/standalone/sassy/tests/misc2 b/test-suite/standalone/sassy/tests/misc2 Binary files differnew file mode 100644 index 000000000..ac84bbc25 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc2 diff --git a/test-suite/standalone/sassy/tests/misc2.asm b/test-suite/standalone/sassy/tests/misc2.asm new file mode 100644 index 000000000..aadc298be --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc2.asm @@ -0,0 +1,111 @@ +BITS 32 +section .text +foo: +in al, 9 +in ax, 9 +in eax, 9 +in al, dx +in ax, dx +in eax, dx +out 9, al +out 9, ax +out 9, eax +out dx, al +out dx, ax +out dx, eax +int 128 +pop cx +pop ecx +pop dword [ecx] +pop word [ecx] +pop ds +pop es +pop ss +pop fs +pop gs +push cx +push edx +push dword 100 +push word 100 +push byte 100 +push word [esi] +push dword [esi] +push cs +push ds +push es +push ss +push fs +push gs +imul ax, bx, word 100 +imul ax, [ebx], word 100 +imul ax, bx, byte 100 +imul ax, [ebx], byte 100 +imul eax, ebx, dword 100 +imul eax, [ebx], dword 100 +imul eax, ebx, byte 100 +imul eax, [ebx], byte 100 +imul eax, dword 100 +imul eax, byte 100 +imul ax, word 100 +imul ax, byte 100 +imul ax, bx +imul ax, [ebx] +imul eax, ebx +imul eax, [ebx] +imul al +imul byte [eax] +imul ax +imul word [eax] +imul eax +imul dword [eax] +test al, 9 +test ax, 9 +test eax, 9 +test bl, cl +test [ebx], cl +test bx, cx +test [ebx], cx +test ebx, ecx +test [ebx], ecx +test bl, 9 +test dword [ebx], 9 +test bx, 9 +test word [ebx], 9 +test ebx, 9 +test byte [ebx], 9 +mov bl, cl +mov [edx], cl +mov bx, dx +mov [esi], dx +mov ebx, edi +mov [eax], edi +mov bl, cl +mov bl, [edx] +mov bx, dx +mov bx, [esi] +mov ebx, edi +mov ebx, [eax] +mov bl, 9 +mov bx, 9 +mov ebx, 9 +mov [edx], byte 9 +mov [esi], word 9 +mov [eax], dword 9 +mov al, [dword 9] +mov ax, [dword 9] +mov eax, [dword 9] +mov [dword 9], al +mov [dword 9], ax +mov [dword 9], eax +mov bx, ds +mov [esi], ss +mov ebx, fs +mov [eax], es +mov gs, dx +mov ds, [esi] +mov fs, edi +mov ss, [eax] +mov ecx, cr2 +mov ecx, dr1 +mov cr0, edx +mov dr0, edx diff --git a/test-suite/standalone/sassy/tests/misc2.scm b/test-suite/standalone/sassy/tests/misc2.scm new file mode 100644 index 000000000..d2464e716 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc2.scm @@ -0,0 +1,110 @@ +( +(in al 9) +(in ax 9) +(in eax 9) +(in al dx) +(in ax dx) +(in eax dx) +(out 9 al) +(out 9 ax) +(out 9 eax) +(out dx al) +(out dx ax) +(out dx eax) +(int #x80) +(pop cx) +(pop ecx) +(pop (dword (& ecx))) +(pop (word (& ecx))) +(pop ds) +(pop es) +(pop ss) +(pop fs) +(pop gs) +(push cx) +(push edx) +(push (dword 100)) +(push (word 100)) +(push (byte 100)) +(push (word (& esi))) +(push (dword (& esi))) +(push cs) +(push ds) +(push es) +(push ss) +(push fs) +(push gs) +(imul ax bx (word 100)) +(imul ax (& ebx) (word 100)) +(imul ax bx (byte 100)) +(imul ax (& ebx) (byte 100)) +(imul eax ebx (dword 100)) +(imul eax (& ebx) (dword 100)) +(imul eax ebx (byte 100)) +(imul eax (& ebx) (byte 100)) +(imul eax (dword 100)) +(imul eax (byte 100)) +(imul ax (word 100)) +(imul ax (byte 100)) +(imul ax bx) +(imul ax (& ebx)) +(imul eax ebx) +(imul eax (& ebx)) +(imul al) +(imul (byte (& eax))) +(imul ax) +(imul (word (& eax))) +(imul eax) +(imul (dword (& eax))) +(test al 9) +(test ax 9) +(test eax 9) +(test bl cl) +(test (& ebx) cl) +(test bx cx) +(test (& ebx) cx) +(test ebx ecx) +(test (& ebx) ecx) +(test bl 9) +(test (dword (& ebx)) 9) +(test bx 9) +(test (word (& ebx)) 9) +(test ebx 9) +(test (byte (& ebx)) 9) +(mov bl cl) +(mov (& edx) cl) +(mov bx dx) +(mov (& esi) dx) +(mov ebx edi) +(mov (& eax) edi) +(mov bl cl) +(mov bl (& edx)) +(mov bx dx) +(mov bx (& esi)) +(mov ebx edi) +(mov ebx (& eax)) +(mov bl 9) +(mov bx 9) +(mov ebx 9) +(mov (& edx) (byte 9)) +(mov (& esi) (word 9)) +(mov (& eax) (dword 9)) +(mov al (& 9)) +(mov ax (& 9)) +(mov eax (& 9)) +(mov (& 9) al) +(mov (& 9) ax) +(mov (& 9) eax) +(mov bx ds) +(mov (& esi) ss) +(mov ebx fs) +(mov (& eax) es) +(mov gs dx) +(mov ds (& esi)) +(mov fs edi) +(mov ss (& eax)) +(mov ecx cr2) +(mov ecx dr1) +(mov cr0 edx) +(mov dr0 edx) +) diff --git a/test-suite/standalone/sassy/tests/misc216 b/test-suite/standalone/sassy/tests/misc216 Binary files differnew file mode 100644 index 000000000..0b481be55 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc216 diff --git a/test-suite/standalone/sassy/tests/misc216.asm b/test-suite/standalone/sassy/tests/misc216.asm new file mode 100644 index 000000000..270bc34c1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc216.asm @@ -0,0 +1,111 @@ +BITS 16 +section .text +foo: +in al, 9 +in ax, 9 +in eax, 9 +in al, dx +in ax, dx +in eax, dx +out 9, al +out 9, ax +out 9, eax +out dx, al +out dx, ax +out dx, eax +int 128 +pop cx +pop ecx +pop dword [ecx] +pop word [ecx] +pop ds +pop es +pop ss +pop fs +pop gs +push cx +push edx +push dword 100 +push word 100 +push byte 100 +push word [esi] +push dword [esi] +push cs +push ds +push es +push ss +push fs +push gs +imul ax, bx, word 100 +imul ax, [ebx], word 100 +imul ax, bx, byte 100 +imul ax, [ebx], byte 100 +imul eax, ebx, dword 100 +imul eax, [ebx], dword 100 +imul eax, ebx, byte 100 +imul eax, [ebx], byte 100 +imul eax, dword 100 +imul eax, byte 100 +imul ax, word 100 +imul ax, byte 100 +imul ax, bx +imul ax, [ebx] +imul eax, ebx +imul eax, [ebx] +imul al +imul byte [eax] +imul ax +imul word [eax] +imul eax +imul dword [eax] +test al, 9 +test ax, 9 +test eax, 9 +test bl, cl +test [ebx], cl +test bx, cx +test [ebx], cx +test ebx, ecx +test [ebx], ecx +test bl, 9 +test dword [ebx], 9 +test bx, 9 +test word [ebx], 9 +test ebx, 9 +test byte [ebx], 9 +mov bl, cl +mov [edx], cl +mov bx, dx +mov [esi], dx +mov ebx, edi +mov [eax], edi +mov bl, cl +mov bl, [edx] +mov bx, dx +mov bx, [esi] +mov ebx, edi +mov ebx, [eax] +mov bl, 9 +mov bx, 9 +mov ebx, 9 +mov [edx], byte 9 +mov [esi], word 9 +mov [eax], dword 9 +mov al, [dword 9] +mov ax, [dword 9] +mov eax, [dword 9] +mov [dword 9], al +mov [dword 9], ax +mov [dword 9], eax +mov bx, ds +mov [esi], ss +mov ebx, fs +mov [eax], es +mov gs, dx +mov ds, [esi] +mov fs, edi +mov ss, [eax] +mov ecx, cr2 +mov ecx, dr1 +mov cr0, edx +mov dr0, edx diff --git a/test-suite/standalone/sassy/tests/misc3 b/test-suite/standalone/sassy/tests/misc3 Binary files differnew file mode 100644 index 000000000..fd2a874fd --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc3 diff --git a/test-suite/standalone/sassy/tests/misc3.asm b/test-suite/standalone/sassy/tests/misc3.asm new file mode 100644 index 000000000..8653ceaa8 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc3.asm @@ -0,0 +1,14 @@ +BITS 32 +section .text +foo: +arpl cx, bx +arpl [ecx], bx +rsm +lldt sp +sldt [esp] +ltr sp +str [esp] +verr sp +verw [esp] +lar ebx, eax +lsl ebx, [eax] diff --git a/test-suite/standalone/sassy/tests/misc3.scm b/test-suite/standalone/sassy/tests/misc3.scm new file mode 100644 index 000000000..82b135954 --- /dev/null +++ b/test-suite/standalone/sassy/tests/misc3.scm @@ -0,0 +1,14 @@ +( +(arpl cx bx) +(arpl (& ecx) bx) +(rsm) +(lldt sp) +(sldt (& esp)) +(ltr sp) +(str (& esp)) +(verr sp) +(verw (& esp)) +(lar ebx eax) +(lsl ebx (& eax)) +) + diff --git a/test-suite/standalone/sassy/tests/mmx b/test-suite/standalone/sassy/tests/mmx new file mode 100644 index 000000000..fa1c7adbb --- /dev/null +++ b/test-suite/standalone/sassy/tests/mmx @@ -0,0 +1,13 @@ +wnหn +~ห~ +fnรfnf~รf~oศo +oม +๓~ม๓~๓~ศfึม฿ +f๋ำf๏!cมk +fgำfh!iมj +fำf!ม์ +fํำf!ม๘ +f๙ำf๚!่ม้ +fุำfู!ีมๅ +f๕ำft!uมv +fdำfe!fม`ำa#fb๎f`:ัา*fำf๑*r๔dfs๔dแโ*
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/mmx.asm b/test-suite/standalone/sassy/tests/mmx.asm new file mode 100644 index 000000000..61e854c46 --- /dev/null +++ b/test-suite/standalone/sassy/tests/mmx.asm @@ -0,0 +1,65 @@ +BITS 32 +section .text +foo: +emms +movd mm1, ebx +movd mm1, [edx] +movd ebx, mm1 +movd [edx], mm1 +movd xmm0, ebx +movd xmm0, [edx] +movd ebx, xmm0 +movd [edx], xmm0 +movq mm1, mm0 +movq mm1, [edx] +movq mm0, mm1 +movq [edx], mm1 +movq xmm0, xmm1 +movq xmm0, [edx] +movq xmm1, xmm0 +movq [edx], xmm0 +pand mm0, mm1 +pandn mm1, [edx] +por xmm2, xmm3 +pxor xmm4, [ecx] +packsswb mm0, mm1 +packssdw mm1, [edx] +packuswb xmm2, xmm3 +punpckhbw xmm4, [ecx] +punpckhwd mm0, mm1 +punpckhdq mm1, [edx] +paddb xmm2, xmm3 +paddw xmm4, [ecx] +paddd mm0, mm1 +paddsb mm1, [edx] +paddsw xmm2, xmm3 +paddusb xmm4, [ecx] +paddusw mm0, mm1 +psubb mm1, [edx] +psubw xmm2, xmm3 +psubd xmm4, [ecx] +psubsb mm0, mm1 +psubsw mm1, [edx] +psubusb xmm2, xmm3 +psubusw xmm4, [ecx] +pmullw mm0, mm1 +pmulhw mm1, [edx] +pmaddwd xmm2, xmm3 +pcmpeqb xmm4, [ecx] +pcmpeqw mm0, mm1 +pcmpeqd mm1, [edx] +pcmpgtb xmm2, xmm3 +pcmpgtw xmm4, [ecx] +pcmpgtd mm0, mm1 +punpcklbw mm2, mm3 +punpcklwd mm4, [ebx] +punpckldq xmm5, xmm6 +punpcklbw xmm7, [edx] +psrlw mm7, mm6 +psrld mm5, [edx] +psrlq xmm7, xmm6 +psllw xmm5, [edx] +pslld mm4, 100 +psllq xmm4, 100 +psraw mm7, mm6 +psrad mm5, [edx] diff --git a/test-suite/standalone/sassy/tests/mmx.scm b/test-suite/standalone/sassy/tests/mmx.scm new file mode 100644 index 000000000..db7dfb328 --- /dev/null +++ b/test-suite/standalone/sassy/tests/mmx.scm @@ -0,0 +1,64 @@ +( +(emms) +(movd mm1 ebx) +(movd mm1 (& edx)) +(movd ebx mm1) +(movd (& edx) mm1) +(movd xmm0 ebx) +(movd xmm0 (& edx)) +(movd ebx xmm0) +(movd (& edx) xmm0) +(movq mm1 mm0) +(movq mm1 (& edx)) +(movq mm0 mm1) +(movq (& edx) mm1) +(movq xmm0 xmm1) +(movq xmm0 (& edx)) +(movq xmm1 xmm0) +(movq (& edx) xmm0) +(pand mm0 mm1) +(pandn mm1 (& edx)) +(por xmm2 xmm3) +(pxor xmm4 (& ecx)) +(packsswb mm0 mm1) +(packssdw mm1 (& edx)) +(packuswb xmm2 xmm3) +(punpckhbw xmm4 (& ecx)) +(punpckhwd mm0 mm1) +(punpckhdq mm1 (& edx)) +(paddb xmm2 xmm3) +(paddw xmm4 (& ecx)) +(paddd mm0 mm1) +(paddsb mm1 (& edx)) +(paddsw xmm2 xmm3) +(paddusb xmm4 (& ecx)) +(paddusw mm0 mm1) +(psubb mm1 (& edx)) +(psubw xmm2 xmm3) +(psubd xmm4 (& ecx)) +(psubsb mm0 mm1) +(psubsw mm1 (& edx)) +(psubusb xmm2 xmm3) +(psubusw xmm4 (& ecx)) +(pmullw mm0 mm1) +(pmulhw mm1 (& edx)) +(pmaddwd xmm2 xmm3) +(pcmpeqb xmm4 (& ecx)) +(pcmpeqw mm0 mm1) +(pcmpeqd mm1 (& edx)) +(pcmpgtb xmm2 xmm3) +(pcmpgtw xmm4 (& ecx)) +(pcmpgtd mm0 mm1) +(punpcklbw mm2 mm3) +(punpcklwd mm4 (& ebx)) +(punpckldq xmm5 xmm6) +(punpcklbw xmm7 (& edx)) +(psrlw mm7 mm6) +(psrld mm5 (& edx)) +(psrlq xmm7 xmm6) +(psllw xmm5 (& edx)) +(pslld mm4 100) +(psllq xmm4 100) +(psraw mm7 mm6) +(psrad mm5 (& edx)) +) diff --git a/test-suite/standalone/sassy/tests/movx b/test-suite/standalone/sassy/tests/movx new file mode 100644 index 000000000..0713452b0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/movx @@ -0,0 +1 @@ +ฟ่ท/พ่ถ/fพ์fถ/
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/movx.asm b/test-suite/standalone/sassy/tests/movx.asm new file mode 100644 index 000000000..e02f42fb3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/movx.asm @@ -0,0 +1,9 @@ +BITS 32 +section .text +foo: +movsx ebp, ax +movzx ebp, word [edi] +movsx ebp, al +movzx ebp, byte [edi] +movsx bp, ah +movzx bp, [edi] diff --git a/test-suite/standalone/sassy/tests/movx.scm b/test-suite/standalone/sassy/tests/movx.scm new file mode 100644 index 000000000..263dac2b4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/movx.scm @@ -0,0 +1,8 @@ +( +(movsx ebp ax) +(movzx ebp (word (& edi))) +(movsx ebp al) +(movzx ebp (byte (& edi))) +(movsx bp ah) +(movzx bp (& edi)) +) diff --git a/test-suite/standalone/sassy/tests/movx16 b/test-suite/standalone/sassy/tests/movx16 new file mode 100644 index 000000000..c7e60b667 --- /dev/null +++ b/test-suite/standalone/sassy/tests/movx16 @@ -0,0 +1 @@ +fฟ่fgท/fพ่fgถ/พ์gถ/
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/movx16.asm b/test-suite/standalone/sassy/tests/movx16.asm new file mode 100644 index 000000000..51645b870 --- /dev/null +++ b/test-suite/standalone/sassy/tests/movx16.asm @@ -0,0 +1,9 @@ +BITS 16 +section .text +foo: +movsx ebp, ax +movzx ebp, word [edi] +movsx ebp, al +movzx ebp, byte [edi] +movsx bp, ah +movzx bp, [edi] diff --git a/test-suite/standalone/sassy/tests/non b/test-suite/standalone/sassy/tests/non new file mode 100644 index 000000000..d1fb96f52 --- /dev/null +++ b/test-suite/standalone/sassy/tests/non @@ -0,0 +1 @@ +7?f๘๚๕ฆfงงขf'/๔lfmmฬฮฯfฯฯษฌfญญคfฅฅnfooafaaf`f``f231ฎfฏฏ๙๛ชfซซ 0ืื45
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/non.asm b/test-suite/standalone/sassy/tests/non.asm new file mode 100644 index 000000000..d81de30b6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/non.asm @@ -0,0 +1,74 @@ +BITS 32 +section .text +foo: +aaa +aas +cbw +cdq +clc +cld +cli +clts +cmc +cmpsb +cmpsw +cmpsd +cpuid +cwde +cwd +daa +das +hlt +insb +insw +insd +int3 +into +invd +iret +iretw +iretd +lahf +leave +lodsb +lodsw +lodsd +movsb +movsw +movsd +nop +outsb +outsw +outsd +popa +popaw +popad +popf +popfw +popfd +pusha +pushaw +pushad +pushf +pushfw +pushfd +rdmsr +rdpmc +rdtsc +sahf +scasb +scasw +scasd +stc +std +sti +stosb +stosw +stosd +ud2 +wbinvd +wrmsr +xlat +xlatb +sysenter +sysexit diff --git a/test-suite/standalone/sassy/tests/non.scm b/test-suite/standalone/sassy/tests/non.scm new file mode 100644 index 000000000..59722f3ef --- /dev/null +++ b/test-suite/standalone/sassy/tests/non.scm @@ -0,0 +1,73 @@ +( +(aaa) +(aas) +(cbw) +(cdq) +(clc) +(cld) +(cli) +(clts) +(cmc) +(cmpsb) +(cmpsw) +(cmpsd) +(cpuid) +(cwde) +(cwd) +(daa) +(das) +(hlt) +(insb) +(insw) +(insd) +(int3) +(into) +(invd) +(iret) +(iretw) +(iretd) +(lahf) +(leave) +(lodsb) +(lodsw) +(lodsd) +(movsb) +(movsw) +(movsd) +(nop) +(outsb) +(outsw) +(outsd) +(popa) +(popaw) +(popad) +(popf) +(popfw) +(popfd) +(pusha) +(pushaw) +(pushad) +(pushf) +(pushfw) +(pushfd) +(rdmsr) +(rdpmc) +(rdtsc) +(sahf) +(scasb) +(scasw) +(scasd) +(stc) +(std) +(sti) +(stosb) +(stosw) +(stosd) +(ud2) +(wbinvd) +(wrmsr) +(xlat) +(xlatb) +(sysenter) +(sysexit) +)
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/non16 b/test-suite/standalone/sassy/tests/non16 new file mode 100644 index 000000000..e62b8c1ff --- /dev/null +++ b/test-suite/standalone/sassy/tests/non16 @@ -0,0 +1 @@ +7?f๘๚๕ฆงfงขf'/๔lmfmฬฮฯฯfฯษฌญfญคฅfฅnofoaafaf``f`f231ฎฏfฏ๙๛ชซfซ 0ืื45
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/non16.asm b/test-suite/standalone/sassy/tests/non16.asm new file mode 100644 index 000000000..3b470640b --- /dev/null +++ b/test-suite/standalone/sassy/tests/non16.asm @@ -0,0 +1,74 @@ +BITS 16 +section .text +foo: +aaa +aas +cbw +cdq +clc +cld +cli +clts +cmc +cmpsb +cmpsw +cmpsd +cpuid +cwde +cwd +daa +das +hlt +insb +insw +insd +int3 +into +invd +iret +iretw +iretd +lahf +leave +lodsb +lodsw +lodsd +movsb +movsw +movsd +nop +outsb +outsw +outsd +popa +popaw +popad +popf +popfw +popfd +pusha +pushaw +pushad +pushf +pushfw +pushfd +rdmsr +rdpmc +rdtsc +sahf +scasb +scasw +scasd +stc +std +sti +stosb +stosw +stosd +ud2 +wbinvd +wrmsr +xlat +xlatb +sysenter +sysexit diff --git a/test-suite/standalone/sassy/tests/plier b/test-suite/standalone/sassy/tests/plier new file mode 100644 index 000000000..33c6942e1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/plier @@ -0,0 +1 @@ +๗3f๗;๖#๖๐f๗๘๗โ๗฿๗ื๗f๗
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/plier.asm b/test-suite/standalone/sassy/tests/plier.asm new file mode 100644 index 000000000..33ce1e9d5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/plier.asm @@ -0,0 +1,13 @@ +BITS 32 +section .text +foo: +div dword [ebx] +idiv word [ebx] +mul byte [ebx] +div al +idiv ax +mul edx +neg edi +not edi +neg dword [ecx] +not word [eax] diff --git a/test-suite/standalone/sassy/tests/plier.scm b/test-suite/standalone/sassy/tests/plier.scm new file mode 100644 index 000000000..1ebe8259b --- /dev/null +++ b/test-suite/standalone/sassy/tests/plier.scm @@ -0,0 +1,12 @@ +( +(div (dword (& ebx))) +(idiv (word (& ebx))) +(mul (byte (& ebx))) +(div al) +(idiv ax) +(mul edx) +(neg edi) +(not edi) +(neg (dword (& ecx))) +(not (word (& eax))) +) diff --git a/test-suite/standalone/sassy/tests/plier16 b/test-suite/standalone/sassy/tests/plier16 new file mode 100644 index 000000000..475902ae7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/plier16 @@ -0,0 +1 @@ +fg๗3g๗;g๖#๖๐๗๘f๗โf๗฿f๗ืfg๗g๗
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/plier16.asm b/test-suite/standalone/sassy/tests/plier16.asm new file mode 100644 index 000000000..b0601ab3f --- /dev/null +++ b/test-suite/standalone/sassy/tests/plier16.asm @@ -0,0 +1,13 @@ +BITS 16 +section .text +foo: +div dword [ebx] +idiv word [ebx] +mul byte [ebx] +div al +idiv ax +mul edx +neg edi +not edi +neg dword [ecx] +not word [eax] diff --git a/test-suite/standalone/sassy/tests/prefix b/test-suite/standalone/sassy/tests/prefix Binary files differnew file mode 100644 index 000000000..ba3c43154 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prefix diff --git a/test-suite/standalone/sassy/tests/prefix.asm b/test-suite/standalone/sassy/tests/prefix.asm new file mode 100644 index 000000000..731bcad82 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prefix.asm @@ -0,0 +1,27 @@ +BITS 32 +section .text +foo: +rep +insd +rep +outsw +rep +lodsb +rep +stosd +rep +movsb +repe +cmpsb +repz +cmpsd +repne +scasd +repnz +scasb +lock +add byte [eax], 1 +lock +dec dword [edx] +lock +xor [ecx], ecx diff --git a/test-suite/standalone/sassy/tests/prefix.scm b/test-suite/standalone/sassy/tests/prefix.scm new file mode 100644 index 000000000..2bfe6c014 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prefix.scm @@ -0,0 +1,14 @@ +(
+(rep (insd))
+(rep (outsw))
+(rep (lodsb))
+(rep (stosd))
+(rep (movsb))
+(repe (cmpsb))
+(repz (cmpsd))
+(repne (scasd))
+(repnz (scasb))
+(lock (add (byte (& eax)) 1))
+(lock (dec (dword (& edx))))
+(lock (xor (& ecx) ecx))
+)
diff --git a/test-suite/standalone/sassy/tests/prefix16 b/test-suite/standalone/sassy/tests/prefix16 Binary files differnew file mode 100644 index 000000000..2b87a3a78 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prefix16 diff --git a/test-suite/standalone/sassy/tests/prefix16.asm b/test-suite/standalone/sassy/tests/prefix16.asm new file mode 100644 index 000000000..e142fe0b7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prefix16.asm @@ -0,0 +1,27 @@ +BITS 16 +section .text +foo: +rep +insd +rep +outsw +rep +lodsb +rep +stosd +rep +movsb +repe +cmpsb +repz +cmpsd +repne +scasd +repnz +scasb +lock +add byte [eax], 1 +lock +dec dword [edx] +lock +xor [ecx], ecx diff --git a/test-suite/standalone/sassy/tests/prims/alt1 b/test-suite/standalone/sassy/tests/prims/alt1 new file mode 100644 index 000000000..fe93a43c6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt1 @@ -0,0 +1 @@ +๋ ๋๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/alt1.scm b/test-suite/standalone/sassy/tests/prims/alt1.scm new file mode 100644 index 000000000..c9dc3d4f6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt1.scm @@ -0,0 +1,18 @@ +(text + (seq (nop) + (alt (nop) + (nop) + (nop) + (inv (nop))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB09 jmp short 0xd +; 00000004 90 nop +; 00000005 EB06 jmp short 0xd +; 00000007 90 nop +; 00000008 EB03 jmp short 0xd +; 0000000A 90 nop +; 0000000B EB01 jmp short 0xe +; 0000000D 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/alt2 b/test-suite/standalone/sassy/tests/prims/alt2 new file mode 100644 index 000000000..1f00723a2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt2 @@ -0,0 +1 @@ +๋}๋}
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/alt2.scm b/test-suite/standalone/sassy/tests/prims/alt2.scm new file mode 100644 index 000000000..d0ce9420a --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt2.scm @@ -0,0 +1,16 @@ +(text + (seq (nop) + (alt (nop) + ge! + (nop) + (inv ge!)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB07 jmp short 0xb +; 00000004 7D05 jnl 0xb +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 7D01 jnl 0xc +; 0000000B 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/alt3 b/test-suite/standalone/sassy/tests/prims/alt3 Binary files differnew file mode 100644 index 000000000..886733710 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt3 diff --git a/test-suite/standalone/sassy/tests/prims/alt3.scm b/test-suite/standalone/sassy/tests/prims/alt3.scm new file mode 100644 index 000000000..13af1975b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt3.scm @@ -0,0 +1,15 @@ +(text + (seq (if (= ecx 0) + (alt z! z!) + (nop)) + (nop))) + +; 00000000 83F900 cmp cx,byte +0x0 +; 00000003 7506 jnz 0xb +; 00000005 7405 jz 0xc +; 00000007 7403 jz 0xc +; 00000009 EB02 jmp short 0xd +; 0000000B 90 nop +; 0000000C 90 nop + + diff --git a/test-suite/standalone/sassy/tests/prims/alt4 b/test-suite/standalone/sassy/tests/prims/alt4 new file mode 100644 index 000000000..a6cf68c85 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt4 @@ -0,0 +1 @@ +๋}๋|
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/alt4.scm b/test-suite/standalone/sassy/tests/prims/alt4.scm new file mode 100644 index 000000000..78a795229 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/alt4.scm @@ -0,0 +1,16 @@ +(text + (seq (nop) + (alt (nop) + ge! + (nop) + ge!) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB07 jmp short 0xb +; 00000004 7D05 jnl 0xb +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 7C01 jl 0xc +; 0000000B 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/begin1 b/test-suite/standalone/sassy/tests/prims/begin1 new file mode 100644 index 000000000..f0140b145 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin1 @@ -0,0 +1 @@ +๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/begin1.scm b/test-suite/standalone/sassy/tests/prims/begin1.scm new file mode 100644 index 000000000..9d1a62b05 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin1.scm @@ -0,0 +1,15 @@ +(text + (begin (nop) + (seq (nop) + (begin (nop) + (inv (nop))) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 EB01 jmp short 0x7 +; 00000006 90 nop +; 00000007 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/begin2 b/test-suite/standalone/sassy/tests/prims/begin2 new file mode 100644 index 000000000..6076321e1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin2 @@ -0,0 +1 @@ +u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/begin2.scm b/test-suite/standalone/sassy/tests/prims/begin2.scm new file mode 100644 index 000000000..5e4889592 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin2.scm @@ -0,0 +1,14 @@ +(text + (begin (nop) + (seq (nop) + (begin (nop) + z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 7501 jnz 0x6 +; 00000005 90 nop +; 00000006 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/begin3 b/test-suite/standalone/sassy/tests/prims/begin3 new file mode 100644 index 000000000..c4d342828 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin3 @@ -0,0 +1 @@ +๋t
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/begin3.scm b/test-suite/standalone/sassy/tests/prims/begin3.scm new file mode 100644 index 000000000..9a8353a87 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin3.scm @@ -0,0 +1,15 @@ +(text + (begin (nop) + (alt (nop) + (begin (nop) + z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7401 jz 0x8 +; 00000007 90 nop +; 00000008 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/begin4 b/test-suite/standalone/sassy/tests/prims/begin4 new file mode 100644 index 000000000..76ad18872 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin4 @@ -0,0 +1 @@ +๋u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/begin4.scm b/test-suite/standalone/sassy/tests/prims/begin4.scm new file mode 100644 index 000000000..a8b4ab3c9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin4.scm @@ -0,0 +1,16 @@ +(text + (begin (nop) + (alt (nop) + (begin (nop) + (inv z!)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7501 jnz 0x8 +; 00000007 90 nop +; 00000008 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/begin5 b/test-suite/standalone/sassy/tests/prims/begin5 new file mode 100644 index 000000000..4a8138156 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin5 @@ -0,0 +1 @@ +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/begin5.scm b/test-suite/standalone/sassy/tests/prims/begin5.scm new file mode 100644 index 000000000..72a8c0922 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/begin5.scm @@ -0,0 +1,18 @@ +(text + (begin (nop) + (inv (alt z! + l! + a!)) + (nop))) + +;The arguments to a begin always take as their win and lose the +;following arg in the sequence, except for the last, which takes +;begin's win and lose. Since the assertions only generate jcc's, they +;would all be jcc's to the last (nop). But it happens that the last +;(nop) is the instruction following the a! assertion. But a jmp to the +;next instruction is really doing nothing at all, so it may be +;eliminated. But then the l! assertion is in the same circumstance, +;and so on. Hence: + +; 00000000 90 nop +; 00000001 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/esc1 b/test-suite/standalone/sassy/tests/prims/esc1 Binary files differnew file mode 100644 index 000000000..7cbd24df0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc1 diff --git a/test-suite/standalone/sassy/tests/prims/esc1.scm b/test-suite/standalone/sassy/tests/prims/esc1.scm new file mode 100644 index 000000000..8a02d9c76 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc1.scm @@ -0,0 +1,32 @@ +(text + (label foo (ret)) + (label bar (ret)) + (begin + (esc ((push $win)) + (alt + (with-win foo + (seq (= eax 3) + (= ebx 2) + (push eax) + (push ebx))) + (with-win bar + (seq (push ebx) + (push eax))))) + (nop) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 681F000000 push dword 0x1f +; 00000007 83F803 cmp eax,byte +0x3 +; 0000000A 750C jnz 0x18 +; 0000000C 83FB02 cmp ebx,byte +0x2 +; 0000000F 7507 jnz 0x18 +; 00000011 50 push eax +; 00000012 53 push ebx +; 00000013 E9E8FFFFFF jmp 0x0 +; 00000018 53 push ebx +; 00000019 50 push eax +; 0000001A E9E2FFFFFF jmp 0x1 +; 0000001F 90 nop +; 00000020 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/esc2 b/test-suite/standalone/sassy/tests/prims/esc2 Binary files differnew file mode 100644 index 000000000..43bef5952 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc2 diff --git a/test-suite/standalone/sassy/tests/prims/esc2.scm b/test-suite/standalone/sassy/tests/prims/esc2.scm new file mode 100644 index 000000000..07179ec21 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc2.scm @@ -0,0 +1,36 @@ +(text + (label foo (ret)) + (label bar (ret)) + (seq (nop) + (esc ((push $win) + (mov edx $lose)) + (alt + (with-win foo + (seq (= eax 3) + (= ebx 2) + (push eax) + (push ebx))) + (with-win bar + (seq (mov esp edx) + (push ebx) + (push eax))))) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 90 nop +; 00000003 6827000000 push dword 0x27 +; 00000008 BA28000000 mov edx,0x28 +; 0000000D 83F803 cmp eax,byte +0x3 +; 00000010 750C jnz 0x1e +; 00000012 83FB02 cmp ebx,byte +0x2 +; 00000015 7507 jnz 0x1e +; 00000017 50 push eax +; 00000018 53 push ebx +; 00000019 E9E2FFFFFF jmp 0x0 +; 0000001E 89D4 mov esp,edx +; 00000020 53 push ebx +; 00000021 50 push eax +; 00000022 E9DAFFFFFF jmp 0x1 +; 00000027 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/esc3 b/test-suite/standalone/sassy/tests/prims/esc3 Binary files differnew file mode 100644 index 000000000..bbfb274a5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc3 diff --git a/test-suite/standalone/sassy/tests/prims/esc3.scm b/test-suite/standalone/sassy/tests/prims/esc3.scm new file mode 100644 index 000000000..d77ea46bc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc3.scm @@ -0,0 +1,16 @@ +(text + (begin (push $eip) + (push $win) + (push $lose)) + (seq (push $eip) + (push $win) + (push $lose) + (nop))) + +; 00000000 6805000000 push dword 0x5 +; 00000005 680A000000 push dword 0xa +; 0000000A 680F000000 push dword 0xf +; 0000000F 6814000000 push dword 0x14 +; 00000014 6819000000 push dword 0x19 +; 00000019 681F000000 push dword 0x1f +; 0000001E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/esc4 b/test-suite/standalone/sassy/tests/prims/esc4 Binary files differnew file mode 100644 index 000000000..6a6d22348 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc4 diff --git a/test-suite/standalone/sassy/tests/prims/esc4.scm b/test-suite/standalone/sassy/tests/prims/esc4.scm new file mode 100644 index 000000000..378beefd2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc4.scm @@ -0,0 +1,35 @@ +(text + (begin (call $eip) + (call $win) + (call $lose)) + (seq (jmp $eip) + (jmp $win) + (jmp $lose) + (nop)) + (seq (jmp short $eip) + (jmp short $win) + (jmp short $lose) + (nop)) + (alt (jmp $win) + (jmp $lose) + (nop) + (nop))) + +; 00000000 E800000000 call 0x5 +; 00000005 E800000000 call 0xa +; 0000000A E800000000 call 0xf +; 0000000F E900000000 jmp 0x14 +; 00000014 E900000000 jmp 0x19 +; 00000019 E901000000 jmp 0x1f +; 0000001E 90 nop +; 0000001F EB00 jmp short 0x21 +; 00000021 EB00 jmp short 0x23 +; 00000023 EB01 jmp short 0x26 +; 00000025 90 nop +; 00000026 E90D000000 jmp 0x38 +; 0000002B EB0B jmp short 0x38 +; 0000002D E902000000 jmp 0x34 +; 00000032 EB04 jmp short 0x38 +; 00000034 90 nop +; 00000035 EB01 jmp short 0x38 +; 00000037 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/esc5 b/test-suite/standalone/sassy/tests/prims/esc5 Binary files differnew file mode 100644 index 000000000..1f5ebdfc5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc5 diff --git a/test-suite/standalone/sassy/tests/prims/esc5.scm b/test-suite/standalone/sassy/tests/prims/esc5.scm new file mode 100644 index 000000000..2f2946635 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc5.scm @@ -0,0 +1,35 @@ +(text + (label foo (ret)) + (label bar (ret)) + (seq (nop) + (esc ((jmp $win) + (jmp $lose)) + (alt + (with-win foo + (seq (= eax 3) + (= ebx 2) + (push eax) + (push ebx))) + (with-win bar + (seq (mov esp edx) + (push ebx) + (push eax))))) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 90 nop +; 00000003 E91F000000 jmp 0x27 +; 00000008 E91B000000 jmp 0x28 +; 0000000D 83F803 cmp eax,byte +0x3 +; 00000010 750C jnz 0x1e +; 00000012 83FB02 cmp ebx,byte +0x2 +; 00000015 7507 jnz 0x1e +; 00000017 50 push eax +; 00000018 53 push ebx +; 00000019 E9E2FFFFFF jmp 0x0 +; 0000001E 89D4 mov esp,edx +; 00000020 53 push ebx +; 00000021 50 push eax +; 00000022 E9DAFFFFFF jmp 0x1 +; 00000027 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/esc6 b/test-suite/standalone/sassy/tests/prims/esc6 Binary files differnew file mode 100644 index 000000000..495ad8116 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc6 diff --git a/test-suite/standalone/sassy/tests/prims/esc6.scm b/test-suite/standalone/sassy/tests/prims/esc6.scm new file mode 100644 index 000000000..b94e6f9dd --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc6.scm @@ -0,0 +1,14 @@ +(text + (iter (seq (nop) + (nop) + (jnz $lose) + (nop) + (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 0F8504000000 jnz near 0xc +; 00000008 90 nop +; 00000009 90 nop +; 0000000A EBF4 jmp short 0x0 +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/esc7 b/test-suite/standalone/sassy/tests/prims/esc7 new file mode 100644 index 000000000..86ff7bc5e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc7 @@ -0,0 +1 @@ +ut๘๋๖
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/esc7.scm b/test-suite/standalone/sassy/tests/prims/esc7.scm new file mode 100644 index 000000000..d23f7f523 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/esc7.scm @@ -0,0 +1,16 @@ +(text + (iter (seq (nop) + (nop) + (jnz short $lose) + (nop) + (nop) + (je short $win)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7506 jnz 0xa +; 00000004 90 nop +; 00000005 90 nop +; 00000006 74F8 jz 0x0 +; 00000008 EBF6 jmp short 0x0 +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/exp-k1 b/test-suite/standalone/sassy/tests/prims/exp-k1 new file mode 100644 index 000000000..cd617b311 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k1 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/exp-k1.scm b/test-suite/standalone/sassy/tests/prims/exp-k1.scm new file mode 100644 index 000000000..902a09065 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k1.scm @@ -0,0 +1,25 @@ +(macro seq-k (lambda tests + (cond ((null? tests) '$win) + ((null? (cdr tests)) (car tests)) + (else `(with-win (seq-k ,@(cdr tests)) + ,(car tests)))))) +(text + (begin (nop) + (nop) + (seq-k (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7504 jnz 0xa +; 00000006 90 nop +; 00000007 7401 jz 0xa +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/exp-k2 b/test-suite/standalone/sassy/tests/prims/exp-k2 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k2 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/exp-k2.scm b/test-suite/standalone/sassy/tests/prims/exp-k2.scm new file mode 100644 index 000000000..65bc20a67 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k2.scm @@ -0,0 +1,25 @@ +(macro inv-k (lambda (itm) + `(with-win-lose $lose $win + ,itm))) + +(text + (alt (if (seq (inv-k (nop)) + (inv-k z!) + (inv-k (inv (nop))) + (inv-k ge!)) + (inv-k (nop)) + (nop)) + (nop))) + +; should be the same as inv4.scm (de Morgan) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/exp-k3 b/test-suite/standalone/sassy/tests/prims/exp-k3 new file mode 100644 index 000000000..76ad18872 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k3 @@ -0,0 +1 @@ +๋u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/exp-k3.scm b/test-suite/standalone/sassy/tests/prims/exp-k3.scm new file mode 100644 index 000000000..bd4ce3628 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k3.scm @@ -0,0 +1,24 @@ +(macro begin-k (lambda body-tail + (if (null? (cdr body-tail)) + (car body-tail) + `(with-win (begin-k ,@(cdr body-tail)) + (with-lose $win + ,(car body-tail)))))) + + +(text + (begin-k (nop) + (alt (nop) + (begin-k (nop) + (inv z!)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7501 jnz 0x8 +; 00000007 90 nop +; 00000008 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/exp-k4 b/test-suite/standalone/sassy/tests/prims/exp-k4 new file mode 100644 index 000000000..9e722fd9b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k4 @@ -0,0 +1 @@ +u๋ ~๋{๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/exp-k4.scm b/test-suite/standalone/sassy/tests/prims/exp-k4.scm new file mode 100644 index 000000000..02fe7add2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/exp-k4.scm @@ -0,0 +1,29 @@ +(macro if-k (lambda (test conseq altern) + `(with-win-lose ,conseq ,altern + ,test))) + +(text + (seq (nop) + (if-k (seq (nop) z!) + (inv (nop)) + (if-k g! + (nop) + (if-k p! + (nop) + (nop)))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0C jmp short 0x13 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB06 jmp short 0x12 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB01 jmp short 0x12 +; 00000011 90 nop +; 00000012 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/if1 b/test-suite/standalone/sassy/tests/prims/if1 new file mode 100644 index 000000000..7ecc60012 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if1 @@ -0,0 +1 @@ +tv๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/if1.scm b/test-suite/standalone/sassy/tests/prims/if1.scm new file mode 100644 index 000000000..20941e001 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if1.scm @@ -0,0 +1,16 @@ +(text + (seq (nop) + (if (alt z! a!) + (nop) + (inv (nop))) + (nop))) + +; 00000000 90 nop +; 00000001 7402 jz 0x5 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 EB03 jmp short 0xb +; 00000008 90 nop +; 00000009 EB01 jmp short 0xc +; 0000000B 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/if2 b/test-suite/standalone/sassy/tests/prims/if2 new file mode 100644 index 000000000..2d8ada333 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if2 @@ -0,0 +1 @@ +tw๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/if2.scm b/test-suite/standalone/sassy/tests/prims/if2.scm new file mode 100644 index 000000000..fa7960910 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if2.scm @@ -0,0 +1,21 @@ +(text + (seq (nop) + (if (seq (nop) + (inv (alt z! a!))) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7405 jz 0x9 +; 00000004 7703 ja 0x9 +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 90 nop +; 0000000A 90 nop + +;Causing the consequent (first) arm of the if to lose cause the whole +;if to lose, and thus the outer seq to lose. + + diff --git a/test-suite/standalone/sassy/tests/prims/if3 b/test-suite/standalone/sassy/tests/prims/if3 new file mode 100644 index 000000000..a459c239b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if3 @@ -0,0 +1 @@ +u๋~๋{๋v
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/if3.scm b/test-suite/standalone/sassy/tests/prims/if3.scm new file mode 100644 index 000000000..2ef4af1fc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if3.scm @@ -0,0 +1,26 @@ +(text + (seq (nop) + (if (seq (nop) z!) + (inv (nop)) + (if g! + (nop) + (if p! + (nop) + (seq a! (nop))))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0E jmp short 0x15 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB08 jmp short 0x14 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB03 jmp short 0x14 +; 00000011 7602 jna 0x15 +; 00000013 90 nop +; 00000014 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/if4 b/test-suite/standalone/sassy/tests/prims/if4 new file mode 100644 index 000000000..9e722fd9b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if4 @@ -0,0 +1 @@ +u๋ ~๋{๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/if4.scm b/test-suite/standalone/sassy/tests/prims/if4.scm new file mode 100644 index 000000000..ca3aa1471 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/if4.scm @@ -0,0 +1,25 @@ +(text + (seq (nop) + (if (seq (nop) z!) + (inv (nop)) + (if g! + (nop) + (if p! + (nop) + (nop)))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0C jmp short 0x13 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB06 jmp short 0x12 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB01 jmp short 0x12 +; 00000011 90 nop +; 00000012 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims/inv1 b/test-suite/standalone/sassy/tests/prims/inv1 new file mode 100644 index 000000000..015f131dc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv1 @@ -0,0 +1 @@ +u}w
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv1.scm b/test-suite/standalone/sassy/tests/prims/inv1.scm new file mode 100644 index 000000000..ec790397f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv1.scm @@ -0,0 +1,20 @@ +(text + (seq (nop) + (inv (seq z! + l! + a!)) + (nop))) + +; 00000000 90 nop +; 00000001 7504 jnz 0x7 +; 00000003 7D02 jnl 0x7 +; 00000005 7701 ja 0x8 +; 00000007 90 nop + +;In order for the outer seq to win all its arguments must win. +;In order for the inv to win its argument must lose. +;The argument to inv is seq, so far a seq to lose any one of its args must lose. +;The first two args are assertions, they lose if their opposite is true, and if their opposite is true the inv wins, hence the jcc's to 0x7. +;The last arg, also an assertion, wins if it is true, but in that case the inv will lose, causing the outer seq to lose, hance the jcc to 0x8, past everything. + + diff --git a/test-suite/standalone/sassy/tests/prims/inv2 b/test-suite/standalone/sassy/tests/prims/inv2 new file mode 100644 index 000000000..783318320 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv2 @@ -0,0 +1 @@ +t|w
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv2.scm b/test-suite/standalone/sassy/tests/prims/inv2.scm new file mode 100644 index 000000000..e649cf181 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv2.scm @@ -0,0 +1,18 @@ +(text + (seq (nop) + (inv (alt z! + l! + a!)) + (nop))) + +; 00000000 90 nop +; 00000001 7405 jz 0x8 +; 00000003 7C03 jl 0x8 +; 00000005 7701 ja 0x8 +; 00000007 90 nop + +;In order for the outer seq to win its arguments must win. In order +;for the inv to win its argument must lose. It's argument is alt, and +;for an alt to lose all its arguments must lose. Therefore if any of +;its arguments win, the inv will lose as will the outer seq. Hence the +;jcc's past everything. diff --git a/test-suite/standalone/sassy/tests/prims/inv3 b/test-suite/standalone/sassy/tests/prims/inv3 new file mode 100644 index 000000000..581ae8c71 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv3 @@ -0,0 +1 @@ +u๋}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv3.scm b/test-suite/standalone/sassy/tests/prims/inv3.scm new file mode 100644 index 000000000..e60c6c9cd --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv3.scm @@ -0,0 +1,19 @@ +(text + (alt (if (inv (seq (nop) + z! + (inv (nop)) + ge!)) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/inv4 b/test-suite/standalone/sassy/tests/prims/inv4 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv4 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv4.scm b/test-suite/standalone/sassy/tests/prims/inv4.scm new file mode 100644 index 000000000..b0c4ee922 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv4.scm @@ -0,0 +1,19 @@ +(text + (alt (if (inv (alt (nop) + z! + (inv (nop)) + ge!)) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/inv5 b/test-suite/standalone/sassy/tests/prims/inv5 new file mode 100644 index 000000000..581ae8c71 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv5 @@ -0,0 +1 @@ +u๋}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv5.scm b/test-suite/standalone/sassy/tests/prims/inv5.scm new file mode 100644 index 000000000..3ead1fd44 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv5.scm @@ -0,0 +1,21 @@ +(text + (alt (if (alt (inv (nop)) + (inv z!) + (inv (inv (nop))) + (inv ge!)) + (inv (nop)) + (nop)) + (nop))) + +; should be the same as inv3.scm, (de Morgan) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/inv6 b/test-suite/standalone/sassy/tests/prims/inv6 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv6 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/inv6.scm b/test-suite/standalone/sassy/tests/prims/inv6.scm new file mode 100644 index 000000000..5868e0bf5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/inv6.scm @@ -0,0 +1,21 @@ +(text + (alt (if (seq (inv (nop)) + (inv z!) + (inv (inv (nop))) + (inv ge!)) + (inv (nop)) + (nop)) + (nop))) + +; should be the same as inv4.scm (de Morgan) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/iter1 b/test-suite/standalone/sassy/tests/prims/iter1 new file mode 100644 index 000000000..9602d9f55 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter1 @@ -0,0 +1 @@ +tv๋๘
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/iter1.scm b/test-suite/standalone/sassy/tests/prims/iter1.scm new file mode 100644 index 000000000..e884a8e6c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter1.scm @@ -0,0 +1,11 @@ +(text + (iter (seq (nop) + (alt z! a!) + (nop)))) + +; 00000000 90 nop +; 00000001 7402 jz 0x5 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 EBF8 jmp short 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims/iter2 b/test-suite/standalone/sassy/tests/prims/iter2 new file mode 100644 index 000000000..405e230ae --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter2 @@ -0,0 +1 @@ +uv}๘
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/iter2.scm b/test-suite/standalone/sassy/tests/prims/iter2.scm new file mode 100644 index 000000000..766337a8c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter2.scm @@ -0,0 +1,13 @@ +(text + (iter + (seq (nop) + (seq z! a!) + (nop) + ge!))) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 7DF8 jnl 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims/iter3 b/test-suite/standalone/sassy/tests/prims/iter3 new file mode 100644 index 000000000..d3adf99ef --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter3 @@ -0,0 +1 @@ +๋uw๙๋๖}๔
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/iter3.scm b/test-suite/standalone/sassy/tests/prims/iter3.scm new file mode 100644 index 000000000..1c1329269 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter3.scm @@ -0,0 +1,13 @@ +(text + (iter (alt (nop) + (seq z! a!) + (nop) + ge!))) + +; 00000000 90 nop +; 00000001 EBFD jmp short 0x0 +; 00000003 7502 jnz 0x7 +; 00000005 77F9 ja 0x0 +; 00000007 90 nop +; 00000008 EBF6 jmp short 0x0 +; 0000000A 7DF4 jnl 0x0 diff --git a/test-suite/standalone/sassy/tests/prims/iter4 b/test-suite/standalone/sassy/tests/prims/iter4 new file mode 100644 index 000000000..5979312ca --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter4 @@ -0,0 +1 @@ +๋u๋๙t}
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/iter4.scm b/test-suite/standalone/sassy/tests/prims/iter4.scm new file mode 100644 index 000000000..8feeb6f27 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter4.scm @@ -0,0 +1,17 @@ +(text + (iter (alt (nop) + (iter (seq (nop) + (nop) + z! + (nop))) + (iter (inv (alt z! + l!)))))) +; 00000000 90 nop +; 00000001 EBFD jmp short 0x0 +; 00000003 90 nop +; 00000004 90 nop +; 00000005 7503 jnz 0xa +; 00000007 90 nop +; 00000008 EBF9 jmp short 0x3 +; 0000000A 7402 jz 0xe +; 0000000C 7DFC jnl 0xa diff --git a/test-suite/standalone/sassy/tests/prims/iter5 b/test-suite/standalone/sassy/tests/prims/iter5 Binary files differnew file mode 100644 index 000000000..be9fb363f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter5 diff --git a/test-suite/standalone/sassy/tests/prims/iter5.scm b/test-suite/standalone/sassy/tests/prims/iter5.scm new file mode 100644 index 000000000..d35aa49b9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter5.scm @@ -0,0 +1,89 @@ +(text + (begin + (iter + (alt (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (zero? eax))) + (iter + (alt (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (zero? eax))))) + +;testing multi-pass iter for jump sizes + +; 00000000 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 0000000B EBF3 jmp short 0x0 +; 0000000D 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000018 EBE6 jmp short 0x0 +; 0000001A 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000025 EBD9 jmp short 0x0 +; 00000027 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000032 EBCC jmp short 0x0 +; 00000034 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 0000003F EBBF jmp short 0x0 +; 00000041 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 0000004C EBB2 jmp short 0x0 +; 0000004E 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000059 EBA5 jmp short 0x0 +; 0000005B 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000066 EB98 jmp short 0x0 +; 00000068 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000073 EB8B jmp short 0x0 +; 00000075 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000080 E97BFFFFFF jmp 0x0 +; 00000085 85C0 test eax,eax +; 00000087 0F8473FFFFFF jz near 0x0 +; 0000008D 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000098 EBF3 jmp short 0x8d +; 0000009A 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000A5 EBE6 jmp short 0x8d +; 000000A7 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000B2 EBD9 jmp short 0x8d +; 000000B4 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000BF EBCC jmp short 0x8d +; 000000C1 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000CC EBBF jmp short 0x8d +; 000000CE 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000D9 EBB2 jmp short 0x8d +; 000000DB 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000E6 EBA5 jmp short 0x8d +; 000000E8 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 000000F3 EB98 jmp short 0x8d +; 000000F5 818491E8030000E8 add dword [ecx+edx*4+0x3e8],0x3e8 +; -030000 +; 00000100 EB8B jmp short 0x8d +; 00000102 85C0 test eax,eax +; 00000104 7487 jz 0x8d diff --git a/test-suite/standalone/sassy/tests/prims/iter6 b/test-suite/standalone/sassy/tests/prims/iter6 new file mode 100644 index 000000000..fcbdd1a48 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter6 @@ -0,0 +1 @@ +[๛t๚[๛t๚
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/iter6.scm b/test-suite/standalone/sassy/tests/prims/iter6.scm new file mode 100644 index 000000000..4ed439a28 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/iter6.scm @@ -0,0 +1,41 @@ +(text + (iter + (begin (iter (seq (pop ebx) + (= ebx 2))) + (iter (seq (pop ebx) + (= ebx 3)))))) + +; 00000000 5B pop ebx +; 00000001 83FB02 cmp ebx,byte +0x2 +; 00000004 74FA jz 0x0 +; 00000006 5B pop ebx +; 00000007 83FB03 cmp ebx,byte +0x3 +; 0000000A 74FA jz 0x6 + +; Why it makes sense that the outer loop doesn't loop: +; Iter can never win, it can only loop forever or lose, in which case +; the loop is exited. The begin wins or loses depending on its last +; tail. In this case, the last tail can never win, since it's an iter, +; but it can lose. But if it loses, the whole begin loses, in which +; case the outer iter loses and is exited. + +; In this case, you can put '(seq) as the last item of the +; begin. Since '(seq) always wins, the begin always wins and the outer +; loop never exits, so the last jmp will be generated: + +; (text +; (iter +; (begin (iter (seq (pop ebx) +; (= ebx 2))) +; (iter (seq (pop ebx) +; (= ebx 3))) +; (seq)))) + +; 00000000 5B pop ebx +; 00000001 83FB02 cmp ebx,byte +0x2 +; 00000004 74FA jz 0x0 +; 00000006 5B pop ebx +; 00000007 83FB03 cmp ebx,byte +0x3 +; 0000000A 74FA jz 0x6 +; 0000000C EBF2 jmp short 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims/label1 b/test-suite/standalone/sassy/tests/prims/label1 new file mode 100644 index 000000000..cf0708fa6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label1 @@ -0,0 +1 @@ +u้๘
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/label1.scm b/test-suite/standalone/sassy/tests/prims/label1.scm new file mode 100644 index 000000000..fe9f5240e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label1.scm @@ -0,0 +1,13 @@ +(text + (label foo (seq (nop) + (label bar z!) + (nop))) + (jmp bar)) + +; foo +; 00000000 90 nop +; bar +; 00000001 7501 jnz 0x4 +; 00000003 90 nop +; 00000004 E9F8FFFFFF jmp 0x1 ; (jmp bar) + diff --git a/test-suite/standalone/sassy/tests/prims/label2 b/test-suite/standalone/sassy/tests/prims/label2 new file mode 100644 index 000000000..40c1cd3fe --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label2 @@ -0,0 +1 @@ +๋๛้๗
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/label2.scm b/test-suite/standalone/sassy/tests/prims/label2.scm new file mode 100644 index 000000000..1c7c21f19 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label2.scm @@ -0,0 +1,15 @@ +(text + (iter (begin + (nop) + (label foo (nop)) + (nop))) + (jmp foo)) + +; 00000000 90 nop +; foo: +; 00000001 90 nop +; 00000002 90 nop +; 00000003 EBFB jmp short 0x0 +; 00000005 E9F7FFFFFF jmp 0x1 ; jmp foo + + diff --git a/test-suite/standalone/sassy/tests/prims/label3 b/test-suite/standalone/sassy/tests/prims/label3 Binary files differnew file mode 100644 index 000000000..4cdfeb960 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label3 diff --git a/test-suite/standalone/sassy/tests/prims/label3.scm b/test-suite/standalone/sassy/tests/prims/label3.scm new file mode 100644 index 000000000..16854ae97 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label3.scm @@ -0,0 +1,25 @@ +(text + (with-win-lose foo bar + (zero? eax)) + (nop) + (nop) + (nop) + (seq (label bar + (inv (iter (seq (dec eax) + (inc ecx) + (>= eax 0))))) + (label foo (push ecx)))) + +; 00000000 85C0 test eax,eax +; 00000002 0F840F000000 jz near 0x17 +; 00000008 E903000000 jmp 0x10 +; 0000000D 90 nop +; 0000000E 90 nop +; 0000000F 90 nop +; bar: +; 00000010 48 dec eax +; 00000011 41 inc ecx +; 00000012 83F800 cmp eax,byte +0x0 +; 00000015 7DF9 jnl 0x10 +; foo: +; 00000017 51 push ecx diff --git a/test-suite/standalone/sassy/tests/prims/label4 b/test-suite/standalone/sassy/tests/prims/label4 Binary files differnew file mode 100644 index 000000000..909860bef --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label4 diff --git a/test-suite/standalone/sassy/tests/prims/label4.scm b/test-suite/standalone/sassy/tests/prims/label4.scm new file mode 100644 index 000000000..7fbb9dca5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/label4.scm @@ -0,0 +1,50 @@ +; local labels via brute force renaming + +(! (begin (define my-gensym ; assuming eval allows non-expressions (eg define) + (let ((count 1)) + (lambda () + (let ((new (string->symbol (string-append + "_label" + (number->string count))))) + (set! count (+ count 1)) + new)))) + 'void)) + +(macro my-local (lambda (name . body) + (define new-sym (my-gensym)) + ; do the substitution manually, + ; instead of relying on a macro to do it, + ; because 'direcs' is a directive + ; and we want to be able use this in a nested context + (define (deep-replace new old lst) + (cond ((pair? lst) (map (lambda (x) + (deep-replace new old x)) + lst)) + ((eqv? old lst) new) + (else lst))) + `(label ,new-sym ,@(deep-replace new-sym name body)))) + + +(text + (label foo (ret)) + + (seq (= ecx "DOIT") + (my-local foo + (pop eax) + (cmp eax 0) + (jnz foo))) + (nop) + (jmp foo)) + +; foo: +; 00000000 C3 ret +; 00000001 81F9444F4954 cmp ecx,0x54494f44 +; 00000007 750A jnz 0x13 + +; _label1: +; 00000009 58 pop eax +; 0000000A 83F800 cmp eax,byte +0x0 +; 0000000D 0F85F6FFFFFF jnz near 0x9 +; 00000013 90 nop +; 00000014 E9E7FFFFFF jmp 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark1 b/test-suite/standalone/sassy/tests/prims/leap-mark1 new file mode 100644 index 000000000..3df256f90 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark1 @@ -0,0 +1 @@ +๋YH
ภu๚
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark1.scm b/test-suite/standalone/sassy/tests/prims/leap-mark1.scm new file mode 100644 index 000000000..21e125003 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark1.scm @@ -0,0 +1,10 @@ +(text + (while (inv (zero? eax)) + (seq (pop ecx) + (dec eax)))) + +; 00000000 EB02 jmp short 0x4 +; 00000002 59 pop ecx +; 00000003 48 dec eax +; 00000004 85C0 test eax,eax +; 00000006 75FA jnz 0x2 diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark2 b/test-suite/standalone/sassy/tests/prims/leap-mark2 new file mode 100644 index 000000000..e5631d947 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark2 @@ -0,0 +1 @@ +๋๋๋t๖
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark2.scm b/test-suite/standalone/sassy/tests/prims/leap-mark2.scm new file mode 100644 index 000000000..51579c064 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark2.scm @@ -0,0 +1,19 @@ +(text + (leap (iter + (seq (nop) + (mark + (leap (seq (nop) + (mark + (leap (seq (nop) + (mark (seq (nop) z!)))))))))))) + +;confusing but correct. + +; 00000000 EB07 jmp short 0x9 +; 00000002 90 nop +; 00000003 EB04 jmp short 0x9 +; 00000005 90 nop +; 00000006 EB01 jmp short 0x9 +; 00000008 90 nop +; 00000009 90 nop +; 0000000A 74F6 jz 0x2 diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark3 b/test-suite/standalone/sassy/tests/prims/leap-mark3 Binary files differnew file mode 100644 index 000000000..ccc006daf --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark3 diff --git a/test-suite/standalone/sassy/tests/prims/leap-mark3.scm b/test-suite/standalone/sassy/tests/prims/leap-mark3.scm new file mode 100644 index 000000000..302d8c68f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/leap-mark3.scm @@ -0,0 +1,31 @@ +(text + (label foo + (leap + (iter (seq (push edx) + (if (= eax 3) + (alt (seq (pop ecx) z!) + (seq (push ebx) z! (mark (pop ebx))) + (seq (mov edx 3))) + (seq (= edx 4) (jmp foo))) + (push edx)))))) + +;hmm... + + +; 00000000 EB0C jmp short 0xe +; 00000002 52 push edx +; 00000003 83F803 cmp eax,byte +0x3 +; 00000006 7510 jnz 0x18 +; 00000008 59 pop ecx +; 00000009 7417 jz 0x22 +; 0000000B 53 push ebx +; 0000000C 7503 jnz 0x11 +; 0000000E 5B pop ebx +; 0000000F EB11 jmp short 0x22 +; 00000011 BA03000000 mov edx,0x3 +; 00000016 EB0A jmp short 0x22 +; 00000018 83FA04 cmp edx,byte +0x4 +; 0000001B 7508 jnz 0x25 +; 0000001D E9DEFFFFFF jmp 0x0 +; 00000022 52 push edx +; 00000023 EBDD jmp short 0x2 diff --git a/test-suite/standalone/sassy/tests/prims/locals1 b/test-suite/standalone/sassy/tests/prims/locals1 Binary files differnew file mode 100644 index 000000000..44dd392d8 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals1 diff --git a/test-suite/standalone/sassy/tests/prims/locals1.scm b/test-suite/standalone/sassy/tests/prims/locals1.scm new file mode 100644 index 000000000..607903a1f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals1.scm @@ -0,0 +1,17 @@ +(text + (locals (bar quux) + (nop) + (label bar + (push quux) + (nop)) + (label quux + (push bar) + (nop)))) + +; 00000000 90 nop +; 00000001 6807000000 push dword 0x7 +; 00000006 90 nop +; 00000007 6801000000 push dword 0x1 +; 0000000C 90 nop + + diff --git a/test-suite/standalone/sassy/tests/prims/locals2 b/test-suite/standalone/sassy/tests/prims/locals2 Binary files differnew file mode 100644 index 000000000..c71619d40 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals2 diff --git a/test-suite/standalone/sassy/tests/prims/locals2.scm b/test-suite/standalone/sassy/tests/prims/locals2.scm new file mode 100644 index 000000000..734d31fb1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals2.scm @@ -0,0 +1,28 @@ +(text + (nop) + (label bar + (push quux)) + (locals (bar quux) + (nop) + (label bar + (push quux) + (nop)) + (label quux + (push bar) + (nop))) + (label quux (push bar))) + +; 00000000 90 nop +; bar: +; 00000001 6813000000 push dword 0x13 ; push quux +; 00000006 90 nop +; local bar: +; 00000007 680D000000 push dword 0xd ; push local quux +; 0000000C 90 nop +; local quux: +; 0000000D 6807000000 push dword 0x7 ; push local bar +; 00000012 90 nop +; quux: +; 00000013 6801000000 push dword 0x1 ; push bar + + diff --git a/test-suite/standalone/sassy/tests/prims/locals3 b/test-suite/standalone/sassy/tests/prims/locals3 Binary files differnew file mode 100644 index 000000000..0e6e55a2f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals3 diff --git a/test-suite/standalone/sassy/tests/prims/locals3.scm b/test-suite/standalone/sassy/tests/prims/locals3.scm new file mode 100644 index 000000000..379d95417 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals3.scm @@ -0,0 +1,25 @@ +(text + (nop) + (label bar (jmp quux)) + (locals (bar quux) + (nop) + (label bar + (jmp quux) + (nop)) + (label quux + (jmp bar) + (nop))) + (label quux (jmp bar))) + +; 00000000 90 nop +; bar: +; 00000001 E90D000000 jmp 0x13 ; jmp quux +; 00000006 90 nop +; local bar: +; 00000007 E901000000 jmp 0xd ; jmp local quux +; 0000000C 90 nop +; local quux: +; 0000000D E9F5FFFFFF jmp 0x7 ; jmp local bar +; 00000012 90 nop +; quux: +; 00000013 E9E9FFFFFF jmp 0x1 ; jmp bar diff --git a/test-suite/standalone/sassy/tests/prims/locals4 b/test-suite/standalone/sassy/tests/prims/locals4 Binary files differnew file mode 100644 index 000000000..909860bef --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals4 diff --git a/test-suite/standalone/sassy/tests/prims/locals4.scm b/test-suite/standalone/sassy/tests/prims/locals4.scm new file mode 100644 index 000000000..63b4da298 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals4.scm @@ -0,0 +1,25 @@ +(text + (label foo (ret)) + + (seq (= ecx "DOIT") + (locals (foo) + (label foo + (with-win foo + (seq (pop eax) + (cmp eax 0) + nz!))))) + + (nop) + (jmp foo)) + +; foo: +; 00000000 C3 ret +; 00000001 81F9444F4954 cmp ecx,0x54494f44 +; 00000007 750A jnz 0x13 + +; local foo: +; 00000009 58 pop eax +; 0000000A 83F800 cmp eax,byte +0x0 +; 0000000D 0F85F6FFFFFF jnz near 0x9 +; 00000013 90 nop +; 00000014 E9E7FFFFFF jmp 0x0 diff --git a/test-suite/standalone/sassy/tests/prims/locals5 b/test-suite/standalone/sassy/tests/prims/locals5 Binary files differnew file mode 100644 index 000000000..8e606fafc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals5 diff --git a/test-suite/standalone/sassy/tests/prims/locals5.scm b/test-suite/standalone/sassy/tests/prims/locals5.scm new file mode 100644 index 000000000..b7e312fe9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals5.scm @@ -0,0 +1,44 @@ +(macro my-while + (lambda (test . body) + `(locals (loop) + (label loop + (with-win (jmp short loop) + (seq ,test + (begin ,@body))))))) + +(text + (label loop + + (nop) + + (my-while (< eax 10) + (pop ebx) + (add eax ebx))) + + (my-while (> ecx 1000) + (pop ebx) + (sub ecx ebx)) + + (jmp short loop)) + +; loop: +; 00000000 90 nop + +; local loop (#1): +; 00000001 83F80A cmp eax,byte +0xa +; 00000004 7D05 jnl 0xb +; 00000006 5B pop ebx +; 00000007 01D8 add eax,ebx +; 00000009 EBF6 jmp short 0x1 + +; local loop (#2): +; 0000000B 81F9E8030000 cmp ecx,0x3e8 +; 00000011 7E05 jng 0x18 +; 00000013 5B pop ebx +; 00000014 29D9 sub ecx,ebx +; 00000016 EBF3 jmp short 0xb + +; 00000018 EBE6 jmp short 0x0 + + + diff --git a/test-suite/standalone/sassy/tests/prims/locals6 b/test-suite/standalone/sassy/tests/prims/locals6 Binary files differnew file mode 100644 index 000000000..8e606fafc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals6 diff --git a/test-suite/standalone/sassy/tests/prims/locals6.scm b/test-suite/standalone/sassy/tests/prims/locals6.scm new file mode 100644 index 000000000..9b03a15a1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals6.scm @@ -0,0 +1,41 @@ +(macro my-while + (lambda (test . body) + `(locals (loop) + (label loop + (with-win (jmp short loop) + (seq ,test + (begin ,@body))))))) + +(text + (label loop + + (nop) + + (my-while (< eax 10) + (pop ebx) + (add eax ebx))) + + (my-while (> ecx 1000) + (pop ebx) + (sub ecx ebx)) + + (jmp short loop)) + +; loop: +; 00000000 90 nop + +; local loop (#1): +; 00000001 83F80A cmp eax,byte +0xa +; 00000004 7D05 jnl 0xb +; 00000006 5B pop ebx +; 00000007 01D8 add eax,ebx +; 00000009 EBF6 jmp short 0x1 + +; local loop (#2): +; 0000000B 81F9E8030000 cmp ecx,0x3e8 +; 00000011 7E05 jng 0x18 +; 00000013 5B pop ebx +; 00000014 29D9 sub ecx,ebx +; 00000016 EBF3 jmp short 0xb + +; 00000018 EBE6 jmp short 0x0 diff --git a/test-suite/standalone/sassy/tests/prims/locals7 b/test-suite/standalone/sassy/tests/prims/locals7 Binary files differnew file mode 100644 index 000000000..0e6e55a2f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals7 diff --git a/test-suite/standalone/sassy/tests/prims/locals7.scm b/test-suite/standalone/sassy/tests/prims/locals7.scm new file mode 100644 index 000000000..35c67306a --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals7.scm @@ -0,0 +1,25 @@ +(text + (nop) + (label bar (jmp quux)) + (locals (bar quux) + (nop) + (label bar) + (jmp quux) + (nop) + (label quux) + (jmp bar) + (nop)) + (label quux (jmp bar))) + +; 00000000 90 nop +; bar: +; 00000001 E90D000000 jmp 0x13 ; jmp quux +; 00000006 90 nop +; local bar: +; 00000007 E901000000 jmp 0xd ; jmp local quux +; 0000000C 90 nop +; local quux: +; 0000000D E9F5FFFFFF jmp 0x7 ; jmp local bar +; 00000012 90 nop +; quux: +; 00000013 E9E9FFFFFF jmp 0x1 ; jmp bar diff --git a/test-suite/standalone/sassy/tests/prims/locals8 b/test-suite/standalone/sassy/tests/prims/locals8 Binary files differnew file mode 100644 index 000000000..93e272aa0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals8 diff --git a/test-suite/standalone/sassy/tests/prims/locals8.scm b/test-suite/standalone/sassy/tests/prims/locals8.scm new file mode 100644 index 000000000..f2fbfc6c6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/locals8.scm @@ -0,0 +1,15 @@ +; testing out skipping of undefined declarations + +(text + (label bar + (nop)) + (locals (bar quux) + (nop) + (label quux) + (jmp bar) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 E900000000 jmp 0x7 +; 00000007 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/seq1 b/test-suite/standalone/sassy/tests/prims/seq1 new file mode 100644 index 000000000..d335cc333 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq1 @@ -0,0 +1 @@ +๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/seq1.scm b/test-suite/standalone/sassy/tests/prims/seq1.scm new file mode 100644 index 000000000..cdf307bd4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq1.scm @@ -0,0 +1,15 @@ +(text + (seq (nop) + (nop) + (seq (nop) + (inv (nop)) + (nop)) + (seq (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 90 nop +; 00000007 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/seq2 b/test-suite/standalone/sassy/tests/prims/seq2 new file mode 100644 index 000000000..6037d7912 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq2 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/seq2.scm b/test-suite/standalone/sassy/tests/prims/seq2.scm new file mode 100644 index 000000000..56ff7c9fa --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq2.scm @@ -0,0 +1,20 @@ +(text + (seq (nop) + (nop) + (seq (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (seq (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7505 jnz 0xb +; 00000006 90 nop +; 00000007 7402 jz 0xb +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/seq3 b/test-suite/standalone/sassy/tests/prims/seq3 new file mode 100644 index 000000000..cd617b311 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq3 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/seq3.scm b/test-suite/standalone/sassy/tests/prims/seq3.scm new file mode 100644 index 000000000..c8fdf27ac --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/seq3.scm @@ -0,0 +1,20 @@ +(text + (begin (nop) + (nop) + (seq (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7504 jnz 0xa +; 00000006 90 nop +; 00000007 7401 jz 0xa +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims/while1 b/test-suite/standalone/sassy/tests/prims/while1 new file mode 100644 index 000000000..e65aa0026 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while1 @@ -0,0 +1 @@ +๋[X๛u๘t๔R๋Q
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/while1.scm b/test-suite/standalone/sassy/tests/prims/while1.scm new file mode 100644 index 000000000..10b4a55f1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while1.scm @@ -0,0 +1,18 @@ +(text + (if (while (= eax 3) + (seq (pop ebx) + (pop eax) + (= ebx 2))) + (push edx) + (push ecx))) + +; 00000000 EB07 jmp short 0x9 +; 00000002 5B pop ebx +; 00000003 58 pop eax +; 00000004 83FB02 cmp ebx,byte +0x2 +; 00000007 7508 jnz 0x11 +; 00000009 83F803 cmp eax,byte +0x3 +; 0000000C 74F4 jz 0x2 +; 0000000E 52 push edx +; 0000000F EB01 jmp short 0x12 +; 00000011 51 push ecx diff --git a/test-suite/standalone/sassy/tests/prims/while2 b/test-suite/standalone/sassy/tests/prims/while2 new file mode 100644 index 000000000..dc703a96e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while2 @@ -0,0 +1 @@ +๋[X๛u๘u๔R๋Q
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/while2.scm b/test-suite/standalone/sassy/tests/prims/while2.scm new file mode 100644 index 000000000..5f86baa2e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while2.scm @@ -0,0 +1,20 @@ +(text + (if (until (= eax 3) + (seq (pop ebx) + (pop eax) + (= ebx 2))) + (push edx) + (push ecx))) + + +; 00000000 EB07 jmp short 0x9 +; 00000002 5B pop ebx +; 00000003 58 pop eax +; 00000004 83FB02 cmp ebx,byte +0x2 +; 00000007 7508 jnz 0x11 +; 00000009 83F803 cmp eax,byte +0x3 +; 0000000C 75F4 jnz 0x2 +; 0000000E 52 push edx +; 0000000F EB01 jmp short 0x12 +; 00000011 51 push ecx + diff --git a/test-suite/standalone/sassy/tests/prims/while3 b/test-suite/standalone/sassy/tests/prims/while3 new file mode 100644 index 000000000..cc379fc48 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while3 @@ -0,0 +1 @@ +๋ [๛tุ๋๖ย๚|๏
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/while3.scm b/test-suite/standalone/sassy/tests/prims/while3.scm new file mode 100644 index 000000000..d292ba337 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/while3.scm @@ -0,0 +1,25 @@ +(text
+ (while (< edx 20)
+ (begin
+ (iter (seq (pop ebx)
+ (!= ebx 4)
+ (add eax ebx)))
+ (add edx eax))))
+
+; iter is sometimes better for inner loops, since both
+; while and until always generate a jmp at their start
+; to the test (the test is placed after their body).
+; When while or until start the body of an outer while/until
+; that means a jmp or jcc to a jmp will be generated.
+; Using iter for the inner loop fixes this.
+
+; 00000000 EB0C jmp short 0xe
+; 00000002 5B pop ebx
+; 00000003 83FB04 cmp ebx,byte +0x4
+; 00000006 7404 jz 0xc
+; 00000008 01D8 add eax,ebx
+; 0000000A EBF6 jmp short 0x2
+; 0000000C 01C2 add edx,eax
+; 0000000E 83FA14 cmp edx,byte +0x14
+; 00000011 7CEF jl 0x2
+
diff --git a/test-suite/standalone/sassy/tests/prims/with-lose1 b/test-suite/standalone/sassy/tests/prims/with-lose1 new file mode 100644 index 000000000..884fbd2d7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose1 @@ -0,0 +1 @@ +รtw๚{๗้๐
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-lose1.scm b/test-suite/standalone/sassy/tests/prims/with-lose1.scm new file mode 100644 index 000000000..bb00b3db9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose1.scm @@ -0,0 +1,20 @@ +(text
+ (label foo (ret))
+ (seq (nop)
+ (with-lose foo
+ (iter (alt (seq (nop) z!)
+ (seq (nop) a!)
+ (seq (nop) po!))))
+ (nop)))
+; foo:
+; 00000000 C3 ret
+
+; 00000001 90 nop
+; 00000002 90 nop
+; 00000003 74FD jz 0x2
+; 00000005 90 nop
+; 00000006 77FA ja 0x2
+; 00000008 90 nop
+; 00000009 7BF7 jpo 0x2
+; 0000000B E9F0FFFFFF jmp 0x0
+; 00000010 90 nop
diff --git a/test-suite/standalone/sassy/tests/prims/with-lose2 b/test-suite/standalone/sassy/tests/prims/with-lose2 Binary files differnew file mode 100644 index 000000000..2c4a524d7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose2 diff --git a/test-suite/standalone/sassy/tests/prims/with-lose2.scm b/test-suite/standalone/sassy/tests/prims/with-lose2.scm new file mode 100644 index 000000000..d5edc4f24 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose2.scm @@ -0,0 +1,20 @@ +(text
+ (label foo (ret))
+ (seq (nop)
+ (with-lose (reloc my-reloc foo 100)
+ (iter (alt (seq (nop) z!)
+ (seq (nop) a!)
+ (seq (nop) po!))))
+ (nop)))
+; foo:
+; 00000000 C3 ret
+
+; 00000001 90 nop
+; 00000002 90 nop
+; 00000003 74FD jz 0x2
+; 00000005 90 nop
+; 00000006 77FA ja 0x2
+; 00000008 90 nop
+; 00000009 7BF7 jpo 0x2
+; 0000000B E964000000 jmp 0x74 <- this is right, (reloc had an addend of 100)
+; 00000010 90 nop
diff --git a/test-suite/standalone/sassy/tests/prims/with-lose3 b/test-suite/standalone/sassy/tests/prims/with-lose3 new file mode 100644 index 000000000..9d92dcc63 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose3 @@ -0,0 +1 @@ +รรร
๖๑์
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-lose3.scm b/test-suite/standalone/sassy/tests/prims/with-lose3.scm new file mode 100644 index 000000000..9c122676f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-lose3.scm @@ -0,0 +1,27 @@ +(text + (label foo (ret)) + (label bar (ret)) + (label qudr (ret)) + (seq + (nop) + (with-lose foo z!) + (with-lose bar ge!) + (with-lose qudr a!) + (nop))) + +; foo: +; 00000000 C3 ret +; bar: +; 00000001 C3 ret +; qudr: +; 00000002 C3 ret +; 00000003 90 nop +; 00000004 0F85F6FFFFFF jnz near 0x0 +; 0000000A 0F8CF1FFFFFF jl near 0x1 +; 00000010 0F86ECFFFFFF jna near 0x2 +; 00000016 90 nop + + + + +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose1 b/test-suite/standalone/sassy/tests/prims/with-win-lose1 Binary files differnew file mode 100644 index 000000000..b0bf6a27e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose1 diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose1.scm b/test-suite/standalone/sassy/tests/prims/with-win-lose1.scm new file mode 100644 index 000000000..4663e8639 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose1.scm @@ -0,0 +1,16 @@ +(text + (with-win-lose foo bar + (= eax 3)) + (seq (nop) (nop) (nop)) + (label foo (ret)) + (label bar (ret))) + +; 00000000 83F803 cmp eax,byte +0x3 +; 00000003 0F8408000000 jz near 0x11 +; 00000009 E904000000 jmp 0x12 +; 0000000E 90 nop +; 0000000F 90 nop +; 00000010 90 nop +; 00000011 C3 ret +; 00000012 C3 ret + diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose2 b/test-suite/standalone/sassy/tests/prims/with-win-lose2 Binary files differnew file mode 100644 index 000000000..b0d068466 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose2 diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose2.scm b/test-suite/standalone/sassy/tests/prims/with-win-lose2.scm new file mode 100644 index 000000000..145e1c598 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose2.scm @@ -0,0 +1,24 @@ +(text + (with-win-lose foo bar + (while (= eax 3) + (seq (nop) + (nop) + l!))) + (seq (nop) (nop) (nop)) + (label foo (ret)) + (label bar (ret))) + +; 00000000 EB08 jmp short 0xa +; 00000002 90 nop +; 00000003 90 nop +; 00000004 0F8D0E000000 jnl near 0x18 +; 0000000A 83F803 cmp eax,byte +0x3 +; 0000000D 74F3 jz 0x2 +; 0000000F E903000000 jmp 0x17 +; 00000014 90 nop +; 00000015 90 nop +; 00000016 90 nop +; 00000017 C3 ret +; 00000018 C3 ret + + diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose3 b/test-suite/standalone/sassy/tests/prims/with-win-lose3 Binary files differnew file mode 100644 index 000000000..16ad9d072 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose3 diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose3.scm b/test-suite/standalone/sassy/tests/prims/with-win-lose3.scm new file mode 100644 index 000000000..f64f70bbc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose3.scm @@ -0,0 +1,24 @@ +(text + (label foo (ret)) + (with-win-lose bar foo + (if (= eax 3) + (nop) + (alt (seq (nop) a!) + (seq (nop) p!)))) + (nop) + (label bar (ret))) + +; foo: +; 00000000 C3 ret +; 00000001 83F803 cmp eax,byte +0x3 +; 00000004 7506 jnz 0xc +; 00000006 90 nop +; 00000007 E914000000 jmp 0x20 +; 0000000C 90 nop +; 0000000D 0F870D000000 ja near 0x20 +; 00000013 90 nop +; 00000014 0F8A06000000 jpe near 0x20 +; 0000001A E9E1FFFFFF jmp 0x0 +; 0000001F 90 nop +; bar: +; 00000020 C3 ret diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose4 b/test-suite/standalone/sassy/tests/prims/with-win-lose4 new file mode 100644 index 000000000..25c343959 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose4 @@ -0,0 +1 @@ +SP๙uร่๓
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose4.scm b/test-suite/standalone/sassy/tests/prims/with-win-lose4.scm new file mode 100644 index 000000000..48832f938 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose4.scm @@ -0,0 +1,13 @@ +(text + (label foo (push ebx)) + (with-win-lose (ret) (call foo) + (seq + (push eax) + (= ecx 4)))) + +; 00000000 53 push ebx +; 00000001 50 push eax +; 00000002 83F904 cmp ecx,byte +0x4 +; 00000005 7501 jnz 0x8 +; 00000007 C3 ret +; 00000008 E8F3FFFFFF call 0x0 diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose5 b/test-suite/standalone/sassy/tests/prims/with-win-lose5 Binary files differnew file mode 100644 index 000000000..fd5d346d8 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose5 diff --git a/test-suite/standalone/sassy/tests/prims/with-win-lose5.scm b/test-suite/standalone/sassy/tests/prims/with-win-lose5.scm new file mode 100644 index 000000000..eae19d401 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win-lose5.scm @@ -0,0 +1,16 @@ +(text + (label foo (push ebx)) + (with-win-lose + (jmp 1000) + (call foo) + (seq + (push eax) + (= ecx 4)))) + +; 00000000 53 push ebx +; 00000001 50 push eax +; 00000002 83F904 cmp ecx,byte +0x4 +; 00000005 7505 jnz 0xc +; 00000007 E9DC030000 jmp 0x3e8 +; 0000000C E8EFFFFFFF call 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims/with-win1 b/test-suite/standalone/sassy/tests/prims/with-win1 new file mode 100644 index 000000000..a1b76fefa --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win1 @@ -0,0 +1 @@ +รร๘uP้๔S้๎
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win1.scm b/test-suite/standalone/sassy/tests/prims/with-win1.scm new file mode 100644 index 000000000..5c4b22f7c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win1.scm @@ -0,0 +1,20 @@ +(text
+ (label foo (ret))
+ (label bar (ret))
+ (with-win bar
+ (if (= eax 3)
+ (push eax)
+ (push ebx))))
+
+; 00000000 C3 ret
+; 00000001 C3 ret
+; 00000002 83F803 cmp eax,byte +0x3
+; 00000005 7506 jnz 0xd
+; 00000007 50 push eax
+; 00000008 E9F4FFFFFF jmp 0x1
+; 0000000D 53 push ebx
+; 0000000E E9EEFFFFFF jmp 0x1
+
+
+
+
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win2 b/test-suite/standalone/sassy/tests/prims/with-win2 new file mode 100644 index 000000000..0521da178 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win2 @@ -0,0 +1 @@ +รร๘uP้๔S้ํ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win2.scm b/test-suite/standalone/sassy/tests/prims/with-win2.scm new file mode 100644 index 000000000..2c3696b1d --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win2.scm @@ -0,0 +1,18 @@ +(text
+ (label foo (ret))
+ (label bar (ret))
+ (with-win bar
+ (if (= eax 3)
+ (push eax)
+ (with-win foo
+ (push ebx)))))
+
+; 00000000 C3 ret
+; 00000001 C3 ret
+; 00000002 83F803 cmp eax,byte +0x3
+; 00000005 7506 jnz 0xd
+; 00000007 50 push eax
+; 00000008 E9F4FFFFFF jmp 0x1
+; 0000000D 53 push ebx
+; 0000000E E9EDFFFFFF jmp 0x0
+
diff --git a/test-suite/standalone/sassy/tests/prims/with-win3 b/test-suite/standalone/sassy/tests/prims/with-win3 new file mode 100644 index 000000000..203346f3d --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win3 @@ -0,0 +1,2 @@ +รร๋X@๘ +}๘u๔๋v ้ไS้
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win3.scm b/test-suite/standalone/sassy/tests/prims/with-win3.scm new file mode 100644 index 000000000..85eccfbd4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win3.scm @@ -0,0 +1,31 @@ +(text
+ (label foo (ret))
+ (label bar (ret))
+ (if (while (!= eax 3)
+ (seq (pop eax)
+ (inc eax)
+ (< eax 10)))
+ (with-win bar
+ (alt z! a!))
+ (with-win foo
+ (push ebx))))
+
+; foo:
+; 00000000 C3 ret
+
+; bar:
+; 00000001 C3 ret
+
+; 00000002 EB07 jmp short 0xb
+; 00000004 58 pop eax
+; 00000005 40 inc eax
+; 00000006 83F80A cmp eax,byte +0xa
+; 00000009 7D12 jnl 0x1d
+; 0000000B 83F803 cmp eax,byte +0x3
+; 0000000E 75F4 jnz 0x4
+; 00000010 0F84EBFFFFFF jz near 0x1
+; 00000016 760B jna 0x23
+; 00000018 E9E4FFFFFF jmp 0x1
+; 0000001D 53 push ebx
+; 0000001E E9DDFFFFFF jmp 0x0
+
diff --git a/test-suite/standalone/sassy/tests/prims/with-win4 b/test-suite/standalone/sassy/tests/prims/with-win4 new file mode 100644 index 000000000..289f34835 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win4 @@ -0,0 +1 @@ +SPร
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims/with-win4.scm b/test-suite/standalone/sassy/tests/prims/with-win4.scm new file mode 100644 index 000000000..4375d9c9f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win4.scm @@ -0,0 +1,9 @@ +(text + (label foo (push ebx)) + (seq (with-win (ret) + (push eax)))) + +; 00000000 53 push ebx +; 00000001 50 push eax +; 00000002 C3 ret + diff --git a/test-suite/standalone/sassy/tests/prims/with-win5 b/test-suite/standalone/sassy/tests/prims/with-win5 Binary files differnew file mode 100644 index 000000000..77842e325 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win5 diff --git a/test-suite/standalone/sassy/tests/prims/with-win5.scm b/test-suite/standalone/sassy/tests/prims/with-win5.scm new file mode 100644 index 000000000..c310fad00 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims/with-win5.scm @@ -0,0 +1,15 @@ +(text + (mov eax 10) +; this should loop 7 times + (label foo + (if (= eax 3) + (with-win (ret)) + (with-win foo + (sub eax 1))))) + +; 00000000 B80A000000 mov eax,0xa +; 00000005 83F803 cmp eax,byte +0x3 +; 00000008 7501 jnz 0xb +; 0000000A C3 ret +; 0000000B 83E801 sub eax,byte +0x1 +; 0000000E E9F2FFFFFF jmp 0x5 diff --git a/test-suite/standalone/sassy/tests/prims16/16alt1 b/test-suite/standalone/sassy/tests/prims16/16alt1 new file mode 100644 index 000000000..fe93a43c6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt1 @@ -0,0 +1 @@ +๋ ๋๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16alt1.scm b/test-suite/standalone/sassy/tests/prims16/16alt1.scm new file mode 100644 index 000000000..fc1f8bd52 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt1.scm @@ -0,0 +1,20 @@ +(bits 16) + +(text + (seq (nop) + (alt (nop) + (nop) + (nop) + (inv (nop))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB09 jmp short 0xd +; 00000004 90 nop +; 00000005 EB06 jmp short 0xd +; 00000007 90 nop +; 00000008 EB03 jmp short 0xd +; 0000000A 90 nop +; 0000000B EB01 jmp short 0xe +; 0000000D 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16alt2 b/test-suite/standalone/sassy/tests/prims16/16alt2 new file mode 100644 index 000000000..1f00723a2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt2 @@ -0,0 +1 @@ +๋}๋}
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16alt2.scm b/test-suite/standalone/sassy/tests/prims16/16alt2.scm new file mode 100644 index 000000000..1759adf15 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt2.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (seq (nop) + (alt (nop) + ge! + (nop) + (inv ge!)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB07 jmp short 0xb +; 00000004 7D05 jnl 0xb +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 7D01 jnl 0xc +; 0000000B 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16alt3 b/test-suite/standalone/sassy/tests/prims16/16alt3 Binary files differnew file mode 100644 index 000000000..886733710 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt3 diff --git a/test-suite/standalone/sassy/tests/prims16/16alt3.scm b/test-suite/standalone/sassy/tests/prims16/16alt3.scm new file mode 100644 index 000000000..bd6071eb1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt3.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (seq (if (= cx 0) + (alt z! z!) + (nop)) + (nop))) + +; 00000000 83F900 cmp cx,byte +0x0 +; 00000003 7506 jnz 0xb +; 00000005 7405 jz 0xc +; 00000007 7403 jz 0xc +; 00000009 EB02 jmp short 0xd +; 0000000B 90 nop +; 0000000C 90 nop + + diff --git a/test-suite/standalone/sassy/tests/prims16/16alt4 b/test-suite/standalone/sassy/tests/prims16/16alt4 new file mode 100644 index 000000000..a6cf68c85 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt4 @@ -0,0 +1 @@ +๋}๋|
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16alt4.scm b/test-suite/standalone/sassy/tests/prims16/16alt4.scm new file mode 100644 index 000000000..e2b7f0dfd --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16alt4.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (seq (nop) + (alt (nop) + ge! + (nop) + ge!) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB07 jmp short 0xb +; 00000004 7D05 jnl 0xb +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 7C01 jl 0xc +; 0000000B 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16begin1 b/test-suite/standalone/sassy/tests/prims16/16begin1 new file mode 100644 index 000000000..f0140b145 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin1 @@ -0,0 +1 @@ +๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16begin1.scm b/test-suite/standalone/sassy/tests/prims16/16begin1.scm new file mode 100644 index 000000000..972729367 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin1.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (begin (nop) + (seq (nop) + (begin (nop) + (inv (nop))) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 EB01 jmp short 0x7 +; 00000006 90 nop +; 00000007 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16begin2 b/test-suite/standalone/sassy/tests/prims16/16begin2 new file mode 100644 index 000000000..6076321e1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin2 @@ -0,0 +1 @@ +u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16begin2.scm b/test-suite/standalone/sassy/tests/prims16/16begin2.scm new file mode 100644 index 000000000..a5a7f7975 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin2.scm @@ -0,0 +1,16 @@ +(bits 16) + +(text + (begin (nop) + (seq (nop) + (begin (nop) + z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 7501 jnz 0x6 +; 00000005 90 nop +; 00000006 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16begin3 b/test-suite/standalone/sassy/tests/prims16/16begin3 new file mode 100644 index 000000000..c4d342828 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin3 @@ -0,0 +1 @@ +๋t
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16begin3.scm b/test-suite/standalone/sassy/tests/prims16/16begin3.scm new file mode 100644 index 000000000..bf897983e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin3.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (begin (nop) + (alt (nop) + (begin (nop) + z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7401 jz 0x8 +; 00000007 90 nop +; 00000008 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16begin4 b/test-suite/standalone/sassy/tests/prims16/16begin4 new file mode 100644 index 000000000..76ad18872 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin4 @@ -0,0 +1 @@ +๋u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16begin4.scm b/test-suite/standalone/sassy/tests/prims16/16begin4.scm new file mode 100644 index 000000000..2fcbf1bfb --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin4.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (begin (nop) + (alt (nop) + (begin (nop) + (inv z!)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7501 jnz 0x8 +; 00000007 90 nop +; 00000008 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16begin5 b/test-suite/standalone/sassy/tests/prims16/16begin5 new file mode 100644 index 000000000..4a8138156 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin5 @@ -0,0 +1 @@ +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16begin5.scm b/test-suite/standalone/sassy/tests/prims16/16begin5.scm new file mode 100644 index 000000000..b3f22b0d6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16begin5.scm @@ -0,0 +1,20 @@ +(bits 16) + +(text + (begin (nop) + (inv (alt z! + l! + a!)) + (nop))) + +;The arguments to a begin always take as their win and lose the +;following arg in the sequence, except for the last, which takes +;begin's win and lose. Since the assertions only generate jcc's, they +;would all be jcc's to the last (nop). But it happens that the last +;(nop) is the instruction following the a! assertion. But a jmp to the +;next instruction is really doing nothing at all, so it may be +;eliminated. But then the l! assertion is in the same circumstance, +;and so on. Hence: + +; 00000000 90 nop +; 00000001 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16esc1 b/test-suite/standalone/sassy/tests/prims16/16esc1 Binary files differnew file mode 100644 index 000000000..99aebf601 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc1 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc1.scm b/test-suite/standalone/sassy/tests/prims16/16esc1.scm new file mode 100644 index 000000000..15b524b15 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc1.scm @@ -0,0 +1,36 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (begin + (esc ((push $win)) + (alt + (with-win foo + (seq (= ax 3) + (= bx 2) + (push eax) + (push ebx))) + (with-win bar + (seq (push ebx) + (push eax))))) + (nop) + (nop))) + + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 681D00 push word 0x1d +; 00000005 3D0300 cmp ax,0x3 +; 00000008 750C jnz 0x16 +; 0000000A 83FB02 cmp bx,byte +0x2 +; 0000000D 7507 jnz 0x16 +; 0000000F 6650 push eax +; 00000011 6653 push ebx +; 00000013 E9EAFF jmp 0x0 +; 00000016 6653 push ebx +; 00000018 6650 push eax +; 0000001A E9E4FF jmp 0x1 +; 0000001D 90 nop +; 0000001E 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16esc2 b/test-suite/standalone/sassy/tests/prims16/16esc2 Binary files differnew file mode 100644 index 000000000..3a89cd66e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc2 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc2.scm b/test-suite/standalone/sassy/tests/prims16/16esc2.scm new file mode 100644 index 000000000..99ebb4d54 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc2.scm @@ -0,0 +1,37 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (seq (nop) + (esc ((push $win) + (mov dx $lose)) + (alt + (with-win foo + (seq (= ax 3) + (= bx 2) + (push ax) + (push bx))) + (with-win bar + (seq (mov sp dx) + (push bx) + (push ax))))) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 90 nop +; 00000003 681F00 push word 0x1f +; 00000006 BA2000 mov dx,0x20 +; 00000009 3D0300 cmp ax,0x3 +; 0000000C 750A jnz 0x18 +; 0000000E 83FB02 cmp bx,byte +0x2 +; 00000011 7505 jnz 0x18 +; 00000013 50 push ax +; 00000014 53 push bx +; 00000015 E9E8FF jmp 0x0 +; 00000018 89D4 mov sp,dx +; 0000001A 53 push bx +; 0000001B 50 push ax +; 0000001C E9E2FF jmp 0x1 +; 0000001F 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16esc3 b/test-suite/standalone/sassy/tests/prims16/16esc3 Binary files differnew file mode 100644 index 000000000..cfb4e959e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc3 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc3.scm b/test-suite/standalone/sassy/tests/prims16/16esc3.scm new file mode 100644 index 000000000..0a4a0e497 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc3.scm @@ -0,0 +1,19 @@ +(bits 16) + +(text + (begin (push $eip) + (push $win) + (push $lose)) + (seq (push $eip) + (push $win) + (push $lose) + (nop))) + +; 00000000 680300 push word 0x3 +; 00000003 680600 push word 0x6 +; 00000006 680900 push word 0x9 +; 00000009 680C00 push word 0xc +; 0000000C 680F00 push word 0xf +; 0000000F 681300 push word 0x13 +; 00000012 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16esc4 b/test-suite/standalone/sassy/tests/prims16/16esc4 Binary files differnew file mode 100644 index 000000000..93b2344ee --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc4 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc4.scm b/test-suite/standalone/sassy/tests/prims16/16esc4.scm new file mode 100644 index 000000000..904921371 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc4.scm @@ -0,0 +1,37 @@ +(bits 16) + +(text + (begin (call $eip) + (call $win) + (call $lose)) + (seq (jmp $eip) + (jmp $win) + (jmp $lose) + (nop)) + (seq (jmp short $eip) + (jmp short $win) + (jmp short $lose) + (nop)) + (alt (jmp $win) + (jmp $lose) + (nop) + (nop))) + +; 00000000 E80000 call 0x3 +; 00000003 E80000 call 0x6 +; 00000006 E80000 call 0x9 +; 00000009 E90000 jmp 0xc +; 0000000C E90000 jmp 0xf +; 0000000F E90100 jmp 0x13 +; 00000012 90 nop +; 00000013 EB00 jmp short 0x15 +; 00000015 EB00 jmp short 0x17 +; 00000017 EB01 jmp short 0x1a +; 00000019 90 nop +; 0000001A E90B00 jmp 0x28 +; 0000001D EB09 jmp short 0x28 +; 0000001F E90200 jmp 0x24 +; 00000022 EB04 jmp short 0x28 +; 00000024 90 nop +; 00000025 EB01 jmp short 0x28 +; 00000027 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16esc5 b/test-suite/standalone/sassy/tests/prims16/16esc5 Binary files differnew file mode 100644 index 000000000..c3d6a596c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc5 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc5.scm b/test-suite/standalone/sassy/tests/prims16/16esc5.scm new file mode 100644 index 000000000..108591222 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc5.scm @@ -0,0 +1,37 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (seq (nop) + (esc ((jmp $win) + (jmp $lose)) + (alt + (with-win foo + (seq (= ax 3) + (= bx 2) + (push ax) + (push bx))) + (with-win bar + (seq (mov sp dx) + (push bx) + (push ax))))) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 90 nop +; 00000003 E91900 jmp 0x1f +; 00000006 E91700 jmp 0x20 +; 00000009 3D0300 cmp ax,0x3 +; 0000000C 750A jnz 0x18 +; 0000000E 83FB02 cmp bx,byte +0x2 +; 00000011 7505 jnz 0x18 +; 00000013 50 push ax +; 00000014 53 push bx +; 00000015 E9E8FF jmp 0x0 +; 00000018 89D4 mov sp,dx +; 0000001A 53 push bx +; 0000001B 50 push ax +; 0000001C E9E2FF jmp 0x1 +; 0000001F 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16esc6 b/test-suite/standalone/sassy/tests/prims16/16esc6 Binary files differnew file mode 100644 index 000000000..90984bdbc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc6 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc6.scm b/test-suite/standalone/sassy/tests/prims16/16esc6.scm new file mode 100644 index 000000000..979b8d400 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc6.scm @@ -0,0 +1,15 @@ +(bits 16) + +(text + (iter (seq (nop) + (nop) + (jnz $lose) + (nop) + (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 0F850400 jnz near 0xa +; 00000006 90 nop +; 00000007 90 nop +; 00000008 EBF6 jmp short 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16esc7 b/test-suite/standalone/sassy/tests/prims16/16esc7 new file mode 100644 index 000000000..86ff7bc5e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc7 @@ -0,0 +1 @@ +ut๘๋๖
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16esc7.scm b/test-suite/standalone/sassy/tests/prims16/16esc7.scm new file mode 100644 index 000000000..f2ebde577 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16esc7.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (iter (seq (nop) + (nop) + (jnz short $lose) + (nop) + (nop) + (je short $win)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7506 jnz 0xa +; 00000004 90 nop +; 00000005 90 nop +; 00000006 74F8 jz 0x0 +; 00000008 EBF6 jmp short 0x0 +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k1 b/test-suite/standalone/sassy/tests/prims16/16exp-k1 new file mode 100644 index 000000000..cd617b311 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k1 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k1.scm b/test-suite/standalone/sassy/tests/prims16/16exp-k1.scm new file mode 100644 index 000000000..cf00dd0c7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k1.scm @@ -0,0 +1,27 @@ +(bits 16) + +(macro seq-k (lambda tests + (cond ((null? tests) '$win) + ((null? (cdr tests)) (car tests)) + (else `(with-win (seq-k ,@(cdr tests)) + ,(car tests)))))) +(text + (begin (nop) + (nop) + (seq-k (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7504 jnz 0xa +; 00000006 90 nop +; 00000007 7401 jz 0xa +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k2 b/test-suite/standalone/sassy/tests/prims16/16exp-k2 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k2 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k2.scm b/test-suite/standalone/sassy/tests/prims16/16exp-k2.scm new file mode 100644 index 000000000..ab054cc76 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k2.scm @@ -0,0 +1,27 @@ +(bits 16) + +(macro inv-k (lambda (itm) + `(with-win-lose $lose $win + ,itm))) + +(text + (alt (if (seq (inv-k (nop)) + (inv-k z!) + (inv-k (inv (nop))) + (inv-k ge!)) + (inv-k (nop)) + (nop)) + (nop))) + +; should be the same as inv4.scm (de Morgan) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k3 b/test-suite/standalone/sassy/tests/prims16/16exp-k3 new file mode 100644 index 000000000..76ad18872 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k3 @@ -0,0 +1 @@ +๋u
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k3.scm b/test-suite/standalone/sassy/tests/prims16/16exp-k3.scm new file mode 100644 index 000000000..75d3a19ee --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k3.scm @@ -0,0 +1,26 @@ +(bits 16) + +(macro begin-k (lambda body-tail + (if (null? (cdr body-tail)) + (car body-tail) + `(with-win (begin-k ,@(cdr body-tail)) + (with-lose $win + ,(car body-tail)))))) + + +(text + (begin-k (nop) + (alt (nop) + (begin-k (nop) + (inv z!)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 EB04 jmp short 0x8 +; 00000004 90 nop +; 00000005 7501 jnz 0x8 +; 00000007 90 nop +; 00000008 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k4 b/test-suite/standalone/sassy/tests/prims16/16exp-k4 new file mode 100644 index 000000000..9e722fd9b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k4 @@ -0,0 +1 @@ +u๋ ~๋{๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16exp-k4.scm b/test-suite/standalone/sassy/tests/prims16/16exp-k4.scm new file mode 100644 index 000000000..f1158bad5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16exp-k4.scm @@ -0,0 +1,31 @@ +(bits 16) + +(macro if-k (lambda (test conseq altern) + `(with-win-lose ,conseq ,altern + ,test))) + +(text + (seq (nop) + (if-k (seq (nop) z!) + (inv (nop)) + (if-k g! + (nop) + (if-k p! + (nop) + (nop)))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0C jmp short 0x13 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB06 jmp short 0x12 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB01 jmp short 0x12 +; 00000011 90 nop +; 00000012 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16if1 b/test-suite/standalone/sassy/tests/prims16/16if1 new file mode 100644 index 000000000..7ecc60012 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if1 @@ -0,0 +1 @@ +tv๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16if1.scm b/test-suite/standalone/sassy/tests/prims16/16if1.scm new file mode 100644 index 000000000..322d2da4b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if1.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (seq (nop) + (if (alt z! a!) + (nop) + (inv (nop))) + (nop))) + +; 00000000 90 nop +; 00000001 7402 jz 0x5 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 EB03 jmp short 0xb +; 00000008 90 nop +; 00000009 EB01 jmp short 0xc +; 0000000B 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16if2 b/test-suite/standalone/sassy/tests/prims16/16if2 new file mode 100644 index 000000000..2d8ada333 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if2 @@ -0,0 +1 @@ +tw๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16if2.scm b/test-suite/standalone/sassy/tests/prims16/16if2.scm new file mode 100644 index 000000000..c35b7e449 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if2.scm @@ -0,0 +1,23 @@ +(bits 16) + +(text + (seq (nop) + (if (seq (nop) + (inv (alt z! a!))) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7405 jz 0x9 +; 00000004 7703 ja 0x9 +; 00000006 90 nop +; 00000007 EB02 jmp short 0xb +; 00000009 90 nop +; 0000000A 90 nop + +;Causing the consequent (first) arm of the if to lose cause the whole +;if to lose, and thus the outer seq to lose. + + diff --git a/test-suite/standalone/sassy/tests/prims16/16if3 b/test-suite/standalone/sassy/tests/prims16/16if3 new file mode 100644 index 000000000..a459c239b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if3 @@ -0,0 +1 @@ +u๋~๋{๋v
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16if3.scm b/test-suite/standalone/sassy/tests/prims16/16if3.scm new file mode 100644 index 000000000..597e5742a --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if3.scm @@ -0,0 +1,28 @@ +(bits 16) + +(text + (seq (nop) + (if (seq (nop) z!) + (inv (nop)) + (if g! + (nop) + (if p! + (nop) + (seq a! (nop))))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0E jmp short 0x15 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB08 jmp short 0x14 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB03 jmp short 0x14 +; 00000011 7602 jna 0x15 +; 00000013 90 nop +; 00000014 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16if4 b/test-suite/standalone/sassy/tests/prims16/16if4 new file mode 100644 index 000000000..9e722fd9b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if4 @@ -0,0 +1 @@ +u๋ ~๋{๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16if4.scm b/test-suite/standalone/sassy/tests/prims16/16if4.scm new file mode 100644 index 000000000..a9fea83d3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16if4.scm @@ -0,0 +1,27 @@ +(bits 16) + +(text + (seq (nop) + (if (seq (nop) z!) + (inv (nop)) + (if g! + (nop) + (if p! + (nop) + (nop)))) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 7503 jnz 0x7 +; 00000004 90 nop +; 00000005 EB0C jmp short 0x13 +; 00000007 7E03 jng 0xc +; 00000009 90 nop +; 0000000A EB06 jmp short 0x12 +; 0000000C 7B03 jpo 0x11 +; 0000000E 90 nop +; 0000000F EB01 jmp short 0x12 +; 00000011 90 nop +; 00000012 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16inv1 b/test-suite/standalone/sassy/tests/prims16/16inv1 new file mode 100644 index 000000000..015f131dc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv1 @@ -0,0 +1 @@ +u}w
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv1.scm b/test-suite/standalone/sassy/tests/prims16/16inv1.scm new file mode 100644 index 000000000..b60ede303 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv1.scm @@ -0,0 +1,22 @@ +(bits 16) + +(text + (seq (nop) + (inv (seq z! + l! + a!)) + (nop))) + +; 00000000 90 nop +; 00000001 7504 jnz 0x7 +; 00000003 7D02 jnl 0x7 +; 00000005 7701 ja 0x8 +; 00000007 90 nop + +;In order for the outer seq to win all its arguments must win. +;In order for the inv to win its argument must lose. +;The argument to inv is seq, so far a seq to lose any one of its args must lose. +;The first two args are assertions, they lose if their opposite is true, and if their opposite is true the inv wins, hence the jcc's to 0x7. +;The last arg, also an assertion, wins if it is true, but in that case the inv will lose, causing the outer seq to lose, hance the jcc to 0x8, past everything. + + diff --git a/test-suite/standalone/sassy/tests/prims16/16inv2 b/test-suite/standalone/sassy/tests/prims16/16inv2 new file mode 100644 index 000000000..783318320 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv2 @@ -0,0 +1 @@ +t|w
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv2.scm b/test-suite/standalone/sassy/tests/prims16/16inv2.scm new file mode 100644 index 000000000..73d4dbf76 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv2.scm @@ -0,0 +1,20 @@ +(bits 16) + +(text + (seq (nop) + (inv (alt z! + l! + a!)) + (nop))) + +; 00000000 90 nop +; 00000001 7405 jz 0x8 +; 00000003 7C03 jl 0x8 +; 00000005 7701 ja 0x8 +; 00000007 90 nop + +;In order for the outer seq to win its arguments must win. In order +;for the inv to win its argument must lose. It's argument is alt, and +;for an alt to lose all its arguments must lose. Therefore if any of +;its arguments win, the inv will lose as will the outer seq. Hence the +;jcc's past everything. diff --git a/test-suite/standalone/sassy/tests/prims16/16inv3 b/test-suite/standalone/sassy/tests/prims16/16inv3 new file mode 100644 index 000000000..581ae8c71 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv3 @@ -0,0 +1 @@ +u๋}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv3.scm b/test-suite/standalone/sassy/tests/prims16/16inv3.scm new file mode 100644 index 000000000..d3f38fe0c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv3.scm @@ -0,0 +1,21 @@ +(bits 16) + +(text + (alt (if (inv (seq (nop) + z! + (inv (nop)) + ge!)) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16inv4 b/test-suite/standalone/sassy/tests/prims16/16inv4 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv4 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv4.scm b/test-suite/standalone/sassy/tests/prims16/16inv4.scm new file mode 100644 index 000000000..2b98c5a63 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv4.scm @@ -0,0 +1,21 @@ +(bits 16) + +(text + (alt (if (inv (alt (nop) + z! + (inv (nop)) + ge!)) + (inv (nop)) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16inv5 b/test-suite/standalone/sassy/tests/prims16/16inv5 new file mode 100644 index 000000000..581ae8c71 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv5 @@ -0,0 +1 @@ +u๋}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv5.scm b/test-suite/standalone/sassy/tests/prims16/16inv5.scm new file mode 100644 index 000000000..1893e06aa --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv5.scm @@ -0,0 +1,23 @@ +(bits 16) + +(text + (alt (if (alt (inv (nop)) + (inv z!) + (inv (inv (nop))) + (inv ge!)) + (inv (nop)) + (nop)) + (nop))) + +; should be the same as inv3.scm, (de Morgan) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16inv6 b/test-suite/standalone/sassy/tests/prims16/16inv6 new file mode 100644 index 000000000..c3e2ac2c0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv6 @@ -0,0 +1 @@ +๋t}๋๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16inv6.scm b/test-suite/standalone/sassy/tests/prims16/16inv6.scm new file mode 100644 index 000000000..056c7d325 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16inv6.scm @@ -0,0 +1,23 @@ +(bits 16) + +(text + (alt (if (seq (inv (nop)) + (inv z!) + (inv (inv (nop))) + (inv ge!)) + (inv (nop)) + (nop)) + (nop))) + +; should be the same as inv4.scm (de Morgan) + +; 00000000 90 nop +; 00000001 EB08 jmp short 0xb +; 00000003 7406 jz 0xb +; 00000005 90 nop +; 00000006 7D03 jnl 0xb +; 00000008 90 nop +; 00000009 EB03 jmp short 0xe +; 0000000B 90 nop +; 0000000C EB01 jmp short 0xf +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16iter1 b/test-suite/standalone/sassy/tests/prims16/16iter1 new file mode 100644 index 000000000..9602d9f55 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter1 @@ -0,0 +1 @@ +tv๋๘
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16iter1.scm b/test-suite/standalone/sassy/tests/prims16/16iter1.scm new file mode 100644 index 000000000..4ce649532 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter1.scm @@ -0,0 +1,13 @@ +(bits 16) + +(text + (iter (seq (nop) + (alt z! a!) + (nop)))) + +; 00000000 90 nop +; 00000001 7402 jz 0x5 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 EBF8 jmp short 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16iter2 b/test-suite/standalone/sassy/tests/prims16/16iter2 new file mode 100644 index 000000000..405e230ae --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter2 @@ -0,0 +1 @@ +uv}๘
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16iter2.scm b/test-suite/standalone/sassy/tests/prims16/16iter2.scm new file mode 100644 index 000000000..2b3097cac --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter2.scm @@ -0,0 +1,15 @@ +(bits 16) + +(text + (iter + (seq (nop) + (seq z! a!) + (nop) + ge!))) + +; 00000000 90 nop +; 00000001 7505 jnz 0x8 +; 00000003 7603 jna 0x8 +; 00000005 90 nop +; 00000006 7DF8 jnl 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16iter3 b/test-suite/standalone/sassy/tests/prims16/16iter3 new file mode 100644 index 000000000..d3adf99ef --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter3 @@ -0,0 +1 @@ +๋uw๙๋๖}๔
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16iter3.scm b/test-suite/standalone/sassy/tests/prims16/16iter3.scm new file mode 100644 index 000000000..a7563e3ad --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter3.scm @@ -0,0 +1,15 @@ +(bits 16) + +(text + (iter (alt (nop) + (seq z! a!) + (nop) + ge!))) + +; 00000000 90 nop +; 00000001 EBFD jmp short 0x0 +; 00000003 7502 jnz 0x7 +; 00000005 77F9 ja 0x0 +; 00000007 90 nop +; 00000008 EBF6 jmp short 0x0 +; 0000000A 7DF4 jnl 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16iter4 b/test-suite/standalone/sassy/tests/prims16/16iter4 new file mode 100644 index 000000000..5979312ca --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter4 @@ -0,0 +1 @@ +๋u๋๙t}
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16iter4.scm b/test-suite/standalone/sassy/tests/prims16/16iter4.scm new file mode 100644 index 000000000..c31640d9e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter4.scm @@ -0,0 +1,19 @@ +(bits 16) + +(text + (iter (alt (nop) + (iter (seq (nop) + (nop) + z! + (nop))) + (iter (inv (alt z! + l!)))))) +; 00000000 90 nop +; 00000001 EBFD jmp short 0x0 +; 00000003 90 nop +; 00000004 90 nop +; 00000005 7503 jnz 0xa +; 00000007 90 nop +; 00000008 EBF9 jmp short 0x3 +; 0000000A 7402 jz 0xe +; 0000000C 7DFC jnl 0xa diff --git a/test-suite/standalone/sassy/tests/prims16/16iter5 b/test-suite/standalone/sassy/tests/prims16/16iter5 Binary files differnew file mode 100644 index 000000000..f864a6681 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter5 diff --git a/test-suite/standalone/sassy/tests/prims16/16iter5.scm b/test-suite/standalone/sassy/tests/prims16/16iter5.scm new file mode 100644 index 000000000..3c42b6c46 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter5.scm @@ -0,0 +1,40 @@ +(bits 16) + +(text + (begin + (iter + (alt (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (zero? eax))) + (iter + (alt (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (add (& ecx (* edx 4) 1000) 1000) + (zero? eax))))) + +;testing multi-pass iter for jump sizes + diff --git a/test-suite/standalone/sassy/tests/prims16/16iter6 b/test-suite/standalone/sassy/tests/prims16/16iter6 new file mode 100644 index 000000000..fcbdd1a48 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter6 @@ -0,0 +1 @@ +[๛t๚[๛t๚
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16iter6.scm b/test-suite/standalone/sassy/tests/prims16/16iter6.scm new file mode 100644 index 000000000..8e6fa1729 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16iter6.scm @@ -0,0 +1,43 @@ +(bits 16) + +(text + (iter + (begin (iter (seq (pop bx) + (= bx 2))) + (iter (seq (pop bx) + (= bx 3)))))) + +; 00000000 5B pop ebx +; 00000001 83FB02 cmp bx,byte +0x2 +; 00000004 74FA jz 0x0 +; 00000006 5B pop ebx +; 00000007 83FB03 cmp bx,byte +0x3 +; 0000000A 74FA jz 0x6 + +; Why it makes sense that the outer loop doesn't loop: +; Iter can never win, it can only loop forever or lose, in which case +; the loop is exited. The begin wins or loses depending on its last +; tail. In this case, the last tail can never win, since it's an iter, +; but it can lose. But if it loses, the whole begin loses, in which +; case the outer iter loses and is exited. + +; In this case, you can put '(seq) as the last item of the +; begin. Since '(seq) always wins, the begin always wins and the outer +; loop never exits, so the last jmp will be generated: + +; (text +; (iter +; (begin (iter (seq (pop ebx) +; (= ebx 2))) +; (iter (seq (pop ebx) +; (= ebx 3))) +; (seq)))) + +; 00000000 5B pop ebx +; 00000001 83FB02 cmp ebx,byte +0x2 +; 00000004 74FA jz 0x0 +; 00000006 5B pop ebx +; 00000007 83FB03 cmp ebx,byte +0x3 +; 0000000A 74FA jz 0x6 +; 0000000C EBF2 jmp short 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16label1 b/test-suite/standalone/sassy/tests/prims16/16label1 new file mode 100644 index 000000000..6c0c68d21 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label1 @@ -0,0 +1 @@ +u้๚
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16label1.scm b/test-suite/standalone/sassy/tests/prims16/16label1.scm new file mode 100644 index 000000000..b385752a2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label1.scm @@ -0,0 +1,13 @@ +(bits 16) + +(text + (label foo (seq (nop) + (label bar z!) + (nop))) + (jmp bar)) + +; 00000000 90 nop +; 00000001 7501 jnz 0x4 +; 00000003 90 nop +; 00000004 E9FAFF jmp 0x1 + diff --git a/test-suite/standalone/sassy/tests/prims16/16label2 b/test-suite/standalone/sassy/tests/prims16/16label2 new file mode 100644 index 000000000..45529adfc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label2 @@ -0,0 +1 @@ +๋๛้๙
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16label2.scm b/test-suite/standalone/sassy/tests/prims16/16label2.scm new file mode 100644 index 000000000..15019eb43 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label2.scm @@ -0,0 +1,15 @@ +(bits 16) + +(text + (iter (begin + (nop) + (label foo (nop)) + (nop))) + (jmp foo)) + + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 EBFB jmp short 0x0 +; 00000005 E9F9FF jmp 0x1 diff --git a/test-suite/standalone/sassy/tests/prims16/16label3 b/test-suite/standalone/sassy/tests/prims16/16label3 Binary files differnew file mode 100644 index 000000000..893b53039 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label3 diff --git a/test-suite/standalone/sassy/tests/prims16/16label3.scm b/test-suite/standalone/sassy/tests/prims16/16label3.scm new file mode 100644 index 000000000..e371d69fb --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label3.scm @@ -0,0 +1,25 @@ +(bits 16) + +(text + (with-win-lose foo bar + (zero? ax)) + (nop) + (nop) + (nop) + (seq (label bar + (inv (iter (seq (dec ax) + (inc cx) + (>= ax 0))))) + (label foo (push cx)))) + +; 00000000 85C0 test ax,ax +; 00000002 0F840D00 jz near 0x13 +; 00000006 E90300 jmp 0xc +; 00000009 90 nop +; 0000000A 90 nop +; 0000000B 90 nop +; 0000000C 48 dec ax +; 0000000D 41 inc cx +; 0000000E 3D0000 cmp ax,0x0 +; 00000011 7DF9 jnl 0xc +; 00000013 51 push cx diff --git a/test-suite/standalone/sassy/tests/prims16/16label4 b/test-suite/standalone/sassy/tests/prims16/16label4 Binary files differnew file mode 100644 index 000000000..ac50eb8ba --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label4 diff --git a/test-suite/standalone/sassy/tests/prims16/16label4.scm b/test-suite/standalone/sassy/tests/prims16/16label4.scm new file mode 100644 index 000000000..a6ad3598f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16label4.scm @@ -0,0 +1,49 @@ +(bits 16) + +; local labels via brute force renaming + +(! (begin (define my-gensym ; assuming eval allows non-expressions (eg define) + (let ((count 1)) + (lambda () + (let ((new (string->symbol (string-append + "_label" + (number->string count))))) + (set! count (+ count 1)) + new)))) + 'void)) + +(macro my-local (lambda (name . body) + (define new-sym (my-gensym)) + ; do the substitution manually, + ; instead of relying on a macro to do it, + ; because 'direcs' is a directive + ; and we want to be able use this in a nested context + (define (deep-replace new old lst) + (cond ((pair? lst) (map (lambda (x) + (deep-replace new old x)) + lst)) + ((eqv? old lst) new) + (else lst))) + `(label ,new-sym ,@(deep-replace new-sym name body)))) + + +(text + (label foo (ret)) + + (seq (= cx "DO") + (my-local foo + (pop ax) + (cmp ax 0) + (jnz foo))) + (nop) + (jmp foo)) + +; 00000000 C3 ret +; 00000001 81F9444F cmp cx,0x4f44 +; 00000005 7508 jnz 0xf +; 00000007 58 pop ax +; 00000008 3D0000 cmp ax,0x0 +; 0000000B 0F85F8FF jnz near 0x7 +; 0000000F 90 nop +; 00000010 E9EDFF jmp 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark1 b/test-suite/standalone/sassy/tests/prims16/16leap-mark1 new file mode 100644 index 000000000..3df256f90 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark1 @@ -0,0 +1 @@ +๋YH
ภu๚
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark1.scm b/test-suite/standalone/sassy/tests/prims16/16leap-mark1.scm new file mode 100644 index 000000000..724b8aa4c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark1.scm @@ -0,0 +1,12 @@ +(bits 16) + +(text + (while (inv (zero? ax)) + (seq (pop cx) + (dec ax)))) + +; 00000000 EB02 jmp short 0x4 +; 00000002 59 pop cx +; 00000003 48 dec ax +; 00000004 85C0 test ax,ax +; 00000006 75FA jnz 0x2 diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark2 b/test-suite/standalone/sassy/tests/prims16/16leap-mark2 new file mode 100644 index 000000000..e5631d947 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark2 @@ -0,0 +1 @@ +๋๋๋t๖
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark2.scm b/test-suite/standalone/sassy/tests/prims16/16leap-mark2.scm new file mode 100644 index 000000000..a1f3502fb --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark2.scm @@ -0,0 +1,21 @@ +(bits 16) + +(text + (leap (iter + (seq (nop) + (mark + (leap (seq (nop) + (mark + (leap (seq (nop) + (mark (seq (nop) z!)))))))))))) + +;confusing but correct. + +; 00000000 EB07 jmp short 0x9 +; 00000002 90 nop +; 00000003 EB04 jmp short 0x9 +; 00000005 90 nop +; 00000006 EB01 jmp short 0x9 +; 00000008 90 nop +; 00000009 90 nop +; 0000000A 74F6 jz 0x2 diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark3 b/test-suite/standalone/sassy/tests/prims16/16leap-mark3 Binary files differnew file mode 100644 index 000000000..0e0a21ecb --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark3 diff --git a/test-suite/standalone/sassy/tests/prims16/16leap-mark3.scm b/test-suite/standalone/sassy/tests/prims16/16leap-mark3.scm new file mode 100644 index 000000000..d78ac4396 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16leap-mark3.scm @@ -0,0 +1,32 @@ +(bits 16) + +(text + (label foo + (leap + (iter (seq (push dx) + (if (= ax 3) + (alt (seq (pop cx) z!) + (seq (push bx) z! (mark (pop bx))) + (seq (mov dx 3))) + (seq (= dx 4) (jmp foo))) + (push dx)))))) + +;hmm... + +; 00000000 EB0C jmp short 0xe +; 00000002 52 push dx +; 00000003 3D0300 cmp ax,0x3 +; 00000006 750E jnz 0x16 +; 00000008 59 pop cx +; 00000009 7413 jz 0x1e +; 0000000B 53 push bx +; 0000000C 7503 jnz 0x11 +; 0000000E 5B pop bx +; 0000000F EB0D jmp short 0x1e +; 00000011 BA0300 mov dx,0x3 +; 00000014 EB08 jmp short 0x1e +; 00000016 83FA04 cmp dx,byte +0x4 +; 00000019 7506 jnz 0x21 +; 0000001B E9E2FF jmp 0x0 +; 0000001E 52 push dx +; 0000001F EBE1 jmp short 0x2 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals1 b/test-suite/standalone/sassy/tests/prims16/16locals1 Binary files differnew file mode 100644 index 000000000..dbd6717ab --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals1 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals1.scm b/test-suite/standalone/sassy/tests/prims16/16locals1.scm new file mode 100644 index 000000000..5daa6392c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals1.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (locals (bar quux) + (nop) + (label bar + (push quux) + (nop)) + (label quux + (push bar) + (nop)))) + +; 00000000 90 nop +; 00000001 680500 push word 0x5 +; 00000004 90 nop +; 00000005 680100 push word 0x1 +; 00000008 90 nop + diff --git a/test-suite/standalone/sassy/tests/prims16/16locals2 b/test-suite/standalone/sassy/tests/prims16/16locals2 Binary files differnew file mode 100644 index 000000000..d62ad87c3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals2 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals2.scm b/test-suite/standalone/sassy/tests/prims16/16locals2.scm new file mode 100644 index 000000000..9c426ca98 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals2.scm @@ -0,0 +1,25 @@ +(bits 16) + +(text + (nop) + (label bar + (push quux)) + (locals (bar quux) + (nop) + (label bar + (push quux) + (nop)) + (label quux + (push bar) + (nop))) + (label quux (push bar))) + +; 00000000 90 nop +; 00000001 680D00 push word 0xd +; 00000004 90 nop +; 00000005 680900 push word 0x9 +; 00000008 90 nop +; 00000009 680500 push word 0x5 +; 0000000C 90 nop +; 0000000D 680100 push word 0x1 + diff --git a/test-suite/standalone/sassy/tests/prims16/16locals3 b/test-suite/standalone/sassy/tests/prims16/16locals3 Binary files differnew file mode 100644 index 000000000..d27d9ee80 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals3 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals3.scm b/test-suite/standalone/sassy/tests/prims16/16locals3.scm new file mode 100644 index 000000000..dfb99eef5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals3.scm @@ -0,0 +1,25 @@ +(bits 16) + +(text + (nop) + (label bar (jmp quux)) + (locals (bar quux) + (nop) + (label bar + (jmp quux) + (nop)) + (label quux + (jmp bar) + (nop))) + (label quux (jmp bar))) + + + +; 00000000 90 nop +; 00000001 E90900 jmp 0xd +; 00000004 90 nop +; 00000005 E90100 jmp 0x9 +; 00000008 90 nop +; 00000009 E9F9FF jmp 0x5 +; 0000000C 90 nop +; 0000000D E9F1FF jmp 0x1 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals4 b/test-suite/standalone/sassy/tests/prims16/16locals4 Binary files differnew file mode 100644 index 000000000..ac50eb8ba --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals4 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals4.scm b/test-suite/standalone/sassy/tests/prims16/16locals4.scm new file mode 100644 index 000000000..613a1c366 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals4.scm @@ -0,0 +1,25 @@ +(bits 16) + +(text + (label foo (ret)) + + (seq (= cx "DO") + (locals (foo) + (label foo + (with-win foo + (seq (pop ax) + (cmp ax 0) + nz!))))) + + (nop) + (jmp foo)) + +; 00000000 C3 ret +; 00000001 81F9444F cmp cx,0x4f44 +; 00000005 7508 jnz 0xf +; 00000007 58 pop ax +; 00000008 3D0000 cmp ax,0x0 +; 0000000B 0F85F8FF jnz near 0x7 +; 0000000F 90 nop +; 00000010 E9EDFF jmp 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16locals5 b/test-suite/standalone/sassy/tests/prims16/16locals5 Binary files differnew file mode 100644 index 000000000..44b77bf21 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals5 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals5.scm b/test-suite/standalone/sassy/tests/prims16/16locals5.scm new file mode 100644 index 000000000..be1614a33 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals5.scm @@ -0,0 +1,38 @@ +(bits 16) + +(macro my-while + (lambda (test . body) + `(locals (loop) + (label loop + (with-win (jmp short loop) + (seq ,test + (begin ,@body))))))) + +(text + (label loop + + (nop) + + (my-while (< ax 10) + (pop bx) + (add ax bx))) + + (my-while (> cx 1000) + (pop bx) + (sub cx bx)) + + (jmp short loop)) + +; 00000000 90 nop +; 00000001 3D0A00 cmp ax,0xa +; 00000004 7D05 jnl 0xb +; 00000006 5B pop bx +; 00000007 01D8 add ax,bx +; 00000009 EBF6 jmp short 0x1 +; 0000000B 81F9E803 cmp cx,0x3e8 +; 0000000F 7E05 jng 0x16 +; 00000011 5B pop bx +; 00000012 29D9 sub cx,bx +; 00000014 EBF5 jmp short 0xb +; 00000016 EBE8 jmp short 0x0 + diff --git a/test-suite/standalone/sassy/tests/prims16/16locals6 b/test-suite/standalone/sassy/tests/prims16/16locals6 Binary files differnew file mode 100644 index 000000000..44b77bf21 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals6 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals6.scm b/test-suite/standalone/sassy/tests/prims16/16locals6.scm new file mode 100644 index 000000000..66f41843e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals6.scm @@ -0,0 +1,37 @@ +(bits 16) + +(macro my-while + (lambda (test . body) + `(locals (loop) + (label loop + (with-win (jmp short loop) + (seq ,test + (begin ,@body))))))) + +(text + (label loop + + (nop) + + (my-while (< ax 10) + (pop bx) + (add ax bx))) + + (my-while (> cx 1000) + (pop bx) + (sub cx bx)) + + (jmp short loop)) + +; 00000000 90 nop +; 00000001 3D0A00 cmp ax,0xa +; 00000004 7D05 jnl 0xb +; 00000006 5B pop bx +; 00000007 01D8 add ax,bx +; 00000009 EBF6 jmp short 0x1 +; 0000000B 81F9E803 cmp cx,0x3e8 +; 0000000F 7E05 jng 0x16 +; 00000011 5B pop bx +; 00000012 29D9 sub cx,bx +; 00000014 EBF5 jmp short 0xb +; 00000016 EBE8 jmp short 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals7 b/test-suite/standalone/sassy/tests/prims16/16locals7 Binary files differnew file mode 100644 index 000000000..d27d9ee80 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals7 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals7.scm b/test-suite/standalone/sassy/tests/prims16/16locals7.scm new file mode 100644 index 000000000..18231a429 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals7.scm @@ -0,0 +1,23 @@ +(bits 16) + +(text + (nop) + (label bar (jmp quux)) + (locals (bar quux) + (nop) + (label bar) + (jmp quux) + (nop) + (label quux) + (jmp bar) + (nop)) + (label quux (jmp bar))) + +; 00000000 90 nop +; 00000001 E90900 jmp 0xd +; 00000004 90 nop +; 00000005 E90100 jmp 0x9 +; 00000008 90 nop +; 00000009 E9F9FF jmp 0x5 +; 0000000C 90 nop +; 0000000D E9F1FF jmp 0x1 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals8 b/test-suite/standalone/sassy/tests/prims16/16locals8 Binary files differnew file mode 100644 index 000000000..da42f300c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals8 diff --git a/test-suite/standalone/sassy/tests/prims16/16locals8.scm b/test-suite/standalone/sassy/tests/prims16/16locals8.scm new file mode 100644 index 000000000..69db4f06b --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16locals8.scm @@ -0,0 +1,17 @@ +(bits 16) + +; testing out skipping of undefined declarations + +(text + (label bar + (nop)) + (locals (bar quux) + (nop) + (label quux) + (jmp bar) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 E90000 jmp 0x5 +; 00000005 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16seq1 b/test-suite/standalone/sassy/tests/prims16/16seq1 new file mode 100644 index 000000000..d335cc333 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq1 @@ -0,0 +1 @@ +๋
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16seq1.scm b/test-suite/standalone/sassy/tests/prims16/16seq1.scm new file mode 100644 index 000000000..15cfd9c35 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq1.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (seq (nop) + (nop) + (seq (nop) + (inv (nop)) + (nop)) + (seq (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 EB02 jmp short 0x8 +; 00000006 90 nop +; 00000007 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16seq2 b/test-suite/standalone/sassy/tests/prims16/16seq2 new file mode 100644 index 000000000..6037d7912 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq2 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16seq2.scm b/test-suite/standalone/sassy/tests/prims16/16seq2.scm new file mode 100644 index 000000000..328955900 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq2.scm @@ -0,0 +1,22 @@ +(bits 16) + +(text + (seq (nop) + (nop) + (seq (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (seq (nop)))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7505 jnz 0xb +; 00000006 90 nop +; 00000007 7402 jz 0xb +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16seq3 b/test-suite/standalone/sassy/tests/prims16/16seq3 new file mode 100644 index 000000000..cd617b311 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq3 @@ -0,0 +1 @@ +ut
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16seq3.scm b/test-suite/standalone/sassy/tests/prims16/16seq3.scm new file mode 100644 index 000000000..539cb8e55 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16seq3.scm @@ -0,0 +1,22 @@ +(bits 16) + +(text + (begin (nop) + (nop) + (seq (nop) + (nop) + z! + (nop) + (inv z!) + (nop)) + (nop))) + +; 00000000 90 nop +; 00000001 90 nop +; 00000002 90 nop +; 00000003 90 nop +; 00000004 7504 jnz 0xa +; 00000006 90 nop +; 00000007 7401 jz 0xa +; 00000009 90 nop +; 0000000A 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16while1 b/test-suite/standalone/sassy/tests/prims16/16while1 new file mode 100644 index 000000000..c0f285f95 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while1 @@ -0,0 +1 @@ +๋[Xu<t๕R๋Q
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16while1.scm b/test-suite/standalone/sassy/tests/prims16/16while1.scm new file mode 100644 index 000000000..6be2db9a2 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while1.scm @@ -0,0 +1,20 @@ +(bits 16) + +(text + (if (while (= al 3) + (seq (pop bx) + (pop ax) + (= bh 2))) + (push dx) + (push cx))) + +; 00000000 EB07 jmp short 0x9 +; 00000002 5B pop bx +; 00000003 58 pop ax +; 00000004 80FF02 cmp bh,0x2 +; 00000007 7507 jnz 0x10 +; 00000009 3C03 cmp al,0x3 +; 0000000B 74F5 jz 0x2 +; 0000000D 52 push dx +; 0000000E EB01 jmp short 0x11 +; 00000010 51 push cx diff --git a/test-suite/standalone/sassy/tests/prims16/16while2 b/test-suite/standalone/sassy/tests/prims16/16while2 new file mode 100644 index 000000000..138dc1d29 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while2 @@ -0,0 +1 @@ +๋[Xu<u๕R๋Q
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16while2.scm b/test-suite/standalone/sassy/tests/prims16/16while2.scm new file mode 100644 index 000000000..8cef5136d --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while2.scm @@ -0,0 +1,20 @@ +(bits 16) + +(text + (if (until (= al 3) + (seq (pop bx) + (pop ax) + (= bh 2))) + (push dx) + (push cx))) + +; 00000000 EB07 jmp short 0x9 +; 00000002 5B pop bx +; 00000003 58 pop ax +; 00000004 80FF02 cmp bh,0x2 +; 00000007 7507 jnz 0x10 +; 00000009 3C03 cmp al,0x3 +; 0000000B 75F5 jnz 0x2 +; 0000000D 52 push dx +; 0000000E EB01 jmp short 0x11 +; 00000010 51 push cx diff --git a/test-suite/standalone/sassy/tests/prims16/16while3 b/test-suite/standalone/sassy/tests/prims16/16while3 new file mode 100644 index 000000000..e137d24e0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while3 @@ -0,0 +1 @@ +๋ [๛tุ๋๖ย|๏
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16while3.scm b/test-suite/standalone/sassy/tests/prims16/16while3.scm new file mode 100644 index 000000000..d886561ff --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16while3.scm @@ -0,0 +1,26 @@ +(bits 16) + +(text + (while (< dh 20) + (begin + (iter (seq (pop bx) + (!= bx 4) + (add ax bx))) + (add dx ax)))) + +; iter is sometimes better for inner loops, since both +; while and until always generate a jmp at their start +; to the test (the test is placed after their body). +; When while or until start the body of an outer while/until +; that means a jmp or jcc to a jmp will be generated. +; Using iter for the inner loop fixes this. + +; 00000000 EB0C jmp short 0xe +; 00000002 5B pop bx +; 00000003 83FB04 cmp bx,byte +0x4 +; 00000006 7404 jz 0xc +; 00000008 01D8 add ax,bx +; 0000000A EBF6 jmp short 0x2 +; 0000000C 01C2 add dx,ax +; 0000000E 80FE14 cmp dh,0x14 +; 00000011 7CEF jl 0x2 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose1 b/test-suite/standalone/sassy/tests/prims16/16with-lose1 new file mode 100644 index 000000000..2d08850ac --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose1 @@ -0,0 +1 @@ +รtw๚{๗้๒
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose1.scm b/test-suite/standalone/sassy/tests/prims16/16with-lose1.scm new file mode 100644 index 000000000..1f87d4ab7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose1.scm @@ -0,0 +1,22 @@ +(bits 16) + +(text + (label foo (ret)) + (seq (nop) + (with-lose foo + (iter (alt (seq (nop) z!) + (seq (nop) a!) + (seq (nop) po!)))) + (nop))) +; foo: +; 00000000 C3 ret + +; 00000001 90 nop +; 00000002 90 nop +; 00000003 74FD jz 0x2 +; 00000005 90 nop +; 00000006 77FA ja 0x2 +; 00000008 90 nop +; 00000009 7BF7 jpo 0x2 +; 0000000B E9F0FFFFFF jmp 0x0 +; 00000010 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose2 b/test-suite/standalone/sassy/tests/prims16/16with-lose2 Binary files differnew file mode 100644 index 000000000..a0935f401 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose2 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose2.scm b/test-suite/standalone/sassy/tests/prims16/16with-lose2.scm new file mode 100644 index 000000000..89e7a9311 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose2.scm @@ -0,0 +1,21 @@ +(bits 16) + +(text + (label foo (ret)) + (seq (nop) + (with-lose (reloc my-reloc foo 100) + (iter (alt (seq (nop) z!) + (seq (nop) a!) + (seq (nop) po!)))) + (nop))) + +; 00000000 C3 ret +; 00000001 90 nop +; 00000002 90 nop +; 00000003 74FD jz 0x2 +; 00000005 90 nop +; 00000006 77FA ja 0x2 +; 00000008 90 nop +; 00000009 7BF7 jpo 0x2 +; 0000000B E96400 jmp 0x72 +; 0000000E 90 nop diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose3 b/test-suite/standalone/sassy/tests/prims16/16with-lose3 new file mode 100644 index 000000000..3acbcdf00 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose3 @@ -0,0 +1 @@ +รรร
๘๕๒
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-lose3.scm b/test-suite/standalone/sassy/tests/prims16/16with-lose3.scm new file mode 100644 index 000000000..27ac9beb9 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-lose3.scm @@ -0,0 +1,26 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (label qudr (ret)) + (seq + (nop) + (with-lose foo z!) + (with-lose bar ge!) + (with-lose qudr a!) + (nop))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 C3 ret +; 00000003 90 nop +; 00000004 0F85F8FF jnz near 0x0 +; 00000008 0F8CF5FF jl near 0x1 +; 0000000C 0F86F2FF jna near 0x2 +; 00000010 90 nop + + + + +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose1 b/test-suite/standalone/sassy/tests/prims16/16with-win-lose1 Binary files differnew file mode 100644 index 000000000..394e8067c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose1 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose1.scm b/test-suite/standalone/sassy/tests/prims16/16with-win-lose1.scm new file mode 100644 index 000000000..aa6d9bc4f --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose1.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (with-win-lose foo bar + (= ax 3)) + (seq (nop) (nop) (nop)) + (label foo (ret)) + (label bar (ret))) + +; 00000000 3D0300 cmp ax,0x3 +; 00000003 0F840600 jz near 0xd +; 00000007 E90400 jmp 0xe +; 0000000A 90 nop +; 0000000B 90 nop +; 0000000C 90 nop +; 0000000D C3 ret +; 0000000E C3 ret diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose2 b/test-suite/standalone/sassy/tests/prims16/16with-win-lose2 Binary files differnew file mode 100644 index 000000000..6fc45b806 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose2 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose2.scm b/test-suite/standalone/sassy/tests/prims16/16with-win-lose2.scm new file mode 100644 index 000000000..748e8cae1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose2.scm @@ -0,0 +1,24 @@ +(bits 16) + +(text + (with-win-lose foo bar + (while (= ax 3) + (seq (nop) + (nop) + l!))) + (seq (nop) (nop) (nop)) + (label foo (ret)) + (label bar (ret))) + +; 00000000 EB06 jmp short 0x8 +; 00000002 90 nop +; 00000003 90 nop +; 00000004 0F8D0C00 jnl near 0x14 +; 00000008 3D0300 cmp ax,0x3 +; 0000000B 74F5 jz 0x2 +; 0000000D E90300 jmp 0x13 +; 00000010 90 nop +; 00000011 90 nop +; 00000012 90 nop +; 00000013 C3 ret +; 00000014 C3 ret diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose3 b/test-suite/standalone/sassy/tests/prims16/16with-win-lose3 Binary files differnew file mode 100644 index 000000000..bbb1ac49e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose3 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose3.scm b/test-suite/standalone/sassy/tests/prims16/16with-win-lose3.scm new file mode 100644 index 000000000..f84ffc450 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose3.scm @@ -0,0 +1,24 @@ +(bits 16) + +(text + (label foo (ret)) + (with-win-lose bar foo + (if (= ax 3) + (nop) + (alt (seq (nop) a!) + (seq (nop) p!)))) + (nop) + (label bar (ret))) + +; 00000000 C3 ret +; 00000001 3D0300 cmp ax,0x3 +; 00000004 7504 jnz 0xa +; 00000006 90 nop +; 00000007 E90E00 jmp 0x18 +; 0000000A 90 nop +; 0000000B 0F870900 ja near 0x18 +; 0000000F 90 nop +; 00000010 0F8A0400 jpe near 0x18 +; 00000014 E9E9FF jmp 0x0 +; 00000017 90 nop +; 00000018 C3 ret diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose4 b/test-suite/standalone/sassy/tests/prims16/16with-win-lose4 new file mode 100644 index 000000000..0bdd94c4c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose4 @@ -0,0 +1 @@ +SP๙uร่๕
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose4.scm b/test-suite/standalone/sassy/tests/prims16/16with-win-lose4.scm new file mode 100644 index 000000000..a09fdd925 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose4.scm @@ -0,0 +1,15 @@ +(bits 16) + +(text + (label foo (push bx)) + (with-win-lose (ret) (call foo) + (seq + (push ax) + (= cx 4)))) + +; 00000000 53 push bx +; 00000001 50 push ax +; 00000002 83F904 cmp cx,byte +0x4 +; 00000005 7501 jnz 0x8 +; 00000007 C3 ret +; 00000008 E8F5FF call 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose5 b/test-suite/standalone/sassy/tests/prims16/16with-win-lose5 new file mode 100644 index 000000000..db9f9cd54 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose5 @@ -0,0 +1 @@ +SP๙u้่๓
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win-lose5.scm b/test-suite/standalone/sassy/tests/prims16/16with-win-lose5.scm new file mode 100644 index 000000000..efdb8a1af --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win-lose5.scm @@ -0,0 +1,17 @@ +(bits 16) + +(text + (label foo (push bx)) + (with-win-lose + (jmp 1000) + (call foo) + (seq + (push ax) + (= cx 4)))) + +; 00000000 53 push bx +; 00000001 50 push ax +; 00000002 83F904 cmp cx,byte +0x4 +; 00000005 7503 jnz 0xa +; 00000007 E9DE03 jmp 0x3e8 +; 0000000A E8F3FF call 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win1 b/test-suite/standalone/sassy/tests/prims16/16with-win1 new file mode 100644 index 000000000..d309920cc --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win1 @@ -0,0 +1 @@ +รรf๘ufP้๔fS้๏
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win1.scm b/test-suite/standalone/sassy/tests/prims16/16with-win1.scm new file mode 100644 index 000000000..486095f1c --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win1.scm @@ -0,0 +1,18 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (with-win bar + (if (= eax 3) + (push eax) + (push ebx)))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 6683F803 cmp eax,byte +0x3 +; 00000006 7505 jnz 0xd +; 00000008 6650 push eax +; 0000000A E9F4FF jmp 0x1 +; 0000000D 6653 push ebx +; 0000000F E9EFFF jmp 0x1 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win2 b/test-suite/standalone/sassy/tests/prims16/16with-win2 new file mode 100644 index 000000000..f046668d0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win2 @@ -0,0 +1 @@ +รรf๘ufP้๔fS้๎
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win2.scm b/test-suite/standalone/sassy/tests/prims16/16with-win2.scm new file mode 100644 index 000000000..1ecda0ec4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win2.scm @@ -0,0 +1,19 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (with-win bar + (if (= eax 3) + (push eax) + (with-win foo + (push ebx))))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 6683F803 cmp eax,byte +0x3 +; 00000006 7505 jnz 0xd +; 00000008 6650 push eax +; 0000000A E9F4FF jmp 0x1 +; 0000000D 6653 push ebx +; 0000000F E9EEFF jmp 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win3 b/test-suite/standalone/sassy/tests/prims16/16with-win3 Binary files differnew file mode 100644 index 000000000..768b1de50 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win3 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win3.scm b/test-suite/standalone/sassy/tests/prims16/16with-win3.scm new file mode 100644 index 000000000..38fc37944 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win3.scm @@ -0,0 +1,28 @@ +(bits 16) + +(text + (label foo (ret)) + (label bar (ret)) + (if (while (!= ax 3) + (seq (pop ax) + (inc ax) + (< ax 10))) + (with-win bar + (alt z! a!)) + (with-win foo + (push bx)))) + +; 00000000 C3 ret +; 00000001 C3 ret +; 00000002 EB07 jmp short 0xb +; 00000004 58 pop ax +; 00000005 40 inc ax +; 00000006 3D0A00 cmp ax,0xa +; 00000009 7D0E jnl 0x19 +; 0000000B 3D0300 cmp ax,0x3 +; 0000000E 75F4 jnz 0x4 +; 00000010 0F84EDFF jz near 0x1 +; 00000014 7607 jna 0x1d +; 00000016 E9E8FF jmp 0x1 +; 00000019 53 push bx +; 0000001A E9E3FF jmp 0x0 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win4 b/test-suite/standalone/sassy/tests/prims16/16with-win4 new file mode 100644 index 000000000..289f34835 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win4 @@ -0,0 +1 @@ +SPร
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win4.scm b/test-suite/standalone/sassy/tests/prims16/16with-win4.scm new file mode 100644 index 000000000..e25c2633e --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win4.scm @@ -0,0 +1,10 @@ +(bits 16) + +(text + (label foo (push bx)) + (seq (with-win (ret) + (push ax)))) + +; 00000000 53 push bx +; 00000001 50 push ax +; 00000002 C3 ret diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win5 b/test-suite/standalone/sassy/tests/prims16/16with-win5 Binary files differnew file mode 100644 index 000000000..bb213e587 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win5 diff --git a/test-suite/standalone/sassy/tests/prims16/16with-win5.scm b/test-suite/standalone/sassy/tests/prims16/16with-win5.scm new file mode 100644 index 000000000..3bb5d3b77 --- /dev/null +++ b/test-suite/standalone/sassy/tests/prims16/16with-win5.scm @@ -0,0 +1,19 @@ +(bits 16) + +(text + (mov ax 10) +; this should loop 7 times + (label foo + (if (= ax 3) + (with-win (ret)) + (with-win foo + (sub ax 1))))) + +; 00000000 B80A00 mov ax,0xa +; 00000003 3D0300 cmp ax,0x3 +; 00000006 7501 jnz 0x9 +; 00000008 C3 ret +; 00000009 2D0100 sub ax,0x1 +; 0000000C E9F4FF jmp 0x3 + + diff --git a/test-suite/standalone/sassy/tests/quick-elf.scm b/test-suite/standalone/sassy/tests/quick-elf.scm new file mode 100644 index 000000000..e75df1303 --- /dev/null +++ b/test-suite/standalone/sassy/tests/quick-elf.scm @@ -0,0 +1,17 @@ +(sassy-make-elf + "tests/quick-elf-new.o" + (sassy + '((text + (foo (begin + (push ebp) + (mov ebp esp) + (get-got) + (lea eax (gotoff quux 4)) + (mov ecx (got qadr)) + (call (plt wizo)) + (jmp wizo)))) + (import qadr wizo) + (export got-name) + (data (quux (dwords 100 200))) + (data (pointer (dwords (sym quux))))))) +
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/r-rm b/test-suite/standalone/sassy/tests/r-rm new file mode 100644 index 000000000..f5d008f1b --- /dev/null +++ b/test-suite/standalone/sassy/tests/r-rm @@ -0,0 +1 @@ +fผุfฝ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/r-rm.asm b/test-suite/standalone/sassy/tests/r-rm.asm new file mode 100644 index 000000000..939ea0a77 --- /dev/null +++ b/test-suite/standalone/sassy/tests/r-rm.asm @@ -0,0 +1,5 @@ +BITS 32 +section .text +foo: +bsf bx, ax +bsr bx, [eax] diff --git a/test-suite/standalone/sassy/tests/r-rm.scm b/test-suite/standalone/sassy/tests/r-rm.scm new file mode 100644 index 000000000..17d1bbc41 --- /dev/null +++ b/test-suite/standalone/sassy/tests/r-rm.scm @@ -0,0 +1,4 @@ +( +(bsf bx ax) +(bsr bx (& eax)) +) diff --git a/test-suite/standalone/sassy/tests/r-rm16 b/test-suite/standalone/sassy/tests/r-rm16 new file mode 100644 index 000000000..a3896cef0 --- /dev/null +++ b/test-suite/standalone/sassy/tests/r-rm16 @@ -0,0 +1 @@ +ผุgฝ
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/r-rm16.asm b/test-suite/standalone/sassy/tests/r-rm16.asm new file mode 100644 index 000000000..e0ac880b5 --- /dev/null +++ b/test-suite/standalone/sassy/tests/r-rm16.asm @@ -0,0 +1,5 @@ +BITS 16 +section .text +foo: +bsf bx, ax +bsr bx, [eax] diff --git a/test-suite/standalone/sassy/tests/regenerate.scm b/test-suite/standalone/sassy/tests/regenerate.scm new file mode 100644 index 000000000..752aed054 --- /dev/null +++ b/test-suite/standalone/sassy/tests/regenerate.scm @@ -0,0 +1,2 @@ +(load "tests/generate-nasm.scm") +(load "tests/generate-prim.scm") diff --git a/test-suite/standalone/sassy/tests/ret b/test-suite/standalone/sassy/tests/ret new file mode 100644 index 000000000..7d800b7c4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/ret @@ -0,0 +1 @@ +รย่ห
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/ret.asm b/test-suite/standalone/sassy/tests/ret.asm new file mode 100644 index 000000000..d50a52f82 --- /dev/null +++ b/test-suite/standalone/sassy/tests/ret.asm @@ -0,0 +1,6 @@ +BITS 32 +section .text +foo: +ret +retn 1000 +retf diff --git a/test-suite/standalone/sassy/tests/ret.scm b/test-suite/standalone/sassy/tests/ret.scm new file mode 100644 index 000000000..2a0fba23b --- /dev/null +++ b/test-suite/standalone/sassy/tests/ret.scm @@ -0,0 +1,5 @@ +( +(ret) +(retn 1000) +(retf) +) diff --git a/test-suite/standalone/sassy/tests/ret16 b/test-suite/standalone/sassy/tests/ret16 new file mode 100644 index 000000000..7d800b7c4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/ret16 @@ -0,0 +1 @@ +รย่ห
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/ret16.asm b/test-suite/standalone/sassy/tests/ret16.asm new file mode 100644 index 000000000..3c9a9cba3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/ret16.asm @@ -0,0 +1,6 @@ +BITS 16 +section .text +foo: +ret +retn 1000 +retf diff --git a/test-suite/standalone/sassy/tests/rm b/test-suite/standalone/sassy/tests/rm Binary files differnew file mode 100644 index 000000000..facb5cb67 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm diff --git a/test-suite/standalone/sassy/tests/rm.asm b/test-suite/standalone/sassy/tests/rm.asm new file mode 100644 index 000000000..f004a8e4a --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm.asm @@ -0,0 +1,8 @@ +BITS 32 +section .text +foo: +invlpg [dword 300+8*esi+esp] +lgdt [dword 300+8*esi+esp] +sgdt [dword 300+8*esi+esp] +lidt [dword 300+8*esi+esp] +sidt [dword 300+8*esi+esp] diff --git a/test-suite/standalone/sassy/tests/rm.scm b/test-suite/standalone/sassy/tests/rm.scm new file mode 100644 index 000000000..bf077fda1 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm.scm @@ -0,0 +1,8 @@ +( +(invlpg (& 200 (* 8 esi) esp 100)) +(lgdt (& 200 (* 8 esi) esp 100)) +(sgdt (& 200 (* 8 esi) esp 100)) +(lidt (& 200 (* 8 esi) esp 100)) +(sidt (& 200 (* 8 esi) esp 100)) +) + diff --git a/test-suite/standalone/sassy/tests/rm16 b/test-suite/standalone/sassy/tests/rm16 Binary files differnew file mode 100644 index 000000000..23326523c --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm16 diff --git a/test-suite/standalone/sassy/tests/rm16.asm b/test-suite/standalone/sassy/tests/rm16.asm new file mode 100644 index 000000000..a1e550a64 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm16.asm @@ -0,0 +1,8 @@ +BITS 16 +section .text +foo: +invlpg [dword 300+8*esi+esp] +lgdt [dword 300+8*esi+esp] +sgdt [dword 300+8*esi+esp] +lidt [dword 300+8*esi+esp] +sidt [dword 300+8*esi+esp] diff --git a/test-suite/standalone/sassy/tests/rm2 b/test-suite/standalone/sassy/tests/rm2 new file mode 100644 index 000000000..7d325165f --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm2 @@ -0,0 +1 @@ +๔$$
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/rm2.asm b/test-suite/standalone/sassy/tests/rm2.asm new file mode 100644 index 000000000..c5da69740 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm2.asm @@ -0,0 +1,5 @@ +BITS 32 +section .text +foo: +lmsw sp +smsw [esp] diff --git a/test-suite/standalone/sassy/tests/rm2.scm b/test-suite/standalone/sassy/tests/rm2.scm new file mode 100644 index 000000000..8f8e297c7 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm2.scm @@ -0,0 +1,4 @@ +( +(lmsw sp) +(smsw (& esp)) +) diff --git a/test-suite/standalone/sassy/tests/rm216 b/test-suite/standalone/sassy/tests/rm216 new file mode 100644 index 000000000..fe1dfb112 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm216 @@ -0,0 +1 @@ +๔g$$
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/rm216.asm b/test-suite/standalone/sassy/tests/rm216.asm new file mode 100644 index 000000000..7c4428f25 --- /dev/null +++ b/test-suite/standalone/sassy/tests/rm216.asm @@ -0,0 +1,5 @@ +BITS 16 +section .text +foo: +lmsw sp +smsw [esp] diff --git a/test-suite/standalone/sassy/tests/run-tests.scm b/test-suite/standalone/sassy/tests/run-tests.scm new file mode 100644 index 000000000..d10db1e1b --- /dev/null +++ b/test-suite/standalone/sassy/tests/run-tests.scm @@ -0,0 +1,541 @@ + ;=========================; + ; ; + ; Sassy test suite ; + ; ; + ;=========================; + +; The three files generate-nasm.scm, generate-prims.scm, and +; generate-direc.scm generate the baselines for these tests. Of the +; three, only generate-nasm.scm should really ever be run again unless +; Sassy's language actually changes, since the corectness of the output +; for generate-prims and generate-direc has to be verified by hand. + +; (generate-nasm generates nasm versions of the Sassy code and assembles +; them by calling nasm -f bin ??. For mzscheme) + +(define %%%include-test '((entry foo))) + +(define (sassy-run-tests . args) + + (define (sassy-symbol-get r n) + (hash-table-ref (sassy-symbol-table r) n)) + + (define (sassy-reloc->list reloc) + (list (sassy-reloc-name reloc) + (sassy-reloc-section reloc) + (sassy-reloc-offset reloc) + (sassy-reloc-type reloc))) + + (define (file-chars->list file) + (with-input-from-file file + (lambda () + (let iter ((new (read-byte))) + (if (eof-object? new) + '() + (cons new (iter (read-byte)))))))) + + (define (l->hex lst) + (map (lambda (x) + (number->string x 16)) + lst)) + + (define (match-lists subl longl) + (let iter ((rs subl) + (rl longl)) + (cond ((null? rs) rl) + ((= (car rs) (car rl)) + (iter (cdr rs) (cdr rl))) + (else (newline) + (display (l->hex subl)) + (newline) + (display (l->hex longl)) + (newline) + #f)))) + + (define (match-opcodes l1 l2) + (cond ((and (null? l1) (null? l2)) #t) + ((or (null? l1) (null? l2)) #f) + ((= (car l1) (car l2)) (match-opcodes (cdr l1) (cdr l2))) + ;be forgiving about prefixes + ((and (not (null? (cdr l1))) + (not (null? (cdr l2))) + (or (and (= (car l1) #x66) (= (cadr l1) #x67) + (= (car l2) #x67) (= (cadr l2) #x66)) + (and (= (car l1) #x67) (= (cadr l1) #x66) + (= (car l2) #x66) (= (cadr l2) #x67)))) + (match-opcodes (cddr l1) (cddr l2))) + (else #f))) + + + (define (sassy-raw c bits32?) + (sassy-text-list + (sassy (if bits32? + `((text (label foo) + (begin ,@c))) + `((bits 16) + (text (label foo) + (begin ,@c))))))) + + (define (succeed x) + (display "test passed: ") + (display x) + (newline)) + + (define (fail x) + (display "TEST FAILED: ") + (display x) + (newline)) + + +;============================================================================; +; opcode-test ; +; ================ ; +; The opcode tests are fairly exhaustive. Every opcode is tested, and ; +; every possible successful parse, whether the opcode(s) use a "gen-" ; +; template or has its own. The output is compared to NASM's. ; +;============================================================================; + (define (opcode-test bits32?) + (newline) + (for-each + (lambda (x) + (let* ((the-codes (with-input-from-file x (lambda () (read)))) + (sassy-res (sassy-raw the-codes bits32?)) + (nasm-res (file-chars->list + (string-append + (substring x 0 (- (string-length x) 4)) + (if bits32? "" "16"))))) + (if (match-opcodes nasm-res sassy-res) + (succeed (if bits32? x (string-append "(16 bit) " x))) + (begin (fail (if bits32? x (string-append "(16 bit) " x))) + (let iter ((codes the-codes)) + (let ((foo (match-lists + (sassy-raw (list (car codes)) bits32?) + nasm-res))) + (if foo + (begin (set! nasm-res foo) + (iter (cdr codes))) + (begin (display (car codes)) + (newline))))) + (error ""))))) + (if bits32? + the-opcode-files + the-opcode16-files))) + + (define the-opcode-files + (list "tests/mem-ref.scm" + "tests/non.scm" + "tests/alu.scm" + "tests/bt.scm" + "tests/shift.scm" + "tests/setcc.scm" + "tests/cmovcc.scm" + "tests/decinc.scm" + "tests/plier.scm" + "tests/load.scm" + "tests/movx.scm" + "tests/r-rm.scm" + "tests/rm.scm" + "tests/rm2.scm" + "tests/aa.scm" + "tests/ret.scm" + "tests/doub-shift.scm" + "tests/cmpx.scm" + "tests/misc1.scm" + "tests/misc2.scm" + "tests/misc3.scm" + "tests/jcc.scm" + "tests/jumps.scm" + "tests/prefix.scm" + "tests/fp0.scm" + "tests/fp1.scm" + "tests/fp2.scm" + "tests/fp3.scm" + "tests/mmx.scm" + "tests/sse1.scm" + "tests/sse2.scm" + "tests/sse3.scm" + "tests/seg.scm" + "tests/brt.scm" + )) + + (define the-opcode16-files + (list + "tests/alu.scm" + "tests/bt.scm" + "tests/cmpx.scm" + "tests/decinc.scm" + "tests/doub-shift.scm" + "tests/jcc.scm" + "tests/jumps.scm" + "tests/load.scm" + "tests/mem-ref.scm" + "tests/misc1.scm" + "tests/misc2.scm" + "tests/movx.scm" + "tests/non.scm" + "tests/plier.scm" + "tests/prefix.scm" + "tests/ret.scm" + "tests/rm2.scm" + "tests/rm.scm" + "tests/r-rm.scm" + "tests/setcc.scm" + "tests/shift.scm" + "tests/seg.scm")) + + +;================================; +; direc-test ; +; ========== ; +; The basic functionality ; +;================================; + + (define (direc-test) + (newline) + (test-export) + (test-import) + (test-heap) + (test-misc) + (test-data) + (test-data-locals) + (test-data-reloc)) + + (define (test-export) + (let ((o (sassy '((export foo quux) + (text (label bar (pop eax)) + (label wizo (push eax))) + (export wizo))))) + (or (and (eqv? 'export (sassy-symbol-scope (sassy-symbol-get o 'foo))) + (eqv? 'export (sassy-symbol-scope (sassy-symbol-get o 'quux))) + (eqv? 'export (sassy-symbol-scope (sassy-symbol-get o 'wizo))) + (eqv? 'local (sassy-symbol-scope (sassy-symbol-get o 'bar))) + (succeed "exports")) + (fail "exports")))) + + (define (test-import) + (let ((o (sassy '((export bar) + (import wizo) + (text (label bar (pop eax)) + (label foo (push edx))) + (import qadr))))) + (or (and (eqv? 'export (sassy-symbol-scope (sassy-symbol-get o 'bar))) + (eqv? 'import (sassy-symbol-scope (sassy-symbol-get o 'wizo))) + (eqv? 'import (sassy-symbol-scope (sassy-symbol-get o 'qadr))) + (eqv? 'local (sassy-symbol-scope (sassy-symbol-get o 'foo))) + (succeed "imports")) + (fail "imports")))) + + (define (test-heap) + (let ((o (sassy '((heap (align 128) + (label foo (bytes 5)) + (words 32) + (align 16) + (label bar (dwords 100))))))) + (or (and (= 480 (sassy-heap-size o)) + (= 128 (sassy-heap-align o)) + (let ((foo-s (sassy-symbol-get o 'foo))) + (and (= 0 (sassy-symbol-offset foo-s)) + (= 5 (sassy-symbol-size foo-s)))) + (let ((bar-s (sassy-symbol-get o 'bar))) + (and (= 80 (sassy-symbol-offset bar-s)) + (= 400 (sassy-symbol-size bar-s)))) + (succeed "heap")) + (fail "heap")))) + + (define (test-misc) + (let ((o (sassy '((org 1000) + (include %%%include-test "tests/include.scm"))))) + (succeed "include") + (and (or (and (eqv? 'foo (sassy-entry-point o)) + (succeed "entry")) + (fail "entry")) + (or (and (= 1000 (sassy-text-org o)) + (= 1024 (sassy-symbol-offset (sassy-symbol-get o 'foo))) + (succeed "org")) + (fail "org")) + (or (and (= 32 (sassy-text-align o)) + (equal? (sassy-text-list o) + (append (make-list 24 #x90) (list 80))) + (succeed "text-align")) + (fail "text-align"))))) + + (define (test-data) + (let ((o (sassy '((data (label foo (dwords "ab")) + (align 8) + (label bar (dwords 100 quux)) + (dwords -3242.52) + (qwords -84930284902.48392048) + (label quux (dwords -1 #\A bar))))))) + (and (or (and (= 40 (sassy-data-size o)) + (= 8 (sassy-data-align o)) + (succeed "data-align")) + (fail "data-align")) + (or (and (= 4 (sassy-symbol-size (sassy-symbol-get o 'foo))) + (= 0 (sassy-symbol-offset (sassy-symbol-get o 'foo))) + (= 8 (sassy-symbol-size (sassy-symbol-get o 'bar))) + (= 8 (sassy-symbol-offset (sassy-symbol-get o 'bar))) + (= 12 (sassy-symbol-size (sassy-symbol-get o 'quux))) + (= 28 (sassy-symbol-offset (sassy-symbol-get o 'quux))) + (equal? (sassy-data-list o) + '(97 98 0 0 0 0 0 0 100 0 0 0 28 0 0 0 82 + 168 74 197 226 123 102 77 61 198 51 + 194 255 255 255 255 65 0 0 0 8 0 0 0)) + (succeed "data")) + (fail "data"))))) + + (define (test-data-locals) + (let ((o (sassy '((data + (dwords 0) + (label foo (dwords "abcd" "efgh")) + (locals (foo) + (label foo + (dwords #xeeeeeeee #xffffffff) + (dwords foo))) + (dwords foo)))))) + (if (equal? (sassy-data-list o) + '(0 0 0 0 97 98 99 100 101 102 103 104 238 238 238 238 255 + 255 255 255 12 0 0 0 4 0 0 0)) + (succeed "data-locals") + (fail "data-locals")))) + + (define (test-data-reloc) + (let ((o (sassy '((data (dwords 100 (reloc abs $here 8)) + (label foo (dwords (reloc abs $here) + (reloc blah quux)))) + (text + (begin (push eax) + (nop) + (nop) + (nop)) + (label quux (push edx))))))) + (or (and (equal? (sassy-data-list o) + '(100 0 0 0 12 0 0 0 8 0 0 0 4 0 0 0)) + (equal? '(quux data 12 blah) + (sassy-reloc->list (car (sassy-reloc-list o)))) + (equal? '(#f data 8 abs) + (sassy-reloc->list (cadr (sassy-reloc-list o)))) + (equal? '(#f data 4 abs) + (sassy-reloc->list (caddr (sassy-reloc-list o)))) + (succeed "data-reloc")) + (fail "data-reloc")))) + +;============================================================================; +; prim-test ; +; ========= ; +; A series of several short tests of some probably (hopefully) common ; +; usage idioms of the primitives. ; +;============================================================================; + (define (prim-test) + (newline) + (for-each + (lambda (x) + (let* ((goal (file-chars->list + (substring x 0 (- (string-length x) 4)))) + (source (sassy-text-list (sassy x)))) + (if (equal? goal source) + (succeed x) + (begin (fail x) + (error ""))))) + the-prim-files)) + + (define the-prim-files + (list "tests/prims/seq1.scm" + "tests/prims/seq2.scm" + "tests/prims/seq3.scm" + "tests/prims/alt1.scm" + "tests/prims/alt2.scm" + "tests/prims/alt3.scm" + "tests/prims/alt4.scm" + "tests/prims/begin1.scm" + "tests/prims/begin2.scm" + "tests/prims/begin3.scm" + "tests/prims/begin4.scm" + "tests/prims/begin5.scm" + "tests/prims/if1.scm" + "tests/prims/if2.scm" + "tests/prims/if3.scm" + "tests/prims/if4.scm" + "tests/prims/inv1.scm" + "tests/prims/inv2.scm" + "tests/prims/inv3.scm" + "tests/prims/inv4.scm" + "tests/prims/inv5.scm" + "tests/prims/inv6.scm" + "tests/prims/iter1.scm" + "tests/prims/iter2.scm" + "tests/prims/iter3.scm" + "tests/prims/iter4.scm" + "tests/prims/iter5.scm" + "tests/prims/iter6.scm" + "tests/prims/leap-mark1.scm" + "tests/prims/leap-mark2.scm" + "tests/prims/leap-mark3.scm" + "tests/prims/while1.scm" + "tests/prims/while2.scm" + "tests/prims/while3.scm" + "tests/prims/with-win1.scm" + "tests/prims/with-win2.scm" + "tests/prims/with-win3.scm" + "tests/prims/with-win4.scm" + "tests/prims/with-win5.scm" + "tests/prims/with-lose1.scm" + "tests/prims/with-lose2.scm" + "tests/prims/with-lose3.scm" + "tests/prims/with-win-lose1.scm" + "tests/prims/with-win-lose2.scm" + "tests/prims/with-win-lose3.scm" + "tests/prims/with-win-lose4.scm" + "tests/prims/with-win-lose5.scm" + "tests/prims/exp-k1.scm" + "tests/prims/exp-k2.scm" + "tests/prims/exp-k3.scm" + "tests/prims/exp-k4.scm" + "tests/prims/esc1.scm" + "tests/prims/esc2.scm" + "tests/prims/esc3.scm" + "tests/prims/esc4.scm" + "tests/prims/esc5.scm" + "tests/prims/esc6.scm" + "tests/prims/esc7.scm" + "tests/prims/label1.scm" + "tests/prims/label2.scm" + "tests/prims/label3.scm" + "tests/prims/label4.scm" + "tests/prims/locals1.scm" + "tests/prims/locals2.scm" + "tests/prims/locals3.scm" + "tests/prims/locals4.scm" + "tests/prims/locals5.scm" + "tests/prims/locals6.scm" + "tests/prims/locals7.scm" + "tests/prims/locals8.scm" + + + "tests/prims16/16alt1.scm" + "tests/prims16/16alt2.scm" + "tests/prims16/16alt3.scm" + "tests/prims16/16alt4.scm" + "tests/prims16/16begin1.scm" + "tests/prims16/16begin2.scm" + "tests/prims16/16begin3.scm" + "tests/prims16/16begin4.scm" + "tests/prims16/16begin5.scm" + "tests/prims16/16if1.scm" + "tests/prims16/16if2.scm" + "tests/prims16/16if3.scm" + "tests/prims16/16if4.scm" + "tests/prims16/16inv1.scm" + "tests/prims16/16inv2.scm" + "tests/prims16/16inv3.scm" + "tests/prims16/16inv4.scm" + "tests/prims16/16inv5.scm" + "tests/prims16/16inv6.scm" + "tests/prims16/16iter1.scm" + "tests/prims16/16iter2.scm" + "tests/prims16/16iter3.scm" + "tests/prims16/16iter4.scm" + "tests/prims16/16iter5.scm" + "tests/prims16/16iter6.scm" + "tests/prims16/16exp-k1.scm" + "tests/prims16/16exp-k2.scm" + "tests/prims16/16exp-k3.scm" + "tests/prims16/16exp-k4.scm" + "tests/prims16/16label1.scm" + "tests/prims16/16label2.scm" + "tests/prims16/16label3.scm" + "tests/prims16/16label4.scm" + "tests/prims16/16leap-mark1.scm" + "tests/prims16/16leap-mark2.scm" + "tests/prims16/16leap-mark3.scm" + "tests/prims16/16locals1.scm" + "tests/prims16/16locals2.scm" + "tests/prims16/16locals3.scm" + "tests/prims16/16locals4.scm" + "tests/prims16/16locals5.scm" + "tests/prims16/16locals6.scm" + "tests/prims16/16locals7.scm" + "tests/prims16/16locals8.scm" + "tests/prims16/16seq1.scm" + "tests/prims16/16seq2.scm" + "tests/prims16/16seq3.scm" + "tests/prims16/16while1.scm" + "tests/prims16/16while2.scm" + "tests/prims16/16while3.scm" + "tests/prims16/16with-lose1.scm" + "tests/prims16/16with-lose2.scm" + "tests/prims16/16with-lose3.scm" + "tests/prims16/16with-win1.scm" + "tests/prims16/16with-win2.scm" + "tests/prims16/16with-win3.scm" + "tests/prims16/16with-win4.scm" + "tests/prims16/16with-win5.scm" + "tests/prims16/16with-win-lose1.scm" + "tests/prims16/16with-win-lose2.scm" + "tests/prims16/16with-win-lose3.scm" + "tests/prims16/16with-win-lose4.scm" + "tests/prims16/16with-win-lose5.scm" + + )) + +;============================================================================; +; elf-test ; +; ========= ; +; A series of several short tests of some probably (hopefully) common ; +; usage idioms of the primitives. ; +;============================================================================; + (define (elf-test) + (newline) + (for-each + (lambda (x) + (let* ((source-name + (string-append + (substring x 0 (- (string-length x) 4)) + ".new.o")) + (goal (file-chars->list + (string-append + (substring x 0 (- (string-length x) 4)) + ".o"))) + (source (begin (sassy-make-elf source-name + (sassy x)) + (file-chars->list source-name)))) + (if (equal? goal source) + (succeed x) + (begin (fail x) + (error ""))))) + the-elf-files)) + + (define the-elf-files + (list "tests/sysexit.scm" + "tests/fac5.scm" + "tests/cell.scm" + + "tests/sysexit2.scm" ; static linking + "tests/count.scm" + + "tests/libhello.scm" ; dynamic linking + "tests/libgoodbye.scm" + "tests/hello.scm" + "tests/bye.scm" + + "tests/localdata1.scm" + "tests/localdata2.scm" + "tests/localdata3.scm" + "tests/localdata4.scm" + + "tests/sect.scm")) ; sections of anon relocs + + (if (eqv? 'all (car args)) + (begin (opcode-test #t) + (opcode-test #f) + (prim-test) + (direc-test) + (elf-test)) + (let iter ((r args)) + (if (not (null? r)) + (begin (case (car r) + ((opcodes) (opcode-test #t)) + ((opcodes16) (opcode-test #f)) + ((prims) (prim-test)) + ((direcs) (direc-test)) + ((elf) (elf-test))) + (iter (cdr r))))))) diff --git a/test-suite/standalone/sassy/tests/sect.scm b/test-suite/standalone/sassy/tests/sect.scm new file mode 100644 index 000000000..78f786cda --- /dev/null +++ b/test-suite/standalone/sassy/tests/sect.scm @@ -0,0 +1,9 @@ +(data + (label foo + (dwords 100 200 300 (reloc abs $here 4)))) + +(text + (label bar + (esc ((push $win)) + (seq (nop) + (nop))))) diff --git a/test-suite/standalone/sassy/tests/seg b/test-suite/standalone/sassy/tests/seg Binary files differnew file mode 100644 index 000000000..d7b0ab130 --- /dev/null +++ b/test-suite/standalone/sassy/tests/seg diff --git a/test-suite/standalone/sassy/tests/seg.asm b/test-suite/standalone/sassy/tests/seg.asm new file mode 100644 index 000000000..be0a849fa --- /dev/null +++ b/test-suite/standalone/sassy/tests/seg.asm @@ -0,0 +1,9 @@ +BITS 32 +section .text +foo: +mov [es:eax], dword 3 +add edx, [ds:ebx] +xor ecx, [cs:4+eax] +push dword [dword es:4] +sub eax, [dword fs:foo] +and dword [dword gs:foo+edx], byte 3 diff --git a/test-suite/standalone/sassy/tests/seg.scm b/test-suite/standalone/sassy/tests/seg.scm new file mode 100644 index 000000000..b9b01a9dc --- /dev/null +++ b/test-suite/standalone/sassy/tests/seg.scm @@ -0,0 +1,8 @@ +( +(mov (es (& eax)) (dword 3)) +(add edx (ds (& ebx))) +(xor ecx (cs (& eax 4))) +(push (dword (es (& 4)))) +(sub eax (fs (& foo))) +(and (dword (gs (& foo edx))) (byte 3)) +) diff --git a/test-suite/standalone/sassy/tests/seg16 b/test-suite/standalone/sassy/tests/seg16 Binary files differnew file mode 100644 index 000000000..590459f07 --- /dev/null +++ b/test-suite/standalone/sassy/tests/seg16 diff --git a/test-suite/standalone/sassy/tests/seg16.asm b/test-suite/standalone/sassy/tests/seg16.asm new file mode 100644 index 000000000..e7621df1e --- /dev/null +++ b/test-suite/standalone/sassy/tests/seg16.asm @@ -0,0 +1,9 @@ +BITS 16 +section .text +foo: +mov [es:eax], dword 3 +add edx, [ds:ebx] +xor ecx, [cs:4+eax] +push dword [dword es:4] +sub eax, [dword fs:foo] +and dword [dword gs:foo+edx], byte 3 diff --git a/test-suite/standalone/sassy/tests/setcc b/test-suite/standalone/sassy/tests/setcc new file mode 100644 index 000000000..f139b81cb --- /dev/null +++ b/test-suite/standalone/sassy/tests/setcc @@ -0,0 +1 @@ +ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0ฤ0
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/setcc.asm b/test-suite/standalone/sassy/tests/setcc.asm new file mode 100644 index 000000000..57bd2a5ac --- /dev/null +++ b/test-suite/standalone/sassy/tests/setcc.asm @@ -0,0 +1,33 @@ +BITS 32 +section .text +foo: +seto ah +setno [eax+esi*1] +setb ah +setc [eax+esi*1] +setnae ah +setnb [eax+esi*1] +setnc ah +setae [eax+esi*1] +sete ah +setz [eax+esi*1] +setne ah +setnz [eax+esi*1] +setbe ah +setna [eax+esi*1] +seta ah +setnbe [eax+esi*1] +sets ah +setns [eax+esi*1] +setp ah +setpe [eax+esi*1] +setnp ah +setpo [eax+esi*1] +setl ah +setnge [eax+esi*1] +setge ah +setnl [eax+esi*1] +setle ah +setng [eax+esi*1] +setnle ah +setg [eax+esi*1] diff --git a/test-suite/standalone/sassy/tests/setcc.scm b/test-suite/standalone/sassy/tests/setcc.scm new file mode 100644 index 000000000..6e6e77590 --- /dev/null +++ b/test-suite/standalone/sassy/tests/setcc.scm @@ -0,0 +1,34 @@ +( +(seto ah) +(setno (& eax (* esi 1))) +(setb ah) +(setc (& eax (* esi 1))) +(setnae ah) +(setnb (& eax (* esi 1))) +(setnc ah) +(setae (& eax (* esi 1))) +(sete ah) +(setz (& eax (* esi 1))) +(setne ah) +(setnz (& eax (* esi 1))) +(setbe ah) +(setna (& eax (* esi 1))) +(seta ah) +(setnbe (& eax (* esi 1))) +(sets ah) +(setns (& eax (* esi 1))) +(setp ah) +(setpe (& eax (* esi 1))) +(setnp ah) +(setpo (& eax (* esi 1))) +(setl ah) +(setnge (& eax (* esi 1))) +(setge ah) +(setnl (& eax (* esi 1))) +(setle ah) +(setng (& eax (* esi 1))) +(setnle ah) +(setg (& eax (* esi 1))) +) + + diff --git a/test-suite/standalone/sassy/tests/setcc16 b/test-suite/standalone/sassy/tests/setcc16 new file mode 100644 index 000000000..9166c5970 --- /dev/null +++ b/test-suite/standalone/sassy/tests/setcc16 @@ -0,0 +1 @@ +ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0ฤg0
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/setcc16.asm b/test-suite/standalone/sassy/tests/setcc16.asm new file mode 100644 index 000000000..501e189a3 --- /dev/null +++ b/test-suite/standalone/sassy/tests/setcc16.asm @@ -0,0 +1,33 @@ +BITS 16 +section .text +foo: +seto ah +setno [eax+esi*1] +setb ah +setc [eax+esi*1] +setnae ah +setnb [eax+esi*1] +setnc ah +setae [eax+esi*1] +sete ah +setz [eax+esi*1] +setne ah +setnz [eax+esi*1] +setbe ah +setna [eax+esi*1] +seta ah +setnbe [eax+esi*1] +sets ah +setns [eax+esi*1] +setp ah +setpe [eax+esi*1] +setnp ah +setpo [eax+esi*1] +setl ah +setnge [eax+esi*1] +setge ah +setnl [eax+esi*1] +setle ah +setng [eax+esi*1] +setnle ah +setg [eax+esi*1] diff --git a/test-suite/standalone/sassy/tests/shift b/test-suite/standalone/sassy/tests/shift Binary files differnew file mode 100644 index 000000000..309e1527d --- /dev/null +++ b/test-suite/standalone/sassy/tests/shift diff --git a/test-suite/standalone/sassy/tests/shift.asm b/test-suite/standalone/sassy/tests/shift.asm new file mode 100644 index 000000000..0e0843df6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/shift.asm @@ -0,0 +1,5 @@ +BITS 32 +section .text +foo: +rcl ebp, 1 +rcr dword [dword 1000+eax], 1 diff --git a/test-suite/standalone/sassy/tests/shift.scm b/test-suite/standalone/sassy/tests/shift.scm new file mode 100644 index 000000000..c7730a234 --- /dev/null +++ b/test-suite/standalone/sassy/tests/shift.scm @@ -0,0 +1,20 @@ +( +(rcl ebp 1) +(rcr (dword (& eax 1000)) 1)) +(rol ebp cl) +(ror (dword (& eax 1000)) cl) +(sal ebp 9) +(sar (dword (& eax 1000)) (byte 9))) +(shl dh 1) +(shr (byte (& ecx ebx)) 1) +(rcl dh cl) +(rcr (byte (& ecx ebx)) cl) +(rol dh 9) +(ror (byte (& ecx ebx)) 9) +(sal bx 1) +(sar (word (& 1000)) 1) +(shl bx cl) +(shr (word (& 1000)) cl) +(rcl bx 9) +(rcr (word (& 1000)) 9) +)
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/shift16 b/test-suite/standalone/sassy/tests/shift16 Binary files differnew file mode 100644 index 000000000..c7463d904 --- /dev/null +++ b/test-suite/standalone/sassy/tests/shift16 diff --git a/test-suite/standalone/sassy/tests/shift16.asm b/test-suite/standalone/sassy/tests/shift16.asm new file mode 100644 index 000000000..06a8f5dde --- /dev/null +++ b/test-suite/standalone/sassy/tests/shift16.asm @@ -0,0 +1,5 @@ +BITS 16 +section .text +foo: +rcl ebp, 1 +rcr dword [dword 1000+eax], 1 diff --git a/test-suite/standalone/sassy/tests/sse1 b/test-suite/standalone/sassy/tests/sse1 Binary files differnew file mode 100644 index 000000000..b91814643 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse1 diff --git a/test-suite/standalone/sassy/tests/sse1.asm b/test-suite/standalone/sassy/tests/sse1.asm new file mode 100644 index 000000000..e175770ef --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse1.asm @@ -0,0 +1,81 @@ +BITS 32 +section .text +foo: +movaps xmm5, xmm4 +movups xmm3, [edx] +movaps [edx], xmm2 +movups xmm5, xmm4 +addps xmm3, xmm0 +subps xmm0, [edx] +mulps xmm3, xmm0 +divps xmm0, [edx] +rcpps xmm3, xmm0 +sqrtps xmm0, [edx] +rsqrtps xmm3, xmm0 +maxps xmm0, [edx] +minps xmm3, xmm0 +andps xmm0, [edx] +andnps xmm3, xmm0 +orps xmm0, [edx] +xorps xmm3, xmm0 +unpckhps xmm0, [edx] +unpcklps xmm3, xmm0 +addss xmm0, xmm1 +subss xmm0, [eax] +mulss xmm0, xmm1 +divss xmm0, [eax] +rcpss xmm0, xmm1 +sqrtss xmm0, [eax] +rsqrtss xmm0, xmm1 +maxss xmm0, [eax] +minss xmm0, xmm1 +comiss xmm0, [eax] +ucomiss xmm0, xmm1 +pavgb mm0, mm1 +pavgw mm2, [edx] +pmaxub xmm3, xmm4 +pmaxsw xmm5, [edx] +pminub mm0, mm1 +pminsw mm2, [edx] +pmulhuw xmm3, xmm4 +psadbw xmm5, [edx] +movhps xmm0, [edx] +movlps [edx], xmm6 +movhlps xmm0, xmm1 +movlhps xmm1, xmm0 +shufps xmm0, xmm6, 10 +cmpps xmm5, [ecx], 20 +prefetcht0 [eax] +prefetcht1 [eax] +prefetcht2 [eax] +prefetchnta [eax] +sfence +movntps [ecx], xmm3 +maskmovq mm3, mm4 +movntq [ebx], mm7 +pmovmskb eax, mm0 +pmovmskb ecx, xmm5 +pshufw mm0, mm1, 40 +pshufw mm0, [ebx], 30 +ldmxcsr [ebx] +stmxcsr [edx] +pinsrw mm1, eax, 4 +pinsrw mm0, [edx], 5 +pinsrw xmm4, ebx, 6 +pinsrw xmm3, [ecx], 7 +pextrw edx, mm3, 28 +pextrw esi, mm0, 14 +cvtsi2ss xmm3, edi +cvtsi2ss xmm3, [edi] +cvtpi2ps xmm4, mm2 +cvtpi2ps xmm4, [100+edi] +movss xmm1, [edx] +movss xmm1, xmm6 +movss [edx], xmm3 +movmskps ebx, xmm3 +cmpss xmm3, xmm4, 10 +cmpss xmm3, [edx], 20 +cvttss2si ebx, xmm3 +cvtss2si eax, [ecx] +cvtps2pi mm3, xmm1 +cvttps2pi mm4, [edx] diff --git a/test-suite/standalone/sassy/tests/sse1.scm b/test-suite/standalone/sassy/tests/sse1.scm new file mode 100644 index 000000000..a498e2aef --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse1.scm @@ -0,0 +1,81 @@ +( +(movaps xmm5 xmm4) +(movups xmm3 (& edx)) +(movaps (& edx) xmm2) +(movups xmm5 xmm4) +(addps xmm3 xmm0) +(subps xmm0 (& edx)) +(mulps xmm3 xmm0) +(divps xmm0 (& edx)) +(rcpps xmm3 xmm0) +(sqrtps xmm0 (& edx)) +(rsqrtps xmm3 xmm0) +(maxps xmm0 (& edx)) +(minps xmm3 xmm0) +(andps xmm0 (& edx)) +(andnps xmm3 xmm0) +(orps xmm0 (& edx)) +(xorps xmm3 xmm0) +(unpckhps xmm0 (& edx)) +(unpcklps xmm3 xmm0) +(addss xmm0 xmm1) +(subss xmm0 (& eax)) +(mulss xmm0 xmm1) +(divss xmm0 (& eax)) +(rcpss xmm0 xmm1) +(sqrtss xmm0 (& eax)) +(rsqrtss xmm0 xmm1) +(maxss xmm0 (& eax)) +(minss xmm0 xmm1) +(comiss xmm0 (& eax)) +(ucomiss xmm0 xmm1) +(pavgb mm0 mm1) +(pavgw mm2 (& edx)) +(pmaxub xmm3 xmm4) +(pmaxsw xmm5 (& edx)) +(pminub mm0 mm1) +(pminsw mm2 (& edx)) +(pmulhuw xmm3 xmm4) +(psadbw xmm5 (& edx)) +(movhps xmm0 (& edx)) +(movlps (& edx) xmm6) +(movhlps xmm0 xmm1) +(movlhps xmm1 xmm0) +(shufps xmm0 xmm6 10) +(cmpps xmm5 (& ecx) 20) +(prefetcht0 (& eax)) +(prefetcht1 (& eax)) +(prefetcht2 (& eax)) +(prefetchnta (& eax)) +(sfence) +(movntps (& ecx) xmm3) +(maskmovq mm3 mm4) +(movntq (& ebx) mm7) +(pmovmskb eax mm0) +(pmovmskb ecx xmm5) +(pshufw mm0 mm1 40) +(pshufw mm0 (& ebx) 30) +(ldmxcsr (& ebx)) +(stmxcsr (& edx)) +(pinsrw mm1 eax 4) +(pinsrw mm0 (& edx) 5) +(pinsrw xmm4 ebx 6) +(pinsrw xmm3 (& ecx) 7) +(pextrw edx mm3 28) +(pextrw esi mm0 14) +(cvtsi2ss xmm3 edi) +(cvtsi2ss xmm3 (& edi)) +(cvtpi2ps xmm4 mm2) +(cvtpi2ps xmm4 (& edi 100)) +(movss xmm1 (& edx)) +(movss xmm1 xmm6) +(movss (& edx) xmm3) +(movmskps ebx xmm3) +(cmpss xmm3 xmm4 10) +(cmpss xmm3 (& edx) 20) +(cvttss2si ebx xmm3) +(cvtss2si eax (& ecx)) +(cvtps2pi mm3 xmm1) +(cvttps2pi mm4 (& edx)) +) + diff --git a/test-suite/standalone/sassy/tests/sse2 b/test-suite/standalone/sassy/tests/sse2 Binary files differnew file mode 100644 index 000000000..3d93abb09 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse2 diff --git a/test-suite/standalone/sassy/tests/sse2.asm b/test-suite/standalone/sassy/tests/sse2.asm new file mode 100644 index 000000000..654d64cf6 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse2.asm @@ -0,0 +1,79 @@ +BITS 32 +section .text +foo: +movapd xmm0, xmm1 +movupd xmm2, [edx] +movdqa [eax], xmm3 +movdqu xmm0, xmm1 +movhpd xmm0, [ecx] +movmskpd ebx, xmm4 +movlpd [ecx], xmm0 +movsd xmm5, xmm6 +movsd xmm7, [esi] +movsd [esi], xmm7 +addpd xmm0, xmm1 +subpd xmm2, [ecx] +mulpd xmm0, xmm1 +divpd xmm2, [ecx] +sqrtpd xmm0, xmm1 +maxpd xmm2, [ecx] +minpd xmm0, xmm1 +andpd xmm2, [ecx] +andnpd xmm0, xmm1 +orpd xmm2, [ecx] +xorpd xmm0, xmm1 +unpckhpd xmm2, [ecx] +unpcklpd xmm0, xmm1 +cvtpd2dq xmm2, [ecx] +cvttpd2dq xmm0, xmm1 +cvtdq2ps xmm2, [ecx] +cvtps2dq xmm0, xmm1 +cvttps2dq xmm2, [ecx] +cvtpd2ps xmm0, xmm1 +punpckhqdq xmm2, [ecx] +punpcklqdq xmm0, xmm1 +addsd xmm2, xmm3 +subsd xmm4, [edi] +mulsd xmm2, xmm3 +divsd xmm4, [edi] +maxsd xmm2, xmm3 +minsd xmm4, [edi] +sqrtsd xmm2, xmm3 +comisd xmm4, [edi] +ucomisd xmm2, xmm3 +cvtdq2pd xmm4, [edi] +cvtps2pd xmm2, xmm3 +cvtsd2ss xmm4, [edi] +cmppd xmm0, xmm1, 10 +shufpd xmm2, [ebx], 20 +pshuflw xmm0, xmm1, 10 +pshufhw xmm2, [ebx], 20 +pshufd xmm0, xmm1, 10 +cmpsd xmm4, xmm5, 20 +cmpsd xmm6, [eax], 30 +cvttpd2pi mm0, xmm1 +cvtpd2pi mm0, [ebp] +pause +lfence +mfence +clflush [ebx] +pmuludq mm0, mm1 +paddq mm0, [edx] +psubq xmm3, xmm1 +pmuludq xmm3, [edx] +maskmovdqu xmm1, xmm2 +movnti [edx], eax +movq2dq xmm3, mm4 +movdq2q mm5, xmm7 +movntpd [eax], xmm3 +movntdq [ebx], xmm4 +pslldq xmm3, 20 +psrldq xmm3, 20 +cvtpi2pd xmm3, mm4 +cvtpi2pd xmm3, [ecx] +cvtss2sd xmm3, xmm6 +cvtss2sd xmm3, [edx] +cvtsd2si ecx, xmm3 +cvttsd2si edx, [edx] +cvtsi2sd xmm3, eax +cvtsi2sd xmm3, [eax] diff --git a/test-suite/standalone/sassy/tests/sse2.scm b/test-suite/standalone/sassy/tests/sse2.scm new file mode 100644 index 000000000..24c35311e --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse2.scm @@ -0,0 +1,78 @@ +( +(movapd xmm0 xmm1) +(movupd xmm2 (& edx)) +(movdqa (& eax) xmm3) +(movdqu xmm0 xmm1) +(movhpd xmm0 (& ecx)) +(movmskpd ebx xmm4) +(movlpd (& ecx) xmm0) +(movsd xmm5 xmm6) +(movsd xmm7 (& esi)) +(movsd (& esi) xmm7) +(addpd xmm0 xmm1) +(subpd xmm2 (& ecx)) +(mulpd xmm0 xmm1) +(divpd xmm2 (& ecx)) +(sqrtpd xmm0 xmm1) +(maxpd xmm2 (& ecx)) +(minpd xmm0 xmm1) +(andpd xmm2 (& ecx)) +(andnpd xmm0 xmm1) +(orpd xmm2 (& ecx)) +(xorpd xmm0 xmm1) +(unpckhpd xmm2 (& ecx)) +(unpcklpd xmm0 xmm1) +(cvtpd2dq xmm2 (& ecx)) +(cvttpd2dq xmm0 xmm1) +(cvtdq2ps xmm2 (& ecx)) +(cvtps2dq xmm0 xmm1) +(cvttps2dq xmm2 (& ecx)) +(cvtpd2ps xmm0 xmm1) +(punpckhqdq xmm2 (& ecx)) +(punpcklqdq xmm0 xmm1) +(addsd xmm2 xmm3) +(subsd xmm4 (& edi)) +(mulsd xmm2 xmm3) +(divsd xmm4 (& edi)) +(maxsd xmm2 xmm3) +(minsd xmm4 (& edi)) +(sqrtsd xmm2 xmm3) +(comisd xmm4 (& edi)) +(ucomisd xmm2 xmm3) +(cvtdq2pd xmm4 (& edi)) +(cvtps2pd xmm2 xmm3) +(cvtsd2ss xmm4 (& edi)) +(cmppd xmm0 xmm1 10) +(shufpd xmm2 (& ebx) 20) +(pshuflw xmm0 xmm1 10) +(pshufhw xmm2 (& ebx) 20) +(pshufd xmm0 xmm1 10) +(cmpsd xmm4 xmm5 20) +(cmpsd xmm6 (& eax) 30) +(cvttpd2pi mm0 xmm1) +(cvtpd2pi mm0 (& ebp)) +(pause) +(lfence) +(mfence) +(clflush (& ebx)) +(pmuludq mm0 mm1) +(paddq mm0 (& edx)) +(psubq xmm3 xmm1) +(pmuludq xmm3 (& edx)) +(maskmovdqu xmm1 xmm2) +(movnti (& edx) eax) +(movq2dq xmm3 mm4) +(movdq2q mm5 xmm7) +(movntpd (& eax) xmm3) +(movntdq (& ebx) xmm4) +(pslldq xmm3 20) +(psrldq xmm3 20) +(cvtpi2pd xmm3 mm4) +(cvtpi2pd xmm3 (& ecx)) +(cvtss2sd xmm3 xmm6) +(cvtss2sd xmm3 (& edx)) +(cvtsd2si ecx xmm3) +(cvttsd2si edx (& edx)) +(cvtsi2sd xmm3 eax) +(cvtsi2sd xmm3 (& eax)) +) diff --git a/test-suite/standalone/sassy/tests/sse3 b/test-suite/standalone/sassy/tests/sse3 new file mode 100644 index 000000000..75919c3f4 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse3 @@ -0,0 +1 @@ +ศษ๒๐๒ม๒ะมfะ๒|ม๒}f|มf}๓ม๓๒
\ No newline at end of file diff --git a/test-suite/standalone/sassy/tests/sse3.asm b/test-suite/standalone/sassy/tests/sse3.asm new file mode 100644 index 000000000..d3976a011 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse3.asm @@ -0,0 +1,16 @@ +BITS 32 +section .text +foo: +monitor +mwait +lddqu xmm0, [edx] +movddup xmm0, xmm1 +addsubps xmm0, xmm1 +addsubpd xmm2, [edx] +haddps xmm0, xmm1 +hsubps xmm2, [edx] +haddpd xmm0, xmm1 +hsubpd xmm2, [edx] +movshdup xmm0, xmm1 +movsldup xmm2, [edx] +movddup xmm0, [edx] diff --git a/test-suite/standalone/sassy/tests/sse3.scm b/test-suite/standalone/sassy/tests/sse3.scm new file mode 100644 index 000000000..20529d7fc --- /dev/null +++ b/test-suite/standalone/sassy/tests/sse3.scm @@ -0,0 +1,18 @@ +( +(monitor) +(mwait) +(lddqu xmm0 (& edx)) +; (fisttp (dword (& edx))) nasm, ndisasm, and objdump all disagree about these +; (fisttp (word (& edx))) but I've double checked, and they should be right +; (fisttp (qword (& edx))) (unless the INTEL documentation is wrong) +(movddup xmm0 xmm1) +(addsubps xmm0 xmm1) +(addsubpd xmm2 (& edx)) +(haddps xmm0 xmm1) +(hsubps xmm2 (& edx)) +(haddpd xmm0 xmm1) +(hsubpd xmm2 (& edx)) +(movshdup xmm0 xmm1) +(movsldup xmm2 (& edx)) +(movddup xmm0 (& edx)) +) diff --git a/test-suite/standalone/sassy/tests/sysexit b/test-suite/standalone/sassy/tests/sysexit Binary files differnew file mode 100644 index 000000000..5365a2c61 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sysexit diff --git a/test-suite/standalone/sassy/tests/sysexit.scm b/test-suite/standalone/sassy/tests/sysexit.scm new file mode 100644 index 000000000..f22c1b2b8 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sysexit.scm @@ -0,0 +1,8 @@ +(entry _start) + +(text + (label _start + (begin + (mov eax 1) + (mov ebx 0) + (int #x80)))) diff --git a/test-suite/standalone/sassy/tests/sysexit2.scm b/test-suite/standalone/sassy/tests/sysexit2.scm new file mode 100644 index 000000000..88369ce58 --- /dev/null +++ b/test-suite/standalone/sassy/tests/sysexit2.scm @@ -0,0 +1,11 @@ +(export exit mybuff) + +(heap (label mybuff (bytes 1))) + +(import exit-code) + +(text + (label exit (begin + (mov eax 1) + (mov ebx (& exit-code)) + (int #x80)))) diff --git a/test-suite/standalone/test-sassy b/test-suite/standalone/test-sassy new file mode 100755 index 000000000..fa84ba565 --- /dev/null +++ b/test-suite/standalone/test-sassy @@ -0,0 +1,47 @@ +#!/bin/sh +exec guile -e main -s $0 "$@" +!# +;;;; test-sassy --- sassy's unit tests +;;;; Copyright (C) 2009 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free +;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(use-modules (language sassy) + (rnrs bytevector) + (rnrs io ports)) + +(define (write-byte b . port) + (put-u8 (if (null? port) (current-output-port) (car port)) + b)) +(define (read-byte . port) + (get-u8 (if (null? port) (current-input-port) (car port)))) +(define (hash-table-ref t k . th) + (cond ((hash-ref t k)) + (else (if (null? t) #f ((car th)))))) +(define hash-table-set! hash-set!) +(define (alist->hash-table lst) + (let ((t (make-hash-table))) + (for-each (lambda (itm) + (hash-table-set! t (car itm) (cdr itm))) + lst) + t)) +(define (hash-table-values t) + (hash-map->list (lambda (k v) v) t)) + +(define (main args) + (chdir (if (null? (cdr args)) "sassy" (cadr args))) + (load "tests/run-tests.scm") + (sassy-run-tests 'all)) |