* $$ JOB JNM=VSEDIT,CLASS=0                                             00000001
* $$ LST CLASS=P                                                        00000002
// JOB VSEDIT           VSEDIT - MAIN PROGRAM                           00000003
// OPTION LOG,CATAL,NOXREF                                              00000004
// EXEC LIBR,PARM='MSHP;ACC S=PRD2.BTAM'                                00000005
   CATAL VSEDIT.A       REP=YES                                         00000006
         PUNCH ' PHASE VSEDIT,* '                                       00000007
         PRINT NOGEN                                                    00000008
* --------------------------------------------------------------------* 00000009
* Based on the sample for local 3270 (SAMP327L) from the BTAM library.* 00000010
*                                                                     * 00000011
* VSEDIT is a full-screen editor for IBM 3270 non-SNA terminals, it   * 00000012
* allows you read members from a VSE sublibrary or VSE/ICCF library,  * 00000013
* modify the data, and save it into a VSE sublibrary.                 * 00000014
*                                                                     * 00000015
* VSEDIT don't require CICS, VTAM or POWER runing, it needs only a    * 00000016
* non-SNA terminal (may use the VSE console) and the BG prompt.       * 00000017
*                                                                     * 00000018
* If POWER is available, allows you read queue entries and Submit     * 00000019
* batch Jobs for execution.                                           * 00000020
*                                                                     * 00000021
* The only special requirement is the BTAM library components, this   * 00000022
* can be found into a backup tape of VSE 2.3 or previous version.     * 00000023
*                                                                     * 00000024
* Installation:                                                       * 00000025
*                                                                     * 00000026
* Catalog VSEICCF, subrout. to read members from VSE/ICCF libraries.  * 00000027
* Catalog VSEPWRS, subrout. to GET/SUB POWER queue entries.           * 00000028
* Catalog VSELIBRM, subrout. to read/write members from VSE sublibary.* 00000029
* Catalog $SBA, macro used by VSEDIT.                                 * 00000030
* Catalog VSEDIT (this program).                                      * 00000031
* Catalog VSE$HEL.Z (VSEDIT Help ), catalog into IJSYSRS.SYSLIB.      * 00000032
* Catalog VSEDIT.PROC, proc. to invoke VSEDIT from the VSE console.   * 00000033
*                                                                     * 00000034
* In order to allow the VSEDIT use to the authorized personnel only:  * 00000035
*                                                                     * 00000036
*     USER-ID........ ________  (only SYSPROG is valid)               * 00000037
*     PASSWORD.......           (PASSWORD)                            * 00000038
*                                                                     * 00000039
* Gustavo Torres                 clgtorres@gmail.com                  * 00000040
* --------------------------------------------------------------------* 00000041
VSEDIT   START X'78'                                                    00000042
* --------------------------------------------------------------------  00000043
*        REGISTER EQUATES                                               00000044
* --------------------------------------------------------------------  00000045
R0       EQU   0                                                        00000046
R1       EQU   1                                                        00000047
R2       EQU   2                   WORK REGISTER                        00000048
R3       EQU   3                   WORK REGISTER                        00000049
R4       EQU   4                   WORK REGISTER                        00000050
MSGADDR  EQU   4                   ADDR OF OUTPUT MESSAGE               00000051
R5       EQU   5                   LENGTH OF OUTPUT MESSAGE             00000052
R6       EQU   6                                                        00000053
RLNREG   EQU   6                   RELATIVE LINE NUMBER                 00000054
R7       EQU   7                                                        00000055
DTFREG   EQU   7                   DTFBT ADDRESS                        00000056
R8       EQU   8                                                        00000057
R9       EQU   9                   DYNAMIC WORK AREAS                   00000058
BASEREG  EQU   10                  FIRST BASE REG                       00000059
BASEREG2 EQU   11                  SECOND BASE REG                      00000060
BASEREG3 EQU   12                  THIRD BASE REG                       00000061
R13      EQU   13                  SAVE AREA FOR THIS TASK              00000062
R14      EQU   14                                                       00000063
R15      EQU   15                                                       00000064
*                                                                       00000065
BASE     BALR  BASEREG,0           ESTABLISH                            00000066
         USING *,BASEREG,BASEREG2,BASEREG3   ADDRESSABILITY             00000067
         LA    BASEREG2,2048(BASEREG)  INITIALIZE                       00000068
         LA    BASEREG2,2048(BASEREG2)       SECOND BASE                00000069
         LA    BASEREG3,2048(BASEREG2) INITIALIZE                       00000070
         LA    BASEREG3,2048(BASEREG3)       THIRD BASE                 00000071
         LA    R13,SAVEAREA        SAVE AREA FOR THIS TASK              00000072
         STXIT AB,ABEXIT,ABSAVE    ESTABLISH AB EXIT ROUTINE            00000073
         STXIT PC,PCEXIT,ABSAVE    ESTABLISH PC EXIT ROUTINE            00000074
* --------------------------------------------------------------------  00000075
*        OBTAIN DYNAMIC WORK AREAS FROM GETVIS                          00000076
* --------------------------------------------------------------------  00000077
GETVIS   EQU   *                                                        00000078
         L     R0,=F'737600'       BUFFER STORAGE (9220 * 80)           00000079
*                                         1000 LINES  (EDITOR STACK)    00000080
*                                  5000 + 3000 LINES  (WORK1, WORK2)    00000081
*                                       +  220 LINES  (HELP)            00000082
         A     R0,=A(LENPARMS*3)        +              CONTROL AREAS    00000083
*                                                                       00000084
         GETVIS ADDRESS=(1),LENGTH=(0)                                  00000085
*                                                                       00000086
         LTR   R15,R15             GETVIS RC ZERO ?                     00000087
         LA    R8,ABNORMAL                                              00000088
         BNZ   CNSLMSG             NOT ZERO, WRITE MESSAGE & EXIT       00000089
*                                                                       00000090
         ST    R1,STACK            STACK ADDRESS                        00000091
         ST    R1,NEXSTACK                                              00000092
         A     R1,=F'80000'        1000 LINES OFFSET                    00000093
*                                                                       00000094
         USING WORKA,R9                                                 00000095
         LR    R9,R1               ADDRESSING WORK1                     00000096
         ST    R1,WORK1            WORK1 ADDRESS                        00000097
         LA    R1,BUFFER           GET BUFFER ADDRESS                   00000098
         ST    R1,PBUFADR          SAVE IT                              00000099
         A     R1,=F'400000'       5000 LINES OFFSET                    00000100
         ST    R1,PENDBUF          SAVE END BUFFER                      00000101
         MVC   RECLEN,=H'80'       REC LENGTH DEFAULT                   00000102
*                                                                       00000103
         LR    R9,R1               ADDRESSING WORK2                     00000104
         ST    R1,WORK2            WORK2 ADDRESS                        00000105
         LA    R1,BUFFER           GET BUFFER ADDRESS                   00000106
         ST    R1,PBUFADR          SAVE IT                              00000107
         A     R1,=F'240000'       3000 LINES OFFSET                    00000108
         ST    R1,PENDBUF          SAVE END BUFFER                      00000109
         MVC   RECLEN,=H'80'       REC LENGTH DEFAULT                   00000110
*                                                                       00000111
         LR    R9,R1               ADDRESSING HELP                      00000112
         ST    R1,HELP             HELP ADDRESS                         00000113
         LA    R1,BUFFER           GET  BUFFER ADDRESS                  00000114
         ST    R1,PBUFADR          SAVE IT                              00000115
         A     R1,=F'17600'        220 LINES OFFSET                     00000116
         ST    R1,PENDBUF          SAVE END BUFFER                      00000117
         L     R9,WORK1            SWITCH TO WORK1                      00000118
* --------------------------------------------------------------------  00000119
         OPEN  DTFBTL              OPEN LINE GROUP                      00000120
*                                                                       00000121
LOGON    EQU   *                                                        00000122
         LA    MSGADDR,LOGONMG     ADDR OF LOGON MSG                    00000123
         LA    R5,LOGONMGL         LENGTH OF MSG                        00000124
         ST    R5,MSGLEN           SAVE MSGLEN                          00000125
         MVI   LOGONSW,C'1'                                             00000126
         B     WRITE                                                    00000127
*                                                                       00000128
BEGSCR   EQU   *                                                        00000129
         MVC   MSG,SCALE                                                00000130
         NOP   *+14                BEGIN MSG ONLY FIRST TIME            00000131
         OI    *-3,X'F0'                                                00000132
         MVC   MSG(L'BEGMSG),BEGMSG                                     00000133
         MVC   LINE1,BLANKS                                             00000134
         MVC   LINE2,BLANKS                                             00000135
         MVC   LINE2(L'EOFMSG),EOFMSG                                   00000136
         LA    R1,1                                                     00000137
         ST    R1,PNORL            NO OF MEMBER RECORDS                 00000138
         MVC   SAVENDBA,PBUFADR    BEGIN WITH ONE LINE                  00000139
         MVC   SAVCURR,PBUFADR                                          00000140
         L     R1,PBUFADR                                               00000141
         MVC   0(80,R1),BLANKS                                          00000142
         LA    R5,TWO1SZ           TWO LINES                            00000143
         ST    R5,MSGLEN           SAVE MSGLEN                          00000144
*                                                                       00000145
FMT01A   EQU   *                                                        00000146
         MVI   WCC,ALARM           ALARM=YES                            00000147
FMT01    EQU   *                                                        00000148
         CLI   MEMBER+1,X'00'      MEMBER IN PROCESS ?                  00000149
         BE    *+10                NO,                                  00000150
         MVC   MSG+57(10),MEMBER   YES, SHOW IT                         00000151
         MVI   MSG+75,C'1'         SCREEN (1)                           00000152
         C     R9,WORK1            WORK1 CURRENT ?                      00000153
         BE    *+8                 YES,                                 00000154
         MVI   MSG+75,C'2'         NO, SCREEN (2)                       00000155
         LA    MSGADDR,FORMAT1     ADDR OF FORMAT1 MESSAGE              00000156
WRITE    BAL   R8,WRITETS          GO WRITE SCREEN                      00000157
         BAL   R8,RETCODE          CHECK RETURN CODE                    00000158
         BAL   R8,WAITD            WAIT FOR COMPLETION                  00000159
         MVI   WCC,NOALARM                                              00000160
         MVC   CMD,BLANKS                                               00000161
         MVC   MSG,SCALE                                                00000162
         MVC   SBAIC+1(2),=X'40C6' FORCE INSERT CURSOR AT 1,7           00000163
*                                                                       00000164
READ     EQU   *                                                        00000165
         LA    R1,10                                                    00000166
         LA    R2,IOAREA                                                00000167
XCIPT    XC    0(200,R2),0(R2)     CLEAR INPUT AREA                     00000168
         LA    R2,200(R2)                                               00000169
         BCT   R1,XCIPT                                                 00000170
*                                                                       00000171
GOREAD   EQU   *                                                        00000172
         BAL   R8,READTI           GO READ A DISPLAY (READTI/TB)        00000173
         BAL   R8,RETCODE          CHECK RETURN CODE                    00000174
         BAL   R8,WAITD            WAIT FOR COMPLETION                  00000175
         CLI   INAID,NOAID         GOT ANY DATA ?                       00000176
         BE    READ                NO, IGNORE AND GO READ               00000177
         CLI   INAID,PA1           PA1                                  00000178
         BE    READ                YES, IGNORE AND GO READ              00000179
         CLI   INAID,PA2           PA2                                  00000180
         BE    READ                YES, IGNORE AND GO READ              00000181
         CLI   INAID,PA3           PA3                                  00000182
         BE    READ                YES, IGNORE AND GO READ              00000183
         CLI   HELPSW,C'1'         HELP IS ACTIVE ?                     00000184
         BE    HELPINT             YES, CHECK HELP KEYS                 00000185
         CLI   LOGONSW,C'1'        LOGON SCREEN ?                       00000186
         BE    CHKLOGON            YES, CHECK LOGON                     00000187
         CLI   INAID,CLEAR         CLEAR KEY                            00000188
         BE    FMT01               YES, GO REDISPLAY                    00000189
*                                                                       00000190
         BAL   R8,FMTINAR          FORMAT INAREA FROM IOAREA            00000191
         BAL   R8,UPDATES          UPDATE CHANGED DATA                  00000192
         BAL   R8,EDITORL          EDITOR LINE COMMANDS                 00000193
*                                                                       00000194
         CLI   INAID,ENTER         ENTER KEY INTERRUPT                  00000195
         BE    ENTERINT            YES, GO CHECK COMMAND                00000196
         CLI   INAID,PF1           PF1                                  00000197
         BE    PF1INT              YES, GO HELP CMD                     00000198
         CLI   INAID,PF2           PF2                                  00000199
         BE    PF2INT              YES, GO RECALL CMD                   00000200
         CLI   INAID,PF3           PF3                                  00000201
         BE    PF3INT              YES, GO DEACTIVATE TERMINAL          00000202
         CLI   INAID,PF4           PF4                                  00000203
         BE    PF4INT              YES, GO SWITCH LOGICAL SCREEN        00000204
         CLI   INAID,PF5           PF5                                  00000205
         BE    PF5INT              YES, GO UP 5 LINES                   00000206
         CLI   INAID,PF6           PF6                                  00000207
         BE    PF6INT              YES, REPEAT THE PREVIOUS COMMAND     00000208
         CLI   INAID,PF7           PF7                                  00000209
         BE    PF7INT              YES, GO BACK                         00000210
         CLI   INAID,PF8           PF8                                  00000211
         BE    PF8INT              YES, GO FORWARD                      00000212
         CLI   INAID,PF9           PF9                                  00000213
         BE    PF9INT              YES, GO TOP                          00000214
         CLI   INAID,PF10          PF10                                 00000215
         BE    PF10INT             YES, GO VIEW 1 72                    00000216
         CLI   INAID,PF11          PF11                                 00000217
         BE    PF11INT             YES, GO VIEW 9 80                    00000218
         CLI   INAID,PF12          PF12                                 00000219
         BE    PF12INT             YES, GO BOTTOM                       00000220
         MVC   MSG(L'PFKERRM),PFKERRM   NO, PFKEY NOT DEFINED           00000221
         B     FMT01A                                                   00000222
* ------------------------------------------------------------------    00000223
ENTERINT EQU   *                                                        00000224
         OC    INCMD,BLANKS        FORCE UPPER CASE                     00000225
         CLC   INCMD(4),BLANKS                                          00000226
         BE    ENTERIN1            GO DOWN ONE LINE                     00000227
*                                                                       00000228
         CLC   RECALL+225,INCMD    NEW CMD CHANGED ?                    00000229
         BE    *+16                     NO,                             00000230
         MVC   RECALL(225),RECALL+45    YES, SHIFT PREV COMMANDS        00000231
         MVC   RECALL+225,INCMD    SAVE NEW CMD                         00000232
         NI    PF2NOP+1,X'0F'      FORCE NOP                            00000233
*                                                                       00000234
         CLC   INCMD(4),=C'GET '   GET COMMAND ?                        00000235
         BE    GETCMD                                                   00000236
         CLC   INCMD(4),=C'PUT '   PUT COMMAND ?                        00000237
         BE    PUTCMD                                                   00000238
         CLC   INCMD(3),=C'SUB'    SUBMIT COMMAND ?                     00000239
         BE    SUBCMD                                                   00000240
         CLC   INCMD(3),=C'LIB'    LIB COMMAND ?                        00000241
         BE    LIBCMD                                                   00000242
         CLI   INCMD,C'L'          LOC COMMAND ?                        00000243
         BE    LOCCMD                                                   00000244
         CLI   INCMD,C'C'          CHA COMMAND ?                        00000245
         BE    CHACMD                                                   00000246
         CLI   INCMD,C'T'          TOP COMMAND ?                        00000247
         BE    PF9INT                                                   00000248
         CLI   INCMD,C'B'          BOT COMMAND ?                        00000249
         BE    PF12INT                                                  00000250
         CLI   INCMD,C'U'          UP  COMMAND ?                        00000251
         BE    UPCMD                                                    00000252
         CLC   INCMD(4),=C'HELP'   HELP COMMAND ?                       00000253
         BE    PF1INT                                                   00000254
         CLC   INCMD(3),=C'REN'    RENUM COMMAND ?                      00000255
         BE    RENCMD                                                   00000256
         CLC   INCMD(3),=C'VIE'    VIEW COMMAND ?                       00000257
         BE    VIECMD                                                   00000258
         MVC   MSG(L'INVCMD),INVCMD                                     00000259
         B     FMT01A                                                   00000260
*                                                                       00000261
ENTERIN1 EQU   *                   DOWN ONE LINE COMMAND                00000262
         L     R1,SAVCURR          LOAD CURRENT REC ADDRESS             00000263
         LTR   R1,R1               SOME ADDRESS ?                       00000264
         BZ    BEGSCR              NO                                   00000265
         LTR   R4,R4               WAS DATA CHANGED ?                   00000266
         BNZ   DSPLY               YES, NO DOWN LINE                    00000267
         AH    R1,RECLEN           NO, INDEX                            00000268
         B     DSPLY               NEXT RECORD                          00000269
* ------------------------------------------------------------------    00000270
PF1INT   EQU   *                   HELP COMMAND                         00000271
         ST    R9,SAVER9           SAVE WORK AREA ADDR                  00000272
         L     R9,HELP             LOAD HELP AREA ADDR                  00000273
NOPHELP  NOP   GOHELP              GET VSE$HEL.Z ONLY FIRST TIME        00000274
         MVC   PFUNC,=C'GET '      FUNCTION                             00000275
         MVC   PLIB,=C'IJSYSRS'    LIBRARY NAME                         00000276
         MVC   PSLIB,=C'SYSLIB  '  SUBLIB NAME                          00000277
         MVC   PMEMB,=C'VSE$HEL '  MEMBER NAME                          00000278
         MVC   PMEMT,=CL8'Z'       MEMBER TYPE                          00000279
*                                                                       00000280
         LA    R1,LIBPARMS                                              00000281
         ST    R1,PARMLIST                                              00000282
         LA    R1,PARMLIST                                              00000283
         CALL  VSELIBRM (LIBPARMS)  GET VSE$HEL.Z FROM IJSYSRS.SYSLIB   00000284
*                                                                       00000285
         CLC   PRETCOD,=C'000'            GET MEMBER OK ?               00000286
         BE    HELPOK                                                   00000287
         MVC   MSG(L'HELPERRM),HELPERRM   NO, ERROR MSG                 00000288
         L     R9,SAVER9           RESTORE WORK AREA ADDR               00000289
         B     FMT01A                                                   00000290
*                                                                       00000291
HELPOK   EQU   *                                                        00000292
         OI    NOPHELP+1,X'F0'                                          00000293
         L     R1,PBUFADR          MEMBER BUFFER ADDRESS                00000294
         L     R3,PNORL            NO OF MEMBER RECORDS                 00000295
         BCTR  R3,0                -1                                   00000296
         MH    R3,=H'80'           80 BYTES/RECORD                      00000297
         AR    R3,R1               R3 = LAST RECORD ADDRESS             00000298
         ST    R3,SAVENDBA         SAVE IT                              00000299
GOHELP   EQU   *                                                        00000300
         MVI   HELPSW,C'1'         HELP IS ACTIVE                       00000301
         L     R1,PBUFADR          MEMBER BUFFER ADDRESS                00000302
         SH    R1,=H'6'                                                 00000303
         MVC   0(6,R1),BUFCTL      MOVE WCC, SBA, SF PROT,NORM          00000304
         ST    R1,HELPBEG          SAVE HELP BEG SCREEN ADDR            00000305
         ST    R1,SAVCURR          SAVE CURRENT REC ADDRESS             00000306
         LR    MSGADDR,R1          ADDR OF HELP MESSAGE                 00000307
         LA    R5,HELPMSGL                                              00000308
         ST    R5,MSGLEN           SAVE MSGLEN                          00000309
         B     WRITE               DISPLAY FIRST HELP SCREEN            00000310
HELPINT  EQU   *                   CHECK HELP KEYS                      00000311
         CLI   INAID,PF3           PF3 KEY ?                            00000312
         BE    HELPEND             YES, END HELP                        00000313
         CLI   INAID,PF7           PF7 KEY ?                            00000314
         BE    HELPREV             YES, GO BACK                         00000315
         L     R1,SAVCURR          NO,                                  00000316
         LA    R1,22*80(R1)           ASSUME NEXT PAGE                  00000317
         C     R1,SAVENDBA         END OF HELP AREA ?                   00000318
         BH    HELPEND             YES                                  00000319
         ST    R1,SAVCURR          SAVE CURRENT REC ADDRESS             00000320
         MVC   0(6,R1),BUFCTL      MOVE WCC, SBA, SF PROT,NORM          00000321
         LR    MSGADDR,R1          ADDR OF HELP MESSAGE                 00000322
         B     WRITE                                                    00000323
HELPREV  L     R1,SAVCURR          LOAD CURRENT REC ADDRESS             00000324
         S     R1,=A(22*80)        PREVIOUS PAGE                        00000325
         C     R1,HELPBEG          WAS THE FIRST PAGE ?                 00000326
         BL    HELPEND             YES                                  00000327
         ST    R1,SAVCURR          SAVE CURRENT REC ADDRESS             00000328
         LR    MSGADDR,R1          ADDR OF HELP MESSAGE                 00000329
         B     WRITE                                                    00000330
HELPEND  EQU   *                   EXIT HELP SCREEN                     00000331
         MVI   HELPSW,C'0'         HELP NOT ACTIVE                      00000332
         L     R9,SAVER9           RESTORE WORK AREA ADDR               00000333
         B     ENTERIN1            GO REDISPLAY ORIGINAL SCREEN         00000334
* ------------------------------------------------------------------    00000335
PF2INT   EQU   *                   RECALL COMMAND                       00000336
PF2NOP   NOP   PREVCMD                                                  00000337
         OI    PF2NOP+1,X'F0'      FORCE BR TO NEXT PF2                 00000338
LASTCMD  LA    R1,RECALL+225       POINT LO LAST COMMAND                00000339
PF2GO    MVC   CMD(45),0(R1)       SHOW IT                              00000340
         ST    R1,RECLADDR         SAVE ADDR OF SHOWED CMD              00000341
         LA    R4,1                                                     00000342
         B     ENTERIN1            REDISPLAY DATA                       00000343
*                                                                       00000344
PREVCMD  EQU   *                                                        00000345
         L     R1,RECLADDR         GET ADDR OF SHOWED CMD               00000346
         SH    R1,=H'45'           INDEX PREVIOUS                       00000347
         CLC   0(45,R1),BLANKS     ANY DATA ?                           00000348
         BE    LASTCMD             NO, SHOW LAST AGAIN                  00000349
         C     R1,=A(RECALL)       LIST END ?                           00000350
         BNL   PF2GO               NO, SHOW PREVIOUS                    00000351
         B     LASTCMD             YES, SHOW LAST AGAIN                 00000352
* ------------------------------------------------------------------    00000353
PF3INT   EQU   *                   QUIT COMMAND                         00000354
         SR    RLNREG,RLNREG       CLEAR RLN REG                        00000355
         L     DTFREG,VDTF         ADDRESS THE DTFBT                    00000356
         CHGNTRY DTFBTL,ATTLST,(RLNREG),SKIP                            00000357
         LA    MSGADDR,CLOSEMG     ADDR OF CLOSE MSG                    00000358
         LA    R5,CLOSEMGL         LENGTH OF MSG                        00000359
         ST    R5,MSGLEN           SAVE MSGLEN                          00000360
         BAL   R8,WRITETS          GO WRITE ENDING MSG                  00000361
         BAL   R8,RETCODE          CHECK RETURN CODE                    00000362
         BAL   R8,WAITD            WAIT FOR COMPLETION                  00000363
         B     CLOSE                                                    00000364
* ------------------------------------------------------------------    00000365
PF4INT   EQU   *                   SWITCH LOGICAL SCREEN                00000366
         C     R9,WORK1            WORK1 CURRENT ?                      00000367
         BE    SETW2               YES, SW TO WORK2                     00000368
         L     R9,WORK1            NO,  SW TO WORK1                     00000369
         LA    R4,1                                                     00000370
         B     ENTERIN1                                                 00000371
SETW2    L     R9,WORK2                                                 00000372
         LA    R4,1                                                     00000373
         B     ENTERIN1            GO REDISPLAY                         00000374
* ------------------------------------------------------------------    00000375
PF5INT   EQU   *                   UP 5 LINES                           00000376
         LH    R2,RECLEN                                                00000377
         MH    R2,=H'5'                                                 00000378
         B     BACK                                                     00000379
* ------------------------------------------------------------------    00000380
PF6INT   EQU   *                   REPEAT THE PREVIOUS COMMAND          00000381
         MVC   INCMD(45),RECALL+225    RESTORE PREV CMD                 00000382
         CLC   INCMD(2),=C'L '     LOCATE ?                             00000383
         BE    LOCCMD                                                   00000384
         CLI   INCMD,C'U'          UP ?                                 00000385
         BE    UPCMD                                                    00000386
         B     ENTERIN1            GO REDISPLAY                         00000387
* ------------------------------------------------------------------    00000388
PF7INT   EQU   *                   BACK COMMAND                         00000389
         LH    R2,RECLEN                                                00000390
         MH    R2,=H'22'                                                00000391
         CLC   SAVCURR,SAVENDBA    WE POINT TO LAST RECORD ?            00000392
         BNE   BACK                NO,                                  00000393
         SH    R2,RECLEN           YES, BACK 21 LINES ONLY              00000394
BACK     EQU   *                                                        00000395
         L     R1,SAVCURR          LOAD CURRENT REC ADDRESS             00000396
         LTR   R1,R1               SOME ADDRESS ?                       00000397
         BZ    FMT01               NO                                   00000398
         SR    R1,R2               BACK NN LINES                        00000399
         C     R1,PBUFADR          POINTER OK ?                         00000400
         BNL   DSPLY               YES                                  00000401
         L     R1,PBUFADR          LOAD BEGIN BUFFER ADDRESS            00000402
         MVC   MSG(24),TOPMSG                                           00000403
         MVI   WCC,ALARM                                                00000404
         B     DSPLY               FIRST RECORD                         00000405
* ------------------------------------------------------------------    00000406
PF8INT   EQU   *                   FORWARD COMMAND                      00000407
         L     R1,SAVNEXTB         LOAD NEXT REC ADDRESS                00000408
         LTR   R1,R1               SOME ADDRESS ?                       00000409
         BZ    FMT01               NO                                   00000410
         B     DSPLY               NEXT RECORD                          00000411
* ------------------------------------------------------------------    00000412
PF9INT   EQU   *                   TOP COMMAND                          00000413
         L     R1,PBUFADR          LOAD BEGIN BUFFER ADDRESS            00000414
         L     R2,PNORL            NO OF MEMBER RECORDS                 00000415
         LTR   R2,R2               SOMETHING HERE ?                     00000416
         BZ    FMT01               NO                                   00000417
         MVC   MSG(24),TOPMSG                                           00000418
         B     DSPLY               NEXT RECORD                          00000419
* ------------------------------------------------------------------    00000420
PF10INT  EQU   *                   VIEW 1 72 COMMAND                    00000421
         L     R1,SAVCURR          LOAD CURRENT REC ADDRESS             00000422
         LTR   R1,R1               SOME ADDRESS ?                       00000423
         BZ    FMT01               NO                                   00000424
         XC    VIEW,VIEW           VIEW MEMBER DISPLAY AT COLUMN 1      00000425
         B     DSPLY               NEXT RECORD                          00000426
* ------------------------------------------------------------------    00000427
PF11INT  EQU   *                   VIEW 9 80 COMMAND                    00000428
         L     R1,SAVCURR          LOAD CURRENT REC ADDRESS             00000429
         LTR   R1,R1               SOME ADDRESS ?                       00000430
         BZ    FMT01               NO                                   00000431
         MVC   VIEW,=H'8'          VIEW MEMBER DISPLAY AT COLUMN 9      00000432
         CLC   RECLEN,=H'80'       RECORD OF 80 BYTES ?                 00000433
         BE    DSPLY               YES, NEXT RECORD                     00000434
         MVC   VIEW,=H'60'         NO,  COLUMN 61                       00000435
         B     DSPLY               NEXT RECORD                          00000436
* ------------------------------------------------------------------    00000437
PF12INT  EQU   *                   BOTTOM COMMAND                       00000438
         L     R1,SAVENDBA         LOAD LAST RECORD ADDRESSS            00000439
         LTR   R1,R1               SOME ADDRESS ?                       00000440
         BZ    FMT01               NO                                   00000441
         B     DSPLY               NEXT RECORD                          00000442
* --------------------------------------------------------------------- 00000443
UPDATES  EQU   *                   UPDATE CHANGED DATA                  00000444
         SR    R4,R4               CLEAR R4                             00000445
         LA    R1,INLINA           INDATA BUFFER                        00000446
         L     R2,SAVCURR          CURRENT REC ADDRESS                  00000447
         LTR   R2,R2               SOME DATA HERE ?                     00000448
         BZR   R8                  NO, RETURN                           00000449
         LA    R3,22                                                    00000450
CHKMDT   TM    0(R1),X'01'         MDT ON ?                             00000451
         BNO   NEXTUPD             NO                                   00000452
         LA    R4,1(R4)            CHANGES COUNT +1                     00000453
         MVI   PRINTABL,X'40'      TRANSLATE X'00' TO X'40'             00000454
         TR    1(72,R1),PRINTABL   TRANSLATE X'01-3F' TO X'E1'          00000455
         MVI   PRINTABL,X'E1'      TRANSLATE X'00' TO X'E1'             00000456
         LR    R5,R2               RECORD ADDRESS                       00000457
         AH    R5,VIEW             ADD SHIFT                            00000458
         LA    R6,80                                                    00000459
         SH    R6,VIEW                                                  00000460
         BCTR  R6,0                                                     00000461
         STC   R6,*+5              SET MOVE LENGTH                      00000462
         MVC   0(00,R5),1(R1)      UPDATE MEMBER                        00000463
NEXTUPD  EQU   *                                                        00000464
         LA    R1,80(R1)           NEXT INPUT LINE                      00000465
         AH    R2,RECLEN           NEXT MEMBER LINE                     00000466
         C     R2,SAVENDBA         END OF MEMBER BUFFER ?               00000467
         BHR   R8                  YES, RETURN                          00000468
         BCT   R3,CHKMDT                                                00000469
         BR    R8                  RETURN                               00000470
* --------------------------------------------------------------------- 00000471
EDITORL  EQU   *                   EDITOR LINE COMMANDS (PASS 1)        00000472
         LA    R1,INEDIA           INDATA BUFFER                        00000473
         L     R2,SAVCURR          CURRENT REC ADDRESS                  00000474
         LTR   R2,R2               SOME DATA HERE ?                     00000475
         BZR   R8                  NO, RETURN                           00000476
         OC    1(6,R1),BLANKS      FORCE UPPER CASE                     00000477
         XC    SAVINPA,SAVINPA     CLEAR LAST INPUT LINE ADR PENDING    00000478
         MVI   STACKSW,C'0'        SETOF STACK SW                       00000479
EDLMDT   TM    0(R1),X'01'         MDT ON ?                             00000480
         BNO   NEXTEDL             NO                                   00000481
         OC    1(6,R1),BLANKS      FORCE EDITOR LINE AREA TO UPPER CASE 00000482
         LA    R4,1(R4)            CHANGES COUNT +1                     00000483
         BAL   R6,EDLPROC          REARRANGE EDITOR LINE CMD AREA       00000484
*                                  R3 = LINES TO COPY, MOVE, ETC        00000485
CHKSLA   EQU   *                                                        00000486
         ST    R3,SAVLINES         SAVE LINES TO ADD                    00000487
         CLI   1(R1),C'/'          SET LINE POINTER CMD ?               00000488
         BNE   CHKCOPY             NO                                   00000489
         ST    R2,SAVCURR          YES, SET CURRENT REC ADDRESS         00000490
         NI    0(R1),X'FE'         SETOFF MDT                           00000491
         B     NEXTEDL                                                  00000492
CHKCOPY  CLI   1(R1),C'C'          COPY (C) LINE CMD ?                  00000493
         BNE   CHKKOPY             NO                                   00000494
         L     R5,NEXSTACK         YES, ADDR OF NEXT STACK ENTRY        00000495
         CLI   STACKSW,C'1'        STACK SW ON ?                        00000496
         BE    OFFMDT              YES, NEXT STACK ENTRY                00000497
         MVI   STACKSW,C'1'        NO, SETON STACK SW                   00000498
         L     R5,STACK            POINT TO BEGIN OF STACK AREA         00000499
OFFMDT   NI    0(R1),X'FE'         SETOFF MDT                           00000500
MOVSTK   LR    R4,R2               R4 = ADDR OF RECORD TO STACK         00000501
MOVSTKN  C     R5,WORK1            END OF STACK AREA ?                  00000502
         BL    MOVSTKOK                   NO,                           00000503
         MVC   MSG(L'STKFULLM),STKFULLM   YES, STACK EDITOR IS FULL     00000504
         MVI   WCC,ALARM           ALARM=YES                            00000505
         BR    R8                  EXIT                                 00000506
MOVSTKOK EQU   *                                                        00000507
         LR    R6,R4                                                    00000508
         CLC   RECLEN,=H'80'       80 BYTES RECORDS ?                   00000509
         BE    *+8                 YES,                                 00000510
         AH    R6,VIEW             NO, USE VIEW TO OFFSET INPUT         00000511
         MVC   0(80,R5),0(R6)      MOVE RECORD TO STACK                 00000512
         LA    R5,80(R5)           POINT TO NEXT STACK ENTRY            00000513
         ST    R5,NEXSTACK         SAVE IT                              00000514
         AH    R4,RECLEN           NEXT LINE TO STACK                   00000515
         C     R4,SAVENDBA         END OF BUFFER ?                      00000516
         BH    NEXTEDL             YES                                  00000517
         BCT   R3,MOVSTKN          NO, LOOP                             00000518
         B     NEXTEDL                                                  00000519
CHKKOPY  CLI   1(R1),C'K'          COPY (K) LINE CMD ?                  00000520
         BNE   CHKMOVE             NO                                   00000521
         L     R5,NEXSTACK         YES, ADDR OF NEXT STACK ENTRY        00000522
         B     OFFMDT                                                   00000523
CHKMOVE  CLI   1(R1),C'M'          MOVE (M) LINE CMD ?                  00000524
         BNE   SAVEDL              NO, SAVE ADDR OF LINE                00000525
         L     R5,NEXSTACK         YES, ADDR OF NEXT STACK ENTRY        00000526
         CLI   STACKSW,C'1'        STACK SW ON ?                        00000527
         BE    CHGCMD              YES, NEXT STACK ENTRY                00000528
         MVI   STACKSW,C'1'        NO, SETON STACK SW                   00000529
         L     R5,STACK            POINT TO BEGIN OF STACK AREA         00000530
CHGCMD   MVI   1(R1),C'D'          CHANGE TO (D) LINE CMD               00000531
         ST    R1,SAVINPA          SAVE INPUT LINE ADR (PENDING CMD)    00000532
         ST    R2,SAVRECA          SAVE BUFFER LINE ADR                 00000533
         B     MOVSTK                                                   00000534
SAVEDL   ST    R1,SAVINPA          SAVE INPUT LINE ADR (PENDING CMD)    00000535
         ST    R2,SAVRECA          SAVE BUFFER LINE ADR                 00000536
NEXTEDL  EQU   *                                                        00000537
         LA    R1,80(R1)           NEXT INPUT LINE                      00000538
         AH    R2,RECLEN           NEXT MEMBER LINE                     00000539
         C     R2,SAVENDBA         END OF MEMBER BUFFER ?               00000540
         BH    EDITORL2            YES, GO PASS 2                       00000541
         C     R1,=A(INEND)        NO,  END OF INAREA ?                 00000542
         BNH   EDLMDT                   NO                              00000543
* --------------------------------------------------------------------- 00000544
EDITORL2 EQU   *                   EDITOR LINE COMMANDS (PASS 2)        00000545
         CLC   RECLEN,=H'80'       80 BYTES RECORDS ?                   00000546
         BNER  R8                  NO, RETURN                           00000547
         L     R1,SAVINPA          LAST INPUT  LINE ADR PENDING         00000548
         LTR   R1,R1               PENDING CMD ?                        00000549
         BZR   R8                  NO, RETURN                           00000550
         L     R2,SAVRECA          LAST BUFFER LINE ADR PENDING         00000551
PREVMDT  TM    0(R1),X'01'         MDT ON ?                             00000552
         BNO   PREVEDL             NO                                   00000553
         PACK  DBL,2(5,R1)         CONVERT (nnn)                        00000554
         CVB   R3,DBL                           TO BINARY               00000555
CHKADD   CLI   1(R1),C'A'          ADD (A) LINE CMD ?                   00000556
         BNE   CHKDUP              NO                                   00000557
         MVC   TEMP,BLANKS         YES, ADD BLANK LINE                  00000558
         MVI   ADDSW,C'1'          SETON ADDSW                          00000559
ADDCMD   BAL   R6,OFFSET           OFFSET NN LINES                      00000560
         LA    R4,80(R2)           R4 = LOCATION TO NEW LINES           00000561
ADDLINE  MVC   0(80,R4),TEMP       ADD BLANK OR DUP LINE                00000562
         LA    R4,80(R4)           NEXT LINE                            00000563
         L     R5,PNORL            NO.LINES IN BUFFER                   00000564
         LA    R5,1(R5)            INDEX                                00000565
         ST    R5,PNORL            SAVE IT                              00000566
         L     R5,SAVENDBA                                              00000567
         LA    R5,80(R5)           INDEX END BUFFER ADDR                00000568
         ST    R5,SAVENDBA         SAVE IT                              00000569
         BCT   R3,ADDLINE          LOOP                                 00000570
         B     PREVEDL                                                  00000571
CHKDUP   CLI   1(R1),C'"'          DUP (") LINE CMD ?                   00000572
         BNE   CHKINS              NO                                   00000573
         MVC   TEMP,0(R2)          YES, ADD DUPLICATE                   00000574
         B     ADDCMD              GO ADD                               00000575
CHKINS   CLI   1(R1),C'I'          INS (I) LINE CMD ?                   00000576
         BNE   CHKDEL              NO                                   00000577
         CLC   STACK,NEXSTACK      YES, SOMETHING IN STACK ?            00000578
         BE    PREVEDL                  NO                              00000579
         L     R5,NEXSTACK         NEXT STACK ENTRY                     00000580
         S     R5,STACK            - STACK BEGIN                        00000581
         SR    R4,R4                                                    00000582
         D     R4,=F'80'           R5 = NO. LINES IN STACK              00000583
         LR    R3,R5               R5 => R3                             00000584
         BAL   R6,OFFSET           OFFSET NN LINES                      00000585
         L     R6,STACK            FIRST STACK ENTRY                    00000586
         LA    R4,80(R2)           R4 = LOCATION TO NEW LINES           00000587
ADDSTK   MVC   0(80,R4),0(R6)      ADD LINE FROM STACK                  00000588
         LA    R6,80(R6)           NEXT STACK ENTRY                     00000589
         LA    R4,80(R4)           NEXT BUFFER RECORD                   00000590
         L     R5,PNORL            NO.LINES IN BUFFER                   00000591
         LA    R5,1(R5)            INDEX                                00000592
         ST    R5,PNORL            SAVE IT                              00000593
         L     R5,SAVENDBA                                              00000594
         LA    R5,80(R5)           INDEX END BUFFER ADDR                00000595
         ST    R5,SAVENDBA         SAVE IT                              00000596
         BCT   R3,ADDSTK           LOOP                                 00000597
         B     PREVEDL             YES                                  00000598
CHKDEL   CLI   1(R1),C'D'          DEL (D) LINE CMD ?                   00000599
         BNE   PREVEDL             NO                                   00000600
         C     R2,PBUFADR          IT IS FIRST LINE ?                   00000601
         BNE   DELOK               NO                                   00000602
         C     R3,PNORL            YES, DELETE OF ENTIRE AREA ?         00000603
         BL    DELOK                    NO, GO DEL                      00000604
         MVC   MSG(L'DELERRM),DELERRM                                   00000605
         B     ENTERIN1                                                 00000606
DELOK    ST    R3,SAVLINES         SAVE LINES TO DEL                    00000607
         L     R5,SAVENDBA         END BUFFER ADDR                      00000608
         SR    R5,R2               - CURRENT LINE ADDR                  00000609
         LA    R5,80(R5)           + LAST RECORD                        00000610
         SR    R4,R4                                                    00000611
         D     R4,=F'80'           R5 = NO. REMAINDER LINES             00000612
         CR    R5,R3               R5 > LINES TO DEL ?                  00000613
         BH    MVCLD               YES, DO MVCL                         00000614
         ST    R5,SAVLINES         NO, DECREMENT REMAINDER LINES        00000615
         B     UPDCNT                                                   00000616
MVCLD    LR    R4,R2               MVCL TO ADDR (FIRST LINE TO DEL)     00000617
         MH    R3,=H'80'           BYTES TO DEL (LINES * 80)            00000618
         LA    R6,0(R3,R4)         MVCL FROM ADDR (NN LINES DOWN)       00000619
         L     R5,SAVENDBA         END BUFFER ADDR                      00000620
         SR    R5,R6               - MVCL FROM ADDR                     00000621
         LA    R5,80(R5)           + LAST RECORD                        00000622
         LR    R7,R5               L2 = L1                              00000623
         MVCL  R4,R6               MOVE IT                              00000624
UPDCNT   EQU   *                                                        00000625
         L     R5,PNORL            NO.LINES IN BUFFER                   00000626
         S     R5,SAVLINES         - NN LINES                           00000627
         ST    R5,PNORL            SAVE IT                              00000628
         L     R3,SAVLINES         LINES TO DEL                         00000629
         MH    R3,=H'80'           BYTES TO DEL (LINES * 80)            00000630
         L     R5,SAVENDBA         END BUFFER ADDR                      00000631
         SR    R5,R3               - (LINES * 80)                       00000632
         ST    R5,SAVENDBA         SAVE IT                              00000633
         LA    R4,1(R4)            SETON UPDATE SW                      00000634
         B     PREVEDL                                                  00000635
*                                                                       00000636
OFFSET   EQU   *                   OFFSET NN LINES                      00000637
         ST    R3,SAVLINES         SAVE LINES TO ADD                    00000638
         L     R5,SAVENDBA         END BUFFER ADDR                      00000639
         MH    R3,=H'80'           COMPUTE OFFSET                       00000640
         LA    R4,0(R3,R5)         R4 = NEW LOCATION ADR                00000641
         LA    R4,80(R4)                                                00000642
         C     R4,PENDBUF          REACH END OF BUFFER ?                00000643
         BNH   OFFSETL             NO                                   00000644
         MVC   MSG(L'OVFLMSG),OVFLMSG                                   00000645
         MVI   WCC,ALARM                                                00000646
         B     ENTERIN1                                                 00000647
OFFSETL  EQU   *                                                        00000648
         C     R2,SAVENDBA         LAST MEMBER LINE ?                   00000649
         BE    OFFSEXIT            SI, RETURN                           00000650
OFFSETA  EQU   *                                                        00000651
         LA    R4,0(R3,R5)         R4 = NEW LOCATION ADR                00000652
         MVC   0(80,R4),0(R5)      OFFSET NN LINES                      00000653
         SH    R5,=H'80'           PREV LINE                            00000654
         CR    R5,R2               DONE ?                               00000655
         BNE   OFFSETA             NO, LOOP                             00000656
OFFSEXIT L     R3,SAVLINES         RESTORE LINES TO ADD                 00000657
         BR    R6                  RETURN                               00000658
*                                                                       00000659
PREVEDL  EQU   *                                                        00000660
         SH    R1,=H'80'           PREV INPUT LINE                      00000661
         SH    R2,=H'80'           PREV MEMBER LINE                     00000662
         C     R1,=A(INLINA)       BEG OF INDATA BUFFER ?               00000663
         BNL   PREVMDT             NO,                                  00000664
         BR    R8                  RETURN                               00000665
* --------------------------------------------------------------------- 00000666
EDLPROC  EQU   *                   REARRANGE EDITOR LINE CMD AREA       00000667
         MVC   WEDLIN,BLANKS                                            00000668
         MVI   SWCMD,C'0'          SETOF SW                             00000669
         MVI   SWNUM,C'0'                                               00000670
         ST    R1,EDLMDTA          SAVE EDITOR LINE MDT ADDR            00000671
         LA    R4,6(R1)            END EDITOR LINE POSITION             00000672
         LA    R5,WEDLIN+5         END WORK AREA                        00000673
EDLOOP1  CLI   0(R4),C'*'                                               00000674
         BE    EDLINDX                                                  00000675
         CLI   0(R4),C'='                                               00000676
         BE    EDLINDX                                                  00000677
         CLI   0(R4),C' '                                               00000678
         BE    EDLINDX                                                  00000679
         TM    0(R4),X'F0'         NUMERIC ?                            00000680
         BO    EDLNUM              YES                                  00000681
         LA    R3,TABCMD           VALID COMMANDS LIST                  00000682
EDLOOP2  CLC   0(1,R4),0(R3)       HIT ?                                00000683
         BE    EDLOK               YES                                  00000684
         LA    R3,1(R3)            NO, NEXT                             00000685
         CLI   0(R3),X'FF'         END LIST ?                           00000686
         BNE   EDLOOP2             NO, LOOP                             00000687
         B     EDLERR                                                   00000688
EDLOK    MVC   WEDLIN(1),0(R4)     MOVE CMD TO FIRST POSITION           00000689
         CLI   SWCMD,C'1'          SW ON ?                              00000690
         BE    EDLERR              YES, ERROR                           00000691
         MVI   SWCMD,C'1'          NO, SETON SW                         00000692
EDLINDX  BCTR  R4,0                -1                                   00000693
         C     R4,EDLMDTA          REACH THE MDT ?                      00000694
         BNE   EDLOOP1             NO, LOOP                             00000695
EDLEND   CLC   WEDLIN+1(5),BLANKS  NUMERIC ARE BLANKS ?                 00000696
         BNE   *+8                 NO, CHECK                            00000697
         MVI   WEDLIN+5,C'1'       YES, FORCE 1                         00000698
         OC    WEDLIN+1(5),=5C'0'  FORCE ZONES TO F                     00000699
         CLC   WEDLIN+1(5),=5C'0'  ALL ZEROS ?                          00000700
         BE    EDLERR              YES, ERROR                           00000701
         MVC   1(6,R1),WEDLIN      MOVE WEDLIN TO INAREA BUFFER         00000702
         PACK  DBL,WEDLIN+1(5)     CONVERT                              00000703
         CVB   R3,DBL                     TO BINARY                     00000704
         CH    R3,=H'999'          nnn TIMES > 999 ?                    00000705
         BNHR  R6                  NO, RETURN                           00000706
EDLERR   MVC   MSG(L'EDLERRM),EDLERRM  YES, SEND ERROR                  00000707
         B     ENTERIN1                                                 00000708
EDLNUM   CLI   SWNUM,C'1'          SW ON ?                              00000709
         BE    EDLERR              YES, ERROR                           00000710
         MVI   SWNUM,C'1'          NO, SETON SW                         00000711
EDLOOP3  MVC   0(1,R5),0(R4)       MOVE NUM TO WEDLIN                   00000712
         BCTR  R4,0                - 1                                  00000713
         BCTR  R5,0                - 1                                  00000714
         C     R4,EDLMDTA          REACH THE MDT ?                      00000715
         BE    EDLEND              YES,                                 00000716
         TM    0(R4),X'F0'         NO, NEXT NUMERIC ?                   00000717
         BO    EDLOOP3                 YES, GO MOVE IT                  00000718
         B     EDLOOP1                 NO, LOOP1                        00000719
* --------------------------------------------------------------------- 00000720
GETCMD   EQU   *                   GET COMMAND                          00000721
         XC    VIEW,VIEW                                                00000722
         BAL   R8,GETPARMS         FIND OPERANDS                        00000723
         CLI   GETPWR,C'1'         GET PWR SW ON ?                      00000724
         BE    GETPCMD             YES, GET PWR QUEUE CMD               00000725
         CLI   NUMERIC,C'1'        SUBPARM1 NUMERIC ?                   00000726
         BE    GETICMD             YES, ASSUME GET ICCF MEMBER          00000727
         B     LIBRM               NO,         GET VSE MEMBER           00000728
*                                                                       00000729
PUTCMD   EQU   *                   PUT COMMAND                          00000730
         BAL   R8,GETPARMS         FIND OPERANDS                        00000731
LIBRM    MVC   PFUNC,INCMD         FUNCTION                             00000732
*                                                                       00000733
         LA    R1,LIBPARMS                                              00000734
         ST    R1,PARMLIST                                              00000735
         LA    R1,PARMLIST                                              00000736
         CALL  VSELIBRM (LIBPARMS)  GET/PUT MEMBER                      00000737
*                                                                       00000738
         CLC   PRETCOD,=C'000'     GET/PUT MEMBER OK ?                  00000739
         BNE   GETERR                                                   00000740
         MVC   MEMBER+1(8),PMEMB   MEMBER NAME FOR SCALE                00000741
         CLC   INCMD(4),=C'GET '   GET COMMAND ?                        00000742
         BE    GET80                                                    00000743
         MVC   MSG(L'MEMSAVED),MEMSAVED                                 00000744
         CLC   PMEMT,=CL8'PROC'    MEMBERTYPE PROC ?                    00000745
         BNE   FMT01A              NO                                   00000746
         MVC   MSG+13(12),WITHDATA                                      00000747
         MVC   MSG+23(1),PSYSIPT   YES, MSG "WITH DATA=X"               00000748
         B     FMT01A                                                   00000749
*                                                                       00000750
GETERR   EQU   *                                                        00000751
         MVC   MSG(L'FULLMSG),FULLMSG                                   00000752
         MVI   WCC,ALARM                                                00000753
         CLC   PRETCOD,=C'999'     BUFFER FULL CONDITION ?              00000754
         BE    GET80               YES                                  00000755
         MVC   MSG(L'PMSG),PMSG    NO, DSPLY LIBRM ERROR                00000756
         B     FMT01A                                                   00000757
*                                                                       00000758
GET80    EQU   *                                                        00000759
         MVC   RECLEN,=H'80'                                            00000760
GETOK    EQU   *                                                        00000761
         L     R1,PBUFADR          MEMBER BUFFER ADDRESS                00000762
         L     R3,PNORL            NO OF MEMBER RECORDS                 00000763
         BCTR  R3,0                -1                                   00000764
         MH    R3,RECLEN                                                00000765
         AR    R3,R1               R3 = LAST RECORD ADDRESS             00000766
         ST    R3,SAVENDBA         SAVE IT                              00000767
*                                                                       00000768
DSPLY    EQU   *                                                        00000769
         ST    R1,SAVCURR          SAVE CURRENT REC ADDRESS             00000770
         LA    R2,LINE1                                                 00000771
         LA    R4,22                                                    00000772
         LA    R5,HDR1SZ                                                00000773
*                                                                       00000774
NEXTREC  EQU   *                                                        00000775
         C     R1,SAVENDBA         LAST RECORD ?                        00000776
         BH    EOF                 YES                                  00000777
         LR    R6,R1               RECORD ADDRESS                       00000778
         AH    R6,VIEW             ADD SHIFT                            00000779
         MVC   0(72,R2),BLANKS     CLEAR DSPLY                          00000780
         LH    R7,RECLEN                                                00000781
         SH    R7,VIEW                                                  00000782
         CH    R7,=H'72'                                                00000783
         BNH   *+8                                                      00000784
         LH    R7,=H'72'                                                00000785
         BCTR  R7,0                                                     00000786
         STC   R7,*+5              SET MOVE LENGTH                      00000787
         MVC   0(72,R2),0(R6)      DSPLY RECORD                         00000788
         TR    0(72,R2),PRINTABL   TRANSLATE X'00-3F' TO X'E1'          00000789
         CLI   ADDSW,C'1'          ADD COMMAND INS CURSOR PENDING ?     00000790
         BNE   NEXTRIND            NO                                   00000791
         CLC   0(72,R2),BLANKS     YES, IS BLANK LINE ?                 00000792
         BNE   NEXTRIND            NO                                   00000793
*                                                                       00000794
         MVI   ADDSW,C'0'          SETOFF SW                            00000795
         LA    R6,24                                                    00000796
         SR    R6,R4               R6 = ACTUAL ROW                      00000797
         LA    R7,1                R7 = COLUMN 1                        00000798
         MH    R6,=H'80'                                                00000799
         AR    R7,R6                                                    00000800
         SR    R6,R6                                                    00000801
         D     R6,=F'64'                                                00000802
         STC   R7,SBAIC+1                                               00000803
         STC   R6,SBAIC+2                                               00000804
         TR    SBAIC+1(2),BINTOEBC                                      00000805
*                                                                       00000806
NEXTRIND AH    R1,RECLEN           NEXT RECORD                          00000807
         LA    R2,85(R2)           NEXT DSPLY LINE                      00000808
         LA    R5,85(R5)                                                00000809
         BCT   R4,NEXTREC                                               00000810
         ST    R1,SAVNEXTB         SAVE NEXT REC ADDRESS                00000811
         ST    R5,MSGLEN           SAVE MSGLEN                          00000812
         B     FMT01                                                    00000813
EOF      MVC   0(72,R2),BLANKS                                          00000814
         MVC   0(L'EOFMSG,R2),EOFMSG                                    00000815
         LA    R5,85(R5)                                                00000816
         ST    R5,MSGLEN           SAVE MSGLEN                          00000817
         B     FMT01                                                    00000818
*                                                                       00000819
GETICMD  EQU   *                   GET ICCF MEMBER                      00000820
         MVC   IPARMS,BLANKS                                            00000821
         MVC   IPARMS(8),=C'PUNCH M('    <=== PUNCH M(                  00000822
         MVC   IPARMS+8(4),SUBPARM1                   lll               00000823
         MVC   IPARMS+12(8),SUBPARM2                      mmmmmmmm      00000824
         MVI   IPARMS+20,C')'                                     )     00000825
         MVC   MEMBER+1(8),SUBPARM2  MEMBER NAME FOR SCALE              00000826
*                                                                       00000827
ICCFCMD  EQU   *                                                        00000828
         MVC   IBUFADR,PBUFADR     MOVE BUFFER ADDRESS                  00000829
         MVC   IENDBUF,PENDBUF     MOVE END BUFFER ADDRESS              00000830
*                                                                       00000831
         LA    R1,IPARMS                                                00000832
         ST    R1,PARMLIST                                              00000833
         LA    R1,PARMLIST                                              00000834
         CALL  VSEICCF (IPARMS)    GET ICCF MEMBER                      00000835
*                                                                       00000836
         MVC   PBUFADR,IBUFADR     MOVE BUFFER ADDRESS                  00000837
         MVC   PNORL,INORL         MOVE NO. RECORDS                     00000838
         CLC   IRETCOD,=C'999'     BUFFER FULL CONDITION ?              00000839
         BNE   GET80               NO                                   00000840
         MVC   MSG(L'FULLMSG),FULLMSG                                   00000841
         MVI   WCC,ALARM                                                00000842
         B     GET80                                                    00000843
*                                                                       00000844
GETPCMD  EQU   *                   GET PWR QUEUE COMMAND                00000845
         MVC   PFUNC,INCMD         FUNCTION                             00000846
         LA    R1,LIBPARMS                                              00000847
         ST    R1,PARMLIST                                              00000848
         LA    R1,PARMLIST                                              00000849
*                                                                       00000850
         CALL  VSEPWRS  (LIBPARMS) GET PWR QUEUE ENTRY                  00000851
*                                                                       00000852
         CLC   PRETCOD,=C'000'     GET OK ?                             00000853
         BE    GETPOK                                                   00000854
         CLI   PRETCOD+2,C'9'      BUFFER FULL CONDITION ?              00000855
         BE    GETPFULL            YES,                                 00000856
         CLI   PRETCOD+2,C'4'      JOBNAME NOT FOUND ?                  00000857
         BNE   GETPMSG             NO,                                  00000858
         MVC   MSG(L'JOBNOF),JOBNOF                                     00000859
         B     FMT01A                                                   00000860
GETPFULL MVC   MSG(L'FULLMSG),FULLMSG                                   00000861
         MVI   WCC,ALARM                                                00000862
GETPOK   MVC   MEMBER+1(8),PWRJOB  MEMBER NAME FOR SCALE                00000863
         MVC   RECLEN,=H'80'                                            00000864
         CLC   PWRQUEUE,=C'LST'    LST QUEUE ENTRY ?                    00000865
         BNE   GETOK               NO, ASSUME 80 BYTES RECLEN           00000866
         MVC   RECLEN,=H'132'      YES, 132 BYTES                       00000867
         B     GETOK                                                    00000868
GETPMSG  MVC   MSG(L'PMSG),PMSG                                         00000869
         B     FMT01A                                                   00000870
* --------------------------------------------------------------------- 00000871
SUBCMD   EQU   *                   SUBMIT COMMAND                       00000872
         MVC   PFUNC,INCMD         FUNCTION                             00000873
         LA    R1,LIBPARMS                                              00000874
         ST    R1,PARMLIST                                              00000875
         LA    R1,PARMLIST                                              00000876
*                                                                       00000877
         CALL  VSEPWRS             SUBMIT                               00000878
*                                                                       00000879
         CLC   PRETCOD,=C'000'     SUBMIT OK ?                          00000880
         BE    SUBOK                                                    00000881
         MVC   MSG(L'PMSG),PMSG                                         00000882
         B     FMT01A                                                   00000883
SUBOK    MVC   MSG(L'SUBMITED),SUBMITED                                 00000884
         B     FMT01A                                                   00000885
* --------------------------------------------------------------------- 00000886
LIBCMD   EQU   *                   LIB (ICCF) COMMAND                   00000887
         XC    VIEW,VIEW                                                00000888
         LA    R1,INCMD+4                                               00000889
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00000890
         MVC   IPARMS,BLANKS                                            00000891
         MVC   IPARMS(8),=C'DSERV L('    <=== DSERV L(                  00000892
         MVC   IPARMS+8(4),0(R1)                      lll               00000893
         MVC   IPARMS+12(10),=C' ) SORTED '               ) SORTED      00000894
         MVC   MEMBER+1(4),=C'LIB '                                     00000895
         MVC   MEMBER+5(4),0(R1)   LIB XXX (SCALE)                      00000896
         B     ICCFCMD                                                  00000897
* ------------------------------------------------------------------    00000898
UPCMD    EQU   *                   UP NN LINES                          00000899
         ZAP   UPNN,=P'1'          DEFAULT TO 1                         00000900
         LA    R1,INCMD+2                                               00000901
         CLI   INCMD+1,C' '                                             00000902
         BE    *+8                                                      00000903
         LA    R1,INCMD+3                                               00000904
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00000905
         TM    0(R1),X'F0'         NUMERIC ?                            00000906
         BNO   GOUP                NO, ASSUME 1                         00000907
         PACK  UPNN,0(1,R1)                                             00000908
         TM    1(R1),X'F0'         NUMERIC ?                            00000909
         BNO   GOUP                NO,                                  00000910
         PACK  UPNN,0(2,R1)                                             00000911
GOUP     ZAP   DBL,UPNN                                                 00000912
         CVB   R2,DBL                                                   00000913
         MH    R2,RECLEN                                                00000914
         B     BACK                                                     00000915
* --------------------------------------------------------------------- 00000916
LOCCMD   EQU   *                   LOCATE COMMAND                       00000917
         LA    R1,INCMD+2                                               00000918
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00000919
         LR    R2,R1               R1 = BEGIN OF STRING                 00000920
         MVI   LOCLOOP1+1,C' '     SET "CLI" TO BLANK                   00000921
         CLI   0(R1),C'/'          DELIMITER ?                          00000922
         BNE   LOCLOOP1            NO,                                  00000923
         MVI   LOCLOOP1+1,C'/'     YES, CHANGE "CLI"                    00000924
         LA    R1,1(R1)                 SKIP                            00000925
         LR    R2,R1                         IT                         00000926
LOCLOOP1 CLI   0(R2),C' '                                               00000927
         BE    LOCGO                                                    00000928
         LA    R2,1(R2)                                                 00000929
         C     R2,=A(INCMD+73)     END OF CMD AREA ?                    00000930
         BNE   LOCLOOP1            NO, LOOP                             00000931
         MVC   MSG(L'INVCMD),INVCMD                                     00000932
         B     FMT01A                                                   00000933
LOCGO    SR    R2,R1               R2 = LENGTH OF STRING                00000934
         BCTR  R2,0                -1                                   00000935
         STC   R2,LOCSCAN+1        CHANGE CLC LENGTH                    00000936
         LH    R4,RECLEN           LAST COLUMN                          00000937
         SR    R4,R2               R4 = NN COLUMNS TO SCAN              00000938
         ST    R4,SAVER4           SAVE R4                              00000939
         L     R2,SAVCURR          LOAD CURRENT REC ADDRESS             00000940
         AH    R2,RECLEN           BEGIN WITH LINE 2                    00000941
LOCNEXR  LR    R3,R2                                                    00000942
         L     R4,SAVER4           RESTORE R4                           00000943
LOCSCAN  CLC   0(00,R3),0(R1)      SCAN HIT ?                           00000944
         BE    LOCHIT              YES                                  00000945
         LA    R3,1(R3)            NEXT COLUMN                          00000946
         BCT   R4,LOCSCAN          LOOP                                 00000947
         AH    R2,RECLEN           NEXT RECORD                          00000948
         C     R2,SAVENDBA         END OF MEMBER ?                      00000949
         BNH   LOCNEXR                NO, SCAN NEXT REC                 00000950
         MVC   MSG(L'STRNOF),STRNOF   YES, STRING NO FOUND              00000951
         B     FMT01A                                                   00000952
LOCHIT   ST    R2,SAVCURR          SET CURRENT REC ADDRESS              00000953
         LA    R4,1                                                     00000954
         B     ENTERIN1                                                 00000955
* --------------------------------------------------------------------- 00000956
CHACMD   EQU   *                   CHANGE COMMAND                       00000957
         MVI   CHANOP+1,X'00'                                           00000958
         LA    R1,INCMD+2                                               00000959
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00000960
         CLI   0(R1),C'/'          DELIMITER ?                          00000961
         BNE   CHAERRM             NO, ERROR MSG                        00000962
         LA    R1,1(R1)                                                 00000963
CHABEGIN LR    R2,R1               R1 = BEGIN OF STRING                 00000964
CHALOOP1 CLI   0(R2),C'/'                                               00000965
         BE    CHAGO                                                    00000966
         LA    R2,1(R2)                                                 00000967
         C     R2,=A(INCMD+73)     END OF CMD AREA ?                    00000968
         BNE   CHALOOP1            NO, LOOP                             00000969
CHAERRM  MVC   MSG(L'PARMERRM),PARMERRM                                 00000970
         B     FMT01A                                                   00000971
CHAGO    LR    R3,R2                                                    00000972
         SR    R3,R1               R3 = LENGTH OF STRING                00000973
         CH    R3,=H'34'           > 34 CHARS LIMIT ?                   00000974
         BH    CHAERRM             YES, ERROR                           00000975
         BCTR  R3,0                -1                                   00000976
CHANOP   NOP   CHASTR2                                                  00000977
         OI    CHANOP+1,X'F0'                                           00000978
         STC   R3,CHASCAN+1        CHANGE CLC LENGTH                    00000979
         STC   R3,CHAHIT+1         CHANGE MVC LENGTH                    00000980
         EX    R3,CHAMVC1          SAVE STRING1                         00000981
         LA    R1,1(R2)            R1 = BEGIN OF STRING2                00000982
         B     CHABEGIN            FIND STRING2                         00000983
CHAMVC1  MVC   STRING1(00),0(R1)   SAVE STRING1                         00000984
CHAMVC2  MVC   STRING2(00),0(R1)   SAVE STRING2                         00000985
CHASTR2  EX    R3,CHAMVC2          SAVE STRING2                         00000986
         CLM   R3,1,CHASCAN+1      LENGTH OF STRINGS EQUAL ?            00000987
         BE    CHAGO2                   YES                             00000988
         MVC   MSG(L'STRERRM),STRERRM   NO, ERROR MSG                   00000989
         B     FMT01A                                                   00000990
CHAGO2   EQU   *                                                        00000991
         LA    R1,1(R2)            NEXT CHAR IN CMD AREA                00000992
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00000993
         ZAP   DBL,=P'99999'                                            00000994
         CLI   0(R1),C'*'          ALL LINES ?                          00000995
         BE    CHAGO3              YES, CHANGE 99999 LINES              00000996
         ZAP   DBL,=P'1'                                                00000997
         CLI   0(R1),C' '          ASSUME 1 LINE ?                      00000998
         BE    CHAGO3              YES,                                 00000999
         TM    0(R1),X'F0'         NUMERIC ?                            00001000
         BNO   CHAERRM             NO, ERROR                            00001001
         PACK  DBL,0(1,R1)                                              00001002
         TM    1(R1),X'F0'         NEXT NUMERIC ?                       00001003
         BNO   CHAGO3              NO,                                  00001004
         PACK  DBL,0(2,R1)                                              00001005
         TM    2(R1),X'F0'         NEXT NUMERIC ?                       00001006
         BNO   CHAGO3              NO,                                  00001007
         PACK  DBL,0(3,R1)                                              00001008
         TM    3(R1),X'F0'         NEXT NUMERIC ?                       00001009
         BNO   CHAGO3              NO,                                  00001010
         PACK  DBL,0(4,R1)                                              00001011
CHAGO3   CVB   R5,DBL              R5 = LINES TO CHANGE                 00001012
         MVI   CHAGLOB,C'0'        CHANGE GLOBAL SW "OFF"               00001013
CHALOOP2 LA    R1,1(R1)            SEARCH 'G' PARM                      00001014
         C     R1,=A(INCMD+73)     REACH LIMIT ?                        00001015
         BH    CHAGO4                                                   00001016
         CLI   0(R1),C' '                                               00001017
         BE    CHALOOP2                                                 00001018
         TM    0(R1),X'F0'         NUMERIC ?                            00001019
         BO    CHALOOP2                                                 00001020
         CLI   0(R1),C'G'          G PARM ?                             00001021
         BNE   CHAERRM             NO, ERROR                            00001022
         MVI   CHAGLOB,C'1'        CHANGE GLOBAL SW "ON"                00001023
CHAGO4   LA    R4,80               COLUMN 80                            00001024
         SR    R4,R3               R4 = NN COLUMNS TO SCAN              00001025
         ST    R4,SAVER4           SAVE R4                              00001026
         L     R2,SAVCURR          LOAD CURRENT REC ADDRESS             00001027
CHANEXR  LR    R3,R2                                                    00001028
         L     R4,SAVER4           RESTORE R4                           00001029
CHASCAN  CLC   0(00,R3),STRING1    SCAN HIT ?                           00001030
         BE    CHAHIT              YES                                  00001031
CHANEXC  LA    R3,1(R3)            NEXT COLUMN                          00001032
         BCT   R4,CHASCAN          LOOP                                 00001033
CHAINDX  AH    R2,RECLEN           NEXT RECORD                          00001034
         C     R2,SAVENDBA         END OF MEMBER ?                      00001035
         BH    CHAEXIT             YES, EXIT                            00001036
         BCT   R5,CHANEXR          NO, SCAN NEXT REC                    00001037
         ST    R2,SAVCURR          SET CURRENT REC ADDRESS              00001038
CHAEXIT  LA    R4,1                                                     00001039
         B     ENTERIN1                                                 00001040
CHAHIT   MVC   0(00,R3),STRING2    CHANGE DATA                          00001041
         ST    R2,SAVCURR          SET CURRENT REC ADDRESS              00001042
         CLI   CHAGLOB,C'1'        CHANGE GLOBAL SW "ON" ?              00001043
         BE    CHANEXC             YES, NEXT COLUMN                     00001044
         B     CHAINDX             NO, NEXT RECORD                      00001045
* --------------------------------------------------------------------- 00001046
RENCMD   EQU   *                   RENUM COMMAND                        00001047
         ZAP   INCR,=P'100'        DEFAULT INCREMENT                    00001048
         L     R2,PBUFADR          MEMBER BUFFER ADDRESS                00001049
         LA    R1,INCMD+4                                               00001050
         CLI   INCMD+3,C' '                                             00001051
         BE    RENFIND                                                  00001052
         LA    R1,INCMD+5                                               00001053
         CLI   INCMD+4,C' '                                             00001054
         BE    RENFIND                                                  00001055
         LA    R1,INCMD+6                                               00001056
RENFIND  BAL   R6,FINDPBEG         FIND PARM BEGIN                      00001057
         TM    0(R1),X'F0'         NUMERIC ?                            00001058
         BNO   RENSTRT             NO, ASSUME 100                       00001059
         PACK  INCR,0(1,R1)                                             00001060
         TM    1(R1),X'F0'         NUMERIC ?                            00001061
         BNO   RENSTRT             NO,                                  00001062
         PACK  INCR,0(2,R1)                                             00001063
         TM    2(R1),X'F0'         NUMERIC ?                            00001064
         BNZ   RENSTRT             NO,                                  00001065
         PACK  INCR,0(3,R1)                                             00001066
RENSTRT  ZAP   DBL,INCR                                                 00001067
RENLOOP  UNPK  TEMP(9),DBL+3(5)                                         00001068
         OI    TEMP+8,X'F0'                                             00001069
         MVC   72(8,R2),TEMP+1                                          00001070
         AP    DBL,INCR                                                 00001071
         AH    R2,RECLEN           NEXT MEMBER RECORD                   00001072
         C     R2,SAVENDBA                LAST RECORD ?                 00001073
         BNH   RENLOOP                    NO, LOOP                      00001074
         MVC   MSG(L'RESEQUEN),RESEQUEN   YES, MSG                      00001075
         MVI   WCC,ALARM                                                00001076
         LA    R4,1(R4)                                                 00001077
         B     ENTERIN1                                                 00001078
* --------------------------------------------------------------------- 00001079
VIECMD   EQU   *                   VIEW MEMBER DISPLAY AT COLUMN NN     00001080
         LA    R1,INCMD+5                                               00001081
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00001082
         TM    0(R1),X'F0'         NUMERIC ?                            00001083
         BNO   PARMERR             NO, ERROR                            00001084
         PACK  DBL,0(1,R1)                                              00001085
         TM    1(R1),X'F0'         NUMERIC ?                            00001086
         BNO   VIECVB              NO,                                  00001087
         PACK  DBL,0(2,R1)                                              00001088
         TM    2(R1),X'F0'         NUMERIC ?                            00001089
         BNO   VIECVB              NO,                                  00001090
         PACK  DBL,0(3,R1)                                              00001091
VIECVB   CVB   R2,DBL                                                   00001092
         BCTR  R2,0                -1                                   00001093
         STH   R2,VIEW             SAVE COLUMN NN -1                    00001094
         B     ENTERIN1                                                 00001095
* --------------------------------------------------------------------- 00001096
GETPARMS EQU   *                   GET/PUT LIB.SLIB MEMN.MEMT DATA=X    00001097
         LA    R1,INCMD+4          OR  GET LLL.ICCFMEM                  00001098
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00001099
         MVI   GETPWR,C'0'         SETOF GET PWR SW                     00001100
         CLI   3(R1),C','          GET QUE,JOBNAME,JOBNUM ?             00001101
         BE    PWRPARMS            YES,                                 00001102
         MVC   RECALL+225(4),INCMD      SAVE GET CMD                    00001103
         MVC   RECALL+229(41),0(R1)     SAVE OPERANDS                   00001104
*                                                                       00001105
         LA    R3,7                MAX LIBNAME LENGTH                   00001106
         BAL   R6,GETSUBP                                               00001107
         MVC   PLIB,SUBPARM1       MOVE LIBRARY NAME                    00001108
         MVC   PSLIB,SUBPARM2      MOVE SUBLIB NAME                     00001109
         CLC   INCMD(4),=C'GET '   GET COMMAND ?                        00001110
         BNE   MNMT                NO, GET MEMBNAME.MEMBTYPE            00001111
         CLI   NUMERIC,C'1'        YES, SUBPARM1 NUMERIC ?              00001112
         BER   R8                       YES, ASSUME ICCF LIBRARY        00001113
MNMT     BAL   R6,FINDPBEG         FIND PARM BEGIN                      00001114
         LA    R3,8                MAX MEMBNAME LENGTH                  00001115
         BAL   R6,GETSUBP                                               00001116
         MVC   PMEMB,SUBPARM1      MOVE MEMBER NAME                     00001117
         MVC   PMEMT,SUBPARM2      MOVE MEMBER TYPE                     00001118
*                                                                       00001119
         CLC   INCMD(4),=C'PUT '   PUT COMMAND ?                        00001120
         BNER  R8                  NO, RETURN                           00001121
         MVI   PSYSIPT,C'N'        DEFAULT DATA=NO                      00001122
         CLC   PMEMT,=CL8'PROC'    MEMBERTYPE PROC ?                    00001123
         BNER  R8                  NO, RETURN                           00001124
         BAL   R6,FINDPBEG         FIND PARM BEGIN                      00001125
         CLC   0(6,R1),=C'DATA=Y'                                       00001126
         BNER  R8                                                       00001127
         MVI   PSYSIPT,C'Y'        SET PARM TO DATA=YES                 00001128
         BR    R8                  RETURN                               00001129
*                                                                       00001130
GETSUBP  EQU   *                                                        00001131
         MVI   SUBPARM1,C' '                                            00001132
         MVC   SUBPARM1+1(15),SUBPARM1                                  00001133
         LA    R2,SUBPARM1                                              00001134
         LA    R3,1(R3)                                                 00001135
         MVI   NUMERIC,C'1'        SETON SW                             00001136
LOOP1    CLI   0(R1),C'.'                                               00001137
         BE    ENDPRM1                                                  00001138
         TM    0(R1),X'F0'         NUMERIC ?                            00001139
         BO    *+8                 YES                                  00001140
         MVI   NUMERIC,C'0'        NO, SETOF SW                         00001141
         MVC   0(1,R2),0(R1)                                            00001142
         LA    R1,1(R1)                                                 00001143
         LA    R2,1(R2)                                                 00001144
         BCT   R3,LOOP1                                                 00001145
         B     PARMERR                                                  00001146
ENDPRM1  LA    R1,1(R1)                                                 00001147
         LA    R2,SUBPARM2                                              00001148
         LA    R3,9                                                     00001149
LOOP2    CLI   0(R1),C' '                                               00001150
         BE    ENDPRM2                                                  00001151
         CLI   0(R1),X'00'                                              00001152
         BE    ENDPRM2                                                  00001153
         MVC   0(1,R2),0(R1)                                            00001154
         LA    R1,1(R1)                                                 00001155
         LA    R2,1(R2)                                                 00001156
         BCT   R3,LOOP2                                                 00001157
         B     PARMERR                                                  00001158
ENDPRM2  CLI   SUBPARM2,C' '                                            00001159
         BE    PARMERR                                                  00001160
         LA    R1,1(R1)                                                 00001161
         BR    R6                                                       00001162
*                                                                       00001163
PWRPARMS EQU   *                   GET QUE,C,JOBNAME,JOBNUM             00001164
         MVC   PWRQUEUE,0(R1)      SAVE QUEUE TYPE                      00001165
         CLC   0(3,R1),=C'RDR'     RDR QUEUE ?                          00001166
         BE    PWRJOBN             YES                                  00001167
         CLC   0(3,R1),=C'PUN'     PUN QUEUE ?                          00001168
         BE    PWRJOBN             YES                                  00001169
         CLC   0(3,R1),=C'LST'     LST QUEUE ?                          00001170
         BE    PWRJOBN             YES                                  00001171
         CLC   0(3,R1),=C'XMT'     XMT QUEUE ?                          00001172
         BNE   PARMERR             NO, ERROR                            00001173
PWRJOBN  MVC   PWRJOB(14),4(R1)    SAVE JOBNAME,JOBNUM                  00001174
         MVI   GETPWR,C'1'         INDICATE GET PWR QUEUE               00001175
         BR    R8                  RETURN                               00001176
*                                                                       00001177
FINDPBEG EQU   *                   FIND PARM BEGIN                      00001178
         CLI   0(R1),C' '                                               00001179
         BNER  R6                  RETURN                               00001180
         LA    R1,1(R1)                                                 00001181
         C     R1,=A(INCMD+72)     REACH LIMIT ?                        00001182
         BNH   FINDPBEG            NO, LOOP                             00001183
         BR    R6                  YES, RETURN                          00001184
*                                                                       00001185
PARMERR  MVC   MSG(L'PARMERRM),PARMERRM                                 00001186
         B     FMT01A                                                   00001187
* ------------------------------------------------------------------    00001188
CHKLOGON EQU   *                   CHECK LOGON                          00001189
         CLI   INAID,PF3           PF3                                  00001190
         BE    PF3INT              YES, GO DEACTIVATE TERMINAL          00001191
         OC    INUSR,BLANKS        FORCE UPPER CASE                     00001192
         OC    INPWD,BLANKS                                             00001193
         CLC   INUSR(7),=C'SYSPROG'                                     00001194
         BNE   LOGONERR                                                 00001195
         CLC   INPWD,=C'PASSWORD'                                       00001196
         BNE   LOGONERR                                                 00001197
         MVI   LOGONSW,C'0'                                             00001198
         B     BEGSCR                                                   00001199
LOGONERR MVC   LOGMSG(L'LOGMSGE),LOGMSGE                                00001200
         B     LOGON                                                    00001201
* ------------------------------------------------------------------    00001202
FMTINAR  EQU   *                   FORMAT INAREA FROM IOAREA            00001203
         LA    R1,23               |                                    00001204
         LA    R2,INAREA           |                                    00001205
FMTCLR   MVC   0(80,R2),BLANKS     | CLEAR INPUT AREA                   00001206
         LA    R2,80(R2)           |                                    00001207
         BCT   R1,FMTCLR           |                                    00001208
*                                                                       00001209
         LA    R1,INSBA            POINT TO BEGIN OF IOAREA             00001210
         MVI   FMTNOP+1,X'00'      FORCE TO NOP                         00001211
FMTLOOP  CLI   0(R1),X'11'         SBA ORDER ?                          00001212
         BE    FMTNOP              YES                                  00001213
FMTINDEX LA    R1,1(R1)                                                 00001214
         C     R1,=A(IOEND)        END OF IOAREA ?                      00001215
         BE    FMTEXTR             YES, EXTRACT LAST FIELD              00001216
         B     FMTLOOP                                                  00001217
*                                                                       00001218
FMTNOP   NOP   FMTEXTR             GO, EXTRACT FIELD                    00001219
         OI    FMTNOP+1,X'F0'      FORCE TO BR                          00001220
*                                                                       00001221
FMTSBA   EQU   *                   SBA TRANSLATE TO ROW AND COLUMN      00001222
         MVC   SBAWORK,1(R1)                                            00001223
         TR    SBAWORK,EBCTOBIN                                         00001224
         NC    SBAWORK,=X'3F3F'                                         00001225
         SR    R4,R4                                                    00001226
         SR    R5,R5                                                    00001227
         IC    R4,SBAWORK                                               00001228
         IC    R5,SBAWORK+1                                             00001229
         SLL   R4,6                                                     00001230
         AR    R5,R4                                                    00001231
         SR    R4,R4                                                    00001232
         D     R4,=F'80'                                                00001233
         STC   R5,SBAROW           0-42    0 => ROW 1                   00001234
         STC   R4,SBACOL           1-80    1 => COLUMN 2                00001235
*                                                                       00001236
         LA    R1,3(R1)            SKIP SBA                             00001237
         LR    R2,R1               R2 POINT TO BEGIN OF FIELD           00001238
         B     FMTINDEX            SEARCH NEXT FIELD                    00001239
FMTEXTR  LR    R3,R1                                                    00001240
         SR    R3,R2               R3 = FIELD LENGTH                    00001241
         BCTR  R3,0                -1                                   00001242
         LTR   R5,R5               ROW ZEROS ?  (CMD AREA)              00001243
         BZ    *+6                 YES                                  00001244
         BCTR  R5,0                NO, -1                               00001245
         MH    R5,=H'80'           OFFSET                               00001246
         LA    R6,INCMDA(R5)       POINT TO DATA FIELD                  00001247
         LA    R0,71               MAX LENGTH (72 BYTES)                00001248
         CH    R4,=H'74'           DATA LINE ?                          00001249
         BL    FMTMOVE             YES, GO MOVE FIELD                   00001250
         LA    R6,INCMDA+73(R5)    NO, POINT TO EDITOR LINE FIELD       00001251
         LA    R0,5                MAX LENGTH (6 BYTES)                 00001252
FMTMOVE  CR    R3,R0               LENGTH > MAX ALLOWED                 00001253
         BNH   *+6                 NO                                   00001254
         LR    R3,R0               YES, USE THE MAX LENGTH              00001255
         EX    R3,FMTMVC           MOVE FIELD TO INAREA                 00001256
         OI    0(R6),X'01'         SETON MDT                            00001257
         C     R1,=A(IOEND)        END OF IOAREA ?                      00001258
         BER   R8                  YES, RETURN                          00001259
         B     FMTSBA                                                   00001260
FMTMVC   MVC   1(00,R6),0(R2)      MOVE FIELD TO INAREA                 00001261
* ------------------------------------------------------------------    00001262
RETCODE  EQU   *                                                        00001263
         B     RTNCDTAB(R15)       BRANCH TO CORRESPONDING ENYRY        00001264
RTNCDTAB EQU   *                                                        00001265
         B     RTNCD0              I/O SUCCESSFULLY INITIATED           00001266
         B     RTNCD4              DTFBT BUSY                           00001267
         B     RTNCD8              INVALID RLN                          00001268
         B     RTNCDC              INVALID TYPE CODE                    00001269
         B     RTNCD10             ALL SKIP BITS ON                     00001270
         B     RTNCD14             LINE ERROR AT OPEN                   00001271
         B     RTNCD18             NO BUFFERS                           00001272
         B     RTNCD1C             NO BUFFER POOL                       00001273
         B     RTNCD20             NO BUFFER MANAGEMENT                 00001274
         B     RTNCD24             BSC USAGE COUNT EXCEEDED             00001275
         B     RTNCD28             3270 LOCAL PRINTER BUSY              00001276
         B     RTNCD2C             3270 NO SBA ORDER IN READ FROM POS   00001277
         B     RTNCD30             DEVICE BUFFER UNRELIABLE             00001278
         B     RTNCD34             OLTEP HAS THE LOCAL 3270             00001279
         BC    0,*                 NOP                                  00001280
         BC    0,*                 NOP                                  00001281
         B     RTNCD40             DEVICE ASSGINED TO IGNORE            00001282
RTNCD0   EQU   *                                                        00001283
         BR    R8                  RETURN                               00001284
RTNCD4   EQU   *                                                        00001285
         S     R8,EIGHT8           SUBTRACT 8 FROM RETURN ADDR          00001286
         BR    R8                     TO RETRY THE OPERATION            00001287
RTNCD8   EQU   *                                                        00001288
         SR    RLNREG,RLNREG       CLEAR RLN TO 0                       00001289
         B     READ                GO READ                              00001290
RTNCDC   EQU   *                                                        00001291
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001292
RTNCD10  EQU   *                                                        00001293
         B     CLOSE               ALL TERMINALS, TERMINATE             00001294
RTNCD14  EQU   *                                                        00001295
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001296
RTNCD18  EQU   *                                                        00001297
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001298
RTNCD1C  EQU   *                                                        00001299
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001300
RTNCD20  EQU   *                                                        00001301
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001302
RTNCD24  EQU   *                                                        00001303
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001304
RTNCD28  EQU   *                                                        00001305
         S     R8,EIGHT8           SUBTRACT 8 FROM RETURN ADDR          00001306
         BR    R8                     TO RETRY THE OPERATION            00001307
RTNCD2C  EQU   *                                                        00001308
         B     ABNORMAL            THIS CONDITION SHOULD NOT OCCUR      00001309
*                             SINCE NO READS FROM POSITIONS ARE USED    00001310
RTNCD30  EQU   *                                                        00001311
         S     R8,EIGHT8           SUBTRACT 8 FROM RETURN ADDR          00001312
         BR    R8                  TO RETRY THE OPERATION               00001313
RTNCD34  EQU   *                                                        00001314
         B     READ                                                     00001315
*                                                                       00001316
WAITD    EQU   *                                                        00001317
         BTWAIT ECB=DECBD                                               00001318
*                                                                       00001319
CHK7FCC  EQU   *                                                        00001320
         L     R1,=A(DECBD)                                             00001321
         CLI   0(R1),SEVENF        NORMAL COMPLETION CODE               00001322
         BNE   CHK64CC             NO CHECK OTHERS                      00001323
         BR    R8                  RETURN                               00001324
CHK64CC  EQU   *                                                        00001325
         CLI   0(R1),SIXTY4        DEVICE BUFFER CLOBBERED FROM RFT     00001326
         BNE   CHK42CC             NO, CHECK SOME MORE                  00001327
         LA    MSGADDR,FORMAT1     ADDR OF OUTPUT MESSAGE               00001328
         LA    R5,FMT1SZ           LENGTH OF MESSAGE                    00001329
WTDVUNRL EQU   *                                                        00001330
         WRITE DECBD,TS,DTFBTL,(MSGADDR),(R5),,(RLNREG),MF=E            00001331
         BNZ   ABNORMAL            DUMP, ABNORMAL RETURN CODE           00001332
         BTWAIT ECB=DECBD                                               00001333
         B     CHK7FCC             CHECK COMPLETION CODE                00001334
CHK42CC  EQU   *                                                        00001335
         CLI   0(R1),FOURTY2       RFT RECEIVED COMP CODE               00001336
         BNE   ABNORMAL                                                 00001337
         TWAIT (R2),TERMTST,ECBLIST=DECBADDR                            00001338
         B     CHK7FCC             CHECK COMPLETION CODE                00001339
*                                                                       00001340
CLOSE    EQU   *                                                        00001341
         BTRD  DTFBTL                                                   00001342
         CLOSE DTFBTL                                                   00001343
         EOJ                                                            00001344
*                                                                       00001345
RTNCD40  EQU   *                   DEVICE ASSIGNED TO IGNORE            00001346
ABNORMAL EQU   *                                                        00001347
         STM   R0,R15,SAVEAREA     SAVE REGS                            00001348
         L     R3,=A(IJLBTEND)     GET ENDING ADDRESS                   00001349
         PDUMP BASE,(R3)                                                00001350
         EOJ                                                            00001351
*                                                                       00001352
CNSLMSG  EQU   *                                                        00001353
         LA    R1,CONCCB           LOAD CORRESPONDING CCB               00001354
         EXCP  (1)                 WRITE MESSAGE                        00001355
         WAIT  (1)                 WAIT FOR I/O COMPLETE                00001356
         BR    R8                  RETURN                               00001357
* ------------------------------------------------------------------    00001358
FORMAT1  EQU   *                                                        00001359
WCC      DC    X'C3'               WCC   X'C3' - X'C7'                  00001360
         $SBA  (1,1,B)                                                  00001361
         DC    C'===>'                                                  00001362
         DC    X'1DC5'             SF = UNPROT MDTON                    00001363
CMD      DC    CL74' '                                                  00001364
         $SBA  (2,1,B)                                                  00001365
MSG      DC    CL77' '                                                  00001366
SBAIC    DC    X'1140C613'         SBA, IC, DEFAULT TO 1,7              00001367
HDR1SZ   EQU   *-FORMAT1                                                00001368
         $SBA  (3,1,UB)                                                 00001369
LINE1    DC    CL72' ',X'1DC8',C'*===* '                                00001370
         $SBA  (4,1,U)                                                  00001371
LINE2    DC    CL72' ',X'1D40',C'*===* '                                00001372
TWO1SZ   EQU   *-FORMAT1                                                00001373
         $SBA  (5,1,U)                                                  00001374
         DC    CL72' ',X'1D40',C'*===* '                                00001375
         $SBA  (6,1,U)                                                  00001376
         DC    CL72' ',X'1D40',C'*===* '                                00001377
         $SBA  (7,1,U)                                                  00001378
         DC    CL72' ',X'1D40',C'*===* '                                00001379
         $SBA  (8,1,U)                                                  00001380
         DC    CL72' ',X'1D40',C'*===* '                                00001381
         $SBA  (9,1,U)                                                  00001382
         DC    CL72' ',X'1D40',C'*===* '                                00001383
         $SBA  (10,1,U)                                                 00001384
         DC    CL72' ',X'1D40',C'*===* '                                00001385
         $SBA  (11,1,U)                                                 00001386
         DC    CL72' ',X'1D40',C'*===* '                                00001387
         $SBA  (12,1,U)                                                 00001388
         DC    CL72' ',X'1D40',C'*===* '                                00001389
         $SBA  (13,1,U)                                                 00001390
         DC    CL72' ',X'1D40',C'*===* '                                00001391
         $SBA  (14,1,U)                                                 00001392
         DC    CL72' ',X'1D40',C'*===* '                                00001393
         $SBA  (15,1,U)                                                 00001394
         DC    CL72' ',X'1D40',C'*===* '                                00001395
         $SBA  (16,1,U)                                                 00001396
         DC    CL72' ',X'1D40',C'*===* '                                00001397
         $SBA  (17,1,U)                                                 00001398
         DC    CL72' ',X'1D40',C'*===* '                                00001399
         $SBA  (18,1,U)                                                 00001400
         DC    CL72' ',X'1D40',C'*===* '                                00001401
         $SBA  (19,1,U)                                                 00001402
         DC    CL72' ',X'1D40',C'*===* '                                00001403
         $SBA  (20,1,U)                                                 00001404
         DC    CL72' ',X'1D40',C'*===* '                                00001405
         $SBA  (21,1,U)                                                 00001406
         DC    CL72' ',X'1D40',C'*===* '                                00001407
         $SBA  (22,1,U)                                                 00001408
         DC    CL72' ',X'1D40',C'*===* '                                00001409
         $SBA  (23,1,U)                                                 00001410
         DC    CL72' ',X'1D40',C'*===* '                                00001411
         $SBA  (24,1,U)                                                 00001412
         DC    CL72' ',X'1D40',C'*===* '                                00001413
FMT1SZ   EQU   *-FORMAT1                                                00001414
         SPACE                                                          00001415
CLOSEMG  EQU   *                                                        00001416
BUFCTL   DC    X'C311C14F1D60'     WCC, SBA (1,79), SF = PROT,NORM      00001417
         DC    C'This terminal is now inactive, VSEDIT is over.'        00001418
CLOSEMGL EQU   *-CLOSEMG                                                00001419
*                                                                       00001420
HELPMSGL EQU   (22*80)             HELP SCREEN SIZE                     00001421
*                                                                       00001422
LOGONMG  EQU   *                                                        00001423
         DC    X'C7'               WCC                                  00001424
         $SBA  (19,6,N)                                                 00001425
         DC    C'USER-ID........'                                       00001426
         $SBA  (19,22)                                                  00001427
         DC    X'1DC513'           SF = UNPROT, IC                      00001428
         DC    C'________'                                              00001429
         $SBA  (19,31,N)                                                00001430
         DC    C'   The name by which the system knows you.'            00001431
         $SBA  (20,6,N)                                                 00001432
         DC    C'PASSWORD.......'                                       00001433
         $SBA  (20,22)                                                  00001434
         DC    X'1DCD'             UNPROT NO DISPLAY ?                  00001435
         DC    C'        '                                              00001436
         $SBA  (20,31,N)                                                00001437
         DC    C'   Your personal access code.'                         00001438
         $SBA  (22,6,N)                                                 00001439
LOGMSG   DC    Cl27' '                                                  00001440
LOGONMGL EQU   *-LOGONMG                                                00001441
* --------------------------------------------------------------------  00001442
*        READ AND WRITE MACROS                                          00001443
* --------------------------------------------------------------------  00001444
         DS    0F                                                       00001445
WRITETS  EQU   *                                                        00001446
         SR    RLNREG,RLNREG       CLEAR RLN REG                        00001447
         L     R5,MSGLEN           RESTORE MSGLEN                       00001448
         L     DTFREG,VDTF         ADDRESS THE DTFBT                    00001449
         WRITE DECBD,TS,DTFBTL,(MSGADDR),(R5),,(RLNREG),MF=E            00001450
         BR    R8                  RETURN                               00001451
*                                                                       00001452
READTB   EQU   *                                                        00001453
*        READ  DECBD,TB,DTFBTL,IOAREA,2000,,(RLNREG),MF=E               00001454
*        BR    R8                  RETURN                               00001455
*                                                                       00001456
READTI   EQU   *                                                        00001457
         READ  DECBD,TI,DTFBTL,IOAREA,2000,,(RLNREG),MF=E               00001458
         BR    R8                  RETURN                               00001459
*                                                                       00001460
WRITETI  EQU   *                                                        00001461
*        WRITE DECBD,TI,DTFBTL,(MSGADDR),(R5),,(RLNREG),MF=E            00001462
*        BR    R8                                                       00001463
*                                                                       00001464
WRITETUS EQU   *                                                        00001465
*        WRITE DECBD,TUS,DTFBTL,FLAGS,1,,(RLNREG),MF=E                  00001466
*        BR    R8                                                       00001467
* ------------------------------------------------------------------    00001468
ABEXIT   EQU   *                   ABEND EXIT ROUTINE                   00001469
         DROP  BASEREG,BASEREG2,BASEREG3                                00001470
         USING *,R15               ESTABLISH ADDRESSABILITY             00001471
         RELEASE SYS005            RELEASE TERMINAL                     00001472
         EOJ                                                            00001473
* ------------------------------------------------------------------    00001474
PCEXIT   EQU   *                   PGM CHECK EXIT ROUTINE               00001475
         DROP  R15                                                      00001476
         USING *,R15               ESTABLISH ADDRESSABILITY             00001477
         RELEASE SYS005            RELEASE TERMINAL                     00001478
*                                                                       00001479
         UNPK  TEMP(9),ABSAVE(5)   UNPACK PSW 0-4                       00001480
         TR    TEMP(8),TRTAB       CONVERT TO PRINTABLE HEX-VALUE       00001481
         MVC   PSW1,TEMP           INSERT PRINTABLE                     00001482
         UNPK  TEMP(9),ABSAVE+4(5) UNPACK PSW 4-8                       00001483
         TR    TEMP(8),TRTAB       CONVERT TO PRINTABLE HEX-VALUE       00001484
         MVC   PSW2,TEMP           INSERT PRINTABLE                     00001485
         LA    R1,PSWMSG           MESSAGE TEXT ADDRESS                 00001486
         STCM  R1,7,CONCCW+1       TO ERROR CCW                         00001487
         MVI   CONCCW+7,PSWMSGL    STORE MESSAGE LENGTH                 00001488
         LA    R1,CONCCB           LOAD CORRESPONDING CCB               00001489
         EXCP  (1)                 WRITE MESSAGE                        00001490
         WAIT  (1)                 WAIT FOR I/O COMPLETE                00001491
         EOJ                                                            00001492
*                                                                       00001493
PSWMSG   DC    C'VSEDIT PGM CHECK  PSW = '                              00001494
PSW1     DS    CL8                                                      00001495
         DC    C' '                                                     00001496
PSW2     DS    CL8                                                      00001497
PSWMSGL  EQU   *-PSWMSG                                                 00001498
* --------------------------------------------------------------------* 00001499
*        SAVE AREA DECLARATIONS                                       * 00001500
* --------------------------------------------------------------------* 00001501
         DS    0F                                                       00001502
SAVEAREA DC    XL72'00'            TASK SAVE AREA                       00001503
SAVER0   DS    F                                                        00001504
SAVER1   DS    F                                                        00001505
SAVER4   DS    F                                                        00001506
SAVER9   DS    F                                                        00001507
ABSAVE   DC    XL72'00'            STXIT AB/PC SAVE AREA                00001508
* --------------------------------------------------------------------  00001509
*        EQUATES                                                        00001510
* --------------------------------------------------------------------  00001511
FOURTY2  EQU   X'42'               RFT RECEIVED COMP CODE               00001512
SIXTY4   EQU   X'64'               DEVICE BUFFER CLOBERED COMP CODE     00001513
NOALARM  EQU   X'C3'               WCC WITHOUT ALARM                    00001514
ALARM    EQU   X'C7'               WCC WITH ALARM                       00001515
NOAID    EQU   X'60'               NO ATTENTION ID GENERATED            00001516
CLEAR    EQU   X'6D'               CLEAR KEY                            00001517
PA1      EQU   X'6C'               PA1 KEY                              00001518
PA2      EQU   X'6E'               PA2 KEY                              00001519
PA3      EQU   X'6B'               PA3 KEY                              00001520
PF1      EQU   X'F1'               PF1 KEY  - HELP                      00001521
PF2      EQU   X'F2'               PF2 KEY  - RECALL LAST COMMAND       00001522
PF3      EQU   X'F3'               PF3 KEY  - QUIT                      00001523
PF4      EQU   X'F4'               PF4 KEY  - SWITCH LOGICAL SCREEN     00001524
PF5      EQU   X'F5'               PF5 KEY  - UP 5                      00001525
PF6      EQU   X'F6'               PF6 KEY  - REPEAT PREVIOUS COMMAND   00001526
PF7      EQU   X'F7'               PF7 KEY  - BACK                      00001527
PF8      EQU   X'F8'               PF8 KEY  - FORWARD                   00001528
PF9      EQU   X'F9'               PF9 KEY  - TOP                       00001529
PF10     EQU   X'7A'               PF10 KEY - VIEW 1 72                 00001530
PF11     EQU   X'7B'               PF11 KEY - VIEW 9 80                 00001531
PF12     EQU   X'7C'               PF12 KEY - BOTTOM                    00001532
ENTER    EQU   X'7D'               ATTENTION ID FOR ENTER KEY           00001533
SEVENF   EQU   X'7F'               NORMAL COMPLETION CODE               00001534
* --------------------------------------------------------------------  00001535
*        CONSTANTS                                                      00001536
* --------------------------------------------------------------------  00001537
BLANKS   DC    CL80' '                                                  00001538
EIGHT8   DC    F'8'                CONSTANT OF 8                        00001539
*                                                                       00001540
PRINTABL DC    256AL1(*-PRINTABL)  00-FF                                00001541
         ORG   PRINTABL                                                 00001542
         DC    64X'E1'             00-3F                                00001543
         ORG                                                            00001544
*                                                                       00001545
EBCTOBIN DC    256AL1(*-EBCTOBIN)                                       00001546
         ORG   EBCTOBIN+X'40'                                           00001547
         DC    X'C0'                                                    00001548
         ORG   EBCTOBIN+X'4A'                                           00001549
         DC    X'CACBCCCDCECF'                                          00001550
         ORG   EBCTOBIN+X'50'                                           00001551
         DC    X'D0'                                                    00001552
         ORG   EBCTOBIN+X'5A'                                           00001553
         DC    X'DADBDCDDDEDF'                                          00001554
         ORG   EBCTOBIN+X'60'                                           00001555
         DC    X'E0E1'                                                  00001556
         ORG   EBCTOBIN+X'6A'                                           00001557
         DC    X'EAEBECEDEEEF'                                          00001558
         ORG   EBCTOBIN+X'7A'                                           00001559
         DC    X'FAFBFCFDFEFF'                                          00001560
         ORG                                                            00001561
*                                                                       00001562
*                0 1 2 3 4 5 6 7 8 9 A B C D E F                        00001563
BINTOEBC DC    X'40C1C2C3C4C5C6C7C8C94A4B4C4D4E4F'  0                   00001564
         DC    X'50D1D2D3D4D5D6D7D8D95A5B5C5D5E5F'  1                   00001565
         DC    X'6061E2E3E4E5E6E7E8E96A6B6C6D6E6F'  2                   00001566
         DC    X'F0F1F2F3F4F5F6F7F8F97A7B7C7D7E7F'  3                   00001567
*                                                                       00001568
TRTAB    EQU   *-240               ENTRY POINT FOR TRANSLATE TABLE      00001569
         DC    C'0123456789ABCDEF' HEX TRANSLATE TABLE                  00001570
* --------------------------------------------------------------------  00001571
DECBADDR DC    X'80'                                                    00001572
         DC    AL3(DECBD)                                               00001573
VDTF     DC    V(DTFBTL)                                                00001574
MSGLEN   DS    F                                                        00001575
FLAGS    DC    X'00'               BYTE OF FLAGS                        00001576
* --------------------------------------------------------------------  00001577
LOGMSGE  DC    C'Incorrect login or password'                           00001578
PARMERRM DC    C'Syntax error or missing parm '                         00001579
STRERRM  DC    C'Length of strings not equal '                          00001580
PFKERRM  DC    C'This KEY is not defined '                              00001581
BEGMSG   DC    C'Press PF1 to show HELP panel  '                        00001582
GETVERRM DC    C'GETVIS failed '                                        00001583
HELPERRM DC    C'Member VSE$HEL.Z not found '                           00001584
JOBNOF   DC    C'Jobname not found '                                    00001585
STRNOF   DC    C'String not found '                                     00001586
STKFULLM DC    C'Editor STACK is full '                                 00001587
MEMSAVED DC    C'Member Saved '                                         00001588
RESEQUEN DC    C'Resequenced '                                          00001589
SUBMITED DC    C'JOB SUBMITED '                                         00001590
WITHDATA DC    C'with DATA=X '                                          00001591
INVCMD   DC    C'Invalid Command '                                      00001592
EDLERRM  DC    C'ERROR in TYPE III AREA '                               00001593
DELERRM  DC    C'DELETE of entire area invalid '                        00001594
FULLMSG  DC    C'The member don''t fit in the work area '               00001595
OVFLMSG  DC    C'The line cmd would overflow the work area '            00001596
TOPMSG   DC    C'***** TOP OF FILE ***** '                              00001597
EOFMSG   DC    C'***** END OF FILE ***** '                              00001598
SCALE    DC    C'....+....1....+....2....+....3....+....4....+....5....*00001599
               +....6....+....7... (X)'                                 00001600
SUBPARM1 DS    CL8                                                      00001601
SUBPARM2 DS    CL8                                                      00001602
NUMERIC  DS    C                   NUMERIC OPERAND                      00001603
GETPWR   DS    C                   GET PWR SW                           00001604
ADDSW    DC    C'0'                ADD COMMAND SW                       00001605
HELPSW   DC    C'0'                HELP ACTIVE SW                       00001606
LOGONSW  DS    C                   LOGON SCREEN SW                      00001607
STACKSW  DS    C                   STACK OPEN SW                        00001608
SWCMD    DS    C                   SW COMMAND                           00001609
SWNUM    DS    C                   SW CMD NUMERIC OPERAND               00001610
WEDLIN   DS    CL6                 WORK EDITOR LINE AREA                00001611
TABCMD   DC    C'ACDIMK/"',X'FF'   EDITOR LINE COMMANDS                 00001612
STRING1  DS    CL34                STRING TO LOCATE                     00001613
STRING2  DS    CL34                REPLACING STRING                     00001614
CHAGLOB  DS    C                   CHANGE GLOBAL SW                     00001615
TEMP     DS    CL80                WORK                                 00001616
INCR     DS    PL5                 RENUM INCREMENT                      00001617
UPNN     DS    PL2                 UP NN LINES COUNT                    00001618
RECALL   DC    6CL45' '            REMEMBER 6 LAST COMMANDS             00001619
RECLADDR DS    F                   ADDR OF LAST CMD SHOWED              00001620
*                                                                       00001621
DBL      DS    D                                                        00001622
CONCCB   CCB   SYSLOG,CONCCW                                            00001623
CONCCW   CCW   X'09',GETVERRM,X'20',L'GETVERRM                          00001624
*                                                                       00001625
PARMLIST DS    F                                                        00001626
HELPBEG  DS    F                   HELP BEG SCREEN ADDR                 00001627
SAVINPA  DS    F                   SAVE INPUT LINE ADDR                 00001628
SAVRECA  DS    F                   SAVE BUFFER LINE ADDR                00001629
SAVLINES DS    F                   SAVE LINES TO ADD, DUP, INS          00001630
EDLMDTA  DS    F                   SAVE EDITOR LINE MDT ADDR            00001631
NEXSTACK DS    F                   ADDR OF NEXT STACK ENTRY             00001632
STACK    DS    F                   EDITOR STACK ADDR                    00001633
WORK1    DS    F                   WORKSET (1) ADDR                     00001634
WORK2    DS    F                   WORKSET (2) ADDR                     00001635
HELP     DS    F                   WORKSET (HELP) ADDR                  00001636
* --------------------------------------------------------------------  00001637
         LTORG                                                          00001638
* --------------------------------------------------------------------  00001639
         DS    0F                                                       00001640
SBAWORK  DS    CL2                                                      00001641
SBAROW   DS    CL1                                                      00001642
SBACOL   DS    CL1                                                      00001643
*                                                                       00001644
         DS    CL2                 DON'T REMOVE IT                      00001645
INAREA   DS    0CL1840             FORMATTED INPUT AREA                 00001646
INCMDA   DS    CL1                 COMMAND AREA MDT                     00001647
INCMD    DS    CL74                COMMAND AREA                         00001648
         DS    CL5                 FILLER                               00001649
INLINA   DS    CL1                 DATA LINE MDT                        00001650
INLIN1   DS    CL72                DATA LINE * 22                       00001651
INEDIA   DS    CL1                 EDITOR LINE MDT                      00001652
INEDI1   DS    CL6                 EDITOR LINE COMMAND * 22             00001653
         ORG   INAREA+1840                                              00001654
INEND    EQU   *                                                        00001655
*                                                                       00001656
IOAREA   DS    0CL2000             IOAREA FOR READTI                    00001657
INAID    DS    CL1                 AID                                  00001658
INCURSOR DS    CL2                 CURSOR SBA                           00001659
INSBA    DS    CL3                 SBA                                  00001660
INUSR    DS    CL8                 USER-ID                              00001661
         DS    CL3                 SBA                                  00001662
INPWD    DS    CL8                 PASSWORD                             00001663
         ORG   IOAREA+2000                                              00001664
IOEND    EQU   *                                                        00001665
* --------------------------------------------------------------------  00001666
WORKA    DSECT                     DYNAMIC WORK AREAS                   00001667
* --------------------------------------------------------------------  00001668
*        VSELIBRM/VSEPWRS  PARMS                                        00001669
* --------------------------------------------------------------------  00001670
LIBPARMS DS    0CL102                                                   00001671
PFUNC    DS    CL3                 FUNCTION GET/PUT                     00001672
PSYSIPT  DS    C                   DATA=Y/N                             00001673
PBUFADR  DS    F                   BUFFER ADDRESS                       00001674
PNORL    DS    F                   NO RECORDS                           00001675
PENDBUF  DS    F                   END BUFFER ADDRESS                   00001676
PLIB     DS    CL7                 LIBRARY NAME                         00001677
PSLIB    DS    CL8                 SUBLIBRARY NAME                      00001678
PMEMB    DS    CL8                 MEMBER NAME                          00001679
PMEMT    DS    CL8                 MEMBER TYPE                          00001680
PRETCOD  DS    CL3                 R15                                  00001681
PMSG     DS    CL52                APIMSGXX                             00001682
         ORG   PLIB                                                     00001683
PWRQUEUE DS    CL3                 PWR QUEUE                            00001684
PWRJOB   DS    CL14                PWR JOBNAME,JOBNUM                   00001685
         ORG                                                            00001686
* --------------------------------------------------------------------  00001687
*        VSEICCF  PARMS                                                 00001688
* --------------------------------------------------------------------  00001689
         DS    0F                                                       00001690
IPARMS   DS    CL21                ICCF PARMS ==> PUNCH/DSERV           00001691
IRETCOD  DS    CL3                 VSEICCF RETURN CODE                  00001692
IBUFADR  DS    F                   BUFFER ADDRESS                       00001693
INORL    DS    F                   NO RECORDS                           00001694
IENDBUF  DS    F                   END BUFFER ADDRESS                   00001695
* --------------------------------------------------------------------  00001696
SAVENDBA DS    F                   SAVE LAST RECORD ADDRESS             00001697
SAVCURR  DS    F                   SAVE CURRENT REC ADDRESS             00001698
SAVNEXTB DS    F                   SAVE NEXT REC ADDRESS                00001699
VIEW     DS    H                   VIEW MEMBER DISPLAY AT COLUMN NN     00001700
RECLEN   DS    H                   RECORD LENGTH IN PROCESS 80/132      00001701
MEMBER   DS    CL10                MEMBER NAME FOR SCALE                00001702
         DS    0F                                                       00001703
LENPARMS EQU   *-LIBPARMS                                               00001704
BUFFER   EQU   *                   MEMBER BUFFER BEGIN                  00001705
* --------------------------------------------------------------------  00001706
VSEDIT   CSECT                                                          00001707
*                                                                       00001708
RMSRTAB  RMSRTAB 2,,                                                    00001709
*                                                                       00001710
DTFBTL   DTFBT LINELST=(005),                                          X00001711
               CU=3272,DEVICE=3277,TERMTST=YES,MODNAME=L3270MOD,       X00001712
               LERBADR=RMSRTAB                                          00001713
*                                                                       00001714
         READ  DECBD,TI,DTFBTL,MF=L                                     00001715
*                                                                       00001716
         PRINT OFF                                                      00001717
L3270MOD BTMOD L3277=YES,TST3277=YES,RMSR=YES                           00001718
         END                                                            00001719
/+                                                                      00001720
/*                                                                      00001721
// LIBDEF *,CATALOG=PRD2.BTAM,SEARCH=PRD2.BTAM                          00001722
// EXEC ASSEMBLY                                                        00001723
         COPY  VSEDIT                                                   00001724
/*                                                                      00001725
// EXEC LNKEDT,PARM='MSHP'                                              00001726
/&                                                                      00001727
* $$ EOJ                                                                00001728
