*AINDMFOIDIR -- DIRECT ACCESS OPEN, READ, CLOSE FOR DARCY 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLE FOIDIR -- OPEN DARCY FILE FOR INPUT 00020001 *A AUTHOR RALPH MCMILLAN 00030001 *A DESIGNER RALPH MCMILLAN 00040001 *A LANGUAGE S/370 ASSEMBLER 00050001 *A SYSTEM IBM 00060001 *A WRITTEN 2/28/89 (COPIED FROM FOSCDK) 00070001 * REVISED 00080000 *A 00090000 *A 00100000 *A CALL FOIDIR (DCBAD, LEN, ERROR, ECB) 00110003 *A 00120001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00130001 *A 00140001 *A IN DCBAD I4 ADDRESS OF BDAM DCB 00150001 *A OUT LEN I4 LENGTH OF EACH RECORD IN BYTES 00160004 *A OUT ERROR I4 ERROR CODE: 0 = OK; 1 = FILE DID NOT OPEN 00170003 *A IN/OUT ECB I4 OPTIONAL 8 WORD ARRAY FOR ECB FOR ASYNCH 00180001 *A I/O 00190001 *A 00200001 *A OPEN DARCY FILE FOR DIRECT ACCESS. FILE WILL HAVE PREVIOUSLY 00210001 *A BEEN CREATED BY SPARC PROCESS CRDA. LEN SHOULD BE THE SAME VALUE 00220001 *A USED IN CRDA WHEN CREATING THE FILE. 00230001 *A 00240000 *A THE FILE IS CREATED SEQUENTIALLY WITH FOCRDA. THEN IT CAN BE 00250001 *A ACCESSED DIRECTLY WITH FOIDIR, FORDIR, AND FOCDIR. 00260001 *A 00270000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 00280000 *A BDAM DA F DA (RIC,WIC) RF 00290000 *A 00300000 *AEND 00310000 SPACE 00320001 *TITLE FORDIR -- READ DARCY FILE 00330001 *A AUTHOR RALPH MCMILLAN 00340001 *A DESIGNER RALPH MCMILLAN 00350001 *A LANGUAGE S/370 ASSEMBLER 00360001 *A SYSTEM IBM 00370001 *A WRITTEN 2/28/89 (COPIED FROM FOSCDK) 00380001 * REVISED 00390001 *A 00400001 *A 00410001 *A CALL FORDIR (DCBAD, DA, DATA, ERROR, ECB) 00420003 *A 00430001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00440001 *A 00450001 *A IN DCBAD I4 ADDRESS OF BDAM DCB 00460001 *A IN/OUT DA I4 RECORD NUMBER IN FILE. INCREMENTED BY 00470001 *A 1 ON RETURN. 00480001 *A OUT DATA ANY OUTPUT RECORD READ FROM DISK 00490001 *A OUT ERROR I4 ERROR CODE: 00500003 *A 0 = OK 00510003 *A 1 = DCB NOT OPEN 00520003 *A 2 = I/O BUFFER NOT AVAILABLE. CHECK 00530003 *A BKBUFADD. 00540003 *A 3 = SHADOW DCB NOT FOUND. 00550003 *A 4 = INVALID DISK ADDRESS. 00560003 *A IN/OUT ECB I4 OPTIONAL 8 WORD ARRAY FOR ECB FOR ASYNCH 00570001 *A I/O 00580001 *A 00590000 *A 00600000 *A READ DARCY RECORD NUMBER DA AND STORE IN DATA. RECORD LENGTH IS 00610001 *A 'LEN' USED IN FOIDIR. A SECOND CALL IS REQUIRED TO COMPLETE THE 00620001 *A READ WHEN USING THE ASYNCH OPTIONS. 00630001 *A 00640001 *A THE FILE IS CREATED SEQUENTIALLY WITH FOCRDA. THEN IT CAN BE 00650001 *A ACCESSED DIRECTLY WITH FOIDIR, FORDIR, AND FOCDIR. 00660001 *A 00670001 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 00680001 *A BDAM DA F DA (RIC,WIC) RF 00690001 *A 00700000 *A USER ABEND CODES: 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 00710003 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 00720000 *AEND 00730000 SPACE 00740003 *TITLE FOCDIR -- CLOSE DARCY FILE 00750001 *A AUTHOR RALPH MCMILLAN 00760001 *A DESIGNER RALPH MCMILLAN 00770001 *A LANGUAGE S/370 ASSEMBLER 00780001 *A SYSTEM IBM 00790001 *A WRITTEN 2/28/89 (COPIED FROM FOSCDK) 00800001 * REVISED 00810001 *A 00820001 *A 00830001 *A CALL FOCDIR (DCBAD, ERROR, ECB) 00840003 *A 00850001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00860001 *A 00870001 *A IN DCBAD I4 ADDRESS OF BDAM DCB 00880001 *A OUT ERROR I4 ERROR CODE: 0 = OK; NO OTHER ERRORS. 00890003 *A IN/OUT ECB I4 OPTIONAL 8 WORD ARRAY FOR ECB FOR ASYNCH 00900001 *A I/O 00910001 *A 00920001 *A 00930000 *A CLOSE THE DARCY FILE. YOU MUST SPECIFY THE ECB TO RELEASE SPACE 00940001 *A ALLOCATED FOR ASYNCH I/O. 00950001 *A 00960001 *A THE FILE IS CREATED SEQUENTIALLY WITH FOCRDA. THEN IT CAN BE 00970001 *A ACCESSED DIRECTLY WITH FOIDIR, FORDIR, AND FOCDIR. 00980001 *A 00990001 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 01000001 *A BDAM DA F DA (RIC,WIC) RF 01010001 *AEND 01020000 EJECT 01030000 PRINT GEN D68 01040000 FOIDIR MENTRYPT 2,(FORDIR,FOCDIR,FOIDIRX) 01050000 * 01060000 EXTRN GETMN2 01070000 * 01080000 LR R12,R13 USE R12 AS BASE REGISTER 01090000 DROP R13 TO REDUCE COMPLICATIONS 01100000 USING SAVEAREA,R12 IN SYNAD EXIT. 01110000 USING IHADCB,R10 R10 = ADDRESS OF DATA CONTROC BLOCK. 01120000 LR R11,R1 01130000 ST R11,PARMLIST SAVE R11 FOR LATER USE 01140000 L R10,0(,R11) 01150000 L R10,0(,R10) 01160000 SPACE 01170000 **************** ADDRESSING MODE SWITCH ****************** EXT 01180000 FOIDIR AMODE ANY EXT 01190000 FOIDIR RMODE 24 EXT 01200000 B *(2) 01210000 B FORDIR$ 01220000 B FOCDIR$ 01230000 B FOIDIR$ 01240001 EJECT 01250000 ******************************************************************* 01260000 * INITIALIZE DIRECT(BDAM) DARCY FILE 01270000 * CALL FOIDIR (DCBAD, LENGTH, ERROR, ECB) 01280003 **************************************************************** 01290000 FOIDIR$ SR R1,R1 01300003 L R6,8(,R11) 01310003 ST R1,0(,R6) SET ERROR = 0 01320003 TM DCBOFLGS,X'10' OPEN? 01330003 BO RETURN 01340000 LA R3,BDAMERR ADDRESS OF BDAM SYNAD. 01380000 ST R3,DCBSYNAD STORE IN DCB. 01390000 TM DCBDSORG,DCBDSGDA D68 01400000 BZ FOIDIR$2 NOT DSORG=DA D68 01410000 TM DCBOPTCD,DCBOPTRB D68 01420000 BZ FOIDIR$2 REL BLK ADDR NOT SPEC D68 01430000 ** OBTAIN SHADOW ELEMENT TO BUILD SECOND DCB IN. D68 01440000 ** THIS DCB WILL BE OPEN FOR ABS ADDR TYPE BDAM. D68 01450000 GETMAIN RU,LV=MC99,SP=1 SHADOW ELM D68 01460000 LR R9,R1 D68 01470000 USING MCHAIND,R9 D68 01480000 L R1,MCHAINS FIRST PREV ALLOC ELM D68 01490000 ST R1,MCHAINP CHAIN IN D68 01500000 ST R9,MCHAINS THIS TO CURRENT PTR D68 01510000 ST R10,MCHAIN1 ORIG DCB TO SHADOW ELM D68 01520000 MVC MCHAIN2,0(R10) COPY DCB AND MOD IT D68 01530000 LA R9,MCHAIN2 COPYIED DCB ADDR D68 01540000 DROP R9 D68 01550000 NI DCBOPTCD-IHADCB(R9),X'FF'-DCBOPTRB CANCEL REL BLK D68 01560000 OI DCBOPTCD-IHADCB(R9),DCBOPTA TURN ON ABS D68 01570000 LA R11,FOIDXX2 01580000 LA R4,FOIDXX1 01590000 BSM R11,R4 SWITCH TO 24 BIT MODE 01600000 FOIDXX1 DS 0H 01610000 * 01620000 OPEN ((R9),INPUT) OPEN SHADOW DCB D68 01630001 FOIDIR$2 EQU * D68 01640000 OPEN ((R10),(INPUT)) 01650001 * 01660000 BSM 0,R11 SWITCH BACK TO INPUT MODE 01670000 FOIDXX2 DS 0H 01680000 TM DCBOFLGS,X'10' 01690000 BO FOIDXX3 01700004 LA R1,1 SET ERROR = 1 01710003 B ERET 01720003 * 01730000 FOIDXX3 L R11,PARMLIST 01740004 L R3,4(,R11) GET A(LENGTH) 01741004 LH R4,DCBBLKSI 01742004 ST R4,0(,R3) RETURN RECORD LENGTH 01743004 * 01744004 TM 8(R11),X'80' CHECK FOR A 4TH ARG 01750003 BO RETURN 01760001 * WE'VE GOT AN ECB, SO DO A GETMAIN FOR A BUFFER NEEDED FOR ASYNCH 01770000 LH R3,DCBBLKSI 01780000 GETMAIN RU,LV=(3),SP=1,LOC=BELOW 01790000 L R3,12(R11) GET THE ECB ARRAY ADDRESS 01800003 MVC 0(32,R3),ZEROS SET IT TO ZEROS AND THEN SAVE 01810000 ST R1,28(R3) THE GETMAIN ADDRESS IN IT 01820000 B RETURN 01830000 EJECT 01840000 **************************************************************** 01850000 * READ DIRECT FROM DARCY FILE 01860001 * CALL FORDIR (DCBAD, DA, DATA, ERROR, ECB) 01870003 **************************************************************** 01880000 FORDIR$ SR R1,R1 01890003 L R6,12(,R11) 01900003 ST R1,0(,R6) SET ERROR = 0 01910003 TM DCBOFLGS,X'10' OPEN? 01920003 BO READDIR 01930000 LA R1,1 SET ERROR = 1 01940003 B ERET 01950003 READDIR TM 12(R11),X'80' CHECK FOR A 5TH ARG 01960003 BNO AEADDIR GO TO ASYNCH VERSION 01970001 * WE DO NOT HAVE AN ECB SO GO NORMAL ROUTE 01980001 L R4,4(R11) A(DA) 01990000 L R2,0(R4) RECORD # 02000000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 02010000 L R3,8(R11) A(DATA) 02020000 LR R5,R2 02030000 BCTR R5,0 -1 02040000 ST R5,BLKREF SAVE DA - 1 02050000 LA R5,BLKREF+1 02060000 ST R3,COMPADD EXT 02070000 NI COMPADD,X'7F' EXT 02080000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 02090000 BL READBK11 IF NOT, GO ON. EXT 02100000 L R3,=V(BKBUFADD) GET BUFFER ADDRESS ADDRESS EXT 02110000 L R3,0(R3) GET BUFFER ADDRESS ADDRESS EXT 02120000 LTR R3,R3 EXT 02130000 BNZ READBK11 EXT 02140000 LA R1,2 SET ERROR = 2 02150003 B ERET 02160003 READBK11 DS 0H EXT 02170000 LA R11,FORDXX2 02180000 LA R8,FORDXX1 02190000 BSM R11,R8 CHANGE TO 24 BIT MODE 02200000 FORDXX1 DS 0H 02210000 * 02220000 READ BDAMRDEC,DI,(R10),(R3),'S',0,(R5) 02230000 ORG *-2 CANCEL BALR D68 02240000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 02250000 LR R5,R0 SAVE FOR LATER D68 02260000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 02270000 TM DCBRECFM,DCBRECTO D68 02280000 BO READDIR2 IT IS TRACKS O'FLOW D68 02290000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 02300000 READDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 02310000 LTR R15,R15 02320000 BNZ ERROR4 02330003 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 02340000 BAL R14,FINDS GET SHADOW DCB ADDR D68 02350000 B ERROR3 DID NOT GET-IF GOT RETS BELOW D68 02360003 READ BDAMRDEC,DI,(R9),,,,(R5),MF=E D68 02370000 CHECK BDAMRDEC 02380000 SPACE 02390000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 02400000 BL FORTRX99 IF NOT, DON'T DO MOVE EXT 02410000 ************* SWITCH MODES AND MOVE IN READ DATA ************* EXT 02420000 STM R4,R7,FORTRXRS SAVE REGS USED FOR MOVE EXT 02430000 L R4,FORTRX1 ADDRESS FOR MODE SWITCH EXT 02440000 BSM 0,R4 SWITCH TO 31 BIT MODE EXT 02450000 DS 0F EXT 02460000 FORTRX1 DC A(FORTRX2+X'80000000') EXT 02470000 FORTRXRS DC 4F'0' EXT 02480000 FORTRX2 DS 0H EXT 02490000 L R4,COMPADD LOAD "OLD R3" EXT 02500000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 02510000 N R5,=X'0000FFFF' EXT 02520000 LR R7,R5 EXT 02530000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 02540000 MVCL R4,R6 MOVE IN THE DATA EXT 02550000 LM R4,R7,FORTRXRS RESTORE REGS USED FOR MOVE EXT 02560000 FORTRX99 DS 0H EXT 02570000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 02580000 FORDXX2 DS 0H 02590000 SPACE 02600000 LA R2,1(R2) DA + 1 02610000 ST R2,0(R4) 02620000 ** 02630000 B RETURN 02640000 * 02650000 ERROR3 LA R1,3 SET ERROR = 3 02660003 B ERET 02670003 ERROR4 LA R1,4 SET ERROR = 4 02680003 B ERET 02690003 EJECT 02700000 **************************************************************** 02710000 * READ DIRECT FROM DARCY FILE, ASYNCH VERSION 02720001 * CALL FORDIR (DCBAD, DA, DATA, ERROR, ECB) 02730003 **************************************************************** 02740000 * GET AND SAVE THE WAIT FLAG 02750000 AEADDIR L R4,16(R11) 02760003 MVC WAITFLAG(4),8(R4) 02770000 ST R4,ECBADDR 02780000 * 02790000 L R4,4(R11) A(DA) 02800000 L R2,0(R4) RECORD # 02810000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 02820000 L R3,8(R11) A(DATA) 02830000 LR R5,R2 02840000 BCTR R5,0 -1 02850000 ST R5,BLKREF SAVE DA - 1 02860000 LA R5,BLKREF+1 02870000 ST R3,COMPADD EXT 02880000 L R3,ECBADDR GET ECB ARRAY ADDRESS 02890000 L R3,28(R3) GET BUFFER ADDRESS FROM ECB 02900000 LTR R3,R3 EXT 02910000 BNZ AEADBK11 EXT 02920000 LA R1,1 SET ERROR = 1 02930003 B ERET 02940003 AEADBK11 DS 0H EXT 02950000 LA R11,AORDXX2 02960000 LA R8,AORDXX1 02970000 BSM R11,R8 CHANGE TO 24 BIT MODE 02980000 AORDXX1 DS 0H 02990000 * 03000000 * SEE IF THIS IS A WAIT CALL 03010000 CLC WAITFLAG,=F'0' 03020000 BNE AORWAIT 03030000 MVC WAITFLAG(4),=F'1' 03040000 * 03050000 READ ADAMRDEC,DI,(R10),(R3),'S',0,(R5) 03060000 ORG *-2 CANCEL BALR D68 03070000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 03080000 LR R5,R0 SAVE FOR LATER D68 03090000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 03100000 TM DCBRECFM,DCBRECTO D68 03110000 BO AEADDIR2 IT IS TRACKS O'FLOW D68 03120000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 03130000 AEADDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 03140000 LTR R15,R15 03150000 BNZ ERROR4 03160003 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 03170000 BAL R14,FINDS GET SHADOW DCB ADDR D68 03180000 B ERROR3 DID NOT GET-IF GOT RETS BELOW D68 03190003 L R1,ECBADDR SAVE THE ECB IN THE 4TH ARG 03200000 LA R3,ADAMRDEC ARRAY FOR USE IN THE WAIT CALL 03210000 MVC 0(28,R1),0(R3) 03220000 READ (1),DI,(R9),,,,(R5),MF=E D68 03230000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 03240000 * 03250000 ********** WAIT CALL **************************************** 03260000 AORWAIT L 1,ECBADDR 03270000 MVC WAITFLAG(4),=F'0' CLEAR THE WAIT FLAG 03280000 CHECK (1) WAIT FOR THE IO TO COMPLETE 03290000 * 03300000 * FOR ASYNCH IO WE ALWAYS USE A BUFFER AREA 03310000 ************* SWITCH MODES AND MOVE IN READ DATA ************* EXT 03320000 STM R4,R7,AORTRXRS SAVE REGS USED FOR MOVE EXT 03330000 L R4,AORTRX1 ADDRESS FOR MODE SWITCH EXT 03340000 BSM 0,R4 SWITCH TO 31 BIT MODE EXT 03350000 DS 0F EXT 03360000 AORTRX1 DC A(AORTRX2+X'80000000') EXT 03370000 AORTRXRS DC 4F'0' EXT 03380000 AORTRX2 DS 0H EXT 03390000 L R4,COMPADD LOAD "OLD R3" EXT 03400000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 03410000 N R5,=X'0000FFFF' EXT 03420000 LR R7,R5 EXT 03430000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 03440000 MVCL R4,R6 MOVE IN THE DATA EXT 03450000 LM R4,R7,AORTRXRS RESTORE REGS USED FOR MOVE EXT 03460000 AORTRX99 DS 0H EXT 03470000 MVC 8(4,R1),=F'0' CLEAR THE WAIT FLAG 03480000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 03490000 AORDXX2 DS 0H 03500000 * SEE IF THIS WAS A WAIT CALL 03510000 CLC WAITFLAG,=F'0' 03520000 BE RETURN 03530000 * 03540000 LA R2,1(R2) DA + 1 03550000 ST R2,0(R4) 03560000 ** 03570000 B RETURN 03580000 EJECT 03590000 ** SUBR TO LOCATE SHADOW DCB FROM DCB SUPPLIED IN REG 10 D68 03600000 ** RETURN SHADOW DCB IN REG 9,SHADOW ELM PTR IN REG 1 D68 03610000 ** PREV SHADOW PTR IN REG 15. D68 03620000 ** RET AT 0(R14) IF NOT FOUND AND 4(R14) IF FOUND. D68 03630000 * D68 03640000 FINDS LA R15,MCHAINS INIT PREV PTR TO ORG D68 03650000 FINDS2 ICM R1,15,MCHAINP-MCHAIND(R15) NEXT ELM D68 03660000 USING MCHAIND,R1 D68 03670000 BZR R14 QUIT IF END CHAIN D68 03680000 C R10,MCHAIN1 D68 03690000 LA R9,MCHAIN2 DCB ADDR IN ELM D68 03700000 BE 4(R14) RETURN IF CORRECT ELM D68 03710000 LR R15,R1 CURRENT TO PREV D68 03720000 B FINDS2 TRY AGAIN D68 03730000 DROP R1 D68 03740000 EJECT 03750000 *************************************************************** 03760000 * CLOSE DARCY FILE 03770001 * CALL FOCDIR (DCBAD, ERROR, ECB) 03780003 *************************************************************** 03790000 FOCDIR$ SR R1,R1 03800003 L R6,4(,R11) 03810003 ST R1,0(,R6) SET ERROR = 0 03820003 TM DCBOFLGS,X'10' OPEN? 03830003 BZ RETURN 03840000 LA R11,RETURN 03850001 LA R4,FOCDXX1 SWITCH TO 24 BIT MODE AND 03860001 BSM R11,R4 SAVE INPUT MODE 03870000 FOCDXX1 DS 0H 03880001 * 03890000 LH R3,DCBBLKSI GET LENGTH OF DATA BUFFER 03900000 STH R3,SIZEHOLD SAVE LENGTH OF DATA BUFFER 03910000 CLOSE ((R10)) 03920000 **LOCATE SHADOW DCB ELM AND RELASE IT. D68 03930000 BAL R14,FINDS LOCATE SHADOW ELM D68 03940000 B FOCDXX3 NOT ONE IF RET HERE D68 03950001 L R0,MCHAINP-MCHAIND(R1) NEXT PTR IN FOUND ELM D68 03960000 ST R0,MCHAINP-MCHAIND(R15) DECHAIN D68 03970000 LR R7,R1 D68 03980000 CLOSE ((R9)) CLOSE SHADOW DCB D68 03990000 FREEMAIN RU,LV=MC99,A=(R7),SP=1 REL SHADOW ELM D68 04000000 FOCDXX3 L R5,PARMLIST 04010001 TM 4(R5),X'80' CHECK FOR A 3RD ARG 04020003 BO FOCDXX2 04030001 * WE'VE GOT AN ECB, SO DO A FREEMAIN ON THE BUFFER NEEDED FOR ASYNCH 04040000 L R3,4(R5) 04050000 LH R3,6(R3) 04060000 L R4,4(R5) 04070000 L R4,28(R4) 04080000 LH R3,SIZEHOLD GET LENGTH OF DATA BUFFER 04090000 FREEMAIN RU,LV=(3),A=(R4),SP=1 04100000 L R3,4(R5) 04110000 MVC 0(32,R3),ZEROS CLEAR THE ECB ARRAY 04120000 ST 15,0(R3) 04130000 FOCDXX2 BSM 0,R11 SWITCH BACK TO INPUT MODE & RETURN 04140001 SPACE 04150000 *************************************************************** 04160000 * 04170000 * SYNAD EXIT FOR INPUT/OUTPUT ERRORS. 04180000 * 04190000 *************************************************************** 04200000 BDAMERR SYNADAF ACSMETH=BDAM 04210000 ST R14,SYNADR14 SAVE R14 FOR RETURN. 04220001 LA R1,8(,R1) SKIP FIRST 8 BYTES OF SYNADAF MESSAGE. 04230000 ST R1,SYNADMSA ESTABLISH PARAMETER LIST FOR FOPERR. 04240000 LA R1,SYNADMSA 04250000 L R15,=V(FOPERR) CALL FOPERR TO PRINT SYNADAF MESSAGE. 04260000 BALR R14,R15 04270000 SYNADRLS RELEASE SYNAD SAVE AREA. 04280000 L R14,SYNADR14 RESTORE R14 TO LEAVE SYNAD EXIT. 04290000 ABEND 449 04300000 SPACE 1 04310000 ERET ST R1,0(,R6) SET ERROR CODE. R6=ADDR OF ERROR. 04320003 SPACE 1 04330003 RETURN DS 0H EXT 04340000 STDRET 04350000 SPACE 04360000 R0 EQU 0 04370000 R1 EQU 1 04380000 R2 EQU 2 04390000 R3 EQU 3 04400000 R4 EQU 4 04410000 R5 EQU 5 04420000 R6 EQU 6 D68 04430000 R7 EQU 7 D68 04440000 R8 EQU 8 D68 04450000 R9 EQU 9 D68 04460000 R10 EQU 10 04470000 R11 EQU 11 04480000 R12 EQU 12 04490000 R13 EQU 13 04500000 R14 EQU 14 04510000 R15 EQU 15 04520000 WAITFLAG DC F'0' 04530000 ECBADDR DS F ADDRESS OF ECB AS PASSED IN 04540000 PARMLIST DS F HOLD AREA FOR R11 04550000 ZEROS DC 8F'0' 04560000 SIZEHOLD DS F 04570000 BLKREF DS F 04580000 SYNADMSA DS F 04590000 SYNADRN DC A(SYNDSKA) ADDRESS OF RCD # FOR ERROR MSG 04600000 SYNDSKA DC F'0' RELATIVE RCD # FOR ERROR MSG 04610000 SYNADR14 DS F 04620000 BLKREF2 DC D'0' LOC TO PUT MBBCCHHR D68 04630000 THELINE DC F'16777215' EXT 04640000 COMPADD DC F'0' EXT 04650000 LTORG , D68 04660000 PRINT NOGEN D68 04670000 MCHAINS DC A(0) ORIGIN OF SHADOW ELMS D68 04680000 DCBD DSORG=DA,DEVD=DA 04690000 ORG , D68 04700000 DCBL99 EQU *-IHADCB D68 04710000 ** DSECT TO MAP SHADOW ELM D68 04720000 MCHAIND DSECT D68 04730000 MCHAINP DS A NEXT ELM D68 04740000 MCHAIN1 DS A ADDR DCB SUPPLIED BY CALLER OF FOIDIR D68 04750000 MCHAIN2 DS XL(DCBL99) SHADOW DCB D68 04760000 MC99 EQU *-MCHAIND LENGTH ELM D68 04770000 END 04780000