FOAPR TITLE ' FOAPR -- REGION S#00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** IZES FOR ARRAY PROCESSOR SAVED FOR ANALYSIS.' 00020000 *TITLEFOAPR -- REGION SIZES FOR ARRAY PROCESSOR SAVED FOR ANALYSIS 00030001 *A AUTHOR/DESIGNER FRANCIS COLLINS 00040000 *A LANGUAGE S/370 ASSEMBLER F 00050000 *A WRITTEN 5-22-81 ADAPTED FROM FOACCT. 00060000 *A 00070000 *A REVISED 7/24/85 RSK. 'CAPPED' FOR EXTENDED ADDRESSING. 00080000 *A CHANGES ARE MARKED BY 'EXT'. 00090001 *A 00100001 *A CALL FOAPR (RECORD) 00110000 *A INPUT RECORD = RECORD TO BE WRITTEN. 00120000 *A 00130000 *A 00140000 *A DESCRIPTION OF FILE FOR RECORDING APR REGION SIZE, ETC. 00150000 *A DDNAME = SPARCAPR 00160000 *A DSNAME = DBG.SPARC.APR 00170000 *A 00180000 *A 00190000 *A THIS PROGRAM PERFORMS THE FOLLOWING OPERATIONS: 00200000 *A 00210000 *A 1. READ THE JOB FILE CONTROL BLOCK. MODIFY THE JFCB TO 00220000 *A CHANGE THE DISPOSITION FROM SHR TO MOD, SO THAT THE 00230000 *A NEW RECORD WILL BE ADDED AT THE END OF THE FILE. 00240000 *A 00250000 *A 2. CHECK FOR PRESENCE OF THE DDNAME. IF ABSENT, RETURN WITH 00260000 *A NO OPERATION PERFORMED. 00270000 *A 00280000 *A 3. ENQUE ON THE NAMES SPARCAPR AND DBG.SPARC.APR. 00290000 *A 00300000 *A 4. OPEN THE FILE. 00310000 *A 00320000 *A 5. WRITE THE RECORD. 00330000 *A BASIC SEQUENTIAL ASSESS METHOD (BSAM). 00340000 *A 00350000 *A 6. CLOSE THE FILE. 00360000 *A STATUS AUTOMATICALLY REVERTS TO SHR. 00370000 *A 00380000 *A 7. DEQUE ON THE NAMES IN (3). THIS SHOULD RELEASE THE FILE. 00390000 *A 00400000 * NOTE: THIS PROGRAM IS PATTERNED AFTER FOACCT WRITTEN BY 00410000 * FRANCIS COLLINS 08-10-75. 00420000 * 00430000 EJECT 00440000 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00450000 R2 EQU 2 ADDRESS OF RECORD TO BE WRITTEN. 00460000 R3 EQU 3 00470001 R4 EQU 4 00480001 R5 EQU 5 LENGTH OF DD-ENTRY IN TASK INPUT/OUTPUT TABLE. 00490000 R6 EQU 6 ADDRESS OF DD-ENTRY IN TAST INPUT/OUTPUT TABLE. 00500000 R7 EQU 7 00510000 R8 EQU 8 ADDRESS OF QNAME PARAMETER FOR ENQUE AND DEQUE. 00520000 R9 EQU 9 ADDRESS OF RNAME PARAMETER FOR ENQUE AND DEQUE. 00530000 R10 EQU 10 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 00540000 R11 EQU 11 ADDRESS OF DATA CONTROL BLOCK. 00550000 R12 EQU 12 BASE REGISTER = ADDRESS OF FOAPR. 00560000 R13 EQU 13 00570000 R14 EQU 14 00580000 R15 EQU 15 00590000 SPACE 00600000 B0T14 EQU B'10110111' USED TO TURN OFF BITS 1 AND 4. 00610000 B1T0 EQU B'10000000' USED TO TURN ON BIT 0. 00620000 B1T4 EQU B'00001000' USED TO TURN ON BIT 4. 00630000 SPACE 2 00640000 FOAPR CSECT 00650000 USING *,R15 00660000 B START 00670000 DC X'05',C'FOAPR ' 00680000 DROP R15 00690000 START STM R14,R12,12(R13) SAVE REGISTERS 00700000 LR R12,R15 00710000 USING FOAPR,R12 ESTABLISH REG 12 AS BASE 00720000 LA R11,SAVE 00730000 ST R11,8(R13) CHAIN SAVE AREA 00740000 ST R13,SAVE+4 POINTER TO OLD SAVE AREA 00750000 LR R13,R11 POINTER TO NEW SAVE AREA 00760000 **************** ADDRESSING MODE SWITCH ****************** EXT 00770000 FOAPR AMODE ANY EXT 00780000 FOAPR RMODE 24 EXT 00790000 LA R4,FONEXT EXT 00800000 LA R5,RETURNIT EXT 00810000 BSM R5,R4 EXT 00820000 RETADD DC F'0' EXT 00830000 FONEXT DS 0H EXT 00840000 ST R5,RETADD EXT 00850000 SPACE 00860000 LA R11,DCB DCB ADDRESS. 00870000 USING IHADCB,R11 00880000 LA R10,JFCBAREA JFCB ADDRESS. 00890000 LA R9,RNAME 'SPARCAPR' 00900000 LA R8,QNAME 'DBG.SPARC.APR' 00910000 SPACE 00920000 USING JFCB,R10 00930000 SPACE 00940000 L R2,0(R1) OBTAIN INPUT PARAMETER. 00950000 LA R2,0(R2) CLEAR FIRST BYTE OF REGISTER. 00960000 SPACE 00970000 RDJFCB ((R11),OUTPUT) CHANGE DISPOSITION FROM SHARE TO MOD. 00980000 OI JFCBTSDM,B1T4 STOP JFCB REWRITE. 00990000 OI JFCBIND2,B1T0 DISP .EQ. MOD. 01000000 NI JFCBIND2,B0T14 TURN OFF JFCSHARE BIT AND JFCOLD BIT. 01010000 EJECT 01020000 EXTRACT TIOTAD,FIELDS=TIOT SEARCH TIOT FOR DDNAME. 01030000 L R6,TIOTAD R6 = TIOT ADDRESS. 01040000 LA R6,24(,R6) R6 = ADDRESS OF FIRST DD-ENTRY IN TIOT. 01050000 FINDDD CLC DDNAME,4(R6) IS DDNAME = SPARCAPR? 01060000 BE ENQUE YES, CONTINUE WITH PROGRAM. 01070000 SR R5,R5 NO, GET LENGTH OF DD-ENTRY, 01080000 IC R5,0(,R6) INDEX TO NEXT DD-ENTRY, 01090000 AR R6,R5 CHECK FOR END OF TIOT, 01100000 CLC 0(4,R6),=F'0' IF NOT END OF TIOT, 01110000 BNE FINDDD LOOP TO TEST NEXT DD-ENTRY. 01120000 B RETURN DDNAME MISSING, RETURN. 01130000 SPACE 01140000 ENQUE ENQ ((R8),(R9),E,13,SYSTEMS) 01150000 SPACE 01160000 OPEN ((R11),OUTPUT),TYPE=J 01170000 EJECT 01180000 WRITE DECB,SF,(R11),(R2) WRITE THE RECORD 01190000 LA R1,DECB 01200000 CHECK (R1) 01210000 SPACE 01220000 CLOSE ((R11)) 01230000 DEQ ((R8),(R9),13,SYSTEMS) 01240000 SPACE 01250000 RETURN DS 0H 01260000 **************** ADDRESSING RETURN ****************** EXT 01270000 L R5,RETADD EXT 01280000 BSM 0,R5 EXT 01290000 RETURNIT DS 0H EXT 01300000 L R13,SAVE+4 RESTORE POINTER TO SAVE AREA 01310000 LM R14,R12,12(R13) RESTORE REGISTERS 01320000 SR R15,R15 ZERO RETURN CODE 01330000 BR R14 RETURN 01340000 EJECT 01350000 SYNEXIT SYNADAF ACSMETH=BSAM 01360000 ST R14,SYNADR14 SAVE R14 FOR RETURN 01370000 LA R1,8(R1) SKIP OVER FIRST 8 BYTES 01380000 ST R1,SYNADMSA EXT. PARAMETER LIST 01390000 LA R1,SYNADMSA 01400000 L R15,=V(FOPERR) CALL FOPERR 01410000 BALR R14,R15 01420000 SYNADRLS RELEASE SYNAD SAVE AREA 01430000 L R14,SYNADR14 RESTORE R14 TO LEAVE SYNAD EXIT 01440000 ABEND 404 01450000 DS 0F 01460000 JFCBPNTR DC X'87',AL3(JFCBAREA) 01470000 JFCBAREA DC 176X'0' 01480000 DDNAME DC CL8'SPARCAPR' 01490000 QNAME DC CL8'SPARCAPR' 01500000 RNAME DC CL13'DBG.SPARC.APR' 01510000 TIOTAD DC F'0' 01520000 SAVE DC 18F'0' 01530000 SYNADMSA DS F 01540000 SYNADRN DC A(SYNDSKA) ADDRESS OF RCD # FOR ERROR MSG 01550000 SYNDSKA DC F'0' RCD # FOR FOPERR ERROR PRINT ROUTINE 01560000 SYNADR14 DS F 01570000 PRINT NOGEN 01580000 DCB DCB DDNAME=SPARCAPR, X01590000 DSORG=PS, X01600000 SYNAD=SYNEXIT, X01610000 EXLST=JFCBPNTR, X01620000 MACRF=(WC) 01630000 LTORG 01640000 JFCB DSECT 01650000 ORG JFCB+52 01660000 JFCBTSDM DS BL1 01670000 ORG JFCB+87 01680000 JFCBIND2 DS BL1 01690000 DCBD DSORG=PS,DEVD=DA 01700000 END 01710000