TITLE 'ICATS FAKE WRITE-TO-THE-UTS ROUTINE' FAK00010
*********************************************************************** FAK00020
* * FAK00030
* MODULE NAME = FAKE UTS WRITE * FAK00040
* * FAK00050
* FUNCTION = SIMULATE A WRITE TO THE UTS MACHINE BY TAKING * FAK00060
* DATA AND WRITING IT TO THE CMS FILE ICATS OUTDATA A. * FAK00070
* THIS ROUTINE GETS EXECUTED INSTEAD OF THE REAL * FAK00080
* UTS I/O ROUTINE WHEN A FAKE UTS INTERRUPT HAS * FAK00090
* INITIATED THIS REQUEST (USED FOR DEBUGGING). * FAK00100
* * FAK00110
* ENTRY POINTS = FAKEWRIT * FAK00120
* * FAK00130
* LINKAGE = SOME ROUTINE DECIDES TO WRITE SOMETHING TO THE UTS, * FAK00140
* BUT THIS REQUEST DIDN'T COME FROM A REAL UTS, IT * FAK00150
* CAME FROM A FAKE INTERRUPT. THEREFORE, TAKE THIS * FAK00160
* DATA HE'S WRITING AND WRITE IT TO A CMS FILE. * FAK00170
* THE CALLER DID THIS * FAK00180
* LA R0,XXX BUFFER LENGTH * FAK00190
* LA R1,BUFFER BUFFER ADDRESS * FAK00200
* L R15,AWRITUTS * FAK00210
* BALR R14,R15 * FAK00220
* TO GET TO THE UTS I/O ROUTINE AND THE UTS I/O * FAK00230
* ROUTINE DETERMINED THIS WAS A FAKE INTERRUPT, SO * FAK00240
* IT DID THIS * FAK00250
* L R15,FAKEWRIT * FAK00260
* BALR R14,R15 * FAK00270
* TO GET TO ME. * FAK00280
* * FAK00290
* REGISTER CONTENTS UPON ENTRY = * FAK00300
* R0 = THE LENGTH OF THE INPUT BUFFER. * FAK00310
* R1 = THE BUFFER ADDRESS. * FAK00320
* R2 = POINTS TO THE ICATS COMMON DATA AREA AS ALWAYS. * FAK00330
* R14 = RETURN ADDRESS BACK TO THE UTS I/O ROUTINE. * FAK00340
* R15 = ADDRESS OF THIS SUBROUTINE (USED FOR BASE REG). * FAK00350
* * FAK00360
* REGISTER CONTENTS UPON EXIT = * FAK00370
* R15 = 0 = EVERYTHING WENT OK. * FAK00380
* OR R15 = 4 = WRITE ERROR. PROBABLY A-DISK IS READ ONLY. * FAK00390
* * FAK00400
* REGISTER USAGE: * FAK00410
* R0 = FREE * FAK00420
* R1 = FREE * FAK00430
* R2 = ICATS COMMON DATA AREA BASE REGISTER (ICDATA) * FAK00440
* R3-R6 = FREE * FAK00450
* R7 = BUFFER ADDRESS LENGTH. AMOUNT OF DATA LEFT TO WRITE. * FAK00460
* R8 = BUFFER ADDRESS POINTER. START OF CURRENT RECORD. * FAK00470
* R9 = FREE * FAK00480
* R10 = USED TEMPORARILY TO HOLD THE RETURN CODE * FAK00490
* R11 = BASE REGISTER FOR THIS ROUTINE * FAK00500
* R12-R13 = FREE * FAK00510
* R14 = RETURN ADDRESS FOR WHEN I CALL SUBROUTINES * FAK00520
* R15 = SUBROUTINE ADDRESS * FAK00530
* * FAK00540
* MODULE LOGIC = * FAK00550
* I) XXXXXX * FAK00560
* 1) XXXXXX * FAK00570
* A) XXXXXX * FAK00580
* B) XXXXXX * FAK00590
* C) XXXXXX * FAK00600
* * FAK00610
* NORMAL EXIT = * FAK00620
* R15 = 0 * FAK00630
* * FAK00640
* EXTERNAL REFERENCES = NONE * FAK00650
* * FAK00660
* CONTROL BLOCKS = ICDATA (ICATS COMMON DATA AREA) * FAK00670
* * FAK00680
* NON-STANDARD MACROS (FOUND IN ICATS MACLIB) * FAK00690
* ICDATA = ICATS COMMON DATA AREA DSECT. * FAK00700
* * FAK00710
* CHANGE ACTIVITY * FAK00720
* DATE NAME REASON FOR CHANGE * FAK00730
* 04/21/83 RICK JASPER BROKEN AWAY FROM ICATS MAINLINE INTO * FAK00740
* SEPARATE SUBROUTINE * FAK00750
* * FAK00760
*********************************************************************** FAK00770
EJECT FAK00780
PRINT GEN,NODATA FAK00790
FAKEWRIT CSECT FAK00800
USING ICDATA,R2 ADDRESS ICATS COMMON DATA AREA FAK00810
USING FAKEWRIT,R15 USE R15 FOR NEXT INSTRUCTION ONLY FAK00820
STM R0,R14,UTSIOREG SAVE CALLERS REGISTERS FAK00830
DROP R15 FAK00840
USING FAKEWRIT,R11 USE R11 FOR THIS ROUTINE'S BASE REG FAK00850
LR R11,R15 SWITCH BASE REGISTER TO R11 FAK00860
LTR R0,R0 INSURE POSITIVE BUFFER LENGTH FAK00870
BNP WRITBAD0 GIVE AN ERROR IF INCORRECT FAK00880
LR R7,R0 SAVE BUFFER LENGTH FAK00890
LR R8,R1 SAVE BUFFER ADDRESS FAK00900
FSERASE 'ICATS OUTDATA A' FAK00910
FSOPEN 'ICATS OUTDATA A',RECFM=F,BSIZE=64 FAK00920
* START WRITING THE DATA OUT 64 BYTES AT A TIME UNTIL END OF DATA FAK00930
WRITWRIT C R7,=F'64' IS # BYTES LEFT < LRECL ?? FAK00940
BNL WRITCONA NO, CONTINUE ON FAK00950
LR R15,R8 IF LAST OUTPUT RECORD IS FAK00960
AR R15,R7 SMALLER THAN THE 64 BYTE FAK00970
MVI 0(R15),C' ' OUTPUT RECORD SIZE, THEN FAK00980
LA R14,62 PAD THE REST OF THIS LAST FAK00990
SR R14,R7 RECORD WITH BLANKS. FAK01000
EX R14,WRITMVC FAK01010
WRITCONA FSWRITE 'ICATS OUTDATA A',BUFFER=(R8),BSIZE=64 FAK01020
LTR R15,R15 SEE IF ANY WRITE ERROR FAK01030
BNZ WRITERR YEP, ABORT FAK01040
LA R8,64(R8) POINT TO NEXT DATA AREA FAK01050
S R7,=F'64' DECREMENT # BYTES LEFT TO WRITE FAK01060
BP WRITWRIT DO ANOTHER WRITE IF MORE DATA LEFT FAK01070
LA R10,0 RETURN CODE = 0 = EVERYTHING'S GREAT FAK01080
WRITEBYE FSCLOSE 'ICATS OUTDATA A' FAK01090
LR R15,R10 TRANSFER RETURN CODE FAK01100
LM R0,R14,UTSIOREG FAK01110
BR R14 BYE FAK01120
* FAK01130
WRITERR LA R10,4 RC = 4 = PROBABLY READ ONLY A-DISK FAK01140
WRTERM 'SORRY, I GOT AN ERROR WRITING THE FILE ICATS OUTDATA' FAK01150
B WRITEBYE OR DISK IS FULL FAK01160
* FAK01170
WRITBAD0 LA R10,8 RC = 8 = INCORRECT BUFFER LENGTH FAK01180
B WRITEBYE FAK01190
* FAK01200
WRITMVC MVC 1(0,R15),0(R15) FAK01210
UTSIOREG DS 15F FAK01220
LTORG FAK01230
ICDATA FAK01240
END FAK01250