MACRO 00050000 BLSCAMM2 &LIST,&NUM 00100000 .** START OF SPECIFICATIONS ******************************************* 00150000 .* 00200000 .* MACRO NAME= BLSCAMM2 00250000 .* 00300000 .* DESCRIPTIVE NAME= EXTRACT PARAMETER SUBLIST ENTRY CHARACTER STRING. 00350000 .* 00400000 .* COPYRIGHT= NONE 00450000 .* 00500000 .* STATUS= SU57 RELEASE 1, LEVEL 0 00550000 .* 00600000 .* FUNCTION= 00650000 .* EXTRACT THE CONTENTS OF THE ENTRY SPECIFIED BY 00700000 .* POSITIONAL PARAMETER 2 FROM THE PARAMETER SPECIFIED BY 00750000 .* POSITIONAL PARAMETER 1 AND PLACE THE EXTRACTED 00800000 .* CHARACTER STRING IN GBLC &BLSCAGC. 00850000 .* 00900000 .* NOTES= NONE 00950000 .* 01000000 .* MODULE TYPE= EXECUTABLE MACRO 01050000 .* 01100000 .* PROCESSOR= ASSEMBLER F 01150000 .* 01200000 .* ATTRIBUTES= REENTRABLE 01250000 .* 01300000 .* INVOCATION SYNTAX= 01350000 .* 01400000 .* BLSCAMM2 LIST,ELEMENTNO 01450000 .* 01500000 .* LIST 01550000 .* PARAMETER LIST FROM WHICH THE ELEMENT IS TO BE 01580000 .* EXTRACTED. 01610000 .* 01700000 .* ELEMENTNO 01750000 .* PARAMETER LIST ELEMENT NUMBER. 01790000 .* 01830000 .* OUTPUT= GBLC &BLSCAGC IS INITIALIZED WITH THE SPECIFIED LIST 01870000 .* ELEMENT. 01910000 .* 02000000 .* EXTERNAL REFERENCES= SEE BELOW 02050000 .* 02090000 .* ROUTINES= NONE 02130000 .* 02170000 .* DATA AREAS= NONE 02210000 .* 02300000 .* CONTROL BLOCKS= NONE 02350000 .* 02400000 .* MACROS= NONE 02450000 .* 02500000 .* CHANGE ACTIVITY= 02550000 .* THIS MODULE IS WRITTEN FOR @G57LPSR 02590000 .* 02630000 .* MESSAGES ISSUED= 02670000 .* MACRO COMPILE TIME ERROR MESSAGES (MNOTES) 02710000 .* 8,LIST CONTAINS AN INNER SUBLIST 02750000 .* 8,INVALID LIST FORMAT 02790000 .* 02830000 .** END OF SPECIFICATIONS ********************************************* 02870000 GBLA &BLSCAGA PARAMETER SUBLIST COUNT 02910000 GBLC &BLSCAGC PARAMETER SUBLIST CHARACTER STRING 03050000 LCLA &CTR CURRENT LIST BYTE COUNTER 03090000 LCLA &ELM CURRENT ELEMENT NUMBER 03130000 LCLA &START CURRENT ELEMENT START BYTE 03170000 LCLA &LEN LIST LENGTH 03210000 LCLC &STR LIST CHARACTER STRING 03250000 &BLSCAGA SETA 0 RETURN CODE 03290000 &BLSCAGC SETC '' RETURNED STRING 03330000 &CTR SETA 1 CURRENT BYTE COUNTER 03370000 &STR SETC '&LIST' LIST CHAR STRING 03410000 &LEN SETA K'&STR LIST LENGTH 03450000 AIF (&LEN EQ 0).END NULL LIST 03490000 .SK1 AIF ('&STR' EQ '()').END NULL LIST 03530000 .SK2 AIF ('&STR'(1,1) EQ '(').SK3 MULTI ELEMENT LIST CANDIDATE 03570000 &BLSCAGC SETC '&LIST' ONE ELEMENT LIST 03610000 AGO .END 03650000 .SK3 ANOP 03690000 &ELM SETA 1 SET UP ELEMENT COUNT LOOP 03730000 &START SETA 2 SET ELEMENT START BYTE 03770000 AGO .LPTST ENTER LOOP 03810000 .LOOP AIF ('&STR'(&CTR,1) NE '(').SK4 03850000 MNOTE 8,'LIST CONTAINS AN INNER SUBLIST' 03890000 AGO .ERR ERROR EXIT 03930000 .SK4 AIF ('&STR'(&CTR,1) NE ',').SK5 NOT ELEMENT END 03970000 AIF (&ELM EQ &NUM).MOVE FOUND REQUESTED ELEMENT 04010000 &START SETA &CTR+1 SET NEW ELEMENT START 04050000 &ELM SETA &ELM+1 BUMP ELEMENT COUNT 04090000 AGO .LPTST 04130000 .SK5 AIF ('&STR'(&CTR,1) NE ')').LPTST NOT END OF PLIST 04170000 AIF (&CTR EQ &LEN).SK6 LIST END MATCHES LOGICAL END 04210000 MNOTE 8,'INVALID LIST FORMAT' 04250000 AGO .ERR 04290000 .SK6 ANOP 04330000 AIF (&ELM EQ &NUM).MOVE REQUESTED SUBLIST ENTRY 04370000 AGO .END REQUESTED ENTRY NOT FOUND 04410000 .LPTST ANOP 04450000 &CTR SETA &CTR+1 BUMP CURRENT BYTE COUNTER 04490000 AIF (&CTR LE &LEN).LOOP NOT END OF LIST 04530000 MNOTE 8,'INVALID LIST FORMAT' 04570000 AGO .ERR 04610000 .MOVE ANOP 04650000 &LEN SETA &CTR-&START MOVE LENGTH 04690000 &BLSCAGC SETC '&STR'(&START,&LEN) PARM SUBLIST ENTRY 04730000 AGO .END 04770000 .ERR ANOP 04810000 &BLSCAGA SETA -1 INDICATE ERROR TO CALLER 04850000 .END MEND 04890000