... fl<? and others; 'c' ig type

This commit is contained in:
ESL 2023-03-20 00:23:42 -04:00
parent 96332a393f
commit 3730b714d4
4 changed files with 1392 additions and 1167 deletions

20
i.c
View file

@ -3560,22 +3560,22 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
if (!pe->igname) continue;
lcode = pe->lcode;
if (!lcode) switch (pe->igtype) {
case 0: case '0':
case 0: case '0': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%0%s]0", pe->enc);
break;
case 1: case '1':
} break;
case 1: case '1': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%1_!%s]0", pe->enc);
break;
case 2: case '2':
} break;
case 2: case '2': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%2_!%s]0", pe->enc);
break;
case 3: case '3':
} break;
case 3: case '3': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%3_!%s]0", pe->enc);
break;
} break;
case 'p': {
lcode = lbuf; assert(pe->enc);
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
@ -3586,6 +3586,10 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
sprintf(lbuf, "%%!1.0u?{.1%s]2}.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22", pe1, pe0);
} break;
case 'c': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%%2.1u,.0?{.0]3}.2a,.0,.3%s?{.3d,.1,:0^[42}f]4}.!0.0^_1[22", pe->enc);
} break;
default: assert(0);
}
if (!lcode || *lcode == 0) continue;

10
i.h
View file

@ -293,11 +293,11 @@ declare_instruction(jmul, "J*\0'(j1)", 0, "fl*", 'p', AUTOGL)
declare_instruction(jdiv, "J/\0,'(j1)J/", 0, "fl/", 'm', AUTOGL)
declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL)
declare_instruction(jrem, "Jr", 0, "flremainder", '2', AUTOGL)
declare_instruction(jlt, "J<", 0, "fl<?", '2', AUTOGL)
declare_instruction(jgt, "J>", 0, "fl>?", '2', AUTOGL)
declare_instruction(jle, "J>!", 0, "fl<=?", '2', AUTOGL)
declare_instruction(jge, "J<!", 0, "fl>=?", '2', AUTOGL)
declare_instruction(jeq, "J=", 0, "fl=?", '2', AUTOGL)
declare_instruction(jlt, "J<", 0, "fl<?", 'c', AUTOGL)
declare_instruction(jgt, "J>", 0, "fl>?", 'c', AUTOGL)
declare_instruction(jle, "J>!", 0, "fl<=?", 'c', AUTOGL)
declare_instruction(jge, "J<!", 0, "fl>=?", 'c', AUTOGL)
declare_instruction(jeq, "J=", 0, "fl=?", 'c', AUTOGL)
declare_instruction(jne, "J=!", 0, "fl!=?", '2', AUTOGL)
declare_instruction(jmin, "Jn", 0, "flmin", '2', AUTOGL)
declare_instruction(jmax, "Jx", 0, "flmax", '2', AUTOGL)

2516
k.c

File diff suppressed because it is too large Load diff

View file

@ -356,7 +356,7 @@
(define (integrable-argc-match? igt n)
(case igt
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)]
[else #f]))
@ -1124,6 +1124,17 @@
(unless (null? (cdr args)) (write-char #\, port)))
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(write-string igc0 port))))]
[(#\c) ; (length args) >= 2
(let ([opc (fx- (length args) 1)] [args (reverse args)])
(codegen (car args) l f s g #f port)
(write-char #\, port)
(do ([args (cdr args) (cdr args)] [l (cons #f l) (cons #f (cons #f l))])
[(null? args)]
(codegen (car args) l f s g #f port)
(unless (null? (cdr args)) (write-char #\, port) (write-char #\, port)))
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(unless (fxzero? i) (write-char #\; port))
(write-string igc0 port)))]
[else (error 'codegen "NYI: unsupported integrable type" igty)]))
(when k (write-char #\] port) (write-serialized-arg k port))]
[call (exp . args)