Skip to content

code generated for the duff device doesn't work ;-)

(cl-user::cat  #P"~/src/lisp/c/duff-device.c")
#|
void duff_s_device(void){
        /*  This is called duff's device and there are many great explanations online: 
            http://en.wikipedia.org/wiki/Duff%27s_device                             */
        /*  What does this do?  */
        unsigned int count = 22;
        unsigned int j = (count + 7) / 8;
        putchar('\n');
        switch(count % 8) {
                case 0: do{     putchar('0' + (int)j);
                case 7:         putchar('0' + (int)j);
                case 6:         putchar('0' + (int)j);
                case 5:         putchar('0' + (int)j);
                case 4:         putchar('0' + (int)j);
                case 3:         putchar('0' + (int)j);
                case 2:         putchar('0' + (int)j);
                case 1:         putchar('0' + (int)j);
                        } while(--j > 0);
        }
        putchar('\n');
}
|#

(pprint (let ((*readtable*               vacietis:c-readtable)
       (vacietis:*compiler-state* (vacietis:make-compiler-state)))
   (with-open-file (src #P"~/src/lisp/c/duff-device.c")
     (read src))))

(vacietis::defun/1 duff_s_device
                   nil
                   (prog* ((j 0) (count 0))
                          (progn (vacietis.c:= count 22))
                          (progn (vacietis.c:= j
                                               (vacietis.c:/
                                                (vacietis.c:+ count 7)
                                                8)))
                          (putchar 10)
                          (vacietis.c:switch (vacietis.c:% count 8)
                                             (1 2 3 4 5 6 7 0)
                                             (0
                                              (vacietis.c:do
                                               (tagbody (putchar
                                                         (vacietis.c:+ 48 j))
                                                        7
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        6
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        5
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        4
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        3
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        2
                                                        (putchar
                                                         (vacietis.c:+ 48 j))
                                                        1
                                                        (putchar
                                                         (vacietis.c:+ 48 j)))
                                               (vacietis.c:>
                                                (vacietis.c:=
                                                 j
                                                 (vacietis.c:- j 1))
                                                0))))
                          (putchar 10)))

;; While compiling duff_s_device :
;; Can't GO to tag 1.