diff options
Diffstat (limited to 'module/language/bytecode.scm')
-rw-r--r-- | module/language/bytecode.scm | 85 |
1 files changed, 1 insertions, 84 deletions
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm index b304e3598..e9cbb7ea0 100644 --- a/module/language/bytecode.scm +++ b/module/language/bytecode.scm @@ -1,6 +1,6 @@ ;;; Bytecode -;; Copyright (C) 2013, 2017, 2018, 2020 Free Software Foundation, Inc. +;; Copyright (C) 2013, 2017, 2018, 2020, 2025 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -34,89 +34,6 @@ (load-extension (string-append "libguile-" (effective-version)) "scm_init_intrinsics") -(begin-deprecated - (define (compute-instruction-arity name args) - (define (first-word-arity word) - (case word - ((X32) 0) - ((X8_S24) 1) - ((X8_F24) 1) - ((X8_C24) 1) - ((X8_L24) 1) - ((X8_S8_I16) 2) - ((X8_S8_ZI16) 2) - ((X8_S12_S12) 2) - ((X8_S12_C12) 2) - ((X8_S12_Z12) 2) - ((X8_C12_C12) 2) - ((X8_F12_F12) 2) - ((X8_S8_S8_S8) 3) - ((X8_S8_S8_C8) 3) - ((X8_S8_C8_S8) 3))) - (define (tail-word-arity word) - (case word - ((C32) 1) - ((I32) 1) - ((A32 AU32 AS32 AF32) 1) - ((B32 BF32 BS32 BU32) 0) - ((N32) 1) - ((R32) 1) - ((L32) 1) - ((LO32) 1) - ((C8_C24) 2) - ((C8_S24) 2) - ((C16_C16) 2) - ((B1_C7_L24) 3) - ((B1_X7_S24) 2) - ((B1_X7_F24) 2) - ((B1_X7_C24) 2) - ((B1_X7_L24) 2) - ((B1_X31) 1) - ((X8_S24) 1) - ((X8_F24) 1) - ((X8_C24) 1) - ((X8_L24) 1))) - (match args - ((arg0 . args) - (fold (lambda (arg arity) - (+ (tail-word-arity arg) arity)) - (first-word-arity arg0) - args)))) - - (define *macro-instruction-arities* - '((cache-current-module! . (0 . 1)) - (cached-toplevel-box . (1 . 0)) - (cached-module-box . (1 . 0)))) - - (define (compute-instruction-arities) - (issue-deprecation-warning - "`instruction-arity' is deprecated. Instead, use instruction-list directly -if needed.") - (let ((table (make-hash-table))) - (for-each - (match-lambda - ;; Put special cases here. - (('jtable . _) - ;; No macro-instruction. - #f) - ((name op '! . args) - (hashq-set! table name - (cons 0 (compute-instruction-arity name args)))) - ((name op '<- . args) - (hashq-set! table name - (cons 1 (1- (compute-instruction-arity name args)))))) - (instruction-list)) - (for-each (match-lambda - ((name . arity) - (hashq-set! table name arity))) - *macro-instruction-arities*) - table)) - - (define *instruction-arities* (delay (compute-instruction-arities))) - - (define-public (instruction-arity name) - (hashq-ref (force *instruction-arities*) name))) - (define *intrinsic-codes* (delay (let ((tab (make-hash-table))) (for-each (lambda (pair) |