1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2%
3% File:         PXNK:FIXUP.SL
4% Description:
5% Author:       Jim Ambras/CRC
6% Created:      27-Mar-84
7% Modified:     11-May-84 07:38:38 (Brian Beach)
8% Mode:         Lisp
9% Package:
10% Status:       Open Source: BSD License
11%
12% (c) Copyright 1983, Hewlett-Packard Company, see the file
13%            HP_disclaimer at the root of the PSL file tree
14%
15% Redistribution and use in source and binary forms, with or without
16% modification, are permitted provided that the following conditions are met:
17%
18%    * Redistributions of source code must retain the relevant copyright
19%      notice, this list of conditions and the following disclaimer.
20%    * Redistributions in binary form must reproduce the above copyright
21%      notice, this list of conditions and the following disclaimer in the
22%      documentation and/or other materials provided with the distribution.
23%
24% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
28% CONTRIBUTORS
29% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
30% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
31% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
32% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
33% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
35% POSSIBILITY OF SUCH DAMAGE.
36%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37%
38% Revisions:
39%
40% 27-Mar-84 13:51:45 (Jim Ambras/CRC)
41%  Added compiletime load of sys-consts.
42% 02-Mar-84 09:19:47 (Jim Ambras/CRC)
43%  Corrected file header.
44% 13-Dec-83 09:31:39 (Tim Tillson)
45%  D-register model version. Added header.
46%
47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
48
49%%%%%%%
50%%%%%% Fuer Cross LAP geklaut von /keller/cons/psl/dist/nonkernel/sun/fixup.sl
51%%%%%%%
52
53(compiletime (load sys-consts))
54
55(commentoutcode %%%% das stoert hier
56
57(off r2i) %avoid infinite recursion
58
59
60(de getbyte (m o)
61  (getbyte m o))
62
63(de byte (m o)
64  (getbyte m o))
65
66(de putbyte (m o v)
67  (putbyte m o v))
68
69(de gethalfword (m o)
70  (gethalfword m o))
71
72(de halfword (m o)
73  (gethalfword m o))
74
75(de puthalfword (m o v)
76  (puthalfword m o v))
77
78(on r2i)
79)
80
81(de bittable (a b)
82  (getbittable a b)
83  )
84
85% Fixups for the HP-Lap.red relocation
86
87(de makerelocword (reloctag relocinf)
88  (iplus2 (ilsh reloctag 30) (field relocinf 2 30)))
89
90(de makerelocinf (reloctag relocinf)
91  (iplus2 (ilsh reloctag 22) (field relocinf 10 22)))
92
93(de makerelochalfword (reloctag relocinf)
94  (iplus2 (ilsh reloctag 14) (field relocinf 18 14)))
95
96(de getbittable (baseaddress bitoffset)
97  (field (ilsh (byte baseaddress (ilsh bitoffset -2))
98               (idifference (itimes2 (field bitoffset 30 2) 2) 6))
99         30 2))
100
101(de putbittable (baseaddress bitoffset value2)
102  (prog (m b c)
103        (setq b
104              (iland (byte baseaddress (setq m (ilsh bitoffset -2)))
105                     (ilsh (idifference -1 (itimes2 3 256))
106                      (idifference -2
107                       (setq c (itimes2 (field bitoffset 30 2) 2))))))
108        (putbyte baseaddress m (if (eq value2 0)
109                   b
110                   (ilor b (ilsh value2 (idifference 6 c)))))))
111
112