         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
   FDESNOLOCK = 199,                                           << 9725>>04975000
   FILENAMETOOLONG = 532,                                      << 9725>>05005000
   GRPNAMEMISSING = 541,                                       << 9725>>05035000
   GRPNAMETOOLONG = 542,                                       << 9725>>05035500
   LWDNAMEMISSING = 561,                                       << 9725>>05125500
   LWDNAMETOOLONG = 562,                                       << 9725>>05126000
   MUSTBEINTERACT  = 1627, <<TARGET MUST BE INTERACTIVE>>      <<01469>>06150000
   PRINTCARETERR      = 101, << PRINTCICARET bounds error. >>  << 9725>>07040000
<< ADS ENVID ERRORS >>                                         << 9725>>07050300
   ENVIDEXPECTALPHA = 5150,                                    << 9725>>07050500
   ENVIDNAMEMISSING = 5151,                                    << 9725>>07051000
   ENVIDNAMETOOLONG = 5152,                                    << 9725>>07051500
   ADSNOTPRESENT    = 5153,                                    << 9725>>07052000
   FPARSEINTERNAL   = 5154,                                    << 9725>>07052500
PROCEDURE FPARSE (FD, RESULT, ITEMS, I'VECTORS);               << 9725>>08585000
BYTE ARRAY FD;                                                 << 9725>>08585500
INTEGER ARRAY RESULT;                                          << 9725>>08586000
LOGICAL ARRAY ITEMS;                                           << 9725>>08586500
DOUBLE ARRAY I'VECTORS;                                        << 9725>>08587000
OPTION VARIABLE, EXTERNAL;                                     << 9725>>08587500
                                                               << 9725>>08588000
PROCEDURE WAIT(EVENTMASK,SPECIALINFO);                         <<02375>>10300100
VALUE EVENTMASK,SPECIALINFO;                                   <<02375>>10300200
INTEGER EVENTMASK;                                             <<02375>>10300300
LOGICAL SPECIALINFO;                                           <<02375>>10300400
OPTION EXTERNAL;                                               <<02375>>10300500
                                                               <<02375>>10300600
PROCEDURE INITUDC( SHOW, COMFN, CHECK'UDC'ARRAY,               << 9335>>11130000
                   CHECK'USER, CHECK'ACCT );                   << 9335>>11131000
   VALUE    SHOW, COMFN;                                       << 9335>>11140000
   LOGICAL  SHOW;                                              << 9335>>11150000
   BYTE     ARRAY CHECK'USER, CHECK'ACCT;                      << 9335>>11151000
   LOGICAL  ARRAY CHECK'UDC'ARRAY;                                      11152000
PROCEDURE CXCHANGELOG EXECUTORHEAD; OPTION EXTERNAL;           <<*9585>>11320100
                                                               <<A1989>>11911000
PROCEDURE CXAPPCCONTROL   EXECUTORHEAD; OPTION EXTERNAL;       <<A1989>>11912000
                                                               <<A1989>>11913000
$EDIT VOID=11920000                                            <<A1989>>11920000
                                                               << 9855>>12420010
PROCEDURE CXFTN EXECUTORHEAD; OPTION EXTERNAL;                 << 9855>>12420020
                                                               << 9855>>12420030
PROCEDURE CXFTNPREP EXECUTORHEAD; OPTION EXTERNAL;             << 9855>>12420040
                                                               << 9855>>12420050
PROCEDURE CXFTNGO EXECUTORHEAD; OPTION EXTERNAL;               << 9855>>12420060
                                                               << 9855>>12420070
                                                               <<D1620>>15171000
PROCEDURE CXAUTOALLOCATE EXECUTORHEAD;                         <<D1620>>15172000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<D1620>>15173000
PROCEDURE CXSHOWALLOCATE EXECUTORHEAD;                         <<01848>>15181000
  OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                     <<01848>>15182000
                                                               <<01848>>15183000
PROCEDURE CXBBASIC EXECUTORHEAD;                               <<71292>>15921000
  OPTION PRIVILEGED, UNCALLABLE,                               <<71292>>15922000
         EXTERNAL;                                                      15923000
                                                                        15924000
PROCEDURE CXBBASICOMP EXECUTORHEAD;                            <<71292>>15925000
  OPTION PRIVILEGED, UNCALLABLE,                               <<71292>>15926000
         EXTERNAL;                                             <<71292>>15927000
                                                                        15928000
PROCEDURE CXBBASICPREP EXECUTORHEAD;                           <<71292>>15929000
  OPTION PRIVILEGED, UNCALLABLE,                               <<71292>>15929100
         EXTERNAL;                                             <<71292>>15929200
                                                                        15929300
PROCEDURE CXBBASICGO EXECUTORHEAD;                             <<71292>>15929400
  OPTION PRIVILEGED, UNCALLABLE,                               <<71292>>15929500
         EXTERNAL;                                             <<71292>>15929600
   PROCEDURE PRINTCICARET(ERRADR);                             << 9725>>16110000
   PROCEDURE CXNSCONTROLD EXECUTORHEAD;                         <<ds83>>16670000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                       <<ds83>>16670500
                                                                <<ds83>>16671000
PROCEDURE UNLOCKJIR(B);                                                 16811000
   VALUE   B;                                                           16812000
   LOGICAL B;                                                           16813000
   OPTION EXTERNAL;                                                     16814000
                                                                        16815000
PROCEDURE FREESIRS;                                                     16816000
   OPTION EXTERNAL;                                                     16816100
                                                                        16816200
INTEGER PROCEDURE AS'DSPLABEL( PROCEDURE'INDEX );              <<A9725>>16980500
VALUE   PROCEDURE'INDEX;                                       <<A9725>>16980550
INTEGER PROCEDURE'INDEX;                                       <<A9725>>16980600
OPTION  EXTERNAL;                                              <<A9725>>16980650
 LOGICAL PROCEDURE SETSYSDB;                                   <<I1565>>16990100
 OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                        <<I1565>>16990200
                                                               <<I1565>>16990300
 PROCEDURE RESETDB(WHERE);                                     <<I1565>>16990400
 VALUE WHERE;                                                  <<I1565>>16990500
 INTEGER WHERE;                                                <<I1565>>16990600
 OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                        <<I1565>>16990700
                                                               <<I1565>>16990800
                                                               <<I1565>>16990900
      SHOWMEMSG := SHOWME55; <<TIOGA  - MOUSE>>                << 1915>>19351000
      SHOWMEMSG := SHOWME55; <<MICRO 3000 - MOUSE>>            << 1915>>19352000
OPTION PRIVILEGED,UNCALLABLE;                                  <<09221>>23711000
   THEN CIERR(ERRNUM := ERR);                                  <<09220>>24680000
IF ERR <= 0 THEN                                               <<09220>>24690000
   BEGIN                                                       <<09220>>24691000
     TOS := JSNO;                                              <<09220>>24700000
     NUM := TOS;                                               <<09220>>24710000
     DEL;                                                      <<09220>>24720000
     GENMSG(CIGENERALMSGSET,46,%10000,NUM);                    <<09220>>24730000
   END;                                                        <<09220>>24740000
      LEN         := 0,       <<length of text>>               <<02149>>30880000
      E'FLAG      := 0;       <<Reset file eqn flag >>         <<02149>>30881000
      WHY'DOING      = 6,      << doing actual STORE/RESTORE >><< 9173>>31160000
      WHY'FILEABSENT = 7,      <<file not on disc            >><< 9173>>31160100
      WHY'WRITING    = 8,      <<  ***not used by STORE***   >><< 9173>>31160200
      WHY'DUMMY      = 999;    << for ease of addition       >><< 9173>>31164900
                                                               <<02149>>31270200
   <<--------------------->>                                   <<02149>>31270400
   <<  RESET'FILE'EQUATE  >>                                   <<02149>>31270600
   <<--------------------->>                                   <<02149>>31270800
                                                               <<02149>>31271000
   SUBROUTINE RESET'FILE'EQUATE;                               <<02149>>31271200
                                                               <<02149>>31271400
      <<This routine resets the "STORE" file equation>>        <<02149>>31271600
                                                               <<02149>>31271800
      BEGIN                                                    <<02149>>31272000
                                                               <<02149>>31272200
      MOVE INFO' := ("RESET ", STORE'FORMAL'NAME, %15);        <<02149>>31272400
                                                               <<02149>>31272600
      COMMAND (INFO', CMDERR, CMDPARM);                        <<02149>>31272800
                                                               <<02149>>31273000
      END;  <<RESET'FILE'EQUATE' SUB>>                         <<02149>>31273200
   <<------------------------------->>                         <<02149>>31273400
      IF E'FLAG THEN                                           <<02149>>31491000
         RESET'FILE'EQUATE;                                    <<02149>>31492000
                                                               <<02149>>31493000
         FAIL (STORE'FAILED, ERRNUM)                           <<02149>>31980000
      ELSE                                                     <<02149>>31981000
         E'FLAG := TRUE;                                       <<02149>>31982000
      IF ERROR = 0 THEN         <<found the JCW!>>             << 9173>>33190000
         IF I <> 0              AND                            << 9173>>33200000
            I <> WHY'FILEABSENT AND                            << 9173>>33201000
            I <> WHY'WRITING    THEN <<STORE return error?>>   << 9173>>33202000
$EDIT VOID=33450000                                            <<02149>>33290000
      LEN         := 0,       <<length of text>>               <<02149>>34160000
      E'FLAG      := 0;       <<reset file eqn flag >>         <<02149>>34161000
      WHY'DOING         = 6,    <<doing actual STORE/RESTORE>> << 9173>>34440000
      WHY'FILEABSENT    = 7,    <<file not on tape          >> << 9173>>34440100
      WHY'WRITING       = 8,    <<file used for writing     >> << 9173>>34440200
      WHY'DUMMY         = 999;  << for ease of addition     >> << 9173>>34444900
   <<--------------------->>                                   <<02149>>34560200
   <<  RESET'FILE'EQUATE  >>                                   <<02149>>34560400
   <<--------------------->>                                   <<02149>>34560600
                                                               <<02149>>34560800
   SUBROUTINE RESET'FILE'EQUATE;                               <<02149>>34561000
                                                               <<02149>>34561200
      <<This routine resets the "STORE" file equation>>        <<02149>>34561400
                                                               <<02149>>34561600
      BEGIN                                                    <<02149>>34561800
                                                               <<02149>>34562000
      MOVE INFO' := ("RESET ", STORE'FORMAL'NAME, %15);        <<02149>>34562200
                                                               <<02149>>34562400
      COMMAND (INFO', CMDERR, CMDPARM);                        <<02149>>34562600
                                                               <<02149>>34562800
      END;  <<RESET'FILE'EQUATE' SUB>>                         <<02149>>34563000
   <<------------------------------->>                         <<02149>>34563200
                                                               <<02149>>34563400
      IF E'FLAG THEN                                           <<02149>>34771000
         RESET'FILE'EQUATE;                                    <<02149>>34772000
                                                               <<02149>>34773000
         FAIL (RESTORE'FAILED, ERRNUM)                         <<02149>>35260000
      ELSE                                                     <<02149>>35261000
         E'FLAG := TRUE;                                       <<02149>>35262000
      IF ERROR = 0 THEN         <<found the JCW!>>             << 9173>>36470000
         IF I <> 0              AND                            << 9173>>36480000
            I <> WHY'FILEABSENT AND                            << 9173>>36481000
            I <> WHY'WRITING    THEN <<RESTORE return error?>> << 9173>>36482000
$EDIT VOID=36740000                                            <<02149>>36580000
INTEGER LPDT'INDEX;                                            <<01469>>38765000
$EDIT                                                          <<01469>>38820000
 0,MUSTBEINTERACT,TELLINVSNUM,TELLXPCTJORS,TELLXPCTJSORAT,     <<01469>>38880000
DEFINE QUIETBIT = (8:1)#;    <<JMAT BIT => TELL WONT WORK>>    <<01469>>38990000
         BEGIN                                                 <<01469>>39803000
         LPDT'INDEX := JMATRETURN(1)*INTEGER(LPDT'ENTRY'SIZE); <<01469>>39804000
         IF NOT LPDT'INTERACTIVE THEN                          <<01469>>39805000
            BEGIN   <<TELL SENDER>>                            <<02150>>39805100
               <<FORMAT JOBID OF TARGET>>                      <<02150>>39805200
               RECIPSNUM(2) := " ";                            <<02150>>39805300
               MOVE RECIPSNUM(3) := RECIPSNUM(2),(3);          <<02150>>39805400
               RECIPSNUM := "J";                               <<02150>>39805800
               ASCII(RESULT.(2:14), 10, RECIPSNUM(1));         <<02150>>39805900
               FORMNAME(5,RECIPID,RECIPSNUM,BRESULT(2),        <<02150>>39805910
                  BRESULT(10),DUMMY);                          <<02150>>39805920
               cierr(errnum := -MUSTBEINTERACT,, 0,                     39805930
                  @RECIPID);                                   <<02150>>39805931
$EDIT VOID=39805932                                                     39805932
            END                                                <<02150>>39805940
$EDIT VOID=39806000                                            <<02150>>39806000
         ELSE                                                  <<01469>>39807000
$EDIT                                                          <<01469>>39960000
$EDIT                                                          <<01469>>39970000
$EDIT                                                          <<01469>>39980000
         END                                                   <<01469>>40045000
$EDIT                                                          <<01469>>40070000
$EDIT                                                          <<01469>>40080000
LOGICAL PROCEDURE WITHINUDC(MAINPIN);                          <<I1565>>50040100
VALUE MAINPIN;                                                 <<I1565>>50040200
INTEGER MAINPIN;                                               <<I1565>>50040300
OPTION PRIVILEGED,UNCALLABLE;                                  <<I1565>>50040400
<<----------------------------------------------------------->><<I1565>>50040500
<<  This procedure will determine if a process is executing  >><<I1565>>50040600
<< a UDC.                                                    >><<I1565>>50040700
<<  To use this procedure please make sure that the mainpin's>><<I1565>>50040800
<< cistack is not executing while this procedure is called.  >><<I1565>>50040900
<< If it does, a system crash could occur.                   >><<I1565>>50041000
<<  *** WARNING ***                                          >><<I1565>>50041100
<<  This procedure expects the DB to be at SYSDB, so the     >><<I1565>>50041200
<< first thing it does is resets the DB.  Upon leaving it    >><<I1565>>50041300
<< sets DB back to SYSDB.                                    >><<I1565>>50041400
<<                                                           >><<I1565>>50041500
<<  Parameters passed:                                       >><<I1565>>50041600
<<    MAINPIN - PIN of the process in question               >><<I1565>>50041700
<<                                                           >><<I1565>>50041800
<<  Return values for WITHINUDC                              >><<I1565>>50041900
<<    TRUE  - process was executed from within a UDC         >><<I1565>>50042000
<<    FALSE - process was a main or process not active or    >><<I1565>>50042100
<<            invalid PIN                                    >><<I1565>>50042200
<<----------------------------------------------------------->><<I1565>>50042300
                                                               <<I1565>>50042400
BEGIN                                                          <<I1565>>50042500
INTEGER MAX'PIN;                                               <<I1565>>50042600
LOGICAL DB'OFFSET,                                             <<I1565>>50042700
        PCBPT,                                                 <<I1565>>50042800
        UDC4WORD;                                              <<I1565>>50042900
DEFINE                                                         <<I1565>>50043000
   UDC4WORD'NESTLEVEL = UDC4WORD.CIS'NESTLEVEL#,               <<I1565>>50043100
   UDC4'DB'DISPLACEMENT = %261#;                               <<I1565>>50043200
                                                               <<I1565>>50043300
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<I1565>>50043400
                                                               <<I1565>>50043500
<< reset the DB  >>                                            <<I1565>>50043600
RESETDB(-1);                                                   <<I1565>>50043700
                                                               <<I1565>>50043800
UDC4WORD := TRUE;                                              <<I1565>>50043900
WITHINUDC := FALSE;                                            <<I1565>>50044000
<< get maximum number of pins allowed >>                       <<I1565>>50044100
                                                               <<I1565>>50044200
MAX'PIN := LPCB(0);                                            <<I1565>>50044300
                                                               <<I1565>>50044400
<< test for valid pin number >>                                <<I1565>>50044500
                                                               <<I1565>>50044600
IF (MAINPIN <= MAX'PIN) LAND (MAINPIN  <> 0) THEN              <<I1565>>50044700
  BEGIN                                                        <<I1565>>50044800
  << calculate pcb offset for process pin >>                   <<I1565>>50044900
                                                               <<I1565>>50045000
   PCBPT := MAINPIN * PCBSIZE;                                 <<I1565>>50045100
                                                               <<I1565>>50045200
  << determine if pcb is active and is a main process >>       <<I1565>>50045300
                                                               <<I1565>>50045400
   IF (SPCBPTYPE = PCBJSMAIN) LAND                             <<I1565>>50045500
      (PQPTR <> -1) THEN                                       <<I1565>>50045600
     BEGIN                                                     <<I1565>>50045700
     << get process DB offset from process's stack >>          <<I1565>>50045800
      MOVEFROMDSEG(@DB'OFFSET,SPCBSTKDST,PXG'RELDB'OFFSET,1);  <<I1565>>50045900
                                                               <<I1565>>50046000
     << calculate offset for UDC NESTLEVEL buffer  >>          <<I1565>>50046100
      DB'OFFSET := DB'OFFSET + UDC4'DB'DISPLACEMENT;           <<I1565>>50046200
                                                               <<I1565>>50046300
     << get UDC NESTLEVEL word                     >>          <<I1565>>50046400
      MOVEFROMDSEG(@UDC4WORD,SPCBSTKDST,DB'OFFSET,1);          <<I1565>>50046500
                                                               <<I1565>>50046600
     << if UDC NESTLEVEL is 0, it's not within a UDC >>        <<I1565>>50046700
     IF (UDC4WORD'NESTLEVEL > 0) THEN                          <<I1565>>50046800
         WITHINUDC := TRUE;                                    <<I1565>>50046900
     END;                                                      <<I1565>>50047000
  END;                                                         <<I1565>>50047100
                                                               <<I1565>>50047200
<< return the DB to where it was before entering here >>       <<I1565>>50047300
SETSYSDB;                                                      <<I1565>>50047400
                                                               <<I1565>>50047500
END;   << WITHINUDC >>                                         <<I1565>>50047600
                                                               <<I1565>>50047700
$PAGE                                                          << 9725>>52625000
INTEGER PROCEDURE MAP'ERRS'FPARSE'TO'CI (ERRNUM);              << 9725>>52625010
VALUE ERRNUM;                                                  << 9725>>52625020
INTEGER ERRNUM;                                                << 9725>>52625030
BEGIN              << Procedure Map'Errs'Fparse'to'CI >>       << 9725>>52625040
                                                               << 9725>>52625050
INTEGER                                                        << 9725>>52625060
   RETURN'VAL = MAP'ERRS'FPARSE'TO'CI;                         << 9725>>52625070
INTEGER ARRAY ERR'MAP (*) = PB :=                              << 9725>>52625080
           0,         <<  0  no such error   >>                << 9725>>52625090
   FPARSEINTERNAL,    << -1  bad item values >>                << 9725>>52625100
   FPARSEINTERNAL,    << -2  parameter bounds viol >>          << 9725>>52625110
   EXPECTPERIOD,      << -3  illegal delimiter >>              << 9725>>52625120
   FPARSEINTERNAL,    << -4  missing items or vectors >>       << 9725>>52625130
   FPARSEINTERNAL,    << -5  illegal item value >>             << 9725>>52625140
   FPARSEINTERNAL,    << -6  item not terminated >>            << 9725>>52625150
   UNKNOWNSYSDEF,     << -7  undefined system file >>          << 9725>>52625160
   FDESNOLOCK,        << -8  "*FDesig" has lockword >>         << 9725>>52625170
   ADSNOTPRESENT,     << -9  envid in FD, w/ no ADS in system>><< 9725>>52625180
   FILEEXPECTALPHA,   << -101 filename 1st char not alpha >>   << 9725>>52625190
   FILENAMEMISSING,   << -102 filename expected in string >>   << 9725>>52625200
   FILENAMETOOLONG,   << -103 filename too long           >>   << 9725>>52625210
   LWDEXPECTALPHA,    << -104 lockword 1st char ...       >>   << 9725>>52625220
   LWDNAMEMISSING,    << -105 lockword expected ...       >>   << 9725>>52625230
   LWDNAMETOOLONG,    << -106 lockword too long           >>   << 9725>>52625240
   GRPEXPECTALPHA,    << -107 groupname 1st char ...      >>   << 9725>>52625250
   GRPNAMEMISSING,    << -108 groupname expected ...      >>   << 9725>>52625260
   GRPNAMETOOLONG,    << -109 groupname too long          >>   << 9725>>52625270
   ACCTEXPECTALPHA,   << -110 accountname 1st char ...    >>   << 9725>>52625280
   ACCTNAMEMISSING,   << -111 accountname expected ...    >>   << 9725>>52625290
   ACCTNAMETOOLONG,   << -112 accountname too long        >>   << 9725>>52625300
   ENVIDEXPECTALPHA,  << -113 envidname 1st char          >>   << 9725>>52625310
   ENVIDNAMEMISSING,  << -114 envidname expected          >>   << 9725>>52625320
   ENVIDNAMETOOLONG;  << -115 envidname too long          >>   << 9725>>52625330
                                                               << 9725>>52625335
EQUATE                                                         << 9725>>52625400
   MAX'SMALL'ERR = 9,                                          << 9725>>52625410
   MIN'BIG'ERR = 101,                                          << 9725>>52625420
   BIG'ERR'ADJUST = MIN'BIG'ERR - (MAX'SMALL'ERR + 1);         << 9725>>52625430
                                                               << 9725>>52625440
IF ERRNUM <= 0 THEN                                            << 9725>>52625450
BEGIN                 << Possible error >>                     << 9725>>52625460
   ERRNUM := -ERRNUM;                                          << 9725>>52625470
   IF ERRNUM > 100 THEN                                        << 9725>>52625480
      ERRNUM := ERRNUM - BIG'ERR'ADJUST;                       << 9725>>52625490
   RETURN'VAL := ERR'MAP(ERRNUM);                              << 9725>>52625500
END                   << Possible error >>                     << 9725>>52625510
ELSE                                                           << 9725>>52625520
   RETURN'VAL := 27;                                           << 9725>>52625530
END;               << Procedure Map'Errs'Fparse'to'CI >>       << 9725>>52625540
$PAGE                                                          << 9725>>52625550
INTEGER PROCEDURE UI'FPARSE (FVECTOR,       << Input >>        << 9725>>52625560
                             GPTR,          << Output >>       << 9725>>52625570
                             APTR,          << Output >>       << 9725>>52625580
                             EPTR,          << Output >>       << 9725>>52625590
                             LPTR,          << Output >>       << 9725>>52625600
                             ERRPTR,        << Output >>       << 9725>>52625610
                             BLANKPTR);     << Input >>        << 9725>>52625620
VALUE FVECTOR, BLANKPTR;                                       << 9725>>52625630
DOUBLE FVECTOR;                                                << 9725>>52625640
LOGICAL                                                        << 9725>>52625650
   GPTR, APTR, EPTR, LPTR, ERRPTR, BLANKPTR;                   << 9725>>52625660
OPTION PRIVILEGED, UNCALLABLE;                                 << 9725>>52625670
COMMENT                                                        << 9725>>52625680
***************************************************************<< 9725>>52625690
*                                                             *<< 9725>>52625700
*                   FUNCTION OF PROCEDURE                     *<< 9725>>52625710
*                                                             *<< 9725>>52625720
* This procedure will take a file designator and decompose    *<< 9725>>52625730
* it to all its legal components and return pointers them.    *<< 9725>>52625740
* The real purpose of this procedure is to facilitate calling *<< 9725>>52625750
* of FPARSE from UI executors who used to call CHECKFILENAME'.*<< 9725>>52625760
* The codition codes, functional return of errors and para-   *<< 9725>>52625770
* meters to this procedure has been made to be as similar to  *<< 9725>>52625780
* CHECKFILENAME' as possible.                                 *<< 9725>>52625790
*                                                             *<< 9725>>52625800
***************************************************************<< 9725>>52625810
*                                                             *<< 9725>>52625820
*                         ALGORITHM                           *<< 9725>>52625830
*                                                             *<< 9725>>52625840
* call fparse                                                 *<< 9725>>52625850
* according to type of file set pointers & returnval          *<< 9725>>52625860
* if error then map the fparse error to cierrs                *<< 9725>>52625870
*                                                             *<< 9725>>52625880
***************************************************************<< 9725>>52625890
*                                                             *<< 9725>>52625900
*                         PARAMETERS                          *<< 9725>>52625910
*                                                             *<< 9725>>52625920
* UI'FPARSE  - CI error or if CCG and system file def. desig #*<< 9725>>52625930
* FVECTOR    - 1st wd has the byte addr, 2nd has len of fname *<< 9725>>52625940
* GPTR       - byte address to group                          *<< 9725>>52625950
* APTR       - byte address to account                        *<< 9725>>52625960
* EPTR       - byte address to ADS envid                      *<< 9725>>52625970
* LPTR       - byte address to lockword                       *<< 9725>>52625980
* ERRPTR     - byte address to location of error, if error    *<< 9725>>52625990
* BLANKPTR   - byte address to a blank provided by caller     *<< 9725>>52626000
*                                                             *<< 9725>>52626010
***************************************************************<< 9725>>52626020
*                                                             *<< 9725>>52626030
* GLOBAL DEFINITIONS: CC for STATUS.(6:2)                     *<< 9725>>52626040
*                     CCE, CCL, CCG                           *<< 9725>>52626050
*                                                             *<< 9725>>52626060
* CALLED BY: Commands who used to call checkfilename', but    *<< 9725>>52626070
*            now they have to parse the ADS envid.            *<< 9725>>52626080
*                                                             *<< 9725>>52626090
* CALLS TO: FPARSE                                            *<< 9725>>52626100
*                                                             *<< 9725>>52626110
***************************************************************<< 9725>>52626120
*                                                             *<< 9725>>52626130
*                     NOTES AND CAUTIONS                      *<< 9725>>52626140
*                                                             *<< 9725>>52626150
* DB SETTING:  ENTRY = Stack            EXIT = Stack          *<< 9725>>52626160
* RESOURCES: none                                             *<< 9725>>52626170
* Condition Codes: CCE - no errs, regular designator          *<< 9725>>52626180
*                  CCG - no errs, backref or system file      *<< 9725>>52626190
*                  CCL - some error had occurred              *<< 9725>>52626200
* NOTE: if a legal system file is given the def. designator   *<< 9725>>52626210
*       code, same as the ones for FOPTIONS of FOPEN, will    *<< 9725>>52626220
*       be returned in UI'FPARSE. If backref designator a 0   *<< 9725>>52626230
*       is returned.                                          *<< 9725>>52626240
*                                                             *<< 9725>>52626250
***************************************************************<< 9725>>52626260
*                                                             *<< 9725>>52626270
* CREATOR OF MODULE:  John Hahn                               *<< 9725>>52626280
*                                                             *<< 9725>>52626290
* MODIFICATION HISTORY:                                       *<< 9725>>52626300
*  Date    SR #    Fix #   Name           Summary             *<< 9725>>52626310
* ------ -------- ------ -------- --------------------------- *<< 9725>>52626320
* 8/7/85                 J.S.Hahn Follows Fparse change for   *<<*1356>>52626321
*                                 System designators         * <<*1356>>52626322
*                                                             *<< 9725>>52626330
***************************************************************<< 9725>>52626340
END OF COMMENT;                                                << 9725>>52626350
BEGIN                                                          << 9725>>52626360
                                                               << 9725>>52626370
BYTE POINTER                                                   << 9725>>52626380
   DESIGNATOR = FVECTOR;                                       << 9725>>52626390
INTEGER                                                        << 9725>>52626400
   DESIG'LEN  = FVECTOR+1;                                     << 9725>>52626410
DOUBLE                                                         << 9725>>52626420
   RESULT;                                                     << 9725>>52626430
INTEGER                                                        << 9725>>52626440
   ERROR = RESULT,                                             << 9725>>52626450
   RETURNVAL = UI'FPARSE;                                      << 9725>>52626460
                                                               << 9725>>52626470
<< ---------------------- >>                                   << 9725>>52626480
<< Definitions for FPARSE >>                                   << 9725>>52626490
<< ---------------------- >>                                   << 9725>>52626500
EQUATE                                                         << 9725>>52626510
   ITEM'END   = 0,                                             << 9725>>52626520
   ITEM'FNAME = 1,                                             << 9725>>52626530
   ITEM'LNAME = 2,                                             << 9725>>52626540
   ITEM'GNAME = 3,                                             << 9725>>52626550
   ITEM'ANAME = 4,                                             << 9725>>52626560
   ITEM'ENAME = 5,                                             << 9725>>52626570
   MAXNUMOFNAMES = ITEM'ENAME,                                 << 9725>>52626580
                                                               << 9725>>52626590
   EXTRANEOUSADESG = 583,                                      << 9725>>52626600
                                                               << 9725>>52626610
   FP'RET'SYSFILE = 2,                                         << 9725>>52626620
   FP'RET'BACKREF = 1;                                         << 9725>>52626630
                                                               << 9725>>52626640
INTEGER ARRAY                                                  << 9725>>52626650
   ITEMS (0:MAXNUMOFNAMES);                                    << 9725>>52626660
DOUBLE ARRAY                                                   << 9725>>52626670
   ITEM'VECTORS (0:MAXNUMOFNAMES);                             << 9725>>52626680
INTEGER                                                        << 9725>>52626690
   ARRAY IITEM'VECTORS(*) = ITEM'VECTORS;                      << 9725>>52626700
                                                               << 9725>>52626710
DEFINE                                                         << 9725>>52626720
   FP'ERRPTR    = IITEM'VECTORS(0) #,                          << 9725>>52626730
   FP'FNAME'OFF = IITEM'VECTORS(0) #,                          << 9725>>52626740
   FP'FNAME'LEN = IITEM'VECTORS(1) #,                          << 9725>>52626750
   FP'LNAME'OFF = IITEM'VECTORS(2) #,                          << 9725>>52626760
   FP'LNAME'LEN = IITEM'VECTORS(3) #,                          << 9725>>52626770
   FP'GNAME'OFF = IITEM'VECTORS(4) #,                          << 9725>>52626780
   FP'GNAME'LEN = IITEM'VECTORS(5) #,                          << 9725>>52626790
   FP'ANAME'OFF = IITEM'VECTORS(6) #,                          << 9725>>52626800
   FP'ANAME'LEN = IITEM'VECTORS(7) #,                          << 9725>>52626810
   FP'ENAME'OFF = IITEM'VECTORS(8) #,                          << 9725>>52626820
   FP'ENAME'LEN = IITEM'VECTORS(9) #,                          << 9725>>52626830
   FP'DEF'DESIG = IITEM'VECTORS(10) #,                         << 9725>>52626840
   FP'DESIG'LEN = IITEM'VECTORS(11) #,                         << 9725>>52626850
                                                               << 9725>>52626860
   FP'IS'STDLIST = (FP'DEF'DESIG = 1) #,                       << 9725>>52626870
   FP'IS'NEWPASS = (FP'DEF'DESIG = 2) #,                       << 9725>>52626880
   FP'IS'OLDPASS = (FP'DEF'DESIG = 3) #,                       << 9725>>52626890
   FP'IS'STDIN   = (FP'DEF'DESIG = 4) #,                       << 9725>>52626900
   FP'IS'STDINX  = (FP'DEF'DESIG = 5) #,                       << 9725>>52626910
   FP'IS'NULL    = (FP'DEF'DESIG = 6) #,                       << 9725>>52626920
                                                               << 9725>>52626930
   SETALLFPARSEITEMS = ITEMS(0) := ITEM'FNAME;                 << 9725>>52626940
                       ITEMS(1) := ITEM'LNAME;                 << 9725>>52626950
                       ITEMS(2) := ITEM'GNAME;                 << 9725>>52626960
                       ITEMS(3) := ITEM'ANAME;                 << 9725>>52626970
                       ITEMS(4) := ITEM'ENAME;                 << 9725>>52626980
                       ITEMS(5) := ITEM'END; #;                << 9725>>52626990
$page                                                          << 9725>>52627000
SUBROUTINE SETNAMEPTRS;                                        << 9725>>52627010
<< ------------------------------------------------------ >>   << 9725>>52627020
<< will set pointers to all components of the designator  >>   << 9725>>52627030
<< based on item vectors return from Fparse               >>   << 9725>>52627040
<< ------------------------------------------------------ >>   << 9725>>52627050
BEGIN               << subroutine setnameptrs >>               << 9725>>52627060
   << --------------------------------------------------- >>   << 9725>>52627070
   << fparse will allow for null lockwords, so we have to >>   << 9725>>52627080
   << tell the command executors that such is the case.   >>   << 9725>>52627090
   << if a null lockword is specified then the pointer to >>   << 9725>>52627100
   << it will be the "/".                                 >>   << 9725>>52627110
   << --------------------------------------------------- >>   << 9725>>52627120
   IF FP'LNAME'LEN <> 0 THEN                                   << 9725>>52627130
      LPTR := @DESIGNATOR + FP'LNAME'OFF                       << 9725>>52627140
   ELSE IF FP'LNAME'OFF <> 0 THEN                              << 9725>>52627150
   BEGIN            << if "/" follows file name >>             << 9725>>52627155
      IF DESIGNATOR(FP'LNAME'OFF-1) = "/" THEN                 << 9725>>52627160
         LPTR := @DESIGNATOR(FP'LNAME'OFF-1);                  << 9725>>52627170
   END              << if "/" follows file name >>             << 9725>>52627175
   ELSE                                                        << 9725>>52627180
      LPTR := BLANKPTR;                                        << 9725>>52627190
                                                               << 9725>>52627200
   IF FP'GNAME'LEN <> 0 THEN                                   << 9725>>52627210
      GPTR := @DESIGNATOR + FP'GNAME'OFF                       << 9725>>52627220
   ELSE                                                        << 9725>>52627230
      GPTR := BLANKPTR;                                        << 9725>>52627240
   IF FP'ANAME'LEN <> 0 THEN                                   << 9725>>52627250
      APTR := @DESIGNATOR + FP'ANAME'OFF                       << 9725>>52627260
   ELSE                                                        << 9725>>52627270
      APTR := BLANKPTR;                                        << 9725>>52627280
   IF FP'ENAME'LEN <> 0 THEN                                   << 9725>>52627290
      EPTR := @DESIGNATOR + FP'ENAME'OFF                       << 9725>>52627300
   ELSE                                                        << 9725>>52627310
      EPTR := BLANKPTR;                                        << 9725>>52627320
END;                << subroutine setnameptrs >>               << 9725>>52627330
LOGICAL SUBROUTINE CHECKDELIMITERS;                            << 9725>>52627340
<< ------------------------------------------------------- >>  << 9725>>52627350
<< will check the name length that fparse returned against >>  << 9725>>52627360
<< the len specified by caller. If different then its an   >>  << 9725>>52627370
<< illegal delimiter at end of name.                       >>  << 9725>>52627380
<< ------------------------------------------------------- >>  << 9725>>52627390
BEGIN               << subroutine check delimiters >>          << 9725>>52627400
   IF FP'DESIG'LEN <> DESIG'LEN THEN                           << 9725>>52627410
   BEGIN            << if lengths don't match up >>            << 9725>>52627420
      CHECKDELIMITERS := TRUE;                                 << 9725>>52627430
      CC := CCL;                                               << 9725>>52627440
      RETURNVAL := EXTRANEOUSADESG;                            << 9725>>52627450
      << we want the error to point to just after the name >>  << 9725>>52627460
      ERRPTR := @DESIGNATOR + FP'DESIG'LEN + FP'FNAME'OFF;     << 9725>>52627470
   END             << if lengths don't match up >>             << 9725>>52627480
   ELSE                                                        << 9725>>52627490
      CHECKDELIMITERS := FALSE;                                << 9725>>52627500
END;                << subroutine check delimiters >>          << 9725>>52627510
$PAGE                                                          << 9725>>52627520
<<--- MAIN BODY --->>                                          << 9725>>52627530
                                                               << 9725>>52627540
   SETALLFPARSEITEMS;                                          << 9725>>52627550
   FPARSE (DESIGNATOR, RESULT, ITEMS, ITEM'VECTORS);           << 9725>>52627560
   <<--- error is the 1st wd of result --->>                   << 9725>>52627570
   IF ERROR = 0 THEN                                           << 9725>>52627580
   BEGIN            << if plain designator name >>             << 9725>>52627590
      IF NOT CHECKDELIMITERS THEN                              << 9725>>52627600
      BEGIN            << if bogus trailing delimiters >>      << 9725>>52627610
         SETNAMEPTRS;                                          << 9725>>52627620
         CC := CCE;                                            << 9725>>52627630
         RETURNVAL := 0;                                       << 9725>>52627640
         ERRPTR := 0;                                          << 9725>>52627650
      END;             << if bogus trailing delimiters >>      << 9725>>52627660
   END              << if plain designator name >>             << 9725>>52627670
   ELSE IF ERROR = FP'RET'BACKREF THEN                         << 9725>>52627680
   BEGIN            << else if "*fd ... " >>                   << 9725>>52627690
      DESIG'LEN := DESIG'LEN - 1;                              << 9725>>52627700
      IF NOT CHECKDELIMITERS THEN                              << 9725>>52627710
      BEGIN            << if bogus trailing delimiters >>      << 9725>>52627720
         SETNAMEPTRS;                                          << 9725>>52627730
         CC := CCG;                                            << 9725>>52627740
         RETURNVAL := 0;                                       << 9725>>52627750
         ERRPTR := 0;                                          << 9725>>52627760
      END;             << if bogus trailing delimiters >>      << 9725>>52627770
   END              << else if "*fd ... " >>                   << 9725>>52627780
   ELSE IF ERROR = FP'RET'SYSFILE THEN                         << 9725>>52627790
   BEGIN            << else if "$xxx " >>                      << 9725>>52627800
$EDIT VOID=052627810                                           <<*1356>>52627810
      IF NOT CHECKDELIMITERS THEN                              << 9725>>52627820
      BEGIN            << if bogus trailing delimiters >>      << 9725>>52627830
         CC := CCG;                                            << 9725>>52627840
         RETURNVAL := FP'DEF'DESIG;                            << 9725>>52627850
         ERRPTR := 0;                                          << 9725>>52627860
      END;             << if bogus trailing delimiters >>      << 9725>>52627870
   END              << else if "$xxx " >>                      << 9725>>52627880
   ELSE BEGIN       << else error in fd >>                     << 9725>>52627890
      RETURNVAL := MAP'ERRS'FPARSE'TO'CI (ERROR);              << 9725>>52627900
      CC := CCL;                                               << 9725>>52627910
      ERRPTR := @DESIGNATOR + FP'ERRPTR;                       << 9725>>52627920
   END;             << else error in fd >>                     << 9725>>52627930
END;                                                           << 9725>>52627940
<< CIERR then calls PRINTCICARET; further suppose that     >>  << 9725>>52830000
<< PRINTCICARET wishes the STATUS and RELATIVE-P that      >>  << 9725>>52840000
<< segment that contains CXLISTF).  While in PRINTCICARET, >>  << 9725>>52870000
<<    |  PRINTCICARET work  |  <--Q+1                      >>  << 9725>>53000000
<< While in PRINTCICARET, a call to STACK'MARK( 0, ...);   >>  << 9725>>53040000
<< Therefore, in this example, PRINTCICARET will need a call >><< 9725>>53060000
PROCEDURE PRINTCICARET(ERRADR);                                << 9725>>54870000
OPTION UNCALLABLE;                                             << 9725>>54890000
ARRAY WBUF(0:CIS'WCOMBUFLEN+5);                                << 1163>>55190000
<< SYSINTERR( PRINTCARETERR, 1 ); >>                           << 1140>>55280000
END; << PROCEDURE PRINTCICARET >>                              << 9725>>55580000
    PRINTCICARET.  IF MISSING, DO NOT PRINT CARET.             << 9725>>55730000
      THEN PRINTCICARET(ERRADR);                               << 9725>>56440000
     FIRST WORD OF ACCESS RESTRICTIONS AS FOLLOWS:             <<09725>>60780000
      SECOND WORD OF ACCESS RESTRICTIONS AS FOLLOWS:           <<U9725>>60820000
THE ABOVE "WORDS" LOOK LIKE THIS:                                       60975000
   double array   |----------------|----------------|                   60975500
                  |       capabilities (matches     |                   60976000
                  |     directory structure)        |                   60976500
                  |----------------|----------------|                   60977000
    Access      1 |  ALLOW cmnd no.|    Access      |                   60977500
    restrictions  |def. in INCLAMSK|   restrictions |                   60978000
                  |----------------|----------------|                   60978500
                  | CI error num.  |                                    60978550
                  |                |                                    60978600
                  |----------------|                                    60978650
                                                                        60979000
The fifth logical word is the CI error number.                          60979500
   SAMGR = %140000, 0, 0, %10, CAPREQSMORAM#, <<SM/AM CHECK>>  <<02376>>61545000
   UL'CAP    = %102200, 0#,   << User Logging capabilities >>  <<*9585>>61630100
   USERLOGGING = UL'CAP,0,%110,CAPREQ'LG'#,                    <<*9585>>61640000
       C'NETCONTROL  = %10, 0, 0, 4, CAPREQ'NM'#,              <<*9725>>61950000
       C'APPCCONTROL = %10, 0, 0, 4, CAPREQ'NM'#,              <<A1989>>61951000
       C'NSCONTROL   = %10, 0, 0, 4, CAPREQ'NM'#,              <<*9725>>62005000
NSCONTROL    W LDISMOUNT   ,"NSCONTROL"   Y CXNSCONTROLD        <<ds83>>64075000
                                          Z C'NSCONTROL;        <<ds83>>64075500
PURGEUSER    W 0           ,"PURGEUSER "  Y CXPURGEUSER  Z SAMGR       ;64220000
BBASICGO     W BBASICPREP  ,"BBASICGO"    Y CXBBASICGO         <<71292>>64521000
                                          Z NOTPB;             <<71292>>64522000
BBASICPREP   W OUTFENCE    ,"BBASICPREP"  Y CXBBASICPREP       <<71292>>64523000
                                          Z NOTPB;             <<71292>>64524000
CHANGELOG    W NETCONTROL  ,"CHANGELOG "  Y CXCHANGELOG  Z     <<*9841>>64600100
                                            USERLOGGING;       <<*9585>>64600200
NETCONTROL   W FORTGO      ,"NETCONTROL"   Y CXNETCONTROL      << 9725>>64600500
                                           Z C'NETCONTROL;     << 9725>>64601000
SHOWALLOCATE W SHOWNMLOG   ,"SHOWALLOCATE" Y CXSHOWALLOCATE    <<01848>>64858000
                                           Z OPBR;             <<01848>>64859000
ALTUSER      W VINIT       ,"ALTUSER "    Y CXALTUSER    Z SAMGR       ;64960000
BBASICOMP    W IMF         ,"BBASICOMP"   Y CXBBASICOMP        <<71292>>65171000
                                          Z NOTPB;             <<71292>>65172000
NEWUSER      W 0           ,"NEWUSER "    Y CXNEWUSER    Z SAMGR       ;65340000
APPCCONTROL  W FTNPREP ,"APPCCONTROL" Y CXAPPCCONTROL          <<A1989>>65490001
                                      Z C'APPCCONTROL;         <<A1989>>65490002
FTNPREP      W A3270       ,"FTNPREP" Y CXFTNPREP   Z NOTPB;   << 9855>>65490010
$EDIT                                                          << 1941>>66010000
DEALLOCATE   W 0           ,"DEALLOCATE"  Y CXDEALLOCATE       << 2257>>66012000
                                          Z UNRESTRICTED;      << 2257>>66013000
SHOWLOGSTAT W FULLBACKUP, "SHOWLOGSTATUS " Y CXSHOWLOGSTATUS            66040000
            Z 0,0,0,0,0;                                                66040001
PURGEGROUP   W MOUNTC      ,"PURGEGROUP"  Y CXPURGEGROUP Z SAMGR       ;66230000
FTN          W FTNGO       ,"FTN"     Y CXFTN       Z NOTPB;   << 9855>>66330010
FTNGO        W SHOWALLOW   ,"FTNGO"   Y CXFTNGO     Z NOTPB;   << 9855>>66330020
ALTGROUP     W 0           ,"ALTGROUP"    Y CXALTGROUP   Z SAMGR       ;66520000
AUTOALLOCATE W MOFF        ,"AUTOALLOCATE" Y CXAUTOALLOCATE             66811000
                                          Z OP;                <<D1620>>66812000
BBASIC       W IMFCONTROL  ,"BBASIC"      Y CXBBASIC           <<71292>>66861000
                                          Z NOTPB;             <<71292>>66862000
NEWGROUP     W ALTACCT     ,"NEWGROUP"    Y CXNEWGROUP   Z SAMGR       ;66960000
      EQUATE JOBEXEC  = 2;                                     << 9378>>67141000
      LOGICAL ARRAY CHECK'UDC'ARRAY( 0:2 );                             67441000
      LOGICAL ARRAY BLANK'LINE( 0:1 );                         << 9118>>67470000
INTEGER                                                        <<A9725>>68580500
   DEVICE'TYPE,  <<0=normal;3=DS/1;5=ADS pseudo term  >>       <<A9725>>68580550
   PLABEL;       <<plabel for ADS procedure DSSTARTJOB>>       <<A9725>>68580600
   JMATWORDZERO,                                               << 9378>>68611000
   JMATDONOTHING,                                              <<02375>>68612000
                                                               << 9378>>68681000
DEFINE                                                         << 9378>>68682000
   JMATWORDZEROSTATE = JMATWORDZERO.JMATSTATEFLD #;            << 9378>>68683000
LOGICAL HAD'SIR;                                               <<01470>>68711000
EQUATE STILLHASSIR = 105; << catalog err number in set 27 >>   <<01470>>68714000
           TEMP'BYTE <> ":"   LAND                             << 9725>>70675000
IF ANOTINBREAK AND NOT PROGCALL THEN                           << 9484>>74370000
   << check to see if user in break and not programatic call >><< 9484>>74371000
   IF (ALLOWMASK(OPCOMMANDWRD)&LSL(OPCOMMANDINX)) >=0          << 2217>>74870000
      AND NOT PXG'ALLOWMASK THEN                               << 2217>>74871000
                                                               << 9378>>75631100
<< Set this baby to EXEC state now that the stack is now >>    << 9378>>75631200
<< completely intact.                                    >>    << 9378>>75631300
                                                               << 9378>>75631400
PXGLOBAL;                                                      << 9378>>75631500
TOS := @JMATWORDZERO;                                          << 9378>>75631600
TOS := JMATDST;                                                << 9378>>75631700
TOS := PXG'JMATINX * JMATENTRYSIZE;                            << 9378>>75631800
TOS := 1;                                                      << 9378>>75631900
ASSEMBLE( MFDS 4 );                                            << 9378>>75632000
JMATWORDZEROSTATE := JOBEXEC;                                  << 9378>>75632100
TOS := JMATDST;                                                << 9378>>75632200
TOS := PXG'JMATINX * JMATENTRYSIZE;                            << 9378>>75632300
TOS := @JMATWORDZERO;                                          << 9378>>75632400
TOS := 1;                                                      << 9378>>75632500
ASSEMBLE( MTDS 4 );                                            << 9378>>75632600
                                                               << 9378>>75632700
<< if this is a special PC Central session, CI will just   >>  <<02375>>75641000
<< be in SON wait, and then terminates when awaken by son >>   <<02375>>75641100
PXGLOBAL;                                                      <<02375>>75641200
MOVEFROMDSEG (@JMATDONOTHING,JMATDST,                          <<02375>>75641300
   (PXG'JMATINX*JMATENTRYSIZE)+31, 1);                         <<02375>>75641400
IF JMATDONOTHING.(3:1)  THEN                                   <<02375>>75641500
   BEGIN                                                       <<02375>>75641600
   WAIT (2,0);                                                 <<02375>>75641700
   TERMINATE;                                                  <<02375>>75641800
   END;                                                        <<02375>>75641900
                                                               <<02375>>75642000
ASSEMBLE (PSDB);  << to prevent other processes from doing  >> << 9433>>75935000
                  << the same thing, i.e. release COMMDST   >> << 9433>>75936000
        SYS'GLOB'EXT (COMMDSTLOC) := 0;                        << 9433>>75961000
        ASSEMBLE (PSEB);                                       << 9433>>75962000
        << release INITIAL communication DST  >>               << 9433>>76020000
        END                                                    << 9433>>76040000
ELSE                                                           << 9433>>76041000
    ASSEMBLE (PSEB); <<  enable process switch  >>             << 9433>>76042000
DEVICE'TYPE := GET'DSDEVICE(PXG'INPUTLDEV);                    <<A9725>>76150500
IF DEVICE'TYPE = 5 THEN       <<ADS pseudo terminal   >>       <<A9725>>76150550
   BEGIN                                                       <<A9725>>76150600
   PLABEL := AS'DSPLABEL(31); <<get DSSTARTJOB plabel >>       <<A9725>>76150650
   IF PLABEL <> 0 THEN        <<ADS is installed      >>       <<A9725>>76150700
      BEGIN                   <<call DSSTARTJOB; waits>>       <<A9725>>76150750
      TOS := PLABEL;          <<for signal from ADS   >>       <<A9725>>76150800
      ASSEMBLE( PCAL 0 );     <<Virtual Terminal      >>       <<A9725>>76150850
      END;                    <<server process.       >>       <<A9725>>76150900
   END;                                                        <<A9725>>76150950
IF DEVICE'TYPE = 3 THEN       <<DS/1 pseudo terminal  >>       <<A9725>>76160000
IF TOS          << Init UDCs if they exist >>                  << 9335>>76410000
   THEN BEGIN                                                           76410100
        CHECK'UDC'ARRAY( 0 ) := FALSE;                                  76410200
        INITUDC( FALSE,,CHECK'UDC'ARRAY );                     << 9335>>76411000
        END;                                                            76412000
   THEN BEGIN                                                  << 9118>>76441000
        MOVE BLANK'LINE( 0 ) := "    ";                        << 9118>>76441010
        PRINT( BLANK'LINE, -4, 0 );                            << 9118>>76441100
        GENMSG( SYSSET, AUTOINSTALL'MSG );                     << 9118>>76450000
        END;  << IF FOS'TAPE = 1 >>                            << 9118>>76450100
         PCBPT := CURPRC;                                      <<01470>>78991000
         IF RESABORTINFO.HASSIRFLAG <> 0                       <<01470>>78992000
            THEN HAD'SIR := TRUE                               <<01470>>78993000
            ELSE HAD'SIR := FALSE;                             <<01470>>78994000
         IF NOT HAD'SIR THEN                                   <<01470>>79145000
            BEGIN                                              <<01470>>79146000
            PCBPT := CURPRC;                                   <<01470>>79150000
            IF RESABORTINFO.HASSIRFLAG <> 0  THEN              <<01470>>79155000
               BEGIN                                           <<01470>>79160000
               SYSINTERR (STILLHASSIR,1);                      <<01470>>79161000
               FREESIRS;                                       <<01470>>79162000
               UNLOCKJIR(0);                                   <<01470>>79163000
               END;                                            <<01470>>79164000
            END;                                               <<01470>>79170000
