|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 11938 (0x2ea2)
Types: s3xseg
Names: »S$E044«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E044«
MACRO 00010000
$E044 00020000
GBLB &MIN MIN SYS GLOBAL 00030000
GBLB &BSCA 00040000
GBLB &MLTA 00050000
GBLB &DFF DFF GLOBAL 00060000
GBLB &DPF DPF GLOBAL @01 00070000
LCLC &# 00080000
LCLC &LVLIH 00090000
TEXT 00100000
&LVLIH SETC 'B' 00110000
AIF (&BSCA).NOC 00120000
&LVLIH SETC 'C' 00130000
.NOC ANOP 00140000
&# SETC ' ' 00150000
TITLE 'COMMON&#.INTERRUPT&#.HANDLER&#.$CC4IH' 00160000
* BEGIN MACRO '$E044' 3/13/73 00170000
SPACE 2 00180000
*********************************************************************** 00190000
* NAME -- $CC4IH * 00200000
* * 00210000
* TITLE -- INTERRUPT HANDLER COMMON SUBROUTINE * 00220000
* * 00230000
* FUNCTION -- * 00240000
* * 00250000
* . DETERMINE IF THE CURRENT CCP TASK IS IN THE * 00260000
* MUST-COMPLETE STAGE AND, IF NOT, CHANGE THE CCP PROGRAM * 00270000
* LEVEL IAR TO CAUSE THE CCP LEVEL TO RESUME FOLLOWING * 00280000
* INTERRUPT LEVEL PROCESSING IN THE CCP DISPATCHER. * 00290000
* . SAVE THE CURRENT TASK'S DISPATCHER CONTROL BYTE $DPFLG * 00300000
* AND SET BOTH DISPATCHER CONTROL BYTES ($DPFLG + $DPFLH) * 00310000
* TO CAUSE THE DISPATCHER TO SAVE THE INTERRUPTED TASK'S * 00320000
* STATUS, PROCESS THE INTERRUPT, AND RESUME THE * 00330000
* INTERRUPTED TASK. * 00340000
* . PREVENT RECURSIVE ENTRY DURING A NESTED INTERRUPT TO * 00350000
* INSURE DATA AND INSTRUCTION ADDRESS REGISTER INTEGRITY. * 00360000
* * 00370000
* OPERATION -- * 00380000
* * 00390000
* . POST THE CCP TO HANDLE INTERRUPTS BY POSTING FLAG BITS IN * 00400000
* THE CCP WORK AREA. * 00410000
* * 00420000
* ENTRY POINT -- $CC4IH * 00430000
* * 00440000
* OUTPUT -- * 00450000
* * 00460000
* . CCP PROGRAM LEVEL IAR RESET TO THE ENTRY ADDRESS OF THE * 00470000
* CCP DISPATCHER $CC4DP. * 00480000
* . CCP DISPATCHER FLAG BYTES $DPFLG + $DPFLH SET TO CAUSE * 00490000
* INTERRUPT PROCESSING BY THE APPROPRIATE CCP ROUTINE. * 00500000
* * 00510000
* EXTERNAL REF -- * 00520000
* * 00530000
* . CCP COMMON WORK AREA $CCCOM, CURRENT TCB, THE INVOKING * 00540000
* INTERRUPT LEVEL ROUTINES NEXT SEQUENTIAL INSTRUCTION * 00550000
* VIA AN EXTRN AND ADDRESS CONSTANT. * 00560000
* * 00570000
* EXIT, NORMAL -- * 00580000
* * 00590000
* . TO INVOKER VIA ARR. * 00600000
* . TO INVOKER OF NESTED LOWER LEVEL INTERRUPTS BY * 00610000
* RESETTING THE LOWER INTERRUPT LEVEL'S IAR TO THE * 00620000
* ADDRESS OF THE INSTRUCTION FOLLOWING THE BRANCH TO * 00630000
* $CC4IH. * 00640000
* * 00650000
* EXIT, ERROR -- NONE * 00660000
* * 00670000
* TABLES -- NONE * 00680000
* * 00690000
* ATTRIBUTES -- * 00700000
* * 00710000
* . RESIDENT, INTERRUPTABLE, EFFECTIVELY REENTRANT THRU * 00720000
* DEPENDENCIES IN THE INVOKING INTERRUPT ROUTINES. * 00730000
* * 00740000
*********************************************************************** 00750000
SPACE 4 00760000
*********************************************************************** 00770000
* ENTRY NAMES, EXTERNAL NAMES, EQUATES, + WORK AREAS * 00780000
*********************************************************************** 00790000
SPACE 1 00800000
EXTRN SETC LABEL IN CONSOLE INTERRUPT 00810000
AIF (&BSCA NE '1').NBSC1 00820000
EXTRN SETB BSCA INTRRUPT HANDLER 00830000
.NBSC1 ANOP 00840000
SPACE 1 00850000
BASE EQU XR2 BASE REGISTER EQUATE 00860000
SPACE 1 00870000
*********************************************************************** 00880000
* MAIN PROCESSING SECTION OF ROUTINE * 00890000
*********************************************************************** 00900000
SPACE 2 00910000
$CC4IH EQU * START OF COMMON INTERRUPT RTN 00920000
LA $CC4IH,BASE 00930000
USING $CC4IH,BASE 00940000
SPACE 2 00950000
LA $CCCOM,XR1 GET @ OF CCP COMMON 00960000
SPACE 1 00970000
*********************************************************************** 00980000
* DETERMINE IF THE CCP CAN BE REROUTED TO HANDLE THIS INTERRUPT * 00990000
*********************************************************************** 01000000
SPACE 1 01010000
SPACE 1 01020000
AIF (&MIN).MIN1 MIN SYS?? 01030000
TBN $DPFLH(,XR1),DPHALT IS $CC4DP IN HALT LOGIC? 01040000
JF IHNOT NO, CONTINUE 01050000
* YES, RESET HIS IAR TO 01060000
* GET OUT OF THE HALT LOGIC 01070000
IHLOAD EQU *+1+## IAR Q-BYTE MODIFIED 01080000
L IH@HPL,## RELOAD CCP'S IAR TO RESET IT 01090000
J IHEXIT EXIT COMMON INTERRUPT HANDLER 01100000
SPACE 1 01110000
.MIN1 ANOP 01120000
IHNOT TBF $DPFLH(,XR1),DPCI+DPRIT HAS AN INTERRUPT ALREADY BEEN 01130000
* PROCESSED 01140000
TBF #OPEND(,XR1),ALLBIT OR THE COMM TASK OP END COUNT 01150000
* NON-ZERO 01160000
JF EXIT NO NEED TO PROCESS IF ANY ON 01170000
SPACE 2 01180000
*---------------------------------------------------------------------* 01190000
* SEE IF THE CCP IS IN THE USER PROGRAM AREA OR NOT AND * 01200000
* INTERRUPT ONLY IF YES * 01210000
*---------------------------------------------------------------------* 01220000
SPACE 1 01230000
IHIAR EQU *+1 SYMBOL FOR MODIFED Q-BYTE 01240000
ST CCPIAR(,BASE),### *S* Q BYTE IS SET BY START UP OF CCP 01250000
* TO THE VALUE FOR THE CCP IAR 01260000
* STOW THE CCP IAR FOR COMPARISON 01270000
CLC @UALFA(2,XR1),CCPIAR(,BASE) IS CCP IAR IN UPA OR HIGHER 01280000
JH EXIT NO, EXIT WITHOUT WRENCHING 01290000
SPACE 1 01300000
AIF (&DFF NE '1').NDFF 01310000
SPACE 1 01320000
*---------------------------------------------------------------------* 01330000
* SEE IF CCP IS IN THE D.F.F. CODE AND DON'T WRENCH IF SO * 01340000
*---------------------------------------------------------------------* 01350000
SPACE 1 01360000
CLC #DFBEG(2,XR1),CCPIAR(,BASE) CCP IN DFF? 01370000
JH IHWRNH NO, WRENCH IAR FROM USER PGM 01380000
SPACE 1 01390000
*------MAYBE NOT, SEE IF IN DFF EXPLICITLY----------------------------* 01400000
SPACE 1 01410000
CLC #DFEND(2,XR1),CCPIAR(,BASE) ACTUALLY IN DFF? 01420000
JNL IHEXIT YES, EXIT WITHOUT WRENCHING 01430000
.NDFF ANOP 01440000
SPACE 1 01450000
*------IS IN A USER PROGRAM, CHANGE CCP IAR---------------------------* 01460000
SPACE 1 01470000
*********************************************************************** 01480000
* AT THIS POINT IT HAS BEEN DETERMINED THAT THE CURRENT TCB * 01490000
* CAN BE INTERRUPTED TO ALLOW THE CCP TO PROCESS THE INTERRUPT * 01500000
*********************************************************************** 01510000
SPACE 1 01520000
SPACE 2 01530000
*********************************************************************** 01540000
* THIS CODE WILL PRESERVE THE SETTING OF THE $DPFLG BITS * 01550000
* DPREG + DPDSP FOR THE TASK TO BE INTERRUPTED. * 01560000
*********************************************************************** 01570000
SPACE 2 01580000
IHWRNH MVC IHMVA+3(2,BASE),@CURTB(,XR1) GET THE ADDRESS OF THE 01590000
* * CURRENT TASK CONTROL BLOCK 01600000
* * FROM THE COMM. AREA 01610000
* 01620000
ALC IHMVA+3(2,BASE),IHTFLG(,BASE) STEP THE INSTRUCTION ADDR 01630000
* * TO THE ADDRESS OF THE CURRENT 01640000
* * TASKS TCBFLG BYTE 01650000
* 01660000
IHMVA MVC ###(1),$DPFLG(,XR1) MOVE $DPFLG INTO THE TO-BE-INTR. 01670000
* * TASKS TCB 01680000
* 01690000
SBF $DPFLG(,XR1),DPREG+DPDSP RESET $DPFLG PRIOR TO 01700000
* GIVING CONTROL TO $DD4DP 01710000
SPACE 2 01720000
SPACE 1 01730000
SLC SETIAR+3(,BASE),IHCUTB(2,BASE) REINITIALIZE THE TCBIAR STOW01740000
* INSTRUCTION PRIOR TO MODIFICA- 01750000
* TION 01760000
MVC IHCUTB(2,BASE),@CURTB(,XR1) SAVE THE CURRENT TCB @ FOR THE 01770000
* NEXT ENTRY RE-INITIALIZATION 01780000
ALC SETIAR+3(,BASE),IHCUTB(2,XR2) COMPUTE THE ADDRESS OF THE 01790000
* TCBIAR WHERE THE CCP IAR IS TO 01800000
* BE SAVED FOR TASK RESUME 01810000
SETIAR ST TCBIAR-TCBCCP,### *S* SAVE THE CCP IAR IN THE TCB 01820000
* Q BYTE SET BY CCP START-UP 01830000
IHIAR2 EQU SETIAR+1 Q BYTE MODIFIED ADDRESS 01840000
SPACE 1 01850000
SBN $DPFLG(,XR1),DPREG SET SAVE REG FLAG FOR $CC4DP 01860000
SBN $DPFLH(,XR1),DPINT+DPRIT TELL $CC4DP THAT... 01870000
* 1. ENTRY IS FROM AN INTERRUPT 01880000
* 2. AN INTERRUPTED TASK EXISTS 01890000
SPACE 1 01900000
IHIAR3 EQU *+1 01910000
L @CC4DP,### *S* RESET THE CCP IAR TO ENTER THE 01920000
* CCP DISPATCHER TO PROCESS 01930000
* THE INTERRUPT THAT OCCURRED 01940000
SPACE 2 01950000
*********************************************************************** 01960000
* EXIT FROM THE INTERRUPT SUBROUTINE TO THE INVOKING INTERRUPT * 01970000
* LEVEL HANDLER. TEST AND RESET THE IAR'S OF THE LOWER LEVEL * 01980000
* INTERRUPT HANDLERS IF THEY ARE CURRENTLY ACTIVE WITHIN THIS * 01990000
* ROUTINE ALSO /I.E. NESTED, HIGHER PRIORITY INTERRUPTS HAVE * 02000000
* CAUSED THE INTERRUPTION OF PROCESSING AT THE LOWER INTERRUPT * 02010000
* LEVELS. THE RESETTING OF THE LOWER LEVEL IAR'S IS DONE TO * 02020000
* AVOID A REPETITION OF PROCESSING + A LOSS OF ARR INTEGRITY. * 02030000
* * 02040000
* THESE TESTS MUST BE IN THE SAME ORDER AS THE INTERUPT LEVEL * 02050000
* PRIORITIES IN THE SYSTEM THREE HARDWARE * 02060000
*********************************************************************** 02070000
SPACE 1 02080000
IHEXIT EQU * EXIT FROM COMMON INTERRUPT RTN 02090000
EXIT EQU * EXIT FROM ROUTINE 02100000
AIF (&MLTA NE '1').NMLTA 02110000
TBN IHFLAG(,BASE),IHM IS THIS THE MLTA /HIGHEST/ LEVEL 02120000
JT SETIA&LVLIH YES, GO RESET THE LOWER LEVEL 02130000
.NMLTA ANOP 02140000
AIF (&BSCA NE '1').NBSCA 02150000
TBN IHFLAG(,BASE),IHB IS THIS THE BSCA INT LEVEL 02160000
JT SETIAC YES, GO RESET CONSOLE IAR 02170000
.NBSCA ANOP 02180000
J NOSET NO, MUST BE CONSOLE, THERE- 02190000
* FORE DON'T RESET ANYTHING 02200000
AIF (&BSCA NE '1').NBSCB 02210000
SETIAB TBN IHFLAG(,BASE),IHB IS BSCA INT LEVEL ACTIVE IN THIS 02220000
* SUBROUTINE 02230000
JF SETIAC NO, CHECK CONSOLE 02240000
L @SETB(,BASE),LVBIAR YES, RESET BSCA IAR 02250000
.NBSCB ANOP 02260000
SETIAC TBN IHFLAG(,BASE),IHC IS CONSOLE LEVEL ACTIVE 02270000
JF NOSET NO, GO ON 02280000
L @SETC(,BASE),LVCIAR YES, RESET CONSOLE IAR 02290000
NOSET EQU * RETURN TO INVOKER 02300000
ST IHRET+3(,BASE),ARR STOW THE RETURN ADDRESS 02310000
AIF (&DPF NE '1').NODPF .SKIP IF NON-DPF SYSTEM @01 02320000
SPACE 2 @01 02330000
********************************************************************@01 02340000
* RESET THE IAR OF THE NON-CCP LEVEL TO CAUSE AN APL TO THE @01 02350000
* CCP LEVEL. THIS CAN ONLY BE DONE IF THE OTHER LEVEL IS NOT @01 02360000
* CURRENTLY PROCESSING IN DSM CODE OR CCP INTERCEPT LOGIC. @01 02370000
********************************************************************@01 02380000
SPACE 1 @01 02390000
ST IHTLVL(,BASE),## STORE OTHER LEVEL IAR @01 02400000
IHLVL1 EQU *-2 Q-CODE SET BY STARTUP @01 02410000
CLC IHTLVL(2,BASE),IHOBEG(,BASE) IAR BELOW PARTITION ? @01 02420000
JL IHRET YES, JUMP - DON'T WRENCH @01 02430000
CLC IHTLVL(2,BASE),IHOEND(,BASE) IAR ABOVE PARTITION ? @01 02440000
JH IHRET YES, JUMP - DON'T WRENCH @01 02450000
ST IHOLVL(,BASE),## STORE OTHER LEVEL IAR @01 02460000
IHLVL2 EQU *-2 Q-CODE SET BY STARTUP @01 02470000
L IHOAPL(,BASE),## POINT IAR AT APL INST @01 02480000
IHLVL3 EQU *-2 Q-CODE SET BY STARTUP @01 02490000
.NODPF ANOP @01 02500000
IHRET B ### RETURN 02510000
AIF (&DPF NE '1').NNDPF .SKIP IF NON-DPF SYSTEM @01 02520000
SPACE 2 @01 02530000
****** OTHER LEVEL WILL APL HERE IF WRENCHING WAS POSSIBLE *********@01 02540000
SPACE 1 @01 02550000
IHAPL APL 0 APL TO ALLOW CCP TO PROCESS @01 02560000
L IHOLVL,## RESTORE OTHER LEVEL IAR @01 02570000
IHLVL4 EQU *-3 Q-CODE SET BY STARTUP @01 02580000
.NNDPF ANOP @01 02590000
EJECT 02600000
************************************************************************02610000
* CONSTANTS AND WORK AREAS USED BY THE COMMON INTERRUPT * 02620000
* ROUTINE * 02630000
*********************************************************************** 02640000
SPACE 1 02650000
AIF (&DPF NE '1').NMDPF SKIP IF NON-DPF @01 02660000
IHOAPL DC AL2(IHAPL) ADDRESS OF APL INST @01 02670000
IHOBEG DC AL2(####) START @ OF OTHER LEVEL PART @01 02680000
IHOEND DC AL2($CCCOM) END @ OF OTHER LEVEL PARTITI @01 02690000
IHTLVL DC AL2(####) SAVE AREA FOR OTHER LEVEL IAR@01 02700000
IHOLVL DC AL2(####) SAVE AREA FOR OTHER LEVEL IAR@01 02710000
SPACE 1 @01 02720000
.NMDPF ANOP @01 02730000
@CC4DP DC AL2($CC4DP) @ OF THE EPA OF THE CCP DISP. 02740000
AIF (&BSCA NE '1').NBSCC 02750000
@SETB DC AL2(SETB) @ OF SET INSTRUCTION IN BSCA IH 02760000
.NBSCC ANOP 02770000
@SETC DC AL2(SETC) @ OF SET INSTRUCTION IN CONS IH 02780000
CCPIAR DC AL2(0) SAVED CCPIAR--MUST BE ZERO INIT. 02790000
IHCUTB DC AL2(0) @ OF CURRENT TCB--MUST BE ZERO 02800000
* INITIALLY 02810000
IHTFLG DC AL2(TCBFLG) DISPLACEMENT INTO THE TCB OF 02820000
* THE SAVE BYTE FOR $DPFLG 02830000
IHFLAG DC BL1'00000000' $CC4IH FLAG BYTE 02840000
IHC EQU BIT0 CONSOLE ENTRY INDICATOR 02850000
AIF (&BSCA NE '1').NBSCD 02860000
IHB EQU BIT1 BSCA ENTRY INDICATOR 02870000
.NBSCD ANOP 02880000
AIF (&MLTA NE '1').NMLTB 02890000
IHM EQU BIT2 MLTA ENTRY INDICATOR 02900000
.NMLTB ANOP 02910000
AIF (&MIN).NHPL 02920000
IH@HPL DC AL2(DPRSET) @ OF INSTRUCTION AFTER HALT 02930000
* IN DISPATCHER 02940000
.NHPL ANOP 02950000
* END MACRO '$E044' 02960000
MEND 02970000