1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <config.h>
include <syserr.h>
# SALLOC.X -- Stack management routines. Stack storage is allocated in
# segments. Space for each segment is dynamically allocated on the heap.
# Each segment contains a pointer to the previous segment to permit
# reclamation of the space (see "Mem.hlp" for additional details).
# This is a low level facility, hence any failure to allocate or deallocate
# stack storage is fatal.
# Segment header structure. The header size parameter SZ_STKHDR is defined
# in <config.h> because it is potentially machine dependent. SZ_STKHDR
# must be chosen such that the maximum alignment criteria is maintained.
define SH_BASE Memi[$1] # char pointer to base of segment
define SH_TOP Memi[$1+1] # char pointer to top of segment + 1
define SH_OLDSEG Memi[$1+2] # struct pointer to header of prev.seg.
# SALLOC -- Allocate space on the stack.
procedure salloc (output_pointer, nelem, datatype)
pointer output_pointer # buffer pointer (output)
int nelem # number of elements of storage required
int datatype # datatype of the storage elements
int nchars, dtype
include <szdtype.inc>
pointer sp, cur_seg
common /salcom/ sp, cur_seg
begin
dtype = datatype
if (dtype < 1 || dtype > MAX_DTYPE)
call sys_panic (500, "salloc: bad datatype code")
# Align stack pointer for any data type. Compute amount of
# storage to be allocated. Always add space for at least one
# extra char for the EOS in case a string is stored in the buffer.
sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1
if (dtype == TY_CHAR)
nchars = nelem + 1 # add space for EOS
else
nchars = nelem * ty_size[dtype] + 1
# Check for stack overflow, add new segment if out of room.
# Since SMARK must be called before SALLOC, cur_seg cannot be
# null, but we check anyhow.
if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg))
call stk_mkseg (cur_seg, sp, nchars)
if (dtype == TY_CHAR)
output_pointer = sp
else
output_pointer = (sp-1) / ty_size[dtype] + 1
sp = sp + nchars # bump stack pointer
end
# SMARK -- Mark the position of the stack pointer, so that stack space
# can be freed by a subsequent call to SFREE. This routine also performs
# initialization of the stack, since it the very first routine called
# during task startup.
procedure smark (old_sp)
pointer old_sp # value of the stack pointer (output)
bool first_time
pointer sp, cur_seg
common /salcom/ sp, cur_seg
data first_time /true/
include "memdbg.com"
int zrtadr()
begin
if (first_time) {
sp = NULL
cur_seg = NULL
call stk_mkseg (cur_seg, sp, SZ_STACK)
first_time = false
}
call zmemlg (sp, zrtadr(), 'A', 2, " smark", 0, 0)
retaddr = 0
old_sp = sp
end
# SFREE -- Free space on the stack. Return whole segments until segment
# containing the old stack pointer is reached.
procedure sfree (old_sp)
pointer old_sp # previous value of the stack pointer
pointer old_seg
pointer sp, cur_seg
common /salcom/ sp, cur_seg
include "memdbg.com"
int zrtadr()
begin
# The following is needed to avoid recursion when SFREE is called
# by the IRAF main during processing of SYS_MSSTKUNFL.
if (cur_seg == NULL)
return
call zmemlg (old_sp, zrtadr(), 'F', 2, " sfree", 0, 0)
retaddr = 0
# If the stack underflows (probably because of an invalid pointer)
# it is a fatal error.
while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) {
if (SH_OLDSEG(cur_seg) == NULL)
call sys_panic (SYS_MSSTKUNFL, "Salloc underflow")
old_seg = SH_OLDSEG(cur_seg) # discard segment
call mfree (cur_seg, TY_STRUCT)
cur_seg = old_seg
}
sp = old_sp # pop stack
end
# STK_MKSEG -- Create and add a new stack segment (link at head of the
# segment list). Called during initialization, and upon stack overflow.
procedure stk_mkseg (cur_seg, sp, segment_size)
pointer cur_seg # current segment
pointer sp # salloc stack pointer
int segment_size # size of new stack segment
int nchars, new_seg
pointer coerce()
int kmalloc()
begin
# Compute size of new segment, allocate the buffer.
nchars = max (SZ_STACK, segment_size) + SZ_STKHDR
if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR)
call sys_panic (SYS_MFULL, "Out of memory")
# Output new stack pointer.
sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR
# Set up the segment descriptor.
SH_BASE(new_seg) = sp
SH_TOP(new_seg) = sp - SZ_STKHDR + nchars
SH_OLDSEG(new_seg) = cur_seg
# Make new segment the current segment.
cur_seg = new_seg
end
|
