1 " ***********************************************************
2 " * *
3 " * Copyright, C Honeywell Bull Inc., 1987 *
4 " * *
5 " * Copyright, C Honeywell Information Systems Inc., 1982 *
6 " * *
7 " * Copyright c 1972 by Massachusetts Institute of *
8 " * Technology and Honeywell Information Systems, Inc. *
9 " * *
10 " ***********************************************************
11
12 "
13 " THREAD
14 "
15 " This procedure is used by the supervisor to manage threaded lists of
16 " objects. Every such object should have a declaration which begins:
17 "
18 " dcl 1 thing aligned based,
19 " 2 forward_ptr bit 18 unaligned,
20 " 2 back_ptr bit 18 unaligned,
21 "
22 " The first word of each object must contain two eighteen bit pointers
23 " segment-base relative to the next and previous objects in the list.
24 "
25 " This procedure also maintains a pointer into the list. It must be an
26 " 18 bit relative offset, and appear in the upper halfword of a word.
27 " The caller of thread may therefore declare it aligned.
28 "
29 " No checking is done to insure that these requirements for alignment
30 " and location are being followed.
31 "
32 " 10/03/73, R. E. Mullen, in v2pl1
33 " 04/17/75, A. Bensoussan, to zero the fp and bp when threading out.
34 " 03/26/81, W. Olin Sibert, to re-code in ALM
35 "
36
37 name thread
38 segdef lin " Thread in, to linear list
39 segdef cin " Thread in, to circular list
40 segdef out " Thread out, of either type
41
42 equ thread,1 " PR1 points to thread word throughout
43 equ object,2 " PR2 points to object
44 equ base,3 " PR3 points to base of segment containing
45 " the object though perhaps not the thread
46
47 equ .object,0 " X0 is offset of object
48 equ .next,1 " X1 is offset of next object
49 equ .prev,2 " X2 is offset of previous object
50 equ .thread,3 " X3 is the value of the thread word on entry
51
52
53 " ^L
54 "
55 " THREAD$LIN -- Thread object into linear list
56 "
57 " dcl thread$lin entry pointer bit 18 unaligned;
58 "
59 " call thread$lin astep sst.ausedp 0;
60 "
61
62
63 lin: epp object,ap|2,*
64 epp thread,ap|4,* " Pointer to thread word
65 epp object,object|0,* " Pointer to object
66
67 eax .object,object|0 " Offset of object
68 ldx .thread,thread|0 " Current value of thread next_object
69
70 " Is list empty now?
71 tnz lin.non_empty " No -- go thread into nonempty list
72
73 " It was empty, so the thing we're threading in will be the only thing in the list.
74
75 stx .object,thread|0 " object.bp = null, object.fp = null
76 stz object|0 " thread = object_ptr
77
78 short_return "
79
80
81 " Since it was nonempty, we thread this object in at the end of the list. The
82 " thread ends up pointing at the object we are threading in, and the object
83 " it used to point to is adjusted to point back at the new one.
84
85 lin.non_empty:
86 epbp base,object|0 " Get a pointer to the base of the segment
87 stz object|0 " object.bp = null
88 stx .thread,object|0 " object.fp = thread prev_object_ptr
89 stx .object,thread|0 " thread = object_ptr
90 sxl .object,base|0,.thread " prev_object.bp = object_ptr
91
92 short_return
93
94
95 " ^L
96 "
97 " THREAD$CIN -- Thread object into circular list
98 "
99 " dcl thread$cin entry pointer bit 18 unaligned;
100 "
101 " call thread$cin astep sst.ausedp 0;
102 "
103
104
105 cin: epp object,ap|2,* " pointer argument
106 epp thread,ap|4,* " Pointer to thread word
107 epp object,object|0,* " Pointer to object
108
109 eax .object,object|0 " Offset of object
110 ldx .thread,thread|0 " Current value of thread next_object
111
112 " Is list empty now?
113 tnz cin.non_empty " No -- go thread into nonempty list
114
115 " It was empty, so all threads point to it
116 stx .object,object|0 " object.fp = object_ptr
117 sxl .object,object|0 " object.bp = object_ptr
118 stx .object,thread|0 " thread = object_ptr
119
120 short_return
121
122
123 " Since it was not empty, we will now thread in the new object between the "previous"
124 " and "next" objects -- the thread is always considered to point to the "next"
125 " object. After our object has been threaded in, it will be at the very end of
126 " the list.
127
128 cin.non_empty:
129 epbp base,object|0 " Get a pointer to the base of the segment
130 stx .thread,object|0 " object.fp = thread next_object_ptr
131 lxl .prev,base|0,.thread " prev_object_ptr
132 sxl .prev,object|0 " object.bp = prev_object.bp
133 stx .object,base|0,.prev " prev_object.fp = object_ptr
134 sxl .object,base|0,.thread " next_object.bp = object_ptr
135
136 short_return
137
138
139 " ^L
140 "
141 " THREAD$OUT -- Thread object out of the list
142 "
143 " dcl thread$out entry pointer bit 18 unaligned;
144 "
145 " call thread$out astep sst.ausedp 0;
146 "
147
148
149 out: epp object,ap|2,* " pointer argument
150 epp thread,ap|4,* " Pointer to thread word
151 epp object,object|0,* " Pointer to object
152
153 eax .object,object|0 " Offset of object
154 ldx .thread,thread|0 " Current value of thread next_object
155
156 epbp base,object|0 " Get a pointer to the base of the segment
157 ldx .next,object|0 " and pointers to the previous and next object
158 lxl .prev,object|0
159 tze out.no_previous " if prev pointer is non-null,
160 " rethread forward pointer for prev object
161 stx .next,base|0,.prev " prev_object.fp = next_object_ptr
162 " fall through
163 out.no_previous:
164 canx .next,=o777777,du " if next pointer is non-null, rethread
165 tze out.no_next " backward pointer for next object
166
167 sxl .prev,base|0,.next " next_object.bp = prev_object_ptr
168 " fall through
169 out.no_next:
170 cmpx .object,thread|0 " If thread pointed to object we are threading
171 tnz out.not_this_one " out, adjust it to point to the next, instead
172
173 stx .next,thread|0 " thread = next_object_ptr
174
175 out.not_this_one: " If this object points to itself, we are
176 cmpx .object,object|0 " removing the only object on a circular
177 tze out.last_in_list " list, so we should zero the thread word
178
179 stz object|0 " Finally, zero the threads in the object
180 " being removed.
181 short_return
182
183
184 out.last_in_list: " Can't use an STZ here, because there may
185 ldx .thread,0,du " be something else in the lower halfword
186 stx .thread,thread|0 " thread = null
187 stz object|0 " Finally, zero the threads in the object
188 " being removed.
189 short_return
190
191 end