//FSE0010  JOB (FSE),
//             'Build FSE libraries',
//             CLASS=A,
//             MSGCLASS=X,
//             MSGLEVEL=(1,1)
//******************************************************************
//*
//*   ALOCATE AND LOAD THE FSE LIBRARIES
//*
//*   CREATE A NEW PROCEDURE FOR THE ASSEMBLY OF FSE MODULES
//*
//******************************************************************
//CLEANUP EXEC PGM=IDCAMS
//SYSPRINT DD  SYSOUT=*
//SYSIN    DD  *
 DELETE JES2.FSE.ASM NONVSAM
 SET LASTCC=0
 SET MAXCC=0
//ALLOC   EXEC PGM=IEFBR14
//ASM      DD  DISP=(NEW,CATLG,DELETE),
//             UNIT=3350,
//             VOL=SER=PUB001,
//             SPACE=(CYL,(1,1,5)),
//             DCB=SYS1.MACLIB,
//             DSN=JES2.FSE.ASM
//FSE      EXEC PGM=IEBUPDTE,REGION=2048K,PARM=NEW
//SYSPRINT  DD  SYSOUT=*
//SYSUT2    DD  DISP=OLD,DSN=JES2.FSE.ASM
//SYSIN     DD  *
./ ADD NAME=FSE
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*  THIS IS A TSO FULL-SCREEN EDITOR TO BE USED SOLELY FOR REMOTE AND
*    LOCAL 3270 UNITS. IT ALLOWES THE SIMULTANEOUS UPDATE AND BROWSE
*    OF UP TO 21 LINES OF A DATA SET, AND THE EXECUTION OF AN FSE/TSO
*    COMMAND AT THE SAME TIME.
*
*  THE FSE SYSTEM IS MADE UP OF 8 SEPARATE MODULES PLACED IN A
*    LINKLIST DATA SET AND A SUBROUTINE LINKED WITH MAIN MODULE
*    "FSE". THE FOLLOWING IS A SUMMARY OF THESE ROUTINES
*    AND THEIR FUNCTIONS:
*
*  1) FSE      THIS IS THE MAIN DRIVER ROUTINE TO WHICH CONTROL IS
*              PASSED FROM THE TSO TMP. IT SCANS THE PARAMETERS
*              BUFFER, SETS ALL PROCESSING OPTION FLAGS, BUILDS A
*              CORE (GETMAINED) SYSEDIT FILE ACCORDING TO SIZE OF
*              DATA SET BEING EDITED, ALLOCATES THE FILE, AND
*              PERFORMS THE MAIN BULK OF FSE SUBCOMMANDS FOR
*              PERFORMANCE CONSIDERATIONS. ONCE THE FILE IS STORED
*              IN CORE, A MAIN LOOP IS EXECUTED FOR EACH TIME
*              THE ENTER KEY IS PRESSED: A STAE AND STAX ROUTINE
*              IS SET UP TO HANDLE ABENDS AND PA1 KEY INTERRUPTS,
*              THE FIRST 21 LINES OF THE DATA SET (STARTING AT THE
*              CURRENT RECORD) ARE WRITTEN TO THE SCREEN, A FULL
*              SCREEN TGET IS ISSUED TO READ THE CRT"S BUFFERS AND
*              ALL MODIFIED LINES ARE WRITTEN TO THE CORRESPONDING
*              RECORDS IN THE SYSEDIT BY LINE NUMBER. WHEN UP TO
*              A MAXIMUM OF 21 LINES ARE WRITTEN BACK TO STORAGE,
*              FSE WILL READ THE BUFFER WHERE COMMANDS ARE ENTERED.
*              IF IT IS A FSE SUBCOMMAND, A ROUTINE HANDLING THE
*              SUBCOMMAND IS EITHER LINKED OR BRANCHED. IF IT NOT
*              AN FSE DEFINED SUBCOMMAND, MODULE "FSETSO" IS LINKED
*              TO PROCESS THE COMMAND, WITH THE ASSUMPTION THAT IT
*              WAS A NATIVE TSO COMMAND. UPON COMPLETION OF THE
*              COMMAND PROCESSING, THE LOOP IS RE-EXECUTED  ETC...
*          *   PFKEYS ARE ALSO PRE DEFINED TO PERFORM SUBCOMMANDS
*              AND ARE ALSO PROGRAMMABLE TO THE USERS" NEEDS.
*
* 2) FSESAVE   THIS MODULE IS LINKED FROM FSE TO SAVE THE SYSEDIT
*              FILE TO SYSDA STORAGE. ALL CHECKS REGARDING LRECL,
*              DSORG, RECFM ETC ARE PERFORMED TO AVOID ABENDS.
*              THIS MODULE IS ALSO USED TO CREATE A TEMPORARY
*              DATA SET (USERID.FSEABCDE) TO STORE JCL TEXT
*              AND PASS IT TO JES2 FOR BACKGROUND PROCESSING
*              BY USING A FAKE SUBMIT COMMAND INTERNALLY.
*
* 3) FSECHANG  THIS MODULE IS LINKED FROM FSE TO HANDLE "CHANGE"
*              SUBCOMMANDS. DUE TO SIZE AND RARETY IN USE IT IS
*              A SEPARATE MODULE IN THE LINKLIST.
*
* 4) FSEPRTY   THIS MODULE IS LINKED FROM FSE TO ALTER DISPATCHING
*              PRIORITY OF FSE-EXECUTING ADDRESS SPACE FOR BETTER
*              RESPONSE TIME AND TO DECREASE SIGNIFICANCE FOR THE
*              THREE INTERVALS IN TSO IPS"S. IT IS CALLED TWICE
*              ONCE ENTERING FSE AT PRTY=240 AND A SECOND TIME
*              LEAVING IT AT PRTY=126.
*
* 5) FSETSO    THIS MODULE IS LINKED FROM FSE TO PROCESS A COMMAND
*              NOT FOUND TO BE AN FSE SUBCOMMAND. IF AN S806 OCCURS
*              FROM THE LINK ISSUED IN FSETSO, MODULE FSESYSCD WILL
*              PLACE "COMMND NOT FOUND" MSG TO THE RESPONSE FIELD.
*
* 6) FSESYSCD  THIS MODULE IS LINKED FROM FSE WHENEVER AN ABEND
*              OCCURS. IT TRANSLATES THE HEX ABEND CODE IN THE
*              PASSED S.D.W.A. FIELD TO PRINTABLE EBCDIC AND MOVES
*              THE ABEND MSG TO THE RESPONSE FIELD.
*
* 7) FSEFREE   THIS MODULE IS LINKED FROM FSE AND FSESAVE TO FREE
*              ANY ALLOCATED FSE DDNAME.
*
* 8) FSEATTR   THIS MODULE IS LINKED FROM FSE UPON ENTRY AND RETURN
*              TO FREE A DCB ATTRIBUTE LIST ALLOCATED FOR NEW
*              DATA SET SAVE FUNCTIONS.
*
* 9) FSEPFKEY  THIS MODULE IS BRANCH-CALLED FROM MAIN MODULE "FSE"
*              TO EITHER EXECUTE A SPECIFIC SUBCOMMAND OR TSO
*              COMMAND ASSOCIATED WITH THE PRESSING OF A PROGRAM
*              FUNCTION KEY, TO DISPLAY THE CURRENT ASSIGNMENT
*              OF PF KEYS 1 - 12, OR TO PROGRAM A USER"S FUNCTION
*              WITH A PFKEY.
*
* 10) IGC0024H THIS TYPE 3/4 USER SVC (248) IS ALSO USED IN A
*              MVT/SVS/TCAM ENVIRONMENT TO REPOSITION THE INTERNAL
*              TCAM MAJOR TERMINAL QCB TO TOP OF THE SCREEN IN
*              ORDER TO AVOID THE JUMPING TO THE NEXT LINE UPON
*              ISSUING A TGET. THIS IS ESPECIALLY IMPORTANT
*              SO AS NOT TO LOSE ANY OUTSIDE ISSUED MESSAGES
*              SUCH AS JOB-END NOTIFY, OPERATOR OR TSO USER
*              MESSAGES, WHICH WILL BE DISPLAYED ON THE UNUSED
*              VERY FIRST LINE OF THE TERMINAL.
*              THE CODE IN "FSE" WILL ONLY ISSUE THE SVC IF
*              TSO IS RUNNING UNDER TCAM AND NOT UNDER MVS.
*              IT IS NOT USED UNDER MVS BECAUSE THERE IS AN
*              AWFUL AMOUNT OF OVERHEAD IN SCHEDULING AN SRB
*              TO THE TCAM ADDRESS SPACE (GETMAIN, FREEMAIN AND
*              OTHER SVC"S, WHICH WOULD EXECUTE EVERY TIME
*              THE ENTER KEY OR A PF KEY IS PRESSED. ALSO
*              IT WOULD BE JOB DEPENDENT ON THE TCAM
*              PROC NAME IN SEARCHING FOR ITS ASCB IN CORE.
*
*
* FSE SUBCOMMANDS ARE :
*                     TOP,BOTTOM,PF,PB,HF,HB,UP,DOWN,RENUM,CHANGE,
*                     COPY,MOVE,DSN,SAVE,END,DONE,FIND,SAVEEND,
*                     DELETE,INSERT,COLUMN,SUBMIT,AUTOSAVE,PFK
*
*
*
*
*     NATIONAL BANK OF NORTH AMERICA
*     7/77  BRUNO LA LICATA.   1/80 (CITIBANK)
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSE      CSECT
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*
*
         STM   R14,R12,12(R13)
         LR    R12,R15               SAVE REGS. AND SET
         USING FSE,R12,R11,R9,R10  16K   ADDRESSABILITY
         L     R11,=A(FSE+4096)
         L     R9,=A(FSE+8192)
         L     R10,=A(FSE+12288)
SAVECP   LR    R2,R1                 SAVE CPPL ADDRESSES
*
GETSAVE  GETMAIN R,LV=72             GET SAVE AREA
         ST    R13,4(R1)             STORE OS/VS REGS.
         ST    R1,8(R13)             STORE FSE REGS.
         B   SKIPLTOR
         LTORG
         DS  0H
SKIPLTOR LR   R13,R1
         LM    R3,R6,0(R2)           LOAD CPPL AREA
         STM   R3,R6,CPPL          STORE THEM FOR LATER USE
*
* THIS SECTION WILL SCAN A COPY OF THE TMP COMMAND BUFFER
*  FOR THE SPECIFIED DSNAME AND KEYWORDS. IF THE DSNAME
*  IS NOT FULLY QUALIFIED (I.E. NO QUOTES) THE USER LOGON
*  ID IS PREFIXED TO IT. IF IT IS FULLY QUALIFIED, THEN THE
*  QUOTES ARE REMOVED.
* IF THE DSNAME IS TOO LONG, MISSING OR DOES NOT HAVE
*  MATCHING QUOTES, THE USER WILL BE PROMPTED FOR A NEW
*  DSNAME.  ONCE THE DSNAME IS VERIFIED, THE END RESULT
*  IS AS FOLLOWS :  FIELD "SAVEDSN" WILL CONTAIN EITHER
*  THE FULLY QUALIFIED NAME STRIPPED OF QUOTES, OR
*  THE SPECIFIED DSNAME WITH THE TSO LOGON ID PREFIXED.
*  FIELD "DSNAME" WILL CONTAIN ONE OF TWO THINGS :
*  1) FOR A PDS(MEMBER), ONLY THE PDS NAME  2) FOR A
*  SEQUENTIAL FILE THE FULL NAME. ("DSNAME" IS USED TO
*
* THE SECOND PART OF THE ROUTINE WILL SCAN THE FIELD
*  "DSNAME" TO CHECK FOR A RIGTH APOSTROPHE (I.E. A
*  PARTITIONED DATA SET WITH MEMBER SPECIFIED).
* IF THE CHARACTER "(" IS FOUND, ONLY THE TRUE
*  DSNAME IS KEPT IN FIELD "DSNAME".
* A CHECK OF THE COMMAND BUFFER IS ALSO MADE TO
*  RETRIEVE KEYWORDS. (VALID ONES ARE NEW,OLD,CLIST
*  CNTL,COBOL,ASM,PLI,DATA). FLAG BITS FOR THE TYPES
*
*
*  ARE SET IN FIELD "DATATYPE". ONLY ONE BIT ON WILL
*  BE ALLOWED FOR THE DATA TYPE. BIT #1 IS EITHER ON
*  (NEW) OR OFF (OLD).
*
*
*
         L    R2,16                 CVT ADDRESS
         CLC  228(4,R2),=F'0'       TSCVT PRESENT?
         BNE  NOMVS1                YES, DEFINETLY NOT MVS
         L    R2,=X'000000F0'       LET SWAP PRTY=240
*        LINK  EP=FSEPRTY           LINK MODULE            AXC
NOMVS1   L     R2,CB                ADDRESS OF COMMAND BUFF
         LH   R3,0(R2)                 LENGTH OF COMMAND
         SH   R3,=H'5'                 TO SYNCH WITH DATA
         EX    R3,MOVEBUFF
         LA    R3,1(R3)
         B     *+10
MOVEBUFF MVC   SAVEBUFF(0),4(R2)
         TR    SAVEBUFF(60),HEXTABLE   MAKE EBCDIC
         LA    R2,SAVEBUFF
DSNLOOP  CLC   0(3,R2),=C'FSE'      CHECK FOR TRUE NAME
         BE    FOUND1
         CLC   0(3,R2),=C'FSS'      CHECK FOR TRUE ALIAS NAME   AXC
         BE    FOUND1                                           AXC
         CLC   0(3,R2),=C'INC'      CHECK FOR TRUE ALIAS NAME   AXC
         BE    FOUND1                                           AXC
         LA    R2,1(R2)             NEXT BYTE
         BCT   R3,DSNLOOP           GO SCAN AGAIN
*
*        TPUT MSG1,3               ISSUE ERROR MSG IF ALIAS
         BC   15,RETURN               FOR FSE WAS GIVEN.
MSG1     DC C''
         DS   0H
*
FOUND1   LA   R2,3(R2)             BUMP TO SKIP COMMAND NAME
LOOP1    CLI  0(R2),X'40'
         BNE FOUNDDSN
         LA   R2,1(R2)             SKIP IF BLANK
         BCT  R3,LOOP1
*
BADNAME  TPUT MSG2,13              NO DSNAME SPECIFIED
READNAME TCLEARQ INPUT             CLEAR TSO INPUT QUEUE
         MVC  DSNAME(56),BLANKS    CLEAN INPUT AREA
         TGET SAVEBUFF,60
         TR   SAVEBUFF(60),HEXTABLE
         LA   R2,SAVEBUFF
*
*
FOUNDDSN LA   R4,0         R4 USED FOR DSNAME LENGTH
         LR   R5,R2        SAVE DSNAME ADDRESS IN BUFFER
         LA   R3,56  MAX LENGTH (44 + 2 QUOTES + 8 FOR MEMBER)
LOOP2    CLI  0(R2),X'40'  CHECK FOR BLANK (END)
         BE   ENDDSN
         LA   R2,1(R2)     BUMP UP BUFFER ADD.
         LA   R4,1(R4)     BUMP UP LENGTH COUNT
         BCT  R3,LOOP2   GO SCAN AGAIN
         TPUT MSG3,24      BAD DSNAME MSG.
         B    READNAME     GO READ ANOTHER
ENDDSN   LR   R7,R4        DSNAME LENGTH
         BCTR R4,0         READY FOR EX
         EX   R4,MOVEDSN   MOVE FROM BUFFER TO "DSNAME"
*
FIXDSN   CLI  DSNAME,C''''  CHECK FOR FULL QUALIFICATION
         BNE  PREFIXID      NO, MUST BE USER DATA SET
         MVC  SAVEDSN(55),BLANKS   CLEAN "DSNAME"
         MVC  SAVEDSN(55),DSNAME+1 MOVE TO STRIP QUOTE
         LA   R2,SAVEDSN    BEGINNING ADD. FOR SEARH
         LA   R3,55              OF ENDING QUOTE--MAX LENGTH
*
LOOP3    CLI  0(R2),C''''
         BE   FOUNDQUO        FOUND IT...
         LA   R2,1(R2)        BUMP UP ADDRESS
         BCT  R3,LOOP3        GO SCAN AGAIN
*
         TPUT MSG3,24         NO ENDING QUOTE...NO GOOD
         BC   15,READNAME    GO READ NEW DSNAME
*
FOUNDQUO MVI 0(R2),X'40'      MAKE IT BLANK
         B   SKIPID           GO TO SCAN KEYWORDS
*
* THIS SECTION WILL PREFIX THE DSNAME WITH THE USER"S
*  LOGON ID FOUND AT P.S.C.B. +0. LENGTH IS AT +7.
*
PREFIXID LA   R2,DSNAME
         LA   R3,SAVEDSN
         MVC  SAVEDSN(55),BLANKS       CLEAR IT FOR MOVE
         L    R4,PSCB           LOAD ADDRESS OF P.S.C.B.
         SR   R5,R5             CLEAR TO LOAD ID LENGTH
         IC   R5,7(R4)          INSERT LENGTH OF TSO ID.
         BCTR R5,0              READY FOR EX
         EX   R5,MOVEID         MOVE ID TO SAVEDSN
         B    *+10              SKIP EXECUTED MOVE
MOVEID   MVC  0(0,R3),0(4)   ---EXECUTED MOVE--
         DS   0H
         LA   R5,1(R5)          ADD BACK TO LENGTH
         AR   R3,R5             POINT TO "." SPOT
         MVI  0(R3),C'.'        MOVE IT IN
         LA   R3,1(R3)          POINT TO NEXT LEVEL
*
*  THIS SECTION WILL MOVE THE READ-IN DSNAME APPENDED TO ID
*
         BCTR R7,0             READY TO EX
         EX   R7,MOVEIN        MOVE REST OF DSNAME
         LA   R7,1(R7)         ADD BACK TO LENGTH
*
*  HERE, THE SPECIFIED KEYWORDS WILL BE SCANNED AND FLAGS
*   IN "DATATYPE" WILL BE SET ACCORDINGLY.
*
SKIPID   EQU  *
         MVC  DSNAME(56),BLANKS
         LA   R2,SAVEBUFF      ADDRESS OF COPY OF C.B.
         LA   R3,80            MAX. SCAN LENGTH
LOOP4    CLC 0(5,R2),=C' NEW ' CHECK FOR NEW DATA SET
         BNE  SKIP1
         OI   DATATYPE,X'80'   SET FLAG
SKIP1    CLC  0(7,R2),=C' CLIST '
         BNE  SKIP2
         OI   DATATYPE,B'00000100'
SKIP2    CLC  0(6,R2),=C' DATA '
         BNE  SKIP3
         OI   DATATYPE,B'00001000'
SKIP3    CLC  0(6,R2),=C' CNTL '
         BNE  SKIP4
         OI   DATATYPE,B'00000010'
SKIP4    CLC  0(5,R2),=C' OLD '
         BNE  SKIP5
         NI   DATATYPE,B'01111111'
SKIP5    CLC  0(5,R2),=C' ASM '
         BNE  SKIP6
         OI   DATATYPE,B'00100000'
SKIP6    CLC  0(5,R2),=C' PLI '
         BNE  SKIP7
         OI   DATATYPE,B'00010000'
SKIP7    CLC  0(7,R2),=C' COBOL '
         BNE  SKIP8
         OI   DATATYPE,B'01000000'
SKIP8    CLC  0(6,R2),=C' LIST '
         BNE  SKIP9
         MVI  LISTFLAG,X'01'
         MVI  DATATYPE,X'04'        GIVE DEFAULT TYPE
         BC   15,SKIP9
LISTFLAG DC   X'00'
         DS   0H
SKIP9    LA   R2,1(R2)              BUMP 1
         BCT  R3,LOOP4
*
*  WHEN LOOP IS EXAUSTED, IF NO "NEW" KEYWORD WAS SPECIFIED
*   THE DEFAULT IS OLD.  A CHECK IS MADE TO SEE IF A TYPE
*   WAS SPECIFIED...IF SO...ONLY ONE SHOULD BE PRESENT...
*   IF NOT...A PROMPT IS MADE FOR TYPE.
*
         B    SKIPCONS             SKIP BYTE
SAVETYPE DC   X'00'
         DS   0H
SKIPCONS MVC  SAVETYPE(1),DATATYPE
         NI   SAVETYPE,B'01111110'
         SR   R5,R5                CLEAR FOR INSERT
         IC   R5,SAVETYPE
         C    R5,=F'2'
         BE   MAINLOG
         C    R5,=F'4'
         BE   MAINLOG
         C    R5,=F'8'
         BE   MAINLOG
         C    R5,=F'16'
         BE   MAINLOG
         C    R5,=F'32'
         BE   MAINLOG
         C    R5,=F'64'
         BE   MAINLOG
*
*  IF HERE, IT MEANS EITHER NO TYPE WAS SPECIFIED, OR
*   MULTIPLE TYPES WERE SPECIFIED...
*
         CH   R5,=H'0'               NO TYPE SPECIFIED?
         BNE  TYPENOOK               MULTIPLE TYPES
         BAL   R7,MAINLOG
         B    SCANTYPE
*
TYPENOOK TPUT BADTYPE,22
         BC   15,RETURN
BADTYPE  DC   C'INVALID TYPE SPECIFIED'
          DS   0H
SCANTYPE LA   R3,44              MAX SCAN LENGTH
         LA   R2,DSNAME          ADDRESS OF SCAN
         LR   R5,R2              SAVE IT
LOOP7    CLI  0(R2),X'40'        END OF DSNAME??
         BE   GETTYPE
         CLI  0(R2),C'.'   A QUALIFIER??
         BNE  ADD1
         LR   R5,R2        SAVE BEGIN ADDRESS
ADD1     LA   R2,1(R2)     ADD 1
         BCT  R3,LOOP7
GETTYPE  EQU  *
         SR   R2,R5        LENGTH OF LAST QUALIFIER (+ ".")
         CLI  0(R5),C'.'   WAS IT A TWO LEVEL DSNAME?
         BNE  SKIPSUBT
         BCTR R2,0         YES, SUBTRACT 1
         LA   R5,1(R5)     YES, POINT TO ACTUAL QUALIFIER
*
SKIPSUBT CLC  0(6,R5),=C'COBOL '
         BNE  DEFAULT1
         OI   DATATYPE,B'01000000'
         B    OKTYPE
DEFAULT1 CLC  0(4,R5),=C'ASM '
         BNE  DEFAULT2
         OI   DATATYPE,B'00100000'
         B    OKTYPE
DEFAULT2 CLC  0(4,R5),=C'PLI '
         BNE  DEFAULT3
         OI   DATATYPE,B'00010000'
         B    OKTYPE
DEFAULT3 CLC  0(5,R5),=C'DATA '
         BNE  DEFAULT4
         OI   DATATYPE,B'00001000'
         B    OKTYPE
DEFAULT4 CLC  0(6,R5),=C'CLIST '
         BNE  DEFAULT5
         OI   DATATYPE,B'00000100'
         B    OKTYPE
DEFAULT5 CLC  0(5,R5),=C'CNTL '
         BNE  NOTYPE
         OI   DATATYPE,B'00000010'
         B    OKTYPE
NOTYPE   EQU  *
*
*  HERE,  NO TYPE WAS SPECIFIED, SO PROMPT USER..
*
         TPUT MSG7,32
         B    SKIPPROM
MSG7     DC   C'INVALID TYPE SPECIFIED, REENTER-'
AGAINTYP DC  20C' '
*
         DS   0H
SKIPPROM TCLEARQ INPUT
         MVC  AGAINTYP(20),BLANKS
         TGET AGAINTYP,20
         TR   AGAINTYP(20),HEXTABLE        MAKE EBCDIC
         LA   R5,AGAINTYP
         LA   R6,20            SCAN LENGTH
PROMPTTT CLI  0(R5),C' '       BLANK?
         BNE  SKIPSUBT         NO..GO CHECK TYPE
         LA   R5,1(R5)         BUMP ADDRESS BY 1
         BCT  R6,PROMPTTT
*
*
MAINLOG  EQU  *
        DS  0H
         LA   R2,SAVEDSN           SCAN ADDRESS
         LA   R4,55
         LA   R6,0                 LENGTH COUNT
LOOP5    CLI  0(R2),C'('           CHECK FOR PDS
         BE   FOUNDPDS
         LA   R2,1(R2)             BUMP 1
         LA   R6,1(R6)             ADD 1 TO COUNT
         BCT  R4,LOOP5
* THIS MUST BE A SEQUENTIAL DATA SET
         MVC  DSNAME(55),SAVEDSN
         B    SKIPPDS
FOUNDPDS OI   DATATYPE,X'01'       FLAG FOR PDS
         LA   R3,SAVEDSN           START ADDRESS
         SR   R2,R3                LENGTH OF TRUE NAME
         MVC  DSNAME(56),BLANKS
         BCTR R2,0
         EX   R2,MOVETRUE
         B    *+10
MOVETRUE MVC  DSNAME(0),SAVEDSN          MOVE TRUE DSNAME-MEMBER
SKIPPDS  EQU  *
*
* CHECK IF HERE FOR NO TYPE
*
         MVC  SAVETYPE(1),DATATYPE
         NI   SAVETYPE,B'01111110'
         SR   R5,R5
         IC   R5,SAVETYPE
         CH   R5,=H'0'
         BNE  OKTYPE
         BR   R7
*
OKTYPE   EQU  *
         LA   R1,CPPL      LOAD TMP PARMS
         LINK  EP=FSEFREE   ,FREE ANY FSE ASSOCIATED DDNAMES
*
         MVC  DAPLUPT,UPT
         MVC  DAPLECT,ECT
         XC   DAPLECB(4),DAPLECB
         MVC  DAPLPSCB,PSCB
         TM   DATATYPE,X'80'  NEW DSN?
         BNO  OLDDSN
NEWDSN   TM   DATATYPE,X'01'  IS IT PDS REQUIRED?
         BNO  NOTPDS
         BAL  R6,PDSRTN             DO ALLOCATION FOR PDS
         BC   15,MAINFSE2
*
*
*  THIS ROUTINE DOES THE ALLOCATION FOR A NEW AND OLD MEMBER
*   OF AN EXISTING P.D.S.
*
*
PDSRTN   LOCATE CAT           MAKE SURE DSN IS CATALOGED
         LTR  R15,R15
         BZ   PDSOK
         TPUT MSG8,22
         BC   15,RETURN
MSG8     DC C'DATA SET NOT CATALOGED'
         DS   0H
PDSOK    EQU  *
*
*  THIS NEXT SECTION RETRIEVES THE MEMBER NAME FROM
*   FIELD SAVEDSN, TO BE USED IN THE DAIR BLOCK.
         LA   R5,SAVEDSN
         LA   R2,SAVEDSN
         LA   R3,55            SEARCH COUNT MAX.
LOOP9    CLI  0(R2),C'('       CHECK FOR PARENTHESIS
         BNE  SKIPLOAD
         LR   R5,R2
SKIPLOAD CLI  0(R2),C')'       CHECK FOR END
         BE   GETMEMBE
         LA   R2,1(R2)         BUMP ADDRESS UP 1
         BCT  R3,LOOP9
*
GETMEMBE SR   R2,R5            GET MEMBER LENGTH+1
         BCTR R2,0             TRUE LENGTH
         CH   R2,=H'8'         VALID LENGTH??
         BNH  LENGTHOK
         TPUT MSG9,19
         B    RETURN
MSG9     DC C'INVALID MEMBER NAME'
         DS   0H
*
LENGTHOK LA   R5,1(R5)         POINT TO MEMBER NAME
         BCTR R2,0
         EX   R2,MOVEMEMB
         B    *+10
MOVEMEMB MVC  MEMBER(0),0(R5)  ---EXECUTED MVC--
         LA    R7,NEWMEMBE
         ST    R7,DAPLDAPB
DYNPDS   LA   R1,DAPL          LOAD PRIMARY DAIR BLOCK
         LINK EP=IKJDAIR      LINK TO ALLOCATION RTN.
DAIRCHEK LTR  R15,R15         OK RETURN?
         BZR  R6              YES,BRANCH TO CALLING RTN
R10CODE  LR    R7,R15          SAVE ERROR CODEDOWN
DAIRERR  TPUT MSG10,15,ASIS   SEND ERROR MSG.
         CVD   R7,DOUBLE
         UNPK MSG11(4),DOUBLE(8)
         OI   MSG11+3,X'F0'
         TPUT MSG11,4
         B    RETURN           BYE BYE
*
MSG10 DC C'DAIR ERROR CODE'
MSG11 DS 4C
      DS 0H
*
NOTPDS   EQU  *
         LOCATE CAT       MAKE SURE DATA SET DOES"NT EXIST
         LTR  R15,R15
         BNZ  OKNEW
*
*  IF R15 = 0 DATA SET ALREADY CATALOGED..NO GOOD
*
         TPUT MSG12,23
         B    RETURN
MSG12    DC C'DATA SET ALREADY EXISTS'
         DS 0H
OKNEW    EQU  *
         B    MAINFSE2
*  FOR NEW PHY. SEQ. DATA SET, AN ATTRIBUTE LIST CONTAINING
*   THE LRECL, BLKSIZE, RECFM HAS TO BE CREATED. THESE VALUES
*   WILL BE DEPENDENT ON THE DATA SET TYPE...(CLIST TYPES
*   ARE  VBS 255 X 1680  VARIABLE BLOCKED.... THE REST ARE
*   80  X 4080 FIXED BLOCKED)
*  THE ATTRIBUTE LIST IS LATER USED TO ALLOCATE THE DATA SET
*  DEFAULTING TO SYSGENED SPACE VALUES AND DISP=(NEW,CATLG,CATLG)
*
*
*  THIS SECTION IS USED TO ALLOCATE AN OLD DATA SET
*
OLDDSN   EQU  *
         TM   DATATYPE,X'01'         A PDS??
         BNO  OLDPS                  MUST BE AN OLD PS
         BAL  R6,PDSRTN              A PDS: GO ALLOCATE
         B    GETMAIN
OLDPS    EQU  *
         LOCATE CAT             MAKE SURE OLD PS IS THERE
         LTR  R15,R15
         BZ   OKOLDPS           YES, CATALOGED...GO ALLOCATE
         TPUT MSG8,22           DATA SET NOT CATALOGED..BYE
         B    RETURN
OKOLDPS  MVI  DA08CTL,X'00'
         LA    R7,NEWMEMBE
         ST    R7,DAPLDAPB
         LA   R1,DAPL            LOAD DAIR BLOCK
         LINK EP=IKJDAIR         ALLOCATE
         LTR  R15,R15
         BZ   GETMAIN
         B    R10CODE
*
GETMAIN  EQU  *
         MVC  VOLSER(6),CATINFO+6   MOVE SER. # FOR OBTAIN
         OBTAIN VTOC                READ DSCB TYPE 1
         LTR  R15,R15               DATA SET THERE??
         BZ   TEST1
         TPUT MSG13,22
         B    RETURN
MSG13    DC   C'DATA SET NOT ON VOLUME'
         DS   0H
*
*  THIS SECTION WILL VALIDATE THE CHARACTERISTICS OF THE
*  DATA SET AND DOUBLE CHECK WITH THE SPECIFIED DATA.
*
TEST1    LA   R6,VTOCINFO           INDEX TO DSCB INFO
WHATYPE  TM   DATATYPE,X'01'        PDS?
         BNO  TEST2
         CLC  38(2,R6),=X'0200'      TEST FOR TRUE PDS
         BE   MAINFSE
         TPUT MSG14,18
         B    RETURN
MSG14 DC C'INCONSISTENT DSORG'
         DS   0H
         LTORG
         DS   0H
TEST2    CLC  38(2,R6),=X'2000'       DSORG=DA??
         BNE  TEST3
         TPUT MSG15,13
         B    RETURN
MSG15    DC   C'INVALID DSORG'
         DS   0H
TEST3    CLC  38(2,R6),=X'8000'       DSORG=IS??
         BNE  TEST4
         TPUT MSG15,13
         B    RETURN
TEST4    TM   DATATYPE,X'01'           HERE MAKE SURE SPECIFIED
         BO   MAINFSE                  AS PS AND TRUE DSORG IS PS
         CLC  38(2,R6),=X'4000'        PS?
         BE   MAINFSE
         TPUT MSG14,18
         B    RETURN
*
MAINFSE  EQU  *
         CLI  VTOCINFO+40,X'C0'          U RECFM??
         BNE  OKRECFM
         TPUT MSG18,21
         B    RETURN
MSG18    DC   C'INVALID RECORD FORMAT'
FIXORVAR DS   X
         DS   0H
*
OKRECFM  CLI VTOCINFO+40,X'80'          F?
         BNE FORMAT1
         MVI FIXORVAR,X'00'
         B   MAINFSE2
FORMAT1  CLI VTOCINFO+40,X'90'          FB?
         BNE FORMAT2
         MVI FIXORVAR,X'00'
         B   MAINFSE2
FORMAT2  CLI VTOCINFO+40,X'40'             V?
         BNE FORMAT3
         MVI FIXORVAR,X'01'
         B   MAINFSE2
FORMAT3  CLI VTOCINFO+40,X'50'             VB?
         BNE FORMAT4
         MVI FIXORVAR,X'01'
         B   MAINFSE2
FORMAT4  CLI VTOCINFO+40,X'54'             VBA?
         BNE FORMAT5
         MVI FIXORVAR,X'01'
         B   MAINFSE2
FORMAT5  CLI VTOCINFO+40,X'84'             FA?
         BNE FORMAT6
         MVI FIXORVAR,X'00'
         B   MAINFSE2
FORMAT6  CLI VTOCINFO+40,X'94'             FBA?
         BNE FORMAT7
         MVI FIXORVAR,X'00'
         B   MAINFSE2
FORMAT7  CLI VTOCINFO+40,X'82'             FM?
         BNE  FORMAT8
         MVI  FIXORVAR,X'00'
         B    MAINFSE2
FORMAT8  CLI  VTOCINFO+40,X'92'            FBM?
         BNE  FORMAT9
         MVI  FIXORVAR,X'00'
         B    MAINFSE2
FORMAT9  CLI  VTOCINFO+40,X'98'            FBS?
         BNE  FORMAT0
         MVI  FIXORVAR,X'00'
         B    MAINFSE2
FORMAT0  TPUT MSG18,21
         B   RETURN
MAINFSE2 TM   DATATYPE,X'80'           NEW DATA SET??
         BO   SETLINES
*
*  IF HERE, DATA SET IS OLD, VERIFIED, CATALOGED AND
*  RESIDENT ON VOLUME
*
GOODOLD  EQU  *
         LA   R5,0           SET REC. COUNT TO 0
         TM   DATATYPE,X'01'        PDS?
         BO   *+8
         B    READWRIT
         MVC MEMBLDL(8),MEMBER
*
*  MUST ALLOCATE FSEDCBPO WITH DIFFERENT DD SO THAT
*  MEMBER NAME IS NOT AFFECTED BY "BLDL"
*
         LA    R7,POPDS
         ST    R7,DAPLDAPB
         MVC  DAPLECB(4),=XL4'00'
         BAL  R6,DYNPDS
         OPEN  FSEDCBPO
MEMCHEK  BLDL FSEDCBPO,LST
         LTR  R15,R15
         BZ   SKIPCLOS
         CLOSE FSEDCBPO
         TPUT MSG22,16
         B    RETURN
MSG22    DC   C'MEMBER NOT FOUND'
         DS   0H
SKIPCLOS CLOSE FSEDCBPO
READWRIT OPEN (FSEDCB,(INPUT))
RECCOUNT GET  FSEDCB,AREA
         LA   R5,1(R5)                 ADD 1 TO RECORDS #
         B    RECCOUNT
EODAD1   STH  R5,RECORDS               SAVE COUNT
         LTR  R5,R5
         BNZ  OVERZERO
         TPUT DSNEMPTY,14
         BC   15,RETURN
DSNEMPTY DC   C'DATA SET EMPTY'
         DS   0H
OVERZERO EQU  *
*
*  R5 NOW CONTAINS THE SIZE OF THE AREA FOR THE EXISTING
*   DATA SET. AN ALGORITHM NOW WILL CALCULATE THE EMPTY
*   SPACE TAGGED AT THE END FOR INSERTIONS.
* THE AMOUNT OF SPACE GIVEN DEPENDS ON THE NUMBER OF
*   RECORDS IN THE DATA SET....IT VARIES FROM 50 TO 200
*
GOCLOSE  CLOSE FSEDCB
         MVC  SAVELREC(2),VTOCINFO+44    SAVE THE LRECL
SPACE1   CH   R5,=H'100'
         BH   SPACE2
         LH   R6,SAVELREC
         MH   R6,=H'300'
         MH   R5,SAVELREC
         AR   R5,R6
         B    GETSPACE
SPACE2   CH   R5,=H'500'
         BH   SPACE3
         LH   R6,SAVELREC
         MH   R6,=H'200'
         MH   R5,SAVELREC
         AR   R5,R6
         B    GETSPACE
SPACE3   CH  R5,=H'1000'
         BH  SPACE4
         LH  R6,SAVELREC
         MH  R6,=H'250'
         MH  R5,SAVELREC
         AR  R5,R6
         B   GETSPACE
SPACE4   LH  R6,SAVELREC
         MH  R6,=H'100'
         MH  R5,SAVELREC
         AR  R5,R6
*
GETSPACE ST  R5,AREASIZE
GETCORE  LR   R0,R5
         GETMAIN EC,LV=(0),A=AREAADD
         LTR  R15,R15
         BZ   OKMAIN
         TPUT MAINMSG,20
         B    RETURN
MAINMSG  DC C'MEMORY NOT AVAILABLE'
         DS   0H
OKMAIN   L    R1,AREAADD
         ST  R1,TOPADD                SAVE BEGIN ADDRESS
         AR  R1,R5                    ADD TO GET END ADD
         SH  R1,SAVELREC              END ADDRESS
         ST  R1,BOTTADD
*
*  CLEAR AREA WITH BLANKS
*
         L    R4,TOPADD
         XR   R6,R6
         L    R7,=XL4'40000000'
         MVCL R4,R6
SKIPERR1 EQU  *
*
*  THIS SECTION WILL READ THE INPUT FILE AND STORE IT
*   SEQUENTIALLY INTO THE GETMAINED AREA.
*
         LA   R5,FSEDCB2
         L    R6,TOPADD
         OPEN FSEDCB2
SETUP1   GET  (R5),(R6)
         AH   R6,SAVELREC
         B    SETUP1
EODAD2   CLOSE FSEDCB2
         MVI   USEFLAG,X'01'
*
         LA   R1,CPPL
         LINK EP=FSEFREE
*        DS   0H
*
SKIPERR2 MVC  CURRADD(4),TOPADD
         LH   R5,RECORDS
         BCTR R5,0
         MH   R5,SAVELREC
         A    R5,TOPADD
         ST   R5,LASTADD
         LH   R5,RECORDS            LOAD # OF RECORDS
         L    R6,TOPADD             TOP OF GETMAINED SYSEDIT
         CLI  LISTFLAG,X'01'
         BE   MAINREAD
LINELOOP CLI  FIXORVAR,X'01'        VARIABLE LENGTH?
         BE   VARTYPE
         TM   DATATYPE,B'01000000'       COBOL?
         BNO  NOCOBOL1
         LR   R8,R6
         B    DOTRT
NOCOBOL1 LR   R8,R6
         AH   R8,SAVELREC
         S    R8,=F'8'               POINT TO LINE NUMBER
DOTRT    SR   R1,R1              FOR TRT
         TM   DATATYPE,B'01000000'
         BNO  *+14
         TRT  0(6,R8),TRTTABLE
         B    *+10
         TRT  0(8,R8),TRTTABLE   SCAN FOR ANYTHING BUT F0 - F9
         LTR  R1,R1              IF 0,VALID LINE #
*
         BNZ  BADLINE#
         TM   DATATYPE,B'01000000'
         BNO  PACK8
         PACK NEWLINE(8),0(6,R8)
         B    *+10
PACK8    PACK NEWLINE(8),0(8,R8)
         CVB  R4,NEWLINE         GET TO BINARY
         C    R4,SAVELINE        IN ASCENDING ORDER?
         BNH  BADLINE#
         ST   R4,SAVELINE        SAVE IT FOR NEXT LINE #
         C    R4,=F'999999'
         BNL  BADLINE#
         B    NEXTLINE           GO SCAN NEXT RECORD
VARTYPE  LR   R8,R6
         LA   R8,4(R8)           POINT TO LINE NUMBER
         B    DOTRT
BADLINE# TPUT MSG20,126
         TCLEARQ INPUT
         TGET SAVEBUFF,1
         B    RENUM
*
MSG20    DC   C'FSE REQUIRES DATA SETS WITH VALID AND IN ASCENDING '
         DC   C'ORDER LINE NUMBERS. PRESS ENTER KEY TO RENUMBER '
         DC   C'AND CONTINUE, OR PA1 TO END'
FAKERENU DC CL25' R'
         DS   0H
*
RENUM    LA   R7,FAKERENU
         BAL  R14,REALONE
         B    MAINREAD
*
NEXTLINE AH   R6,SAVELREC
         BCT  R5,LINELOOP
*
*  ALL PRE-REQS DONE...DO READS AND WRITES
*
          B   MAINREAD
*
SETLINES MVI  USEFLAG,X'00'
         TM   DATATYPE,X'01'               PDS?
         BNO  SET2
         LA    R7,POPDS
         ST    R7,DAPLDAPB
         MVC  DAPLECB(4),=XL4'00'
         BAL  R6,DYNPDS
*
         OPEN  FSEDCBPO
         MVC MEMBLDL(8),MEMBER
         BLDL FSEDCBPO,LST
         LTR  R15,R15
         BZ   BADME
         CLOSE FSEDCBPO
         B    SET2
BADME    TPUT MSG23,21
         B    RETURN
MSG23    DC   C'MEMBER ALREADY EXISTS'
         DS   0H
SET2     TM   DATATYPE,B'00000100'        CLIST TYPE??
         BO   LARGER
         LA   R5,80
         MVI  FIXORVAR,X'00'
         STH  R5,SAVELREC
         B    SETUPNEW
LARGER   LA   R5,255                 LRECL FOR NEW CLIST
         STH  R5,SAVELREC
SETUPNEW EQU  *
         TM   DATATYPE,X'04'
         BNO  *+8
         MVI  FIXORVAR,X'01'
*
         LA   R5,300
         STH  R5,RECORDS
*
         MH   R5,SAVELREC
*
*  GETMAIN FOR 300 RECORDS X LRECL
*
         GETMAIN R,LV=(R5)
         ST   R1,TOPADD
         ST   R1,CURRADD
         SH   R1,SAVELREC
         ST   R1,LASTADD
         AH   R1,SAVELREC
         AR   R1,R5               ADD TO GET ABSOLUTE BOUND
         SH   R1,SAVELREC         GET ADDRESS OF BOTTOM LINE
         ST   R1,BOTTADD
*
*  CLEAR AREA WITH BLANKS
*
         L    R4,TOPADD
         XR   R6,R6
         L    R7,=XL4'40000000'
         MVCL R4,R6
*
*
*  HERE LINE NUMBERS WILL BE PLACED IN THE IN-CORE
*   RECORDS DEPENDING ON THE DATA TYPE
*
         MVC  SAVELINE(4),=F'10'
         LH   R5,RECORDS
         L    R6,TOPADD
SETNUMB  CLI  FIXORVAR,X'01'          VARIABLE LENGTH?
         BO   LARGER2
         L    R7,SAVELINE
         CVD  R7,DOUBLE
*        UNPK 72(8,R6),DOUBLE(8)
*        OI   79(R6),X'F0'
         B    NEXTSET
LARGER2  L    R7,SAVELINE
         CVD  R7,DOUBLE
*        UNPK 4(8,R6),DOUBLE(8)
*        OI   11(R6),X'F0'
         MVC  0(2,R6),SAVELREC         MOVE THE RECORD LENGTH
         MVC  2(2,R6),=H'0'            RESERVED ZEROES
NEXTSET  L    R7,SAVELINE
         A    R7,=F'10'
         C    R7,=F'999999'
         BNH  OKGREAT
BADNUMB  EQU  *
         B    RETURN
*SG26    DC   C'LINE NUMBER TOO LARGE FOUND'
         DS   0H
OKGREAT  ST   R7,SAVELINE
         AH   R6,SAVELREC
         BCT  R5,SETNUMB
*
MAINREAD EQU  *
         MVC  RESPONSE(50),BLANKS
         GETMAIN R,LV=2048         GET AREA FOR INPUT
         ST   R1,AREAADD
         LR   R2,R1
         LA   R3,2048
         XR   R4,R4
         L    R5,=XL4'40000000'
         MVCL R2,R4                CLEAR INPUT AREA
         B    GOTOMVC
         LTORG
         DS   0H
GOTOMVC  MVC  COMMAND(2),=C'PF'    TO START WITH
         MVC  RESPONSE(15),TOPMSG  "TOP OF DATA SET" MSG
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  TESTCOB
         MVC  RESPONSE(17),LOWFIND
         MVC  COMMAND(19),BLANKS
TESTCOB  TM   DATATYPE,X'40'   COBOL?
         BNO  TPUTLOOP         NO, USE COLUMN 1
         MVC  COLUMN(2),=H'6'      AT COL. 7
         MVC  OUTCOL(3),=C'7  '
TPUTLOOP EQU  *
*
*
         STAE 0
         L    R3,ABENDPRM
         STM  R6,R3,SAVEREG
         STAE ABEND01,PARAM=ABENDPRM,PURGE=HALT
         B   KEEPON
         DS   0H
         LTORG
         DS   0H
*
KEEPON   EQU  *
         TM   AUTOFLAG,1
         BNO  MORESAVE
         L    R7,SAVES#
         CH   R7,=H'10'         10 LINES CHANGED?
         BL   MORESAVE
         XR   R7,R7
         ST   R7,SAVES#
         MVI  PARMSAVE,X'00'
         LA   R3,PARMS
         LA   R4,PARMSAVE
         LA   R7,EMERG
         LINK EP=FSESAVE
         B    TPUTLOOP
MORESAVE LA   R7,LINE#1             LOOP TO CLEAR SCREEN AREA
         STAX                  ,  KILL PREVIOUS CIRB BLOCK
         STAX PA1RTN,DEFER=NO  ,SET PA1 KEY EXIT
         LA   R8,21                BCT COUNT FOR NUMBER OF LINES
CLEARLOP MVC  0(7,R7),=7C' '       CLEAR LINE NUMBER
         MVC  7(72,R7),=72C' '     CLEAR LINE DATA
         LA   R7,84(R7)            BUMP UP ADDRESS TO NEXT SET
         BCT  R8,CLEARLOP          GO DO IT AGAIN
*
*
         L    R5,CURRADD
         LA   R7,LINE#1
         L    R6,LASTADD
         LA   R8,21
MOVEDATA CR   R5,R6
         BH   SENDSCRN
*
         CLI  FIXORVAR,X'00'        FIXED TYPE??
         BNE  VARIABLE
         TM   DATATYPE,B'01000000'       COBOL?
         BNO  FIXED
         TM   LISTFLAG,X'01'
         BO   BRUNO1
         MVC  0(6,R7),0(R5)
BRUNO1   B    NOCOBOL2
FIXED    LR   R2,R5
         AH   R2,SAVELREC
         SH   R2,=H'6'
         TM   LISTFLAG,X'01'
         BO   NOCOBOL2
         MVC  0(6,R7),0(R2)
NOCOBOL2 LH   R4,SAVELREC
COLOK1   SH   R4,COLUMN
         CH   R4,=H'72'
         BNH  *+8
         LA   R4,72
         LTR  R4,R4
         BZ   SKIPAA
         BCTR R4,0
SKIPAA   AH   R5,COLUMN
         EX   R4,MOVEFIX
         SH   R5,COLUMN
         B    *+10
MOVEFIX  MVC  7(0,R7),0(R5)        MOVE DATA
         B    SKIPVARI
VARIABLE TM   LISTFLAG,X'01'
         BO   BRUNO2
         MVC  0(6,R7),6(R5)
BRUNO2   LH   R4,SAVELREC
         SH   R4,=H'12'
         SH   R4,COLUMN
         CH   R4,=H'72'
        BNH  *+8
        LA   R4,72
         LTR  R4,R4
         BZ   SKIPBB
         BCTR R4,0
SKIPBB   AH   R5,COLUMN
         CLI  LISTFLAG,X'01'
         BNE  YESLINES
         EX   R4,NOLINES
         B    SKIPEXX
NOLINES  MVC  7(0,R7),0(R5)
YESLINES EX   R4,MOVEVAR
SKIPEXX  SH   R5,COLUMN
         B    *+10
MOVEVAR  MVC  7(0,R7),12(R5)       MOVE DATA
SKIPVARI AH   R5,SAVELREC
*
         LA   R7,84(R7)
         BCT  R8,MOVEDATA
*
*
SENDSCRN EQU  *
         LA   R2,SIZESCR
         TPUT SCREEN,(2),FULLSCR   ,     SEND 3270 SCREEN
         LTR  R15,R15
         BZ   SKIPRET
         B    RETURN
SKIPRET  EQU  *
         L    R2,AREAADD
BL       LA   R3,2048             2048
         XR   R4,R4
         L    R5,=XL4'40000000'
         MVCL R2,R4
         LA   R3,2048            LOAD BACK LENGTH OF TGET
         L    R7,AREAADD
*
*  THE TGET MACRO WILL READ ALL MODIFIED FIELDS FROM THE
*    OUTPUTTED SCREEN. THE SEQUENCE OF INPUT FIELDS ARE :
*    KEY PRESSED,CURSER ADDRESS,BUFFER ADDRESS,DATA,
*    BUFFER ADDRESS,DATA.......
READSCR  EQU   *
         TGET (R7),(R3),ASIS
         LR    R5,R15
         LTR  R5,R5
         BZ   SKIPZZZZ
         B    RETURN
SKIPZZZZ LR   R3,R7
         MVC  KEY(1),0(R3)      SAVE PFKEY
         L    R3,16             CVT ADDRESS
         TM   240(R3),X'80'     TCAM UP?
         BNO  SAVEGET           NO, MUST BE VTAM
         CLC  228(4,R3),=F'0'   SVC 248 (IGC0024H) TYPE 4 IS ONLY
         BE   SAVEGET           ISSUED RUNNING UNDER SVS/MVT/TCAM
*                               ONLY. VTAM DOES NOT JUMP CURSOR.
         L    R1,=X'FFFFFFFF'   FLAG TO INDICATE TCAM FUNCTION
         SVC  248               ISSUE SVC
*
*
*
SAVEGET  LR   R3,R7             SAVE ADDRESS OF GETMAINED DATA
         LA   R4,8           BCT COUNT FOR TRANSLATE
TRLOOP   TR   0(256,R3),HEXTABLE
         LA   R3,256(R3)        TR THE NEXT 256 BYTES
         BCT  R4,TRLOOP         DO IT FOR 2048 BYTES
         B    LINECHAN          #### SCAN LINE CHANGES ####
KEYS     L    R7,AREAADD        #### BEFORE COMMAND    ####
         CLI  KEY,X'7D'        ENTER KEY PRESSED?
         BE   TEST3270          YES, GO SCAN BUFFER
         LR   R1,R7             NO, MUST BE PFKEY...
         LA   R0,0              R0=0 IS PFKEY...R0=1 IS KEY COMMAND
         CALL FSEPFKEY          GO SEE WHAT IT IS
*
TEST3270 EQU *
         MVC  CURRADD(4),SAVECURR   COME HERE AFTER CHANGING LINES
*   R7 HAS ADDRESS OF INPUT AREA
*   R3 HAS LENGTH OF SCAN
*
         L    R7,AREAADD
         LA   R3,2048
INLOOP   CLC  0(3,R7),=XL3'11C1D5'        SCAN FOR COMMAND BUFFER
         BNE  SKIPCO
         B    HERECOMM
SKIPCO   LA   R7,1(R7)
         BCT  R3,INLOOP
         CLI  LINEFLAG,X'00'
         BE   DIRECRTN
         MVI  LINEFLAG,X'00'
         B    TPUTLOOP
*  IF NO COMMAND ENTERED, SCAN FOR CHANGED LINES
*
LINECHAN EQU  *
         MVC  FAKEIN(4),=C'0000'
         MVC  SAVECURR(4),CURRADD
         MVC  FAKELIN2(14),BLANKS
CHANGE01 L    R7,AREAADD
         MVI  LINEFLAG,X'00'
         LA   R3,2048
CHANGELO CLC  0(3,R7),=X'11C261'
         BE   CHANGE02
         CLC  0(3,R7),=X'11C3F1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11C5C1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11C6D1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11C761'
         BE   CHANGE02
         CLC  0(3,R7),=X'11C8F1'
         BE   CHANGE02
         CLC  0(3,R7),=X'114AC1'
         BE   CHANGE02
         CLC  0(3,R7),=X'114BD1'
         BE   CHANGE02
         CLC  0(3,R7),=X'114C61'
         BE   CHANGE02
         CLC  0(3,R7),=X'114DF1'
         BE   CHANGE02
         CLC  0(3,R7),=X'114FC1'
         BE   CHANGE02
         CLC  0(3,R7),=X'1150D1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D161'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D2F1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D4C1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D5D1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D661'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D7F1'
         BE   CHANGE02
         CLC  0(3,R7),=X'11D9C1'
         BE   CHANGE02
         CLC  0(3,R7),=X'115AD1'
         BE   CHANGE02
         CLC  0(3,R7),=X'115B61'
         BE   CHANGE02
CHANGE10 LA   R7,1(R7)
         BCT  R3,CHANGELO
         MVC  RESPONSE(50),BLANKS
         CLI  FAKELIN2,C' '
         BE   KEYS
         CLI  FAKELIN2+7,C' '
         BE   KEYS
GOODRANG ST   R7,SAVE7
         ST   R3,SAVE3
         LA   R7,FAKEBLK
         BAL  R14,SKIPLA14
         L    R7,SAVE7
         L    R3,SAVE3
*
         B    KEYS
CHANGE02 MVI  MODFLAG,X'01'
         L    R6,SAVES#
         LA   R6,1(R6)
         ST   R6,SAVES#
*        MVC  0(3,R7),=C'XXX'
         LA   R7,3(R7)
         B    SKIPBUFF
FAKEINSR DC   C' IN '
FAKEIN#  DC   7C' '
FAKEIN   DC   C'0000'
         DC   C' '
FAKEBUFF DC   C' DEL '
FAKELINE DC   20C' '
FAKEBLK  DC   C' DEL '
FAKELIN2 DC   14C' '
         DS   0H
SKIPBUFF MVI  ENDFLAG,X'00'
         MVC  FAKELINE(20),BLANKS
         CLI  6(R7),C'F'
         BNE  CHECK#L
         MVC  FAKELIN2(6),0(R7)
CHECK#L  CLI  6(R7),C'L'
         BNE  CHECKDEL
         MVC  FAKELIN2+7(6),0(R7)
CHECKDEL ST   R3,SAVE3
         XR   R3,R3
         IC   R3,6(R7)
         C    R3,=F'240'
         BNL  NUMTYPE
         L    R3,SAVE3
         B    CHECKD
NUMTYPE  EQU *
         MVC  FAKEIN+3(1),6(R7)
         MVC  FAKEIN#(6),0(R7)
         ST   R7,SAVE7
         LA   R7,FAKEINSR
         BAL  R14,FAKEINRT
         L    R3,SAVE3
         L    R7,SAVE7
CHECKD   CLI  6(R7),C'D'
         BNE  NODELCHA
         MVC  FAKELINE(6),0(R7)
         ST   R7,SAVE7
         ST   R3,SAVE3
         LA   R7,FAKEBUFF
         BAL  R14,SKIPLA14
         L    R7,SAVE7
         L    R3,SAVE3
         B    CHANGELO
NODELCHA LA   R5,72        MAX SCREEN LINE LENGTH
         LR   R2,R7
         LA   R2,7(R2)     POINT TO DATA
         XR   R4,R4
CHANGE90 CLI  0(R2),X'11'  3270 START BUFFER ADDRESS?
         BE   CHANGE91
         LA   R4,1(R4)     ADD 1 TO DATA COUNT
         LA   R2,1(R2)
         BCT  R5,CHANGE90
CHANGE91 MVI  LINEFLAG,X'01'
         L    R5,TOPADD
         L    R6,LASTADD
         MVI  ENDFLAG,X'00'
CHANGE12 CLI  FIXORVAR,X'00'
         BNE  CHANGE03
         TM   DATATYPE,B'01000000'
         BNO  NOCOBOL3
         CLC  0(6,R7),0(R5)
         BE   CHANGE05
         B    CHANGE06
NOCOBOL3 LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'6'
         CLC  0(6,R7),0(R8)
         BE   CHANGE05
         B    CHANGE06
CHANGE03 CLC  0(6,R7),6(R5)
         BE   CHANGE05
CHANGE06 AH   R5,SAVELREC
         CR   R5,R6
         BH   CHANGE11
         B    CHANGE12
CHANGE11 C    R5,LASTADD
         BNH  CHANGE13
         SH   R5,SAVELREC
CHANGE13 ST   R5,CURRADD
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(50),CHANGMSG
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
CHANGMSG DC C'LINE TO BE MODIFIED NOT FOUND. USE " IN  " COMMAND'
         DS   0H
*
CHANGE05 EQU  *
         MVI  DIRECT,X'01'
         LH   R8,SAVELREC
         SH   R8,=H'8'
         SH   R8,COLUMN
         CLI  FIXORVAR,X'00'
         BNE  CHANGE14
         TM   DATATYPE,B'01000000'
         BNO  NOCOBOL4
         AH   R8,=H'2'
NOCOBOL4 AH   R5,COLUMN
         LTR  R4,R4
         BNZ  WHICH1
         BCTR R8,0
         EX   R8,MOVEX401
         B    *+10
MOVEX401 MVC  0(0,R5),BLANKS
         SH   R5,COLUMN
         B    CHANGELO
WHICH1   CR   R8,R4
         BNH  USE8A
         LR   R8,R4
USE8A    LTR  R8,R8
         BZ   *+6
         BCTR R8,0
         LH   R2,SAVELREC
         SH   R2,=H'8'
         TM   DATATYPE,X'40'   COBOL?
         BNO  *+8
         LA   R2,2(R2)
         SH   R2,COLUMN
         BCTR R2,0
         EX   R2,MOVEX401
         EX   R8,CHANGE15
         B    *+10
CHANGE15 MVC  0(0,R5),7(R7)
         SH   R5,COLUMN
         B    CHANGELO
CHANGE14 SH   R8,=H'4'
         MVC  0(2,R5),SAVELREC
         AH   R5,COLUMN
         LTR  R4,R4
         BNZ  WHICH2
         BCTR R8,0
         EX   R8,MOVEX402
         B    *+10
MOVEX402 MVC  12(0,R5),BLANKS
         SH   R5,COLUMN
         B    CHANGELO
WHICH2   CR   R8,R4
         BNH  USE8B
         LR   R8,R4
USE8B    LTR  R8,R8
         BZ   *+6
         BCTR R8,0
*
         LH   R2,SAVELREC
         SH   R2,=H'12'
         SH   R2,COLUMN
         BCTR R2,0
         EX   R2,MOVEX402
         EX   R8,CHANGE16
         B    *+10
CHANGE16 MVC  12(0,R5),7(R7)
         SH   R5,COLUMN
         B    CHANGELO
*
*
*  NO COMMAND WAS ENTERED AND NO LINES WERE CHANGED...
*    LOOK AT FIELD "DIRECT".. IF = 1 DIRECTION IS FORWARD
*    IF = 0 DIRECTION IS BACKWARD
*
DIRECRTN LA  R7,FAKEPFPB
         CLI  DIRECT,X'00'
         BE   PBRTN
         B    PFRTN           IF = 1  GO AHEAD
FAKEPFPB DC C' PF 1 '
         DS 0H
*
*
*  THIS SECTION WILL SCAN THE INPUT AREA BUFFER FOLLOWING THE
*  SBA AND 3270 ADDRESS FOR INPUT COMMAND. THE FUNCTION IS TO
* DETERMINE WHAT ROUTINE WILL BE BRANCHED TO FOR A SPECIFIED
*  COMMAND.
*
*
HERECOMM LA   R3,22    19+3 OF 3270 INFO
         MVC  0(3,R7),=3C' '
FIRSTBLK CLI  0(R7),C' '
         BNE  TRYIT
         LA   R7,1(R7)
         BCT  R3,FIRSTBLK
         B    DIRECRTN
TRYIT    BCTR R7,0
COMMLOOP CLC  0(5,R7),=C' TOP '
         BE   TOPRTN
         CLC  0(3,R7),=C' T '
         BE   TOPRTN
         CLC  0(5,R7),=C' PFK '
         BNE  TRYBOTT
         LR   R1,R7
         LA   R0,1
         CALL FSEPFKEY
         B    TPUTLOOP
TRYBOTT  CLC  0(4,R7),=C' BOT'
         BE   BOTTRTN
         CLC  0(3,R7),=C' B '
         BE   BOTTRTN
         CLC  0(4,R7),=C' PF '
         BE   PFRTN
         CLC  0(4,R7),=C' PB '
         BE   PBRTN
         CLC  0(4,R7),=C' HF '
         BE   HFRTN
         CLC  0(4,R7),=C' HB '
         BE   HBRTN
         CLC  0(6,R7),=C' FIND '
         BE   FINDRTN
         CLC  0(3,R7),=C' F '
         BE   FINDRTN
         CLC  0(5,R7),=C' DSN '
         BE   DSNRTN
         CLC  0(10,R7),=C' AUTOSAVE '
         BNE  NOAUTO
         MVC  SAVES#(4),=F'0'
         MVI  AUTOFLAG,X'01'
         B    TPUTLOOP
NOAUTO   CLC  0(4,R7),=C' DEL'
         BE   DELRTN
          CLC  0(4,R7),=C' UP '
          BE   UPRTN
          CLC  0(6,R7),=C' DOWN '
          BE   DOWNRTN
          CLC  0(4,R7),=C' IN '
          BE   INRTN
         CLC   0(8,R7),=C' INSERT '
         BE   INRTN
         CLC  0(8,R7),=C' COLUMN '
         BE   COLRTN
         CLC  0(5,R7),=C' COL '
         BE   COLRTN
         CLC  0(3,R7),=C' C '
         BE   CHANGRTN
         CLC  0(8,R7),=C' CHANGE '
         BE   CHANGRTN
         CLC  0(6,R7),=C' COPY '
         BNE  CHECKMOV
         MVI  MOVCOPFL,X'01'
         B    MOVECOPY
CHECKMOV CLC  0(6,R7),=C' MOVE '
         BNE  CHKM2
         MVI  MOVCOPFL,X'00'
         B    MOVECOPY
CHKM2    CLC  0(3,R7),=C' M '
         BNE  NOMOVE
         MVI  MOVCOPFL,X'00'
         B    MOVECOPY
NOMOVE   EQU  *
         CLC  0(6,R7),=C' SAVE '
         BNE  SET11
         MVI  SEFLAG,X'00'
         BC   15,SAVERTN
SET11    CLC  0(3,R7),=C' S '
         BNE  SETEST
         MVI  SEFLAG,X'00'
         BC   15,SAVERTN
SETEST   CLC  0(9,R7),=C' SAVEEND '
         BNE  NOSE
         MVI  SEFLAG,X'01'
         BC   15,SAVERTN
NOSE     EQU  *
         CLC  0(5,R7),=C' END '
         BE   ENDRTN
*        CLC  0(3,R7),=C' H '
*        BE   HELPRTN
*        CLC  0(6,R7),=C' HELP '
*        BE   HELPRTN
         CLC  0(4,R7),=C' REN'
         BE   RENUMRTN
         CLC  0(3,R7),=C' R '
         BE   RENUMRTN
         CLC  0(6,R7),=C' DONE '
         BE   END01
         CLC  0(4,R7),=C' SUB'
         BE   SUBRTN
         LA   R7,1(R7)
         LA   R8,CPPL
         LR   R3,R7
         LA   R4,70
X11LOOP  CLI  0(R3),X'11'
         BNE  KEEPGOIN
         MVC  0(5,R3),BLANKS
         B    TSOCMD
KEEPGOIN LA   R3,1(R3)
         BCT  R4,X11LOOP
TSOCMD   LINK EP=FSETSO
         B    TPUTLOOP
*
*
*  THIS NEXT SECTION CONTAINS ROUTINES WHICH ARE BRANCHED TO
*    WHEN THE CORRISPONDING COMMAND WAS ENTERED IN THE BUFFER
*  REG. R7 HAS THE ADDRESS OF THE COMMAND  EX.  PF 2
ENDRTN   CLI  ENDFLAG,X'01'      WAS AN END ISSUED?
         BE   END01
         CLI  MODFLAG,X'00'      DATA MODIFIED?
         BNE   END03
END01    TPUT  CLEER,8,FULLSCR,,HOLD   CLEAR SCREEN       VBA01
         L     R2,16                   CVT ADDRESS
         CLC   228(4,R2),=F'0'         MVT,SVS TSO?
         BNE   RETURN
         LA    2,126    MAKE SWAPPABLE & RESET PRIORITY BACK
*        LINK  EP=FSEPRTY                                  AXC
DUMMSTAE EQU  *
         B     RETURN
END03    MVC   RESPONSE(50),BLANKS
         MVC   RESPONSE(38),ENDMSG
         MVC   COMMAND(19),BLANKS
         MVI   ENDFLAG,X'01' SET FLAG TO SAY USER ENDS WITH
*                            NO SAVE. FLAG MUST BE RESET ON
*                            COMMANDS THAT MODIFY DATA.
         B     TPUTLOOP
ENDMSG DC C'DATA SET NOT SAVED - ENTER SAVE OR END'
         DS    0H
*
MOVECOPY EQU  *
         LA   R7,1(R7)
         MVI  ENDFLAG,X'00'
         LA   R3,30
MOVCOP1  CLI  0(R7),C' '
         BE   MOVCOP2
         LA   R7,1(R7)
         BCT  R3,MOVCOP1
         B    BADFIND1
MOVCOP2  CLI  0(R7),C' '
         BNE  MOVCOP3
         LA   R7,1(R7)
         BCT  R3,MOVCOP2
         B    BADFIND1
MOVCOP3  XR   R4,R4
         LR   R5,R7
MOVCOP4  CLI  0(R7),C' '
         BE   MOVCOP5
         BAL  R14,DIGITIC
         BCT  R3,MOVCOP4
         B    BADFIND1
MOVCOP5  BAL  R14,LTRRTN
         EX   R4,MOVCOP6
         B    *+10
MOVCOP6  PACK DOUBLE(8),0(0,R5)   EXECUTED
         CVB  R6,DOUBLE
         ST   R6,FIELD1
MOVCOP7  CLI  0(R7),C' '
         BNE  MOVCOP8
         LA   R7,1(R7)
         BCT  R3,MOVCOP7
         B    BADFIND1
MOVCOP8  XR   R4,R4
         LR   R5,R7
MOVCOP9  CLI  0(R7),C' '
         BE   MOVCOP10
         BAL  R14,DIGITIC
         BCT  R3,MOVCOP9
         B    BADFIND1
MOVCOP10 BAL  R14,LTRRTN
         EX    R4,MOVCOP11
         B     *+10
MOVCOP11 PACK  DOUBLE(8),0(0,R5)
         CVB   R6,DOUBLE
         ST    R6,FIELD2
MOVCOP12 CLI   0(R7),C'='
         BE    ONLY2
         CLI   0(R7),C' '
         BNE   MOVCOP13
         LA    R7,1(R7)
         BCT   R3,MOVCOP12
ONLY2    MVC   FIELD3(4),FIELD2
         MVC   FIELD2(4),FIELD1
         B     DOINSRT
MOVCOP13 XR   R4,R4
         LR   R5,R7
MOVCOP14 CLI  0(R7),C' '
         BE   MOVCOP15
         BAL  R14,DIGITIC
         BCT  R3,MOVCOP14
         B    BADFIND1
MOVCOP15 BAL  R14,LTRRTN
         EX   R4,MOVCOP16
         B    *+10
MOVCOP16 PACK DOUBLE(8),0(0,R5)
         CVB  R6,DOUBLE
         ST   R6,FIELD3
*
DOINSRT  EQU  *
         L    R2,TOPADD
         L    R3,LASTADD
         AH   R3,SAVELREC
MOVCOPYY BAL   R14,THRURANG
         C    R5,FIELD1
         BE   CHECK#2
         AH   R2,SAVELREC
         B    THRURANG
CHECK#2  ST   R2,STARTING
         CLC  FIELD1(4),FIELD2
         BNE  MOVCOP19
         ST   R2,ENDING
         B    MOVCOPOK
MOVCOP19 BAL  R14,THRURANG
         C    R5,FIELD2
         BE   CHECK#3
         AH   R2,SAVELREC
         B    THRURANG
CHECK#3  ST   R2,ENDING
*
MOVCOPOK EQU  *
         L   R0,ENDING
         AH  R0,SAVELREC
         S   R0,STARTING
         ST  R0,COPYLEN
         GETMAIN EC,LV=(0),A=COPYADD
         LTR R15,R15
         BNZ  NOCORE
         L   R2,COPYADD
         A   R2,COPYLEN
         ST  R2,COPYEND
         L   R3,COPYLEN
         LR  R5,R3
         L   R2,COPYADD
         L   R4,STARTING
         MVCL R2,R4
*
         XR   R6,R6
         L    R7,ENDING
         AH   R7,SAVELREC
         S    R7,STARTING
         LH   R8,SAVELREC
         DR   R6,R8
         CVD  R7,DOUBLE
         UNPK FAKEIN(4),DOUBLE(8)
         OI   FAKEIN+3,X'F0'
         L    R7,FIELD3
         CVD  R7,DOUBLE
         UNPK FAKEIN#(6),DOUBLE(8)
         OI   FAKEIN#+5,X'F0'
         LA   R7,FAKEINSR
         BAL  R14,FAKEINRT
         TM   INFLAG1,X'01'
         BO   GOODIN
         B    TPUTLOOP
GOODIN   EQU  *
*
GO       MVI  MODFLAG,X'01'
         L    R2,CURRADD
         L    R4,COPYADD
         L    R5,COPYEND
MOVCOP20 CR  R4,R5
         BE  MOVORCOP
         LH  R6,SAVELREC
         SH  R6,=H'7'
         CLI  FIXORVAR,X'00'
         BNE  MOVCOP22
         TM   DATATYPE,X'40'
         BNO  MOVCOP21
         EX   R6,MOVCOP23
         B    NEXTCOPY
MOVCOP21 SH   R6,=H'2'
         EX   R6,MOVCOP24
         B    NEXTCOPY
MOVCOP22 SH   R6,=H'6'
         EX   R6,MOVCOP25
         B    NEXTCOPY
MOVCOP23 MVC  6(0,R2),6(R4)
MOVCOP24 MVC  0(0,R2),0(R4)
MOVCOP25 MVC  12(0,R2),12(R4)
*
NEXTCOPY AH   R2,SAVELREC
         AH   R4,SAVELREC
         B    MOVCOP20
MOVORCOP L    R2,SAVES#
         LA   R2,1(R2)
         ST   R6,SAVES#
         TM   MOVCOPFL,X'01'    COPY SPECIFIED?
         BNO  MOVEFUNC
         L    R0,COPYLEN
         FREEMAIN R,LV=(0),A=COPYADD
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(14),=C'LINE(S) COPIED'
         B    TPUTLOOP
*
MOVEFUNC L    R2,FIELD1
         CVD  R2,DOUBLE
         UNPK FAKELIN2(6),DOUBLE(8)
         OI   FAKELIN2+5,X'F0'
         ICM  R2,X'0F',FIELD2
         CVD  R2,DOUBLE
         UNPK FAKELIN2+7(6),DOUBLE(8)
         OI   FAKELIN2+12,X'F0'
         LA   R7,FAKEBLK
         BAL  R14,SKIPLA14
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(13),=C'LINE(S) MOVED'
         B    TPUTLOOP
*
*
DIGITIC  XR    R6,R6
         IC    R6,0(R7)
         C     R6,=F'240'
         BL    BADFIND1
         LA   R4,1(R4)
         LA   R7,1(R7)
         BR   R14
*
*
LTRRTN   LTR  R4,R4
         BZ   BADFIND1
         C    R4,=F'6'
         BH   BADFIND1
         BCTR R4,0
         BR   R14
*
*
THRURANG CR   R2,R3
         BE   DEL26
         CLI  FIXORVAR,X'00'
         BNE  MOVCOP18
         TM   DATATYPE,X'40'
         BNO  MOVCOP17
         PACK DOUBLE(8),0(6,R2)
         B    CHECK#1
MOVCOP17 LR   R6,R2
         AH   R6,SAVELREC
         SH   R6,=H'6'
         PACK DOUBLE(8),0(6,R6)
         B    CHECK#1
MOVCOP18 PACK DOUBLE(8),6(6,R2)
CHECK#1  CVB  R5,DOUBLE
         BR   R14
*
*
SAVERTN  EQU  *
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  SKIPDC
         B    BADLOW
PARMSAVE DS   X
         DS   0F
DDCOUNT  DC   F'1'
PARMS    DC   A(TOPADD,LASTADD,ALLOCDSN,SAVEDSN,MEMBER)
         DC   A(PSCB,SAVEFLAG,ENDFLAG,SAVELREC,DATATYPE)
         DC   A(PARMSAVE,FIXORVAR,CPPL,RESPONSE,DDCOUNT)
         DS   0H
SKIPDC   EQU  *
         MVI   SAVEFLAG,X'00'
         MVI   PARMSAVE,X'00'
         LA    R4,PARMSAVE    RETURN FLAGS ARE SET HERE
         LA    R3,PARMS
         MVC   COMMAND(19),BLANKS
         MVC   RESPONSE(50),BLANKS
*
         LINK EP=FSESAVE
OKSAVE   TM   PARMSAVE,X'01'    SAVE OK?
         BO   SKIPZERO
         B    TPUTLOOP
SKIPZERO EQU  *
         MVI  MODFLAG,X'00'
         MVI  ENDFLAG,X'01'
         MVI  SAVEFLAG,X'01'   FLAG TO INDICATE SAVED
         XR   R6,R6
         ST   R6,SAVES#
         TM   SEFLAG,1         SAVE-END ISSUED?
         BO   ENDRTN
         MVI  SEFLAG,X'00'
         B    TPUTLOOP
*
SUBRTN   EQU  *
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  *+8
         B     BADLOW
         MVI   PARMSAVE,X'00'
         LA    R3,PARMS
         LA    R4,PARMSAVE
         MVC   COMMAND(19),BLANKS
         LA    R7,FAKESAVE
         LINK  EP=FSESAVE
         TM    PARMSAVE,X'01'
         BNO   TPUTLOOP
         MVC   RESPONSE(50),BLANKS
*        DS    0H
OKSAVE1  LA    R8,CPPL
         LA    R7,FAKESUB
         LINK  EP=FSETSO
         MVC   RESPONSE(50),BLANKS
         ICM   R3,15,PSCB
         XR    R4,R4
         IC    R4,7(R3)
         BCTR  R4,0
         EX    R4,MOVEID#
         BC    15,*+10
MOVEID#  MVC   NAMEOFIT(0),0(R3)
         LA    R4,1(R4)
         LA    R3,NAMEOFIT
         AR    R3,R4
         MVC   0(9,R3),=C'.FSEABCDE'
         SR    R0,R0
         SCRATCH SUBDSN
         LTR   R15,R15
         BZ    SCRCODE
         MVC   RESPONSE(46),SCRMSG
         BC   15,TPUTLOOP
SCRMSG   DC C'UNABLE TO DELETE FSEABCDE. USE DELETE COMMAND '
         DS   0H
SCRCODE  CATALOG UNCATSUB
CATCODE  B     TPUTLOOP
FAKESAVE DC    C' S FSEABCDE '
FAKESUB  DC    C'SUBMIT FSEABCDE     '
UNCATSUB CAMLST UNCAT,NAMEOFIT
SUBDSN   CAMLST SCRATCH,NAMEOFIT,,TSOPAK
NAMEOFIT DC    CL44' '
TSOPAK   DC    H'1'
         DC   XL4'3050200B'         DEVICE TYPE     CHANGE THESE
         DC   CL6'WORK00'           VOLUME          FOR INSTALLATION
         DC   H'0'
         DS   0H
INRTN    LA   R14,TPUTLOOP
FAKEINRT LA   R7,1(R7)
         MVI  ENDFLAG,X'00'
         MVI  INFLAG1,X'00'
         LA   R3,19
IN01     CLI  0(R7),C' '
         BE   IN02
         LA   R7,1(R7)
         BCT  R3,IN01
         BR   R14
IN02     CLI  0(R7),C' '
         BNE  IN03
         LA   R7,1(R7)
         BCT  R3,IN02
INBAD    MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(29),INMSG1
INGETOUT MVC  COMMAND(19),BLANKS
         BR   R14
INMSG1   DC   C'INVALID OR MISSING PARAMETERS'
         DS   0H
IN03     LA   R4,0
         LR   R5,R7
IN04     CLI  0(R7),C' '
         BE   IN05
         XR   R6,R6
         IC   R6,0(R7)
         C    R6,=F'240'
         BL   INBAD
         LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,IN04
         B    INBAD
IN05     CH   R4,=H'6'
         BH   INBAD
         BCTR R4,0
         EX   R4,IN06
         B    *+10
IN06     PACK DOUBLE(8),0(0,R5)
         CVB  R4,DOUBLE
         ST   R4,LOWER
IN07     CLI  0(R7),C' '
         BNE  IN08
         LA   R7,1(R7)
         BCT  R3,IN07
         B    INBAD
IN08     LA   R4,0
         LR   R5,R7
IN09     CLI  0(R7),C' '
         BE   IN10
         XR   R6,R6
         IC   R6,0(R7)
         C    R6,=F'240'
         BL   INBAD
         LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,IN09
IN10     BCTR R4,0
         EX   R4,IN11
         B    *+10
IN11     PACK DOUBLE(8),0(0,R5)
         CVB  R4,DOUBLE
         LTR  R4,R4
         BZ   INBAD
         C    R4,=F'1000'
         BNL  INBAD
         STH  R4,INCOUNT
         A    R4,LOWER
         ST   R4,UPPER
         B    INMAIN
         LTORG
         DS   0H
INMAIN   EQU  *
         L    R5,TOPADD
         MVI INFLAG,X'01'    FIRST TIME INSERT
         L    R6,LASTADD
         AH   R6,SAVELREC
IN12     CR   R5,R6
         BE   SKIPFIT
IN72     CR   R5,R6
         BE   DELNONE
*
         CLI  FIXORVAR,X'00'
         BNE  IN13
         TM   DATATYPE,B'01000000'
         BNO  IN14
         XR   R1,R1
         TRT  0(6,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(6,R5)
         CVB  R7,DOUBLE
         B    IN16
IN14     XR   R1,R1
         LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'8'
         TRT  0(8,R8),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(8,R8)
         CVB  R7,DOUBLE
         B    IN16
IN13     XR   R1,R1
         TRT  4(8,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),4(8,R5)
         CVB  R7,DOUBLE
IN16     C    R7,LOWER
         BNH  IN90
         CLI  INFLAG,X'00'
         BE   NOIN
         MVC  CURRADD(4),TOPADD
         L    R5,CURRADD
         B    IN18
NOIN     L    R7,LOWER
         B    DELNONE
IN90     BNE  IN17
         AH   R5,SAVELREC
         ST   R5,CURRADD
         B    IN18
IN17     AH   R5,SAVELREC
         MVI  INFLAG,X'00'
         B    IN72
IN18     MVI  INFLAG,X'00'
         CR   R5,R6
         BNL  SKIPFIT
         L    R3,UPPER
         CLI  FIXORVAR,X'00'
         BNE  IN19
         TM   DATATYPE,B'01000000'
         BNO  IN20
         XR   R1,R1
         TRT  0(6,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(6,R5)
         CVB  R7,DOUBLE
         B    IN21
IN20     XR   R1,R1
         LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'8'
         TRT  0(8,R8),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(8,R8)
         CVB  R7,DOUBLE
         B    IN21
IN19     XR   R1,R1
         TRT  4(8,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),4(8,R5)
         CVB  R7,DOUBLE
IN21     CR   R3,R7
         BL   IN23
IN22     MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(35),INMSG2
         MVC  COMMAND(19),BLANKS
         BR   R14
INMSG2   DC   C'RANGE EXTENDS INTO EXISTING LINE(S)'
         DS   0H
IN23     EQU  *
*  IT FITS
         L    R5,LASTADD
         S    R5,CURRADD
         AH   R5,SAVELREC
         ST   R5,XLEN
         MVC  SAVELAST(4),LASTADD
         LH   R5,INCOUNT
         MH   R5,SAVELREC
         L    R6,LASTADD
         AR   R6,R5
         C    R6,BOTTADD
         BNH  IN24
NOCORE   MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         MVC  RESPONSE(48),INMSG3
         BR   R14
INMSG3 DC C'STORAGE NOT AVAILABLE FOR INSERT. SAVE AND END.   '
         DS   0H
IN24    ST    R6,LASTADD
        L     R6,CURRADD
        L     R7,XLEN
        LR    R5,R7
        LH    R4,SAVELREC
        MH    R4,INCOUNT
        A     R4,CURRADD
         ST    R6,SAVEFROM
        ST    R4,AREASIZE
        LR    R3,R5
        ST    R3,FREELEN
        LR    R0,R5
*       ICM   R0,8,=X'7F000000'        FROM SUBPOOL 127
        GETMAIN EC,LV=(0),A=FREEMAI
        LTR   R15,R15
        BNZ   NOCORE
        L     R2,FREEMAI
        MVCL  R2,R6
        L     R2,FREEMAI
        LR    R3,R5
        L     R4,AREASIZE
        MVCL  R4,R2
         MVI  MODFLAG,X'01'
        L    R0,FREELEN
        FREEMAIN R,LV=(0),A=FREEMAI
*
*
*  INCOUNT HAS # OF RECORDS TO BE INSERTED
*  CURRADD HAS ADDRESS OF IN-CORE FIRST RECORD TO BE INITIATED
*
         L    R4,CURRADD
         LH   R5,SAVELREC
         MH   R5,INCOUNT
         XR   R6,R6
         L    R7,=X'40000000'
*
         MVCL R4,R6
         L    R5,CURRADD
         LH   R3,INCOUNT
IN25     L    R6,LOWER
         LA   R6,1(R6)
         ST   R6,LOWER
         CLI  FIXORVAR,X'00'
         BNE  IN26
         TM   DATATYPE,B'01000000'
         BO   IN27
         CVD  R6,DOUBLE
         LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'8'
         UNPK 0(8,R8),DOUBLE(8)
         OI   7(R8),X'F0'
         B    CLEANUP
IN27     CVD  R6,DOUBLE
         UNPK 0(6,R5),DOUBLE(8)
         OI   5(R5),X'F0'
         B    CLEANUP
IN26     CVD  R6,DOUBLE
         UNPK 4(8,R5),DOUBLE(8)
         OI   11(R5),X'F0'
         MVC  0(2,R5),SAVELREC
         MVC  2(2,R5),=X'0000'
CLEANUP  AH   R5,SAVELREC
         BCT  R3,IN25
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         MVI  INFLAG1,X'01'
         ICM  R6,X'0F',SAVES#
         LA   R6,1(R6)
         ST   R6,SAVES#
         BR   R14
SKIPFIT  LH   R6,INCOUNT
         MH   R6,SAVELREC
         L    R5,CURRADD
         AR   R5,R6
         SH   R5,SAVELREC
         C    R5,BOTTADD
         BH   NOCORE
         ST   R5,LASTADD
         L    R4,CURRADD
         LR   R5,R6
*
         XR   R6,R6
         ICM  R7,15,=X'40000000'
         MVCL R4,R6
         LH   R3,INCOUNT
         L    R5,CURRADD
         MVI  MODFLAG,X'01'
         B    IN25
*
*
         LTORG
         DS   0H
*
*
RENUMRTN MVI  LISTFLAG,X'00'
         LA  R14,TPUTLOOP
REALONE  MVI  ENDFLAG,X'00'
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  RENUMLOW
         B    BADLOW
RENUMLOW LA    R7,1(R7)
         LA    R3,19
RENUM01  CLI   0(R7),C' '
         BE    RENUM02
         LA    R7,1(R7)
         BCT  R3,RENUM01
         B    RENUM07
RENUM02  CLI  0(R7),C' '
         BNE  RENUM03
         LA   R7,1(R7)
         BCT  R3,RENUM02
         MVC  SAVELINE(4),=F'10'
         MVC  NUMVALUE(2),=H'10'
         B    RENUM07
RENUM03  LA   R4,0            DIGIT COUNT
         LR   R5,R7           SAVE BEGIN ADDR.
RENUM04  CLI  0(R7),C' '
         BE   RENUM05
         XR   R6,R6
         IC   R6,0(R7)         CHECK IF NUMERIC
         C    R6,=F'240'
         BL   BADFIND1
         LA   R4,1(R4)         ADD TO DIGIT COUNT
         LA   R7,1(R7)
         BCT  R3,RENUM04
RENUM05  LTR  R4,R4
         BZ   BADFIND1
         C    R4,=F'6'         MORE THAN 6 DIGITS?
         BH   BADFIND1
         BCTR R4,0
         EX   R4,RENUM06
         B    *+10
RENUM06  PACK DOUBLE(8),0(0,5)
         CVB  R6,DOUBLE
         C    R6,=F'999999'
         BH   BADFIND1
         ST   R6,SAVELINE
RENUM14  CLI   0(R7),C' '
         BNE   RENUM15
         LA    R7,1(R7)
         BCT   R3,RENUM14
         MVC   NUMVALUE(2),=H'10'
         B     RENUM07
RENUM15  XR    R4,R4
         LR    R5,R7
RENUM16  CLI   0(R7),C' '
         BE    RENUM17
         XR    R6,R6
         IC    R6,0(R7)
         C     R6,=F'240'
         BL    BADFIND1
         LA    R7,1(R7)
         LA    R4,1(R4)
         BCT   R3,RENUM16
RENUM17  LTR   R4,R4
         BZ    BADFIND1
         C     R4,=F'4'
         BH    BADFIND1
         BCTR  R4,0
         EX    R4,RENUM18
         B     *+10
RENUM18  PACK  DOUBLE(8),0(0,R5)
         CVB   R6,DOUBLE
         LTR   R6,R6
         BZ    BADFIND1
         C     R6,=F'1000'
         BH    BADFIND1
         STH   R6,NUMVALUE
RENUM07  EQU  *
         L    R2,TOPADD
         L    R3,LASTADD
         AH   R3,SAVELREC
RENUMXXX L    R7,LASTADD
         AH   R7,SAVELREC
         S    R7,TOPADD
         LH   R8,SAVELREC
         XR   R6,R6
         DR   R6,R8         FIND OUT # OF RECS
*  R7 HAS # OF USED RECORDS
         MH   R7,NUMVALUE
         A    R7,SAVELINE
         C    R7,=F'999999'   CHECK FOR LINE # TOO BIG
         BH   RENUM11         TOO LARGE
         L   R4,SAVELINE
         SH  R4,NUMVALUE
         ST  R4,SAVELINE
RENUM08  CR   R2,R3
         BE   RENUM09
         L    R4,SAVELINE
         AH   R4,NUMVALUE
         ST   R4,SAVELINE
         CLI  FIXORVAR,X'00'  FIXED TYPE REC LENGTH?
         BNE  RENUM12
         CVD  R4,DOUBLE
         TM   DATATYPE,B'01000000'
         BNO  NOCOBOL5
         UNPK 0(6,R2),DOUBLE(8)
         OI   5(R2),X'F0'
         B    RENUM13
NOCOBOL5 LR   R5,R2
         AH   R5,SAVELREC
         SH   R5,=H'8'
         UNPK 0(8,R5),DOUBLE(8)
         OI   7(R5),X'F0'
         B    RENUM13
RENUM12  CVD  R4,DOUBLE
         UNPK 4(8,R2),DOUBLE(8)
         OI   11(R2),X'F0'
RENUM13  AH   R2,SAVELREC
         B    RENUM08
RENUM09  MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(19),RENUMSG1
         MVC  COMMAND(19),BLANKS
         MVI  MODFLAG,X'01'
         MVC  NUMVALUE(2),=H'10'
         MVC  SAVELINE(4),=F'10'
         BR   R14
RENUMSG1 DC   C'DATA SET RENUMBERED'
         DS   0H
RENUM11  MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(47),RENUMSG2
         MVC  COMMAND(19),BLANKS
         BR   R14
RENUMSG2 DC C'LINE NUMBERS EXCEED 6 DIGITS. USE SMALLER VALUE'
         DS   0H
PFRTN    BAL  R14,DIGITRTN
         LA   R5,20
DOWNDIG  MH   R5,SAVELREC
         MH   R5,DIGIT#
         A    R5,CURRADD
         C    R5,LASTADD
         BH   BOTTRTN
         ST   R5,CURRADD
         MVI  ENDFLAG,X'00'
         MVI  DIRECT,X'01'
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
*
*
PBRTN    BAL  R14,DIGITRTN
         LA   R5,20
UPDIG    MH   R5,SAVELREC
         MH   R5,DIGIT#
         L    R6,CURRADD
         SR   R6,R5
         C   R6,TOPADD
         BL   TOPRTN
         MVI  ENDFLAG,X'00'
         ST   R6,CURRADD
         MVI  DIRECT,X'00'
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
*
*
DIGITRTN LA   R7,3(R7)         POINT TO X'40'
         LA   R3,8             MAX COUNT
PFLOOP1  CLI  0(R7),C' '
         BNE  PF02
         LA   R7,1(R7)
         BCT  R3,PFLOOP1
*
*  NO DIGIT SPECIFIED (DIGIT# = 1)
*
         LA   R5,1
         STH  R5,DIGIT#
         BR   R14
*
*  DIGIT SPECIFIED
*
PF02     XR   R4,R4
         LR   R5,R7
PFLOOP2  CLI  0(R7),C' '
         BE   PF03
         XR   R6,R6
         IC   R6,0(R7)
         C    R6,=F'240'
         BL   INBAD
         LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,PFLOOP2
*
PF03     CH   R4,=H'100'
         BH   INBAD
         LTR  R4,R4
         BZ   *+6
         BCTR R4,0
         EX   R4,PF04
         B    *+10
PF04     PACK DOUBLE(8),0(0,R5)
         CVB  R4,DOUBLE
         STH  R4,DIGIT#
         BR   R14
DIGIT#   DS   H
*
*
DELRTN   EQU  *
         LA   R14,TPUTLOOP
SKIPLA14 MVI  ENDFLAG,X'00'
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  NOTEMPTY
         B    BADLOW
NOTEMPTY LA   R7,1(R7)
         LA   R3,19
DEL01    CLI  0(R7),C' '
         BE   DEL02
         LA   R7,1(R7)
         BCT  R3,DEL01
         B    DEL26
DEL02    CLI  0(R7),C' '
         BNE  DEL03
         LA   R7,1(R7)
         BCT  R3,DEL02
         B    DEL26
DEL03    LA   R4,0
         LR   R5,R7
DEL04    CLI  0(R7),C' '
         BE   DEL05
         XR   R6,R6
         IC   R6,0(R7)
         C    R6,=F'240'
         BL   DEL26
         LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,DEL04
         CH   R4,=H'6'
         BH   DEL26
* NO UPPER BOUND SPECIFIED
         B    DELUPPER
DEL05    CH   R4,=H'6'
         BH   DEL26
         BCTR R4,0
         EX   R4,DEL06
         B    *+10
DEL06    PACK DOUBLE(8),0(0,R5)
         CVB  R4,DOUBLE
         ST   R4,LOWER
DEL07    CLI  0(R7),C' '
         BNE  DEL08
         LA   R7,1(R7)
         BCT  R3,DEL07
DELUPPER MVC  UPPER(4),=4X'00'
         BC   15,DELMAIN
*
DEL08    XR   R4,R4
         LR   R5,R7
DEL09    CLI  0(R7),C' '
         BE   DEL10
         SR   R6,R6
         IC   R6,0(R7)
         C    R6,=F'240'
         BL   DEL26
         LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,DEL09
DEL10    CH   R4,=H'6'
         BH   DEL26
         BCTR R4,0
         EX   R4,DEL11
         B    *+10
DEL11    PACK DOUBLE(8),0(0,R5)
         CVB  R4,DOUBLE
         ST   R4,UPPER
*
DELMAIN  EQU  *
         ICM  R5,15,TOPADD
         ICM  R6,15,LASTADD
         AH   R6,SAVELREC
DEL12    CR   R5,R6
         BE   DELNONE
         CLI  FIXORVAR,X'00'
         BNE  DEL13
         TM   DATATYPE,B'01000000'
         BNO  DEL14
         SR   R1,R1
         TRT  0(6,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(6,R5)
         CVB  R7,DOUBLE
         BC   15,DEL16
DEL14    XR   R1,R1
         LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'8'
         TRT  0(8,R8),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(8,R8)
         CVB  R7,DOUBLE
         BC   15,DEL16
DEL13    XR   R1,R1
         TRT  4(8,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),4(8,R5)
         CVB  R7,DOUBLE
DEL16    C    R7,LOWER
         BNH  DEL89
         L    R7,LOWER
         B    DELBAD
DEL89    BNE  DEL17
         ST   R5,CURRADD
         BC   15,DEL18
DEL17    AH   R5,SAVELREC
         B    DEL12
DELNONE  L    R7,LOWER
DELBAD   CVD  R7,DOUBLE
         UNPK DELMSG2(8),DOUBLE(8)
         OI   DELMSG2+7,X'F0'
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(30),DELMSG1
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
*
DELMSG1  DC C'LINE NUMBER '
DELMSG2  DS 8C
DELMSG3  DC C' NOT FOUND'
         DS 0H
*
DEL18    LA   R3,1
         L    R5,UPPER
         LTR  R5,R5
         BNZ  DEL19
         MVC  UPPER(4),LOWER
         L    R5,UPPER
DEL19    C    R5,LOWER
         BL   DEL26
         L    R5,CURRADD
         L    R6,LASTADD
         AH   R6,SAVELREC
DEL20    CR   R5,R6
         BE   DEL21
         CLI  FIXORVAR,X'00'
         BNE  DEL22
         TM   DATATYPE,B'01000000'
         BNO  DEL23
         XR   R1,R1
         TRT  0(6,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(6,R5)
         CVB  R7,DOUBLE
         B    DEL24
DEL23    XR   R1,R1
         LR   R8,R5
         AH   R8,SAVELREC
         SH   R8,=H'8'
         TRT  0(8,R8),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),0(8,R8)
         CVB  R7,DOUBLE
         B    DEL24
DEL22    XR   R1,R1
         TRT  4(8,R5),TRTTABLE
         LTR  R1,R1
         BNZ  DEL15
         PACK DOUBLE(8),4(8,R5)
         CVB  R7,DOUBLE
DEL24    C    R7,UPPER
         BNH  DEL90
         L    R7,UPPER
         B    DELBAD
DEL90    BE   DEL25
         AH   R5,SAVELREC
         LA   R3,1(R3)
         B    DEL20
DEL21    L    R7,UPPER
         B    DELBAD
DEL15    MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(32),DELMSG4
         MVC  COMMAND(19),BLANKS
         ST   R5,CURRADD
         BC   15,TPUTLOOP
DELMSG4  DC C'INVALID LINE NUMBER - CORRECT IT'
         LTORG
         DS   0H
DEL25    EQU  *
         MH   R3,SAVELREC
         L    R8,LASTADD
         AH   R8,SAVELREC
         S    R8,TOPADD
         SR   R8,R3
         LTR  R8,R8
         BNZ  DEL92
         L    R8,TOPADD
         ST   R8,CURRADD
         SH   R8,SAVELREC
         ST   R8,LASTADD
         B    DEL93
DEL92    L    R4,CURRADD
         LR   R6,R3
         A    R6,CURRADD
         L    R5,LASTADD
         S    R5,CURRADD
         SR   R5,R3
         AH   R5,SAVELREC
         LR   R7,R5
         MVCL R4,R6
         L    R5,LASTADD
         SR   R5,R3
         ST   R5,LASTADD
*
*
*
*
DEL93    MVI  MODFLAG,X'01'
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(16),DELMSG7
         ICM  6,X'0F',SAVES#
         LA   6,1(6)
         ST   6,SAVES#
         MVC  COMMAND(19),BLANKS
         BR   R14
DELMSG7  DC   C'LINE(S) DELETED '
         DS   0H
DEL26    MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         MVC  RESPONSE(23),DELMSG8
         BC   15,TPUTLOOP
DELMSG8  DC C'INVALID RANGE SPECIFIED'
         DS  0H
DOWNRTN  LA   R7,2(R7)
         BAL  R14,DIGITRTN
         LA   R5,1
         BC   15,DOWNDIG
*
*
UPRTN    BAL  R14,DIGITRTN
         LA   R5,1
         B    UPDIG
*
*
FINDRTN  MVI  ENDFLAG,X'00'
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  FINDSK
BADLOW   MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(17),LOWFIND
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
LOWFIND  DC   C'DATA SET IS EMPTY'
SAVECHAR DS   C
         DS   0H
FINDSK   LA   R7,1(R7)
         MVI  DIRECT,X'01'
         LA   R3,19
FIND01   CLI  0(R7),C' '
         BE   FIND02
         LA   R7,1(R7)
         BCT  R3,FIND01
         B    BADFIND1
FIND02   CLI  0(R7),C' '
         BNE  FIND03
         LA   R7,1(R7)
         BCT  R3,FIND02
         B    TRYREPET
FIND03   XR   R2,R2
         IC   R2,0(R7)
         STC  R2,SAVECHAR
         LA   R7,1(R7)
         LR   R5,R7
         LA   R4,0
FIND04   CLC  0(1,R7),SAVECHAR
         BNE  FIND10
         LTR  R4,R4
         BZ   BADFIND1
         BCTR R4,0
FIND11   MVC  FINDSTR(17),BLANKS
         EX   R4,FIND12
         LA   R4,1(R4)
         ST   R4,FINDLENG
         B    FIND05
FIND12   MVC  FINDSTR(0),0(R5)   -- EXECUTED -
FIND10   LA   R4,1(R4)
         LA   R7,1(R7)
         BCT  R3,FIND04
         B    BADFIND1
FIND05   L    R6,CURRADD
         LH   R7,SAVELREC
         L    R8,LASTADD
         AH   R8,SAVELREC
FIND06   LTR  R4,R4
         BZ   BADFIND1
         BCTR R4,0
FIND07   EX   R4,FIND08
         B    *+10
FIND08   CLC  0(0,R6),0(R5)
         BNE  FIND99
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
FIND99   LA   R6,1(R6)
         BCT  R7,FIND07
         CR   R6,R8
         BE   BADFIND2
         LH   R7,SAVELREC
         ST   R6,CURRADD
         B    FIND07
BADFIND1 MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(22),FINDMSG1
         B    TPUTLOOP
BADFIND2 MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(16),FINDMSG2
         B    TPUTLOOP
FINDMSG1 DC   C'INVALID COMMAND FORMAT'
FINDMSG2 DC   C'STRING NOT FOUND'
         DS   0H
TRYREPET L   R4,FINDLENG
         LA  R5,FINDSTR
         LH  R6,SAVELREC
         A   R6,CURRADD
         C   R6,LASTADD
         BH  FIND05
         ST  R6,CURRADD
         B   FIND05
         DS  0F
FINDLENG DC  F'0'
FINDSTR  DC  17C' '
         DS  0H
*
*
CHANGRTN EQU *
         ICM  R6,X'0F',SAVES#
         LA   R6,1(R6)
         ST   R6,SAVES#
         B    CALLCHG
CPARMS   DC   A(TOPADD,LASTADD,SAVELREC,MODFLAG,RESPONSE,COMMAND)
         DC   A(DATATYPE,FIXORVAR)
         DS   0H
CALLCHG  LA   R7,1(R7)
         LA   R3,60
         MVI  ENDFLAG,X'00'
         LA   R4,CPARMS
       LINK EP=FSECHANG
         B    TPUTLOOP
*
*
         DS   0H
COLRTN  EQU  *
         MVI  ENDFLAG,X'00'
         LA   R7,1(R7)
         LA   R3,19
         L    R5,TOPADD
         L    R6,LASTADD
         CR   R5,R6
         BNH  COLLOOP
         B    BADLOW
COLLOOP  CLI  0(R7),C' '
         BE   COLNUM
         LA   R7,1(R7)
         BCT  R3,COLLOOP
COLMOVES MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(35),COLMSG
         B    TPUTLOOP
COLMSG   DC   C'MISSING OR INVALID COLUMN SPECIFIED'
         DS   0H
COLNUM   CLI  0(R7),C' '
         BNE  COLNUM2
         LA   R7,1(R7)
         BCT  R3,COLNUM
         B    COLMOVES
*
COLNUM2  EQU  *
         LR   R4,R7
         LA   R3,3
         LA   R6,0
COLLOOP2 CLI  0(R7),C' '
         BE   COLNUM3
         LA   R6,1(R6)
         SR   R5,R5
         IC   R5,0(R7)
         C    R5,=F'240'
         BL   COLMOVES
         LA   R7,1(R7)
         BCT  R3,COLLOOP2
COLNUM3  BCTR R6,0
         EX   R6,COLNUM4
         B    *+10
COLNUM4  PACK DOUBLE(8),0(0,R4)
         CVB  R5,DOUBLE
         LTR  R5,R5
         BZ   COLMOVES
         CLI  FIXORVAR,X'00'
         BNE  NEXT4
         CH   R5,SAVELREC
         BH   COLMOVES
         BCTR R5,0
         B    SKIPMORE
NEXT4    AH   R5,=H'12'
         CH   R5,SAVELREC
         BH   COLMOVES
         SH   R5,=H'13'
SKIPMORE STH  R5,COLUMN
         MVC  OUTCOL(3),=3C' '
         EX   R6,COLNUM5
         B    *+10
COLNUM5  MVC  OUTCOL(0),0(R4)
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         B    TPUTLOOP
*
*
*
ABENDTOP L    R4,0(R1)    A(PARMLIST IN SDWA)
         L    R4,4(R4)    A(SAVEREG)
*
         LM   R6,R3,0(R4)
         MVI  DIRECT,X'01'
*        MVC  CURRADD(4),TOPADD
         MVI  ENDFLAG,X'00'
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),RESPONSE
         LA   R6,RESPONSE
         LA   R5,SDWA
GETSYSCD LINK EP=FSESYSCD
         B    TPUTLOOP
TOPRTN   EQU  *
         MVC  CURRADD(4),TOPADD
         MVI  ENDFLAG,X'00'
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(15),TOPMSG
         MVC  COMMAND(19),BLANKS
         MVI  DIRECT,X'01'
         B    TPUTLOOP
TOPMSG   DC   C'TOP OF DATA SET'
         DS   0H
PA1RTN   L    R1,0(R1)
         LM   R0,R15,8(R15)
         B    TPUTLOOP
*
*
DSNRTN   MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(50),SAVEDSN
         MVC  COMMAND(19),BLANKS
         MVI  ENDFLAG,X'00'
         B    TPUTLOOP
*
*
BOTTRTN  LA   R5,20
         MH   R5,SAVELREC
         L    R6,LASTADD
         SR   R6,R5
         C    R6,TOPADD
         BL   TOPRTN
         ST   R6,CURRADD
         MVC  COMMAND(19),BLANKS
         MVC  RESPONSE(50),BLANKS
         MVC  RESPONSE(18),BOTTMSG
         MVI  ENDFLAG,X'00'
         MVI  DIRECT,X'00'
         B    TPUTLOOP
BOTTMSG  DC   C'BOTTOM OF DATA SET'
         DS   0H
*
*
HFRTN    LA   R5,10
         MH   R5,SAVELREC
         A    R5,CURRADD
         C    R5,LASTADD
         BH   BOTTRTN
         ST   R5,CURRADD
         MVI  ENDFLAG,X'00'
         MVC  RESPONSE(50),BLANKS
         MVC  COMMAND(19),BLANKS
         MVI  DIRECT,X'01'
         B    TPUTLOOP
*
*
HBRTN    LA   R5,10
         MH   R5,SAVELREC
         L    R6,CURRADD
         SR   R6,R5
         C    R6,TOPADD
         BL   TOPRTN
         ST   R6,CURRADD
         MVI  ENDFLAG,X'00'
         MVC  COMMAND(19),BLANKS
         MVC  RESPONSE(50),BLANKS
         MVI  DIRECT,X'00'
         B    TPUTLOOP
*
*
RETURN   EQU  *
*
*
LOOK3    EQU  *
          LA   R1,CPPL
          LINK EP=FSEFREE
*
*
*
*
*  FOUR FIELDS ARE USED THROUGHOUT THIS PROGRAM TO
*    ADDRESS THE RECORDS FOR THE FULLSCREEN AND TO MAKE
*    BOUNDARIES BETWEEN START OF SYSEDIT, LAST USED LINE
*    AND THE LAST ABSOLUTE LINE (RECORD).
*
*  TOPADD  IS THE ABSOLUTE START OF SYSEDIT
*  CURRADD IS THE ADDRESS OF THE START OF THE CURRENT RECORD
*  LASTADD IS THE ADDRESS OF THE LAST USED RECORD
*  BOTTADD IS THE ADDRESS OF THE LAST USABLE RECORD.
*
GOBACK   L    R13,4(R13)
         LM 14,12,12(13)
         BR 14
         LTORG
         DS  0F
CPPL     EQU  *
CB       DS   F     COMMAND BUFFER
UPT      DS   F     USER PROFILE TABLE
PSCB     DS   F     PROTECTED STEP CONTROL BLOCK
ECT      DS   F     ENVIRONMENT CONTROL TABLE
ALLOCDSN DC H'44'
DSNAME   DC   56C' '
MSG2     DC   C'ENTER DSNAME-'
MSG3     DC   C'INVALID DSNAME, REENTER-'
         DS   0H
MOVEDSN  MVC  DSNAME(0),0(R5)
SAVEDSN  DC   55C' '
SAVEBUFF DC   60C' '
STAEFLAG DC   X'00'
MSG4     DC   C'DATA SET NOT CATALOGED'
VOLSER   DC   6X'00'
         DS   0F
MSG5     DC   C'DATA SET NOT IN VOLUME'
FORMAT   DC   X'00'
MOVEIN   DS 0H
         MVC  0(0,R3),DSNAME
DATATYPE DC   X'00'
HEXTABLE DC   X'400102030405060708090A0B0C0D0E0F10111213141516171819'
         DC    X'1A1B1C1D1E1F202122232425262728292A2B2C2D2E2F303132'
         DC    X'333435363738393A3B3C3D3E3F404142434445464748494A4B'
         DC    X'4C4D4E4F505152535455565758595A5B5C5D5E5F6061626364'
         DC    X'65666768696A6B6C6D6E6F707172737475767778797A7B7C7D'
         DC    X'7E7F80C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6'
         DC    X'D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9AAABACADAEAF'
         DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7C8'
         DC X'C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1'
         DC X'E2E3E4E5E6E7E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FA'
         DC X'FBFCFDFEFF'
        DS  0F
NEWMEMBE DC X'0008',6X'00'
         DC AL4(ALLOCDSN)
DDNAME   DC C'FSEFILE '
DA08BLK  DC 16C' '
         DC  4X'00'
DA08PQTY DC 4X'00'
DA08SQTY DC 4X'00'
         DC 4X'00'
MEMBER   DC 8C' '
         DC 8C' '
DAIRFLAG DC 3X'08'
DA08CTL  DC B'00000000'
         DC 4X'00'
LIST     DC 8C' '
         DS 0F
*
DAPL     EQU *
DAPLUPT  DS F
DAPLECT  DS F
DAPLECB  DC F'0'
DAPLPSCB DS F
DAPLDAPB DS F
  DS 0D
DOUBLE   DS  D
SAVECURR  DS  F
FIELD1    DS  F
FIELD2    DS  F
FIELD3    DS  F
STARTING  DS  F
ENDING    DS  F
MOVCOPFL  DS  X
         DS  0F
COPYADD  DS  F
COPYEND  DS  F
COPYLEN  DS  F
BOTTADD  DS  F
TOPADD   DS  F
AREASIZE DS  F
SAVELREC DC  H'0'
RECORDS  DC  H'0'
AREA     DS  255C
FSEDCB DCB MACRF=GM,DDNAME=FSEFILE,DSORG=PS,EODAD=EODAD1
FSEDCB2 DCB DDNAME=FSEFILE,MACRF=GM,DSORG=PS,EODAD=EODAD2
*SEDCB3 DCB DDNAME=FSEFILE,MACRF=PM,DSORG=PS,EODAD=EODAD3
FSEDCBPO DCB DDNAME=FSEFILE2,MACRF=(R),DSORG=PO
     DS  0H
LST  DC H'1',H'58'
MEMBLDL DC 8C' '
        DS 70C
  DS 0F
LASTADD   DS  F
CURRADD   DS  F
SAVELINE  DC  F'-10'
          DS  0D
NEWLINE   DS  D
TRTTABLE  DC  240X'FF',10X'00',6X'FF'
    DS  0F
POPDS    DC X'0008',6X'00',AL4(ALLOCDSN),C'FSEFILE2'
         DC 16C' ',16X'00',16C' '
         DC  3X'08',B'00000000',4X'00',8C' '
    DS  0F
*
*  THIS IS THE DC SECTION USED TO OUTPUT THE FULL SCREEN
CLEER     DC X'C11140403C404000'
SCREEN    EQU *
       DC X'C111C1503C404000'
         DC X'11C1501DE8',C'==>',X'1DC813'
COMMAND   DC 21C' '
          DC         C'==>'
RESPONSE  DC 52C' '
         DC X'11C2601DC8'
LINE#1   DS 7C
LINE1    DS 72C
         DC X'11C3F01DC8'
LINE#3   DS 7C
LINE3    DS 72C
         DC X'11C5401DC8'
LINE#4   DS 7C
LINE4    DS 72C
         DC X'11C6501DC8'
LINE#5   DS 7C
LINE5    DS 72C
         DC X'11C7601DC8'
LINE#6   DS 7C
LINE6    DS 72C
         DC X'11C8F01DC8'
LINE#7   DS 7C
LINE7    DS 72C
         DC X'114A401DC8'
LINE#8   DS 7C
LINE8    DS 72C
         DC X'114B501DC8'
LINE#9   DS 7C
LINE9    DS 72C
         DC X'114C601DC8'
LINE#10  DS 7C
LINE10   DS 72C
         DC X'114DF01DC8'
LINE#11  DS 7C
LINE11   DS 72C
         DC X'114F401DC8'
LINE#12  DS 7C
LINE12   DS 72C
         DC X'1150501DC8'
LINE#13  DS 7C
LINE13   DS 72C
         DC X'11D1601DC8'
LINE#14  DS 7C
LINE14   DS 72C
         DC X'11D2F01DC8'
LINE#15  DS 7C
LINE15   DS 72C
         DC X'11D4401DC8'
LINE#16  DS 7C
LINE16   DS 72C
         DC X'11D5501DC8'
LINE#17  DS 7C
LINE17   DS 72C
         DC X'11D6601DC8'
LINE#18  DS 7C
LINE18   DS 72C
         DC X'11D7F01DC8'
LINE#19  DS 7C
LINE19   DS 72C
         DC X'11D9401DC8'
LINE#20  DS 7C
LINE20   DS 72C
         DC X'115A501DC8'
LINE#21  DS 7C
LINE21   DS 72C
         DC X'115B601DC8'
LINE#22  DS 7C
LINE22   DS 72C
         DC  X'115CF01DE8'
         DC  C'COL '
OUTCOL   DC  C'1  '
         DC  7CL10'----+----!'
         DC  C'--'
         DC  X'11C1501DE8'
         DC  C'==>'
         DC  X'1DC813'
SIZESCR  EQU  (*-SCREEN)
         DS 0F
AREAADD  DS F
SAVELAST DS F
XLEN     DS F
INCOUNT  DS H
UPPER    DS F
LOWER    DS F
COLUMN  DC  H'0'
DIRECT  DC  X'01'
USEFLAG  DC X'00'
SAVEFLAG DC X'00'
INFLAG   DS  X
INFLAG1  DS  X
MODFLAG  DC X'00'
LINEFLAG DC X'00'
ENDFLAG  DC X'01'
SEFLAG   DC X'00'
         DS 0F
NUMVALUE DC H'10'
         DS  0F
SAVEFROM DS  F
FREELEN  DS F
*EWCAT   CAMLST CAT,DSNAME,,CATVOL
*ATVOL   DC  H'1'
*        DC  X'3050200D'
*        DC  C'VS2TSO'
KEY      DS  C
         DS  0F
FREEMAI  DS  F
SAVES#   DC  F'0'
SAVE7    DS  F
SAVE3    DS  F
MYCB     DS  4X
CBTEXT   DS  18C
FAKECPPL DS  0F
FAKECB   DS  F
FAKEUPT  DS  F
FAKEPSCB DS  F
FAKEECT  DS  F
SAVEREG  DS 15F
ABENDPRM DC  A(ABENDTOP,SAVEREG,SDWA)
SDWA     DS 7C
AUTOFLAG DC X'00'
EMERG    DC C' S FSE.AUTOSAVE '
VTOC     CAMLST SEARCH,DSNAME,VOLSER,VTOCINFO
VTOCINFO DS 200C
CAT      CAMLST NAME,DSNAME,,CATINFO
CATINFO  DS  0D
         DS  265C
BLANKS   DC  255C' '
ABEND01  CSECT
         STM  14,12,12(13)
         BALR 12,0
         USING *,12
         ST  13,SAVE+4
         LA  5,SAVE
         ST  5,8(13)
         LR  13,5
*
         L   13,4(13)
         LM  14,12,12(13)
         LA  15,4
         L   3,0(1)
         L   3,0(3)
         LR  0,3
         L   4,0(1)
         L   4,8(4)   ADDRESS OF SDWA IN FSE
         MVC 0(7,4),0(1)
BR14     BR  14
SAVE     DS  18F
         END
./ ADD NAME=FSEATTR
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*    THIS ROUTINE WILL BE LINKED FROM "FSE" AND "FSESAVE" MODULES
*    TO CONDITIONALLY TRY TO FREE AN ATTRIBUTE LIST ALLOCATED BY
*    "FSESAVE" WHEN A SAVE FUNCTION FOR A NEW DATA SET IS PERFORMED.
*
*    THIS ATTRIBUTE LIST IS USED TO ALLOCATE DCB PARAMETERS FOR THE
*    DAIR FUNCTION OF ALLOCATING A NEW DATA SET.
*
*    AT ENTRY, R1 POINTS TO THE C.P.P.L. LIST TO BE USED WITH DAIR.
*
*    BRUNO LA LICATA     LVL 1.00     11 / 11 / 77
*    N.B.N.A.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSEATTR  CSECT
*
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         SAVE (14,12)                  STORE MVS REGS
         LR   R12,R15                  SET ADDRESSABILITY
         USING FSEATTR,R12
         ST    R13,SAVE+4                    AND SET SAVING
         LA    R5,SAVE
         ST    R5,8(R13)                           CONVENTION
         LR    R13,R5
         LR   R2,R1                    SAVE CPPL
         MVC  UPT(4),4(R2)             INITIALIZE DAIR BLOCK
         MVC  ECT(4),12(R2)
         XC   ECB(4),ECB                     FOR DEALLOCATION
         MVC  PSCB(4),8(R2)
         LA   R1,DAPL
         LINK EP=IKJDAIR               CALL DAIR
         L   R13,4(13)                 RETURN TO FSE OR
         RETURN (14,12)                       FSESAVE SUBLOGIC
         BR   14
DAPL     DS   0F
UPT      DS   F
ECT      DS   F
ECB      DC   F'0'
PSCB     DS   F
ADDRESS  DC   A(ATTRLIST)
ATTRLIST DC   X'0034'
         DC   4X'00',X'20',X'00',C'FSEATTR ',4X'00'
         DS   0F
SAVE  DS 18F
         END
./ ADD NAME=FSECHANG
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*   THIS ROUTINE IS LINKED FROM MAIN DRIVER "FSE" WHEN A CHANGE
*    COMMAND IS ISSUED. IT WILL SCAN THE COMMAND BUFFER AND SET
*    VARIABLES DESCRIBING BEGIN, END ADDRESSES, LENGTHS OF NEW
*    AND OLD TEXT STRINGS ETC..
*   AN INTERNAL ROUTINE IS INVOKED EVERY TIME A LINE FOUND IN THE
*    SPECIFIED RANGE IS TO BE SCANNED FOR THE TEXT. THE DATA IN
*    EACH MODIFIED LINE IS EITHER SHORTENED OR LENGTHENED (AND
*    THEREFORE TRUNCATED) ACCORDING TO THE NEW AND OLD TEXT STRINGS.
*
*   AT ENTRY POINT, R7 POINTS TO THE COMMAND BUFFER,
*                   R4  POINTS TO THE PASSED PARAMETER LIST
*                   (DC A(TOPADD,LASTADD,SAVELREC,MODFLAG,RESPONSE,
*                         COMMAND,DATATYPE,FIXORVAR))
*
*
*    BRUNO LA LICATA           LVL 1.00       1 / 12 / 77
*    N.B.N.A.
*
*
FSECHANG CSECT
         STM  14,12,12(13)
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         LR   R12,R15                  SET ADDRESSABILITY
         USING FSECHANG,R12              AND SAVE REGISTERS.
         ST   R13,SAVE+4
         LA   R5,SAVE
         ST   R5,8(R13)
         LR   R13,R5
         LR   R10,R4
         XC   RECORDS(4),RECORDS       INITIALIZE BUFFER AREAS
         MVI  ALLFLAG,X'00'              AND FLAG FOR "ALL" FUNCTION
         MVC  RECORD(255),BLANKS
C01      CLI  0(R7),C' '               SCAN FOR FIRST GAP
         BE   C02
         LA   R7,1(R7)
         BCT  R3,C01
         B    BADFIND1                 NO GAP FOR MAX LENGTH OF 60?
C02      CLI  0(R7),C' '                  YES, NO GOOD...
         BNE  C03                      SCAN FOR BEGGINNING OF LINE #
         LA   R7,1(R7)
         BCT  R3,C02
         B    BADFIND1                 NONE? TOO BAD...
C03      XR   R4,R4                    CLEAR FOR DIGIT COUNT
         LR   R5,R7                    SAVE BEGIN ADDRESS
C04      CLI  0(R7),C' '               SECOND GAP REACHED?
         BE   C05                      YES, GO DO IT ON SECOND LINE #
         XR   R6,R6                    CLEAR FOR DIGIT VALIDITY
         IC   R6,0(R7)
         C    R6,=F'240'               DIGIT NUMERIC?
         BL   BADFIND1                 NO, GO ISSUE MESSAGE
         LA   R4,1(R4)                 ADD 1 TO DIGIT COUNT
         LA   R7,1(R7)                 ADD 1 TO ADDRESS
         BCT  R3,C04                   GO DO IT UNTIL GAP ENDS
         B    BADFIND1                 FORMAT IS INVALID IF HERE.
C05      BCTR R4,0                     HERE, LINE NUMBER IS
         EX   R4,C06                     MADE TO BINARY
         B    *+10                       AND STORED INTO "FIRSTLIN".
C06      PACK DOUBLE(8),0(0,R5)
         CVB  R5,DOUBLE
*        LTR  R5,R5
*        BZ   BADFIND1
         ST   R5,FIRSTLIN
C07      CLI  0(R7),C' '               SCAN FOR NEXT LINE NUMBER, OR
         BNE  C08                      A SLASH (THAT INDICATES ONLY
         LA   R7,1(R7)                 1 LINE NUMBER WAS SPECIFIED)
         BCT  R3,C07
         B    BADFIND1
C08      CLI  0(R7),C'/'               SLASH FOUND: ONLY 1 LINE NUMBER
         BNE  C09                       SPECIFIED, SO MOVE MAKE LOW
         MVC  SECONDLI(4),FIRSTLIN      BOUNDARY = HIGH BOUNDARY
         B    C14                       AND SKIP SECOND LINE PROCESS.
C09      EQU  *
         XR   R4,R4                    CLEAR FOR DIGIT COUNT
         LR   R5,R7                    SAVE BEGIN ADDRESS
C10      CLI  0(R7),C' '               END OF LINE # DIGITS?
         BE   C11                      YES, GO CHECK IT
         XR   R6,R6                    CLEAR FOR IC ON DIGIT
         IC   R6,0(R7)
         C    R6,=F'240'               NUMERIC?
         BL   BADFIND1                 NO, BAD NEWS
         LA   R4,1(R4)                 ADD TO DIGIT COUNT
         LA   R7,1(R7)                 ADD TO ADDRESS
         BCT  R3,C10                   GO SCAN FOR END
         B    BADFIND1                 FORMAT INVALID IF HERE
C11      BCTR R4,0
         EX   R4,C12                   PACK LINE NUMBER
         B    *+10
C12      PACK DOUBLE(8),0(0,R5)             AND MAKE IT BINARY
         CVB  R5,DOUBLE
*        LTR  R5,R5
*        BZ   BADFIND1
         ST   R5,SECONDLI               STORE IT IN "SECONDLI"
C13      CLI  0(R7),C' '               CHECK FOR SLASH
         BNE  C14                      GO THRU GAP UNTIL NON-BLANK
         LA   R7,1(R7)
         BCT  R3,C13
         B    BADFIND1
C14      CLI  0(R7),C'/'               SLASH?
         BNE  BADFIND1                 NO, ERROR IN FORMAT
         LA   R7,1(R7)
         ST   R7,ADDR1                 STORE ADDRESS OF STRING
         XR   R5,R5                    CLEAR FOR LENGTH COUNT
C15      CLI  0(R7),C'/'               CHECK FOR END OF STRING1
         BE   C16
         LA   R7,1(R7)                 ADD TO ADDRESS
         LA   R5,1(R5)                 ADD FOR LENGTH COUNT
         BCT  R3,C15                   GO SCAN
         B    BADFIND1                 FORMAT INVALID : (NOT COMPLETE)
C16      LTR  R5,R5                    NO DATA ON STRING #1?
         BZ   BADFIND1                  NO DATA : INVALID FORMAT
         STH  R5,LEN1                  STORE LENGTH
         LA   R7,1(R7)                 SKIP SLASH
         ST   R7,ADDR2                 STORE STRING #2 ADDRESS
         XR   R5,R5                    CLEAR FOR LENGTH
C17      CLI  0(R7),C'/'               SCAN FOR LAST SLASH
         BE   C18
         LA   R7,1(R7)                 ADD TO ADDRESS
         LA   R5,1(R5)                 ADD TO COUNT
         BCT  R3,C17                   GO SCAN
         B    BADFIND1                 FORMAT INVALID
C18      STH  R5,LEN2                  END FOUND : STORE LENGTH
         CLI  1(R7),C'A'               SCAN FOR ALL SPECIFICATION
         BNE  SKIPMSG1                 NO, SKIP SET OF FLAG
         MVI  ALLFLAG,X'01'            YES, SET ALL FLAG
         BC   15,SKIPMSG1
BADFIND1 L    R9,20(R10)               THIS SECTION INITIALIZES
*        MVC  0(19,R9),=19C' '         FSE BUFFERS FOR SCREEN I/O
         L    R9,16(R10)               AND MOVES "INVALID FORMAT"
         MVC  0(22,R9),MSG1            MESSAGE.
         B    RETURN
*
MSG1     DC   C'INVALID COMMAND FORMAT'
MSG2     DC   C'LINE NOT FOUND'
MSG3     DC   C'TEXT NOT FOUND'
MSG4     EQU  *
RECS     DS   3C
         DC   C' CHANGE(S) MADE '
RECORD   DC   255C' '
BLANKS   DC   255C' '
ALLFLAG  DS   X
         DS   0D
TOPADD   DS   F
LASTADD  DS   F
RECORDS  DS   F
DOUBLE   DS   D
FIRSTLIN DS   F
SECONDLI DS   F
ADDR1    DS   F
ADDR2    DS   F
SAVE     DS   18F
LEN1     DS   H
X        DS   H
Y        DS   H
LEN2     DS   H
SAVELREC DS   H
FIXORVAR DS   X
DATATYPE DS   X
*
SKIPMSG1 EQU  *                     * * * * * * * * * * * * * * *
         L    R3,28(R10)               THIS SECTION MOVES DATA
         MVC  FIXORVAR(1),0(R3)
         L    R3,0(R10)                   FIELDS FROM FSE BUFFERS
         MVC  TOPADD(4),0(R3)
         L    R3,24(R10)                  TO FSECHANG BUFFERS
         MVC  DATATYPE(1),0(R3)
         L    R3,4(R10)
         MVC  LASTADD(4),0(R3)
         L    R3,8(R10)
         MVC  SAVELREC(2),0(R3)
*                                   * * * * * * * * * * * * * * * *
CMAIN    EQU  *                     HERE THE SYSEDIT DATA SET IN CORE
         ICM  R6,15,LASTADD         IS SCANNED RECORD BY RECORD
         ICM  R5,15,TOPADD          SEARCHING FOR THE LINE NUMBER
         AH   R6,SAVELREC           CORRESPONDING TO THE SPECIFIED
C19      CR   R5,R6                 ONE. WHEN IT IS FOUND, A LOOP
         BE   BADFIND2              IS EXECUTED FOR THE RECORDS FOUND
         TM   FIXORVAR,1            IN THE SPECIFIED RANGE (INCLUSIVE)
         BO   CVAR1                 SCANNING FOR THE TEXT IN STRING #1.
         TM   DATATYPE,X'40'        FOR EACH MATCH IN THE RECORDS
         BO   CCOBOL1               WITHIN THE RANGE, ROUTINE MOVEDATA
COTHERS1 LR   R8,R5                 IS BAL"ED TO DO THE CHANGES.
         AH   R8,SAVELREC           IF NO "ALL" WAS SPECIFIED, UPON
         SH   R8,=H'6'              COMPLETION OF 1 CHANGE, RETURN IS
         PACK DOUBLE(8),0(6,R8)     MADE TO FSE. THE NUMBER OF CHANGES
         CVB  R8,DOUBLE             MADE IS RECORDED AND PASSED TO
         B    C21                   FSE FOR DISPLAY.
CCOBOL1  PACK DOUBLE(8),0(6,R5)
         CVB  R8,DOUBLE
         B    C21
CVAR1    PACK DOUBLE(8),6(6,R5)
         CVB  R8,DOUBLE
C21      C    R8,FIRSTLIN
         BE   CFOUND1
         AH   R5,SAVELREC
         B    C19
*
BADFIND2 EQU  *                  BADFIND2 WILL CLEAR COMMAND BUFFER
         L    R3,20(R10)
*        MVC  0(19,R3),=19C' '      AND MOVE "TEXT" NOT FOUND IN
         L    R3,16(R10)
         MVC  0(14,R3),MSG2             RESPONSE FIELD OF FSE.
         B    RETURN
CFOUND1  LR   R8,R5
         LH   R3,SAVELREC
         TM   FIXORVAR,X'01'
         BNO  NOV
         SH   R3,=H'12'
         LA   R8,12(R8)
         B    GODOIT
NOV      TM   DATATYPE,X'40'
         BNO  NOC
         SH   R3,=H'6'
         LA   R8,6(R8)
         B    GODOIT
NOC      SH   R3,=H'8'
*
*
*
GODOIT   LH   R4,LEN1
         BCTR R4,0
         ICM  R2,X'0F',ADDR1
CLOOP1   CR   R5,R6
         BE   FINISH
         TM   FIXORVAR,1
         BO   CVAR2
         TM   DATATYPE,X'40'
         BO   CCOBOL2
COTHERS2 LR   R9,R5
         AH   R9,SAVELREC
         SH   R9,=H'8'
         PACK DOUBLE(8),0(8,R9)
         CVB  R9,DOUBLE
         B    C22
CCOBOL2  PACK DOUBLE(8),0(6,R5)
         CVB  R9,DOUBLE
         B    C22
CVAR2    PACK DOUBLE(8),4(8,R5)
         CVB  R9,DOUBLE
C22      C    R9,SECONDLI
         BH   FINISH
CLOOP2   EQU  *
         EX   R4,C23
         B    *+10
C23      CLC  0(0,R8),0(R2)        DATA MATCHES?
         BNE  KEEPON                     NO, GO ADD TO ADDRESS
         MVC  RECORD(255),BLANKS         INITIALIZE WORK BUFFER
         TM   FIXORVAR,X'01'             VARIABLE RECORDS?
         BNO  NOTVARIA                   NO
         MVC  0(2,R5),SAVELREC           YES, MOVE LRECL TO RECORD
NOTVARIA BAL  R14,MOVEDATA             GO CHANGE DATA
         TM   ALLFLAG,1                ALL SPECIFIED?
         BNO  FINISH                   NO, RETURN TO FSE
         LH   R11,LEN1                 YES, ADD SHORTER OF LEN 1
         CH   R11,LEN2                 OR LEN 2 TO ADDRESS AND
         BNL  MOVELEN2                           ...
         LH   R11,LEN2                           ...
MOVELEN2 AR   R8,R11                   GO SCAN AGAIN
         SR   R3,R11
         BCTR R8,0
KEEPON   LA   R8,1(R8)                 ADD 1 TO ADDRESS IN RECORD
         BCT  R3,CLOOP2
NEXTREC  AH   R5,SAVELREC              NEXT RECORD..ADD LRECL
         LH   R3,SAVELREC
         LR   R8,R5
         B    CLOOP1                   GO SCAN AGAIN IN NEXT REC
FINISH   CLC  FIRSTLIN(4),SECONDLI     RANGE > THAN 1 LINE?
         BNE  MODIFIED                 YES, GO GET # OF CHANGES MADE
         L    R3,12(R10)
         TM   0(R3),1                  ANY DATA MODIFIED?
         BO   MODIFIED                 YES, GO GET # OF RECS
         L    R3,20(R10)
         MVC  0(19,R3),=19C' '         CLEAR FSE BUFFRES
         L    R3,16(R10)
         MVC  0(14,R3),MSG3
         B    RETURN                   RETURN TO FSE
*
MODIFIED L    R3,RECORDS              "MODIFIED" ROUTINE WILL
         CVD  R3,DOUBLE                MOVE THE NUMBER OF CHANGES INTO
         UNPK RECS(3),DOUBLE(8)        FSE RESPONSE FIELD.
         OI   RECS+2,X'F0'
         L    R3,20(R10)
         MVC  0(19,R3),=19C' '
         L    R3,16(R10)
         MVC  0(19,R3),MSG4
RETURN   L    R13,4(R13)               RETURN TO FSE
         LM   R14,R12,12(R13)
         BR   R14
*
*
MOVEDATA EQU  *                      THREE ROUTINES CAN BE USED TO
         CLC  LEN1(2),LEN2           CHANGE DATA:
         BNE  NOTSAME
         L    R7,ADDR2
         EX   R4,MOVESAME
         L    R7,12(R10)
         MVI  0(R7),1
         L    R7,RECORDS
         LA   R7,1(R7)
         ST   R7,RECORDS
         BR   R14
MOVESAME MVC  0(0,R8),0(R7)
*
NOTSAME  EQU  *
         LH   R0,LEN1
         CH   R0,LEN2
         BH   MAKESMAL
MAKEBIG  LR   R9,R5
         ST   R9,SAVSTART
         CLI  FIXORVAR,X'01'
         BNE  ELSESAVE
*        MVC  SAVELINE(8),4(R9)
         B    GOAHEAD
ELSESAVE TM   DATATYPE,X'40'
         BNO  OTHRTYP
         LR   R11,R9
         AH   R11,SAVELREC
         MVC  SAVELINE(6),0(R11)
         B    GOAHEAD
OTHRTYP  EQU  *
         LR   R11,R9
         AH   R11,SAVELREC
         SH   R11,=H'8'
         MVC  SAVELINE(8),0(R11)
GOAHEAD  AH   R9,SAVELREC
         SR   R9,R8
         BCTR R9,0
         STH  R9,X
         LR   R9,R8
         AH   R9,LEN1
         MVC  RECORD(255),0(R9)
         LH   R7,LEN2
         SH   R7,LEN1
         STH  R7,Y
         LH   R7,X
         SH   R7,Y
         STH  R7,X
         LH   R7,LEN2
         CH   R7,X
         BNH  OK1
         LH   R7,X
OK1      BCTR R7,0
         L    R9,ADDR2
         EX   R7,MOVEBIG1
         B    *+10
MOVEBIG1 MVC  0(0,R8),0(R9)
         LR   R9,R8
         AH   R9,LEN2
         LH   R7,X
         SH   R7,Y
         BCTR R7,0
         TM   DATATYPE,X'40'
         BO   EXLINBEF
         TM   FIXORVAR,1
         BO   EXLINBEF
         SH   R7,=H'8'
EXLINBEF LH   R11,LEN1
         LA   R11,1(R11)
         CH   R11,LEN2
         BNE  SKIP1MOR
         BCTR R7,0
SKIP1MOR EQU  *
*
*
         EX   R7,MOVEBIG2
         B    SAVEBACK
MOVEBIG2 MVC  0(0,R9),RECORD
SAVEBACK L    R9,SAVSTART
         LR   R11,R9
         CLI  FIXORVAR,X'01'
         BNE  BACKELSE
         AH   R11,SAVELREC
         MVC  0(2,R11),SAVELREC
         BC   15,DONE
BACKELSE TM   DATATYPE,X'40'
         BNO  BACKNOCO
         LR   R11,R5
         AH   R11,SAVELREC
         MVC  0(6,R11),SAVELINE
         B    DONE
BACKNOCO AH   R11,SAVELREC
         SH   R11,=H'8'
         MVC  0(8,R11),SAVELINE
DONE     EQU  *
ADDTOREC L    R7,12(R10)
         MVI  0(R7),1
         L    R7,RECORDS
         LA   R7,1(R7)
         ST   R7,RECORDS
         BR   R14
MAKESMAL EQU  *
         LH   R7,LEN1
         SH   R7,LEN2
         STH  R7,Y
         LR   R9,R5
         AH   R9,SAVELREC
         SR   R9,R8
         SH   R9,LEN1
         STH  R9,X
         BCTR R9,0
         TM   FIXORVAR,1
         BO   DOEXEC
         TM   DATATYPE,X'40'
         BO   DOEXEC
         SH   R9,=H'9'
DOEXEC   LR   R7,R8
         AH   R7,LEN1
         EX   R9,MOVESMA1
         B    *+10
MOVESMA1 MVC  RECORD(0),0(R7)
         L    R7,ADDR2
         LH   R0,LEN2
         LTR  R0,R0
         BZ   SKIPIF0
         LH   R9,LEN2
         BCTR R9,0
         EX   R9,MOVESMA2
         B    *+10
MOVESMA2 MVC  0(0,R8),0(R7)
SKIPIF0  LR   R7,R8
         AH   R7,LEN2
         LH   R9,X
         AH   R9,Y
         BCTR R9,0
         TM   FIXORVAR,1
         BO   LINEBFRE
         TM   DATATYPE,X'40'
         BO   LINEBFRE
         SH   R9,=H'8'
LINEBFRE EX   R9,MOVESMA3
         B    ADDTOREC
MOVESMA3 MVC  0(0,R7),RECORD
*
         DS  0F
SAVSTART DS  F
SAVELINE DS  8C
         END
./ ADD NAME=FSEFREE
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*    THIS MODULE IS LINKED FROM MAIN LOGIC ROUTINE "FSE" OR SAVE      *
*     COMMAND MODULE "FSESAVE" TO FREE UP ANY UTILITY ASSOCIATED      *
*     DDNAME (I.E. STARTING WITH FSE..)                               *
*    DAIR IS USED, AS IN ALL FSE MODULES FOR VS1/SVS/MVS              *
*     COMPATIBILITY.                                                  *
*                                                                     *
*    BRUNO LA LICATA       N.B.N.A.         11 / 77                   *
*                                                                     *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSEFREE  CSECT
*
R0       EQU 0
R1       EQU 1
R2       EQU 2
R3       EQU 3
R4       EQU 4
R5       EQU 5
R6       EQU 6
R7       EQU 7
R8       EQU 8
R9       EQU 9
R10      EQU 10
R11      EQU 11
R12      EQU 12
R13      EQU 13
R14      EQU 14
R15      EQU 15
*
         SAVE (14,12)            SAVE
         LR   R2,R1
         LR   R12,R15                REGISTERS
         USING FSEFREE,R12
         ST    R13,SAVE+4                 AND SET
         LA    R5,SAVE
         ST    R5,8(R13)                      ADDRESSABILITY
         LR    R13,R5
         MVC  UPT(4),4(R2)              SAVE THE 4 ADDRESSES
         MVC  ECT(4),12(R2)             OF THE C.P.P.L. PASSED
         MVC  PSCB(4),8(R2)
         L    R4,16                     A(CVT)
         L    R4,0(R4)                  A(OLD NEW TCB)
         L    R4,4(R4)                  A(TCB)
         L    R4,12(R4)                 A(MY TIOT)
         LA   R4,24(R4)                 BUMP UP TO DD ENTRIES START
LOOP     CLI  0(R4),X'00'               END OF ENTRIES?
         BE   RETURN                    YES, GO BACK
         XR   R5,R5                     CLEAR FOR INSERT
         IC   R5,0(R4)                  GET LENGTH OF DD ENTRY
         MVC  DDNAME(8),4(R4)
         CLC  DDNAME(6),=C'FSEFIL'
         BE   DEALLOC
         CLC  DDNAME(5),=C'SYS00'
         BNE  NEXT
DEALLOC  XC   ECB(4),ECB                CLEAR ECB
         LA   R1,DAPL                   LOAD PARM LIST ADD.
         LINK EP=IKJDAIR              , CALL ALLOCATION ROUTINE
NEXT     AR   R4,R5                     BUMP TO NEXT ENTRY
         BC   15,LOOP                  GO GET NEXT
RETURN   L   13,4(13)
         RETURN (14,12)
DAPL     DS  0F
UPT      DS  F
ECT      DS   F
ECB      DC   F'0'
PSCB     DS   F
ADDRESS  DC   A(BLOCK)
BLOCK    DC   X'0018'
B        DC   10X'00'
DDNAME   DC   8C' '
C        DC   8C' '
D        DC   2C' '
E        DC   X'00'
F        DC   X'10'
         DC   8X'00'
     DS  0F
SAVE  DS 18F
ERRMSG   DC  C'ERROR DEALLOCATING '
DD       DS  8C
         END
./ ADD NAME=FSEHELP
)S SUBCOMMANDS -
  TOP,BOTTOM,PF,PB,HF,HB,FIND,DSN,AUTOSAVE,DELETE,UP,DOWN,INSERT,
  COLUMN,CHANGE,COPY,MOVE,SAVE,SAVEEND,END,RENUM,DONE,SUBMIT,PFK
)F FUNCTION -
  THE FSE COMMAND IS USED TO CREATE OR MODIFY SEQUENTIAL DATA SETS,
  MEMBERS OF PARTITIONED DATA SETS OR THE BROWESING BACK AND FORTH
  OF UN-NUMBERED DATA SETS (DUMPS ETC..). IT ALLOWES THE SIMULTANEOUS
  UPDATE OF UP TO 21 LINES ON A CRT TERMINAL AND THE EXECUTION
  OF AN FSE SUBCOMMAND OR TSO COMMAND AT THE SAME TIME.
  THIS IS AN EXAMPLE OF A SCREEN IMAGE BACK AT THE TERMINAL :

                _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
                 ==> COMMAND ==>RESPONSE       
                00010   DATA  LINE  1          
                00020   DATA  LINE  2          
                  .      .        .            
                  .      .        .            
                  .      .        .            
                  .      .        .            
                  .      .        .            
                  .      .        .            
                00200   DATA  LINE  20         
                00210   DATA  LINE  21         
                 ----COLUMN INDICATOR----- 
                _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _

  FSE HAS 4 MODES OF DATA MODIFICATION, WHICH MAY BE USED CUNCURRENTLY
  OR SEPARATLY.
    A) ENTERING AN FSE SUBCOMMAND OR A TSO COMMAND (ALL EXCEPT IDCAMS
       RELATED I.E. DELETE, LISTC ETC.., TIME AND EXEC).
    B) MOVING THE CRT CURSOR TO ANY OF THE DATA LINES (UP TO 21) AND
       MODIFYING DATA BY TYPING OVER THE OLD ONE.
    C) BY USING THE CHARACTER IMMEDIATLY FOLLOWING THE LINE NUMBER
       AND IMMEDIATLY PRECEDING THE DATA FIELD IN THE SAME LINE.
       A DIGIT 0 - 9 WILL INSERT THAT MANY BLANK LINES AFTER THAT
       PARTICULAR LINE.
       A CHARACTER "F" AND "L" IN TWO DIFFERENT LINES BUT ON THE
       SAME SCREEN (FIRST & LAST) WILL DELETE THAT RANGE OF LINES.
       A CHARACTER "D"  WILL DELETE THAT LINE.
    D) BY ALTERING TE ACTUAL 6 DIGIT LINE NUMBER TO THE NUMBER OF
       OF ANOTHER LINE NUMBER. THIS WILL COPY THE ALTERED LINE
       TO THE OTHER.
 NOTE: IF YOU HAVE TERMINALS WITH KEYBOARDS EQUIPPED WITH PROGRAM
       FUNCTION KEYS, EACH PFK CAN BE USED TO PRE-PROGRAM ANY
       SUBCOMMAND OR NATIVE TSO COMMAND. (SEE THE DESCRIPTION
       OF THE "PFK" COMMAND ON ITS USE.)

  IN ESSENCE THE USER HAS THE ABILITY OF DOING ALL FOUR FUNCTIONS
    AT THE SAME TIME, WHILE MIXING FUNCTION B, C AND D IN ANY
    COMBINATION OR LINE(S).

  NOTE - IF NO DATA IS ALTERED, NO COMMAND ENTERED, NO FIELDS
         MODIFIED AND USER PRESSES ENTER KEY, FSE WILL EITHER
         PAGE FORWARD OR BACKWARD 21 LINES DEPENDING ON THE
         PREVIOUS DIRECTION.
       - IF DATA IS TO BE MODIFIED BY TYPING OVER THE OLD ONE,
         AND THE NEW DATA IS LONGER, THE USER MUST FIRST PRESS
         THE ERASE-END-OF-FILE KEY AT THE END OF THE LINE TO BE
         MODIFIED (BY THE TRAILING BLANKS), AND SUBSEQUENTLY RETURN
         AND DO THE INSERT-KEY FUNCTION.
)X SYNTAX -
         FSE    'DSNAME'  NEW/OLD  LIST/NOLIST
                CLIST/DATA/CNTL/ASM/PLI/COBOL
  REQUIRED - 'DSNAME' & BLANKS SEPARATING KEYWORDS
  DEFAULTS - OLD,NOLIST
  ALIAS    - NONE
  NOTE     - THE DATA SET MUST HAVE VALID LINE NUMBERS IN ASCENDING
             ORDER NOT EXCEEDING 999999, ELSE USER WILL BE ASKED TO
             EITHER RENUMBER IT OR END FSE SESSION.
  NOTE     - IF THE FULLY QUALIFIED DATA SET NAME IS SPECIFIED, IT MUST
             BE ENCLOSED IN SINGLE QUOTES. IF THE DATA SET NAME IS NOT
             ENTERED WITHIN QUOTES, THE USERID IS ALWAYS APPENDED TO
             THE LEFT OF THE NAME. THE RIGHTMOST QUALIFIER OF THE
             NAME ENTERED MAY BE A DESCRIPTIVE QUALIFIER FOR A
             PARTICULAR DATA SET TYPE.
  NOTE     - DATA SET TYPE IS ONLY REQUIRED IF THE LAST QUALIFIER IN
             THE DATA SET NAME IS NOT EITHER ASM,PLI,DATA,CLIST OR
             CNTL. IF THE KEYWORD "LIST" WAS SPECIFED, A QUALIFIER
             IS NOT REQUIRED.
)O OPERANDS -
  'DSNAME' - NAME OF THE DATA SET TO BE CREATED OR EDITED.
))NEW      - DATA SET NAMED DID NOT EXIST BEFORE COMMAND WAS ISSUED.
))OLD      - DATA SET ALREADY EXISTED WHEN THE EDIT COMMAND WAS ISSUED.
))LIST     - ONLY BROWESING WILL BE ALLOWED. (USED TO SCAN BACK AND
             FORTH ON DUMPS, JCL OUTPUT ETC..)
           - THIS OPTION REQUIRES NO DATA SET TYPE KEYWORD.
))NOLIST   - FULL EDITING WILL BE ALLOWED.
))COBOL    - DATA CONSISTS OF COBOL SOURCE STATEMENTS.
))ASM      - DATA CONSISTS OF ASSEMBLER SOURCE STATEMENTS.
))DATA     - DATA IS TO BE INPUT TO A PROGRAM.
))CLIST    - DATA IS INPUT TO AN EXEC COMMAND.
))CNTL     - DATA IS CONTROL DATA FOR A SUBMIT COMMAND.
))PLI      - INPUT DATA CONSISTS OF PLI SOURCE STATEMENTS.


        ---- S U B C O M M A N D   D E S C R I P T I O N ----



  TOP      - WILL POSITION DATA SET AT FIRST 21 LINES
  T

  BOTTOM   - WILL POSITION DATA SET AT LAST 21 LINES
  B

  PF  NNN  - WILL PAGE FORWARD NNN NUMBER OF PAGES IN DATA SET.
           - DEFAULT NNN = 1 PAGE

  PB  NNN  - WILL PAGE BACK NNN NUMBER OF PAGES IN DATA SET.
           - DEFAULT NNN = 1 PAGE

  HF       - WILL HALH PAGE FORWARD 10 LINES OF DATA SET

  HB       - WILL HALH PAGE BACK 10 LINES OF DATA SET

  UP  NNN  - WILL MOVE SCREEN UP NNN NUMBER OF LINES.
           - DEFAULT NNN = 1 LINE

  DOWN NNN - WILL MOVE SCREEN DOWN NNN NUMBER OF LINES.
           - DEFAULT NNN = 1 LINE

  FIND 'STRING'
  F         - WILL SEARCH DATA SET STARTING FROM LINE AT TOP
            - OF SCREEN TILL A MATCH IS MADE WITH CHARACTER
            - STRING. CHARACTER STRING MUST BE WITHIN SET OF
            - DELIMITERS MADE UP OF ANY CHARACTER.
            - A "FIND" WITH NO STRING WILL ATTEMPT TO FIND THE
            - NEXT OCCURRENCE OF THE STRING.

  DELETE LINE1 LINE2
  DEL       - WILL DELETE LINE1, OR RANGE LINE1-LINE2 IF LINE2
            - IS SPECIFIED.

  INSERT LINE1  NN
  IN        - WILL INSERT NN NUMBER OF BLANK LINES FOLLOWING LINE1.

  COLUMN NNN
  COL       - WILL SHIFT DISPLAYED DATA ON SCREEN SO THAT THE
            - FIRST CHRACTER OF EACH LINE IS ACTUALLY OFFSET BY
            - THE SPECIFIED COLUMN. THIS IS USEFUL FOR DATA SETS
            - WITH RECORD LENGTHS LARGER THAN 80, SO THAT DATA
            - AT THE END OF THE RECORD MAY BE ALTERED OR DISPLAYED.

  CHANGE  LINE1  LINE2  /STRING1/STRING2/ALL
  C         - WILL CHANGE STRING1 OF LINE1 (OR LINE1 THROUGH LINE2
            - IF SPECIFIED) TO STRING2.
            - ONLY ONE CHANGE PER LINE IS MADE UNLESS KEYWORD "ALL"
            - IS SPECIFIED IMMEDIATLY FOLLOWING ENDING SLASH.
            - OPTIONAL A) LINE2
            -          B) ALL
      NOTE: - TRUNCATION OR TRAILING BLANKS WILL RESULT IF STRING1
            - AND STRING2 ARE OF DIFFERENT LENGTHS.

  COPY  LINE1  LINE2  LINE3
            - WILL COPY LINE1 (OR LINE1 THROUGH LINE2 IF SPECIFIED)
            - AFTER EXISTING LINE3.
            - OPTIONAL A) LINE2
            - REQUIRED A) LINE1
                       B) LINE3
                       C) LINE1, LINE2 AND LINE3 MUST BE EXISTING
  MOVE  LINE1  LINE2  LINE3
            - WILL MOVE LINE1 (OR LINE1 THROUGH LINE2 IF SPECIFIED)
            - AFTER EXISTING LINE3.
            - OPTIONAL A) LINE2
            - REQUIRED A) LINE1
                       B) LINE3
                       C) LINE1, LINE2 AND LINE3 MUST BE EXISTING

  RENUM  NNN  MMM
  R         - WILL RENUMBER DATA SET STARTING WITH NNN BY MMM
            - INCREMENTS.
            - OPTIONAL A) NNN
                       B) MMM
            - DEFAULT IS NNN=10  MMM=10

  PFK    DISPLAY
         D
         NN=(COMMAND)
            - THE DISPLAY (ABBREVIATED "D") WILL DISPLAY THE
            - CURRENT COMMANDS ASSOCIATED WITH EACH PF KEY.
            - BY SPECIFYING A KEY NUMBER, A PFK CAN BE PROGRAMMED
            - TO EXECUTE A SPECIFIC COMMAND.

  SAVE   'DSNAME'
  S         - WILL SAVE THE DATA SET BACK TO DISK.
            - 'DSNAME' FOLLOWES SAME TSO STANDARDS AS IN FSE COMMAND
            - SYNTAX, WHERE QUOTES DENOTE FULL QUALIFICATION, ELSE
            - USER ID IS PREFIXED.
            - OPTIONAL A) 'DSNAME' IS NOT REQUIRED: A "SAVE"
                          SUBCOMMAND ALONE WILL SAVE INTO THE
                          ORIGINAL DATA SET.
      NOTE: - THE SAVE FUNCTION WILL RETURN ANY MESSAGES OR ABEND
            - CODE MESSAGES IF IT FAILS, I.E. SPACE ABENDS ETC...
            - AT THIS POINT ANOTHER "SAVE" SUBCOMMAND SHOULD BE
            - TOWARD ANOTHER DATA SET.

  SAVEEND 'DSNAME'
            - WILL SAVE THE DATA SET BACK TO DISK AND END FSE SESSION.
            - 'DSNAME' FOLLOWES SAME TSO STANDARDS AS IN FSE COMMAND
            - SYNTAX, WHERE QUOTES DENOTE FULL QUALIFICATION, ELSE
            - USER ID IS PREFIXED.
            - OPTIONAL A) 'DSNAME' IS NOT REQUIRED: A "SAVEEND"
                          SUBCOMMAND ALONE WILL SAVE INTO THE
                          ORIGINAL DATA SET AND END FSE SESSION.
      NOTE: - THE SAVEEND FUNCTION WILL RETURN ANY MESSAGES OR ABEND
            - CODE MESSAGES IF IT FAILS, I.E. SPACE ABENDS ETC...
            - AT THIS POINT ANOTHER "SAVE" OR "SAVEEND" COMMAND
            - SHOULD BE ISSUED TOWARD ANOTHER DATA SET.

  END       - WILL END FSE SESSION.
            - IF CHANGES WERE MADE TO THE DATA SET, USER WILL BE
            - ASKED TO EITHER ENTER A "SAVE" COMMAND TO STORE
            - BACK THE CHANGES, OR ANOTHER "END" COMMAND TO BYPASS
            - SAVING.

  DONE      - WILL UNCONDITIONALLY END FSE SESSION WITHOUT ANY
            - CHANGES BEING SAVED.

  SUBMIT    - WILL SUBMIT THE DATA SET BEING EDITED TO THE INTERNAL
  SUB       - READER FOR BACKGROUND PROCESSING.

  AUTOSAVE  - WILL AUTOMATICALLY SAVE DATA SET EVERY 10 LINES WORTH
            - OF CHANGES INTO "USERID.FSE.AUTOSAVE".
            - THIS MEASURE ALLOWES USER TO KEEP EDITING WITHOUT
            - PERIODICALLY SAVING AS A PRECAUTION OF POSSIBLE
            - SYSTEM CRASH.
     NOTE:  - IT IS THE USER"S RESPONSIBILITY TO DELETE
            - HIS "USERID.FSE.AUTOSAVE" AFTER A CLEAN "SAVE"
            - PERFORMED INTO HIS DATA SET.

  DSN       - WILL DISPLAY THE NAME OF THE DATA SET BEING EDITED.
./ ADD NAME=FSEPFKEY
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*  THIS MODULE (FSEPFKEY) IS CALLED BY BRANCH BY MAIN MODULE FSE    *
*   FOR THREE FUNCTIONS:                                            *
*   A) TO EXECUTE A PRE-PROGRAMMED PFKEY (1 - 12) COMMAND R0=0      *
*   B) TO PROGRAM A PFKEY COMMAND EQUATE                  R0=1      *
*   C) TO DISPLAY THE CURRENT PFKEY PROGRAMMED FUNCTIONS. R0=1      *
*                                                                   *
*                                                                   *
*  THIS MODULE IS LINKED INTO FSE FOR PERFORMANCE REASONS.          *
*  INPUT PARMS ARE AS FOLLOWS:                                      *
*  A)  R0=0  R1=ADDRESS OF TGET ASIS AREA...EXECUTE FUNCTION        *
*  B)  R0=1  R1=ADDRESS OF " PFK " COMMAND..PROGRAM FUNCTION        *
*  C)  R0=1  R1=ADDRESS OF " PFK " COMMAND..DISPLAY FUNCTION        *
*                                                                   *
*   BRUNO LA LICATA  CITIBANK I.M.G.       01 / 11 / 1980           *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
FSEPFKEY CSECT                     SET ADDRESSABILITY
*
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         SAVE (14,12)                       SET ADDRESSABILITY
         LR   R12,R15
         USING FSEPFKEY,R12                     AND
         ST  R13,SAVE+4
         LA  R5,SAVE                                 SAVE REGISTERS
         ST  R5,8(R13)
         LR  R13,R5
*
         ST  R1,SAVER1             SAVE PARM
         CLI 0(R1),X'40'           DISPLAY OR PROGRAM?
         BE  NOTEXEC               YES...SKIP EXECUTION LOGIC
         B   EXEC
SCANKEY  LA  R4,12                 MAX NUMBER OF PFKEYS
         LA  R5,AREA               ADDRESS OF DSECT
LOOP     CLC 0(1,R1),0(5)          COMPARE KEY VALUES
         BER R14
         LA  R5,26(R5)             BUMP TABLE UP 26
         BCT R4,LOOP               GO TRY AGAIN
         B   RETURN                NO KEY
EXEC     BAL R14,SCANKEY
         MVC 3(25,R1),1(R5)
         MVC 0(3,R1),=X'11C1D5'
         B   RETURN                EXECUTE PFKEY
NOTEXEC  EQU *
         LR  R7,R1
         LA  R7,4(R7)
         LA  R8,10
WORDLOOP CLI 0(R7),C' '
         BNE SOMETHNG
         LA  R7,1(R7)
         BCT R8,WORDLOOP
         B   RETURN
SOMETHNG CLI 0(R7),C'D'
         BE  DISPLAY
         LR  R5,R7
         LA  R8,3
         LA  R9,0
DIGITL   CLC 0(2,R7),=C'=('
         BE  FOUNDEQ
         XR  R10,R10
         IC  R10,0(R7)
         CH  R10,=H'240'
         BL  RETURN
         LA  R7,1(R7)
         LA  R9,1(R9)
         BCT R8,DIGITL
         B   RETURN
FOUNDEQ  EQU  *
         BCTR R9,0
         EX   R9,PACKIT
         B    *+10
PACKIT   PACK DOUBLE(8),0(0,R5)
         CVB  R5,DOUBLE
         LTR  R5,R5
         BZ   RETURN
         CH   R5,=H'12'
         BH   RETURN
         CH   R5,=H'10'
         BNE  TRY11
         MVI  KEY,X'7A'
         B    SKIPNUM
TRY11    CH   R5,=H'11'
         BNE  TRY12
         MVI  KEY,X'7B'
         B    SKIPNUM
TRY12    CH   R5,=H'12'
         BNE  NUMERIC
         MVI  KEY,X'7C'
         B    SKIPNUM
NUMERIC  CVD  R5,DOUBLE
         UNPK KEY(1),DOUBLE(8)
         OI   KEY,X'F0'
SKIPNUM  LA   R1,KEY
         BAL  R14,SCANKEY
* WHEN HERE...MACHING ENTRY FOUND
* R5 POINTS TO KEY+COMMAND
         LA   R7,2(R7)
         LA   R8,25
         LR   R2,R7
         LA   R4,0
PARLOOP  CLI  0(R7),C')'
         BE   FOUNDPAR
         LA   R7,1(R7)
         LA   R4,1(R4)
         BCT  R8,PARLOOP
         B    RETURN
FOUNDPAR LTR  R4,R4
         BZ   RETURN
         MVC  1(25,R5),=25C' '
         BCTR R4,0
         EX   R4,MOVECMD
         B    *+10
MOVECMD  MVC  1(0,R5),0(R2)
         B    RETURN
DISPLAY  TPUT CLEAR,8,FULLSCR,,HOLD
         LA   R2,12
         LA   R3,1
         LA   R4,AREA
DISLOOP  CVD  R3,DOUBLE
         UNPK DISMSG1+3(2),DOUBLE(8)
         OI   DISMSG1+4,X'F0'
         MVC  DISMSG2(25),=25C' '
         MVC  DISMSG2(25),1(R4)
         TPUT DISMSG1,31
         LA   R4,26(R4)
         LA   R3,1(R3)
         BCT  R2,DISLOOP
         TPUT DISMSG1+5,1
         TPUT PROMPT,28
         TGET KEY,1
RETURN   EQU *
         L   13,SAVE+4
         LM  14,12,12(13)
         BR  14
         DS  0F
SAVE     DS  18F
SAVER1   DS  F
KEY      DS X
DISMSG1  DC  C'PFK01 '
DISMSG2  DC  25C' '
PROMPT   DC  C'PRESS ENTER TO RETURN TO FSE'
CLEAR    DC  X'C11140403C404000'
AREA     DC  X'F1',C'TOP                      '
         DC  X'F2',C'DOWN 1                   '
         DC  X'F3',C'R 100 100                '
         DC  X'F4',C'PB                       '
         DC  X'F5',C'F                        '
         DC  X'F6',C'C                        '
         DC  X'F7',C'PB                       '
         DC  X'F8',C'PF                       '
         DC  X'F9',C'SUBMIT                   '
         DC  X'7A',C'UP 1                     '
         DC  X'7B',C'B                        '
         DC  X'7C',C'END                      '
         DS  0D
DOUBLE   DS  D
         END
./ ADD NAME=FSEPRTY
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*  THIS MODULE (FSEPRTY) IS LINKED FROM MAIN DRIVER FSE TO ALTER    *
*   THE DISPATCHING PRIORITY OF THE EXECUTING ASCB FOR INCREASED    *
*   RESPONSE TIME AND TO DECREASE SIGNIFICANCE IN IPS FOR SECOND    *
*   & THIRD PERIOD TSO. THIS FEATURE WILL BE ONLY EXECUTED UNDER    *
*   MVS, BYPASSING IT FOR OTHER OPERATING SYSTEMS (ASCB IS          *
*   VERIFIED BEFORE CHAP FUNCTION.                                  *
*                                                                   *
*  AT ENTRY REG. 2 HAS THE BINARY VALUE OF THE NEW DISPATCHING      *
*  PRIORITY, (USUALLY 240 ENTERING FSE, AND 126 LEAVING IT)         *
*  IF THE HIGH BIT IN R2 IS ON MAKES ADDR. SPACE NON-SWAPPABLE      *
*                                                                   *
*  NO FRR IS SET, BUT RATHER A SIMPLE STAE TO CONTROL ABENDS.       *
*                                                                   *
*   BRUNO LA LICATA  N.B.N.A.         8 / 14 /78                    *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
FSEPRTY  CSECT                     SET ADDRESSABILITY
*
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         SAVE (14,12)                       SET ADDRESSABILITY
         LR   R12,R15
         USING FSEPRTY,R12                      AND
         ST  R13,SAVE+4
         LA  R5,SAVE                                 SAVE REGISTERS
         ST  R5,8(R13)
         LR  R13,R5
         LR  R10,R2
         L    2,16        A(CVT)
         L    2,0(2)      A(OLD/NEW TCB)
         L    2,4(2)      A(MY TCB)
         L    2,180(2)    A(JSCB)
         XR   0,0         CLEAR FOR IC
         IC   0,236(2)    JSCB FLAG BYTE
         STC  0,BYTE      STORE AWAY
         OI   BYTE,X'01'  TURN MODESET BIT ON
         IC   0,BYTE      IC FOR ZAP SVC
         LR   15,2        ADD OF JSCB
         LA   15,236(15)  JSCB FLAGS ADDRESS
         SVC  248         ZAP BIT ON
         MODESET KEY=ZERO,MODE=SUP
         B    SKIPBYTE    GO PROCESS
BYTE     DS   C
SKIPBYTE DS   0H
SETSTAE  EQU   *                            SET UP STAE ENVIRONMENT
          LR  R2,R10
         ST    R2,SAVER2                    USE R2 AS PARM (DPRTY)
         STH   R2,BINPRTY
         L     R3,ABENDPRM
         STM   R6,R3,SAVEREG
*        STAE  ABEND01,PARAM=ABENDPRM,PURGE=HALT
         BC   15,GETSTAT
ABENDTOP L     R4,0(R1)            THIS SECTION WILL RESET REGISTERS
         L     R4,4(R4)            IN CASE OF ABEND
         LM    R6,R3,0(R4)
RETURN   EQU   *
         MODESET KEY=NZERO,MODE=PROB   ,SET PROBLEM STATE BACK
         L    R13,SAVE+4           LOAD BACK SAVE REG
         RETURN (14,12)            RETURN TO FSE
         DS    0F
ASCBADD  DS F
         DS  0D
DOUBLE   DS  D
         DS  0H
GETSTAT  L   R10,X'220'            ASCB
         ST  R10,HISASCB           SAVE ASCB ADDRESS
         L   R11,144(R10)          OUCB ADDRESS
         NI  19(R11),X'BF'         TURN OFF APG BIT
         TM   SAVER2,X'80'         NON-SWAP REQUEST?
         BNO  PUT2A                NO, GO PUT IN RIGHT SRM CODE
         MVI  SRMCODE,X'29'        MOVE CODE
         B    PUT29                SKIP THER VALUE
PUT2A    MVI  SRMCODE,X'2A'        MOVE CODE
PUT29    EQU  *
         XR   R0,R0                CLEAR R0
         IC   R0,SRMCODE           INSERT CODE
SVC      SVC  95                   ISSUE SYSEVENT
         LTR  R1,R1                GOOD RETURN?
         BZ   CHAPP                YES, GO FINISH
         TPUT SRMMSG,16            NO, SEND ERROR MSG
CHAPP    EQU  *
DOCHAP   SR   R0,R0
         LA   R1,PARM
         LA   13,CHAPSAVE         GIVE CHAP WORK REG SPACE
         L    R6,16               ADDRESS OF CVT
         L    R15,676(R6)         ADDRESS OF CHAP ROUTINE
         BALR R14,R15             BRANCH TO IT
         LA   R13,CHAPSAVE
         B    RETURN
         DS  0F
SAVER2   DS  F
SAVE     DS    18F
CHAPSAVE DS    18F
PARM     DS   0F
         DC   X'8000'
BINPRTY  DC   H'0'
HISASCB  DS   F
SAVEREG  DS   15F
ABENDPRM DC   A(ABENDTOP,SAVEREG,SDWA)
SDWA     DS  10C
SRMMSG   DC  C'NONZERO SRM CODE'
SRMCODE  DS  X
         DS  0H
ABEND01  CSECT
         STM  14,12,12(13)       THIS IS
         BALR 12,0
         USING *,12                 A DUMMY CSECT
         ST   13,SAVE3+4
         LA   5,SAVE3                   USED TO GET
         ST   5,8(13)
         LR   13,5                          BACK TO MAIN
         L    13,4(13)
         LM   14,12,12(13)                      LINE AFTER
         LA   15,4
         L    3,0(1)                                    ABEND
         L    3,0(3)
         LR   0,3
         L    4,0(1)
         L    4,8(4)
         MVC  0(10,4),0(1)
         BR   14
       DS  0F
SAVE3    DS   18F
    END
./ ADD NAME=FSESAVE
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*    THIS ROUTINE IS LINKED FROM MAIN DRIVER "FSE" WHEN A SAVE
*    SUBCOMMAND IS ENTERED. EXPLANATION OF LOGIC FLOW FOLLOWES :
*  - UPON ENTRY INTO FSESAVE, A SCAN OF THE SUBCOMMAND BUFFER
*    IS DONE TO SEE WHETHER A DATA SET WAS ENTERED WITH THE "S"
*    OR "SAVE". IF THE DATA SET WAS NOT ENTERED, IT ASSUMES THE
*    SYSEDIT FILE IS TO BE WRITTEN BACK INTO THE ORIGINAL ONE
*    THAT WAS EDITED. FSESAVE WILL USE MANY ADDRESSES PASSED FROM
*    FSE TO RETRIEVE DATATYPE, FLAGS, DSNAMES ETC...
*  - IF A DATA SET WAS ENTERED, FSESAVE WILL SCAN IT FOR VALIDITY
*    ETC... AND ALSO MOVE MEMBER NAME FOR PDS"S INTO SAVE AREAS.
*  - WHEN ALL PERTINENT FIELDS ARE MOVED FROM "FSE" BUFFERS TO
*    FSESAVE BUFFERS, A CHECK IS MADE FOR EITHER OLD OR NEW STATUS
*  - FOR AN OLD DATA SET, A FORMAT 1 DSCB IS READ INTO STORAGE
*    TO VALIDATE DATA SET CHARACTERISTICS ETC...
*  - FOR A NEW DATA SET, (ACCORDING TO TYPE) A DATA SET WILL BE
*    ALLOCATEDWITH STANDARD CHARACTERISTICS.
*  - THE SYSEDIT FILE WILL BE WRITTEN TO THE ALLOCATED DATA SET
*    USING 1 OF 6 POSSIBLE DCB"S THAT ARE DEFINED.
*  - EACH TIME FSESAVE IS ENTERED, A COUNT OF DDNAMED IS INCREMENTED
*    TO ALLOW ONLY ONE USE OF A PARTICULAR DCB PER EDIT.
*    THIS IS USED IN CASE OF ABEND WHILE WRITING OUT..(B37,D37,E37)
*    HAVING THE STAE ROUTINE TAKING CONTROL AND LEAVING THE DCB OPEN
*    (CONTRARY TO DOCUMENTATION, CLOSING THE DCB AND REUSING IT,
*    RESULTED IN VARIOUS I/O ABENDS)
*    AT ENTRY POINT R3 CONTAINS THE ADDRESS OF THE PARMLIST :
*     DC A(TOPADD,LASTADD,ALLOCDSN,SAVEDSN,MEMBER,PSCB,SAVEFLAG,
*          ENDFLAG,SAVELREC,DATATYPE,PARMSAVE,FIXORVAR,CPPL,RESPONSE,
*          DDCOUNT)
*    R7 CONTAINS THE ADDRESS OF THE SUBCOMMAND BUFFER
*    R4 CONTAINS THE ADDRESS OF THE PARMSAVE FLAG (TO INDICATE
*    SUCCESFULL SAVE TO "FSE")
*
*
*    BRUNO LA LICATA        LVL 1.00      11 / 11 / 77
*    N.B.N.A.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSESAVE  CSECT
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*
*
         STM   R14,R12,12(R13)         SAVE REGISTERS
         LR    R12,R15                    AND SET
         USING FSESAVE,R12,R11              ADDRESSABILITY
         L   R11,=A(FSESAVE+4096)              FOR 8K
         BC  15,GETSAVE                SKIP LITERAL POOL
         LTORG
         DS  0H
GETSAVE  ST    R13,SAVE+4            SET UP CONVENTIONAL
         LA    R5,SAVE               SAVE AREA CHAINING
         ST    R5,8(R13)
         LR    R13,R5
         LR   R10,R3                 SAVE R3 ==> R10  MAIN PARM REG.
         ST   R10,SAVEPARM           SAVE IT
         LA   R7,1(R7)
         LR   R2,R7                  R2 ADD(SUBCOMMAND BUFFER)
         LA   R3,10                  MAX LENGTH TO SEE IF DSNAME
         LR   R9,R4                    WAS SPECIFIED.
         L    R1,48(R10)               LOAD R1 WITH C.P.P.L.
         LINK EP=FSEATTR               FREE ATTRLIST(FSEATTR) IF ALLOC.
         L    R1,48(R10)               LOAD R1 WITH C.P.P.L.
         LINK EP=FSEFREE               FREE DDNAMES ALLOCATED
         L    R4,56(R10)
         L    R4,0(R4)                 LOAD DDNAME COUNT
         CVD  R4,DOUBLE
         UNPK DDNAME+6(2),DOUBLE(8)    MOVE IT INTO DAIR FIELD
         OI   DDNAME+7,X'F0'
*
*
         MVC  CATINFO(256),=256C' '    HOUSEKEPING
         MVC  DSNAME(56),CATINFO
         MVC  SAVEDSN(55),CATINFO
         MVI  DATATYPE,X'00'
DSNLOOP  CLI  0(R2),C' '               THIS SECTION WILL TEST TO SEE
         BE   ADDBACK                    IF A DATA SET NAME WAS GIVEN
         LA   R2,1(R2)                   IN THE SAVE SUBCOMMAND.
         BCT  R3,DSNLOOP
         B    NODSNAME                 NO DSNAME FOUND
ADDBACK  LA   R3,5
LOOP1    CLI  0(R2),X'40'
         BNE FOUNDDSN                  DATA SET NAME SPECIFIED..
         LA   R2,1(R2)                 SKIP IF BLANK
         BCT  R3,LOOP1
         B    NODSNAME                NO DSNAME WAS FOUND....
*
*
FOUNDDSN MVC   DDNAME+8(16),=16C' '         CLEAR DAIR UNIT/VOL
         CLC   0(8,R2),=C'FSEABCDE'         IS IT SUBMIT-SAVE?
         BNE   SKIPSUB                      NO, SKIP INIT
         MVC   DDNAME+8(16),=C'3350    WORK00  ' SET UP DAIR
*
SKIPSUB  LA   R4,0                    R4 USED FOR DSNAME LENGTH
         LR   R5,R2                   SAVE DSNAME ADDRESS IN BUFFER
         LA   R3,56  MAX LENGTH (44 + 2 QUOTES + 8 FOR MEMBER)
LOOP2    CLI  0(R2),X'40'             CHECK FOR BLANK (END)
         BE   ENDDSN
         LA   R2,1(R2)                BUMP UP BUFFER ADD.
         LA   R4,1(R4)                BUMP UP LENGTH COUNT
         BCT  R3,LOOP2   GO SCAN AGAIN
         MVI  0(R9),B'00010000'        INVALID DSNAME SPECIFIED
         L    R10,52(R10)              MOVE MESSAGE
         MVC  0(41,R10),SAVEMSG4
         B    RETURN                   GOBACK TO FSE
SAVEMSG4 DC   C'INVALID DSNAME SPECIFIED - USE NEW DSNAME'
         DS   0H
ENDDSN   LR   R7,R4                    DSNAME LENGTH
         MVC  DSNAME(56),=56C' '
         BCTR R4,0                     READY FOR EX
         EX   R4,MOVEDSN               MOVE FROM BUFFER TO "DSNAME"
*
FIXDSN   CLI  DSNAME,C''''             CHECK FOR FULL QUALIFICATION
         BNE  PREFIXID                 NO, MUST BE USER DATA SET
         MVC  SAVEDSN(55),=55C' '      CLEAN "DSNAME"
         MVC  SAVEDSN(55),DSNAME+1     MOVE TO STRIP QUOTE
         LA   R2,SAVEDSN               BEGINNING ADD. FOR SEARH
         LA   R3,55                    OF ENDING QUOTE--MAX LENGTH
*
LOOP3    CLI  0(R2),C''''
         BE   FOUNDQUO                 FOUND IT...
         LA   R2,1(R2)                 BUMP UP ADDRESS
         BCT  R3,LOOP3                 GO SCAN AGAIN
         MVI 0(R9),B'00010000'
         L    R10,52(R10)
         MVC  0(41,R10),SAVEMSG4
         BC   15,RETURN
FOUNDQUO MVI 0(R2),X'40'               MAKE IT BLANK
         B   SKIPID                    GO TO SCAN KEYWORDS
*
* THIS SECTION WILL PREFIX THE DSNAME WITH THE USER"S
*  LOGON ID FOUND AT P.S.C.B. +0. LENGTH IS AT +7.
*
PREFIXID LA   R2,DSNAME
          LA   R3,SAVEDSN
         MVC  SAVEDSN(55),=55C' '      CLEAR IT FOR MOVE
         L    R4,20(R10)               POINT TO LOGON ID
         L    R4,0(R4)
         SR   R5,R5                    CLEAR TO LOAD ID LENGTH
         IC   R5,7(R4)                 INSERT LENGTH OF TSO ID.
         BCTR R5,0                     READY FOR EX
         EX   R5,MOVEID                MOVE ID TO SAVEDSN
         B    *+10                     SKIP EXECUTED MOVE
MOVEID   MVC  0(0,R3),0(4)             ---EXECUTED MOVE--
         DS   0H
         LA   R5,1(R5)                 ADD BACK TO LENGTH
         AR   R3,R5                    POINT TO "." SPOT
         MVI  0(R3),C'.'               MOVE IT IN
         LA   R3,1(R3)                 POINT TO NEXT LEVEL
*
*  THIS SECTION WILL MOVE THE READ-IN DSNAME APPENDED TO ID
*
         BCTR R7,0                     READY TO EX
         EX   R7,MOVEIN                MOVE REST OF DSNAME
         LA   R7,1(R7)                 ADD BACK TO LENGTH
*
*  HERE, THE SPECIFIED KEYWORDS WILL BE SCANNED AND FLAGS
*   IN "DATATYPE" WILL BE SET ACCORDINGLY.
*
SKIPID   EQU  *
MAINLOG  EQU  *
        DS  0H
         LA   R2,SAVEDSN               SCAN ADDRESS
         LA   R4,55
         LA   R6,0                     LENGTH COUNT
LOOP5    CLI  0(R2),C'('               CHECK FOR PDS
         BE   FOUNDPDS
         LA   R2,1(R2)                 BUMP 1
         LA   R6,1(R6)                 ADD 1 TO COUNT
         BCT  R4,LOOP5
* THIS MUST BE A SEQUENTIAL DATA SET
         MVC  DSNAME(55),SAVEDSN
         NI   DATATYPE,B'11111110'     MAKE SEQUNTIAL
         B    OKTYPE
FOUNDPDS OI   DATATYPE,X'01'           FLAG FOR PDS
         LA   R3,SAVEDSN               START ADDRESS
         SR   R2,R3                    LENGTH OF TRUE NAME
         MVC  DSNAME(56),=56C' '
         BCTR R2,0
         EX   R2,MOVETRUE
         B    *+10
MOVETRUE MVC  DSNAME(0),SAVEDSN          MOVE TRUE DSNAME-MEMBER
*
*
OKTYPE   EQU  *                          LOAD UP
         L    R2,48(R10)  CPPL ADD.         C.P.P.L.
         L    R3,4(R2)                           ADDRESSES
         ST   R3,DAPLUPT                                FROM
         L    R3,16(R2)
         ST   R3,DAPLECT                                    FSE
         L    R3,8(R2)
         ST   R3,DAPLPSCB
         XC   DAPLECB(4),DAPLECB
*
*
NEWDSN   TM   DATATYPE,X'01'        IS IT PDS REQUIRED?
         BNO  NOTPDS
         BAL  R6,PDSRTN             DO ALLOCATION FOR PDS
         BC   15,GETMAIN            GO TO MAIN LINE RTN
*
*
*  THIS ROUTINE DOES THE ALLOCATION FOR A NEW AND OLD MEMBER
*   OF AN EXISTING P.D.S.
*
*
PDSRTN   LOCATE CAT                 MAKE SURE DSN IS CATALOGED
         LTR  R15,R15
         BZ   PDSOK                 OK, CATALOGED
PDSNOTOK MVI  0(R9),X'08'
         L    R10,52(R10)
         MVC  0(44,R10),SAVEMSG5
         BC   15,RETURN
SAVEMSG5 DC   C'SPECIFIED PDS NOT CATALOGED - USE NEW DSNAME'
         DS   0H
PDSOK    EQU  *
*
*  THIS NEXT SECTION RETRIEVES THE MEMBER NAME FROM
*   FIELD SAVEDSN, TO BE USED IN THE DAIR BLOCK.
         LA   R5,SAVEDSN
         LA   R2,SAVEDSN
         LA   R3,55            SEARCH COUNT MAX.
LOOP9    CLI  0(R2),C'('       CHECK FOR PARENTHESIS
         BNE  SKIPLOAD
         LR   R5,R2
SKIPLOAD CLI  0(R2),C')'       CHECK FOR END
         BE   GETMEMBE
         LA   R2,1(R2)         BUMP ADDRESS UP 1
         BCT  R3,LOOP9
*
GETMEMBE SR   R2,R5            GET MEMBER LENGTH+1
         BCTR R2,0             TRUE LENGTH
         CH   R2,=H'8'         VALID LENGTH??
         BNH  LENGTHOK
         MVI  0(R9),X'10'
         L    R10,52(R10)
         MVC  0(41,R10),SAVEMSG4
         B    RETURN
*
LENGTHOK LA   R5,1(R5)         POINT TO MEMBER NAME
         BCTR R2,0
         EX   R2,MOVEMEMB
         B    *+10
MOVEMEMB MVC  MEMBER(0),0(R5)  ---EXECUTED MVC--
         LA    R7,NEWMEMBE
         ST    R7,DAPLDAPB
         MVC   NEWMEMBE+2(6),=6X'00'         INITIALIZA
         MVC   DA08BLK(4),=4X'00'                DYNAMIC
         MVC   DA08PQTY(4),=4X'00'                  ALLOCATION
         MVC   DA08SQTY(4),=4X'00'                     PARAMETERS
         MVC   DA08DQTY(4),=4X'00'                   FOR
         MVC   DAIRFLAG(3),=X'080808'                    AN OLD
         MVI   DA08CTL,X'00'                                DATA SET
         MVC   DA08CTL+1(3),=3X'00'
         MVI   DA08CTL+4,X'40'
         MVC   LIST(8),=8C' '
DYNPDS   LA   R1,DAPL                      LOAD PRIMARY DAIR BLOCK
         LINK EP=IKJDAIR                   LINK TO ALLOCATION RTN.
DAIRCHEK LTR  R15,R15                      OK RETURN?
         BZR  R6                           YES,BRANCH TO CALLING RTN
         MVI  0(R9),X'80'                  NO ALLOCATION...
         L    R10,52(R10)                  ADD(RESPONSE FIELD)
         MVC  0(41,R10),SAVEMSG1           MOVE MESSAGE
         BC   15,RETURN                    GO BACK TO FSE
*
SAVEMSG1 DC   C'DYNAMIC ALLOCATION ERROR - USE NEW DSNAME'
         DS   0H
*
NOTPDS   EQU  *
         MVI NEWFLAG,X'01'             NEW DEFAULT
         LOCATE CAT                   MAKE SURE DATA SET DOES"NT EXIST
         LTR  R15,R15                 CHECK RETURN FROM LOCATE
         BNZ  OKNEW                   NOT CATALOGED...
        MVI  NEWFLAG,X'00'            CATALOGED, MOVE TO FLAG
         B    OLDDSN                  GO PROCESS AN OLD DATA SET
NEFLAG   DS   X
         DS 0H
OKNEW    EQU  *
*
*  FOR NEW PHY. SEQ. DATA SET, AN ATTRIBUTE LIST CONTAINING
*   THE LRECL, BLKSIZE, RECFM HAS TO BE CREATED. THESE VALUES
*   WILL BE DEPENDENT ON THE DATA SET TYPE...(CLIST TYPES
*   ARE  VBS 255 X 1680  VARIABLE BLOCKED.... THE REST ARE
*   80  X 4080 FIXED BLOCKED)
*  THE ATTRIBUTE LIST IS LATER USED TO ALLOCATE THE DATA SET
*  DEFAULTING TO SYSGENED SPACE VALUES AND DISP=(NEW,CATLG,CATLG)
*
         LA    R7,ATTRLIST            ADDRESS OF DAIR BLOCK
         ST    R7,DAPLDAPB            STORE IT
         LA   R1,DAPL                 LOAD PRIMARY DAIR BLOCK
         L    R2,36(R10)
CHECK2   TM   0(R2),B'00000100'    CHECK FOR CLIST TYPE
         BNO  SKIPCLIS                NOT CLIST
CLISTTYP LA   R5,255                  BUFFER SIZE AND LRECL
         STH  R5,LRECL                MOVE IT
*        STH  R5,BUFFLEN              MOVE IT
         MVC  BLKSIZE(2),=H'1680'     MOVE DEFAULT BLKSIZE
         MVI  FIXORVAR,X'01'
         MVI  RECFM,B'01010000'       MOVE DEFAULT VB RECFM
         B    DAIRATTR               SKIP OTHER DEFAULTS
SKIPCLIS MVC  LRECL(2),=H'80'        LRECL DEFAULT
*        MVC  BUFFLEN(2),=H'80'      BUFFER SIZE
         MVC  BLKSIZE(2),=H'4080'    BLKSIZE DEFAULT
         MVI  RECFM,B'10010000'      RECFM=FB DEFAULT
DAIRATTR LINK EP=IKJDAIR             LINK TO ALLOCATE DCB
         LTR  R15,R15                GOOD CODE?
         BZ   DSNALLOC               YES, GO ALLOCATE DATA SET
         MVI  0(R9),X'80'            NO, GO TPUT THE CODE
         L    R10,52(R10)
         MVC  0(41,R10),SAVEMSG1
         B    RETURN
DSNALLOC LA   R7,NEWMEMBE           SET UP APPROPRIATE DAIR BLK.
         ST   R7,DAPLDAPB
         MVI DAIRFLAG,B'00000100'       * *  * * * * * * * * * * * *
         MVI DAIRFLAG+1,B'00000010'     *                          *
         MVI DAIRFLAG+2,B'00000000'     *  INITIALIZE DAIR CONTROL *
         MVI DA08CTL,B'10010010'        *  BLOCKS FOR ALLOCATION   *
         MVC NEWMEMBE+2(6),=6X'00'      *  OF NEW DATA SET.        *
         MVC DA08BLK(4),=4X'00'         *                          *
         MVC DA08DQTY(4),=4X'00'        *                          *
         MVC MEMBER(8),=8C' '           *                          *
         MVC  LIST(8),=C'FSEATTR '      * * * * * * * * * * * * * *
         L    R2,4(R10)
         L    R2,0(R2)                  SAVE FIELD "SAVELREC" FROM
         L    R3,32(R10)                FSE INTO FSESAVE.
         LH   R3,0(R3)
         STH  R3,SAVELREC               THIS ROUTINE  WILL CALCULATE
         AR   R2,R3                       THE AMOUNT OF SPACE IN
         MH   R3,=H'50'                   TRACKS NEEDED TO SAVE THE
         AR   R2,R3                       SYSEDIT FILE.
         L    R3,0(R10)                   MINIMUM IS 4 TRACKS, AND
         L    R3,0(R3)                    FOR ANY GREATER SPACE NEEDS
         SR   R2,R3                       EACH 6K OF STORAGE USES 1
LOOKR2   EQU  *                           TRACK TO ALLOW OVERHEAD.
         LR   R3,R2
         XR   R2,R2
         C    R3,=F'6000'               LESS THAN 6K?
         BNH  TRACKS2                   YES, ALLOCATE 4 TRACKS.
*
         D    R2,=F'6000'               DIVIDE TOTAL STORAGE
         LA   R3,3(R3)                     USED IN SYSEDIT BY 6000
         ST   R3,DA08PQTY                  TO CALCULATE THE NUMBER
         ST   R3,DA08SQTY                  OF TRACKS NEEDED FOR
         B    SKIPDEF                      SAVE FUNCTION.
TRACKS2  LA   R3,4
         ST   R3,DA08PQTY               STORE QUANTITY INTO
         ST   R3,DA08SQTY                  DAIR BLOCK
SKIPDEF  EQU  *
         LA  R1,DAPL                    LOAD ADD. OF PRIMARY BLOCK
         LINK EP=IKJDAIR                CALL ALLOCATION RTN.
         LTR  R15,R15                   CHECK RETURN CODE
         BZ   WRITEFIL                  OK, WRITE SYSEDIT TO DISK.
         MVI  0(R9),X'80'               NO GOOD...
        L    R10,52(R10)                MOVE MESSAGE TO RESPONSE
        MVC  0(41,R10),SAVEMSG1             FIELD AND
        B    RETURN                               GO BACK TO FSE.
*  THIS SECTION IS USED TO ALLOCATE AN OLD DATA SET
*
OLDDSN   EQU  *
OLDPS    EQU  *
OKOLDPS  MVI  DA08CTL,B'00000000'       * * * * * * * * * * * * * *
         MVC  NEWMEMBE+2(6),=6X'00'     *
         MVC  DA08BLK(4),=4X'00'        * THIS SECTION INITIALIZES
         MVC  DA08PQTY(4),=4X'00'       *
         MVC  DA08SQTY(4),=4X'00'       * D.A.I.R. BLOCKS FOR
         MVC  DA08DQTY(4),=4X'00'       *
         MVC  MEMBER(8),=8C' '          * ALLOCATION OF AN OLD
         MVC  DAIRFLAG(3),=X'080808'    *
         MVC  LIST(8),=8C' '            * PHY. SEQ. DATA SET
         LA    R7,NEWMEMBE              *
         ST    R7,DAPLDAPB              *
BEFORE   LA   R1,DAPL                   * * * * * * * * * * * * * * *
         LINK EP=IKJDAIR
AFTER    LTR  R15,R15                   GOOD RETURN CODE?
         BZ   GETMAIN                   YES, GO WRITE SYSEDIT
         MVI  0(R9),X'80'               NO, MOVE MESSAGE
         L   R10,52(R10)                   TO RESPONSE FIELD
         MVC 0(41,R10),SAVEMSG1                 AND RETURN TO FSE
         B   RETURN
GETMAIN  EQU  *
         MVC  VOLSER(6),CATINFO+6   MOVE SER. # FOR OBTAIN
         OBTAIN VTOC                READ DSCB TYPE 1
CODE15   LTR  R15,R15               DATA SET THERE??
         BZ   TEST1
         B    PDSNOTOK
*
*  THIS SECTION WILL VALIDATE THE CHARACTERISTICS OF THE
*  DATA SET AND DOUBLE CHECK WITH THE SPECIFIED DATA.
*
TEST1    LA   R6,VTOCINFO           INDEX TO DSCB INFO
WHATYPE  TM   DATATYPE,X'01'        PDS?
         BNO  TEST2
         CLC  38(2,R6),=X'0200'      TEST FOR TRUE PDS
         BE   MAINFSE
         MVI  0(R9),X'08'
         L    R10,52(R10)
         MVC  0(44,R10),SAVEMSG5
         B    RETURN
TEST2    CLC  38(2,R6),=X'2000'       DSORG=DA??
         BNE  TEST3
BADDS    MVI  0(R9),X'04'
         L    R10,52(R10)
         MVC  0(45,R10),SAVEMSG7
         B    RETURN
SAVEMSG7 DC   C'INVALID RECFM/DSORG OR LRECL - USE NEW DSNAME'
         DS   0H
TEST3    CLC  38(2,R6),=X'8000'       DSORG=IS??
         BNE  TEST4
         B    BADDS
TEST4    TM   DATATYPE,X'01'           HERE MAKE SURE SPECIFIED
         BO   MAINFSE                  AS PS AND TRUE DSORG IS PS
         CLC  38(2,R6),=X'4000'        PS?
         BE   MAINFSE
         B    PDSNOTOK
         DS   0H
*
MAINFSE  EQU  *
         CLI  VTOCINFO+40,X'C0'          U RECFM??
         BNE  OKRECFM
         B    BADDS
FIXORVAR DS   X
         DS   0H
*
OKRECFM  CLI VTOCINFO+40,X'80'          F?
         BNE FORMAT1
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT1  CLI VTOCINFO+40,X'90'          FB?
         BNE FORMAT2
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT2  CLI VTOCINFO+40,X'40'             V?
         BNE FORMAT3
         MVI FIXORVAR,X'01'
         B   WRITEFIL
FORMAT3  CLI VTOCINFO+40,X'50'             VB?
         BNE FORMAT4
         MVI FIXORVAR,X'01'
         B   WRITEFIL
FORMAT4  CLI VTOCINFO+40,X'54'             VBA?
         BNE FORMAT5
         MVI FIXORVAR,X'01'
         B   WRITEFIL
FORMAT5  CLI VTOCINFO+40,X'84'             FA?
         BNE FORMAT6
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT6  CLI VTOCINFO+40,X'94'             FBA?
         BNE FORMAT7
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT7  CLI VTOCINFO+40,X'82'             FM?
         BNE FORMAT8
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT8  CLI VTOCINFO+40,X'92'             FBM?
         BNE FORMAT9
         MVI FIXORVAR,X'00'
         B   WRITEFIL
FORMAT9  CLI VTOCINFO+40,X'98'             FBS?
         BNE FORMAT0
         MVI FIXORVAR,X'00'
         B   WRITEFIL
* FORMAT IS THEREFORE SOMETHING WEIRD...BYE BYE
FORMAT0  B   BADDS
WRITEFIL EQU *
*
GOODOLD  EQU  *
         CLI  NEWFLAG,X'01'
         BE   OPENDCB
         L    R2,44(R10)
         CLC  FIXORVAR(1),0(R2)     CHECK TYPES
         BE   CHECKLRE
         B    BADDS
CHECKLRE L    R2,32(R10)
         MVC  SAVELREC(2),0(R2)
         CLC  VTOCINFO+44(2),0(R2)    LRECLS THE SAME?
         BE   OPENDCB                 GO WRITE IT OUT
         B    BADDS
NODSNAME L    R2,36(R10)              * * * * * * * * * * * * * * * *
         TM   0(R2),X'01'             *
         BNO  NOPDS1                  *    THIS ROUTINE IS BRANCHED
         MVI  DATATYPE,X'01'          *
         B    SKIPPS                  *    WHENEVER A SAVE WAS DONE
NOPDS1   MVI  DATATYPE,X'00'          *
SKIPPS   L    R2,8(R10)               *    WITH NO DATA SET NAME
         LA   R2,2(R2)                *
         MVC  DSNAME(56),0(R2)        *    SPECIFIED.
         L    R2,12(R10)              *
         MVC  SAVEDSN(55),0(R2)       *    THE ORIGINAL DSNAME IS
         L    R2,36(R10)              *
         TM   0(R2),X'01'             *    MOVED FROM FSE BUFFERS
         BO   OKTYPE                  *
         TM   0(R2),X'80'             *    AND NEW/OLD PS/PDS FLAGS
         BNO  OLDONE                  *
         MVI  NEWFLAG,X'01'           *    FLAGS ARE INITIALIZED.
         B    OKTYPE                  *
OLDONE   MVI  NEWFLAG,X'00'           *
         B    OKTYPE                  *
*                                     * * * * * * * * * * * * * * * *
*
OPENDCB  EQU  *
*        STAE 0
*        STAE ABEND,PURGE=NONE
         B    DOWORK
ABEND    EQU  *   ,WAS STAE 0
         L    R2,TCBADD
         L    R2,17(R2)
         CLC  0(3,R2),=X'B37000'
         BNE  NOTB37
         MVI  0(R9),X'40'
         B    RETURN
NOTB37   CLC  0(3,R2),=X'D37000'
         BNE  NOTD37
         MVI  0(R9),X'40'
         B    RETURN
NOTD37   CLC  0(3,R2),=X'E37000'
         BNE  NOSPACE
         MVI  0(R9),X'40'
         B    RETURN
NOSPACE  MVI  0(R9),X'20'
         B    RETURN
         DS   0F
SAVEPARM  DS   F
          DS   0H
RETURN   L   R10,SAVEPARM
         L    R1,48(R10)
         LINK EP=FSEFREE
         L    R1,48(R10)
         LINK EP=FSEATTR
         L    R13,4(R13)
         LM   14,12,12(R13)
         XR   R15,R15
         BR   R14
*
*
DOWORK   L    R2,16                        SAVE TCB ADDRESS
         L    R2,0(R2)                         OF THIS LOGON.
         L    R2,4(R2)
         ST   R2,TCBADD
         B    SKIPTCB
TCBADD   DS   F
         DS   0H
SKIPTCB  EQU  *
*
         L   R4,56(R10)                       LOAD ADDRESS(DD COUNT)
         L   R3,0(R4)                         LOAD DDNAME COUNT
         CLI  NEWFLAG,X'01'                     TO BE USED IN INDEXING
         BNE  SETOLD                            TO PICK UP NEW DCB.
WHICHDCB EQU  *
         LA   R7,6
         LA   R8,MOVE1
         LA   R6,DCB1                         THIS LOOP WILL USE
DCBLOOP  XR   R4,R4                              THE VALUE IN REG. R3
         IC   R4,0(R6)                           TO GET ADDRESS OF
         CR   R4,R3                              A DCB TO BE USED
         BNE  TRYPLUS1                           IN OPENING FILE.
         ICM  R4,15,0(R6)
         BALR R14,R8
         BC   15,DCBOPEN
TRYPLUS1 LA   R6,4(R6)                        ADD FOR NEXT 4 BYTES
         BCT  R7,DCBLOOP
         ABEND 999                            BAD NEWS...NO DCB????
SETOLD   LA   R7,6
         LA   R6,DCB1
         LA   R8,MOVE2
         B    DCBLOOP
*
*
DCBOPEN  L    R4,56(R10)                 LOAD ADD(DD COUNT)
         L    R3,0(R4)                   LOAD DD COUNT
         C    R3,=F'6'                   MAX REACHED?
         BE   BACKTO1                    YES, GO SET IT BACK
         LA   R3,1(R3)                   NO, BUMP UP BY 1
         B    *+8
BACKTO1  LA   R3,1                       SET IT BACK TO 1
         ST   R3,0(R4)                      AND STORE IT FSE BUFF.
         L    R3,0(R10)                  GET TOPADD
         L    R3,0(R3)
         L    R4,4(R10)                  GET LASTADD
         L    R4,0(R4)
         AH   R4,SAVELREC                ADD LRECL
         SLL  R2,8                       CLEAN UP BYTE
         SRL  R2,8
LOOPSAVE CR   R3,R4                      WRITE OUT RECORDS
         BE   FINISHOK                      UNTIL LASTADD+LRECL
         PUT  (R2),(R3)                     IS REACHED.
         AH   R3,SAVELREC
         B    LOOPSAVE
FINISHOK CLOSE ((R2))                    CLOSE FILE
         MVI  0(R9),X'01'                    AND MOVE SAVED MESSAGE
         L    R10,52(R10)
         MVC  0(9,R10),SAVEMSG6
         MVC  9(43,R10),DSNAME
*
         B    RETURN                     RETURN TO FSE
SAVEMSG6 DC   C'SAVED IN '
         DS   0F
MOVE1    MVC  X'3E'(2,R4),BLKSIZE        THIS ROUTINE IS BAL"ED
         MVC  X'52'(2,R4),LRECL             FOR OPENING A DCB
         MVC  X'24'(1,R4),RECFM             FOR A NEW DATA SET
         LR   R2,R4
         OPEN ((R2),(OUTPUT))
         BR   R14
MOVE2    MVC  X'52'(2,R4),VTOCINFO+44    THIS ROUTINE IS BAL"ED
         MVC  X'3E'(2,R4),VTOCINFO+42       FOR OPENING A DCB
         MVC  X'24'(1,R4),VTOCINFO+40       FOR A NEW DATA SET
         LR   R2,R4
         OPEN ((R2),(OUTPUT))
         BR   R14
         DS 0F
ALLOCDSN DC H'44'
DSNAME   DC   56C' '
         DS   0H
MOVEDSN  MVC  DSNAME(0),0(R5)
SAVEDSN  DC   55C' '
CAT      CAMLST NAME,DSNAME,,CATINFO
CATINFO  DS   0D
         DC   300C' '
VOLSER   DC   6C' '
         DS   0F
VTOC     CAMLST SEARCH,DSNAME,VOLSER,VTOCINFO
VTOCINFO DS   200C
MOVEIN   DS 0H
         MVC  0(0,R3),DSNAME
DATATYPE DC   X'00'
HEXTABLE DC   X'400102030405060708090A0B0C0D0E0F10111213141516171819'
         DC    X'1A1B1C1D1E1F202122232425262728292A2B2C2D2E2F303132'
         DC    X'333435363738393A3B3C3D3E3F404142434445464748494A4B'
         DC    X'4C4D4E4F505152535455565758595A5B5C5D5E5F6061626364'
         DC    X'65666768696A6B6C6D6E6F707172737475767778797A7B7C7D'
         DC    X'7E7F80C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6'
         DC    X'D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9AAABACADAEAF'
         DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7C8'
         DC X'C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1'
         DC X'E2E3E4E5E6E7E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FA'
         DC X'FBFCFDFEFF'
        DS  0F
NEWMEMBE DC X'0008',6X'00'
         DC AL4(ALLOCDSN)
DDNAME   DC C'FSEFIL03'
         DC 16C' '
DA08BLK  DC  4X'00'
DA08PQTY DC 4X'00'
DA08SQTY DC 4X'00'
DA08DQTY DC 4X'00'
MEMBER   DC 8C' '
         DC 8C' '
DAIRFLAG DC 3X'00'
DA08CTL  DC B'00000000'
         DC 3X'00',X'40'
LIST     DC 8C' '
         DS 0F
*
DAPL     EQU *
DAPLUPT  DS F
DAPLECT  DS F
DAPLECB  DC F'0'
DAPLPSCB DS F
DAPLDAPB DS F
  DS 0D
DOUBLE   DS  D
ATTRLIST DC X'0034'       ALLOCATE ATTRLIST
         DC 4X'00'
         DC B'01000000'
         DC X'00'
         DC  C'FSEATTR '
         DC AL4(DAIRACB)
*
         DS  0D
DAIRACB  DC 8X'00'
         DC 6X'00'
         DC X'80'
         DC X'00'
         DC 3X'00'
         DC 3X'00'
         DC 2X'00'
         DC X'10'
         DC X'40'
BUFFLEN  DC H'0'
         DC B'00100000'
         DC 7X'00'
RECFM    DC X'00'
         DC X'80'
BLKSIZE  DC H'00'
LRECL    DC H'0'
         DC X'50'
         DC 4X'00'
         DS  0F
SAVELREC DC  H'0'
FSEDCB1 DCB DDNAME=FSEFIL01,MACRF=PM,DSORG=PS
FSEDCB2 DCB DDNAME=FSEFIL02,MACRF=PM,DSORG=PS
FSEDCB3 DCB DDNAME=FSEFIL03,MACRF=PM,DSORG=PS
FSEDCB4 DCB DDNAME=FSEFIL04,MACRF=PM,DSORG=PS
FSEDCB5 DCB DDNAME=FSEFIL05,MACRF=PM,DSORG=PS
FSEDCB6 DCB DDNAME=FSEFIL06,MACRF=PM,DSORG=PS
*
NEWFLAG DS X
        DS  0F
DCB1 DC  X'01',AL3(FSEDCB1)
DCB2 DC  X'02',AL3(FSEDCB2)
DCB3 DC  X'03',AL3(FSEDCB3)
DCB4 DC  X'04',AL3(FSEDCB4)
DCB5 DC  X'05',AL3(FSEDCB5)
DCB6 DC  X'06',AL3(FSEDCB6)
     DS  0F
SAVE DS  18F
   END
./ ADD NAME=FSESYSCD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*    THIS ROUTINE IS LINKED FROM MAIN DRIVER "FSE" WHEN AN ABEND
*    CONDITION OCCURRED (FROM ROUTINE "TOPABEND" ).
*    TWO ADDRESSES ARE PASSED: A) IN REG. R5 THE ADDRESS OF THE
*    SDWA FIELD WHERE THE ABEND CODE IS SAVED (AT +5)
*    B) IN REG. R6 THE ADDRESS OF THE RESPONSE FIELD OF "FSE"
*    WHERE THE MESSAGE REPORTING THE ABEND IS MOVED.
*
*    THE ROUTINE CAN BE EXPANDED TO CHECK FOR USER ABENDS (AT SDWA +6)
*    IF USER-WRITTEN PROGRAMS ARE INVOKED EXPLICITLY IN THE COMMAND
*    FIELD OF "FSE".
*    THIS VERSION ONLY CHECKS AND REPORTS SYSTEM ABENDS.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSESYSCD CSECT
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         STM  14,12,12(13)  SAVE REGISTERS
         LR   12,15
         USING FSESYSCD,12      AND
         ST   13,SAVE+4
         LA   8,SAVE                 SET
         ST   8,8(R13)
         LR   R13,R8                     ADDRESSABILITY
*
*  R5 = ADDRESS(SDWA - ABEND RETRY RTN)
*  R6 = ADDRESS(RESPONSE FIELD)
*
         LA   R8,SYSCODE1      R8 WILL HAVE THE ADDRESS OF
         XR   R9,R9            THE CHARACTER WHERE THE EBCDIC
         CLC  5(3,R5),=X'806000'  COMMAND NOT FOUND?
         BNE  CHECKPA1            NO, CHECK FOR S0C4 FROM PA1
S806     MVC  0(17,R6),=C'COMMAND NOT FOUND'
         B    RETURN
CHECKPA1 CLC  5(3,R5),=X'0C4000'  S0C4 FROM PA1 INTERRUPT?
         BNE  ELSE                NO, GO FIND CODE
         MVC  0(50,R6),=50C' '    YES, CLEAR RESPONSE FIELD
         MVC  0(35,R6),PA1MSG
         B    RETURN
ELSE     IC   R9,5(R5)         ABEND DIGIT WILL BE MOVED.
         SRL  R9,4             R5 POINTS TO THE SDWA AREA FIELD
         BAL  R10,CHANGE       WHERE THE ABEND CODE IS STORED.
         LA   R8,SYSCODE2      R9 IS USED AS CARRIER OF THE VALUE
         XR   R9,R9            OF EACH 4BITS OF ABEND CODE TO
         IC   R9,5(R5)         COMMON ROUTINE "CHANGE".
         SLL  R9,28
         SRL  R9,28
         BAL  R10,CHANGE
         LA   R8,SYSCODE3
         XR   R9,R9
         IC   R9,6(R5)
         SRL  R9,4
         BAL  R10,CHANGE
         MVC  0(17,R6),ABENDMSG
RETURN   L    R13,4(R13)
         LM   R14,R12,12(R13)
         BR   R14
*
ABENDMSG DC   C'SYSTEM ABEND S'
SYSCODE1 DS   C
SYSCODE2 DS   C
SYSCODE3 DS   C
PA1MSG   DC   C'PLEASE DO NOT USE PA1 INTERRUPT KEY'
         DS   0F
SAVE     DS   18F
DOUBLE   DS   D
*
         DS   0H
CHANGE   CH   R9,=H'9'          THIS ROUTINE WILL CONVERT
         BH   HIGHER            EACH 4 BIT VALUE OF THE ABEND
         CVD  R9,DOUBLE         CODE STORED IN R9 TO A DIGIT
         UNPK 0(1,R8),DOUBLE(8) WHICH WILL BE MOVED IN THE
         OI   0(R8),X'F0'       RESPONSE FIELD OF "FSE".
         BR   R10
HIGHER   CH   R9,=H'10'
         BNE  B
         MVI  0(R8),C'A'
         BR   R10
B        CH   R9,=H'11'
         BNE  C
         MVI  0(R8),C'B'
         BR   R10
C        CH   R9,=H'12'
         BNE  D
         MVI  0(R8),C'C'
         BR   R10
D        CH   R9,=H'13'
         BNE  E
         MVI  0(R8),C'D'
         BR   R10
E        CH   R9,=H'14'
         BNE  F
         MVI  0(R8),C'E'
         BR   R10
F        MVI  0(R8),C'F'
         BR   R10
*
*
         END
./ ADD NAME=FSETSO
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*   THIS ROUTINE IS LINKED FROM MAIN DRIVER "FSE" WHEN A COMMAND
*   WAS ENTERED THAT WAS FOUND TO BE A NON-FSE SUBCOMMAND.
*   THE FIELD WHERE THE COMMAND WAS ENTERED IS SCANNED FOR VALIDITY
*   AND IF A VALID COMMAND NAME WAS ENTERED, A LINK IS ISSUED
*   FOR IT.  S806 ABENDS WILL BE PROCESSED BY THE "ABEND01" CSECT
*   IN "FSE" IF A NON-FOUND CONDITION IS TRUE.
*
*   AT ENTRY R7 POINTS TO THE FIELD WHERE THE COMMAND WAS ISSUED,
*   AND R8 POINTS TO C.P.P.L. LIST WHICH IS PASSED TO THE COMMAND
*   TO BE INVOKED VIA R1.
*
*   WHEN CONTROL IS RETURNED FROM THE LINKED -SUBCOMMAND- , THE
*   SCREEN IS CLEARED  AND A TGET IS ISSUED TO ALLOW USER TO
*   RETURN TO "FSE" BY PRESSING ENTER.
*
*   BRUNO LA LICATA         LVL 1.00     11 / 11 / 77
*   N.B.N.A.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FSETSO   CSECT
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
*
         STM  R14,R12,12(R13)     SAVE
         LR   R12,R15
         USING FSETSO,12              REGISTERS
         ST   R13,SAVE+4
         LA   R5,SAVE                       AND SET
         ST   R5,8(R13)
         LR   R13,R5                               ADDRESSABILITY
         MVC COMMAND(76),=76C' '      CLEAR COMMAND NAME
         MVC LINKEP(8),COMMAND        CLEAR MODULE NAME
*
*  R7 =ADDRESS(INPUT LINE AT START OF COMMAND)
*  R8 =ADDRESS(CPPL)
*
         TCLEARQ OUTPUT                   CLEAR OUT Q
         TPUT    CLEAR,8,FULLSCR,,HOLD     CLEAR SCREEN
*
         LR   R9,R7     SAVE BEGINNING ADDR.
         LA   R10,76    MAX SCAN LENGTH
         XR   R4,R4
TSOLOOP1 CLI  0(R7),C' '                  SCAN FOR
         BE   CHECKLEN                      END
         LA   R7,1(R7)                         OF
         LA   R4,1(R4)                           COMMAND
         BCT  R10,TSOLOOP1                           NAME
CHECKLEN C    R4,=F'8'                 LENGTH LARGER THAN MAX?
         BNH  LENGTHOK                 NO, OK
         TPUT LENGTHMS,20              YES, ISSUE MESSAGE
         B    RETURN                        AND RETURN TO FSE
LENGTHOK BCTR R4,0                     MOVE
         EX   R4,MOVENAME                  COMMAND
         B    *+10                             NAME
MOVENAME MVC  LINKEP(0),0(R9)                     TO AREA
         LA   R4,1(R4)                 LOAD BACK FOR THE EX BCTR
         STH  R4,COMMLEN               SAVE LENGTH
         XR   R4,R4
TSOLOOP2 CLC  0(5,R7),=5C' '           SCAN FOR END OF PARM
         BE   NOSECOND                 IF SO, SKIP PROCESSING
         CLI  0(R7),C' '               BYPASS
         BNE  READPARM                    BLANKS
         LA   R7,1(R7)                       FOR A
         LA   R4,1(R4)                         LENGTH
         BCT  R10,TSOLOOP2                         OF < 5
NOSECOND MVC  BLANKLEN(2),=H'0'        ONLY COMMAND NAME SPECIFIED
         MVC  SUBPARML(2),BLANKLEN     SAVE LENGTHS OF ZEROES
         B    COMPUTE                  GO MAKE UP FAKE C.B.
READPARM STH  R4,BLANKLEN              SAVE LENGTH OF MIDDLE BLANKS
         XR   R4,R4
TSOLOOP3 CLC  0(5,R7),=5C' '           END OF PARMS?
         BE   ENDOFPRM                 YES
         LA   R7,1(R7)                 NO, KEEP LOOKING
         LA   R4,1(R4)                     AND ADDING
         BCT  R10,TSOLOOP3
ENDOFPRM STH  R4,SUBPARML              THIS SECTION WILL USE
COMPUTE  LH   R4,COMMLEN               THE  LENGTHS OF 1)COMMAND
         AH   R4,BLANKLEN              NAME 2)BLANKS FROM END OF
         STH  R4,PARMOFFS              COMMAND NAME TO START OF
         AH   R4,SUBPARML              SUBPARAMETERS IN ORDER TO
         LA   R4,4(R4)                 MOVE THE LENGTHS IN A FAKE
         STH  R4,TOTLEN                COMMAND BUFFER TO BE USED
         SH   R4,=H'4'                 IN PASSING C.P.P.L. VALUES
         BCTR R4,0                     TO PROGRAM.
         EX   R4,MOVEALL
         B    *+10
MOVEALL  MVC  COMMAND(0),0(R9)         MOVE FIELDS IN FAKE C.B.
         LM   R2,R5,0(R8)              STORE ALL C.P.P.L. VALUES
         STM  R2,R5,CB                 EXCEPT C.B.
         LA   R2,FAKECB                USE FAKE ONE
         ST   R2,CB                       TO STORE IT AS
         LA   R1,CPPL                         PARMS IN R1
         LINK EPLOC=LINKEP             LINK MODULE
         TPUT PROMPT,28
         TCLEARQ INPUT                 WAIT FOR USER TO PRESS
         TGET COMMAND,1                ENTER TO RETURN BACK
*
*
RETURN   L    R13,4(R13)               TO "FSE".
         LM   R14,R12,12(R13)
         BR   R14
PROMPT   DC   C'PRESS ENTER TO RETURN TO FSE'
         DS   0F
SAVE     DS   18F
CLEAR    DC   X'C11140403C404000'
FAKECB   DS   0F
TOTLEN   DS   H
PARMOFFS DS   H
COMMAND  DC   76C' '
         DS   0H
COMMLEN  DS   H
BLANKLEN DS   H
SUBPARML DS   H
LINKEP   DC   8C' '
LENGTHMS DC   C'INVALID COMMAND NAME'
CPPL     DS   0F
CB       DS   F
UPT      DS   F
PSCB     DS   F
ECT      DS   F
*
         END
./ ADD NAME=IGC0024H
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*   THIS SVC (248 TYPE 4) IS USED IN F.S.E. EDITOR TO
*    A) GIVE ISSUING CODE KEY ZERO SUPERVISOR MODE ABILITY
*       IN ORDER FOR "FSEPRTY" MODULE TO EXECUTE
*    B) WITH ENTRY REGISTER 1 =X'FFFFFFFF' TO EXECUTE
*       TCAM REPOSITIONING CODE TO BYPASS CURSOR JUMPING.
*       NOTE: IT IS ONLY ISSUED FOR THE LATTER FUNCTION
*       IN A NON-MVS ENVIRONMENT.(SEE REASONS IN PROLOGUE
*       IN MODULE "FSE")
*
*    THIS SVC (248) IS A TYPE 4 DISABLED.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
R0       EQU  0
R1       EQU  1
R2       EQU  2
R3       EQU  3
R4       EQU  4
R5       EQU  5
R6       EQU  6
R7       EQU  7
R8       EQU  8
R9       EQU  9
R10      EQU  10
R11      EQU  11
R12      EQU  12
R13      EQU  13
R14      EQU  14
R15      EQU  15
IGC0024H CSECT
         ENTRY IGC0024H
         BALR  R6,0                   SET BASE REGISTER
         USING *,R6                   AND TELL ASSEMBLER
         C     R1,FF                  TCAM FLAG?
         BE    TCAMCODE               YES, GO EXECUTE
         STC   R0,0(R15)              NO, ZAP JSCB
         BC    15,RETURN              RETURN TO ISSUER
TCAMCODE L     5,16                   A(CVT)
         L     5,0(5)                 A(OLD/NEW TCB)
         L     5,4(5)                 A(MYTCB)
         L     5,180(5)               A(MY JSCB)
         MVC   TJID(2),268(5)         SAVE TJID
         L     R2,16                  ADD(CVT)
         L     R2,X'F0'(R2)           ADD(ADD(TCAM AVT))
         L     R2,0(R2)               ADD(TCAM AVT)
         ICM   R2,15,424(R2)          ADD(TERMNAME TABLE)
         LH    R3,44(R2)              NUMBER OF TERMINALS GENNED IN MCP
         LA    R4,82(R2)              POINT TO OFFSET FOR ENTRIES: EACH
         XR    R5,R5                    ENTRY HAS NAME + ADDRESS OF QCB
         IC    R5,40(R2)              LENGTH OF EACH TERMINAL NAME
LOOP     LR    R7,R4                  SAVE BEGGINNING ADDRESS
         AR    R7,R5                  ADD THE LENGTH OF NAME
         BCTR  R7,0                   SUBTRACT FOR 4 BYTE LOAD
         L     R7,0(R7)               ADD(TERMINAL TABLE ENTRY)
         L     R7,0(R7)               ADD(DESTINATION QCB FOR CRT)
         CLC   30(2,R7),TJID          CHECK TO SEE IF THIS IS RIGTH
         BNE   GETNEXT                  TERMINAL BY MATCHING TJID"S
*                                     NO, GO GET NEXT DEST. QCB
         TPUT  CLEARSCR,8,FULLSCR,,HOLD  YES, CLEAR SCREEN
         MVI   21(R7),X'00'           MOVE 0 TO CARRIAGE COUNT BYTE
         BC    15,RETURN              GOOD WORK..RETURN TO BASE...
*
GETNEXT  AR    R4,R5                  ADD TERMINAL NAME LENGTH
         LA    R4,3(R4)               ADD 3 BYTES FOR QCB ADDRESS
         BCT   R3,LOOP                GO SCAN AGAIN FOR NEXT QCB
*
RETURN   BR    R14                    RETURN TO SVC ISSUER
*
CLEARSCR DC   X'C11140403C404000'     THIS IS DC FOR SCRREN CLEAR
TJID     DS   H
ID       DC   7C' '
         DS   0F
FF       DC   X'FFFFFFFF'
*
         END  IGC0024H
./ ADD NAME=INSTALL
 PLEASE READ THIS INSTALLATION DOCUMENTATION CAREFULLY BEFORE DOING
  ANYTHING.
 THESE ARE THE STEPS TO BE FOLLOWED IN INSTALLING THIS 3270-II FULL
  SCREEN EDITOR ON YOUR SYSTEM. (THIS SOFTWARE WILL WORK WITH OPERATING
  SYSTEMS FROM MVT TO MVS...BUT KEEP IN MIND THE DEPENDENCIES DESCRIBED
  BELOW).

 1)  FSE HAS ONE MODULE THAT IS OPTIONAL AND ONLY USED IF RUNNING
     MVS. NO CONCERN SHOULD BE MADE ABOUT THIS, SINCE THE CODE WILL
     HANDLE IT, BUT TWO CONSIDERATIONS SHOULD BE NOTED:
     "FSE" WILL FIND OUT IF THE OPERATING SYSTEM IS DRIVEN BY MVS..
     IF SO, IT WILL OS/LINK MODULE "FSEPRTY" TO ALTER THE DISPATCHING
     PRIORITY OF THE ADDRESS SPACE FROM DEFAULT TO 240 AND TAKE IT
     OUT OF APG. THIS IS DONE TO GIVE SECOND AND THIRD IPS INTERVALS
     SUPER RESPONSE BACK AT THE TUBE.
     ONE CONSIDERATION IS THE VALUE OF THIS NEW DISPATCHING PRTY OF
     240 WITH YOUR JOB : KEEP IT THIS HIGH IN AN ENVIRONMENT
     WITH A LOT OF CPU HOGS IN THE SYSTEM AND LITTLE OR MEDIUM
     I/O UTILIZATION, DECREASE DOWN TO 200 FOR MEDIUM CPU AND HIGH
     I/O UTILIZATIONS. (THIS WAS MONITORED BY "RMF" AND "RESOLVE"
     FIND HAPPY MEDIUM WITHOUT LOSING TSO RESPONSE UNDER FSE).
  *  THE OTHER CONSIDERATION IS ONLY THINKABLE IF YOU HAVE A LOTTA
     MEGS ON YOUR CPU TO HANDLE THE EXTRA PAGING IT WILL RESULT IN.
     IF YOU SO CHOOSE, YOU CAN AUTOMATICALLY MAKE YOUR ADDRESS
     SPACE NON-SWAPPABLE AND THE BACK SWAPPABLE UPON ENTERING
     AND LEAVING THE FSE SESSION. THIS WILL RESULT IN IMPROVED
     RESPONSE TIME AND CERTAINLY QUICKER EDITS.
  *  KEEP IN MIND IT DEPENDS ON YOUR STORAGE CONSTRAINS AND JOB-MIX
     TO GIVE YOU AN INITIAL IDEA, YOU SHOULD USE IT WITH MACHINE
     RUNNING 10 BATCH, 5 STARTED TASKS, 10-20 TSO USERS ON FOUR
     MEGABYTES.
  *  BOTH THE NEW PRIORITY AND THE SWAPPABILITY OPTIONS ARE HARDCODED
     IN MODULE "FSE", LOADED ON REGISTER 2 JUST BEFORE ISSUING
     AN OS/LINK TO "FSEPRTY"  ----  LINK  EP=FSEPRTY -----
     THERE ARE ONLY TWO PLACES IN THE SOURCE OF "FSE"  WHERE THIS
     MODULE IS LINKED, THEREFORE IT SHOULD BE NO PROBLEM FINDING IT.
     THE FIRST TIME IT IS CALLED WITH REG 2 =X'800000F0' WHICH MEANS
     A) HIGH BIT ON = NONSWAPPABLE
     B) NEW PRIORITY OF 240
     THE SECOND TIME IT IS CALLED WITH REG 2 =F'126' WHICH MEANS
     A) HIGH BIT OFF = SWAPPABLE AS USUAL
     B) NORMAL PRIORITY OF 126

  *  MAKE THE NECESSARY CHANGES ACCORDING TO YOUR SYSTEM.

2)  ASSEMBLE & LINK MODULES FSEATTR,FSECHANG,FSEFREE,FSEPRTY,
                            FSESAVE,FSESYSCD,FSETSO
    INTO ANY UNAUTHORIZED LINKLIST DATA SET (OR STEPLIBED TO IN
    LOGON PROC)  NONREENTRANT, NONREUSABLE AS STANDALONE MODULES.

2A) ASSEMBLE & LINK FSEPFKEY ANYWHERE.

2B) ASSEMBLE AND LINK FSE INTO A LINKLIST DATA SET AND LINK IT WITH
    PREVIOUSLY ASSEMBLED-LINKED MODULE FSEPFKEY, NORENT, NOREUS.

****** ESSENTIALLY, THE FINAL PRODUCT IS A MAIN MODULE "FSE" WITH ****
****** A SUBROUTINE LINKED IN IT, AND SEVEN (7) SEPARATE MODULES  ****
****** IN THE LINKLIST DATA SET.                                  ****

2C) COPY MEMBER "FSEHELP" INTO "SYS1.HELP(FSE)" TO HAVE THE HELP
   COMMAND AVAILABLE.

3) MODULES "FSE" AND "FSESAVE" ARE INSTALLATION DEPENDENT FOR THE
   "SUBMIT" SUBCOMMAND. "FSESAVE" PERFORMS BOTH THE "SAVE" AND THE
   "SUBMIT" FUNCTIONS. IF IT IS A SUBMIT, IT FORCES AN ALLOCATION
   ON A PREDESCRIBED SCRATCH PACK THAT SHOULD BE INITIALIZED TO
   YOUR INSTALLATION CONFIGURATION. UPON RETURN TO "FSE" THE
   TEMPORARY DATA SET ALLOCATED BY FORCE ON A SCRATCH PACK IS
   DELETED, AGAIN BY A VOLSER HARDCODED IN THE SOURCE. THIS IS
   TO PREVENT TOO MUCH ACCESS BY FSE ON MULTI-TSOPACK CONFIGURATIONS.

   JUST HARDCODE A VOLSER ON THE PARM LIST OF THE SCRATCH MACRO
   (THE ONLY ONE) IN MODULE "FSE" AND IN THE HOUSECLEANING
   BEGGINNING SECTION OF MODULE "FSESAVE". (THE VALUE IN THE VANILLA
   CODE IS "IMG038")

3A) THIS FULLSCREEN EDITOR IS ACCESS METHOD INDEPENDENT (TGET/TPUT),
   BUT A FEATURE HAS BEEN INCORPORATED TO EASE THE OPERATION
   UNDER TCAM TO BYPASS THE JUMPING OF THE CURSOR TO THE NEXT
   LINE UPON ISSUING A TGET (AN OLD PAIN IN THE REAR).
   MODULE  "FSE" WILL SEE IF YOU ARE RUNNING VTAM; IF SO IT KEEPS
   GOING NORMALLY. IF YOU ARE RUNNING TCAM WITH OPERATING SYSTEMS
   OTHER THAN MVS, THE CODE WILL ISSUE A TYPE 4 SVC, NAMELY
   248 (IGC0024H) TO REPOSITION THE TCAM TERMINAL QCB CURSOR TO (0,0)
   SO AS TO ALLOW FOREIGN MESSAGES AS OPERATOR OR JOB-END NOTIFYS
   TO DISPLAY ON THE "UNUSED" TOP LINE OF THE SCREEN WITHOUT
   LOSING IT.
   THIS SVC IS ALSO USED BY MODULE "FSEPRTY" FOR KEY ZERO SERVICE,
   THEREFORE BOTH VTAM AND TCAM USERS SHOULD ASSEMBLE AND LINK
   IGC0024H (OR YOUR OWN NUMBER) INTO SYS1.LPALIB. REMEMBER TO ALSO
   CHANGE THE SVC NUMBER TO YOUR OWN AROUND LABEL "READSCR" IN
   MODULE "FSE" AND AT BEGGINNING SECTION IN MODULE "FSEPRTY"
   (IF YOU NEED TO), AND TO IPL SYSTEM WITH CLPA.

4) WITH TCAM, MAKE SURE THE CUTOFF MACRO IN THE INHDR PART OF THE
    TSO MESSAGE HANDLER IS 2100 OR GREATER (ALSO IN NCP IF USED)
   WITH VTAM USE ENOUGH BUFFERS AND BUFSIZE TO ACCOMMODATE 2100 BYTES
   TO SKIP ANY CHAINING THAT CAN SLOW YOU DOWN.

5) MODIFY "SYS1.PARMLIB(IKJPRMXX)" UNDER TCAM OR
   "SYS1.PARMLIB(TSOKEY00)" TO ALLOW FULL SCREEN SUPPORT BY
   INCREASING OWAITHI AND INLOCKHI TO 24 ELSE FSE WILL NOT BE
   ABLE TO READ OR WRITE FULL SCREENS OF DATA.
   ALSO (MVT,SVS) MAKE SURE YOUR TSO REGIONS SIZE IN IKJPRMXX
   IS LARGE ENOUGH FOR REQUIRED GETMAINS...(REGSIZE=600K
   IS TYPICAL FOR PROGRAM SIZES OF 5000 LINES LRECL 80).

6) REMEBER, FSE WAS DESIGNED AND WRITTEN TO DRAW CIRCLES AROUND
   OTHER MANUFACTURER"S FULL SCREEN EDITORS IN PERFORMANCE.
   BE SURE ALL THOSE DETAILS ABOVE ARE FOLLOWED TO GAIN 100%
   OF ITS CAPABILITIES.

   ANY QUESTIONS OR PROBLEMS FEEL FREE TO CALL ME (BRUNO LALICATA)
   AT CITIBANK IN DOWNTOWN NEW YORK AT (212) 558-7262.

./ ADD NAME=BE
         MACRO
&NAME    BE    &LOC
&NAME    BC    8,&LOC
         MEXIT
         MEND
./ ADD NAME=BER
         MACRO
&NAME    BER   &LOC
&NAME    BCR   8,&LOC
         MEXIT
         MEND
./ ADD NAME=BZ
         MACRO
&NAME    BZ    &LOC
&NAME    BC    8,&LOC
         MEXIT
         MEND
./ ADD NAME=BZR
         MACRO
&NAME    BZR   &LOC
&NAME    BCR   8,&LOC
         MEXIT
         MEND
/*
//DELETE  EXEC PGM=IDCAMS
//SYSPRINT DD  SYSOUT=*
//SYSIN    DD  *
 DELETE SYS1.PROCLIB(FSEASML) NONVSAM
 SET LASTCC = 0
 SET MAXCC = 0
//FSEASM  EXEC PGM=IEBUPDTE,REGION=512K,PARM=NEW
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DISP=SHR,DSN=SYS1.PROCLIB
//SYSIN    DD  DATA
./ ADD NAME=FSEASML
//FSEASML PROC MEMBER=MISSING
//ASM     EXEC PGM=IEUASM,
//             REGION=4096K,
//             PARM='NODECK,LOAD,TERM'
//SYSTERM  DD  SYSOUT=*
//SYSPRINT DD  SYSOUT=*
//SYSPUNCH DD  SYSOUT=B
//SYSLIB   DD  DISP=SHR,DSN=JES2.FSE.ASM,DCB=BLKSIZE=32720
//         DD  DISP=SHR,DSN=SYS1.MACLIB
//         DD  DISP=SHR,DSN=SYS1.AMODGEN
//SYSUT1   DD  UNIT=VIO,SPACE=(CYL,(10,10))
//SYSUT2   DD  UNIT=VIO,SPACE=(CYL,(10,10))
//SYSUT3   DD  UNIT=VIO,SPACE=(CYL,(10,10))
//SYSIN    DD  DISP=SHR,DSN=JES2.FSE.ASM(&MEMBER)
//SYSGO    DD  DISP=(NEW,PASS),
//             UNIT=VIO,
//             SPACE=(CYL,(10,10)),
//             DCB=(LRECL=80,BLKSIZE=3120,RECFM=FB)
//LINK    EXEC PGM=IEWL,
//             REGION=512K,
//             PARM='LIST,MAP,NORENT,NOREUS',
//             COND=(4,LT,ASM)
//SYSUT1   DD  UNIT=VIO,SPACE=(CYL,(1,1))
//SYSLIB   DD  DISP=SHR,DSN=SYS2.CMDLIB
//SYSLIN   DD  DISP=(OLD,DELETE),DSN=*.ASM.SYSGO
//         DD  DDNAME=SYSIN
//SYSLMOD  DD  DISP=SHR,DSN=SYS2.CMDLIB(&MEMBER)
//SYSPRINT DD  SYSOUT=*
/*
