1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PU:FAST-VECTOR.SL 4% Description: IGetV, IGetS, etc. 5% Author: 6% Created: 7% Modified: 19 Oct 1984 0952-PDT (Brian Beach) 8% Package: Utilities 9% Status: Open Source: BSD License 10% 11% (c) Copyright 1982, University of Utah 12% 13% Redistribution and use in source and binary forms, with or without 14% modification, are permitted provided that the following conditions are met: 15% 16% * Redistributions of source code must retain the relevant copyright 17% notice, this list of conditions and the following disclaimer. 18% * Redistributions in binary form must reproduce the above copyright 19% notice, this list of conditions and the following disclaimer in the 20% documentation and/or other materials provided with the distribution. 21% 22% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 23% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 24% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 25% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 26% CONTRIBUTORS 27% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 28% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 29% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 30% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 31% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 32% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33% POSSIBILITY OF SUCH DAMAGE. 34% 35%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 36 37% Probably the best thing to do about obtaining needed SysLisp 38% features is to make sure the compiler has them at all times. 39 40(compiletime (load if-system)) 41 42(de IGetV (v i) 43 (cond ((not (Vectorp v)) (NonVectorError v 'IGetV)) 44 ((not (FixP i)) (NonIntegerError i 'IGetV)) 45 (t (indx v i)) 46 )) 47 48(de IPutv (v i x) 49 (cond ((not (Vectorp v)) (NonVectorError v 'IPutv)) 50 ((not (FixP i)) (NonIntegerError i 'IPutv)) 51 (t (setindx v i x)) 52 )) 53 54(de ISizeV (v) 55 (cond ((not (Vectorp v)) (NonVectorError v 'ISizeV)) 56 (t (size v)) 57 )) 58 59(Put 'IGetV 'Assign!-Op 'IPutV) 60 61(de IGetS (s i) 62 (cond ((not (StringP s)) (NonStringError s 'IGetS)) 63 ((not (FixP i)) (NonIntegerError i 'IGetS)) 64 (t (indx s i)) 65 )) 66 67(de IPutS (s i c) 68 (cond ((not (StringP s)) (NonStringError s 'IPutS)) 69 ((not (FixP i)) (NonIntegerError i 'IPutS)) 70 ((not (FixP c)) (NonCharacterError c 'IPutS)) 71 (t (setindx s i c)) 72 )) 73 74(de ISizeS (s) 75 (cond ((not (StringP s)) (NonStringError s 'ISizeS)) 76 (t (size s)) 77 )) 78 79(Put 'IGetS 'Assign!-Op 'IPutS) 80 81% Compiler declarations for fast functions. 82 83(put 'igetv 'fast-function 'fast-igetv) 84(put 'iputv 'fast-function 'fast-iputv) 85(put 'igets 'fast-function 'fast-igets) 86(put 'iputs 'fast-function 'fast-iputs) 87(put 'isizev 'fast-function 'fast-isizev) 88(put 'isizes 'fast-function 'fast-isizes) 89 90(put 'igetv 'fast-flag t) 91(put 'iputv 'fast-flag t) 92(put 'igets 'fast-flag t) 93(put 'iputs 'fast-flag t) 94(put 'isizev 'fast-flag t) 95(put 'isizes 'fast-flag t) 96 97(if_system Cray % Tags don't need to be stripped on the Cray 98 (progn 99 (ds fast-igetv (vector index) (vecitm vector index)) 100 (ds fast-iputv (vector index value) (putvecitm vector index value)) 101 (ds fast-igets (string index) (strbyt string index)) 102 (ds fast-iputs (string index value) (putstrbyt string index value)) 103 (ds fast-isizev (vector) (veclen vector)) 104 (ds fast-isizes (string) (strlen string)) 105 ) 106 %else 107 % Tags need to be stripped almost everywhere 108 (progn 109 (ds fast-igetv (vector index) (vecitm (vecinf vector) index)) 110 (ds fast-iputv (vector index value) (putvecitm (vecinf vector) 111 index value)) 112 (ds fast-igets (string index) (strbyt (strinf string) index)) 113 (ds fast-iputs (string index value) (putstrbyt (strinf string) 114 index value)) 115 (ds fast-isizev (vector) (veclen (vecinf vector))) 116 (ds fast-isizes (string) (strlen (strinf string))) 117 ) 118) 119 120% End of file. 121