Deck SSDEBUG Part 001

2 Modifications

Listing Sections

Source

Seq #  *Modification Id* Act 
----------------------------+
02195  M00S02169.ssdebug +++|            ERRFLAG = TRUE;
02196  M00S02170.ssdebug +++|            END
02197  M00S02171.ssdebug +++|
02198  M00S02172.ssdebug +++|          END  # CHECK VALID OPTIONS #
02199  M00S02173.ssdebug +++|
02200  M00S02174.ssdebug +++|#
02201  M00S02175.ssdebug +++|*     WRITE THE DIRECTIVE NUMBER, ERROR FLAG,
02202  M00S02176.ssdebug +++|*     IMAGE AND THE CRACKED PARAMETERS TO THE
02203  M00S02177.ssdebug +++|*     SCRATCH FILE.
02204  M00S02178.ssdebug +++|#
02205  M00S02179.ssdebug +++|
02206  M00S02180.ssdebug +++|        WRITEW(DSCR$FET[0],DBARG[0],DBDIRPRML,FLAG);
02207  M00S02181.ssdebug +++|        END  # CRACK AND SYNTAX CHECK DIRECTIVES #
02208  M00S02182.ssdebug +++|
02209  M00S02183.ssdebug +++|      IF DIRNUM EQ 0
02210  M00S02184.ssdebug +++|      THEN                           # NO DIRECTIVES #
02211  M00S02185.ssdebug +++|        BEGIN
02212  M00S02186.ssdebug +++|        DBMSG$LN[0] = " SSDEBUG, NO DIRECTIVES.";
02213  M00S02187.ssdebug +++|        MESSAGE(DBMSG[0],SYSUDF1);
02214  M00S02188.ssdebug +++|        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
02215  M00S02189.ssdebug +++|        END
02216  M00S02190.ssdebug +++|
02217  M00S02191.ssdebug +++|      WRITER(DSCR$FET[0],RCL);
02218  M00S02192.ssdebug +++|      REWIND(DSCR$FET[0],RCL);
02219  M00S02193.ssdebug +++|      RETURN;
02220  M00S02194.ssdebug +++|
02221  M00S02195.ssdebug +++|      END  # DBLOOP #
02222  M00S02196.ssdebug +++|
02223  M00S02197.ssdebug +++|    TERM
02224  M00S02198.ssdebug +++|PROC DBMAIN;
02225  M00S02199.ssdebug +++|# TITLE DBMAIN - PROCESS *SSDEBUG* DIRECTIVES.                        #
02226  M00S02200.ssdebug +++|
02227  M00S02201.ssdebug +++|      BEGIN  # SSDEBUG #
02228  M00S02202.ssdebug +++|
02229  M00S02203.ssdebug +++|#
02230  M00S02204.ssdebug +++|**    DBMAIN - PROCESS *SSDEBUG* DIRECTIVES.
02231  M00S02205.ssdebug +++|*
02232  M00S02206.ssdebug +++|*     PROC DBMAIN.
02233  M00S02207.ssdebug +++|*
02234  M00S02208.ssdebug +++|*     ENTRY    THE CRACKED AND SYNTAX CHECKED DIRECTIVES
02235  M00S02209.ssdebug +++|*              HAVE BEEN WRITTEN TO A SCRATCH FILE WHICH HAS
02236  M00S02210.ssdebug +++|*              BEEN REWOUND.
02237  M00S02211.ssdebug +++|*              (DSCR$FET) = FET FOR READING THE SCRATCH FILE.
02238  M00S02212.ssdebug +++|*
02239  M00S02213.ssdebug +++|*     EXIT     ALL DIRECTIVES HAVE BEEN PROCESSED OR AN ERROR FLAG
02240  M00S02214.ssdebug +++|*              HAS BEEN SET UP.
02241  M00S02215.ssdebug +++|*
02242  M00S02216.ssdebug +++|*     MESSAGES FAMILY NOT FOUND.
02243  M00S02217.ssdebug +++|*
02244  M00S02218.ssdebug +++|*     NOTES    A LOOP IS SET UP TO READ EACH DIRECTIVE
02245  M00S02219.ssdebug +++|*              FROM THE SCRATCH FILE INTO THE COMMON AREA
02246  M00S02220.ssdebug +++|*              DEFINED IN *COMTDBP*.  THE CATALOG OR MAP IS
02247  M00S02221.ssdebug +++|*              OPENED AND THE CORRESPONDING ROUTINE IS
02248  M00S02222.ssdebug +++|*              CALLED TO PROCESS THE DIRECTIVE.  ANY ERROR
02249  M00S02223.ssdebug +++|*              IN DIRECTIVE PROCESSING CAUSES *SSDEBUG*
02250  M00S02224.ssdebug +++|*              TO ABORT.
02251  M00S02225.ssdebug +++|#
02252  M00S02226.ssdebug +++|
02253  M00S02227.ssdebug +++|#
02254  M00S02228.ssdebug +++|****  PROC DBMAIN - XREF LIST BEGIN.
02255  M00S02229.ssdebug +++|#
02256  M00S02230.ssdebug +++|
02257  M00S02231.ssdebug +++|      XREF
02258  M00S02232.ssdebug +++|        BEGIN
02259  M00S02233.ssdebug +++|        PROC COPEN;                  # OPEN CATALOG #
02260  M00S02234.ssdebug +++|        PROC DBCMAP;                 # PROCESS REMOVE SMMAP ENTRY
02261  M00S02235.ssdebug +++|                                       DIRECTIVE #
02262  M00S02236.ssdebug +++|        PROC DBFLAG;                 # PROCESS CHANGE FLAG DIRECTIVE #
02263  M00S02237.ssdebug +++|        PROC DBFMAP;                 # PROCESS REMOVE FCT ENTRY
02264  M00S02238.ssdebug +++|                                       DIRECTIVE #
02265  M00S02239.ssdebug +++|        PROC DBRDFIL;                # PROCESS READ FILE DIRECTIVE #
02266  M00S02240.ssdebug +++|        PROC DBRDSTM;                # PROCESS READ AU DIRECTIVE #
02267  M00S02241.ssdebug +++|        PROC DBREL;                  # PROCESS RELEASE MSF PROBLEM
02268  M00S02242.ssdebug +++|                                       CHAIN DIRECTIVE #
02269  M00S02243.ssdebug +++|        PROC DBRESP;                 # PROCESSES RESPONSE FROM EXEC #
02270  M00S02244.ssdebug +++|        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
02271  M00S02245.ssdebug +++|        PROC MESSAGE;                # DISPLAY MESSAGES #
02272  M00S02246.ssdebug +++|        PROC MOPEN;                  # OPEN SMMAP #
02273  M00S02247.ssdebug +++|        PROC READ;                   # READS A FILE #
02274  M00S02248.ssdebug +++|        PROC READW;                  # DATA TRANSFER ROUTINE #
02275  M00S02249.ssdebug +++|        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
02276  M00S02250.ssdebug +++|                                       OR RETURN #
02277  M00S02251.ssdebug +++|        PROC RETERN;                 # RETURNS A FILE #
02278  M00S02252.ssdebug +++|        PROC RPLINE;                 # WRITES A REPORT LINE #
02279  M00S02253.ssdebug +++|        PROC RPSPACE;                # WRITES A BLANK LINE #
02280  M00S02254.ssdebug +++|        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
02281  M00S02255.ssdebug +++|        PROC SSINIT;                  # SETS UP TABLES AND POINETRS #
02282  M00S02256.ssdebug +++|        FUNC XCOD C(10);             # INTEGER TO DISPLAY CONVERSION #
02283  M00S02257.ssdebug +++|        END
02284  M00S02258.ssdebug +++|
02285  M00S02259.ssdebug +++|#
02286  M00S02260.ssdebug +++|****  PROC DBMAIN - XREF LIST END.
02287  M00S02261.ssdebug +++|#
02288  M00S02262.ssdebug +++|
02289  M00S02263.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
02290  M00S02264.ssdebug +++|
02291  M00S02265.ssdebug +++|*CALL COMBFAS
02292  M00S02266.ssdebug +++|*CALL COMBCMD
02293  M00S02267.ssdebug +++|*CALL COMBCMS
02294  M00S02268.ssdebug +++|*CALL COMBCPR
02295  M00S02269.ssdebug +++|*CALL COMBPFP
02296  M00S02270.ssdebug +++|*CALL COMBSNS
02297  M00S02271.ssdebug +++|*CALL COMSPFM
02298  M00S02272.ssdebug +++|*CALL COMTDBG
02299  M00S02273.ssdebug +++|*CALL COMTDBP
02300  M00S02274.ssdebug +++|*CALL COMTOUT
02301  M00S02275.ssdebug +++|
02302  M00S02276.ssdebug +++|      ITEM DIS$SB     C(10);         # SUBFAMILY IN DISPLAY CODE #
02303  M00S02277.ssdebug +++|      ITEM EOR        B;             # INDICATES END OF RECORD #
02304  M00S02278.ssdebug +++|      ITEM I          I;             # LOOP INDUCTION VARIABLE #
02305  M00S02279.ssdebug +++|      ITEM J          I;             # LOOP INDUCTION VARIABLE #
02306  M00S02280.ssdebug +++|      ITEM RESPCODE   I;             # RESPONSE CODE #
02307  M00S02281.ssdebug +++|
02308  M00S02282.ssdebug +++|      ARRAY CATNAME [0:0] P(1);      # CATALOG FILE NAME #
02309  M00S02283.ssdebug +++|        BEGIN
02310  M00S02284.ssdebug +++|        ITEM CAT$NAM    C(00,00,06);  # FIRST 6 CHARACTERS #
02311  M00S02285.ssdebug +++|        ITEM CAT$SB     C(00,36,01);  # SUBFAMILY IDENTIFIER #
02312  M00S02286.ssdebug +++|        END
02313  M00S02287.ssdebug +++|
02314  M00S02288.ssdebug +++|      ARRAY DRWSTAT [0:0] S(SNSLEN);;  # DRAWER STATUS TABLE #
02315  M00S02289.ssdebug +++|
02316  M00S02290.ssdebug +++|      ARRAY MAPNAME [0:0] P(1);      # MAP FILE NAME #
02317  M00S02291.ssdebug +++|        BEGIN
02318  M00S02292.ssdebug +++|        ITEM MAP$NAM    C(00,00,07) = ["SMMAP  "];
02319  M00S02293.ssdebug +++|        ITEM MAP$SM     C(00,30,01);  # SM IDENTIFIER #
02320  M00S02294.ssdebug +++|        ITEM MAP$ZFILL  U(00,36,06) = [0];
02321  M00S02295.ssdebug +++|        END
02322  M00S02296.ssdebug +++|
02323  M00S02297.ssdebug +++|#
02324  M00S02298.ssdebug +++|*     SWITCH TO PROCESS *SSDEBUG* DIRECTIVES.  THE
02325  M00S02299.ssdebug +++|*     ORDER OF THE SWITCH LABELS IS THE SAME AS THE
02326  M00S02300.ssdebug +++|*     DIRECTIVE NAMES SET UP IN ARRAY *DB$DIR*
02327  M00S02301.ssdebug +++|*     DEFINED IN *COMTDBG*.
02328  M00S02302.ssdebug +++|#
02329  M00S02303.ssdebug +++|
02330  M00S02304.ssdebug +++|      SWITCH DIR$ACT                 # SWITCH TO PROCESS DIRECTIVES #
02331  M00S02305.ssdebug +++|        CMAP,                        # REMOVE SMMAP ENTRY #
02332  M00S02306.ssdebug +++|        FMAP,                        # REMOVE *FCT* ENTRY #
02333  M00S02307.ssdebug +++|        REL,                         # RELEASE PROBLEM CHAIN #
02334  M00S02308.ssdebug +++|        RDFIL,                       # READ FILE #
02335  M00S02309.ssdebug +++|        RDSTM,                       # READ AU #
02336  M00S02310.ssdebug +++|        FLAG;                        # CHANGE FLAG #
02337  M00S02311.ssdebug +++|
02338  M00S02312.ssdebug +++|CONTROL EJECT;
02339  M00S02313.ssdebug +++|
02340  M00S02314.ssdebug +++|      ADDRSENSE = LOC(DRWSTAT[0]);   # FWA OF DRAWER STATUS TABLE #
02341  M00S02315.ssdebug +++|      P<SNS> = ADDRSENSE;
02342  M00S02316.ssdebug +++|
02343  M00S02317.ssdebug +++|#
02344  M00S02318.ssdebug +++|*     INITIALIZE THE FETS, BUFFERS, TABLES AND
02345  M00S02319.ssdebug +++|*     POINTERS NEEDED TO ACCESS CATALOGS AND MAPS.
02346  M00S02320.ssdebug +++|#
02347  M00S02321.ssdebug +++|
02348  M00S02322.ssdebug +++|      SSINIT;
02349  M00S02323.ssdebug +++|
02350  M00S02324.ssdebug +++|#
02351  M00S02325.ssdebug +++|*     READ THE DIRECTIVES.
02352  M00S02326.ssdebug +++|#
02353  M00S02327.ssdebug +++|
02354  M00S02328.ssdebug +++|      READ(DSCR$FET[0],RCL);
02355  M00S02329.ssdebug +++|
02356  M00S02330.ssdebug +++|      EOR = FALSE;
02357  M00S02331.ssdebug +++|      FASTFOR I = 0 STEP 1 WHILE NOT EOR
02358  M00S02332.ssdebug +++|      DO
02359  M00S02333.ssdebug +++|        BEGIN  # PROCESS EACH DIRECTIVE #
02360  M00S02334.ssdebug +++|        READW(DSCR$FET[0],DBARG[0],DBDIRPRML,RESPCODE);
02361  M00S02335.ssdebug +++|        IF RESPCODE NQ OK
02362  M00S02336.ssdebug +++|        THEN                         # NO MORE DIRECTIVES #
02363  M00S02337.ssdebug +++|          BEGIN
02364  M00S02338.ssdebug +++|          EOR = TRUE;
02365  M00S02339.ssdebug +++|          TEST I;
02366  M00S02340.ssdebug +++|          END
02367  M00S02341.ssdebug +++|
02368  M00S02342.ssdebug +++|#
02369  M00S02343.ssdebug +++|*     WRITE THE DIRECTIVE TO THE OUTPUT FILE.
02370  M00S02344.ssdebug +++|#
02371  M00S02345.ssdebug +++|
02372  M00S02346.ssdebug +++|        RPLINE(OUT$FETP,DBARG$DIRN[0],2,5,1);
02373  M00S02347.ssdebug +++|        RPLINE(OUT$FETP,DBARG$DIRI[0],8,80,0);
02374  M00S02348.ssdebug +++|        RPSPACE(OUT$FETP,SP"SPACE",1);
02375  M00S02349.ssdebug +++|
02376  M00S02350.ssdebug +++|        IF DBARG$DIRF[0]
02377  M00S02351.ssdebug +++|        THEN                         # SYNTAX ERROR IN DIRECTIVE #
02378  M00S02352.ssdebug +++|          BEGIN
02379  M00S02353.ssdebug +++|          RPLINE(OUT$FETP,"*** SYNTAX ERROR",2,16,0);
02380  M00S02354.ssdebug +++|          TEST I;                    # GET NEXT DIRECTIVE #
02381  M00S02355.ssdebug +++|          END
02382  M00S02356.ssdebug +++|
02383  M00S02357.ssdebug +++|        IF DBARG$FM[0] EQ 0
02384  M00S02358.ssdebug +++|        THEN                         # FAMILY NOT SPECIFIED #
02385  M00S02359.ssdebug +++|          BEGIN
02386  M00S02360.ssdebug +++|          DBARG$FM[0] = DEF$FAM;     # USE DEFAULT FAMILY #
02387  M00S02361.ssdebug +++|          END
02388  M00S02362.ssdebug +++|
02389  M00S02363.ssdebug +++|        PFP$WRD0[0] = 0;             # SET FLAGS #
02390  M00S02364.ssdebug +++|        PFP$WRD1[0] = 0;             # CLEAR PACK NAME #
02391  M00S02365.ssdebug +++|        PFP$FG1[0] = TRUE;
02392  M00S02366.ssdebug +++|        PFP$FG2[0] = TRUE;
02393  M00S02367.ssdebug +++|        PFP$FG4[0] = TRUE;
02394  M00S02368.ssdebug +++|
02395  M00S02369.ssdebug +++|#
02396  M00S02370.ssdebug +++|*     OPEN THE SMMAP FOR *RS*, *RC* AND *CF* DIRECTIVES.
02397  M00S02371.ssdebug +++|#
02398  M00S02372.ssdebug +++|
02399  M00S02373.ssdebug +++|        IF DBARG$OP[0] EQ "RC"
02400  M00S02374.ssdebug +++|          OR ( DBARG$OP[0] EQ "RS" AND DBARG$WCN[0] NQ 0 )
02401  M00S02375.ssdebug +++|          OR (DBARG$OP[0] EQ "CF"
02402  M00S02376.ssdebug +++|          AND (DBARG$FL[0] EQ "ME" OR DBARG$FO[0] LS 0))
02403  M00S02377.ssdebug +++|        THEN
02404  M00S02378.ssdebug +++|          BEGIN  # OPEN SMMAP #
02405  M00S02379.ssdebug +++|          PFP$FAM[0] = DEF$FAM;      # SET FAMILY AND USER INDEX #
02406  M00S02380.ssdebug +++|          PFP$UI[0] = DEF$UI;
02407  M00S02381.ssdebug +++|          SETPFP(PFP);
02408  M00S02382.ssdebug +++|          IF PFP$STAT[0] NQ 0
02409  M00S02383.ssdebug +++|          THEN                       # DEFAULT FAMILY NOT FOUND #
02410  M00S02384.ssdebug +++|            BEGIN
02411  M00S02385.ssdebug +++|            DBMSG$LN[0] = " FAMILY NOT FOUND.";
02412  M00S02386.ssdebug +++|            MESSAGE(DBMSG[0],SYSUDF1);
02413  M00S02387.ssdebug +++|            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
02414  M00S02388.ssdebug +++|            END
02415  M00S02389.ssdebug +++|
02416  M00S02390.ssdebug +++|          MAP$SM[0] = DBARG$SM[0];
02417  M00S02391.ssdebug +++|          MOPEN(DBARG$SMID[0],MAP$NAM[0],"RM",RESPCODE);
02418  M00S02392.ssdebug +++|          IF RESPCODE NQ CMASTAT"NOERR"
02419  M00S02393.ssdebug +++|          THEN                       # UNABLE TO OPEN MAP #
02420  M00S02394.ssdebug +++|            BEGIN
02421  M00S02395.ssdebug +++|            DBRESP(RESPCODE,0);
02422  M00S02396.ssdebug +++|            TEST I;
02423  M00S02397.ssdebug +++|            END
02424  M00S02398.ssdebug +++|
02425  M00S02399.ssdebug +++|          ELSE                       # MAP OPENED #
02426  M00S02400.ssdebug +++|            BEGIN
02427  M00S02401.ssdebug +++|            LOFPROC(MAP$NAM[0]);     # ADD LFN TO LIST OF FILES #
02428  M00S02402.ssdebug +++|            END
02429  M00S02403.ssdebug +++|
02430  M00S02404.ssdebug +++|          END  # OPEN SMMAP #
02431  M00S02405.ssdebug +++|
02432  M00S02406.ssdebug +++|#
02433  M00S02407.ssdebug +++|*     OPEN THE CATALOG FOR *RF*, *RP*, *RL*, AND *CF* DIRECTIVES.
02434  M00S02408.ssdebug +++|#
02435  M00S02409.ssdebug +++|
02436  M00S02410.ssdebug +++|        IF DBARG$OP[0] EQ "RF"
02437  M00S02411.ssdebug +++|          OR DBARG$OP[0] EQ "RP"
02438  M00S02412.ssdebug +++|          OR DBARG$OP[0] EQ "RL"
02439  M00S02413.ssdebug +++|          OR (DBARG$OP[0] EQ "CF" AND DBARG$FL[0] EQ "ME"
02440  M00S02414.ssdebug +++|          AND DBARG$FO[0] GR 0)
02441  M00S02415.ssdebug +++|        THEN
02442  M00S02416.ssdebug +++|          BEGIN  # OPEN CATALOG #
02443  M00S02417.ssdebug +++|          PFP$FAM[0] = DBARG$FM[0];  # SET FAMILY AND USER INDEX #
02444  M00S02418.ssdebug +++|          PFP$UI[0] = DEF$UI + DBARG$SB[0];
02445  M00S02419.ssdebug +++|          SETPFP(PFP);
02446  M00S02420.ssdebug +++|          IF PFP$STAT[0] NQ 0
02447  M00S02421.ssdebug +++|          THEN                       # FAMILY NOT FOUND #
02448  M00S02422.ssdebug +++|            BEGIN
02449  M00S02423.ssdebug +++|            DBMSG$LN[0] = " FAMILY NOT FOUND.";
02450  M00S02424.ssdebug +++|            MESSAGE(DBMSG[0],SYSUDF1);
02451  M00S02425.ssdebug +++|            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
02452  M00S02426.ssdebug +++|            END
02453  M00S02427.ssdebug +++|
02454  M00S02428.ssdebug +++|          CAT$NAM[0] = SFMCAT;
02455  M00S02429.ssdebug +++|          DIS$SB = XCOD(DBARG$SB[0]);
02456  M00S02430.ssdebug +++|          CAT$SB[0] = C<9,1>DIS$SB;
02457  M00S02431.ssdebug +++|          COPEN(DBARG$FM[0],DBARG$SB[0],CATNAME[0],"RM",TRUE,RESPCODE);
02458  M00S02432.ssdebug +++|          IF RESPCODE NQ CMASTAT"NOERR"
02459  M00S02433.ssdebug +++|          THEN                       # UNABLE TO OPEN CATALOG #
02460  M00S02434.ssdebug +++|            BEGIN
02461  M00S02435.ssdebug +++|            DBRESP(RESPCODE,0);
02462  M00S02436.ssdebug +++|            TEST I;
02463  M00S02437.ssdebug +++|            END
02464  M00S02438.ssdebug +++|
02465  M00S02439.ssdebug +++|          ELSE                       # CATALOG OPENED #
02466  M00S02440.ssdebug +++|            BEGIN
02467  M00S02441.ssdebug +++|            LOFPROC(OCT$LFN[1]);     # ADD LFN TO LIST OF FILES #
02468  M00S02442.ssdebug +++|            END
02469  M00S02443.ssdebug +++|
02470  M00S02444.ssdebug +++|          END  # OPEN CATALOG #
02471  M00S02445.ssdebug +++|
02472  M00S02446.ssdebug +++|#
02473  M00S02447.ssdebug +++|*     PROCESS THE DIRECTIVE.
02474  M00S02448.ssdebug +++|#
02475  M00S02449.ssdebug +++|
02476  M00S02450.ssdebug +++|        SLOWFOR J = 0 STEP 1 UNTIL DBDIRNM
02477  M00S02451.ssdebug +++|        DO
02478  M00S02452.ssdebug +++|          BEGIN  # FIND MATCHING DIRECTIVE #
02479  M00S02453.ssdebug +++|          IF DB$DIRNM[J] EQ DBARG$OP[0]
02480  M00S02454.ssdebug +++|          THEN
02481  M00S02455.ssdebug +++|            BEGIN
02482  M00S02456.ssdebug +++|            GOTO DIR$ACT[J];
02483  M00S02457.ssdebug +++|CMAP:                                # REMOVE SMMAP ENTRY #
02484  M00S02458.ssdebug +++|            DBCMAP;
02485  M00S02459.ssdebug +++|            TEST I;
02486  M00S02460.ssdebug +++|
02487  M00S02461.ssdebug +++|FMAP:                                # REMOVE *FCT* ENTRY #
02488  M00S02462.ssdebug +++|            DBFMAP;
02489  M00S02463.ssdebug +++|            TEST I;
02490  M00S02464.ssdebug +++|
02491  M00S02465.ssdebug +++|REL:                                 # RELEASE PROBLEM CHAINS #
02492  M00S02466.ssdebug +++|            DBREL;
02493  M00S02467.ssdebug +++|            TEST I;
02494  M00S02468.ssdebug +++|
02495  M00S02469.ssdebug +++|RDFIL:                               # READ FILE #
02496  M00S02470.ssdebug +++|            DBRDFIL;
02497  M00S02471.ssdebug +++|            TEST I;
02498  M00S02472.ssdebug +++|
02499  M00S02473.ssdebug +++|RDSTM:
02500  M00S02474.ssdebug +++|            DBRDSTM;                 # READ AU #
02501  M00S02475.ssdebug +++|            TEST I;
02502  M00S02476.ssdebug +++|
02503  M00S02477.ssdebug +++|FLAG:
02504  M00S02478.ssdebug +++|            DBFLAG;                  # CHANGE FLAG #
02505  M00S02479.ssdebug +++|            TEST I;
02506  M00S02480.ssdebug +++|
02507  M00S02481.ssdebug +++|            END
02508  M00S02482.ssdebug +++|
02509  M00S02483.ssdebug +++|          END  # FIND MATCHING DIRECTIVE #
02510  M00S02484.ssdebug +++|
02511  M00S02485.ssdebug +++|        END  # PROCESS EACH DIRECTIVE #
02512  M00S02486.ssdebug +++|
02513  M00S02487.ssdebug +++|      RETURN;
02514  M00S02488.ssdebug +++|
02515  M00S02489.ssdebug +++|      END  # DBMAIN #
02516  M00S02490.ssdebug +++|
02517  M00S02491.ssdebug +++|    TERM
02518  M00S02492.ssdebug +++|PROC DBOPT(FLAG);
02519  M00S02493.ssdebug +++|# TITLE DBOPT - CHECKS CRACKED PARAMETERS FOR VALID OPTIONS.          #
02520  M00S02494.ssdebug +++|
02521  M00S02495.ssdebug +++|      BEGIN  # DBOPT #
02522  M00S02496.ssdebug +++|
02523  M00S02497.ssdebug +++|#
02524  M00S02498.ssdebug +++|**    DBOPT - CHECKS CRACKED PARAMETERS FOR VALID OPTIONS.
02525  M00S02499.ssdebug +++|*
02526  M00S02500.ssdebug +++|*     PROC DBOPT(FLAG)
02527  M00S02501.ssdebug +++|*
02528  M00S02502.ssdebug +++|*     ENTRY   THE CRACKED AND CONVERTED PARAMETERS ARE SET UP
02529  M00S02503.ssdebug +++|*             IN THE COMMON AREA DEFINED IN *COMTDBP*.
02530  M00S02504.ssdebug +++|*
02531  M00S02505.ssdebug +++|*     EXIT    ALL OPTIONS HAVE BEEN CHECKED FOR VALIDITY.
02532  M00S02506.ssdebug +++|*             (FLAG) = 0, NO ERROR.
02533  M00S02507.ssdebug +++|*                      1, VALID OPTION VIOLATED.
02534  M00S02508.ssdebug +++|*
02535  M00S02509.ssdebug +++|*     NOTES   ALL THE DIRECTIVES ARE CHECKED FOR VALID
02536  M00S02510.ssdebug +++|*             OPTIONS.  THE VALID OPTIONS ARE
02537  M00S02511.ssdebug +++|*               1.  *OP* MUST BE A VALID DIRECTIVE NAME.
02538  M00S02512.ssdebug +++|*               2.  *FO* MUST BE SPECIFIED FOR OP=RF, RP AND RL,
02539  M00S02513.ssdebug +++|*                   AND *ST* MUST BE SPECIFIED FOR OP=RF AND RP.
02540  M00S02514.ssdebug +++|*               3.  *SB* MUST BE FROM 0 TO 7.
02541  M00S02515.ssdebug +++|*               4.  *CS* MUST BE FROM A THROUGH H.
02542  M00S02516.ssdebug +++|*               5.  *SL* AND *SU* MUST BE FROM 1 TO 1931.
02543  M00S02517.ssdebug +++|*               5.  *SL* AND *SU* MUST BE FROM 1 TO 1931.
02544  M00S02518.ssdebug +++|*               6.  *SL* MUST BE LESS THAN OR EQUAL TO *SU*.
02545  M00S02519.ssdebug +++|*               7.  FOR OP=RS, ONE AND ONLY ONE OF THE FOLLOWING
02546  M00S02520.ssdebug +++|*                   PARAMETERS MUST BE SPECIFIED:  *V*, *YI*, OR *D*.
02547  M00S02521.ssdebug +++|*               8.  FOR OP=CF, ONE AND ONLY ONE OF THE FOLLOWING
02548  M00S02522.ssdebug +++|*                   PARAMETERS MUST BE SPECIFIED:  *V*, *YI*, OR *FO*.
02549  M00S02523.ssdebug +++|*               9.  *FL*, *ON*, AND *OF* ARE VALID ONLY FOR OP=CF.
02550  M00S02524.ssdebug +++|*               10. FOR OP=CF, *FL* MUST BE A VALID FLAG NAME AND
02551  M00S02525.ssdebug +++|*                   EITHER *ON* OR *OF* MUST BE SPECIFIED.
02552  M00S02526.ssdebug +++|*               11. *YI* AND *ZI* MUST BE SPECIFIED TOGETHER.
02553  M00S02527.ssdebug +++|*               12. *YI* MUST BE FROM 0 TO 21.
02554  M00S02528.ssdebug +++|*               13. *ZI* MUST BE FROM 0 TO 15.
02555  M00S02529.ssdebug +++|*               14. *YI*, *ZI* MUST BE SPECIFIED FOR OP=RC.
02556  M00S02530.ssdebug +++|*
02557  M00S02531.ssdebug +++|*              ANY VIOLATION OF THE VALID OPTIONS CAUSES A
02558  M00S02532.ssdebug +++|*              MESSAGE TO BE PRINTED IN THE DAYFILE AND THE
02559  M00S02533.ssdebug +++|*              REPORT FILE, AND AN ERROR FLAG TO BE RETURNED
02560  M00S02534.ssdebug +++|*              TO THE CALLING ROUTINE.
02561  M00S02535.ssdebug +++|#
02562  M00S02536.ssdebug +++|
02563  M00S02537.ssdebug +++|      ITEM FLAG       I;             # ERROR STATUS #
02564  M00S02538.ssdebug +++|
02565  M00S02539.ssdebug +++|#
02566  M00S02540.ssdebug +++|****  PROC DBOPT - XREF LIST BEGIN.
02567  M00S02541.ssdebug +++|#
02568  M00S02542.ssdebug +++|
02569  M00S02543.ssdebug +++|      XREF
02570  M00S02544.ssdebug +++|        BEGIN
02571  M00S02545.ssdebug +++|        PROC DBERR;                  # ERROR PROCESSOR #
02572  M00S02546.ssdebug +++|        END
02573  M00S02547.ssdebug +++|
02574  M00S02548.ssdebug +++|#
02575  M00S02549.ssdebug +++|****  PROC DBOPT - XREF LIST END.
02576  M00S02550.ssdebug +++|#
02577  M00S02551.ssdebug +++|
02578  M00S02552.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
02579  M00S02553.ssdebug +++|*CALL COMBFAS
02580  M00S02554.ssdebug +++|*CALL COMBCPR
02581  M00S02555.ssdebug +++|*CALL COMTDBP
02582  M00S02556.ssdebug +++|*CALL COMTDBG
02583  M00S02557.ssdebug +++|*CALL COMTDER
02584  M00S02558.ssdebug +++|*CALL COMTLAB
02585  M00S02559.ssdebug +++|
02586  M00S02560.ssdebug +++|      ITEM FOUND      B;             # SEARCH FLAG #
02587  M00S02561.ssdebug +++|      ITEM I          I;             # LOOP INDUCTION VARIABLE #
02588  M00S02562.ssdebug +++|      ITEM OPTCOUNT   I;             # OPTION COUNT #
02589  M00S02563.ssdebug +++|
02590  M00S02564.ssdebug +++|CONTROL EJECT;
02591  M00S02565.ssdebug +++|
02592  M00S02566.ssdebug +++|      FLAG = 1;                      # INITIALIZE #
02593  M00S02567.ssdebug +++|
02594  M00S02568.ssdebug +++|#
02595  M00S02569.ssdebug +++|*     CHECK FOR A LEGAL DIRECTIVE NAME.
02596  M00S02570.ssdebug +++|#
02597  M00S02571.ssdebug +++|
02598  M00S02572.ssdebug +++|      FOUND = FALSE;
02599  M00S02573.ssdebug +++|      FASTFOR I = 0 STEP 1 UNTIL DBDIRNM
02600  M00S02574.ssdebug +++|      DO
02601  M00S02575.ssdebug +++|        BEGIN  # SEARCH FOR MATCHING DIRECTIVE NAME #
02602  M00S02576.ssdebug +++|        IF DBARG$OP[0] EQ DB$DIRNM[I]
02603  M00S02577.ssdebug +++|        THEN
02604  M00S02578.ssdebug +++|          BEGIN
02605  M00S02579.ssdebug +++|          FOUND = TRUE;
02606  M00S02580.ssdebug +++|          END
02607  M00S02581.ssdebug +++|
02608  M00S02582.ssdebug +++|        END  # SEARCH FOR MATCHING DIRECTIVE NAME #
02609  M00S02583.ssdebug +++|
02610  M00S02584.ssdebug +++|      IF NOT FOUND
02611  M00S02585.ssdebug +++|      THEN                           # ILLEGAL DIRECTIVE #
02612  M00S02586.ssdebug +++|        BEGIN
02613  M00S02587.ssdebug +++|        DBERRCODE = S"DILLEG$DIR";
02614  M00S02588.ssdebug +++|        DBERR(DBERRCODE);
02615  M00S02589.ssdebug +++|        RETURN;
02616  M00S02590.ssdebug +++|        END
02617  M00S02591.ssdebug +++|
02618  M00S02592.ssdebug +++|#
02619  M00S02593.ssdebug +++|*     CHECK IF *FO* SPECIFIED CORRECTLY.
02620  M00S02594.ssdebug +++|#
02621  M00S02595.ssdebug +++|
02622  M00S02596.ssdebug +++|      IF DBARG$FO[0] EQ -1           ##
02623  M00S02597.ssdebug +++|        OR (DBARG$FO[0] EQ -2        ##
02624  M00S02598.ssdebug +++|        AND (DBARG$OP[0] EQ "RF"     ##
02625  M00S02599.ssdebug +++|        OR DBARG$OP[0] EQ "RP"       ##
02626  M00S02600.ssdebug +++|        OR DBARG$OP[0] EQ "RL"))
02627  M00S02601.ssdebug +++|        OR ( DBARG$FO[0] GQ 0 AND DBARG$FO[0] LS MINFO )
02628  M00S02602.ssdebug +++|        OR ( DBARG$FO[0] GR MAXFO )
02629  M00S02603.ssdebug +++|      THEN                           # *FO* OPTION VIOLATED #
02630  M00S02604.ssdebug +++|        BEGIN
02631  M00S02605.ssdebug +++|        DBERRCODE = S"DVIOL$FO";
02632  M00S02606.ssdebug +++|        DBERR(DBERRCODE);
02633  M00S02607.ssdebug +++|        RETURN;
02634  M00S02608.ssdebug +++|        END
02635  M00S02609.ssdebug +++|
02636  M00S02610.ssdebug +++|#
02637  M00S02611.ssdebug +++|*     CHECK IF *ST* IS SPECIFIED CORRECTLY.
02638  M00S02612.ssdebug +++|#
02639  M00S02613.ssdebug +++|
02640  M00S02614.ssdebug +++|      IF DBARG$ST[0] EQ -1           ##
02641  M00S02615.ssdebug +++|        OR ( ( DBARG$ST[0] EQ -2       ##
02642  M00S02616.ssdebug +++|        OR DBARG$ST[0] EQ 0 )          ##
02643  M00S02617.ssdebug +++|        AND (DBARG$OP[0] EQ "RF"     ##
02644  M00S02618.ssdebug +++|        OR DBARG$OP[0] EQ "RP"))
02645  M00S02619.ssdebug +++|      THEN                           # *ST* OPTION VIOLATED #
02646  M00S02620.ssdebug +++|        BEGIN
02647  M00S02621.ssdebug +++|        DBERRCODE = S"DVIOL$ST";
02648  M00S02622.ssdebug +++|        DBERR(DBERRCODE);
02649  M00S02623.ssdebug +++|        RETURN;
02650  M00S02624.ssdebug +++|        END
02651  M00S02625.ssdebug +++|
02652  M00S02626.ssdebug +++|#
02653  M00S02627.ssdebug +++|*     CHECK THE VALUE OF *SB*.
02654  M00S02628.ssdebug +++|#
02655  M00S02629.ssdebug +++|
02656  M00S02630.ssdebug +++|      IF DBARG$SB[0] LS 0            ##
02657  M00S02631.ssdebug +++|        OR DBARG$SB[0] GR 7
02658  M00S02632.ssdebug +++|      THEN                           # *SB* OPTION VIOLATED #
02659  M00S02633.ssdebug +++|        BEGIN
02660  M00S02634.ssdebug +++|        DBERRCODE = S"DVIOL$SB";
02661  M00S02635.ssdebug +++|        DBERR(DBERRCODE);
02662  M00S02636.ssdebug +++|        RETURN;
02663  M00S02637.ssdebug +++|        END
02664  M00S02638.ssdebug +++|
02665  M00S02639.ssdebug +++|#
02666  M00S02640.ssdebug +++|*     CHECK THE VALUE OF *SM*.
02667  M00S02641.ssdebug +++|#
02668  M00S02642.ssdebug +++|
02669  M00S02643.ssdebug +++|      IF DBARG$SM[0] LS "A"          ##
02670  M00S02644.ssdebug +++|        OR DBARG$SM[0] GR "H"        ##
02671  M00S02645.ssdebug +++|        OR DBARG$WSM[0] NQ 0         ##
02672  M00S02646.ssdebug +++|      THEN                           # *SM* OPTION VIOLATED #
02673  M00S02647.ssdebug +++|        BEGIN
02674  M00S02648.ssdebug +++|        DBERRCODE = S"DVIOL$SM";
02675  M00S02649.ssdebug +++|        DBERR(DBERRCODE);
02676  M00S02650.ssdebug +++|        RETURN;
02677  M00S02651.ssdebug +++|        END
02678  M00S02652.ssdebug +++|
02679  M00S02653.ssdebug +++|#
02680  M00S02654.ssdebug +++|*     CHECK THE VALUE OF *SL*.
02681  M00S02655.ssdebug +++|#
02682  M00S02656.ssdebug +++|
02683  M00S02657.ssdebug +++|      IF ( DBARG$SL[0] LS 0          ##
02684  M00S02658.ssdebug +++|        OR DBARG$SL[0] GR INAVOT )  # MAXIMUM AU PER CARTRIDGE #
02685  M00S02659.ssdebug +++|        OR ( DBARG$OP[0] EQ "RS"     ##
02686  M00S02660.ssdebug +++|        AND DBARG$SL[0] EQ 0 )       ##
02687  M00S02661.ssdebug +++|      THEN                           # *SL* OPTION VIOLATED #
02688  M00S02662.ssdebug +++|        BEGIN
02689  M00S02663.ssdebug +++|        DBERRCODE = S"DVIOL$SL";
02690  M00S02664.ssdebug +++|        DBERR(DBERRCODE);
02691  M00S02665.ssdebug +++|        RETURN;
02692  M00S02666.ssdebug +++|        END
02693  M00S02667.ssdebug +++|
02694  M00S02668.ssdebug +++|#
02695  M00S02669.ssdebug +++|*     CHECK THE VALUE OF *SU*.
02696  M00S02670.ssdebug +++|#
02697  M00S02671.ssdebug +++|
02698  M00S02672.ssdebug +++|      IF ( DBARG$SU[0] LS 0          ##
02699  M00S02673.ssdebug +++|        OR DBARG$SU[0] GR INAVOT )  # MAXIMUM AU PER CARTRIDGE #
02700  M00S02674.ssdebug +++|        OR ( DBARG$OP[0] EQ "RS"     ##
02701  M00S02675.ssdebug +++|        AND DBARG$SU[0] EQ 0 )       ##
02702  M00S02676.ssdebug +++|        OR DBARG$SU[0] LS DBARG$SL[0]
02703  M00S02677.ssdebug +++|      THEN                           # *SU* OPTION VIOLATED #
02704  M00S02678.ssdebug +++|        BEGIN
02705  M00S02679.ssdebug +++|        DBERRCODE = S"DVIOL$SU";
02706  M00S02680.ssdebug +++|        DBERR(DBERRCODE);
02707  M00S02681.ssdebug +++|        RETURN;
02708  M00S02682.ssdebug +++|        END
02709  M00S02683.ssdebug +++|
02710  M00S02684.ssdebug +++|#
02711  M00S02685.ssdebug +++|*     CHECK THE VALUE OF *CN*
02712  M00S02686.ssdebug +++|#
02713  M00S02687.ssdebug +++|
02714  M00S02688.ssdebug +++|      IF DBARG$WCN[0] EQ -1
02715  M00S02689.ssdebug +++|      THEN                           # *CN* OPTION VIOLATED #
02716  M00S02690.ssdebug +++|        BEGIN
02717  M00S02691.ssdebug +++|        DBERRCODE = S"DVIOL$V";
02718  M00S02692.ssdebug +++|        DBERR(DBERRCODE);
02719  M00S02693.ssdebug +++|        RETURN;
02720  M00S02694.ssdebug +++|        END
02721  M00S02695.ssdebug +++|
02722  M00S02696.ssdebug +++|
02723  M00S02697.ssdebug +++|#
02724  M00S02698.ssdebug +++|*     CHECK THE VALUE OF *YI* AND *ZI*.
02725  M00S02699.ssdebug +++|#
02726  M00S02700.ssdebug +++|
02727  M00S02701.ssdebug +++|      IF DBARG$YI[0] LS -1           ##
02728  M00S02702.ssdebug +++|        OR DBARG$ZI[0] LS -1         ##
02729  M00S02703.ssdebug +++|        OR DBARG$YI[0] GR MAX$Y      ##
02730  M00S02704.ssdebug +++|        OR DBARG$ZI[0] GR MAX$Z      ##
02731  M00S02705.ssdebug +++|        OR DBARG$ZI[0] EQ Z$NO$CUBE
02732  M00S02706.ssdebug +++|      THEN                           # *YI*, *ZI* OPTION VIOLATED #
02733  M00S02707.ssdebug +++|        BEGIN
02734  M00S02708.ssdebug +++|        DBERRCODE = S"DVIOL$YZ";
02735  M00S02709.ssdebug +++|        DBERR(DBERRCODE);
02736  M00S02710.ssdebug +++|        RETURN;
02737  M00S02711.ssdebug +++|        END
02738  M00S02712.ssdebug +++|
02739  M00S02713.ssdebug +++|#
02740  M00S02714.ssdebug +++|*     CHECK IF *YI* AND *ZI* ARE SPECIFIED TOGETHER.
02741  M00S02715.ssdebug +++|#
02742  M00S02716.ssdebug +++|
02743  M00S02717.ssdebug +++|      IF (DBARG$YI[0] EQ -1          ##
02744  M00S02718.ssdebug +++|        AND DBARG$ZI[0] GQ 0)        ##
02745  M00S02719.ssdebug +++|        OR (DBARG$YI[0] GQ 0         ##
02746  M00S02720.ssdebug +++|        AND DBARG$ZI[0] EQ -1)
02747  M00S02721.ssdebug +++|      THEN                           # *YI*, *ZI* OPTION VIOLATED #
02748  M00S02722.ssdebug +++|        BEGIN
02749  M00S02723.ssdebug +++|        DBERRCODE = S"DVIOL$YZ";
02750  M00S02724.ssdebug +++|        DBERR(DBERRCODE);
02751  M00S02725.ssdebug +++|        RETURN;
02752  M00S02726.ssdebug +++|        END
02753  M00S02727.ssdebug +++|
02754  M00S02728.ssdebug +++|#
02755  M00S02729.ssdebug +++|*     *YI*, *ZI* MUST BE SPECIFIED FOR OP=RC.
02756  M00S02730.ssdebug +++|#
02757  M00S02731.ssdebug +++|
02758  M00S02732.ssdebug +++|      IF DBARG$OP[0] EQ "RC"         ##
02759  M00S02733.ssdebug +++|        AND DBARG$YI[0] EQ -1
02760  M00S02734.ssdebug +++|      THEN                           # *YI*, *ZI* OPTION VIOLATED #
02761  M00S02735.ssdebug +++|        BEGIN
02762  M00S02736.ssdebug +++|        DBERRCODE = S"DVIOL$YZ";
02763  M00S02737.ssdebug +++|        DBERR(DBERRCODE);
02764  M00S02738.ssdebug +++|        RETURN;
02765  M00S02739.ssdebug +++|        END
02766  M00S02740.ssdebug +++|
02767  M00S02741.ssdebug +++|#
02768  M00S02742.ssdebug +++|*     FOR OP=RS, ONE AND ONLY ONE OF THE FOLLOWING MUST BE
02769  M00S02743.ssdebug +++|*     SPECIFIED:  *CN*, OR *YI*.  FOR OP=CF, ONE AND ONLY
02770  M00S02744.ssdebug +++|*     ONE OF THE FOLLOWING MUST BE SPECIFIED: *CN*, *YI*, OR *FO*.
02771  M00S02745.ssdebug +++|#
02772  M00S02746.ssdebug +++|
02773  M00S02747.ssdebug +++|      IF DBARG$OP[0] EQ "RS" OR DBARG$OP[0] EQ "CF"
02774  M00S02748.ssdebug +++|      THEN
02775  M00S02749.ssdebug +++|        BEGIN  # CHECK *CN*, *YI*, AND *FO* #
02776  M00S02750.ssdebug +++|        OPTCOUNT = 0;
02777  M00S02751.ssdebug +++|        IF DBARG$WCN[0] NQ 0
02778  M00S02752.ssdebug +++|        THEN                          # *CN* SPECIFIED #
02779  M00S02753.ssdebug +++|          BEGIN
02780  M00S02754.ssdebug +++|          OPTCOUNT = OPTCOUNT + 1;
02781  M00S02755.ssdebug +++|          END
02782  M00S02756.ssdebug +++|
02783  M00S02757.ssdebug +++|        IF DBARG$YI[0] GQ 0
02784  M00S02758.ssdebug +++|        THEN                         # *YI* SPECIFIED #
02785  M00S02759.ssdebug +++|          BEGIN
02786  M00S02760.ssdebug +++|          OPTCOUNT = OPTCOUNT + 1;
02787  M00S02761.ssdebug +++|          END
02788  M00S02762.ssdebug +++|
02789  M00S02763.ssdebug +++|        IF DBARG$OP[0] EQ "CF" ##
02790  M00S02764.ssdebug +++|          AND DBARG$FO[0] GR 0
02791  M00S02765.ssdebug +++|        THEN                         # *FO* SPECIFIED AND OP=CF #
02792  M00S02766.ssdebug +++|          BEGIN
02793  M00S02767.ssdebug +++|          OPTCOUNT = OPTCOUNT + 1;
02794  M00S02768.ssdebug +++|          DBERRCODE = S"DVIOL$VFOX";
02795  M00S02769.ssdebug +++|          END
02796  M00S02770.ssdebug +++|
02797  M00S02771.ssdebug +++|        IF OPTCOUNT NQ 1
02798  M00S02772.ssdebug +++|        THEN                         # OPTION VIOLATED #
02799  M00S02773.ssdebug +++|          BEGIN
02800  M00S02774.ssdebug +++|          DBERR(DBERRCODE);
02801  M00S02775.ssdebug +++|          RETURN;
02802  M00S02776.ssdebug +++|          END
02803  M00S02777.ssdebug +++|
02804  M00S02778.ssdebug +++|        END  # CHECK *CN*, *YI*, AND *FO* #
02805  M00S02779.ssdebug +++|
02806  M00S02780.ssdebug +++|
02807  M00S02781.ssdebug +++|#
02808  M00S02782.ssdebug +++|*     *FL* IS REQUIRED FOR OP=CF, AND NOT ALLOWED FOR ANY
02809  M00S02783.ssdebug +++|*     OTHER DIRECTIVES.
02810  M00S02784.ssdebug +++|#
02811  M00S02785.ssdebug +++|
02812  M00S02786.ssdebug +++|      IF (DBARG$OP[0] EQ "CF" AND DBARG$FL[0] LQ 0)
02813  M00S02787.ssdebug +++|        OR (DBARG$OP[0] NQ "CF" AND DBARG$FL[0] GR 0)
02814  M00S02788.ssdebug +++|      THEN                           # *FL* OPTION VIOLATED #
02815  M00S02789.ssdebug +++|        BEGIN
02816  M00S02790.ssdebug +++|        DBERRCODE = S"DVIOL$FL";
02817  M00S02791.ssdebug +++|        DBERR(DBERRCODE);
02818  M00S02792.ssdebug +++|        RETURN;
02819  M00S02793.ssdebug +++|        END
02820  M00S02794.ssdebug +++|
02821  M00S02795.ssdebug +++|#
02822  M00S02796.ssdebug +++|*     EITHER *ON* OR *OF* (BUT NOT BOTH) MUST BE SPECIFIED FOR
02823  M00S02797.ssdebug +++|*     OP=CF, BUT NEITHER MAY BE USED WITH OTHER DIRECTIVES.
02824  M00S02798.ssdebug +++|#
02825  M00S02799.ssdebug +++|
02826  M00S02800.ssdebug +++|      IF (DBARG$OP[0] EQ "CF" AND DBARG$ON[0] EQ DBARG$OF[0])
02827  M00S02801.ssdebug +++|        OR (DBARG$OP[0] NQ "CF"
02828  M00S02802.ssdebug +++|        AND ((DBARG$ON[0] NQ 0) OR (DBARG$OF[0] NQ 0)))
02829  M00S02803.ssdebug +++|      THEN                           # *ON*, *OF* OPTION VIOLATED #
02830  M00S02804.ssdebug +++|        BEGIN
02831  M00S02805.ssdebug +++|        DBERRCODE = S"DVIOL$ONOF";
02832  M00S02806.ssdebug +++|        DBERR(DBERRCODE);
02833  M00S02807.ssdebug +++|        RETURN;
02834  M00S02808.ssdebug +++|        END
02835  M00S02809.ssdebug +++|
02836  M00S02810.ssdebug +++|#
02837  M00S02811.ssdebug +++|*     CHECK FOR A VALID VALUE OF *FL*.
02838  M00S02812.ssdebug +++|#
02839  M00S02813.ssdebug +++|
02840  M00S02814.ssdebug +++|      IF DBARG$OP[0] EQ "CF"
02841  M00S02815.ssdebug +++|      THEN                           # CHANGE FLAG DIRECTIVE #
02842  M00S02816.ssdebug +++|        BEGIN  # CHECK *FL* #
02843  M00S02817.ssdebug +++|        FOUND = FALSE;
02844  M00S02818.ssdebug +++|        FASTFOR I = 0 STEP 1 WHILE NOT FOUND AND I LQ DBFLAGNM
02845  M00S02819.ssdebug +++|        DO
02846  M00S02820.ssdebug +++|          BEGIN
02847  M00S02821.ssdebug +++|          IF DBARG$FL[0] EQ DB$FLAG[I]
02848  M00S02822.ssdebug +++|          THEN
02849  M00S02823.ssdebug +++|            BEGIN
02850  M00S02824.ssdebug +++|            FOUND = TRUE;
02851  M00S02825.ssdebug +++|            DBARG$FLCD[0] = DB$FLCODE[I];  # SAVE STATUS VALUE #
02852  M00S02826.ssdebug +++|            DBARG$FLSD[0] = DB$FLSTR[I];   # AU DETAIL FLAG #
02853  M00S02827.ssdebug +++|            END
02854  M00S02828.ssdebug +++|
02855  M00S02829.ssdebug +++|          END
02856  M00S02830.ssdebug +++|
02857  M00S02831.ssdebug +++|        IF NOT FOUND
02858  M00S02832.ssdebug +++|        THEN
02859  M00S02833.ssdebug +++|          BEGIN
02860  M00S02834.ssdebug +++|          DBERRCODE = S"DVIOL$FL";
02861  M00S02835.ssdebug +++|          DBERR(DBERRCODE);
02862  M00S02836.ssdebug +++|          RETURN;
02863  M00S02837.ssdebug +++|          END
02864  M00S02838.ssdebug +++|
02865  M00S02839.ssdebug +++|        END  # CHECK *FL* #
02866  M00S02840.ssdebug +++|
02867  M00S02841.ssdebug +++|      FLAG = 0;                      # NO ERRORS DETECTED #
02868  M00S02842.ssdebug +++|      RETURN;
02869  M00S02843.ssdebug +++|
02870  M00S02844.ssdebug +++|      END  # DBOPT #
02871  M00S02845.ssdebug +++|
02872  M00S02846.ssdebug +++|    TERM
02873  M00S02847.ssdebug +++|PROC DBRDFIL;
02874  M00S02848.ssdebug +++|# TITLE DBRDFIL - PROCESS READ FILE DIRECTIVE.                        #
02875  M00S02849.ssdebug +++|
02876  M00S02850.ssdebug +++|      BEGIN  # DBRDFIL #
02877  M00S02851.ssdebug +++|
02878  M00S02852.ssdebug +++|#
02879  M00S02853.ssdebug +++|**    DBRDFIL - PROCESS READ FILE DIRECTIVE.
02880  M00S02854.ssdebug +++|*
02881  M00S02855.ssdebug +++|*     PROC DBRDFIL.
02882  M00S02856.ssdebug +++|*
02883  M00S02857.ssdebug +++|*     ENTRY     THE CRACKED AND SYNTAX CHECKED DIRECTIVE IS
02884  M00S02858.ssdebug +++|*               IN THE COMMON AREA DEFINED IN *COMTDBP*.
02885  M00S02859.ssdebug +++|*               THE CATALOG IS OPEN FOR THE SPECIFIED FAMILY
02886  M00S02860.ssdebug +++|*               AND SUBFAMILY.
02887  M00S02861.ssdebug +++|*               P<CPR>     = FWA OF CALLSS PARAMETER BLOCK.
02888  M00S02862.ssdebug +++|*               (USER$FAM) = USER-S FAMILY NAME.
02889  M00S02863.ssdebug +++|*               (USER$UI)  = USER-S USER INDEX.
02890  M00S02864.ssdebug +++|*
02891  M00S02865.ssdebug +++|*     EXIT      THE DIRECTIVE HAS BEEN PROCESSED AND
02892  M00S02866.ssdebug +++|*               THE CATALOG HAS BEEN CLOSED OR AN ERROR
02893  M00S02867.ssdebug +++|*               CONDITION HAS BEEN DETECTED.
02894  M00S02868.ssdebug +++|*
02895  M00S02869.ssdebug +++|*     MESSAGES  SSDEBUG ABNORMAL, DBRDFIL.
02896  M00S02870.ssdebug +++|*
02897  M00S02871.ssdebug +++|*     NOTES     THE CARTRIDGE IS LOADED AND A REQUEST IS SENT
02898  M00S02872.ssdebug +++|*               TO EXEC TO COPY EACH RAW AU IN THE CHAIN
02899  M00S02873.ssdebug +++|*               TO THE SPECIFIED FILE.  IF AN OFF CARTRIDGE
02900  M00S02874.ssdebug +++|*               LINK EXISTS THE NEXT CARTRIDGE IS LOADED.  THIS
02901  M00S02875.ssdebug +++|*               SEQUENCE IS REPEATED UNTIL THE ENTIRE FILE IS
02902  M00S02876.ssdebug +++|*               COPIED.  IF FROZEN CHAIN FLAG IS SET
02903  M00S02877.ssdebug +++|*               *SSDEBUG* ABORTS WITH A DAYFILE MESSAGE.
02904  M00S02878.ssdebug +++|#
02905  M00S02879.ssdebug +++|
02906  M00S02880.ssdebug +++|#
02907  M00S02881.ssdebug +++|****  PROC DBRDFIL - XREF LIST BEGIN.
02908  M00S02882.ssdebug +++|#
02909  M00S02883.ssdebug +++|
02910  M00S02884.ssdebug +++|      XREF
02911  M00S02885.ssdebug +++|        BEGIN
02912  M00S02886.ssdebug +++|        PROC CCLOSE;                 # CLOSES THE CATALOG #
02913  M00S02887.ssdebug +++|        PROC CGETFCT;                # GET *FCT* ENTRY #
02914  M00S02888.ssdebug +++|        PROC DBCALL4;                # ISSUES A TYPE 4 UCP REQUEST #
02915  M00S02889.ssdebug +++|        PROC DBERR;                  # ERROR PROCESSOR #
02916  M00S02890.ssdebug +++|        PROC DBRESP;                 # PROCESSES RESPONSE FROM EXEC #
02917  M00S02891.ssdebug +++|        PROC MESSAGE;                # DISPLAYS MESSAGES #
02918  M00S02892.ssdebug +++|        PROC PFD;                    # *PFM* REQUEST INTERFACE #
02919  M00S02893.ssdebug +++|        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
02920  M00S02894.ssdebug +++|                                       OR RETURN #
02921  M00S02895.ssdebug +++|        PROC RETERN;                 # RETURNS A FILE #
02922  M00S02896.ssdebug +++|        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
02923  M00S02897.ssdebug +++|        PROC ZSETFET;                # INITIALIZES A FET #
02924  M00S02898.ssdebug +++|        END
02925  M00S02899.ssdebug +++|
02926  M00S02900.ssdebug +++|#
02927  M00S02901.ssdebug +++|****  PROC DBRDFIL - XREF LIST END.
02928  M00S02902.ssdebug +++|#
02929  M00S02903.ssdebug +++|
02930  M00S02904.ssdebug +++|      DEF PROCNAME  #"DBRDFIL."#;    # PROC NAME #
02931  M00S02905.ssdebug +++|
02932  M00S02906.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
02933  M00S02907.ssdebug +++|*CALL COMBFAS
02934  M00S02908.ssdebug +++|*CALL COMBCMS
02935  M00S02909.ssdebug +++|*CALL COMBCPR
02936  M00S02910.ssdebug +++|*CALL COMBMCT
02937  M00S02911.ssdebug +++|*CALL COMBPFP
02938  M00S02912.ssdebug +++|*CALL COMSPFM
02939  M00S02913.ssdebug +++|*CALL COMTDBG
02940  M00S02914.ssdebug +++|*CALL COMTDBP
02941  M00S02915.ssdebug +++|*CALL COMTDER
02942  M00S02916.ssdebug +++|
02943  M00S02917.ssdebug +++|      ITEM ANOTHERVOL B;             # MORE VOLUMES ON CARTRIDGE #
02944  M00S02918.ssdebug +++|      ITEM CHNCNTRL   I;             # CHAIN CONTROL FIELD #
02945  M00S02919.ssdebug +++|      ITEM FCTBADR    I;             # FWA OF BUFFER FOR *FCT* #
02946  M00S02920.ssdebug +++|      ITEM FLAG       I;             # ERROR STATUS #
02947  M00S02921.ssdebug +++|      ITEM GTNXTCART  B;             # GET NEXT CARTRIDGE FLAG #
02948  M00S02922.ssdebug +++|      ITEM LAST       B;             # END OF CHAIN INDICATOR #
02949  M00S02923.ssdebug +++|      ITEM LINK       I;             # OFF CARTRIDGE LINK #
02950  M00S02924.ssdebug +++|      ITEM NXTFCT     I;             # NEXT *FCT* ENTRY ORDINAL #
02951  M00S02925.ssdebug +++|      ITEM NXTSTRM    I;             # NEXT AU IN THE CHAIN #
02952  M00S02926.ssdebug +++|      ITEM RESPCODE   I;             # RESPONSE FROM EXEC #
02953  M00S02927.ssdebug +++|      ITEM SH         I;             # STRIPE HIGH #
02954  M00S02928.ssdebug +++|      ITEM SL         I;             # STRIPE LOW #
02955  M00S02929.ssdebug +++|      ITEM TEMP       I;             # INTEGER SCRATCH #
02956  M00S02930.ssdebug +++|      ARRAY FCTENT [0:0] P(FCTENTL);;  # *FCT* ENTRY #
02957  M00S02931.ssdebug +++|      ARRAY SCRFET [0:0] S(SFETL);;  # SCRATCH FET #
02958  M00S02932.ssdebug +++|
02959  M00S02933.ssdebug +++|
02960  M00S02934.ssdebug +++|CONTROL EJECT;
02961  M00S02935.ssdebug +++|
02962  M00S02936.ssdebug +++|#
02963  M00S02937.ssdebug +++|*     DEFINE THE USER-S FILE TO RECEIVE THE RAW AU DATA.
02964  M00S02938.ssdebug +++|#
02965  M00S02939.ssdebug +++|
02966  M00S02940.ssdebug +++|      RESTPFP(PFP$RESUME);           # RESTORE USER-S *PFP* #
02967  M00S02941.ssdebug +++|
02968  M00S02942.ssdebug +++|      FLAG = 0;
02969  M00S02943.ssdebug +++|      PFD("DEFINE",DBARG$PF[0],0,"RC",FLAG,0);
02970  M00S02944.ssdebug +++|      IF FLAG NQ OK
02971  M00S02945.ssdebug +++|      THEN                           # UNABLE TO DEFINE USER-S FILE #
02972  M00S02946.ssdebug +++|        BEGIN
02973  M00S02947.ssdebug +++|        DBERRCODE = S"DDEF$PF";
02974  M00S02948.ssdebug +++|        DBERR(DBERRCODE);
02975  M00S02949.ssdebug +++|        RETURN;
02976  M00S02950.ssdebug +++|        END
02977  M00S02951.ssdebug +++|
02978  M00S02952.ssdebug +++|      ZSETFET(LOC(SCRFET[0]),DBARG$PF[0],0,0,SFETL);
02979  M00S02953.ssdebug +++|      RETERN(SCRFET[0],RCL);
02980  M00S02954.ssdebug +++|
02981  M00S02955.ssdebug +++|      GTNXTCART = TRUE;              # INITIALIZE THE FLAGS #
02982  M00S02956.ssdebug +++|      LINK = 0;
02983  M00S02957.ssdebug +++|      ANOTHERVOL = FALSE;
02984  M00S02958.ssdebug +++|      NXTFCT = DBARG$FO[0];
02985  M00S02959.ssdebug +++|      SL = INSPAU*DBARG$ST[0] + (INFTST - INSPAU);
02986  M00S02960.ssdebug +++|      NXTSTRM = DBARG$ST[0];
02987  M00S02961.ssdebug +++|      LAST = FALSE;
02988  M00S02962.ssdebug +++|      FCTBADR = LOC(FCTENT[0]);
02989  M00S02963.ssdebug +++|
02990  M00S02964.ssdebug +++|#
02991  M00S02965.ssdebug +++|*     COPY EACH AU OF THE FILE.
02992  M00S02966.ssdebug +++|#
02993  M00S02967.ssdebug +++|
02994  M00S02968.ssdebug +++|      REPEAT WHILE NOT LAST
02995  M00S02969.ssdebug +++|      DO
02996  M00S02970.ssdebug +++|        BEGIN  # COPY RAW AU #
02997  M00S02971.ssdebug +++|        IF GTNXTCART  ##
02998  M00S02972.ssdebug +++|          AND NOT ANOTHERVOL
02999  M00S02973.ssdebug +++|        THEN
03000  M00S02974.ssdebug +++|          BEGIN  # GET NEXT CARTRIDGE #
03001  M00S02975.ssdebug +++|          CGETFCT(DBARG$FM[0],DBARG$SB[0],DBARG$SMID[0],NXTFCT,
03002  M00S02976.ssdebug +++|            FCTBADR,0,FLAG);
03003  M00S02977.ssdebug +++|          IF FLAG NQ CMASTAT"NOERR"
03004  M00S02978.ssdebug +++|          THEN                       # UNABLE TO GET *FCT* ENTRY #
03005  M00S02979.ssdebug +++|            BEGIN
03006  M00S02980.ssdebug +++|            DBRESP(FLAG,0);
03007  M00S02981.ssdebug +++|            RETURN;
03008  M00S02982.ssdebug +++|            END
03009  M00S02983.ssdebug +++|
03010  M00S02984.ssdebug +++|#
03011  M00S02985.ssdebug +++|*     CHECK FOR FROZEN CHAIN.
03012  M00S02986.ssdebug +++|#
03013  M00S02987.ssdebug +++|
03014  M00S02988.ssdebug +++|          P<FCT> = FCTBADR;
03015  M00S02989.ssdebug +++|          IF FCT$Y[0] EQ 0 AND FCT$Z[0] EQ 0
03016  M00S02990.ssdebug +++|          THEN                    # NO CARTRIDGE FOR *FO* #
03017  M00S02991.ssdebug +++|            BEGIN
03018  M00S02992.ssdebug +++|            FLAG = CMASTAT"ORDERR";
03019  M00S02993.ssdebug +++|            DBRESP(FLAG,0);
03020  M00S02994.ssdebug +++|            END
03021  M00S02995.ssdebug +++|
03022  M00S02996.ssdebug +++|          FLAG = FCT$FRCF(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03023  M00S02997.ssdebug +++|          IF FLAG EQ 1
03024  M00S02998.ssdebug +++|          THEN                       # FROZEN CHAIN #
03025  M00S02999.ssdebug +++|            BEGIN
03026  M00S03000.ssdebug +++|            DBERRCODE = S"DFROZ$CHN";
03027  M00S03001.ssdebug +++|            DBERR(DBERRCODE);
03028  M00S03002.ssdebug +++|            RETURN;
03029  M00S03003.ssdebug +++|            END
03030  M00S03004.ssdebug +++|
03031  M00S03005.ssdebug +++|          SETFCTX(NXTSTRM);
03032  M00S03006.ssdebug +++|          TEMP = FCT$LEN(FWD,FPS);
03033  M00S03007.ssdebug +++|          SH = SL + INSPAU*TEMP + INSPAU - 1;
03034  M00S03008.ssdebug +++|
03035  M00S03009.ssdebug +++|#
03036  M00S03010.ssdebug +++|*     CHECK FOR BEGINNING OF VOLUME.
03037  M00S03011.ssdebug +++|#
03038  M00S03012.ssdebug +++|
03039  M00S03013.ssdebug +++|          FLAG = FCT$CC(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03040  M00S03014.ssdebug +++|          IF FLAG NQ CHAINCON"FIRST"  ##
03041  M00S03015.ssdebug +++|            AND FLAG NQ CHAINCON"ONLY"  ##
03042  M00S03016.ssdebug +++|            AND LINK EQ 0            # NOT CONTINUATION CARTRIDGE #
03043  M00S03017.ssdebug +++|          THEN                           # INVALID STARTING AU #
03044  M00S03018.ssdebug +++|            BEGIN
03045  M00S03019.ssdebug +++|            DBERRCODE = S"DVIOL$ST";
03046  M00S03020.ssdebug +++|            DBERR(DBERRCODE);
03047  M00S03021.ssdebug +++|            RETURN;
03048  M00S03022.ssdebug +++|            END
03049  M00S03023.ssdebug +++|
03050  M00S03024.ssdebug +++|#
03051  M00S03025.ssdebug +++|*     CHECK FOR ALLOCATED AU.
03052  M00S03026.ssdebug +++|#
03053  M00S03027.ssdebug +++|
03054  M00S03028.ssdebug +++|          FLAG = FCT$FBF(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03055  M00S03029.ssdebug +++|          IF FLAG EQ 0
03056  M00S03030.ssdebug +++|          THEN                           # AU NOT ALLOCATED #
03057  M00S03031.ssdebug +++|            BEGIN
03058  M00S03032.ssdebug +++|            DBERRCODE = S"DVIOL$ST";
03059  M00S03033.ssdebug +++|            DBERR(DBERRCODE);
03060  M00S03034.ssdebug +++|            RETURN;
03061  M00S03035.ssdebug +++|            END
03062  M00S03036.ssdebug +++|
03063  M00S03037.ssdebug +++|#
03064  M00S03038.ssdebug +++|*     CHECK FOR AU CONFLICT.
03065  M00S03039.ssdebug +++|#
03066  M00S03040.ssdebug +++|
03067  M00S03041.ssdebug +++|          FLAG = FCT$AUCF(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03068  M00S03042.ssdebug +++|          IF FLAG NQ 0
03069  M00S03043.ssdebug +++|          THEN                           # INTERSECTING CHAIN #
03070  M00S03044.ssdebug +++|            BEGIN
03071  M00S03045.ssdebug +++|            DBERRCODE = S"DVIOL$ST";
03072  M00S03046.ssdebug +++|            DBERR(DBERRCODE);
03073  M00S03047.ssdebug +++|            RETURN;
03074  M00S03048.ssdebug +++|            END
03075  M00S03049.ssdebug +++|
03076  M00S03050.ssdebug +++|#
03077  M00S03051.ssdebug +++|*     CHECK FOR START OF FRAGMENT.
03078  M00S03052.ssdebug +++|#
03079  M00S03053.ssdebug +++|
03080  M00S03054.ssdebug +++|          FLAG = FCT$SFF(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03081  M00S03055.ssdebug +++|          IF FLAG NQ 0
03082  M00S03056.ssdebug +++|          THEN                           # START OF FRAGMENT #
03083  M00S03057.ssdebug +++|            BEGIN
03084  M00S03058.ssdebug +++|            DBERRCODE = S"DVIOL$ST";
03085  M00S03059.ssdebug +++|            DBERR(DBERRCODE);
03086  M00S03060.ssdebug +++|            RETURN;
03087  M00S03061.ssdebug +++|            END
03088  M00S03062.ssdebug +++|
03089  M00S03063.ssdebug +++|#
03090  M00S03064.ssdebug +++|*     LOAD THE CARTRIDGE.
03091  M00S03065.ssdebug +++|#
03092  M00S03066.ssdebug +++|
03093  M00S03067.ssdebug +++|          P<FCT> = FCTBADR;
03094  M00S03068.ssdebug +++|          DBCALL4(REQTYP4"LOAD$CART",FCT$Y[0],FCT$Z[0],0,0,0,0,
03095  M00S03069.ssdebug +++|            RESPCODE);
03096  M00S03070.ssdebug +++|          IF RESPCODE NQ RESPTYP4"OK4"
03097  M00S03071.ssdebug +++|          THEN                       # UNABLE TO LOAD CARTRIDGE #
03098  M00S03072.ssdebug +++|            BEGIN
03099  M00S03073.ssdebug +++|            DBRESP(RESPCODE,TYP"TYP4");
03100  M00S03074.ssdebug +++|            RETURN;
03101  M00S03075.ssdebug +++|            END
03102  M00S03076.ssdebug +++|
03103  M00S03077.ssdebug +++|          TRNSPORT = CPR$DRD[0];     # SET UP TRANSPORT ID #
03104  M00S03078.ssdebug +++|          GTNXTCART = FALSE;
03105  M00S03079.ssdebug +++|          END  # GET NEXT CARTRIDGE #
03106  M00S03080.ssdebug +++|
03107  M00S03081.ssdebug +++|#
03108  M00S03082.ssdebug +++|*     COPY THE RAW AU.
03109  M00S03083.ssdebug +++|#
03110  M00S03084.ssdebug +++|
03111  M00S03085.ssdebug +++|        ANOTHERVOL = FALSE;
03112  M00S03086.ssdebug +++|        DBCALL4(REQTYP4"CP$RAW$AU",FCT$Y[0],FCT$Z[0],SL,SH,
03113  M00S03087.ssdebug +++|          USER$FAM[0],USER$UI[0],RESPCODE);
03114  M00S03088.ssdebug +++|        IF RESPCODE NQ RESPTYP4"OK4"
03115  M00S03089.ssdebug +++|        THEN                         # UNABLE TO COPY RAW AU #
03116  M00S03090.ssdebug +++|          BEGIN
03117  M00S03091.ssdebug +++|          DBRESP(RESPCODE,TYP"TYP4");
03118  M00S03092.ssdebug +++|          RETURN;
03119  M00S03093.ssdebug +++|          END
03120  M00S03094.ssdebug +++|
03121  M00S03095.ssdebug +++|#
03122  M00S03096.ssdebug +++|*     GET THE NEXT AU IN THE CHAIN.
03123  M00S03097.ssdebug +++|#
03124  M00S03098.ssdebug +++|
03125  M00S03099.ssdebug +++|        LINK = FCT$CLKOCL(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03126  M00S03100.ssdebug +++|        IF LINK NQ 0
03127  M00S03101.ssdebug +++|        THEN                         # OFF CARTRIDGE LINK TEST #
03128  M00S03102.ssdebug +++|          BEGIN  # OFF CARTRIDGE LINK EXISTS #
03129  M00S03103.ssdebug +++|          GTNXTCART = TRUE;
03130  M00S03104.ssdebug +++|          IF LINK EQ 1
03131  M00S03105.ssdebug +++|          THEN                       # USE FIRST OFF CARTRIDGE LINK #
03132  M00S03106.ssdebug +++|            BEGIN
03133  M00S03107.ssdebug +++|            NXTFCT = FCT$OCL[0] + MINFO;
03134  M00S03108.ssdebug +++|            END
03135  M00S03109.ssdebug +++|
03136  M00S03110.ssdebug +++|          IF LINK EQ 2
03137  M00S03111.ssdebug +++|          THEN                       # USE SECOND OFF CARTRIDGE LINK #
03138  M00S03112.ssdebug +++|            BEGIN
03139  M00S03113.ssdebug +++|            NXTFCT = FCT$OCL1[0] + MINFO;
03140  M00S03114.ssdebug +++|            END
03141  M00S03115.ssdebug +++|
03142  M00S03116.ssdebug +++|          IF LINK EQ 3
03143  M00S03117.ssdebug +++|          THEN                       # USE THIRD OFF CARTRIDGE LINK #
03144  M00S03118.ssdebug +++|            BEGIN
03145  M00S03119.ssdebug +++|            NXTFCT = FCT$OCL2[0] + MINFO;
03146  M00S03120.ssdebug +++|            END
03147  M00S03121.ssdebug +++|
03148  M00S03122.ssdebug +++|          DBCALL4(REQTYP4"UNLD$CART",FCT$Y[0],FCT$Z[0],0,0,0,0,
03149  M00S03123.ssdebug +++|            RESPCODE);
03150  M00S03124.ssdebug +++|          IF RESPCODE NQ RESPTYP4"OK4"
03151  M00S03125.ssdebug +++|          THEN                       # UNABLE TO UNLOAD CARTRIDGE #
03152  M00S03126.ssdebug +++|            BEGIN
03153  M00S03127.ssdebug +++|            DBRESP(RESPCODE,TYP"TYP4");
03154  M00S03128.ssdebug +++|            RETURN;
03155  M00S03129.ssdebug +++|            END
03156  M00S03130.ssdebug +++|
03157  M00S03131.ssdebug +++|          NXTSTRM = FCT$LINK(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03158  M00S03132.ssdebug +++|          SL = INSPAU*NXTSTRM + (INFTST - INSPAU);
03159  M00S03133.ssdebug +++|          END  # OFF CARTRIDGE LINK EXISTS #
03160  M00S03134.ssdebug +++|
03161  M00S03135.ssdebug +++|        IF LINK EQ 0
03162  M00S03136.ssdebug +++|        THEN                         # NO OFF CARTRIGE LINK #
03163  M00S03137.ssdebug +++|          BEGIN  # NO OFF CARTRIDGE LINK #
03164  M00S03138.ssdebug +++|          CHNCNTRL = FCT$CC(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03165  M00S03139.ssdebug +++|          IF CHNCNTRL EQ CHAINCON"LAST"  ##
03166  M00S03140.ssdebug +++|            OR CHNCNTRL EQ CHAINCON"ONLY"
03167  M00S03141.ssdebug +++|          THEN                      # END OF CHAIN #
03168  M00S03142.ssdebug +++|            BEGIN
03169  M00S03143.ssdebug +++|            LAST = TRUE;
03170  M00S03144.ssdebug +++|            TEST DUMMY;
03171  M00S03145.ssdebug +++|            END
03172  M00S03146.ssdebug +++|
03173  M00S03147.ssdebug +++|          NXTSTRM = FCT$LINK(FCT$WD(NXTSTRM),FCT$WP(NXTSTRM));
03174  M00S03148.ssdebug +++|          SL = INSPAU*NXTSTRM + (INFTST - INSPAU);
03175  M00S03149.ssdebug +++|          SETFCTX(NXTSTRM);
03176  M00S03150.ssdebug +++|          TEMP = FCT$LEN(FWD,FPS);
03177  M00S03151.ssdebug +++|          SH = SL + INSPAU*TEMP + INSPAU - 1;
03178  M00S03152.ssdebug +++|          ANOTHERVOL = TRUE;
03179  M00S03153.ssdebug +++|          END  # NO OFF CARTRIDGE LINK #
03180  M00S03154.ssdebug +++|
03181  M00S03155.ssdebug +++|        END  # COPY RAW AU #
03182  M00S03156.ssdebug +++|
03183  M00S03157.ssdebug +++|#
03184  M00S03158.ssdebug +++|*     UNLOAD THE CARTRIDGE.
03185  M00S03159.ssdebug +++|#
03186  M00S03160.ssdebug +++|
03187  M00S03161.ssdebug +++|      DBCALL4(REQTYP4"UNLD$CART",FCT$Y[0],FCT$Z[0],0,0,0,0,
03188  M00S03162.ssdebug +++|        RESPCODE);
03189  M00S03163.ssdebug +++|      IF RESPCODE NQ RESPTYP4"OK4"
03190  M00S03164.ssdebug +++|      THEN                           # PROCESS ERROR RESPONSE #
03191  M00S03165.ssdebug +++|        BEGIN
03192  M00S03166.ssdebug +++|        DBRESP(RESPCODE,TYP"TYP4");
03193  M00S03167.ssdebug +++|        RETURN;
03194  M00S03168.ssdebug +++|        END
03195  M00S03169.ssdebug +++|
03196  M00S03170.ssdebug +++|      CCLOSE(DBARG$FM[0],DBARG$SB[0],0,FLAG);
03197  M00S03171.ssdebug +++|      IF FLAG NQ CMASTAT"NOERR"
03198  M00S03172.ssdebug +++|      THEN                           # UNABLE TO CLOSE CATALOG #
03199  M00S03173.ssdebug +++|        BEGIN
03200  M00S03174.ssdebug +++|        DBRESP(FLAG,0);
03201  M00S03175.ssdebug +++|        END
03202  M00S03176.ssdebug +++|
03203  M00S03177.ssdebug +++|      RETURN;
03204  M00S03178.ssdebug +++|
03205  M00S03179.ssdebug +++|      END  # DBRDFILE #
03206  M00S03180.ssdebug +++|
03207  M00S03181.ssdebug +++|    TERM
03208  M00S03182.ssdebug +++|PROC DBRDSTM;
03209  M00S03183.ssdebug +++|# TITLE DBRDSTM - PROCESS READ AU DIRECTIVE.                      #
03210  M00S03184.ssdebug +++|
03211  M00S03185.ssdebug +++|      BEGIN  # DBRDSTM #
03212  M00S03186.ssdebug +++|
03213  M00S03187.ssdebug +++|#
03214  M00S03188.ssdebug +++|**    DBRDSTM - PROCESS READ AU DIRECTIVE.
03215  M00S03189.ssdebug +++|*
03216  M00S03190.ssdebug +++|*     PROC DBRDSTM.
03217  M00S03191.ssdebug +++|*
03218  M00S03192.ssdebug +++|*     ENTRY     THE CRACKED AND SYNTAX CHECKED DIRECTIVE IS
03219  M00S03193.ssdebug +++|*               IN THE COMMON AREA DEFINED IN *COMTDBG*.
03220  M00S03194.ssdebug +++|*               THE MAP FOR THE SPECIFIED SM IS OPEN.
03221  M00S03195.ssdebug +++|*               P<CPR>     = FWA OF CALLSS PARAMETER BLOCK.
03222  M00S03196.ssdebug +++|*               (USER$FAM) = USER-S FAMILY NAME.
03223  M00S03197.ssdebug +++|*               (USER$UI)  = USER-S USER INDEX.
03224  M00S03198.ssdebug +++|*
03225  M00S03199.ssdebug +++|*     EXIT      THE DIRECTIVE HAS BEEN PROCESSED AND
03226  M00S03200.ssdebug +++|*               THE MAP HAS BEEN CLOSED OR AN ERROR
03227  M00S03201.ssdebug +++|*               CONDITION HAS BEEN DETECTED.
03228  M00S03202.ssdebug +++|*
03229  M00S03203.ssdebug +++|*     MESSAGES  SSDEBUG ABNORMAL, DBRDSTM.
03230  M00S03204.ssdebug +++|*
03231  M00S03205.ssdebug +++|*     NOTES     THE SPECIFIED CARTRIDGE IS LOADED AND A REQUEST
03232  M00S03206.ssdebug +++|*               IS SENT TO EXEC TO COPY EACH SELECTED AU TO
03233  M00S03207.ssdebug +++|*               THE SPECIFIED FILE.
03234  M00S03208.ssdebug +++|#
03235  M00S03209.ssdebug +++|
03236  M00S03210.ssdebug +++|#
03237  M00S03211.ssdebug +++|****  PROC DBRDSTM - XREF LIST BEGIN.
03238  M00S03212.ssdebug +++|#
03239  M00S03213.ssdebug +++|
03240  M00S03214.ssdebug +++|      XREF
03241  M00S03215.ssdebug +++|        BEGIN
03242  M00S03216.ssdebug +++|        PROC DBCALL4;                # ISSUES TYPE 4 UCP REQUEST #
03243  M00S03217.ssdebug +++|        PROC DBERR;                  # ERROR PROCESSOR #
03244  M00S03218.ssdebug +++|        PROC DBRESP;                 # PROCESSES RESPONSE FROM EXEC #
03245  M00S03219.ssdebug +++|        PROC DBVSN;                  # SEARCH SM MAP FOR A VSN #
03246  M00S03220.ssdebug +++|        PROC MCLOSE;                 # CLOSES SMMAP #
03247  M00S03221.ssdebug +++|        PROC MESSAGE;                # DISPLAYS MESSAGES #
03248  M00S03222.ssdebug +++|        PROC PFD;                    # *PFM* REQUEST INTERFACE #
03249  M00S03223.ssdebug +++|        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
03250  M00S03224.ssdebug +++|                                       OR RETURN #
03251  M00S03225.ssdebug +++|        PROC RETERN;                 # RETURNS A FILE #
03252  M00S03226.ssdebug +++|        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
03253  M00S03227.ssdebug +++|        PROC ZSETFET;                # INITIALIZES A FET #
03254  M00S03228.ssdebug +++|        END
03255  M00S03229.ssdebug +++|
03256  M00S03230.ssdebug +++|#
03257  M00S03231.ssdebug +++|****  PROC DBRDSTM - XREF LIST END.
03258  M00S03232.ssdebug +++|#
03259  M00S03233.ssdebug +++|
03260  M00S03234.ssdebug +++|      DEF PROCNAME  #"DBRDSTM."#;    # PROC NAME #
03261  M00S03235.ssdebug +++|
03262  M00S03236.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
03263  M00S03237.ssdebug +++|*CALL COMBFAS
03264  M00S03238.ssdebug +++|*CALL COMBCMS
03265  M00S03239.ssdebug +++|*CALL COMBCPR
03266  M00S03240.ssdebug +++|*CALL COMBMAP
03267  M00S03241.ssdebug +++|*CALL COMBPFP
03268  M00S03242.ssdebug +++|*CALL COMSPFM
03269  M00S03243.ssdebug +++|*CALL COMTDBG
03270  M00S03244.ssdebug +++|*CALL COMTDBP
03271  M00S03245.ssdebug +++|*CALL COMTDER
03272  M00S03246.ssdebug +++|
03273  M00S03247.ssdebug +++|      ITEM FLAG       I;             # ERROR STATUS #
03274  M00S03248.ssdebug +++|      ITEM I          I;             # LOOP INDUCTION VARIABLE #
03275  M00S03249.ssdebug +++|      ITEM RESPCODE   I;             # RESPONSE CODE #
03276  M00S03250.ssdebug +++|      ITEM STRIPELO   I;             # INITIAL STRIPE #
03277  M00S03251.ssdebug +++|      ITEM STRIPEHI   I;             # LAST STRIPE #
03278  M00S03252.ssdebug +++|      ITEM Y          I;             # Y COORDINATE #
03279  M00S03253.ssdebug +++|      ITEM Z          I;             # Z COORDINATE #
03280  M00S03254.ssdebug +++|
03281  M00S03255.ssdebug +++|      ARRAY CMAPENT [0:0] P(MAPENTL);;  # SMMAP ENTRY #
03282  M00S03256.ssdebug +++|      ARRAY SCRFET [0:0] S(SFETL);;  # SCRATCH FET #
03283  M00S03257.ssdebug +++|
03284  M00S03258.ssdebug +++|CONTROL EJECT;
03285  M00S03259.ssdebug +++|
03286  M00S03260.ssdebug +++|#
03287  M00S03261.ssdebug +++|*     DEFINE THE USER-S FILE TO RECEIVE THE RAW AU DATA.
03288  M00S03262.ssdebug +++|#
03289  M00S03263.ssdebug +++|
03290  M00S03264.ssdebug +++|      RESTPFP(PFP$RESUME);           # RESTORE USER-S *PFP* #
03291  M00S03265.ssdebug +++|
03292  M00S03266.ssdebug +++|      FLAG = 0;
03293  M00S03267.ssdebug +++|      PFD("DEFINE",DBARG$PF[0],0,"RC",FLAG,0);
03294  M00S03268.ssdebug +++|      IF FLAG NQ OK
03295  M00S03269.ssdebug +++|      THEN                           # UNABLE TO DEFINE USER-S FILE #
03296  M00S03270.ssdebug +++|        BEGIN
03297  M00S03271.ssdebug +++|        DBERRCODE = S"DDEF$PF";
03298  M00S03272.ssdebug +++|        DBERR(DBERRCODE);
03299  M00S03273.ssdebug +++|        RETURN;
03300  M00S03274.ssdebug +++|        END
03301  M00S03275.ssdebug +++|
03302  M00S03276.ssdebug +++|      ZSETFET(LOC(SCRFET[0]),DBARG$PF[0],0,0,SFETL);
03303  M00S03277.ssdebug +++|      RETERN(SCRFET[0],RCL);
03304  M00S03278.ssdebug +++|
03305  M00S03279.ssdebug +++|#
03306  M00S03280.ssdebug +++|*     LOCATE THE CARTRIDGE.
03307  M00S03281.ssdebug +++|#
03308  M00S03282.ssdebug +++|
03309  M00S03283.ssdebug +++|      Y = DBARG$YI[0];               # COORDINATES SPECIFIED, IF ANY #
03310  M00S03284.ssdebug +++|      Z = DBARG$ZI[0];
03311  M00S03285.ssdebug +++|
03312  M00S03286.ssdebug +++|      IF DBARG$D[0] GQ -1
03313  M00S03287.ssdebug +++|      THEN                           # CARTRIDGE IN INPUT DRAWER #
03314  M00S03288.ssdebug +++|        BEGIN
03315  M00S03289.ssdebug +++|        Z = SM$ENT$TY;                # SET ENTRY TRAY #
03316  M00S03290.ssdebug +++|        Y = 0;
03317  M00S03291.ssdebug +++|        END
03318  M00S03292.ssdebug +++|
03319  M00S03293.ssdebug +++|      IF DBARG$WCN[0] NQ 0
03320  M00S03294.ssdebug +++|      THEN
03321  M00S03295.ssdebug +++|        BEGIN  # SEARCH SMMAP FOR THE VSN #
03322  M00S03296.ssdebug +++|        DBVSN(Y,Z,CMAPENT[0],FLAG);
03323  M00S03297.ssdebug +++|        IF FLAG NQ OK
03324  M00S03298.ssdebug +++|        THEN                         # VSN NOT FOUND #
03325  M00S03299.ssdebug +++|          BEGIN
03326  M00S03300.ssdebug +++|          DBERRCODE = S"DVSN$NFND";
03327  M00S03301.ssdebug +++|          DBERR(DBERRCODE);
03328  M00S03302.ssdebug +++|          RETURN;
03329  M00S03303.ssdebug +++|          END
03330  M00S03304.ssdebug +++|
03331  M00S03305.ssdebug +++|        END  # SEARCH SMMAP FOR THE VSN #
03332  M00S03306.ssdebug +++|
03333  M00S03307.ssdebug +++|#
03334  M00S03308.ssdebug +++|*     LOAD THE CARTRIDGE.
03335  M00S03309.ssdebug +++|#
03336  M00S03310.ssdebug +++|
03337  M00S03311.ssdebug +++|      DBCALL4(REQTYP4"LOAD$CART",Y,Z,0,0,0,0,RESPCODE);
03338  M00S03312.ssdebug +++|      IF RESPCODE NQ RESPTYP4"OK4"
03339  M00S03313.ssdebug +++|      THEN                           # UNABLE TO LOAD CARTRIDGE #
03340  M00S03314.ssdebug +++|        BEGIN
03341  M00S03315.ssdebug +++|        DBRESP(RESPCODE,TYP"TYP4");
03342  M00S03316.ssdebug +++|        RETURN;
03343  M00S03317.ssdebug +++|        END
03344  M00S03318.ssdebug +++|
03345  M00S03319.ssdebug +++|      TRNSPORT = CPR$DRD[0];         # SET UP TRANSPORT ID #
03346  M00S03320.ssdebug +++|
03347  M00S03321.ssdebug +++|#
03348  M00S03322.ssdebug +++|*     COPY EACH OF THE SELECTED RAW AU.
03349  M00S03323.ssdebug +++|#
03350  M00S03324.ssdebug +++|
03351  M00S03325.ssdebug +++|      STRIPELO = INSPAU*DBARG$SL[0] + ( INFTST - INSPAU );
03352  M00S03326.ssdebug +++|      STRIPEHI = INSPAU*(DBARG$SU[0] - DBARG$SL[0] + 1) + STRIPELO - 1;
03353  M00S03327.ssdebug +++|      DBCALL4(REQTYP4"CP$RAW$AU",Y,Z,STRIPELO,STRIPEHI,USER$FAM[0],
03354  M00S03328.ssdebug +++|        USER$UI[0],RESPCODE);
03355  M00S03329.ssdebug +++|
03356  M00S03330.ssdebug +++|#
03357  M00S03331.ssdebug +++|*     UNLOAD THE CARTRIDGE.
03358  M00S03332.ssdebug +++|#
03359  M00S03333.ssdebug +++|
03360  M00S03334.ssdebug +++|      DBCALL4(REQTYP4"UNLD$CART",Y,Z,0,0,0,0,RESPCODE);
03361  M00S03335.ssdebug +++|      IF RESPCODE NQ RESPTYP4"OK4"
03362  M00S03336.ssdebug +++|      THEN                           # UNABLE TO UNLOAD CARTRIDGE #
03363  M00S03337.ssdebug +++|        BEGIN
03364  M00S03338.ssdebug +++|        DBRESP(RESPCODE,TYP"TYP4");
03365  M00S03339.ssdebug +++|        RETURN;
03366  M00S03340.ssdebug +++|        END
03367  M00S03341.ssdebug +++|
03368  M00S03342.ssdebug +++|      IF DBARG$WCN[0] NQ 0
03369  M00S03343.ssdebug +++|      THEN                           # MAP OPENED #
03370  M00S03344.ssdebug +++|        BEGIN
03371  M00S03345.ssdebug +++|        MCLOSE(DBARG$SMID[0],FLAG);
03372  M00S03346.ssdebug +++|        IF FLAG NQ CMASTAT"NOERR"
03373  M00S03347.ssdebug +++|        THEN                         # UNABLE TO CLOSE SMMAP #
03374  M00S03348.ssdebug +++|          BEGIN
03375  M00S03349.ssdebug +++|          DBRESP(FLAG,0);
03376  M00S03350.ssdebug +++|          END
03377  M00S03351.ssdebug +++|
03378  M00S03352.ssdebug +++|        END
03379  M00S03353.ssdebug +++|
03380  M00S03354.ssdebug +++|      RETURN;
03381  M00S03355.ssdebug +++|
03382  M00S03356.ssdebug +++|      END  # DBRDSTM #
03383  M00S03357.ssdebug +++|
03384  M00S03358.ssdebug +++|    TERM
03385  M00S03359.ssdebug +++|PROC DBREL;
03386  M00S03360.ssdebug +++|# TITLE DBREL - RELEASE PROBLEM CHAIN AND CLEAR FLAGS.                #
03387  M00S03361.ssdebug +++|
03388  M00S03362.ssdebug +++|      BEGIN  # DBREL #
03389  M00S03363.ssdebug +++|
03390  M00S03364.ssdebug +++|#
03391  M00S03365.ssdebug +++|**    DBREL - RELEASE PROBLEM CHAIN AND CLEAR FLAGS.
03392  M00S03366.ssdebug +++|*
03393  M00S03367.ssdebug +++|*     PROC DBREL.
03394  M00S03368.ssdebug +++|*
03395  M00S03369.ssdebug +++|*     ENTRY   THE CRACKED AND SYNTAX CHECKED DIRECTIVE PARAMETERS
03396  M00S03370.ssdebug +++|*             ARE IN THE COMMON AREA DEFINED IN *COMTDBP*.
03397  M00S03371.ssdebug +++|*             THE CATALOG IS OPEN FOR THE SPECIFIED FAMILY AND
03398  M00S03372.ssdebug +++|*             SUBFAMILY.
03399  M00S03373.ssdebug +++|*             P<CPR> = FWA OF CALLSS PARAMETER BLOCK.
03400  M00S03374.ssdebug +++|*
03401  M00S03375.ssdebug +++|*     EXIT    THE DIRECTIVE HAS BEEN PROCESSED AND THE
03402  M00S03376.ssdebug +++|*             CATALOG HAS BEEN CLOSED OR AN ERROR CONDI-
03403  M00S03377.ssdebug +++|*             TION HAS BEEN DETECTED.
03404  M00S03378.ssdebug +++|*
03405  M00S03379.ssdebug +++|*     NOTES   THE SELECTED *FCT* ENTRY IS CHECKED FOR THE
03406  M00S03380.ssdebug +++|*             FROZEN CHAIN FLAG AND IF SET, A REQUEST IS
03407  M00S03381.ssdebug +++|*             SENT TO EXEC TO RELEASE THE PROBLEM CHAIN.
03408  M00S03382.ssdebug +++|#
03409  M00S03383.ssdebug +++|
03410  M00S03384.ssdebug +++|#
03411  M00S03385.ssdebug +++|****  PROC DBREL - XREF LIST BEGIN.
03412  M00S03386.ssdebug +++|#
03413  M00S03387.ssdebug +++|
03414  M00S03388.ssdebug +++|      XREF
03415  M00S03389.ssdebug +++|        BEGIN
03416  M00S03390.ssdebug +++|        PROC CCLOSE;                 # CLOSES THE CATALOG #
03417  M00S03391.ssdebug +++|        PROC CGETFCT;                # GET *FCT* ENTRY #
03418  M00S03392.ssdebug +++|        PROC DBCALL3;                # ISSUES A TYPE 3 UCP REQUEST #
03419  M00S03393.ssdebug +++|        PROC DBERR;                  # ERROR PROCESSOR #
03420  M00S03394.ssdebug +++|        PROC DBRESP;                 # PROCESS RESPONSE FROM EXEC #
03421  M00S03395.ssdebug +++|        END
03422  M00S03396.ssdebug +++|
03423  M00S03397.ssdebug +++|#
03424  M00S03398.ssdebug +++|****  PROC DBREL - XREF LIST END.
03425  M00S03399.ssdebug +++|#
03426  M00S03400.ssdebug +++|
03427  M00S03401.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
03428  M00S03402.ssdebug +++|*CALL COMBFAS
03429  M00S03403.ssdebug +++|*CALL COMBCMS
03430  M00S03404.ssdebug +++|*CALL COMBCPR
03431  M00S03405.ssdebug +++|*CALL COMBMCT
03432  M00S03406.ssdebug +++|*CALL COMTDBG
03433  M00S03407.ssdebug +++|*CALL COMTDBP
03434  M00S03408.ssdebug +++|*CALL COMTDER
03435  M00S03409.ssdebug +++|
03436  M00S03410.ssdebug +++|      ITEM FCTBADR    I;             # FWA OF BUFFER FOR *FCT* #
03437  M00S03411.ssdebug +++|      ITEM FLAG       I;             # ERROR STATUS #
03438  M00S03412.ssdebug +++|      ITEM RESPCODE   I;             # RESPONSE FROM EXEC #
03439  M00S03413.ssdebug +++|
03440  M00S03414.ssdebug +++|      ARRAY FCTENT [0:0] P(FCTENTL);;  # *FCT* ENTRY #
03441  M00S03415.ssdebug +++|
03442  M00S03416.ssdebug +++|CONTROL EJECT;
03443  M00S03417.ssdebug +++|
03444  M00S03418.ssdebug +++|#
03445  M00S03419.ssdebug +++|*     CHECK THE FROZEN CHAIN FLAG IN THE *FCT* ENTRY.
03446  M00S03420.ssdebug +++|#
03447  M00S03421.ssdebug +++|
03448  M00S03422.ssdebug +++|      FCTBADR = LOC(FCTENT[0]);
03449  M00S03423.ssdebug +++|      CGETFCT(DBARG$FM[0],DBARG$SB[0],DBARG$SMID[0],DBARG$FO[0],
03450  M00S03424.ssdebug +++|        FCTBADR,0,FLAG);
03451  M00S03425.ssdebug +++|      IF FLAG NQ CMASTAT"NOERR"
03452  M00S03426.ssdebug +++|      THEN                           # UNABLE TO GET *FCT* ENTRY #
03453  M00S03427.ssdebug +++|        BEGIN
03454  M00S03428.ssdebug +++|        DBRESP(FLAG,0);
03455  M00S03429.ssdebug +++|        RETURN;
03456  M00S03430.ssdebug +++|        END
03457  M00S03431.ssdebug +++|
03458  M00S03432.ssdebug +++|      P<FCT> = FCTBADR;
03459  M00S03433.ssdebug +++|      FLAG = FCT$FRCF(FCT$WD(DBARG$ST[0]),FCT$WP(DBARG$ST[0]));
03460  M00S03434.ssdebug +++|      IF FLAG EQ 0
03461  M00S03435.ssdebug +++|      THEN                           # FROZEN CHAIN FLAG NOT SET #
03462  M00S03436.ssdebug +++|        BEGIN
03463  M00S03437.ssdebug +++|        DBERRCODE = S"DFROZ$NSET";
03464  M00S03438.ssdebug +++|        DBERR(DBERRCODE);
03465  M00S03439.ssdebug +++|        RETURN;
03466  M00S03440.ssdebug +++|        END
03467  M00S03441.ssdebug +++|
03468  M00S03442.ssdebug +++|#
03469  M00S03443.ssdebug +++|*     RELEASE FROZEN CHAIN.
03470  M00S03444.ssdebug +++|#
03471  M00S03445.ssdebug +++|
03472  M00S03446.ssdebug +++|      DBCALL3(REQTYP3"PURG$FRAG",0,DBARG$FO[0],0,0,RESPCODE);
03473  M00S03447.ssdebug +++|      IF RESPCODE NQ RESPTYP3"OK3"
03474  M00S03448.ssdebug +++|      THEN                           # UNABLE TO RELEASE FROZEN CHAIN #
03475  M00S03449.ssdebug +++|        BEGIN
03476  M00S03450.ssdebug +++|        DBRESP(RESPCODE,TYP"TYP3");
03477  M00S03451.ssdebug +++|        RETURN;
03478  M00S03452.ssdebug +++|        END
03479  M00S03453.ssdebug +++|
03480  M00S03454.ssdebug +++|      CCLOSE(DBARG$FM[0],DBARG$SB[0],0,FLAG);
03481  M00S03455.ssdebug +++|      IF FLAG NQ CMASTAT"NOERR"
03482  M00S03456.ssdebug +++|      THEN                           # UNABLE TO CLOSE CATALOG #
03483  M00S03457.ssdebug +++|        BEGIN
03484  M00S03458.ssdebug +++|        DBRESP(FLAG,0);
03485  M00S03459.ssdebug +++|        END
03486  M00S03460.ssdebug +++|
03487  M00S03461.ssdebug +++|      RETURN;
03488  M00S03462.ssdebug +++|
03489  M00S03463.ssdebug +++|      END  # DBREL #
03490  M00S03464.ssdebug +++|
03491  M00S03465.ssdebug +++|    TERM
03492  M00S03466.ssdebug +++|PROC DBRESP((RESPCODE),(REQTYPE));
03493  M00S03467.ssdebug +++|# TITLE DBRESP - PROCESS RESPONSE FROM EXEC.                          #
03494  M00S03468.ssdebug +++|
03495  M00S03469.ssdebug +++|      BEGIN  # DBRESP #
03496  M00S03470.ssdebug +++|
03497  M00S03471.ssdebug +++|#
03498  M00S03472.ssdebug +++|**    DBRESP - PROCESS RESPONSE FROM EXEC.
03499  M00S03473.ssdebug +++|*
03500  M00S03474.ssdebug +++|*     PROC DBRESP((RESPCODE),(REQTYPE))
03501  M00S03475.ssdebug +++|*
03502  M00S03476.ssdebug +++|*     ENTRY    (RESPCODE) = RESPONSE CODE FROM EXEC.
03503  M00S03477.ssdebug +++|*              (REQTYPE)  = TYPE OF REQUEST SENT TO EXEC.
03504  M00S03478.ssdebug +++|*                           0, FOR MAP/CATALOG ACCESS ROUTINES.
03505  M00S03479.ssdebug +++|*
03506  M00S03480.ssdebug +++|*     EXIT     THE ERROR RESPONSE HAS BEEN PROCESSED.
03507  M00S03481.ssdebug +++|*
03508  M00S03482.ssdebug +++|*     MESSAGES SSDEBUG ABNORMAL, DBRESP.
03509  M00S03483.ssdebug +++|*
03510  M00S03484.ssdebug +++|*     NOTES    *SSDEBUG* ERROR PROCESSOR IS CALLED WITH THE
03511  M00S03485.ssdebug +++|*              CORRESPONDING ERROR CODE.
03512  M00S03486.ssdebug +++|#
03513  M00S03487.ssdebug +++|
03514  M00S03488.ssdebug +++|      ITEM RESPCODE   I;             # RESPONSE CODE FROM EXEC #
03515  M00S03489.ssdebug +++|      ITEM REQTYPE    I;             # TYPE OF REQUEST SENT TO EXEC #
03516  M00S03490.ssdebug +++|
03517  M00S03491.ssdebug +++|#
03518  M00S03492.ssdebug +++|****  PROC DBRESP - XREF LIST BEGIN.
03519  M00S03493.ssdebug +++|#
03520  M00S03494.ssdebug +++|
03521  M00S03495.ssdebug +++|      XREF
03522  M00S03496.ssdebug +++|        BEGIN
03523  M00S03497.ssdebug +++|        PROC DBERR;                  # ERROR PROCESSOR #
03524  M00S03498.ssdebug +++|        PROC MESSAGE;                # DISPLAYS MESSAGE #
03525  M00S03499.ssdebug +++|        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
03526  M00S03500.ssdebug +++|                                       OR RETURN #
03527  M00S03501.ssdebug +++|        END
03528  M00S03502.ssdebug +++|
03529  M00S03503.ssdebug +++|#
03530  M00S03504.ssdebug +++|****  PROC DBRESP - XREF LIST END.
03531  M00S03505.ssdebug +++|#
03532  M00S03506.ssdebug +++|
03533  M00S03507.ssdebug +++|      DEF PROCNAME  #"DBRESP."#;     # PROC NAME #
03534  M00S03508.ssdebug +++|
03535  M00S03509.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
03536  M00S03510.ssdebug +++|*CALL COMBFAS
03537  M00S03511.ssdebug +++|*CALL COMBCMS
03538  M00S03512.ssdebug +++|*CALL COMBCPR
03539  M00S03513.ssdebug +++|*CALL COMTDBG
03540  M00S03514.ssdebug +++|*CALL COMTDER
03541  M00S03515.ssdebug +++|
03542  M00S03516.ssdebug +++|#
03543  M00S03517.ssdebug +++|*     STATUS SWITCH TO PROCESS THE RESPONSE CODES RETURNED
03544  M00S03518.ssdebug +++|*     IN RESPONSE TO A TYPE 3 UCP REQUEST.
03545  M00S03519.ssdebug +++|#
03546  M00S03520.ssdebug +++|
03547  M00S03521.ssdebug +++|      SWITCH RESPACT3: RESPTYP3      # TYPE 3 RESPONSE CODES #
03548  M00S03522.ssdebug +++|              OK3$ACT: OK3,          # NO ERROR #
03549  M00S03523.ssdebug +++|           INTLCK$ACT: C$M$INTLCK,   # CATALOG/MAP INTERLOCKED #
03550  M00S03524.ssdebug +++|            NOPEN$ACT: C$M$NOPEN,    # CATALOG/MAP NOT OPEN #
03551  M00S03525.ssdebug +++|            RESUB$ACT: RESUB$REQ,    # RESUBMIT REQUEST #
03552  M00S03526.ssdebug +++|           SCATEX$ACT: SUB$CAT$EX,   # SUBCATALOG ALREADY EYISTS #
03553  M00S03527.ssdebug +++|            NOSUB$ACT: NO$SUB$CAT,   # NO SUCH SUBCATALOG #
03554  M00S03528.ssdebug +++|           PFPROB$ACT: PF$PROB,      # PF PROBLEM #
03555  M00S03529.ssdebug +++|           NEMPTY$ACT: MSC$NEMPTY,   # MSC NOT EMPTY #
03556  M00S03530.ssdebug +++|           ILLORD$ACT:ILLEG$ORD,     # ORDINAL OUT OF RANGE #
03557  M00S03531.ssdebug +++|            NFROZ$ACT: NFROZ$FRAG,   # NON FROZEN FRAGMENT #
03558  M00S03532.ssdebug +++|            GR$FL$ACT: GROUP$FUL;    # GROUP FULL STATUS #
03559  M00S03533.ssdebug +++|
03560  M00S03534.ssdebug +++|#
03561  M00S03535.ssdebug +++|*     STATUS SWITCH TO PROCESS THE RESPONSE CODES
03562  M00S03536.ssdebug +++|*     RETURNED IN RESPONSE TO A TYPE 4 UCP REQUEST.
03563  M00S03537.ssdebug +++|#
03564  M00S03538.ssdebug +++|
03565  M00S03539.ssdebug +++|      SWITCH RESPACT4: RESPTYP4      # TYPE 4 RESPONSE CODES #
03566  M00S03540.ssdebug +++|              OK4$ACT: OK4,          # NO ERROR #
03567  M00S03541.ssdebug +++|          CSN$MIS$ACT: CART$LB$ERR,  # PART OF LABEL MATCHED #
03568  M00S03542.ssdebug +++|          CSN$USE$ACT: CSN$IN$USE,   # CSN IN USE #
03569  M00S03543.ssdebug +++|         CELL$EMP$ACT: CELL$EMP,     # SPECIFIED CELL EMPTY #
03570  M00S03544.ssdebug +++|         CELL$FLL$ACT: CELL$FULL,    # SPECIFIED CELL FULL #
03571  M00S03545.ssdebug +++|         EX$DMARK$ACT: EX$DMARK,     # EXCESSIVE DMARKS #
03572  M00S03546.ssdebug +++|         UNK$CART$ACT: UNK$CART,     # NO CARTRIDGE LABEL MATCH #
03573  M00S03547.ssdebug +++|           URDERR$ACT: UN$RD$ERR,    # UNRECOVERABLE READ ERROR #
03574  M00S03548.ssdebug +++|           UWTERR$ACT: UN$WRT$ERR,   # UNRECOVERABLE WRITE ERROR #
03575  M00S03549.ssdebug +++|          VOL$ERR$ACT: VOL$HD$ERR,   # VOLUME HEADER ERROR #
03576  M00S03550.ssdebug +++|         M86HW$PR$ACT: M86$HDW$PR,   # M860 HARDWARE PROBLEM #
03577  M00S03551.ssdebug +++|            RMSER$ACT: RMS$FL$ERR,   # DISK FILE ERROR #
03578  M00S03552.ssdebug +++|           DSKFUL$ACT: DISK$FULL,    # DISK FULL #
03579  M00S03553.ssdebug +++|            ATTER$ACT: ATTACH$ERR,   # ATTACH ERROR #
03580  M00S03554.ssdebug +++|          SMA$OFF$ACT: SMA$OFF,      # SM IS OFF #
03581  M00S03555.ssdebug +++|              EOI$ACT: EOI;          # END OF INFORMATION ON FILE #
03582  M00S03556.ssdebug +++|
03583  M00S03557.ssdebug +++|CONTROL EJECT;
03584  M00S03558.ssdebug +++|
03585  M00S03559.ssdebug +++|#
03586  M00S03560.ssdebug +++|*     CHECK THE RESPONSE TYPE.
03587  M00S03561.ssdebug +++|#
03588  M00S03562.ssdebug +++|
03589  M00S03563.ssdebug +++|      IF REQTYPE EQ TYP"TYP3"
03590  M00S03564.ssdebug +++|      THEN                           # TYPE 3 UCP REQUEST #
03591  M00S03565.ssdebug +++|        BEGIN
03592  M00S03566.ssdebug +++|        GOTO RESPACT3[RESPCODE];
03593  M00S03567.ssdebug +++|        END
03594  M00S03568.ssdebug +++|
03595  M00S03569.ssdebug +++|      IF REQTYPE EQ TYP"TYP4"
03596  M00S03570.ssdebug +++|      THEN                           # TYPE 4 UCP REQUEST #
03597  M00S03571.ssdebug +++|        BEGIN
03598  M00S03572.ssdebug +++|        GOTO RESPACT4[RESPCODE];
03599  M00S03573.ssdebug +++|        END
03600  M00S03574.ssdebug +++|
03601  M00S03575.ssdebug +++|      IF REQTYPE NQ 0
03602  M00S03576.ssdebug +++|      THEN                           # ILLEGAL ERROR TYPE #
03603  M00S03577.ssdebug +++|        BEGIN
03604  M00S03578.ssdebug +++|        GOTO ERR;
03605  M00S03579.ssdebug +++|        END
03606  M00S03580.ssdebug +++|
03607  M00S03581.ssdebug +++|#
03608  M00S03582.ssdebug +++|*     PROCESS RESPONSE FROM CATALOG/MAP ACCESS ROUTINES.
03609  M00S03583.ssdebug +++|#
03610  M00S03584.ssdebug +++|
03611  M00S03585.ssdebug +++|      IF RESPCODE EQ CMASTAT"INTLK"
03612  M00S03586.ssdebug +++|      THEN                           # CATALOG/MAP INTERLOCKED #
03613  M00S03587.ssdebug +++|        BEGIN
03614  M00S03588.ssdebug +++|        DBERRCODE = S"DC$M$INTLK";
03615  M00S03589.ssdebug +++|        DBERR(DBERRCODE);
03616  M00S03590.ssdebug +++|        RETURN;
03617  M00S03591.ssdebug +++|        END
03618  M00S03592.ssdebug +++|
03619  M00S03593.ssdebug +++|      IF RESPCODE EQ CMASTAT"ATTERR"
03620  M00S03594.ssdebug +++|      THEN                           # ATTACH ERROR #
03621  M00S03595.ssdebug +++|        BEGIN
03622  M00S03596.ssdebug +++|        DBERRCODE = S"DPF$PROB";
03623  M00S03597.ssdebug +++|        DBERR(DBERRCODE);
03624  M00S03598.ssdebug +++|        RETURN;
03625  M00S03599.ssdebug +++|        END
03626  M00S03600.ssdebug +++|
03627  M00S03601.ssdebug +++|      IF RESPCODE EQ CMASTAT"NOSUBCAT"
03628  M00S03602.ssdebug +++|      THEN                           # NO SUCH SUBCATALOG #
03629  M00S03603.ssdebug +++|        BEGIN
03630  M00S03604.ssdebug +++|        DBERRCODE = S"DNO$SUBCAT";
03631  M00S03605.ssdebug +++|        DBERR(DBERRCODE);
03632  M00S03606.ssdebug +++|        RETURN;
03633  M00S03607.ssdebug +++|        END
03634  M00S03608.ssdebug +++|
03635  M00S03609.ssdebug +++|      IF RESPCODE EQ CMASTAT"ORDERR"
03636  M00S03610.ssdebug +++|      THEN                           # *FCT* ORDINAL OUT OF RANGE #
03637  M00S03611.ssdebug +++|        BEGIN
03638  M00S03612.ssdebug +++|        DBERRCODE = S"DORD$ERR";
03639  M00S03613.ssdebug +++|        DBERR(DBERRCODE);
03640  M00S03614.ssdebug +++|        RETURN;
03641  M00S03615.ssdebug +++|        END
03642  M00S03616.ssdebug +++|
03643  M00S03617.ssdebug +++|      GOTO ERR;                      # ILLEGAL RESPONSE CODE #
03644  M00S03618.ssdebug +++|
03645  M00S03619.ssdebug +++|#
03646  M00S03620.ssdebug +++|*     PROCESS RESPONSE CODES FOR TYPE 3 UCP REQUESTS.
03647  M00S03621.ssdebug +++|#
03648  M00S03622.ssdebug +++|
03649  M00S03623.ssdebug +++|OK3$ACT:                             # NO ERROR #
03650  M00S03624.ssdebug +++|      RETURN;
03651  M00S03625.ssdebug +++|
03652  M00S03626.ssdebug +++|INTLCK$ACT:                          # CATALOG/MAP FILE INTERLOCKED #
03653  M00S03627.ssdebug +++|      DBERRCODE = S"DC$M$INTLK";
03654  M00S03628.ssdebug +++|      DBERR(DBERRCODE);
03655  M00S03629.ssdebug +++|      RETURN;
03656  M00S03630.ssdebug +++|
03657  M00S03631.ssdebug +++|NOPEN$ACT:                           # CATALOG/MAP NOT OPEN #
03658  M00S03632.ssdebug +++|      DBERRCODE = S"DC$M$NOPEN";
03659  M00S03633.ssdebug +++|      DBERR(DBERRCODE);
03660  M00S03634.ssdebug +++|      RETURN;
03661  M00S03635.ssdebug +++|
03662  M00S03636.ssdebug +++|RESUB$ACT:                           # RESUBMIT REQUEST #
03663  M00S03637.ssdebug +++|      GOTO ERR;
03664  M00S03638.ssdebug +++|
03665  M00S03639.ssdebug +++|SCATEX$ACT:                          # SUBCATALOG ALREADY EYISTS #
03666  M00S03640.ssdebug +++|      GOTO ERR;
03667  M00S03641.ssdebug +++|
03668  M00S03642.ssdebug +++|NOSUB$ACT:                           # NO SUCH SUBCATALOG #
03669  M00S03643.ssdebug +++|      DBERRCODE = S"DNO$SUBCAT";
03670  M00S03644.ssdebug +++|      DBERR(DBERRCODE);
03671  M00S03645.ssdebug +++|      RETURN;
03672  M00S03646.ssdebug +++|
03673  M00S03647.ssdebug +++|PFPROB$ACT:                          # PF PROBLEM #
03674  M00S03648.ssdebug +++|      DBERRCODE = S"DPF$PROB";
03675  M00S03649.ssdebug +++|      DBERR(DBERRCODE);
03676  M00S03650.ssdebug +++|      RETURN;
03677  M00S03651.ssdebug +++|
03678  M00S03652.ssdebug +++|NEMPTY$ACT:                          # MSC NOT EMPTY #
03679  M00S03653.ssdebug +++|      GOTO ERR;
03680  M00S03654.ssdebug +++|
03681  M00S03655.ssdebug +++|ILLORD$ACT:                          # *FCT* ORDINAL OUT OF RANGE #
03682  M00S03656.ssdebug +++|      DBERRCODE = S"DORD$ERR";
03683  M00S03657.ssdebug +++|      DBERR(DBERRCODE);
03684  M00S03658.ssdebug +++|      RETURN;
03685  M00S03659.ssdebug +++|
03686  M00S03660.ssdebug +++|NFROZ$ACT:                           # NON FROZEN FRAGMENT #
03687  M00S03661.ssdebug +++|      DBERRCODE = S"DFROZ$NSET";
03688  M00S03662.ssdebug +++|      DBERR(DBERRCODE);
03689  M00S03663.ssdebug +++|      RETURN;
03690  M00S03664.ssdebug +++|
03691  M00S03665.ssdebug +++|GR$FL$ACT:                           # GROUP FULL #
03692  M00S03666.ssdebug +++|      GOTO ERR;
03693  M00S03667.ssdebug +++|
03694  M00S03668.ssdebug +++|#
03695  M00S03669.ssdebug +++|*     PROCESS RESPONSE CODES FOR TYPE 4 UCP REQUESTS.
03696  M00S03670.ssdebug +++|#
03697  M00S03671.ssdebug +++|
03698  M00S03672.ssdebug +++|OK4$ACT:                             # NO ERROR #
03699  M00S03673.ssdebug +++|      RETURN;
03700  M00S03674.ssdebug +++|
03701  M00S03675.ssdebug +++|CSN$MIS$ACT:                         # CSN CARTRIDGE MISMATCH #
03702  M00S03676.ssdebug +++|      DBERRCODE = S"DCART$LB$ERR";
03703  M00S03677.ssdebug +++|      DBERR(DBERRCODE);
03704  M00S03678.ssdebug +++|      RETURN;
03705  M00S03679.ssdebug +++|
03706  M00S03680.ssdebug +++|CSN$USE$ACT:                         # CSN IN USE #
03707  M00S03681.ssdebug +++|      DBERRCODE = S"DCSN$IN$USE";
03708  M00S03682.ssdebug +++|      DBERR(DBERRCODE);
03709  M00S03683.ssdebug +++|      RETURN;
03710  M00S03684.ssdebug +++|
03711  M00S03685.ssdebug +++|CELL$EMP$ACT:                        # CELL EMPTY #
03712  M00S03686.ssdebug +++|      DBERRCODE = S"DCELL$EMP";
03713  M00S03687.ssdebug +++|      DBERR(DBERRCODE);
03714  M00S03688.ssdebug +++|      RETURN;
03715  M00S03689.ssdebug +++|
03716  M00S03690.ssdebug +++|CELL$FLL$ACT:                        # CELL FULL #
03717  M00S03691.ssdebug +++|      GOTO ERR;
03718  M00S03692.ssdebug +++|
03719  M00S03693.ssdebug +++|EX$DMARK$ACT:                        # EXCESSIVE DEMARKS #
03720  M00S03694.ssdebug +++|      GOTO ERR;
03721  M00S03695.ssdebug +++|
03722  M00S03696.ssdebug +++|UNK$CART$ACT:                        # NO CARTRIDGE LABEL MATCH #
03723  M00S03697.ssdebug +++|      DBERRCODE = S"DUNK$CART";
03724  M00S03698.ssdebug +++|      DBERR(DBERRCODE);
03725  M00S03699.ssdebug +++|      RETURN;
03726  M00S03700.ssdebug +++|
03727  M00S03701.ssdebug +++|URDERR$ACT:                          # UNRECOVERABLE READ ERROR #
03728  M00S03702.ssdebug +++|      DBERRCODE = S"DUN$RD$ERR";
03729  M00S03703.ssdebug +++|      DBERR(DBERRCODE);
03730  M00S03704.ssdebug +++|      RETURN;
03731  M00S03705.ssdebug +++|
03732  M00S03706.ssdebug +++|UWTERR$ACT:                          # UNRECOVERABLE WRITE ERROR #
03733  M00S03707.ssdebug +++|      GOTO ERR;
03734  M00S03708.ssdebug +++|
03735  M00S03709.ssdebug +++|VOL$ERR$ACT:                         # VOLUME HEADER ERROR #
03736  M00S03710.ssdebug +++|      DBERRCODE = S"DVOL$HD$ERR";
03737  M00S03711.ssdebug +++|      DBERR(DBERRCODE);
03738  M00S03712.ssdebug +++|      RETURN;
03739  M00S03713.ssdebug +++|
03740  M00S03714.ssdebug +++|M86HW$PR$ACT:                        # M860 HARDWARE ERROR #
03741  M00S03715.ssdebug +++|      DBERRCODE = S"DSYS$ERR";
03742  M00S03716.ssdebug +++|      DBERR(DBERRCODE);
03743  M00S03717.ssdebug +++|      RETURN;
03744  M00S03718.ssdebug +++|
03745  M00S03719.ssdebug +++|RMSER$ACT:                           # DISK FILE ERROR #
03746  M00S03720.ssdebug +++|      DBERRCODE = S"DDSKFL$ERR";
03747  M00S03721.ssdebug +++|      DBERR(DBERRCODE);
03748  M00S03722.ssdebug +++|      RETURN;
03749  M00S03723.ssdebug +++|
03750  M00S03724.ssdebug +++|DSKFUL$ACT:                          # DISK FULL #
03751  M00S03725.ssdebug +++|      DBERRCODE = S"DDISK$FULL";
03752  M00S03726.ssdebug +++|      DBERR(DBERRCODE);
03753  M00S03727.ssdebug +++|      RETURN;
03754  M00S03728.ssdebug +++|
03755  M00S03729.ssdebug +++|ATTER$ACT:                           # ATTACH ERROR #
03756  M00S03730.ssdebug +++|      DBERRCODE = S"DATT$ERR";
03757  M00S03731.ssdebug +++|      DBERR(DBERRCODE);
03758  M00S03732.ssdebug +++|      RETURN;
03759  M00S03733.ssdebug +++|
03760  M00S03734.ssdebug +++|SMA$OFF$ACT:                          # SMA OFF #
03761  M00S03735.ssdebug +++|      DBERRCODE = S"DSMA$OFF";
03762  M00S03736.ssdebug +++|      DBERR(DBERRCODE);
03763  M00S03737.ssdebug +++|      RETURN;
03764  M00S03738.ssdebug +++|
03765  M00S03739.ssdebug +++|EOI$ACT:                            # EOI ON FILE #
03766  M00S03740.ssdebug +++|      GOTO ERR;
03767  M00S03741.ssdebug +++|
03768  M00S03742.ssdebug +++|ERR:
03769  M00S03743.ssdebug +++|      DBMSG$PROC[0] = PROCNAME;      # ABNORMAL TERMINATION #
03770  M00S03744.ssdebug +++|      MESSAGE(DBMSG[0],SYSUDF1);
03771  M00S03745.ssdebug +++|      RESTPFP(PFP$ABORT);            # RESTORE USER-S *PFP* AND ABORT #
03772  M00S03746.ssdebug +++|
03773  M00S03747.ssdebug +++|
03774  M00S03748.ssdebug +++|      END  # DBRESP #
03775  M00S03749.ssdebug +++|
03776  M00S03750.ssdebug +++|    TERM
03777  M00S03751.ssdebug +++|PROC DBVSN(Y,Z,MAPENT,FLAG);
03778  M00S03752.ssdebug +++|# TITLE - DBVSN - SEARCH SMMAP FOR THE CSN.                         #
03779  M00S03753.ssdebug +++|
03780  M00S03754.ssdebug +++|      BEGIN  # DBVSN #
03781  M00S03755.ssdebug +++|
03782  M00S03756.ssdebug +++|#
03783  M00S03757.ssdebug +++|**    DBVSN - SEARCH SMMAP FOR CSN.
03784  M00S03758.ssdebug +++|*
03785  M00S03759.ssdebug +++|*     PROC DBVSN(Y,Z,MAPENT,FLAG)
03786  M00S03760.ssdebug +++|*
03787  M00S03761.ssdebug +++|*     ENTRY    (DBARG$SMID) = SM-ID.
03788  M00S03762.ssdebug +++|*              (DBARG$CN)    = DIGIT PORTION OF CSN.
03789  M00S03763.ssdebug +++|*              (DBARG$CM)    = CARTRIDGE MANUFACTURER CODE.
03790  M00S03764.ssdebug +++|*
03791  M00S03765.ssdebug +++|*     EXIT     (Y)    = Y COORDINATE OF MATCHING CSN.
03792  M00S03766.ssdebug +++|*              (Z)    = Z COORDINATE OF MATCHING CSN.
03793  M00S03767.ssdebug +++|*              (MAPENT) = SMMAP ENTRY.
03794  M00S03768.ssdebug +++|*              (FLAG)   = ERROR STATUS.
03795  M00S03769.ssdebug +++|*                         0, NO ERROR
03796  M00S03770.ssdebug +++|*                       1, CSN NOT FOUND.
03797  M00S03771.ssdebug +++|*
03798  M00S03772.ssdebug +++|*     MESSAGES SSDEBUG ABNORMAL, DBVSN.
03799  M00S03773.ssdebug +++|*
03800  M00S03774.ssdebug +++|*     NOTES    THE SMMAP IS SEARCHED SEQUENTIALLY FOR
03801  M00S03775.ssdebug +++|*              MATCHING CSN.
03802  M00S03776.ssdebug +++|#
03803  M00S03777.ssdebug +++|
03804  M00S03778.ssdebug +++|      ITEM Y           I;           # Y COORDINATE OF MATCHING CSN #
03805  M00S03779.ssdebug +++|      ITEM Z           I;           # Z COORDINATE OF MATCHING CSN #
03806  M00S03780.ssdebug +++|      ARRAY MAPENT [0:0] S(3);;      # SMMAP ENTRY #
03807  M00S03781.ssdebug +++|      ITEM FLAG       I;             # ERROR STATUS #
03808  M00S03782.ssdebug +++|
03809  M00S03783.ssdebug +++|#
03810  M00S03784.ssdebug +++|****  PROC DBVSN - XREF LIST BEGIN.
03811  M00S03785.ssdebug +++|#
03812  M00S03786.ssdebug +++|
03813  M00S03787.ssdebug +++|      XREF
03814  M00S03788.ssdebug +++|        BEGIN
03815  M00S03789.ssdebug +++|        PROC MESSAGE;                # DISPLAYS MESSAGE #
03816  M00S03790.ssdebug +++|        PROC MGETENT;                # GET SMMAP ENTRY #
03817  M00S03791.ssdebug +++|        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
03818  M00S03792.ssdebug +++|                                       OR RETURN #
03819  M00S03793.ssdebug +++|        END
03820  M00S03794.ssdebug +++|
03821  M00S03795.ssdebug +++|#
03822  M00S03796.ssdebug +++|****  PROC DBVSN - XREF LIST END.
03823  M00S03797.ssdebug +++|#
03824  M00S03798.ssdebug +++|
03825  M00S03799.ssdebug +++|      DEF PROCNAME  #"DBVSN."#;      # PROC NAME #
03826  M00S03800.ssdebug +++|
03827  M00S03801.ssdebug +++|      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
03828  M00S03802.ssdebug +++|*CALL COMBFAS
03829  M00S03803.ssdebug +++|*CALL COMBCMS
03830  M00S03804.ssdebug +++|*CALL COMBCPR
03831  M00S03805.ssdebug +++|*CALL COMBMAP
03832  M00S03806.ssdebug +++|*CALL COMTDBP
03833  M00S03807.ssdebug +++|*CALL COMTDBG
03834  M00S03808.ssdebug +++|
03835  M00S03809.ssdebug +++|      ITEM I          I;             # LOOP INDUCTION VARIABLE #
03836  M00S03810.ssdebug +++|      ITEM MAPADDR    I;             # FWA OF BUFFER TO HOLD ENTRY #
03837  M00S03811.ssdebug +++|
03838  M00S03812.ssdebug +++|CONTROL EJECT;
03839  M00S03813.ssdebug +++|
03840  M00S03814.ssdebug +++|      FLAG = 0;                      # INITIALIZE #
03841  M00S03815.ssdebug +++|      MAPADDR = LOC(MAPENT[0]);
03842  M00S03816.ssdebug +++|      P<SMUMAP> = MAPADDR;
03843  M00S03817.ssdebug +++|
03844  M00S03818.ssdebug +++|#
03845  M00S03819.ssdebug +++|*     SEARCH SMMAP FOR MATCHING VSN.
03846  M00S03820.ssdebug +++|#
03847  M00S03821.ssdebug +++|
03848  M00S03822.ssdebug +++|      FASTFOR I = 1 STEP 1 UNTIL MAXORD
03849  M00S03823.ssdebug +++|      DO
03850  M00S03824.ssdebug +++|        BEGIN  # SEARCH SMMAP #
03851  M00S03825.ssdebug +++|        MGETENT(DBARG$SMID[0],I,MAPADDR,FLAG);
03852  M00S03826.ssdebug +++|        IF FLAG NQ CMASTAT"NOERR"
03853  M00S03827.ssdebug +++|        THEN                         # ABNORMAL TERMINATION #
03854  M00S03828.ssdebug +++|          BEGIN
03855  M00S03829.ssdebug +++|          DBMSG$PROC[0] = PROCNAME;
03856  M00S03830.ssdebug +++|          MESSAGE(DBMSG[0],SYSUDF1);
03857  M00S03831.ssdebug +++|          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
03858  M00S03832.ssdebug +++|          END
03859  M00S03833.ssdebug +++|
03860  M00S03834.ssdebug +++|        IF CM$CCOD[0] EQ DBARG$CM[0] AND CM$CSND[0] EQ DBARG$CN[0]
03861  M00S03835.ssdebug +++|        THEN                         # VSN MATCH FOUND #
03862  M00S03836.ssdebug +++|          BEGIN
03863  M00S03837.ssdebug +++|          Y = ( MAXORD - I )/( MAX$Z + 1 );
03864  M00S03838.ssdebug +++|          Z = MAXORD - I - ( MAX$Z + 1 )* Y;
03865  M00S03839.ssdebug +++|          RETURN;
03866  M00S03840.ssdebug +++|          END
03867  M00S03841.ssdebug +++|
03868  M00S03842.ssdebug +++|        END  # SEARCH SMMAP #
03869  M00S03843.ssdebug +++|
03870  M00S03844.ssdebug +++|      FLAG = 1;                      # MATCHING VSN NOT FOUND #
03871  M00S03845.ssdebug +++|      RETURN;
03872  M00S03846.ssdebug +++|
03873  M00S03847.ssdebug +++|      END
03874  M00S03848.ssdebug +++|
03875  M00S03849.ssdebug +++|    TERM