From e876fa07be0ae68dc862490bbeb43bdc33a430d8 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 15 Jan 2019 03:14:40 +0000 Subject: [PATCH] Umptuple-check that instruction widths sum to multiples of 32 bits. --- src/compiler/machines/aarch64/insmac.scm | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/src/compiler/machines/aarch64/insmac.scm b/src/compiler/machines/aarch64/insmac.scm index cfb7d4120..f2d6ad05f 100644 --- a/src/compiler/machines/aarch64/insmac.scm +++ b/src/compiler/machines/aarch64/insmac.scm @@ -31,16 +31,18 @@ USA. (define (parse-instruction form forms early? environment) (assert (not early?)) (receive (expansion bits) (process* form forms environment) - bits + (assert (or (not bits) (zero? (remainder bits 32))) bits (cons form forms)) expansion)) (define (process* form forms environment) (let recur ((form form) (forms forms)) (receive (expansion bits) (process form environment) + (assert (or (not bits) (zero? (remainder bits 32)) bits form)) (if (pair? forms) (receive (tail bits*) (recur (car forms) (cdr forms)) + (assert (or (not bits*) (zero? (remainder bits* 32))) bits* forms) (values `(,(close-syntax 'APPEND environment) ,expansion ,tail) - (+ bits bits*))) + (and bits bits* (+ bits bits*)))) (values expansion bits))))) (define (process form environment) @@ -58,13 +60,16 @@ USA. (consequent (caddr form)) (alternative (cadddr form))) (receive (con-exp con-bits) (process consequent environment) + (assert con-bits consequent) + (assert (zero? (remainder con-bits 32)) con-bits consequent) (receive (alt-exp alt-bits) (process alternative environment) - (assert (eqv? con-bits alt-bits)) + (assert (eqv? con-bits alt-bits) con-bits alt-bits alternative) (values `(,(close-syntax 'IF environment) ,condition ,con-exp ,alt-exp) con-bits))))) (define (process-fixed form environment) (receive (expansion bits) (expand-fields (cdr form) environment) + (assert (zero? (remainder bits 32)) bits form) (values `(,(close-syntax 'LIST environment) ,(optimize-group-syntax expansion #f environment)) bits))) @@ -88,7 +93,7 @@ USA. (hi (cadr range))) (receive (expansion bits) (process* (car forms) (cdr forms) environment) (assert bits "Variable within variable prohibited!") - (assert (zero? (remainder bits 32)) "Wrong number of bits!") + (assert (zero? (remainder bits 32)) bits forms) `(,expansion ,bits ,lo ,hi))))) (define (process-macro form environment) @@ -101,12 +106,14 @@ USA. ,expansion))) width))) -(define (expand-fields fields environment) - (let loop ((fields fields) (elements '()) (bits 0)) +(define (expand-fields all-fields environment) + (let loop ((fields all-fields) (elements '()) (bits 0)) (if (pair? fields) (receive (element1 bits1) (expand-field (car fields) environment) (loop (cdr fields) (cons element1 elements) (+ bits1 bits))) - (values (reverse! elements) bits)))) + (begin + (assert (zero? (remainder bits 32)) bits all-fields) + (values elements bits))))) (define (expand-field field environment) (let ((bits (car field)) -- 2.25.1