From a9a5d75abe2cb87ba5e071a7dc81d9639bdead24 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Fri, 7 Feb 1992 05:58:34 +0000 Subject: [PATCH] Add shortcircuit_apply hooks. --- v7/src/compiler/machines/spectrum/lapgen.scm | 15 ++- v7/src/compiler/machines/spectrum/rules3.scm | 29 ++++- v7/src/microcode/cmpauxmd/hppa.m4 | 120 +++++++++++++++---- v8/src/microcode/cmpauxmd/hppa.m4 | 120 +++++++++++++++---- 4 files changed, 230 insertions(+), 54 deletions(-) diff --git a/v7/src/compiler/machines/spectrum/lapgen.scm b/v7/src/compiler/machines/spectrum/lapgen.scm index 01937b0a3..402f7c1da 100644 --- a/v7/src/compiler/machines/spectrum/lapgen.scm +++ b/v7/src/compiler/machines/spectrum/lapgen.scm @@ -1,9 +1,9 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/lapgen.scm,v 4.36 1991/05/07 17:44:02 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/lapgen.scm,v 4.37 1992/02/07 05:58:34 jinx Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.41 1991/05/06 23:05:51 jinx Exp $ -Copyright (c) 1988-1991 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -576,7 +576,16 @@ MIT in each case. |# -1+ zero? positive? - negative?)) + negative? + shortcircuit-apply + shortcircuit-apply-1 + shortcircuit-apply-2 + shortcircuit-apply-3 + shortcircuit-apply-4 + shortcircuit-apply-5 + shortcircuit-apply-6 + shortcircuit-apply-7 + shortcircuit-apply-8)) (define (invoke-hook hook) (LAP (BLE () (OFFSET ,hook 4 ,regnum:scheme-to-interface-ble)) diff --git a/v7/src/compiler/machines/spectrum/rules3.scm b/v7/src/compiler/machines/spectrum/rules3.scm index 955c9ab7b..568a6714f 100644 --- a/v7/src/compiler/machines/spectrum/rules3.scm +++ b/v7/src/compiler/machines/spectrum/rules3.scm @@ -1,9 +1,9 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rules3.scm,v 4.30 1991/05/07 17:54:14 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rules3.scm,v 4.31 1992/02/07 05:58:22 jinx Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.30 1991/05/07 13:45:31 jinx Exp $ -Copyright (c) 1988-1991 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -60,9 +60,28 @@ MIT in each case. |# (INVOCATION:APPLY (? frame-size) (? continuation)) continuation ;ignore (LAP ,@(clear-map!) - ,@(load-immediate frame-size regnum:second-arg) - (LDWM () (OFFSET 4 0 22) ,regnum:first-arg) ; procedure - ,@(invoke-interface code:compiler-apply))) + ,@(case frame-size + ((1) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-1 4 + ,regnum:scheme-to-interface-ble)))) + ((2) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-2 4 + ,regnum:scheme-to-interface-ble)))) + ((3) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-3 4 + ,regnum:scheme-to-interface-ble)))) + ((4) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-4 4 + ,regnum:scheme-to-interface-ble)))) + ((5) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-5 4 + ,regnum:scheme-to-interface-ble)))) + ((6) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-6 4 + ,regnum:scheme-to-interface-ble)))) + ((7) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-7 4 + ,regnum:scheme-to-interface-ble)))) + ((8) (LAP (BLE () (OFFSET ,hook:compiler-shortcircuit-apply-8 4 + ,regnum:scheme-to-interface-ble)))) + (else + (LAP ,@(load-immediate frame-size regnum:second-arg) + (BLE () (OFFSET ,hook:compiler-shortcircuit-apply 4 + ,regnum:scheme-to-interface-ble))))) + (LDWM () (OFFSET 4 0 22) ,regnum:first-arg))) (define-rule statement (INVOCATION:JUMP (? frame-size) (? continuation) (? label)) diff --git a/v7/src/microcode/cmpauxmd/hppa.m4 b/v7/src/microcode/cmpauxmd/hppa.m4 index c7e2d513c..45ae85fb2 100644 --- a/v7/src/microcode/cmpauxmd/hppa.m4 +++ b/v7/src/microcode/cmpauxmd/hppa.m4 @@ -1,8 +1,8 @@ changecom(`;');;; -*-Midas-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/hppa.m4,v 1.19 1992/02/05 01:44:36 jinx Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/hppa.m4,v 1.20 1992/02/07 05:58:12 jinx Exp $ ;;; -;;; Copyright (c) 1989-91 Massachusetts Institute of Technology +;;; Copyright (c) 1989-1992 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -298,30 +298,47 @@ generic_positive_hook generic_negative_hook B generic_negative+4 LDW 0(0,22),6 ; arg1 - -no_hook + +shortcircuit_apply_hook + B shortcircuit_apply+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_1_hook + B shortcircuit_apply_1+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_2_hook + B shortcircuit_apply_2+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_3_hook + B shortcircuit_apply_3+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_4_hook + B shortcircuit_apply_4+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_5_hook + B shortcircuit_apply_5+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_6_hook + B shortcircuit_apply_6+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_7_hook + B shortcircuit_apply_7+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_8_hook + B shortcircuit_apply_8+4 + EXTRU 26,5,6,24 ; procedure type -> 24 ;; -;; Provide dummy trapping hooks in case a newver version of compiled +;; Provide dummy trapping hooks in case a newer version of compiled ;; code that expects more hooks is run. ;; - BREAK 0,18 - NOP - BREAK 0,19 - NOP - BREAK 0,20 - NOP - BREAK 0,21 - NOP - BREAK 0,22 - NOP - BREAK 0,23 - NOP - BREAK 0,24 - NOP - BREAK 0,25 - NOP - BREAK 0,26 - NOP +no_hook BREAK 0,27 NOP BREAK 0,28 @@ -350,6 +367,26 @@ no_hook NOP BREAK 0,39 NOP + BREAK 0,40 + NOP + BREAK 0,41 + NOP + BREAK 0,42 + NOP + BREAK 0,43 + NOP + BREAK 0,44 + NOP + BREAK 0,45 + NOP + BREAK 0,46 + NOP + BREAK 0,47 + NOP + BREAK 0,48 + NOP + BREAK 0,49 + NOP ifelse(ASM_DEBUG,1,"interface_break COMB,= 21,22,interface_break @@ -709,6 +746,43 @@ define_generic_binary(plus,2b,FADD) define_generic_unary_predicate(positive,2c,>) define_generic_unary_predicate(zero,2d,=) +;;;; Optimized procedure application for unknown procedures. +;;; Procedure in r26, arity (for shortcircuit-apply) in r25. + +shortcircuit_apply + EXTRU 26,5,6,24 ; procedure type -> 24 + COMICLR,= TC_CCENTRY,24,0 + B,N shortcircuit_apply_lose + DEP 5,5,6,26 ; procedure -> address + LDB -3(0,26),23 ; procedure's frame-size + COMB,<>,N 25,23,shortcircuit_apply_lose + BLE,N 0(5,26) ; invoke procedure + +define(define_shortcircuit_fixed, +"shortcircuit_apply_$1 + EXTRU 26,5,6,24 ; procedure type -> 24 + COMICLR,= TC_CCENTRY,24,0 + B shortcircuit_apply_lose + LDI $1,25 + DEP 5,5,6,26 ; procedure -> address + LDB -3(0,26),23 ; procedure's frame-size + COMB,<>,N 25,23,shortcircuit_apply_lose + BLE,N 0(5,26) ; invoke procedure") + +define_shortcircuit_fixed(1) +define_shortcircuit_fixed(2) +define_shortcircuit_fixed(3) +define_shortcircuit_fixed(4) +define_shortcircuit_fixed(5) +define_shortcircuit_fixed(6) +define_shortcircuit_fixed(7) +define_shortcircuit_fixed(8) + +shortcircuit_apply_lose + DEP 24,5,6,26 ; insert type back + B scheme_to_interface + LDI 0x14,28 + ;;;; Assembly language entry point used by utilities in cmpint.c ;;; to return to the interpreter. ;;; It returns from C_to_interface. diff --git a/v8/src/microcode/cmpauxmd/hppa.m4 b/v8/src/microcode/cmpauxmd/hppa.m4 index 18f23eeba..d82c96996 100644 --- a/v8/src/microcode/cmpauxmd/hppa.m4 +++ b/v8/src/microcode/cmpauxmd/hppa.m4 @@ -1,8 +1,8 @@ changecom(`;');;; -*-Midas-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpauxmd/hppa.m4,v 1.19 1992/02/05 01:44:36 jinx Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpauxmd/hppa.m4,v 1.20 1992/02/07 05:58:12 jinx Exp $ ;;; -;;; Copyright (c) 1989-91 Massachusetts Institute of Technology +;;; Copyright (c) 1989-1992 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -298,30 +298,47 @@ generic_positive_hook generic_negative_hook B generic_negative+4 LDW 0(0,22),6 ; arg1 - -no_hook + +shortcircuit_apply_hook + B shortcircuit_apply+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_1_hook + B shortcircuit_apply_1+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_2_hook + B shortcircuit_apply_2+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_3_hook + B shortcircuit_apply_3+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_4_hook + B shortcircuit_apply_4+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_5_hook + B shortcircuit_apply_5+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_6_hook + B shortcircuit_apply_6+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_7_hook + B shortcircuit_apply_7+4 + EXTRU 26,5,6,24 ; procedure type -> 24 + +shortcircuit_apply_8_hook + B shortcircuit_apply_8+4 + EXTRU 26,5,6,24 ; procedure type -> 24 ;; -;; Provide dummy trapping hooks in case a newver version of compiled +;; Provide dummy trapping hooks in case a newer version of compiled ;; code that expects more hooks is run. ;; - BREAK 0,18 - NOP - BREAK 0,19 - NOP - BREAK 0,20 - NOP - BREAK 0,21 - NOP - BREAK 0,22 - NOP - BREAK 0,23 - NOP - BREAK 0,24 - NOP - BREAK 0,25 - NOP - BREAK 0,26 - NOP +no_hook BREAK 0,27 NOP BREAK 0,28 @@ -350,6 +367,26 @@ no_hook NOP BREAK 0,39 NOP + BREAK 0,40 + NOP + BREAK 0,41 + NOP + BREAK 0,42 + NOP + BREAK 0,43 + NOP + BREAK 0,44 + NOP + BREAK 0,45 + NOP + BREAK 0,46 + NOP + BREAK 0,47 + NOP + BREAK 0,48 + NOP + BREAK 0,49 + NOP ifelse(ASM_DEBUG,1,"interface_break COMB,= 21,22,interface_break @@ -709,6 +746,43 @@ define_generic_binary(plus,2b,FADD) define_generic_unary_predicate(positive,2c,>) define_generic_unary_predicate(zero,2d,=) +;;;; Optimized procedure application for unknown procedures. +;;; Procedure in r26, arity (for shortcircuit-apply) in r25. + +shortcircuit_apply + EXTRU 26,5,6,24 ; procedure type -> 24 + COMICLR,= TC_CCENTRY,24,0 + B,N shortcircuit_apply_lose + DEP 5,5,6,26 ; procedure -> address + LDB -3(0,26),23 ; procedure's frame-size + COMB,<>,N 25,23,shortcircuit_apply_lose + BLE,N 0(5,26) ; invoke procedure + +define(define_shortcircuit_fixed, +"shortcircuit_apply_$1 + EXTRU 26,5,6,24 ; procedure type -> 24 + COMICLR,= TC_CCENTRY,24,0 + B shortcircuit_apply_lose + LDI $1,25 + DEP 5,5,6,26 ; procedure -> address + LDB -3(0,26),23 ; procedure's frame-size + COMB,<>,N 25,23,shortcircuit_apply_lose + BLE,N 0(5,26) ; invoke procedure") + +define_shortcircuit_fixed(1) +define_shortcircuit_fixed(2) +define_shortcircuit_fixed(3) +define_shortcircuit_fixed(4) +define_shortcircuit_fixed(5) +define_shortcircuit_fixed(6) +define_shortcircuit_fixed(7) +define_shortcircuit_fixed(8) + +shortcircuit_apply_lose + DEP 24,5,6,26 ; insert type back + B scheme_to_interface + LDI 0x14,28 + ;;;; Assembly language entry point used by utilities in cmpint.c ;;; to return to the interpreter. ;;; It returns from C_to_interface. -- 2.25.1