-
Notifications
You must be signed in to change notification settings - Fork 2
/
LINDEX3.ASM
215 lines (215 loc) · 11.6 KB
/
LINDEX3.ASM
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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
LINDEXA CSECT
* LINDEX VERSION 3.0 BY CLYDE THOMAS ZUBER *
***********************************************************************
* *
* ATTR: RENT,REUS,REFR,AMODE(31),RMODE(ANY) *
* *
* THIS SUBROUTINE FINDS THE POSITION OF FIRST OCCURANCE OF ANY OF A *
* LIST OF CHARACTERS IN A STRING. THE FIRST ARGUMENTS IS THE STRING *
* TO BE SEARCHED. THE SECOND IS LIST. THE THIRD ARGUMENT IS THE *
* VARIABLE IN WHICH TO RETURN THE POSITION. IF NONE ARE FOUND A *
* VALUE OF ZERO IS RETURNED. *
* THIS ROUTINE HAS TWO ENTRY POINTS. LINDEXA IS FOR REGULAR OS/370 *
* LINKAGE FOR ASSEMBLER PROGRAMS. LINDEX IS FOR PL/I PROGRAMS USING *
* PL/I OPTIMIZER R3.1, R4.0 AND R5.0 CONVENTIONS. *
* *
* ENTRY LINDEXA: *
* STRING AND LIST ARE ASSUMED TO BE VARYING LENGTH (AS PL/I) OR *
* ALTERNATELY, FIVE ARGUMENTS MAY BE PASSED AND THEN THE LAST TWO ARE *
* HALFWORDS SPECIFING THE LENGTH OF THE STRING AND LIST RESPECTIVELY. *
* FOR VARYING LENGTH SET UP THE CALL AND VARIABLES LIKE THIS: *
* CALL LINDEXA,(STR,LIST,ANSWER),VL *
* ANSWER DS F THE RETURN VALUE *
* STR DC H'50' THE LENGTH OF THE STRING *
* DS CL50 THE STRING ITSELF *
* LIST DC H'10' THE LENGTH OF THE STRING *
* DS CL10 THE STRING ITSELF *
* *
* ENTRY LINDEX: *
* THE STRING DESCRIPTOR BLOCKS ARE PASSED AS PARAMETERS. THIS MEANS *
* THAT THE STRINGS MAY BE EITHER FIXED OR VARYING LENGTH. THE CONTROL *
* BLOCK FORMAT IS AS FOLLOWS: *
* 0 1 2 3 4 *
* ------------------------------------------ *
* | BYTE ADDR OF CHAR STRING | *
* ------------------------------------------ *
* | DCL LENGTH |X| UNUSED| | *
* ------------------------------------------ *
* 0=FIXED *
* 1=VARYING *
* *
* WHEN USING THE LINDEX ENTRY FROM PL/I IT SHOULD BE DECLARED AS A *
* PL/I PROCEDURE AS FOLLOWS: *
* DECLARE LINDEX ENTRY RETURNS(FIXED BINARY(31)); *
* THE TWO PARAMETERS THEN SHOULD BE CHAR, EITHER FIXED OR VARYING. *
* THE RETURNS(FIXED BINARY(31)) WORKS BECAUSE PL/I CREATES A THIRD *
* ARGUMENT TO OBTAIN ITS RETURN VALUE. *
* *
* NOTE: PL/I ERROR MSG OFFSETS ARE RELATIVE TO REAL ENTRY POINT *
* R11 - PROCEDURE BASE *
* R12 - RESERVED *
* R13 - ADDRESS OF DYNAMIC STORAGE AREA *
* *
***********************************************************************
EJECT
LINDEXA AMODE 31
LINDEXA RMODE ANY
***********************************************************************
*** ASSEMBLER ENTRY POINT *********************************************
***********************************************************************
USING *,15 IDENTIFY BASE REGISTER
B START SKIP IDENTIFICATION SECTION
DC AL1(6) PROGRAM IDENTIFIER
DC C'LINDEX V3.0 BY CLYDE THOMAS ZUBER'
START STM 14,12,12(13) SAVE REGISTERS
LR 5,1 ADDRESS OF PARM ADDR LIST
GETMAIN R,LV=STOREND-STORAGE
L 15,16(13) RESTORE R15 (BASE REG)
ST 13,4(1) CHAIN SAVE AREAS
ST 1,8(13) ..
MVI 0(1),X'00' CLEAR FLAG (WILL DO FREEMAIN)
LR 13,1 POINT TO DSA
USING STORAGE,13 ..
LM 7,9,0(5) ADDRESS OF FIRST THREE ARGUMENTS
LTR 9,9 ARE THERE MORE ARGUMENTS?
BM PARM3 NO, ONLY THREE
L 2,12(5) GET ADDRESS OF FOURTH ARGUMENT
L 3,16(5) GET ADDRESS OF FIFTH ARGUMENT
LH 4,0(2) LENGTH OF STR
LH 5,0(3) LENGTH OF LIST
LR 2,7 COPY BEGIN ADDR OF STR
LR 3,8 COPY BEGIN ADDR OF LIST
B SAVEPARM SKIP OTHER PARM PASSING
PARM3 EQU *
LA 2,2(7) ADDR OF STR
LA 3,2(8) ADDR OF LIST
LH 4,0(7) LENGTH OF STR
LH 5,0(8) LENGTH OF LIST
B SAVEPARM SKIP OTHER ENTRY CODE
EJECT
***********************************************************************
*** PL/I REAL ENTRY - PROLOGUE CODE ***********************************
***********************************************************************
ENTRY LINDEX
DC C' LINDEX' PROGRAM IDENTIFIER
DC AL1(6) ..
LINDEX DS 0H
USING *,15 IDENTIFY BASE REGISTER
STM 14,12,12(13) SAVE REGISTERS
LR 2,1 ADDRESS OF PARM ADDR LIST
LA 0,STOREND-STORAGE PUT THE LENGTH OF THE NEW DSA IN R0
L 1,76(13) PTR NEXT AVAIL BYTE AFTER LAST DSA
ALR 0,1 ADD THEM TOGETHER
CL 0,12(12) COMPARE WITH LAST AVAILABLE BYTE
BNH SPCAVAIL IT WILL FIT
L 15,116(12) OBTAIN MORE STORAGE (PL/I ROUTINE)
BALR 14,15 ..
SPCAVAIL L 14,72(13) GET ADDR OF LSW FROM OLD DSA
LR 15,0 COPY R0 (NAB AFTER NEW DSA)
STM 14,0,72(1) SAVE LSW AND NAB IN NEW DSA
L 15,16(13) RESTORE R15 (BASE REG)
ST 13,4(1) ADDR OF LAST DSA IN NEW DSA
ST 1,8(13) CHAIN SAVE AREA (NOT DONE BY PL/I)
MVI 0(1),X'80' SET FLAGS IN DSA TO PRESERVE PL/I
MVI 1(1),X'00' ERROR HANDLING IN THIS ROUTINE
MVI 86(1),X'91' ..
MVI 87(1),X'C0' ..
LR 13,1 POINT TO NEW DSA
USING STORAGE,13 ..
LM 7,9,0(2) ADDRESS OF ARGUMENTS
L 2,0(7) ADDR OF STR
L 3,0(8) ADDR OF LIST
TM 6(7),X'80' IS IT VARYING?
BZ FIXSTR NO, FIXED LENGTH STRING
LH 4,0(2) VARYING LENGTH OF STR
LA 2,2(2) REAL ADDR OF STR
B DONESTR
FIXSTR LH 4,4(7) FIXED LENGTH OF STRING
DONESTR EQU *
TM 6(8),X'80' IS IT VARYING?
BZ FIXLIST NO, FIXED LENGTH STRING
LH 5,0(3) VARYING LENGTH OF STR
LA 3,2(3) REAL ADDR OF STR
B SAVEPARM
FIXLIST LH 5,4(8) FIXED LENGTH OF STRING
EJECT
***********************************************************************
*** PROCEDURE BASE ****************************************************
***********************************************************************
SAVEPARM EQU *
BALR 11,0 RESET BASE ADDRESS
USING *,11 IDENTIFY BASE REGISTER
ST 2,STRADDR SAVE PARAMETERS
ST 9,ANSADDR ..
LA 6,0 ZERO
ST 6,0(9) INITIALIZE ANSWER
LTR 4,4 IS STR LENGTH ZERO?
BZ RETURN YES, BYE
LTR 5,5 IS LIST LENGTH ZERO?
BZ RETURN YES, BYE BYE
AR 5,3 COMPUTE END ADDRESS OF LIST
BCTR 5,0 ..
ST 5,ENDLST ..
LR 9,4 COMPUTE END ADDRESS OF STR
AR 9,2 ..
BCTR 9,0 ..
ST 9,ENDSTR ..
LA 6,1(4) SET MAX AS ONE GREATER THAN POSSIBLE
ST 6,MAX SAVE FOR LATTER COMPARE
LA 8,1 CONSTANT INCREMENT
SEARCH EQU *
L 7,STRADDR SET UP FOR SEARCH THROUGH STR
L 9,ENDSTR ..
BAL 14,INDEX SEARCH STR FOR THIS POSITION IN LIST
CR 6,7 REG7 IS POSITION IF IT WAS FOUND
BNP NEXT EITHER NOT FOUND OR > EARLIER
LR 6,7 SAVE LEAST POSITION WHERE ANY FOUND
NEXT EQU *
L 9,ENDLST END OF LIST TO TERMINATE LOOP
BXLE 3,8,SEARCH GET POSITION OF NEXT CHAR IN LIST
C 6,MAX DID WE FIND ANY CHAR OF LIST IN STR?
BNE FINISH YES WE FOUND ONE
SR 6,6 NO SEND BACK A ZERO
***********************************************************************
*** EPILOGUE CODE *****************************************************
***********************************************************************
FINISH DS 0H
L 9,ANSADDR GET ADDRESS OF WHERE WE PUT ANSWER
ST 6,0(9) SAVE ANSWER FOR CALLING PROGRAM
RETURN EQU *
LR 1,13 COPY R13
L 13,4(13) RESTORE R13
*********ST****15,16(13)***********SAVE*RETURN*CODE********************
TM 0(1),X'80' IS DSA FROM PL/I?
BO EXIT YES, NO FREEMAIN REQUIRED
LA 0,STOREND-STORAGE GET LENGTH
FREEMAIN R,LV=(0),A=(1) FREE DSA
EXIT LM 14,12,12(13) RESTORE CALLER'S REGISTERS
BR 14 RETURN
EJECT
***********************************************************************
*** INDEX INTERNAL SUBROUTINE *****************************************
***********************************************************************
INDEX EQU *
CLC 0(1,7),0(3) R3 POINTS TO A CHAR IN LIST
BE FOUND IF IT IS IN STR THEN QUIT LOOKING
BXLE 7,8,INDEX GET NEXT POSITION IN STR
L 7,MAX NEVER FOUND SO RETURN HIGH VALUE
BR 14 RETURN
FOUND EQU *
S 7,STRADDR SUBTRACT BEGIN ADDR TO GET OFFSET
LA 7,1(7) ADD ONE TO OFFSET TO GET POSITION
BR 14 RETURN
***********************************************************************
*** DYNAMIC STORAGE AREA **********************************************
***********************************************************************
STORAGE DSECT
SAVEAREA DS 22F
ANSADDR DS F
ENDLST DS F
ENDSTR DS F
MAX DS F
STRADDR DS F
STOREND DS 0D
END