blob: 8ab2f2a030691319526c2586e85a73cbb9090430 (
plain) (
blame)
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
|
subroutine dsfree (block)
integer block
integer mem( 1)
common/cdsmem/mem
integer p0, p, q
integer n, junk
integer con (10)
p0 = block - 2
n = mem (p0 + 0)
q = 2
23000 continue
p = mem (q + 1)
if (.not.(p .eq. 0 .or. p .gt. p0))goto 23003
goto 23002
23003 continue
q = p
23001 goto 23000
23002 continue
if (.not.(q + mem (q + 0) .gt. p0))goto 23005
call remark (45Hin dsfree: attempt to free unallocated block.)
call remark (21Htype 'c' to continue.)
junk = getlin (con, 0)
if (.not.(con (1) .ne. 99 .and. con (1) .ne. 67))goto 23007
call endst
23007 continue
return
23005 continue
if (.not.(p0 + n .eq. p .and. p .ne. 0))goto 23009
n = n + mem (p + 0)
mem (p0 + 1) = mem (p + 1)
goto 23010
23009 continue
mem (p0 + 1) = p
23010 continue
if (.not.(q + mem (q + 0) .eq. p0))goto 23011
mem (q + 0) = mem (q + 0) + n
mem (q + 1) = mem (p0 + 1)
goto 23012
23011 continue
mem (q + 1) = p0
mem (p0 + 0) = n
23012 continue
return
end
|
