Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Can we IPL using a Tape

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> All Other Mainframe Topics
View previous topic :: :: View next topic  
Author Message
Hunny Sachdeva

New User


Joined: 11 Jun 2009
Posts: 20
Location: india

PostPosted: Mon Jun 15, 2009 11:57 am    Post subject: Can we IPL using a Tape
Reply with quote

Can we IPL using a Tape?
If yes, how to do it?
If no, why not?

Rgds,
Hunny
Back to top
View user's profile Send private message

enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10256
Location: italy

PostPosted: Mon Jun 15, 2009 12:01 pm    Post subject: Reply to: IPL from Tape
Reply with quote

You Ipl from tape the same way You Ipl form dasd
use a tape address instead of a disk address

obviously the tape must be no label and contain a proper standalone program

when asking a "why not" the usual answer would be...
because the people who designed/build the thing decided so icon_biggrin.gif
Back to top
View user's profile Send private message
Hunny Sachdeva

New User


Joined: 11 Jun 2009
Posts: 20
Location: india

PostPosted: Mon Jun 15, 2009 3:06 pm    Post subject: Reply to: Can we IPL using a Tape
Reply with quote

Thanks,

But my doubt is iplable DASD has some special chracteristics like bootstrap module as cylinder0,track0.
Can we make a tape to look in the same way and system being oblivious of the fact that it is using a tape.

have you ever done that or due you know somebody who has icon_wink.gif

Regards,
Hunny
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8593
Location: Back in jolly old England

PostPosted: Mon Jun 15, 2009 3:09 pm    Post subject:
Reply with quote

Obviously so, as it is possible to IPL from a tape. The last time that I done that was about 25 years ago.

Why the sudden interest in tape IPL's - what is your requirement
Back to top
View user's profile Send private message
Hunny Sachdeva

New User


Joined: 11 Jun 2009
Posts: 20
Location: india

PostPosted: Mon Jun 15, 2009 3:19 pm    Post subject:
Reply with quote

No i was just curious but have absolutely no idea how to do it.
i mean how to write an IPLable tape..
Back to top
View user's profile Send private message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10256
Location: italy

PostPosted: Mon Jun 15, 2009 3:22 pm    Post subject: Reply to: Can we IPL using a Tape
Reply with quote

reword Your question, please, it is very unclear
also it was not what You asked in the starting post

if You want good answers learn to ask good questions

if You speak assembler here are tho stages for ipling from a card deck under VM

Code:
         TITLE 'VM MINI-LOADER PHASE 0'                                 IPL00010
IPL0     START 0                                                        IPL00020
         DC    F'0',AL4(560)        IPL PSW                             IPL00030
         DC    X'02',AL3(512)       IPL CCW1 (READ)                     IPL00040
         DC    X'60',X'00',AL2(80)  CC+SLI  COUNT=80                    IPL00050
         DC    X'08',AL3(528)       TIC TO START OF TXT                 IPL00060
         DC    F'0'                 (REMAINDER OF CCW IGNORED)          IPL00070
         END   IPL0                                                     IPL00080



Code:
         TITLE 'VM MINI-LOADER PHASE II'                                IPL00010
*********************************************************************** IPL00020
*                                                                     * IPL00030
*        VM MINI-LOADER PHASE II                                      * IPL00040
*        P.FLASS -- EMPIRE STATE COLLEGE (SUNY) -- OCT 87             * IPL00050
*        FUNCTION: READ INTO ABSOLUTE LOC 512 BY LOADER PHASE I       * IPL00060
*          AS 'TXT CARDS.  THIS MODULE RELOCATES ITSELF TO HIGH       * IPL00070
*          MEMORY (OBTAINED BY DIAGNOSE X'60'), READS FOLLOWING       * IPL00080
*          PROGRAM TXT AND EXITS VIA LPSW 0                           * IPL00090
*                                                                     * IPL00100
*********************************************************************** IPL00110
         START 528             AS LOADED BY PHASE I                     IPL00120
R0       EQU   0               REGISTER EQUATES                         IPL00130
R1       EQU   1                                                        IPL00140
R2       EQU   2                                                        IPL00150
R3       EQU   3                                                        IPL00160
R4       EQU   4                                                        IPL00170
R5       EQU   5                                                        IPL00180
R6       EQU   6                                                        IPL00190
R7       EQU   7                                                        IPL00200
R8       EQU   8                                                        IPL00210
R9       EQU   9                                                        IPL00220
R10      EQU   10                                                       IPL00230
R11      EQU   11                                                       IPL00240
R12      EQU   12                                                       IPL00250
R13      EQU   13                                                       IPL00260
R14      EQU   14                                                       IPL00270
R15      EQU   15                                                       IPL00280
*                                                                       IPL00290
IPL1CRD0 EQU   *                   BEGINNING OF TXT CARD 0              IPL00300
*                                                        CRD LEN CUM    IPL00310
IPL1CCW1 DC    X'02',AL3(592)      CCW TO READ CARD 1      0   4   4    IPL00320
         DC    X'60',X'00',AL2(80)                             .        IPL00330
IPL1CCW2 DC    X'02',AL3(672)      CCW TO READ CARD 2      0   4   8    IPL00340
         DC    X'60',X'00',AL2(80)                             .        IPL00350
IPL1CCW3 DC    X'02',AL3(752)      CCW TO READ CARD 3      0   4  12    IPL00360
         DC    X'60',X'00',AL2(80)                             .        IPL00370
IPL1CCW4 DC    X'02',AL3(832)      CCW TO READ CARD 4      0   4  16    IPL00380
         DC    X'20',X'00',AL2(80) <END OF CCW CHAIN>          .        IPL00390
*                                                                       IPL00400
* * *    EXECUTION BEGINS HERE FOLLOWING IPL    * * *                   IPL00410
*                                                                       IPL00420
IPL1     EQU   *                                                        IPL00430
         BALR  R12,0                                       0   1  17    IPL00440
         USING *,R12                                                    IPL00450
         DC    X'83',X'F0',XL2'60' GET MEMORY SIZE IN R15  0   2  19    IPL00460
         SH    R15,IPL1K           SUBTRACT 1K             0   2  21    IPL00470
         B     IPL1CRD0+80         BRANCH TO CARD 1        0   2  23    IPL00480
IPL1K    DC    H'1024'             LOADER SIZE             0   1  24    IPL00490
         DC    XL8'00'             (TO END OF CARD 0)      0   4  28    IPL00500
* * *    END OF TXT CARD 0 * * *                                        IPL00510
IPL1CRD1 EQU   *                   BEGINNING OF CARD 1   CRD LEN CUM    IPL00520
         BALR  R12,0                                       1   1   1    IPL00530
         USING *,R12                                                    IPL00540
         MVC   0(REMLEN,R15),LOADER MOVE REST OF CARD 1    1   3   4    IPL00550
         LA    R1,REMLEN(,R15)      ADVANCE POINTER        1   2   6    IPL00560
         MVC   0(56,R1),IPL1CRD1+80    MOVE CARD 2         1   3   9    IPL00570
         MVC   56(56,R1),IPL1CRD1+160   MOVE CARD 3        1   3  12    IPL00580
         MVC   112(56,R1),IPL1CRD1+240  MOVE CARD 4        1   3  15    IPL00590
         BR    R15                 EXECUTE RELOCATED LOADER1   1  16    IPL00600
*                                                                       IPL00610
*        LOADER ROUTINE TO BE RELOCATED INTO HI MEM                     IPL00620
*        REGISTER USAGE:                                                IPL00630
*          R1:    IPL DEVICE ADDRESS                                    IPL00640
*          R2:    CHANNEL PROGRAM ADDRESS                               IPL00650
*          R3:    BUFFER ADDRESS                                        IPL00660
*          R4,R5: WORK REGISTERS                                        IPL00670
*          R15:   BASE REGISTER                                         IPL00680
*                                                                       IPL00690
LOADER   DS    0H                  ACTUAL START ADDRESS                 IPL00700
         USING *,R15               ESTABLISHED BY CALLER                IPL00710
         LA    R1,512              LOAD 'FROM' ADDRESS     1   2  18    IPL00720
         XC    0(256,R1),0(R1)     ZERO OUT RELOCATED TXT  1   3  21    IPL00730
         XC    256(256,R1),256(R1)                         1   3  24    IPL00740
         L     R1,0                SAVE IPL DEVICE ADDRESS 1   2  26    IPL00750
         LA    R2,LDRCHANP         LOAD A(CHANNEL PROG)    1   2  28    IPL00760
REMLEN   EQU   56-(LOADER-IPL1CRD1) AMT OF CARD 1 TO MOVE               IPL00770
* * *    END OF TXT CARD 1    * * *                                     IPL00780
IPL1CRD2 EQU   *                                                        IPL00790
         LA    R3,LDRBUF          LOAD A(BUFFER)           2   2   2    IPL00800
         STCM  R3,B'0111',1(R2)   RELOCATE ADDRESS IN CHAN 2   2   4    IPL00810
LDRSIO   DS    0H                 READ A CARD                           IPL00820
         ST    R2,72              LOAD CAW                 2   2   6    IPL00830
         SIO   0(R1)              READ A CARD              2   2   8    IPL00840
         BNZ   LDRERR             .. ERROR                 2   2  10    IPL00850
LDRTIO   EQU   *                  LOOP UNTIL I/O COMPLETE               IPL00860
         TIO   0(R1)              TEST                     2   2  12    IPL00870
         BZ    LDRMOV             .. SUCCESSFUL READ       2   2  14    IPL00880
         BC    1,LDRERR           .. ERROR                 2   2  16    IPL00890
         B     LDRTIO             .. NOT COMPLETE          2   2  18    IPL00900
LDRMOV   EQU   *                  WE HAVE A CARD                        IPL00910
         CLI   0(R3),X'02'        Q/ IS IT OBJECT DECK CARD2   2  20    IPL00920
         BNE   LDRERR             .. NO, ERROR             2   2  22    IPL00930
         CLC   LDREND,1(R3)       Q/ 'END' CARD?           2   3  25    IPL00940
         BE    LDREXEC            .. YES, GO EXEC LOADED PR2   2  27    IPL00950
         NOPR  0                  (ALIGNMENT)              2   1  28    IPL00960
* * *    END OF TXT CARD 2    * * *                                     IPL00970
IPL1CRD3 EQU   *                                                        IPL00980
         CLC   LDRTXT,1(R3)       Q/ 'TXT' CARD?           3   3   3    IPL00990
         BNE   LDRSIO             .. NO, IGNORE ALL OTHERS 3   2   5    IPL01000
         SR    R4,R4                                       3   1   6    IPL01010
         ICM   R4,B'0111',5(R3)   LOAD TXT LOAD ADDRESS    3   2   8    IPL01020
         LH    R5,10(,R3)         LOAD TXT LENGTH          3   2  10    IPL01030
         BCTR  R5,0               DECREMENT FOR EXECUTE    3   1  11    IPL01040
         EX    R5,LDRMVC          MOVE TXT TO MEMORY       3   2  13    IPL01050
*        MVC   0(*-*,R4),16(R3)                                         IPL01060
         B     LDRSIO             GO READ NEXT CARD        3   2  15    IPL01070
LDRMVC  MVC   0(*-*,R4),16(R3)   EXECUTED INSTRUCTION      3   3  18    IPL01080
*                                                                       IPL01090
LDRTXT   DC    C'TXT'             CONSTANTS                3   3  21    IPL01100
LDREND   DC    C'END'               "  "                       .        IPL01110
*                                                                       IPL01120
LDREXEC  DS    0H                 LOAD COMPLETE                         IPL01130
         LPSW  0                  EXECUTE LOADED PROGRAM   3   2  23    IPL01140
*                                                                       IPL01150
LDRERR   DS    0H                 ERROR ON LOAD                         IPL01160
         LPSW  WAITPSW            DISABLED WAIT            3   2  25    IPL01170
*                                                                       IPL01180
         DC    XL6'0'             TO END OF CARD 3         3   3  28    IPL01190
* * *    END OF TXT CARD 3    * * *                                     IPL01200
IPL1CRD4 EQU   *                                                        IPL01210
WAITPSW  DC    X'00',X'02',AL2(0) DISABLED WAIT PSW        4   2   2    IPL01220
         DC    X'00',AL3(LOADER)                           4   2   4    IPL01230
*                                                                       IPL01240
LDRCHANP DS    0D                 READ CHANNEL PROGRAM                  IPL01250
         DC    X'02',AL3(*-*)                              4   2   6    IPL01260
         DC    X'00',X'00',AL2(80)                         4   2   8    IPL01270
*                                                                       IPL01280
         DC    XL40'00'           (UNUSED TO END OF CARD  4  20  28     IPL01290
* * *    END OF TXT CARD 4    * * *                                     IPL01300
LDRBUF   DS    0D                 80 BYTE BUFFER BEGINS HERE            IPL01310
LDRLEN   EQU   *-LOADER           ACTUAL LENGTH OF LOADER               IPL01320
LDRREQ   EQU   LDRLEN+80          TOTAL STORAGE REQUIREMENT             IPL01330
*                                                                       IPL01340
         END   IPL1                                                     IPL01350



the code for a tape IPL is along the lines
Back to top
View user's profile Send private message
Hunny Sachdeva

New User


Joined: 11 Jun 2009
Posts: 20
Location: india

PostPosted: Mon Jun 15, 2009 3:30 pm    Post subject:
Reply with quote

my first question was how can we ipl from a tape if at all..

and i got the response that yes we can
but that raises a question "how to make a tape look exactly as SYSRES volume"

i hope the question is much clear now..
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8057
Location: East Dubuque, Illinois, USA

PostPosted: Mon Jun 15, 2009 3:45 pm    Post subject:
Reply with quote

You don't make a tape look exactly like a SYSRES volume. IPL from tape doesn't work the same -- it requires a standalone program which loads everything that is usually on the SYSRES volume from the tape.
Back to top
View user's profile Send private message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10256
Location: italy

PostPosted: Mon Jun 15, 2009 3:48 pm    Post subject: Reply to: Can we IPL using a Tape
Reply with quote

Quote:
have you ever done that or due you know somebody who has


yes,yes

here two more samples
the first one will build a tape with the standalone stuff
Code:
         PRINT NOGEN
         REGEQU
BUILDIPL CSECT
         STM   R14,R12,12(R13)         SAVE REGS
         LR    R3,R15                  GET BASE
         LA    R4,2048                 2048
         LA    R4,2048(R3,R4)          GET BASE + 4096
         USING BUILDIPL,R3,R4          ESTABLISH ADDRESSABILITY
         ST    R13,SA+4                SAVE PREV S.A. ADDRESS
         LA    R13,SA                  THIS SA ADDRESS IN R13
*
         OPEN  (IPLTXT,,TAPE,OUTPUT)
         LA    R12,TAPE
         USING IHADCB,R12
*
IPLREAD  EQU   *
         GET   IPLTXT,REC
         CLC   REC(4),TXTCARD           IS THIS A .TXT CARD?
         BNE   IPLREAD                  SKIP THE REST
         MVC   IPLPSW,REC+16            MOVE IPL PSW
*
         LA    R4,TBUFF
         L     R5,=F'32760'             BUFFER LENGTH
         SR    R7,R7                    SET PAD CHAR TO 0
         MVCL  R4,R6                    INITIALIZE THE BUFFER
*
         LA    R4,TBUFF                 ESTABLISH BUFFER POSITION
         SR    R8,R8                    SET UP ADJUSTMENT REG
         BCTR  R8,0                     -1
*
READ     EQU   *
         GET   IPLTXT,REC
         CLC   REC(4),TXTCARD           IS THIS A .TXT CARD?
         BNE   READ                     SKIP THE REST
*
BUILD    EQU   *
         SR    R5,R5                    CLEAR FOR IC
         IC    R5,REC+11                GET LENGTH ON THIS TXT CARD
         BCTR  R5,0                     MAKE IBM LENGTH
         SR    R6,R6                    CLEAR FOR ICM
         ICM   R6,7,REC+5               GET LOCATION ADDR
         CL    R8,=A(-1)                FIRST LOCATION ADJ SET?
         BNE   NOADJ                    ALREADY SET
         LR    R8,R6                    ADJUST BY 1ST TXT ADDRESS
*
NOADJ    EQU   *
         SR    R6,R8                    REDUCE ADJ TO BUFFER START
         AR    R6,R4                    ADDR IN OUR BUFFER
         EX    R5,MVCBLD                MOVE TXT TO BUFFER
*MVCBLD  MVC   0(0,R6),REC+16
         C     R6,=A(TBUFF+32760)       PAST END?
         BL    READ                     GO GET NEXT TXT CARD
*
         WTO   'TOTAL OBJECT SIZE MORE THAN 32760, ABORTED'
         B     QUIT
MVCBLD   MVC   0(0,R6),REC+16           EXECUTED INSTR
*
EOD      EQU   *
         LA    R6,1(R5,R6)              COMPUTE LAST BYTE USED
         LA    R5,TBUFF                 START OF BUFFER
         SR    R6,R5                    COMPUTE LENGTH USED
         STH   R6,IPLCCW3+6             STORE LEN IN CCW
         STCM  R8,7,IPLCCW3+1           SAVE FIRST LOAD ADDR IN CCW
*
         LA    R4,L'IPLREC
         STH   R4,DCBBLKSI
         STH   R4,DCBLRECL
         WRITE DECB,SF,TAPE,IPLREC,(R4),MF=E
         CHECK DECB
*
         LA    R4,L'IPLREC2
         STH   R4,DCBBLKSI
         STH   R4,DCBLRECL
         WRITE DECB,SF,TAPE,IPLREC2,(R4),MF=E
         CHECK DECB
*
         STH   R6,DCBBLKSI
         STH   R6,DCBLRECL
         WRITE DECB,SF,TAPE,(R5),(R6),MF=E
         CHECK DECB
*
DONE     EQU   *
         WTO   'IPLABLE TAPE CREATED'
*
QUIT     EQU   *
         CLOSE (IPLTXT,,TAPE)
         L     R13,4(,R13)             GET PREVIOUS S.A. ADDR
         LM    R14,R12,12(R13)         RESTORE REGS
         SR    R15,R15                 CLEAR ANY RETURN CODE
         BR    R14                     AND RETURN TO THE SYSTEM
         DROP  R3,R4
TAPE     DCB   DDNAME=TAPE,LRECL=80,BLKSIZE=80,RECFM=U,DSORG=PS,       X
               MACRF=W
IPLTXT   DCB   DDNAME=IPLTXT,LRECL=80,RECFM=FB,DSORG=PS,EODAD=EOD,     X
               MACRF=GM
         WRITE DECB,SF,TAPE,MF=L
*
         LTORG
SA       DS    9D
IPLREC   DS    0CL24
IPLPSW   DC    D'0'
IPLCCW1  CCW   X'02',X'100',X'40',16
IPLCCW2  CCW   X'08',X'100',X'40',0
*
IPLREC2  DS    0CL16
IPLCCW3  CCW   X'02',*-*,X'40',*-*
IPLCCW4  CCW   X'07',*-*,X'00',1
*
TXTCARD  DC    X'02',C'TXT'
REC      DS    CL80
TBUFF    DS    32760X
         DCBD  DSORG=PS,DEVD=TA
         END   BUILDIPL


the second is the actual thing that gets apended to the bootstrap
Code:
R0       EQU   0                                                        REG00040
R1       EQU   1                                                        REG00050
R2       EQU   2                                                        REG00060
R3       EQU   3                                                        REG00070
R4       EQU   4                                                        REG00080
R5       EQU   5                                                        REG00090
R6       EQU   6                                                        REG00100
R7       EQU   7                                                        REG00110
R8       EQU   8                                                        REG00120
R9       EQU   9                                                        REG00130
R10      EQU   10                                                       REG00140
R11      EQU   11                                                       REG00150
R12      EQU   12                                                       REG00160
R13      EQU   13                                                       REG00170
R14      EQU   14                                                       REG00180
R15      EQU   15                                                       REG00190
*                                                                       REG00200
FLC      DSECT                         DEFINE FIXED LOW CORE            ASM04650
         USING *,0                                                      ASM04660
RESNPSW  DS    D                       RESTART NEW PSW                  ASM04670
RESOPSW  DS    D                       RESTART OLD PSW                  ASM04680
IPLCCW2  DS    D                       IPL CCW 2                        ASM04690
EXTOPSW  DS    D                       EXTERNAL OLD PSW                 ASM04700
SVCOPSW  DS    D                       SVC OLD PSW                      ASM04710
PGMOPSW  DS    D                       PROGRAM OLD PSW                  ASM04720
MCHOPSW  DS    D                       MACHINE CHECK OLD PSW            ASM04730
IOOPSW   DS    D                       I/O OLD PSW                      ASM04740
CSW      DS    D                       CHANNEL STATUS WORD              ASM04750
CAW      DS    F                       CHANNEL ADDRESS WORD             ASM04760
         DS    F                       UNASSIGNED                       ASM04770
ITIMER   DS    F                       INTERVAL TIMER                   ASM04780
         DS    F                       UNASSIGNED                       ASM04790
EXTNPSW  DS    D                       EXTERNAL NEW PSW                 ASM04800
SVCNPSW  DS    D                       SVC NEW PSW                      ASM04810
PGMNPSW  DS    D                       PROGRAM NEW PSW                  ASM04820
MCHNPSW  DS    D                       MACHINE CHECK NEW PSW            ASM04830
IONPSW   DS    D                       I/O NEW PSW                      ASM04840
         DS    6X                      UNUSED                           ASM04850
EXTI     DS    2X                      EXTERNAL INT. CODE  (EC ONLY)    ASM04860
         DS    3X                                                       ASM04870
SVCI     DS    1X                      SVC      INT. CODE  (EC ONLY)    ASM04880
         DS    2X                                                       ASM04890
PGMI     DS    2X                      PGM      INIT CODE  (EC ONLY)    ASM04900
PGEXAD   DS    F                       PAGE EXECEPTION ADDRESS          ASM04910
         DS    36X                     UNUSED                           ASM04920
IOSCHA   DS    0XL4                    I/O SUBCHANNEL ADDR  (390 ONLY)
IOSID    DS    2X                          SUBCHANNEL ID
IOIA     DS    2X                          DEV ADDRESS     (EC ONLY)    ASM04930
         DS    6F                      UNUSED                           ASM04940
         ORG   FLC+X'800'              EXTEND ON TO FIXED LOW CORE
EXTRGSV  DS    16F                     EXT INTERRUPT REG SAVE AREA
SVCRGSV  DS    16F                     SVC INTERRUPT REG SAVE AREA
PGMRGSV  DS    16F                     PGM INTERRUPT REG SAVE AREA
IORGSV   DS    16F                     IO INTERRUPT REG SAVE AREA
CPUTIMER DS    D                       CPU TIMER STORE
TIMERCT  DS    F                       TIMER HEARTBEAT COUNTER
*
IPL390   CSECT
         DC    X'000C0000',A(TEST+X'80000000')
         ORG   *+X'FF8'
*
         PRINT GEN
TEST     EQU   *
         USING *,R11
         BALR  R11,0
         BCTR  R11,0
         BCTR  R11,0
         LA    R12,2048
         LA    R12,2048(R11,R12)
         USING TEST,R11,R12
REAL1    EQU   *
         MVC   SVCNPSW,SVCS              SET SVC NEW
         MVC   MCHNPSW,MCS               MACHINE CHECK NEW
         MVC   PGMNPSW,PGMS              PGM NEW
         MVC   EXTNPSW,EXTS              EXT NEW
         MVC   IONPSW,IOSATTN            I/O NEW
         STIDP CPUID                     STORE CPU ID
         STCTL 0,0,SAVE                  SAVE DEFAULT CR0
         OC    SAVE(4),CR0               INIT WITH OUR FLAGS
         LCTL  0,0,SAVE                  LOAD CR 0 MASKS
         LCTL  6,6,=X'FF000000'          LOAD I/O INTRPT CTL MASK
         MVI   163(0),X'00'              ENSURE OUR Z/MODE FLAG IS
*                                         NOT SET IN CASE STORAGE WAS
*                                         NOT CLEARED BY IPL 480 CLEAR
*
         L     R1,=X'00010000'           SET SUBCHANNEL 0000
         LA    R2,X'FFF'                 HIGHEST SUBCH WE WILL SUPPORT
*
ENABLE   EQU   *
         STSCH SCHIB                     STORE SUBCHANNEL INFO
         BC    1,NEXTSCH                 SUBCHANNEL NOT THERE
         OI    SCHIB+5,X'80'             ENABLE THE SUBCHANNEL
         MSCH  SCHIB                     TELL THE SUBCHANNEL
*
NEXTSCH  EQU   *
         LA    R1,1(,R1)                 COMPUTE NEXT SUBCHANNEL NUM
         BCT   R2,ENABLE                 GO FIND THEM ALL
*
         XC    TIMERCT,TIMERCT           INIT CPU TIMER INTRPT COUNT
         MVC   CPUTIMER,TIMER            INITIALIZE CPU TIMER STORE
         SPT   CPUTIMER                  START TIMER HEARTBEAT
*
ATTNWT   EQU   *
         LPSW  WAITPSW                   ENABLED WAIT FOR CONSOLE INT
*
IOINT    EQU   *
         L     R1,IOSCHA                 GET IO SUBCHANNEL ADDR
         ST    R1,CONADDR                SAVE POSSIBLE CONSOLE ADDR
*
IOTSCH0  EQU   *
         XC    IOIRB,IOIRB               CLEAR THE IRB
         TSCH  IOIRB                     GET INTERRUPT INFO
         BC    7,IOTSCH0                 WAIT UNTIL COMPLETE
*
         CLI   IOIRB+8,X'80'             WAS THIS AN ATTN INTERRUPT?
         BNE   ATTNWT                    NO, GO BACK TO SLEEP
*
         LA    R2,SENSEID                -> SENSE ID CCW
         BAL   R9,STARTIO                GO ISSUE SENSE ID COMMAND
*
         TM    IOIRB+8,X'0C'             CHAN END/DEV END ON SENSE?
         BNO   ERROR1                    NO, SHUT DOWN
*
         CLC   IDBUFF+4(2),=X'3278'      WAS THIS A 3270 DEVICE?
         BNE   ATTNWT                    NO, WAIT FOR ONE
*
* - WHEN HERE, "CONADDR" CONTAINS SUBCH ADDR OF 3270 CONSOLE TO USE
*
         MVC   IONPSW,IOSATTN            I/O NEW
*
         UNPK  SAVE2(9),CPUID(5)         CONVERT CPUID DISPLAYABLE HEX
         MVC   DISPCPU(8),SAVE2          MOVE TO THE DISPLAY PANEL
         TR    DISPCPU(8),HEXTRAN-240    XLATE THE HEX CHARS
         UNPK  SAVE2(9),CPUID+4(5)       DO SAME FOR LOW HALF CPUID
         MVC   DISPCPU+9(8),SAVE2
         TR    DISPCPU+9(8),HEXTRAN-240
*
*-- ISSUE WRITE STRUCTURED FIELD TO SEE HOW LARGE THE DISPLAY IS
*
         LA    R2,WSF                    -> TO WRITE SF CCW
         BAL   R9,STARTIO                GO ISSUE
*
         LA    R2,WSFINT                 SET I/O NEW PSW TO
         O     R2,=X'80000000'            31 BIT MODE AND
         ST    R2,IONPSW+4                POINT TO NEXT INTERRUPT RTN
         LPSW  WAITPSW                   WAIT FOR RPQ RESULTS INTRPT
*
*-- ISSUE READ TO GET THE STRUCTURED FIELD RESULTS
*
WSFINT   EQU   *
         XC    IOIRB,IOIRB               CLEAR IRB
         TSCH  IOIRB                     GET I/O COMPLETION INFO
         BC    7,WSFINT                  WAIT UNTIL COMPLETE
*
         LA    R2,READQ                  -> CCW TO READ THE WSF RESULTS
         BAL   R9,STARTIO                GO ISSUE
*
         LA    R2,UPDPANEL               SET I/O NEW PSW TO
         O     R2,=X'80000000'            31 BIT MODE AND
         ST    R2,IONPSW+4                POINT TO NEXT INTERRUPT RTN
*
*-- READ THE 3270 DISPLAY CONTENTS AND RE-DISPLAY THE PANEL
*-- THIS IS THE MAIN PROCESSING LOOP WHEN AN ATTENTION KEY IS PRESSED
*
UPDPANEL EQU   *
         XC    IOIRB,IOIRB               CLEAR THE IRB
         TSCH  IOIRB                     CLEAR THE INTERRUPT
*
         LA    R2,READ                   -> CCW TO READ 3270 DISPLAY
         BAL   R9,STARTIO                GO ISSUE THE CCW
         CLI   AID,X'F1'                 WAS PF1 PRESSED
         BE    ZARCH                     YES, GO TO Z MODE
         CLI   AID,X'F7'                 WAS PF7 PRESSED
         BE    BWD                       YES, GO BWD 1 PAGE
         CLI   AID,X'F8'                 WAS PF8 PRESSED
         BE    FWD                       YES, GO FWD 1 PAGE
         CLI   AID,X'7C'                 WAS PF12 PRESSED
         BE    QUIT                      YES, QUIT
*
REWRITE  EQU   *
         L     R2,TIMERCT                GET CPU TIMER COUNT
         CVD   R2,SAVE                   CONVERT
         UNPK  DISPTMR,SAVE              UNPK TO THE DISPLAY PANEL
         OI    DISPTMR+7,X'F0'           FIX SIGN
*
         BAL   R9,DISPLAY                GO FORMAT/DISPLAY STORAGE
*
         LA    R2,EWRITE                 -> CCW TO DISPLAY 3270 PANEL
         BAL   R9,STARTIO                GO ISSUE THE WRITE
*
         TM    163(0),X'01'              ARE WE IN Z/MODE?
         BO    ZWAIT                     YES
         LPSW  WAITPSW                   WAIT FOR ATTN KEY PRESS
ZWAIT    LPSWE ZWAITPSW                  ZMODE WAIT FOR ATTN KEY
*
*
*
*
*
*-- GET INTO Z/ARCHITECTURE MODE
*
ZARCH    EQU   *
         MVC   X'1B0'(4,0),=X'00040000'     SET UP EXT NEW PSW
         MVC   X'1B4'(4,0),=X'80000000'     31-BIT MODE
         MVC   X'1B8'(4,0),=X'00000000'
         MVC   X'1BC'(4,0),=A(EXTFLIH)      EXT NEW PSW Z/MODE
*
         MVC   X'1D0'(4,0),=X'00060000'     SET UP PGM NEW PSW
         MVC   X'1D4'(4,0),=X'80000000'     31-BIT MODE
         MVC   X'1D8'(4,0),=X'00000000'
         MVC   X'1DC'(4,0),=X'00009999'     BOGUS ADDR IF PGM CHECK
*
         MVC   X'1F0'(4,0),=X'00040000'     SET UP EXT NEW PSW
         MVC   X'1F4'(4,0),=X'80000000'     31-BIT MODE
         MVC   X'1F8'(4,0),=X'00000000'
         MVC   X'1FC'(4,0),=A(UPDPANEL)     IO NEW PSW Z/MODE
*
         SR    R2,R2                        STATUS REG SET TO 0
         LA    R3,1                         R3=1 MEANS SET Z/ARCH MODE
*                                           R3=0 MEANS SET ESA/390 MODE
         SR    R4,R4                        CPU PREFIX REG = 0
         SIGP  2,4,X'12'                    X'12' = SET ARCHITECTURE
         OI    X'A3'(0),X'01'               INDICATE NOW IN Z/MODE
         MVC   MODE,MODEZ                   MOVE NEW MODE TO PANEL
         B     REWRITE
*
*-- HERE IF PF12 PRESSED - LOAD DISABLED WAIT PSW
*
QUIT     EQU   *
         LA    R2,CLEAR                  -> CCW TO CLEAR DISPLAY
         BAL   R9,STARTIO                GO START THE I/O
         LPSW  FINAL                     LOAD QUIT DISABLED WAIT PSW
*
*-- START THE SUBCHANNEL TO EXECUTE A CCW
*
STARTIO  EQU   *
         ST    R2,ORBCCW                 PUT IN ORB
         SSCH  IOORB                     START THE SUBCHANNEL
         BC    7,*                       LOOP IF NOT OPER
IOTSCH   EQU   *
         XC    IOIRB,IOIRB               CLEAR IRB
         TSCH  IOIRB                     GET I/O COMPLETION INFO
         BC    7,IOTSCH                  WAIT UNTIL COMPLETE
         BR    R9                        RETURN
*
*-- INCREMENT THE MEMORY ADDRESS TO THE NEXT PAGE
*
FWD      EQU   *
         L     R4,MEMADDR
         LA    R4,256(,R4)
         ST    R4,MEMADDR
         B     REWRITE
*
*-- DECREMENT THE MEMORY ADDRESS TO THE PREVIOUS PAGE
*
BWD      EQU   *
         L     R4,MEMADDR
         S     R4,=F'256'
         BM    REWRITE                   DONT LET IT GO NEGATIVE
         ST    R4,MEMADDR
         B     REWRITE
*
*-- FILL IN THE HEX FIELDS ON THE DISPLAY PANEL
*
DISPLAY  EQU   *
         L     R4,MEMADDR                GET MEM ADDR TO DISPLAY
         LA    R5,64                     64 WORDS SHOWN ON PANEL
         LA    R6,DISPLTAB               LIST OF PANEL ADDRESSES
*
DISP010  EQU   *
         UNPK  SAVE(9),0(5,R4)           ADD ZONES TO A WORD
         TR    SAVE(8),HEXTRAN-240       MAKE DISPLAYABLE HEX
         L     R7,0(,R6)                 GET ADDR OF WORD ON PANEL
         MVC   4(8,R7),SAVE              MOVE DISPLAYABLE WORD TO PANEL
*
         LA    R6,4(,R6)                 NEXT PANEL WORD
         LA    R4,4(,R4)                 NEXT MEMORY WORD
         BCT   R5,DISP010                KEEP FORMATTING
*
         L     R4,MEMADDR                GET MEM ADDR TO DISPLAY
         LA    R5,16                     16 CHARACTER TRANSLATION LINES
         LA    R6,CHARTAB                LIST OF PANEL ADDRESSES
*
DISP020  EQU   *
         L     R7,0(,R6)                 GET ADDR OF AREA ON PANEL
         MVC   0(16,R7),0(R4)            MOVE MEMORY TO PANEL
         TR    0(16,R7),TRTAB            DISPLAY SELECTED TRANSLATION
*
         LA    R6,4(,R6)                 NEXT PANEL LINE
         LA    R4,16(,R4)                NEXT MEMORY AREA
         BCT   R5,DISP020                KEEP FORMATTING
*
         L     R4,MEMADDR                GET MEM ADDR TO DISPLAY
         LA    R5,16                     16 LINES SHOWN ON PANEL
         LA    R6,ADDRTAB                LIST OF PANEL ADDRESSES
*
DISP030  EQU   *
         ST    R4,SAVE2+4                SAVE MEM ADDR
         UNPK  SAVE(9),SAVE2+4(5)        ADD ZONES TO A WORD
         TR    SAVE(8),HEXTRAN-240       MAKE DISPLAYABLE HEX
         L     R7,0(,R6)                 GET ADDR OF WORD ON PANEL
         MVC   5(8,R7),SAVE              MOVE DISPLAYABLE WORD TO PANEL
*
         LA    R6,4(,R6)                 NEXT PANEL WORD
         LA    R4,16(,R4)                NEXT MEMORY WORD
         BCT   R5,DISP030                KEEP FORMATTING
         BR    R9
*
*
*----
*
WAIT     LPSW  WAITPSW                   ENABLED WAIT
ERROR1   LPSW  ERRPSW1                   DISABLED WAIT ERROR
SAVE     DS    D
SAVE2    DS    2D
CPUID    DS    D
CONADDR  DS    F
MEMADDR  DC    A(0)                      MEMORY ADDR DISPLAYED
CR0      DS    0XL4
         DC    X'00'  0-7
         DC    X'00'  8-15
         DC    X'04'  16-23  .... X1..   ENABLE CPU TIMER MASK
*                                 .-----> X=CLOCK COMPARATOR MASK
         DC    X'00'  24-31
         DS    0D
IOORB    DC    A(*)             WORD 0    ADDR OF THIS ORB
         DC    X'0000FF00'        1       LPM SET TO FF
ORBCCW   DC    A(-1)              2       CCW ADDR
         DC    A(0)               3
         DC    A(0)               4
         DC    A(0)               5
         DC    A(0)               6
         DC    A(0)               7
IOIRB    DC    24A(0)
SCHIB    DC    24A(0)
SENSEID  CCW   X'E4',IDBUFF,X'00',7
PLSENSE  CCW   X'04',X'F0',X'00',24
EWRITE   CCW   X'05',TBUFF,X'00',TBUFFL    X'0D' IS ERASE WRITEA
CLEAR    CCW   X'05',CLRSC,X'00',5         CLEAR SCREEN
WSF      CCW   X'11',RPQ,X'00',7           WSF READ PARTITION QUERY
READ     CCW   X'06',RBUFF,X'20',100       READ DATA (BUT LIMIT TO 100)
READQ    CCW   X'06',RPQBUF,X'00',24       READ QUERY RESULT
*
LOWCORE  DS    0D
SVCS     DC    X'000E000000000011'         SVC NEW PSW
MCS      DC    X'000E000000000022'         MACHINE CHECK NEW PSW
IOSATTN  DC    X'000C000080',AL3(IOINT)    IO NEW PSW FOR INITIAL ATTN
IOS      DC    X'000C000080',AL3(IOFLIH)   IO NEW PSW
PGMS     DC    X'000E000000000033'         PGM NEW PSW
EXTS     DC    X'000C000080',AL3(EXTFLIH)  EXTERNAL NEW PSW
*
TIMER    DC    X'0000000100000000'      ROUGHLY ONE SECOND
*
         DS    0D
ZWAITPSW DC    X'03060000000000000000000000000000'
WAITPSW  DC    X'030E000000000000'      ENABLED WAIT PSW
ERRPSW1  DC    X'000E000000000101'      DISABLE WAIT - BAD SENSE ID I/O
FINAL    DC    X'000E000000000002'      DISABLE WAIT - WE QUIT
MODEZ    DC    X'A9',CL5'/ARCH'         LOWER CASE Z IS X'A9'
*
IDBUFF   DS    XL7                      SENSE ID BUFFER
CLRSC    DC    X'C311404013'            CURSOR TO 1,1
RPQ      DC    X'000701FF030081'      READ PARTITION QUERY
*                ----        XX ------> QUERY CODE FOR USABLE AREA
*                LEN       XX---------> X'00'=SPECIFIC QUERY CODE
*                        XX-----------> X'03'=SPECIFIC QUERY CODE LIST
*                      XX-------------> X'FF'=QUERY OPERATION
*                    XX---------------> X'01'=WSF IS READ PART'N QUERY
*
*
*
*
*
         DS    0D
         DC    CL8'RPQBUF'               EYECATCHER TO VIEW RPQ RESULT
RPQBUF   DC    24X'00'
RBUFF    DS    0XL100
AID      DS    X                         AID BYTE
CURSOR   DS    2X                        CURSOR POSITION ON READ
RDATA    DS    97X                       INPUT DATA STREAM
*
TBUFF    DC    X'C31140401D40',C'DEVICE 580  TIMER='
DISPTMR  DC    CL8' '
         DC    CL22' ',C'CPUID='
DISPCPU  DC    CL17' '
*
A00ADR   DC    X'11C2601DF0',CL8'00000000'
A00WD1   DC    XL4'1DF01D40',CL8'00000000'
A00WD2   DC    XL4'1DF01D40',CL8'00000000'
A00WD3   DC    XL4'1DF01D40',CL8'00000000'
A00WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A00TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A01ADR   DC    X'11C3F01DF0',CL8'00000000'
A01WD1   DC    XL4'1DF01D40',CL8'00000000'
A01WD2   DC    XL4'1DF01D40',CL8'00000000'
A01WD3   DC    XL4'1DF01D40',CL8'00000000'
A01WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A01TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A02ADR   DC    X'11C5401DF0',CL8'00000000'
A02WD1   DC    XL4'1DF01D40',CL8'00000000'
A02WD2   DC    XL4'1DF01D40',CL8'00000000'
A02WD3   DC    XL4'1DF01D40',CL8'00000000'
A02WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A02TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A03ADR   DC    X'11C6501DF0',CL8'00000000'
A03WD1   DC    XL4'1DF01D40',CL8'00000000'
A03WD2   DC    XL4'1DF01D40',CL8'00000000'
A03WD3   DC    XL4'1DF01D40',CL8'00000000'
A03WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A03TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A04ADR   DC    X'11C7601DF0',CL8'00000000'
A04WD1   DC    XL4'1DF01D40',CL8'00000000'
A04WD2   DC    XL4'1DF01D40',CL8'00000000'
A04WD3   DC    XL4'1DF01D40',CL8'00000000'
A04WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A04TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A05ADR   DC    X'11C8F01DF0',CL8'00000000'
A05WD1   DC    XL4'1DF01D40',CL8'00000000'
A05WD2   DC    XL4'1DF01D40',CL8'00000000'
A05WD3   DC    XL4'1DF01D40',CL8'00000000'
A05WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A05TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A06ADR   DC    X'114A401DF0',CL8'00000000'
A06WD1   DC    XL4'1DF01D40',CL8'00000000'
A06WD2   DC    XL4'1DF01D40',CL8'00000000'
A06WD3   DC    XL4'1DF01D40',CL8'00000000'
A06WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A06TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A07ADR   DC    X'114B501DF0',CL8'00000000'
A07WD1   DC    XL4'1DF01D40',CL8'00000000'
A07WD2   DC    XL4'1DF01D40',CL8'00000000'
A07WD3   DC    XL4'1DF01D40',CL8'00000000'
A07WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A07TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A08ADR   DC    X'114C601DF0',CL8'00000000'
A08WD1   DC    XL4'1DF01D40',CL8'00000000'
A08WD2   DC    XL4'1DF01D40',CL8'00000000'
A08WD3   DC    XL4'1DF01D40',CL8'00000000'
A08WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A08TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A09ADR   DC    X'114DF01DF0',CL8'00000000'
A09WD1   DC    XL4'1DF01D40',CL8'00000000'
A09WD2   DC    XL4'1DF01D40',CL8'00000000'
A09WD3   DC    XL4'1DF01D40',CL8'00000000'
A09WD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A09TR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0AADR   DC    X'114F401DF0',CL8'00000000'
A0AWD1   DC    XL4'1DF01D40',CL8'00000000'
A0AWD2   DC    XL4'1DF01D40',CL8'00000000'
A0AWD3   DC    XL4'1DF01D40',CL8'00000000'
A0AWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0ATR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0BADR   DC    X'1150501DF0',CL8'00000000'
A0BWD1   DC    XL4'1DF01D40',CL8'00000000'
A0BWD2   DC    XL4'1DF01D40',CL8'00000000'
A0BWD3   DC    XL4'1DF01D40',CL8'00000000'
A0BWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0BTR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0CADR   DC    X'11D1601DF0',CL8'00000000'
A0CWD1   DC    XL4'1DF01D40',CL8'00000000'
A0CWD2   DC    XL4'1DF01D40',CL8'00000000'
A0CWD3   DC    XL4'1DF01D40',CL8'00000000'
A0CWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0CTR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0DADR   DC    X'11D2F01DF0',CL8'00000000'
A0DWD1   DC    XL4'1DF01D40',CL8'00000000'
A0DWD2   DC    XL4'1DF01D40',CL8'00000000'
A0DWD3   DC    XL4'1DF01D40',CL8'00000000'
A0DWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0DTR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0EADR   DC    X'11D4401DF0',CL8'00000000'
A0EWD1   DC    XL4'1DF01D40',CL8'00000000'
A0EWD2   DC    XL4'1DF01D40',CL8'00000000'
A0EWD3   DC    XL4'1DF01D40',CL8'00000000'
A0EWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0ETR    DC    CL16' '
         DC    C'*',X'1DF040'
*
A0FADR   DC    X'11D5501DF0',CL8'00000000'
A0FWD1   DC    XL4'1DF01D40',CL8'00000000'
A0FWD2   DC    XL4'1DF01D40',CL8'00000000'
A0FWD3   DC    XL4'1DF01D40',CL8'00000000'
A0FWD4   DC    XL4'1DF01D40',CL8'00000000'
         DC    X'1DF0401D40',C'*'
A0FTR    DC    CL16' '
         DC    C'*',X'1DF040'
*
         DC    X'11D8C31DF8'
ERR      DC    CL50' '
         DC    X'1DF040115A501DF8'
         DC    C'==>',X'1DC813'
CMDLINE  DC    CL75' '
         DC    X'1DF040115CF01DF8'
         DC    C'PFKEYS  1=SWITCH TO Z/ARCH  7=PREV  8=NEXT  12=QUIT'
         DC    C'               MODE='
MODE     DC    CL6'S/390'
         DC    X'1DF0'
TBUFFL   EQU   *-TBUFF
*
HEXTRAN  DC    CL16'0123456789ABCDEF'
         DS    0F
DISPLTAB DC    A(A00WD1)
         DC    A(A00WD2)
         DC    A(A00WD3)
         DC    A(A00WD4)
         DC    A(A01WD1)
         DC    A(A01WD2)
         DC    A(A01WD3)
         DC    A(A01WD4)                        TABLE
         DC    A(A02WD1)
         DC    A(A02WD2)
         DC    A(A02WD3)
         DC    A(A02WD4)
         DC    A(A03WD1)
         DC    A(A03WD2)                         FOR
         DC    A(A03WD3)
         DC    A(A03WD4)
         DC    A(A04WD1)
         DC    A(A04WD2)
         DC    A(A04WD3)
         DC    A(A04WD4)                       DISPLAY
         DC    A(A05WD1)
         DC    A(A05WD2)
         DC    A(A05WD3)
         DC    A(A05WD4)
         DC    A(A06WD1)
         DC    A(A06WD2)
         DC    A(A06WD3)
         DC    A(A06WD4)
         DC    A(A07WD1)
         DC    A(A07WD2)                        FIELDS
         DC    A(A07WD3)
         DC    A(A07WD4)
         DC    A(A08WD1)
         DC    A(A08WD2)
         DC    A(A08WD3)
         DC    A(A08WD4)
         DC    A(A09WD1)
         DC    A(A09WD2)
         DC    A(A09WD3)
         DC    A(A09WD4)
         DC    A(A0AWD1)
         DC    A(A0AWD2)
         DC    A(A0AWD3)
         DC    A(A0AWD4)
         DC    A(A0BWD1)
         DC    A(A0BWD2)
         DC    A(A0BWD3)
         DC    A(A0BWD4)
         DC    A(A0CWD1)
         DC    A(A0CWD2)
         DC    A(A0CWD3)
         DC    A(A0CWD4)
         DC    A(A0DWD1)
         DC    A(A0DWD2)
         DC    A(A0DWD3)
         DC    A(A0DWD4)
         DC    A(A0EWD1)
         DC    A(A0EWD2)
         DC    A(A0EWD3)
         DC    A(A0EWD4)
         DC    A(A0FWD1)
         DC    A(A0FWD2)
         DC    A(A0FWD3)
         DC    A(A0FWD4)
*
ADDRTAB  DC    A(A00ADR,A01ADR,A02ADR,A03ADR)
         DC    A(A04ADR,A05ADR,A06ADR,A07ADR)
         DC    A(A08ADR,A09ADR,A0AADR,A0BADR)
         DC    A(A0CADR,A0DADR,A0EADR,A0FADR)
*
CHARTAB  DC    A(A00TR,A01TR,A02TR,A03TR,A04TR,A05TR,A06TR,A07TR)
         DC    A(A08TR,A09TR,A0ATR,A0BTR,A0CTR,A0DTR,A0ETR,A0FTR)
*
*                 0 1 2 3 4 5 6 7 8 9 A B C D E F
TRTAB    DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  0        TR TABLE
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  1
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  2
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  3          FOR
         DC    X'404B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  4
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  5
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  6
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  7        CHARACTER
         DC    X'4B8182838485868788894B4B4B4B4B4B'  8
         DC    X'4B9192939495969798994B4B4B4B4B4B'  9
         DC    X'4B4BA2A3A4A5A6A7A8A94B4B4B4B4B4B'  A
         DC    X'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'  B        CONVERSION
         DC    X'4BC1C2C3C4C5C6C7C8C94B4B4B4B4B4B'  C
         DC    X'4BD1D2D3D4D5D6D7D8D94B4B4B4B4B4B'  D
         DC    X'4B4BE2E3E4E5E6E7E8E94B4B4B4B4B4B'  E
         DC    X'F0F1F2F3F4F5F6F7F8F94B4B4B4B4B4B'  F
         LTORG
*
EXTFLIH  CSECT
         STM   R0,R15,EXTRGSV            SAVE REGS
         DC    X'0D30'   BASR R3,0       ESTABLISH BASE REG
         LA    R1,*-EXTFLIH              DISTANCE FROM ENTRY
         SR    R3,R1                     COMPUTE ENTRY ADDR
         USING EXTFLIH,R3
         CLC   EXTI,=X'1005'             CPU TIMER EXPIRY?
         BE    EXTCPT                    YES
         CLC   EXTI,=X'0040'             EXTERNAL INT KEY?
         BE    EXTEXIT                   NO,
         B     EXTEXIT
*
EXTCPT   EQU   *
         L     R15,TIMERCT               TIMER INTERRUPT COUNT
         LA    R15,1(,R15)               BUMP COUNT
         ST    R15,TIMERCT               PUT BACK
         SPT   CPUTIMER                  SET NEW TIMER
         B     EXTEXIT
*
EXTEXIT  EQU   *
         TM    163(0),X'01'              ARE WE IN Z/MODE ?
         BO    EXTZXIT                   YES
         LM    R0,R15,EXTRGSV            RESTORE REGS
         LPSW  EXTOPSW                   RETURN FROM OTHER EXTERNALS
*
EXTZXIT  EQU   *
         LM    R0,R15,EXTRGSV            RESTORE REGS
         LPSWE X'130'(0)                 LOAD EXT OLD PSW Z/MODE
         LTORG
*
IOFLIH   CSECT
         STM   R0,R15,IORGSV             SAVE REGS
         DC    X'0D30'   BASR R3,0       ESTABLISH BASE REG
         LA    R1,*-IOFLIH               DISTANCE FROM ENTRY
         SR    R3,R1                     COMPUTE ENTRY ADDR
         USING IOFLIH,R3
*
IOEXIT   EQU   *
         TM    163(0),X'01'              ARE WE IN Z/MODE ?
         BO    IOZXIT                    YES
         LM    R0,R15,IORGSV             RESTORE REGS
         LPSW  IOOPSW                    RETURN FROM I/O INTERRUPT
*
IOZXIT   EQU   *
         LM    R0,R15,IORGSV             RESTORE REGS
         LPSWE X'170'(0)                 LOAD I/O OLD PSW Z/MODE
         LTORG
         END   IPL390
Back to top
View user's profile Send private message
Hunny Sachdeva

New User


Joined: 11 Jun 2009
Posts: 20
Location: india

PostPosted: Mon Jun 15, 2009 3:58 pm    Post subject:
Reply with quote

thanks guys..

that clears my doubts..
i will use it let know how it works for me..
Back to top
View user's profile Send private message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10256
Location: italy

PostPosted: Mon Jun 15, 2009 4:04 pm    Post subject: Reply to: Can we IPL using a Tape
Reply with quote

i do not see any reason for You to use it

in a real environment the only reason to use tapes is for emergencies and system malfunctions
by having iplable tapes of

standalone :
dump ( service aid )
ICKSADSF ( disk initialization program )
ADRDSSU ( dump restore )

the instructions on how to create an Iplable tape are contained in the relevan manuals

the samples posted are just toys without any real use
no error recovery, for example, nor proper user interface for messages
so... beware
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> All Other Mainframe Topics All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Length of Tape file Mohan Kothakota JCL & VSAM 9 Thu Apr 20, 2017 10:24 pm
No new posts TAPE VERIFY utility?? MrExtraordinare JCL & VSAM 3 Fri Dec 09, 2016 10:57 pm
No new posts stacking files on a tape Pedro JCL & VSAM 7 Wed Aug 17, 2016 11:11 pm
No new posts Reading selected volumes of a multi-v... RickBig JCL & VSAM 6 Wed Jul 13, 2016 7:26 pm
No new posts How to copy Tape dataset to unix main... chaky All Other Mainframe Topics 4 Fri Jul 08, 2016 2:52 am


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us