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
|
.title op_mprofextexfun - invoke external extrinsic function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 2005, 2012 Fidelity Information Services, Inc ;
; ;
; This source code contains the intellectual property ;
; of its copyright holder(s), and is made available ;
; under a license. If you do not know the terms of ;
; the license, please stop and do not read further. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
G_MSF
PROCDESC
; op_mprofextexfun - invoke external extrinsic function
;
; arguments:
; routine address of procedure descriptor of procedure containing extrinsic function
; label address of offset into routine to which to transfer control
; ret_value address for function to place return value
; mask
; actualcnt actual argument count
; actual1 address of actual first argument
; actual2 address of actual second argument
; . . .
$routine name=op_mprofextexfun, entry=op_mprofextexfun_ca, kind=stack, saved_regs=<r2, r13, r18, r19, r20, r21, fp>, - ; BYPASSOK
data_section_pointer=true, -
data_section=<$DATA$, QUAD, NOPIC, CON, REL, LCL, NOSHR, MIX, NOEXE, RD, WRT>
$linkage_section
A_frame_pointer: .address frame_pointer
L_ERR_FMLLSTMISSING: .long ERR_FMLLSTMISSING
L_ERR_GTMCHECK: .long ERR_GTMCHECK
L_ERR_LABELUNKNOWN: .long ERR_LABELUNKNOWN
$data_section
PDSC_FLAGS:
.long GTM_PD_FLAGS
$code_section
.base r27, $ls
ldq r2, $dp
.base r2, $ds
putframe
mov r27, r13
.base r13, $ls
L9: beq r16, L20 ; if procdsc == 0, this routine has not yet been linked into current image
beq r17, L40 ; if labaddr == 0 (and procdsc != 0), it's an unknown label
; Check whether first argument is procedure descriptor or routine header.
ldl r28, PDSC_FLAGS
ldl r0, (r16)
xor r28, r0, r28
bne r28, L10 ; if not procedure descriptor, it must be a routine header
ldq r16, 8(r16) ; rhdaddr = procdsc->entry_point ; entry point address is address of routine header
L10: mov r17, r22 ; temporarily save labaddr, so it is not overriden
ldl r17, (r17) ; *lab_ln_ptr
beq r17, L40
ldl r28, mrt$curr_ptr(r16)
addl r17, r28, r17
addl r17, r16, r17 ; rhdaddr + *lab_ln_ptr
ldl r17, (r17) ; *labaddr
ldl r28, mrt$curr_ptr(r16) ; rhdaddr->current_rhead_ptr
addl r16, r28, r18
addl r17, r18, r18
mov r22, r17 ; restore the original labaddr
addq r17, 4, r17 ; labaddr += 4, to point to has_parms
ldl r17, (r17) ; *has_parms
beq r17, L50 ; if has_parms == 0, then issue an error
L12: $call new_stack_frame_sp, args=<r16, mrt$lnk_ptr(r16)/L, r18>, set_arg_info=false
ldl r16, 0(r10) ; push $TRUTH aka $TEST
bic r16, #^Xfe, r16 ; clear all but low order bit
L15: ldq r17, $RSA_OFFSET+24(fp) ; old r18 (ret_value)
ldq r18, $RSA_OFFSET+32(fp) ; old r19 (mask)
ldq r19, $RSA_OFFSET+40(fp) ; old r20 (actualcnt)
ldq r20, $RSA_OFFSET+48(fp) ; old r21 (actual1)
ldq r21, $SIZE(fp) ; actual2, if any
lda r25, 4(r19)
; If more than 1 argument, push rest onto stack.
subq r19, 2, r28 ; number of arguments to put onto stack (actual3 . . . actualn)
ble r28, zero_in_stack ; all original arguments in registers
lda r0, $SIZE(fp)
s8addq r28, r0, r0 ; address of actualn
loop: ldq r1, (r0)
lda sp, -8(sp)
lda r0, -8(r0)
stq r1, (sp)
subq r28, 1, r28
bgt r28, loop
zero_in_stack:
$call push_parm, set_arg_info=false ; push_parm ($T, ret_value, mask, argc[, actual1[, actual2 . . .]])
L16: getframe
$begin_epilogue
mov fp, sp
ldq r2, $RSA_OFFSET+8(sp)
ldq fp, $RSA_OFFSET+56(sp)
lda sp, $SIZE(sp)
ret r26
$end_epilogue
L20: bne r17, L30 ; procdsc == 0, but label != 0 => internal error
lda sp, -8(sp) ; auto_zlink will put value here
stq r31, (sp)
$call auto_zlink, args=<msf$mpc_off(r12)/L, sp>, set_arg_info=false
beq r0, L30
mov r0, r16 ; rhdaddr of newly-ZLINK'ed routine
ldq r17, (sp) ; new labaddr
lda sp, 8(sp)
beq r17, L40 ; found routine, but labaddr still 0 => unknown label
br L10
L30: $call lib$signal, args=<L_ERR_GTMCHECK/L>
$begin_epilogue
getframe
mov fp, sp
ldq r2, $RSA_OFFSET+8(sp)
ldq fp, $RSA_OFFSET+56(sp)
lda sp, $SIZE(sp)
ret r26
$end_epilogue
L40: $call lib$signal, args=<L_ERR_LABELUNKNOWN/L>
$begin_epilogue
getframe
mov fp, sp
ldq r2, $RSA_OFFSET+8(sp)
ldq fp, $RSA_OFFSET+56(sp)
lda sp, $SIZE(sp)
ret r26
$end_epilogue
L50: $call lib$signal, args=<L_ERR_FMLLSTMISSING/L>
$begin_epilogue
getframe
mov fp, sp
ldq r2, $RSA_OFFSET+8(sp)
ldq fp, $RSA_OFFSET+56(sp)
lda sp, $SIZE(sp)
ret r26
$end_epilogue
$end_routine name=op_mprofextexfun
.end
|
