PRGM SSBLD; # TITLE SSBLD - MAIN ROUTINE OF SSBLD. # BEGIN # SSBLD # # *** SSBLD - BUILD UDT FOR SSEXEC. * * SSBLD ATTACHES THE FILE SPECIFIED BY THE CONTROL STATEMENT * CALL AND BUILDS A DIRECT ACCESS PERMANENT FILE - BUDT * UNDER USER INDEX 377760B. * * * SSBLD(PARAMETER1,PARAMTER2) - PARAMETERS ARE OPTIONAL. * * PARAMETER DESCRIPTION * * CF USE DIRECT ACCESS PERMANENT FILE *SUDT* UNDER * UI = 377760B AS INPUT FOR BUILDING THE UDT. * * CF=LFN USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER * UI = 377760B AS INPUT FOR BUILDING THE UDT. * * CF OMITTED SAME AS CF. * * BF USE DIRECT ACCESS PERMANENT FILE *BUDT* UNDER * UI = 377760B FOR DESTINATION BUDT FILE. * * BF=LFN USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER * UI = 377760B FOR DESTINATION BUDT FILE. * * BF OMITTED SAME AS BF. * * MESSAGES * * SSBLD ABORT - SYNTAX ERROR. * SSBLD - MUST BE SYSTEM ORIGIN. * SSBLD - CANNOT RE-ATTACH BUDT FILE. * SSBLD - NO SOURCE CONFIGURATION FILE. * SSBLD - SUDT FILE BUSY. * SSBLD - BUDT FILE BUSY. * SSBLD - UNABLE TO DEFINE BUDT FILE. * SSBLD - BUDT FILE PROBLEMS. * SSBLD - COMPLETE. * * * * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. # # **** PRGM SSBLD - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # CALLS *ABORT* MACRO # PROC BLTAB; # SETS UP ARGUMENT LIST # PROC BZFILL; # BLANK OR ZERO FILL A BUFFER # PROC GETPFP; # GET USER INDEX AND FAMILY # PROC GETSPS; # GET SYSTEM ORIGIN PRIVILEDGES # PROC MESSAGE; # CALLS MESSAGE MACRO # PROC NEXTLIN; # READ NEXT LINE # PROC PFD; # *PFM* REQUEST INTERFACE # PROC RDSUDT; # READ CONFIGURATION FILE SOURCE # PROC RETERN; # RETURN A FILE # PROC RESTPFP; # RESTORE USER-S *PFP* # PROC WTBUDT; # WRITE UDT TO DISK FILE # PROC XARG; # CRACK PARAMETER LIST # END # **** PRGM SSBLD - XREF LIST END. # DEF SMMAX #"H"#; # MAXIMUM SM VALUE # DEF SMMIN #"A"#; # MINIMUM SM VALUE # DEF NOPARAM #-1#; # NO PARAMETER SPECIFIED # DEF PROCNAME #"SSBLD."#; # PROCEDURE NAME # DEF RSLEN #1#; # RETURN STATUS LENGTH # DEF SYNTAXOK #0#; # SYNTAX OK # DEF LISTCON #0#; # DO NOT LIST COMDECKS # CONTROL PRESET; *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBPFP *CALL COMBUDT *CALL COMSPFM *CALL COMTBLD *CALL COMTBLP ITEM ARGLIST U; # ADDRESS OF ARGUMENT TABLE # ITEM FLAG U; # ERROR FLAG FOR ASARG # ITEM OPTION I; # OPTION TO SKIP PROGRAM NAME # ARRAY MSGDETAIL1 [0:0] P(4); BEGIN # ARRAY MSGDETAIL1 # ITEM LEAD1 C(00,00,01) = [" "]; # LEADING BLANK # ITEM MSGPFNH C(00,06,04) = ["PFN="]; # PFN= # ITEM MSGPFN C(00,30,07); # FILE NAME # ITEM MSGFAMH C(01,12,09) = [", FAMILY="]; # FAMILY = # ITEM MSGFAM C(02,06,08); # FAMILY AND COMMA # ITEM MSGZRO1 U(03,00,12) = [0]; # TERMINATOR # END # ARRAY MSGDETAIL1 # ARRAY SPSSTAT [0:0] S(RSLEN); BEGIN ITEM SPS$STATUS U(00,48,12); # RETURN STATUS # END CONTROL EJECT; # * GET SYSTEM ORIGIN PRIVILEDGES. # GETSPS(SPSSTAT); IF SPS$STATUS NQ 0 THEN BEGIN BLMSG$LN[0] = " SSBLD - MUST BE SYSTEM ORIGIN."; MESSAGE(BLMSG[0],SYSUDF1); ABORT; # ABORT # END # * SAVE THE USER-S CURRENT FAMILY AND INDEX IN COMMON. # GETPFP(PFP[0]); USER$FAM[0] = PFP$FAM[0]; USER$UI[0] = PFP$UI[0]; # * CRACK THE PARAMETERS ON THE *SSBLD* CALL. # BLTAB(ARGLIST); # SET UP THE ARGUMENT LIST # OPTION = 0; # SKIP OVER PROGRAM NAME # XARG(ARGLIST,OPTION,FLAG); # CRACK THE PARAMETERS # IF FLAG NQ SYNTAXOK THEN BEGIN BLMSG$LN[0] = " SSBLD ABORT - SYNTAX ERROR."; MESSAGE(BLMSG[0],SYSUDF1); # SYNTAX ERROR MESSAGE # RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # * ATTACH SSEXEC UDT SOURCE FILE. # CFNAME = DARG$CF[0]; BZFILL(CFNAME,TYPFILL"ZFILL",7); # ZERO FILL FILE NAME # BEGIN PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"NA",0,0); IF FLAG NQ OK THEN BEGIN # PROCESS ATTACH ERROR FLAG # IF FLAG EQ FBS THEN # SSEXEC UDT SOURCE FILE BUSY # BEGIN BLMSG$LN[0] = " SSBLD - SUDT FILE BUSY."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RETORE USER-S PFP AND ABORT # END BEGIN BLMSG$LN[0] = " SSBLD - NO SOURCE CONFIGURATION FILE. "; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END END # PROCESS ATTACH ERROR FLAG # END # * ATTACH SSEXEC UDT BINARY FILE. # CFNAME = DARG$BF[0]; BZFILL(CFNAME,TYPFILL"ZFILL",7); BEGIN PFD("ATTACH",CFNAME,0,"M","W","RC",FLAG,"NA",0,"PW",BUDTPW,0); IF FLAG NQ OK THEN BEGIN # PROCESS ATTACH ERROR FLAG # IF FLAG EQ FBS THEN # COMMUNICATION FILE BUSY # BEGIN BLMSG$LN[0] = " SSBLD - BUDT FILE BUSY."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END IF FLAG EQ FNF THEN # FILE DOES NOT EXIST # BEGIN PFD("DEFINE",CFNAME,0,"RC",FLAG,0,"PW",BUDTPW,0); IF FLAG NQ OK THEN # PROCESS DEFINE ERROR # BEGIN BLMSG$LN[0] = " SSBLD - UNABLE TO DEFINE BUDT FILE."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END END ELSE # ABNORMAL TERMINATION # BEGIN BLMSG$LN[0] = " SSBLD - BUDT FILE PROBLEMS. "; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END END # PROCESS ATTACH ERROR FLAG # END # * READ THE CONFIGURATION SOURCE FILE AND GENERATE UDT. # RDSUDT; # * WRITE THE UDT TO DISK. # WTBUDT; # * REATTACH UDT FILE, CLEANUP, AND EXIT. # PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"PW",BUDTPW,0); IF FLAG NQ OK THEN # PERMANENT FILE PROBLEM # BEGIN BLMSG$LN[0] = " SSBLD - CANNOT RE-ATTACH BUDT FILE."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END RETERN(BL$FET[0],RCL); BLMSG$LN[0] = " SSBLD COMPLETE."; # SSBLD COMPLETE # MESSAGE(BLMSG[0],UDFL1); RESTPFP(PFP$END); # RESTORE USER-S *PFP* # END # SSBLD # TERM PROC RDSUDT; # TITLE RDSUDT - READ *SUDT* OR OTHER SPECIFIED FILE TO MEMORY. # BEGIN # RDSUDT # # ** RDSUDT - READ CONFIGURATION SOURCE FILE TO MEMORY. * * THIS PROCEDURE READS THE M860 CONFIGURATION SOURCE * FILE TO SSBLD-S MEMORY FOR INTERPRETATION PRIOR * TO SSBLD GENERATING THE *BUDT* FILE. * RDSUDT READS THE CONFIGURATION FILE ONE LINE AT * TIME. THESE STATEMENTS MUST APPEAR IN A SPECIFIED ORDER. * IF NOT, RDSUDT WILL ABORT THE JOB. THE ORDER IS: * * ALL *CU* STATEMENTS APPEAR FIRST. * ALL *CIF* STATEMENTS APPREAR NEXT. * ALL *DTI* STATEMENTS APPEAR NEXT. * ALL *DTO* STATEMENTS APPEAR NEXT. * ALL *DIF* STATEMENTS APPEAR NEXT. * ALL *DRC* STATEMENTS APPEAR NEXT. * ALL *DRD* STATEMENTS APPEAR NEXT. * ALL *AIF* STATEMENTS APPEAR NEXT. * ALL *SM* STATEMENTS APPEAR LAST. * * THE ABOVE STATEMENTS ARE THE ONLY LEGAL MNEMONIC * DESCRIPTORS ALLOWED. USE OF ANY OTHER DESCRIPTOR * WILL CAUSE *SSBLD* TO ABORT. * * AN ASTERISK (*) IN COLUMN ONE INDICATES A COMMENT * STATEMENT. * * * PROC RDSUDT. * * ENTRY NONE. * * EXIT CONFIGURATION SOURCE FILE READ TO MEMORY. * IT WILL BE SCANNED FOR SYNTACTICAL CORRECTNESS * AND CORRECT ORDER. * * MESSAGES * * RDSUDT - CONFIGURATION FILE EMPTY. * RDSUDT - INCORRECT *CU* COUNT. * RDSUDT - MISSING *SM* COUNT COMMAND. * RDSUDT - CAN-T CRACK *SM* COMMAND. * RDSUDT - CH/CIF CONFLICT. * RDSUDT - INCORRECT *SM* COUNT. * RDUSDT - NULL DIRECTIVE. * RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE. * RDSUDT - INCORRECT EST ORDINAL. * RDSUDT - *CU* ENTRY MISSING = SIGN. * RDSUDT - CHANNEL 0 NOT FIRST CHANNEL. * RDSUDT - MISSING CHANNELS ON *CU* COMMAND. * RDSUDT - *CIF* COMMAND MISSING = SIGN. * RDSUDT - *DTI* COMMAND MISSING = SIGN. * RDSUDT - *DTO* COMMAND MISSING = SIGN. * RDSUDT - *DIF* COMMAND MISSING = SIGN. * RDSUDT - *DRC* COMMAND MISSING = SIGN. * RDSUDT - *AIF* COMMAND MISSING = SIGN. * RDSUDT - *SM* COMMAND MISSING = SIGN. * RDSUDT - *SM* COMMAND MISSING COMMA. * RDSUDT - INCORRECT DEVICE ADDRESS. * RDSUDT - EXTRA ENTRIES ON DIRECTIVE. * RDSUDT - INCORRECT CONFIGURATION FILE HEADER. * RDSUDT - STATEMENT OUT OF ORDER. * RDSUDT - INCORRECT STATUS. * RDSUDT - INCORRECT COMMAND TERMINATOR. * RDSUDT - EXTRA PATHS TO *DRD*. * RDSUDT - EXTRA PATHS TO *SM*. * RDSUDT - SOURCE FILE STATEMENT CONFLICT. * RDSUDT - COMMAND SYNTAX ERROR. * RDSUDT - INCORRECT STATEMENT MNEMONIC. * RDSUDT - STATEMENT OUT OF ORDER. * RDSUDT - CONFIGURATION FILE STATEMENT CONFLICT. * RDSUDT - SM STATEMENT - INCORRECT DS VALUE. * RDSUDT - SM STATEMENT - INCORRECT ST VALUE. * RDSUDT - INVALID AIF PATHS. * # # **** PROC RDSUDT - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILLS AN ITEM # PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE # PROC NEXTLIN; # READ NEXT LINE AND CHECK IT # PROC NEXTPRM; # GET NEXT PARAMETER, CHECK IT # PROC READ; # READS A FILE # PROC READC; # READ ONE LINE # PROC READW; # DATA TRANSFER ROUTINE # PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT OR RETURN # PROC RETERN; # RETURNS A FILE # PROC REWIND; # REWINDS A FILE # PROC UPDRDST; # UPDATE NODE STATUS # FUNC XDXB; # CONVERT DISPLAY CODE TO BINARY # PROC ZFILL; # ZERO FILLS A BUFFER # PROC ZSETFET; # SETS UP A FET # END # **** PROC RDSUDT - XREF LIST END. # DEF MSG$BADEST #" RDSUDT - INCORRECT EST ORDINAL. "#; DEF MSG$BADADR #" RDSUDT - INCORRECT DEVICE ADDRESS. "#; DEF MSG$BADENT #" RDSUDT - EXTRA ENTRIES ON DIRECTIVE."#; DEF MSG$BADNUM #" RDSUDT - INCORRECT CONFIGURATION FILE HEADER."#; DEF MSG$BADST #" RDSUDT - INCORRECT STATEMENT MNEMONIC."#; DEF MSG$BDORD #" RDSUDT - STATEMENT OUT OF ORDER."#; DEF MSG$BDST #" RDSUDT - INCORRECT STATUS."#; DEF MSG$BDTERM #" RDSUDT - INCORRECT COMMAND TERMINATOR. "#; DEF MSG$EXDRD #" RDSUDT - EXTRA PATHS TO *DRD*."#; DEF MSG$EXPATH #" RDSUDT - EXTRA PATHS TO *SM*."#; DEF MSG$INCCU #" RDUSDT - INCORRECT *CU* COUNT."#; DEF MSG$INCSM #" RDSUDT - INCORRECT *SM* COUNT."#; DEF MSG$INVAIF #" RDSUDT - INVALID AIF PATHS."#; DEF MSG$SM$DS #" RDSUDT - SM STATEMENT - INCORRECT DS VALUE."#; DEF MSG$SM$ST #" RDSUDT - SM STATEMENT - INCORRECT ST VALUE."#; DEF MSG$STCON #" RDSUDT - SOURCE FILE STATEMENT CONFLICT"#; DEF MSG$SYNER #" RDSUDT - COMMAND SYNTAX ERROR"#; DEF PROCNAME #"RDSUDT."#; # PROC NAME # DEF ZERO #0#; # CONSTANT ZERO # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBFET *CALL COMBTDM *CALL COMBUDT *CALL COMSPFM *CALL COMTBLD *CALL COMTBLP *CALL COMTOUT ITEM ACCESSOR I; # DEVICE ADDRESS OF M861 # ITEM ARGLIST I; # ARGUMENT LIST ADDRESS # ITEM BUFP I; # FWA OF BUFFER # ITEM CHAR1 C(1); # ONE CHARACTER # ITEM CHAR2 C(2); # TWO CHARACTERS # ITEM CHAR3 C(3); # THREE CHARACTERS # ITEM CUNUM I; # ORDINAL OF CURRENT *CU* # ITEM CUXX I; # ORDINAL OF PRIMARY *CU* # ITEM CUYY I; # ORDINAL OF SECONDARY *CU* # ITEM NCOL I; # NEXT COLUMN NUMBER # ITEM SCOL I; # STARTING COLUMN NUMBER # ITEM DEVTYPE C(3); # DEVICE NMEMONIC # ITEM DIRNUM I; # DIRECTIVE NUMBER # ITEM DIRLINE C(90); # DIRECTIVE TEXT LINE # ITEM DRDNUM I; # ORDINAL OF CURRENT *DRD* # ITEM EOR B; # END-OF-RECORD FLAG # ITEM FETP I; # FWA OF FET # ITEM FOUND B; # LOOP EXIT CONTROL # ITEM ARGKEY2 C(2); # ARGUMENT KEY - 2 CHARACTERS # ITEM ARGKEY3 C(3); # ARGUMENT KEY - 3 CHARACTERS # ITEM NKEY2 C(2); # DIRECTIVE KEY - 2 CHARACTER # ITEM OKEY2 C(2); # DIRECTIVE KEY - 2 CHARACTER # ITEM NKEY3 C(3); # DIRECTIVE KEY - 3 CHARACTER # ITEM OKEY3 C(3); # DIRECTIVE KEY - 3 CHARACTER # ITEM KEYOK B; # CONTROL VARIABLE # ITEM MASK I; # MASK FOR SPECIAL FILE NAMES # ITEM I I; # LOOP INDEX # ITEM J I; # LOOP INDEX # ITEM K I; # LOOP INDEX # ITEM LFN C(7); # FILE NAME # ITEM MAXARG I; # MAXIMUM NUMBER OF ARGUMENTS # ITEM LOOPC B; # LOOP CONTROL VARIABLE # ITEM LOOPK B; # LOOP CONTROL VARIABLE # ITEM LOOPL B; # LOOP CONTROL # ITEM NUMCH I; # NUMBER OF CHARACTERS # ITEM ORD I; # ORDINAL OF DEVICE TYPE # ITEM SAVEDORD I; # SAVED DRD ORDINAL # ITEM SMNUM I; # ORDINAL OF CURRENT *SM* # ITEM STAT I; # STATUS OF PROCEDURE CALL # ITEM TERMINATOR C(1); # TERMINATING CHARACTER # ITEM TMPI I; # INTEGER SCRATCH # ITEM TMPJ I; # INTEGER SCRATCH # ARRAY MSG [1:2] S(2); # MESSAGES DISPLAYED # BEGIN ITEM MSGW C(00,00,20) = ## [ "CONFIGURATION FILE READ ", " " ]; END # * SWITCH STATEMENT # SWITCH DIRECTIVE NULL, M862CTLR, CHANIF, DEVICETI, DEVICETO, DEVICEIF, DATARC, NULL, ACCIF, NULL, M861SM; CONTROL EJECT; # * SET UP FET FOR CONFIGURATION FILE AND REWIND IT. # LFN = DARG$CF[0]; FETP = LOC(BL$FET[0]); BUFP = LOC(BL$BUF[0]); ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL); READ(BL$FET[0],NRCL); EOR = FALSE; # * READ FIRST 2 CARDS OF CONFIGURATION SOURCE FILE. * CARD 1 CONTAINS NUMBER OF CU-S (LEFT-JUSTIFIED) * CARD 2 CONTAINS NUMBER OF SM-S (LEFT-JUSTIFIED) # READC(BL$FET[0],DIRLINE,9,STAT); BZFILL(DIRLINE,TYPFILL"BFILL",90); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = " RDSUDT - CONFIGURATION FILE EMPTY."; MESSAGE(BLMSG[0],SYSUDF1); END STAT = XDXB(C<0,1>DIRLINE,1,NUM$CU); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END BLMSG$LN[0] = DIRLINE; MESSAGE(BLMSG[0],SYSUDF1); P = LOC(BL$UDT$HDR); IF NUM$CU GR MAXCTN OR NUM$CU LQ ZERO THEN BEGIN BLMSG$LN[0] = MSG$INCCU; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END # * SAVE COUNT OF M862-S # UDT$LINE$CUN = NUM$CU; READC(BL$FET[0],DIRLINE,9,STAT); BZFILL(DIRLINE,TYPFILL"BFILL",90); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = " MISSING *SM* COUNT COMMAND."; MESSAGE(BLMSG[0],SYSUDF1); # ERROR MESSAGE # RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END STAT = XDXB(C<0,1>DIRLINE,1,NUM$SM); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0]= " RDSUDT - CAN-T CRACK *SM* COMMAND. "; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END BLMSG$LN[0] = DIRLINE; MESSAGE(BLMSG[0],SYSUDF1); IF NUM$SM GR MAXSM OR NUM$SM LQ ZERO THEN BEGIN BLMSG$LN[0] = MSG$INCSM; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END UDT$LINE$SMN = NUM$SM; # * INITIALIZE *BUDT* POSITIONING COUNTERS. # CUNUM = 0; SMNUM = 0; # * READ DIRECTIVES FROM SOURCE FILE # EOR = FALSE; SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR DO BEGIN NEXTLIN(DIRLINE,STAT,TMPI); IF STAT NQ 0 THEN BEGIN EOR = TRUE; TEST DIRNUM; END BLMSG$LN[0] = DIRLINE; MESSAGE(BLMSG[0],SYSUDF1); GOTO DIRECTIVE[TMPI]; NULL: BLMSG$LN[0] = " RDSUDT - NULL DIRECTIVE. "; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); M862CTLR: CUNUM = CUNUM + 1; P = LOC(BL$UDT$M862[CUNUM]); ARGKEY2 = C<0,2>DIRLINE; ARGKEY3 = " "; IF ARGKEY2 NQ NM$KEY2[2] THEN BEGIN BLMSG$LN[0] = ## " RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END STAT = XDXB(C<2,3>DIRLINE,0,TMPI); # ASSUME 3-CHAR EST ORD # SCOL = 5; IF STAT NQ 0 THEN BEGIN STAT = XDXB(C<2,2>DIRLINE,0,TMPI); # ASSUME 2-CHAR EST ORD # SCOL = 4; IF STAT NQ 0 THEN # BAD EST ORDINAL # BEGIN # EXIT # BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # EXIT # END IF (TMPI LS O"10") OR (TMPI GR MAXEST) THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END UD$ESTO[1] = TMPI; IF CDIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *CU* ENTRY MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL + 1; CHAR1 = CDIRLINE; STAT = XDXB(CHAR1,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF (TMPI EQ 1) OR (TMPI EQ 3) OR (TMPI EQ 5) OR (TMPI EQ 7) THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL + 1; IF CDIRLINE NQ COMMA THEN # BAD SYNTAX # BEGIN # EXIT # BLMSG$LN[0] = MSG$SYNER; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # EXIT # # * STORE M862 DEVICE ADDRESS AND SET EXISTENCE FLAG. # UD$CUDA[1] = TMPI; UD$EXIST[1] = TRUE; SCOL = SCOL + 1; DEVTYPE = "CH"; NUMCH = 2; LOOPC = FALSE; SLOWFOR J = 1 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM(DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR); # * INSERT *CH* DATA INTO BUDT # IF ( ORD EQ 0 ) AND ( J NQ 1 ) AND ( STAT NQ 2 ) THEN BEGIN BLMSG$LN[0] = " RDSUDT - CHANNEL 0 NOT FIRST CHANNEL."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END IF ( STAT NQ 2 ) AND ( J EQ 1 ) THEN BEGIN UD$CHANA[1] = ORD; UD$CHEX0[1] = TRUE; IF STAT EQ 1 THEN BEGIN UD$CHANA$O[1] = TRUE; END ELSE BEGIN UD$CHANA$O[1] = FALSE; END END IF ( STAT EQ 2 ) AND ( J EQ 1 ) THEN BEGIN UD$CHANA[1] = 0; UD$CHANA$O[1] = FALSE; END IF ( STAT NQ 2 ) AND ( J EQ 2 ) THEN BEGIN UD$CHANB[1] = ORD; UD$CHEX1[1] = TRUE; IF STAT EQ 1 THEN BEGIN UD$CHANB$O[1] = TRUE; END ELSE BEGIN UD$CHANB$O[1] = FALSE; END END IF ( STAT EQ 2 ) AND ( J EQ 2 ) THEN BEGIN UD$CHANB[1] = 0; UD$CHANB$O[1] = FALSE; END IF ( STAT NQ 2 ) AND ( J EQ 3 ) THEN BEGIN UD$CHANC[1] = ORD; UD$CHEX2[1] = TRUE; IF STAT EQ 1 THEN BEGIN UD$CHANC$O[1] = TRUE; END ELSE BEGIN UD$CHANC$O[1] = FALSE; END END IF ( STAT EQ 2 ) AND ( J EQ 3 ) THEN BEGIN UD$CHANC[1] = 0; UD$CHANC$O[1] = FALSE; END IF ( STAT NQ 2 ) AND ( J EQ 4 ) THEN BEGIN UD$CHAND[1] = ORD; UD$CHEX3[1] = TRUE; IF STAT EQ 1 THEN BEGIN UD$CHAND$O[1] = TRUE; END ELSE BEGIN UD$CHAND$O[1] = FALSE; END END IF ( STAT EQ 2 ) AND ( J EQ 4 ) THEN BEGIN UD$CHAND[1] = 0; UD$CHAND$O[1] = FALSE; END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J GR MAX$CH THEN BEGIN BLMSG$LN[0] = ## "RDSUDT - MISSING CHANNELS ON *CU* COMMAND."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = NCOL; TEST J; END TEST DIRNUM; CHANIF: IF( ARGKEY2 NQ NM$KEY2[2] ) AND (ARGKEY3 NQ " ") THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[3]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR 3 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *CIF* COMMAND MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY3[4]; NUMCH = 3; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN # * CHECK FOR VALID CHANNELS AND CIF LASHUPS. # IF ( ( TMPI EQ 0 ) ## AND ( UD$CHANA[1] EQ 0 ) ## AND ( UD$CHANB[1] NQ 0 ) ) ## OR ( ( TMPI EQ 1 ) ## AND ( UD$CHANB[1] EQ 0 ) ) ## OR ( ( TMPI EQ 2 ) ## AND ( UD$CHANC[1] EQ 0 ) ) ## OR ( ( TMPI EQ 3 ) ## AND ( UD$CHAND[1] EQ 0 ) ) ## THEN BEGIN BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. "; MESSAGE ( BLMSG[0] , SYSUDF1) ## ; RESTPFP ( PFP$ABORT ); # RESTORE USER-S PFP AND ABORT # END CIFI ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF STAT EQ 1 THEN BEGIN CIFI ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J EQ MAX$DTI THEN BEGIN LOOPC = TRUE; TEST J; END SCOL = NCOL; END SCOL = NCOL; DEVTYPE = NM$KEY3[5]; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN # * CHECK FOR VALID CHANNELS AND CIF LASHUPS. # IF ( ( TMPI EQ 0 ) ## AND ( UD$CHANA[1] EQ 0 ) ## AND ( UD$CHANB[1] NQ 0 ) ) ## OR ( ( TMPI EQ 1 ) ## AND ( UD$CHANB[1] EQ 0 ) ) ## OR ( ( TMPI EQ 2 ) ## AND ( UD$CHANC[1] EQ 0 ) ) ## OR ( ( TMPI EQ 3 ) ## AND ( UD$CHAND[1] EQ 0 ) ) ## THEN BEGIN BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. "; MESSAGE ( BLMSG[0] , SYSUDF1); RESTPFP ( PFP$ABORT ); # RESTORE USER-S PFP AND ABORT # END CIFO ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF STAT EQ 1 THEN BEGIN CIFO ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J EQ MAX$DTO THEN BEGIN LOOPC = TRUE; TEST J; END SCOL = NCOL; END TEST DIRNUM; DEVICETI: IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[3] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[4]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR 1 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *DTI* COMMAND MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY3[6]; NUMCH = 3; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN DTI01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF STAT EQ 1 THEN BEGIN DTI01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J GR MAX$DIF THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END SCOL = NCOL; END TEST DIRNUM; DEVICETO: IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[4] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE( BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[5]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR 1 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *DTO* COMMAND MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY3[6]; NUMCH = 3; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN DTO01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF STAT EQ 1 THEN BEGIN DTO01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J GR MAX$DIF THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END SCOL = NCOL; END TEST DIRNUM; DEVICEIF: IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[5] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[6]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR 1 THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *DIF* COMMAND MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY3[7]; NUMCH = 3; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN DIF01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF STAT EQ 1 THEN BEGIN DIF01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J GR MAX$DRC THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END SCOL = NCOL; END TEST DIRNUM; DATARC: IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[6] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[7]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR MAX$DRC THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *DRC* ENTRY MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY3[8]; NUMCH = 3; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN BEGIN IF ((TMPI LQ 1) AND (ORD GR MAX$DRD)) # DRCS 0/1 ONLY GO TO DRDS 0-7 # OR ((TMPI GQ 2) AND (ORD LQ MAX$DRD)) # DRC 2/3 ONLY GO TO DRDS 8-15 # THEN # DRC-DRD PATHS NOT CORRECT # BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI EQ 0 THEN BEGIN DRC00 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF TMPI EQ 1 THEN BEGIN DRC01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 ); END IF TMPI EQ 2 THEN BEGIN DRC02 ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1); END IF TMPI EQ 3 THEN BEGIN DRC03 ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1); END END IF STAT EQ 1 THEN BEGIN IF TMPI EQ 0 THEN BEGIN DRC00 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TMPI EQ 1 THEN BEGIN DRC01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 ); END IF TMPI EQ 2 THEN BEGIN DRC02 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 ); END IF TMPI EQ 3 THEN BEGIN DRC03 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 ); END END IF J GR MAX$DRD THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END SCOL = NCOL; END TEST DIRNUM; ACCIF: IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[7] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY3 = NM$KEY3[9]; STAT = XDXB(C<3,1>DIRLINE,0,TMPI); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF TMPI LS 0 OR TMPI GR 1 THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *AIF* ENTRY MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = 5; DEVTYPE = NM$KEY2[10]; NUMCH = 2; LOOPC = FALSE; SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC ) DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR ); IF STAT NQ 2 THEN # AIF PATH EXISTS # BEGIN # EXISTS # IF TMPI EQ 0 THEN # AIF0 PATH # BEGIN # AIF0 # AIF0(1,ORD,PATH$DF"U$EXISTS",ON); END # AIF0 # ELSE # AIF1 PATH # BEGIN # AIF1 # AIF1(1,ORD,PATH$DF"U$EXISTS",ON); END # AIF1 # END # EXISTS # IF STAT EQ 1 THEN # AIF PATH TURNED ON # BEGIN # ON # IF TMPI EQ 0 THEN # AIF0 PATH # BEGIN # AIF0 # AIF0(1,ORD,PATH$DF"U$ON",ON); END # AIF0 # ELSE # AIF1 PATH # BEGIN # AIF1 # AIF1(1,ORD,PATH$DF"U$ON",ON); END # AIF1 # END # ON # IF (UD$AIF003[1] NQ 0 AND UD$AIF047[1] NQ 0) ## OR (UD$AIF103[1] NQ 0 AND UD$AIF147[1] NQ 0) THEN # AIF GOES TO BOTH SETS OF SM-S # BEGIN # EXIT # BLMSG$LN[0] = MSG$INVAIF; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # EXIT # IF TERMINATOR EQ PERIOD THEN BEGIN LOOPC = TRUE; TEST J; END IF J GR MAX$AC THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END SCOL = NCOL; END TEST DIRNUM; M861SM: SMNUM = SMNUM + 1; P = LOC(BL$UDT$M861[SMNUM]); IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[9] ) THEN BEGIN BLMSG$LN[0] = MSG$BDORD; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END ARGKEY2 = NM$KEY2[11]; IF ( C<2,1>DIRLINE LS "A" ) OR ( C<2,1>DIRLINE GR "H" ) THEN BEGIN BLMSG$LN[0] = MSG$BADEST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SM$ID[1] = C<2,1>DIRLINE; SM$EXIST[1] = TRUE; # * INITIALIZE DRD STAGE/DESTAGE DEFAULTS, SUBJECT TO LATER CHANGE # SM$STNUM[1] = 2; SM$DSNUM[1] = 1; IF C<3,1>DIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " RDSUDT - *SM* ENTRY MISSING = SIGN."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF ( C<4,2>DIRLINE NQ "ON" ) AND ( C<4,3>DIRLINE NQ "OFF" ) THEN BEGIN BLMSG$LN[0] = MSG$BDST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF C<4,2>DIRLINE EQ "ON" THEN BEGIN SCOL = 6; SM$ON[1] = TRUE; END ELSE BEGIN SCOL = 7; END IF CDIRLINE NQ COMMA THEN BEGIN BLMSG$LN[0] = "RDSUDT - *SM* COMMAND MISSING COMMA."; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL +1; IF CDIRLINE NQ NM$KEY2[10] THEN BEGIN BLMSG$LN[0] = MSG$BADST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL+2; CHAR1 = CDIRLINE; STAT = XDXB(CHAR1,0,ACCESSOR); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF ((ACCESSOR LS 0) OR (ACCESSOR GR 7)) THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL=SCOL+1; IF CDIRLINE NQ COMMA THEN BEGIN BLMSG$LN[0] = MSG$SYNER; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL+1; # * LINK M862-S WITH M861-S # LOOPK = FALSE; SLOWFOR J = 1 STEP 1 WHILE NOT LOOPK DO BEGIN IF CDIRLINE EQ COMMA THEN BEGIN SCOL = SCOL+1; IF J GR MAX$SMCU THEN BEGIN LOOPK = TRUE; TEST J; END TEST J; END IF ( CDIRLINE NQ NM$KEY2[2] ) ## AND ( CDIRLINE NQ NM$KEY3[8] ) THEN BEGIN BLMSG$LN[0] = MSG$STCON; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END IF CDIRLINE EQ NM$KEY3[8] THEN BEGIN LOOPK = TRUE; TEST J; END IF J GR MAX$SMCU THEN BEGIN BLMSG$LN[0] = MSG$BADENT; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END SCOL = SCOL+2; CHAR3 = CDIRLINE; STAT = XDXB(CHAR3,0,ORD); # ASSUME 3-CHARACTER CU ORDINAL # IF STAT NQ 0 THEN BEGIN CHAR2 = CDIRLINE; STAT = XDXB(CHAR2,0,ORD); # ASSUME 2-CHARACTER CU ORDINAL # SCOL = SCOL + 2; IF STAT NQ 0 THEN # BAD CONTROLLER ORDINAL # BEGIN # EXIT # BLMSG$LN[0] = MSG$BADADR; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # EXIT # END ELSE # BUMP POSITION COUNTER # BEGIN # BUMP # SCOL = SCOL + 3; END # BUMP # IF CDIRLINE NQ COMMA THEN # BAD SYNTAX # BEGIN # EXIT # BLMSG$LN[0] = MSG$SYNER; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # EXIT # SCOL = SCOL + 1; LOOPC = FALSE; SLOWFOR K = 1 STEP 1 WHILE NOT LOOPC DO BEGIN P = LOC(BL$UDT$M862[K]); IF UD$ESTO[1] NQ ORD THEN BEGIN IF K GQ MAXCTN THEN BEGIN BLMSG$LN[0] = MSG$STCON; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END END IF UD$ESTO[1] EQ ORD THEN BEGIN LOOPC = TRUE; TEST K; END TEST K; END # * INSERT ACCESSOR DEVICE ADDRESS INTO M861 TABLE # SM$SUN[1] = ACCESSOR; # * MOVE ACCESSOR LINKAGE TO M861 TABLE # K = K-1; IF ( SM$STS0[1] NQ 0 ) ## AND ( SM$STS1[1] NQ 0 ) THEN BEGIN BLMSG$LN[0] = MSG$EXPATH; MESSAGE(BLMSG[0],SYSUDF1); # ERROR IN CONFIGURATION FILE # RESTPFP(PFP$ABORT); END IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF0[1] EQ ON THEN # AIF-AC PATH FOUND # BEGIN # SM # BUD$SMAIF[1] = SMNUM; # LINK SM TO CU # END # SM # IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF1[1] EQ ON THEN # AIF-AC PATH FOUND # BEGIN # SM # BUD$SMAIF[1] = SMNUM; # LINK SM TO CU # END # SM # IF SM$STS0[1] EQ 0 THEN BEGIN SM$STS0[1] = SM$FLAG[1]; SM$CUO0[1] = K; TEST J; END IF SM$STS1[1] EQ 0 THEN BEGIN SM$STS1[1] = SM$FLAG[1]; SM$CUO1[1] = K; TEST J; END END # TEST J # # * NOW CRACK DRD COMMANDS # DEVTYPE = NM$KEY3[8]; NUMCH = 3; LOOPK = FALSE; SLOWFOR J = 0 STEP 1 WHILE NOT LOOPK DO BEGIN NEXTPRM( DIRLINE,SCOL,DEVTYPE, ## NUMCH,ORD,NCOL,STAT,TERMINATOR); SAVEDORD = ORD; # IN CASE DRD IS 8-15 # IF ORD GR MAX$DRD THEN # ALLOW FOR FULL CONFIGURATION # BEGIN ORD = ORD - MAX$DRD - 1; END IF STAT NQ 2 THEN BEGIN SMDRD ( 1 , ORD , PATH$DF"U$EXISTS" , 1 ); # * VALIDATE ACCESSOR AND DRD DEVICE ADDRESSES # IF ( ( ACCESSOR EQ 0 ) ## AND ( ORD GR 1 ) ) ## OR ( ( ACCESSOR EQ 1 ) ## AND ( ORD LS 2 OR ORD GR 3 ) ) ## OR ( ( ACCESSOR EQ 2 ) ## AND ( ORD LS 4 OR ORD GR 5 ) ) ## OR ( ( ACCESSOR EQ 3 ) ## AND ( ORD LS 6 ) ) ## THEN BEGIN BLMSG$LN[0] = MSG$BADADR; MESSAGE ( BLMSG[0] , SYSUDF1 ) ## ; RESTPFP ( PFP$ABORT ); END # * ASSOCIATE EVEN NUMBERED DRD-S WITH FIRST POSITION IN TABLE # IF ( ORD EQ 0 ) ## OR ( ORD EQ 2 ) ## OR ( ORD EQ 4 ) ## OR ( ORD EQ 6 ) ## THEN BEGIN D0$SUN[1] = SAVEDORD; # STORE TRUE NUMBER # END ELSE BEGIN D1$SUN[1] = SAVEDORD; # STORE TRUE NUMBER # END END IF STAT EQ 2 THEN BEGIN SCOL = NCOL; TEST J; END IF STAT EQ 1 THEN BEGIN SMDRD ( 1 , ORD , PATH$DF"U$ON" , 1 ); END IF TERMINATOR EQ PERIOD THEN BEGIN LOOPK = TRUE; TEST J; END IF J GQ MAX$SMDRD - 1 THEN BEGIN # SEARCH FOR DESTAGE AND STAGE PARAMETERS # SCOL = NCOL; # * CHECK FOR STAGE/DESTAGE DRD PARAMETERS # IF CDIRLINE NQ "DS=" THEN BEGIN # ERROR IN STATMENT # BLMSG$LN[0] = MSG$SM$DS; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # ERROR IN STATEMENT # SCOL = SCOL + 3; CHAR1 = CDIRLINE; # GET NUMBER OF DESTAGING DRDS # STAT = XDXB(CHAR1,0,TMPI); IF STAT NQ 0 THEN BEGIN # NOT A NUMBER # BLMSG$LN[0] = MSG$SM$DS; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # NOT A NUMBER # IF TMPI LS 1 ## OR TMPI GR 2 THEN BEGIN # NUMBER OUT OF RANGE # BLMSG$LN[0] = MSG$SM$DS; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # NUMBER OUT OF RANGE # SM$DSNUM[1] = TMPI; # NUMBER OF DRDS FOR DESTAGING # SCOL = SCOL + 1; IF CDIRLINE NQ ",ST=" THEN BEGIN # ERROR IN STATEMENT # BLMSG$LN[0] = MSG$SM$ST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # ERROR IN STATEMENT # SCOL = SCOL + 4; CHAR1 = CDIRLINE; # GET NUMBER OF STAGING DRDS # STAT = XDXB(CHAR1,0,TMPI); IF STAT NQ 0 THEN BEGIN # NOT A NUMBER # BLMSG$LN[0] = MSG$SM$ST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # NOT A NUMBER # IF TMPI LS 1 ## OR TMPI GR 2 THEN BEGIN # NUMBER OUT OF RANGE # BLMSG$LN[0] = MSG$SM$ST; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # NUMBER OUT OF RANGE # SM$STNUM[1] = TMPI; # NUMBER OF DRDS FOR STAGING # LOOPK = TRUE; TEST J; END # SEARCH FOR DESTAGE AND STAGE PARAMETERS # SCOL = NCOL; END # TEST J # # * MOVE DRC/DRD PATH STATUS TO DRD TABLE # # * NOTE: * IF THERE ARE TWO SEPERATE M862-S CONNECTED TO THE SAME M861 SM, * THEN THE SECOND M862 ( FROM THE START OF THE BUDT ) INTO THE SM * IS ( BY DEFINITION ) THE SECOND CU IN THE SM TABLE. HENCE, IT CAN * ONLY INTERFACE TO THE *STSS* PATH IN THE *DRD* TABLES. # P = LOC(BL$UDT$M862[1]); IF SM$CNT0[1] NQ 0 THEN BEGIN # CU0/DRD LINKUP # IF D0$EXIST[1] THEN # UPPER DRD EXISTS # BEGIN # UPPER # BD0$STSP[1] = 1; UPDRDST(D0$SUN[1],SM$CUO0[1]); END # UPPER # IF D1$EXIST[1] THEN # LOWER DRD EXISTS # BEGIN # LOWER # BD1$STSP[1] = 1; UPDRDST(D1$SUN[1],SM$CUO0[1]); END # LOWER # END # CU0/DRD LINKUP # IF SM$CNT1[1] NQ 0 THEN BEGIN # CU1/DRD LINKUP # IF D0$EXIST[1] THEN # UPPER DRD EXISTS # BEGIN # UPPER # BD0$STSS[1] = 1; UPDRDST(D0$SUN[1],SM$CUO1[1]); END # UPPER # IF D1$EXIST[1] THEN # LOWER DRD EXISTS # BEGIN # LOWER # BD1$STSS[1] = 1; UPDRDST(D1$SUN[1],SM$CUO1[1]); END # LOWER # END # CU1/DRD LINKUP # TEST DIRNUM; END # TEST DIRNUM # IF NUM$CU NQ CUNUM THEN BEGIN BLMSG$LN[0] = MSG$INCCU; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP ANF^D ABORT # END IF NUM$SM NQ SMNUM THEN BEGIN BLMSG$LN[0] = MSG$INCSM; MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END RETERN(BL$FET[0],RCL); END # RDSUDT # TERM PROC NEXTLIN(DIRLINE,STAT,INDEX); # TITLE NEXTLIN - READ NEXT LINE OF CONFIGURATION SOURCE FILE. # BEGIN # NEXTLIN # # *** PROC TO READ ONE LINE OF DATA FROM DATA ALREADY IN A FET. * *NEXTLIN* READS A LINE (WHICH IS AN *SSBLD* CONFIGURATION * FILE DIRECTIVE). THE PROC READS CARDS UNTIL IT FINDS ONE THAT * IS NOT A COMMENT CARD. IT CHECKS FOR END OF RECORD AND * VALID CONFIGURATION FILE NMEMONIC. * * ENTRY - NONE. * * EXIT * * DIRLINE = CONFIGURATION FILE IMAGE * STAT = STATUS RESPONSE FROM *READC* * INDEX = INDEX INTO NM$KEY ARRAY ( DIRECTIVE ORDINAL ) * * MESSAGES * * NEXTLIN - INCORRECT SSBLD MNEMONIC. * # # * PROC NEXTLIN - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK ZERO FILL # PROC MESSAGE; # ISSUE MESSAGE # PROC READC; # READ ONE LINE # PROC RESTPFP; # RESTORE USER-S PFP # PROC ZFILL; # ZERO FILL PROC # END # * PROC NEXTLIN - XREF LIST END. # ITEM DIRLINE C(90); # DIRECTIVE TEXT LINE # ITEM STAT I; # RETURN STATUS # ITEM INDEX I; # ARRAY INDEX # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBFET *CALL COMBUDT *CALL COMSPFM *CALL COMTBLD ITEM COMMENT B; # COMMENT INDICATOR # ITEM EOR B; # STATUS VARIABLE FOR *READC* # ITEM I I; # LOOP VARIABLE # ITEM KEYOK B; # CONTROL VARIABLE # ITEM KEY2 C(2); # 2 CHARACTER DIRECTIVE KEYWORD # ITEM KEY3 C(4); # 3 CHARACTER DIRECTIVE KEYWORD # ITEM DIRNUM I; # LOOP INDEX # CONTROL EJECT; # * READ ONE (NON-COMMENT) DIRECTIVE. # EOR = FALSE; SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR DO BEGIN # PROCESS NEXT DIRECTIVE # DIRLINE = " "; # ERASE PREVIOUS LINE # READC(BL$FET[0],DIRLINE,9,STAT); BZFILL(DIRLINE,TYPFILL"BFILL",90); C<89,1>DIRLINE = PERIOD; IF STAT NQ 0 THEN BEGIN EOR = TRUE; RETURN; END IF C<0,1>DIRLINE NQ "*" THEN # NOT COMMENT # BEGIN EOR = TRUE; TEST DIRNUM; BLMSG$LN=DIRNUM; MESSAGE(BLMSG[0],SYSUDF1); END TEST DIRNUM; END KEY2 = C<0,2>DIRLINE; KEY3 = C<0,3>DIRLINE; KEYOK = FALSE; SLOWFOR I=1 STEP 1 WHILE (NOT KEYOK) AND (I LQ BLLM) DO BEGIN IF ( KEY2 EQ NM$KEY2[1] ) ## OR ( KEY2 EQ NM$KEY2[2] ) ## OR ( KEY2 EQ NM$KEY2[10] ) ## OR ( KEY2 EQ NM$KEY2[11] ) ## THEN BEGIN IF KEY2 EQ NM$KEY2[I] THEN BEGIN INDEX=I-1; KEYOK = TRUE; TEST I; END END ELSE BEGIN IF KEY3 EQ NM$KEY3[I] THEN BEGIN INDEX = I-1; KEYOK = TRUE; TEST I; END END TEST I; END IF NOT KEYOK THEN BEGIN BLMSG$LN[0] = " NEXTLIN - INCORRECT SSBLD MNEMONIC."; MESSAGE(BLMSG[0],SYSUDF1); # ERROR MESSAGE # RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT # END END # NEXTLIN # TERM PROC NEXTPRM(DIRLINE,SCOL,DEVTYPE,NUMCH,ORD,NCOL,STAT,TERMINATOR); # TITLE NEXTPRM - CRACK NEXT LINE OF SOURCE FILE DIRECTIVES. # BEGIN # NEXTPRM # # *** PROC TO CRACK EVERYTHING TO THE RIGHT OF THE FIRST *=* SIGN * IN A *SSBLD* SOURCE FILE DIRECTIVE. * * ENTRY * * DIRLINE = CONFIGURATION SOURCE FILE DIRECTIVE * SCOL = COLUMN OF DIRECTIVE IN WHICH TO START SEARCH * DEVTYPE = NMEMONIC BEING SEARCHED FOR * NUMCH = NUMBER OF CHARACTERS IN DEVTYPE * * EXIT * * ORD = ORDINAL OF DEVTYPE ON SOURCE LINE * NCOL = NUMBER OF THE NEXT COLUMN FOLLOWING TERMINATOR. * STAT = STATUS OF DEVTYPE IN THE DIRECTIVE ( ON/OFF/NON-EXISTEXT ) * TERMINATOR = THE TERMINATOR FOUND ( EITHER *,* OR *.* ) * * MESSAGES * * NEXTPRM - INCORRECT MNEMONIC. * NEXTPRM - ORDINAL INCORRECT. * NEXTPRM - INCORRECT DRD ORDINAL. * NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE. * NEXTPRM - INCORRECT CHANNEL NUMBER. * NEXTPRM - INCORRECT *SM* ORDINAL. * NEXTPRM - INCORRECT *CU* EST ORDINAL. * NEXTPRM - MISSING EQUAL SIGN. * NEXTPRM - INCORRECT DIRECTIVE STATUS. * NEXTPRM - INCORRECT TERMINATOR. * # ITEM DIRLINE C(90); # DIRECTIVE LINE INPUT # ITEM SCOL I; # STARTING COLUMN # ITEM DEVTYPE C(3); # DEVICE TYPE # ITEM NUMCH I; # NUMBER OF CHARACTERS # ITEM ORD I; # DEVTYPE ORDINAL # ITEM NCOL I; # NEXT COLUMN # ITEM STAT I; # STATUS -0=OFF,1=ON,2=NON-EXISTENT # ITEM TERMINATOR C(1); # TERMINATING CHARACTER # # * PROC NEXTPRM - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # ISSUE MESSAGE # PROC RESTPFP; # RESTORE USER-S PFP # FUNC XDXB; # CONVERT DISPLAY CODE TO BINARY # END # * PROC NEXTPRM - XREF LIST END. # DEF MSG$BADORD #" NEXTPRM - ORDINAL INCORRECT."#; DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL COMBFAS *CALL COMBUDT *CALL COMTBLD ITEM LOOPC B; # LOOP CONTROL # ITEM I I; # LOOP INDEX # ITEM TMPC C(2); # CHARACTER SCRATCH CELL # ITEM TMPI I; # SCRATCH INTEGER # CONTROL EJECT; # * GET NEXT NON-BLANK CHARACTER # LOOPC = FALSE; SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC DO BEGIN IF CDIRLINE EQ " " THEN BEGIN SCOL = SCOL+1; TEST I; END LOOPC = TRUE; TEST I; END # * CHECK DIRECTIVE NMEMONIC # IF ( CDIRLINE NQ C<0,NUMCH>DEVTYPE ) ## AND ( CDIRLINE NQ COMMA ) ## AND ( CDIRLINE NQ PERIOD ) ## THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT MNEMONIC."; GOTO ERRORPRM; END # * CHECK FOR COMMA OR PERIOD( IMPLIES NON-EXISTENT ENTRY ). # IF( CDIRLINE EQ COMMA ) ## OR ( CDIRLINE EQ PERIOD ) THEN BEGIN STAT = 2; ORD = 0; GOTO TERMINATE; END # * REMOVE EMBEDDED BLANKS # SCOL = SCOL+NUMCH; LOOPC = FALSE; SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC DO BEGIN IF CDIRLINE EQ " " THEN BEGIN SCOL = SCOL+1; TEST I; END LOOPC = TRUE; TEST I; END # * GET AND VALIDATE ORDINAL # IF( C<0,NUMCH>DEVTYPE NQ NM$KEY2[2] ) ## AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[10] ) ## AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[1] ) ## THEN BEGIN TMPC = C<3,1>DIRLINE; STAT = XDXB(TMPC,1,ORD); IF C<0,3>DIRLINE EQ NM$KEY3[7] AND ORD GQ 2 THEN BEGIN # EXPANDED DRD CONFIGURATION # TMPC = CDIRLINE; STAT = XDXB(TMPC,1,ORD); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END IF ORD EQ 1 THEN BEGIN # DRD DEVICE ADDRESS IS 2 DIGITS # TMPC = CDIRLINE; STAT = XDXB(TMPC,1,ORD); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END SCOL = SCOL + 1; END # DRD DEVICE ADDRESS IS 2 DIGITS # END # EXPANDED DRD CONFIGURATION # ELSE BEGIN # STANDARD DRD CONFIGURATION # TMPC = CDIRLINE; STAT = XDXB(TMPC,1,ORD); IF STAT NQ 0 THEN # ORDINAL IS 1 DIGIT LONG # BEGIN # ONE # TMPC = CDIRLINE; END # ONE # ELSE # ORDINAL IS 2 DIGITS LONG # BEGIN # TWO # TMPC = CDIRLINE; SCOL = SCOL + 1; # PRESET FOR NEXT CHARACTER # END # TWO # STAT = XDXB(TMPC,1,ORD); # GET DRD ORDINAL # IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END END # STANDARD DRD CONFIGURATION # IF NUMCH EQ 3 THEN BEGIN IF C<0,3>DEVTYPE EQ NM$KEY3[8] THEN BEGIN IF ( ORD LS 0 ) OR ( ORD GR MAX$DRDDA ) THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT DRD ORDINAL."; GOTO ERRORPRM; END END END IF ( ( ORD LS 0 ) OR ( ORD GR MAX$DRC ) ) ## AND ( C<0,3>DEVTYPE NQ NM$KEY3[8] ) THEN BEGIN BLMSG$LN[0] = " NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE."; GOTO ERRORPRM; END SCOL = SCOL+1; END ELSE BEGIN IF C<0,2>DEVTYPE EQ NM$KEY2[1] THEN BEGIN TMPC = CDIRLINE; STAT = XDXB(TMPC,0,ORD); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END IF (( ORD GR O"13" ) AND ( ORD LS O"20" )) ## OR ( ORD GR O"33") THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT CHANNEL NUMBER."; GOTO ERRORPRM; END SCOL = SCOL+2; END IF C<0,2>DEVTYPE EQ NM$KEY2[10] THEN BEGIN TMPC = CDIRLINE; STAT = XDXB(TMPC,0,ORD); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END IF (ORD LS 0) OR (ORD GR 7) THEN BEGIN BLMSG$LN[0] = "NEXTPRM - INCORRECT *SM* ORDINAL."; GOTO ERRORPRM; END SCOL = SCOL+1; END IF C<0,2>DEVTYPE EQ NM$KEY2[2] THEN BEGIN TMPC = CDIRLINE; STAT = XDXB(TMPC,0,ORD); IF STAT NQ 0 THEN BEGIN BLMSG$LN[0] = MSG$BADORD; GOTO ERRORPRM; END IF (ORD LS 10 ) OR ( ORD GR O"77" ) THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT *CU* ORDINAL."; GOTO ERRORPRM; END SCOL = SCOL + 2; END IF ( C<0,2>DEVTYPE EQ "ON" ) ## OR ( C<0,3>DEVTYPE EQ "OFF" ) THEN BEGIN GOTO TERMINATE; END END # * FIND NEXT NON-BLANK CHARACTER # LOOPC = FALSE; SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC DO BEGIN IF CDIRLINE EQ " " THEN BEGIN SCOL = SCOL + 1; TEST I; END LOOPC = TRUE; TEST I; END IF CDIRLINE NQ "=" THEN BEGIN BLMSG$LN[0] = " NEXTPRM - MISSING EQUAL SIGN."; GOTO ERRORPRM; END SCOL = SCOL + 1; # * FIND NEXT NON-BLANK CHARACTER # LOOPC = FALSE; SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC DO BEGIN IF CDIRLINE EQ " " THEN BEGIN SCOL = SCOL +1; TEST I; END LOOPC = TRUE; TEST I; END IF( CDIRLINE NQ "ON" ) ## AND ( CDIRLINE NQ "OFF" ) THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT DIRECTIVE STATUS."; GOTO ERRORPRM; END IF CDIRLINE EQ "ON" THEN BEGIN STAT = 1; SCOL = SCOL+2; END ELSE BEGIN STAT = 0; SCOL = SCOL + 3; END TERMINATE: LOOPC = FALSE; SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC DO BEGIN IF CDIRLINE EQ " " THEN BEGIN SCOL = SCOL + 1; TEST I; END LOOPC = TRUE; TEST I; END IF( CDIRLINE NQ COMMA ) ## AND ( CDIRLINE NQ PERIOD ) THEN BEGIN BLMSG$LN[0] = " NEXTPRM - INCORRECT TERMINATOR."; GOTO ERRORPRM; END TERMINATOR = CDIRLINE; NCOL = SCOL+1; RETURN; ERRORPRM: MESSAGE(BLMSG[0],SYSUDF1); RESTPFP(PFP$ABORT); END # NEXTPRM # TERM PROC UPDRDST(DRD,CONTORD); # TITLE UPDRDST - UPDATE DRD STATUS ACCORDING TO PATH STATUS # BEGIN # UPDRDST # # *** UPDATE TRUE STATUS OF A DRD * * THE TRUE STATUS OF A DRD (ON/OFF) AT INITIALIZATION * TIME DEPENDS ON THE STATUS OF THE PATHS LEADING TO * IT FROM THE DIF-S AND DRC-S. IF ALL PATHS LEADING TO THE DRD * ARE OFF, THEN THIS PROC WILL SET THE INITIAL STATUS * OF THE DRD TO BE OFF REGARDLESS OF WHAT THE SSBLD * DIRECTIVE SAYS. * * ENTRY DRD = DRD ORDINAL. * CONTORD = CONTROLLER ORDINAL TO SCAN FOR PATH. * * EXIT DRD STATUS UPDATED IF NECESSARY. * * MESSAGES NONE. # ITEM CONTORD U; # CONTROLLER ORDINAL # ITEM DRD U; # DRD NUMBER # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMBUDT ITEM FIRSTDRC U; # FIRST DRC TO SCAN FOR PATH # ITEM I U; # LOOP INDEX # ITEM J U; # LOOP INDEX # CONTROL EJECT; CONTROL INERT; # * ONLY DRC-S 0 AND 1 CAN CONNECT TO DRD-S 0-7. * ONLY DRC-S 2 AND 3 CAN CONNECT TO DRD-S 8-15. # FIRSTDRC = 0; # ASSUME CHECKING DRC-S 0 AND 1 # IF DRD GQ 8 THEN # DRD CONNECTED TO OTHER DRC PAIR # BEGIN # RESET # FIRSTDRC = 2; # CHECK DRC-S 2 AND 3 # END # RESET # # * SET THE PASSED DRD AS ON WITH RESPECT TO THE PASSED CONTROLLER * IF A DIF-DRC-DRD PATH CAN BE FOUND THAT IS ON FROM A * DIF IN THE PASSED CU TO THE PASSED DRD. * * NOTE: ALL CONTROLLERS ARE SEARCHED FOR A VALID DRC-DRD * PATH, SINCE DRC-S ARE INDEPENDENT OF THE CONTROLLERS * THEY RESIDE IN. * # SLOWFOR I = 1 STEP 1 UNTIL MAXCTN DO # SEARCH ALL CU-S FOR DRC-S # BEGIN # CU # SLOWFOR J = FIRSTDRC STEP 1 UNTIL (FIRSTDRC + 1) DO # CHECK BOTH DRC-S # BEGIN # DRC # P = LOC(UD$DRCP0[I]) + J; # LOCATE DRC # IF PATHBIT(B<57,3>DRD,PATH$DF"U$EXISTS") EQ 1 ## AND PATHBIT(B<57,3>DRD,PATH$DF"U$ON") EQ 1 # DRC-DRD ON # AND ((BUD$DIF0[CONTORD] EQ 1 ## AND BUD$DIF0[CONTORD] EQ 1) # DIF0-DRC PATH FOUND ON # OR (BUD$DIF1[CONTORD] EQ 1 ## AND BUD$DIF1[CONTORD] EQ 1)) # DIF1-DRC PATH FOUND ON # THEN # DRD CONFIRMED ON TO CONTROLLER # BEGIN # DRD ON # IF CONTORD EQ SM$CUO0[1] THEN # SET DRD ON TO PRIMARY CU # BEGIN # PRIMARY # IF B<59,1>DRD EQ 0 AND D0$ON[1] THEN # EVEN-NUMBERED DRD CHECKED # BEGIN # EVEN # BD0$STSP[1] = 1; END # EVEN # IF B<59,1>DRD EQ 1 AND D1$ON[1] THEN # ODD-NUMBERED DRD CHECKED # BEGIN # ODD # BD1$STSP[1] = 1; END # ODD # END # PRIMARY # ELSE # SET DRD ON TO SECONDARY CU # BEGIN # SECONDARY # IF B<59,1>DRD EQ 0 AND D0$ON[1] THEN # EVEN-NUMBERED DRD CHECKED # BEGIN # EVEN # BD0$STSS[1] = 1; END # EVEN # IF B<59,1>DRD EQ 1 AND D1$ON[1] THEN # ODD-NUMBERED DRD CHECKED # BEGIN # ODD # BD1$STSS[1] = 1; END # ODD # END # SECONDARY # RETURN; # SEARCH COMPLETE # END # DRD ON # END # DRC # END # CU # CONTROL REACTIVE; IF B<59,1>DRD EQ 0 THEN # EVEN-NUMBERED DRD FOUND OFF # BEGIN # OFF # D0$FLAG[1] = D0$STSP[1] LOR D0$STSS[1]; # IN CASE OFF TO BOTH # END # OFF # ELSE # ODD-NUMBERED DRD FOUND OFF # BEGIN # OFF # D1$FLAG[1] = D1$STSP[1] LOR D1$STSS[1]; # IN CASE OFF TO BOTH # END # OFF # CONTROL INERT; END # UPDRDST # TERM PROC WTBUDT; # TITLE WTBUDT - WRITE SSBLD GENERATED UDT TO DISK FILE # BEGIN # WTBUDT # # *** WTBUDT - WRITE UDT TO PERMANENT FILE. * * TWTBUDT WRITES THE SSBLD GENERATED UDT TO THE SSEXEC * ACCESSIBLE PERMANENT FILE. THE DEFAULT FLIE NAME IS *BUDT*. * * PROC WTBUDT. * * ENTRY - NONE. * * EXIT - UDT WRITTEN TO THE PERMANENT FILE. * * MESSAGES * * WTBUDT - CIO ERROR. * WTBUDT - DEVICE FULL FOR UDT FILE. * * NOTES # # **** PROC WTBUDT - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILL AN ITEM # PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE # PROC RESTPFP; # RESTORE USER-S PFP AND ABORT # PROC RETERN; # RETURNS A FILE # PROC REWIND; # REWINDS A FILE # PROC WRITE; # WRITE DATA TO DISK # PROC WRITEF; # WRITE EOF ON DISK FILE # PROC WRITER; # WRITES EOR ON A FILE # PROC WRITEW; # DATA TRANSFER ROUTINE # PROC ZFILL; # ZERO FILLS A BUFFER # PROC ZSETFET; # SETS UP A FET # END # **** PROC WTBUDT - XREF LIST END. # DEF MSG$CIOERR #"WTBUDT - CIO ERROR."#; DEF MSG$DSKFULL #"WTBUDT - DEVICE FULL FOR UDT FILE."#; DEF LISTCON #0#; # DO NOT LIST THE COMMON DECKS # *CALL,COMBFAS *CALL,COMBBZF *CALL,COMBFET *CALL,COMBUDT *CALL,COMSPFM *CALL,COMTBLD *CALL,COMTBLP *CALL,COMTOUT ITEM BUFP I; # FWA OF BUFFER # ITEM FETP I; # FET POINTER # ITEM TMPI I; ITEM TMPJ I; ITEM TMPK I; ITEM LFN C(7); # FILE NAME # ITEM STAT I; # INTEGER STATUS VARIABLE # CONTROL EJECT; # * SET UP THE FET FOR UDT BINARY AND REWIND IT. # LFN = DARG$BF[0]; BZFILL(LFN,TYPFILL"ZFILL",7); FETP = LOC(BL$FET[0]); BUFP = LOC(BL$BUF[0]); ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL); REWIND(BL$FET[0],RCL); P = LOC(BL$UDT$HDR); # * WRITE THE FILE TO *CIO* BUFFER # WRITEW(BL$FET[0],BL$UDT$LOC[0],LARCUDTLTM,STAT); # * WRITE UDT TO DISK # WRITE(BL$FET[0],RCL); WRITER(BL$FET[0],RCL); WRITEF(BL$FET[0],RCL); REWIND(BL$FET[0],RCL); RETERN(BL$FET[0],RCL); END # WTBUDT # TERM