010-string.scm (1310B)
1 ;; tests/cc-cg/10-string.scm — string-pool interning. 2 ;; Models: char *p = "hello"; 3 ;; char *q = "hello"; 4 ;; char *r = "world"; 5 ;; return (p == q) + (p != r); /* expected: 2 */ 6 ;; Exercises cg-push-string's idempotent intern: identical literals 7 ;; share an address, distinct literals don't. 8 9 (let* ((cg (cg-init)) 10 (cp-ty (%ctype 'ptr 8 8 %t-i8))) 11 (cg-fn-begin cg "main" '() %t-i32) 12 (let* ((p-off (cg-alloc-slot cg 8 8)) 13 (q-off (cg-alloc-slot cg 8 8)) 14 (r-off (cg-alloc-slot cg 8 8)) 15 (p (%sym "p" 'var 'auto cp-ty p-off)) 16 (q (%sym "q" 'var 'auto cp-ty q-off)) 17 (r (%sym "r" 'var 'auto cp-ty r-off))) 18 ;; p = "hello" 19 (cg-push-sym cg p) (cg-push-string cg "hello") 20 (cg-assign cg) (cg-pop cg) 21 ;; q = "hello" 22 (cg-push-sym cg q) (cg-push-string cg "hello") 23 (cg-assign cg) (cg-pop cg) 24 ;; r = "world" 25 (cg-push-sym cg r) (cg-push-string cg "world") 26 (cg-assign cg) (cg-pop cg) 27 ;; (p == q) + (p != r) 28 (cg-push-sym cg p) (cg-load cg) 29 (cg-push-sym cg q) (cg-load cg) 30 (cg-binop cg 'eq) 31 (cg-push-sym cg p) (cg-load cg) 32 (cg-push-sym cg r) (cg-load cg) 33 (cg-binop cg 'ne) 34 (cg-binop cg 'add)) 35 (cg-return cg) 36 (cg-fn-end cg) 37 (write-bv-fd 1 (cg-finish cg)))