./ ADD SSI=00010968,NAME=IKDGDCFE,SOURCE=0 * MODULE NAME CONVERT S/360 DOUBLE PRECISION REAL NUMBERS TO 1130 00400017 * EXTENDED PRECISION FORMAT 00800017 * 01200017 * ENTRY POINT GDCFE 01600017 * 02000017 * EXIT TO THE NEXT SEQUENTIAL INSTRUCTION OF THE CALLING 02400017 * ROUTINE VIA REGISTER 14 02800017 * 03200017 * INPUT IN REGISTER 1 THE ADDRESS OF A PARAMETER LIST 03600017 * + 0 A(USERARRAY) S/360 INPUT ARRAY 04000017 * + 4 A(TEMPARRAY) 1130 OUTPUT ARRAY 04400017 * + 8 A(ELCOUNT) COUNT OF ELEMENTS TO CONVERT 04800017 * 05200017 * OUTPUT AN ARRAY OF REAL NUMBERS IN THE 1130 FORTRAN EXTENDED 05600017 * PRECISION FORMAT 06000017 * 06400017 * EXTERNAL REFERENCES NONE 06800017 * 07200017 * FUNCTION TO CONVERT AN ARRAY OF REAL NUMBERS IN THE S/360 FORTRAN 07600017 * DOUBLE PRECISION FORMAT TO AN ARRAY OF REAL NUMBERS IN 08000017 * THE 1130 FORTRAN EXTENDED PRECISION FORMAT 08400017 EJECT 08800017 * 09200017 * REGISTER UTILIZATION 09600017 * 10000017 INPL EQU 0 10200017 EL1 EQU 0 10400017 PLIST EQU 1 10800017 FRAD EQU 2 11200017 TOAD EQU 3 11600017 ELCT EQU 4 12000017 TRANS EQU 5 12400017 FRACT1 EQU 6 12800017 TASK EQU 6 13200017 DELTA EQU 7 13600017 FRACT2 EQU 7 14000017 CHAR EQU 8 14400017 BOTMF EQU 8 14800017 BASE EQU 9 15200017 CT EQU 10 15600017 BOTMT EQU 10 16000017 SLAVE EQU 11 16400017 PHAS2 EQU 15 16800017 EJECT 17200017 * 17600017 * PERFORM NORMAL INITIALIZATION FUNCTIONS 18000017 * 18400017 GDCFE CSECT 18800017 SAVE (14,12) 19200017 BALR BASE,0 19600017 USING *,BASE 20000017 LM FRAD,ELCT,0(PLIST) 20400017 L ELCT,0(ELCT) 20800017 SR PHAS2,PHAS2 21200017 SR EL1,EL1 21600017 SR INPL,INPL 21800017 * 22000017 * IF THE ELEMENT COUNT IS NOT GREATER THAN ZERO CONTROL IS IMMEDIATELY 22400017 * RETURNED TO THE CALLING ROUTINE. 22800017 * 23200017 LTR ELCT,ELCT 23600017 BC 12,GDCFE120 24000017 * 24100017 * IF THE ARRAYS OVERLAP IN ANY WAY CONVERSION IS DONE IN PLACE IN THE 24200017 * INPUT ARRAY. ELEMENT REFORMATTING IS ACCOMPLISHED IN TWO PHASES. 24300017 * PHASE 1 CONVERTS AN ELEMENT FROM THE BOTTOM OF THE ARRAY, MOVES AN 24400017 * UNCONVERTED ELEMENT FROM THE TOP TO THE OPEN SPOT AT THE BOTTOM, AND 24500017 * THEN STORES THE CONVERTED ELEMENT IN THE OPEN SPOT AT THE TOP. PHASE 24600017 * 2 CONVERTS THE ELEMENTS MOVED TO THE LOWER HALF OF THE ARRAY BY PHASE 24700017 * 1. THE ARRAY WAS INVERTED BY PHASE 1. 24800017 * 24900017 * DETERMINE IF ARRAYS OVERLAP 25000017 * 25100017 CR FRAD,TOAD ARE ARRAYS COINCIDENT 25200017 BE GDCFE008 YES 25300017 BH GDCFE002 25400017 LR BOTMF,ELCT COMPUTE THE ADDRESS OF THE 25500017 MH BOTMF,NH8 BOTTOM OF THE 25600017 AR BOTMF,FRAD INPUT ARRAY 25700017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 25800017 BNH GDCFE005 YES 25900017 B GDCFE008 25950017 GDCFE002 LR BOTMT,ELCT COMPUTE THE ADDRESS OF 26000017 MH BOTMT,NH6 THE BOTTOM OF THE 26100017 AR BOTMT,TOAD OUTPUT ARRAY 26200017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 26300017 BH GDCFE008 NO 26400017 GDCFE005 LH INPL,NH1 INDICATE CONVERSION BETWEEN 26500017 * ARRAYS 26600017 LR SLAVE,ELCT COMPUTE THE ADDRESS OF 26700017 SH SLAVE,NH1 THE LAST ELEMENT IN 26800017 MH SLAVE,NH8 THE INPUT ARRAY 26900017 AR FRAD,SLAVE 27000017 B GDCFE020 27100017 * PHASE 1 28000017 * 28400017 GDCFE008 CH ELCT,NH1 IS PHASE 2 REQUIRED 28800017 BNE GDCFE010 YES 29200017 LH EL1,NH1 INDICATE PHASE 2 NOT REQUIRED 29600017 B GDCFE020 30000017 GDCFE010 LR TOAD,FRAD INITIALIZE ARRAY INDEXES 30400017 LR TRANS,FRAD 30800017 LR SLAVE,ELCT COMPUTE THE ADDRESS OF 31200017 SH SLAVE,NH1 THE LAST ELEMENT 31600017 SLL SLAVE,3 IN THE INPUT 32000017 AR FRAD,SLAVE ARRAY 32400017 SRL ELCT,1 COMPUTE PHASE 1 ELEMENT COUNT 32800017 * 33200017 * REFORMATTING IS DONE AS FOLLOWS 33600017 * 1) THE 7 BIT HEXADECIMAL EXPONENT IS CHANGED TO AN 8 BIT 34000017 * BINARY EXPONENT. 34400017 * 2) THE HEXADECIMAL FRACTION IS NORMALIZED AS A BINARY FRACTION 34800017 * AND THE BINARY EXPONENT IS ACCORDINGLY REDUCED. 35200017 * 3) AN EXCESS 128 BINARY EXPONENT IS FORMED AND THE SIGN IS 35600017 * POSITIONED. 36000017 * 4) THE REFORMATTED NUMBER IS STORED. 36400017 * 36800017 GDCFE020 LH SLAVE,NH63 37200017 SR CHAR,CHAR 37600017 IC CHAR,0(FRAD) GET AN UNCONVERTED EXPONENT 38000017 NR CHAR,SLAVE CONVERT EXPONENT FROM EXCESS 64 38400017 SLL CHAR,2 HEXADECIMAL TO EXCESS 128 38800017 AH CHAR,NH128 BINARY 39200017 L FRACT1,0(FRAD) GET AN UNCONVERTED FRACTION 39600017 L FRACT2,4(FRAD) 40000017 SLDL FRACT1,8 ISOLATE FRACTION 40400017 LH CT,NH56 INITIALIZE LOOP CONTROL 40800017 GDCFE030 LTR FRACT1,FRACT1 IS FRACTION NORMALIZED 41200017 BM GDCFE040 YES 41600017 SLDL FRACT1,1 NORMALIZE FRACTION 42000017 SH CHAR,NH1 ADJUST BINARY EXPONENT 42400017 BCT CT,GDCFE030 42800017 SR CHAR,CHAR NUMBER IS ZERO 43200017 B GDCFE050 43600017 GDCFE040 SRL FRACT1,1 MAKE NUMBER POSITIVE 44000017 TM 0(FRAD),X'80' SHOULD NUMBER BE POSITIVE 44400017 BZ GDCFE050 YES 44800017 LH SLAVE,NHM1 FORM NEGATIVE NUMBER BY 45200017 XR SLAVE,FRACT1 COMPUTING THE TWO'S COMPLEMENT 45600017 AH SLAVE,NH1 OF THE FRACTION 46000017 LR FRACT1,SLAVE 46400017 GDCFE050 LTR INPL,INPL IS CONVERSION IN PLACE 46600017 BP GDCFE060 46800017 LTR PHAS2,PHAS2 HAS PHASE 2 BEGUN 47000017 BP GDCFE060 YES 47200017 MVC 0(8,FRAD),0(TRANS) SAVE ELEMENT FROM OVERLAY 47600017 GDCFE060 STH FRACT1,4(TOAD) STORE THE 32 48000017 SRL FRACT1,16 BIT SIGNED 48400017 STH FRACT1,2(TOAD) FRACTION 48800017 STH CHAR,0(TOAD) STORE EXPONENT 49200017 LTR INPL,INPL IS CONVERSION IN PLACE 49300017 BZ GDCFE063 YES 49400017 SH FRAD,NH8 ADJUST INPUT ARRAY INDEX 49500017 AH TOAD,NH6 ADJUST OUTPUT ARRAY INDEX 49600017 BCT ELCT,GDCFE020 ADJUST ELEMENT COUNT 49700017 B GDCFE120 49800017 GDCFE063 LTR EL1,EL1 IS CONVERSION COMPLETE 49900017 BP GDCFE120 YES 50000017 AH TOAD,NH6 50400017 LTR PHAS2,PHAS2 HAS PHASE 2 BEGUN 50800017 BP GDCFE065 YES 51200017 SH FRAD,NH8 ADJUST ARRAY INDEXES 51600017 AH TRANS,NH8 52000017 BCT ELCT,GDCFE020 52400017 * 52800017 * PHASE 2 53200017 * 53600017 LM FRAD,ELCT,0(PLIST) RESTORE PARAMETERS 54000017 L ELCT,0(ELCT) 54400017 LR SLAVE,ELCT COMPUTE THE ADDRESS OF THE FIRST 54800017 AH ELCT,NH1 COMPUTE PHASE 2 ELEMENT COUNT 55200017 SRL ELCT,1 55600017 SRL SLAVE,1 56000017 LR TOAD,SLAVE 56400017 SLL SLAVE,3 UNCONVERTED ELEMENT IN THE 56800017 MH TOAD,NH6 57200017 AR TOAD,FRAD 57600017 AR FRAD,SLAVE ARRAY 58000017 LH PHAS2,NH1 INDICATE PHASE 2 IS STARTED 58400017 B GDCFE020 58800017 GDCFE065 AH FRAD,NH8 ADJUST ARRAY INDEX 59200017 BCT ELCT,GDCFE020 59600017 * 60000017 * IF THE INPUT AND OUTPUT ARRAYS ARE NOT COINCIDENT THE REFORMATTED 60400017 * DATA IS MOVED INTO THE OUTPUT ARRAY 60800017 * 61200017 LM FRAD,ELCT,0(PLIST) RESTORE PARAMETERS 61600017 CR FRAD,TOAD ARE ARRAYS COINCIDENT 62000017 BE GDCFE120 YES 62400017 L TASK,0(ELCT) COMPUTE TOTAL MOVE COUNT 62800017 MH TASK,NH6 63200017 LA BOTMF,0(FRAD,TASK) COMPUTE ADDR OF END OF INPUT 63600017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 64000017 BNH GDCFE070 YES 64400017 LA BOTMT,0(TOAD,TASK) COMPUTE ADDR OF END OF OUTPUT 64800017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 65200017 BNH GDCFE070 YES 65600017 CR FRAD,TOAD 66000017 BL GDCFE080 66400017 GDCFE070 CH TASK,NH256 CAN MOVE BE COMPLETED 66800017 BNH GDCFE115 YES 67200017 MVC 0(256,TOAD),0(FRAD) MOVE DATA TO OUTPUT ARRAY 67600017 AH FRAD,NH256 ADJUST INPUT ARRAY INDEX 68000017 AH TOAD,NH256 ADJUST OUTPUT ARRAY INDEX 68400017 SH TASK,NH256 ADJUST MOVE COUNT 68800017 B GDCFE070 69200017 GDCFE080 LR DELTA,BOTMT COMPUTE THE MAXIMUM MOVE COUNT 69600017 SR DELTA,BOTMF LESS THAN 256 70000017 GDCFE090 CH TASK,NH256 CAN MOVE BE COMPLETED 70400017 BNH GDCFE110 MAYBE 70800017 CH DELTA,NH256 CAN 256 BYTES BE MOVED 71200017 BNH GDCFE100 NO 71600017 SH BOTMF,NH256 ADJUST INPUT ARRAY INDEX 72000017 SH BOTMT,NH256 ADJUST OUTPUT ARRAY INDEX 72400017 MVC 0(256,BOTMF),0(BOTMT) MOVE DATA TO OUTPUT ARRAY 72800017 SH TASK,NH256 ADJUST MOVE COUNT 73200017 B GDCFE090 73600017 GDCFE100 SR BOTMF,DELTA ADJUST INPUT ARRAY INDEX 74000017 SR BOTMT,DELTA ADJUST OUTPUT ARRAY INDEX 74400017 SH DELTA,NH1 PREPARE TO EXECUTE MOVE 74800017 EX DELTA,MOVE1 MOVE DATA TO OUTPUT ARRAY 75200017 AH DELTA,NH1 RESTORE INCREMENT MOVE PARAMETER 75600017 SR TASK,DELTA ADJUST MOVE COUNT 76000017 B GDCFE090 76400017 GDCFE110 CR TASK,DELTA CAN MOVE BE COMPLETED 76800017 BH GDCFE100 YES 77200017 GDCFE115 SH TASK,NH1 PREPARE TO EXECUTE MOVE 77600017 EX TASK,MOVE2 MOVE DATA TO OUTPUT ARRAY 78000017 GDCFE120 RETURN (14,12),T 78400017 EJECT 78800017 * 79200017 * DEFINED CONSTANTS 79600017 * 80000017 NHM1 DC H'-1' 80400017 NH1 DC H'1' 80800017 NH6 DC H'6' 81200017 NH8 DC H'8' 81600017 NH56 DC H'56' 82000017 NH63 DC H'63' 82400017 NH128 DC H'128' 82800017 NH256 DC H'256' 83200017 DS 0F 83600017 MOVE1 MVC 0(0,BOTMT),0(BOTMF) 84000017 MOVE2 MVC 0(0,TOAD),0(FRAD) 84400017 END 84800017 ./ ADD SSI=00010443,NAME=IKDGDCFF,SOURCE=0 * MODULE NAME CONVERT S/360 STANDARD LENGTH REAL NUMBERS AND 32 BIT 00300017 * ALPHAMERIC DATA TO 1130 STANDARD PRECISION FORMAT 00600017 * 00900017 * ENTRY POINT GDCFF 01200017 * 01500017 * EXIT TO THE CALLING ROUTINE VIA REGISTER 14 01800017 * 02100017 * INPUT IN REGISTER 1 THE ADDRESS OF A PARAMETER LIST 02400017 * + 0 A(USERARRAY) S/360 INPUT ARRAY 02700017 * + 4 A(TEMPARRAY) 1130 OUTPUT ARRAY 03000017 * + 8 A(ELCOUNT) COUNT OF ELEMENTS TO BE COVERTED 03300017 * +12 A(TYPCON) INDICATES TYPE OF CONVERSION 03600017 * 03900017 * OUTPUT AN ARRAY OF REAL NUMBERS OR ALPHAMERIC DATA IN THE 1130 04200017 * FORTRAN STANDARD PRECISION (4BYTE) FORMAT. 04500017 * 04800017 * EXTERNAL REFERENCES NONE 05100017 * 05400017 * FUNCTION 1) TO CONVERT AN ARRAY OF REAL NUMBERS IN THE S/360 05700017 * STANDARD LENGTH FORMAT TO AN ARRAY OF REAL NUMBERS IN 06000017 * THE 1130 FORTRAN STANDARD PRECISION FORMAT. 06300017 * 06600017 * 2) TO CONVERT AN ARRAY OF 32 BIT ALPHAMERIC DATA IN THE 06900017 * S/360 FORTRAN FORMAT TO AN ARRAY OF 32 BIT ALPHAMERIC 07200017 * DATA IN THE 1130 FORTRAN FORMAT 07500017 EJECT 07800017 * 08100017 * REGISTER UTILIZATION 08400017 * 08700017 BASE EQU 9 09000017 PLIST EQU 1 09300017 FRAD EQU 2 09600017 TOAD EQU 3 09900017 ELCT EQU 4 10200017 TYPCON EQU 5 10500017 BOTMT EQU 6 10800017 TASK EQU 7 11100017 BOTMF EQU 8 11400017 DELTA EQU 10 11700017 INPL1 EQU 0 12000017 INPL2 EQU 15 12300017 SLAVE EQU 11 12600017 SIGN EQU 6 12900017 FRACT EQU 7 13200017 CHAR EQU 8 13500017 CT EQU 5 13800017 EJECT 14100017 * 14400017 * PERFORM NORMAL INITIALIZATION FUNCTIONS. 14700017 * 15000017 GDCFF CSECT 15300017 SAVE (14,12) SAVE GENERAL REGISTERS 15600017 BALR BASE,0 ESTABLISH ADDRESSABILITY 15900017 USING *,BASE 16200017 LM FRAD,TYPCON,0(PLIST) GET PARAMETERS 16500017 L ELCT,0(ELCT) GET ELEMENT COUNT 16800017 L TYPCON,0(TYPCON) GET CONVERSION CODE 17100017 SR INPL1,INPL1 INITIALIZE SWITCHES 17400017 SR INPL2,INPL2 17700017 * 18000017 * IF THE ELEMENT COUNT IS NOT GREATER THAN ZERO CONTROL IS RETURNED TO 18300017 * THE CALLING ROUTINE WITHOUT CONVERSION. 18600017 * 18900017 LTR ELCT,ELCT SHOULD DATA BE CONVERTED 19200017 BC 12,GDCFF200 NO 19500017 * 19800017 * IF THE INPUT AND OUTPUT ARRAYS OVERLAP THE INPUT ARRAY DATA IS MOVED 20100017 * INTO THE OUTPUT ARRAY AND CONVERSION IS DONE IN PLACE. THREE DISTINCT 20400017 * TYPES OF OVERLAP ARE RECOGNIZED. 20700017 * TYPE 1 - THE ARRAYS ARE COINCIDENT, DATA IS NOT MOVED 21000017 * TYPE 2 - THE BOTTOM OF THE INPUT ARRAY OVERLAPS THE TOP OF THE 21300017 * OUTPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 21600017 * STARTING AT THE BOTTOM. 21900017 * TYPE 3 - THE BOTTOM OF THE OUTPUT ARRAY OVERLAPS THE TOP OF 22200017 * THE INPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 22500017 * STARTING AT THE TOP. 22800017 * 23100017 CR FRAD,TOAD TEST FOR TYPE OF OVERLAP 23400017 BE GDCFF080 TYPE 1 23700017 BL GDCFF030 TYPE 2 24000017 * 24300017 * DETERMINE IF ARRAYS ARE DISTINCT OR CORRESPOND TO TYPE 3 OVERLAP 24600017 * 24900017 LR BOTMT,ELCT COMPUTE THE ADDRESS OF THE 25200017 SLL BOTMT,2 BOTTOM OF THE 25500017 AR BOTMT,TOAD OUTPUT ARRAY 25800017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 26100017 BNH GDCFF090 YES 26400017 * 26700017 * TYPE 3 OVERLAP 27000017 * 27300017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 27600017 SLL TASK,2 27900017 GDCFF010 CH TASK,NH256 CAN MOVE BE COMPLETED 28200017 BNH GDCFF020 YES 28500017 MVC 0(256,TOAD),0(FRAD) MOVE DATA TO OUTPUT ARRAY 28800017 SH TASK,NH256 ADJUST MOVE COUNT 29100017 AH TOAD,NH256 ADJUST OUTPUT ARRAY INDEX 29400017 AH FRAD,NH256 ADJUST INPUT ARRAY INDEX 29700017 B GDCFF010 30000017 GDCFF020 SH TASK,NH1 PREPARE MOVE COUNT 30300017 EX TASK,MOVE1 MOVE DATA TO OUTPUT ARRAY 30600017 B GDCFF070 30900017 * 31200017 * DETERMINE IF ARRAYS ARE DISTINCT OR CORRESPOND TO TYPE 2 OVERLAP 31500017 * 31800017 GDCFF030 LR BOTMF,ELCT COMPUTE THE ADDRESS OF 32100017 SLL BOTMF,2 THE BOTTOM OF THE 32400017 AR BOTMF,FRAD INPUT ARRAY 32700017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 33000017 BNH GDCFF090 YES 33300017 * 33600017 * TYPE 2 OVERLAP 33900017 * 34200017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 34500017 SLL TASK,2 34800017 LR BOTMT,ELCT COMPUTE THE ADDRESS OF 35100017 SLL BOTMT,2 THE BOTTOM OF THE 35400017 AR BOTMT,TOAD OUTPUT ARRAY 35700017 LR DELTA,BOTMT COMPUTE MAXIMUM SINGLE MOVE 36000017 SR DELTA,BOTMF COUNT LESS THAN 256 36300017 GDCFF040 CH TASK,NH256 CAN MOVE BE COMPLETED 36600017 BNH GDCFF060 YES 36900017 CH DELTA,NH256 IS A DELTA MOVE POSSIBLE 37200017 BL GDCFF050 YES 37500017 SH BOTMT,NH256 ADJUST OUTPUT ARRAY INDEX 37800017 SH BOTMF,NH256 ADJUST INPUT ARRAY INDEX 38100017 MVC 0(256,BOTMT),0(BOTMF) MOVE DATA TO OUTPUT ARRAY 38400017 SH TASK,NH256 ADJUST MOVE COUNT 38700017 B GDCFF040 39000017 GDCFF050 SR BOTMT,DELTA ADJUST OUTPUT ARRAY INDEX 39300017 SR BOTMF,DELTA ADJUST INPUT ARRAY INDEX 39600017 SH DELTA,NH1 PREPARE TO EXECUTE MOVE 39900017 EX DELTA,MOVE2 MOVE DATA TO OUTPUT ARRAY 40200017 AH DELTA,NH1 RESTORE COUNT 40500017 SR TASK,DELTA ADJUST MOVE COUNT 40800017 B GDCFF040 41100017 GDCFF060 CR TASK,DELTA CAN MOVE BE COMPLETED 41400017 BH GDCFF050 NO 41700017 SH TASK,NH1 PREPARE TO EXECUTE MOVE 42000017 EX TASK,MOVE1 MOVE DATA TO OUTPUT ARRAY 42300017 * 42600017 * PREPARE FOR CONVERSION 42900017 * 43200017 GDCFF070 LM FRAD,TOAD,0(PLIST) GET PARAMETERS 43500017 LR FRAD,TOAD SET UP FOR IN PLACE CONVERSION 43800017 GDCFF080 LH INPL1,NH1 INDICATE IN PLACE CONVERSION 44100017 GDCFF090 LR SLAVE,ELCT COMPUTE THE ADDRESS OF 44400017 SH SLAVE,NH1 THE LAST ELEMENT IN 44700017 SLL SLAVE,2 THE OUTPUT ARRAY 45000017 AR TOAD,SLAVE 45300017 CH TYPCON,NH1 IS INPUT DATA ARITHMETIC 45600017 BNE GDCFF180 NO 45900017 * 46200017 * ARITHMETIC INPUT. EACH DATA ELEMENT IS CHANGED IN FORM AND THE ORDER 46500017 * OF THE ELEMENTS IS INVERTED. 46800017 * 47100017 GDCFF100 SR SIGN,SIGN 47400017 SR CHAR,CHAR 47700017 GDCFF110 L FRACT,0(FRAD) GET AN UNCONVERTED NUMBER 48000017 LTR FRACT,FRACT DOES NUMBER EQUAL ZERO 48300017 BZ GDCFF130 YES 48600017 SLDL SIGN,1 ISOLATE SIGN BIT 48900017 SLL FRACT,7 ISOLATE FRACTION 49200017 NI 0(FRAD),X'7F' TURN OFF SIGN BIT 49500017 IC CHAR,0(FRAD) ISOLATE CHARACTERISTIC 49800017 SH CHAR,NH64 CONVERT CHARACTERISTIC FROM AN 50100017 SLL CHAR,2 HEXADECIMAL EXCESS 64 EXPONENT 50400017 AH CHAR,NH128 TO A BINARY EXCESS 128 EXPONEN 50700017 LA CT,24 INITIALIZE LOOP CONTROL 51000017 GDCFF120 LTR FRACT,FRACT NORMALIZE FRACTION 51300017 BM GDCFF125 51600017 SLL FRACT,1 51900017 SH CHAR,NH1 ADJUST BINARY CHARACTERISTIC 52200017 BCT CT,GDCFF120 52500017 GDCFF125 SRL FRACT,1 MAKE NUMBER POSITIVE 52800017 LTR SIGN,SIGN SHOULD NUMBER BE POSITIVE 53100017 BZ GDCFF130 YES 53400017 LH SLAVE,NHM1 FORM NEGATIVE FRACTION BY 53700017 XR SLAVE,FRACT COMPUTING THE TWO'S 54000017 AH SLAVE,NH1 COMPLEMENT 54300017 LR FRACT,SLAVE 54600017 GDCFF130 LTR INPL1,INPL1 IS CONVERSION IN PLACE 54900017 BZ GDCFF160 NO 55200017 * 55500017 * CONVESION IN PLACE IS ACCOMPLISHED IN 2 PHASES. PHASE 1 CONVERTS 55800017 * ELEMENTS FROM THE TOP OF THE ARRAY AND STORES IT IN THE BOTTOM. 56100017 * OVERLAY IS PREVENTED BY MOVING THE UNCONVERTED ELEMENT AT THE BOTTOM 56400017 * OF THE ARRAY TO THE TOP. PHASE 2 CONVERTS AN STORES THE ELEMENTS 56700017 * WHICH WERE MOVED TO THE TOP BY PHASE 1. 57000017 * 57300017 * PHASE 1 57600017 * 57900017 LTR INPL2,INPL2 IS PHASE 1 COMPLETE 58200017 BP GDCFF150 YES 58500017 MVC 0(4,FRAD),0(TOAD) SAVE ELEMENT FROM OVERLAY 58800017 ST FRACT,0(TOAD) STORE CONVERTED FRACTION 59100017 STC CHAR,3(TOAD) STORE CONVERTED CHARACTERISTIC 59400017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 59700017 CR FRAD,TOAD SHOULD PHASE 2 BE STARTED 60000017 BE GDCFF140 YES 60300017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 60600017 CR FRAD,TOAD SHOULD PHASE 2 BE STARTED 60900017 BNE GDCFF170 NO 61200017 GDCFF140 LH INPL2,NH1 INDICATE PHASE 2 BEGUN 61500017 B GDCFF170 61800017 * 62100017 * PHASE 2 62400017 * 62700017 GDCFF150 ST FRACT,0(FRAD) STORE CONVERTED FRACTION 63000017 STC CHAR,3(FRAD) STORE CONVERTED CHARACTERISTIC 63300017 SH FRAD,NH4 ADJUST ARRAY INDEX 63600017 B GDCFF170 63900017 * 64200017 * CONVERSION BETWEEN ARRAYS 64500017 * 64800017 GDCFF160 ST FRACT,0(TOAD) STORE CONVERTED FRACTION 65100017 STC CHAR,3(TOAD) STORE CONVERTED CHARACTERISTIC 65400017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 65700017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 66000017 GDCFF170 BCT ELCT,GDCFF100 66300017 B GDCFF200 66600017 * 66900017 * ALPHAMERIC INPUT. THE ORDER OF THE INPUT ELEMENTS IS INVERTED FOR 67200017 * OUTPUT. THE INVERSION CAN BE DONE IN PLACE OR BETWEEN ARRAYS. 67500017 * 67800017 GDCFF180 LTR INPL1,INPL1 IS INVERSION IN PLACE 68100017 BZ GDCFF190 NO 68400017 * 68700017 * INVERSION IN PLACE 69000017 * 69300017 GDCFF185 L SLAVE,0(TOAD) GET AN ELEMENT FROM BOTTOM 69600017 MVC 0(4,TOAD),0(FRAD) MOVE ELEMENT FROM TOP TO BOTTOM 69900017 ST SLAVE,0(FRAD) STORE ELEMENT FROM BOTTOM AT TOP 70200017 SH ELCT,NH2 ADJUST ELEMENT COUNT 70500017 LTR ELCT,ELCT IS INVERSION COMPLETE 70800017 BC 12,GDCFF200 YES 71100017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 71400017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 71700017 B GDCFF185 72000017 * 72300017 * INVERSION BETWEEN ARRAYS 72600017 * 72900017 GDCFF190 MVC 0(4,TOAD),0(FRAD) TRANSFER AN ELEMENT 73200017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 73500017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 73800017 BCT ELCT,GDCFF190 ADJUST ELEMENT COUNT 74100017 GDCFF200 RETURN (14,12),T 74400017 EJECT 74700017 * 75000017 * DEFINED CONSTANTS 75300017 * 75600017 NH1 DC H'1' 75900017 NH2 DC H'2' 76200017 NH4 DC H'4' 76500017 NH64 DC H'64' 76800017 NH128 DC H'128' 77100017 NH256 DC H'256' 77400017 NHM1 DC H'-1' 77700017 DS 0F 78000017 MOVE1 MVC 0(0,TOAD),0(FRAD) 78300017 MOVE2 MVC 0(0,BOTMT),0(BOTMF) 78600017 END 78900017 ./ ADD SSI=00010443,NAME=IKDGDCFI,SOURCE=0 * MODULE NAME CONVERT S/360 STANDARD PRECISION INTEGER TO 1130 00400017 * STANDARD PRECISION INTEGER 00800017 * 01200017 * ENTRY POINT GDCFI 01600017 * 02000017 * EXIT TO THE CALLING ROUTINE VIA REGISTER 14. 02400017 * 02800017 * ATTRIBUTES REENTRANT 03200017 * 03600017 * INPUT IN REGISTER 1 THE ADDRESS OF A PARAMETER LIST 04000017 * +0 A(PRIMARRAY) INTEGERS TO BE CONVERTED 04400017 * +4 A(SUBARRAY) AREA TO RECEIVE CONVERTED INPUT 04800017 * +8 A(ELCOUNT) A COUNT OF THE NUMBER OF ELEMENTS 05200017 * TO BE CONVERTED 05600017 * 06000017 * OUTPUT AN ARRAY OF INTEGERS IN THE 1130 FORTRAN STANDARD 06400017 * PRECISION FORMAT. 06800017 * 07200017 * EXTERNAL REFERENCE NONE 07600017 * 08000017 * FUNCTION TO CONVERT AN ARRAY OF INTEGERS IN THE OS/360 FORTRAN 08400017 * STANDARD PRECISION FORMAT TO AN ARRAY OF INTEGERS IN 08800017 * THE 1130 FORTRAN STANDARD PRECISION FORMAT. 09200017 * 09600017 EJECT 10000017 * 10400017 * REGISTER UTILIZATION 10800017 * 11200017 INPL EQU 0 SWITCH TO INDICATE IN PLACE CONVERSION 11600017 PLIST EQU 1 INPUT PARAMETER LIST ADDRESS 12000017 FRAD EQU 2 INPUT ARRAY ADDRESS 12400017 TOAD EQU 3 OUTPUT ARRAY ADDRESS 12800017 ELCT EQU 4 ELEMENT COUNT 13200017 OSLGTH EQU 5 SWITCH INDICATES INPUT ELEMENT LENGTH 13600017 DELTA EQU 6 MAX MOVE COUNT LESS THAN 256 14000017 PRECON EQU 6 14400017 BOTMF EQU 7 BOTTOM ADDR OF INPUT ARRAY 14800017 SLAVE EQU 7 15200017 BOTMT EQU 8 BOTTOM ADDR OF OUTPUT ARRAY 15600017 BASE EQU 9 CSECT BASE ADDRESSABILITY 16000017 CON EQU 10 16400017 TASK EQU 11 TOTAL MOVE COUNT 16800017 INPL2 EQU 15 SW TO INDICATE PART 2 OF IN PLACE CONVERT 17200017 EJECT 17600017 * 18000017 * PERFORM NORMAL INITIALIZATION FUNCTIONS. 18400017 * 18800017 GDCFI CSECT 19200017 SAVE (14,12) SAVE GENERAL REGS 19600017 BALR BASE,0 ESTABLISH CSECT ADDRESSABILITY 20000017 USING *,BASE 20400017 LM FRAD,OSLGTH,0(PLIST) GET PARAMS 20800017 L ELCT,0(ELCT) 21200017 NI 0(OSLGTH),X'7F' TURN OFF PLIST END BIT 21600017 L OSLGTH,0(OSLGTH) 22000017 SLL OSLGTH,1 22400017 SR INPL,INPL INITIALIZE SWITCHES 22800017 SR INPL2,INPL2 23200017 SR PRECON,PRECON 23600017 * 24000017 * IF THE ELEMENT COUNT IS NEGATIVE OR ZERO CONTROL IS RETURNED TO THE 24400017 * CALLING ROUTINE WITHOUT CONVERSION 24800017 * 25200017 LTR ELCT,ELCT IS ELEM COUNT GREATER THAN 0 25600017 BC 12,GDCFI190 26000017 * 26400017 * IF THE INPUT AND OUTPUT ARRAYS OVERLAP THE INPUT ARRAY IS MOVED INTO 26800017 * THE OUTPUT ARRAY. FOUR DISTINCT TYPES OF OVERLAP ARE RECOGNIZED. IN 27200017 * THE FIRST TYPE THE ARRAYS COINCIDE; NO MOVING IS DONE AND CONVERSION 27600017 * IS DONE IN PLACE. IN THE SECOND TYPE THE BOTTOM OF THE OUTPUT ARRAY 28000017 * OVERLAPS INTO THE INPUT ARRAY; MOVEMENT IS TO THE TOP OF THE OUTPUT 28400017 * ARRAY AND CONVERSION IS DONE IN PLACE. IN THE THIRD TYPE THE BOTTOM 28800017 * OF THE INPUT ARRAY OVERLAPS INTO THE OUTPUT ARRAY; MOVEMENT IS TO THE 29200017 * BOTTOM OF THE OUTPUT ARRAY AND CONVERSION IS DONE EITHER IN PLACE, IF 29600017 * THE INPUT DATA IS FOUR BYTES, OR BETWEEN ARRAYS IF THE INPUT DATA IS 30000017 * TWO BYTES. IN THE FOURTH TYPE THE OUTPUT ARRAY IS WITHIN THE INPUT 30400017 * ARRAY; MOVEMENT IS TO THE TOP OF THE OUTPUT ARRAY AND CONVERSION IS 30800017 * DONE IN PLACE. 31200017 * 31600017 CR FRAD,TOAD TEST FOR OVERLAP TYPE 32000017 BE GDCFI040 TYPE 1 32400017 BH GDCFI010 TYPE 2 32800017 LR BOTMF,ELCT COMPUTE THE ADDRESS OF 33200017 CH OSLGTH,NH2 33600017 BE GDCFI005 34000017 SLL BOTMF,2 34400017 B GDCFI007 34800017 GDCFI005 SLL BOTMF,1 35200017 GDCFI007 AR BOTMF,FRAD 35600017 CR BOTMF,TOAD DO ARRAYS OVERLAP 36000017 BNH GDCFI050 36400017 LA PRECON,1 36800017 LR TOAD,FRAD 37200017 B GDCFI040 37600017 GDCFI010 LR BOTMT,ELCT COMPUTE THE ADDRESS OF THE 38000017 SLL BOTMT,1 BOTTOM OF THE OUTPUT 38400017 AR BOTMT,TOAD ARRAY FOR 4 BYTE DATA 38800017 CR BOTMT,FRAD TEST FOR TYPE 2 OVERLAP 39200017 BNH GDCFI050 NO OVERLAP 39600017 LR TASK,ELCT COMPUTE THE ADDRESS OF THE 40000017 CH OSLGTH,NH2 40400017 BE GDCFI015 40800017 SLL TASK,2 41200017 B GDCFI020 41600017 GDCFI015 SLL TASK,1 42000017 GDCFI020 CH TASK,NH256 IS TOTAL MOVE MORE THAN 256 42400017 BL GDCFI030 NO 42800017 MVC 0(256,TOAD),0(FRAD) MOVE INPUT DATA TO OUTPUT ARRAY 43200017 SH TASK,NH256 DECREMENT TOTAL MOVE COUNT 43600017 AH FRAD,NH256 44000017 AH TOAD,NH256 44400017 B GDCFI020 44800017 GDCFI030 SH TASK,NH1 PREPARE MOVE COUNT PARAMETER 45200017 EX TASK,MOVE1 MOVE INPUT DATA TO OUTPUT ARRAY 45600017 LM FRAD,TOAD,0(PLIST) 46000017 LR FRAD,TOAD 46400017 GDCFI040 LA INPL,1 INDICATE IN PLACE CONVERSION 46800017 * 47200017 * WHEN THE LENGTH OF THE INPUT ELEMENTS IS TWO BYTES THE ELEMENT FORMAT 47600017 * DOES NOT CHANGE FOR OUTPUT. HOWEVER THE ORDER OF THE ARRAY ELEMENTS 48000017 * MUST STILL BE INVERTED. NO DISTINCTION IS MADE BETWEEN ARITHMETIC 48400017 * INPUT AND LOGICAL (ALPHAMERIC) INPUT. 48800017 * 49200017 GDCFI050 LR SLAVE,ELCT 49600017 SH SLAVE,NH1 LAST ELEMENT IN THE 50000017 CH OSLGTH,NH2 50400017 BE GDCFI055 50800017 SLL SLAVE,2 51200017 B GDCFI057 51600017 GDCFI055 SLL SLAVE,1 52000017 GDCFI057 AR FRAD,SLAVE 52400017 CH OSLGTH,NH2 52800017 BNE GDCFI090 53200017 GDCFI060 LTR INPL,INPL TEST FOR CONVERT IN PLACE 53600017 BZ GDCFI080 NO 54000017 LH SLAVE,0(TOAD) SAVE ELEMENT FORM OVERLAY 54400017 MVC 0(2,TOAD),0(FRAD) INVERT ARRAY 54800017 STH SLAVE,0(FRAD) 55200017 SH ELCT,NH2 55600017 GDCFI070 LTR ELCT,ELCT HAS ARRAY BEEN FULLY INVERTED 56000017 BC 12,GDCFI155 YES 56400017 SH FRAD,NH2 INDEX UP INPUT ARRAY 56800017 AH TOAD,NH2 57200017 B GDCFI060 YES 57600017 GDCFI080 MVC 0(2,TOAD),0(FRAD) INVERT ARRAY 58000017 SH ELCT,NH1 DECRENENT ELEMENT COUNT 58400017 B GDCFI070 YES 58800017 * 59200017 * WHEN THE LENGTH OF THE INPUT ELEMENTS IS FOUR BYTES THE ELEMENT 59600017 * FORMAT MUST CHANGE AS WELL AS THE ORDER OF THE ELEMENTS IN THE ARRAY 60000017 * 60400017 GDCFI090 L CON,0(FRAD) GET ELEMENT TO BE CONVERTED 60800017 SRDA CON,15 SHIFT DATA OUT 61200017 SRL CON,16 POSITION SIGN BIT 61600017 SLDA CON,15 SHIFT DATA BACK IN 62000017 LTR INPL,INPL CONVERT IN PLACE 62400017 BZ GDCFI140 NO 62800017 LTR INPL2,INPL2 CONVERT IN PLACE, PHASE 2 63200017 BP GDCFI130 YES 63600017 * 64000017 * CONVERSION IN PLACE, PHASE ONE. 64400017 * 64800017 MVC 0(4,FRAD),0(TOAD) SAVE ELEMENT FROM OVERLAY 65200017 STH CON,0(TOAD) STORE CONVERTED ELEMENT 65600017 SH FRAD,NH2 INDEX UP INPUT ARRAY 66000017 CR FRAD,TOAD SHOULD PHASE 1 END 66400017 BE GDCFI100 YES 66800017 BL GDCFI110 YES 67200017 SH FRAD,NH2 INDEX UP INPUT ARRAY 67600017 CR FRAD,TOAD SHOULD PHASE 1 END 68000017 BNE GDCFI150 NO 68400017 AH FRAD,NH4 68800017 B GDCFI120 69200017 GDCFI100 AH FRAD,NH6 INIT INPUT ARRAY INDEX PHASE 2 69600017 B GDCFI120 70000017 GDCFI110 AH FRAD,NH10 INIT INPUT ARRAY INDEX PHASE 2 70400017 GDCFI120 LA INPL2,1 INDICATE IN PHASE 2 70800017 B GDCFI150 71200017 * 71600017 * CONVERSION IN PLACE, PHASE 2. 72000017 * 72400017 GDCFI130 STH CON,0(TOAD) STORE CONVERTED ELEMENT 72800017 AH FRAD,NH8 73200017 B GDCFI150 73600017 * 74000017 * CONVERSION BETWEEN ARRAYS 74400017 * 74800017 GDCFI140 STH CON,0(TOAD) STORE CONVERTED ELEMENT 75200017 SH FRAD,NH4 INDEX UP INPUT ARRAY 75600017 GDCFI150 AH TOAD,NH2 INDEX DOWN OUTPUT ARRAY 76000017 BCT ELCT,GDCFI090 HAVE ALL ELEMENTS BEEN CONVERTED 76400017 GDCFI155 LTR PRECON,PRECON SHOULD DATA BE MOVED 76800017 BZ GDCFI190 77200017 LM FRAD,ELCT,0(PLIST) 77600017 L ELCT,0(ELCT) 78000017 LR BOTMT,ELCT 78400017 SLL BOTMT,1 78800017 AR BOTMT,TOAD 79200017 LR BOTMF,ELCT 79600017 SLL BOTMF,1 80000017 AR BOTMF,FRAD 80400017 * 80800017 * TYPE 4 OVERLAP 81200017 * 81600017 LR DELTA,BOTMT COMPUTE MAXIMUM MOVE COUNT 82000017 SR DELTA,BOTMF LESS THAN 256 82400017 LR TASK,BOTMF COMPUTE THE NUMBER OF BYTES 82800017 SR TASK,FRAD WHICH MUST BE MOVED 83200017 GDCFI160 CH TASK,NH256 IS TOTAL MOVE MORE THAN 256 83600017 BNH GDCFI180 NO 84000017 CH DELTA,NH256 CAN 256 BYTES BE MOVED 84400017 BNH GDCFI170 NO 84800017 SH BOTMF,NH256 85200017 SH BOTMT,NH256 85600017 MVC 0(256,BOTMT),0(BOTMF) MOVE INPUT DATA TO OUTPUT ARRAY 86000017 SH TASK,NH256 DECREMENT TOTAL MOVE COUNT 86400017 B GDCFI160 86800017 GDCFI170 SR BOTMF,DELTA ADJUST INPUT ARRAY INDEX 87200017 SR BOTMT,DELTA ADJUST OUTPUT ARRAY INDEX 87600017 SH DELTA,NH1 PREPARE MOVE COUNT PARAMETER 88000017 EX DELTA,MOVE2 MOVE INPUT DATA TO OUTPUT ARRAY 88400017 AH DELTA,NH1 88800017 SR TASK,DELTA DECREMENT TOTAL MOVE COUNT 89200017 B GDCFI160 89600017 GDCFI180 CR DELTA,TASK CAN MOVE BE COMPLETED 90000017 BL GDCFI170 NO 90400017 SR BOTMF,TASK 90800017 SR BOTMT,TASK 91200017 SH TASK,NH1 PREPARE MOVE COUNT PARAMETER 91600017 EX TASK,MOVE2 MOVE INPUT DATA TO OUTPUT ARRAY 92000017 GDCFI190 RETURN (14,12),T 92400017 EJECT 92800017 * 93200017 * DEFINED CONSTANTS 93600017 * 94000017 MOVE1 MVC 0(0,TOAD),0(FRAD) 94400017 MOVE2 MVC 0(0,BOTMT),0(BOTMF) 94800017 NH1 DC H'1' 95200017 NH2 DC H'2' 95600017 NH4 DC H'4' 96000017 NH6 DC H'6' 96400017 NH8 DC H'8' 96800017 NH10 DC H'10' 97200017 NH256 DC H'256' 97600017 END 98000017 ./ ADD SSI=00011102,NAME=IKDGDCTE,SOURCE=0 * MODULE NAME CONVERT 1130 EXTENDED PRECISION REAL NUMBERS TO S/360 00500017 * DOUBLE PRECISION REAL NUMBERS 01000017 * 01500017 * ENTRY POINT GDCTE 02000017 * 02500017 * EXIT TO THE CALLING ROUTINE VIA REGISTER 14 03000017 * 03500017 * INPUT IN REGISTER 1 THE ADDRESS OF A PARAMETER LIST 04000017 * +0 A(TEMPARRAY) 1130 INPUT ARRAY 04500017 * +4 A(USERARRAY) S/360 OUTPUT ARRAY 05000017 * +8 A(ELCOUNT) NUMBER OF INPUT ELEMENTS 05500017 * 06000017 * OUTPUT AN ARRAY OF REAL NUMBERS IN THE S/360 FORTRAN DOUBLE 06500017 * 07000017 * EXTERNAL REFERENCES NONE 07500017 * 08000017 * FUNCTION TO CONVERT AN ARRAY OF REAL NUMBERS IN THE 1130 FORTRAN 08500017 * EXTENDED PRECISION FORMAT TO AN ARRAY OF REAL NUMBERS IN 09000017 * THE S/360 FORTRAN DOUBLE PRECISION FORMAT 09500017 EJECT 10000017 * 10500017 * REGISTER UTILIZATION 11000017 * 11500017 INPL EQU 0 11700017 PLIST EQU 1 12000017 FRAD EQU 2 12500017 TOAD EQU 3 13000017 ELCT EQU 4 13500017 WORK1 EQU 5 14000017 SLAVE EQU 5 14500017 WORK2 EQU 6 15000017 FRACT1 EQU 6 15500017 FRACT2 EQU 7 16000017 BOTMF EQU 7 16200017 CHAR EQU 8 16500017 BOTMT EQU 8 16700017 BASE EQU 9 17000017 CT EQU 10 17500017 TASK EQU 11 18000017 EJECT 18500017 * 19000017 * NORMAL INITIALIZATION FUNCTIONS 19500017 * 20000017 GDCTE CSECT 20500017 SAVE (14,12) SAVE GENERAL REGISTERS 21000017 BALR BASE,0 ESTABLISH ADDRESSABILITY 21500017 USING *,BASE 22000017 LM FRAD,ELCT,0(PLIST) GET PARAMETERS 22500017 L ELCT,0(ELCT) 23000017 SR INPL,INPL INITIALIZE SWITCH 23200017 * 23500017 * IF THE ELEMENT COUNT IS NOT GREATER THAN ZERO CONTROL IS RETURNED TO 24000017 * THE CALLING ROUTINE WITHOUT CONVERSION 24500017 * 25000017 LTR ELCT,ELCT SHOULD DATA BE CONVERTED 25500017 BC 12,GDCTE160 NO 26000017 * 26010017 * IF THE INPUT AND OUTPUT ARRAYS ARE DISTINCT CONVERSION IS PERFORMED 26020017 * IN A WAY THAT WILL NOT DESTROY THE INPUT DATA. THE INVERSION AND 26030017 * CONVERSION PROCESSES ARE ACCOMPLISHED SIMULTANEOUSLY. 26040017 * 26050017 * DETERMINE IF ARRAYS OVERLAP 26060017 * 26070017 CR FRAD,TOAD ARE ARRAYS COINCIDENT 26080017 BE GDCTE008 YES 26090017 BH GDCTE002 26100017 LR BOTMF,ELCT COMPUTE THE ADDRESS OF 26110017 MH BOTMF,NH6 THE BOTTOM OF THE 26120017 AR BOTMF,FRAD INPUT ARRAY 26130017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 26140017 BNH GDCTE005 YES 26150017 B GDCTE008 26160017 GDCTE002 LR BOTMT,ELCT COMPUTE THE ADDRESS OF 26170017 SLL BOTMT,3 THE BOTTOM OF THE 26180017 AR BOTMT,TOAD OUTPUT ARRAY 26190017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 26200017 BH GDCTE008 NO 26210017 GDCTE005 LH INPL,NH1 INDICATE DISTINCT ARRAYS 26220017 LR SLAVE,ELCT COMPUTE THE ADDRESS OF 26230017 SH SLAVE,NH1 THE LAST ELEMENT IN 26240017 MH SLAVE,NH6 THE INPUT ARRAY 26250017 AR FRAD,SLAVE 26260017 B GDCTE060 26270017 * 26500017 * IF THE INPUT ARRAY STARTS AT A HIGHER CORE ADDRESS THAN THE OUTPUT 27000017 * ARRAY THE INPUT DATA IS MOVED INTO THE OUTPUT ARRAY. THIS EFFECTIVELY 27500017 * PRODUCES COINCIDENT ARRAYS. 28000017 * 28500017 GDCTE008 CR FRAD,TOAD MUST DATA BE MOVED 29000017 BNH GDCTE030 NO 29500017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 30000017 MH TASK,NH6 30500017 GDCTE010 CH TASK,NH256 CAN MOVE BE COMPLETED 31000017 BNH GDCTE020 YES 31500017 MVC 0(256,TOAD),0(FRAD) MOVE DATA TO OUTPUT ARRAY 32000017 SH TASK,NH256 ADJUST MOVE COUNT 32500017 AH FRAD,NH256 ADJUST INPUT ARRAY INDEX 33000017 AH TOAD,NH256 ADJUST OUTPUT ARRAY INDEX 33500017 B GDCTE010 34000017 GDCTE020 SH TASK,NH1 PREPARE TO EXECUTE MOVE 34500017 EX TASK,MOVE MOVE DATA TO OUTPUT ARRAY 35000017 L FRAD,4(PLIST) EQUIVALENCE ARRAYS 35500017 * 36000017 * ARRAY INVERSION IS ACCOMPLISHED IN PLACE AND IS A SEPERATE OPERATION 36500017 * FROM ELEMENT REFORMATTING. 37000017 * 37500017 GDCTE030 LR TOAD,ELCT COMPUTE THE ADDRESS 38000017 SH TOAD,NH1 OF THE LAST 38500017 MH TOAD,NH6 ELEMENT IN 39000017 AR TOAD,FRAD THE ARRAY 39500017 GDCTE040 LH WORK1,0(FRAD) GET NEXT ELEMENT 40000017 SLL WORK1,8 FROM THE TOP 40500017 IC WORK1,2(FRAD) OF THE ARRAY 41000017 SLL WORK1,8 41500017 IC WORK1,3(FRAD) 42000017 LH WORK2,4(FRAD) TOP OF THE ARRAY 42500017 MVC 0(6,FRAD),0(TOAD) MOVE ELEMENT FROM BOTTOM TO TOP 43000017 STH WORK1,2(TOAD) STORE THE ELEMENT FROM 43500017 SRL WORK1,16 THE TOP OF THE ARRAY 44000017 STH WORK1,0(TOAD) INTO THE VACATED SPACE 44500017 STH WORK2,4(TOAD) AT THE BOTTOM 45000017 AH FRAD,NH6 ADJUST ARRAY INDEXES 45500017 SH TOAD,NH6 46000017 SH ELCT,NH2 ADJUST ELEMENT COUNT 46500017 LTR ELCT,ELCT IS INVERSION COMPLETE 47000017 BP GDCTE040 NO 47500017 LM FRAD,ELCT,0(PLIST) RESTORE PARAMETERS 48000017 L ELCT,0(ELCT) 48500017 * 49000017 * ELEMENTS ARE REFORMATTED AND PLACED IN THE PROPER LOCATION IN THE 49500017 * OUTPUT ARRAY. REFORMATTING IS DONE AS FOLLOWS: 50000017 * 1) AN INTEGRAL 6 BIT HEXADECIMAL EXPONENT IS FORMED FROM THE 50500017 * 8 BIT BINARY EXPONENT 51000017 * 2) THE 31 BIT BINARY FRACTION IS NORMALIZED AS A HEXADECIMAL 51500017 * FRACTION 52000017 * 3) THE SIGN BIT IS ATTACHED TO THE EXPONENT 52500017 * 4) THE REFORMATTED NUMBER IS STORED 53000017 * 53500017 CR FRAD,TOAD WERE ELEMENTS MOVED TO OUTPUT 54000017 BNH GDCTE050 NO 54500017 LR FRAD,TOAD EQUIVALENCE ARRAYS 55000017 GDCTE050 LR WORK1,ELCT COMPUTE THE ADDRESS 55500017 SH WORK1,NH1 OF THE LAST 56000017 MH WORK1,NH6 ELEMENT IN THE 56500017 AR FRAD,WORK1 INPUT ARRAY 57000017 LR WORK1,ELCT COMPUTE THE ADDRESS 57500017 SH WORK1,NH1 OF THE LAST 58000017 SLL WORK1,3 ELEMENT IN THE 58500017 AR TOAD,WORK1 OUTPUT ARRAY 59000017 GDCTE060 CLC 1(5,FRAD),ZERO DOES NUMBER EQUAL ZERO 59500017 BNE GDCTE070 NO 60000017 XC 0(8,TOAD),0(TOAD) ZERO OUTPUT ELEMENT 60500017 B GDCTE150 61000017 GDCTE070 SR CHAR,CHAR 61500017 IC CHAR,1(FRAD) GET AN UNCONVERTED EXPONENT 62000017 NI 1(FRAD),X'03' DETERMINE THE SHIFT 62500017 SR SLAVE,SLAVE COUNT NEEDED TO 63000017 IC SLAVE,1(FRAD) FORM A NORMALIZED 63500017 STC CHAR,1(FRAD) 63700017 LH CT,NH4 HEXADECIMAL 64000017 SR CT,SLAVE FRACTION 64500017 CH CT,NH4 SHOULD SHIFT COUNT BE ZERO 65000017 BNE GDCTE080 NO 65500017 SR CT,CT MAKE SHIFT COUNT ZERO 66000017 GDCTE080 AR CHAR,CT MAKE EXPONENT INTEGRAL 4 66500017 SH CT,NH1 ADJUST SHIFT COUNT FOR SIGN 67000017 SH CHAR,NH128 CONVERT EXPONENT FROM BINARY 67500017 SRL CHAR,2 EXCESS 128 TO HEXADECIMAL 68000017 AH CHAR,NH64 EXCESS 64 68500017 GDCTE090 LH FRACT1,2(FRAD) GET AN UNCONVERTED FRACTION 69000017 LH FRACT2,4(FRAD) 69500017 SLL FRACT2,16 POSITION SIGNED FRACTION IN 70000017 SLDL FRACT1,16 A REGISTER 70500017 LTR CT,CT IS SHIFT COUNT POSITIVE 71000017 BC 12,GDCTE110 NO 71500017 GDCTE100 SRDA FRACT1,1 NORMALIZE FRACTION 72000017 BCT CT,GDCTE100 72500017 GDCTE110 TM 2(FRAD),X'80' IS NUMBER NEGATIVE 73000017 BZ GDCTE120 NO 73500017 AH CHAR,NH128 POSITION NEGATIVE SIGN 74000017 LH SLAVE,NHM1 FORM A NEGATIVE NUMBER BY 74500017 XR SLAVE,FRACT1 COMPUTING THE TWO'S COMPLEMENT 75000017 AH SLAVE,NH1 OF THE FRACTION 75500017 LR FRACT1,SLAVE 76000017 LH SLAVE,NHM1 76500017 XR SLAVE,FRACT2 77000017 AH SLAVE,NH1 77500017 LR FRACT2,SLAVE 78000017 GDCTE120 LTR CT,CT IS NUMBER FULL NORMALIZED 78500017 BC 10,GDCTE130 YES 79000017 SRDL FRACT1,7 POSITION FRACTION 79500017 B GDCTE140 80000017 GDCTE130 SRDL FRACT1,8 POSITION FRACTION 80500017 GDCTE140 ST FRACT2,4(TOAD) STORE CONVERTED FRACTION 81000017 ST FRACT1,0(TOAD) 81500017 STC CHAR,0(TOAD) STORE CONVERTED EXPONENT 82000017 GDCTE150 SH FRAD,NH6 ADJUST INPUT ARRAY INDEX 82500017 LTR INPL,INPL IS CONVERSION IN PLACE 82600017 BP GDCTE155 NO 82700017 SH TOAD,NH8 ADJUST OUTPUT ARRAY INDEX 83000017 B GDCTE157 83100017 GDCTE155 AH TOAD,NH8 ADJUST OUTPUT ARRAY INDEX 83200017 GDCTE157 BCT ELCT,GDCTE060 83600017 GDCTE160 RETURN (14,12),T 84000017 EJECT 84500017 * 85000017 * DEFINED CONSTANTS 85500017 * 86000017 NHM1 DC H'-1' 86500017 NH1 DC H'1' 87000017 NH2 DC H'2' 87500017 NH4 DC H'4' 88000017 NH6 DC H'6' 88500017 NH8 DC H'8' 89000017 NH64 DC H'64' 89500017 NH128 DC H'128' 90000017 NH256 DC H'256' 90500017 ZERO DC 8X'00' 91000017 DS 0F 91500017 MOVE MVC 0(0,TOAD),0(FRAD) 92000017 END 92500017 ./ ADD SSI=01010443,NAME=IKDGDCTF,SOURCE=0 * MODULE NAME CONVERT 1130 STANDARD PRECISION REAL NUMBERS AND 32 BIT 00300017 * ALPHAMERIC DATA TO S/360 STANDARD LENGTH FORMAT. 00600017 * 00900017 * ENTRY POINT GDCTF 01200017 * 01500017 * EXIT TO THE CALLING ROUTINE VIA REGISTER 14 01800017 * 02100017 * INPUT IN REGISTER 1 THE ADDRESS OF A PARAMETER LIST 02400017 * + 0 A(TEMPARRAY) 1130 INPUT ARRAY 02700017 * + 4 A(USERARRAY) S/360 OUTPUT ARRAY 03000017 * + 8 A(ELCOUNT) NUMBER OF INPUT ELEMENTS 03300017 * +12 A(TYPCON) INDICATES ALPHA OR NUMA INPUT 03600017 * 03900017 * OUTPUT AN ARRAY OF REAL NUMBERS OR ALPHAMERIC DATA IN THE S/360 04200017 * FORTRAN STANDARD LENGTH (4 BYTE) FORMAT 04500017 * 04800017 * EXTERNAL REFERENCES NONE 05100017 * 05400017 * FUNCTION 1) TO CONVERT AN ARRAY OF REAL NUMBERS IN THE 1130 05700017 * FORTRAN STANDARD PRECISION FORMAT TO AN ARRAY OF REAL 06000017 * NUMBERS IN THE S/360 FORTRAN STANDARD LENGTH FORMAT. 06300017 * 06600017 * 2) TO CONVERT AN ARRAY OF 32 BIT ALPHAMERIC DATA IN THE 06900017 * 1130 FORTRAN FORMAT TO AN ARRAY OF 32 BIT ALPHAMERIC 07200017 * DATA IN THE S/360 FORTRAN FORMAT. 07500017 EJECT 07800017 * 08100017 * REGISTER UTILIZATION 08400017 * 08700017 INPL1 EQU 0 09000017 PLIST EQU 1 09300017 FRAD EQU 2 09600017 TOAD EQU 3 09900017 ELCT EQU 4 10200017 TYPCON EQU 5 10500017 BOTMT EQU 6 10800017 CHAR EQU 6 11100017 FRACT EQU 7 11400017 BOTMF EQU 7 11700017 CT EQU 8 12000017 TASK EQU 8 12300017 BASE EQU 9 12600017 DELTA EQU 10 12900017 SLAVE EQU 11 13200017 INPL2 EQU 15 13500017 EJECT 13800017 * 14100017 * PERFORM NORMAL INITIALIZATION FUNCTIONS 14400017 * 14700017 GDCTF CSECT 15000017 SAVE (14,12) SAVE GENERAL REGISTERS 15300017 BALR BASE,0 ESTABLISH ADDRESSABILITY 15600017 USING *,BASE 15900017 LM FRAD,TYPCON,0(PLIST) GET PARAMETERS 16200017 L ELCT,0(ELCT) GET ELEMENT COUNT 16500017 L TYPCON,0(TYPCON) GET CONVERSION CODE 16800017 SR INPL1,INPL1 INITIALIZE SWITCHES 17100017 SR INPL2,INPL2 17400017 * 17700017 * IF THE ELEMENT COUNT IS NOT GREATER THAN ZERO CONTROL IS RETURNE TO 18000017 * THE CALLING ROUTINE WITHOUT CONVERSION. 18300017 * 18600017 LTR ELCT,ELCT SHOULD DATA BE CONVERTED 18900017 BC 12,GDCTF200 NO 19200017 * 19500017 * IF THE INPUT AND OUTPUT ARRAYS OVERLAP THE INPUT ARRAY DATA IS MOVED 19800017 * INTO THE OUTPUT ARRAY AND CONVERSION IS DONE IN PLACE. THREE DISTINCT 20100017 * TYPES OF OVERLAP ARE RECOGNIZED. 20400017 * TYPE 1 - THE ARRAYS ARE COINCIDENT, DATA IS NOT MOVED 20700017 * TYPE 2 - THE BOTTOM OF THE INPUT ARRAY OVERLAPS THE TOP OF THE 21000017 * OUTPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 21300017 * STARTING AT THE BOTTOM 21600017 * TYPE 3 - THE BOTTOM OF THE OUTPUT ARRAY OVERLAPS THE TOP OF 21900017 * THE INPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 22200017 * STARTING AT THE TOP 22500017 * 22800017 CR FRAD,TOAD TEST FOR TYPE OF OVERLAP 23100017 BE GDCTF080 TYPE 1 23400017 BL GDCTF030 TYPE 2 23700017 * 24000017 * DETERMINE IF ARRAYS ARE DISTINCT OR CORRESPOND TO TYPE 3 OVERLAP 24300017 * 24600017 LR BOTMT,ELCT COMPUTE THE ADDRESS OF THE 24900017 SLL BOTMT,2 BOTTOM OF THE 25200017 AR BOTMT,TOAD OUTPUT ARRAY 25500017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 25800017 BNH GDCTF090 YES 26100017 * 26400017 * TYPE 3 OVERLAP 26700017 * 27000017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 27300017 SLL TASK,2 27600017 GDCTF010 CH TASK,NH256 CAN MOVE BE COMPLETED 27900017 BNH GDCTF020 YES 28200017 MVC 0(256,TOAD),0(FRAD) MOVE DATA TO OUTPUT ARRAY 28500017 SH TASK,NH256 ADJUST MOVE COUNT 28800017 AH FRAD,NH256 ADJUST OUTPUT ARRAY INDEX 29100017 AH TOAD,NH256 ADJUST INPUT ARRAY INDEX 29400017 B GDCTF010 29700017 GDCTF020 SH TASK,NH1 PREPARE TO EXECUTE MOVE 30000017 EX TASK,MOVE1 MOVE DATA TO OUTPUT ARRAY 30300017 B GDCTF070 30600017 * 30900017 * DETERMINE IF ARRAYS ARE DISTINCT OR CORRESPOND TO TYPE 2 OVERLAP 31200017 * 31500017 GDCTF030 LR BOTMF,ELCT COMPUTE THE ADDRESS OF THE 31800017 SLL BOTMF,2 BOTTOM OF THE 32100017 AR BOTMF,FRAD INPUT ARRAY 32400017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 32700017 BNH GDCTF090 YES 33000017 * 33300017 * TYPE 2 OVERLAP 33600017 * 33900017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 34200017 SLL TASK,2 34500017 LR BOTMT,ELCT COMPUTE THE ADDRESS OF 34800017 SLL BOTMT,2 THE BOTTOM OF THE 35100017 AR BOTMT,TOAD OUTPUT ARRAY 35400017 LR DELTA,BOTMT COMPUTE MAXIMUM SINGLE MOVE 35700017 SR DELTA,BOTMF COUNT LESS THAN 256 36000017 CH DELTA,NH256 IS A DELTA MOVE POSSIBLE 36300017 BL GDCTF050 YES 36600017 GDCTF040 CH TASK,NH256 CAN MOVE BE COMPLETED 36900017 BNH GDCTF060 YES 37200017 SH BOTMT,NH256 ADJUST OUTPUT ARRAY INDEX 37500017 SH BOTMF,NH256 ADJUST INPUT ARRAY INDEX 37800017 MVC 0(256,BOTMT),0(BOTMF) MOVE DATA TO OUTPUT ARRAY 38100017 SH TASK,NH256 ADJUST MOVE COUNT 38400017 B GDCTF040 38700017 GDCTF050 CR TASK,DELTA CAN MOVE BE COMPLETED 39000017 BNH GDCTF060 YES 39300017 SR BOTMT,DELTA ADJUST OUTPUT ARRAY INDEX 39600017 SR BOTMF,DELTA ADJUST INPUT ARRAY INDEX 39900017 SH DELTA,NH1 PREPARE TO EXECUTE MOVE 40200017 EX DELTA,MOVE2 MOVE DATA TO OUTPUT ARRAY 40500017 AH DELTA,NH1 RESTORE COUNT 40800017 SR TASK,DELTA ADJUST MOVE COUNT 41100017 B GDCTF050 41400017 GDCTF060 SH TASK,NH1 PREPARE TO EXECUTE MOVE 41700017 EX TASK,MOVE1 MOVE DATA TO OUTPUT ARRAY 42000017 * 42300017 * PREPARE FOR CONVERSION 42600017 * 42900017 GDCTF070 LM FRAD,TOAD,0(PLIST) GET PARAMETERS 43200017 LR FRAD,TOAD SET UP FOR CONVERSION IN PLACE 43500017 GDCTF080 LH INPL1,NH1 INDICATE CONVERSION IN PLACE 43800017 GDCTF090 LR SLAVE,ELCT COMPUTE THE ADDRESS OF 44100017 SH SLAVE,NH1 THE LAST ELEMENT IN 44400017 SLL SLAVE,2 THE OUTPUT ARRAY 44700017 AR TOAD,SLAVE 45000017 CH TYPCON,NH1 IS INPUT DATA ARITHMETIC 45300017 BNE GDCTF180 NO 45600017 * 45900017 * ARITHMETIC INPUT. EACH DATA ELEMENT IS CHANGED IN FORM AND THE ORDER 46200017 * OF THE ELEMENTS IS INVERTED. 46500017 * 46800017 GDCTF100 LH CT,NH4 47100017 SR SLAVE,SLAVE 47400017 SR CHAR,CHAR 47700017 C CHAR,0(FRAD) DOES NUMBER EQUAL ZERO 48000017 BE GDCTF128 YES 48300017 IC CHAR,3(FRAD) GET AN UNCONVERTED EXPONENT 48600017 NI 3(FRAD),X'03' DETERMINE THE SHIFT COUNT NEEDED 48900017 IC SLAVE,3(FRAD) TO FORM A NORMALIZED 49200017 SR CT,SLAVE HEXADECIMAL FRACTION 49500017 CH CT,NH4 SHOULD SHIFT COUNT BE ZERO 49800017 BNE GDCTF110 NO 50100017 SR CT,CT MAKE SHIFT COUNT ZERO 50400017 GDCTF110 AR CHAR,CT MAKE EXPONENT INTEGRAL 4 50700017 LA CT,7(CT) SHIFT TO POSITION FRACTION 51000017 SH CHAR,NH128 CONVERT EXPONENT FROM BINARY 51300017 SRL CHAR,2 EXCESS 128 TO HEXADECIMAL 51600017 AH CHAR,NH64 EXCESS 64 51900017 GDCTF120 NI 3(FRAD),X'00' DETACH EXPONENT FROM FRACTION 52200017 L FRACT,0(FRAD) GET AN UNCONVERTED FRACTION 52500017 GDCTF125 SRA FRACT,1 NORMALIZE FRACTION 52800017 BCT CT,GDCTF125 53100017 TM 0(FRAD),X'80' IS NUMBER NEGATIVE 53400017 BZ GDCTF130 NO 53700017 AH CHAR,NH128 POSITION SIGN ON EXPONENT 54000017 LH SLAVE,NHM1 FORM NEGATIVE NUMBER BY 54300017 XR SLAVE,FRACT COMPUTING THE TWO'S COMPLEMENT 54600017 AH SLAVE,NH1 OF THE FRACTION 54900017 GDCTF128 LR FRACT,SLAVE 55200017 * 55500017 * CONVERSION IN PLACE IS ACCOMPLISHED IN 2 PHASES. PHASE 1 CONVERTS AN 55800017 * ELEMENTS FROM THE TOP OF THE ARRAY AND STORES IT IN THE BOTTOM. 56100017 * OVERLAY IS AVOIDED BY MOVING THE UNCONVERTED ELEMENT AT THE BOTTOM OF 56400017 * THE ARRAY TO THE TOP. PHASE 2 CONVERTS AND STORES THE ELEMENTS WHICH 56700017 * WERE MOVED TO THE TOP BY PHASE 1. 57000017 * 57300017 * PHASE 1 57600017 * 57900017 GDCTF130 LTR INPL1,INPL1 IS CONVERSION IN PLACE 58200017 BZ GDCTF160 NO 58500017 LTR INPL2,INPL2 IS PHASE 1 COMPLETE 58800017 BP GDCTF150 YES 59100017 MVC 0(4,FRAD),0(TOAD) SAVE ELEMENT FROM OVERLAY 59400017 ST FRACT,0(TOAD) STORE CONVERTED FRACTION 59700017 STC CHAR,0(TOAD) STORE CONVERTED CHARACTERISTIC 60000017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 60300017 CR FRAD,TOAD SHOULD PHASE 2 BE STARTED 60600017 BE GDCTF140 YES 60900017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 61200017 CR FRAD,TOAD SHOULD PHASE 2 BE STARTED 61500017 BNE GDCTF170 NO 61800017 GDCTF140 LH INPL2,NH1 INDICATE PHASE 2 BEGUN 62100017 B GDCTF170 62400017 * 62700017 * PHASE 2 63000017 * 63300017 GDCTF150 ST FRACT,0(FRAD) STORE CONVERTED FRACTION 63600017 STC CHAR,0(FRAD) STORE CONVERTED CHARACTERISTIC 63900017 SH FRAD,NH4 ADJUST ARRAY INDEX 64200017 B GDCTF170 64500017 * 64800017 * CONVERSION BETWEEN ARRAYS 65100017 * 65400017 GDCTF160 ST FRACT,0(TOAD) STORE CONVERTED FRACTION 65700017 STC CHAR,0(TOAD) STORE CONVERTED CHARACTERISTIC 66000017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 66300017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 66600017 GDCTF170 BCT ELCT,GDCTF100 66900017 B GDCTF200 67200017 * 67500017 * ALPHAMERIC INPUT. THE ORDER OF THE INPUT ELEMENTS IS INVERTED FOR 67800017 * OUTPUT. THE INVERSION CAN BE DONE IN PLACE OR BETWEEN ARRAYS. 68100017 * 68400017 GDCTF180 LTR INPL1,INPL1 IS INVERSION IN PLACE 68700017 BZ GDCTF190 NO 69000017 * 69300017 * INVERSION IN PLACE 69600017 * 69900017 GDCTF185 L SLAVE,0(TOAD) GET AN ELEMENT FROM BOTTOM 70200017 MVC 0(4,TOAD),0(FRAD) MOVE ELEMENT FROM TOP TO BOTTOM 70500017 ST SLAVE,0(FRAD) STORE ELEMENT FROM BOTTOM AT TOP 70800017 SH ELCT,NH2 ADJUST ELEMENT COUNT 71100017 LTR ELCT,ELCT IS INVERSION COMPLETE 71400017 BC 12,GDCTF200 YES 71700017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 72000017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 72300017 B GDCTF185 72600017 * 72900017 * INVERSION BETWEEN ARRAYS 73200017 * 73500017 GDCTF190 MVC 0(4,TOAD),0(FRAD) TRANSFER AN ELEMENT 73800017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 74100017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 74400017 BCT ELCT,GDCTF190 ADJUST ELEMENT COUNT 74700017 GDCTF200 RETURN (14,12),T 75000017 EJECT 75300017 * 75600017 * DEFINED CONSTANTS 75900017 * 76200017 NHM1 DC H'-1' 76500017 NH1 DC H'1' 76800017 NH2 DC H'2' 77100017 NH4 DC H'4' 77400017 NH8 DC H'8' 77700017 NH64 DC H'64' 78000017 NH128 DC H'128' 78300017 NH256 DC H'256' 78600017 MOVE1 MVC 0(0,TOAD),0(FRAD) 78900017 MOVE2 MVC 0(0,BOTMT),0(BOTMF) 79200017 END 79500017 ./ ADD SSI=00010443,NAME=IKDGDCTI,SOURCE=0 * MODULE NAME CONVERT 1130 INTEGERS AND 16 BIT ALPHAMERIC DATA TO 00300017 * S/360 FORMAT 00600017 * 00900017 * ENTRY POINT GDCTI 01200017 * 01500017 * EXIT TO THE CALLING ROUTINE VIA REGISTER 14 01800017 * 02100017 * INPUT IN REGISTER 1 THE ADDRESS OF A PAREMETER LIST 02400017 * + 0 A(SUBARRAY) 1130 INPUT ARRAY 02700017 * + 4 A(PRIMARRAY) S/360 OUTPUT ARRAY 03000017 * + 8 A(ELCOUNT) COUNT OF ELEMENS TO CONVERT 03300017 * +12 A(OSLGTH) LENGTH (BYTES) OF S/360 ELEMENTS 03600017 * 03900017 * OUTPUT AN ARRAY OF INTEGERS OR ALPHAMERIC DATA IN THE S/360 04200017 * FORTRAN STANDARD LENGTH (4 BYTES) OR HALF WORD (2 BYTES) 04500017 * FORMAT 04800017 * 05100017 * EXTERNAL REFERENCES NONE 05400017 * 05700017 * FUNCTION 1) TO CONVERT AN ARRAY OF INTEGERS IN THE 1130 FORTRAN 06000017 * STANDARD PRECISION FORMAT TO AN ARRAY OF INTEGERS IN THE 06300017 * S/360 FORTRAN STANDARD LENGTH FORMAT. 06600017 * 06900017 * 2) TO CONVERT AN ARRAY OF INTEGERS IN THE 1130 FORTRAN 07200017 * "ONE WORD INTEGER" FORMAT TO AN ARRAY OF INTEGERS IN THE 07500017 * S/360 FORTRAN HALF WORD FORMAT. 07800017 * 08100017 * 3) TO CONVERT AN ARRAY OF 16 BIT ALPHAMERIC DATA IN THE 08400017 * 1130 FORTRAN FORMAT TO AN ARRAY OF 16 BIT ALPHAMERIC 08700017 * DATA IN THE S/360 FORMAT. 09000017 EJECT 09300017 * 09600017 * REGISTER UTILIZATION 09900017 * 10200017 INPL EQU 0 SWITCH INDICATES IN PLACE CONVERSION 10500017 PLIST EQU 1 INPUT PARAMETER LIST ADDRESS 10800017 FRAD EQU 2 INPUT ARRAY ADDRESS 11100017 TOAD EQU 3 OUTPUT ARRAY ADDRESS 11400017 ELCT EQU 4 ELEMENT COUNT 11700017 OSLGTH EQU 5 SWITCH INDICATES OUTPUT ELEMENT LENGTH 12000017 BOTMT EQU 6 BOTTOM ADDRESS OF OUTPUT ARRAY 12300017 CON1 EQU 6 CONVERSION REG 12600017 BOTMF EQU 7 BOTTOM ADDRESS OF INPUT ARRAY 12900017 CON2 EQU 7 CONVERSION REG 13200017 CON3 EQU 8 CONVERSION REG 13500017 TASK EQU 8 TOTAL MOVE COUNT 13800017 BASE EQU 9 CSECT BASE 14100017 MOVE EQU 15 14400017 DELTA EQU 10 MAXIMUM MOVE COUNT LESS THAN 256 14700017 LASTL EQU 10 LAST ELEM ADDR OF INPUT ARRAY 15000017 SLAVE EQU 11 WORK REG 15300017 EJECT 15600017 GDCTI CSECT 15900017 SAVE (14,12) SAVE GENERAL REGISTERS 16200017 BALR BASE,0 ESTABLISH ADDRESSABILITY 16500017 USING *,BASE 16800017 LM FRAD,OSLGTH,0(PLIST) GET PARAMETERS 17100017 L ELCT,0(ELCT) GET ELEMENT COUNT 17400017 L OSLGTH,0(OSLGTH) GET S/360 ELEMENT LENGTH CODE 17700017 SR INPL,INPL INITIALIZE SWITCH 18000017 SR MOVE,MOVE 18300017 * 18600017 * IF THE ELEMENT COUNT IS NOT GREATER THAN ZERO CONTROL IS RETURNED TO 18900017 * THE CALLING ROUTINE WITHOUT CONVERSION. 19200017 * 19500017 LTR ELCT,ELCT SHOULD DATA BE CONVERTED 19800017 BC 12,GDCTI250 NO 20100017 * 20400017 * IF THE INPUT AND OUTPUT ARRAYS OVERLAP THE INPUT ARRAY DATA IS MOVED 20700017 * INTO THE OUTPUT ARRAY AND CONVERSION IS DONE IN PLACE. THREE DISTINCT 21000017 * TYPES OF OVERLAP ARE RECOGNIZED. 21300017 * TYPE 1 - THE ARRAYS ARE COINCIDENT, NO DATA IS MOVED 21600017 * TYPE 2 - THE BOTTOM OF THE INPUT ARRAY OVERLAPS THE TOP OF THE 21900017 * OUTPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 22200017 * STARTING AT THE BOTTOM. 22500017 * TYPE 3 - THE BOTTOM OF THE OUTPUT ARRAY OVERLAPS THE TOP OF 22800017 * THE INPUT ARRAY, DATA IS MOVED INTO THE OUTPUT ARRAY 23100017 * STARTING AT THE TOP. 23400017 * 23700017 CR FRAD,TOAD TEST FOR TYPE OF OVERLAP 24000017 BE GDCTI140 TYPE 1 24300017 BL GDCTI060 TYPE 2 24600017 * 24900017 * TYPE 3 OVERLAP 25200017 * 25500017 LR BOTMT,ELCT COMPUTE THE ADDRESS OF THE 25800017 CH OSLGTH,NH1 BOTTOM OF THE OUTPUT ARRAY FOR 26100017 BE GDCTI010 26400017 SLL BOTMT,2 4 BYTE OUTPUT DATA 26700017 B GDCTI020 27000017 GDCTI010 SLL BOTMT,1 2 BYTE OUTPUT DATA 27300017 GDCTI020 AR BOTMT,TOAD 27600017 CR BOTMT,FRAD ARE ARRAYS DISTINCT 27900017 BNH GDCTI150 YES 28200017 * 28500017 * MOVE INPUT DATA TO OUTPUT ARRAY 28800017 * 29100017 LR TASK,ELCT COMPUTE TOTAL MOVE COUNT 29400017 CH OSLGTH,NH1 29700017 BE GDCTI030 30000017 SLL TASK,2 30300017 B GDCTI040 30600017 GDCTI030 SLL TASK,1 30900017 GDCTI040 CH TASK,NH256 CAN MOVE BE COMPLETED 31200017 BNH GDCTI120 YES 31500017 MVC 0(256,TOAD),0(FRAD) MOVE DATA TO OUTPUT ARRAY 31800017 SH TASK,NH256 ADJUST TOTAL MOVE COUNT 32100017 AH TOAD,NH256 ADJUST OUTPUT ARRAY INDEX 32400017 AH FRAD,NH256 ADJUST INPUT ARRAY INDEX 32700017 B GDCTI040 33000017 * 33300017 * TYPE 2 OVERLAP 33600017 * 33900017 GDCTI060 LR BOTMF,ELCT COMPUTE THE ADDRESS 34200017 SLL BOTMF,1 OF THE BOTTOM OF 34500017 AR BOTMF,FRAD THE INPUT ARRAY 34800017 CR BOTMF,TOAD ARE ARRAYS DISTINCT 35100017 BNH GDCTI150 YES 35400017 CH OSLGTH,NH1 IS OUTPUT DATA 2 BYTE 35700017 BE GDCTI070 YES 36000017 LH MOVE,NH1 INDICATE CONVERT AFTER INVERT 36300017 LH INPL,NH1 INDICATE IN PLACE CONVERSION 36600017 * 36900017 * MOVE INPUT DATA TO OUTPUT ARRAY 37200017 * 37500017 LR TOAD,ELCT COMPUTE THE ADDRESS 37800017 SH TOAD,NH1 OF THE LAST 38100017 SLL TOAD,1 ELEMENT IN THE 38400017 AR TOAD,FRAD INPUT ARRAY 38700017 B GDCTI180 39000017 GDCTI070 LR BOTMT,ELCT COMPUTE THE ADDRESS 39300017 SLL BOTMT,1 OF THE BOTTOM OF 39600017 AR BOTMT,TOAD THE OUTPUT ARRAY 39900017 LR DELTA,BOTMT COMPUTE THE MAXIMUM MOVE COUNT 40200017 SR DELTA,BOTMF LESS THAN 256 40500017 LR TASK,BOTMF COMPUTE TOTAL MOVE COUNT 40800017 SR TASK,FRAD 41100017 GDCTI090 CH TASK,NH256 CAN MAXIMUM MOVE BE MADE 41400017 BNH GDCTI100 YES 41700017 CH DELTA,NH256 CAN 256 BYTES BE MOVED 42000017 BNH GDCTI110 NO 42300017 SH BOTMF,NH256 ADJUST INPUT ARRAY ADDRESS 42600017 SH BOTMT,NH256 ADJUST OUTPUT ARRAY ADDRESS 42900017 MVC 0(256,BOTMT),0(BOTMF) MOVE DATA TO OUTPUT ARRAY 43200017 SH TASK,NH256 ADJUST TOTAL MOVE COUNT 43500017 B GDCTI090 43800017 GDCTI100 CR TASK,DELTA CAN MOVE BE COMPLETED 44100017 BL GDCTI120 YES 44400017 GDCTI110 SR BOTMT,DELTA ADJUST OUTPUT ARRAY INDEX 44700017 SR BOTMF,DELTA ADJUST INPUT ARRAY INDEX 45000017 SH DELTA,NH1 PREPARE MOVE COUNT 45300017 EX DELTA,MOVE2 MOVE DATA TO OUTPUT ARRAY 45600017 AH DELTA,NH1 45900017 SR TASK,DELTA ADJUST TOTAL MOVE COUNT 46200017 B GDCTI090 46500017 GDCTI120 SH TASK,NH1 PREPARE MOVE COUNT 46800017 EX TASK,MOVE1 MOVE DATA TO OUTPUT ARRAY 47100017 * 47400017 * SETUP FOR CONVERSION 47700017 * 48000017 GDCTI130 LM FRAD,TOAD,0(PLIST) 48300017 LR FRAD,TOAD PREPARE TO CONVERT IN PLACE 48600017 GDCTI140 LH INPL,NH1 INDICATE CONVERSION IN PLACE 48900017 LR LASTL,ELCT COMPUTE THE ADDRESS 49200017 SH LASTL,NH1 OF THE LAST ELEMENT 49500017 SLL LASTL,1 IN THE INPUT ARRAY 49800017 AR LASTL,FRAD 50100017 GDCTI150 LR SLAVE,ELCT COMPUTE THE ADDRESS OF THE 50400017 SH SLAVE,NH1 LAST ELEMENT IN THE OUTPUT 50700017 CH OSLGTH,NH1 ARRAY FOR 51000017 BE GDCTI160 51300017 SLL SLAVE,2 4 BYTE OUTPUT DATA 51600017 B GDCTI170 51900017 GDCTI160 SLL SLAVE,1 2 BYTE OUTPUT DATA 52200017 GDCTI170 AR TOAD,SLAVE 52500017 CH OSLGTH,NH1 SHOULD ELEMENT FORM BE CHANGED 52800017 BNE GDCTI210 YES 53100017 * 53400017 * WHEN THE LENGTH OF THE OUTPUT ELEMENTS IS 2 BYTES THE ELEMENT FORMAT 53700017 * DOES NOT CHANGE. HOWEVER THE ORDER OF THE ELEMENTS IS INVERTED. NO 54000017 * DISTINCTION IS MADE ARITHMETIC INPUT AND ALPHAMERIC INPUT. 54300017 * 54600017 GDCTI180 LTR INPL,INPL SHOULD CONVERSION BE IN PLACE 54900017 BP GDCTI190 YES 55200017 MVC 0(2,TOAD),0(FRAD) INVERT ARRAYS 55500017 SH ELCT,NH1 DECREMENT ELEMENT COUNT 55800017 B GDCTI200 56100017 GDCTI190 LH SLAVE,0(TOAD) SAVE ELEMENT FROM OVERLAY 56400017 MVC 0(2,TOAD),0(FRAD) INVERT ARRAY 56700017 STH SLAVE,0(FRAD) 57000017 SH ELCT,NH2 DECREMENT ELEMENT COUNT 57300017 GDCTI200 LTR ELCT,ELCT IS INVERSION COMPLETE 57600017 BC 12,GDCTI205 YES 57900017 AH FRAD,NH2 ADJUST INPUT ARRAY INDEX 58200017 SH TOAD,NH2 ADJUST OUTPUT ARRAY INDEX 58500017 B GDCTI180 58800017 GDCTI205 LTR MOVE,MOVE MUST DATA BE CONVERTED AND MOVED 59100017 BZ GDCTI250 NO 59400017 LM FRAD,ELCT,0(PLIST) GET PARAMETERS 59700017 L ELCT,0(ELCT) GET ELEMENT COUNT 60000017 LR SLAVE,ELCT COMPUTE THE ADDRESS 60300017 SH SLAVE,NH1 OF THE LAST 60600017 SLL SLAVE,1 ELEMENT IN THE 60900017 AR FRAD,SLAVE INPUT ARRAY 61200017 LR SLAVE,ELCT COMPUTE THE ADDRESS 61500017 SH SLAVE,NH1 OF THE LAST 61800017 SLL SLAVE,2 ELEMENT IN THE 62100017 AR TOAD,SLAVE OUTPUT ARRAY 62400017 GDCTI207 LH CON1,0(FRAD) GET AN UNCONVERTED NUMBER 62700017 SLL CON1,16 POSITION SIGN BIT 63000017 SRA CON1,16 POSITION DATA 63300017 ST CON1,0(TOAD) STORE CONVERTED NUMBER 63600017 BCT ELCT,GDCTI208 IS CONVERSION COMPLETE 63900017 B GDCTI250 YES 64200017 GDCTI208 SH FRAD,NH2 ADJUST INPUT ARRAY ADDRESS 64500017 SH TOAD,NH4 ADJUST OUTPUT ARRAY ADDRESS 64800017 B GDCTI207 65100017 * 65400017 * WHEN THE LENGTH OF THE OUTPUT ELEMENTS IS 4 BYTES THE ELEMENT FORMAT, 65700017 * AS WELL AS THEIR ARRAY ORDER MUST CHANGE. 66000017 * 66300017 GDCTI210 LH CON1,0(FRAD) GET AN UNCONVERTED NUMBER 66600017 SLL CON1,16 POSITION SIGN BIT 66900017 SRA CON1,16 POSITION DATA 67200017 CH ELCT,NH1 IS CONVERSION COMPLETE 67500017 BNE GDCTI220 NO 67800017 ST CON1,0(TOAD) STORE CONVERTED NUMBER 68100017 B GDCTI250 68400017 GDCTI220 LH CON2,2(FRAD) GET AN UNCONVERTED NUMBER 68700017 SLL CON2,16 POSITION SIGN BIT 69000017 SRA CON2,16 POSITION DATA 69300017 LTR INPL,INPL SHOULD CONVERSION BE IN PLACE 69600017 BZ GDCTI225 NO 69900017 LH CON3,0(LASTL) GET AN UNCONVERTED NUMBER 70200017 SLL CON3,16 POSITION SIGN BIT 70500017 SRA CON3,16 POSITION DATA 70800017 ST CON3,0(FRAD) STORE CONVERTED NUMBER 71100017 SH ELCT,NH1 ADJUST ELEMENT COUNT 71400017 SH LASTL,NH2 ADJUST IN PLACE POINTER 71700017 GDCTI225 CH ELCT,NH3 ARE THERE ONLY 3 ELEMENTS 72000017 BNE GDCTI230 NO 72300017 LH CON3,4(FRAD) GET AN UNCONVERTED NUMBER 72600017 SLL CON3,16 POSITION SIGN BIT 72900017 SRA CON3,16 POSITION DATA 73200017 ST CON1,0(TOAD) STORE CONVERTED NUMBER 73500017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 73800017 ST CON2,0(TOAD) STORE CONVERTED NUMBER 74100017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 74400017 ST CON3,0(TOAD) STORE CONVERTED NUMBER 74700017 B GDCTI250 75000017 GDCTI230 ST CON1,0(TOAD) STORE CONVERTED NUMBER 75300017 SH ELCT,NH2 ADJUST ELEMENT COUNT 75600017 LTR ELCT,ELCT IS CONVERSION COMPLETE 75900017 BZ GDCTI240 YES 76200017 BM GDCTI250 76500017 AH FRAD,NH4 ADJUST INPUT ARRAY INDEX 76800017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 77100017 ST CON2,0(TOAD) STORE CONVERTED NUMBER 77400017 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 77700017 B GDCTI210 78000017 GDCTI240 SH TOAD,NH4 ADJUST OUTPUT ARRAY INDEX 78300017 ST CON2,0(TOAD) STORE CONVERTED NUMBER 78600017 GDCTI250 RETURN (14,12),T 78900017 EJECT 79200017 * 79500017 * DEFINE CONSTANTS 79800017 * 80100017 NH1 DC H'1' 80400017 NH2 DC H'2' 80700017 NH3 DC H'3' 81000017 NH4 DC H'4' 81300017 NH256 DC H'256' 81600017 MOVE1 MVC 0(0,TOAD),0(FRAD) 81900017 MOVE2 MVC 0(0,BOTMT),0(BOTMF) 82200017 END 82500017 ./ ADD SSI=00012448,NAME=IKDGTCLR,SOURCE=0 TITLE 'IKDGTCLR' PROCESSOR-TO-PROCESSOR CONTROLLER 00400017 *STATUS: CHANGE LEVEL 000 * 00800017 *FUNCTION/OPERATION: TO PROVIDE LINKAGE TO THE PTOP DATA TRANSMISSION * 01200017 * ROUTINES BY PROVIDING ENTRY POINTS. * 01600017 * * 02000017 *ENTRY POINTS: ENTRY VIA A CALL FROM THE PTOP USER AT * 02400017 * GTNIT * 02800017 * GTEND * 03200017 * GTRED * 03600017 * GTWRT * 04000017 * GTCLT * 04400017 * * 04800017 *INPUT: REGISTER 1 POINTS TO THE CALLING SEQUENCE PARAMETER LIST * 05200017 * * 05600017 *OUTPUT: LINKAGE TO THE REQUESTED ROUTINE PASSING THE INPUT PARAMETER * 06000017 * LIST IN REGISTER 11 * 06400017 * * 06800017 *EXTERNAL ROUTINES: THE FOLLOWING PTOP DATA TRANSMISSION ROUTINES ARE * 07200017 * INVOKED: * 07600017 * 1. IKDGTNIT VIA LINK - INITIALIZE PTOP PROGRAM * 08000017 * 2. IKDGTEND VIA LINK - TERMINATE PTOP PROGRAM * 08400017 * 3. IKDRDWRT VIA BALR - INITIATES USER READ/WRITE FUNCTIONS * 08800017 * 4. IKDGTCLT VIA BALR - PROVIDES USER I/O STATUS * 09200017 * * 09600017 *EXITS-NORMAL: RETURN TO USER * 10000017 * -ERROR: NONE * 10400017 * * 10800017 *TABLES/WORK AREAS: GRAPHIC TELECOMMUNICATIONS CONTROL BLOCK * 11200017 * * 11600017 *ATTRIBUTES: PROBLEM PROGRAM RESIDENT, REENTRANT, NON PRIVELEGED * 12000017 * * 12400017 *NOTES: NONE * 12800017 R0 EQU 0 REGISTER EQUATES 13200017 RPRAM EQU 1 CONTINUED 13600017 R1 EQU 1 CONTINUED 14000017 R2 EQU 2 CONTINUED 14400017 RUATBL EQU 3 CONTINUED 14800017 RDSRN EQU 4 CONTINUED 15200017 RGTCB EQU 4 CONTINUED 15600017 R5 EQU 5 CONTINUED 16000017 RCODE EQU 6 CONTINUED 16400017 RBASE EQU 7 CONTINUED 16800017 RPASS EQU 11 CONTINUED 17200017 RSAVE EQU 13 CONTINUED 17600017 R14 EQU 14 CONTINUED 18000017 R15 EQU 15 CONTINUED 18400017 * 19200017 * PROGRAM EQUATES DEFINED 19600017 * 20000017 ZERO EQU 0 20400017 ONE EQU 1 20800017 TWO EQU 2 21200017 THREE EQU 3 21600017 FOUR EQU 4 22000017 FIVE EQU 5 22400017 EIGHT EQU 8 22800017 NITSTAT EQU 20 23200017 SVINFO EQU 20 23600017 ASYNC EQU X'20' 24000017 ASYSV EQU 36 24400017 FLGS EQU 36 24800017 LNG EQU 200 25200017 ENTAD EQU 396 25600017 CNT EQU 412 26000017 SVAR EQU 416 26400017 IKDGTCLR CSECT 26800017 USING *,15 27200017 ENTRY GTNIT 27600017 GTNIT LA R0,ONE INSERT GTNIT SW IN REG 0 28000017 B CONTROL BRANCH TO CONTROLLER ENTRY 28400017 USING *,15 28800017 ENTRY GTRED 29200017 GTRED LA R0,TWO INSERT GTRED SW IN REG 0 29600017 B CONTROL BRANCH TO CONTROLLER ENTRY 30000017 USING *,15 30400017 ENTRY GTWRT 30800017 GTWRT LA R0,THREE INSERT GTWRT SW IN REG 0 31200017 B CONTROL BRANCH TO CONTROLLER ENTRY 31600017 USING *,15 32000017 ENTRY GTCLT 32400017 GTCLT LA R0,FOUR INSERT GTCLT SW IN REG 0 32800017 B CONTROL BRANCH TO CONTROLLER ENTRY 33200017 USING *,15 33600017 ENTRY GTEND 34000017 GTEND LA R0,FIVE INSERT GTEND SW IN REG 0 34400017 B CONTROL BRANCH TO CONTROLLER ENTRY 34800017 CONTROL SAVE (14,12) 35200017 * 35600017 DROP 15 36000017 BALR RBASE,R0 ESTABLISH ADDRESSIBILITY 36400017 USING *,RBASE 36800017 * 37200017 LR RPASS,RPRAM PASS USER PARAM LIST 37600017 LR RCODE,R0 SAVE ENTRY POINT CODE 38000017 SR RDSRN,RDSRN SET REG 4 TO ZERO 38400017 SR R2,R2 SET R2 EQ ZERO 38800017 * 39200017 CHGTCB L RDSRN,ZERO(RPASS) LOAD DSRN ADCON 39600017 L RDSRN,ZERO(RDSRN) LOAD DSR NUMBER AND USE AS INDEX 40000017 C RDSRN,MAXDSRN IS DSRN GREATER THAN 99 40400017 BNH LOADTBL BRANCH IF NOT 40800017 * 41200017 C RCODE,ONECON IS IT REQUEST TO GTNIT 41600017 BNE ERR1 BRANCH IF NOT 42000017 * 42400017 L R2,NITSTAT(RPASS) LOAD ADR OF USER STAT AREA 42800017 L R1,TWOCON LOAD CODE 43200017 LNR R1,R1 SET CODE NEGATIVE 43600017 ST R1,ZERO(R2) STORE IT IN USERS AREA 44000017 B RETURN BRANCH TO RETURN TO USER 44400017 * 44800017 ERR1 C RCODE,FOURCON IS IT A GTCLT REQUEST 45200017 BNE RETURN BRANCH IF NOT 45600017 * 46000017 SETCOD L R2,EIGHT(RPASS) LOAD RET AREA ADCON 46400017 MVC ZERO(FOUR,R2),TWOCON INSERT RETURN CODE IN USEA AREA 46800017 B RETURN RETURN TO USER 47200017 * 47600017 LOADTBL EQU * 48000017 LOAD EP=IKDUATBL LOAD UNIT ASMT TABLE MODULE 48400017 * 48800017 LR RUATBL,R0 SAVE PTOP UATBL ADR 49200017 * 49600017 L R2,CNT(RUATBL) LOAD GTCB CNT FLD 50000017 LTR R2,R2 COUNT EQ 0 50400017 BZ GETGTCB BRANCH IF YES 50800017 DELETE EP=IKDUATBL 51200017 * 51600017 GETGTCB EQU * 52000017 S RDSRN,ONECON USE DSRN AS INDEX TO REFERENCE 52400017 SLL RDSRN,TWO APPROPRIATE GTCB ADR FIELD 52800017 AR RDSRN,RUATBL ADD ADR OF UNIT ASGMT TBL 53200017 L RDSRN,ZERO(RDSRN) LOAD ADDRESS OF GTCB 53600017 LTR RDSRN,RDSRN DOES GTCB ADDRESS EXIST 54000017 BZ ISNIT BRANCH IF NOT 54400017 * 54800017 * IS THIS A REQUEST FROM THE USER'S ASYNCHRONOUS ROUTINE 55200017 * 55600017 USING IKDGTCB,RGTCB 56000017 * 56400017 SR R5,R5 SET R5 TO ZERO 56800017 TM GTCFLAGS,ASYNC IS THIS AS ASYN RTN CALL 57200017 BZ SETMLSV BRANCH IF NOT 57600017 * 58000017 L R5,GTCSVINF LOAD PTR TO ML-STATUS-SVAREA 58400017 ASYNREQ LA R5,ASYSV(R5) LOAD ADR OF ASYN SVAREA 58800017 ST RSAVE,FOUR(R5) SET UP SVAREA CONVENTIONS 59200017 ST R5,EIGHT(RSAVE) CONTINUE 59600017 LR RSAVE,R5 CONTINUE 60000017 B CALLNIT BRANCH TO CHECK CALL 60400017 * 60800017 SETMLSV ST RSAVE,SVAR+FOUR(RUATBL) SET UP SAVE AREA 61200017 LR R2,RSAVE CONTINUE 61600017 LA RSAVE,SVAR(RUATBL) CONTINUE 62000017 ST RSAVE,EIGHT(R2) CONTINUE 62400017 * 63200017 CALLNIT C RCODE,ONECON IS THIS A CALL TO GTNIT 63600017 BNE CHKON BRANCH IF NOT 64000017 * 64400017 LINKNIT LINK EP=IKDGTNIT LINK TO AND EXECUTE GTNIT RTN 64800017 * 65200017 LTR R15,R15 WAS INIT SUCCESSFUL 65600017 BP RESTORE BRANCH IF NOT 65900017 * 66200017 TESTASYN TM GTCFLAGS,ASYNC ASYN RTN REQUEST 66500017 BZ NOTASYN BRANCH IF NOT 66800017 * 67100017 L RSAVE,FOUR(RSAVE) RESTORE USER'S REG 13 67400017 B RETURN RETURN TO USER 67700017 * 68000017 RESTORE L RSAVE,SVAR+FOUR(RUATBL) RESTORE SAVE REGISTER 68300017 * 69200017 DELETE EP=IKDUATBL DELETE PTOP UNIT ASSIGNMT TABLE 69600017 * 70000017 * 70400017 RETURN RETURN (14,12),T 70800017 * 71200017 CHKON C RCODE,FIVECON IS IT A GTEND REQ 71600017 BNE BRCHRTN BRANCH IF NOT 72000017 * 72400017 LINK EP=IKDGTEND 72800017 * 73200017 LTR R15,R15 IS RETURN CODE FROM GTEND ZERO 73600017 BZ RESTORE BRANCH IF YES 74000017 * 74400017 C R15,FOURCON DOES CODE EQUAL 4 74800017 BE FREEASYN BRANCH IF YES 75200017 * 75600017 NOTASYN L RSAVE,SVAR+FOUR(RUATBL) RESTORE ML SVAR PTR 76000017 B RETURN RETURN TO USER 76400017 * 76800017 FREEASYN L RSAVE,FOUR(RSAVE) RESTORE USER'S REG 13 77200017 L R0,SVGET LOAD FREEMAIN REQUEST 77600017 L R1,GTCSVINF LOAD ADR OF ML-STATUS-SAVAREA 78000017 * 78400017 FREEMAIN R,LV=(0),A=(1) FREE ASYN RTN SVAR 78800017 * 79200017 B RETURN RETURN TO USER 79600017 * 80000017 ISNIT EQU * 80400017 C RCODE,ONECON WAS IT REQUEST FOR GTNIT 80800017 BNE ERR1 BRANCH IF NOT 81200017 B SETMLSV BRANCH TO SET UP SAVE AREA 81600017 * 82000017 BRCHRTN S RCODE,TWOCON SET UP INDEX TO GTWRT,GTRED, OR 82400017 SLL RCODE,TWO GTCLT ROUTINE 82800017 LR R15,RUATBL LOAD ADR OF PTOP UNIT ASGMT TBL 83200017 LA R15,ENTAD(R15) ADD ENTRY ADDRESSES DISPLACEMT 83600017 AR R15,RCODE ADD INDEX TO APPROPRIATE RTN 84000017 L R15,ZERO(R15) LOAD ADDRESS OF APPROPRIATE RTN 84400017 BALR R14,R15 BRANCH AND LINK TO ROUTINE 84800017 * 85200017 B TESTASYN BRANCH TO ASYN REQUEST CHECK 85600017 * 86000017 * CONSTANTS DEFINED 86400017 * 86800017 ZEROCON DC F'0' CONSTANT 0 87200017 ONECON DC F'1' CONSTANT 1 87600017 TWOCON DC F'2' CONSTANT 2 88000017 FOURCON DC F'4' CONSTANT 4 88400017 FIVECON DC F'5' CONSTANT 5 88800017 MAXDSRN DC F'99' LARGEST VALID DSRN 89200017 SVGET DC F'200' ASYN SVAR GETMAIN LENGTH 89600017 CNOP 0,4 90000017 COPY IKDGTCB 90400017 END 90800017 ./ ADD SSI=00012434,NAME=IKDGTCLT,SOURCE=0 TITLE 'IKDGTCLT' PROCESSOR-TO-PROCESSOR CONTROL/TEST ROUTINE 00500017 *STATUS: CHANGE LEVEL 000 * 01000017 *FUNCTION/OPERATION: 1. TO FURNISH LAST READ/WRITE STATUS FOR USER * 01500017 * 2. TO WAIT FOR I/O COMPLETION * 02000017 * * 02500017 *ENTRY POINTS: AT IKDGTCLT VIA BALR FROM IKDGTCLR (CONTROLLER) * 03000017 * * 03500017 *INPUT: REGISTER 11 POINTS TO USER'S PARAMETER LIST * 04000017 * REGISTER 4 POINTS TO GTCB REFERENCED BY USER'S DSRN * 04500017 * * 05000017 *OUTPUT: STATUS CODE FOR USER'S LAST READ/WRITE PLACED IN USER AREA * 05500017 * * 06000017 *EXTERNAL ROUTINES: NONE * 06500017 * * 07000017 *EXITS-NORMAL: RETURN TO CONTROLLER VIA RETURN MACRO * 07500017 * -ERROR: NONE * 08000017 * * 08500017 *TABLES/WORK AREAS: GRAPHIC TELECOMMUNICATIONS CONTROL BLOCK * 09000017 * * 09500017 *ATTRIBUTES: PROBLEM PROGRAM MODE,AND PROBLEM PROGRAM RESIDENT * 10000017 * * 10500017 *NOTES: N/A * 11000017 R0 EQU 0 REGISTER EQUATES 11500017 R1 EQU 1 CONTINUED 12000017 R2 EQU 2 CONTINUED 12500017 R3 EQU 3 CONTINUED 13000017 RGTCB EQU 4 CONTINUED 13500017 RCODE EQU 5 CONTINUED 14000017 RSTAT EQU 6 CONTINUED 14500017 RBASE EQU 7 CONTINUED 15000017 RPRAM EQU 11 CONTINUED 15500017 RSAVE EQU 13 CONTINUED 16000017 R14 EQU 14 CONTINUED 16500017 R15 EQU 15 CONTINUED 17000017 * * 18500017 * PROGRAM EQUATE STATEMENTS * 19000017 * * 19500017 ZERO EQU 0 20000017 CODE2 EQU 2 20500017 THREE EQU 3 21000017 FOUR EQU 4 21500017 CODE4 EQU 4 22000017 CODE5 EQU 5 22500017 EIGHT EQU 8 23000017 ASVDISP EQU 72 23500017 GTEND EQU X'01' 24000017 READ EQU X'01' 24500017 READWAIT EQU X'03' 25000017 WRITWAIT EQU X'04' 25500017 ASYNC EQU X'20' ASYNC RTN IN CONTROL 26000017 WTCLT EQU X'40' 26500017 WTCLT1 EQU X'41' 27000017 LNGOFF EQU X'7B' 27200017 SETOFF EQU X'7F' 27500017 OKNIT EQU X'80' 28000017 PEND EQU X'80' 28500017 CONTEND EQU X'84' 29000017 LNGPND EQU X'87' 29200017 OFFWT1 EQU X'BE' 29500017 OFFWT2 EQU X'BF' 30000017 * 30500017 * 31000017 IKDGTCLT CSECT 31500017 SAVE (14,12),,* 32000017 BALR RBASE,R0 ESTABLISH BASE REG 32500017 USING *,RBASE CONTINUE 33000017 USING IKDGTCB,RGTCB ESTABLISH BASE FOR GTCB DSECT 33500017 SR R2,R2 SET REG 2 TO 0 34000017 TM GTCFLAGS,ASYNC ASYNC RTN IN CONTROL 34500017 BO ASYNSV BRANCH IF YES 35000017 * 35500017 ST RSAVE,GTCSVAR+FOUR SET UP ML SVAREA CHAIN 36000017 LR R2,RSAVE CONTINUE 36500017 LA RSAVE,GTCSVAR CONTINUE 37000017 ST RSAVE,EIGHT(R2) CONTINUE 37500017 TESTCODE EQU * READ OR WRITE TEST REQUEST CHECK 38000017 SR R2,R2 SET R2 TO ZERO 38500017 LM RCODE,RSTAT,FOUR(RPRAM) LOAD PARAM LIST ADDRESSES 39000017 CLI THREE(RCODE),FOUR IS TESTCODE VALID 39500017 BH SETCD2 BRANCH IF NOT 40000017 * 40500017 TM GTCFLAGS,GTEND HAS 1130 USER GTENDED 41000017 BZ TESTNIT BRANCH IF NOT 41500017 LA R2,CODE5 LOAD STATCODE 42000017 B SET BRANCH TO INSERT CODE 42500017 TESTNIT TM GTCFLAGS,OKNIT HAS 360 USER INITIALIZED OK 43000017 BO RDTEST BRANCH IF TEST 43500017 SETCD2 EQU * OTHERWISE 44000017 LA R2,CODE2 SET STATCODE TO 2 44500017 B SET BRANCH TO INSERT CODE 45000017 RDTEST TM THREE(RCODE),READ READ TEST 45500017 BZ WRTEST BRANCH IF NOT 46000017 * 46500017 CLI GTCLSTRD,ZERO HAS A READ BEEN ISSUED 47000017 BE SETCD2 BRANCH IF NOT 47500017 * 48000017 CLI GTCLSTRD,CONTEND READ CONTENTION 48500017 BNE RDWTEST BRACNH IF NOT 49000017 SETCD4 EQU * OTHERWISE 49400017 LA R2,CODE4 SET CODE TO 4 49800017 B SET BRANCH TO INSERT CODE 50200017 * 50600017 RDWTEST CLI THREE(RCODE),READWAIT IS READ AND WAIT TEST REQ'D 51000017 BNE WRGLNG BRANCH IF NOT 51500017 * 52000017 TM GTCLSTRD,PEND HAS I/O COMPLETED 52500017 BZ SETRD BRANCH IF YES 53000017 * 53500017 OI FLGS3,WTCLT1 SET WAIT ON READ BIT 54000017 MVI GTCECB,ZERO CLEAR ECB 54500017 LA R1,GTCECB PUT ECB ADR IN REG 1 55000017 WAIT ECB=(1) WAIT FOR I/O COMPLETION 55500017 * 56000017 NI FLGS3,OFFWT1 56500017 TM GTCFLAGS,GTEND HAS 1130 ENDED 57000017 BZ IFCONT BRANCH IF NOT 57500017 * 58000017 LA R2,CODE5 SET GTEND CODE = 5 58500017 B SET BRANCH TO INSERT CODE 59000017 * 59500017 IFCONT EQU * CHECK CONTENTION 60000017 CLI GTCLSTRD,CONTEND IS READ IN CONTENTION 60500017 BNE SETRD BRANCH IF NOT 61000017 B SETCD4 BRANCH TO SET CODE = 4 61500017 * 62000017 WRGLNG EQU * 62050017 CLI GTCLSTRD,LNGPND WAS BAD LNG INDICATED 62100017 BNE SETRD BRANCH IF NOT 62150017 * 62200017 IC R2,GTCLSTRD INSERT LAST READ STATUS 62250017 LA R3,LNGOFF INSERT PENDING BIT OFF VALUE 62300017 NR R2,R3 TURN OFF HIGH ORDER STATUS BIT 62350017 B SET BRANCH TO INSERT CODE 62400017 * 62450017 SETRD IC R2,GTCLSTRD INSERT STATUS 62500017 BITOFF EQU * 63000017 LA R3,SETOFF 63500017 NR R2,R3 TURN OFF PENDING BIT 64000017 * 64500017 SET ST R2,ZERO(RSTAT) PLACE CODE IN USER AREA 65000017 * 65500017 * 66000017 TM GTCFLAGS,ASYNC ASYNC RTN REQ 66500017 BO ASYNRET BRANCH IF YES 67000017 * 67500017 L RSAVE,GTCSVAR+FOUR RESTORE CALLER'S SVAREA PTR 68000017 RETURN RETURN (14,12),T 68500017 * 69000017 * 69500017 ASYNSV EQU * 70000017 LA R1,ASVDISP(RSAVE) LOAD ADR OF ASYSV AR 70500017 ST RSAVE,FOUR(R1) SAVE CALLER'S SVAREA PTR 71000017 ST R1,EIGHT(RSAVE) EST SVAREA CHAIN 71500017 LR RSAVE,R1 CONTINUE 72000017 B TESTCODE BRANCH TO CHECK REQUEST 72500017 * 73000017 * 73500017 ASYNRET L RSAVE,FOUR(RSAVE) RESTORE SAVE AREA PTR 74000017 B RETURN BRANCH TO RETURN TO CALLER 74500017 * 75000017 * 75500017 WRTEST EQU * 76000017 CLI GTCLSTWR,ZERO HAS A WRITE BEEN ISSUED 76500017 BE SETCD2 BRANCH IF NOT 77000017 * 77500017 TM THREE(RCODE),WRITWAIT WAIT ON WRITE REQUEST 78000017 BZ PUTWRT BRANCH IF NOT 78500017 * 79000017 TM GTCLSTWR,PEND HAS I/O COMPLETED 79500017 BZ PUTWRT BRANCH IF YES 80000017 * 80500017 OI FLGS3,WTCLT SET GTCLT IN WAIT STATE FLAG 81000017 MVI GTCECB,ZERO CLEAR ECB 81500017 LA R1,GTCECB PUT ADR OF ECB IN REG 1 82000017 WAIT ECB=(1) WAIT FOR I/O 82500017 * 83000017 NI FLGS3,OFFWT2 SET WAIT FLG OFF IN GTCB 83200017 TM GTCFLAGS,GTEND HAS 1130 USER CALLED GTEND 83580017 BZ PUTWRT BRANCH IF NOT 83660017 * 83740017 LA R2,CODE5 SET CODE = 5 83820017 B SET BRANCH TO INSERT CODE 84120017 * 84420017 PUTWRT IC R2,GTCLSTWR INSERT LAST WRITE STATUS 84720017 B BITOFF BRANCH TO SET PENDING BIT OFF 85020017 * 85320017 CNOP 0,4 86000017 COPY IKDGTCB 86500017 END 87000017 ./ ADD SSI=00010310,NAME=IKDGTEND,SOURCE=0 TITLE 'IKDGTEND' PROCESSOR-TO-PROCESSOR TERMINATION ROUTINE 00300017 *STATUS: CHANGE LEVEL 000 * 00600017 *FUNCTION/OPERATION: TO TERMINATE THE PROCESSOR-TO-PROCESSOR PROGRAM * 00900017 * 1. CLOSE/DISABLE THE BTAM COMMUNICATION LINE * 01200017 * 2. FREE STORAGE ACQUIRED FOR USER RD/WRT BFRS AND FOR GTCB * 01500017 * 3. DELETE IKDRDWRT, IKDGTCLT AND IKDGTIRB ROUTINES * 01800017 * 4. FOR USER ASYNCHRONOUS ROUTINE CALL TO GTEND, RESTORES MAINLINE * 02100017 * I/O STATUS * 02400017 * * 02700017 *ENTRY POINTS: ENTRY AT IKDGTEND VIA LINK FROM IKDGTCLR (CONTROLLER) * 03000017 * * 03300017 *INPUT: REGISTER 11 POINTS TO USER'S PARAMETER LIST * 03600017 * REGISTER 3 POINTS TO THE PTOP UNIT ASSIGNMENT TABLE (IKDUATBL) * 03900017 * REGISTER 4 POINTS TO THE GTCB REFERENCED BY USER'S DSRN * 04200017 * * 04500017 *OUTPUT: RETURN CODES TO IKDGTCLR (CONTROLLER) IN REGISTER 15 * 04800017 * A) ZERO - END OF USER JOB, CONTROLLER SHOULD DELETE IKDUATBL * 05100017 * B) FOUR - USER ASYNCHRONOUS ROUTINE ENDED, CONTROLLER SHOULD FREE * 05400017 * ASYNCHRONOUS ROUTINE SAVE AREA STORAGE * 05700017 * C) EIGHT - USER TERMINATED ONE BTAM LINE, OTHER LINES STILL OPEN * 06000017 * IN JOB; CONTROLLER SHOULD NOT DELETE IKDUATBL * 06300017 * * 06600017 *EXTERNAL ROUTINES: NONE * 06900017 * * 07200017 *EXITS-NORMAL: RETURN TO CONTROLLER * 07500017 * -ERROR: NONE * 07800017 * * 08100017 *TABLES/WORK AREAS: GRAPHIC TELECOMMUNICATION CONTROL BLOCK (GTCB), * 08400017 * UNIT ASSIGNMENT TABLE (IKDUATBL) * 08700017 * * 09000017 *ATTRIBUTES: REENTRANT, TRANSIENT, NON-PRIVELEGED * 09300017 * * 09600017 *NOTES: NONE * 09900017 R0 EQU 0 REGISTER EQUATES 10200017 R1 EQU 1 CONTINUED 10500017 R2 EQU 2 CONTINUED 10800017 RUATBL EQU 3 CONTINUED 11100017 RGTCB EQU 4 CONTINUED 11400017 R5 EQU 5 CONTINUED 11700017 RBASE EQU 7 CONTINUED 12000017 RDCB EQU 8 CONTINUED 12300017 RASYNSV EQU 9 CONTINUED 12600017 RSAVE EQU 13 CONTINUED 12900017 R14 EQU 14 CONTINUED 13200017 R15 EQU 15 CONTINUED 13500017 * 13800017 ZERO EQU 0 PROGRAM EQUATES 14100017 ONE EQU 1 EQUATE 1 14400017 TWO EQU 2 EQUATE 2 14700017 THREE EQU 3 EQUATE 3 15000017 FOUR EQU 4 EQUATE 4 15300017 FIVE EQU 5 EQUATE 5 15600017 SIX EQU 6 EQUATE 6 15900017 EIGHT EQU 8 EQUATE 8 16200017 AFLGS EQU 12 EQUATE 12 16500017 INFO EQU 28 EQUATE 28 16800017 UCBAD EQU 32 EQUATE 32 17100017 SVDISP EQU 72 EQUATE 72 17400017 USECNT EQU 412 USECNT FIELD DISP IN UATBL 17700017 * 18000017 GTEND EQU X'01' FLAG BIT 18300017 ASYEND EQU X'0200' HEADER FOR ASYN MSG END 18600017 HDRLNG EQU X'04' HDR LENGTH 18900017 MSGEND EQU X'0800' HDR FOR END MSG 19200017 WTIXR EQU X'10' OP TYPE FLAG 19500017 ASYNC EQU X'20' 1130 ASYN REQ FLAG 19800017 WTASY EQU X'20' WAIT FOR ASYN END MSG FLAG 20100017 HALTIO EQU X'48' HALT I/O COMPLETION CODE 20400017 WTOFF EQU X'5F' TURN OFF CODE 20700017 ENDOFF EQU X'7F' OFF CODE 21000017 BIT EQU X'80' HI-ORDER BIT 21300017 WTEND EQU X'80' WAIT FOR END MSG FLAG 21600017 STARTED EQU X'83' STATUS CODE = 3 21900017 ASYREQ EQU X'88' ASYN END MSG HEADER 22200017 TERMREQ EQU X'98' END MSG HEADER 22500017 ENDASY EQU X'DF' OFF FLAG 22800017 IKDGTEND CSECT 26400017 SAVE (14,12),,* 26800017 BALR RBASE,R0 ESTABLISH BASE REGISTER 7 27200017 USING *,RBASE CONTINUE 27600017 USING IKDGTCB,RGTCB EST. GTCB DSECT BASE REG 4 28000017 LA RDCB,GTCDCB EST. DCB DSECT BASE 28400017 USING IHADCB,RDCB CONTINUE 28800017 * 29200017 TM GTCFLAGS,ASYNC ASYN ROUTINE REQUEST 29600017 BO ASYNSV BRANCH IF YES 30000017 ST RSAVE,GTCSVAR+FOUR EST. SAVE AREA CHAIN 30400017 LR R2,RSAVE CONTINUE 30800017 LA RSAVE,GTCSVAR CONTINUE 31200017 ST RSAVE,EIGHT(R2) CONTINUE 31600017 OI FLGS3,WTEND SET GTEND RTN ENTERED FLAG 32000017 PENDING EQU * CHECK I/O STATUS 32400017 MVI GTCECB,ZERO CLEAR ECB TO 0 32800017 CLI GTCLSTWR,STARTED HAS USER WRITE BEEN STARTED 33200017 BNE CHKPTOP BRANCH IF NOT 33600017 * 34000017 WAITWRT EQU * 34400017 LA R1,GTCECB 34800017 OI FLGS3,WTEND SET GTEND IN WAIT STATE FLAG 35200017 WAIT ECB=(1) WAIT FOR PENDING USER WRITE 35600017 * 36000017 NI FLGS3,ENDOFF SET WAIT FLG OFF 36400017 B CHKSTAT BRANCH TO RESETPL 36800017 CHKPTOP EQU * 37200017 TM FLGS2,WTIXR HAS PTOP WRITTEN A MSG 37600017 BO WAITWRT BRANCH IF YES 38000017 * 38400017 CHKSTAT EQU * ISSUE RESETPL 38800017 LA R1,GTCPDECB LOAD DECB ADR IN PARAM REG 1 39200017 RESETPL (1) HALT I/O 39600017 LA R1,GTCECB SET ECB ADDRESS 40000017 C R15,CON4 IS RETURN CODE AN ERROR TYPE 40400017 BE SETWT BRANCH IF EQUAL 40800017 * 41200017 L R2,DCBDEBAD GET UCB ADR FROM DEB 41260017 L R2,UCBAD(R2) 41320017 TM FOUR(R2),WTEND WAS HALTIO ISSUD 41380017 BNZ SETR1 SET POINTER TO DECB 41420017 LA R1,GTCPDECB 41460017 B SETWT BRANCH TO WAIT FOR I/O COMPLETEION 41500017 SETR1 EQU * 41540017 * 41580017 LA R1,GTCPDECB SET DECB POINTER 41630017 CLI GTCPDECB,HALTIO IS HALTIO COMPLETE 41680017 BE CHKASYN BRANCH IF YES 42100017 * 42400017 * 42800017 * 43200017 SETWT EQU * 43600017 TM GTCFLAGS,GTEND HAS 1130 GTENDED 44000017 BO CHKASYN BRANCH IF YES 44400017 * 44800017 OI FLGS3,WTEND SET GTEND IN WAIT STATE FLAG 45600017 WAIT ECB=(1) WAIT FOR I/O ON RESETPL 46000017 * 46400017 NI FLGS3,ENDOFF SET WAIT FLG OFF 46800017 CHKASYN EQU * 47200017 TM GTCFLAGS,ASYNC REQ FROM 360 ASYN RTN 47600017 BZ CHKEND BRANCH IF NOT 48000017 * 48400017 L R2,GTCSVINF LOAD ADR OF ML-STATUS SVAREA 48800017 MVC AFLGS(ONE,R2),GTCFLAGS MOVE FLGS1 TO SAVE AREA 49200017 MVC GTCECB(INFO),ZERO(R2) MOVE ML STATUS TO GTCB 49600017 * 50000017 CHKEND TM GTCFLAGS,GTEND HAS 1130 USER CALLED GTEND 50400017 BZ WRITE BRANCH IF NOT 50800017 * 51200017 TM GTCFLAGS,ASYNC ASYN RTN REQUEST 51600017 BO ASYNRET BRANCH IF YES 52000017 * 52400017 UPDATE LA R2,GTCDCB SET UP CLOSE PARAM LIST 52800017 ST R2,GTCPTPWR PUT DCB ADR IN LIST 53300017 MVI GTCPTPWR,BIT SET HI-ORDER BIT 53800017 LA R1,GTCPTPWR PUT LIST ADR IN PARAM REG 54300017 * 54800017 CLOSE MF=(E,(1)) CLOSE DCB 55200017 * 55600017 LH R2,GTCWRSIZ GET WR BFR SIZE 55620017 AH R2,GTCRDSIZ ADD READ BFR SIZE 55640017 L R1,GTCWRBUF LOAD ADR OF BFR 55660017 C R1,GTCRDBUF READ AND WRITE BFR SAME 55680017 BE ADD8 BRANCH IF YES 55700017 * 55720017 LA R2,EIGHT(R2) ADD HDR LNG 8 55740017 * 55760017 ADD8 LA R2,EIGHT(R2) ADD HDR LNG 8 55780017 LR R0,R2 LOAD LNG INTO PARAM REG 55800017 * 55820017 FREEMAIN R,LV=(0),A=(1) FREE RD/WR BFR CORE 55840017 * 55860017 L R0,GTCBGET LOAD GTCB LNG IN REG 0 56160017 LR R1,RGTCB PUT GTCB ADR IN REG 1 56460017 L RSAVE,GTCSVAR+FOUR SAVE CALLER'S REG 13 56760017 SR R2,R2 CLEAR REG 2 57200017 IC R2,ZERO(RGTCB) INSERT DSRN FOR INDEX 57600017 S R2,CON1 SUBTRACT 1 FROM DSRN TO INDEX 58000017 SLL R2,TWO MULTIPLY BY 4 58400017 AR R2,RUATBL ADD ADR OF PTOP UATBL 58800017 XC ZERO(FOUR,R2),ZERO(R2) CLEAR UATBL SLOT FOR GTCB ADR 59200017 * 59600017 FREEMAIN R,LV=(0),A=(1) FREE GTCB CORE 60000017 * 60400017 L R5,USECNT(RUATBL) LOAD USECNT FIELD 60800017 BCT R5,GOBACK BRANCH IF USECNT NOT ZERO 61200017 * 61600017 * 62000017 DELETE EP=IKDRDWRT 62400017 * 62800017 DELETE EP=IKDGTCLT 63200017 * 63600017 DELETE EP=IKDGTIRB 64000017 * 64400017 * 64800017 GOBACK EQU * 65200017 ST R5,USECNT(RUATBL) RESTORE UPDATED USECNT 65400017 LTR R5,R5 IS USECNT EQUAL TO ZERO 65600017 BNZ RETURNCD BRANCH IF NOT 66000017 * 66400017 RETURN (14,12),T,RC=0 RETURN TO INDICATE END OF JOB 66800017 * 67200017 * 67600017 RETURNCD RETURN (14,12),T,RC=8 RETURN TO INDICATE LINES OPEN 68000017 * 68400017 * 68800017 ASYNSV LA R2,SVDISP(RSAVE) SET UP SVAREA FOR ASYN RTN REQ 69200017 ST RSAVE,FOUR(R2) CONTINUE 69600017 ST R2,EIGHT(RSAVE) CONTINUE 70000017 LR RASYNSV,RSAVE SAVE ADR 70400017 LR RSAVE,R2 CONTINUE 70800017 B PENDING BRANCH TO CHECK I/O STATUS 71200017 * 71600017 * 72000017 * 72400017 WRITE EQU * SET UP MESSAGE 72800017 MVC GTCPTPWR(TWO),DCBBSTSX MOVE IN CTL CHARS DLE STX 73200017 MVC GTCPTPWR+THREE(ONE),GTCDSRNO COMPLETE MSG HEADER 73600017 LH R1,GTCWRSEQ UPDATE SEQUENCE NUMBER 74000017 LA R1,ONE(R1) CONTINUE 74300017 STH R1,GTCWRSEQ CONTINUE 74600017 STC R1,GTCPTPWR+FOUR INSERT SEQ NO. IN HDR 74900017 MVI GTCPTPWR+FIVE,HDRLNG FINISH HDR 75200017 * 75500017 TM GTCFLAGS,ASYNC ASYN END REQUEST 75800017 BO SETASYN BRANCH IF YES 76100017 * 76400017 MVI GTCPTPWR+TWO,TERMREQ INSERT MSG CODE 76700017 OI FLGS3,WTEND SET GTEND IN WAIT STATE TO END 77600017 LA R2,MSGEND GET END MSG CODE 78000017 B WTIXRMSG BRANCH TO ISSUE WRITE 78400017 * 78800017 SETASYN EQU * SET UP ASYN END MSG 79200017 MVI GTCPTPWR+TWO,ASYREQ INSERT CODE 79600017 LA R2,ASYEND GET ASYN END MSG CODE 80000017 OI FLGS3,WTASY SET GTEND WAITING FOR ASYN END 80400017 * * 80800017 * WRITE END MESSAGE FOR ASYN OR END * 81200017 * * 81600017 WTIXRMSG STH R2,GTCPTPWR+SIX INSERT PROPER MSG CODE 82000017 MVI FLGS2,WTIXR SET PTOP WTIXR FLAG 82400017 MVI GTCECB,ZERO CLEAR ECB TO ZERO 82800017 LA R1,GTCPDECB GET DECB ADR 83200017 LA R2,GTCPTPWR GET WRBUF ADR 83600017 WRITE (1),TIXR,(8),(2),10,,1,MF=E 84000017 * 84400017 * 84800017 WAITEND EQU * 85200017 LA R1,GTCECB 85600017 WAIT ECB=(1) WAIT FOR I/O COMPLETION 86000017 * 86400017 NI FLGS3,WTOFF SET WAIT FLAGS OFF 86800017 TM GTCFLAGS,ASYNC ASYNC END MSG REQ 87200017 BZ UPDATE BRANCH IF NOT 87600017 * 88000017 ASYNRET EQU * 88400017 NI GTCFLAGS,ENDASY SET ASYNC BIT OFF 88800017 LR RSAVE,RASYNSV RESTORE SVAR PTR 89200017 RETURN (14,12),T,RC=4 RETURN WITH RETURN CODE = 4 89600017 * * 90000017 * CONSTANTS DEFINED * 90400017 * * 90800017 CON1 DC F'1' CONSTANT EQUAL TO 1 91200017 CON4 DC F'4' CONSTANT EQUAL TO 4 91600017 GTCBGET DC F'512' LENGTH OF GTCB STORAGE 92000017 CNOP 0,4 92400017 COPY IKDGTCB 92800017 DCBD DSORG=CX,DEVD=BS 93200017 END 93600017 ./ ADD SSI=01010919,NAME=IKDGTIRB,SOURCE=0 TITLE 'IKDGTIRB' PROCESSOR-TO-PROCESSOR INTERFACE RESOLUTION ROUTINE 00090019 *STATUS: CHANGE LEVEL 000 * 00180019 *FUNTION/OPERATION: TO MONITOR THE COMPLETION OF ALL PTOP I/O AND * 00270019 * INCLUDES THE FOLLOWING - * 00360019 * 1. TO MAINTAIN THE PTOP SYSTEM READY-TO-READ ENVIRONMENT * 00450019 * 2. TO INITIATE PENDING I/O REQUESTS * 00540019 * 3. TO SCHEDULE THE S/360 USER ASYNCHRONOUS ROUTINE UPON REQUEST * 00630019 * FROM THE 1130 USER * 00720019 * * 00810019 *ENTRY POINTS: ENTRY AT IKDGTIRB VIA ASYNCHRONOUS EXIT EFFECTOR * 00900019 * * 00990019 *INPUT: REGISTER 0 CONTAINS THE ADDRESS OF THE IQE FOR THIS ROUTINE * 01080019 * REGISTER 1 POINTS TO THE IOB FOR THE COMPLETED I/O OPERATION * 01170019 * * 01260019 *OUTPUT: GTCB FIELDS AND FLAGS UPDATED TO REFLECT PTOP I/O STATUS * 01350019 * * 01440019 *EXTERNAL ROUTINES: NONE * 01530019 * * 01620019 *EXITS-NORMAL: RETURN TO I/O SUPERVISOR * 01710019 * -ERROR: NONE * 01800019 * * 01890019 *TABLES/WORK AREAS: GTCB,BTAM DCB, * 01980019 * * 02070019 *ATTRIBUTES: REENTRANT,PRIVILEGED MODE,PROBLEM PROGRAM RESIDENT, * 02160019 * ASYNCHRONOUS EXIT ROUTINE * 02250019 * * 02340019 *NOTES: CONTROL IS PASSED TO THIS ROUTINE WHEN BTAM BSC CHANNEL OR * 02430019 * EXCEPTIONAL END APPENDAGE RECOGNIZES THAT THE I/O COMPLETED WAS * 02520019 * FOR THE PTOP USER, THUS SCHEDULING THE ROUTINE VIA ASYNCHRONOUS * 02610019 * EXIT EFFECTOR, STAGE 2 * 02700019 R0 EQU 0 WORK REGISTER 02790019 R1 EQU 1 WORK REGISTER 02880019 R2 EQU 2 WORK REGISTER 02970019 R3 EQU 3 WORK REGISTER 03060019 RGTCB EQU 4 GTCB DSECT REGISTER 03150019 RDECB EQU 5 DECB REGISGER 03240019 RDCB EQU 6 DCB DSECT REGISTER 03330019 RBASE EQU 7 BASE REGISTER 03420019 RBFR EQU 8 BFR ADR REGISTER 03510019 RIRB EQU 9 FOR USER ASYN RTN SCHEDULING 03600019 RIOB EQU 11 IOB ADR REGISTER 03690019 RSAVE EQU 13 SAVE AREA REGISTER 03780019 R14 EQU 14 03870019 R15 EQU 15 03960019 ZERO EQU 0 EQUATE 0 04050019 ONE EQU 1 EQUATE 1 04140019 TWO EQU 2 EQUATE 2 04230019 THREE EQU 3 EQUATE 3 04320019 FOUR EQU 4 EQUATE 4 04410019 STAGE2 EQU 4 AEE STAGE 2 ADR DISP 04500019 CURTCB EQU 4 CURRENT TCB ADR DISP 04590019 FIVE EQU 5 EQUATE 5 04680019 TYPE EQU 5 EQUATE 5 04770019 SIX EQU 6 EQUATE 6 04860019 SEVEN EQU 7 EQUATE 7 04950019 EIGHT EQU 8 EQUATE 8 05040019 MSGLNG EQU 10 EQUATE 10 05130019 BFAD EQU 12 EQUATE 12 05220019 TCB EQU 12 TCB ADR DISP 05310019 PASLNG EQU 14 PASSWORD MSG LNG 05400019 DECSENS0 EQU 16 DECB SENSE FIELD 0 05490019 CVTPTR EQU 16 CVT DISP 05580019 COUNT EQU 18 EQUATE 18 05670019 DCBDISP EQU 20 DISP OF DCB ADR IN IOB 05760019 DECFLAGS EQU 24 DISP OF DECB FLAGS 05850019 INFO EQU 28 EQUATE 28 05940019 NEXAVL EQU 96 DISP OF IRB IQE NEKAVAIL FIELD 06030019 IQE EQU 100 DISP OF IQE IN IRB WORK AREA 06120019 LNG EQU 200 EQUATE 200 06210019 EQ255 EQU 255 EQUATE 255 06300019 * 06390019 GTEND EQU X'01' FLAGS 06480019 RTI EQU X'01' FLAGS 06570019 READ EQU X'01' FLAGS 06660019 SUCCES EQU X'01' FLAGS 06750019 SHORT EQU X'01' FLAGS 06840019 ASYMSG EQU X'02' FLAGS 06930019 COMMN EQU X'02' FLAGS 07020019 RTRPND EQU X'02' FLAGS 07110019 SVRTRD EQU X'02' FLAGS 07200019 RTT EQU X'03' FLAGS 07290019 ASYPND EQU X'04' FLAGS 07380019 HDRLNG EQU X'04' FLAGS 07470019 RTPAS EQU X'04' FLAGS 07560019 TENTION EQU X'04' FLAGS 07650019 ERROR EQU X'06' FLAGS 07740019 WRGLNG EQU X'07' FLAGS 07830019 ASYEND EQU X'08' FLAGS 07920019 A1130 EQU X'08' FLAGS 08010019 CANPND EQU X'08' FLAGS 08100019 INTVREQ EQU X'08' FLAGS 08190019 PTOPHDR8 EQU X'08' FLAGS 08280019 PTPWTR EQU X'08' FLAGS 08370019 ERRNIT2 EQU X'09' FLAGS 08460019 ERRNIT1 EQU X'0A' FLAGS 08550019 WTR EQU X'0A' FLAGS 08640019 PENDING EQU X'0E' FLAGS 08730019 ASYNIT EQU X'10' FLAGS 08820019 CANCL EQU X'10' FLAGS 08910019 CONTENTN EQU X'10' FLAGS 09000019 DATATD EQU X'10' FLAGS 09090019 ENDMSG EQU X'10' FLAGS 09180019 PTPTIXR EQU X'10' FLAGS 09270019 ASYNC EQU X'20' FLAGS 09360019 PTPRTT EQU X'20' FLAGS 09450019 RTRCTD EQU X'20' FLAGS 09540019 WTASY EQU X'20' FLAGS 09630019 ASYCTD EQU X'40' FLAGS 09720019 INTERV EQU X'40' FLAGS 09810019 PTPRTI EQU X'40' FLAGS 09900019 RTRD EQU X'40' FLAGS 09990019 WTCLTWR EQU X'40' FLAGS 10080019 WTCLTRD EQU X'41' FLAGS 10170019 HALTIO EQU X'48' FLAGS 10260019 CANOFF EQU X'77' FLAGS 10350019 CODE7F EQU X'7F' COMPLETION CODE 10440019 WTOFF EQU X'7F' FLAGS 10530019 BIGLNG EQU X'80' FLAGS 10620019 CANCTD EQU X'80' FLAGS 10710019 DATAMSG EQU X'80' FLAGS 10800019 OKNIT EQU X'80' FLAGS 10890019 PTOPHDR EQU X'80' FLAGS 10980019 USEROP EQU X'80' FLAGS 11070019 WTEND EQU X'80' FLAGS 11160019 RDPEND EQU X'82' USER STATCODE FLAGS 11250019 WRPEND EQU X'82' USER STATCODE FLAGS 11340019 STARTED EQU X'83' USER STATCODE FLAGS 11430019 CONTEND EQU X'84' USER STATCODE FLAGS 11520019 LNGWRG EQU X'87' USER STATCODE FLAGS 11610019 PNDCAN EQU X'88' FLAGS 11700019 PTPHDR88 EQU X'88' FLAGS 11790019 PTPHDR90 EQU X'90' FLAGS 11880019 USRTIXR EQU X'90' FLAGS 11970019 WTIXR EQU X'92' FLAGS 12060019 INITMSG EQU X'94' FLAGS 12150019 PTOPMSG EQU X'98' FLAGS 12240019 USRRTT EQU X'A0' FLAGS 12330019 OFF1 EQU X'BF' FLAGS 12420019 RTRDOFF EQU X'BF' FLAGS 12510019 OFF2 EQU X'DF' FLAGS 12600019 WAITST EQU X'E0' FLAGS 12690019 OFFREQ EQU X'EF' FLAGS 12780019 OFFASY EQU X'F7' FLAGS 12870019 OFFPND EQU X'F7' FLAGS 12960019 OFFCAN EQU X'FA' FLAGS 13050019 PNDOFF EQU X'FB' FLAGS 13140019 OFFSV EQU X'FD' FLAGS 13230019 ENDOFF EQU X'FE' FLAGS 13320019 PRMLST EQU IQE+16 DISP OF PARAM LIST FOR ASYN USER 13410019 * 14600019 * 14700019 * 14800019 IKDGTIRB CSECT 14900019 *2434,353000,775000-778000 14950019 SAVE (14,12),,* 15000019 BALR RBASE,R0 ESTABLISH BASE REG 7 15100019 USING *,RBASE CONTINUE 15200019 USING IKDGTCB,RGTCB BASE FOR GTCB DSECT 15300019 USING IHADCB,RDCB BASE FOR BTAM DCB DSECT 15400019 LR RIOB,R1 SAVE IOB ADR 15500019 * 15600019 L RDECB,FOUR(RIOB) LOAD ADR OF ECB (DECB ADR ALSO) 15700019 L RDCB,DCBDISP(RIOB) LOAD ADR OF PTOP DCB 15800019 LA RDCB,ZERO(RDCB) CLEAR HI-ORDER BYTE TO ZERO 15900019 LR RGTCB,RDCB 16000019 SH RGTCB,GTCBAD ACCESS GTCB ADR FROM DCB DISP 16100019 L RBFR,BFAD(RDECB) LOAD ADR OF RD/WRT BFR 16200019 L R3,ZERO(RGTCB) LOAD PTOP WATBL ADR 16300019 LA R3,ZERO(R3) CLEAR HI-ORDER BYTE 16400019 SR R1,R1 16500019 IC R1,ZERO(RGTCB) INSERT DSRN 16600019 SH R1,CON1 SUBTRACT 1 FROM DSRN 16700019 SLL R1,TWO MULTIPLY BY 4 16800019 AR R3,R1 ADD TO UATBL ADR 16900019 C RGTCB,ZERO(R3) IS THIS A VALID GTCB 17000019 BE SVCHAIN BRANCH IF YES 17100019 * 17200019 B RETURN OTHERWISE RETURN CONTROL TO SUPR 17400019 * 17500019 SVCHAIN EQU * ESTABLISH SVAREA CHAIN 17600019 ST RSAVE,GTCIRBSV+FOUR CONTINUE 17700019 LR R1,RSAVE CONTINUE 17800019 LA RSAVE,GTCIRBSV CONTINUE 17900019 ST RSAVE,EIGHT(R1) CONTINUE 18000019 * 18200019 CLI ZERO(RDECB),HALTIO WAS HALT I/O ISSUED 18300019 BE RESTORE BRANCH IF YES 18400019 * 18500019 IOTYPE EQU * 18600019 TM FIVE(RDECB),READ I/O OPERATION A READ 18700019 BO RDTYP BRANCH IF YES 18800019 * 18900019 CLI TYPE(RDECB),WTIXR IOTYPE A WRITE TIXR 19000019 BE WRTYP BRANCH IF YES 19100019 * 19200019 * 19500019 CLI TYPE(RDECB),WTR IOTYPE WRITE RESET (NEG. RESP) 19600019 BE WTRNEG BRANCH IF YES 19700019 * * 19800019 * INVALID IOTYPE FOR PTOP SUPPORT * 19900019 * * 20000019 RESTORE L RSAVE,GTCIRBSV+FOUR RESTORE REG 13 20100019 RETURN EQU * 20200019 RETURN (14,12),T 20300019 *********************************************************************** 20400019 * * 20500019 * THE FOLLOWING MONITORS COMPLETION * 20600019 * OF A WRITE RESET OPERATION * 20700019 * * 20800019 *********************************************************************** 20900019 WTRNEG EQU * 21000019 TM GTCFLAGS,OKNIT HAS 360 COMPLETED INITIALIZATION 21100019 BZ POSTPTOP BRANCH IF NOT 21200019 * 21300019 TM FLGS3,WTEND IS GTEND RTN WAITING TO END 21400019 BZ END1130 BRANCH IF NOT 21500019 * 21600019 TM FLGS4,PNDCAN CANCEL MSG PENDING/CONTENDING 21610019 BZ POSTPTOP BRANCH IF NEITHER 21680019 B END2 BRANCH TO CHECK PEND/CONTEND 21750019 * 21820019 POSTPTOP EQU * POST GTNIT OUT OF WAIT AND RET 21890019 LA R1,GTCECB LOAD ADR OF ECB IN REG 1 21960019 POST (1) POST COMPLETION 22030019 B RESTORE RETURN TO SUPERVISOR 22100019 * 22200019 END1130 EQU * 22300019 TM GTCFLAGS,GTEND WAS CANCEL 1130 ISSUED 22400019 BO CLRPTOP BRANCH IF YES 22800019 * 23200019 B CHKPEND BRANCH TO START NEXT I/O 23600019 *********************************************************************** 24300019 * * 24400019 * THE FOLLOWING MONITORS COMPLETION * 24500019 * OF A READ INITIAL OPERATION * 24600019 * * 24700019 *********************************************************************** 24800019 RDTYP EQU * 24900019 CLI TYPE(RDECB),RTT IOTYPE A READ TT 25000019 BE RDCONT BRANCH IF YES 25100019 * 25200019 TM GTCFLAGS,OKNIT HAS INTIIALIZATION COMPLETED 25300019 BZ PASSMSG BRANCH IF NOT 25400019 * 25500019 CLI ZERO(RDECB),CODE7F WAS I/O SUCCESSFUL 25600019 BE CHKEND BRANCH IF YES 25700019 * 25800019 TM FLGS2,USEROP USER READ OPERATION 25900019 BO SETRD BRANCH IF YES 26000019 * 26100019 CHKEND EQU * 26200019 TM GTCFLAGS,GTEND HAS 1130 ISSUED GTEND 26300019 BZ CHKMSG BRANCH IF NOT 26400019 B MSGOK BRANCH TO CHECK MSG FORMAT 26500019 * 26700019 PASSMSG EQU * 26800019 OI FLGS3,COMMN SET FLAG FOR GTNIT 26900019 CLI ZERO(RDECB),CODE7F WAS OPERATION SUCCESSFUL 27000019 BNE POSERR BRANCH IF NOT 27100019 * 27200019 MSGOK EQU * 27300019 CLI TWO(RBFR),INITMSG INITIALIZATION MSG 27400019 BE PASSOK BRANCH IF YES 27500019 * 27600019 POSERR EQU * 27700019 MVI FLGS2,ERRNIT2 SET INIT ERR FLG 27800019 B WTRERR1 BRANCH TO WRITE RESET 27900019 * 28000019 WRTERR EQU * 28100019 MVI FLGS2,PTPWTR SET ONLY WTR BIT ON 28200019 WTRERR1 EQU * 28300019 LA R1,GTCPDECB 28400019 MVI GTCPDECB,ZERO 28500019 OI FLGS2,PTPWTR SET WRITE RESET GFLAG 28600019 WRITE (1),TR,(6),,,,1,MF=E WRITE NEG RESPONSE 28700019 * 28800019 B RESTORE RETURN TO SUPERVISOR 28900019 * 29000019 PASSOK EQU * 29100019 L R1,GTCPASS LOAD USER'S PASSWD PTR 29200019 CLC ZERO(SIX,R1),SIX(RBFR) DO PASSWORDS MATCH 29300019 BE OKPASS BRANCH IF YES 29400019 * 29500019 MVI FLGS2,ERRNIT1 SET INIT ERR FLAG 29600019 B WTRERR1 BRANCH TO WRITE RESET 29700019 * 29800019 OKPASS MVI FLGS2,RTPAS SET RTT FOR PASSWORD FLAG 29900019 B READTT1 BRANCH TO READ CONTINUE 30000019 * * 30100019 * ISSUE READ CONTINUE OPERATION * 30200019 * * 30300019 READTT EQU * 30400019 MVI FLGS2,PTPRTT SET PTOP RTT FLAG 30500019 READTT1 EQU * 30600019 LA R1,GTCPDECB LOAD ADR OF DECB 30700019 MVI GTCPDECB,ZERO 30800019 LA RBFR,THREE(RBFR) LOAD ADR OF BFR+3 TO READ EOT 30900019 READ (1),TT,(6),(8),,,1,MF=E 31000019 * 31100019 B RESTORE RETURN TO SUPERVISOR 31200019 * 31300019 CHKMSG EQU * CHECK MESSAGE FORMATS 31400019 TM TWO(RBFR),PTOPHDR PTOP MSG HEADER 31500019 BZ WRTERR BRANCH IF NOT 31600019 * 31700019 TM TWO(RBFR),PTOPHDR8 PTOP MSG (NOT USER DATA MSG) 31800019 BO WHICHMSG BRANCH IF YES 31900019 MVI FLGS2,USRRTT SET USERS RTT FLAG 32000019 MVI GTCLSTRD,STARTED SET USER LSTRD TO 2 32100019 TM FLGS4,SHORT WAS THERE INCORRECT LENGTH 32200019 BO BIGCNT BRANCH IF YES 32300019 LH R1,COUNT(RDECB) LOAD RESIDUAL COUNT 32400019 LTR R1,R1 IS COUNT EQUAL TO ZERO 32500019 BNZ CODE7 BRANCH IF NOT - INCORRECT LENGTH 32600019 * 32700019 BIGCNT EQU * INCORRECT LENGTH CHECK 32800019 NI FLGS4,ENDOFF TURN FLAG OFF 32900019 TM THREE(RBFR),BIGLNG 1130 INDICATE INCORRECT LENGTH 33000019 BZ READTT1 BRANCH IF NOT 33100019 * 33200019 CODE7 EQU * 33300019 MVI GTCLSTRD,WRGLNG SET INCORRECT LNG CODE=7 33400019 OI GTCLSTRD,STARTED SET LSTRD TO STARTED CONDITION 33500019 LH R1,GTCRDLNG LOAD LENGTH OF READ 33600019 SH R1,COUNT(RDECB) SUBTRACT RESIDUAL COUNT 33700019 STH R1,GTCRDLNG STORE UPDATED LENGTH 33800019 B READTT1 BRANCH TO ISSUE READ CONTINUE 33900019 * 34100019 WHICHMSG EQU * 34200019 CLI TWO(RBFR),PTOPMSG REQUEST TO CANCEL,END,ASYN 34300019 BNE MSG88 BRANCH IF NOT 34400019 * 34500019 CLI SIX(RBFR),ASYMSG REQUEST FOR ASYN RTN 34600019 BNE CANMSG BRANCH IF NOT 34700019 * 34800019 TM GTCFLAGS,ASYNC ASYNC RTN ALREADY SCHEDULED 34820019 BC 1,READTT BRANCH IF YES 34840019 * 34860019 OI GTCFLAGS,ASYNIT SET ASYN RTN REQUESTED FLG 34900019 B READTT BRANCH TO ISSUE READ CONTINUE 35000019 * 35100019 CANMSG CLI SIX(RBFR),CANCL REQUEST TO CANCEL 1130 35200019 BE WRTERR SEND ERROR NOTIFICATION 35300019 * 35400019 IFEND CLI SIX(RBFR),PTOPHDR8 HAS 1130 GTENDED 35500019 BNE WRTERR BRANCH IF NOT 35600019 * 35700019 OI GTCFLAGS,GTEND SET 1130 GTEND FLAG 35800019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD FLG OFF 35900019 TM FLGS4,CANCTD IS CANCEL CONTENTION PENDING 36000019 BZ ANDOFF BRANCH IF NOT 36100019 NI FLGS3,PNDOFF SET CONTENTION FLAG OFF 36200019 ANDOFF EQU * 36300019 NI FLGS4,CANOFF SET CANCEL PENDING FLGS OFF 36400019 B READTT BRANCH TO ISSUE READ CONTINUE 36500019 * 36700019 MSG88 CLI SIX(RBFR),RTRCTD 1130 MSER READY-TO-READ MSG 36800019 BNE NOTASY BRANCH IF NOT 36900019 MVC GTCLNGSV(TWO),EIGHT(RBFR) SAVE LNG PASSED FROM 1130 37000019 OI GTCFLAGS,RTRD SET 1130 READY-TO-READ FLAG 37100019 TM GTCLSTRD,USEROP IS USER READ PENDING 37200019 BZ READTT BRANCH IF NOT 37300019 * 37400019 MVI GTCLSTRD,CONTEND SET READ CONTENTION 37500019 CLI FLGS3,WTCLTRD READ IN WAIT STATE 37600019 BNE READTT BRANCH IF NOT 37700019 * 37800019 LA R1,GTCECB 37900019 POST (1) 38000019 * 38100019 B READTT BRANCH TO ISSUE READ CONTINUE 38200019 * 38300019 NOTASY CLI SIX(RBFR),ASYMSG 1130 ASYN END MSG 38400019 BNE WRTERR BRANCH IF NOT 38500019 * 38600019 NI GTCFLAGS,OFFASY SET FLG OFF 38700019 TM GTCFLAGS,SVRTRD WAS 1130 ML RTRD SAVED 38800019 BZ READTT BRANCH IF NOT 38900019 * 39000019 OI GTCFLAGS,RTRD SET 1130 RTRD FLAG 39100019 NI GTCFLAGS,OFFSV SET SAVE RTRD OFF 39200019 B READTT BRANCH TO ISSUE READ CONTINUE 39300019 *********************************************************************** 39400019 * * 39500019 * THE FOLLOWING MONITORS COMPLETION OF* 39600019 * A WRITE INITIAL TRANSPARENT WITH * 39700019 * RESET OPERATION * 39800019 * * 39900019 *********************************************************************** 40000019 WRTYP EQU * 40100019 TM DECFLAGS(RDECB),CONTENTN WRITE CONTENTION EXIST 40120019 BO SVWRT BRANCH IF YES 40140019 * 40160019 CLI GTCPDECB,CODE7F WAS I/O SUCCESSFUL 40240019 BE WRCHK BRANCH IF YES 40320019 * 40400019 IOERRS EQU * 40500019 TM FLGS2,USRTIXR WAS THIS A USER DATA WRITE 40600019 BNO RTRDMSG BRANCH IF NOT 40700019 * 40800019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD OFF 40900019 CLI GTCLSTRD,CONTEND READ STATUS IN CONTENTION 41000019 BNE ERRCOD BRANCH IF NOT 41100019 * 41200019 MVI GTCLSTRD,RDPEND SET RD STATUS TO PENDING=2 41300019 * 41400019 ERRCOD EQU * 41500019 TM DECSENS0(RDECB),INTERV INTERVENTION REQUIRED ON LINE 41600019 BZ LINERR BRANCH IF NOT 41700019 * 41800019 MVI GTCLSTWR,INTVREQ SET LSTWR STATUS TO 8 41900019 B TESTWAIT BRANCH TO TEST WAIT CONDITION 42000019 * 42100019 LINERR MVI GTCLSTWR,ERROR SET LSTWR STATUS TO 6 42200019 * 42300019 TESTWAIT EQU * 42400019 CLI FLGS3,WTCLTWR IS GTCLT WAITING FOR WRITE 42500019 BNE CHKOP BRANCH IF NOT 42600019 * 42700019 POSTUSER EQU * POST USER TEST/WAIT CONDITION 42800019 LA R1,GTCECB GET ADR OF GTCB ECB 42900019 POST (1) POST MACRO 43000019 * 43100019 CHKOP EQU * 43200019 * 43500019 CLI TYPE(RDECB),RTI WAS ERROR FOR READ INITIAL 43600019 BE WRTERR BRANCH IF YES 43700019 * 43800019 TM FLGS3,WTEND IS GTEND WAITING TO END 43900019 BZ CHKPEND BRANCH IF NOT 43950019 * 44000019 TM FLGS4,PNDCAN CANCEL REQ PENDING/CONTENTING 44050019 BZ POSTPTOP BRANCH IF NOT 44150019 B END2 BRANCH TO CHECK 1130 ENDED COND 44250019 * 44400019 RTRDMSG EQU * 44500019 CLI SIX(RBFR),CANCL ERROR ON CANCEL MSG 44600019 BNE RDERR BRANCH IF NOT 44700019 * 44800019 NI GTCFLAGS,OFFCAN TURN OFF CANCEL REQ FLAG 44820019 B CHKOP BRANCH TO CHECK WHICH OP ENDED 44840019 * 44860019 RDERR EQU * 44880019 CLI TWO(RBFR),PTPHDR88 ERROR ON READY-TO-READ MSG 44940019 BNE TESTASYN BRANCH IF NOT EQUAL 45000019 * 45100019 CLI SIX(RBFR),RTRCTD ERROR ON READY-TO-READ MSG 45200019 BNE TESTASYN BRANCH IF NOT 45300019 * 45400019 SETRD EQU * 45500019 TM DECSENS0(RDECB),INTERV INTERVENTION REQUIRED ON LINE 45600019 BZ LINERR1 BRANCH IF NOT 45700019 * 45800019 MVI GTCLSTRD,INTVREQ SET LAST RD STATUS TO 8 45900019 B WAITONRD BRANCH TO CHECK WAIT CONDITION 46000019 * 46100019 LINERR1 MVI GTCLSTRD,ERROR SET LAST RD STATUS TO 6 46200019 * 46300019 WAITONRD EQU * 46400019 TM FLGS3,WTCLTRD IS GTCLT WAITING FOR READ 46500019 BO POSTUSER BRANCH IF YES 46600019 B CHKOP BRANCH TO CHECK OP TYPE 46700019 * 46808019 TESTASYN EQU * 46816019 CLI TWO(RBFR),PTOPMSG IS IT ASYN REQ MSG ERROR 46824019 BNE TESTEND BRANCH IF NOT 46832019 * 46840019 CLI SIX(RBFR),ASYMSG CHECK MSG TYPE FURTHER 46940019 BNE TESTEND BRANCH IF NOT ASYN REQ MSG 47040019 * 47140019 NI GTCFLAGS,OFFASY TURN ASYN REQ FLAG OFF 47240019 B CHKOP BRANCH TO CHECK OP TYPE 47340019 SVWRT EQU * SAVE WRITE REQ 47600019 OI FLGS3,TENTION SET WRITE CONTENTION FLAG 47700019 CLI TWO(RBFR),PTPHDR90 ASYN,CANCEL,OR END MSG 47800019 BNE TESTREST BRANCH IF NOT 47900019 * 48000019 CLI SIX(RBFR),PTOPHDR8 IS IT END MSG 48100019 BNE SVCAN BRANCH IF NOT 48200019 * 48300019 OI FLGS3,ENDMSG SET CONTENTION-ON-END MSG FLAG 48400019 B ISSUERTI BRANCH TO ISSUE READ INITIAL 48500019 * 48600019 SVCAN CLI SIX(RBFR),CANCL IS IT CANCEL MSG 48700019 BNE SVASYN BRANCH IF NOT 48800019 * 48900019 OI FLGS4,CANCTD SET CANCEL MSG CONTENTION 49000019 NI GTCFLAGS,ENDOFF SET 1130 GTEND FLAG OFF 49100019 B ISSUERTI BRANCH TO ISSUE READ INITIAL 49200019 * 49300019 SVASYN CLI SIX(RBFR),ASYMSG IS IT 1130 ASYN RTN REQ MSG 49400019 BNE ISSUERTI BRANCH IF NOT 49500019 * 49600019 OI FLGS4,ASYCTD SET ASYN REQ CONTENTION FLAG 49700019 B ISSUERTI BRANCH TO ISSUE READ INITIAL 49800019 * 49900019 TESTREST EQU * CHECK THE MSG FORMAT 50000019 TM TWO(RBFR),PTPHDR88 RTRD,ASYN END,OR USER WRITE 50100019 BZ ISSUERTI BRANCH IF NONE OF THE ABOVE 50200019 BM USRWRT BRANCH IF USER WRITE MSG 50300019 * 50400019 CLI SIX(RBFR),RTRCTD IS TI READY-TO-READ MSG 50500019 BNE SVEND BRANCH IF NOT 50600019 * 50700019 OI FLGS4,RTRCTD SET CONTENTION ON RTRD 50800019 B ISSUERTI BRANCH TO ISSUE READ INITIAL 50900019 * 51000019 SVEND CLI SIX(RBFR),ASYMSG IS IT ASYN END MSG 51100019 BNE ISSUERTI BRANCH IF NOT 51200019 * 51300019 OI FLGS3,ASYEND SET CONTENTION ON ASYN END MSG 51400019 B ISSUERTI BRANCH TO ISSUE READ INITIAL 51500019 * 51600019 USRWRT EQU * 51700019 OI FLGS4,DATATD SET CONTENTION ON USER WRITE 51800019 MVI GTCLSTWR,WRPEND RESET LAST WR STATUS TO 2 51900019 * 52000019 ISSUERTI EQU * 52100019 TM GTCLSTRD,USEROP IS USER READ PENDING 52200019 BO USERTI BRANCH IF YES 52300019 CLRPTOP EQU * ZERO OUT PTOP READ BFR 52400019 XC GTCPTPRD(PASLNG),GTCPTPRD CLEAR 14 BYTES OF BFR AREA 52500019 LA RBFR,GTCPTPRD LOAD ADR OF BFR 52600019 TM GTCFLAGS,GTEND HAS 1130 CALLED GTEND 52700019 BO SETLNG BRANCH IF YES 52800019 * 52900019 LA R2,BFAD LOAD LNG OF BFR # 12 53000019 B READTI BRANCH TO READ INITIAL 53100019 * 53200019 SETLNG EQU * 53300019 LA R2,PASLNG LOAD LNG FOR PASSWORD MSG 53400019 B READTI BRANCH TO READ INITIAL 53500019 * 53600019 USERTI EQU * 53700019 LH R2,GTCRDLNG LOAD LNG OF USER READ BFR 53800019 CH R2,CON3 IS RD LNG LESS THAN 3 53900019 BL INPTOP1 BRANCH IF YES 54000019 * 54100019 L RBFR,GTCRDBUF LOAD ADR OF USER'S BFR 54200019 XC ZERO(BFAD,RBFR),ZERO(RBFR) CLEAR USERS RD BFR-12 BYTES 54210019 LH R1,GTCRDSIZ LOAD RD LNG 54220019 LTR R1,R1 DOES LNG EQU /0 54230019 BP USERD BRANCH IF NOT 54240019 * 54250019 LH R1,GTCWRSIZ LOAD WRBFR SIZE 54260019 USERD EQU * CHECK 54270019 CR R1,R2 IS BFR SIZ AS LARGE AS REQ 54280019 BNL USERD1 BRANCH IF YES 54290019 * 54300019 LR R2,R1 EXCHANGE LNG 54310019 USERD1 EQU * GO ON 54320019 LA R2,SEVEN(R2) ADD 7 TO BFR LNG FOR CTL CHARS 54400019 INPTOP EQU * READ INTO PTOP BFR 54500019 MVI FLGS2,USEROP SET USER OPER FLAG 54600019 B READTI1 BRANCH TO ISSUE READ INITIAL 54700019 * 54800019 INPTOP1 EQU * READ USER DATA IN PTOP BFR 54900019 LA RBFR,GTCPTPRD GET PTOP RDBUF ADR 55000019 LA R2,BFAD LOAD LNG = 12 55100019 OI FLGS4,SHORT SET SHORT LNG FLAG 55200019 B INPTOP BRANCH TO SET USER FLAG 55300019 * 55400019 READTI EQU * SET OP TYPE FLAGS FIELD TO ZERO 55500019 MVI FLGS2,ZERO TO INDICATE PTOP OP 55600019 READTI1 EQU * ISSUE READ INITIAL OPER 55700019 OI FLGS2,PTPRTI SET PTOP RTI FLAG 55800019 LR R1,RDECB SET DECB ADR IN PARAM REG 55900019 READ (1),TI,(6),(8),(2),,1,MF=E READ INITIAL 56000019 * 56100019 B RESTORE RETURN TO SUPERVISOR 56200019 * 57900019 WRCHK EQU * 58000019 * 58300019 CLI FLGS2,USRTIXR WAS THIS USER WRITE DATA 58400019 BNE TESTCAN BRANCH IF NOT 58500019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD OFF 58600019 CLI GTCLSTRD,CONTEND IS READ IN CONTENTION 58700019 BNE COMPCODE BRANCH IF NOT 58800019 * 58900019 MVI GTCLSTRD,RDPEND SET LSTRD STATUS =2 59000019 * 59100019 COMPCODE EQU * 59200019 CLC GTCWRLNG(TWO),GTCLNGSV INCORRECT LENGTH 59300019 BNE SETCD7 BRANCH IF YES 59400019 * 59500019 LH R1,GTCWRSIZ LOAD WRITE BFR SIZE 59510019 LTR R1,R1 EQUAL TO 0 59520019 BP BFRLNG BRANCH IF NOT 59530019 * 59540019 LH R1,GTCRDSIZ LOAD RD LNG 59550019 BFRLNG EQU * CHECK LNG 59560019 CH R1,GTCWRLNG IS BFR SIZE AS LARGE AS I/O REQ 59570019 BL SETCD7 BRANCH IF NOT 59580019 * 59590019 MVI GTCLSTWR,SUCCES SET LAST WRITE STATUS TO 1 59600019 B TESTWAIT BRANCH TO CHECK WAIT CONDITION 59700019 * 59800019 SETCD7 MVI GTCLSTWR,WRGLNG SET LAST WR STATUS TO 7 59900019 B TESTWAIT BRANCH TO TEST WAIT CONDITION 60000019 * 60100019 TESTCAN EQU * 60130019 CLI SIX(RBFR),CANCL WAS CANCEL MSG SET TO 1130 60160019 BE CHKWAIT BRANCH IF YES 60190019 * 60220019 TESTEND EQU * 60250019 TM FLGS3,WTASY IS GTEND WAITING FOR ASYEND MSG 60300019 BZ CHKOP BRANCH IF NOT 60400019 * 60500019 LA R1,GTCECB 60600019 POST (1) 60700019 * 60800019 L R1,GTCSVINF LOAD SVINFO AREA ADR 60900019 MVC GTCECB(FOUR),ZERO(R1) REPLACE ML ECB STATUS 61000019 B CHKOP BRANCH TO CHECK OP TYPE 61100019 *********************************************************************** 61200019 * * 61300019 * THE FOLLOWING MONITORS COMPLETION OF* 61400019 * A READ CONTINUE OPERATION * 61500019 * * 61600019 *********************************************************************** 61700019 RDCONT EQU * 61800019 SH RBFR,CON3 ADJUST BFR ADR TO START OF BFR 61900019 TM FLGS2,RTPAS PASSWORD-CHK-READ-CONTINUE OPERATION 62000019 BZ TESTMSG BRANCH IF NOT 62100019 * 62200019 TM GTCFLAGS,GTEND HAS 1130 REINITIALIZED 62300019 BZ POST BRANCH IF NOT 62400019 * 62500019 NI GTCFLAGS,ENDOFF SET 1130 GTEND FLG OFF 62600019 NI GTCFLAGS,PNDOFF SET CANCEL FLAG OFF 62700019 B CHKPEND BRANCH TO CHECK FOR PENDING I/O 62800019 * 62900019 POST EQU * 63000019 LA R1,GTCECB 63100019 POST (1) POST WAIT IN GTNIT 63200019 * 63300019 OI GTCFLAGS,OKNIT SET INITIALIZATION BIT 63400019 B CLRPTOP BRANCH TO ZERO BFR AND ISSUE I/O 63500019 * 63700019 TESTMSG EQU * 63800019 CLI TWO(RBFR),DATAMSG WAS 1130 DATA MSG RECEIVED 63900019 BNE WHATHEN BRANCH IF NOT 64000019 * 64100019 CLI GTCPDECB,CODE7F I/O SUCCESSFUL 64200019 BNE SETRD BRANCH IF NOT 64300019 * 64400019 CLI GTCLSTRD,LNGWRG WRONG LNG INDICATED 64500019 BNE SETSTAT BRANCH IF NOT 64600019 * 64700019 MVI GTCLSTRD,WRGLNG SET LAST RD STATUS TO 7 64800019 B MOVERD BRANCH TO MOVE DATA TO TEMPARRAY 64900019 * 65000019 SETSTAT EQU * 65100019 MVI GTCLSTRD,SUCCES SET LAST RD STATUS TO 1 65200019 * 65300019 MOVERD EQU * 65400019 L R2,GTCRDARY LOAD ADR OF USER DATARRAY 65500019 LA RBFR,SIX(RBFR) ADJUST BFR ADR TO START OF DATA 65600019 SR R15,R15 SET R1K TO ZERO 65700019 LH R1,GTCRDLNG LOAD LENGTH TO BE READ 65800019 LH R14,GTCRDSIZ LOAD RD LNG 65900019 LTR R14,R14 DOES LNG EQUAL 0 66000019 BP BFRSIZ BRANCH IF NOT 66100019 * 66200019 LH R14,GTCWRSIZ 66300019 BFRSIZ EQU * 66400019 CR R1,R14 IS RD REQ GREATER THAN BFR SIZE 66500019 BNH RDMOV BRANCH IF NOT 66600019 * 66700019 LR R1,R14 EXCHANGE LNGS 66800019 MVI GTCLSTRD,WRGLNG SET WRONG LENGTH LSTRD STATUS 66900019 RDMOV EQU * MOVE DATA 67000019 LA R14,WAITONRD LOAD ADR OF NSI 67100019 * 67400019 * 67500019 MVLOOP EQU * 67600019 LA R15,EQ255 LOAD MAXIMUM MV LNG 67700019 MVAGAIN CH R1,CON256 IS LNG GREATER THAN 256 OR EQUAL 67800019 BNL HIGHEQL BRANCH IF YES 67900019 SH R1,CON1 68000019 EX R1,MOVE EXECUTE EXACT LNG 68100019 BR R14 RETURN TO NSI 68200019 * 68300019 MOVE MVC ZERO(ONE,R2),ZERO(RBFR) MOVE INSTRUCTION FOR E4 68400019 * 68500019 HIGHEQL EQU * 68600019 SH R1,CON256 DECREMENT COUNT 68700019 EX R15,MOVE EXECUTE 68800019 LTR R1,R1 IS COUNT EQ TO 0 68900019 * 69000019 BCR EIGHT,R14 BRANCH IF YES 69060019 AH RBFR,CON256 UPDATE ARRAY POINTERS 69130019 AH R2,CON256 69160019 B MVAGAIN BRANCH TO CONTINUE MOVING DATA 69260019 * 69400019 WHATHEN EQU * 69500019 TM GTCFLAGS,GTEND DID 1130 ISSUE GTEND 69600019 BZ REQASYN BRANCH IF NOT 69700019 * 69800019 TM FLGS4,PNDCAN CANCEL REQ PENDING/CONTENDING 69810019 BZ CHKWAIT BRANCH TO TEST WAIT CONDITION 69820019 * 69830019 NI FLGS4,CANOFF TURN FLAGS OFF 69840019 CHKWAIT EQU * 69850019 TM FLGS3,WAITST ANY RTN WAITING 69900019 BZ CLRPTOP BRANCH TO ZERO BFR 70000019 * 70100019 TM FLGS3,WTEND IS GTEND WAITING TO END 70200019 BO POSTPTOP BRANCH IF YES 70300019 * 70400019 LA R1,GTCECB LOAD ADR OF ECB IN PARAM REG 70500019 POST (1) POST THE ECB 70600019 * 70700019 B CLRPTOP BRANCH TO ZERO BFR 70800019 * 70900019 REQASYN EQU * 71000019 TM GTCFLAGS,ASYNIT WAS S/360 ASYNC RTN REQUESTED 71100019 BZ CANREQ BRANCH IF NOT 71200019 * 71300019 TM FLGS3,ENDMSG IS S/360 GTEND PENDING 71400019 BO END1 BRANCH IF YES 71600019 * 71900019 TM FLGS4,PNDCAN IS CANCEL MSG PENDING 72000019 BO END2 BRANCH IF YES 72100019 * 72200019 TM FLGS3,WTEND GTEND IN WAIT STATE 72220019 BO CHKOP BRANCH IF YES 72240019 * 72260019 NI GTCFLAGS,OFFREQ SET ASYN REQ BIT OFF 72300019 OI GTCFLAGS,ASYNC SET ASYNC SCHEDULED BIT ON 72400019 * * 72500019 * CREATE IRB AND IQE FOR USER'S * 72600019 * ASYNCHRONOUS ROUTINE AND SCHEDULE * 72700019 * IT VIA AEE STAGE 2 * 72800019 * * 72900019 L R0,GTCASYNC LOAD EP OF USER'S ASYN RTN 73000019 * 73100019 CIRB EP=(0),SVAREA=YES,WKAREA=4,STAB=(DYN) 73200019 * 73300019 LR RIRB,R1 SAVE IRB ADR 73400019 LA R1,IQE(RIRB) LOAD ADR OF IQE 73500019 ST R1,NEXAVL(RIRB) STORE IQE ADR IN IRB NEXAVAIL FLD 73600019 ST RIRB,EIGHT(R1) STORE IRB ADR IN IQE 73700019 LA R2,PRMLST(RIRB) LOAD ADR OF PARM LIST AT IQE+16 73800019 ST R2,FOUR(R1) PUT ADR INTO PARM FIELD OF IQE 73900019 LH R15,EIGHT(RBFR) LOAD PARAM FROM 1130 74000019 ST R15,GTCSTART 74100019 SR R15,R15 74200019 IC R15,GTCDSRNO LOAD DSRN 74300019 ST R15,GTCDSRAD 74400019 LA R15,GTCDSRAD 74500019 ST R15,ZERO(R2) STORE IN PARM LIST 74600019 LA R15,GTCSTART 74700019 ST R15,FOUR(R2) 74800019 L R15,CVTPTR LOAD ADR OF CVT 74900019 L R14,ZERO(R15) LOAD PTR TO TCB DOUBLE WORD 75000019 L R14,CURTCB(R14) LOAD CURRENT TCB ADR 75100019 ST R14,TCB(R1) STORE TCB ADR IN IQE 75200019 * 75300019 XC ZERO(FOUR,R1),ZERO(R1) CLEAR LINK FLD IN IQE 75400019 MVC NEXAVL(FOUR,RIRB),ZERO(R1) IQE LINK FLD TO IRB NEXAVL 75500019 LNR R1,R1 PUT IQE IN NEG FORMAT 75600019 L R15,STAGE2(R15) LOAD AEE STAGE 2 ADR FROM CVT 75700019 * 75800019 BALR R14,R15 BRANCH AND LINK TO AEE STAGE2 75900019 * 76000019 L R0,SVGET LOAD CORE REQ FOR ML-STATUS-SVAR 76100019 GETMAIN R,LV=(0) 76200019 * 76300019 ST R1,GTCSVINF PUT ADR INTO GTCB 76400019 XC ZERO(LNG,R1),ZERO(R1) CLEAR TO ZERO 76500019 * 76600019 MVC ZERO(INFO,R1),GTCECB MOVE ML STATUS TO SVAREA 76700019 XC GTCECB(BFAD),GTCECB CLEAR FIELDS TO 0 76800019 XC GTCLSTRD(EIGHT),GTCLSTRD CLEAR LSTRD/WRT FIELDS 76900019 XC FLGS2(THREE),FLGS2 CLEAR LAST 3 BYTES OF FLAGS 77000019 B CLRPTOP BRANCH TO ZERO BFR 77100019 * 77300019 CANREQ EQU * 77400019 * 77900019 * 78000019 CHKPEND EQU * TEST FOR PENDING MSGS 78100019 TM FLGS3,ENDMSG IS GTEND MSG PENDING 78200019 BZ CANPEND BRANCH IF NOT 78300019 * 78400019 END1 EQU * 78500019 NI FLGS3,OFFREQ SET CONTENTION ON END MSG OFF 78600019 WRITIXR EQU * 78700019 MVI FLGS2,ZERO SET PTOP OPER BIT 78800019 LA RBFR,GTCPTPWR LOAD ADR OF PTOP WR BFR 78900019 LA R2,MSGLNG LOAD LNG 79000019 WRITIXR1 EQU * 79100019 OI FLGS2,PTPTIXR SET PTOP WTIXR FLAG 79200019 LR R1,RDECB LOAD DECB ADR IN PARAM REG 1 79300019 WRITE (1),TIXR,(6),(8),(2),,1,MF=E 79400019 * 79500019 B RESTORE RETURN TO SUPERVISOR 79600019 * 79800019 CANPEND EQU * 79900019 TM FLGS4,PNDCAN IS CANCEL MSG PENDING 80000019 BZ MSGTEND BRANCH IF NOT 80100019 END2 EQU * 80200019 TM FLGS4,CANCTD IS CANCEL MSG IN CONTENTION 80300019 BZ SETMSGUP BRANCH IF NOT 80400019 * 80500019 NI FLGS4,WTOFF SET CONTENTION FLG OFF 80600019 NI FLGS3,PNDOFF CONTINUE 80700019 ENDONE EQU * 80800019 TM GTCFLAGS,GTEND HAS 1130 GTENDED 80900019 BO CLRPTOP BRANCH IF YES 81000019 * 81100019 OI GTCFLAGS,GTEND SET 1130 GTEND FLAG 81200019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD FLAG OFF 81300019 B WRITIXR BRANCH TO ISSUE WRITE 81400019 * 81600019 MSGTEND EQU * 81700019 TM FLGS3,TENTION WRITE CONTENTION PENDING 81800019 BZ TESTPEND BRANCH IF NOT 81900019 NI FLGS3,PNDOFF SET CONTENTION BIT OFF 82000019 TM FLGS4,ASYCTD IS IT REQ TO 1130 ASYN 82100019 BZ ENDCTD BRANCH IF NOT 82200019 * 82300019 NI FLGS4,OFF1 SET FLG OFF 82400019 OI GTCFLAGS,A1130 SET FLAG 82500019 B WRITIXR BRANCH TO ISSUE WRITE 82600019 * 82700019 ENDCTD EQU * 82800019 TM FLGS3,ASYEND IS ASYN END MSG PENDING 82900019 BZ WRTCTD BRANCH IF NOT 83000019 * 83100019 NI FLGS3,OFFPND SET FLG OFF 83200019 B WRITIXR BRANCH TO ISSUE WRITE 83300019 * 83400019 WRTCTD EQU * 83500019 TM FLGS4,DATATD IS USER WRITE DATA PENDING 83600019 BZ RTRDCTD BRANCH IF NOT 83700019 * 83800019 NI FLGS4,OFFREQ SET FLAG OFF 83900019 MVI GTCLSTWR,STARTED SET LSTWR CODE TO 3 84000019 MVI FLGS2,USEROP SET OP TYPE CODE FOR USER 84100019 L RBFR,GTCWRBUF LOAD USER'S WRBFR ADR 84200019 LH R2,GTCWRLNG LOAD USER WR LNG 84300019 LA R2,SIX(R2) INCREMENT LNG BY 6 84400019 B WRITIXR1 BRANCH TO ISSUE WRITE 84500019 * 84600019 RTRDCTD EQU * 84700019 NI FLGS4,OFF2 SET FLG OFF 84800019 MVI GTCLSTRD,RDPEND SET LSTRD CODE = 2 84900019 B WRITIXR BRANCH TO ISSUE WRITE 85000019 * 85300019 TESTPEND EQU * 85400019 TM FLGS4,PENDING ARE ANY PTOP MSGS PENDING 85500019 BZ USERPEND BRANCH IF NOT 85600019 * 85700019 SETMSGUP EQU * 85800019 MVC GTCPTPWR(TWO),DCBBSTSX MOVE IN CTL CHARS DLE STX 85900019 MVI GTCPTPWR+TWO,PTOPMSG COMPLETE MSG HEADER 86000019 MVC GTCPTPWR+THREE(ONE),GTCDSRNO CONTINUE 86100019 MVC GTCPTPWR+FOUR(ONE),GTCWRSEQ+ONE CONTINUE 86200019 MVI GTCPTPWR+FIVE,HDRLNG CONTINUE 86300019 * 86400019 TM FLGS4,CANPND IS IT CANCEL REQ 86500019 BZ NOTCAN BRANCH IF NOT 86600019 * 86700019 NI FLGS4,OFFPND SET FLG OFF 86800019 OI GTCFLAGS,GTEND SET 1130 GTEND FLAG 86900019 MVI GTCPTPWR+SIX,CANCL MOVE IN CANCEL MSG INDICATOR 87000019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD OFF 87100019 B WRITIXR BRANCH TO ISSUE WRITE 87200019 * 87300019 NOTCAN EQU * 87400019 TM FLGS4,ASYPND IS IT ASYN REQ 87500019 BZ USERPEND BRANCH IF NOT 87600019 * 87700019 NI FLGS4,PNDOFF SET FLG OFF 87800019 MVC GTCPTPWR+EIGHT(TWO),GTCPRMSV INSERT ASYN PARAM 87900019 MVI GTCPTPWR+SIX,ASYMSG MOVE IN ASYN REQ MSG INDICATOR 88000019 OI GTCFLAGS,A1130 SET ASYN REQ FLAG 88100019 TM GTCFLAGS,RTRD IS 1130 ML READY TO READ 88200019 BZ WRITIXR BRANCH IF NOT 88300019 * 88400019 OI GTCFLAGS,SVRTRD SAVE THE 1130 RTRD FLAG 88500019 NI GTCFLAGS,RTRDOFF SET 1130 RTRD FLAG OFF 88600019 B WRITIXR BRANCH TO ISSUE WRITE 88700019 * 88800019 USERPEND EQU * 88900019 CLI GTCLSTWR,WRPEND IS A USER WRITE PENDING 89000019 BNE NOTRTRD BRANCH IF NOT 89100019 * 89200019 TM GTCFLAGS,RTRD IS 1130 READY-TO-READ 89300019 BO MVDATA BRANCH IF YES 89400019 * 89600019 NOTRTRD EQU * 89700019 TM FLGS4,RTRPND IS S/360 RTRD MSG PENDING 89800019 BZ ISSUERTI BRANCH IF NOT 89900019 * 90000019 NI FLGS4,OFFSV SET FLAG OFF 90100019 MVI GTCPTPWR+TWO,PTPHDR88 COMPLETE MESSAGE HEADER 90140019 MVI GTCPTPWR+SIX,RTRCTD CONTINUE 90180019 LH R1,GTCRDSIZ LOAD RD BFR SIZE 90220019 LTR R1,R1 SIZE EQUAL /0 90260019 BP RDBFR1 BRANCH IF NOT 90300019 * 90340019 LH R1,GTCWRSIZ LOAD LNG OF WRBFR 90380019 RDBFR1 EQU * 90420019 CH R1,GTCRDLNG DOES BFR SIZE EXCEED RD REQ 90460019 BL RDMSG BRANCH IF NOT 90500019 * 90540019 LH R1,GTCRDLNG LOAD REQ FOR READ LNG 90580019 RDMSG EQU * 90620019 STH R1,GTCPTPWR+EIGHT INSET RDLNG INTO MSG 90660019 MVI GTCLSTRD,RDPEND SET LSTRD CODE = 2 90700019 B WRITIXR BRANCH TO ISSUE WRITE 90740019 * 90800019 MVDATA EQU * 90900019 L R2,GTCWRBUF LOAD ADR OF USERS WRITE BFR 91000019 LA R2,SIX(R2) GET ADR OF DATA PORTION OF MSG 91100019 L RBFR,GTCWRARY LOAD ADR OF USER DATARRAY 91200019 * 91300019 LH R14,GTCWRSIZ LOAD WRBFR SIZ 91350019 LTR R14,R14 DOES THE A SIZE EQU 0 91400019 BP WRBFR BRANCH IF NOT 91450019 * 91500019 LH R14,GTCRDSIZ LOAD READ BFR SIZE 91550019 * 91600019 WRBFR EQU * 91650019 LH R1,GTCWRLNG LOAD LNG 91700019 CR R14,R1 IS WR BFR AS LARGE AS REQ. 91710019 BNL WRSIZ BRANCH IF YES 91720019 * 91730019 LR R1,R14 EXCHANGE REGS 91740019 WRSIZ EQU * 91750019 LA R14,SETWRMSG LOAD RETURN ADR 91800019 B MVLOOP BRANCH TO MOVE DATA 92000019 * 92200019 * 92300019 SETWRMSG EQU * 92400019 L R2,GTCWRBUF GET START OF USER WRBUF 92500019 MVC ZERO(TWO,R2),DCBBSTSX INSERT CTL CHARS DLE STX 92600019 MVI TWO(R2),PTOPHDR COMPLETE MESSAGE HEADER 92700019 MVC THREE(ONE,R2),GTCDSRNO CONTINUE 92800019 MVC FOUR(ONE,R2),GTCWRSEQ+ONE CONTINUE 92900019 MVI FIVE(R2),HDRLNG CONTINUE 93000019 L RBFR,GTCWRBUF LOAD USERS WRBUF ADR 93100019 LH R2,GTCWRLNG LOAD LNG OF USER WRITE DATA 93200019 CH R2,GTCLNGSV IS WR LNG GREATER THAN READ 93400019 BNH SETLEN BRANCH IF NOT 93430019 * 93460019 LH R2,GTCLNGSV LOAD 1130 READ LNG 93490019 OI THREE(RBFR),BIGLNG SET WRONG LENGTH FLAG FOR 1130 93520019 SETLEN EQU * CHECK WRBFR SIZE 93550019 LH R1,GTCWRSIZ LOAD WRBFR SIZE 93580019 LTR R1,R1 DOES BFR SIZE EQUAL 0 93610019 BP WRMSG BRANHC IF NOT 93640019 * 93670019 LH R1,GTCRDSIZ LOAD RDBFR SIZE 93700019 WRMSG EQU * 93730019 CR R1,R2 IS BFR SIZE AS LARGE AS REQ 93760019 BNL WRMSG1 BRANCH IF YES 93790019 * 93820019 LR R2,R1 EXCHANGE LENGTHS 93850019 WRMSG1 EQU * COMPLETE PREPARATIONS FOR WRITE 93880019 LA R2,SIX(R2) ADD LNG OF CTL CHARS 94000019 MVI GTCLSTWR,STARTED SET LAST WRT TO STARTED 94100019 * 94200019 MVI FLGS2,USEROP SET USER OP TYPE FLAG 94300019 B WRITIXR1 BRANCH TO ISSUE WRITE 94400019 * * 94500019 * CONSTANTS DEFINED * 94600019 * * 94700019 CON1 DC H'1' CONSTANT EQUAL TO 1 94800019 CON3 DC H'3' CONSTANT EQUAL TO 3 94900019 GTCBAD DC H'64' DISP OF GTCB ADR FROM DCB 95000019 CON256 DC H'256' CONSTANT EQUAL TO 256 95100019 DS 0F FULLWORD BOUNDARY 95200019 SVGET DC X'FA' SUBPOOL ID 250 95300019 DC AL3(200) SAVE AREA GETMAIN REQUEST 95400019 CNOP 0,4 95600019 COPY IKDGTCB 95700019 DCBD DSORG=CX,DEVD=BS 95800019 END 95900019 ./ ADD SSI=00012136,NAME=IKDGTNIT,SOURCE=0 TITLE 'IKDGTNIT' PROCESSOR-TO-PROCESSOR INITIALIZER 00200017 *STATUS: CHANGE LEVEL 000 * 00400017 *FUNCTION/OPERATION: TO INITIALIZE THE PROCESSOR-TO-PROCESSOR PROGRAM * 00600017 * 1. ESTABLISH A GTCB FOR THE LINE * 00800017 * 2. LOAD IKDGTIRB, IKDGTCLT, IKDRDWRT ROUTINES * 01000017 * 3. PREPARE THE BTAM LINE FOR COMMUNICATION,I.E. OPEN THE BTAM DCB * 01200017 * 4. ESTABLISH INITIAL CPU-TO-CPU COMMUNICATION * 01400017 * * 01600017 *ENTRY POINTS: ENTRY AT IKDGTNIT VIA A LINK FROM IKDGTCLR (CONTROLLER)* 01800017 * * 02000017 *INPUT: REGISTER 11 POINTS TO USER'S PARAM LIST * 02200017 * REGISTER 3 POINTS TO UNIT ASSIGNMENT TABLE * 02400017 * REGISTER 4 POINTS TO EXISTING GTCB OR CONTAINS ZEROS * 02600017 * * 02800017 *OUTPUT: USER STATCODE AREA CONTAINS ONE OF THE FOLLOWING CODES * 03000017 * A) ZERO - SUCCESSFUL COMMUNICATION * 03200017 * B) PLUS ONE - I/O ERRORS FOUND * 03400017 * C) MINUS ONE - PASSWORDS DID NOT MATCH * 03600017 * D) PLUS TWO - FIVE MINUTE TIME LIMIT ELAPSED BEFORE CONTACT MADE * 03800017 * * 04000017 *EXTERNAL ROUTINES: NONE * 04200017 * * 04400017 *EXITS-NORMAL: RETURN TO CONTROLLER WITH RETURN CODE ZERO * 04600017 * -ERROR: RETURN TO CONTROLLER WITH RETURN CODE FOUR WHICH MEANS * 04800017 * OTHER THAN A ZERO STATCODE (SEE 'OUTPUT') WAS RETURNED TO THE USER* 05000017 * * 05200017 *TABLES/WORK AREAS: GRAPHIC TELECOMMUNICATION CONTROL BLOCK (GTCB) * 05400017 * PTOP UNIT ASSIGNMENT TABLE * 05600017 * * 05800017 *ATTRIBUTES: REENTRANT,TRANSIENT,NON-PRIVILEGED * 06000017 * * 06200017 *NOTES: THE STIMER MACRO IS USED WITH THE WAIT PARAM FOR ONE SECOND * 06400017 * INTERVALS. THIS MACRO IS LOOPED THROUGH FOR A MAXIMUM OF FIVE * 06600017 * MINUTES OR UNTIL SOME CONTACT HAS BEEN MADE WITH THE OTHER CPU. * 06800017 R0 EQU 0 07500017 R1 EQU 1 07800017 R2 EQU 2 08100017 RUATBL EQU 3 08400017 RGTCB EQU 4 08700017 R5 EQU 5 09000017 R6 EQU 6 09300017 RBASE EQU 7 09600017 R8 EQU 8 09900017 R9 EQU 9 10200017 RDCB EQU 10 10500017 RPRAM EQU 11 10800017 RSAVE EQU 13 11100017 R14 EQU 14 11400017 R15 EQU 15 11700017 * 12000017 ZERO EQU 0 12300017 ONE EQU 1 12600017 TWO EQU 2 12900017 THREE EQU 3 13200017 FOUR EQU 4 13500017 SIX EQU 6 EQUATE 6 13600017 EIGHT EQU 8 13800017 SIXTEEN EQU 16 13900017 TWENTY EQU 20 EQUATE 20 14000017 NEXT EQU 256 14100017 TIMECTR EQU 300 14400017 GTRED EQU 396 GTRED ADR DISP IN PTOP UATBL 14700017 GTWRT EQU 400 GTWRT ADR DISP 15000017 GTCLT EQU 404 15300017 GTIRB EQU 408 GTIRB ADR DISP 15600017 USECNT EQU 412 15900017 HEX1 EQU X'01' EQUATE X'01' 16000017 ERRNEG EQU X'02' 16200017 COMMN EQU X'02' 16500017 ERRNIT EQU X'03' 16800017 HEX10 EQU X'10' EQUATE X'10' 16900017 HEX20 EQU X'20' EQUATE X'20' 17000017 PTPRTI EQU X'40' PTOP RT1 BIT 17100017 PTPBIT EQU X'40' 17400017 OKNIT EQU X'80' 17700017 HEX80 EQU X'80' EQUATE X'80' 17800017 NOCOMN EQU X'FD' 18000017 * 18300017 IKDGTNIT CSECT 18600017 SAVE (14,12),,* 18900017 BALR RBASE,0 19200017 USING *,RBASE ESTABLISH BASE REGISTER 19500017 USING DSECT,RPRAM SET UP DSECT BASE REG 19800017 USING IKDGTCB,RGTCB 20100017 LA RDCB,GTCDCB ESTABLISH BASE FOR DCB DSCT 20400017 USING IHADCB,RDCB 20700017 * 21000017 LTR RGTCB,RGTCB DOES GTCB EXIST FOR THIS DSRN 21300017 BP MVPTRS BRANCH IF YES 21600017 * 21900017 L R0,GETREQ LOAD GETMAIN REQUEST 22200017 GETMAIN R,LV=(0) GET STORAGE FOR GTCB 22500017 * 22800017 LR RGTCB,R1 SET STORAGE ADR IN DSECT REG 23100017 AR RDCB,RGTCB ADD ADR OF GTCB TO DCB DSECT REG 23400017 XC ZERO(NEXT,RGTCB),ZERO(RGTCB) CLEAR GTCB CORE TO ZERO 23700017 XC ZERO(NEXT,RGTCB),ZERO(RGTCB) CONTINUE 24000017 ST RUATBL,GTCDSRNO STORE PTOP UNIT ASGT TABLE ADR 24300017 L R5,DSRN LOAD DSR NUMBER ADCON 24600017 L R5,ZERO(R5) R5 CONTAINS SDR NUMBER 24900017 STC R5,GTCDSRNO STORE DSRN IN GTCB 25200017 * 25500017 SR R2,R2 25800017 IC R2,GTCDSRNO PLACE GTCB ADR INTO UATBL 26100017 S R2,CON1 26400017 SLL R2,TWO MULTIPLY BY 4 26700017 AR R2,RUATBL ADD ADR OF UNIT ASGNMT TABLE 27000017 ST RGTCB,ZERO(R2) STORE ADR INTO PROPER SLOT 27300017 * * 27600017 * INITIALIZE GTCB * 27900017 * * 28200017 MVC GTCPASS(4),PASSAD MOVE IN PASSWORD PTR 28600017 L R1,ASYNAD LOAD PTR TO VCON 29100017 L R1,ZERO(R1) LOAD ADR OF ASYN RTN 29400017 ST R1,GTCASYNC PUT ADR IN GTCB 29700017 * 30000017 LM R1,R2,WRBUFPTR 30300017 L R1,ZERO(R1) LOAD WRITE LNG 30320017 L R2,ZERO(R2) LOAD READ LNG 30340017 LTR R1,R1 DOES WRITE LNG EQUAL 0 30360017 BP SVWRT BRANCH IF NOT 30380017 * 30400017 LTR R2,R2 DOES READ LNG EQUAL 0 30420017 BP SVRD BRANCH IF NOT 30440017 * 30460017 L R8,ERCODAD LOAD ADR OF USER STATCODE AREA 30480017 LA R1,TWO SET CODE TO 2 30500017 LNR R1,R1 SET CODE NEGATIVE 30520017 ST R1,ZERO(R8) PLACE CODE IN USERS AREA 30540017 B FREEGTCB BRANCH TO CLEAN UP AND RETURN 30560017 * 30580017 SVRD EQU * 30600017 STH R2,GTCRDSIZ SAVE RD BFR SIZE 30620017 * 30640017 HDRLNG8 EQU * 30660017 LA R2,EIGHT(R2) ADD HEADER LNG OF 8 30680017 B GETBFR BRANCH TO GETMAIN 30700017 * 30720017 SVWRT EQU * 30740017 STH R1,GTCWRSIZ SAVE WRITE BFR SIZE 30760017 LTR R2,R2 DOES READ LNG EQUAL 0 30780017 BZ HDRLNG8 BRANCH IF YES 30800017 * 30820017 STH R2,GTCRDSIZ SAVE RD BFR SIZE 30840017 LA R2,SIXTEEN(R2) ADD HEADER LNG OF 16 30860017 * 30880017 GETBFR EQU * 30900017 AR R2,R1 ADD BFR SIZES TOGETHER 30920017 LR R0,R2 LOAD LNG INTO PARAM REG 30940017 * 30960017 GETMAIN R,LV=(0) GET BFR STORAGE 30980017 * 31000017 ST R1,GTCWRBUF STORE WRITE BFR ADR IN GTCB 31020017 LH R2,GTCWRSIZ LOAD WRBUF SIZE 31040017 LTR R2,R2 DOES READ LNG EQUAL 0 31060017 BP STORERD BRANCH IF NOT 31080017 * 31100017 SAMEADR EQU * INSERT SAME ADR FOR BFRSS 31120017 ST R1,GTCRDBUF INSERT SAME ADR FOR RDBFR 31140017 B SETSAV BRANCH TO SET UP SV AREA 31160017 * 31180017 STORERD EQU * 31200017 LH R5,GTCRDSIZ LOAD RDBUF SIZE 31220017 LTR R5,R5 DOES READ BFR SIZE EQ 0 31240017 BZ SAMEADR BRANCH IF YES 31260017 * 31280017 AR R2,R1 UPDATE BFR ADR BY READ SIZE 31300017 LA R2,EIGHT(R2) ADD HEADER LNG 31320017 ST R2,GTCRDBUF STORE RDBFR ADR IN GTCB 31340017 * 31360017 SETSAV EQU * SAVE AREA CONVENTIONS 31380017 ST RSAVE,GTCSVAR+FOUR EST SVAREA CHAIN 31680017 LR R2,RSAVE CONTINUE 31980017 LA RSAVE,GTCSVAR CONTINUE 32280017 ST RSAVE,EIGHT(R2) CONTINUE 32580017 * 32880017 CLC USECNT(FOUR,RUATBL),CONZERO DOES USECNT EQ ZERO 33180017 BH DOIO BRANCH IF GREATER 33600017 * 33900017 LOAD EP=IKDGTIRB IKDGTIRB 34200017 ST R0,GTIRB(RUATBL) 34500017 * 35100017 * 35400017 DOIO EQU * 35500017 MVC DCBBSTSX(FOUR),GTIRB(RUATBL) MOVE GTIRB ADR TO DCB 35600017 SR R2,R2 CLEAR REG 2 TO ZERO 35700017 IC R2,GTCDSRNO INSERT DSRN INTO R2 TO BEGIN 36000017 CVD R2,DCBDDNAM CONVERSION FROM HEX VALUE 36300017 UNPK GTCPTPRD(FOUR),DCBDDNAM+SIX(THREE) TO EBCDIC 36600017 * 36900017 MVC DCBDDNAM(EIGHT),DDNM MOVE DDNAME INTO DCB 37200017 MVC DCBDDNAM+TWO(TWO),GTCPTPRD MOVE IN DSRN 37500017 * 37800017 OI DCBXCODE,PTPBIT SET PTOP BIT IN DCB 38100017 OI DCBXCODE,OKNIT SET SLAVE BIT IN DCB 38400017 * 39000017 DEVTYPE DCBDDNAM,GTCPTPWR DETERMINE WHETHER 1130 OR 360 39300017 * PUT INFO IN WKAREA 39600017 MVI DCBBUFCB+THREE,HEX1 DUMMY THE BTAM DCB EXPANSION 39900017 MVI DCBDSORG,HEX10 CONTINUE 40200017 MVI DCBIOBAD+THREE,HEX1 CONTINUE 40500017 MVI DCBOFLGS,COMMN CONTINUE 40800017 MVI DCBMACR,HEX20 CONTINUE 41100017 MVI DCBMACR+ONE,HEX20 CONTINUE 41400017 LA R1,GTCDCB SET UP OPEN PARAM LIST 41700017 ST R1,GTCPTPRD IN GTCB RDBFR AREA 42000017 MVI GTCPTPRD,HEX80 SET END OF PARAM LST INDICATOR 42300017 LA R1,GTCPTPRD SET PARAM LST ADR IN REG 1 42600017 * 42900017 OPEN MF=(E,(1)) OPEN DCB TO EST LINE-GROUP 43200017 * 43500017 * IS COMMUNICATION WITH A 360 43800017 *CHECK PTPWRBF+2 FOR DEV CLASS AND UNIT TYPE 44100017 * 44400017 XC GTCPTPRD(TWENTY),GTCPTPRD CLEAR WORK AREA 44700017 * 45000017 LA R1,GTCPDECB LOAD ADR OF DECB 45300017 LA R2,GTCPTPRD 45600017 MVI FLGS2,PTPRTI SET PTOP READ INITIAL FLAG 45900017 * 46200017 READ (1),TI,(10),(2),14,,1,MF=E 46500017 * 46800017 * * * * * * * * 47100017 * TIMER MECHANISM * 47400017 * * * * * * * * 47700017 WAITIO EQU * 48000017 SET EQU * 48300017 LA R6,TIMECTR SET CTR 48600017 LA R5,ONESEC LOAD ADR OF NUMBER OF TIMER 48900017 * 49200017 WAITIME STIMER WAIT,TUINTVL=(5) SET TIMER FOR 1 SECOND AND WAIT 49500017 * 49800017 TM FLGS3,COMMN HAS COMMUNICATION BEEN MADE 50100017 BO WAITNIT BRANCH IF YES 50400017 BCT R6,WAITIME BRANCH TO WAIT ANOTHER SECOND 50700017 B TESTNIT OR BRANCH TO SET ERR STATCODE 51000017 * 51300017 WAITNIT EQU * 51600017 LA R1,GTCECB 51900017 WAIT ECB=(1) 52200017 TESTNIT EQU * WAS INITIALIZATION SUCCESSFUL 52500017 L R8,ERCODAD LOAD USER STATCODE ADR 52800017 TM FLGS3,COMMN HAS SOME COMMUNICATION MADE 53100017 BZ NOGO BRANCH IF NOT 53300017 * 53500017 NI FLGS3,NOCOMN SET COMMN FLG OFF 53700017 TM FLGS2,ERRNIT WAS THERE AN ERROR IN INIT 53900017 BZ LOADRTNS BRANCH IF NOT TO LOAD PTOP RTNS 54100017 * 54300017 TM FLGS2,ERRNEG DID PASSWORDS MATCH 54500017 BZ HARDERR BRANCH IF NOT 54700017 * 54900017 LA R1,ONE GET CODE 55100017 SOFTERR EQU * 55300017 LNR R1,R1 SET CODE NEGATIVE 55500017 B GIVECODE BRANCH TO SET CODE IN USER AREA 55700017 * 57000017 HARDERR EQU * 57300017 * 57600017 LA R1,ONE GET CODE POS FOR LINE ERRORS 57900017 B GIVECODE BRANCH TO SET CODE IN USER AREA 58200017 * 58500017 NOGO EQU * 58800017 LA R1,TWO GET CODE POS FOR 5MIN ELAPSED 59100017 GIVECODE ST R1,ZERO(R8) STORE CODE IN USERS AREA 59400017 * 59700017 CLEANUP EQU * 60000017 * * 60300017 * CLEANUP CORE,DELETE ROUTINES,CLOSE LINE * 60600017 * * 60900017 LA R2,GTCDCB SET UP TO CLOSE'LINE 62400017 ST R2,GTCPTPWR STORE DCB ADR IN PARAM LIST 62700017 MVI GTCPTPWR,HEX80 SET END OF LIST INDICATOR 63000017 LA R1,GTCPTPWR SET PARM LIST ADR IN REG 1 63300017 * 63600017 CLOSE MF=(E,(1)) CLOSE DCB 63900017 * 64200017 CLC USECNT(FOUR,RUATBL),CONZERO IS USECNT EQU TO 0 64220017 BH FREEBUF BRANCH IF NOT 64240017 DELETE EP=IKDGTIRB 64260017 * 64320017 SR R2,R2 64380017 ST R2,GTIRB(RUATBL) CLEAR UATBL SLOT OF GTIRB ADR 64440017 * 64444017 FREEBUF EQU * SAVE CALLER'S REG 13 64448017 LH R2,GTCWRSIZ LOAD WRBUF LNG 64452017 AH R2,GTCRDSIZ ADD RDBUF LNG 64456017 L R1,GTCWRBUF LOAD WRBFR ADR 64460017 C R1,GTCRDBUF WRBFR ADR SAME AS RDBFR 64464017 BE ADD8 BRANCH IF YES 64468017 * 64472017 LA R2,EIGHT(R2) ADD HDR LNG OF 8 64476017 ADD8 LA R2,EIGHT(R2) ADD ADDITIONAL ADRLNG OF 8 64480017 LR R0,R2 PUT TOTAL LNG IN PARAM REG 0 64484017 * 64488017 FREEMAIN R,LV=(0),A=(1) FREE RD/WRT BFRS 64492017 * 64496017 L RSAVE,GTCSVAR+FOUR RESTORE CALLER'S SVAREA PTR 64796017 FREEGTCB EQU * FREE B GTCB,SLOT IN UATBL 64896017 SR R2,R2 CLEAR R2 64996017 IC R2,GTCDSRNO SAVE DSRN FROM GTCB 65100017 L R0,GETREQ LOAD CORE AMOUNT TO FREE GTCB 65400017 LR R1,RGTCB LOAD ADR OF CORE TO BE FREED 65700017 * 66000017 FREEMAIN R,LV=(0),A=(1) FREE GTCB CORE 66300017 * 66600017 S R2,CON1 ACCESS GTCB SLOT IN UATBL 66900017 SLL R2,TWO MULTIPLY BY 4 67200017 AR R2,RUATBL ADD ADR OF UATBL TO DISP 67500017 XC ZERO(FOUR,R2),ZERO(R2) CLEAR GTCB PTR SLOT 67800017 L R2,USECNT(RUATBL) LOAD USECNT 68100017 LTR R2,R2 DOES USECNT EQ 0 68400017 BP GOBACK RETURN TO CONTROLLER 68700017 * 69000017 RETURN (14,12),T,RC=4 RETURN TO CALLER (CONTROLLER) 69300017 * * * * * 69600017 * * 69900017 * * 70200017 * * * * * 70500017 LOADRTNS EQU * 70800017 L R2,USECNT(RUATBL) LOAD USECNT 71000017 LTR R2,R2 DOES USECNT EQ 0 71200017 BP UPCOUNT BRANCH IF YES 71400017 * 71600017 LOAD EP=IKDRDWRT LOAD READ/WRITE RTN 71800017 ST R0,GTRED(RUATBL) PUT ADR IN UATBL 72000017 ST R0,GTWRT(RUATBL) PUT ADR IN UATBL 72200017 * 72400017 LOAD EP=IKDGTCLT LOAD GTCLT RTN 72600017 ST R0,GTCLT(RUATBL) PUT ADR IN UATBL 72800017 * 73000017 UPCOUNT EQU * UPDATE USECNT 73200017 LA R2,ONE(R2) ADD ONE 73400017 ST R2,USECNT(RUATBL) REPLACE IN UATBL 73600017 SR R2,R2 CLEAR REG 2 TO ZERO 73800017 ST R2,ZERO(R8) PLACE SUCCESS CODE IN USER AREA 74000017 L RSAVE,GTCSVAR+FOUR RESTORE CALLER'S SVAR PTR 74700017 GOBACK EQU * RETURN WITH RC =0 75400017 RETURN (14,12),T,RC=0 76200017 * 76500017 * 76800017 MVPTRS EQU * 77100017 MVC GTCPASS(FOUR),PASSAD MOVE IN PASSWORD PTR 77400017 L R1,ASYNAD LOAD PTR TO VCON 77700017 L R1,ZERO(R1) LOAD ADR OF ASYN RTN 78000017 ST R1,GTCASYNC PUT ADR IN GTCB 78300017 SR R6,R6 SET R6 TO 0 78600017 L R1,ERCODAD LOAD ADR OF USER STATCOD 78900017 ST R6,ZERO(R1) SET STATCOD TO ZERO 79200017 B GOBACK BRANCH TO RETURN WITH RC =0 79500017 * * 79800017 * CONSTANTS DEFINED * 80100017 * * 80400017 DS 0F PUT ON FULLWORD BOUNDARY 80700017 CONZERO DC F'0' NUMERICAL CONSTANT 0 81000017 CON1 DC F'1' NUMERICAL CONSTANT 1 81300017 GETREQ DC F'512' GETMAIN REQ FOR GTCB 81600017 ONESEC DC F'38462' TIMER UNITS FOR ONE SECOND 81900017 DDNM DC C'FTXXF001' DUMMY DDNM 82200017 CNOP 0,4 82500017 DSECT DSECT 82800017 DS 0F USER PARAM LIST DSECT 83100017 DSRN DS F DSRN 83400017 WRBUFPTR DS F PTR TO WRBUF 83700017 RDBUFPTR DS F PTR TO RDBUF 84000017 ASYNAD DS F ASYN RTN ADR PTR 84300017 PASSAD DS F PASSWORD PTR ADR 84600017 ERCODAD DS F PTR TO USER STATCOD 84900017 * * 87300017 COPY IKDGTCB 87600017 DCBD DSORG=CX,DEVD=BS 87900017 END 88200017 ./ ADD SSI=00010358,NAME=IKDRDWRT,SOURCE=0 TITLE 'IKDRDWRT' PROCESSOR-TO-PROCESSOR READ/WRITE ROUTINE 00300017 *STATUS: CHANGE LEVEL 000 * 00600017 *FUNCTION/OPERATION: 1.TO INITIATE USER READ/WRITE REQUESTS AND TO * 00900017 * ISSUE THE I/O REQUEST WHEN POSSIBLE * 01200017 * 2.TO PREVENT USER I/O QUEUING * 01500017 * 3.TO MAINTAIN PTOP INTERNAL BOOKKEEPING CONTROL * 01800017 * * 02100017 * ENTRY POINTS: ENTRY AT IKDRDWRT VIA BALR FROM IKDGTCLR (CONTROLLER) * 02400017 * * 02700017 *INPUT: REGISTER 4 POINTS TO GTCB REFERENCED BY USER DSRN * 03000017 * REGISTER 6 CONTAINS A READ CODE=0 OR A WRITE CODE=4 * 03300017 * REGISTER 11 POINTS TO USER'S PARAMETER LIST * 03600017 * * 03900017 *OUTPUT: UPDATED GTCB AND APPROPRIATE I/O STATUS CODES * 04200017 * * 04500017 *EXTERNAL ROUTINES: NONE * 04800017 * * 05100017 *EXITS-NORMAL: RETURN TO CONTROLLER VIA RETURN MACRO * 05400017 * -ERROR: NONE * 05700017 * * 06000017 *TABLES/WORK AREAS: GRAPHIC TELECOMMUNICATIONS CONTROL BLOCK * 06300017 * * 06600017 *ATTRIBUTES: REENTRANT,PROBLEM PROGRAM RESIDENT * 06900017 * * 07200017 *NOTES: N/A * 07500017 R0 EQU 0 REGISTER EQUATES 07800017 R1 EQU 1 REGISTER EQUATES 08100017 R2 EQU 2 REGISTER EQUATES 08400017 RDCB EQU 3 REGISTER EQUATES 08700017 RUATBL EQU 3 REGISTER EQUATES 09000017 RGTCB EQU 4 REGISTER EQUATES 09300017 RSVINF EQU 5 REGISTER EQUATES 09600017 RCODE EQU 6 REGISTER EQUATES 09900017 RBASE EQU 7 REGISTER EQUATES 10200017 RSTAT EQU 8 REGISTER EQUATES 10500017 RSEQ EQU 9 REGISTER EQUATES 10800017 R10 EQU 10 REGISTER EQUATES 11100017 RPRAM EQU 11 REGISTER EQUATES 11400017 RSAVE EQU 13 REGISTER EQUATES 11700017 R14 EQU 14 REGISTER EQUATES 12000017 R15 EQU 15 REGISTER EQUATES 12300017 * * 12600017 * PROGRAM EQUATE STATEMENTS * 12900017 * * 13200017 ZERO EQU 0 13500017 ONE EQU 1 13800017 TWO EQU 2 14100017 THREE EQU 3 14400017 FOUR EQU 4 14700017 TPARRAY EQU 4 15000017 FIVE EQU 5 15300017 SIX EQU 6 15600017 SEVEN EQU 7 EQUATE 7 15700017 EIGHT EQU 8 15900017 ELCNT EQU 8 16200017 MSGLNG EQU 10 16500017 CTLOPT EQU 16 DISPLACEMENT OF WRITE CTL OPTION 16800017 UCBAD EQU 32 16900017 ASVDISP EQU 72 ASYN RTN SVAREA DISPLACEMENT 17100017 EQ255 EQU 255 17400017 GTEND EQU X'01' 17700017 RTRPND EQU X'02' 18000017 SVRTRD EQU X'02' 18300017 ASYPND EQU X'04' 18600017 CANCEL EQU X'04' REQ TO CANCEL 1130 FLAG 18900017 HEX04 EQU X'04' EQUATE 4 FOR MSG HDR 19000017 CANPND EQU X'08' 19200017 A1130 EQU X'08' 1130 ASYN RTN REQ ACTIVE 19500017 CANASY EQU X'0C' 19800017 PTPTIXR EQU X'10' 20100017 ASYNC EQU X'20' 360 ASYNC RTN ACTIVE FLAG 20400017 RTRD EQU X'40' 20700017 HEX48 EQU X'48' EQUATE STMT FOR HALT I/O CODE 20800017 OKNIT EQU X'80' 21000017 PEND EQU X'80' 21300017 BIGLNG EQU X'80' 21600017 NOTSTRT EQU X'82' 21900017 STRTED EQU X'83' 22200017 CONTEND EQU X'84' 22500017 HEX88 EQU X'88' PTOP MSG HEADER CODE 22600017 USRTIXR EQU X'90' 22800017 HEX98 EQU X'98' EQUATE X'98' FOR PTOP MSG CODE 22900017 ASYN EQU X'0200' 23100017 RTRDOFF EQU X'BF' 23400017 OFFCAN EQU X'F7' 23700017 OFFASY EQU X'FB' 24000017 PNDOFF EQU X'FD' 24300017 * 24600017 IKDRDWRT CSECT 24900017 SAVE (14,12),,* 25200017 BALR RBASE,R0 EST. BASE REG 25500017 USING *,RBASE CONTINUE 25800017 USING IKDGTCB,RGTCB EST. BASE FOR GTCB DSECT 26100017 LA RDCB,GTCDCB LOAD ADR OF BTAM DCB 26400017 USING IHADCB,RDCB EST. BASE FOR DCB DSECT 26700017 TM GTCFLAGS,ASYNC REQUEST FROM ASYNC ROUTINE 27000017 BO ASYNSV BRANCH IF YES 27300017 * 27600017 ST RSAVE,GTCSVAR+FOUR SET UP ML SVAREA CHAIN 27900017 LR R1,RSAVE CONTINUE 28200017 LA RSAVE,GTCSVAR CONTINUE 28500017 ST RSAVE,EIGHT(R1) CONTINUE 28800017 * 29400017 SR RSVINF,RSVINF CLEAR INFO SAVE AREA REG 29700017 INITOK EQU * 30000017 RDWRTQ LTR RCODE,RCODE IS IT A READ REQUEST 30300017 BNZ CHKWRT BRANCH IF NOT 30600017 LH RSEQ,GTCRDSEQ LOAD SEQ NO. INTO REG 30900017 LA RSTAT,GTCLSTRD LOAD ADR OF LSTRD STATUS FLD 31200017 LA R1,GTCRDARY LOAD ADR OF RD ARRAY FLD IN GTCB 31500017 TM GTCLSTRD,PEND A READ REQUEST PENDING 31800017 BZ COMPUTE BRANCH IF NOT 32100017 * 32400017 RESTORE LTR RSVINF,RSVINF ASYNC RTN REQUEST 32700017 BP ASYNRET BRANCH IF YES 33000017 * 33300017 L RSAVE,GTCSVAR+FOUR RESTORE CALLER'S REG 13 33600017 RETURN RETURN (14,12),T 33900017 * 34200017 ASYNSV L RSVINF,GTCSVINF LOAD ASYN RTN INFO AREA ADDRESS 34500017 LA R1,ASVDISP(RSAVE) LOAD ADR OF ASYN SVAR 34800017 ST RSAVE,FOUR(R1) SET UP SVAREA CHAIN 35100017 ST R1,EIGHT(RSAVE) CONTINUE 35400017 LR RSAVE,R1 CONTINUE 35700017 B INITOK RETURN TO NORMAL PROCESSING 36000017 * 36300017 ASYNRET EQU * RESTORE ASYN CALLER'S REG 13 36600017 L RSAVE,FOUR(RSAVE) CONTINUE 36900017 B RETURN RETURN TO CALLER 37200017 * 38100017 CHKWRT EQU * 38400017 L R2,CTLOPT(RPRAM) LOAD ADR OF CTL OPTION 38700017 CLI THREE(R2),TWO REQ TO WRITE ASYN OR CANCEL 39000017 BL WRPEND BRANCH IF NOT 39300017 LH RSEQ,GTCWRSEQ LOAD WRITE SEQ NO. 39600017 LA RSEQ,ONE(RSEQ) INCREMENT SEQ NO. 39900017 BH SETCAN BRANCH IF CANCEL REQ 40500017 * 40800017 TM GTCFLAGS,A1130 IS REQUEST FOR 1130 ASYN PENDING 41100017 BO RESTORE BRANCH IF YES 41300017 * 41500017 STH RSEQ,GTCWRSEQ UPDATE SEQ NO. 41700017 L R1,TPARRAY(RPRAM) LOAD TEMP ARRAY ADR 42000017 LH R1,ZERO(R1) LOAD USER PARAM 42300017 STH R1,GTCPRMSV STORE ASYN PARM IN GTCB 42600017 OI GTCFLAGS,A1130 SET ASYNC FLAGS FOR 1130 42900017 OI FLGS4,ASYPND SET ASYN MSG PENDING FLAG 43100017 TM GTCFLAGS,RTRD IS 1130 ML READY-TO-READ 43300017 BZ RESET BRANCH IF NOT TO RESETPL 43500017 * 43700017 NI GTCFLAGS,RTRDOFF SET 1130 READY TO READ OFF 44100017 OI GTCFLAGS,SVRTRD SAVE THE READY TO READ 44400017 B RESET BRANCH TO RESETPL 44700017 * 45000017 SETCAN EQU * 45300017 TM GTCFLAGS,CANCEL IS CANCEL REQUEST PENDING 45600017 BO RESTORE BRANCH IF YES 45900017 * 46200017 TM GTCFLAGS,GTEND HAS 1130 GTENDED 46500017 BO RESTORE BRANCH IF YES 46700017 * 46900017 STH RSEQ,GTCWRSEQ INSERT SEQ NO. 47100017 OI GTCFLAGS,CANCEL SET CANCEL FLAG 47400017 OI FLGS4,CANPND SET CANCEL MSG PENDING FLAG 47700017 B RESET BRANCH TO RESETPL 48000017 WRPEND LA R1,GTCWRARY LOAD ADR OF WR ARRAY FLD IN GTCB 48300017 LA RSTAT,GTCLSTWR LOAD ADR OF LSTWR STATUS FLD 48600017 TM GTCLSTWR,PEND A WRITE REQ PENDING 48900017 BO RESTORE BRANCH IF YES 49200017 LH RSEQ,GTCWRSEQ LOAD SEQ NO. INTO REG 49500017 * 49800017 COMPUTE EQU * 50100017 L R2,TPARRAY(RPRAM) LOAD ADR OF USERS TEMPARRAY 50400017 ST R2,ZERO(R1) STORE ADR INTO APPROPRIATE FLD 50700017 MVI ZERO(RSTAT),NOTSTRT SET STATUS TO 2 WITH PENDING'80' 51000017 * 51300017 LM R1,R2,ELCNT(RPRAM) LOAD R1=ELCOUNT ADR, R2=DATATYPE 51600017 L R1,ZERO(R1) LOAD R1 WITH ACTUAL COUNT 51900017 CLI THREE(R2),FOUR IS DATA TYPE CODE 4-STD.PR.REAL 52200017 BH EXTPREAL BRANCH IF CODE 5-EXT.PR.REAL 52500017 BE STDREAL BRANCH IF CODE 4 52800017 SLL R1,ONE MULTIPLY ELCOUNT BY 2 FOR 53100017 B UPDATE CODES - 1,2,3 53400017 * 53700017 STDREAL SLL R1,TWO MULTIPLY ELCOUNT BY 4 FOR CD 4 54000017 B UPDATE BRANCH TO UPDATE GTCB 54300017 * 54600017 EXTPREAL MH R1,CON6 MULTIPLY ELCOUNT BY 6 FOR CODE 5 54900017 UPDATE EQU * UPDATE GTCB WITH INFO AND BEGIN 54960017 L R2,TPARRAY(RPRAM) STORAGE AND FETCH PROTECT CHECK 55020017 IC R15,ZERO(R2) GET AND REPLACE FIRST BYTE OF 55080017 STC R15,ZERO(R2) USER'S TEMPARRAY 55140017 AR R2,R1 ADD LEGTH TO ADDRESS 55200017 IC R15,ZERO(R2) GET AND REPLACE LAST BYTE OF 55260017 STC R15,ZERO(R2) USER'S TEMPARRAY 55320017 * 55380017 STH R1,TWO(RSTAT) STORE LENGTH IN LAST STATUS FLD 55440017 LA RSEQ,ONE(RSEQ) INCREMENT SEQUENCE NUMBER 55500017 * 55800017 * 56100017 LTR RCODE,RCODE IS IT A READ REQUEST 56400017 BZ SVSEQ BRANCH IF YES 56700017 STH RSEQ,GTCWRSEQ UPDATE WRITE SEQ NO. FLD 57000017 TM GTCFLAGS,RTRD IS 1130 USER READY-TO-READ 57300017 BZ RESTORE BRANCH IF NOT 57500017 B RESET OTHERWISE BRANCH TO RESETPL 57700017 * 57900017 SVSEQ STH RSEQ,GTCRDSEQ STORE SEQ NO. IN GTCB 58100017 OI FLGS4,RTRPND SET RTRD MSG PENDING FLAG 58300017 * 58500017 RESET LA R1,GTCPDECB LOAD DECB ADR IN REG 1 58700017 TM GTCFLAGS,GTEND HAS 1130 CALLED GTEND 58900017 BO RESTORE BRANCH IF YES 59100017 RESETPL (1) HALT I/O 60000017 * 60300017 C R15,CON4 DID RESETPL RETURN A CODE 60400017 BE RESTORE BRANCH IF YES 60500017 * 60600017 L R2,DCBDEBAD LOAD DEB ADR 60700017 L R2,UCBAD(R2) LOAD ADR OF UCB 61260017 TM FOUR(R2),PEND WAS HALT I/O ISSUED 61290017 BZ CHKECB BRANCH IF NOT 61320017 * 61350017 LA R1,GTCPDECB LOAD DECB ADR IN REG1 61380017 WAIT ECB=(1) 61410017 * 61440017 CHKECB EQU * 61470017 CLI GTCPDECB,HEX48 WAS HALT I/O ISSUED 61670017 BNE RESTORE BRANCH IF NOT 61870017 * 62100017 LTR RCODE,RCODE READ OR WRITE REQUEST 62400017 BNZ WRITE BRANCH IF WRITE REQUEST 62500017 * 62600017 NI FLGS4,PNDOFF SET RTRD MSG PENDING FLG OFF 62700017 MVC GTCPTPWR(TWO),DCBBSTSX SET CTL CHARS DLE STX IN WRBUF 62800017 STC RSEQ,GTCPTPWR+FOUR INSERT SEQ NO. 62900017 MVI GTCPTPWR+TWO,HEX88 INSERT RTRD CODE IN MSG HDR 63000017 MVC GTCPTPWR+THREE(ONE),GTCDSRNO INSERT DSRN 63100017 MVI GTCPTPWR+FIVE,HEX04 COMPLETE MSG 63200017 MVI GTCPTPWR+SIX,ASYNC CONTINUE 63300017 MVI GTCPTPWR+SEVEN,ZERO CONTINUE 63400017 LH R2,GTCRDSIZ LOAD READ BFR SIZE 63500017 CH R2,CON1 READ BFR SIZE EQUAL TO 0 63600017 BNL LNGCHK BRANCH IF NOT 63700017 * 63800017 LH R2,GTCWRSIZ LOAD WRBFR LNG 63900017 LNGCHK EQU * 64000017 CH R2,GTCRDLNG IS BFR SIZE AS LARGE AS REQUEST 64100017 BL LNGMV BRANCH IF NOT 64200017 * 64300017 LH R2,GTCRDLNG LOAD RDBFR LNG 64400017 LNGMV EQU * 64500017 STH R2,GTCPTPWR+EIGHT STORE BFR LNG IN MSG 64600017 * 66000017 TM GTCFLAGS,RTRD DOES READ CONTENTION ELIST 66300017 BZ RTRDMSG BRANCH IF NOT 66600017 * 66900017 MVI GTCLSTRD,CONTEND SET READ CONTENTION FLAG 67200017 * 67500017 RTRDMSG EQU * PREPARE TO WRITE THE RTRD MSG 67800017 LA R2,MSGLNG LOAD MSG LNG 68100017 MVI FLGS2,PTPTIXR SET WTIXR FLAG 68400017 LA R10,GTCPTPWR LOAD ADR OF PTOP WRBFR 68700017 * 69000017 WRDATA EQU * ISSUE I/O 69300017 LA R1,GTCPDECB LOAD ADR OF DECB 69600017 * 69900017 WRITE (1),TIXR,(3),(10),(2),,1,MF=E 70200017 * 70500017 B RESTORE BRANCH TO RETURN TO CALLER 70900017 * 71400017 WRITE EQU * 71700017 TM FLGS4,CANASY REQ TO CANCEL OR FOR ASYN 72000017 BC FIVE,WR1130 BRANCH IF YES 72300017 * 72600017 * 72900017 L R2,TPARRAY(RPRAM) LOAD ADR OF TEMPARRAY 73200017 L R10,GTCWRBUF LOAD ADR OF USER WRBUF 73500017 LA R10,SIX(R10) LOAD ADR OF DATA AREA IN BFR 73800017 * 74100017 * 75000017 LH R1,GTCWRLNG LOAD LENGTH OF DATA 75300017 LH R14,GTCWRSIZ 75350017 LTR R14,R14 DOES WRITE BFR SIZE EQUAL 0 75400017 BP LNGSET BRANCH IF NOT 75450017 * 75500017 LH R14,GTCRDSIZ LOAD RDBFR LNG 75550017 LNGSET EQU * 75600017 CR R1,R14 DOES WRITE REQUEST EXCEED BFRSIZ 75650017 BNH LNGSET1 BRANCH IF NOT 75700017 * 75750017 LR R1,R14 LOAD WRBFR SIZE IN REG 1 75800017 LNGSET1 EQU * 75850017 LA R15,EQ255 LOAD MAXIMUM MOVE LNG 75900017 MVLOOP CH R1,CON256 IS LNG GREATER THAN 256 76200017 BNL HIGHEQL BRANCH IF YES 76500017 * 76800017 SH R1,CON1 SUBTRACT 1 TO EXECUTE MOVE 77100017 EX R1,MOVE EXECUTE EXACT LNG 77400017 * 77700017 INSERT EQU * 78000017 L R10,GTCWRBUF GET START OF USER WRBUF 78300017 MVC ZERO(TWO,R10),DCBBSTSX MOVE CTL CHARS IN MSG HDR 78600017 MVI TWO(R10),PEND CONTINUE 78900017 MVC THREE(ONE,R10),GTCDSRNO CONTINUE 79200017 STC RSEQ,FOUR(R10) CONTINUE 79500017 MVI FIVE(R10),HEX04 CONTINUE 79800017 * 80100017 MVI GTCLSTWR,STRTED SET STARTED BUT NOT COMPLETE 80400017 MVI FLGS2,USRTIXR SET USER WTIXR FLG 80700017 LH R2,GTCWRLNG LOAD LENGTH TO DO WRITE 81000017 CH R2,GTCLNGSV IS WRITE LNG GTEATER THAN READ 81300017 BNH SETLNG BRANCH IF NOT 81600017 * 81900017 LH R2,GTCLNGSV LOAD LNG PASSED FROM 1130 82200017 OI THREE(R10),BIGLNG INSERT INCORRECT LNG FLAG 82500017 SETLNG EQU * 82800017 CR R2,R14 DOES REQUEST EXCEED BFR SIZE 82850017 BNH SETLNG1 BRANCH IF NOT 82900017 * 82950017 LR R2,R14 LOAD BFR SIZE 83000017 SETLNG1 EQU * 83050017 LA R2,SIX(R2) ADD CTL CHAR TO BFR LNG 83100017 B WRDATA BRANCH TO WRITE 83400017 HIGHEQL EQU * 83700017 SH R1,CON256 DECREMENT LNG COUNT 84000017 EX R15,MOVE EXECUTE MAXIMUM MOVE 84300017 * 84600017 LTR R1,R1 DOES LNG COUNT EQUAL 0 84800017 BZ INSERT BRANCH IF YES 85000017 AH R2,CON256 UPDATE ARRAY POINTERS 85300017 AH R10,CON256 ADD 256 TO BFR ADR 85400017 B MVLOOP BRANCH TO MOVE MORE DATA 85500017 * 85800017 * 88500017 WR1130 EQU * 88800017 MVC GTCPTPWR(TWO),DCBBSTSX MOVE IN CTL CHARS DLE STX 89100017 MVI GTCPTPWR+TWO,HEX98 COMPLETE MSG HEADER 89400017 MVC GTCPTPWR+THREE(ONE),GTCDSRNO CONTINUE 89700017 STC RSEQ,GTCPTPWR+FOUR CONTINUE 90000017 MVI GTCPTPWR+FIVE,HEX04 CONTINUE 90300017 OI FLGS2,PTPTIXR SET WTIXR FLAG 90600017 TM FLGS4,ASYPND IS ASYN REQ MSG PENDING 90900017 BO WRASYN BRANCH IF YES 91200017 * 91500017 MVC GTCPTPWR+SIX(TWO),TERM INSERT CANCEL HDR INFO 91800017 NI FLGS4,OFFCAN SET PENDING FLG OFF 92100017 NI GTCFLAGS,RTRDOFF SET 1130 READY TO READ OFF 92400017 OI GTCFLAGS,GTEND SET 1130 GTEND FLAGS 92700017 B RTRDMSG BRANCH TO WRITE MSG 93000017 * 93300017 WRASYN LA R0,ASYN LOAD ASYN MSG CODE 93600017 STH R0,GTCPTPWR+SIX INSERT IN MSG 93900017 MVC GTCPTPWR+EIGHT(TWO),GTCPRMSV INSERT PARAM 94200017 NI FLGS4,OFFASY SET PENDING FLAG OFF 94500017 B RTRDMSG BRANCH TO WRITE MSG 94900017 * 95400017 MOVE MVC ZERO(ONE,R10),ZERO(R2) MOVE USER DATA TO WRBFR 95700017 * 96000017 * CONSTANTS DEFINED * 96300017 * * 96600017 DS 0F FULLWORD ALIGNMENT 96900017 CON1 DC H'1' CONSTANT 1 97200017 CON6 DC H'6' CONSTANT 6 97500017 CON256 DC H'256' CONSTANT 256 97800017 TERM DC X'1000' CANCEL CODE 98100017 CON4 DC F'4' CONSTANT 4 98400017 CNOP 0,4 98700017 COPY IKDGTCB 99000017 DCBD DSORG=CX,DEVD=BS 99300017 END 99600017 ./ ADD SSI=00012069,NAME=IKDUATBL,SOURCE=0 TITLE 'IKDUATBL' PROCESSOR-TO-PROCESSOR UNIT ASSIGNMENT TABLE 03000017 *STATUS: CHANGE LEVEL 000 * 06000017 *FUNCTION/OPERATION: TO PROVIDE A TABLE IN WHICH TO HOLD THE ADDRESSES* 09000017 * OF UP TO 100 GRAPHIC TELECOMMUNICATION CONTROL BLOCKS (GTCB) * 12000017 * BASED ON THE DATA SET REFERENCE NUMBERS (S/360-1130 COMMUNICATION * 15000017 * LINES) INITIALIZED BY THE PROBLEM PROGRAM USER. THE TABLE ALSO * 18000017 * CONTAINS POINTERS TO PTOP ROUTINES IKDRDWRT,IKDGTCLT AND IKDGTIRB,* 21000017 * AN 18 WORD SAVE AREA (USED BY IKDGTCLR - CONTROLLER) AND A USECNT * 24000017 * FIELD WHICH CONTAINS THE NUMBER OF GTCB ADDRESSES IN THE TABLE. * 27000017 * * 30000017 *ENTRY POINTS: N/A * 33000017 * * 36000017 *INPUT: N/A * 39000017 * * 42000017 *OUTPUT: N/A * 45000017 * * 48000017 *EXTERNAL ROUTINES: N/A * 51000017 * * 54000017 *EXITS-NORMAL: N/A * 57000017 * * 60000017 * -ERROR: N/A * 63000017 * * 66000017 *TABLES/WORK AREAS: N/A * 69000017 *ATTRIBUTES: REUSABLE, PROBLEM PROGRAM RESIDENT * 72000017 * * 75000017 *NOTES: THE TABLE IS LOADED BY IKDGTCLR (CONTROLLER) AND DELETED * 78000017 * BY THE CONTROLLER. IT IS UPDATED BY IKDGTNIT AND IKDGTEND. * 81000017 IKDUATBL CSECT 84000017 USING *,2 ESTABLISH A BASE REGISTER 87000017 DC 125F'0' 125 WORDS OF ZERO 90000017 CNOP 0,4 93000017 END 96000017