FOACCT TITLE ' FOACCT -- ACCOUNTI#00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** NG RECORD--WRITE TO DBG.SPARC.ACCOUNT FILE.' 00020000 *TITLEFOACCT -- ACCOUNTING RECORD, WRITE TO DBG.SPARC.ACCOUNT FILE 00030000 *A AUTHOR/DESIGNER FRANCIS COLLINS 00040000 *A LANGUAGE S/370 ASSEMBLER F 00050000 *A SYSTEM IBM (SEE CRAY) 00060000 *A WRITTEN 8-10-75 00070000 * REVISED 2--3-76 FAC. REMOVE DEBUG STM, 00080000 * INITIALIZE SAVE AREA TO ZEROS, 00090000 * CHANGE MACRF TO WC. (PAT BURGESS). 00100000 * REVISED 4-15-77 FAC. CHANGE ENQUE TO RESERVE. 00110000 * CHANGE DEQUE CORRESPONDINGLY. 00120000 * REVISED 7-18-79 FAC. RESERVE BEFORE OPEN, DEQUE AFTER CLOSE. 00130000 * REVISED 4-27-83 CMP. CHANGE RESERVE TO ENQ & USE EXTEND OPTION 00140000 * REVISED 7-15-85 RSK. 'CAPPED' TO USE 24 BIT ADDRESSING EVEN 00150000 * WHEN CALLED BY A 31 BIT MAIN. CHANGES 00160001 * MARKED BY 'EXT'. 00170001 *A 00180000 *A 00190000 *A CALL FOACCT (ACCTDW) 00200000 *A INPUT ACCTDW = ACCOUNTING RECORD TO BE WRITTEN. R8 00210000 *A 00220000 *A 00230000 *A DESCRIPTION OF ACCOUNTING FILE. 00240000 *A DDNAME = SPARCACC 00250000 *A DSNAME = DBG.SPARC.ACCOUNT 00260000 *A DSORG = PS (PHYSICAL SEQUENTIAL) 00270000 *A RECFM = F (FIXED) 00280000 *A LRECL = 164 BYTES 00290000 *A 00300000 *A DESCRIPTION OF ACCOUNTING RECORD--SEE CSACCT. 00310000 *A 00320000 *A THIS PROGRAM PERFORMS THE FOLLOWING OPERATIONS: 00330000 *A 00340000 *A 1. ENQUE THE NAMES 'SPARACC' AND 'DBG.SPARACC.' 00350000 *A 00360000 *A 2. OPEN THE FILE, WRITE THE RECORD, AND CLOSE THE FILE. 00370000 *A BASIC SEQUENTIAL ASSESS METHOD (BSAM). 00380000 *A STATUS AUTOMATICALLY REVERTS TO SHR. 00390000 *A 00400000 *A 3. DEQUE ON THE NAMES IN (1). 00410000 * 00420000 EJECT 00430000 FOACCT CSECT 00440000 R0 EQU 0 00450000 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00460000 R2 EQU 2 ADDRESS OF ACCTDW--RECORD TO BE WRITTEN. 00470000 R3 EQU 3 00480000 R4 EQU 4 00490000 R5 EQU 5 LENGTH OF DD-ENTRY IN TASK INPUT/OUTPUT TABLE. 00500000 R6 EQU 6 ADDRESS OF DD-ENTRY IN TAST INPUT/OUTPUT TABLE. 00510000 R7 EQU 7 ADDRESS OF ADDRESS OF UNIT CONTROL BLOCK. 00520000 R8 EQU 8 ADDRESS OF QNAME PARAMETER FOR ENQUE AND DEQUE. 00530000 R9 EQU 9 ADDRESS OF RNAME PARAMETER FOR ENQUE AND DEQUE. 00540000 R10 EQU 10 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 00550000 R11 EQU 11 ADDRESS OF DATA CONTROL BLOCK. 00560000 R12 EQU 12 BASE REGISTER = ADDRESS OF FOACCT. 00570000 R13 EQU 13 00580000 R14 EQU 14 00590000 R15 EQU 15 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 * 00640000 USING *,R15 00650000 B START 00660000 DC X'06',C'FOACCT ' 00670000 START STM R14,R12,12(R13) 00680000 ST R13,SAVE+4 00690000 LA R12,SAVE 00700000 ST R12,8(,R13) 00710000 LR R13,R12 00720000 SPACE 00730000 LR R12,R15 BASE REGISTER. 00740000 LA R11,DCB DCB ADDRESS. 00750000 LA R10,JFCBAREA JFCB ADDRESS. 00760000 LA R9,RNAME 'SPARCACC' 00770000 LA R8,QNAME 'DBG.SPARCACC' 00780000 **************** ADDRESSING MODE SWITCH ****************** EXT 00790001 FOACCT AMODE ANY EXT 00800001 FOACCT RMODE 24 EXT 00810001 LA R4,FONEXT EXT 00820001 LA R5,RETURNIT EXT 00830001 BSM R5,R4 EXT 00840001 FONEXT DS 0H EXT 00850001 ST R5,RETADD EXT 00860001 **************** ADDRESSING MODE SWITCH ****************** EXT 00870001 DROP R15 00880000 USING FOACCT,R12 00890000 USING JFCB,R10 00900000 SPACE 00910000 L R2,0(,R1) ADDRESS OF RECORD TO BE WRITTEN. 00920000 LA R2,0(,R2) CLEAR FIRST BYTE OF REGISTER. 00930000 SPACE 00940000 * *STM R14,R12,SAVE+12 SAVE REGISTERS FOR DEBUGGING. 00950000 EJECT 00960000 ENQ ((R8),(R9),E,12,SYSTEMS) 00970000 EJECT 00980000 OPEN ((R11),EXTEND) 00990000 SPACE 01000000 WRITE DECB,SF,(R11),(R2) 01010000 SPACE 01020000 LA R1,DECB 01030000 CHECK (1) 01040000 CLOSE ((R11)) 01050000 SPACE 01060000 DEQ ((R8),(R9),12,SYSTEMS) 01070000 SPACE 01080000 L R5,RETADD EXT 01090001 BSM 0,R5 EXT 01100001 RETURNIT DS 0H EXT 01110001 SPACE 01120000 L R13,SAVE+4 01130000 LM R14,R12,12(R13) 01140000 SR R15,R15 01150000 BR R14 01160000 EJECT 01170000 DS 0F 01180000 RETADD DC F'0' 01190000 JFCBPNTR DC X'87',AL3(JFCBAREA) 01200000 JFCBAREA DC 176X'0' 01210000 SPACE 01220000 DDNAME DC CL8'SPARCACC' 01230000 QNAME DC CL8'SPARCACC' 01240000 RNAME DC CL12'DBG.SPARCACC' 01250000 TIOTAD DC F'0' 01260000 SPACE 01270000 SAVE DC 18F'0' 01280000 PRINT NOGEN 01290000 DCB DCB DDNAME=SPARCACC, -01300000 DSORG=PS, -01310000 EXLST=JFCBPNTR, -01320000 MACRF=(WC) BSAM. 01330000 SPACE 01340000 JFCB DSECT 01350000 ORG JFCB+52 01360000 JFCBTSDM DS BL1 01370000 ORG JFCB+87 01380000 JFCBIND2 DS BL1 01390000 SPACE 01400000 END 01410000