PRINT GEN TITLE 'ALC$LOAD - GETMAIN/LOAD PROGRAM' *---------------------------------------------------------------------* * A L C $ L O A D * *---------------------------------------------------------------------* R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 R00 EQU 0 R01 EQU 1 R02 EQU 2 R03 EQU 3 R04 EQU 4 R05 EQU 5 R06 EQU 6 R07 EQU 7 R08 EQU 8 R09 EQU 9 ALC$LOAD CSECT USING *,R11,R12 R11,R12=BASE REGISTERS STM R14,R12,12(R13) SAVE REGISTERS LR R11,R15 ADDRESSIBILITY LA R12,2048(0,R11) LA R12,2048(0,R12) LR R1,R13 SAVE SAVE AREA POINTER LA R13,SAVEAREA POINT TO MY SAVEAREA ST R13,8(0,R1) SET FORW CHAIN IN CALLERS SAREA ST R1,4(0,R13) SET BACK CHAIN IN MY SAVEAREA L R1,24(0,R1) REACQUIRE R1 AS IT CAME HERE L R9,0(R1) GET "PARM=" STUFF ST R9,ALC$ADR SAVE AS 1ST PARM PASSED B START DC C'*' PGMID DC CL8'ALC$LOAD' DC C'*' COMPDATE DC CL8'&SYSDATE' COMPTIME DC CL8'&SYSTIME' DS 0F SAVEAREA DC 18F'0' START EQU * OPEN (IPARM,INPUT),MODE=31 OPEN (OSTAT,OUTPUT),MODE=31 LA R6,ALC$ADR POINT TO 1ST LIST OF ADDRESS PARM$000 EQU * GET IPARM,PARM$REC MVC STAT$REC(1),=C' ' MVC STAT$REC+1(79),STAT$REC CLEAR OUTPUT RECORD MVC STAT$REC(8),PGMID MOVE PGMID TO OUTPUT REC CLC PARM$LIT,=C'PROGRAM : ' PROGRAM TO LOAD? BNE PARM$100 NO, CONTINUE MVC ALC$PGM,PARM$PGM SAVE PROGRAM MVC MSG2+5(8),PARM$PGM SAVE PROGRAM MVC STAT$REC+8(72),MSG2 PUT OSTAT,STAT$REC B PARM$000 GET NEXT RECORD PARM$100 EQU * CLC PARM$LIT,=C'TABLE : ' DO A GET MAIN FOR A TABLE BNE PARM$000 NO, THEN GET NEXT RECORD A R6,FIXEDLEN POINT TO NEXT ADDR SLOT * CALCULATE STORAGE REQUIRED FOR THIS TABLE MVC MSG1+7(5),PARM$LEN GET LEN OF TABLE MVC MSG1+15(6),PARM$PGM+2 GET NUM OF RECS IN TABLE MVC MSG1+25(19),EPAT GET EDIT PATTERN FOR LENGTH MVC MSG1+45(19),PARM$DSC GET DESC OF TABLE PACK W$CNT,PARM$PGM+1(7) GET NUMBER OF RECORDS PACK DBLEWORD,PARM$LEN GET LENGTH OF EACH ENTRY MP DBLEWORD,W$CNT LENGTH OF GETMAIN AREA ED MSG1+25(19),DBLEWORD SAVE LENGTH OF GETMAIN AREA MVC STAT$REC+8(72),MSG1 PUT OSTAT,STAT$REC CVB R2,DBLEWORD R2=LENGTH OF GETMAIN AREA GETMAIN RC,LV=(2),BNDRY=DBLWD,LOC=31 LTR R15,R15 GETMAIN RETURN GOOD? BZ *+4+2 YES--> CONTINUE DC H'0' NO---> FORCE OC4 ST R1,0(R6) SAVE ADDR OF THIS AREA B PARM$000 GET NEXT RECORD * PARM$999 EQU * CLOSE (IPARM,),MODE=31 CLOSE (OSTAT,),MODE=31 *================================================================== * LOAD AND EXECUTE PROGRAM SELECTED *================================================================== LA R2,ALC$PGM LOAD EPLOC=(2),LOADPT=ALC$LP LA R1,ALC$ADR GET ADDR OF PARMS (FOR LINKAGE L R15,ALC$LP GET LOADPOINT OF PROGRAM BALR R14,R15 $GOBACK EQU * L R13,4(0,R13) POINT BACK TO CALLERS SAVEAREA RETURN (14,12),,RC=0 SET RC=0 BR R14 GOBACK TO MOMMA EJECT LTORG ********************************************************************** * CONSTANTS,DSECTS * ********************************************************************** DS 0D DBLEWORD DS D W$LEN DS D W$CNT DS F W$LEN1 DS F FIXEDLEN DC F'4' ALC$PGM DS CL8 * PROGRAM TO LOAD ALC$LP DS F * LOADPOINT OF PGM TO LOAD ABNDCODE DC F'0' ALC$ADR DC F'0' * ADDRESS OF PARMS PASSED ALC$ADR1 DC F'0' * ADDRESS OF TABLE 1 ALC$ADR2 DC F'0' * ADDRESS OF TABLE 2 ALC$ADR3 DC F'0' * ADDRESS OF TABLE 3 ALC$ADR4 DC F'0' * ADDRESS OF TABLE 4 ALC$ADR5 DC F'0' * ADDRESS OF TABLE 5 ALC$ADR6 DC F'0' * ADDRESS OF TABLE 6 ALC$ADR7 DC F'0' * ADDRESS OF TABLE 7 ALC$ADR8 DC F'0' * ADDRESS OF TABLE 8 ALC$ADR9 DC F'0' * ADDRESS OF TABLE 9 ALC$ADRA DC F'0' * ADDRESS OF TABLE 10 ALC$ADRB DC F'0' * ADDRESS OF TABLE 11 ALC$ADRC DC F'0' * ADDRESS OF TABLE 12 ALC$ADRD DC F'0' * ADDRESS OF TABLE 13 ALC$ADRE DC F'0' * ADDRESS OF TABLE 14 ALC$ADRF DC F'0' * ADDRESS OF TABLE 15 * * B 1 2 3 4 5 6 7 8 9 A B C D E F EPAT DC X'402020202020206B2020206B2020206B202120' EPAT2 DC X'402020202120' EPAT3 DC X'40202120' MSG1 DC CL72' TBL L=XXXXX #=XXXXXX GM=XXXXXXXXXXXXXXXXXXX' MSG2 DC CL72' PGM=XXXXXXXX' STAT$REC DS CL80 PARM$REC DS 0CL80 PARM$LIT DS CL10 PARM$PGM DS CL8 DS CL1 PARM$LEN DS CL5 DS CL1 PARM$DSC DS CL40 DS CL15 EJECT DS 0F IPARM DCB DSORG=PS,MACRF=GM,RECFM=FB,DDNAME=IPARM,LRECL=80, X DCBE=ABV1,EODAD=PARM$999 ABV1 DCBE RMODE31=BUFF OSTAT DCB DSORG=PS,MACRF=PM,RECFM=FB,DDNAME=OSTAT,LRECL=80, X DCBE=ABV2 ABV2 DCBE RMODE31=BUFF EJECT ALC$PARM DSECT ALC$LEN DS H END