843 |
(defun c1dm-bad-key (key) |
(defun c1dm-bad-key (key) |
844 |
(cmperr "Defmacro-lambda-list contains illegal use of ~s." key)) |
(cmperr "Defmacro-lambda-list contains illegal use of ~s." key)) |
845 |
|
|
846 |
|
(defmacro maybe-wt-c2dm-bind-vl (vl cvar form end-form) |
847 |
|
`(let ((ipos (file-position *compiler-output1*))) |
848 |
|
,form |
849 |
|
(let ((npos (file-position *compiler-output1*))) |
850 |
|
(c2dm-bind-vl ,vl ,cvar) |
851 |
|
(if (eql npos (file-position *compiler-output1*)) |
852 |
|
(file-position *compiler-output1* ipos) |
853 |
|
,end-form)))) |
854 |
|
|
855 |
(defun c2dm (whole env vl body |
(defun c2dm (whole env vl body |
856 |
&aux (cvar (next-cvar))) |
&aux (cvar (next-cvar))) |
857 |
(when (or *safe-compile* *compiler-check-args*) |
(when (or *safe-compile* *compiler-check-args*) |
864 |
(wt-nl "vs_top=sup;") |
(wt-nl "vs_top=sup;") |
865 |
(when whole (c2bind whole)) |
(when whole (c2bind whole)) |
866 |
(when env (c2bind env)) |
(when env (c2bind env)) |
867 |
(wt-nl "{object V" cvar "=base[0]->c.c_cdr;") |
(maybe-wt-c2dm-bind-vl vl cvar (wt-nl "{object V" cvar "=base[0]->c.c_cdr;") (wt "}")) |
|
(c2dm-bind-vl vl cvar) |
|
|
(wt "}") |
|
868 |
(c2expr body) |
(c2expr body) |
869 |
) |
) |
870 |
|
|
886 |
(c2dm-reserve-vl v) |
(c2dm-reserve-vl v) |
887 |
(setf (var-ref v) (vs-push)))) |
(setf (var-ref v) (vs-push)))) |
888 |
|
|
889 |
(defun c2dm-bind-vl (vl cvar |
(defun c2dm-bind-vl (vl cvar |
890 |
&aux |
&aux |
891 |
(requireds (car vl)) (optionals (cadr vl)) |
(requireds (car vl)) (optionals (cadr vl)) |
892 |
(rest (caddr vl)) (key-flag (cadddr vl)) |
(rest (caddr vl)) (key-flag (cadddr vl)) |
936 |
(*ccb-vs* *ccb-vs*)) |
(*ccb-vs* *ccb-vs*)) |
937 |
(c2dm-bind-init (cadr kwd) (caddr kwd)) |
(c2dm-bind-init (cadr kwd) (caddr kwd)) |
938 |
(when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) nil)) |
(when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) nil)) |
939 |
(wt-nl "} else {")) |
(wt "} else {")) |
940 |
(c2dm-bind-loc (cadr kwd) `(cvar ,cvar1)) |
(c2dm-bind-loc (cadr kwd) `(cvar ,cvar1)) |
941 |
(when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) t)) |
(when (cadddr kwd) (c2dm-bind-loc (cadddr kwd) t)) |
942 |
(wt "}}"))) |
(wt-nl "}}"))) |
943 |
(when (and (or *safe-compile* *compiler-check-args*) |
(when (and (or *safe-compile* *compiler-check-args*) |
944 |
(null rest) |
(null rest) |
945 |
(null key-flag)) |
(null key-flag)) |
958 |
(defun c2dm-bind-loc (v loc) |
(defun c2dm-bind-loc (v loc) |
959 |
(if (consp v) |
(if (consp v) |
960 |
(let ((cvar (next-cvar))) |
(let ((cvar (next-cvar))) |
961 |
(wt-nl "{object V" cvar "= " loc ";") |
(maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}"))) |
|
(c2dm-bind-vl v cvar) |
|
|
(wt "}")) |
|
962 |
(c2bind-loc v loc))) |
(c2bind-loc v loc))) |
963 |
|
|
964 |
(defun c2dm-bind-init (v init) |
(defun c2dm-bind-init (v init) |
966 |
(let* ((*vs* *vs*) (*inline-blocks* 0) |
(let* ((*vs* *vs*) (*inline-blocks* 0) |
967 |
(cvar (next-cvar)) |
(cvar (next-cvar)) |
968 |
(loc (car (inline-args (list init) '(t))))) |
(loc (car (inline-args (list init) '(t))))) |
969 |
(wt-nl "{object V" cvar "= " loc ";") |
(maybe-wt-c2dm-bind-vl v cvar (wt-nl "{object V" cvar "= " loc ";") (wt "}")) |
970 |
(c2dm-bind-vl v cvar) |
(close-inline-blocks)) |
|
(wt "}") |
|
|
(close-inline-blocks)) |
|
971 |
(c2bind-init v init))) |
(c2bind-init v init))) |
972 |
|
|
973 |
|
|