From b18fcdb8c7f438b0036eeeff62708d155bce49d7 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 3 Jun 2009 17:49:28 -0400 Subject: [PATCH] Added the case numbers to assembly labels. Fixed a bug with branch tables where PCH needed to be set. Fixed constant folding to fold recursively. Fixed a bug in the simulator where WREG was duplicated. Fixed a bug in the latches of the simulator. Added a function to show PICOBIT lists stored in memory. Changed the way register tables are generated, to use the actual registers and the PIC18 and not the virtual ones used for the CFGs. Moved the code interpreted by PICOBIT to 0x8000 instead of 0x5000 to avoid overwriting the vm. --- asm.scm | 2 +- cfg.scm | 22 ++++++- code-generation.scm | 24 ++++---- operators.scm | 40 +++++++++++-- pic18-sim.scm | 49 ++++++++++++---- register-allocation.scm | 6 +- six-comp.scm | 73 ++++++++++++----------- tests/picobit/picobit-vm-sixpic.c | 118 +++++++++++++++++++------------------- 8 files changed, 212 insertions(+), 122 deletions(-) diff --git a/asm.scm b/asm.scm index 5998473..b1d2d8c 100644 --- a/asm.scm +++ b/asm.scm @@ -231,7 +231,7 @@ (if (= (vector-ref x 1) pos) (loop2 (cdr lst) changed? pos) (begin - (table-set! symbol-table pos (vector-ref x 2)) + (table-set! symbol-table pos (asm-label-id x)) (vector-set! x 1 pos) (loop2 (cdr lst) #t pos))) ;; DEFERRED diff --git a/cfg.scm b/cfg.scm index f115bba..63711ac 100644 --- a/cfg.scm +++ b/cfg.scm @@ -319,6 +319,8 @@ (pop-break))) ;; switchs with branch tables + ;; since offsets are calculated using one byte, switches are limited to + ;; 60 cases or so (slightly below 64) (define (switch ast) (let* ((var (subast1 ast)) (entry-bb bb) @@ -349,6 +351,23 @@ (end-bbs (reverse end-bbs)) (cases (reverse cases)) (l (length bbs))) + ;; add the case names to the bb names + (for-each ;; TODO do it for all named bbs, not just switch (but, since the name is on the successor, might be lost) + (lambda (bb case) + (vector-set! + (bb-label (car (bb-succs bb))) 2 + (string->symbol + (string-append (symbol->string (asm-label-id (bb-label bb))) + "$" + (if (symbol? case) + ;; default + (symbol->string case) + ;; (case n) + (string-append + (symbol->string (car case)) + (number->string (cadr case)))))))) + bbs + cases) ;; handle fall-throughs (for-each (lambda (i) @@ -394,7 +413,8 @@ op))) (expr-type-set! ast ((op-type-rule op) ast)) ast))))) - #f #f)))))) + (new-byte-cell) ; working space to calculate addresses + #f)))))) (in exit-bb) (pop-break))) diff --git a/code-generation.scm b/code-generation.scm index 9a0e247..8c4ed64 100644 --- a/code-generation.scm +++ b/code-generation.scm @@ -368,23 +368,25 @@ (compare #f x)))))) ((branch-table) - (let ((off (byte-cell-adr src1))) ; branch no TODO we can't have literals, we need the space to calculate the address + (let ((off (byte-cell-adr src1)) ; branch no TODO we can't have literals, we need the space to calculate the address FOO since we calculate elsewhere, maybe not + (scratch (byte-cell-adr src2))) ; working space ;; precalculate the low byte of the PC (movfw off) - (movff PCL off) ;; TODO at assembly, this can all be known statically ;; we add 4 times the offset, since gotos are 4 ;; bytes long - (addwf off) - (addwf off) - (addwf off) - (addwf off) + (movff off scratch) + (addwf scratch) + (addwf scratch) + (addwf scratch) ;; to compensate for the PC advancing while we calculate - (movlw 20) - (addwf off) + (movlw 10) + (addwf scratch) + (movfw PCL) ;; TODO at assembly, this can all be known statically + (addwf scratch) (clrf WREG) - (addwfc PCLATH) ; set PCH if we overflow - (movff off PCL) ; setting PCL moves PCLATH to PCH - + (addwfc PCLATH) + (movff scratch PCL) + ;; create the jump table (for-each (lambda (bb) (goto (bb-label bb)) diff --git a/operators.scm b/operators.scm index bbd1418..31b0c55 100644 --- a/operators.scm +++ b/operators.scm @@ -44,12 +44,41 @@ (define (type-rule-bool-op2 ast) 'int) + +(define (constant-fold-op1 op) + (lambda (ast) + (let* ((x (subast1 ast)) + (lx (cond ((literal? x) + (literal-val x)) + ((operation? x) => + (lambda (op) + (let ((val ((op-constant-fold op) x))) + (if (literal? val) val #f)))) + (else #f)))) + (if lx + (new-literal (expr-type ast) (op lx)) + ast)))) + (define (constant-fold-op2 op) (lambda (ast) - (let ((x (subast1 ast)) - (y (subast2 ast))) - (if (and (literal? x) (literal? y)) - (new-literal (expr-type ast) (op (literal-val x) (literal-val y))) + (let* ((x (subast1 ast)) + (y (subast2 ast)) + (lx (cond ((literal? x) + (literal-val x)) + ((operation? x) => + (lambda (op) + (let ((val ((op-constant-fold op) x))) + (if (literal? val) val #f)))) + (else #f))) + (ly (cond ((literal? y) + (literal-val y)) + ((operation? y) => + (lambda (op) + (let ((val ((op-constant-fold op) y))) + (if (literal? val) val #f)))) + (else #f)))) + (if (and lx ly) + (new-literal (expr-type ast) (op lx ly)) ast)))) (define-op1 'six.!x '!x @@ -150,8 +179,7 @@ (define-op1 'six.-x '-x type-rule-int-op1 - (lambda (ast) - ast) ;; TODO + (constant-fold-op1 (lambda (x) (- x))) (lambda (ast) ...)) diff --git a/pic18-sim.scm b/pic18-sim.scm index 0a5cde3..3b57471 100644 --- a/pic18-sim.scm +++ b/pic18-sim.scm @@ -4,7 +4,6 @@ (define pic18-rom #f) (define pic18-stack #f) (define pic18-pc #f) -(define pic18-wreg #f) (define instrs-counts #f) ; counts how many times each instruction is executed (define break-points '()) ; list of adresses at which the simulation stops @@ -18,6 +17,10 @@ (define pic18-cycles #f) (define pic18-exit #f) +(define fsr-alist (list (cons INDF0 (cons FSR0H FSR0L)) + (cons INDF1 (cons FSR1H FSR1L)) + (cons INDF2 (cons FSR2H FSR2L)))) + (define (get-ram adr) (cond ((= adr TOSU) (bitwise-and (arithmetic-shift (get-tos) -16) #xff)) @@ -35,9 +38,7 @@ (arithmetic-shift pic18-zero-flag 2) (arithmetic-shift pic18-overflow-flag 3) (arithmetic-shift pic18-negative-flag 4))) - ((assq adr (list (cons INDF0 (cons FSR0H FSR0L)) - (cons INDF1 (cons FSR1H FSR1L)) - (cons INDF2 (cons FSR2H FSR2L)))) + ((assq adr fsr-alist) => (lambda (x) (get-ram (bitwise-ior (arithmetic-shift (bitwise-and (u8vector-ref pic18-ram @@ -61,8 +62,8 @@ (set-tos (+ (bitwise-and (get-tos) #x1fff00) byte))) ((= adr PCL) - (set-pc (+ (bitwise-and (arithmetic-shift (get-ram PCLATU) 16) #x1f) - (bitwise-and (arithmetic-shift (get-ram PCLATH) 8) #xff) + (set-pc (+ (arithmetic-shift (get-ram PCLATU) 16) + (arithmetic-shift (get-ram PCLATH) 8) (bitwise-and byte #xfe)))) ((= adr STATUS) (set! pic18-carry-flag (bitwise-and byte 1)) @@ -70,9 +71,7 @@ (set! pic18-zero-flag (arithmetic-shift (bitwise-and byte 4) -2)) (set! pic18-overflow-flag (arithmetic-shift (bitwise-and byte 8) -3)) (set! pic18-negative-flag (arithmetic-shift (bitwise-and byte 16) -4))) - ((assq adr (list (cons INDF0 (cons FSR0H FSR0L)) - (cons INDF1 (cons FSR1H FSR1L)) - (cons INDF2 (cons FSR2H FSR2L)))) + ((assq adr fsr-alist) => (lambda (x) (set-ram (bitwise-ior ;; TODO factor common code with get-ram ? (arithmetic-shift (bitwise-and (u8vector-ref pic18-ram @@ -130,10 +129,10 @@ (bitwise-and (get-ram BSR) #x0f)) (define (get-wreg) - pic18-wreg) + (get-ram WREG)) (define (set-wreg byte) - (set! pic18-wreg byte)) + (set-ram WREG byte)) (define (zero-flag?) (not (= 0 pic18-zero-flag))) @@ -1044,3 +1043,31 @@ ;; debugging procedures (define (add-break-point adr) (set! break-points (cons adr break-points))) (define (continue) (set! single-stepping-mode? #f)) ;; TODO + the equivalent of ,c + +;; takes the regiter number for env0 and env1 and shows the picobit stack +;; TODO can actually be used to show any list, if given a pointer to it (free list ?) +;; TODO find the register by doing a reverse lookup on the register table +(define (picobit-stack env0 env1) + (define (obj->ram o field) + (get-ram (+ 512 (arithmetic-shift (- o 512) 2) field))) + (define (get-car o) ;; TODO shouldn't end up seeing any rom objects + (bitwise-ior (arithmetic-shift (bitwise-and (obj->ram o 0) #x1f) 8) + (obj->ram o 1))) + (define (get-cdr o) + (bitwise-ior (arithmetic-shift (bitwise-and (obj->ram o 2) #x1f) 8) + (obj->ram o 3))) + (define (show-obj o) + (pp (list o (cond ((= o 0) #f) + ((= o 1) #f) + ((= o 2) '()) + ((< o (+ 3 255 1 1)) ; fixnum + (- o 4)) + ((< o 512) ; rom + "rom") ;; TODO be more precise + ((< o 1280) + "ram") + (else "invalid"))))) + (let loop ((ptr (+ (* 256 (get-ram env1)) (get-ram env0)))) + (if (not (= ptr 2)) ;; '() + (begin (show-obj (get-car ptr)) + (loop (get-cdr ptr)))))) diff --git a/register-allocation.scm b/register-allocation.scm index 7734d44..e716f5e 100644 --- a/register-allocation.scm +++ b/register-allocation.scm @@ -157,7 +157,11 @@ (if (null? lst) (begin (byte-cell-adr-set! byte-cell adr) (table-set! - register-table adr + register-table + (if (and (> adr #x5F) (< adr #xF60)) + ;; not in bank 0 + (+ adr #xa0) + adr) (cons (byte-cell-name byte-cell) (table-ref register-table adr '())))) (let ((x (car lst))) diff --git a/six-comp.scm b/six-comp.scm index c3685f6..3104ef3 100755 --- a/six-comp.scm +++ b/six-comp.scm @@ -5,35 +5,35 @@ (define allocate-registers? #t) ; can be turned off to reduce compilation time (define fold-constants? #t) -;; ;; to use when interpreting -;; (include "asm.scm") -;; (include "pic18.scm") -;; (include "pic18-sim.scm") -;; (include "utilities.scm") -;; (include "ast.scm") -;; (include "operators.scm") -;; (include "cte.scm") -;; (include "parser.scm") -;; (include "cfg.scm") -;; (include "optimizations.scm") -;; (include "code-generation.scm") -;; (include "register-allocation.scm") -;; (include "profiler.scm") - -;; to use with compiled code -(load "asm") -(load "pic18") -(load "pic18-sim") -(load "utilities") -(load "ast") -(load "operators") -(load "cte") -(load "parser") -(load "cfg") -(load "optimizations") -(load "code-generation") -(load "register-allocation") -(load "profiler") +;; to use when interpreting +(include "asm.scm") +(include "pic18.scm") +(include "pic18-sim.scm") +(include "utilities.scm") +(include "ast.scm") +(include "operators.scm") +(include "cte.scm") +(include "parser.scm") +(include "cfg.scm") +(include "optimizations.scm") +(include "code-generation.scm") +(include "register-allocation.scm") +(include "profiler.scm") + +;; ;; to use with compiled code +;; (load "asm") +;; (load "pic18") +;; (load "pic18-sim") +;; (load "utilities") +;; (load "ast") +;; (load "operators") +;; (load "cte") +;; (load "parser") +;; (load "cfg") +;; (load "optimizations") +;; (load "code-generation") +;; (load "register-allocation") +;; (load "profiler") ;------------------------------------------------------------------------------ @@ -103,7 +103,11 @@ (with-output-to-file (string-append filename ".map") (lambda () (write (table->list symbol-table)))) (with-output-to-file (string-append filename ".reg") - (lambda () (write (table->list register-table)))) + (lambda () (write (map (lambda (x) + ;; write it in hex, for easier + ;; cross-reference with the simulation + (cons (number->string (car x) 16) (cdr x))) + (table->list register-table))))) (asm-write-hex-file (string-append filename ".hex")) (asm-end!) ;; data contains a list of additional hex files @@ -122,8 +126,13 @@ (define (simulate hexs map-file reg-file asm-file) (set! symbol-table (with-input-from-file map-file (lambda () (list->table (read))))) - (set! register-table (with-input-from-file reg-file - (lambda () (list->table (read))))) + (set! register-table + (with-input-from-file reg-file + (lambda () (list->table + (map (lambda (x) + ;; read from hex + (cons (string->number (car x) 16) (cdr x))) + (read)))))) (set! asm-filename asm-file) (apply execute-hex-files hexs)) diff --git a/tests/picobit/picobit-vm-sixpic.c b/tests/picobit/picobit-vm-sixpic.c index 1792ca7..8f78b3b 100644 --- a/tests/picobit/picobit-vm-sixpic.c +++ b/tests/picobit/picobit-vm-sixpic.c @@ -114,10 +114,10 @@ void ram_set_fieldn (int16 o, int8 n, int8 val) { case 3: ram_set_field3 (o, val); break; } } -int8 rom_get_field0 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x5000 + 4 + (0)))); } -int8 rom_get_field1 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x5000 + 4 + (1)))); } -int8 rom_get_field2 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x5000 + 4 + (2)))); } -int8 rom_get_field3 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x5000 + 4 + (3)))); } +int8 rom_get_field0 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (0)))); } +int8 rom_get_field1 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (1)))); } +int8 rom_get_field2 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (2)))); } +int8 rom_get_field3 (int16 o) { int16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (3)))); } /* int16 ram_get_car (int16 o); */ @@ -189,7 +189,7 @@ void mark (int16 temp) { int16 stack; int16 visit; - if ((!((temp) >= 4096) && ((temp) >= 512))) { + if ((!((temp) >= 1280) && ((temp) >= 512))) { visit = 0; push: @@ -211,7 +211,7 @@ void mark (int16 temp) { temp = ram_get_cdr (visit); - if ((!((temp) >= 4096) && ((temp) >= 512))) { + if ((!((temp) >= 1280) && ((temp) >= 512))) { ; int16 tmp = 2; // TODO literals should be int, but that's wasteful ram_set_gc_tags (visit, (tmp<<5)); @@ -235,7 +235,7 @@ void mark (int16 temp) { else temp = ram_get_car (visit); - if ((!((temp) >= 4096) && ((temp) >= 512))) { + if ((!((temp) >= 1280) && ((temp) >= 512))) { ; int16 tmp = 1; ram_set_gc_tag0 (visit, (tmp<<5)); @@ -309,7 +309,7 @@ void sweep () { - int16 visit = 4095; + int16 visit = 1279; free_list = 0; @@ -468,9 +468,9 @@ int16 make_integer (int16 lo, int16 hi) { } int16 integer_hi (int16 x) { - if ((!((x) >= 4096) && ((x) >= 512))) + if ((!((x) >= 1280) && ((x) >= 512))) return ram_get_car (x); - else if ((!((x) >= 4096) && !(!((x) >= 4096) && ((x) >= 512)) && ((x) >= (3 +255 - -1 +1)))) + else if ((!((x) >= 1280) && !(!((x) >= 1280) && ((x) >= 512)) && ((x) >= (3 +255 - -1 +1)))) return rom_get_car (x); else if (x < (3 - -1)){ return ((0 + (3 - -1))-1); @@ -482,9 +482,9 @@ int16 integer_hi (int16 x) { int16 integer_lo (int16 x) { int16 t = ram_get_field2 (x); - if ((!((x) >= 4096) && ((x) >= 512))) + if ((!((x) >= 1280) && ((x) >= 512))) return (t << 8) + ram_get_field3 (x); - else if ((!((x) >= 4096) && !(!((x) >= 4096) && ((x) >= 512)) && ((x) >= (3 +255 - -1 +1)))) + else if ((!((x) >= 1280) && !(!((x) >= 1280) && ((x) >= 512)) && ((x) >= (3 +255 - -1 +1)))) return (t << 8) + rom_get_field3 (x); else return x - (3 - -1); @@ -515,12 +515,12 @@ int32 decode_int (int16 o) { if (o <= (3 + (255 - -1))) return (o - (3 - -1)); - if ((!((o) >= 4096) && ((o) >= 512))) { + if ((!((o) >= 1280) && ((o) >= 512))) { if (!((ram_get_field0 (o) & #xc0) == 0)) halt_with_error(); return ram_get_field3 (o); } - else if ((!((o) >= 4096) && !(!((o) >= 4096) && ((o) >= 512)) && ((o) >= (3 +255 - -1 +1)))) { + else if ((!((o) >= 1280) && !(!((o) >= 1280) && ((o) >= 512)) && ((o) >= (3 +255 - -1 +1)))) { if (!((rom_get_field0 (o) & #xc0) == 0)) halt_with_error(); return rom_get_field3 (o); @@ -944,10 +944,10 @@ void prim_numberp () { && arg1 <= (3 + (255 - -1))) arg1 = 1; else { - if ((!((arg1) >= 4096) && ((arg1) >= 512))){ + if ((!((arg1) >= 1280) && ((arg1) >= 512))){ arg1 = (ram_get_field0 (arg1) & #xc0) == 0; } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) arg1 = (rom_get_field0 (arg1) & #xc0) == 0; else arg1 = 0; @@ -1116,9 +1116,9 @@ void prim_xor () { void prim_pairp () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) + if ((!((arg1) >= 1280) && ((arg1) >= 512))) arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0)))); - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0)))); else arg1 = 0; @@ -1137,12 +1137,12 @@ void prim_cons () { } void prim_car () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); arg1 = ram_get_car (arg1); } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); arg1 = rom_get_car (arg1); @@ -1152,12 +1152,12 @@ void prim_car () { } void prim_cdr () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); arg1 = ram_get_cdr (arg1); } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); arg1 = rom_get_cdr (arg1); @@ -1167,7 +1167,7 @@ void prim_cdr () { } void prim_set_car () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); @@ -1180,7 +1180,7 @@ void prim_set_car () { } void prim_set_cdr () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0))) halt_with_error(); @@ -1201,9 +1201,9 @@ void prim_nullp () { void prim_u8vectorp () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) + if ((!((arg1) >= 1280) && ((arg1) >= 512))) arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))); - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60)))); else arg1 = 0; @@ -1233,14 +1233,14 @@ void prim_make_u8vector () { void prim_u8vector_ref () { a2 = decode_int (arg2); - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60))) halt_with_error(); if ((ram_get_car (arg1) <= a2) || (a2 < 0)) halt_with_error(); arg1 = ram_get_cdr (arg1); } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60))) halt_with_error(); if ((rom_get_car (arg1) <= a2) || (a2 < 0)) @@ -1250,7 +1250,7 @@ void prim_u8vector_ref () { else halt_with_error(); - if (((arg1) >= 4096)) { + if (((arg1) >= 1280)) { arg1 += (a2 >> 2); a2 %= 4; @@ -1276,7 +1276,7 @@ void prim_u8vector_set () { if (a3 > 255) halt_with_error(); - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60))) halt_with_error(); if ((ram_get_car (arg1) <= a2) || (a2 < 0)) @@ -1297,12 +1297,12 @@ void prim_u8vector_set () { } void prim_u8vector_length () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60))) halt_with_error(); arg1 = encode_int (ram_get_car (arg1)); } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60))) halt_with_error(); arg1 = encode_int (rom_get_car (arg1)); @@ -1320,7 +1320,7 @@ void prim_u8vector_copy () { a3 = decode_int (arg5); - if ((!((arg1) >= 4096) && ((arg1) >= 512)) && (!((arg3) >= 4096) && ((arg3) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512)) && (!((arg3) >= 1280) && ((arg3) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)) || !(((ram_get_field0 (arg3) & #x80) == #x80) && ((ram_get_field2 (arg3) & #xe0) == #x60))) halt_with_error(); if ((ram_get_car (arg1) < (a1 + a3)) || (a1 < 0) || @@ -1348,7 +1348,7 @@ void prim_u8vector_copy () { } } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))) && (!((arg3) >= 4096) && ((arg3) >= 512))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))) && (!((arg3) >= 1280) && ((arg3) >= 512))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60)) || !(((ram_get_field0 (arg3) & #x80) == #x80) && ((ram_get_field2 (arg3) & #xe0) == #x60))) halt_with_error(); if ((rom_get_car (arg1) < (a1 + a3)) || (a1 < 0) || @@ -1396,31 +1396,31 @@ void prim_not () { } void prim_symbolp () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) + if ((!((arg1) >= 1280) && ((arg1) >= 512))) arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x20)))); - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x20)))); else arg1 = 0; } void prim_stringp () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) + if ((!((arg1) >= 1280) && ((arg1) >= 512))) arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x40)))); - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x40)))); else arg1 = 0; } void prim_string2list () { - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x40))) halt_with_error(); arg1 = ram_get_car (arg1); } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x40))) halt_with_error(); @@ -1674,17 +1674,17 @@ int16 pop () { void pop_procedure () { arg1 = pop(); - if ((!((arg1) >= 4096) && ((arg1) >= 512))) { + if ((!((arg1) >= 1280) && ((arg1) >= 512))) { if (!((ram_get_field0 (arg1) & #xc0) == #x40)) halt_with_error(); - entry = ram_get_entry (arg1) + #x5000; + entry = ram_get_entry (arg1) + #x8000; } - else if ((!((arg1) >= 4096) && !(!((arg1) >= 4096) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { + else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) { if (!((rom_get_field0 (arg1) & #xc0) == #x40)) halt_with_error(); - entry = rom_get_entry (arg1) + #x5000; + entry = rom_get_entry (arg1) + #x8000; } else halt_with_error(); @@ -1747,11 +1747,11 @@ void save_cont () { void init_ram_heap () { int8 i; - int16 o = 4095; + int16 o = 1279; free_list = 0; - int16 tmp = (512 + (glovars + 1) >> 1); // TODO optimization + int16 tmp = (512 + ((glovars + 1) >> 1)); // TODO optimization TODO parens added to solve a potential shift priority problem while (o > tmp) { @@ -1761,12 +1761,12 @@ void init_ram_heap () { o--; } - free_list_vec = 4096; + free_list_vec = 1280; ram_set_car (free_list_vec, 0); - ram_set_cdr (free_list_vec, ((8191 - 4096 + 1)*4) >> 2); + ram_set_cdr (free_list_vec, ((2047 - 1280 + 1)*4) >> 2); for (i=0; i