********************************************************************** 00100000 * * 00200000 * IKJEGSIO IS A SET OF STRUCTURED MACROS THAT BUILD THE * 00300000 * ASSEMBLER INSTRUCTIONS TO PREPARE A PERSONALIZED PARM * 00400000 * LIST AND THE BRANCH TO IKJEGIO FOR I/O SERVICES. THE * 00500000 * SET OF MACROS ARE INCLUDED; HOWEVER, THE MACRO SOURCE * 00600000 * IS SUPPRESSED. * 00700000 * * 00800000 * STATUS -- VERSION NO. 01 - OS/VS2 RELEASE NO. 02 * 00900000 * CHANGE LEVEL -- 01 - DATE 2-2-73 * 01000000 * * 01100000 ********************************************************************** 01200000 PRINT OFF 01300000 MACRO 01400000 &LABEL IKJEGSIO *01500000 &TYPEREQ, TYPE SERVICE REQUESTED *01600000 &FIRST=, FIRST MESSAGE TO BE ISSUED *01700000 &INST11=, FIRST INSERT OF THE 1ST MSG *01800000 &INST12=, SECOND INSERT OF THE 1ST MSG *01900000 &INST13=, THIRD INSERT OF THE 1ST MSG *02000000 &INST14=, FOURTH INSERT OF THE 1ST MSG *02100000 &INST15=, FIFTH INSERT OF THE 1ST MSG *02200000 &INST16=, SIXTH INSERT OF THE 1ST MSG *02300000 &SECOND=, FIRST MESSAGE TO BE ISSUED *02400000 &INST21=, FIRST INSERT OF THE 2ND MSG *02500000 &INST22=, SECOND INSERT OF THE 2ND MSG *02600000 &INST23=, THIRD INSERT OF THE 2ND MSG *02700000 &INST24=, FOURTH INSERT OF THE 2ND MSG *02800000 &INST25=, FIFTH INSERT OF THE 2ND MSG *02900000 &INST26=, SIXTH INSERT OF THE 2ND MSG *03000000 &ID=, MODULE CALLING ID NUMBER *03100000 &MF=, TYPE MACRO TO EXPAND *03200000 &DATAPTR=, ADDRESS OF DATA LINE *03300000 &DSNAME=, ADDRESS OF OPEN DCB *03400000 &SVC=, SVC NUMBER *03500000 &ABENDRG=, REGISTER CONTAINING ABEND NUM *03600000 &RC=, REGISTER CONTAINING ABEND CODE *03700003 &VCONBR= BRANCH TO VCON NOT TO TSTIO @ZA04126 03730003 .********************************************************************* 03800000 .** * 03900000 .** HEADER */ 04000000 .**DRIVER: 04100000 .** E MAIN DRIVER */ 04200000 .** * 04300000 .********************************************************************* 04400000 GBLB &LISTSW SWITCH TO INDICATE LIST FORM 04500000 GBLB &STORESW SW TO INDICATE PARM STRIPPING 04600000 LCLC &ADDRESS VARIABLE TO CONTAIN THE STORE AD 04700000 LCLC &NUMID VARIABLE TO STRIP ID NUMBER 04800000 LCLA &IDCON VARIABLE TO CONTAIN THE ID NUM 04900000 LCLA &LENGTH VARIABLE TO COUNT CHARS IN PARM 05000000 &LISTSW SETB 0 INITIALIZE LIST SWITCH OFF 05100000 &STORESW SETB 0 INITIALIZE STORE SWITCH OFF 05200000 &NUMID SETC '&ID'(4,2) STRIP OFF THE LETTERS FROM ID NO 05300000 &IDCON SETA &NUMID TRANSFER VALUE FOR LATER USE 05400000 .********************************************************************* 05500000 .** * 05600000 .** D (NO,,YES,%CONT1) 05700000 .** HAS THE 'MF' PARAMETER BEEN CODED PROPERLY ? */ 05800000 .** * 05900000 .********************************************************************* 06000000 AIF ('&MF(1)' EQ '').ERRORMF 06100000 AIF ('&MF(1)' EQ 'E').MFE 06200000 AIF ('&MF(1)' EQ 'L').MFL 06300000 .********************************************************************* 06400000 .** * 06500000 .** P ISSUE AN ERROR MESSAGE */ 06600000 .** P (,END) 06700000 .** SET CONDITION CODE = 12 */ 06800000 .** */ 06900000 .** * 07000000 .********************************************************************* 07100000 MNOTE 12,'SYNTAX ERROR ENCOUNTERED IN MF= PARM' 07200000 AGO .NOLINK 07300000 .ERRORMF MNOTE 12,'MF= PARAMETER OMITTED, BUT IS REQUIRED' 07400000 AGO .NOLINK 07500000 .ERORMFE MNOTE 12,'THE ADDRESS PORTION IS REQUIRED WITH THE EXECUTABLE *07600000 FORM' 07700000 AGO .NOLINK 07800000 .ERORMFA MNOTE 4,'THE ADDRESS PORTION IS INVALID WITH THE LIST FORM AND*07900000 IS IGNORNED' 08000000 AGO .IDROUT 08100000 .********************************************************************* 08200000 .** * 08300000 .**%CONT1: 08400000 .** P SET THE MF TYPE SWITCHES ON */ 08500000 .** * 08600000 .********************************************************************* 08700000 .MFE AIF ('&MF(2)' EQ '').ERORMFE GO TO ERROR EXIT WITH MSG 08800000 &ADDRESS SETC '&MF(2)' PREPARE TO PROCESS ADDRESS 08900000 AIF ('&ADDRESS'(1,1) EQ '(').MFADREG TEST FOR REG NOT. 09000000 &LABEL LA 1,&ADDRESS ESTABLISH ADDRESSABILITY TO PARM 09100000 AGO .IDROUT CONTINUE PROCESSING NEXT OPERAND 09200000 .MFADREG ANOP LABEL FOR REG NOTATION OF ADDR 09300000 &LABEL LR 1,&ADDRESS ESTABLISH ADDRESSABILITY TO PARM 09400000 AGO .IDROUT CONTINUE PROCESSING NEXT OPERAND 09500000 .MFL ANOP ROUTINE BRANCHED TO IF LIST FORM 09600000 &LISTSW SETB 1 TURN ON THE LIST FORM SWITCH 09700000 DS 0H ALIGN TO HALFWORD BOUNDRY 09800000 B *+88 BRANCH AROUND PARM LIST 09900000 AIF ('&MF(2)' NE '').ERORMFA TEST FOR ADDR WITH L FORM 10000000 .********************************************************************* 10100000 .** * 10200000 .** D (NO,,YES,%CONT2) 10300000 .** IS THE USER'S ID NUMBER CODED CORRECTLY ? */ 10400000 .** * 10500000 .********************************************************************* 10600000 .IDROUT ANOP LABEL FOR 'ID=' OPERAND PROC 10700000 AIF ('&ID' EQ '').ERRORID TEST FOR NULL PARM 10800000 &LENGTH SETA K'&ID COUNT LENGTH OF I.D. PARM 10900000 AIF (&LENGTH NE 5).ERRIDSZ PUT OUT ERROR MESSAGE 11000000 AIF (&LISTSW EQ 1).IDLIST TEST IF THIS SHOULD BE DC OR MVI 11100000 AGO .IDE BRANCH TO MOVE ID INTO P.L. ROUT 11200000 .********************************************************************* 11300000 .** * 11400000 .** P ISSUE A WARNING MESSAGE */ 11500000 .** P (,%CONT3) 11600000 .** SET CONDITION CODE = 4 IF LIST FORM */ 11700000 .** * 11800000 .********************************************************************* 11900000 .ERRIDSZ ANOP BRANCH HERE IF ID PARM HAS ERROR 12000000 MNOTE 12,'THERE IS A SYNTAX ERROR IN THE ID= PARM' 12100000 AGO .NOLINK BRANCH TO RETURN TO THE USER 12200000 .ERRORID ANOP ROUTINE IF ID INCORRECT 12300000 AIF (&LISTSW EQ 1).ID4 IF THIS IS A LIST FORM SET CC=4 12400000 MNOTE 4,'THE ID= PARM IS MISSING OR INCORRECT' 12500000 AGO .SELECT BRANCH TO CONTINUE PROCESSING 12600000 .ID4 MNOTE 0,'THE ID= PARM IS MISSING OR INCORRECT' 12700000 AGO .SELECT BRANCH TO CONTINUE PROCESSING 12800000 .********************************************************************* 12900000 .** * 13000000 .**%CONT2: 13100000 .** P GENERATE THE INSTRUCTIONS NECESSARY TO 13200000 .** STORE THE USERS ID# IN THE P.L. */ 13300000 .** * 13400000 .********************************************************************* 13500000 .IDE ANOP ROUTINE TO MOVE ID # IN P.L. 13600000 MVI 1(1),&IDCON SET UP MOVE INSTRUCTION 13700000 AGO .SELECT CONTINUE PROCESSING 13800000 .IDLIST ANOP ROUTINE TO CREATE 'DC'S FOR ID 13900000 &LABEL DC AL1(0) FILLER 14000000 DC AL1(&IDCON) DC FOR CALLER'S ID # IN P.L. 14100000 .********************************************************************* 14200000 .** * 14300000 .**%CONT3: 14400000 .** D (YES,,NO,%CONT4) 14500000 .** IS THIS REQUEST FOR DATA ? */ 14600000 .** * 14700000 .********************************************************************* 14800000 .SELECT ANOP DETERMINE WHICH SERVICE REQ'D 14900000 AIF ('&TYPEREQ' NE 'DATA').SELECT2 TEST IF DATA REQUEST 15000000 .********************************************************************* 15100000 .** * 15200000 .** S (,END) 15300000 .** CALL DATA: GENERATE INSTRUCIONS FOR DATA */ 15400000 .** * 15500000 .********************************************************************* 15600000 DATA &DATAPTR,&DSNAME CALL DATA REQ'T ROUTINE 15700000 AGO .END EXIT 15800000 .********************************************************************* 15900000 .** * 16000000 .**%CONT4: 16100000 .** D (YES,,NO,%CONT5) 16200000 .** IS THIS REQUEST FOR AN SVC ERROR MESSAGE ? */ 16300000 .** * 16400000 .********************************************************************* 16500000 .SELECT2 ANOP TEST FOR SVCERR REQUEST ROUT 16600000 AIF ('&TYPEREQ' NE 'SVCERR').SELECT3 CONTINUE IF NOT SVCERR 16700000 .********************************************************************* 16800000 .** * 16900000 .** S (,END) 17000000 .** CALL SVCMSG: GENERATE INSTRUCTIONS FOR SVC MSG */ 17100000 .** * 17200000 .********************************************************************* 17300000 SVCERR &SVC,&ABENDRG,&RC,&INST11 CALL SVCERR REQ'T ROUTINE 17400000 AGO .END EXIT 17500000 .********************************************************************* 17600000 .** * 17700000 .**%CONT5: 17800000 .** D (YES,,NO,%CONT6) 17900000 .** IS THIS REQUEST FOR A MESSAGE ? */ 18000000 .** * 18100000 .********************************************************************* 18200000 .SELECT3 ANOP TEST FOR MSG REQUEST ROUTINE 18300000 AIF ('&TYPEREQ' NE 'MSG').SELECT4 CONTINUE IF NOT MSG 18400000 .********************************************************************* 18500000 .** * 18600000 .** S (,END) 18700000 .** CALL MSG: GENERATE INSTRUCTIONS FOR MSG */ 18800000 .** * 18900000 .********************************************************************* 19000000 MSG &FIRST,&SECOND,&INST11,&INST12,&INST13,&INST14,&INST15, *19100000 &INST16,&INST21,&INST22,&INST23,&INST24,&INST25,&INST26 19200000 AGO .END EXIT 19300000 .********************************************************************* 19400000 .** * 19500000 .**%CONT6: 19600000 .** D (YES,,NO,%CONT7) 19700000 .** IS THIS REQUEST FOR A PROMPTING MESSAGE ? */ 19800000 .** * 19900000 .********************************************************************* 20000000 .SELECT4 ANOP TEST FOR PTGT REQUEST ROUTINE 20100000 AIF ('&TYPEREQ' NE 'PTGT').ERSLECT CONTINUE IF NOT MSG 20200000 .********************************************************************* 20300000 .** * 20400000 .** S (,END) 20500000 .** CALL PTGT: GENERATE INSTRUCTIONS FOR PTGT MSG */ 20600000 .** * 20700000 .********************************************************************* 20800000 PTGT &FIRST INVOKE THE INTERNAL SUBROUTINE 20900000 AGO .END EXIT 21000000 .********************************************************************* 21100000 .** * 21200000 .**%CONT7: 21300000 .** P ISSUE AN ERROR MESSAGE */ 21400000 .** P (,NOLINK) 21500000 .** SET CONDITION CODE TO 12 */ 21600000 .** * 21700000 .********************************************************************* 21800000 .ERSLECT ANOP COME HERE IF SYNTAX IN &TYPEREQ 21900000 MNOTE 12,'MISSING OR SYNTAX ERROR IN OPTION KEYWORD' 22000000 AGO .NOLINK BRANCH TO EXIT 22100000 .********************************************************************* 22200000 .** * 22300000 .**END: 22400000 .** D (NO,,YES,NOLINK) 22500000 .** HAS THE LIST FORM BEEN REQUESTED ? */ 22600000 .** * 22700000 .********************************************************************* 22800000 .END ANOP ENDING ROUTINE FOR ENTIRE MACRO 22900000 AIF (&LISTSW EQ 1).NOLINK BRANCH AROUND THE BRANCH & LINK 23000000 .********************************************************************* 23100000 .** * 23200000 .** P GENERATE THE BRANCH & LINK INSTRUCTION TO I/O */ 23300000 .** * 23400000 .********************************************************************* 23500000 AIF ('&VCONBR' NE 'YES').BALR 23510003 L 15,@IOVCON ADDR TO BR TO @ZA04126 23550003 BALR 14,15 ENTER THE IO ROUTINE @ZA04126 23556003 AGO .NOLINK 23570003 .BALR ANOP 23580003 L 15,TSTIO ESTABLISH THE ADDRESS TO IO 23600000 BALR 14,15 BRANCH TO I/O 23700000 .********************************************************************* 23800000 .** * 23900000 .**NOLINK: 24000000 .** R RETURN CONTROL */ 24100000 .** * 24200000 .********************************************************************* 24300000 .NOLINK MEND RETURN CONTROL TO USER 24400000 MACRO 24500000 DATA &DATAPTR,&DSNAME 24600000 .********************************************************************* 24700000 .** * 24800000 .**DATA: 24900000 .** E DATA REQUEST ROUTINE */ 25000000 .** * 25100000 .********************************************************************* 25200000 GBLB &LISTSW 25300000 .********************************************************************* 25400000 .** * 25500000 .** P SET UP INSTRUCTION NECESSARY TO STORE */ 25600000 .** DATA REQUEST # IN P.L. */ 25700000 .** * 25800000 .********************************************************************* 25900000 AIF (&LISTSW EQ 1).LISTTYP FIND OUT WHICH FORM E OR L 26000000 MVI 0(1),1 STORE TYPE REQT IN P. L. (DATA) 26100000 AGO .NEXTSTP BRANCH AND CONTINUE 26200000 .LISTTYP ANOP LABEL FOR DC TYPE INSTRUCTION 26300000 DC AL2(0) FILLER 26400000 .********************************************************************* 26500000 .** * 26600000 .** D (YES,,NO,%CONT8) 26700000 .** IS THE 'DATAPTR' PARAMETER NULL */ 26800000 .** * 26900000 .********************************************************************* 27000000 .NEXTSTP ANOP LABEL USED TO SKIP DC TYPE INST 27100000 AIF ('&DATAPTR' NE '').STOREDP TEST FOR REQD PARM DATAPTR 27200000 .********************************************************************* 27300000 .** * 27400000 .** P ISSUE WARNING MESSAGE */ 27500000 .** * 27600000 .********************************************************************* 27700000 MNOTE 0,'THE DATAPTR KEYWORD IS REQUIRED, UNLESS A NULL LINE *27800000 HAS BEEN REQUESTED' 27900000 .********************************************************************* 28000000 .** * 28100000 .**%CONT8: 28200000 .** S CALL STORE: TO INSERT DATAPTR, DSNAME 28300000 .** AND FILLER INTO P.L. */ 28400000 .** * 28500000 .********************************************************************* 28600000 .STOREDP ANOP BRANCH HERE IF &DATAPTR CODED 28700000 STORE 4,&DATAPTR,4 PREPARE INST TO INSERT INTO P.L. 28800000 STORE 8,&DSNAME,4 PREPARE INST TO INSERT INTO P.L. 28900000 STORE 12,,72 IF LIST FORM PREPARE DC'S ZERO 29000000 .********************************************************************* 29100000 .** * 29200000 .**%CONT9: 29300000 .** R RETURN TO THE DRIVER */ 29400000 .** * 29500000 .********************************************************************* 29600000 MEND 29700000 MACRO 29800000 SVCERR &SVC,&ABENDRG,&RC,&INST11 29900000 .********************************************************************* 30000000 .** * 30100000 .**SVC: 30200000 .** E SVC BUILD PARM ROUTINE */ 30300000 .** * 30400000 .********************************************************************* 30500000 GBLB &LISTSW SWITCH FOR LIST FORM OF MF 30600000 GBLB &STORE SW FOR STORE TO STRIP NUM DOWN 30700000 .********************************************************************* 30800000 .** * 30900000 .** P SET UP INST NECESSARY TO STORE 31000000 .** SVC REQUEST # IN P.L. */ 31100000 .** * 31200000 .********************************************************************* 31300000 AIF (&LISTSW EQ 1).NEXTSTP TEST FOR LIST FORM INST 31400000 MVI 0(1),3 STORE SVCERR REQUEST NUM IN P.L. 31500000 .********************************************************************* 31600000 .** * 31700000 .** D (YES,,NO,%CONT10) 31800000 .** ARE THE PARAMETERS CODED CORRECTLY ? */ 31900000 .** P ISSUE WARNING MESSAGE IF INCORRECT */ 32000000 .** * 32100000 .********************************************************************* 32200000 .NEXTSTP ANOP THIS PORTION CHECKS PARMS 32300000 AIF ('&ABENDRG' EQ '').CONT1 BRANCH TO CONTINUE IF NULL 32400000 AIF ('&ABENDRG'(1,1) EQ '(').CONT1 BRANCH TO CONTINUE IF OK 32500000 MNOTE 12,'REGISTER NOTATION IS REQUIRED WITH THE ABENDRG PARM' 32600000 .CONT1 ANOP BRANCH HERE IF ABENDRG OK 32700000 AIF ('&RC' EQ '').CONT2 BRANCH TO CONTINUE IF NULL 32800000 AIF ('&RC'(1,1) EQ '(').CONT2 BRANCH TO CONTINUE IF OK 32900000 MNOTE 12,'REGISTER NOTATION IS REQUIRED WITH THE RC PARM' 33000000 .CONT2 ANOP BRANCH HERE IF RC PARM OK 33100000 AIF ('&SVC' NE '').STORSVC TEST FOR NULL PARM 33200000 MNOTE 0,'THE SVC KEYWORD IS REQUIRED WITH THE SVCERR OPTION' 33300000 .********************************************************************* 33400000 .** * 33500000 .**%CONT10: 33600000 .** S CALL STORE: TO INSERT &ABENDRG, &SVC, 33700000 .** &RC AND FILLER INTO P.L. */ 33800000 .** * 33900000 .********************************************************************* 34000000 .STORSVC ANOP BRANCH HERE IF &SVC CODED 34100000 STORE 2,,2 PREPARE FILLER IF LIST FORM 34200000 STORE 4,&ABENDRG,4 PREPARE INST TO INSERT INTO P.L. 34300000 STORE 8,&RC,4 PREPARE INST TO INSERT INTO P.L. 34400000 STORE 12,,4 PREPARE FILLER IF LIST FORM 34500000 STORE 16,&SVC,4 PREPARE INST TO INSERT INTO P.L. 34600000 STORE 20,,26 PREPARE FILLER IF LIST FORM 34700000 .********************************************************************* 34800000 .** * 34900000 .** S CALL INSTTYP: PROCESS TYPE INSERT */ 35000000 .** * 35100000 .********************************************************************* 35200000 TYPE 46,&INST11 35300000 .********************************************************************* 35400000 .** * 35500000 .** S CALL STORE: PREPARE INST TO STORE 35600000 .** FILLER INTO P.L. */ 35700000 .** * 35800000 .********************************************************************* 35900000 STORE 52,,8 PREPARE FILLER IF LIST FORM 36000000 .********************************************************************* 36100000 .** * 36200000 .** S CALL INSTWHR: PROCESS WHERE PORTION OF INSERT */ 36300000 .** * 36400000 .********************************************************************* 36500000 WHERE 60,&INST11 36600000 .********************************************************************* 36700000 .** * 36800000 .**%CONT13: 36900000 .** R RETURN TO DRIVER */ 37000000 .** * 37100000 .********************************************************************* 37200000 MEND END OF SVCERR ROUTINE 37300000 MACRO 37400000 MSG &FIRST,&SECOND,&INST11,&INST12,&INST13,&INST14,&INST15, *37500000 &INST16,&INST21,&INST22,&INST23,&INST24,&INST25,&INST26 37600000 .********************************************************************* 37700000 .** * 37800000 .**MSG: 37900000 .** E MSG ROUTINE */ 38000000 .** * 38100000 .********************************************************************* 38200000 GBLB &LISTSW SWITCH IF LIST FORM USED 38300000 GBLB &STORESW SW INDICATES TO STORE STRIP NUM 38400000 .********************************************************************* 38500000 .** * 38600000 .** P SET UP INST NECESSARY TO 38700000 .** STORE MSG REQ # IN P.L. */ 38800000 .** * 38900000 .********************************************************************* 39000000 AIF (&LISTSW EQ 1).LISTTYP TEST WHICH FORM MACRO L OR E 39100000 MVI 0(1),2 MOVE CODE FOR MSG INTO P.L. 39200000 .********************************************************************* 39300000 .** * 39400000 .** D (YES,,NO,%CONT14) 39500000 .** IS THE 'FIRST' PARAMETER NULL ? */ 39600000 .** * 39700000 .********************************************************************* 39800000 .LISTTYP ANOP LABEL USED BRANCH AROUND E INST 39900000 AIF ('&FIRST' NE '').NEXTSTP TEST IF USER CODED FIRST PARM 40000000 .********************************************************************* 40100000 .** * 40200000 .** P ISSUE AN WARNING MSG */ 40300000 .** * 40400000 .********************************************************************* 40500000 MNOTE 0,'THE FIRST PARM IS REQUIRED WITH THE MSG OPTION' 40600000 .********************************************************************* 40700000 .** * 40800000 .**%CONT14: 40900000 .** S CALL INSTTYP: SET UP INST TO INSERT 41000000 .** TYPES INTO P. L. */ 41100000 .** * 41200000 .********************************************************************* 41300000 .NEXTSTP ANOP ROUTINE TO PLACE TYPES IN LIST 41400000 INSTTYP 2,&INST11,&INST12,&INST13,&INST14,&INST15,&INST16 41500000 STORE 8,,8 PREPARE FILLER IF LIST FORM 41600000 .********************************************************************* 41700000 .** * 41800000 .**%CONT17: 41900000 .** S CALL STORE: STORE &FIRST INTO PARM LIST */ 42000000 .** * 42100000 .********************************************************************* 42200000 &STORESW SETB 1 TURN ON STRIP SWITCH FOR STORE 42300000 STORE 16,&FIRST,4 PREPARE INST TO STORE IN LIST 42400000 .********************************************************************* 42500000 .** * 42600000 .** S CALL INSTWHR: PROCESS WHERE PORTION OF INSERTS */ 42700000 .** * 42800000 .********************************************************************* 42900000 INSTWHR 20,&INST11,&INST12,&INST13,&INST14,&INST15,&INST16 43000000 STORE 44,,2 PREPARE FILLER IF LIST FORM 43100000 .********************************************************************* 43200000 .** * 43300000 .** S CALL INSTTYP: PROCESS TYPE INSERT OF 2ND LEV */ 43400000 .** * 43500000 .********************************************************************* 43600000 INSTTYP 46,&INST21,&INST22,&INST23,&INST24,&INST25,&INST26 43700000 .********************************************************************* 43800000 .** * 43900000 .** S CALL STORE: PREPARE INST TO STORE 44000000 .** &SECOND AND FILLER INTO P.L. */ 44100000 .** * 44200000 .********************************************************************* 44300000 STORE 52,,4 PREPARE FILLER IF LIST FORM 44400000 &STORESW SETB 1 TURN ON STRIP SWITCH FOR STORE 44500000 STORE 56,&SECOND,4 PREPARE INST TO STORE &SECOND 44600000 .********************************************************************* 44700000 .** * 44800000 .** S CALL INSTWHR: PROCESS WHERE PORTION OF INSERTS */ 44900000 .** * 45000000 .********************************************************************* 45100000 INSTWHR 60,&INST21,&INST22,&INST23,&INST24,&INST25,&INST26 45200000 .********************************************************************* 45300000 .** * 45400000 .**%CONT18: 45500000 .** R RETURN TO DRIVER */ 45600000 .** * 45700000 .********************************************************************* 45800000 MEND END OF MESSAGE PROCESSOR ROUTINE 45900000 MACRO 46000000 PTGT &FIRST 46100000 .********************************************************************* 46200000 .** * 46300000 .** E PTGT ROUTINE */ 46400000 .** * 46500000 .********************************************************************* 46600000 GBLB &LISTSW SWITCH FOR LIST FORM 46700000 GBLB &STORESW SWITCH FOR STORE TO STRIP NUM 46800000 .********************************************************************* 46900000 .** * 47000000 .** P SET NECESSARY INST TO STORE 47100000 .** PTGT # INTO P.L. */ 47200000 .** * 47300000 .********************************************************************* 47400000 AIF (&LISTSW EQ 1).LISTTYP TEST FOR LIST FORM 47500000 MVI 0(1),4 STORE CODE NUM FOR PTGT REQT 47600000 .********************************************************************* 47700000 .** * 47800000 .** D (YES,,NO,%CONT19) 47900000 .** IS THE 'FIRST' PARAMETER NULL ? */ 48000000 .** * 48100000 .********************************************************************* 48200000 .LISTTYP ANOP BRANCH TO IF LIST FORM 48300000 AIF ('&FIRST' NE '').STOR1ST TEST FOR NULL PARM 48400000 .********************************************************************* 48500000 .** * 48600000 .** P ISSUE AN WARNING MESSAGE */ 48700000 .** * 48800000 .********************************************************************* 48900000 MNOTE 0,'THE FIRST KEYWORD IS REQUIRED WITH THE PTGT OPTION' 49000000 .********************************************************************* 49100000 .** * 49200000 .**%CONT19: 49300000 .** S CALL STORE: STORE PARMS AND FILLERS INTO P.L. */ 49400000 .** * 49500000 .********************************************************************* 49600000 .STOR1ST ANOP ROUTINE TO PREPARE P.L. 49700000 STORE 2,,14 PREPARE FILLER IF LIST FORM 49800000 &STORESW SETB 1 TURN ON STRIP SWITCH 49900000 STORE 16,&FIRST,4 PREPARE INST TO STORE &FIRST 50000000 STORE 20,,64 PREPARE FILLER IF LIST FORM 50100000 .********************************************************************* 50200000 .** * 50300000 .**%CONT20: 50400000 .** R RETURN TO DRIVER */ 50500000 .** * 50600000 .********************************************************************* 50700000 MEND END OF PTGT PROCESSOR ROUTINE 50800000 MACRO 50900000 INSTTYP &START,&IN1,&IN2,&IN3,&IN4,&IN5,&IN6 51000000 .********************************************************************* 51100000 .** * 51200000 .**INSTTYP: 51300000 .** E ROUTINE FOR INSERT TYPE PORTION */ 51400000 .** * 51500000 .********************************************************************* 51600000 LCLA &DISP VARIABLE TO CONTAIN DISPLACEMENT 51700000 &DISP SETA &START INITIALIZE DISPLACEMENT COUNTER 51800000 .********************************************************************* 51900000 .** * 52000000 .** P PREPARE EACH INSERT TO BE PROCESSED 52100000 .** BY TYPE PROCESSOR */ 52200000 .** * 52300000 .********************************************************************* 52400000 TYPE &DISP,&IN1 CALL TYPE ROUTINE TO STORE PARM 52500000 &DISP SETA &DISP+1 INCREMENT DISPLACEMENT COUNTER 52600000 TYPE &DISP,&IN2 CALL TYPE ROUTINE TO STORE PARM 52700000 &DISP SETA &DISP+1 INCREMENT DISPLACEMENT COUNTER 52800000 TYPE &DISP,&IN3 CALL TYPE ROUTINE TO STORE PARM 52900000 &DISP SETA &DISP+1 INCREMENT DISPLACEMENT COUNTER 53000000 TYPE &DISP,&IN4 CALL TYPE ROUTINE TO STORE PARM 53100000 &DISP SETA &DISP+1 INCREMENT DISPLACEMENT COUNTER 53200000 TYPE &DISP,&IN5 CALL TYPE ROUTINE TO STORE PARM 53300000 &DISP SETA &DISP+1 INCREMENT DISPLACEMENT COUNTER 53400000 TYPE &DISP,&IN6 CALL TYPE ROUTINE TO STORE PARM 53500000 .********************************************************************* 53600000 .** * 53700000 .** R RETURN TO CONTINUE PROCESSING */ 53800000 .** * 53900000 .********************************************************************* 54000000 MEND END OR TYPE PROCESSOR OF INSERTS 54100000 MACRO 54200000 TYPE &DISP,&IN INTERNAL ROUTINE / TYPE PORTION 54300000 .********************************************************************* 54400000 .** * 54500000 .**TYPE: E ROUTINE TO DETERMINE WHICH TYPE */ 54600000 .** * 54700000 .********************************************************************* 54800000 LCLA &TYINST VARIABLE FOR CODE OF INSERT 54900000 .********************************************************************* 55000000 .** * 55100000 .** D (NO,,YES,NULLTYP) 55200000 .** IS THIS INSERT NULL ? */ 55300000 .** * 55400000 .********************************************************************* 55500000 AIF ('&IN' EQ '').NULLTYP BRANCH TO NULL PROCESSING 55600000 .********************************************************************* 55700000 .** * 55800000 .** P DETERMINE WHICH TYPE REQ'T (PDE,NUM,ETC) */ 55900000 .** * 56000000 .********************************************************************* 56100000 AIF ('&IN(1)' NE 'APDE').CONT1 TEST IF APDE TYPE INSERT 56200000 &TYINST SETA 6 SET CODE VARIABLE / INDICATE PDE 56300000 AGO .PROCESS BRANCH TO STORE INTO LIST 56400000 .CONT1 ANOP BRANCHED TO IF NOT PDE 56500000 AIF ('&IN(1)' NE 'NUM').CONT2 TEST IF NUM TYPE INSERT 56600000 &TYINST SETA 5 SET CODE VARIABLE / INDICATE PDE 56700000 AGO .PROCESS BRANCH TO STORE INTO LIST 56800000 .CONT2 ANOP BRANCHED TO IF NOT PDE 56900000 AIF ('&IN(1)' NE 'REG').CONT3 TEST IF REG TYPE INSERT 57000000 &TYINST SETA 1 SET CODE VARIABLE / INDICATE REG 57100000 AIF ('&IN(2)'(1,1) EQ '(').CONT21 TEST FOR REG NOTATION 57200000 MNOTE 12,'WITH THE REG TYPE INSERT ONLY REG NOTATION ALLOWED' 57300000 .CONT21 ANOP BRANCH HERE IF SYNTAX OK 57400000 AGO .PROCESS BRANCH TO STORE INTO LIST 57500000 .CONT3 ANOP BRANCH TO IF NOT REG TYPE 57600000 AIF ('&IN(1)' NE 'ADDR').CONT4 TEST IF ADDR TYPE INSERT 57700000 &TYINST SETA 2 SET CODE VAR / INDICATE ADDR 57800000 AGO .PROCESS BRANCH TO STORE INTO LIST 57900000 .CONT4 ANOP BRANCH TO IF NOT ADDR TYPE 58000000 AIF ('&IN(1)' NE 'ADDRCONX').CONT5 TEST ADDRCONX TYPE INSERT 58100000 &TYINST SETA 3 SET CODE VAR / INDICATE ADDR 58200000 AGO .PROCESS BRANCH TO STORE INTO LIST 58300000 .CONT5 ANOP BRANCH TO IF NOT ADDR TYPE 58400000 AIF ('&IN(1)' NE 'ADDRCOND').CONT6 TEST ADDRCOND TYPE INSERT 58500000 &TYINST SETA 4 SET CODE VAR / INDICATE ADDR 58600000 AGO .PROCESS BRANCH TO STORE INTO LIST 58700000 .CONT6 ANOP BRANCH TO IF NOT ADDRCONX TYPE 58800000 AIF ('&IN(1)' NE 'VPDE').ERROR TEST VPDE TYPE INSERT 58900000 &TYINST SETA 7 SET CODE VAR / INDICATE ADDR 59000000 AGO .PROCESS BRANCH TO STORE INTO LIST 59100000 .********************************************************************* 59200000 .** * 59300000 .** P IF THERE IS A SYNTAX ERROR - ISSUE WARNING MSG */ 59400000 .** * 59500000 .********************************************************************* 59600000 .ERROR ANOP COME HERE IF SYNTAX ERROR FOUND 59700000 MNOTE 12,'THE TYPE PORTION OF AN INSERT HAS A SYNTAX ERROR' 59800000 &TYINST SETA 0 SET CODE TO NULL VALUE 59900000 .PROCESS ANOP THIS PORTION CALLS STORE 60000000 .********************************************************************* 60100000 .** * 60200000 .** S (,ENDTYP) 60300000 .** CALL STORE: STORE CODE INTO P. L. */ 60400000 .** * 60500000 .********************************************************************* 60600000 STORE &DISP,&TYINST,1 CALL STORE TO PREPARE INST 60700000 AGO .ENDTYP BRANCH TO END TO RETURN 60800000 .********************************************************************* 60900000 .** * 61000000 .**NULLTYP: 61100000 .** S CALL STORE: STORE FILLER ZEROS IF L FORM */ 61200000 .** * 61300000 .********************************************************************* 61400000 .NULLTYP ANOP BRANCH HERE IF INSERT PARM NULL 61500000 STORE &DISP,,1 CALL STORE FOR FILLER 61600000 .********************************************************************* 61700000 .** * 61800000 .**ENDTYP: R RETURN TO INSTTYP */ 61900000 .** * 62000000 .********************************************************************* 62100000 .ENDTYP ANOP BRANCH HERE TO EXIT ROUTINE 62200000 MEND END OF TYPE ROUTINE 62300000 MACRO 62400000 INSTWHR &START,&IN1,&IN2,&IN3,&IN4,&IN5,&IN6 62500000 .********************************************************************* 62600000 .** * 62700000 .**INSTWHR: 62800000 .** E ROUTINE FOR INSERT WHERE PORTION */ 62900000 .** * 63000000 .********************************************************************* 63100000 LCLA &DISP VARIABLE TO CONTAIN DISPLACEMENT 63200000 &DISP SETA &START INITIALIZE DISPLACEMENT COUNTER 63300000 .********************************************************************* 63400000 .** * 63500000 .** P PREPARE EACH INSERT TO BE PROCESSED 63600000 .** BY WHERE PROCESSOR */ 63700000 .** * 63800000 .********************************************************************* 63900000 WHERE &DISP,&IN1 CALL TYPE ROUTINE TO STORE PARM 64000000 &DISP SETA &DISP+4 INCREMENT DISPLACEMENT COUNTER 64100000 WHERE &DISP,&IN2 CALL TYPE ROUTINE TO STORE PARM 64200000 &DISP SETA &DISP+4 INCREMENT DISPLACEMENT COUNTER 64300000 WHERE &DISP,&IN3 CALL TYPE ROUTINE TO STORE PARM 64400000 &DISP SETA &DISP+4 INCREMENT DISPLACEMENT COUNTER 64500000 WHERE &DISP,&IN4 CALL TYPE ROUTINE TO STORE PARM 64600000 &DISP SETA &DISP+4 INCREMENT DISPLACEMENT COUNTER 64700000 WHERE &DISP,&IN5 CALL TYPE ROUTINE TO STORE PARM 64800000 &DISP SETA &DISP+4 INCREMENT DISPLACEMENT COUNTER 64900000 WHERE &DISP,&IN6 CALL TYPE ROUTINE TO STORE PARM 65000000 .********************************************************************* 65100000 .** * 65200000 .** R RETURN TO CONTINUE PROCESSING */ 65300000 .** * 65400000 .********************************************************************* 65500000 MEND 65600000 MACRO 65700000 WHERE &DISP,&IN 65800000 .********************************************************************* 65900000 .** * 66000000 .**WHERE: E ROUTINE PROCESS WHERE PORTION OF ONE INSERT */ 66100000 .** * 66200000 .********************************************************************* 66300000 GBLB &STORESW SWITCH - INDICATE STRIP NUM 66400000 LCLC &WHERE LABEL USED TO OBTAIN WHERE PARM 66500000 &WHERE SETC '&IN(2)' STRIP OFF WHERE PORTION OF INST 66600000 .********************************************************************* 66700000 .** * 66800000 .** D (NO,,YES,NULLWHR) 66900000 .** IS THIS INSERT NULL ? */ 67000000 .** * 67100000 .********************************************************************* 67200000 AIF ('&IN' EQ '').NULLWHR BRANCH TO NULL PROCESSING 67300000 .********************************************************************* 67400000 .** * 67500000 .** P ISSUE A WARNING MSG IF WHERE PORTION IS NULL */ 67600000 .** * 67700000 .********************************************************************* 67800000 AIF ('&WHERE' NE '').CONT TEST FOR NULL PORTION 67900000 MNOTE 12,'AN INSERT WHERE PORTION IS MISSING OR MISSPELLED' 68000000 .********************************************************************* 68100000 .** * 68200000 .** P TURN ON THE STRIP SW IF 'NUM' IS THE TYPE */ 68300000 .** * 68400000 .********************************************************************* 68500000 .CONT ANOP THIS PORTION PREPARE TO STORE 68600000 &STORESW SETB ('&IN(1)' EQ 'NUM') TURN ON STRIP SWITCH IF I/O NUM 68700000 .********************************************************************* 68800000 .** * 68900000 .** S (,ENDWHR) 69000000 .** CALL STORE: HAVE WHERE PORTION PLACED IN P.L. */ 69100000 .** * 69200000 .********************************************************************* 69300000 STORE &DISP,&WHERE,4 CALL STORE - STORE WHERE PORTION 69400000 AGO .ENDWHR BRANCH TO END FOR RETURN 69500000 .********************************************************************* 69600000 .** * 69700000 .**NULLWHR: 69800000 .** S CALL STORE: STORE FILLER ZEROS IF L FORM */ 69900000 .** * 70000000 .********************************************************************* 70100000 .NULLWHR ANOP BRANCH HERE IF INSERT PARM NULL 70200000 STORE &DISP,,4 CALL STORE FOR FILLER 70300000 .********************************************************************* 70400000 .** * 70500000 .**ENDWHR: R RETURN TO PROCESSING */ 70600000 .** * 70700000 .********************************************************************* 70800000 .ENDWHR ANOP BRANCH HERE TO EXIT 70900000 MEND END OF INSTWHR ROUTINE 71000000 MACRO 71100000 STORE &DISP,&PARM,&LEN ROUT. TO PREPARE INST FOR LIST 71200000 .********************************************************************* 71300000 .** * 71400000 .**STORE: 71500000 .** E STORE DATA IN PARM LIST */ 71600000 .** * 71700000 .********************************************************************* 71800000 GBLB &STORESW SW TO INDICATE STRIPPING 71900000 GBLB &LISTSW SW TO INDICATE USER USED L FORM 72000000 LCLC &PARMC VARIABLE TO STRIP PARM DOWN 72100000 LCLA &PARMN VARIABLE TO CHANGE ATTRIBUTES 72200000 LCLA &LENGTH VARIABLE TO COUNT CHARS IN PARM 72300000 .********************************************************************* 72400000 .** * 72500000 .** D (NO,,YES,START) 72600000 .** IS THIS A LIST FORM ? */ 72700000 .** * 72800000 .********************************************************************* 72900000 AIF (&LISTSW EQ 1).START AVOID NEXT TEST IF LIST FORM 73000000 .********************************************************************* 73100000 .** * 73200000 .** D (NO,,YES,RETURN) 73300000 .** IS THIS A NULL PARM ? */ 73400000 .** * 73500000 .********************************************************************* 73600000 AIF ('&PARM' EQ '').RETURN TEST FOR NULL PARM (ONLY E FORM) 73700000 .********************************************************************* 73800000 .** * 73900000 .**START: D (YES,,NO,PROCESS) 74000000 .** IS STRIP SWITCH ON ? */ 74100000 .** * 74200000 .********************************************************************* 74300000 .START ANOP BRANCH HERE IF LIST FORM 74400000 AIF (&STORESW NE 1).PROCESS SEE IF THERE IS NO NEED TO STRIP 74500000 AIF ('&PARM' EQ '').PROCESS IF NULL DO NOT PREPARE TO STRIP 74600000 .********************************************************************* 74700000 .** * 74800000 .** D (NO,,YES,PROCESS) 74900000 .** TEST FOR REGISTER NOTATION */ 75000000 .** * 75100000 .********************************************************************* 75200000 AIF ('&PARM'(1,1) EQ '(').PROCESS TEST FOR REGISTER NOTATION 75300000 .********************************************************************* 75400000 .** * 75500000 .** P ISSUE A WARNING MESSAGE IF 75600000 .** ERROR FOUND IN NUMBER TO BE STRIPPED */ 75700000 .** * 75800000 .********************************************************************* 75900000 &LENGTH SETA K'&PARM COUNT PARM LENGTH FOR POSS ERROR 76000000 AIF (&LENGTH EQ 5).OK TEST FOR SYNTAX ERROR BY USER 76100000 MNOTE 12,'A SYNTAX ERROR FOUND IN A MESSAGE OR INSERT NUMBER' 76200000 .********************************************************************* 76300000 .** * 76400000 .**OK: P STRIP OFF NUMBER PORTION OF PARM */ 76500000 .** * 76600000 .********************************************************************* 76700000 .OK ANOP BRANCH HERE IF NUM SEEMS CORRECT 76800000 &PARMC SETC '&PARM'(3,3) STRIP OF NUM PORTION 76900000 &PARMN SETA &PARMC CHANGE ATTRIBUTE / CHAR TO ARTH 77000000 .********************************************************************* 77100000 .** * 77200000 .** D (YES,,NO,BLDINST) 77300000 .** IS THIS THE LIST FORM WHICH REQS DC'S */ 77400000 .** * 77500000 .********************************************************************* 77600000 AIF (&LISTSW NE 1).BLDINST SEE IF PL IN DYNAMIC STORAGE 77700000 .********************************************************************* 77800000 .** * 77900000 .** P (,RETURN) 78000000 .** BUILD DC FOR LIST FORM P.L. */ 78100000 .** * 78200000 .********************************************************************* 78300000 DC AL&LEN.(&PARMN) PLACEMENT OF PARAMETER INTO LIST 78400000 AGO .RETURN BRANCH TO EXIT 78500000 .********************************************************************* 78600000 .** * 78700000 .**BLDINST: P (,RETURN) 78800000 .** BUILD THE INSTURCTION NECESSARY TO STORE 78900000 .** INTO A DYNAMIC AREA */ 79000000 .** * 79100000 .********************************************************************* 79200000 .BLDINST ANOP BRANCH HERE FOR EXECUTABLE FORM 79300000 AIF (&LEN EQ 1).BLDMVI1 SEE IF ONE BYTE TYPE INST NEEDED 79400000 LA 14,&PARMN GET PARAMETER INTO WORK REGISTER 79500000 ST 14,&DISP.(1) STORE PARAMETER INTO PARM LIST 79600000 AGO .RETURN BRANCH TO EXIT 79700000 .BLDMVI1 ANOP BRANCH HERE IF ONE BYTE LENGTH 79800000 MVI &DISP.(1),&PARMN MOVE PARM INTO PARAMETER LIST 79900000 AGO .RETURN BRANCH TO EXIT 80000000 .********************************************************************* 80100000 .** * 80200000 .**PROCESS: P PREPARE DC OR INSTRUCTIONS TO BUILD P.L. */ 80300000 .** * 80400000 .********************************************************************* 80500000 .PROCESS ANOP BRANCH HERE / STANDARD STORE REQ 80600000 AIF (&LISTSW NE 1).INSTBLD TEST FOR EXECUTABLE FORM REQT 80700000 AIF ('&PARM' NE '').DCPARM TEST FOR FILLER REQUEST 80800000 DC &LEN.AL1(0) FILLER OF HEX ZEROS 80900000 AGO .RETURN BRANCH TO EXIT 81000000 .DCPARM ANOP BRANCH HERE FOR PREPARATION DC'S 81100000 AIF ('&PARM'(1,1) NE '(').CONTDC ENSURE USER HAS NOT USED RG 81200000 MNOTE 12,'REGISTER NOTATION IS NOT PERMITTED WITH THE LIST FOR*81300000 M (MF=L)' 81400000 .CONTDC DC AL&LEN.(&PARM) PLACEMENT OF PARAMETER INTO LIST 81500000 AGO .RETURN BRANCH TO EXIT 81600000 .INSTBLD ANOP BRANCH HERE FOR DYNAMIC LIST 81700000 AIF (&LEN NE 1).CONTI2 TEST FOR ONE BYTE TYPE INST 81800000 AIF ('&PARM'(1,1) NE '(').CONTI1 TEST FOR REG NOTATION 81900000 STC &PARM,&LEN.(1) STORE PARM INTO LIST 82000000 AGO .RETURN BRANCH TO EXIT 82100000 .CONTI1 ANOP BRANCH HERE FOR MVI TYPE INST 82200000 MVI &DISP.(1),&PARM MOVE VALUE INTO LIST 82300000 AGO .RETURN BRANCH TO EXIT 82400000 .CONTI2 ANOP BRANCH HERE IF NOT ONE BYTE 82500000 AIF ('&PARM'(1,1) EQ '(').REGPARM IF REG USE STORE INST 82600000 LA 14,&PARM GET PARM INTO WORK REGISTER 82700000 ST 14,&DISP.(1) STORE PARM INTO PARAMETER LIST 82800000 AGO .RETURN BRANCH TO EXIT 82900000 .REGPARM ANOP BRANCH HERE IF REG NOTATION 83000000 ST &PARM,&DISP.(1) STORE PARM INTO PARAMETER LIST 83100000 .********************************************************************* 83200000 .** * 83300000 .**RETURN: R RETURN TO CALLER AND CONTINUE PROCESSING */ 83400000 .** * 83500000 .********************************************************************* 83600000 .RETURN ANOP EXIT ROUTINE FOR STORE 83700000 &STORESW SETB 0 TURN OFF STRIP SW FOR NEXT PARM 83800000 MEND END OF STORE ROUTINE 83900000 PRINT ON 84000000