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