|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 61976 (0xf218)
Types: s3xseg
Names: »S$E065«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E065«
MACRO 00010000
$E065 00020000
GBLB &DFF 00030000
GBLB &NDF 00040000
TEXT 00050000
AIF (&NDF).END 00060000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE. 3270 SUPPORT FOR CCP' @10 00070000
SPACE 00080000
*********************************************************************** 00090000
* * 00100000
*NAME- $E065 @10 00110000
* * 00120000
*VERSION-V4M0 MODEL 15D CCP @10 00130000
* * 00140000
*TITLE- $E065 DISPLAY FORMAT CONTROL ROUTINE, $CC4II PORTION. @10 00150000
* THIS IS THE MAIN ROUTINE TO SERVICE USER PROGRAMS WHICH USE * 00160000
* THE DISPLAY FORMAT FACILITY (DFF). RUNS UNDER CONTROL OF @10 00170000
* THE USER TCB. @10 00175000
* * 00180000
*FUNCTION- PROVIDE LOGICAL DATA MANAGEMENT SUPPORT FOR COMPONENTS OF * 00190000
* OF THE 3270 SYSTEM. THE PRIMARY FUNCTION IS TO INITIALIZE @10 00200000
* THE PROGRAM APPENDED STORAGE AREA (PAS) IN RESPONSE TO A @10 00210000
* USER TASK OPERATION INVOLVING A DFF TERMINAL. THE DATA IN @10 00220000
* THE PAS IS USED LATER BY THE DFF TASK ($CC4DF). @10 00230000
* * 00290000
* THE FUNCTIONS PROVIDED FOR THE VARIOUS OP CODES ARE * 00300000
* AS FOLLOWS... * 00310000
* * 00320000
* 'GET MESSAGE' AND 'STOP INVITE INPUT' -- THE USER PARAMETER * 00330000
* LIST WILL BE MODIFIED TO TELL CM/CS HOW MUCH OF A HOLD@10 00340000
* AREA TO GETMAIN FOR THE 3270 TEXT. THE USER'S RECORD @10 00350000
* AREA WILL BE BLANKED. AFTER THE OP-END @10 00355000
* OCCURS THE DATA WILL BE MOVED FROM THE DYNAMIC TP BUFFER * 00360000
* TO THE USER'S RECORD AREA. THE ADDRESS OF THE TP AREA * 00370000
* WHICH CONTAINS THE 3270 TEXT WILL BE PLACED IN THE USER'S* 00380000
* PARAMETER LIST BY CM/CS. THE PARAMETER LIST WILL BE R@10 00390000
* STORED TO THE ORIGINIAL CONDITION BEFORE RETURNING TO * 00400000
* $CC4II. THE TP AREA REQUIRED FOR PASSING 3270 TEXT IS * 00410000
* GET-MAINED BY CM/CS AND FREED BY CM/CS. EXCEPTIONS AR@10 00420000
* INPUT OPERATIONS. IN THOSE CASES $CC4DF FREE-MAINS THE @10 00430000
* AREAS GET-MAINED BY CM/CS. @10 00440000
* * 00450000
* 'INVITE INPUT' -- THE PLRECA AND PLINL AS SET BY THE USER IS * 00460000
* IGNORED BY THIS ROUTINE. THE USER PARAMETER LIST IS @10 00470000
* MODIFIED TO TELL CM/CS HOW MUCH OF A HOLD AREA TO @10 00480000
* GETMAIN FOR THE 3270 TEXT. @10 00490000
* * 00500000
* 'ACCEPT INPUT' -- THIS OPERATION IS HANDLED FOR THE MOST PART* 00510000
* LIKE 'GET MESSAGE', EXCEPT THE DATA AREA ADDRESS OF THE * 00520000
* 3270 TEXT AND PLEFFL IS OBTAINED FROM THE TUB. @10 00530000
* THIS ROUTINE WILL HANDLE DATA WITH A PROGRAM REQUEST IF@10 00540000
* PRUF IS ACTIVE ON THE TERMINAL AT PROGRAM REQUEST TIME. * 00550000
* IF PRUF IS ACTIVE, DATA WILL BE HANDLED AS NORMAL ACCEPT * 00560000
* INPUT OPERATION. IF NOT, DATA WILL BE HANDLED ENTIRELY * 00570000
* BY CM/CS. @10 00580000
* * 00590000
* 'PUT MESSAGE' -- PLOUTL IN THE USER'S PARAMETER LIST IS * 00600000
* MODIFIED BY THIS ROUTINE TO REFLECT THE ACTUAL AMOUNT * 00610000
* OF 3270 TEXT BEING SENT BY THIS ROUTINE. @10 00620000
* * 00690000
* 'PUT OVERRIDE' -- THE TRANSIENT $CC4DB WILL BE INVOKED TO @10 00700000
* DIAGNOSE THE USE OF THE OPERATION AND TO CALCULATE THE * 00710000
* LENGTH OF TEXT TO GENERATE, ALSO DETERMINING IF BLOCKING * 00720000
* IS REQUIRED. @10 00730000
* * 00760000
* 'COPY' -- SET UP PARAMETER LIST SO CM/CS WILL GETMAIN AN @10 00770000
* AREA IN TPBUFFER TO BUILD COPY TEXT. * 00780000
* THIS OPERATION WILL GO THROUGH CM/CS AS A 'PUT MESSAGE@10 00790000
* * 00800000
* 'ERASE ALL UNPROTECTED' --THE USER'S PARAMETER LIST WILL BE@10 00820000
* MODIFIED TO INDICATE TEXT LENGTH. @10 00830000
* * 00870000
* 'RELEASE TERMINAL' -- THIS OPERATION INVOLVES BLANKING * 00880000
* OUT THE TT ENTRY FOR THE RESPECTIVE TERMINAL. NO * 00890000
* REPERCUSIONS ARE TAKEN OUT ON THE USER FOR RELEASING * 00900000
* TERMINAL WHICH HAD NOT PREVIOUSLY BEEN USED WITH DFF. @10 00910000
* * 00930000
*ENTRY POINT- THERE ARE TWO ENTRY POINT FROM $CC4II. * 00940000
* DFA000 - ALL REQUESTS FOR DFF FUNCTIONS. @10 00942000
* DFQ030 - RETURN CODE CHECKED FOR CONDITIONS THAT * 00944000
* MIGHT DESTROY DFF SCREEN FORMAT SUCH AS CLEAR * 00946000
* * 00950000
*INPUT- XR2 MUST CONTAIN THE HIGH ORDER ADDRESS OF THE USER CCP * 00960000
* PARAMETER LIST. * 00970000
* A 'USER PROGRAM APPENDED STORAGE AREA' (PAS) MUST BE * 00980000
* AVAILABLE FOR STORING DATA SPECIFIC TO THIS TASK. * 00990000
* * 01000000
* DISPLAY FORMATS MUST HAVE BEEN ALREADY GENERATED AND MUST * 01010000
* EXIST IN THE OBJECT LIBRARY. THE FORMAT MUST BE IN TWO PARTS.* 01020000
* THE FIRST PART IS THE 'FIELD DESCRIPTOR TABLE' (FDT), AND * 01030000
* THE SECOND IS THE TEXT STREAM FOR AN INITIAL PUT TO A 3270 * 01040000
* TERMINAL. * 01050000
* * 01060000
* FOR ALL OPERATIONS, PLRECA MUST POINT TO THE HIGH-ORDER * 01070000
* BYTE OF THE TERMINAL NAME FOR WHICH THE OPERATION IS INTENDED* 01080000
* (EXCEPT FOR ACCEPT INPUT, IN WHICH CASE THE POINTER IS TO THE * 01090000
* HIGH ORDER BYTE OF THE DATA AREA). IMMEDIATELY FOLLOWING THE 6 * 01100000
* CHARACTER TERMINAL NAME MUST BE THE BEGINING OF THE DATA AREA* 01110000
* * 01120000
* FOR OUTPUT OPERATIONS, THE FOLLOWING INFORMATION IS ALSO * 01130000
* REQUIRED... * 01140000
* 'PUT MSG'- DISPLAY FORMAT NAME IN FIRST 6 POSITIONS OF * 01150000
* THE DATA AREA, FOLLOWED BY ANY DATA FOR FIELDS WHICH WERE* 01160000
* DEFINED AS BEING SUPPLIED AT EXECUTION TIME. @10 01170000
* * 01180000
* 'PUT OVERRIDE'- THE WCC MUST BE THE FIRST POSITION IN THE* 01190000
* DATA AREA. THIS IS THE MINIMUM ENTRY FOR THIS OPERATION.* 01200000
* OPTIONALLY, 9 POSITIONS SHOULD BE GIVEN FOR EACH FIELD * 01210000
* WHICH IS TO BE OVERRIDEN. 6 FOR FIELD NAME 1 EACH FOR * 01220000
* TYPE, CURSOR, AND MODIFY. * 01230000
* * 01240000
* * 01270000
*OUTPUT- @10 01280000
* UPDATED AREAS IN PAS TO REFLECT CURRENT STATUS OF OPERATION@10 01310000
* FOR THIS TASK. * 01320000
* * 01330000
* * 01340000
* IF A TASK WILL BE TERMINATED, THE TRANSIENT $CC4DD WILL BE * 01350000
* INVOKED TO DETERMINE IF THE CONSOLE MESSAGE 528 SHOULD BE @10 01360000
* ISSUED. * 01370000
* * 01380000
*DIAGNOSTICS- THE FOLLOWING DIAGNOSTICS ARE PERFORMED AND ISSUED * 01390000
* BY THIS ROUTINE. (OTHERS ARE GIVEN BY $CC4DB, $CC4DC AND @10 01400000
* $CC4DF). @10 01405000
* TERMINATION CODES... * 01410000
* * 01420000
* FF - 255 * 01430000
* FE - 254 * 01440000
* FC - 252 * 01460000
* F9 - 249 * 01480000
* F8 - 248 * 01490000
* F7 - 247 @10 01495000
* F6 - 246 * 01500000
* F3 - 243 * 01520000
* * 01540000
*EXTERNAL REFERENCE- * 01550000
* CCCOM * 01560000
* TCB * 01570000
* USER PARAMETER LIST * 01580000
* TUB * 01590000
* FDT (FIELD DESCRIPTOR TABLE) * 01600000
* PAS (PROGRAM APPENDED STORAGE) * 01610000
* TT (TERMINAL TABLE) * 01620000
* FT (FORMAT TABLE) * 01630000
* * 01640000
*CALLED BY- $CC4II OPERATING FOR USER TASK. @10 01650000
* * 01770000
* * 01780000
*EXITS TO- $CC4CM OR $CC4#M COMMUNICATIONS MANAGER OR SCHEDULER @10 01790000
* POST * 01800000
* WAIT * 01810000
* $CC4MX MOVE * 01820000
* $CC4DB DFCR TRANSIENT TO DIAGNOSE 'PUT OVERRIDES'. * 01830000
* $CC4DD DFCR TRANSIENT TO ISSUE MESSAGE 528. * 01840000
* $CC4PI TRANSIENT INITIATOR * 01850000
* CC4TI2 TERMINATE A TASK * 01860000
* DISK IOS * 01870000
* DISK WAIT * 01880000
* * 01890000
* * 01920000
*ATTRIBUTES-REUSABLE @10 01930000
* * 01940000
*NOTES: ALL TASK DEPENDENT INFORMATION IS KEPT IN THE 'PAS' ATTACHED * 01950000
* TO THE USER PROGRAM. * 01960000
* * 01970000
* ORGANIZATION OF THIS ROUTINE... * 01980000
* 1. DFA000 ENTRY POINT AND FUNCTION DETERMINATION. 01990000
* 2. DFB000 'PUT MESSAGE', NORMAL AND BLOCKING. * 02000000
* 3. DFC000 'COPY' OPERATION. * 02010000
* 4. DFD000 'PUT' OVERRIDES', NORMAL AND BLOCKING. * 02020000
* 5. DFE000 'ERASE ALL UNPROTECTED' OPERATION. * 02030000
* 6. DFF000 CREATE A 'TT' ENTRY * 02040000
* 7. DFG000 'GET', 'INVITE INPUT', 'ACCEPT INPUT', 'STOP * 02050000
* INVITE INPUT' OPERATIONS. * 02060000
* 8. DFH000 CALCULATE GETMAIN TP-BUFFER LENGTH * 02070000
* 9. DFI000 INCREMENT THE DISK ADDRESS IN THE IOB. * 02080000
* 10. DFJ000 READ THE 'FDT' INTO 'PAS'. * 02090000
* 11. DFQ000 CONTROL RETURN TO $CC4II AND RESTORE USER'S * 02100000
* PARAMETER LIST. * 02110000
* 12. DFR000 'RELEASE' A TERMINAL FROM DFCR. * 02120000
* 13. DFT000 'TERMINATE' A TASK. * 02130000
* 14. DFV000 READ FROM DISK. * 02140000
* * 02150000
* CHANGE ACTIVITY * 02160000
* RELEASE 3 * 02170000
* @01/INCR/ - PROGRAM REQUEST UNDER FORMAT. * 02180000
* * 02190000
* RELEASE 4 * 02200000
* @02/INCR/ES.0419 - MODIFY DATA OPERATION IS THE ONLY VALID * 02210000
* OPERATION FOR A PUT OVERRIDE TO A PFGR * 02220000
* FORMAT. * 02230000
* @03/APAR/S306869 - FALSE BIT LEFT ON AFTER RETURNING FROM * 02240000
* A TRANSIENT CALL. * 02250000
* * 02251000
* RELEASE 1 SYSTEM/3 MOD-15D. * 02252000
* RELEASE 2 SYSTEM/3 MOD-15D. * 02253000
* @04/INCR/OS.0214 - INCORE FORMAT INDEX OPTION. * 02254000
* @05/INCR/OS.XXXX - VAR. PRUF INVITE INPUT LENGTH. * 02255000
* RELEASE 3 SYSTEM/3 MOD-15D. * 02255800
* @06/APAR/S311518 - ACCEPT NO-WAIT OPERATION. * 02256600
* @07/APAR/S311955 - FORMATS NOT FOUND IN SECTOR. * 02257400
* @08/APAR/S311284 - MULTI PRUF SCREEN AND TUBPIL. * 02258200
* @09/INCR/OS.0347 - SUPPORT FOR COMMAND RELEASE. * 02259000
* RELEASE 4 SYSTEM/3 MOD-15D. @10 02259200
* @10/INCR/OS4301 - TPBUFFER IMPROVMENTS. @10 02259400
* @11/INCR/OS4201 - FORMATS ON ANY SIMULATION AREA @11 02259600
* RELEASE 5 SYSTEM/3 MOD-15D. @12 02259700
* @12/APAR/S315898- BAD IOB FLAGS SET FOR DFF ON ANY PACK @12 02259800
* * 02260000
*********************************************************************** 02270000
EJECT 02280000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE. -- EQUATES--' @10 02290000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02300000
* * 02310000
* EQUATES USED IN THIS ROUTINE * 02320000
* * 02330000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02340000
SPACE 02350000
ZEROD EQU 0 CONSTANT EQUATE 02360000
ONED EQU 1 CONSTANT EQUATE 02370000
TWOD EQU 2 CONSTANT EQUATE 02380000
THREED EQU 3 CONSTANT EQUATE 02390000
FOURD EQU 4 CONSTANT EQUATE 02400000
SPACE 02410000
* MISCELLANEOUS EQUATES 02420000
* REGISTER EQUATES 02430000
CCOM EQU 1 REG FOR CCP COM AREA 02440000
COM2 EQU 2 REGISTER EQUATE 02450000
CCOM2 EQU 2 REGISTER EQUATE 02460000
PAS1 EQU 1 REGISTER EQUATE 02470000
PAS2 EQU 2 REGISTER EQUATE 02480000
FT1 EQU 1 REGISTER EQUATE 02490000
FT2 EQU 2 FORMAT TABLE REG 02500000
LRA1 EQU 1 02510000
LRA2 EQU 2 02520000
FDT2 EQU 2 02530000
FDT1 EQU 1 02540000
OPTR1 EQU 1 02550000
DTF1 EQU 1 DTF PTR 02560000
DTF2 EQU 2 DTF REGISTER 02570000
UPL1 EQU 1 PARM LIST REGISTER 02580000
UPL2 EQU 2 REGISTER EQUATE 02590000
TCB1 EQU 1 REGISTER EQUATE 02600000
TCBR1 EQU 1 TCB REG 1 02610000
TT1 EQU 1 REGISTER EQUATE 02620000
TT2 EQU 2 REG TO POINT TO TT 02630000
TUB1 EQU 1 TUB PTR 02640000
TUB2 EQU 2 TUB POINTER 02650000
GM2 EQU 2 REGISTER FOR GET-MAIN PARM LIST 02660000
OHA1 EQU 1 REGISTER EQUATE 02670000
OHA2 EQU 2 REGISTER EQUATE 02680000
OH2 EQU 2 REGISTER EQUATE 02690000
TCB2 EQU 2 REGISTER EQUATE 02700000
IOB EQU 1 REGISTER EQUATE 02710000
TYP1 EQU 1 REGISTER EQUATE 02720000
BFR2 EQU 2 REGISTER EQUATE 02730000
SPACE 02740000
* MISC EQUATES 02750000
COM EQU X'C000' FLAG FOR RELOCATION TO CCOM VALU 02760000
PGM EQU X'8000' FLAG FOR RELOCATION TO CCP PGM 02770000
X01 EQU X'01' HEX EQUATE VALUE 02780000
CMD EQU 1 HEX EQUATE VALUE 02790000
X20 EQU X'20' HEX EQUATE VALUE 02800000
XC0 EQU X'C0' HEX EQUATE VALUE 02810000
X08 EQU X'08' HEX EQUATE VALUE 02820000
X06 EQU X'06' HEX EQUATE VALUE 02830000
X27 EQU X'27' HEX EQUATE VALUE 02840000
X16 EQU X'16' HEX EQUATE VALUE 02850000
X80 EQU X'80' HEX EQUATE VALUE 02860000
X07D EQU 7 HEX EQUATE VALUE 02870000
X60 EQU X'60' HEX VALUE 60 02880000
XF0 EQU X'F0' NEX F0 02890000
X0F EQU X'0F' HAX 0F 02900000
EQUFF EQU X'FF' HEX EQUATE VALUE 02910000
BLANKD EQU X'40' EQUATE FOR A BLANK 02920000
END EQU X'FF' STOPPER 02930000
MODDAT EQU C'M' MODIFIED DATA SUPPLIED @02 02940000
SPACE 02950000
* EQUATES FOR THE FUNCTION DETERMINATION TABLE 02960000
OPTBOP EQU 0 DISP TO OP CODE 02970000
OPTB@ EQU 2 DISP TO ADDRESS FOR OP CODE 02980000
OPTBLL EQU 3 LENGTH OF AN ENTRY 02990000
SPACE 03000000
HIGH EQU X'84' HIGH CONDITION CODE 03010000
NOTLOW EQU X'02' NOT LOW CONDITION CODE 03020000
NOTHI EQU X'04' NOT HIGH CONDITION CODE 03030000
TANDEQ EQU X'16' TRUE AND EQUAL 03040000
FORNE EQU X'96' FALSE OR NOT EQUAL 03050000
FOREQ EQU X'91' FALSE OR EQUAL CONDITION CODE 03060000
SPACE 03070000
FTLD EQU 5 L-1 OF FT NAME 03080000
TNAMLD EQU 5 L-1 OF TERMINAL NAME 03090000
LINE1 EQU X'80' DEVICE CODE FOR BSCA LINE 1 03100000
DTFDEV EQU 0 DISP IN DTF TO DEVICE CODE 03110000
NUMBIT EQU X'0F' NUMERIC BITS 03120000
NEGZON EQU X'D0' NEGATIVE ZONE 03130000
POSZON EQU X'F0' POSITIVE ZONE 03140000
MINUS EQU C'-' MINUS SIGN 03150000
IOBOK EQU X'40' IOB COMPLETION CODE FOR 'NORMAL' 03160000
FNAMLD EQU 6 LENGTH OF A FIELD NAME 03170000
SPACE 03180000
* EQUATES FOR THE DISPLAY FORMAT INDEX IN CCPFILE 03190000
INX2 EQU XR2 REGISTER FOR FORMAT INDEX 03200000
INXNAM EQU #+4-1 DISP TO NAME IN INDEX ENTRY 03210000
INXCS EQU INXNAM+2 DISP TO DISK C/S IN INDEX 03220000
INXLNG EQU INXCS+1 FULL LENGTH OF AN INDEX ENTRY 03230000
INXNXT EQU X'FE' INCORE INDEX CONTINUE INDICATOR 03235000
INXEND EQU X'FF' INDICATION OF END OF INDEX 03240000
INXNS EQU 42 NUMBER INDEX ENTRIES IN A SECTOR 03250000
INXES EQU 256-INXNS*6 UNUSED PORTION OF FORMAT SECTOR. 03251000
SPACE 03252000
* EXTERNAL POINTERS IN 2K OR 4K MAPPED INDEX AREA. @04 03253000
EP@SDF EQU #+2-1 POINTER TO SHORT DTF INDEXES @04 03254000
EP@DFF EQU EP@SDF+2 POINTER TO DFF INCORE INDEX @04 03255000
EP@DFE EQU EP@DFF+2 POINTER TO END OF AREA @04 03256000
EP@LOG EQU X'7000' ADDRESS OF INDEX ATR'S @04 03257000
INXATR EQU 14 ATR DISPLACMENT FOR INDEX @04 03258000
AT0E0F EQU X'57' Q-CODE FOR LCP ATR'S @04 03259000
SPACE 03260000
* EQUATES FOR CHECKING LNG OF TEXT FOR 'PUT OVERRIDES' 03270000
* THESE EQUATES WILL OVERLAY THE FIELD NAME INN THE FDT 03280000
FLDOHL EQU 2 SAVE AREA IN FDTNAM FOR OHA LNG 03290000
FLDTLN EQU 4 SAVE AREA IN FDTNAM FOR TEXT LNG 03300000
SPACE 03310000
CCCDSP EQU 6 DISP TO CCC IN LRA 03320000
WCC EQU 2 DISP IN TEXT TO WCC 03330000
ININIT EQU 4 DISP IN INPUT TEXT TO CURSOR @ 03340000
IHAD@D EQU 3 DISP TO TEXT @ IN IHA WHEN 03350000
* POINTING TO BYTE BEFORE SBA 03360000
IHA2 EQU 2 03370000
LRAAID EQU 0 DISP IN LRA TO AID 03380000
IHAID EQU 2 DISP IN IHA TO AID 03390000
SPDCHR EQU C'>' GT SIGN 03400000
HIGHBT EQU X'C0' BIT 0 AND BIT 1 03410000
AIDSPA EQU X'7E' AID FOR SPD ATTENTION 03420000
SPACE 03430000
* EQUATES FOR THE WRITE CONTROL CHARACTER (WCC) FOR 3270 03440000
S3WCC EQU X'D0' S/3 WCC OF 'D0' 03450000
SPCWCC EQU X'6A' 3270 SPECIAL WCC OF '6A' 03460000
MDTWCC EQU X'C1' WCC TO RESET MDT 03470000
DUMWCC EQU X'40' DUMMMY WCC USED FOR SECOND AND 03480000
* SUCCESSUVE BLOCKS OF OUTPUT. 03490000
WCCMDT EQU BIT7 MDT BIT IN WCC 03500000
WCCRKB EQU BIT6 WCC BIT TO RESET KEYBOARD 03510000
SBADSP EQU 0 DISP IN OHA TO SBA 03520000
SBA@DP EQU 2 DISP TO @@ AFTER SBA 03530000
ATTDSP EQU 4 DISP TO ATTRIBUTE 03540000
SFDP EQU 3 DISP TO SF CHAR WITH ATTR 03550000
CURDPT EQU 5 DISP TO IC WITH 'TYPE' GIVEN 03560000
CURDP EQU 3 DISP TO IC WITHOUT 'TYPE' GIVEN 03570000
SPDCDP EQU 5 DISP IN TEXT TO DESIGNATOR CHAR 03580000
SPACE 03590000
* EQUATES FOR PUT OVERRIDE ITEMS IN LRA 03600000
SPACE 03610000
PORNAM EQU 5 FIELD NAME 03620000
PORTYP EQU PORNAM+1 DISP TO 'TYPE' 03630000
PORCUR EQU PORTYP+1 DISP TO 'CURSOR' 03640000
PORMOD EQU PORCUR+1 DISP TO 'MODIFY ' 03650000
PORDAT EQU PORMOD+1 DISP TO DATA 03660000
PORLNG EQU PORDAT LENGTH OF NORMAL LIST 03670000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE. --CONSTANTS--' @10 03680000
* LNG CONTENTS 03690000
ONE EQU X$0001 2 X'0001' 03700000
TWO EQU X$0002 2 X'0002' 03710000
X800 DC XL2'0800' 2 X'0800' @10 03715000
X200 DC XL2'0200' 2 X'0200' 03720000
X0020 DC XL2'0020' 2 X'0020' 03730000
FOUR EQU X$0004 2 X'0004' 03740000
SIX DC XL2'0006' 2 X'0006' 03750000
MIN6 DC XL2'FFFA' 2 I'-6' 03760000
TTLNG DC AL2(TTL) 2 A(TTL) 03770000
FTLNG DC AL2(FTL) 2 A(FTL) 03780000
WORK DC XL2'0000' 2 GNERAL WORK AREA 03790000
IIXR1 EQU WORK 2 SAVE AREA FO XR1 SAVE 03800000
X00FF DC XL2'00FF' 2 CONSTANT OF 255 03810000
SPACE 03820000
MOVEPL EQU * GENERAL MOVE PARM LIST 03830000
DFGLEN DC XL2'00' LENGTH TO MOVE 03840000
DFGRF@ DC AL2(#) MOVE TO ADDRESS 03850000
DC AL2(BLANK) MOVE FROM ADDRESS 03860000
DC XL2'0001' LENGTH OF FROM FIELD 03870000
DC XL1'00' NO ATR SWAPPING 03880000
BLANK DC CL1' ' BLANK CHARACTER 03890000
TITLE 'DISPLAY FORMAT CONTROL RTN -- FUNCTION DETERMINATION' @10 03900000
* * * * * * * * * * * 03910000
ENTRY DFA000 * 03920000
DFA000 EQU * THIS IS THE ENTRY POINT 03930000
* * * * * * * * * * * FROM $CC4II. 03940000
SPACE 03950000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03960000
* * 03970000
* SECTION A - 'OP CODE DETERMINATION' SECTION. THIS PART WILL * 03980000
* STORE THE USER PARAMETER LIST IN PAS (PROGRAM APPENDED STORAGE)* 03990000
* AND DETERMINE WHAT THE OPERATION CODE IS, AND GIVE CONTROL TO * 04000000
* THE PROPER SECTION OF CODE. * 04010000
* * 04020000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04030000
SPACE 04040000
* * * * ALL TASK DEPENDENT INFO IS SAVED IN PAS. * * * * 04070000
* * * * FIND THE ADDRESS OF PAS AND STORE THE ADDRESS OF THE * * * * 04090000
* * * * UPL (USER PARAMETER LIST) * * * * 04100000
SPACE 04110000
ST IIXR1,XR1 SAVE REGISTER 1 04115000
L NCTCB@,TCBR1 LOAD CURRENT TCB ADDR 04120000
L TCB@AS(,TCBR1),PAS1 LOAD PAS @ 04130000
ST PASIAR(,PAS1),ARR SAVE RETURN ADDRESS 04140000
SPACE 04150000
ST PAS@A1,PAS1 SAVE PAS @ 04170000
MVC PASIX1(,PAS1),IIXR1(2) MOVE ADDR TO PAS 04180000
SPACE 2 04190000
* GET TERMINAL NAME AND SAVE IT IN CURRENT AREA IN PAS. 04200000
SPACE 1 04210000
ST PASPL@(,PAS1),UPL2 SAVE UPL ADDRESS 04220000
MVC PASCPL+PLTUBA(,PAS1),PLTUBA(PLTUBA+1,UPL2) SAVE 1ST 12 @10 04230000
* BYTES OF ORIGINAL PARM LIST IN PAS.@10 04240000
SPACE 04250000
TBN PLOPC(,UPL2),OPACI ACCEPT INPUT OPERATION AND @06 04255000
TBF PLOPC(,UPL2),ALLBIT-OPANW ONLY ACCEPT INPUT OPERATION? @06 04260000
JF DFA045 NO, DONT UPDATE DATA PTR. @06 04270000
ALC PASCPL+PLRECA(2,PAS1),SIX YES, UPDATE PTR TO DATA 04280000
J DFA047 CONTINUE, RTN CODE SET UP ALREAD 04290000
DFA045 SLC PLRTC(,UPL2),PLRTC(2,UPL2) CLEAR RETURN CODE TO ZERO 04300000
DFA047 L PASCPL+PLRECA(,PAS1),LRA2 GET LRA ADDRESS 04310000
A MIN6,LRA2 POINT BACK TO TNAME 04320000
MVC PASCTN(,PAS1),TNAMLD(6,LRA2) SAVE TERMINAL NAME 04330000
L PASPL@(,PAS1),UPL2 RELOAD UPL 04340000
SPACE 2 04350000
* NOW DETERMINE THE OP CODE AND GIVE CONTROL TO APPROPRIATE SPOT. 04360000
SPACE 1 04370000
LA OPTBL,OPTR1 LOAD TABLE OF OP CODES + @ 04380000
DFA050 CLC OPTBOP(,OPTR1),PLOPC(1,UPL2) OP CODES MATCH 04390000
JE DFA060 YES, FINISH UP 04400000
LA OPTBLL(,OPTR1),OPTR1 INCREMENT TO NEXT ELEMENT 04410000
CLI ZEROD(,OPTR1),END END OF LEGAL OP CODES? 04420000
BNE DFA050 NO, LOOP BACK 04430000
****** ERROR INVALID OP CODE SENT TO THIS ROUTINE 04440000
B DFT030 CALL TERMINATION ROUTINE 04450000
DC AL1(TCCIOP) TERMINATION CODE 04460000
SPACE 2 04470000
DFA060 EQU * 04480000
SPACE 1 04490000
* ONLY ONE OF THE VALID OP CODES IN THE TABLE ARE EXPECTED. 04500000
* NOW TRANSFER CONTROL TO THE APPROPRIATE ROUTINE. 04510000
SPACE 1 04520000
MVC XCTLA1,OPTB@(2,OPTR1) MOVE ENTRY @ TO INSTR 04530000
DFA070 LA #,PAS1 RELOAD PAS @ 04540000
PAS@A1 EQU DFA070+3 04550000
SPACE 1 04560000
DFA080 B # TRANSFER CONTROL 04570000
XCTLA1 EQU DFA080+3 04580000
EJECT 04590000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04600000
* * 04610000
* OP CODE TABLE AND RESPECTIVE PROCESSING ROUTINES. * 04620000
* * 04630000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04640000
SPACE 1 04650000
OPTBL EQU * 04660000
DC AL1(OPGET) 'GET' OP CODE AND 'STOP II' 04670000
DC AL2(DFG000) ENTRY POINT OF APPROPRIATE RTN 04680000
SPACE 1 04690000
DC AL1(OPINV) 'INVITE INPUT' 04700000
DC AL2(DFG000) ENTRY POINT OF APPROPRIATE RTN 04710000
SPACE 1 04720000
DC AL1(OPACI) 'ACCEPT INPUT' 04730000
DC AL2(DFG000) ENTRY POINT OF APPROPRIATE RTN 04740000
SPACE 1 04750000
DC AL1(OPPUT+OPMSG) 'PUT MSG' + 'PUT OVERRIDES' 04760000
DC AL2(DFB000) ENTRY POINT OF APPROPRIATE RTN 04770000
SPACE 1 04780000
DC AL1(OPPNW+OPMSG) 'PUT NO WAIT' + 'PUT OVERRIDES' 04790000
DC AL2(DFB000) ENTRY POINT OF APPROPRIATE RTN 04800000
SPACE 1 04810000
DC AL1(OPCOPY+OPPUT) 'COPY' OP CODE 04820000
DC AL2(DFC000) ENTRY POINT OF APPROPRIATE RTN 04830000
SPACE 1 @06 04832000
DC AL1(OPANW) 'ACCEPT NO-WAIT INPUT' @06 04834000
DC AL2(DFG000) ENTRY POINT OF ROUTINE @06 04836000
SPACE 1 04840000
DC AL1(OPEAU+OPPUT) 'ERASE ALL UNPROTECTED' (EAU) 04850000
DC AL2(DFE000) ENTRY POINT OF APPROPRIATE RTN 04860000
SPACE 1 04870000
DC AL1(OPPUT+OPRUF) 'PUT MESSAGE' RUF OP-CODE @01 04890000
DC AL2(DFB000) ENTRY POINT OF APPROPRIATE RTN 04900000
SPACE 1 04910000
DC AL1(OPPNW+OPRUF) 'PUT NO-WAIT' RUF OP-CODE @10 04920000
DC AL2(DFB000) ENTRY POINT OF APPROPRIATE RTN 04930000
SPACE 1 04940000
DC AL1(OPREL) 'RELEASE' OP CODE 04960000
DC AL2(DFR000) ENTRY POINT OF APPROPRIATE RTN 04970000
SPACE 1 04980000
DC AL1(OPREL+OPKPL) 'RELEASE' AND KEEP LINE 04990000
DC AL2(DFR000) ENTRY POINT OF APPROPRIATE RTN 05000000
SPACE 1 05002000
DC AL1(OPRTC) 'RELEASE/TASK CHAIN' OPCODE @09 05004000
DC AL2(DFR000) ENTRY POINT OF APPROPRIATE RTN 05006000
SPACE 1 05010000
DC AL1(END) END OF TABLE 05020000
TITLE 'DISPLAY FORMAT CONTROL RTN -- PUT INITIAL NO BLOCK' @10 05030000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05040000
* * 05050000
* PROCESS 'PUT MESSAGE'. THIS ROUTINE WILL PROCESS THE OP CODES * 05060000
* 'PUT MESSAGE' AND 'PUT NO WAIT MESSAGE'. IT WILL ALSO RECEIVE * 05070000
* CONTROL FOR 'PUT OVERRIDES AND WILL CALL THE APPROPRIATE ROUTINE 05080000
* TO DO THAT WORK. * 05090000
* * 05100000
* INPUT TO THIS ROUTINE IS EXPECTED TO BE: * 05110000
* XR1--> PAS (PROGRAM APPENDED STORAGE AREA). * 05120000
* XR2--> UPL (USER PARAMETER LIST). * 05130000
* * 05140000
* * 05160000
* * 05170000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05180000
SPACE 2 05190000
DFB000 EQU * 05200000
SPACE 1 05210000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05220000
* DETERMINE IF OP CODE IS 'PUT OVERRIDES' AND GIVE CONTROL TO THE 05230000
* PROPER ROUTINE. * 05240000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05250000
SPACE 1 05260000
MVI PASFLG(,PAS1),PASFTS SET ON FIRST TIME SWITCH 05270000
* CHANGE 'PUT NO WAIT' TO 'PUT WAIT' 05280000
SBF PLOPC(,UPL2),OPPNW-OPPUT MODIFY TO PUT MSG 05290000
SBF PASCPL+PLOPC(,PAS1),OPPNW-OPPUT MODIFY TO PUT MSG 05300000
CLI PLOPM(,UPL2),OPLIST 'PUT OVERRIDE'? 05310000
BE DFD000 YES, CALL APPROPRIATE ROUTINE 05320000
SPACE 2 05330000
* VERIFY TERMINAL NAME AND GET TT ENTRY 05340000
B DFF000 CALL TT ENTRY FIND RTN 05350000
SPACE 05360000
L PASPL@(,PAS1),UPL2 RELOAD UPL @ 05370000
L PASCT@(,PAS1),TT1 LOAD THIS TT ENTRY 05380000
L TTFT@(,TT1),FT1 LOAD RESPECTIVE FT ENTRY 05390000
MVC PLOUTL(,UPL2),FTOUTL(2,FT1) MOVE TEXT LENGTH TO UPL 05400000
L PAS@A1,PAS1 SAVE ALSO IN WORK AREA. 05410000
MVC PASTTS(,PAS1),PLOUTL(2,UPL2) 05420000
B DFH000 SETUP LENGTH FOR GETMAIN OF @10 05430000
* *OUTPUT HOLD AREA. @10 05435000
SPACE 2 05440000
B DFJ000 READ FDT INTO PAS 05450000
B DFFRTN RETURN TO II MAINLINE 05460000
SPACE 05470000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE.-- COPY OPERATION' 05480000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05490000
* * 05500000
* 'COPY' OP CODE SECTION. * 05510000
* * 05520000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05530000
SPACE 2 05540000
DFC000 EQU * ENTRY POINT TO THIS SECTION @10 05550000
* VERIFY THE 'TO' TERMINAL NAME 05560000
SPACE 05570000
SBN PASFLG(,PAS1),PASFRT INDICATE 'TO' TERMINAL NAME 05580000
B DFF000 CALL RTN TO FIND TERMINAL ENTRY 05590000
ST PASTOD(,PAS1),TT2 SAVE TT ENTRY ADDRESS 05600000
SPACE 05610000
* VERIFY 'FROM' TERMINAL NAME 05620000
SPACE 05630000
SBF PASFLG(,PAS1),PASFRT INDICATE 'FROM' TERMINAL NAME 05640000
SPACE 05650000
MVC PASUDL(,PAS1),PASCPL+PLOUTL(2,PAS1) SAVE OUTPUT LENGTH 05660000
L PASCPL+PLRECA(,PAS1),LRA2 POINT TO RCD AREA 05670000
MVC PASCTN(,PAS1),TNAMLD(6,LRA2) MOVE NAME TO 'CURENT' AREA 05680000
MVC PASCCC(,PAS1),CCCDSP(1,LRA2) MOVE CCC IF ANY 05690000
B DFF000 CALL TERMINAL NAME VERIFY RTN 05700000
ST PASFRD(,PAS1),TT2 SAVE TT ENTRY @ 05710000
SPACE 05720000
*SETUP GETMAIN LENGTH FOR 3270 TEXT @10 05730000
SPACE 05740000
MVC PASTTS(2,PAS1),FOUR SET TO GETMAIN FOUR BYTES 05750000
B DFH000 CALL GETMAIN SETUP ROUTINE @10 05760000
SPACE 05770000
B DFFRTN RETURN TO II MAINLINE 05780000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE. --PUT OVERRIDES--' @10 05790000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05800000
* PROCESS 'PUT OVERRRIDES' OPERATION @10 05810000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05820000
SPACE 2 05830000
DFD000 EQU * 05840000
SPACE 2 05850000
* XR1-->PAS,XR2-->UPL 05860000
SPACE 05870000
* GO TO THE ROUTINE TO FIND THE TERMINAL AND FORMAT TABLE ENTRY 05880000
SPACE 05890000
B DFF000 FIND TT ENTRY 05900000
B DFJ000 GET FDT FOR THIS FORMAT 05910000
SPACE 05920000
* CALL TRANSIENT TO CALCULATE LENGTH OF TEXT NEEDED TO PUT OUT 05930000
* FOR THIS TEXT STREAM. 05940000
SPACE 05950000
LA ZEROD(,PAS1),PAS2 SAVE PAS ADDRESS IN REGISTER 2 05960000
B CC4PI CALL TRANSIENT CONTROL ROUTINE 05970000
DC AL1(CC4DB) NAME OF TRANSIENT DESIRED 05980000
CCP DISABL,PMR DISABLE INTERRUPTS 05990000
ST PAS@A1,PAS2 STORE PAS ADDRESS LOCALLY 06000000
SPACE 06010000
B DFT000 CALL TERMINATE CHECK ROUTINE 06020000
LA ZEROD(,PAS2),PAS1 RELOAD PAS REGISTER 06030000
SPACE 06040000
*SETUP GETMAIN LENGTH FOR OUTPUT TEXT @10 06050000
SPACE 06060000
L PASPL@(,PAS1),UPL2 RELOAD PARM POINTER 06070000
B DFH000 CALL GETMAIN SETUP ROUTINE @10 06080000
B DFFRTN RETURN TO II MAINLINE 06090000
SPACE 06100000
TITLE 'DISPLAY FORMAT CONTROL RTN -- ERASE ALL UNPROTECTED' @10 06110000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06120000
* * 06130000
* 'ERASE ALL UNPROTECTED' (EAU) OPERATION CODE. * 06140000
* XR1-->PAS, XR2-->USER PARAMETER LIST. * 06150000
* * 06160000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06170000
SPACE 2 06180000
DFE000 EQU * ENTRY POINT TO THIS SECTION 06190000
SPACE 06200000
* VERIFY THE TERMINAL NAME AND GET TT ENTRY 06210000
B DFF000 CALL 'FIND TT ENTRY' ROUTINE 06220000
SPACE 06230000
*SETUP GETMAIN LENGTH FOR 3270 TEXT @10 06240000
SPACE 06250000
MVC PASTTS(2,PAS1),TWO INDICATE NUMBER OF BYTES TO SEND 06260000
B DFH000 CALL GETMAIN SETUP ROUTINE @10 06270000
B DFFRTN RETURN TO II MAINLINE 06280000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE. --FIND TT ENTRY--' @10 06290000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06300000
* * 06310000
* FIND AND/OR CREATE 'TERMINAL TABLE' ENTRY. @10 06320000
* INPUT IS EXPECTED TO BE AS FOLLOWS: * 06330000
* XR1--> PAS * 06340000
* XR2--> UPL * 06350000
* NAME OF TERMINAL IN PAS * 06360000
* OUTPUT WILL BE A CREATED TT ENTRY IF NONE EXISTS ALREADY AND * 06370000
* THE ADDRESS OF THE ENTRY IN PAS. * 06380000
* * 06390000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06400000
SPACE 2 06410000
DFF000 EQU * 06420000
SPACE 1 06430000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06440000
* FIND A TT ENTRY FOR THIS TERMINAL IN PAS. * 06450000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06460000
ST PASFR@(,PAS1),ARR SAVE RETURN POINT IN PAS 06470000
SBF PASFLG(,PAS1),PASRUF SET OFF READ UNDER FORMAT @01 06490000
MVI PASTTE-1(,PAS1),ZEROD INIT 'END' OF TT ENTRIES 06510000
L PASITT(,PAS1),TT2 LOAD ADDR OF FIRST TT 06520000
DFF010 CLC PASCTN(,PAS1),TTNAME(6,TT2) NAME IN PAS AND TT MATCH? 06530000
JE DFF100 YES, CONTINUE PROCESSING IT 06540000
SPACE 06550000
* CHECK IF THIS ENTRY USED. IF NOT AND ONE IS NEEDED FOR A NEW 06560000
* ENTRY REUSE IT. WHEN A TERMINAL IS RELEASED THE TT NAME WILL BE 06570000
* BLANKED OUT INDICATING AN UNUSED ENTRY. 06580000
SPACE 1 06590000
CLI TTNAME-TNAMLD(,TT2),BLANKD IS FIRST CHAR BLANK? 06600000
JNE DFF030 NO, IT IS USED. 06610000
ST PASTTE(,PAS1),TT2 YES, SAVE ADDRESS OF THIS ENTRY 06620000
SPACE 06630000
DFF030 CLI TTCHN@-1(,TT2),ZEROD IS CHAIN POINTER BLANK? (LAST?) 06640000
JE DFF040 YES, BUILD A NEW ONE 06650000
L TTCHN@(,TT2),TT2 NO, LOAD NEXT ENTRY 06660000
B DFF010 LOOP BACK 06670000
SPACE 2 06680000
* ENTRY DOES NOT EXIST. CREATE ONE IF PROPER OP CODE 06690000
SPACE 1 06700000
DFF040 TBN PASCPL+PLOPC(,PAS1),OPPUT+OPMSG IS OP CODE 06710000
TBF PASCPL+PLOPM(,PAS1),OPLIST PUT W/O OVERRIDES 06720000
JT DFF060 YES, CREATE TT ENTRY @10 06730000
SPACE 1 06740000
* CHECK IF 'COPY TO' TERMINAL' 06750000
SPACE 1 06760000
CLI PASCPL+PLOPC(,PAS1),OPCOPY+OPPUT 'COPY' OP CODE? 06770000
TBN PASFLG(,PAS1),PASFRT AND CHECKING 'TO' TERMINAL? 06780000
JC DFF060,TANDEQ YES, CREATE TT ENTRY @10 06790000
SPACE 06800000
* CHECK IF A READ UNDER FORMAT CONTROL ACCEPT INPUT 06810000
SPACE 06820000
TBN PASCPL+PLOPC(,PAS1),OPACI ACCEPT INPUT OPERATION AND @06 06825000
TBF PASCPL+PLOPC(,PAS1),ALLBIT-OPANW ONLY ACCEPT INPUT? @06 06830000
L PASCPL+PLTUBA(,PAS1),TUB1 POINT TO TUB 06840000
TBN TUBSCS(,TUB1),TUBRUF READ UNDER FORMAT ON ? 06850000
L PAS@A1,PAS1 RELOAD PAS POINTER 06860000
JT DFF050 YES, BRANCH @06 06870000
SPACE 2 06880000
* IF 'RELEASE' OP CODE, IT MEANS THE TERMINAL NEVER RECEIVED A 06890000
* DISPLAY FORMAT. IF THIS IS THE CASE, BLANK OUT TT ENTRY @ TO 06900000
* INDICATE TERMINAL ENTRY NOT FOUND 06910000
SPACE 1 06920000
MVI PASCT@-1(,PAS1),ZEROD BLANK OUT ADDRESS 06930000
TBN PASCPL+PLOPC(,PAS1),OPREL IS IT 'RELEASE'? 06940000
JT DFF150 YES, EXIT ROUTINE 06950000
SPACE 2 06960000
****** ERROR ATTEMPT TO USE TERMINAL W/O @10 06970000
* FIRST ISSUING A FORMAT TO IT. 06980000
B DFT030 CALL TERMINATION ROUTINE 06990000
DC AL1(TC01) TERMINATION CODE 07000000
* NO RETURN CONTROL EXPECTED 07010000
SPACE 2 07020000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07030000
* CREATE A NEW TT ENTRY IF SPACE EXISTS. * 07040000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07050000
SPACE 07060000
DFF050 SBN PASFLG(,PAS1),PASRUF SET ON READ UNDER FORMAT @01 07080000
SPACE 1 07100000
DFF060 CLI PASTTE-1(,PAS1),ZEROD IS OLD ONE AVAILABLE? 07110000
JE DFF070 NO, CREATE NEW ONE. 07120000
L PASTTE(,PAS1),TT2 YES, USE THE OLD ONE. 07130000
J DFF090 JUMP OVER SPACE ALLOCATION 07140000
SPACE 2 07150000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07160000
* ALLOCATE NEW SPACE FOR A TT ENTRY. * 07170000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07180000
SPACE 1 07190000
DFF070 EQU * TT2 POINTS TO LAST TT ENTRY 07200000
LA ONED(,TT2),TT2 INCT TO RIGHT OF ADDRESS 07210000
ST STF1,TT2 SAVE THIS POINTER. 07220000
L PASNFT(,PAS1),TT2 LOAD NEXT AVAIL ADDRESS 07230000
ALC PASNFT(,PAS1),TTLNG(2) ADD LNG OF TT ENTRY 07240000
CLC PASNFT(,PAS1),PASEFT(2,PAS1) NEW ADDRESS PAST END? 07250000
JNH DFF080 NO, OKAY 07260000
SPACE 2 07270000
****** ERROR NO ROOM FOR ANOTHER TT @10 07280000
DFF075 B DFT030 ENTRY. CALL TERMINATION 07290000
DC AL1(TC02) TERMINATION CODE 07300000
SPACE 2 07310000
* SPACE EXISTS. ALLOCATE AREA + CREATE CHAIN POINTER. 07320000
SPACE 1 07330000
DFF080 ST TTCHN@+#,TT2 PUT ADDR THIS ENTRY IN LAST ONE 07340000
STF1 EQU DFF080+3 07350000
MVI TTCHN@-1(,TT2),ZEROD BLANK OUT CHAIN PTR. NEW LAST. 07360000
SPACE 2 07370000
* NOW CREATE OR FILL IN PART OF THE TT ENTRY @10 07380000
SPACE 1 07390000
DFF090 MVC TTNAME(,TT2),PASCTN(TNAMLD+1,PAS1) MOVE TERMINAL NAME 07400000
MVI TTFT@-1(,TT2),ZEROD BLANK OUT FORMAT TABLE PTR. 07410000
J DFF110 CONTINUE BUILDING ENTRY. 07420000
EJECT 07430000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07440000
* ENTRY FOUND. PUT ELEMENT ADDRESS IN PAS IF NOT 'COPY FROM' * 07450000
* TERMINAL. IF A NEW FORMAT IS TO BE USED, CREATE A FORMAT TABLE* 07460000
* ENTRY. * 07470000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07480000
SPACE 1 07490000
DFF100 CLI PASCPL+PLOPC(,PAS1),OPCOPY+OPPUT IS THIS 'COPY FROM'? 07500000
TBF PASFLG(,PAS1),PASFRT TERMINAL? 07510000
JC DFF150,TANDEQ YES, NO OTHER ACTION NEEDED. 07520000
SPACE 07530000
DFF110 ST PASCT@(,PAS1),TT2 STORE @ IN CURRENT TT PROCESSED 07540000
TBN PASFLG(,PAS1),PASRUF READ UNDER FORMAT ? @01 07560000
JF DFF120 NO, BRANCH @01 07570000
MVC PASCFT(4,PAS1),PASRFN(,PAS1) MOVE IN FORMAT NAME @01 07580000
J DFF125 CONTINUE PROCESSING @01 07590000
DFF120 TBN PASCPL+PLOPC(,PAS1),OPPUT+OPMSG IS THIS A PUT MESSAGE ? 07610000
TBF PASCPL+PLOPM(,PAS1),OPLIST (NOT OVERRIDE) 07620000
JF DFF150 NO, SKIP FOLLOWING PART 07630000
SPACE 2 07640000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07650000
* SEE IF FORMAT NAME IN LRA MATCHES ONE IN FT. IF NOT CREATE OR @10 07660000
* FIND CORRECT FT ENTRY. @10 07670000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07680000
SPACE 1 07690000
* MOVE THE FORMAT NAME TO PAS 07700000
L PASCPL+PLRECA(,PAS1),LRA2 LOAD LRA ADDRESS 07710000
MVC PASCFT(,PAS1),FTLD(4,LRA2) MOVE NAME TO PAS 07720000
SPACE 1 07730000
* LOAD FT ENTRY ASSOCIATED WITH THIS TERMINAL 07740000
DFF125 L PASCT@(,PAS1),TT2 LOAD CURRENT TT ENTRY @ 07750000
L TTFT@(,TT2),FT2 LOAD RESPECTIVE FT ENTRY 07760000
SPACE 2 07770000
* THE HIGH ORDER BYTE OF THE FORMAT TABLE ENTRY IS 0'D OUT IF A FOR@10 07780000
* MAT DOES NOT EXIST FOR THIS ENTRY. THEREFORE A COMPARE WILL BE 07790000
* MADE TO LOW CORE AND THE FOLLOWING COMPARE WILL NOT BE EQUAL 07800000
SPACE 07810000
DFF130 CLC PASCFT(,PAS1),FTNAME(4,FT2) DOES THE NAME MATCH? 07820000
JNE DFF300 NO, CREATE FT ENTRY OR FIND 07830000
* CURRENT ONE @10 07840000
* MOVE INPUT TEXT LENGTH TO TT ENTRY AND RESET IFT BITS ON 07850000
SPACE 1 07860000
DFF140 L PASCT@(,PAS1),TT1 LOAD TT @ 07870000
MVC TTINLH(,TT1),FTINL(2,FT2) MOVE LENGTH INPUT HOLD AREA 07880000
MVI TTIFT(,TT1),ALLBIT INIT IFT TO ALL FLDS TO BE MOVED@10 07890000
MVC TTIFT-1(,TT1),TTIFT(TTIFTL-1,TT1) PROPAGATE THROUGH 07900000
SPACE 1 07910000
LA ZEROD(,TT1),TT2 SWITCH REGISTERS. 07920000
L PAS@A1,PAS1 RELOAD PAS @ 07930000
SPACE 07940000
* RETURN TO CALLER 07950000
SPACE 1 07960000
DFF150 L PASFR@(,PAS1),IAR RETURN TO CALLER 07970000
TITLE 'DISPLAY FORMAT CONTROL RTN -- CREATE FORMAT TABLE' @10 07980000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07990000
* * 08000000
* THIS ROUTINE WILL CREATE A FORMAT TABLE ENTRY FOR A DESIRED * 08010000
* DISPLAY IF ONE DOES NOT ALREADY EXIST IN THE APPROPRIATE @10 08020000
* PAS. IF ONE DOES EXIST, THEN THE APPROPRIATE INFORMATION WILL * 08030000
* BE TRANSFERRED TO THE CURRENT TERMINAL TABLE ENTRY. * 08040000
* IF A 'FORMAT TABLE' ENTRY NEEDS TO BE BUILT, THE INDEX OF @10 08050000
* FORMAT NAMES AND CURRENT DISK C/S WILL BE SEARCHED. @10 08060000
* * 08070000
* * 08080000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08090000
SPACE 3 08100000
* * * * * * * 08110000
DFF300 EQU * ENTRY POINT 08120000
* * * * * * * 08130000
SPACE 2 08140000
* FORMAT NAME ALREADY MOVED TO PAS. SEE IF AN ENTRY EXISTS ALREA@10 08150000
L PASITT(,PAS1),TT2 LOAD FIRST TT ENTRY 08160000
LA TTL(,TT2),FT2 POINT TO FIRST FT ENTRY 08170000
DFF310 CLC FTNAME(,FT2),PASCFT(4,PAS1) DO NAMES MATCH? 08180000
SPACE 1 08190000
BE DFF390 YES, NO NEED TO CREATE ENTRY 08200000
CLI FTCHN@-1(,FT2),ZEROD NO, IS THIS LAST ENTRY? 08210000
JE DFF320 YES, CREATE AN ENTRY 08220000
L FTCHN@(,FT2),FT2 GET NEXT ENTRY 08230000
B DFF310 LOOP BACK 08240000
EJECT 08250000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08260000
* CREATE A FORMAT TABLE ENTRY. THIS REQUIRES A SEARCH OF THE @10 08270000
* FORMAT INDEX CREATED BY START-UP WHICH IS LOCATED IN @10 08280000
* THE $CCPFILE OR THE EXTERNAL POINTER LIST. @10 08285000
* THE INDEX WILL GIVE THE START DISK C/S OF THE FORMAT ON THE * 08290000
* SYSTEM OR PROGRAM PACK. THEN THE WHOLE FDT WILL BE READ IN * 08300000
* FOR THE LENGTH OF THE AREA AVAILABLE IN THIS PAS. * 08310000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08320000
SPACE 2 08330000
DFF320 EQU * 08340000
SPACE 1 08350000
* ALLOCATE SPACE FOR AN ENTRY 08360000
SPACE 1 08370000
MVC FTCHN@(,FT2),PASNFT(2,PAS1) MOVE CHAIN ADDRESS TO NEXT FT 08380000
L PASNFT(,PAS1),FT2 LOAD PTR TO NEXT AVAIL AREA 08390000
ST PASCF@(,PAS1),FT2 SAVE AT 'CURRENT' POINTER 08400000
ALC PASNFT(,PAS1),FTLNG(2) INCR BY LNG OF ENTRY 08410000
CLC PASNFT(,PAS1),PASEFT(2,PAS1) ENOUGH ROOM FOR THIS ENTRY? 08420000
BH DFF075 *** ERROR *** NO, NOT ENOUGH ROOM FOR FT ENTRY 08440000
SPACE 1 08450000
*INITIALIZE IOB FOR POSSIBLE READ OF FORMAT INDEX IN $CCPFILE @10 08450100
MVC PASIOB+IOBQB(,PAS1),#CPFLQ(1) MOVE Q BYTE OF CCPFILE 08450200
MVC PASIOB+IOBSB(,PAS1),@DFFIX(2) MOVE C/S OF INDEX 08450400
MVC DFF356+1,#DFQ(1) SAVE Q BYTE OF FORMAT PACK 08450600
MVC PASIOB+IOBDAT(,PAS1),PASFDT(2,PAS1) MOVE FDT @ FOR DATA 08450800
MVC PASIOB+IOBNB(,PAS1),PASFDL(1,PAS1) MOVE LNG TO IOB 08451000
SLC PASIOB+IOBNB(,PAS1),ONE(1) DECR TO L - 1 08451200
SPACE 2 08451400
* SCAN INCORE DFF INDEX, IF IT EXISTS. IF INDEX FOUND @10 08451600
* THEN GO BUILD PAS FDT ENTRY. ELSE SEARCH $CCPFILE DFF @10 08451800
* INDEX FOR THE FORMAT. @04 08452000
SPACE 08452200
TBN $FLGA,#EPL TEST IF EXTERNAL PARM EXISTS @04 08452400
JF DFF340 NO. THEN SEARCH $CCPFILE @10 08452600
L NCTCB@,TCB2 ADDRESS CURRENT TCB. @04 08452800
MVC INXATT,TCBATT-INXATR(2,TCB2) SAVE CURRENT ATR'S @04 08453000
MVC TCBATT-INXATR(,TCB2),@EPATR(2) FETCH ATR'S FOR INDEX @04 08453200
LCP TCBATT-INXATR(,TCB2),AT0E0F LOAD THE DFF INDEX ATRS @04 08453400
LA EP@LOG,INX2 ADDRESS THE INDEX BLOCKS @04 08453600
L EP@DFF(,INX2),INX2 ADDRESS THE DFF INDEX @04 08453800
SPACE 08454000
DFF322 CLC INXNAM(,INX2),PASCFT(4,PAS1) TEST IF THIS IS THE FORMAT@04 08454200
JE DFF326 YES. GO MOVE S/C ADDRESS @04 08454400
CLI ZEROD(,INX2),INXNXT TEST IF END-OF-INDEX @04 08454600
JE DFF324 YES. BUT MORE IN $CCPFILE. @04 08454800
JH DFF325 YES. BUT NONE IN $CCPFILE. @04 08455000
LA INXLNG(,INX2),INX2 NEXT INDEX IN BLOCK. @04 08455200
B DFF322 LOOP ON INDEX. @04 08455400
SPACE 08455600
DFF324 B DFF328 RESTORE ATR'S @04 08455800
J DFF340 GO SEARCH $CCPFILE @10 08456000
SPACE 08456200
DFF325 B DFF328 RESTORE ATR'S @04 08456400
J DFF355 ERROR, FORMAT DOES NOT EXIST @04 08456600
SPACE 08456800
DFF326 MVC PASWRK(,PAS1),INXCS(2,INX2) FETCH CS OF FORMAT FOUND @04 08457000
B DFF328 RESTORE ATR'S @04 08457200
LA PASWRK-INXCS(,PAS1),INX2 POINT TO CS ADDRESS @04 08457400
J DFF356 GO PROCESS IT. @04 08457600
SPACE 08457800
* RESTORE FORMAT ATR'S SUBROUTINE * @04 08458000
DFF328 ST DFF329+3,ARR SAVE RETURN ADDRESS @04 08458200
L NCTCB@,TCB2 ADDRESS CURRENT TCB. @04 08458400
MVC TCBATT-INXATR(,TCB2),INXATT(2) RESTORE ATR'S SAVED @04 08458600
LCP TCBATT-INXATR(,TCB2),AT0E0F RESTORE ATR'S SAVED @04 08458800
DFF329 B # RETURN TO CALLER @04 08459000
INXATT DC AL2(##) SAVE AREA FOR ATR'S @04 08459200
SPACE 2 08459400
* ALLOCATE SPACE FOR AN ENTRY AND SET UP POINTER TO NEXT AVALABLE @10 08460000
* ENTRY. NOW PREPARE TO READ THE INDEX INTO THE THE PAS FDT AREA @10 08470000
* FIND THE C/S OF THE FORMAT 08480000
SPACE 1 08490000
DFF340 MVC WORK,PASFDL(1,PAS1) MOVE FDT AREA LENGTH 08560000
SLC PASWRK(,PAS1),PASWRK(2,PAS1) CLEAR WORK AREA 08570000
MVI PASWKZ(,PAS1),INXNS INIT NUMBER ENTRIES IN SECTOR 08580000
SPACE 08590000
DFF345 ALC PASWRK(,PAS1),PASWKZ(2,PAS1) ADD SECTOR AMT TO TOTAL 08600000
SLC WORK,ONE(1) DECR NUMBER OF SECTORS 08610000
BNE DFF345 LOOP IF NOT FINISHED 08620000
SPACE 08630000
* READ INDEX INTO FDT AREA 08640000
B DFV000 CALL DISK IOS 08650000
SPACE 08660000
* NOW SEARCH INDEX FOR THE DESIRED DISPLAY FORMAT NAME 08670000
L PASFDT(,PAS1),INX2 08680000
DFF350 CLC INXNAM(,INX2),PASCFT(4,PAS1) DO NAMES COMPARE? 08690000
JE DFF356 YES, EXIT 08700000
CLI ZEROD(,INX2),INXNXT END OF SECTOR OR INDEX @04 08710000
JH DFF355 END-OF-INDEX, INDICATE ERROR @04 08715000
JL DFF352 END-OF-SECTOR, NO THEN SKIP. @04 08720000
LA INXES(,INX2),INX2 END-OF-SECTOR,YES NEXT SECT. @04 08725000
B DFF350 BRANCH TO PROCESS NEXT ENTRY @07 08726000
SPACE 1 @07 08727000
DFF352 LA INXLNG(,INX2),INX2 INCR TO NEXT ENTRY @04 08730000
SLC PASWRK(,PAS1),ONE(2) DECR NUMBER SECTORS PROCESSED 08740000
BNE DFF350 IF MORE SECTORS TO PROCESS, LOOP 08750000
SPACE 08760000
* PROCESSED ALL THE INDEXES IN CORE AND STILL NOT FOUND. 08770000
* READ MORE INDEXES INTO FDT AREA 08780000
SPACE 08790000
B DFI000 INCR DISK ADDRESS 08800000
B DFF340 LOOP BACK TO READ MORE 08810000
SPACE 2 08820000
****** ERROR FORMAT NAME NOT FOUND IN INDEX 08830000
DFF355 B DFT030 CALL TERMINATE ROUTINE 08840000
DC AL1(TC04) 08850000
SPACE 2 08860000
* INDEX FOUND, NOW READ FDT OF THIS FORMAT INTO FDT AREA IN PAS 08870000
SPACE 08880000
DFF356 MVI PASIOB+IOBQB(,PAS1),# MOVE IN Q BYTE OF PACK FORMATS 08890000
MVC PASIOB+IOBSB(,PAS1),INXCS(2,INX2) MOVE FORMAT C/S INTO IO 08900000
SPACE 08910000
* NOW READ THE FDT OF THE DESIRED FORMAT INTO PAS 08920000
B DFV000 CALL DISK IOS 08930000
SPACE 2 08940000
* BUILD UP FORMAT TABLE ENTRY 08950000
SPACE 1 08960000
DFF360 L PASCF@(,PAS1),FT2 RELOAD @ OF THIS ENTRY 08970000
MVI FTCHN@-1(,FT2),ZEROD CLEAR CHAIN POINTER 08980000
MVC FTFCS(,FT2),PASIOB+IOBSB(2,PAS1) MOVE C/S OF FDT 08990000
MVC FTTSCS(,FT2),FTFCS(2,FT2) INIT C/S OF TEXT 09000000
MVC FTNAME(,FT2),PASCFT(4,PAS1) MOVE FMT NAME 09010000
L PASFDT(,PAS1),FDT1 LOAD DATA AREA @ 09020000
MVC FTFDTL(,FT2),FDTNS(1,FDT1) MOVE NUMBER SECTORS OF FDT 09030000
MVC FTTSL(,FT2),FDTTSN(1,FDT1) MOVE # SECTORS TEXT STREAM 09040000
MVC FTOUTL(,FT2),FDTTSL(2,FDT1) MOVE BYTE LNG OF TEXT STREAM 09050000
MVC FTINL(,FT2),FDTTSI(2,FDT1) MOVE FULL INPUT LENGTH 09060000
SPACE 2 09070000
* CALCULATE ACTUAL C/S OF TEXT STREAM 09080000
SPACE 1 09090000
* ADD # OF SECTORS OF FDT TO FIND BEGIN C/S OF DATA TEXT. 09100000
MVC FDTWRK(,FDT1),FDTNS(1,FDT1) MOVE FDT LENGTH TO 'WORK' 09110000
* THE FDT IS AT LEAST ONE SECTOR IN LENGTH 09120000
SPACE 09130000
DFF363 ALC FTTSCS(,FT2),FOUR(1) ADD ONE SECTOR TO BASE C/S 09140000
TBN FTTSCS(,FT2),X60 OVERFLOW TO ANOTHER TRACK? 09150000
JF DFF370 NO, OKAY 09160000
ALC FTTSCS(,FT2),X0020(2) YES, FORCE TO NEXT TRACK @ 09170000
DFF370 SLC FDTWRK(,FDT1),ONE(1) DECR FDT LENGTH 09180000
BNE DFF363 IF NOT FINISHED, LOOP BACK 09190000
SPACE 2 09200000
* CHECK FOR SCREEN SIZE 09210000
TBN FDTM#(,FDT1),FDTM#2 IS THIS FMT FOR MODEL 2? 09220000
JF DFF390 NO, CONTINUE 09230000
SBN FTTSL(,FT2),FTM#2 YES, INDICATE IN FT 09240000
SPACE 09250000
* CHECK IF THIS TERMINAL IS PROPER MODEL NUMBER FOR THE FORMAT 09260000
DFF390 L PAS@A1,PAS1 RELOAD PAS @ 09270000
SPACE 09280000
L PASCPL+PLTUBA(,PAS1),TUB1 POINT TO RESPECTIVE TUB 09290000
TBN FTTSL(,FT2),FTM#2 MODEL 2 FORMAT? 09300000
JF DFF392 NO, CHECK MODEL 1 TERMINAL 09310000
CLI TUBPHY(,TUB1),TUB7M2 MODEL 2 3277? 09320000
JE DFF397 YES, OKAY 09330000
CLI TUBPHY(,TUB1),TUB5M2 MODEL 2 3275? 09340000
JE DFF397 YES, OKAY 09350000
J DFF394 NO, ERROR 09360000
SPACE 09370000
DFF392 EQU * CHECK FOR MODEL 1 TERMINAL 09380000
CLI TUBPHY(,TUB1),TUB7M1 MODEL 1 3277? 09390000
JE DFF397 YES, OKAY 09400000
CLI TUBPHY(,TUB1),TUB5M1 MODEL 1 3275? 09410000
JE DFF397 YES, OKAY 09420000
SPACE 09430000
****** ERROR TERMINAL MODEL NUMBER DOES NOT MATCH DISPLAY MODEL # 09440000
DFF394 B DFT030 CALL TERMINATION ROUTINE 09450000
DC AL1(TC13) 09460000
SPACE 2 09470000
*CHECK IF THIS FDT WILL FIT IN THE AREA RESERVED FOR IT @10 09490000
SPACE 09500000
DFF397 EQU * 09510000
L PAS@A1,PAS1 RELOAD PAS @ 09520000
CLC PASFDL(,PAS1),FTFDTL(1,FT2) WILL WHOLE FDT FIT IN AREA? 09530000
JNL DFF400 YES, OKAY 09540000
SPACE 09550000
****** ERROR FDT WILL NOT FIT INTO THE AREA 09560000
DFF395 EQU * 09570000
B DFT030 CALL TERMINATION ROUTINE 09580000
DC AL1(TC10) 09590000
SPACE 09600000
DFF400 L PASCT@(,PAS1),TT1 RELOAD CURRENT TT ENTRY 09610000
ST TTFT@(,TT1),FT2 STORE @ OF RESPECTIVE FT ENTRY 09620000
DFF410 L PAS@A1,PAS1 RELOAD PAS @ 09630000
B DFF140 RETURN @10 09640000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE.---INPUT OPERATIONS' @10 09650000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09660000
* * 09670000
* INPUT SECTION FOR 'GET', 'INVITE INPUT', 'STOP INVITE INPUT', * 09680000
* 'ACCEPT INPUT'. * 09690000
* * 09700000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09710000
SPACE 2 09720000
DFG000 EQU * ENTRY POINT TO THIS SECTION 09730000
SPACE 09740000
* FIND THE TERMINAL NAME TABLE ENTRY 09750000
SPACE 09760000
B DFF000 TT SHOULD BE CREATED ALREADY @10 09770000
SPACE 09780000
*IF THIS IS AN INVITE INPUT, THEN BYPASS GETTING FDT 09790000
SPACE 09800000
CLI PASCPL+PLOPC(,PAS1),OPINV INVITE INPUT OPERATION ? 09810000
JE DFG020 YES, BRANCH 09820000
B DFJ000 GO READ IN FDT 09830000
SPACE 09840000
* BLANK OUT CALLER'S RECORD AREA 09850000
SPACE 09860000
LA MOVEPL,XR2 POINT TO MOVE PARM LIST 09870000
MVC DFGLEN-MOVEPL(2,XR2),PASCPL+PLINL(,PAS1) MOVE IN LENGTH 09880000
MVC DFGRF@-MOVEPL(2,XR2),PASCPL+PLRECA(,PAS1) MOVE IN ADDR 09890000
B CC4MX CALL MOVE ROUTINE 09900000
DFG020 L PASPL@(,PAS1),UPL2 RELOAD UPL @ 09910000
TBN PASCPL+PLOPC(,PAS1),OPACI ACCEPT INPUT OPERATION AND @06 09915000
TBF PASCPL+PLOPC(,PAS1),ALLBIT-OPANW ONLY ACCEPT INPUT? @06 09920000
JT DFG060 YES @06 09930000
SPACE 09940000
DFG030 EQU * 09950000
* OP CODE IS 'STOP II', 'GET', OR 'INVITE INPUT'. 09960000
* MOVE LENGTH OF TEXT STREAM EXPECTED INTO PARM LIST INSTEAD OF 09970000
* USER'S LENGTH. 09980000
L PASCT@(,PAS1),TT1 LOAD CURRENT TT ENTRY 09990000
MVC PLINL(,UPL2),TTINLH(2,TT1) MOVE EXPECTED TEXT LENGTH. 10000000
CLC PLINL(2,UPL2),#TPANY INPUT LENGTH EXCEED TPBUFF ? 10010000
JNH DFG040 NO, BRANCH 10020000
B DFT030 YES, TERMINATE USER TASK 10030000
DC AL1(TCCTPB) INPUT LENGTH > TPBUFF 10040000
DFG040 EQU * 10050000
L PAS@A1,PAS1 RELOAD PAS 10060000
DFG060 B DFFRTN RETURN TO II MAINLINE 10070000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE--SETUP GETMAIN LENGTH' @10 10080000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10090000
* * 10100000
*SETUP GETMAIN LENGTH -- SETUP LENGTH OF AREA TO BE GETMAINED BY @10 10110000
* CM/CS FROM CCP'S DYNAMIC TPBUFFER AREA. @10 10120000
* * 10130000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10140000
SPACE 2 10150000
* * * * * * * 10160000
DFH000 EQU * ENTRY POINT 10170000
* * * * * * * 10180000
SPACE 1 10190000
* THE RETURN ADDR IS SAVED IN PAS SINCE A TASK SWITCH MAY OCCUR 10200000
* XR1 SHOULD BE POINTING TO PAS. XR2 TO UPA. @08 10205000
ST PASTAR(,PAS1),ARR SAVE RETURN POINT 10210000
L PASCPL+PLTUBA(,PAS1),TUB2 LOAD @ OF RESPECTIVE TUB. 10234000
SPACE 2 10240000
* FIND OUT WHICH LINE THE TERMINAL IS ON. 10250000
DFH020 MVC PASOHL(,PAS1),TUBRCL(2,TUB2) MOVE IN SIZE OF RECORD LENGTH 10280000
L TUBDTF(,TUB2),DTF2 --> LINE DTF @10 10282000
TBN LCBATA(,DTF2),LCBDFF DFF BUFFER SUPPORTED? @10 10284000
JF DFH025 NO-CONTINUE @10 10286000
CLC PASOHL(,PAS1),X800(2) REC LEN < 2K? @10 10288000
JL DFH025 YES--USE IT @10 10290000
MVC PASOHL(,PAS1),X800(2) SET LENGTH TO 2K @10 10292000
DFH025 SBF PASFLG(,PAS1),ALLBIT-PASFTS CLEAR OUT FLAG BYTES @10 10300000
CLC PASTTS(,PAS1),PASOHL(2,PAS1) TOTAL TEXT > RECORD LENGTH 10310000
JNH DFH050 NO, THEN NO BLOCKING. 10320000
SPACE 2 10330000
* INDICATE BLOCKING. FIND OUT WHAT THE BLOCK SIZE IS 10340000
DFH040 SBN PASFLG(,PAS1),PASBLK INDICATE BLOCKING AND FIRST TIME 10350000
DFH042 CLC PASOHL(,PAS1),X200(2) IS RECORD LENGTH AT LEAST 512 ? 10360000
JNL DFH060 YES, OKAY 10370000
SPACE 1 10380000
****** ERROR FOR BLOCKING, RECORD LENGTH MUST 10390000
DFH045 B DFT030 BE AT LEAST 512. 10400000
DC AL1(TC08) TERMINATION CODE 10410000
SPACE 10420000
* NO BLOCKING -- USE PASTTS FOR LENGTH @10 10425000
DFH050 MVC PASOHL(2,PAS1),PASTTS(,PAS1) MOVE IN OUTPUT HOLD LENGTH@10 10430000
ALC PASOHL(2,PAS1),X00FF INCREMENT TO SECTOR BOUNDARY 10440000
SBF PASOHL(,PAS1),ALLBIT SET OFF RIGHT MOST BITS 10450000
TBN LCBATA(,DTF2),LCBDFF DFF BUFFER SUPPORTED? @10 10453000
JT DFH060 YES-BRANCH @10 10456000
CLC PASOHL-1(1,PAS1),#TPPUT-1 SIZE GREATER THAN PUT AREA ? 10460000
JNH DFH060 NO, EVERYTHING OK 10470000
MVC PASOHL-1(1,PAS1),#TPPUT-1 MOVE IN NEW SIZE 10480000
B DFH040 GO INDICATE BLOCKING REQUIRED 10490000
SPACE 2 10500000
* INDICATE AMOUNT OF TEXT AREA REQUIRED IN BUFFER. 10510000
SPACE 1 10515000
DFH060 EQU * 10520000
TBN PASCPL+PLOPC(,PAS1),OPPUT+OPMSG PUT MESSAGE ? 10530000
JF DFH062 NO, BRANCH 10540000
TBN PASCPL+PLOPM(,PAS1),OPLIST PUT OVERRIDE ? 10550000
TBF PASFLG(,PAS1),PASBLK AND NOT A BLOCKING OPERATION 10560000
JF DFH063 NO, BRANCH 10570000
DFH062 MVC PASOHL(2,PAS1),PASTTS(,PAS1) MOVE IN REQUIRED TPBUFFER SPC 10580000
DFH063 EQU * 10590000
SPACE 10600000
L PASPL@(,PAS1),UPL2 POINT TO USER PARM LIST 10610000
MVC PLOUTL(2,UPL2),PASOHL(,PAS1) MOVE IN REQ. LENGTH 10620000
DFH070 EQU * 10630000
L PASTAR(,PAS1),IAR RETURN TO CALLER 10640000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE.--INCREMENT DISK ADDR' 10650000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10660000
* * 10670000
* INCREMENT THE DISK C/S ADDRESS IN IOB TO READ IN NEXT PART OF * 10680000
* THE FDT. * 10690000
* * 10700000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10710000
SPACE 2 10720000
DFI000 EQU * 10730000
SPACE 10740000
* XR1 SHOULD POINT TO PAS 10750000
ST PASXR@(,PAS1),ARR SAVE RETURN ADDRESS 10760000
SPACE 10770000
* IOBCHN IS UPDATED ONE SECTOR SINCE THIS FIELD WAS UPDATED BY 10780000
* DISK IOS TO POINT TO THE LAST SECTOR READ IN BY IT. 10790000
SPACE 10800000
DFI010 ALC PASIOB+IOBCHN(,PAS1),FOUR(1) INCR TO NEXT SECTOR 10810000
TBN PASIOB+IOBCHN(,PAS1),X60 IS THIS NEW @ INVALID? 10820000
JF DFI020 NO, OKAY 10830000
ALC PASIOB+IOBCHN(,PAS1),X0020(2) YES, INCR TO NEXT TRACK @ 10840000
SPACE 10850000
DFI020 MVC PASIOB+IOBSB(,PAS1),PASIOB+IOBCHN(2,PAS1) MOVE NEW @ TO 10860000
* PROPER PLACE 10870000
SPACE 2 10880000
L PASXR@(,PAS1),IAR RETURN TO CALLER 10890000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE.---READ FDT INTO PAS' 10900000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10910000
* * 10920000
* READ 'FIELD DESCRIPTOR TABLE' (FDT). IF THE DESIRED ONE IS NOT 10930000
* IN THE CURRENT PAS, THEN READ IT FROM DISK. * 10940000
* XR1-->PAS, XR2 IS NOT, NOT SAVED. * 10950000
* * 10960000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10970000
SPACE 2 10980000
DFJ000 ST PASJR@(,PAS1),ARR SAVE RETURN ADDRESS IN PAS 10990000
L PASCT@(,PAS1),TT2 LOAD CURRENT TT ENTRY 11000000
CLC TTFT@(,TT2),PASCF@(2,PAS1) @ OF FT MATCH CURRENT ONE? 11010000
JE DFJ060 YES, TEST FOR PUT OVERRIDE 11020000
SPACE 2 11030000
* CURRENT FDT IN PAS NOT CORRECT ONE, READ PROPER ONE IN FROM DISK. 11040000
SPACE 1 11050000
L TTFT@(,TT2),FT2 POINT TO FT ENTRY 11060000
SPACE 11070000
* Q BYTE FOR IOB SET UP ALREADY IN IOB BY ALLOCATE INITIALIZATION 11080000
SPACE 11090000
MVC PASIOB+IOBNB(,PAS1),FTFDTL(3,FT2) MOVE C/S OF FDT+ # SCTRS 11100000
SPACE 1 11110000
DFJ030 SLC PASIOB+IOBNB(,PAS1),ONE(1) DECR TO #-1. 11120000
MVC PASIOB+IOBDAT(,PAS1),PASFDT(2,PAS1) MOVE FDT @ 11130000
ST PASCF@(,PAS1),FT2 SAVE @ OF CURRENT FT ENTRY 11140000
SPACE 11150000
B DFV000 CALL DISK IOS AND WAIT 11160000
SPACE 11170000
DFJ060 L PASFDT(,PAS1),FDT2 POINT TO FDT @02 11190000
CLI PASCPL+PLOPM(,PAS1),OPLIST IS OP CODE PUT OVERRIDE @02 11200000
TBN FDTCFG(,FDT2),FDTPRT IS THIS A PRINTER GEN. FORMAT@02 11210000
JC DFJ062,TANDEQ JUMP TRUE AND EQUAL @02 11220000
J DFJ065 NO-CONTINUE @02 11230000
SPACE 1 @10 11240000
DFJ062 L PASCPL+PLRECA(,PAS1),LRA1 POINT TO OVERRIDE LIST @02 11250000
LA WCC-1(,LRA1),LRA1 INCR PAST WCC @02 11260000
CLI PORMOD(,LRA1),BLANKD OPERATION FIELD BLANK? @02 11270000
JE DFJ065 JUMP EQUAL @02 11280000
CLI PORMOD(,LRA1),MODDAT MODIFY DATA OPERATION? @02 11290000
JE DFJ065 JUMP EQUAL @02 11300000
SPACE 1 @10 11310000
****** ERROR TYPE, CURSOR POSITION OR ERASE OPERATIONS ARE NOT VALID@02 11320000
* WHEN ISSUING A PUT OVERRIDE TO A PFGR FORMAT @02 11330000
B DFT030 CALL TERMINATION CODE @02 11340000
DC AL1(TC09) @02 11350000
SPACE 1 @10 11360000
DFJ065 L PAS@A1,PAS1 RELOAD PAS @ @02 11370000
L PASJR@(,PAS1),IAR RETURN VIA PAS 11390000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE.---EXIT TO $CC4II' @10 11400000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11410000
* COMMON SECTION TO RETURN TO II'S MAINLINE CODE * 11420000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11430000
SPACE 2 11440000
DFFRTN EQU * 11450000
MVC DFFIRT+3(2),PASIAR(,PAS1) MOVE IN RETURN ADDRESS 11460000
L PASPL@(,PAS1),UPL2 RELOAD USER'S PARM POINTER 11470000
L PASIX1(,PAS1),XR1 RESTORE REGISTER 1 11480000
DFFIRT B # RETURN TO II'S MAINLINE 11490000
TITLE 'DISPLAY FORMAT CONTROL ROUTINE --- RELEASE TERMINAL' @10 11500000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11510000
* * 11520000
* RELEASE OP CODE LOGIC. * 11530000
* * 11540000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11550000
SPACE 2 11560000
DFR000 EQU * 11570000
* CHECK TERMINAL NAME FOR VALIDITY AND FIND IT TT IT WAS PROCESSED @10 11580000
* PREVIOUSLY BY THIS PROGRAM. 11590000
SPACE 11600000
B DFF000 CALL TERMINAL TABLE ROUTINE 11610000
SPACE 11620000
* IF TERMINAL NAME IS NOT FOUND, THE HIGH-ORDER BYTE OF 'CURRENT' * 11630000
* ENTRY WILL BE ZERO 11640000
CLI PASCT@-1(,PAS1),ZEROD WAS MATCH ENTRY FOUND? 11650000
JE DFR020 NO, CONTINUE 11660000
SPACE 11670000
* THE FOLLOWING IS AN ENTRY POINT FROM DFF IF A TERMINAL WAS @10 11680000
* RELEASED BY AN TERMINAL OPERATOR COMMAND 11690000
DFR010 MVI TTNAME-TNAMLD(,TT2),BLANKD CLEAR NAME IN TT ENTRY 11700000
MVI TTFT@-1(,TT2),ZEROD BLANK OUT FT CHAIN POINTER 11710000
SPACE 11720000
* PREPARE TO RETURN TO $CC4II 11730000
DFR020 B DFFRTN RETURN TO II'S MAINLINE 11740000
TITLE 'DISPLAY FORMAT CONTROL RTN -- CHECK FOR TERMINATION' @10 11750000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11760000
* * 11770000
* TERMINATE A TASK. THIS ROUTINE WILL CHECK IF A TASK SHOULD * 11780000
* BE TERMINATED. IF IT SHOULD, A TERMINATION CODE SHOULD BE * 11790000
* PLACED IN THE TASK'S PASTC. IF NOT, THAT AREA SHOULD BE X'00'. * 11800000
* * 11810000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11820000
SPACE 2 11830000
*##################################### 11840000
* THE FOLLOWING INSTRUCTION IS THE ENTRY POINT FOR ERRORS WHICH WERE 11850000
* GENERATED WITH IN THIS PROGRAM, NOT FROM A TRANSIENT. THE ARR 11860000
* SHOULD BE POINTING TO A TERMINATION CODE. 11870000
DFT030 ST DFT050+4,ARR SAVE ADDR OF TERMINATION CODE 11880000
L PAS@A1,PAS2 LOAD PAS @ 11890000
DFT050 MVC PASTC(,PAS2),#(1) MOVE TERM CODE TO PAS 11900000
*##################################### 11910000
SPACE 11920000
*###################################### 11930000
* THE FOLLOWING INSTRUCTION IS THE ENTRY FOR CHECKING THE 11940000
* THE TERMINATION CODE AFTER A CALL TO THE TRANSIENTS 11950000
*###################################### 11960000
DFT000 CLI PASTC(,PAS2),ZEROD NO TERMINATION CODE ? 11970000
JE DFT035 RIGHT, RETURN 11980000
SPACE 11990000
* AN ERROR WAS DETECTED FROM A TRANSIENT.. CALL $CC4DD TO CHECK 12000000
* IF MSG 528 SHOULD BE ISSUED. 12010000
SPACE 12020000
DFT010 B CC4PI CALL TRANSIENT HANDLER 12030000
DC AL1(CC4DD) TRANSIENT NAME 12040000
SPACE 12050000
DFT020 LA PASTC(,PAS2),PAS2 LOAD @ OF TERMINATION CODE 12060000
ST PASWRK-PASTC(,PAS2),PAS2 SAVE THE ADDRESS 12070000
L PASWRK-PASTC(,PAS2),ARR POINT THE ARR TO IT 12080000
SPACE 12090000
DFT025 L DFTI2,IAR EXIT TO TERMINATION ROUTINE 12100000
DFTI2 DC AL2(C4TI2) ADDRESS OF TERMINATION ROUTINE 12110000
SPACE 12120000
DFT035 ST PASXR@(,PAS2),ARR RETURN TO CALLER 12130000
ST PAS@A1,PAS2 SAVE PAS @ IN CASE $CC4DB OR 12140000
* $CC4DB WERE CALLED 12150000
DFT040 L PASXR@(,PAS2),IAR RETURN TO CALLER 12160000
TITLE 'DISPLAY FORMAT CONTROL RTN -- CALL DISK IOS + WAIT' @10 12170000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12180000
* * 12190000
* CALL DISK IOS AND WAIT, AND CHECK FOR COMPLETION CODE * 12200000
* XR1 WILL BE SAVED AND RESTORED. XR2 WILL BE DESTROYED. @10 12210000
* * 12220000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12230000
SPACE 2 12240000
DFV000 EQU * 12250000
ST PASTAR(,PAS1),ARR SAVE CALLER'S RETURN ADDRESS 12260000
LA ZEROD(,PAS1),PAS2 SWITCH REGISTERS 12270000
LA PASIOB(,PAS2),IOB LOAD IOB ADDRESS 12280000
CLI IOBQB(,IOB),X'C0' IS THIS A PHYSICAL SIMU AREA?@12 12281000
JL DFV002 NO--GO SET ON READ BIT @11 12282000
SBF IOBQB(,IOB),X'20' YES-ALTER Q AND FLAG2 TO @11 12283000
SBN IOBFL2(,IOB),X'14' -INDICATE "SPECIAL" Q @11 12284000
J DFV003 @11 12285000
DFV002 SBN IOBQB(,IOB),X01 SET ON READ BIT @11 12290000
SBF IOBFL2(,IOB),X'14' NOT A SPECIAL Q CODE @12 12295000
DFV003 CCP ENABLE,PMR ENABLE INTERRUPTS @11 12300000
SPACE 12310000
SVC 0 START DISK I/O 12320000
DC XL1'02' RIB FOR EXIO 12330000
DFV005 SVC 0 WAIT ON I/O 12340000
DC XL1'03' RIB FOR WAIT 12350000
TBN IOBECB(,IOB),POST IS MY ECB POSTED ? 12360000
BF DFV005 NO, BRANCH 12370000
SPACE 12380000
CCP DISABL,PMR DISABLE INTERRUPTS 12390000
CLI IOBCMP(,IOB),IOBOK NORMAL COMPLETION? 12400000
ST PAS@A1,PAS2 STORE PAS ADDRESS LOCALLY 12410000
JE DFV020 YES, CONTINUE 12420000
SPACE 12430000
****** ERROR NON-NORMAL DISK COMPLETION 12440000
DFV010 EQU * 12450000
B DFT030 CALL TERMINATION CODE 12460000
DC AL1(TC07) 12470000
SPACE 2 12480000
DFV020 LA ZEROD(,PAS2),PAS1 SWITCH REGISTERS AGAIN 12490000
DFV040 L PASTAR(,PAS1),IAR RETURN TO CALLER 12500000
TITLE 'CHECK RETURN CODE OF OPERATION AFTER OP-END COMPLETE' @10 12510000
DFQ030 ST DFQXR1+3,XR1 STORE CALLER'S XR1 12520000
ST DFQRTN+3,ARR STORE CALLER'S ARR 12530000
L NCTCB@,TCB1 POINT TO TASK'S TCB 12540000
L TCB@AS(,TCB1),PAS1 POINT TO PAS 12550000
ST PASWRK(,PAS1),UPL2 STORE PARM POINTER 12560000
MVC PLINL(6,UPL2),PASCPL+PLINL(,PAS1) RESTORE PARM LIST 12570000
MVC PLRECA(2,UPL2),PASCPL+PLRECA(,PAS1) AND ADDRESS 12580000
CLI PLRTC(,UPL2),RCOK GOOD RETURN CODE ? 12590000
JE DFQ080 YES, RETURN 12600000
SPACE 12610000
* NON-ZERO RETURN CODE, SO CHECK IF TERMINAL SHOULD BE TREATED 12620000
* AS IF THE FORMAT IS NOT AT THE TERMINAL. IF SO BLANK OUT 12630000
* THE TERMINAL NAME IN THE TT ENTRY TO INDICATE PROGRAM WAS 12640000
* NOT COMMUNICATING TO TERMINAL. 12650000
SPACE 12660000
CLI PLRTC(,UPL2),RCXCLR 'CLEAR' KEY GIVEN ? 12670000
JE DFQ050 YES, CLEAR TT ENTRY 12680000
CLI PLOPC(,UPL2),OPEAU+OPPUT 'EAU' REQUEST ? 12690000
TBF PLOPC(,UPL2),OPGET OR A GET REQUEST ? 12700000
JC DFQ080,FOREQ 'EAU' OR INPUT, IGNORE 12710000
TBN PLOPM(,UPL2),OPLIST PUT OVERRIDE OP ? 12720000
JF DFQ050 NO, CLEAR TT ENTRY 12730000
TBN PASWCC(,PAS1),WCCMDT REQUEST TO RESET MDT ? 12740000
JF DFQ080 NO, LEAVE AS IS 12750000
DFQ050 L PASCT@(,PAS1),TT2 POINT TO TT ENTRY 12760000
MVI TTNAME-TNAMLD(,TT2),BLANKD CLEAR OUT TT ENTRY 12770000
DFQ080 L PASWRK(,PAS1),UPL2 RELOAD USER PARM 12780000
DFQXR1 LA #,XR1 RELOAD CALLER'S XR1 12790000
DFQRTN B # RETURN TO CALLER 12800000
.END ANOP 12810000
MEND 12820000