PRGM SSALTER;
# TITLE SSALTER - INITIALIZES *SSALTER* UTILITY. #
BEGIN # SSALTER #
#
*** SSALTER - INITIALIZES *SSALTER* UTILITY.
*
* THIS PROGRAM INITIALIZES *SSALTER* UTILITY BY
* CALLING THE FIRST *SSALTER* *K* DISPLAY AND
* PROVIDING THE INTERFACE BETWEEN THE CONSOLE
* OPERATOR AND *SSEXEC* IN MAINTAINING THE
* M860 HARDWARE CONFIGURATION.
*
*
* COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
#
#
**** PRGM SSALTER - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # CALLS *ABORT* MACRO #
PROC ALTKINP; # DIGEST KEYBOARD INPUT #
PROC ALTKINT; # *SSALTER* *K* DISPLAY
INITIALIZER #
PROC BZFILL; # BLANK OR ZERO FILLS A BUFFER #
PROC GETFAM; # GET DEFAULT FAMILY #
PROC GETPFP; # GET USER INDEX AND FAMILY #
PROC GETSPS; # GET SYSTEM ORIGIN STATUS #
PROC MESSAGE; # DISPLAYS A MESSAGE #
PROC RECALL; # PUT PROGRAM INTO RECALL #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC SETPFP; # SET FAMILY AND USER INDEX #
PROC SETQP; # SET QUEUE PRIORITY #
PROC SETPR; # SET CPU PRIORITY #
PROC UCPREQ; # ISSUE TYPE 1 OR 5 UCP REQUEST #
PROC XARG; # USED TO SATISFY SSJ= EXTERNAL #
END
#
**** PRGM SSALTER - XREF LIST END.
#
#
* DAYFILE MESSAGES.
#
DEF MSG1 #" SSALTER - SYNTAX ERROR."#;
DEF MSG2 #" SSALTER COMPLETE."#;
DEF MSG3 #" SSALTER - MUST BE SYSTEM ORIGIN."#;
DEF MSG4 #" SSALTER - CANNOT CONNECT TO SSEXEC."#;
DEF MSG5 #" SSALTER - INCORRECT RESPONSE FROM SSEXEC."#;
#
* MISCELLAEOUS DEFINITIONS
#
DEF RSLEN #1#; # RETURN STATUS WORD LENGTH #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
CONTROL PRESET;
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCPR
*CALL COMBPFP
*CALL COMBTDM
*CALL COMBUCR
*CALL COMSPFM
*CALL COMTALT
ITEM ARGLIST I; # ADDRESS OF ARGUMENT TABLE #
ITEM DEFORD I; # DEFAULT FAMILY ORDINAL #
ITEM FLAG I; # ERROR STATUS #
ITEM I I; # LOOP COUNTER #
ITEM INDX I; # INDEX VARIABLE #
ITEM INITIALIZE B; # STATUS OF *SSEXEC* CALL #
ITEM KBCUEST C(3); # EST ORDINAL OF REQUESTED CU #
ITEM LINK I; # LINKED FAMILY ORDINAL #
ITEM LOOPC B; # LOOP CONTROL #
ITEM NUM I; # NUMBER OF FAMILIES #
ITEM OPTION I; # OPTION TO SKIP PROGRAM NAME #
ITEM RESPCODE I; # RESPONSE FROM EXEC #
ARRAY CALL$SS [0:0] P(CPRLEN);; # CALLSS PARAMETER BLOCK #
ARRAY ALMSG[0:0] P(4);
BEGIN
ITEM ALMSG$LN C(00,00,39); # MESSAGE LINE #
ITEM ALMSG$TERM U(03,48,12) = [0]; # ZERO TERMINATOR #
END
ARRAY SPSSTAT [0:0] S(RSLEN);
BEGIN
ITEM SPS$STATUS U(00,48,12); # RETURN STATUS #
END
CONTROL EJECT;
#
* CALL *XARG* TO ALLOW SSJ= ENTRY POINT TO BE SATISFIED.
#
XARG(ARGLIST,OPTION,FLAG);
#
* GET SPECIAL SYSTEM PRIVELEDGES
#
GETSPS ( SPSSTAT );
IF SPS$STATUS NQ 0
THEN
BEGIN
ALMSG$LN[0] = MSG3;
MESSAGE(ALMSG[0],SYSUDF1);
ABORT;
END
#
* GET SUBSYSTEM QUEUE PRIORITY.
#
SETQP( -1 );
#
* GET THE SAME CPU PRIORITY AS *SSEXEC*.
#
SETPR;
#
* SAVE THE USER-S CURRENT FAMILY AND USER INDEX IN COMMON.
#
GETPFP(PFP[0]);
USER$FAM[0] = PFP$FAM[0];
USER$UI[0] = PFP$UI[0];
#
* SET UP DEFAULT FAMILY AND SUBSYSTEM ID
#
SSID$AL = ATAS;
GETFAM(FAMT,NUM,LINK,DEFORD,SSID$AL);
#
* SET REQUESTOR ID TO *SSALTER*
#
REQID$AL = REQNAME"RQIALTER";
#
* ESTABLISH LONG-TERM CONNECT WITH *SSEXEC*
#
P<CPR> = LOC(CALL$SS[0]);
UCPREQ ( TYP"TYP1", REQTYP1"CONNECT", RESPCODE );
IF RESPCODE NQ RESPTYP1"OK1"
THEN # CONNECT NOT DONE #
BEGIN
ALTMSG$LN[0] = MSG4;
MESSAGE(ALTMSG[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
UCPREQ(TYP"TYP5",REQTYP5"SSA$PUDT",RESPCODE);
IF ( RESPCODE NQ RESPTYP5"OK5" ) ##
AND ( RESPCODE NQ RESPTYP5"SSA$OK" )
THEN
BEGIN # PROCESS INCORRECT RESPONSE #
UCPREQ ( TYP"TYP1", REQTYP1"DISCONNECT", RESPCODE );
ALTMSG$LN[0] = MSG5;
MESSAGE (ALTMSG[0],SYSUDF1);
RESTPFP(PFP$ABORT);
END # PROCESS INCORRECT RESPONSE #
#
* SET UP INITIALIZATION STATUS
#
INITIALIZE = RESPCODE EQ RESPTYP5"SSA$OK";
#
* INITIALIZE *K* DISPLAY
#
ALTKINT ( INITIALIZE );
#
* WAIT FOR OPERATOR INPUT
#
COMMAND:
LOOPC = FALSE;
SLOWFOR I = 0 WHILE ( NOT LOOPC )
DO
BEGIN # ISSUE RECALL REQUESTS #
RECALL(0);
IF KB$AL$CLEAR[0] NQ 0
THEN
BEGIN
LOOPC = TRUE;
KREQCLEARAL = TRUE;
MESSAGE ( BZEROES$AL, LINE2 );
KL$AL$SUBL1[LF$AL$KBREJ] = " ";
TEST I;
END
TEST I;
END # ISSUE RECALL REQUESTS #
#
* PROCESS KEYBOARD INPUTS.
* CHECK FOR *STOP*, *END*, *CU*, OR *SM*.
#
IF ( C<0,3>KB$AL$SCAN[0] EQ ALTK$END ) ##
OR ( C<0,4>KB$AL$SCAN[0] EQ ALTK$STOP )
THEN
BEGIN
GOTO FINISHED;
END
IF ( C<0,2>KB$AL$SCAN[0] NQ ALTK$SM ) ##
AND ( C<0,2>KB$AL$SCAN[0] NQ ALTK$CU )
THEN
BEGIN
KL$AL$SUBL1[LF$AL$KBREJ] = "*** REJECT ***";
KB$AL$CLEAR[0] = 0;
GOTO COMMAND; # WAIT FOR NEW OPERATOR INPUT #
END
KL$AL$SUBL1[LF$AL$KBREJ] = " "; # CLEAR REJECT LINE #
#
* SET UP COMMAND INDEX
#
IF C<0,2>KB$AL$SCAN[0] EQ ALTK$SM
THEN
BEGIN
INDX = 1;
END
IF C<0,2>KB$AL$SCAN[0] EQ ALTK$CU
THEN
BEGIN
INDX = 2;
KBCUEST = C<2,3>KB$AL$SCAN[0];
END
KB$AL$CLEAR = 0;
ALTKINP( INDX, KBCUEST, INITIALIZE );
KB$AL$CLEAR[0] = 0;
ALTKINT ( INITIALIZE );
GOTO COMMAND;
FINISHED:
#
* DISCONNECT FROM *SSEXEC*
#
UCPREQ ( TYP"TYP1", REQTYP1"DISCONNECT", RESPCODE );
ALTMSG$LN[0] = MSG2; # STOP WITH DAYFILE MESSAGE #
MESSAGE(ALTMSG[0],UDFL1);
RESTPFP(PFP$END); # RESTORE USER-S *PFP* #
END # SSALTER #
TERM
PROC ALTKINP( INDEX, ORDINAL, INITIALIZE );
# TITLE ALTKINP - KEYBOARD INPUT. #
BEGIN # ALTKINP #
#
** ALTKINP - KEYBOARD INPUT.
*
* *ALTKINP* PROCESSES THE OPERATOR RESPONSES OR COMMANDS.
*
* PROC ALTKINP.
*
* ENTRY INITIALIZE - BOOLEAN ( TRUE IMPLIES INITIALIZE )
* INDEX - AN INDEX DESCRIBING WHICH DISPLAY TO DISPLAY.
* ORDINAL EST ORDINAL FOR REQUESTED M862.
*
* EXIT FOR A VALID OPERATOR RESPONSE -
* THE *KWORD* REQUEST (IF IT IS STILL AVAILABLE)
* IS COMPLETED AND DELINKED.
* THE LEFT SCREEN AREA FOR THE RESPONSE IS CLEARED.
*
* FOR A VALID OPERATOR COMMAND -
* THE DEFINED PROCESSING IS DONE.
*
* FOR AN INVALID OPERATOR TYPE-IN -
* THE TYPE-IN IS DISPLAYED IN THE ECHO LINE OF THE
* LEFT SCREEN.
* THE *** REJECT *** IS DISPLAYED IN THE REJECT LINE.
*
* ARRAY KBINPUTAL - KEYBOARD BUFFER CLEARED.
*
#
ITEM INITIALIZE B; # INPUT VARIABLE #
ITEM INDEX I; # INPUT VARIABLE #
ITEM ORDINAL C(3); # INPUT VARIABLE #
#
**** PROC ALTKINP - XREF LIST BEGIN.
#
XREF
BEGIN
FUNC XCDD;
PROC CHKMODE; # CHECK MODE OF PATH/NODE #
PROC CUCOMM; # CRACK *CU* COMMAND PARAMETERS #
PROC DISPCU; # GENERATE *CU* DISPLAY #
PROC DISPSM; # GENERATE *SM* DISPLAY #
PROC KCLR; # CLEAR CURRENT REQUEST #
PROC MESSAGE; # DISPLAYS A MESSAGE #
PROC POKEDIS; # WRITE TO *K* DISPLAY #
PROC RECALL; # PUT PROGRAM INTO RECALL #
PROC UCPREQ; # ISSUE UCP CALL TO *SSEXEC* #
FUNC XDXB I; # CONVERT DISPLAY CODE TO INTEGER
#
END
#
**** PROC ALTKINP - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBPFP
*CALL COMBUCR
*CALL COMBUDT
*CALL COMTALT
ITEM BITNUM I; # BIT NUMBER FOR UCP CALL #
ITEM CH I; # CHARACTER INDEX #
ITEM CH1 C(1); # CHARACTER #
ITEM CH2 C(2); # 2 CHARACTERS #
ITEM CHAR C(1); # CHARACTER #
ITEM CHAR2 C(2); # 2 CHARACTERS #
ITEM CHAR3 C(3); # 3-CHARACTER SCRATCH VARIABLE #
ITEM COLUMN I; # COLUMN NUMBER IN DISPLAY #
ITEM COUNT I; # NUMBER OF CHARACTERS #
ITEM CUINDEX I; # *CU* INDEX IN UDT #
ITEM CU0 U; # SM/DRD STATUS TO CU 0 #
ITEM CU1 U; # SM/DRD STATUS TO CU 1 #
ITEM COMMAND C(10); # OPERATOR COMMAND #
ITEM FLAG B; # OUTPUT FROM CHKMODE #
ITEM INDX I; # LOOP INDEX #
ITEM J I; # SCRATCH INTEGER #
ITEM K I; # SCRATCH INTEGER #
ITEM LINE I; # *K* DISPLAY LINE NUMBER #
ITEM LOOPC B; # LOOP CONTROL VARIABLE #
ITEM NCHAR I; # NEXT CHARACTER COUNTER #
ITEM ORD I; # ORDINAL #
ITEM ESTORD I; # EST ORDINAL #
ITEM MSG C(80); # MESSAGE #
ITEM REJECT B; # REJECT RESPONSE FLAG #
ITEM RESPCODE I; # RESPONSE FROM SSEXEC #
ITEM SMINDEX I; # *SM* INDEX IN UDT #
ITEM STAT I; # INTEGER STATUS #
ITEM STATE B; # PATH STATUS #
ITEM TEMP I; # TEMPORARY INTEGER #
ARRAY CALL$SS[0:0]P(CPRLEN);; # CALLSS PARAMETER BLOCK #
CONTROL EJECT;
#
* SET INITIAL CONDITIONS
#
P<UDT$WORD> = LOC( UDT$HDR);
P<CPR> = LOC( CALL$SS[0] );
CUINDEX = 0;
SMINDEX = 0;
KL$AL$LINE[LF$AL$KBREJ] = " "; # CLEAR REJECT LINE #
KL$AL$SUBL1[LF$AL$KBECHO] = KB$AL$SCAN[0]; # SET ECHO LINE #
#
* CRACK THE KEYBOARD INPUT. DETERMINE IF INPUT IS -
* . CU - INDICATING A REQUEST TO DISPLAY THE *CU* DISPLAY
* . SM - INDICATING A REQUEST TO DISPLAY THE *SM* DISPLAY
#
CU$DISP:
IF INDEX EQ 2
THEN
BEGIN # PROCESS *CU* COMMAND #
#
* LOCATE CORRECT UDT ENTRY
#
LOOPC = FALSE;
SLOWFOR INDX = 0 STEP 1 WHILE NOT LOOPC
DO
BEGIN
P< UDT$CN > = LOC ( UDT$M862[INDX] );
STAT = XDXB(ORDINAL,0,ESTORD); # ASSUME 3 CHARACTERS #
IF STAT NQ 0
THEN
BEGIN
STAT = XDXB(C<0,2>ORDINAL,0,ORD); # ASSUME 2 CHARACTERS #
IF STAT NQ 0
THEN # BAD EST ORDINAL #
BEGIN # EXIT #
GOTO REJECTORD;
END # EXIT #
END
IF ESTORD EQ 0
THEN
BEGIN
GOTO REJECTORD; # BLANK IS ILLEGAL #
END
IF ESTORD NQ UD$ESTO[1]
THEN
BEGIN
IF INDX GQ UDT$LINE$CUN[0]
THEN
BEGIN
GOTO REJECTORD; # REJECT IF BAD ORDINAL #
END
TEST INDX;
END
ELSE
LOOPC = TRUE;
TEST INDX;
END
CUINDEX = INDX;
DISPCU ( CUINDEX, ESTORD );
CU$DISP1:
#
* WAIT FOR OPERATOR INPUT
#
LOOPC = FALSE;
SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
DO
BEGIN # ISSUE RECALL UNTIL INPUT #
RECALL ( 0 );
IF KB$AL$CLEAR NQ 0
THEN
BEGIN
LOOPC = TRUE;
KL$AL$LINE[LF$AL$KBECHO] = KB$AL$SCAN[0]; # ECHO THE
REQUEST #
CPR$CUORD[0] = CUINDEX;
#
* SEND ALL OPERATOR COMMANDS TO THE SYSTEM DAYFILE.
#
MESSAGE ( KB$AL$SCAN[0], SYSUDF1 );
TEST J;
END
END # ISSUE RECALL REQUESTS UNTIL INPUT #
IF C<0,3>KB$AL$SCAN[0] EQ ALTK$END
THEN
BEGIN
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR J = 4 STEP 1 UNTIL LF$AL$KBECHO
DO
BEGIN
CU$LN[J] = ALTK$BL;
CU$EOL[J] = 0;
END
RETURN; # RETURN IF *END* #
END
ELSE
BEGIN
GOTO REJECTCOM;
END
END # PROCESS *CU* COMMAND #
SM$DISP:
IF INDEX EQ 1
THEN
BEGIN # PROCESS *SM* COMMANDS #
DISPSM( SMINDEX , INITIALIZE );
SM$DISP1:
#
* WAIT FOR OPERATOR INPUT
#
LOOPC = FALSE;
SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
DO
BEGIN # ISSUE RECALL UNTIL INPUT #
RECALL ( 0 );
IF KB$AL$CLEAR NQ 0
THEN
BEGIN
LOOPC = TRUE;
KL$AL$LINE[LF$AL$KBECHO] = KB$AL$SCAN[0]; # ECHO THE
REQUEST #
#
* SEND ALL OPERATOR COMMANDS TO THE SYSTEM DAYFILE.
#
MESSAGE ( KB$AL$SCAN[0], SYSUDF1 );
TEST J;
END
END # ISSUE RECALL REQUESTS UNTIL INPUT #
IF ( C<0,2>KB$AL$SCAN[0] NQ ALTK$SM ) ##
AND ( C<0,3>KB$AL$SCAN[0] NQ ALTK$END ) ##
AND ( C<0,1>KB$AL$SCAN[0] NQ ALTK$PLUS )
THEN
BEGIN # REJECT RESPONSE #
GOTO REJECTCOM;
END # REJECT RESPONSE #
KL$AL$SUBL1[LF$AL$KBREJ] = " "; # CLEAR REJECT LINE #
IF C<0,1>KB$AL$SCAN[0] EQ ALTK$PLUS
THEN
BEGIN # PROCESS K.+ #
SMINDEX = SMINDEX + 1;
IF SMINDEX GQ UDT$LINE$SMN[0]
THEN
BEGIN # NO SUCH DISPLAY AVAILABLE #
SMINDEX = SMINDEX - 1;
GOTO REJECTCOM;
END # NO SUCH DISPLAY AVAILABLE #
ELSE
BEGIN # "+" IS OK, DISPLAY NEXT PAGE #
KB$AL$CLEAR[0] = 0;
KL$AL$LINE[LF$AL$KBECHO] = " ";
GOTO SM$DISP;
END # "+" IS OK, DISPLAY NEXT PAGE #
END # PROCESS PLUS #
IF C<0,2>KB$AL$SCAN[0] NQ ALTK$SM
THEN
BEGIN
#
* BLANK THE SCREEN
#
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR J = LF$AL$BODY STEP 1 UNTIL LF$AL$KBECHO
DO
BEGIN
SM$LN[J] = ALTK$BL;
SM$EOL[J] = 0;
END
RETURN; # RETURN IF *END* OR *STOP* #
END
P<UDT$SMA> = LOC(UDT$M861[SMINDEX]);
IF C<2,1>KB$AL$SCAN[0] NQ SM$ID[1] # NOT THE SM ON CONSOLE #
OR C<3,1>KB$AL$SCAN[0] NQ COMMA
THEN
BEGIN # REJECT RESPONSE #
GOTO REJECTCOM;
END # REJECT RESPONSE #
CHAR2 = C<4,2>KB$AL$SCAN[0];
IF ( CHAR2 NQ NM$KEY2[2] ) ##
AND C<4,3>KB$AL$SCAN[0] NQ NM$KEY3[8]
THEN
BEGIN # REJECT RESPONSE #
GOTO REJECTCOM;
END # REJECT RESPONSE #
IF C<4,3>KB$AL$SCAN[0] EQ NM$KEY3[8]
THEN
BEGIN # PRE-PROCESS DRD STATUS CHANGE #
STAT = XDXB(C<7,2>KB$AL$SCAN[0],1,J); # ASSUME 2 CHARS #
NCHAR = 9;
IF STAT NQ 0
THEN
BEGIN # ONE #
STAT = XDXB(C<7,1>KB$AL$SCAN[0],1,J); # ASSUME 1 CHAR #
NCHAR = 8;
IF STAT NQ 0
THEN # BAD DRD ORDINAL #
BEGIN # REJECT #
GOTO REJECTCOM;
END # REJECT #
END # ONE #
IF C<NCHAR,1>KB$AL$SCAN[0] NQ COMMA
THEN # BAD SYNTAX #
BEGIN # EXIT #
GOTO REJECTCOM;
END # EXIT #
NCHAR = NCHAR + 1;
IF C<NCHAR,2>KB$AL$SCAN[0] NQ "CU"
THEN # BAD SYNTAX #
BEGIN # EXIT #
GOTO REJECTCOM;
END # EXIT #
NCHAR = NCHAR + 2;
IF (J LS 0) OR (J GR MAX$DRDDA)
THEN
BEGIN # REJECT BAD DEVICE ADDRESS #
GOTO REJECTCOM;
END # REJECT BAD DEVICE ADDRESS #
IF (J NQ D0$SUN[1]) AND (J NQ D1$SUN[1])
THEN
BEGIN # REJECT BAD DEVICE ADDRESS #
GOTO REJECTCOM;
END # REJECT BAD DEVICE ADDRESS #
CHAR3 = C<NCHAR,3>KB$AL$SCAN[0];
STAT = XDXB(CHAR3,0,K); # ASSUME 3 CHARS #
IF STAT NQ 0
THEN
BEGIN
CHAR2 = C<NCHAR,2>KB$AL$SCAN[0];
STAT = XDXB(CHAR2,0,K); # ASSUME 2 #
NCHAR = NCHAR + 2;
IF STAT NQ 0
THEN # BAD CONTROLLER ORDINAL #
BEGIN # EXIT #
GOTO REJECTCOM;
END # EXIT #
END
ELSE # BUMP POSITION COUNTER #
BEGIN # BUMP #
NCHAR = NCHAR + 3;
END # BUMP #
IF ( K LS 0 ) OR ( K GR MAXEST )
THEN
BEGIN
GOTO REJECTCOM;
END
END # PREPROCESS DRD STATUS CHANGE #
CHAR2 = C<4,2>KB$AL$SCAN[0];
IF CHAR2 EQ NM$KEY2[2]
THEN
BEGIN # PREPROCESS ACCESSOR CHANGE REQUEST #
STAT = XDXB(C<6,3>KB$AL$SCAN[0],0,J); # ASSUME 3 CHARS #
NCHAR = 9;
IF STAT NQ 0
THEN
BEGIN
STAT = XDXB(C<6,2>KB$AL$SCAN[0],0,J); # ASSUME 2 CHARS #
NCHAR = 8;
IF STAT NQ 0
THEN # BAD CONTROLLER ORDINAL #
BEGIN # EXIT #
GOTO REJECTCOM;
END # EXIT #
END
IF ( J LS 0 ) OR ( J GR MAXEST )
THEN
BEGIN
GOTO REJECTCOM;
END
END # PREPROCESS ACCESSOR CHANGE REQUEST #
#
* ADVANCE TO STATUS CHARACTER.
#
IF C<NCHAR,1>KB$AL$SCAN[0] NQ "="
THEN # BAD SYNTAX #
BEGIN # EXIT #
GOTO REJECTCOM;
END # EXIT #
NCHAR = NCHAR + 1;
#
* ADJUST DRD DEVICE ADDRESS
#
IF C<4,3>KB$AL$SCAN[0] EQ "DRD"
THEN
BEGIN
J = J - ((J/2)*2);
END
#
* J GQ 8 IMPLIES K.SM"ID",CUNN=X. COMMAND
* J EQ 0 OR 1 IMPLIES K.SM"ID",DRDN,CUNN=X. COMMAND.
#
CHAR = C<NCHAR,1>KB$AL$SCAN;
IF ( CHAR NQ ALTK$MAINT ) ##
AND ( CHAR NQ ALTK$ONLINE ) ##
AND ( CHAR NQ ALTK$OFFLINE )
THEN
BEGIN # REJECT INVALID STATUS #
GOTO REJECTCOM;
END # REJECT INVALID STATUS #
IF ( CHAR EQ ALTK$MAINT ) AND INITIALIZE
THEN
BEGIN
GOTO REJECTCOM; # INITIALIZE PROHIBITS MAINTENANCE
MODE #
END
IF J GQ 8
THEN
BEGIN
P<UDT$LOC> = LOC(SM$WD0[1]);
CU0 = SMST0; # SAVE CU STATUS INDEXES #
CU1 = SMST1;
END
IF J EQ 0
THEN
BEGIN
P<UDT$LOC> = LOC(D0$WD0[1]);
TEMP = D0$WD0[1];
CU0 = DRST0; # SAVE CU STATUS INDEXES #
CU1 = DRST1;
END
IF J EQ 1
THEN
BEGIN
P<UDT$LOC> = LOC(D1$WD0[1]);
TEMP = D1$WD0[1];
CU0 = DRST0; # SAVE CU STATUS INDEXES #
CU1 = DRST1;
END
#
* CHECK PATH/NODE CURRENT CONDITION
#
IF J LQ 1
THEN
BEGIN
P<UDT$CN> = LOC(UDT$M862[SM$CUO0[1]-1]);
IF K EQ UD$ESTO[1]
THEN
BEGIN # CHECK FIRST CONTROLLER #
IF B<12+PATH$DF"U$EXISTS",1>TEMP EQ 0
THEN
BEGIN
GOTO REJECTCOM;
END
CHKMODE ( UDT$LOC, 2, CHAR, FLAG, BITNUM );
CPR$CUORD[0] = SM$CUO0[1]; # IDENTIFY CONTROLLER #
END # CHECK FIRST CONTROLLER #
IF K NQ UD$ESTO[1]
THEN
BEGIN # CHECK SECOND CU TABLE #
P<UDT$CN> = LOC(UDT$M862[SM$CUO1[1]-1]);
IF K NQ UD$ESTO[1]
THEN
BEGIN # CU ORDINAL NOT FOUND #
GOTO REJECTCOM;
END # CU ORDINAL NOT FOUND #
IF B<18+PATH$DF"U$EXISTS",1>TEMP EQ 0
THEN
BEGIN
GOTO REJECTCOM;
END
CHKMODE ( UDT$LOC, 3, CHAR, FLAG, BITNUM );
CPR$CUORD[0] = SM$CUO1[1]; # IDENTIFY CONTROLLER #
END # CHECK SECOND CU TABLE #
END
ELSE
BEGIN # CHECK ACCESSOR STATUS #
P<UDT$CN> = LOC(UDT$M862[SM$CUO0[1]-1]);
IF J NQ UD$ESTO[1]
THEN
BEGIN # CHECK SECOND CU TABLE #
P<UDT$CN> = LOC(UDT$M862[SM$CUO1[1]-1]);
IF J NQ UD$ESTO[1]
THEN
BEGIN # CU ORDINAL NOT FOUND #
GOTO REJECTCOM;
END # CU ORDINAL NOT FOUND #
P<UDT$CN> = LOC(UDT$M862[SM$CUO1[1]-1]);
CPR$CUORD[0] = SM$CUO1[1];
END # CHECK SECOND CU TABLE #
P<UDT$CN> = LOC(UDT$M862[SM$CUO0[1]-1]);
IF J EQ UD$ESTO[1]
THEN
BEGIN
CPR$CUORD[0] = SM$CUO0[1];
CHKMODE ( UDT$LOC, 2, CHAR, FLAG, BITNUM );
END
ELSE
BEGIN
CHKMODE ( UDT$LOC, 4, CHAR, FLAG, BITNUM );
END
END # CHECK ACCESSOR STATUS #
#
* FLAG EQ TRUE IMPLIES PATH/NODE ALREADY IN REQUESTED STATE
#
IF FLAG
THEN
BEGIN
GOTO GOODCOM; # COMMAND WAS ACCEPTED #
END
IF ( J LQ 1 ) ##
AND ( CHAR EQ ALTK$ONLINE ) ##
AND ( NOT SM$ON[1] ) ##
AND ( NOT INITIALIZE )
THEN
BEGIN
GOTO REJECTSMCHG;
END
IF J GQ 8
THEN
BEGIN
CPR$UDTQ = LOC(UDT$M861[SMINDEX])+BIAS$EN0-LOC(UDT$HDR);
END
IF J EQ 0
THEN
BEGIN
CPR$UDTQ = LOC(UDT$M861[SMINDEX])+BIAS$EN3-LOC(UDT$HDR);
END
IF J EQ 1
THEN
BEGIN
CPR$UDTQ = LOC(UDT$M861[SMINDEX])+BIAS$EN20-LOC(UDT$HDR);
END
CPR$BYNR = BITNUM;
IF ( CHAR EQ ALTK$ONLINE ) ##
OR ( CHAR EQ ALTK$MAINT )
THEN
BEGIN
CPR$PMMR = TRUE;
END
ELSE
BEGIN
CPR$PMMR = FALSE;
END
#
* UPDATE *K* DISPLAY REQUEST BITS WHILE WAITING ON *SSEXEC*.
#
IF J LQ 1
THEN
BEGIN
TEMP = 8 + J*2;
END
IF J GQ 8
THEN
BEGIN
TEMP = 6;
END
COLUMN = 37;
IF ( C<COLUMN,1>SM$LN[TEMP] EQ " " ) ##
OR ( ( C<COLUMN,1>SM$LN[TEMP] EQ ALTK$ONLINE ) ##
AND ( CHAR EQ ALTK$MAINT ) ) ##
OR ( ( C<COLUMN,1>SM$LN[TEMP] EQ ALTK$MAINT ) ##
AND ( CHAR EQ ALTK$ONLINE ) )
THEN
BEGIN
GOTO REJECTCOM; # NON-EXISTENT ELEMENT OR ILLEGAL
SWITCH #
END
TEMP = TEMP - 1; # POSITION LINE FOR ASTERISK
DISPLAY #
CHAR = ALTK$AST;
COUNT = 1;
POKEDIS ( TEMP, COLUMN, COUNT, CHAR );
UCPREQ ( TYP"TYP5", REQTYP5"SSA$UUDT", RESPCODE );
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
#
* SET GLOBAL FLAGS IF SSEXEC IS INITIALIZING.
* SSEXEC WILL DO SO ONCE IT IS INITIALIZED.
#
IF INITIALIZE
THEN # SET GLOBAL FLAGS #
BEGIN # DISPLAY CONSOLIDATED STATUS #
IF PATHBIT(CU0,PATH$DF"U$ON") EQ 1 ##
OR PATHBIT(CU1,PATH$DF"U$ON") EQ 1
THEN
BEGIN
CPR$PMMR = TRUE;
CPR$BYNR = PATH$DF"U$ON";
UCPREQ ( TYP"TYP5", REQTYP5"SSA$UUDT", RESPCODE );
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
END
IF PATHBIT(CU0,PATH$DF"U$RQ$DIAG") EQ 1 ##
OR PATHBIT(CU1,PATH$DF"U$RQ$DIAG") EQ 1
THEN
BEGIN
CPR$PMMR = TRUE;
CPR$BYNR = PATH$DF"U$RQ$DIAG";
UCPREQ ( TYP"TYP5", REQTYP5"SSA$UUDT", RESPCODE );
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
END
IF PATHBIT(CU0,PATH$DF"U$ON") EQ 0 ##
AND PATHBIT(CU1,PATH$DF"U$ON") EQ 0
THEN
BEGIN
CPR$PMMR = FALSE;
CPR$BYNR = PATH$DF"U$ON";
UCPREQ ( TYP"TYP5", REQTYP5"SSA$UUDT", RESPCODE );
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
END
END # DISPLAY CONSOLIDATED STATUS #
GOTO GOODCOM;
END # PROCESS *SM* COMMANDS #
#
* REJECT REQUEST
#
REJECTSMCHG:
KL$AL$SUBL1[LF$AL$KBREJ] = "*** SM STATUS PROHIBITS CHANGE ***";
KB$AL$CLEAR[0] = 0;
GOTO SM$DISP1;
REJECTCOM:
KL$AL$SUBL1[LF$AL$KBREJ] = "*** REJECT ***";
KB$AL$CLEAR[0] = 0;
IF INDEX EQ 1
THEN
BEGIN
GOTO SM$DISP1; # GET NEXT COMMAND #
END
ELSE
BEGIN
GOTO CU$DISP1; # GET NEXT COMMAND #
END
REJECTORD:
KL$AL$SUBL1[LF$AL$KBREJ] = " *** REJECT CU ORD *** ";
KB$AL$CLEAR[0] = 0;
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR J = LF$AL$BODY STEP 1 UNTIL LF$AL$KBREJ-1
DO
BEGIN
CU$EOL[J] = 0;
END
RETURN; # RETURN TO MAIN PROGRAM #
#
* RESPONSE WAS GOOD. CLEAR ECHO.
#
GOODCOM:
KL$AL$LINE[LF$AL$KBECHO] = " "; # CLEAR ECHO #
KB$AL$CLEAR[0] = 0;
IF INDEX EQ 1
THEN
BEGIN
GOTO SM$DISP; # GET NEXT COMMAND #
END
ELSE
BEGIN
GOTO CU$DISP1; # GET NEXT COMMAND #
END
END # ALTKINP #
TERM
PROC ALTKINT ( INITIALIZE );
# TITLE ALTKINT - *K* DISPLAY INITIALIZATION. #
BEGIN # ALTKINT #
#
** ALTKINT - *K* DISPLAY INTIALIZATION.
*
* *ALTKINT* ISSUES THE *CONSOLE* MACRO TO ACTIVATE THE
* *K* DISPLAY AND INITIALIZES THE *K* DISPLAY BUFFERS.
*
* PROC ALTKINT.
*
* ENTRY INITIALIZE - BOOLEAN ( TRUE IMPLIES INITIALIZE )
*
* EXIT THE *CONSOLE* MACRO IS ISSUED.
* THE TITLE IS PLACED IN THE LEFT SCREEN BUFFER.
* THE *B* DISPLAY LINE 2 IS CLEARED.
*
* MESSAGES * REQUEST *K* DISPLAY * (FROM *CONSOLE* MACRO).
*
#
ITEM INITIALIZE B; # INPUT VARIABLE #
#
**** PROC ALTKINT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC CONSOLE; # ISSUE *CONSOLE* MACRO #
PROC MESSAGE; # ISSUE *MESSAGE* MACRO #
END
#
**** PROC ALTKINT - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMTALT
ITEM ALTHDR1 C(58) =
" VALID DISPLAYS ARE";
ITEM ALTHDR2 C(58) =
" K.SM";
ITEM ALTHDR3 C(58) =
" K.CUNN - NN = EST ORDINAL OF M862";
ITEM I I; # LOOP COUNTER #
CONTROL EJECT;
#
* SET UP AND ISSUE THE CONSOLE MACRO.
#
CP$KBADDR[0] = LOC(KBINPUTAL[0]);
CP$KLADDR[0] = LOC(KLEFTSCRNAL[0]);
CONSOLE(CPARAM[0]);
#
* REQUEST *K* DISPLAY ON *B* DISPLAY.
#
MESSAGE("$ REQUEST *K* DISPLAY ",LINE2);
KL$AL$COMP[0] = FALSE; # SET TOGGLE OFF #
KREQCLEARAL = FALSE;
KB$AL$CLEAR[0] = 0;
#
* SET UP TITLE LINE IN LEFT SCREEN BUFFER.
#
KL$AL$LINE[LF$AL$TITLE] = TITLELINE$AL;
KL$AL$LINE[LF$AL$TITLE+1] = TITLEBOX$AL;
IF INITIALIZE
THEN
BEGIN # DISPLAY INITIALIZATION MESSAGE #
KL$AL$LINE[LF$AL$TITLE+2] = TITLELINE$MD;
END # DISPLAY INITIALIZATION MESSAGE #
#
* DISPLAY VALID COMMANDS.
#
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR I = LF$AL$BODY STEP 1 UNTIL LF$AL$KBECHO + 1
DO
BEGIN
SM$EOL[0] = 0;
END
SM$LN[8] = ALTHDR1;
SM$LN[10] = ALTHDR2;
SM$LN[11] = ALTHDR3;
END # ALTKINT #
TERM
PROC CHKMODE ( WORD, FIELD, MODE, FLAG, BITNUM );
# TITLE BITNUM - CHECK EXISTING MODE OF PATH/NODE IN M860 #
BEGIN # CHKMODE #
#
**** CHKMODE - CHECK EXISTING MODE OF PATH/NODE IN M860
*
* *CHKMODE* EXAMINES THE EXISTING STATUS OF THE REQUESTED
* PATH/NODE. IF IT IS THE SAME AS THE STATUS BEING REQUESTED,
* *CHKMODE* RETURNS WITH FLAG = TRUE. IF NOT, FLAG IS RETURNED
* AS FALSE. ALSO, BITNUM IS RETURNED AS THE BIT NUMBER THAT
* WAS CHECKED SO A SUBSEQUENT UCPCALL CAN BE MADE TO *SSEXEC*
* IF DESIRED.
*
* ENTRY
* WORD = WORD IN UDT TO BE CHECKED.
* FIELD = ORDINAL OF 6 BIT FIELD TO CHECK IN WORD.
* MODE = MODE OF PATH/NODE TO CHECK FOR.
*
* EXIT
* FLAG = TRUE IF REQUESTED MODE IS THE SAME AS EXISTING MODE.
* BITNUM = BIT NUMBER IN WORD OF THE BIT THAT WAS CHECKED.
#
ITEM BITNUM I; # OUTPUT VARIABLE #
ITEM FIELD I; # INPUT VARIABLE #
ITEM FLAG B; # OUTPUT VARIABLE #
ITEM MODE C(1); # INPUT VARIABLE #
ARRAY WORD[0:0] S(1);
BEGIN
ITEM UDTWORD I (00,00,60); # INPUT WORD ADDRESS #
END
#
**** PROC CHKMODE - XREF LIST BEGIN.
#
XREF
BEGIN
PROC MESSAGE; # ISSUE DAYFILE MESSAGE #
PROC RESTPFP; # RESTORE USER-S PFP AND ABORT #
END
#
**** PROC CHKMODE - XREF LIST END.
#
CONTROL PRESET;
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBUDT
*CALL,COMTALT
ITEM I I; # INTEGER VARIABLE #
ITEM MODEB B; # STATUS DESCRIPTOR #
CONTROL EJECT;
#
* DETERMINE MODE BEING SEARCHED FOR
#
MODEB = FALSE;
IF ( MODE EQ ALTK$MAINT ) ##
OR ( MODE EQ ALTK$ONLINE )
THEN
BEGIN
MODEB = TRUE;
END
I = 0;
IF ( MODE EQ ALTK$MAINT )
THEN
BEGIN
I = PATH$DF"U$RQ$DIAG";
END
IF ( MODE EQ ALTK$ONLINE ) ##
OR ( MODE EQ ALTK$OFFLINE )
THEN
BEGIN
I = PATH$DF"U$ON";
END
IF ( I NQ 1 ) AND ( I NQ 3 )
THEN
BEGIN
ALTMSG$LN[0] = " CHKMODE - ILLEGAL MODE REQUESTED.";
MESSAGE ( ALTMSG[0],SYSUDF1 );
RESTPFP ( PFP$ABORT );
END
#
* DETERMINE BIT NUMBER
#
BITNUM = FIELD*6 + I;
IF ( ( B<BITNUM,1>UDTWORD EQ 1) AND ( MODEB ) ) ##
OR ( ( B<BITNUM,1>UDTWORD EQ 0 ) ##
AND ( NOT MODEB ) ##
AND ( B<FIELD*6 + PATH$DF"U$RQ$DIAG",1>UDTWORD EQ 0 ) ) ##
THEN
BEGIN
FLAG = TRUE;
END
ELSE
BEGIN
FLAG = FALSE;
IF NOT MODEB AND B<FIELD*6 + PATH$DF"U$RQ$DIAG",1>UDTWORD EQ 1
THEN
BEGIN
BITNUM = BITNUM + PATH$DF"U$RQ$DIAG" - PATH$DF"U$ON";
END
END
END # CHKMODE #
TERM
PROC DISPCU ( INDEX, ORDINAL );
# TITLE DISPCU - DISPLAY *SM* DISPLAY #
BEGIN # DISPCU #
#
*** DISPCU - DISPLAY *CU* DISPLAY
*
* *DISPCU* GENERATES AND DISPLAYS THE *CU* DISPLAY
* FOR *SSALTER*
*
* ENTRY INDEX = CU TO BE DISPLAYED.
*
*
* EXIT DISPLAY SHOWN ON LEFT SCREEN.
#
ITEM INDEX I; # INPUT VARIABLE #
ITEM ORDINAL I; # INPUT VARIABLE #
#
**** PROC DISPCU - XREF LIST BEGIN.
#
XREF
BEGIN
PROC KDISCIF; # DISPLAY CIF CONFIGURATION #
PROC MESSAGE; # ISSUE A DAYFILE MESSAGE #
PROC POKEDIS; # UPDATE *K* DISPLAY #
PROC RESTPFP; # RESTORE USER-S PFP AND ABORT OR
RETURN #
PROC UCPREQ; # ISSUE UCP REQUEST TO SSEXEC #
FUNC XCOD C(10); # CONVERT INTEGER TO OCTAL DISPLAY
#
FUNC XDXB; # CONVERT DISPLAY CODE TO INTEGER
#
END
#
**** PROC DISPCU - XREF LIST END.
#
#
* DAYFILE MESSAGES.
#
DEF MSG1 #" DISPCU - INCORRECT RESPONSE FROM SSEXEC."#;
DEF BLANK #" "#;
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBUDT
*CALL,COMTALT
ARRAY CHAR10[0:0] S(1); # CHARACTER MANIPULATION #
BEGIN
ITEM CHAR$10 C(00,00,10);
ITEM CHAR$R1 C(00,54,01);
ITEM CHAR$R2 C(00,48,02);
ITEM CHAR$R3 C(00,42,03);
END
ITEM CH1 C(1); # ONE CHARACTER #
ITEM CH2 C(2); # TWO CHARACTERS #
ITEM COLUMN I; # *K* DISPLAY COLUMN NUMBER #
ITEM FIRSTAC I; # FIRST AC TO SCAN IN AIF GROUP #
ITEM I I; # LOOP INDEX #
ITEM J I; # LOOP INDEX #
ITEM JINDEX I; # PARAMETER FOR *KDISCIF* #
ITEM LINE I; # *K* DISPLAY LINE NUMBER #
ITEM LOOPC B; # LOOP CONTROL #
ITEM NCH I; # LOOP COUNTER #
ITEM ORD I; # TEMPORARY STORAGE #
ITEM RESPCODE I; # RESPONSE FROM *SSEXEC* #
ITEM STAT I; # STATUS FROM *XDXB* #
ITEM TEMP I; # TEMPORARY CELL #
CONTROL EJECT;
ITEM CUBLANK C(58) =
" ";
ITEM CUHDR1 C(58) =
" CU";
ITEM CUHDR2 C(58) =
" ORD ST";
ITEM CUHDR3 C(58) =
" CUNN ST";
ITEM CUHDR4 C(58) =
" CIFU CIFV DTI0 DTO0 DIF0 DRC0 DRC1 AIF0";
ITEM CUHDR5 C(58) =
" ---- ---- ---- ---- ---- ---- ---- ----";
ITEM CUHDR7 C(58) =
" DTI0X DTI0X DIF0X DIF0X DRC0X DRD0X DRD0X SMA0X";
ITEM CUHDR8 C(58) =
" DTI1X DTI1X DIF1X DIF1X DRC1X DRD1X DRD1X SMA1X";
ITEM CUHDR9 C(58) =
" DTO0X DTO0X DRC2X DRD2X DRD2X SMA2X";
ITEM CUHDR10 C(58) =
" DTO1X DTO1X DTI1 DTO1 DRC3X DRD3X DRD3X SMA3X";
ITEM CUHDR11 C(58) =
" ---- ---- DRD4X DRD4X";
ITEM CUHDR12 C(58) =
" DIF0X DIF0X DIF1 DRD5X DRD5X AIF1";
ITEM CUHDR13 C(58) =
" CH DIF1X DIF1X ---- DRD6X DRD6X ----";
ITEM CUHDR14 C(58) =
" CH ST CIF DRC0X DRD7X DRD7X SMA0X";
ITEM CUHDR15 C(58) =
" NN ST U DRC1X SMA1X";
ITEM CUHDR16 C(58) =
" MM ST V DRC2X SMA2X";
ITEM CUHDR17 C(58) =
" DRC3X SMA3X";
CONTROL EJECT;
#
* BLANK THE *K* DISPLAY
#
P<CU$SCREEN> = LOC(KLEFTSCRNAL);
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR I = LF$AL$BODY STEP 1 UNTIL LF$AL$KBECHO-1
DO
BEGIN
CU$LN[I] = CUBLANK;
CU$EOL[I] = 0;
END
#
* PAINT NON-CHANGING WORDS ON THE SCREEN
#
CU$LN[4] = CUHDR1;
CU$LN[5] = CUHDR2;
CU$LN[6] = CUHDR3;
CU$LN[8] = CUHDR4;
CU$LN[9] = CUHDR5;
CU$LN[10] = CUHDR7;
CU$LN[11] = CUHDR8;
CU$LN[12] = CUHDR9;
CU$LN[13] = CUHDR10;
CU$LN[14] = CUHDR11;
CU$LN[15] = CUHDR12;
CU$LN[16] = CUHDR13;
CU$LN[17] = CUHDR14;
CU$LN[18] = CUHDR15;
CU$LN[19] = CUHDR16;
CU$LN[20] = CUHDR17;
#
* GET UDT INFORMATION
#
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
IF ( RESPCODE NQ RESPTYP5"OK5" ) ##
AND ( RESPCODE NQ RESPTYP5"SSA$OK" )
THEN
BEGIN # PROCESS INCORRECT RESPONSE #
UCPREQ ( TYP"TYP1", REQTYP1"DISCONNECT", RESPCODE );
ALTMSG$LN[0] = MSG1;
MESSAGE ( ALTMSG[0],SYSUDF1 );
RESTPFP ( PFP$ABORT );
END # PROCESS INCORRECT RESPONSE #
#
* DISPLAY STATIC INFORMATION
#
CHAR$10[0] = XCOD ( ORDINAL );
IF ORDINAL LQ O"77"
THEN # ORDINAL HAS 2 CHARACTERS #
BEGIN # TWO #
POKEDIS(6,22,2,CHAR$R2[0]);
END # TWO #
ELSE # ORDINAL HAS 3 CHARACTERS #
BEGIN # THREE #
POKEDIS(6,22,3,CHAR$R3[0]);
END # THREE #
#
* UPDATE STATUSES FROM UDT INFORMATION
#
IF UD$CUON[1]
THEN
BEGIN
CH2 = ALTK$CHON;
END
ELSE
BEGIN
CH2 = ALTK$CHOFF;
END
POKEDIS ( 6, 28, 2, CH2 );
LOOPC = FALSE;
SLOWFOR NCH = MAX$CH-2 STEP -1 UNTIL 0
DO
BEGIN # DISPLAY CHANNELS/CIFS #
IF LOOPC # TEST CHANNEL A EXAMINED #
THEN
BEGIN
TEST NCH;
END
IF NCH EQ 1
THEN
BEGIN
LINE = 18;
COLUMN = 7;
END
ELSE
BEGIN
LINE = 19;
COLUMN = 14;
END
IF ( UD$CHAND[1] NQ 0 ) AND ( NCH EQ MAX$CH-2 )
THEN
BEGIN
CHAR$10[0] = XCOD ( UD$CHAND$C[1] );
POKEDIS ( LINE, 4, 2, CHAR$R2[0] ); # DISPLAY CHANNEL #
IF UD$CHAND$O[1]
THEN
BEGIN
CH2 = ALTK$CHON;
END
ELSE
BEGIN
CH2 = ALTK$CHOFF;
END
POKEDIS ( LINE, 8, 2, CH2 ); # DISPLAY CHANNEL STATUS #
CH1 = ALTK$CIF3;
POKEDIS ( LINE, 13, 1, CH1 ); # DISPLAY CIF FOR CHANNEL #
POKEDIS ( 8, COLUMN, 1, CH1 ); # DISPLAY CIF #
STAT = XDXB ( ALTK$CIF3, 0, JINDEX );
KDISCIF ( JINDEX, NCH ); # DISPLAY CIF ON OUT #
TEST NCH;
END
IF ( ( UD$CHANC[1] NQ 0 ) ##
AND ( NCH EQ MAX$CH-2 ) ##
AND ( UD$CHAND[1] EQ 0 ) ) ##
OR ( ( UD$CHANC[1] NQ 0 ) ##
AND ( NCH EQ 0 ) ##
AND ( UD$CHAND[1] NQ 0 ) )
THEN
BEGIN
CHAR$10[0] = XCOD ( UD$CHANC$C[1] );
POKEDIS ( LINE, 4, 2, CHAR$R2[0] ); # DISPLAY CHANNEL #
IF UD$CHANC$O[1]
THEN
BEGIN
CH2 = ALTK$CHON;
END
ELSE
BEGIN
CH2 = ALTK$CHOFF;
END
POKEDIS ( LINE, 8, 2, CH2 ); # DISPLAY STATUS #
CH1 = ALTK$CIF2;
POKEDIS ( LINE, 13, 1, CH1 ); # DISPLAY CIF NUMBER #
POKEDIS ( 8, COLUMN, 1, CH1 ); # DISPLAY CIF #
STAT = XDXB ( ALTK$CIF2, 0, JINDEX );
KDISCIF ( JINDEX, NCH ); # DISPLAY CIF ON OUT #
TEST NCH;
END
IF ( ( UD$CHANB[1] NQ 0 ) ##
AND ( NCH EQ 1 ) ##
AND ( UD$CHAND[1] EQ 0 ) ##
AND ( UD$CHANC[1] EQ 0 ) ) ##
OR ( ( UD$CHANB[1] NQ 0 ) ##
AND ( NCH EQ 0 ) ##
AND ( ( UD$CHAND[1] NQ 0 ) ##
AND ( UD$CHANC[1] EQ 0) ##
OR ( UD$CHAND[1] EQ 0) ##
AND ( UD$CHANC[1] NQ 0 ) ) )
THEN
BEGIN
CHAR$10[0]= XCOD ( UD$CHANB$C[1] );
POKEDIS ( LINE, 4, 2, CHAR$R2[0]); # DISPLAY CHANNEL #
IF UD$CHANB$O[1]
THEN
BEGIN
CH2= ALTK$CHON;
END
ELSE
BEGIN
CH2= ALTK$CHOFF;
END
POKEDIS ( LINE, 8, 2, CH2 ); # DISPLAY CHANNEL STATUS #
CH1 = ALTK$CIF1;
POKEDIS ( LINE, 13, 1, CH1 ); # DISPLAY CIF NUMBER #
POKEDIS ( 8, COLUMN, 1, CH1 ); # DISPLAY CIF NUMBER #
STAT = XDXB ( ALTK$CIF1, 0, JINDEX );
KDISCIF ( JINDEX, NCH ); # DISPLAY CIF ON OUT #
TEST NCH;
END
IF ( UD$CHANA[1] NQ 0 ) ##
OR ( ( UD$CHANA[1] EQ 0 ) AND ( NCH GR 0 ) )
THEN
BEGIN
CHAR$10[0] = XCOD ( UD$CHANA$C[1] );
POKEDIS ( LINE, 4, 2, CHAR$R2[0] ); # DISPLAY CHANNEL #
IF UD$CHANA$O[1]
THEN
BEGIN
CH2 = ALTK$CHON;
END
ELSE
BEGIN
CH2 = ALTK$CHOFF;
END
POKEDIS ( LINE, 8, 2, CH2 ); # DISPLAY CHANNEL STATUS #
CH1 = ALTK$CIF0;
POKEDIS ( LINE, 13, 1, CH1 ); # DISPLAY CIF NUMBER #
POKEDIS ( 8, COLUMN, 1, CH1 ); # DISPLAY CIF NUMBER #
STAT = XDXB ( ALTK$CIF0, 0, JINDEX );
KDISCIF ( JINDEX, NCH ); # DISPLAY CIF ON OUT #
LOOPC = TRUE; # FORCE EXIT OF CHANNEL LOOP #
TEST NCH;
END
END
IF C<13,1>CU$LN[19] EQ "V"
THEN
BEGIN
C<13,1>CU$LN[19] = " ";
C<4,10>CU$LN[19] = " ";
SLOWFOR I = 0 STEP 1 UNTIL MAX$CIF + 2
DO
BEGIN
LINE = 8 + I;
C<11,5>CU$LN[LINE] = ALTK$B5; # CLEAR UNNECESSARY DATA #
END
END # DISPLAY CHANNELS/CIFS #
#
* UPDATE SM/AIF FIELDS OF *K* DISPLAY.
#
P<PTHSTAT> =
LOC(UD
$AIF0
[1]); # PRESET TO AIF0 # SLOWFOR ORD = 0 STEP 1 UNTIL MAX$AIF
DO
BEGIN
COLUMN = 57;
TEMP = 10;
IF ORD EQ 1
THEN
BEGIN
P<PTHSTAT> =
LOC(UD
$AIF1
[1]); # RESET TO AIF1 # TEMP = 17;
END
FIRSTAC = 0; # ASSUME AC-S ARE 0-3 #
IF B<24,24>PATH$WORD[0] NQ 0
THEN # 2ND SET OF SM-S USED #
BEGIN # 2ND #
FIRSTAC = MAX$AC + 1; # RESET TO AC-S 4-7 #
POKEDIS(TEMP,56,1,"4"); # CHANGE SM ORDINALS TO 2ND SET #
POKEDIS(TEMP+1,56,1,"5");
POKEDIS(TEMP+2,56,1,"6");
POKEDIS(TEMP+3,56,1,"7");
END # 2ND #
SLOWFOR J = FIRSTAC STEP 1 UNTIL (FIRSTAC + MAX$AC)
DO # LOOP THROUGH AC-S 0-3 OR 4-7 #
BEGIN
I = J*6;
LINE = TEMP + (J - FIRSTAC);
IF B<I+PATH$DF"U$EXISTS",1>PATH$WORD[0] EQ 0
THEN
BEGIN
POKEDIS ( LINE, 53, 5, ALTK$B5 ); # BLANK THE FIELD #
TEST J;
END
IF B<I+PATH$DF"U$ON",1>PATH$WORD[0] NQ 0
THEN
BEGIN
POKEDIS ( LINE, 57, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, 57, 1, ALTK$OFFLINE ); # OFFLINE MODE #
TEST J;
END
END # TEST J #
END # TEST ORD #
#
* CLEAR OUT ALL REQUEST BITS
#
END # DISPCU #
TERM
PROC DISPSM ( INDEX , INITIALIZE );
# TITLE DISPSM - DISPLAY *SM* INFORMATION #
BEGIN # DISPSM #
#
*** DISPSM - DISPLAY *SM* DISPLAY
*
* *DISPSM* GENERATES AND DISPLAYS THE *SM* DISPLAY
* FOR *SSALTER*
*
* ENTRY INDEX = SM TO BE DISPLAYED.
* INITIALIZE = TRUE IF AND ONLY IF *SSEXEC* IS
* BEING INITIALIZED.
*
*
* EXIT DISPLAY SHOWN ON LEFT SCREEN.
#
#
**** PROC DISPSM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC MESSAGE; # ISSUE A DAYFILE MESSAGE #
PROC POKEDIS; # UPDATE *K* DISPLAY #
PROC RESTPFP; # RESTORE USER-S PFP AND ABORT OR
RETURN #
PROC UCPREQ; # ISSUE UCP REQUEST TO SSEXEC #
FUNC XCDD C(10); # CONV INT TO DECIMAL DISPLAY #
FUNC XCOD C(10); # CONVERT INTEGER TO OCTAL DISPLAY
#
END
#
**** PROC DISPSM - XREF LIST END.
#
#
* DAYFILE MESSAGES.
#
DEF MSG1 #" DISPSM - INCORRECT RESPONSE FROM SSEXEC."#;
DEF BLANK #" "#;
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBUDT
*CALL,COMTALT
ARRAY CHAR10[0:0] S(3); # CHARACTER MANIPULATION #
BEGIN
ITEM CHAR$10 C(00,00,10);
ITEM CHAR$R3 C(00,42,03);
ITEM CHAR$R2 C(00,48,02);
ITEM CHAR$DRD0 C(01,00,10);
ITEM CHAR$2D0 C(01,48,02);
ITEM CHAR$D0 C(01,54,01);
ITEM CHAR$DRD1 C(02,00,10);
ITEM CHAR$2D1 C(02,48,02);
ITEM CHAR$D1 C(02,54,01);
END
ITEM CH C(2); # TWO CHARACTERS #
ITEM I I; # LOOP INDEX #
ITEM EST$ORD I; # EST ORDINAL #
ITEM INDEX I; # INPUT PARAMETER #
ITEM INITIALIZE B; # INPUT PARAMETER #
ITEM ORD I; # TEMPORARY STORAGE #
ITEM RESPCODE I; # RESPONSE FROM *SSEXEC* #
ITEM SMID C(1); # STORAGE MODULE ID #
ITEM TEMP I; # SCRATCH #
CONTROL EJECT;
ITEM SMBLANK C(58) =
" ";
ITEM SMHDR1 C(58) =
" PCU SCU SM/DRD";
ITEM SMHDR2 C(58) =
" ST ST ST";
ITEM SM$LINE C(58) =
" SM X N N X";
ITEM DRD$LINE C(58) =
" DRD N X";
ITEM DASH$LINE C(58) =
" ------------------------------------";
ITEM VALID$COM C(58) =
" VALID COMMANDS ARE -";
ITEM VAL$COM1 C(58) =
" K.SMI,CUNN=S.";
ITEM VAL$COM2 C(58) =
" K.SMI,DRDN,CUNN=S.";
ITEM VAL$COM3 C(58) =
" K.+ = DISPLAY NEXT SM";
ITEM VAL$COM4 C(58) =
" I = SM IDENTIFIER";
ITEM VAL$COM5 C(58) =
" N = DRD DEVICE ADDRESS";
ITEM VAL$COM6 C(58) =
" NN = CU EST ORDINAL";
ITEM VAL$COM7 C(58) =
" S = STATUS - U(ON),F(OFF),M(MAINTENANCE)";
ITEM VAL$COM8 C(58) =
" S = STATUS - U(ON),F(OFF)";
ITEM VAL$COM9 C(59) =
" + = DISPLAY NEXT SM";
CONTROL EJECT;
#
* BLANK THE *K* DISPLAY
#
P<SM$SCREEN> = LOC(KLEFTSCRNAL);
SLOWFOR I = LF$AL$BODY STEP 1 UNTIL LF$AL$KBECHO-1
DO
BEGIN
SM$LN[I] = SMBLANK;
SM$EOL[I] = 0;
END
#
* PAINT NON-CHANGING WORDS ON THE SCREEN
#
SM$LN[3] = SMHDR1;
SM$LN[4] = SMHDR2;
SM$LN[6] = SM$LINE;
SM$LN[8] = DRD$LINE;
SM$LN[10] = DRD$LINE;
SM$LN[11] = DASH$LINE;
SM$LN[12] = VALID$COM;
SM$LN[13] = VAL$COM1;
SM$LN[14] = VAL$COM2;
SM$LN[15] = VAL$COM3;
SM$LN[16] = VAL$COM4;
SM$LN[17] = VAL$COM5;
SM$LN[18] = VAL$COM6;
SM$LN[19] = VAL$COM8;
IF NOT INITIALIZE
THEN
BEGIN
SM$LN[19] = VAL$COM7;
END
#
* DISPLAY STATIC INFORMATION
#
P<UDT$SMA> = LOC( UDT$M861[INDEX] );
CHAR$DRD0[0] = XCDD(D0$SUN[1]);
CHAR$DRD1[0] = XCDD(D1$SUN[1]);
TEMP = 6; # SM LINE #
POKEDIS ( TEMP , 11 , 1 , SM$ID[1] );
ORD = SM$CUO0[1] - 1;
IF ORD NQ -1
THEN
BEGIN
P<UDT$CN> = LOC( UDT$M862[ORD] );
EST$ORD = UD$ESTO[1];
CHAR$10[0] = XCOD(EST$ORD);
END
ELSE
BEGIN
CHAR$10[0] = BLANK;
END
IF EST$ORD LQ O"77"
THEN # ORDINAL HAS 2 CHARACTERS #
BEGIN # TWO #
POKEDIS(TEMP,19,2,CHAR$R2[0]);
END # TWO #
ELSE # ORDINAL HAS 3 CHARACTERS #
BEGIN # THREE #
POKEDIS(TEMP,18,3,CHAR$R3[0]);
END # THREE #
ORD = SM$CUO1[1] - 1;
IF ORD NQ -1
THEN
BEGIN
P<UDT$CN> = LOC( UDT$M862[ORD] );
EST$ORD = UD$ESTO[1];
CHAR$10[0] = XCOD ( EST$ORD );
END
ELSE
BEGIN
CHAR$10[0] = BLANK; # BLANK IF NONE PRESENT #
END
IF EST$ORD LQ O"77"
THEN # ORDINAL HAS 2 CHARACTERS #
BEGIN # TWO #
POKEDIS(TEMP,28,2,CHAR$R2[0]);
END # TWO #
ELSE # ORDINAL HAS 3 CHARACTERS #
BEGIN # THREE #
POKEDIS(TEMP,27,3,CHAR$R3[0]);
END # THREE #
#
* GET UDT INFORMATION
#
UCPREQ ( TYP"TYP5", REQTYP5"SSA$PUDT", RESPCODE );
IF ( RESPCODE NQ RESPTYP5"OK5" ) ##
AND ( RESPCODE NQ RESPTYP5"SSA$OK" )
THEN
BEGIN # PROCESS INCORRECT RESPONSE #
UCPREQ ( TYP"TYP1", REQTYP1"DISCONNECT", RESPCODE );
ALTMSG$LN[0] = MSG1;
MESSAGE ( ALTMSG[0],SYSUDF1 );
RESTPFP ( PFP$ABORT );
END # PROCESS INCORRECT RESPONSE #
#
* EXTRACT UDT DATA AND UPDATE THE DYNAMIC K-DISPLAY
#
IF SM$EXIST[1]
THEN
BEGIN
IF SM$ON[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$OFFLINE );
END
IF SM$DIAG[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$MAINT );
END
IF SM$STS0[1] NQ 0
THEN
BEGIN # DISPLAY ACCESSOR STATUS FROM 1ST CU #
IF B<PATH
$DF
"U$ON",1>SM
$STS0
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 21 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 21 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>SM
$STS0
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 21 , 1 , ALTK$MAINT );
END
END # DISPLAY ACCESSOR STATUS FROM 1ST CU #
IF SM$STS1[1] NQ 0
THEN
BEGIN # DISPLAY ACCESSOR STATUS FROM 2ND CU #
IF B<PATH
$DF
"U$ON",1>SM
$STS1
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP ,30 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 30 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>SM
$STS1
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 30 , 1 , ALTK$MAINT );
END
END # DISPLAY ACCESSOR STATUS FROM 2ND CU #
IF NOT (SM$ON$ACK[1] OR SM$DAG$ACK[1])
THEN
BEGIN
POKEDIS ( TEMP , 48 , 1 , BLANK );
END
END
TEMP = 8 ; # SET FIRST DRD LINE #
IF D0$EXIST[1]
THEN
BEGIN
POKEDIS ( TEMP , 11 , 1 , CHAR$D0[0] );
IF D0$SUN[1] GQ 10
THEN # DRD ORDINAL HAS 2 CHARACTERS #
BEGIN # TWO #
POKEDIS(TEMP,10,2,CHAR$2D0[0]);
END # TWO #
IF D0$ON[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$OFFLINE );
END
IF D0$DIAG[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$MAINT );
END
END
IF D0$STSP[1] NQ 0
THEN
BEGIN # DISPLAY DRD STATUS FROM 1ST CU #
IF B<PATH
$DF
"U$ON",1>D0
$STSP
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>D0
$STSP
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$MAINT );
END
END # DISPLAY DRD STATUS FROM 1ST CU #
IF D0$STSS[1] NQ 0
THEN
BEGIN # DISPLAY DRD STATUS FROM 2ND CU #
IF B<PATH
$DF
"U$ON",1>D0
$STSS
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>D0
$STSS
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$MAINT );
END
END # DISPLAY DRD STATUS FROM 2ND CU #
IF NOT D0$EXIST[1]
THEN
BEGIN
POKEDIS ( TEMP , 2 , 5 , ALTK$B5 ); # BLANK NON-EXISTENT DRD #
POKEDIS(TEMP,10,2," ");
POKEDIS ( TEMP , 37 , 1 , BLANK );
POKEDIS ( TEMP , 48 , 1 , BLANK );
END
TEMP = 10; # SET SECOND DRD LINE #
IF D1$EXIST[1]
THEN
BEGIN
POKEDIS ( TEMP , 11 , 1 , CHAR$D1[0] );
IF D1$SUN[1] GQ 10
THEN # DRD ORDINAL HAS 2 CHARACTERS #
BEGIN # TWO #
POKEDIS(TEMP,10,2,CHAR$2D1[0]);
END # TWO #
IF D1$ON[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$OFFLINE );
END
IF D1$DIAG[1]
THEN
BEGIN
POKEDIS ( TEMP , 37 , 1 , ALTK$MAINT );
END
END
IF D1$STSP[1] NQ 0
THEN
BEGIN # DISPLAY DRD STATUS FROM 1ST CU #
IF B<PATH
$DF
"U$ON",1>D1
$STSP
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>D1
$STSP
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 20 , 1 , ALTK$MAINT );
END
END # DISPLAY DRD STATUS FROM 1ST CU #
IF D1$STSS[1] NQ 0
THEN
BEGIN # DISPLAY DRD STATUS FROM 2ND CU #
IF B<PATH
$DF
"U$ON",1>D1
$STSS
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$ONLINE );
END
ELSE
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$OFFLINE );
END
IF B<PATH
$DF
"U$RQ$DIAG",1>D1
$STSS
[1] EQ 1 THEN
BEGIN
POKEDIS ( TEMP , 29 , 1 , ALTK$MAINT );
END
END # DISPLAY DRD STATUS FROM 2ND CU #
IF NOT D1$EXIST[1]
THEN
BEGIN
POKEDIS ( TEMP , 2 , 5 , ALTK$B5 ); # BLANK NON-EXISTENT DRDS #
POKEDIS(TEMP,10,2," ");
POKEDIS ( TEMP , 37 , 1 , BLANK );
POKEDIS ( TEMP , 48 , 1 , BLANK );
END
END # DISPSM #
TERM
PROC KDISCIF ( INDEX, CIFORD );
# TITLE KDISCIF - DISPLAY CIF DATA FROM UDT. #
BEGIN # KDISCIF #
#
** KDIXCIF - DISPLAY CIF DATA FROM UDT.
*
* PROC KDISCIF ( INDEX, CIFORD )
*
* ENTRY - INDEX = DEVICE ADDRESS OF CIF TO DISPLAY.
* CIFORD = INDICATOR DESCRIBING COLUMN TO UPDATE.
*
* EXIT - *CU* DISPLAY UPDATED FOR CIF COLUMNS.
*
#
ITEM INDEX I; # INPUT VARIABLE #
ITEM CIFORD I; # INPUT VARIABLE #
#
**** PROC KDISCIF - XREF LIST BEGIN.
#
XREF
BEGIN
PROC POKEDIS; # POKE DATA INTO *K* DISPLAY
BUFFER #
PROC KDISDTX; # UPDATE DTI/DTO DISPLAY #
END
#
* KDISCIF - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBUDT
*CALL,COMTALT
CONTROL EJECT;
ITEM COLUMN I; # COLUMN NUMBER #
ITEM COLUMNM4 I; # COLUMN NUMBER MINUS 4 #
ITEM I I; # INTEGER SCRATCH #
ITEM J I; # LOOP VARIABLE #
ITEM LINE I; # LINE IN *K* DISPLAY #
CONTROL EJECT;
IF CIFORD EQ 0
THEN
BEGIN
COLUMN = 15;
COLUMNM4 = 11;
END
ELSE
BEGIN
COLUMN = 8;
COLUMNM4 = 4;
END
IF INDEX GQ 2
THEN
BEGIN
GOTO CIF23; # JUMP IF CIF2 OR CIF3 #
END
#
* LOOP FOR EACH DTI/DTO
#
SLOWFOR J = 0 STEP 1 UNTIL MAX$CIF
DO
BEGIN # CIF01 TESTING #
LINE = J + 10;
I = J*6;
IF B< I+(INDEX*24)+PATH$DF"U$EXISTS", 1>UD$CIF01[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK DISPLAY #
KDISDTX(J);
TEST J;
END
KDISDTX ( J ); # DISPLAY DTI/DTO ON OUT #
IF B< I+(INDEX*24)+PATH$DF"U$RQ$DIAG", 1 >UD$CIF01[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # DIAG MODE #
TEST J;
END
IF B< I+(INDEX*24)+PATH$DF"U$ON", 1 >UD$CIF01[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MD #
END
END # CIF01 TESTING #
RETURN;
CIF23:
#
* LOOP FOR EACH DTI/DTO ON CIF2/CIF3
#
INDEX = INDEX - 2;
SLOWFOR J = 0 STEP 1 UNTIL MAX$CIF
DO
BEGIN # CIF23 TESTING #
LINE = J + 10;
I = J*6;
IF B< I+(INDEX*24)+PATH$DF"U$EXISTS", 1>UD$CIF23[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK DISPLAY #
TEST J;
END
KDISDTX ( J ); # DISPLAY DTI/DTO ON OUT #
IF B< I+(INDEX*24)+PATH$DF"U$RQ$DIAG", 1 >UD$CIF23[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # DIAG MODE #
TEST J;
END
IF B< I+(INDEX*24)+PATH$DF"U$ON", 1 >UD$CIF23[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MD #
END
END # CIF23 TESTING #
RETURN;
END # KDISCIF #
TERM
PROC KDISDIF ( INDEX );
# TITLE KDISDIF - DISPLAY DIF DATA FROM UDT. #
BEGIN # KDISDIF #
#
** KDISDIF - DISPLAY DTI/DTO DATA FROM UDT.
*
* PROC KDISDIF ( INDEX )
*
* ENTRY - INDEX = DEVICE ADDRESS OF DIF TO DISPLAY.
*
* EXIT - *CU* DISPLAY UPDATED FOR DIF COLUMNS.
*
#
ITEM INDEX I; # INPUT VARIABLE #
#
**** PROC KDISDIF - XREF LIST BEGIN.
#
XREF
BEGIN
PROC KDISDRC; # DISPLAY DRC ON OUT #
PROC POKEDIS; # POKE DATA INTO *K* DISPLAY
BUFFER #
END
#
* KDISDIF - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBUDT
*CALL,COMTALT
CONTROL EJECT;
ITEM COLUMN I; # *K* DISPLAY COLUMN #
ITEM COLUMNM4 I; # *K* DISPLAY COLUMN #
ITEM I I; # INTEGER SCRATCH #
ITEM J I; # LOOP VARIABLE #
ITEM LINE I; # LINE IN *K* DISPLAY #
CONTROL EJECT;
COLUMN = 36; # POSITION COLUMN #
COLUMNM4 = 32; # POSITION 5 BLANKS #
I = INDEX*24; # POSITION TO CORRECT FIELD #
#
* LOOP FOR EACH DIF
#
SLOWFOR J = 0 STEP 1 UNTIL MAX$DRC
DO
BEGIN # DIF TESTING #
LINE = J + 10;
IF INDEX EQ 1
THEN
BEGIN # ADJUST FOR THE DISPLAY #
LINE = LINE + 7;
END # ADJUST FOR THE DISPLAY #
KDISDRC ( J ); # DISPLAY DRC ON OUT #
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1>UD$DIF[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1>UD$DIF[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1>UD$DIF[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MD #
END
END # DIF TESTING #
END # KDISDIF #
TERM
PROC KDISDRC ( INDEX );
# TITLE KDISDRC - DISPLAY DRC DATA FROM UDT. #
BEGIN # KDISDRC #
#
** KDISDRC - DISPLAY DRC DATA FROM UDT.
*
* PROC KDISDRC ( INDEX )
*
* ENTRY - INDEX = DEVICE ADDRESS OF DRC TO DISPLAY.
*
* EXIT - *CU* DISPLAY UPDATED FOR *DRC* COLUMNS.
*
#
ITEM INDEX I; # INPUT VARIABLE #
#
**** PROC KDISDRC - XREF LIST BEGIN.
#
XREF
BEGIN
PROC POKEDIS; # POKE DATA INTO *K* DISPLAY
BUFFER #
FUNC XCDD C(10); # CONVERT DECIMAL TO DISP CODE #
END
#
* KDISDRC - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBUDT
*CALL,COMTALT
#
* SWITCH STATEMENT
#
SWITCH DRCCOLUMN
DRC0,
DRC1,
DRC2,
DRC3;
CONTROL EJECT;
ITEM COLUMN I; # *K* DISPLAY COLUMN #
ITEM COLUMNM4 I; # *K* DISPLAY COLUMN #
ITEM I I; # INTEGER SCRATCH #
ITEM J I; # LOOP VARIABLE #
ITEM LINE I; # LINE IN *K* DISPLAY #
#
* CHARACTER MANIPULATION.
#
ARRAY DRDSCR[0:0] S(1); # FOR DRD ORDINALS > 7 #
BEGIN
ITEM CHAR10 C(00,00,10);
ITEM CHAR2 C(00,48,02);
ITEM CHAR C(00,54,01);
END
CONTROL EJECT;
#
* INITIALIZE *K* DISPLAY COORDINATES.
#
IF (INDEX EQ 0 AND UD$DRCP0[1] EQ 0) ##
OR (INDEX EQ 1 AND UD$DRCP1[1] EQ 0) ##
OR (INDEX EQ 2 AND UD$DRCP2[1] EQ 0) ##
OR (INDEX EQ 3 AND UD$DRCP3[1] EQ 0)
THEN # DRC DOES NOT EXIST ON THIS CU #
BEGIN # SKIP #
RETURN;
END # SKIP #
IF INDEX GR 1
THEN
BEGIN # ADJUST - EXPANDED CONFIGURATION #
LINE = 8;
COLUMN = 42 + (INDEX-2)*7;
IF INDEX EQ 2
THEN
BEGIN
POKEDIS( LINE , COLUMN , 1 , ALTK$DRC2 ); # SET DRC2 #
END
ELSE
BEGIN
POKEDIS ( LINE , COLUMN , 1 , ALTK$DRC3 ); # SET DRC3 #
END
LINE = 10; # FIRST LINE OF DRD-S #
SLOWFOR J = (MAX$DRD + 1) STEP 1 UNTIL MAX$DRDDA
DO # RESET TO SECOND DRD GROUP #
BEGIN # RESET #
IF J LS 10
THEN # DRD IS ONE DIGIT #
BEGIN # ONE #
CHAR10 = XCDD(J);
POKEDIS(LINE,COLUMN,1,CHAR);
END # ONE #
ELSE # DRD IS TWO DIGITS #
BEGIN # TWO #
CHAR10 = XCDD(J);
POKEDIS(LINE,COLUMN,2,CHAR2);
END # TWO #
LINE = LINE + 1;
END # RESET #
END # ADJUST - EXPANDED CONFIGURATION #
IF INDEX EQ 0 ##
OR INDEX EQ 2
THEN
BEGIN
COLUMN = 43; # COLUMN FOR DRC0/DRC2 DATA #
COLUMNM4 = 39;
END
ELSE
BEGIN
COLUMN = 50; # COLUMN FOR DRC1/DRC3 DATA #
COLUMNM4 = 46;
END
GOTO DRCCOLUMN[INDEX];
DRC0:
#
* LOOP FOR EACH DRD ON DRC0
#
SLOWFOR J = 0 STEP 1 UNTIL MAX$DRD
DO
BEGIN # DRD TESTING #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1>UD$DRCP0[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1>UD$DRCP0[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1>UD$DRCP0[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING #
RETURN;
DRC1:
#
* LOOP FOR EACH DRD ON DRC1
#
SLOWFOR J = 0 STEP 1 UNTIL MAX$DRD
DO
BEGIN # DRD TESTING FOR DRC1 #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1 >UD$DRCP1[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1 >UD$DRCP1[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1 >UD$DRCP1[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING FOR DRC1 #
RETURN;
DRC2:
#
* LOOP FOR EACH DRD ON DRC2
#
SLOWFOR J = 0 STEP 1 UNTIL 1
DO
BEGIN #DRD TESTING FOR DRC 2 #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1 >UD$DRCP2[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1 >UD$DRCP2[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1 >UD$DRCP2[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING FOR DRC2 #
COLUMN = COLUMN + 1;
SLOWFOR J = 2 STEP 1 UNTIL MAX$DRD
DO
BEGIN # DRD TESTING #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1 >UD$DRCP2[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 6, ALTK$B6 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1 >UD$DRCP2[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1 >UD$DRCP2[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING FOR DRC2 #
RETURN;
DRC3:
#
* LOOP FOR EACH DRD ON DRC 3
#
SLOWFOR J = 0 STEP 1 UNTIL 1
DO
BEGIN # DRD TESTING #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1 >UD$DRCP3[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1 >UD$DRCP3[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1 >UD$DRCP3[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING FOR DRC3 #
COLUMN = COLUMN + 1; # PRESET FOR 2-DIGIT DRD-S #
SLOWFOR J = 2 STEP 1 UNTIL MAX$DRD
DO
BEGIN # DRD TESTING #
LINE = J + 10;
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1 >UD$DRCP3[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 6, ALTK$B6 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1 >UD$DRCP3[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1 >UD$DRCP3[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MODE #
END
END # DRD TESTING FOR DRC3 #
END # KDSIDRC #
TERM
PROC KDISDTX ( INDEX );
# TITLE KDISDTX - DISPLAY DTI/DTO DATA FROM UDT. #
BEGIN # KDISDTX #
#
** KDISDTX - DISPLAY DTI/DTO DATA FROM UDT.
*
* PROC KDISDTX ( INDEX )
*
* ENTRY - INDEX = DEVICE ADDRESS OF DTI/DTO TO DISPLAY.
*
* EXIT - *CU* DISPLAY UPDATED FOR DTI/DTO COLUMNS.
*
#
ITEM INDEX I; # INPUT VARIABLE #
#
**** PROC KDISDTX - XREF LIST BEGIN.
#
XREF
BEGIN
PROC POKEDIS; # POKE DATA INTO *K* DISPLAY
BUFFER #
PROC KDISDIF; # DISPLAY DIF STATUS #
END
#
* KDISDTX - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBUDT
*CALL,COMTALT
CONTROL EJECT;
ITEM COLUMN I; # *K* DISPLAY COLUMN #
ITEM COLUMNM4 I; # *K* DISPLAY COLUMN #
ITEM I I; # INTEGER SCRATCH #
ITEM J I; # LOOP VARIABLE #
ITEM LINE I; # LINE IN *K* DISPLAY #
CONTROL EJECT;
#
* INITIALIZE *K* DISPLAY COORDINATES.
#
IF INDEX LQ MAX$DTI
THEN
BEGIN
COLUMN = 22; # COLUMN FOR *DTI* DATA #
COLUMNM4 = 18;
END
ELSE
BEGIN
COLUMN = 29; # COLUMN FO *DTO* DATA #
COLUMNM4 = 25;
GOTO DTO; # PROCESS *DTO* REQUEST #
END
I = INDEX*12; # POSITION TO CORRECT FIELD #
#
* LOOP FOR EACH DTI
#
SLOWFOR J = 0 STEP 1 UNTIL MAX$DIF
DO
BEGIN # DTI TESTING #
LINE = J + 10;
IF INDEX EQ 1
THEN
BEGIN # ADJUST FOR THE DISPLAY #
LINE = LINE + 5;
END # ADJUST FOR THE DISPLAY #
KDISDIF ( J ); # DISPLAY DIF ON OUT #
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1>UD$DTI[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1>UD$DTI[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1>UD$DTI[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MD #
END
END # DTI TESTING #
RETURN;
DTO:
INDEX = INDEX - 2;
I = INDEX*12;
SLOWFOR J = 0 STEP 1 UNTIL MAX$DIF
DO
BEGIN # DTO TESTING #
LINE = J + 10;
IF INDEX EQ 1
THEN
BEGIN # ADJUST FOR THE DISPLAY #
LINE = LINE + 5;
END # ADJUST FOR THE DISPLAY #
KDISDIF ( J ); # DISPLAY DIF ON OUT #
IF B< (J*6)+I+PATH$DF"U$EXISTS", 1>UD$DTO[1] EQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMNM4, 5, ALTK$B5 ); # BLANK FIELD #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$RQ$DIAG", 1>UD$DTO[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$MAINT ); # SET DIAG MODE #
TEST J;
END
IF B< (J*6)+I+PATH$DF"U$ON", 1>UD$DTO[1] NQ 0
THEN
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$ONLINE ); # ONLINE MODE #
TEST J;
END
ELSE
BEGIN
POKEDIS ( LINE, COLUMN, 1, ALTK$OFFLINE ); # OFFLINE MD #
END
END # DTO TESTING #
INDEX = INDEX +2;
END # KDISDTX #
TERM
PROC POKEDIS ( LINE, CHAR, COUNT, VALUE );
# TITLE POKEDIS - SET VALUE IN DISPLAY. #
BEGIN # POKEDIS #
#
** POKEDIS - SET CHARACTER VALUE IN DISPLAY.
*
* *POKEDIS* POKES A CHARACTER INTO AN EXISTING
* *SM* OR *CU* DIPLAY. THE CHARACTER INIDICATES THE
* CURRENT OR REQUESTED STATE OF ONE OF PATHS/NODES
* IN THE M860 CURRENTLY UNDER INSPECTION BY *SSALTER*.
*
* ENTRY
* LINE - ONE OF THE (LF$AL$NLIN) LINES IN THE *K* DISPLAY.
* CHAR - THE STARTING COLUMN NUMBER TO BE USED.
* COUNT - THE NUMBER OF CHARACTERS IN THE STRING.
* VALUE - THE CHARACTER STRING TO BE INSERTED.
*
*
* EXIT
*
* CHARACTER(S) POKED INTO THE DISPLAY.
#
#
**** PROC POKEDIS - XREF LIST BEGIN.
#
XREF
BEGIN
END
#
**** PROC POKEDIS - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMTALT
ITEM LINE I; # INPUT PARAMETER #
ITEM CHAR I; # INPUT PARAMETER #
ITEM COUNT I; # INPUT PARAMETER #
ITEM VALUE C(10); # INPUT PARAMETER #
CONTROL EJECT;
#
* SET CHARACTER(S) INTO DISPLAY
#
C<CHAR,COUNT>SM$LN[LINE] = VALUE;
END # POKEDIS #
TERM
PROC UCPREQ((REQTYPE),(REQCODE),RESPCODE);
# TITLE UCPREQ - ISSUES TYPE 1 OR 5 UCP REQUEST TO EXEC. #
BEGIN # UCPREQ #
#
** UCPREQ - ISSUES A TYPE 1 OR 5 UCP REQUEST TO EXEC.
*
* PROC UCPREQ((REQTYPE),(REQCODE),RESPCODE)
*
* ENTRY (REQTYPE) = REQUEST TYPE.
* (REQCODE) = REQUEST CODE.
* (USER$FAM) = FAMILY NAME.
* (REQID$AL) = REQUESTOR ID.
* (SSID$AL) = SUBSYSTEM ID.
* P<CPR> = FWA OF CALLSS PARAMETER BLOCK.
*
* EXIT (RESPCODE) = RESPONSE FROM EXEC.
*
* MESSAGES SSALTER ABNORMAL, UCPREQ.
*
* NOTES THE CALLSS PARAMETER REQUEST BLOCK IS SET
* UP FOR A TYPE 1 OR TYPE 5 UCP REQUEST AND
* THE REQUEST IS ISSUED TO EXEC.
#
ITEM REQTYPE I; # REQUEST TYPE #
ITEM REQCODE I; # REQUEST CODE #
ITEM RESPCODE I; # RESPONSE FROM EXEC #
#
**** PROC UCPREQ - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # STOPS PROCESSING #
PROC CALLSS; # ISSUES A UCP/SCP REQUEST #
PROC MESSAGE; # DISPLAYS MESSAGES #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC ZFILL; # ZERO FILL A BUFFER #
END
#
**** PROC UCPREQ - XREF LIST END.
#
DEF PROCNAME #"UCPREQ."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBPFP
*CALL,COMBUDT
*CALL COMSPFM
*CALL COMTALT
ITEM I I; # LOOP INDUCTION VARIABLE #
ITEM LOOPC B; # LOOP CONTROL #
ITEM WORDCOUNT I; # WORD COUNT OF UDT #
CONTROL EJECT;
#
* ZERO FILL CALLSS PARAMETER BLOCK.
#
ZFILL ( CPR[0], 1 ); # ZERO FIRST WORD #
ZFILL ( CPR[3], CPRLEN - 3 ); # ZERO WORDS 4 - CPRLEN #
CPR$RQT[0] = REQTYPE; # SET UP PARAMETER BLOCK #
CPR$RQC[0] = REQCODE;
CPR$RQI[0] = REQID$AL;
CPR$RT[0] = 2; # HAVE SYSTEM CONTROL REQUEST #
CPR$ADDR2 = LOC(UDT$HDR);
WORDCOUNT = 0;
IF REQTYPE EQ TYP"TYP1"
THEN # TYPE 1 REQUEST #
BEGIN
CPR$WC[0] = TYP1$WC;
END
ELSE
BEGIN # TYPE 5 OR ILLEGAL REQUEST #
IF REQTYPE EQ TYP"TYP5"
THEN # TYPE 5 REQUEST #
BEGIN
IF REQCODE EQ REQTYP5"SSA$PUDT"
THEN
BEGIN
CPR$ADDR4 = PRULEN; # SET COUNT AT *CPUMTR* MAX #
CPR$ADDR3 = 0;
END
CPR$WC[0] = TYP5$WC;
END
ELSE # ILLEGAL REQUEST TYPE #
BEGIN
ALTMSG$PROC[0] = PROCNAME;
MESSAGE(ALTMSG[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # TYPE 5 OR ILLEGAL REQUEST #
CALLSS(SSID$AL,CPR[0],RCL);
IF CPR$ES[0] EQ 0
THEN
BEGIN
RESPCODE = CPR$RQR[0]; # RETURN RESPONSE FROM EXEC #
END
ELSE
BEGIN
RESPCODE = CPR$ES[0]; # RETURN RESPONSE FROM SYSTEM #
RETURN;
END
IF REQTYPE NQ TYP"TYP5"
THEN
BEGIN
RETURN; # RETURN IF NOT *SSA$PUDT* REQ #
END
IF REQCODE NQ REQTYP5"SSA$PUDT"
THEN
BEGIN
RETURN; # RETURN IF NOT PASS UDT REQUEST #
END
ELSE
BEGIN
P<UDT$WORD> = LOC(UDT$HDR);
WORDCOUNT = UDT$WORDCNT - PRULEN;
LOOPC = FALSE;
SLOWFOR I = 0 STEP PRULEN WHILE ( NOT LOOPC )
DO
BEGIN
CPR$ADDR2 = CPR$ADDR2 + PRULEN;
CPR$ADDR3 = CPR$ADDR3 + PRULEN;
IF WORDCOUNT GR PRULEN
THEN
BEGIN
CPR$ADDR4[0] = PRULEN;
WORDCOUNT = WORDCOUNT - PRULEN;
END
ELSE
BEGIN
CPR$ADDR4[0] = WORDCOUNT;
LOOPC = TRUE;
END
CPR$C[0] = FALSE;
CPR$ES[0] = 0;
CALLSS ( SSID$AL, CPR[0], RCL );
TEST I;
END
IF CPR$ES[0] NQ 0
THEN
BEGIN
RESPCODE = CPR$ES[0];
RETURN;
END
ELSE
BEGIN
RESPCODE = CPR$RQR[0];
END
END
END # UCPREQ #
TERM