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
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
Joined: 06 Jun 2008 Posts: 8696 Location: Dubuque, Iowa, USA
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.
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
