diff options
| author | Stefan Monnier | 2008-04-25 17:16:24 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-04-25 17:16:24 +0000 |
| commit | ed9bdfc505f092db9aa010b263ab3a3c615e3b22 (patch) | |
| tree | 7e1085178cd482b682c83a92302f6a395804fb1f | |
| parent | a08ea1818b260c0ec7c0696c3fc9860e1d3f451d (diff) | |
| download | emacs-ed9bdfc505f092db9aa010b263ab3a3c615e3b22.tar.gz emacs-ed9bdfc505f092db9aa010b263ab3a3c615e3b22.zip | |
Turn comments into docstrings.
| -rw-r--r-- | lisp/international/ccl.el | 132 |
1 files changed, 65 insertions, 67 deletions
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 82c4c434504..5137a662aba 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el | |||
| @@ -186,9 +186,9 @@ | |||
| 186 | (defvar ccl-current-ic 0 | 186 | (defvar ccl-current-ic 0 |
| 187 | "The current index for `ccl-program-vector'.") | 187 | "The current index for `ccl-program-vector'.") |
| 188 | 188 | ||
| 189 | ;; Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and | ||
| 190 | ;; increment it. If IC is specified, embed DATA at IC. | ||
| 191 | (defun ccl-embed-data (data &optional ic) | 189 | (defun ccl-embed-data (data &optional ic) |
| 190 | "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and | ||
| 191 | increment it. If IC is specified, embed DATA at IC." | ||
| 192 | (if ic | 192 | (if ic |
| 193 | (aset ccl-program-vector ic data) | 193 | (aset ccl-program-vector ic data) |
| 194 | (let ((len (length ccl-program-vector))) | 194 | (let ((len (length ccl-program-vector))) |
| @@ -201,16 +201,16 @@ | |||
| 201 | (aset ccl-program-vector ccl-current-ic data) | 201 | (aset ccl-program-vector ccl-current-ic data) |
| 202 | (setq ccl-current-ic (1+ ccl-current-ic)))) | 202 | (setq ccl-current-ic (1+ ccl-current-ic)))) |
| 203 | 203 | ||
| 204 | ;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give | ||
| 205 | ;; proper index number for SYMBOL. PROP should be | ||
| 206 | ;; `translation-table-id', `translation-hash-table-id' | ||
| 207 | ;; `code-conversion-map-id', or `ccl-program-idx'. | ||
| 208 | (defun ccl-embed-symbol (symbol prop) | 204 | (defun ccl-embed-symbol (symbol prop) |
| 205 | "Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give | ||
| 206 | proper index number for SYMBOL. PROP should be | ||
| 207 | `translation-table-id', `translation-hash-table-id' | ||
| 208 | `code-conversion-map-id', or `ccl-program-idx'." | ||
| 209 | (ccl-embed-data (cons symbol prop))) | 209 | (ccl-embed-data (cons symbol prop))) |
| 210 | 210 | ||
| 211 | ;; Embed string STR of length LEN in `ccl-program-vector' at | ||
| 212 | ;; `ccl-current-ic'. | ||
| 213 | (defun ccl-embed-string (len str) | 211 | (defun ccl-embed-string (len str) |
| 212 | "Embed string STR of length LEN in `ccl-program-vector' at | ||
| 213 | `ccl-current-ic'." | ||
| 214 | (if (> len #xFFFFF) | 214 | (if (> len #xFFFFF) |
| 215 | (error "CCL: String too long: %d" len)) | 215 | (error "CCL: String too long: %d" len)) |
| 216 | (if (> (string-bytes str) len) | 216 | (if (> (string-bytes str) len) |
| @@ -227,27 +227,26 @@ | |||
| 227 | 0))) | 227 | 0))) |
| 228 | (setq i (+ i 3)))))) | 228 | (setq i (+ i 3)))))) |
| 229 | 229 | ||
| 230 | ;; Embed a relative jump address to `ccl-current-ic' in | ||
| 231 | ;; `ccl-program-vector' at IC without altering the other bit field. | ||
| 232 | (defun ccl-embed-current-address (ic) | 230 | (defun ccl-embed-current-address (ic) |
| 231 | "Embed a relative jump address to `ccl-current-ic' in | ||
| 232 | `ccl-program-vector' at IC without altering the other bit field." | ||
| 233 | (let ((relative (- ccl-current-ic (1+ ic)))) | 233 | (let ((relative (- ccl-current-ic (1+ ic)))) |
| 234 | (aset ccl-program-vector ic | 234 | (aset ccl-program-vector ic |
| 235 | (logior (aref ccl-program-vector ic) (ash relative 8))))) | 235 | (logior (aref ccl-program-vector ic) (ash relative 8))))) |
| 236 | 236 | ||
| 237 | ;; Embed CCL code for the operation OP and arguments REG and DATA in | ||
| 238 | ;; `ccl-program-vector' at `ccl-current-ic' in the following format. | ||
| 239 | ;; |----------------- integer (28-bit) ------------------| | ||
| 240 | ;; |------------ 20-bit ------------|- 3-bit --|- 5-bit -| | ||
| 241 | ;; |------------- DATA -------------|-- REG ---|-- OP ---| | ||
| 242 | ;; If REG2 is specified, embed a code in the following format. | ||
| 243 | ;; |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| | ||
| 244 | ;; |-------- DATA -------|-- REG2 --|-- REG ---|-- OP ---| | ||
| 245 | |||
| 246 | ;; If REG is a CCL register symbol (e.g. r0, r1...), the register | ||
| 247 | ;; number is embedded. If OP is one of unconditional jumps, DATA is | ||
| 248 | ;; changed to a relative jump address. | ||
| 249 | |||
| 250 | (defun ccl-embed-code (op reg data &optional reg2) | 237 | (defun ccl-embed-code (op reg data &optional reg2) |
| 238 | "Embed CCL code for the operation OP and arguments REG and DATA in | ||
| 239 | `ccl-program-vector' at `ccl-current-ic' in the following format. | ||
| 240 | |----------------- integer (28-bit) ------------------| | ||
| 241 | |------------ 20-bit ------------|- 3-bit --|- 5-bit -| | ||
| 242 | |------------- DATA -------------|-- REG ---|-- OP ---| | ||
| 243 | If REG2 is specified, embed a code in the following format. | ||
| 244 | |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| | ||
| 245 | |-------- DATA -------|-- REG2 --|-- REG ---|-- OP ---| | ||
| 246 | |||
| 247 | If REG is a CCL register symbol (e.g. r0, r1...), the register | ||
| 248 | number is embedded. If OP is one of unconditional jumps, DATA is | ||
| 249 | changed to a relative jump address." | ||
| 251 | (if (and (> data 0) (get op 'jump-flag)) | 250 | (if (and (> data 0) (get op 'jump-flag)) |
| 252 | ;; DATA is an absolute jump address. Make it relative to the | 251 | ;; DATA is an absolute jump address. Make it relative to the |
| 253 | ;; next of jump code. | 252 | ;; next of jump code. |
| @@ -261,25 +260,25 @@ | |||
| 261 | (ash data 8))))) | 260 | (ash data 8))))) |
| 262 | (ccl-embed-data code))) | 261 | (ccl-embed-data code))) |
| 263 | 262 | ||
| 264 | ;; extended ccl command format | ||
| 265 | ;; |- 14-bit -|- 3-bit --|- 3-bit --|- 3-bit --|- 5-bit -| | ||
| 266 | ;; |- EX-OP --|-- REG3 --|-- REG2 --|-- REG ---|-- OP ---| | ||
| 267 | (defun ccl-embed-extended-command (ex-op reg reg2 reg3) | 263 | (defun ccl-embed-extended-command (ex-op reg reg2 reg3) |
| 264 | "extended ccl command format | ||
| 265 | |- 14-bit -|- 3-bit --|- 3-bit --|- 3-bit --|- 5-bit -| | ||
| 266 | |- EX-OP --|-- REG3 --|-- REG2 --|-- REG ---|-- OP ---|" | ||
| 268 | (let ((data (logior (ash (get ex-op 'ccl-ex-code) 3) | 267 | (let ((data (logior (ash (get ex-op 'ccl-ex-code) 3) |
| 269 | (if (symbolp reg3) | 268 | (if (symbolp reg3) |
| 270 | (get reg3 'ccl-register-number) | 269 | (get reg3 'ccl-register-number) |
| 271 | 0)))) | 270 | 0)))) |
| 272 | (ccl-embed-code 'ex-cmd reg data reg2))) | 271 | (ccl-embed-code 'ex-cmd reg data reg2))) |
| 273 | 272 | ||
| 274 | ;; Just advance `ccl-current-ic' by INC. | ||
| 275 | (defun ccl-increment-ic (inc) | 273 | (defun ccl-increment-ic (inc) |
| 274 | "Just advance `ccl-current-ic' by INC." | ||
| 276 | (setq ccl-current-ic (+ ccl-current-ic inc))) | 275 | (setq ccl-current-ic (+ ccl-current-ic inc))) |
| 277 | 276 | ||
| 278 | ;; If non-nil, index of the start of the current loop. | 277 | (defvar ccl-loop-head nil |
| 279 | (defvar ccl-loop-head nil) | 278 | "If non-nil, index of the start of the current loop.") |
| 280 | ;; If non-nil, list of absolute addresses of the breaking points of | 279 | (defvar ccl-breaks nil |
| 281 | ;; the current loop. | 280 | "If non-nil, list of absolute addresses of the breaking points of |
| 282 | (defvar ccl-breaks nil) | 281 | the current loop.") |
| 283 | 282 | ||
| 284 | ;;;###autoload | 283 | ;;;###autoload |
| 285 | (defun ccl-compile (ccl-program) | 284 | (defun ccl-compile (ccl-program) |
| @@ -321,26 +320,26 @@ | |||
| 321 | (setq i (1+ i))) | 320 | (setq i (1+ i))) |
| 322 | vec)) | 321 | vec)) |
| 323 | 322 | ||
| 324 | ;; Signal syntax error. | ||
| 325 | (defun ccl-syntax-error (cmd) | 323 | (defun ccl-syntax-error (cmd) |
| 324 | "Signal syntax error." | ||
| 326 | (error "CCL: Syntax error: %s" cmd)) | 325 | (error "CCL: Syntax error: %s" cmd)) |
| 327 | 326 | ||
| 328 | ;; Check if ARG is a valid CCL register. | ||
| 329 | (defun ccl-check-register (arg cmd) | 327 | (defun ccl-check-register (arg cmd) |
| 328 | "Check if ARG is a valid CCL register." | ||
| 330 | (if (get arg 'ccl-register-number) | 329 | (if (get arg 'ccl-register-number) |
| 331 | arg | 330 | arg |
| 332 | (error "CCL: Invalid register %s in %s" arg cmd))) | 331 | (error "CCL: Invalid register %s in %s" arg cmd))) |
| 333 | 332 | ||
| 334 | ;; Check if ARG is a valid CCL command. | ||
| 335 | (defun ccl-check-compile-function (arg cmd) | 333 | (defun ccl-check-compile-function (arg cmd) |
| 334 | "Check if ARG is a valid CCL command." | ||
| 336 | (or (get arg 'ccl-compile-function) | 335 | (or (get arg 'ccl-compile-function) |
| 337 | (error "CCL: Invalid command: %s" cmd))) | 336 | (error "CCL: Invalid command: %s" cmd))) |
| 338 | 337 | ||
| 339 | ;; In the following code, most ccl-compile-XXXX functions return t if | 338 | ;; In the following code, most ccl-compile-XXXX functions return t if |
| 340 | ;; they end with unconditional jump, else return nil. | 339 | ;; they end with unconditional jump, else return nil. |
| 341 | 340 | ||
| 342 | ;; Compile CCL-BLOCK (see the syntax above). | ||
| 343 | (defun ccl-compile-1 (ccl-block) | 341 | (defun ccl-compile-1 (ccl-block) |
| 342 | "Compile CCL-BLOCK (see the syntax above)." | ||
| 344 | (let (unconditional-jump | 343 | (let (unconditional-jump |
| 345 | cmd) | 344 | cmd) |
| 346 | (if (or (integerp ccl-block) | 345 | (if (or (integerp ccl-block) |
| @@ -385,8 +384,8 @@ | |||
| 385 | (defconst ccl-max-short-const (ash 1 19)) | 384 | (defconst ccl-max-short-const (ash 1 19)) |
| 386 | (defconst ccl-min-short-const (ash -1 19)) | 385 | (defconst ccl-min-short-const (ash -1 19)) |
| 387 | 386 | ||
| 388 | ;; Compile SET statement. | ||
| 389 | (defun ccl-compile-set (cmd) | 387 | (defun ccl-compile-set (cmd) |
| 388 | "Compile SET statement." | ||
| 390 | (let ((rrr (ccl-check-register (car cmd) cmd)) | 389 | (let ((rrr (ccl-check-register (car cmd) cmd)) |
| 391 | (right (nth 2 cmd))) | 390 | (right (nth 2 cmd))) |
| 392 | (cond ((listp right) | 391 | (cond ((listp right) |
| @@ -414,8 +413,8 @@ | |||
| 414 | (ccl-embed-code 'set-register rrr 0 right)))))) | 413 | (ccl-embed-code 'set-register rrr 0 right)))))) |
| 415 | nil) | 414 | nil) |
| 416 | 415 | ||
| 417 | ;; Compile SET statement with ASSIGNMENT_OPERATOR. | ||
| 418 | (defun ccl-compile-self-set (cmd) | 416 | (defun ccl-compile-self-set (cmd) |
| 417 | "Compile SET statement with ASSIGNMENT_OPERATOR." | ||
| 419 | (let ((rrr (ccl-check-register (car cmd) cmd)) | 418 | (let ((rrr (ccl-check-register (car cmd) cmd)) |
| 420 | (right (nth 2 cmd))) | 419 | (right (nth 2 cmd))) |
| 421 | (if (listp right) | 420 | (if (listp right) |
| @@ -432,8 +431,8 @@ | |||
| 432 | (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right))) | 431 | (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right))) |
| 433 | nil) | 432 | nil) |
| 434 | 433 | ||
| 435 | ;; Compile SET statement of the form `(RRR = EXPR)'. | ||
| 436 | (defun ccl-compile-expression (rrr expr) | 434 | (defun ccl-compile-expression (rrr expr) |
| 435 | "Compile SET statement of the form `(RRR = EXPR)'." | ||
| 437 | (let ((left (car expr)) | 436 | (let ((left (car expr)) |
| 438 | (op (get (nth 1 expr) 'ccl-arith-code)) | 437 | (op (get (nth 1 expr) 'ccl-arith-code)) |
| 439 | (right (nth 2 expr))) | 438 | (right (nth 2 expr))) |
| @@ -466,17 +465,17 @@ | |||
| 466 | (logior (ash op 3) (get right 'ccl-register-number)) | 465 | (logior (ash op 3) (get right 'ccl-register-number)) |
| 467 | left))))) | 466 | left))))) |
| 468 | 467 | ||
| 469 | ;; Compile WRITE statement with string argument. | ||
| 470 | (defun ccl-compile-write-string (str) | 468 | (defun ccl-compile-write-string (str) |
| 469 | "Compile WRITE statement with string argument." | ||
| 471 | (let ((len (length str))) | 470 | (let ((len (length str))) |
| 472 | (ccl-embed-code 'write-const-string 1 len) | 471 | (ccl-embed-code 'write-const-string 1 len) |
| 473 | (ccl-embed-string len str)) | 472 | (ccl-embed-string len str)) |
| 474 | nil) | 473 | nil) |
| 475 | 474 | ||
| 476 | ;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'. | ||
| 477 | ;; If READ-FLAG is non-nil, this statement has the form | ||
| 478 | ;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. | ||
| 479 | (defun ccl-compile-if (cmd &optional read-flag) | 475 | (defun ccl-compile-if (cmd &optional read-flag) |
| 476 | "Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'. | ||
| 477 | If READ-FLAG is non-nil, this statement has the form | ||
| 478 | `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'." | ||
| 480 | (if (and (/= (length cmd) 3) (/= (length cmd) 4)) | 479 | (if (and (/= (length cmd) 3) (/= (length cmd) 4)) |
| 481 | (error "CCL: Invalid number of arguments: %s" cmd)) | 480 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 482 | (let ((condition (nth 1 cmd)) | 481 | (let ((condition (nth 1 cmd)) |
| @@ -546,25 +545,25 @@ | |||
| 546 | (ccl-embed-current-address end-true-part-address)))) | 545 | (ccl-embed-current-address end-true-part-address)))) |
| 547 | unconditional-jump))) | 546 | unconditional-jump))) |
| 548 | 547 | ||
| 549 | ;; Compile BRANCH statement. | ||
| 550 | (defun ccl-compile-branch (cmd) | 548 | (defun ccl-compile-branch (cmd) |
| 549 | "Compile BRANCH statement." | ||
| 551 | (if (< (length cmd) 3) | 550 | (if (< (length cmd) 3) |
| 552 | (error "CCL: Invalid number of arguments: %s" cmd)) | 551 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 553 | (ccl-compile-branch-blocks 'branch | 552 | (ccl-compile-branch-blocks 'branch |
| 554 | (ccl-compile-branch-expression (nth 1 cmd) cmd) | 553 | (ccl-compile-branch-expression (nth 1 cmd) cmd) |
| 555 | (cdr (cdr cmd)))) | 554 | (cdr (cdr cmd)))) |
| 556 | 555 | ||
| 557 | ;; Compile READ statement of the form `(read-branch EXPR BLOCK0 BLOCK1 ...)'. | ||
| 558 | (defun ccl-compile-read-branch (cmd) | 556 | (defun ccl-compile-read-branch (cmd) |
| 557 | "Compile READ statement of the form `(read-branch EXPR BLOCK0 BLOCK1 ...)'." | ||
| 559 | (if (< (length cmd) 3) | 558 | (if (< (length cmd) 3) |
| 560 | (error "CCL: Invalid number of arguments: %s" cmd)) | 559 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 561 | (ccl-compile-branch-blocks 'read-branch | 560 | (ccl-compile-branch-blocks 'read-branch |
| 562 | (ccl-compile-branch-expression (nth 1 cmd) cmd) | 561 | (ccl-compile-branch-expression (nth 1 cmd) cmd) |
| 563 | (cdr (cdr cmd)))) | 562 | (cdr (cdr cmd)))) |
| 564 | 563 | ||
| 565 | ;; Compile EXPRESSION part of BRANCH statement and return register | ||
| 566 | ;; which holds a value of the expression. | ||
| 567 | (defun ccl-compile-branch-expression (expr cmd) | 564 | (defun ccl-compile-branch-expression (expr cmd) |
| 565 | "Compile EXPRESSION part of BRANCH statement and return register | ||
| 566 | which holds a value of the expression." | ||
| 568 | (if (listp expr) | 567 | (if (listp expr) |
| 569 | ;; EXPR has the form `(EXPR2 OP ARG)'. Compile it as SET | 568 | ;; EXPR has the form `(EXPR2 OP ARG)'. Compile it as SET |
| 570 | ;; statement of the form `(r7 = (EXPR2 OP ARG))'. | 569 | ;; statement of the form `(r7 = (EXPR2 OP ARG))'. |
| @@ -573,10 +572,10 @@ | |||
| 573 | 'r7) | 572 | 'r7) |
| 574 | (ccl-check-register expr cmd))) | 573 | (ccl-check-register expr cmd))) |
| 575 | 574 | ||
| 576 | ;; Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch. | ||
| 577 | ;; REG is a register which holds a value of EXPRESSION part. BLOCKs | ||
| 578 | ;; is a list of CCL-BLOCKs. | ||
| 579 | (defun ccl-compile-branch-blocks (code rrr blocks) | 575 | (defun ccl-compile-branch-blocks (code rrr blocks) |
| 576 | "Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch. | ||
| 577 | REG is a register which holds a value of EXPRESSION part. BLOCKs | ||
| 578 | is a list of CCL-BLOCKs." | ||
| 580 | (let ((branches (length blocks)) | 579 | (let ((branches (length blocks)) |
| 581 | branch-idx | 580 | branch-idx |
| 582 | jump-table-head-address | 581 | jump-table-head-address |
| @@ -625,8 +624,8 @@ | |||
| 625 | ;; Branch command ends by unconditional jump if RRR is out of range. | 624 | ;; Branch command ends by unconditional jump if RRR is out of range. |
| 626 | nil) | 625 | nil) |
| 627 | 626 | ||
| 628 | ;; Compile LOOP statement. | ||
| 629 | (defun ccl-compile-loop (cmd) | 627 | (defun ccl-compile-loop (cmd) |
| 628 | "Compile LOOP statement." | ||
| 630 | (if (< (length cmd) 2) | 629 | (if (< (length cmd) 2) |
| 631 | (error "CCL: Invalid number of arguments: %s" cmd)) | 630 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 632 | (let* ((ccl-loop-head ccl-current-ic) | 631 | (let* ((ccl-loop-head ccl-current-ic) |
| @@ -649,8 +648,8 @@ | |||
| 649 | (setq ccl-breaks (cdr ccl-breaks)))) | 648 | (setq ccl-breaks (cdr ccl-breaks)))) |
| 650 | nil)))) | 649 | nil)))) |
| 651 | 650 | ||
| 652 | ;; Compile BREAK statement. | ||
| 653 | (defun ccl-compile-break (cmd) | 651 | (defun ccl-compile-break (cmd) |
| 652 | "Compile BREAK statement." | ||
| 654 | (if (/= (length cmd) 1) | 653 | (if (/= (length cmd) 1) |
| 655 | (error "CCL: Invalid number of arguments: %s" cmd)) | 654 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 656 | (if (null ccl-loop-head) | 655 | (if (null ccl-loop-head) |
| @@ -659,8 +658,8 @@ | |||
| 659 | (ccl-embed-code 'jump 0 0) | 658 | (ccl-embed-code 'jump 0 0) |
| 660 | t) | 659 | t) |
| 661 | 660 | ||
| 662 | ;; Compile REPEAT statement. | ||
| 663 | (defun ccl-compile-repeat (cmd) | 661 | (defun ccl-compile-repeat (cmd) |
| 662 | "Compile REPEAT statement." | ||
| 664 | (if (/= (length cmd) 1) | 663 | (if (/= (length cmd) 1) |
| 665 | (error "CCL: Invalid number of arguments: %s" cmd)) | 664 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 666 | (if (null ccl-loop-head) | 665 | (if (null ccl-loop-head) |
| @@ -668,8 +667,8 @@ | |||
| 668 | (ccl-embed-code 'jump 0 ccl-loop-head) | 667 | (ccl-embed-code 'jump 0 ccl-loop-head) |
| 669 | t) | 668 | t) |
| 670 | 669 | ||
| 671 | ;; Compile WRITE-REPEAT statement. | ||
| 672 | (defun ccl-compile-write-repeat (cmd) | 670 | (defun ccl-compile-write-repeat (cmd) |
| 671 | "Compile WRITE-REPEAT statement." | ||
| 673 | (if (/= (length cmd) 2) | 672 | (if (/= (length cmd) 2) |
| 674 | (error "CCL: Invalid number of arguments: %s" cmd)) | 673 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 675 | (if (null ccl-loop-head) | 674 | (if (null ccl-loop-head) |
| @@ -689,8 +688,8 @@ | |||
| 689 | (ccl-embed-code 'write-register-jump arg ccl-loop-head)))) | 688 | (ccl-embed-code 'write-register-jump arg ccl-loop-head)))) |
| 690 | t) | 689 | t) |
| 691 | 690 | ||
| 692 | ;; Compile WRITE-READ-REPEAT statement. | ||
| 693 | (defun ccl-compile-write-read-repeat (cmd) | 691 | (defun ccl-compile-write-read-repeat (cmd) |
| 692 | "Compile WRITE-READ-REPEAT statement." | ||
| 694 | (if (or (< (length cmd) 2) (> (length cmd) 3)) | 693 | (if (or (< (length cmd) 2) (> (length cmd) 3)) |
| 695 | (error "CCL: Invalid number of arguments: %s" cmd)) | 694 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 696 | (if (null ccl-loop-head) | 695 | (if (null ccl-loop-head) |
| @@ -714,8 +713,8 @@ | |||
| 714 | (ccl-embed-code 'read-jump rrr ccl-loop-head)) | 713 | (ccl-embed-code 'read-jump rrr ccl-loop-head)) |
| 715 | t) | 714 | t) |
| 716 | 715 | ||
| 717 | ;; Compile READ statement. | ||
| 718 | (defun ccl-compile-read (cmd) | 716 | (defun ccl-compile-read (cmd) |
| 717 | "Compile READ statement." | ||
| 719 | (if (< (length cmd) 2) | 718 | (if (< (length cmd) 2) |
| 720 | (error "CCL: Invalid number of arguments: %s" cmd)) | 719 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 721 | (let* ((args (cdr cmd)) | 720 | (let* ((args (cdr cmd)) |
| @@ -726,12 +725,12 @@ | |||
| 726 | (setq args (cdr args) i (1- i))))) | 725 | (setq args (cdr args) i (1- i))))) |
| 727 | nil) | 726 | nil) |
| 728 | 727 | ||
| 729 | ;; Compile READ-IF statement. | ||
| 730 | (defun ccl-compile-read-if (cmd) | 728 | (defun ccl-compile-read-if (cmd) |
| 729 | "Compile READ-IF statement." | ||
| 731 | (ccl-compile-if cmd 'read)) | 730 | (ccl-compile-if cmd 'read)) |
| 732 | 731 | ||
| 733 | ;; Compile WRITE statement. | ||
| 734 | (defun ccl-compile-write (cmd) | 732 | (defun ccl-compile-write (cmd) |
| 733 | "Compile WRITE statement." | ||
| 735 | (if (< (length cmd) 2) | 734 | (if (< (length cmd) 2) |
| 736 | (error "CCL: Invalid number of arguments: %s" cmd)) | 735 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 737 | (let ((rrr (nth 1 cmd))) | 736 | (let ((rrr (nth 1 cmd))) |
| @@ -789,8 +788,8 @@ | |||
| 789 | (error "CCL: Invalid argument: %s" cmd)))) | 788 | (error "CCL: Invalid argument: %s" cmd)))) |
| 790 | nil) | 789 | nil) |
| 791 | 790 | ||
| 792 | ;; Compile CALL statement. | ||
| 793 | (defun ccl-compile-call (cmd) | 791 | (defun ccl-compile-call (cmd) |
| 792 | "Compile CALL statement." | ||
| 794 | (if (/= (length cmd) 2) | 793 | (if (/= (length cmd) 2) |
| 795 | (error "CCL: Invalid number of arguments: %s" cmd)) | 794 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 796 | (if (not (symbolp (nth 1 cmd))) | 795 | (if (not (symbolp (nth 1 cmd))) |
| @@ -799,15 +798,15 @@ | |||
| 799 | (ccl-embed-symbol (nth 1 cmd) 'ccl-program-idx) | 798 | (ccl-embed-symbol (nth 1 cmd) 'ccl-program-idx) |
| 800 | nil) | 799 | nil) |
| 801 | 800 | ||
| 802 | ;; Compile END statement. | ||
| 803 | (defun ccl-compile-end (cmd) | 801 | (defun ccl-compile-end (cmd) |
| 802 | "Compile END statement." | ||
| 804 | (if (/= (length cmd) 1) | 803 | (if (/= (length cmd) 1) |
| 805 | (error "CCL: Invalid number of arguments: %s" cmd)) | 804 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 806 | (ccl-embed-code 'end 0 0) | 805 | (ccl-embed-code 'end 0 0) |
| 807 | t) | 806 | t) |
| 808 | 807 | ||
| 809 | ;; Compile read-multibyte-character | ||
| 810 | (defun ccl-compile-read-multibyte-character (cmd) | 808 | (defun ccl-compile-read-multibyte-character (cmd) |
| 809 | "Compile read-multibyte-character" | ||
| 811 | (if (/= (length cmd) 3) | 810 | (if (/= (length cmd) 3) |
| 812 | (error "CCL: Invalid number of arguments: %s" cmd)) | 811 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 813 | (let ((RRR (nth 1 cmd)) | 812 | (let ((RRR (nth 1 cmd)) |
| @@ -817,8 +816,8 @@ | |||
| 817 | (ccl-embed-extended-command 'read-multibyte-character rrr RRR 0)) | 816 | (ccl-embed-extended-command 'read-multibyte-character rrr RRR 0)) |
| 818 | nil) | 817 | nil) |
| 819 | 818 | ||
| 820 | ;; Compile write-multibyte-character | ||
| 821 | (defun ccl-compile-write-multibyte-character (cmd) | 819 | (defun ccl-compile-write-multibyte-character (cmd) |
| 820 | "Compile write-multibyte-character" | ||
| 822 | (if (/= (length cmd) 3) | 821 | (if (/= (length cmd) 3) |
| 823 | (error "CCL: Invalid number of arguments: %s" cmd)) | 822 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 824 | (let ((RRR (nth 1 cmd)) | 823 | (let ((RRR (nth 1 cmd)) |
| @@ -828,8 +827,8 @@ | |||
| 828 | (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0)) | 827 | (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0)) |
| 829 | nil) | 828 | nil) |
| 830 | 829 | ||
| 831 | ;; Compile translate-character | ||
| 832 | (defun ccl-compile-translate-character (cmd) | 830 | (defun ccl-compile-translate-character (cmd) |
| 831 | "Compile translate-character." | ||
| 833 | (if (/= (length cmd) 4) | 832 | (if (/= (length cmd) 4) |
| 834 | (error "CCL: Invalid number of arguments: %s" cmd)) | 833 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 835 | (let ((Rrr (nth 1 cmd)) | 834 | (let ((Rrr (nth 1 cmd)) |
| @@ -846,8 +845,8 @@ | |||
| 846 | (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) | 845 | (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) |
| 847 | nil) | 846 | nil) |
| 848 | 847 | ||
| 849 | ;; Compile lookup-integer | ||
| 850 | (defun ccl-compile-lookup-integer (cmd) | 848 | (defun ccl-compile-lookup-integer (cmd) |
| 849 | "Compile lookup-integer." | ||
| 851 | (if (/= (length cmd) 4) | 850 | (if (/= (length cmd) 4) |
| 852 | (error "CCL: Invalid number of arguments: %s" cmd)) | 851 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 853 | (let ((Rrr (nth 1 cmd)) | 852 | (let ((Rrr (nth 1 cmd)) |
| @@ -866,8 +865,8 @@ | |||
| 866 | (ccl-embed-extended-command 'lookup-int rrr RRR 0)))) | 865 | (ccl-embed-extended-command 'lookup-int rrr RRR 0)))) |
| 867 | nil) | 866 | nil) |
| 868 | 867 | ||
| 869 | ;; Compile lookup-character | ||
| 870 | (defun ccl-compile-lookup-character (cmd) | 868 | (defun ccl-compile-lookup-character (cmd) |
| 869 | "Compile lookup-character." | ||
| 871 | (if (/= (length cmd) 4) | 870 | (if (/= (length cmd) 4) |
| 872 | (error "CCL: Invalid number of arguments: %s" cmd)) | 871 | (error "CCL: Invalid number of arguments: %s" cmd)) |
| 873 | (let ((Rrr (nth 1 cmd)) | 872 | (let ((Rrr (nth 1 cmd)) |
| @@ -960,7 +959,6 @@ | |||
| 960 | 959 | ||
| 961 | ;;; CCL dump stuff | 960 | ;;; CCL dump stuff |
| 962 | 961 | ||
| 963 | ;; To avoid byte-compiler warning. | ||
| 964 | (defvar ccl-code) | 962 | (defvar ccl-code) |
| 965 | 963 | ||
| 966 | ;;;###autoload | 964 | ;;;###autoload |
| @@ -987,8 +985,8 @@ | |||
| 987 | (ccl-dump-1)) | 985 | (ccl-dump-1)) |
| 988 | )) | 986 | )) |
| 989 | 987 | ||
| 990 | ;; Return a CCL code in `ccl-code' at `ccl-current-ic'. | ||
| 991 | (defun ccl-get-next-code () | 988 | (defun ccl-get-next-code () |
| 989 | "Return a CCL code in `ccl-code' at `ccl-current-ic'." | ||
| 992 | (prog1 | 990 | (prog1 |
| 993 | (aref ccl-code ccl-current-ic) | 991 | (aref ccl-code ccl-current-ic) |
| 994 | (setq ccl-current-ic (1+ ccl-current-ic)))) | 992 | (setq ccl-current-ic (1+ ccl-current-ic)))) |