(loader '((title |traverse.lo|))) (loader'((fentry check-travinit subr0) (entry check-travinit subr0) (mov 't a2) (mov '(test-travinit 1) a1) (jmp check-value) )) (loader'((fentry meter-travinit subr0) (entry meter-travinit subr0) (mov 'travinit a2) (mov '(init-traverse) a1) (jmp perform-meter) )) (loader'((fentry test-travinit subr1) (entry test-travinit subr1) (cabne a1 '1 104) (bra init-traverse) 103 (push a1) (call init-traverse) (pop a1) 104 (sobgez a1 103) (mov 't a1) (return) )) (loader'((fentry check-travrun subr0) (entry check-travrun subr0) (mov 't a2) (mov '(test-travrun 1) a1) (jmp check-value) )) (loader'((fentry meter-travrun subr0) (entry meter-travrun subr0) (mov 'travrun a2) (mov '(run-traverse) a1) (jmp perform-meter) )) (loader'((fentry test-travrun subr1) (entry test-travrun subr1) (cabne a1 '1 104) (bra run-traverse) 103 (push a1) (call run-traverse) (pop a1) 104 (sobgez a1 103) (mov 't a1) (return) )) (putprop 'node '((() () (snb) () () () () () () ()) parents sons sn entry1 entry2 entry3 entry4 entry5 entry6 mark) 'defstruct) (loader'((entry #:node:make subr0) (push (@ 101)) (push nil) (push nil) (call snb) (push a1) (push nil) (push nil) (push nil) (push nil) (push nil) (push nil) (push nil) (mov '10 a4) (jmp vector) 101 (eval ()) (push a1) (push (@ 102)) (push a1) (push 'node) (mov '2 a4) (jmp typevector) 102 (eval ()) (mov (& 0) a1) (adjstk '1) (return) )) (if (featurep 'setf) (progn (progn (putprop '#:node:parents '#:node:parents 'setf-inverse) '#:node:parents))) (if (featurep 'compiler) (progn (defmacro-open #:node:parents (struct . valeur) (ifn valeur (list 'vref struct 0) (list 'vset struct 0 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:sons '#:node:sons 'setf-inverse) '#:node:sons))) (if (featurep 'compiler) (progn (defmacro-open #:node:sons (struct . valeur) (ifn valeur (list 'vref struct 1) (list 'vset struct 1 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:sn '#:node:sn 'setf-inverse) '#:node:sn))) (if (featurep 'compiler) (progn (defmacro-open #:node:sn (struct . valeur) (ifn valeur (list 'vref struct 2) (list 'vset struct 2 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry1 '#:node:entry1 'setf-inverse) '#:node:entry1))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry1 (struct . valeur) (ifn valeur (list 'vref struct 3) (list 'vset struct 3 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry2 '#:node:entry2 'setf-inverse) '#:node:entry2))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry2 (struct . valeur) (ifn valeur (list 'vref struct 4) (list 'vset struct 4 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry3 '#:node:entry3 'setf-inverse) '#:node:entry3))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry3 (struct . valeur) (ifn valeur (list 'vref struct 5) (list 'vset struct 5 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry4 '#:node:entry4 'setf-inverse) '#:node:entry4))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry4 (struct . valeur) (ifn valeur (list 'vref struct 6) (list 'vset struct 6 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry5 '#:node:entry5 'setf-inverse) '#:node:entry5))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry5 (struct . valeur) (ifn valeur (list 'vref struct 7) (list 'vset struct 7 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:entry6 '#:node:entry6 'setf-inverse) '#:node:entry6))) (if (featurep 'compiler) (progn (defmacro-open #:node:entry6 (struct . valeur) (ifn valeur (list 'vref struct 8) (list 'vset struct 8 (car valeur)))))) (if (featurep 'setf) (progn (progn (putprop '#:node:mark '#:node:mark 'setf-inverse) '#:node:mark))) (if (featurep 'compiler) (progn (defmacro-open #:node:mark (struct . valeur) (ifn valeur (list 'vref struct 9) (list 'vset struct 9 (car valeur)))))) (putprop '#:node:parents (lambda (y x) (list '#:node:parents x y)) 'setf-expander) '#:node:parents (putprop '#:node:sons (lambda (y x) (list '#:node:sons x y)) 'setf-expander) '#:node:sons (putprop '#:node:sn (lambda (y x) (list '#:node:sn x y)) 'setf-expander) '#:node:sn (putprop '#:node:entry1 (lambda (y x) (list '#:node:entry1 x y)) 'setf-expander) '#:node:entry1 (putprop '#:node:entry2 (lambda (y x) (list '#:node:entry2 x y)) 'setf-expander) '#:node:entry2 (putprop '#:node:entry3 (lambda (y x) (list '#:node:entry3 x y)) 'setf-expander) '#:node:entry3 (putprop '#:node:entry4 (lambda (y x) (list '#:node:entry4 x y)) 'setf-expander) '#:node:entry4 (putprop '#:node:entry5 (lambda (y x) (list '#:node:entry5 x y)) 'setf-expander) '#:node:entry5 (putprop '#:node:entry6 (lambda (y x) (list '#:node:entry6 x y)) 'setf-expander) '#:node:entry6 (putprop '#:node:mark (lambda (y x) (list '#:node:mark x y)) 'setf-expander) '#:node:mark (defvar traverse-sn 0) (defvar *count-call* 0) (defvar traverse-rand 21) (defvar traverse-count 0) (defvar traverse-marker nil) (defvar traverse-root) (setq traverse-sn 0 traverse-rand 21 traverse-count 0 traverse-marker nil) (loader'((entry snb subr0) (mov (cvalq traverse-sn) a4) (plus '1 a4) (mov a4 (cvalq traverse-sn)) (mov a4 a1) (return) )) (loader'((fentry traverse-seed subr0) (entry traverse-seed subr0) (mov '21 (cvalq traverse-rand)) (mov '21 a1) (return) )) (loader'((entry traverse-random subr0) (mov (cvalq traverse-rand) a4) (times '17 a4) (rem '251 a4) (mov a4 (cvalq traverse-rand)) (mov a4 a1) (return) )) (loader'((entry traverse-remove subr2) (push a2) (mov (car a2) a4) (cabne (cdr a4) (car a2) 101) (mov (car a2) a1) (push (car a1)) (mov nil (car a2)) (pop a1) (adjstk '1) (return) 101 (cabne a1 '0 103) (mov (car a2) a1) (push (car a1)) (push (car a2)) 105 (mov (& 0) a4) (mov (& 2) a3) (cabeq (cdr a4) (car a3) 106) (mov (cdr a4) (& 0)) (bra 105) 106 (mov (car a3) a2) (mov (cdr a2) (cdr a4)) (mov a4 (car a3)) (adjstk '1) (pop a1) (adjstk '1) (return) 103 (mov (car a2) a3) (push (car a2)) (push (cdr a3)) (push a1) 107 (cabeq (& 0) '0 108) (mov (& 0) a4) (diff '1 a4) (mov (& 2) a3) (mov (& 1) a2) (mov (cdr a2) (& 1)) (mov (cdr a3) (& 2)) (mov a4 (& 0)) (bra 107) 108 (mov (& 2) a1) (mov (& 1) (cdr a1)) (mov (car a1) a1) (adjstk '4) (return) )) (loader'((entry traverse-select subr2) (push (car a2)) (push a1) 101 (cabeq (& 0) '0 102) (mov (& 0) a4) (diff '1 a4) (mov (& 1) a3) (mov (cdr a3) (& 1)) (mov a4 (& 0)) (bra 101) 102 (mov (& 1) a1) (mov (car a1) a1) (adjstk '2) (return) )) (loader'((entry traverse-add subr2) (push a2) (bfnil a2 101) (push (@ 103)) (push (@ 104)) (push a1) (mov '1 a4) (jmp list) 104 (eval ()) (mov a1 (cdr a1)) (push a1) (mov '1 a4) (jmp list) 103 (eval ()) (adjstk '1) (return) 101 (bfnil (car a2) 105) (push (@ 107)) (push a1) (mov '1 a4) (jmp list) 107 (eval ()) (mov a1 (cdr a1)) (mov (& 0) a4) (mov a1 (car a4)) (mov a4 a1) (adjstk '1) (return) 105 (push a2) (push (car a2)) (mov (car a2) a2) (mov (cdr a2) a2) (jcall cons) (pop a4) (mov a1 (cdr a4)) (pop a3) (mov a4 (car a3)) (mov a3 a1) (adjstk '1) (return) )) (loader'((entry traverse-create-structure subr1) (push a1) (push (@ 101)) (call #:node:make) (push a1) (mov '1 a4) (jmp list) 101 (eval ()) (push a1) (mov (& 1) a4) (diff '1 a4) (push a1) (push a4) 102 (cabeq (& 0) '0 103) (call #:node:make) (mov (& 2) a2) (jcall cons) (mov a1 (& 2)) (mov (& 0) a4) (diff '1 a4) (mov a4 (& 0)) (bra 102) 103 (push (@ 104)) (mov (& 2) a4) (mov (& 3) (cdr a4)) (push a4) (mov '1 a4) (jmp list) 104 (eval ()) (mov a1 (& 2)) (push a1) (mov a1 a2) (mov '0 a1) (call traverse-remove) (mov nil a2) (call traverse-add) (push nil) (push nil) (push a1) 105 (mov (& 3) a4) (btnil (car a4) 106) (call traverse-random) (rem (& 7) a1) (mov (& 3) a2) (call traverse-remove) (mov a1 (& 2)) (call traverse-random) (rem (& 7) a1) (mov (& 0) a2) (call traverse-select) (mov a1 (& 1)) (mov (& 0) a2) (mov (& 2) a1) (call traverse-add) (hpxmov (& 1) '1 a2) (mov (& 2) a1) (jcall cons) (hpmovx a1 (& 1) '1) (hpxmov (& 2) '0 a2) (mov (& 1) a1) (jcall cons) (hpmovx a1 (& 2) '0) (bra 105) 106 (mov (& 0) a2) (mov '0 a1) (call traverse-select) (mov (& 7) a2) (adjstk '8) (bra find-root) )) (loader'((entry find-root subr2) (push a1) (push a2) 101 (cabeq (& 0) '0 102) (hpxmov (& 1) '0 a4) (btnil a4 102) (hpxmov (& 1) '0 a4) (mov (car a4) (& 1)) (mov (& 0) a4) (diff '1 a4) (mov a4 (& 0)) (bra 101) 102 (mov (& 1) a1) (adjstk '2) (return) )) (loader'((entry travers subr2) (push a2) (mov (cvalq *count-call*) a4) (plus '1 a4) (mov a4 (cvalq *count-call*)) (hpxmov a1 '9 a3) (cabne a3 a2 101) (mov nil a1) (adjstk '1) (return) 101 (hpmovx a2 a1 '9) (mov (cvalq traverse-count) a3) (plus '1 a3) (mov a3 (cvalq traverse-count)) (hpxmov a1 '3 a4) (btnil a4 103) (mov nil a4) (bra 104) 103 (mov 't a4) 104 (hpmovx a4 a1 '3) (hpxmov a1 '4 a4) (btnil a4 105) (mov nil a4) (bra 106) 105 (mov 't a4) 106 (hpmovx a4 a1 '4) (hpxmov a1 '5 a4) (btnil a4 107) (mov nil a4) (bra 108) 107 (mov 't a4) 108 (hpmovx a4 a1 '5) (hpxmov a1 '6 a4) (btnil a4 109) (mov nil a4) (bra 110) 109 (mov 't a4) 110 (hpmovx a4 a1 '6) (hpxmov a1 '7 a4) (btnil a4 111) (mov nil a4) (bra 112) 111 (mov 't a4) 112 (hpmovx a4 a1 '7) (hpxmov a1 '8 a4) (btnil a4 113) (mov nil a4) (bra 114) 113 (mov 't a4) 114 (hpmovx a4 a1 '8) (hpxmov a1 '1 a4) (push a4) 115 (btnil (& 0) 116) (mov (& 0) a1) (mov (& 1) a2) (mov (car a1) a1) (call travers) (mov (& 0) a4) (mov (cdr a4) (& 0)) (bra 115) 116 (mov nil a1) (adjstk '2) (return) )) (loader'((entry traverse subr1) (push '0) (push (cvalq traverse-count)) (mov (& 1) (cvalq traverse-count)) (push '1) (push '(traverse-count)) (push 'lambda) (push llink) (push dlink) (push cbindn) (stack dlink) (btnil (cvalq traverse-marker) 101) (mov nil a4) (bra 102) 101 (mov 't a4) 102 (mov a4 (cvalq traverse-marker)) (mov a4 a2) (call travers) (mov (cvalq traverse-count) a1) (mov (& 1) dlink) (mov (& 6) (cvalq traverse-count)) (adjstk '8) (return) )) (loader'((entry init-traverse subr0) (mov '100 a1) (call traverse-create-structure) (mov a1 (cvalq traverse-root)) (mov nil a1) (return) )) (loader'((entry run-traverse subr0) (mov '50 a4) (bra 102) 101 (push a4) (mov (cvalq traverse-root) a1) (call traverse) (mov (cvalq traverse-root) a1) (call traverse) (mov (cvalq traverse-root) a1) (call traverse) (mov (cvalq traverse-root) a1) (call traverse) (mov (cvalq traverse-root) a1) (call traverse) (pop a4) 102 (sobgez a4 101) (mov 't a1) (return) )) (loader '((end)))