<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$CONTROL USLINIT,MAP,CODE                                               00010000
<<UTILITY - MODULE 70>>                                                 00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$CONTROL SEGMENT= UTILITY1                                              00060000
BEGIN                                                                   00065000
$PAGE "  *** FIX  INFORMATION *** "                            <<04205>>00070000
<<**********************************************************>> <<04205>>00075000
<<                                                          >> <<04205>>00080000
<<                    FIX    INFORMATION                    >> <<04205>>00085000
<<                                                          >> <<04205>>00090000
<<  For each fix submitted, please describe                 >> <<04205>>00095000
<<  the fix and date below.                                 >> <<04205>>00100000
<<**********************************************************>> <<04205>>00105000
                                                               <<04205>>00110000
<<**********************************************************>> <<04205>>00115000
<<  Modified LOG to read in the new log record for type 8,  >> <<04205>>00120000
<< in which three words were added, extending the lenght to >> <<04205>>00125000
<< 34 words.  Also cleaned up a subroutine for readability. >> <<04205>>00130000
<<  February 10,1982                                        >> <<04205>>00135000
<<**********************************************************>> <<04205>>00140000
$PAGE                                                          <<04205>>00145000
                                                                        00150000
<< MISCELLANEOUS UTILITY INTRINSICS >>                                  00155000
<< Variable definitions for the segment of code use to call >> <<07232>>00160000
INTEGER ARRAY ARRDB6(*)=DB+6;                                  <<07232>>00165000
<< JOBINFO.                                                 >> <<07232>>00170000
                                                               <<07232>>00175000
DEFINE A  = ABSOLUTE#;                                         <<07232>>00180000
DEFINE ABSYS = %1000#,                                         <<07232>>00185000
       PCBBASE = A(3)#;                                        <<07232>>00190000
                                                               <<07232>>00195000
                                                                        00200000
                                                               <<06899>>00205000
<<*********************************************************>>  <<06899>>00210000
<<                                                         >>  <<06899>>00215000
<< The following variables are defined globally since they >>  <<06899>>00220000
<< are used by the "procedure" HRZNSYSPROC.  HRZNSYSPROC   >>  <<06899>>00225000
<< is the outer block of the Horizon data base manager and >>  <<06899>>00230000
<< is PROCREATEd by PROGEN when the system starts up.  The >>  <<06899>>00235000
<< variables used by HRZNSYSPROC should be declared in the >>  <<06899>>00240000
<< outer block so that they are DB relative, not Q         >>  <<06899>>00245000
<< relative.  DO NOT USE THESE VARIABLES OUTSIDE OF THE    >>  <<06899>>00250000
<< PROCEDURE HRZNSYSPROC.                                  >>  <<06899>>00255000
<<                                                         >>  <<06899>>00260000
<<*********************************************************>>  <<06899>>00265000
                                                               <<06899>>00270000
INTEGER                                                        <<06899>>00275000
   IDENTNUM,                                                   <<06899>>00280000
   PLABEL;                                                     <<06899>>00285000
                                                               <<06899>>00290000
LOGICAL ARRAY                                                  <<06899>>00295000
   PROCNAME'(0:20);                                            <<06899>>00300000
                                                               <<06899>>00305000
BYTE ARRAY PROCNAME(*) = PROCNAME';                            <<06899>>00310000
                                                               <<06899>>00315000
                                                               <<06899>>00320000
INTRINSIC                                                      <<06899>>00325000
   LOADPROC,                                                   <<06899>>00330000
   UNLOADPROC;                                                 <<06899>>00335000
                                                               <<06899>>00340000
<<*********************************************************>>  <<06899>>00345000
<<                                                         >>  <<06899>>00350000
<< IMPORTANT NOTE:  The PROGEN procedure AWAKEHORIZON does >>  <<06899>>00355000
<< some initialization of these global variables.  Any     >>  <<06899>>00360000
<< changes or additions to these global variables should   >>  <<06899>>00365000
<< also be reflected in PROGEN.                            >>  <<06899>>00370000
<<                                                         >>  <<06899>>00375000
<<                                                         >>  <<06899>>00380000
<< End of the HRZNSYSPROC declarations.                    >>  <<06899>>00385000
<<                                                         >>  <<06899>>00390000
<<*********************************************************>>  <<06899>>00395000
                                                                        00400000
<< GLOBAL DECLARATIONS >>                                               00405000
   LOGICAL STATUS = Q-1;                                                00410000
   DEFINE CC = STATUS.(6:2)#;                                           00415000
   EQUATE                                                               00420000
      CCE = 2,                                                          00425000
      CCG = 0,                                                          00430000
      CCL = 1;                                                          00435000
   DEFINE                                                               00440000
      DUPLICATE = ASSEMBLE (DUP)#,                                      00445000
       TRIPLICATE = ASSEMBLE(DUP,DUP)#,                                 00450000
      DELETE = ASSEMBLE (DEL)#;                                         00455000
   INTEGER XREG = X;                                                    00460000
   INTEGER X = X;                                              <<00.05>>00465000
   LOGICAL POINTER SPNTR0 = S-0;                                        00470000
   ARRAY DBARRAY (*) = DB+0;                                            00475000
   INTEGER S0 = S-0;                                                    00480000
   INTEGER S3 = S-3;                                                    00485000
   BYTE POINTER  BPS0 = S-0,  BPS1 = S-1;                               00490000
EQUATE BLNK = " ";                                             <<07232>>00495000
$INCLUDE INCLJIT                                               <<07232>>00500000
$INCLUDE INCLCAP                                               <<07232>>00505000
$INCLUDE INCLPXG                                               <<06593>>00510000
$INCLUDE PCBFINCL                                              <<06593>>00515000
$INCLUDE INCLPCB5                                              <<06594>>00520000
$INCLUDE INCLXDD5                                              <<07232>>00525000
<< These are the DEFINEs and EQUATEs for PCB stuff >>          <<07232>>00530000
DEFINE                                                         <<07232>>00535000
     USERMAIN  =2#,                                            <<07232>>00540000
     UCOP      =6#;                                            <<07232>>00545000
LOGICAL POINTER PCB = SYSPCBINDEX;                             <<06594>>00550000
<< all  EQUATES and directory for JMAT header and entries      <<07232>>00555000
EQUATE                                                         <<07232>>00560000
     MAXNUMSJ=%037777,                                         <<07232>>00565000
     PCBSIR=34,                                                <<07232>>00570000
     JOBEXEC=2,                                                <<07232>>00575000
     JOBSUSP=4,                                                <<07232>>00580000
     JOBSCHED=%70,                                             << 8202>>00585000
     JOBWAIT=%40,                                              <<07232>>00590000
     JOBCIINIT=%60,                                            <<07232>>00595000
     JOBINTRO=1,                                               <<07232>>00600000
     GRPNAME'L=4,                                              <<07232>>00605000
     JOBNAME'L=4,                                              <<07232>>00610000
     USERNAME'L=4,                                             <<07232>>00615000
     ACCTNAME'L=4;                                             <<07232>>00620000
$INCLUDE INCLJMAT                                              <<07232>>00625000
$INCLUDE INCLLPDT                                              <<07232>>00630000
<< SYSTEM INTRINSICS >>                                                 00635000
$INCLUDE INCLLDT5                                              <<07232>>00640000
<< *********************************************************** <<07232>>00645000
<< *******                                             ******* <<07232>>00650000
<< *******      EXTERNAL PROCEDURE DEFINITIONS         ******* <<07232>>00655000
<< *******                                             ******* <<07232>>00660000
<< *********************************************************** <<07232>>00665000
PROCEDURE HELP; OPTION EXTERNAL;                                        00670000
PROCEDURE ERRORON;                                                      00675000
   OPTION EXTERNAL;                                                     00680000
PROCEDURE ERROREXIT (INTRIN, ERRBYTE, PARAM);                           00685000
   VALUE INTRIN, ERRBYTE, PARAM;                                        00690000
   INTEGER INTRIN, ERRBYTE, PARAM;                                      00695000
   OPTION EXTERNAL;                                                     00700000
LOGICAL PROCEDURE FBNDVIOL(TARGET,WC,UBND);                    <<07232>>00705000
   VALUE TARGET,WC,UBND;                                       <<07232>>00710000
   INTEGER TARGET,WC,UBND;                                     <<07232>>00715000
   OPTION EXTERNAL;                                            <<07232>>00720000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,AA,B,C,D,E,          <<07232>>00725000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>00730000
    VALUE SETNO,MSGNO,MASK,AA,B,C,D,E,DEST,REPLY,BUFF,         <<07232>>00735000
      DST,IOTYPE;                                              <<0U.EB>>00740000
    LOGICAL SETNO,MSGNO,MASK,AA,B,C,D,E,DEST,REPLY,BUFF,       <<07232>>00745000
      DST,IOTYPE;                                              <<0U.EB>>00750000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>00755000
                                                               <<0U.EB>>00760000
DOUBLE PROCEDURE CHEK (I,F,P,C,O);                             <<00.05>>00765000
   VALUE   I,F,P,C,O;                                          <<00.05>>00770000
   LOGICAL I,F,O;                                              <<00.05>>00775000
   DOUBLE  P,C;                                                <<00.05>>00780000
   OPTION  EXTERNAL,VARIABLE;                                  <<00.05>>00785000
INTEGER PROCEDURE GETDATASEG (MSIZE,DSIZE);                    <<00.05>>00790000
   VALUE   MSIZE,DSIZE;                                        <<00.05>>00795000
   INTEGER MSIZE,DSIZE;                                        <<00.05>>00800000
   OPTION  EXTERNAL;                                           <<00.05>>00805000
PROCEDURE RELDATASEG (INDX);                                   <<00.05>>00810000
   VALUE   INDX;                                               <<00.05>>00815000
   INTEGER INDX;                                               <<00.05>>00820000
   OPTION EXTERNAL;                                            <<00.05>>00825000
INTEGER PROCEDURE SETCRITICAL;                                 <<00.05>>00830000
   OPTION  EXTERNAL;                                           <<00.05>>00835000
PROCEDURE RESETCRITICAL (CRIT);                                <<00.05>>00840000
   VALUE   CRIT;                                               <<00.05>>00845000
   INTEGER CRIT;                                               <<00.05>>00850000
   OPTION  EXTERNAL;                                           <<00.05>>00855000
INTEGER PROCEDURE GETSYSBUF (NUMB,IFLAG);                      <<00.05>>00860000
   VALUE   NUMB,IFLAG;                                         <<00.05>>00865000
   INTEGER NUMB;                                               <<00.05>>00870000
   LOGICAL IFLAG;                                              <<00.05>>00875000
   OPTION  EXTERNAL;                                           <<00.05>>00880000
PROCEDURE RETURNSYSBUF (INDX);                                 <<00.05>>00885000
   VALUE   INDX;                                               <<00.05>>00890000
   INTEGER INDX;                                               <<00.05>>00895000
   OPTION  EXTERNAL;                                           <<00.05>>00900000
DOUBLE PROCEDURE ATTACHIO (DU, QM, DST, BUF, FUNC, CNT, PAR1, PAR2, FL);00905000
   VALUE DU, FL, DST, QM, BUF, FUNC, CNT, PAR1, PAR2;                   00910000
   INTEGER DU, FL, DST, QM, BUF, FUNC, CNT, PAR1, PAR2;                 00915000
   OPTION EXTERNAL;                                                     00920000
INTEGER PROCEDURE EXCHANGEDB (D);                                       00925000
   VALUE D;                                                             00930000
   INTEGER D;                                                           00935000
   OPTION EXTERNAL;                                                     00940000
                                                               <<01711>>00945000
INTEGER PROCEDURE CALENDAR;                                    <<01711>>00950000
  OPTION EXTERNAL;                                             <<01711>>00955000
                                                               <<01711>>00960000
DOUBLE PROCEDURE CLOCK;                                        <<01711>>00965000
  OPTION EXTERNAL;                                             <<01711>>00970000
                                                               <<01711>>00975000
PROCEDURE SUDDENDEATH (SYSFAILNUM);                            <<01711>>00980000
  VALUE SYSFAILNUM;                                            <<01711>>00985000
  INTEGER SYSFAILNUM;                                          <<01711>>00990000
  OPTION EXTERNAL;                                             <<01711>>00995000
                                                               <<01711>>01000000
                                                               <<04223>>01005000
PROCEDURE SOFT'DEATH (SYSFAILNUM);                             <<04223>>01010000
   VALUE SYSFAILNUM;                                           <<04223>>01015000
   INTEGER SYSFAILNUM;                                         <<04223>>01020000
   OPTION EXTERNAL;                                            <<04223>>01025000
                                                               <<04223>>01030000
INTEGER PROCEDURE GETSIR (SIRNUM);                             <<01711>>01035000
  VALUE SIRNUM;   INTEGER SIRNUM;                              <<01711>>01040000
  OPTION EXTERNAL;                                             <<01711>>01045000
                                                               <<01711>>01050000
PROCEDURE RELSIR (SIRNUM, SIRSTATE);                           <<01711>>01055000
  VALUE SIRNUM, SIRSTATE;                                      <<01711>>01060000
  INTEGER SIRNUM, SIRSTATE;                                    <<01711>>01065000
  OPTION EXTERNAL;                                             <<01711>>01070000
                                                               <<01711>>01075000
LOGICAL PROCEDURE SETSYSDB;                                    <<01711>>01080000
  OPTION EXTERNAL;                                             <<01711>>01085000
                                                               <<01711>>01090000
PROCEDURE RESETDB (DSTNUM);                                    <<01711>>01095000
  VALUE DSTNUM;   INTEGER DSTNUM;                              <<01711>>01100000
  OPTION EXTERNAL;                                             <<01711>>01105000
                                                               <<01711>>01110000
PROCEDURE AWAKE (PCBPTR, WAKEEVENT, WAITEVENT);                <<01711>>01115000
  VALUE PCBPTR, WAKEEVENT, WAITEVENT;                          <<01711>>01120000
  INTEGER PCBPTR, WAITEVENT;                                   <<01711>>01125000
  LOGICAL WAKEEVENT;                                           <<01711>>01130000
  OPTION EXTERNAL;                                             <<01711>>01135000
                                                               <<01711>>01140000
PROCEDURE DELAY (MILLISECS);                                   <<01711>>01145000
  VALUE MILLISECS;   DOUBLE MILLISECS;                         <<01711>>01150000
  OPTION EXTERNAL;                                             <<01711>>01155000
                                                               <<01711>>01160000
INTEGER PROCEDURE DEVICESTATUS(LDNUM);                         <<01794>>01165000
VALUE LDNUM;                                                   <<01794>>01170000
INTEGER LDNUM;                                                 <<01794>>01175000
OPTION EXTERNAL;                                               <<01794>>01180000
                                                               <<01794>>01185000
INTRINSIC FREAD,FWRITE,FGETINFO;                               <<00.05>>01190000
INTRINSIC FATHER,QUIT,FMTCLOCK,FMTCALENDAR,GETDSEG;            <<07232>>01195000
INTEGER PROCEDURE FREADX (FNUM, BUF, LEN);                              01200000
   VALUE FNUM, LEN;                                                     01205000
   INTEGER FNUM, LEN;                                                   01210000
   ARRAY BUF;                                                           01215000
   OPTION EXTERNAL;                                                     01220000
                                                                        01225000
INTEGER PROCEDURE Get'Disc'Space (ldev, number'of'sectors,     <<03506>>01230000
                                  disc'address);               <<03506>>01235000
   VALUE ldev, number'of'sectors;                              <<03506>>01240000
   INTEGER ldev;                                               <<03506>>01245000
   DOUBLE number'of'sectors, disc'address;                     <<03506>>01250000
   OPTION EXTERNAL;                                            <<03506>>01255000
                                                               <<03506>>01260000
                                                               <<07232>>01265000
LOGICAL PROCEDURE CHECKJOB(JMATENTRY);                         <<07232>>01270000
  ARRAY JMATENTRY;                                             <<07232>>01275000
  OPTION EXTERNAL;                                             <<07232>>01280000
                                                               <<07232>>01285000
INTEGER PROCEDURE NEXTPARMD(DELIMS,STRING,PTR,DELIMPTR);       <<07232>>01290000
  BYTE ARRAY DELIMS,STRING;                                    <<07232>>01295000
  BYTE POINTER PTR,DELIMPTR;                                   <<07232>>01300000
  OPTION VARIABLE,EXTERNAL;                                    <<07232>>01305000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03506>>01310000
                             number'of'sectors);               <<03506>>01315000
   VALUE ldev, disc'address, number'of'sectors;                <<03506>>01320000
   INTEGER ldev;                                               <<03506>>01325000
   DOUBLE disc'address, number'of'sectors;                     <<03506>>01330000
   OPTION EXTERNAL;                                            <<03506>>01335000
INTEGER PROCEDURE WHERES'DB;                                   <<07232>>01340000
  OPTION PRIVILEGED,EXTERNAL;                                  <<07232>>01345000
INTEGER PROCEDURE DEVSPEC(DEVICE,BUF);                         <<07232>>01350000
VALUE DEVICE;                                                  <<07232>>01355000
INTEGER DEVICE;                                                <<07232>>01360000
BYTE ARRAY BUF;                                                <<07232>>01365000
OPTION EXTERNAL;                                               <<07232>>01370000
                                                               <<07232>>01375000
INTEGER PROCEDURE PROCINFO(ERR1,ERR2,PIN,OPT1,I1,              <<07232>>01380000
                                         OPT2,I2,              <<07232>>01385000
                                         OPT3,I3,              <<07232>>01390000
                                         OPT4,I4,              <<07232>>01395000
                                         OPT5,I5,              <<07232>>01400000
                                         OPT6,I6);             <<07232>>01405000
VALUE PIN,OPT1,OPT2,OPT3,OPT4,OPT5,OPT6;                       <<07232>>01410000
INTEGER PIN,OPT1,OPT2,OPT3,OPT4,OPT5,OPT6,ERR1,ERR2;           <<07232>>01415000
BYTE ARRAY I1,I2,I3,I4,I5,I6;                                  <<07232>>01420000
OPTION EXTERNAL,VARIABLE;                                      <<07232>>01425000
                                                               <<07232>>01430000
<< ******************************************************** >> <<07232>>01435000
<< *******   END OF EXTERNAL PROCEDURE DEFINITIONS  ******* >> <<07232>>01440000
<< ******************************************************** >> <<07232>>01445000
                                                               <<03506>>01450000
$PAGE "Procedure JOBINFO - Definition"                         <<07232>>01455000
$PAGE "UTILITY PROCEDURES"                                     <<00.05>>01460000
<< ******************************************************** >> <<07232>>01465000
<< *******                                          ******* >> <<07232>>01470000
<< *******      Procedure FIND'DAD'USERMAIN         ******* >> <<07232>>01475000
<< *******                                          ******* >> <<07232>>01480000
<< ******************************************************** >> <<07232>>01485000
INTEGER PROCEDURE FIND'DAD'USERMAIN(SONPIN);                   <<07232>>01490000
VALUE SONPIN;                                                  <<07232>>01495000
INTEGER SONPIN;                                                <<07232>>01500000
OPTION PRIVILEGED,UNCALLABLE;                                  <<*7883>>01505000
BEGIN                                                          <<07232>>01510000
COMMENT:  Returns the PIN of USER MAIN of which SONPIN         <<07232>>01515000
          originated.  Returns -1 if not found.      ;         <<07232>>01520000
INTEGER TEMPPIN,FATHER;                                        <<07232>>01525000
LOGICAL POINTER PCB = 3;                                       <<07232>>01530000
LOGICAL SUCCESS,PCBPT;                                         <<07232>>01535000
TEMPPIN:=SONPIN;                                               <<07232>>01540000
SUCCESS:=FALSE;                                                <<07232>>01545000
WHILE NOT SUCCESS DO                                           <<07232>>01550000
   BEGIN                                                       <<07232>>01555000
   PCBPT:=PCBSIZE*TEMPPIN;                                     <<07232>>01560000
   << Got word 9 from TEMPPIN's PCB, word#9 contains process >><<07232>>01565000
   << type will look for USER MAIN, if we get to UCOP abort  >><<07232>>01570000
   IF PROCSTATE.PTYPEFIELD = USERMAIN                          <<07232>>01575000
      THEN BEGIN                                               <<07232>>01580000
           SUCCESS:=TRUE;                                      <<07232>>01585000
           FIND'DAD'USERMAIN:=TEMPPIN;                         <<07232>>01590000
           END                                                 <<07232>>01595000
      ELSE IF PROCSTATE.PTYPEFIELD = UCOP                      <<07232>>01600000
              THEN BEGIN                                       <<07232>>01605000
                   SUCCESS:=TRUE;                              <<07232>>01610000
                   FIND'DAD'USERMAIN:=-1; << Caller must check <<07232>>01615000
                   << This is an error situation >>            <<07232>>01620000
                   END                                         <<07232>>01625000
              ELSE BEGIN                                       <<07232>>01630000
                   << Get FATHER to check out >>               <<07232>>01635000
                   PCBPT:=PCBSIZE*TEMPPIN;                     <<07232>>01640000
                   FATHER:=SPCBFATHERINFO;                     <<07232>>01645000
                   TEMPPIN:=FATHER;                            <<07232>>01650000
                   END; << Getting a new father candidate >>   <<07232>>01655000
   END; << While loop >>                                       <<07232>>01660000
END; << Procedure FIND'DAD'USERMAIN >>                         <<07232>>01665000
                                                               <<07232>>01670000
<< ******************************************************* >>  <<07232>>01675000
<< *******                                         ******* >>  <<07232>>01680000
<< *******          Procedure FJOBNUM              ******* >>  <<07232>>01685000
<< *******                                         ******* >>  <<07232>>01690000
<< ******************************************************* >>  <<07232>>01695000
LOGICAL PROCEDURE FJOBNUM(JMATARR, ENTRYP,JOBNUM,JOB,JNAME,    <<07232>>01700000
                           UNAME,ANAME);                       <<07232>>01705000
VALUE JOBNUM,JOB;                                              <<07232>>01710000
INTEGER ARRAY JMATARR,JNAME,UNAME,ANAME;                       <<07232>>01715000
INTEGER JOB,       ENTRYP;                                     <<07232>>01720000
DOUBLE JOBNUM;                                                 <<07232>>01725000
OPTION VARIABLE;                                               <<07232>>01730000
BEGIN                                                          <<07232>>01735000
   COMMENT                                                     <<07232>>01740000
THIS ROUTINE SEARCHES THE JMAT FOR THE SPECIFIED JOB.          <<07232>>01745000
THE JOB MAY BE SPECIFIED IN SEVERAL WAYS:                      <<07232>>01750000
   1) THE JOB # OR SESSION # MAY BE SPECIFIED                  <<07232>>01755000
   2) THE JOBNAME, USERNAME, AND ACCOUNT NAME MAY BE SPECIFIED.<<07232>>01760000
JMAT entry returned starting at JMATENTRY(JMATHEADERSIZE).     <<07232>>01765000
'JMATENTRY'.  THE JMAT HEADER IS RETURNED THROUGH JMATENTRY'S  <<07232>>01770000
1st JMATHEADERSIZE words.                                      <<07232>>01775000
***WARNING***                                                  <<07232>>01780000
WHILE THIS ROUTINE IS OPTION VARIABLE, IT MAKES NO VALIDITY    <<07232>>01785000
CHECK ON THE CONSISTENCY OF WHICH PARAMETERS ARE SPECIFIED.    <<07232>>01790000
IF THE SEARCH IS A TYPE 1) SEARCH THEN THE FOLLOWING SHOULD    <<07232>>01795000
      SPECIFIED:                                               <<07232>>01800000
         JMATENTRY,ENTRYRP,JOBNUM,JOB                          <<07232>>01805000
IF THE SEARCH IS A TYPE 2) SEARCH, THEN THE FOLLOWING SHOULD   <<07232>>01810000
      SPECIFIED:                                               <<07232>>01815000
         JMATENTRY,ENTRYP,JNAME,UNAME,ANAME            ;       <<07232>>01820000
                                                               <<07232>>01825000
                                                               <<07232>>01830000
   INTEGER ARRAY JACCT(0:ACCTNAME'L-1),                        <<07232>>01835000
                 JUSER(0:USERNAME'L-1),                        <<07232>>01840000
                 JJOB(0:JOBNAME'L-1);                          <<07232>>01845000
   LOGICAL LOCAL'FJOBNUM=FJOBNUM;                              <<07232>>01850000
   INTEGER I,LASTP,SIR,JMATINX:=JMATENTRYSIZE;                 <<07232>>01855000
   FJOBNUM:=FALSE;                                             <<07232>>01860000
   SIR:=GETSIR(JMATSIR);                                       <<07232>>01865000
<< Get JMATHEADER >>                                           <<07232>>01870000
TOS:=@JMATARR;                                                 <<07232>>01875000
TOS:=JMATDST;                                                  <<07232>>01880000
TOS:=0;                                                        <<07232>>01885000
TOS:=JMATHEADERSIZE;                                           <<07232>>01890000
ASSEMBLE( MFDS 4 );                                            <<07232>>01895000
   ENTRYP:=JMATENTRYPTR;              <<POINTER TO 1ST ENTRY>> <<07232>>01900000
   LASTP:=(JMATCURSIZE*128)-JMATENTSIZE; << PTR TO LAST ENTRY>><<07232>>01905000
   DO                                                          <<07232>>01910000
   BEGIN     <<BEGIN SCAN OF JMAT ENTRIES>>                    <<07232>>01915000
      << Get JMAT entry >>                                     <<07232>>01920000
      TOS:=@JMATARR(JMATENTRYSIZE);                            <<07232>>01925000
      TOS:=JMATDST;                                            <<07232>>01930000
      TOS:=ENTRYP;                                             <<07232>>01935000
      TOS:=JMATENTSIZE;                                        <<07232>>01940000
      ASSEMBLE( MFDS 4);                                       <<07232>>01945000
      IF  INTEGER(JMATJOBSTATE) <> 0 THEN  << VALID ENTRY >>   <<07332>>01950000
      IF JOBNUM <> 0D     <<SEARCH BY JOBNUM>>                 <<07232>>01955000
         THEN IF JOBNUM=DOUBLE(JMATJSNO)                       <<07232>>01960000
              THEN IF JMATJSTYPE = JOB                         <<07232>>01965000
                      THEN FJOBNUM:=TRUE                       <<07232>>01970000
                      ELSE                                     <<07232>>01975000
              ELSE                                             <<07232>>01980000
      ELSE BEGIN <<SEARCHING BY JOBNAME,ACCOUNTNAME,USERNAME>> <<07232>>01985000
      MOVE JACCT(0):=JMATACCTNAME,(4);                         <<07232>>01990000
      MOVE JUSER(0):=JMATUSERNAME,(4);                         <<07232>>01995000
      MOVE JJOB(0):=JMATJOBNAME,(4);                           <<07232>>02000000
      FJOBNUM:=TRUE;                                           <<07232>>02005000
      I:=-1;                                                   <<07232>>02010000
      WHILE (I:=I+1)< 4 AND LOCAL'FJOBNUM DO                   <<07232>>02015000
      IF((JUSER(I)<>UNAME(I))LOR(JACCT(I)<>ANAME(I)) LOR       <<07232>>02020000
        (JMATJSTYPE <> JOB)) THEN  FJOBNUM:=FALSE              <<07232>>02025000
        ELSE IF JNAME(0) <> "  "                               <<07232>>02030000
                THEN IF JJOB(I)<>JNAME(I) THEN FJOBNUM:=FALSE; <<07232>>02035000
      END;                                                     <<07232>>02040000
   END                                                         <<07232>>02045000
   UNTIL ((LOCAL'FJOBNUM=TRUE) LOR                             <<07232>>02050000
     ((ENTRYP:=ENTRYP+JMATENTRYSIZE)>LASTP));                  <<07232>>02055000
   RELSIR(JMATSIR,SIR);                                        <<07232>>02060000
END;                                                           <<07232>>02065000
                                                                        02070000
<< ******************************************************** >> <<07232>>02075000
<< *******                                          ******* >> <<07232>>02080000
<< *******     Procedure SPOOLINFO                  ******* >> <<07232>>02085000
<< *******                                          ******* >> <<07232>>02090000
<< ******************************************************** >> <<07232>>02095000
LOGICAL PROCEDURE SPOOLINFO(XDDN,JOBNUM,SSTUFF,CLASS,LDEV,     <<07232>>02100000
                            FNAME);                            <<07232>>02105000
VALUE XDDN,JOBNUM,CLASS,LDEV;                                  <<07232>>02110000
INTEGER XDDN,       LDEV;                                      <<07232>>02115000
LOGICAL ARRAY SSTUFF;                                          <<07232>>02120000
LOGICAL ARRAY FNAME;                                           <<07232>>02125000
DOUBLE JOBNUM;                                                 <<07232>>02130000
LOGICAL CLASS;                                                 <<07232>>02135000
OPTION PRIVILEGED;                                             <<07232>>02140000
    BEGIN                                                      <<07232>>02145000
    COMMENT:  Returns spoolfle number/spoolstate.  If XDDN is  <<07232>>02150000
    0, then the input spoolfle/state is returned if            <<07232>>02155000
    1, then the output spoolfle/state is returned, else        <<07232>>02160000
    error.                                                     <<07232>>02165000
    Also returns TRUE in SSTUFF(2) if XDDN = 1 and the aborted << 8961>>02170000
    job bit is on.                                             << 8961>>02175000
    ;                                                          <<07232>>02180000
LOGICAL ARRAY XDD'HEAD(0:SIZE'OF'XDD'HEAD-1);                  <<07232>>02185000
LOGICAL ARRAY XDD'SUBENTRY(0:SIZE'OF'XDD'SUBENTRY-1);          <<07232>>02190000
INTEGER TEMPSIR,DSTN,SAVESIR,OFFSET,LDT'INDEX,LDEV'HEAD,I;     <<07232>>02195000
LOGICAL ARRAY LDT(0:SIZE'OF'LDT'ENTRY-1);                      <<07232>>02200000
LOGICAL ARRAY SPFILENAME(0:3);                                 <<07232>>02205000
LOGICAL FOUND,ENTRYP;                                          <<07232>>02210000
SPOOLINFO := TRUE;                                             <<07232>>02215000
IF XDDN = 0   << Get IDD SIR/DST number >>                     <<07232>>02220000
   THEN BEGIN                                                  <<07232>>02225000
        TEMPSIR:=IDD'SIR;                                      <<07232>>02230000
        SAVESIR:=GETSIR(IDD'SIR);                              <<07232>>02235000
        DSTN:=IDD'DST;                                         <<07232>>02240000
        END                                                    <<07232>>02245000
   ELSE BEGIN << Get ODD SIR/DST number >>                     <<07232>>02250000
        TEMPSIR:=ODD'SIR;                                      <<07232>>02255000
        SAVESIR:=GETSIR(ODD'SIR);                              <<07232>>02260000
        DSTN:=ODD'DST;                                         <<07232>>02265000
        OFFSET:=XDD'CLASS'ENTRY;                               <<07232>>02270000
        END;                                                   <<07232>>02275000
IF CLASS = 0                                                   <<07232>>02280000
   THEN BEGIN << We have an LDEV, whether in or out >>         <<07232>>02285000
        TOS:=@LDT;                                             <<07232>>02290000
                                                               <<07232>>02295000
        TOS:=LDT'DST;                                          <<07232>>02300000
                                                               <<07232>>02305000
        TOS:=0;                                                <<07232>>02310000
        TOS:=SIZE'OF'LDT'ENTRY;                                <<07232>>02315000
        ASSEMBLE(MFDS 4);                                      <<07232>>02320000
        LDT'INDEX:=LDEV*INTEGER(LDT'ENTRY'SIZE);               <<07232>>02325000
        TOS:=@LDT;                                             <<07232>>02330000
        TOS:=LDT'DST;                                          <<07232>>02335000
        TOS:=LDT'INDEX;                                        <<07232>>02340000
        TOS:=SIZE'OF'LDT'ENTRY;                                <<07232>>02345000
        ASSEMBLE(MFDS 4);                                      <<07232>>02350000
        LDT'INDEX:=0;    << FOR THE LDT INCLUDE FILE >>        <<07232>>02355000
        LDEV'HEAD:=LDT'XDD'HEAD'ENTRY'PTR;                     <<07232>>02360000
        OFFSET:=LDEV'HEAD*INTEGER(SIZE'OF'XDD'HEAD);           <<07232>>02365000
        END;                                                   <<07232>>02370000
<< HEADER STUFF >>                                             <<07232>>02375000
TOS:=@XDD'HEAD;                                                <<07232>>02380000
TOS:=DSTN;                                                     <<07232>>02385000
TOS:=OFFSET;                                                   <<07232>>02390000
TOS:=SIZE'OF'XDD'HEAD;                                         <<07232>>02395000
ASSEMBLE(MFDS 4);                                              <<07232>>02400000
<< SET UP VARIABLES FOR LOOPING >>                             <<07232>>02405000
ENTRYP:=XDDH'FIRST'SUBENTRY;                                   <<07232>>02410000
<< LOOP >>                                                     <<07232>>02415000
FOUND:=FALSE;                                                  <<07232>>02420000
DO BEGIN                                                       <<07232>>02425000
   << XDD ENTRY >>                                             <<07232>>02430000
   TOS:=@XDD'SUBENTRY;                                         <<07232>>02435000
   TOS:=DSTN;                                                  <<07232>>02440000
   TOS:=ENTRYP;                                                <<07232>>02445000
   TOS:=SIZE'OF'XDD'SUBENTRY;                                  <<07232>>02450000
   ASSEMBLE(MFDS 4);                                           <<07232>>02455000
   MOVE SPFILENAME(0):=XDDS'FILE'NAME,(4);                     <<07232>>02460000
   IF JOBNUM = DOUBLE(XDDS'JOB'NUMBER)                        <<<07232>>02465000
      THEN BEGIN                                               <<07232>>02470000
           FOUND:=TRUE; << Assume file names will match >>     <<07232>>02475000
           I:=-1;                                              <<07232>>02480000
           WHILE(I:=I+1) < 4 DO                                <<07232>>02485000
            IF FNAME(I) <> SPFILENAME(I) THEN FOUND:=FALSE;    <<07232>>02490000
           IF FOUND = TRUE                                     <<07232>>02495000
              THEN BEGIN                                       <<07232>>02500000
                   IF XDDN = 1 AND ODDS'ABORTED'JOB = 1        << 8961>>02505000
                      THEN SSTUFF( 2 ) := TRUE                 << 8961>>02510000
                      ELSE SSTUFF( 2 ) := FALSE;               << 9063>>02515000
                   SSTUFF(0):=XDDS'DFID'NUMBER;                <<07232>>02520000
                   SSTUFF(1):=XDDS'SPOOL'STATE;                <<07232>>02525000
                   END                                         <<07232>>02530000
                   ELSE                                        <<07232>>02535000
           END;                                                <<07232>>02540000
   ENTRYP:=XDDS'NEXT'SUBENTRY;                                 <<07232>>02545000
   END                                                         <<07232>>02550000
UNTIL ((FOUND = TRUE) LOR (ENTRYP = XDDS'END'OF'CHAIN));       <<07232>>02555000
RELSIR(TEMPSIR,SAVESIR);                                       <<07232>>02560000
IF FOUND = FALSE THEN SPOOLINFO:=FALSE;                        <<07232>>02565000
END; << PROCEDURE SPOOLINFO >>                                 <<07232>>02570000
LOGICAL PROCEDURE BINARY (STRING, LENGTH);                              02575000
   VALUE LENGTH;                                                        02580000
<< FUNCTION:                                                            02585000
   CONVERT <STRING> TO 1 BINARY WORD.  OCTAL CONVERSION IF STRING(0) =  02590000
   "%";  (SIGNED) DECIMAL CONVERSION IF STRING(0) = "+", "-", OR DIGIT. 02595000
<< INPUT PARAMETERS: >>                                                 02600000
   BYTE ARRAY STRING;        <<ASCII STRING TO BE CONVERTED>>           02605000
   INTEGER LENGTH;           <<LENGTH OF STRING>>                       02610000
<< RETURNS:                                                             02615000
   CCE- SUCCESSFUL COMPLETION.                                          02620000
   CCG- OVERFLOW, INCLUDING TOO MANY CHARACTERS.                        02625000
   CCL- ILLEGAL CHARACTER, INCLUDING "8", AND "9" FOR OCTAL.  >>        02630000
   OPTION PRIVILEGED;                                                   02635000
                                                                        02640000
BEGIN                                                                   02645000
   LOGICAL BINARYHANG := [10/62, 6/2];                                  02650000
   LOGICAL RESULT_ 0, BASE_ 10;                                         02655000
   INTEGER LIM := %71, PNTR = X;                                        02660000
<< CODE >>                                                              02665000
   ERRORON;                                                             02670000
   TOS := CHEK (BINARYHANG, %102, 3D);                                  02675000
   IF LENGTH <> 0 THEN                                                  02680000
      BEGIN                                                             02685000
      IF < THEN ERROREXIT (BINARYHANG, 8, 2);                           02690000
      TOS := (@STRING +LENGTH -1) & LSR(1);                             02695000
      ASSEMBLE (DDUP, CMP);                                             02700000
      IF < THEN TOS.(0:1) := 1;                                         02705000
      XREG := TOS;                                                      02710000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (BINARYHANG, 6, 1);    02715000
      END;                                                              02720000
   XREG_ 0;                                                             02725000
   IF STRING = "%" THEN                                                 02730000
      BEGIN                                                             02735000
      LIM _ "7";                                                        02740000
      BASE_ 8;                                                          02745000
      END                                                               02750000
   ELSE IF STRING <> "+" THEN                                           02755000
         IF STRING = "-" THEN LIM := %72                                02760000
         ELSE XREG_ -1;                                                 02765000
   PUSH (STATUS);                                                       02770000
   TOS.(2:1) := 0;                                                      02775000
   SET (STATUS);                                                        02780000
   WHILE (PNTR_ PNTR+1) < LENGTH DO                                     02785000
      BEGIN                                                             02790000
      TOS_ RESULT*BASE;                                                 02795000
      IF CARRY THEN GOTO SETOVERFLOW;                                   02800000
      TOS_ STRING(PNTR);                                                02805000
      IF <= THEN GOTO SETBADCHAR;                                       02810000
      DUPLICATE;                                                        02815000
      IF TOS > LIM THEN GOTO SETBADCHAR;                                02820000
      RESULT_ TOS.(12:4)+TOS;                                           02825000
      IF CARRY THEN GOTO SETOVERFLOW;                          <<00.04>>02830000
      END;                                                              02835000
   IF LIM >= "9" THEN    <<A DECIMAL CONVERSION>>                       02840000
      IF RESULT > 32768 THEN GOTO SETOVERFLOW                           02845000
      ELSE IF = THEN    <<BETTER BE NEGATIVE>>                          02850000
            IF LIM = "9" THEN GOTO SETOVERFLOW                          02855000
            ELSE   <<SMALLEST NEGATIVE NUMBER>>                         02860000
         ELSE IF LIM = %72 THEN RESULT_ -RESULT;                        02865000
   BINARY_ RESULT;                                                      02870000
   TOS := CCE;                                                          02875000
EXIT:                                                                   02880000
   CC := TOS;                                                           02885000
   ERROREXIT (BINARYHANG, 0, 0);                                        02890000
SETOVERFLOW:                                                            02895000
   TOS := CCG;                                                          02900000
   GOTO EXIT;                                                           02905000
SETBADCHAR:                                                             02910000
   TOS := CCL;                                                          02915000
   GOTO EXIT;                                                           02920000
   HELP;  << CALL FOR LINKING TO DEBUGER >>                             02925000
END  <<BINARY>>;                                                        02930000
                                                                        02935000
                                                                        02940000
DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                                02945000
   VALUE LENGTH;  BYTE ARRAY STRING; INTEGER LENGTH;                    02950000
   OPTION PRIVILEGED;                                                   02955000
BEGIN                                                                   02960000
      LOGICAL STAT = Q-1;                                               02965000
      INTEGER TOP = S-0;                                                02970000
      INTEGER I := 0;                                                   02975000
      DOUBLE TOPD = S-1;                                                02980000
      LOGICAL HANGPARM := %11202;                                       02985000
   ERRORON;                                                             02990000
      TOS := CHEK(HANGPARM,%202, 3D);                                   02995000
      BEGIN IF LENGTH < 0 THEN ERROREXIT (HANGPARM, 8, 2);              03000000
            IF LENGTH = 0 THEN                                          03005000
                 BEGIN  TOS := 0D;                                      03010000
                        GO TO SKIP;                                     03015000
                 END;                                                   03020000
            IF LENGTH > 12 THEN GO TO ERR1;                             03025000
            ASSEMBLE(DUP);                                              03030000
      IF TOS < (XREG := (@STRING+LENGTH-1)&LSR(1)) THEN XREG.(0:1) := 1;03035000
            IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (HANGPARM, 6, 1);03040000
      END;                                                              03045000
      TOS := 0D;                                                        03050000
      IF STRING = "%" THEN                                              03055000
      BEGIN IF (LENGTH = 12) AND (STRING(1) > %63) THEN GO TO ERR1;     03060000
            WHILE (I:=I+1) < LENGTH DO                                  03065000
            BEGIN ASSEMBLE(DLSL 3);                                     03070000
                  TOS := LOGICAL(STRING(I)) - %60;                      03075000
                  IF (TOP>7) OR (TOP<0) THEN GO TO ERR2;                03080000
                  ASSEMBLE(OR)                                          03085000
            END                                                         03090000
      END                                                               03095000
      ELSE                                                              03100000
      BEGIN PUSH(STATUS);                                               03105000
            ASSEMBLE(TRBC 2);                                           03110000
            SET(STATUS);                                                03115000
            IF (STRING <> "+") AND (STRING <> "-") THEN I := I - 1;     03120000
            WHILE (I:=I+1) < LENGTH DO                                  03125000
            BEGIN IF TOPD >= %2000000000D THEN GO TO ERR1;              03130000
                  ASSEMBLE(DLSL 1; DDUP; DLSL 2; DADD);                 03135000
                  IF OVERFLOW THEN GO TO ERR1;                          03140000
                  TOS := 0;                                             03145000
                  TOS := LOGICAL(STRING(I)) - %60;                      03150000
                  IF (TOP>9) OR (TOP<0) THEN GO TO ERR2;                03155000
                  ASSEMBLE(DADD);                                       03160000
                  IF OVERFLOW THEN                                      03165000
                  BEGIN IF TOPD <> %20000000000D THEN GO TO ERR1;       03170000
                        IF STRING <> "-" THEN GO TO ERR1;               03175000
                        GO TO SKIP                                      03180000
                  END                                                   03185000
            END;                                                        03190000
            IF STRING = "-" THEN ASSEMBLE(DNEG);                        03195000
      END;                                                              03200000
SKIP: DBINARY := TOS;                                                   03205000
      STAT.(6:2) := 2;                                                  03210000
EXIT:                                                                   03215000
   ERROREXIT (HANGPARM, 0, 0);                                          03220000
ERR1: STAT.(6:2) := 0;                                                  03225000
   GOTO EXIT;                                                           03230000
ERR2: STAT.(6:2) := 1;                                                  03235000
   GOTO EXIT;                                                           03240000
END  <<DBINARY>>;                                                       03245000
                                                                        03250000
                                                                        03255000
                                                                        03260000
                                                                        03265000
INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                           03270000
   VALUE WORD, BASE;                                                    03275000
<< FUNCTION:                                                            03280000
   CONVERT <WORD> TO ASCII.  FOR BASE= 10, PERFORM SIGNED DECIMAL       03285000
   CONVERSION (STRING(0) = "-", IF NECESSARY).  >>                      03290000
<< INPUT PARAMETERS: >>                                                 03295000
   LOGICAL WORD;             <<WORD TO BE CONVERTED>>                   03300000
   INTEGER BASE;             <<8 (OCTAL), OR 10 (SIGNED DECIMAL)>>      03305000
<< OUTPUT PARAMETERS: >>                                                03310000
   BYTE ARRAY STRING;        <<RESULT. PROVIDE ROOM FOR AT LEAST 6 BYT>>03315000
   OPTION PRIVILEGED;                                                   03320000
                                                                        03325000
BEGIN                                                                   03330000
   LOGICAL ASCIIHANG := [10/63, 6/3];                                   03335000
   BYTE ARRAY TEMP (0:5) = Q;                                           03340000
   INTEGER WORDD = WORD;                                                03345000
   LOGICAL FLAGS := 0;                                                  03350000
   DEFINE START = FLAGS.(15:1) #;                                       03355000
   DEFINE RTJUST = FLAGS.(14:1) #;                                      03360000
   INTEGER LENGTH = Q-7;                                                03365000
                                                                        03370000
                                                                        03375000
SUBROUTINE CHEKIT (LEN);                                                03380000
   VALUE LEN;                                                           03385000
   INTEGER LEN;                                                         03390000
BEGIN                                                                   03395000
   TOS := CHEK (ASCIIHANG, %103, %60D);                                 03400000
      BEGIN                                                             03405000
      TOS := (@STRING +S3 -1) & LSR(1);                                 03410000
      ASSEMBLE (DDUP, CMP);                                             03415000
      IF < THEN TOS.(0:1) := 1;                                         03420000
      XREG := TOS;                                                      03425000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (ASCIIHANG, 6, 3);     03430000
      END;                                                              03435000
   END    <<SUBROUTINE CHELIT>>;                                        03440000
<< MAIN CODE >>                                                         03445000
   ERRORON;                                                             03450000
   IF BASE <> 8 THEN                                                    03455000
      BEGIN                                                             03460000
      IF BASE <> 10 THEN                                                03465000
         BEGIN    <<RT JUSTIFY REQUEST>>                                03470000
         IF BASE <> -10 THEN ERROREXIT (ASCIIHANG, 8, 2);               03475000
         RTJUST := TRUE;                                                03480000
         BASE := 10;                                                    03485000
         END;                                                           03490000
      IF WORDD < 0 THEN                                                 03495000
         BEGIN                                                          03500000
         PUSH (STATUS);                                                 03505000
         ASSEMBLE (TRBC 2);                                             03510000
         SET (STATUS);                                                  03515000
         WORDD_ -WORDD;                                                 03520000
         IF OVERFLOW THEN                                               03525000
            BEGIN                                                       03530000
            MOVE TEMP := "-32768";                                      03535000
            XREG := 0;                                                  03540000
            GOTO SETUP;                                                 03545000
            END;                                                        03550000
         START := TRUE;                                                 03555000
         END;                                                           03560000
      TOS_ WORDD;                                                       03565000
      XREG := 6;                                                        03570000
      DO BEGIN                                                          03575000
         TOS := BASE;                                                   03580000
         ASSEMBLE (DIV, DECX);                                          03585000
         TEMP(XREG) := TOS +%60;                                        03590000
         ASSEMBLE (TEST);                                               03595000
         END                                                            03600000
      UNTIL =;                                                          03605000
      IF START THEN TEMP (XREG := XREG -1) := "-";                      03610000
SETUP:                                                                  03615000
      << XREG = LEFT BYTE OF RESULT IN TEMP >>                          03620000
      LENGTH := 6 -XREG;                                                03625000
      TOS := @STRING;    <<SETUP FOR MOVE>>                             03630000
      TOS := @TEMP;                                                     03635000
      IF RTJUST THEN                                                    03640000
         BEGIN    <<RT JUSTIFICATION>>                                  03645000
         TOS := TOS +5;                                                 03650000
         TOS := -LENGTH;                                                03655000
         TOS := S0 +2;    <<(FOR BOUND. CHECK)>>                        03660000
         END                                                            03665000
      ELSE                                                              03670000
         BEGIN    <<LEFT JUSTIFY>>                                      03675000
         TOS := TOS +XREG;                                              03680000
         TOS := LENGTH;                                                 03685000
         TOS := S0;                                                     03690000
         END;                                                           03695000
      << S-0 = LENGTH 4 BOUND. CHECK >>                                 03700000
      << (S-3):(S-1) = MOVE SETUP >>                                    03705000
      CHEKIT (*);                                                       03710000
      ASSEMBLE (MVB);                                                   03715000
      END                                                               03720000
   ELSE                                                                 03725000
      BEGIN    <<OCTAL>>                                                03730000
      CHEKIT (6);                                                       03735000
      XREG := 5;                                                        03740000
      LENGTH := 1;                                                      03745000
      TOS_ WORD;                                                        03750000
      DO BEGIN                                                          03755000
         DUPLICATE;                                                     03760000
         TOS := TOS LAND 7;                                             03765000
         IF <> THEN LENGTH := 6 -XREG;                                  03770000
         STRING (XREG) := TOS + %60;                                    03775000
         TOS := TOS & LSR(3);                                           03780000
         XREG := XREG -1;                                               03785000
         END                                                            03790000
      UNTIL <;                                                          03795000
      END;                                                              03800000
                                                                        03805000
   ERROREXIT (ASCIIHANG, 0, 0);                                         03810000
END  <<ASCII>>;                                                         03815000
                                                                        03820000
                                                                        03825000
INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                             03830000
   VALUE WORD,BASE;                                                     03835000
   DOUBLE WORD; INTEGER BASE;                                           03840000
   BYTE ARRAY STRING;                                                   03845000
   OPTION PRIVILEGED;                                                   03850000
BEGIN LOGICAL SNFLG := FALSE;                                           03855000
      INTEGER J;                                                        03860000
      BYTE ARRAY LSTRING(0:10);                                         03865000
      LOGICAL HANGPARM := %11304;                                       03870000
      INTEGER LENGTH = Q-8;                                             03875000
      LOGICAL K=S-0;                                                    03880000
      DOUBLE TOP=S-1;                                                   03885000
   ERRORON;                                                             03890000
      J := 11;                                                          03895000
      TOS := WORD;                                                      03900000
      IF BASE = 8 THEN                                                  03905000
      BEGIN LENGTH := 1;                                                03910000
            WHILE (J := J-1) >= 0 DO                                    03915000
            BEGIN TOS := K LAND 7;                                      03920000
                  IF <> THEN LENGTH := 11-J;                            03925000
                  TOS := TOS + %60;                                     03930000
                  LSTRING(J) := TOS;                                    03935000
                  TOS := TOS & DLSR(3);                                 03940000
            END;                                                        03945000
      TOS := 11;                                                        03950000
            J := J + 1;                                                 03955000
            GO TO FINISH                                                03960000
      END;                                                              03965000
      IF BASE <> 10 THEN ERROREXIT (HANGPARM, 8, 2);                    03970000
      ASSEMBLE(DTST);                                                   03975000
      IF = THEN                                                         03980000
      BEGIN LSTRING(10) := %60;                                         03985000
            TOS := (LENGTH := 1);                                       03990000
            J:=10;                                                      03995000
            GO TO FINISH                                                04000000
      END;                                                              04005000
      IF < THEN                                                         04010000
      BEGIN SNFLG := TRUE;                                              04015000
            IF TOP <> %20000000000D THEN ASSEMBLE(DNEG);                04020000
      END;                                                              04025000
LOOP:                                                                   04030000
      J := J - 1;                                                       04035000
      ASSEMBLE(ZERO,CAB);                                               04040000
      TOS := 10;                                                        04045000
      ASSEMBLE(DIVL,CAB);                                               04050000
      TOS := 10;                                                        04055000
      ASSEMBLE(DIVL);                                                   04060000
      LSTRING(J) := TOS + %60;                                          04065000
      ASSEMBLE(DTST);                                                   04070000
      IF = THEN                                                         04075000
      BEGIN IF SNFLG THEN                                               04080000
            BEGIN J := J - 1;                                           04085000
                  LSTRING(J) := "-";                                    04090000
            END;                                                        04095000
            TOS := (LENGTH := 11 -J);                                   04100000
FINISH:                                                                 04105000
      TOS := CHEK (HANGPARM, %103, %61D);                               04110000
      BEGIN ASSEMBLE(DUP);                                              04115000
            IF TOS < (XREG := (@STRING+LENGTH-1) & LSR(1) )             04120000
               THEN XREG.(0:1) := 1;                                    04125000
            IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (HANGPARM, 6, 3);04130000
      END;                                                              04135000
            MOVE STRING := LSTRING (J), (S0);                           04140000
            ERROREXIT (HANGPARM, 0, 0);                                 04145000
      END;                                                              04150000
      GO TO LOOP                                                        04155000
END   <<DASCII>>;                                                       04160000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                              <<01.01>>04165000
<< AVOIDS UNDESIRABLE ESCAPE SEQUENCES AND CONTROL CHARACTERS ><<01.01>>04170000
<< HAVING UNWANTED EFFECTS WHEN DISPLAYED BY A TELL OR TELLOP ><<01.01>>04175000
<< COMMAND, OR A PRINTOP OR PRINTOPREPLY INTRINSIC,           ><<01.01>>04180000
<< TO A 2640A, 2640B, 2644A OR 2645A OR TO A GE TERMINET.     ><<01.01>>04185000
<< MAY REQUIRE MODIFICATION FOR MULTILINGUAL CAPABILITY.      ><<01.01>>04190000
VALUE LEN;                                                     <<01.01>>04195000
INTEGER LEN;  << LENGTH OF MSG IN BYTES >>                     <<01.01>>04200000
BYTE ARRAY MSG;   <<ALWAYS BEGINS ON WD BDY, MUST END WITH CR>><<U.RAO>>04205000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01.01>>04210000
BEGIN                                                          <<01.01>>04215000
   BYTE POINTER MSG'CHAR;    << POINTS TO FIRST CHARACTER IN MS<<01.01>>04220000
   BYTE POINTER CHAR;        << POINTS TO CURRENT CHARACTER >> <<01.01>>04225000
   INTEGER INDEX;            << INDEX OF CURRENT CHARACTER >>  <<01.01>>04230000
   LOGICAL DONE;             << LOOP CONTROL FLAG >>           <<01.01>>04235000
   BYTE ARRAY TEXT(0:LEN);   << HOLDS MSG TO INSURE ROOM FOR CR<<01.01>>04240000
   EQUATE                                                      <<01.01>>04245000
      BELL        =%7,                                         <<01.01>>04250000
      SHIFT'IN    =%17,                                        <<01.01>>04255000
      SHIFT'OUT   =%16,                                        <<01.01>>04260000
      CR'ESC      =%006433,                                    <<01.01>>04265000
      CR          =%15,                                        <<01.01>>04270000
      NUL         =%0,                                         <<01.01>>04275000
      ESC         =%33;                                        <<01.01>>04280000
   DEFINE                                                      <<01.01>>04285000
      SPACE          =" "#,                                    <<01.01>>04290000
      ALT'CHAR'SET   =")"#,                                    <<01.01>>04295000
      DISPLAY'ENHANCE="&d"#;                                   <<01.01>>04300000
                                                               <<01.01>>04305000
   << SCREEN OUT MSB OF EACH BYTE IN TEXT >>                   <<01.01>>04310000
   @MSG'CHAR := @MSG;                                          <<U.RAO>>04315000
   MOVE TEXT:=MSG'CHAR, (LEN);  << PUT MSG IN LOCAL ARRAY >>   <<01.01>>04320000
   @CHAR:=@TEXT;                                               <<01.01>>04325000
   WHILE (@CHAR < @TEXT(LEN)) DO                               <<01.01>>04330000
   BEGIN  << SCREEN OUT MSB OF EACH BYTE IN TEXT >>            <<01.01>>04335000
      CHAR:=BYTE(LOGICAL(CHAR) LAND %177);                     <<01.01>>04340000
      @CHAR:=@CHAR+1;                                          <<01.01>>04345000
   END;                                                        <<01.01>>04350000
   TEXT(LEN):=CR;  << CR AT END TO STOP SCANS >>               <<01.01>>04355000
                                                               <<01.01>>04360000
   << CHECK FOR ESCAPE SEQUENCE(S) >>                          <<01.01>>04365000
   @CHAR:=@TEXT;                                               <<01.01>>04370000
   DONE:=FALSE;                                                <<01.01>>04375000
   DO                                                          <<01.01>>04380000
   BEGIN                                                       <<01.01>>04385000
      SCAN CHAR UNTIL CR'ESC, 1;                               <<01.01>>04390000
      @CHAR:=TOS;                                              <<01.01>>04395000
      IF CARRY THEN                                            <<01.01>>04400000
      BEGIN  << CR FOUND >>                                    <<01.01>>04405000
         IF @CHAR >= @TEXT(LEN) THEN                           <<01.01>>04410000
            DONE:=TRUE;  << GOT A CR AT END OF TEXT >>         <<01.01>>04415000
      END                                                      <<01.01>>04420000
      ELSE  << GOT ESC ... >>                                  <<01.01>>04425000
         IF @CHAR=@TEXT(LEN-1) THEN  << GOT ESC AT END OF MSG ><<01.01>>04430000
            MSG'CHAR(@CHAR-@TEXT):=SPACE                       <<01.01>>04435000
         ELSE                                                  <<01.01>>04440000
            IF CHAR(1) = DISPLAY'ENHANCE THEN  << OK >>        <<01.01>>04445000
            ELSE                                               <<01.01>>04450000
               IF CHAR(1) = ALT'CHAR'SET THEN  << OK >>        <<01.01>>04455000
               ELSE  << UNACCEPTABLE ESCAPE SEQUENCE >>        <<01.01>>04460000
                  MSG'CHAR(@CHAR-@TEXT):=SPACE;                <<01.01>>04465000
      IF (@CHAR:=@CHAR+1) >= @TEXT(LEN) THEN DONE:=TRUE;       <<01.01>>04470000
   END                                                         <<01.01>>04475000
   UNTIL DONE;                                                 <<01.01>>04480000
                                                               <<01.01>>04485000
   << CHECK FOR CONTROL CHARACTER(S) >>                        <<01.01>>04490000
   INDEX:=0;                                                   <<01.01>>04495000
   @CHAR:=@TEXT;                                               <<01.01>>04500000
   WHILE INDEX < LEN DO                                        <<01.01>>04505000
   BEGIN                                                       <<01.01>>04510000
      WHILE CHAR(INDEX) >= SPACE                               <<01.01>>04515000
      AND INDEX < LEN-1 DO                                     <<01.01>>04520000
         INDEX:=INDEX+1;                                       <<01.01>>04525000
      IF CHAR(INDEX) < BYTE(SPACE)                             <<01.01>>04530000
      AND CHAR(INDEX) <> BYTE(NUL)                             <<01.01>>04535000
      AND CHAR(INDEX) <> BYTE(ESC)                             <<01.01>>04540000
      AND CHAR(INDEX) <> BYTE(BELL)                            <<01.01>>04545000
      AND CHAR(INDEX) <> BYTE(SHIFT'IN)                        <<01.01>>04550000
      AND CHAR(INDEX) <> BYTE(SHIFT'OUT) THEN                  <<01.01>>04555000
         MSG'CHAR(INDEX):=SPACE;  << UNACCEPTABLE CTRL CHAR >> <<01.01>>04560000
      << NEXT CHARACTER >>                                     <<01.01>>04565000
      INDEX:=INDEX+1;                                          <<01.01>>04570000
   END;                                                        <<01.01>>04575000
END;  << CLEAN'MESSAGE >>                                      <<01.01>>04580000
                                                               <<KS.02>>04585000
PROCEDURE ZEROBYTE4GENMSG(MESSAGE,LENGTH,OP);                  <<KS.02>>04590000
VALUE LENGTH,OP;                                               <<KS.02>>04595000
LOGICAL OP;                                                             04600000
INTEGER LENGTH;                                                <<KS.02>>04605000
ARRAY MESSAGE;                                                 <<KS.02>>04610000
OPTION PRIVILEGED,UNCALLABLE;                                  <<KS.02>>04615000
BEGIN                                                          <<KS.02>>04620000
   INTEGER TEMPLEN;                                            <<01458>>04625000
   BYTE ARRAY TEMPPTR(*) = Q;                                  <<01458>>04630000
   << TEMPPTR MUST BE THE LAST LOCAL DECLARATION.  ITS SPACE >><<01458>>04635000
   << IS ALLOCATED BY THE "ADDS 0" INSTRUCTION.              >><<01458>>04640000
   TEMPLEN:=IF LENGTH<0 THEN -LENGTH ELSE LENGTH&ASL(1);       <<KS.02>>04645000
   TOS:=(TEMPLEN&ASR(1))+1;<<1 EXTRA WORD FOR ZERO TERMINATOR>><<KS.02>>04650000
   ASSEMBLE(ADDS 0);                                           <<KS.02>>04655000
   TOS:=@TEMPPTR;                                              <<KS.02>>04660000
   TOS:=@MESSAGE&LSL(1);                                       <<KS.02>>04665000
   MOVE *:=*,(TEMPLEN),2; <<MOVE MESSAGE INTO STACK ARRAY>>    <<KS.02>>04670000
   BPS0:=0; <<TERMINATE MESSAGE WITH ZERO BYTE FOR GENMSG>>    <<KS.02>>04675000
   GENMSG(-1,@TEMPPTR,,,,,,,IF OP THEN 0 ELSE -2);             <<KS.02>>04680000
   PUSH(STATUS); <<RETURN GENMSG'S STATUS>>                    <<KS.02>>04685000
   TOS:=TOS.(6:2);                                             <<KS.02>>04690000
   CC:=TOS;                                                    <<KS.02>>04695000
END;                                                           <<KS.02>>04700000
                                                                        04705000
                                                                        04710000
PROCEDURE PRINT (MESSAGE, LENGTH, TYPE);                                04715000
   VALUE LENGTH, TYPE;                                                  04720000
   ARRAY MESSAGE;                                                       04725000
   INTEGER LENGTH, TYPE;                                                04730000
   OPTION PRIVILEGED;                                                   04735000
BEGIN                                                                   04740000
   ENTRY PRINT';                                                        04745000
   LOGICAL PRINTHANG := [10/65, 6/3];                                   04750000
LOGICAL PCBPT;                                                 <<06594>>04755000
PRINT':                                                                 04760000
   <<CHECK PARAMETER BOUNDS AND DB>>                                    04765000
   ERRORON;                                                             04770000
   TOS := CHEK (PRINTHANG, 3, 2D);                                      04775000
   IF LENGTH <> 0 THEN                                                  04780000
      BEGIN                                                             04785000
      XREG := @MESSAGE +                                                04790000
         (IF LENGTH < 0 THEN (-LENGTH+1) & ASR(1) ELSE LENGTH) -1;      04795000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (PRINTHANG, 6, 1);     04800000
      END;                                                              04805000
   PCBPT := CURPRC;                                            <<06594>>04810000
   IF PROCSTATE.SYSTEMPROCFLAG = 1 THEN << SYSTEM PROCESS >>   <<06594>>04815000
   BEGIN                                                       <<KS.02>>04820000
      ZEROBYTE4GENMSG(MESSAGE,LENGTH,FALSE);                   <<KS.02>>04825000
      PUSH(STATUS);                                            <<KS.02>>04830000
   END                                                         <<KS.02>>04835000
   ELSE                                                                 04840000
      BEGIN    << MAIN OR USER: GO THRU FILE SYS >>                     04845000
      FWRITE (2, MESSAGE, LENGTH, TYPE);                                04850000
      PUSH (STATUS);                                                    04855000
      END;                                                              04860000
   TOS:=TOS.(6:2);                                             <<KS.02>>04865000
   CC := TOS;                                                           04870000
   ERROREXIT (PRINTHANG, 0, 0);                                         04875000
   END  <<PRINT>>;                                                      04880000
                                                                        04885000
                                                                        04890000
PROCEDURE PRINTOP (MESSAGE, LENGTH, TYPE);                              04895000
   VALUE LENGTH, TYPE;                                                  04900000
   ARRAY MESSAGE;                                                       04905000
   INTEGER LENGTH, TYPE;                                                04910000
   OPTION PRIVILEGED;                                                   04915000
BEGIN                                                                   04920000
   LOGICAL PRINTOPHANG := [10/66, 6/3];                                 04925000
   <<CHECK PARAMETER BOUNDS AND DB>>                                    04930000
   ERRORON;                                                             04935000
   TOS := CHEK (PRINTOPHANG, 3, 2D);                                    04940000
   IF LENGTH <> 0 THEN                                                  04945000
      BEGIN                                                             04950000
      XREG := @MESSAGE +                                                04955000
         (IF LENGTH < 0 THEN (-LENGTH+1) & ASR(1) ELSE LENGTH) -1;      04960000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (PRINTOPHANG, 6, 1);   04965000
      END;                                                              04970000
   IF LENGTH < 0 THEN                                          <<01458>>04975000
      BEGIN                                                    <<01458>>04980000
      IF LENGTH < -72 THEN LENGTH := -72;                      <<01458>>04985000
      END                                                      <<01458>>04990000
   ELSE                                                        <<01458>>04995000
      IF LENGTH > 36 THEN LENGTH := 36;                        <<01458>>05000000
   TOS := LENGTH;                                                       05005000
   IF < THEN TOS := -TOS                                                05010000
   ELSE TOS := TOS & ASL(1);                                            05015000
   CLEAN'MESSAGE(MESSAGE,S0);                                  <<01.01>>05020000
   ZEROBYTE4GENMSG(MESSAGE,LENGTH,TRUE);                       <<KS.02>>05025000
   IF <> THEN CC := CCL                                        <<0U.EB>>05030000
   ELSE                                                                 05035000
      CC := CCE;                                                        05040000
                                                               <<KS.04>>05045000
   ERROREXIT (PRINTOPHANG, 0, 0);                                       05050000
   END  <<PRINTOP>>;                                                    05055000
                                                                        05060000
                                                                        05065000
INTEGER PROCEDURE READ (MESSAGE, EXPECTEDL);                            05070000
   VALUE EXPECTEDL;                                                     05075000
   ARRAY MESSAGE;                                                       05080000
   INTEGER EXPECTEDL;                                                   05085000
   OPTION PRIVILEGED;                                                   05090000
BEGIN                                                                   05095000
   ENTRY READX;                                                         05100000
   LOGICAL X := FALSE;    <<READX FLAG>>                                05105000
EQUATE CONSOLE=%1074;  <<SYS GLOBAL CELL CONTAINING CONSOLE#>> <<00552>>05110000
   LOGICAL READHANG := [10/64, 6/2];                                    05115000
LOGICAL PCBPT;                                                 <<06594>>05120000
   <<CHECK PARAMETER BOUNDS & DB>>                                      05125000
                                                                        05130000
   GOTO START;                                                          05135000
                                                                        05140000
READX:                                                                  05145000
   X := TRUE;                                                           05150000
                                                                        05155000
START:                                                                  05160000
   ERRORON;                                                             05165000
   TOS := CHEK (READHANG, %102, 2D);                                    05170000
   IF EXPECTEDL <> 0 THEN                                               05175000
      BEGIN                                                             05180000
      XREG := @MESSAGE +                                                05185000
         (IF EXPECTEDL < 0 THEN (-EXPECTEDL+1)&ASR(1) ELSE EXPECTEDL)-1;05190000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (READHANG, 6, 1);      05195000
      END;                                                              05200000
PCBPT := CURPRC;                                               <<06594>>05205000
IF PROCSTATE.SYSTEMPROCFLAG = 1 THEN << SYSTEM PROCESS >>      <<06594>>05210000
      BEGIN    << SYS PROCESS: DO ATTACHIO DIRECTLY >>                  05215000
                                                               <<00552>>05220000
TOS:=ATTACHIO(ABSOLUTE(CONSOLE),0,0,@MESSAGE,                  <<06894>>05225000
            0, EXPECTEDL, 0, 0, 1);                                     05230000
      ASSEMBLE (TEST);                                                  05235000
      IF < THEN TOS := -TOS;                                            05240000
      ASSEMBLE (XCH);                                                   05245000
      TOS := IF TOS.(13:3) = 2 THEN CCG                                 05250000
            ELSE IF > THEN CCL ELSE CCE;                                05255000
      END                                                               05260000
   ELSE                                                                 05265000
      BEGIN    << MAIN OR USER: USE FILE SYS >>                         05270000
      TOS := 0;    <<SETUP FOR FREAD OR FREADX CALL>>                   05275000
      TOS := 1;                                                         05280000
      TOS := @MESSAGE;                                                  05285000
      TOS := EXPECTEDL;                                                 05290000
      TOS := IF X THEN FREADX (*, *, *) ELSE FREAD (*, *, *);           05295000
      PUSH (STATUS);    <<RETURN STATUS>>                               05300000
      TOS := TOS.(6:2);                                                 05305000
      END;                                                              05310000
   CC := TOS;                                                           05315000
   READ := TOS;    <<LENGTH>>                                           05320000
   ERROREXIT (READHANG, 0, 0);                                          05325000
   END  <<READ>>;                                                       05330000
                                                                        05335000
                                                                        05340000
INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);                  05345000
   VALUE LENGTH;                                                        05350000
<< FUNCTION:                                                            05355000
   SEARCH <DICT> FOR <TARGET>.  >>                                      05360000
<< INPUT PARAMETERS: >>                                                 05365000
   BYTE ARRAY TARGET;        <<STRING TO SEARCH FOR>>                   05370000
   INTEGER LENGTH;           <<LENGTH OF <TARGET>.>>                    05375000
   BYTE ARRAY DICT;          <<"DICTIONARY" FOR SEARCH.  EACH ENTRY:    05380000
      1. BYTE LENGTH OF ITEMS 1+2+3+4.  (1 BYTE)                        05385000
      2. BYTE LENGTH OF ITEM 2. (1 BYTE)                                05390000
      3. THE "WORD" FOR THIS ENTRY.                                     05395000
      4. (OPTIONAL) A CALLER-RELEVANT "DEFINITION" (>= 0 BYTES LONG).   05400000
      LAST ENTRY HAS 0 ENTRY LENGTH. >>                                 05405000
<< OUTPUT PARAMETER: >>                                                 05410000
   BYTE POINTER DEFN;        <<(OPTIONAL) BYTE ADDR OF ITEM 4>>         05415000
   OPTION VARIABLE, PRIVILEGED;                                         05420000
                                                                        05425000
BEGIN                                                                   05430000
   LOGICAL SEARCHHANG := [10/70, 6/5];                                  05435000
   LOGICAL PARMCOUNT = Q-4;                                             05440000
   LOGICAL LLENGTH = LENGTH;                                            05445000
   BYTE POINTER PNTR = DICT;                                            05450000
   INTEGER COUNT_ 0;                                                    05455000
   INTEGER X=      X,                                          <<09.KM>>05460000
           S0=     S-0,                                        <<09.KM>>05465000
           UBOUND= SEARCH-1;                                   <<09.KM>>05470000
   DEFINE COMPARE2 = ASSEMBLE (CMPB 2)#;                                05475000
<< CODE >>                                                              05480000
   ERRORON;                                                             05485000
   TOS := CHEK (SEARCHHANG, %104, %263D, , 1);                          05490000
   IF LLENGTH > 0 THEN                                                  05495000
      BEGIN                                                             05500000
      IF LLENGTH > 254 THEN ERROREXIT (SEARCHHANG, 8, 2);               05505000
      TOS := (@TARGET+LENGTH-1) &LSR(1);                                05510000
      ASSEMBLE (DDUP, CMP);                                             05515000
      IF < THEN TOS.(0:1) := 1;                                         05520000
      XREG := TOS;                                                      05525000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (SEARCHHANG, 6, 1);    05530000
      END;                                                              05535000
   TOS:=TOS:=@PNTR&LSR(1);                                     <<09.KM>>05540000
   IF TOS>@S0 THEN TOS.(0:1):=1;       <<WD ADR OF CUR ENTRY>> <<09.KM>>05545000
                                                               <<09.KM>>05550000
   WHILE PNTR<>0 DO                                            <<09.KM>>05555000
      BEGIN                                                             05560000
      COMMENT:                                                 <<09.KM>>05565000
        S-0 = WORD-ADDR OF CURRENT ENTRY.                      <<09.KM>>05570000
                                                               <<09.KM>>05575000
        ADDRESS OF NEXT ENTRY MUST LIE BETWEEN CURRENT ENTRY   <<09.KM>>05580000
        AND CALLING SEQUENCE ("UBOUND").  RANGE CHECK IS       <<09.KM>>05585000
        NECESSARY DUE TO POSSIBLE INVALID WRAP-AROUND INTO     <<09.KM>>05590000
        DB-MINUS AREA DURING BYTE-WORD ADDRESS CONVERSION;     <<09.KM>>05595000
                                                               <<09.KM>>05600000
      TOS:=TOS:=@PNTR(PNTR)&LSR(1);                            <<09.KM>>05605000
      IF TOS>@S0 THEN TOS.(0:1):=1;    <<WD ADR OF NEXT ENTRY>><<09.KM>>05610000
      IF NOT (TOS<=TOS<=@UBOUND)                               <<09.KM>>05615000
         THEN ERROREXIT(SEARCHHANG,6,3);                       <<09.KM>>05620000
      TOS:=X;                          <<WD ADR OF NEXT ENTRY>><<09.KM>>05625000
      COUNT_ COUNT+1;                                                   05630000
      IF INTEGER(PNTR(1)) = LENGTH THEN                                 05635000
         BEGIN                                                          05640000
         TOS_ @PNTR(XREG+1);                                            05645000
         TOS_ @TARGET;                                                  05650000
         TOS_ LENGTH;                                                   05655000
         COMPARE2;                                                      05660000
         IF = THEN                                                      05665000
            BEGIN                                                       05670000
            IF PARMCOUNT THEN @DEFN := TOS;                             05675000
            SEARCH_ COUNT;                                              05680000
            ERROREXIT (SEARCHHANG, 0, 0);                               05685000
            END;                                                        05690000
         DELETE;                                                        05695000
         END;                                                           05700000
      @PNTR:=@PNTR(PNTR);              <<IN BNDS, SEE 1ST TST>><<09.KM>>05705000
      END;                                                              05710000
   SEARCH_ 0;                                                           05715000
   ERROREXIT (SEARCHHANG, 0, 0);                                        05720000
END  <<SEARCH>>;                                                        05725000
                                                                        05730000
                                                                        05735000
PROCEDURE WHO                                                           05740000
   (MODE, CAPABILITY, LATTR, USERN, GROUPN, ACCTN, HOMEN, TERMNUM);     05745000
   LOGICAL MODE, TERMNUM;                                               05750000
   DOUBLE CAPABILITY, LATTR;                                            05755000
   BYTE ARRAY USERN, GROUPN, ACCTN, HOMEN;                              05760000
   OPTION VARIABLE, PRIVILEGED;                                         05765000
BEGIN                                                                   05770000
   LOGICAL WHOHANG := [10/69, 6/9];                                     05775000
   LOGICAL PARMCNT = Q-4;                                               05780000
   INTEGER ARRAY BPARMS (*) = Q-9;                                      05785000
   INTEGER CAPAD = Q-11;                                                05790000
   INTEGER LATAD = Q-10;                                                05795000
   LOGICAL LS0 = S-0;                                                   05800000
   INTEGER PCBGLOBLOC;                                         <<06593>>05805000
   ARRAY QARRAY(*) = Q + 0;                                    <<06593>>05810000
   INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                   <<06895>>05815000
   BYTE ARRAY BJITARR(*)=JITARR;                               <<06895>>05820000
   INTEGER ARRAY WCAPS(*) = CAPABILITY;                        <<06895>>05825000
   INTEGER ARRAY WLATTRS(*) = LATTR;                           <<06895>>05830000
<< >>                                                                   05835000
   ERRORON;                                                             05840000
   CHEK (WHOHANG, 8, %137752D, , %377);                                 05845000
<< BEGINNING ADDRESSES IN BOUNDS; NOW CHECK ENDING ADDRESSES >>         05850000
   CAPAD := CAPAD +1;                                                   05855000
   LATAD := LATAD +1;                                                   05860000
   XREG := 3;                                                           05865000
   DO BEGIN                                                             05870000
      BPARMS (XREG) := BPARMS (XREG) +7;                                05875000
      XREG := XREG -1;                                                  05880000
      END                                                               05885000
   UNTIL <;                                                             05890000
   CHEK (WHOHANG, 8, %37750D, , %377);                                  05895000
   << Return the addresses of the Byte Array Parameters to >>  <<06895>>05900000
   << their original values                                >>  <<06895>>05905000
   XREG:=3;                                                    <<06895>>05910000
   DO BEGIN                                                    <<06895>>05915000
      BPARMS(XREG):=BPARMS(XREG)-7;                            <<06895>>05920000
      XREG:=XREG-1;                                            <<06895>>05925000
      END                                                      <<06895>>05930000
      UNTIL <;                                                 <<06895>>05935000
   TOS := PARMCNT;                                                      05940000
<< GET PCBX STUFF >>                                                    05945000
   PXGLOBAL;                                                   <<06593>>05950000
   IF LS0 THEN                                                          05955000
      TERMNUM := PXG'INPUTLDEV;                                <<06593>>05960000
   IF LS0 & LSR (7) THEN                                                05965000
      BEGIN                                                    <<06593>>05970000
        MODE.(15:1) := PXG'INTERACTIVE;                        <<06593>>05975000
        MODE.(14:1) := PXG'DUPLICATIVE;                        <<06593>>05980000
        MODE.(12:2) := PXG'JOBTYPE;                            <<06593>>05985000
        MODE.(0:12) := 0;  <<zero out top bits >>              <<07172>>05990000
        END;                                                   <<06593>>05995000
<< GET JIT STUFF, IF NECESSARY >>                                       06000000
   TOS := TOS LAND %176;                                                06005000
   IF > THEN                                                            06010000
      BEGIN                                                    <<06895>>06015000
      TOS:=@JITARR;                                            <<06895>>06020000
      TOS:=PXG'JITDST;                                         <<06895>>06025000
      TOS:=0;                                                  <<06895>>06030000
      TOS:=JIT'ENTRY'SIZE;                                     <<06895>>06035000
      ASSEMBLE (MFDS 4);                                       <<06895>>06040000
      PXGLOBAL;                                                <<06593>>06045000
      IF LS0 & LSR(6) THEN                                              06050000
         BEGIN                                                          06055000
         CAPAD := CAPAD -1;                                             06060000
         MOVE WCAPS(0):=JITUSERCAPS,(2);                       <<06895>>06065000
         END;                                                           06070000
      IF LS0 & LSR(5) THEN                                              06075000
         BEGIN                                                          06080000
         LATAD := LATAD -1;                                             06085000
         MOVE WLATTRS:=JITLOCALATTR,(2);                       <<06895>>06090000
         END;                                                           06095000
      IF LS0 & LSR(4) THEN                                              06100000
         MOVE USERN:=BJITUSERNAME,(8);                         <<06895>>06105000
      IF LS0 & LSR(3) THEN                                              06110000
         MOVE GROUPN:=BJITLOGONGROUP,(8);                      <<06895>>06115000
      IF LS0 & LSR(2) THEN                                              06120000
         MOVE ACCTN:=BJITHACCTNAME,(8);                        <<06895>>06125000
      IF LS0 & LSR(1) THEN                                              06130000
         MOVE HOMEN:=BJITHOMEGROUP,(8);                        <<06895>>06135000
      END;                                                              06140000
   ERROREXIT (WHOHANG, 0, 0);                                           06145000
   END    <<WHO>>;                                                      06150000
                                                                        06155000
                                                                        06160000
INTEGER PROCEDURE MYCOMMAND                                             06165000
   (COMIMAGE, DELIMITERS, MAXPARMS, NUMPARMS, PARMS, DICT, DEFN);       06170000
      VALUE MAXPARMS;                                                   06175000
<< FUNCTION:                                                            06180000
   EXTRACT AND FORMAT THE PARAMETERS OF <COMIMAGE>, AND (OPTIONALLY)    06185000
   EXTRACT A "COMMAND" AND SEARCH <DICT>. >>                            06190000
<< INPUT PARAMETERS: >>                                                 06195000
   BYTE ARRAY COMIMAGE;      <<(COMMAND AND) PARAMETERS IN AMOS FORMAT>>06200000
   BYTE ARRAY DELIMITERS;    <<(OPT.) ARRAY OF ADMISSABLE DELIMITERS>>  06205000
   INTEGER MAXPARMS;         <<SIZE OF PARMS IN DOUBLE-WORDS>>          06210000
   BYTE ARRAY DICT;          <<(OPTIONAL) EXTRACT COMMAND AND SEARCH >> 06215000
<< OUTPUT PARAMETERS: >>                                                06220000
   INTEGER NUMPARMS;          << NUMBER OF PARAMETERS IN COMIMAGE >>    06225000
   DOUBLE ARRAY PARMS;       <<PARAMETER DESCRIPTORS.  EACH DOUBLE:     06230000
      WORD 1: BYTE POINTER TO FIRST CHARACTER.                          06235000
      WORD 2: (11:5) = 0  FOLLOWED BY COMMA.                            06240000
                     = 1  FOLLOWED BY EQUAL.                            06245000
                     = 2  FOLLOWED BY SEMI-COLON.                       06250000
                     = 3  LAST PARAMETER.                               06255000
                     OR, IF <DELIMITERS> SPECIFIED, THEN BYTE DISP.     06260000
              (8:1)  = 1  CONTAINS ALPHABETICS.                         06265000
              (9:1)  = 1  CONTAINS NUMERICS.                            06270000
              (10:1) = 1  CONTAINS SPECIALS.                            06275000
              (0:8)  = LENGTH IN BYTES (0 IF OMITTED) >>                06280000
   BYTE POINTER DEFN;        <<   (SEE SEARCH INTRINSIC)  >>            06285000
   OPTION VARIABLE;                                                     06290000
<< RETURNS:                                                             06295000
   CCE- PARAMETERS FORMATTED. DICT NOT SUPPLIED, OR MYCOMMAND RETURNS   06300000
        COMMAND NUMBER (SEE SEARCH INTRINSIC).                          06305000
   CCG- TOO MANY PARAMETERS. <PARMS> FILLED WITH 1ST <MAXPARMS> OF THEM.06310000
   CCL- <DICT> SUPPLIED BUT COMMAND NOT FOUND. NO FORMATTING. >>        06315000
OPTION PRIVILEGED;                                                      06320000
BEGIN                                                                   06325000
   INTEGER S0 = S-0;                                                    06330000
   LOGICAL MYCOMMANDHANG := [10/71, 6/8];                               06335000
   LOGICAL PARMCOUNT = Q-4;                                             06340000
   BYTE POINTER PNTR = COMIMAGE;                                        06345000
   LOGICAL LMAXPARMS = MAXPARMS;                                        06350000
   LOGICAL START, ENDX;                                                 06355000
   BYTE POINTER COMMAND = START;                                        06360000
   INTEGER LENGTH = ENDX;                                               06365000
   LOGICAL CRBLANK _ %6440;                                             06370000
   LOGICAL                                                              06375000
      X1 := ",=",                                                       06380000
      X2 := %35415;                                                     06385000
   LOGICAL LASTFLAG := FALSE;                                           06390000
   DOUBLE LIMS;                                                         06395000
<< CODE >>                                                              06400000
   ERRORON;                                                             06405000
   TOS := (LIMS := CHEK (MYCOMMANDHANG, %107, %27217D, , %43));         06410000
   IF LMAXPARMS > 0 THEN                                                06415000
      BEGIN                                                             06420000
      IF LMAXPARMS > %20000 THEN ERROREXIT (MYCOMMANDHANG, 8, 3);       06425000
      XREG := @PARMS + (MAXPARMS & ASL(1)) - 1;                         06430000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (MYCOMMANDHANG, 6, 5); 06435000
      END;                                                              06440000
   IF PARMCOUNT.(14:1) THEN                                             06445000
      BEGIN                                 <<EXTRACT COMMAND>>         06450000
      TOS := @PNTR;                                                     06455000
      ASSEMBLE (DUP, DUP);                                              06460000
      @COMMAND_ TOS;                                                    06465000
      MOVE * := * WHILE ANS, 0;                                <<04697>>06470000
      @PNTR_ TOS;                                                       06475000
      LENGTH_ TOS-@COMMAND;                                             06480000
      IF NOT(PARMCOUNT) THEN TOS := SEARCH (COMMAND, LENGTH, DICT)      06485000
      ELSE TOS_ SEARCH (COMMAND, LENGTH, DICT,  DEFN);                  06490000
      IF (MYCOMMAND _ TOS) = 0 THEN                                     06495000
         BEGIN                                                          06500000
         CC_ CCL;                                                       06505000
         ERROREXIT (MYCOMMANDHANG, 0, 0);                               06510000
         END;                                                           06515000
      IF CARRY THEN ERROREXIT (MYCOMMANDHANG, 21, 0);                   06520000
      END                                                               06525000
   ELSE MYCOMMAND _ 0;                                                  06530000
   IF NOT(PARMCOUNT.(10:1)) THEN @DELIMITERS := @X1 & LSL(1);           06535000
<< FORMAT PARAMETERS >>                                                 06540000
   XREG := 0;                                                           06545000
NEXTPARM:                                                               06550000
   SCAN PNTR WHILE CRBLANK, 1;                                          06555000
   ASSEMBLE (DUP, DUP);                                                 06560000
   @PNTR_ TOS;                                                          06565000
   START_ TOS;                                                          06570000
   TOS _ 0;                                                             06575000
   GOTO SCANALPHNUM;                                                    06580000
DOBLANK:                                                                06585000
   SCAN PNTR WHILE CRBLANK, 1;                                          06590000
   @PNTR_ TOS;                                                          06595000
   IF < THEN GOTO CHECKFUNNY;                                           06600000
DOSPECIAL:                                                              06605000
   TOS := TOS LOR %40;                                                  06610000
SCANALPHNUM:                                                            06615000
   TOS_ PNTR;                                                           06620000
   ASSEMBLE (DEL);                                                      06625000
   IF = THEN                                                            06630000
      BEGIN    <<ALPHABETIC>>                                           06635000
ALPH: TOS := TOS LOR %200;                                              06640000
      TOS_ @PNTR;                                                       06645000
      ASSEMBLE (DUP);                                                   06650000
      MOVE * := * WHILE AS, 1;                                          06655000
      @PNTR_ TOS;                                                       06660000
      END;                                                              06665000
   IF > THEN                                                            06670000
      BEGIN    <<NUMERIC>>                                              06675000
      TOS := TOS LOR %100;                                              06680000
      TOS_ @PNTR;                                                       06685000
      ASSEMBLE (DUP);                                                   06690000
      MOVE *_ * WHILE N, 1;                                             06695000
      @PNTR_ TOS;                                                       06700000
      END;                                                              06705000
   IF = THEN GOTO ALPH;                                                 06710000
   ENDX_ @PNTR;                                                         06715000
<< POSSIBILITIES NOW:                                                   06720000
   1. A DELIMETER,                                                      06725000
   2. A BLANKS-FIELD WITHIN PARAMETER,                                  06730000
   3. A BLANKS-FIELD JUST BEFORE DELIMETER, OR                          06735000
   4. A SPECIAL CHARACTER THAT'S PART OF PARAMETER. >>                  06740000
CHECKFUNNY:                                                             06745000
   SCAN DELIMITERS UNTIL (%6400 LOR LOGICAL(PNTR)), 1;                  06750000
   IF CARRY THEN                                                        06755000
      << 1. CHARACTER IS CR,                                            06760000
         2. CHARACTER IS SPECIAL OR BLANK.  >>                          06765000
      BEGIN                                                             06770000
      TOS := PNTR;                                                      06775000
      IF S0 <> %15 THEN                                                 06780000
         BEGIN                                                          06785000
         ASSEMBLE (DELB);                                               06790000
         @PNTR := @PNTR+1;                                              06795000
         IF TOS = " " THEN GOTO DOBLANK;                                06800000
         GOTO DOSPECIAL;                                                06805000
         END;                                                           06810000
      LASTFLAG := TOS;                                                  06815000
      TOS := XREG;                                                      06820000
      TOS := LIMS;                                                      06825000
      TOS := @PNTR & LSR(1);                                            06830000
      ASSEMBLE (DDUP, CMP);                                             06835000
      IF < THEN TOS.(0:1) := 1;                                         06840000
      XREG := TOS;                                                      06845000
      IF NOT (TOS <= XREG <= TOS) THEN ERROREXIT (MYCOMMANDHANG, 6, 1); 06850000
      XREG := TOS;                                                      06855000
      END;                                                              06860000
<< A DELIMITER FOUND >>                                                 06865000
   TOS := TOS-@DELIMITERS;    <<DELIMITER POSITION IN <DELIMITERS>.>>   06870000
   IF LOGICAL (S0) > 31 THEN ERROREXIT (MYCOMMANDHANG, 6, 2);           06875000
   TOS := ENDX-START;    <<PARAMETER LENGTH>>                           06880000
   <<SPECIAL CASE: NO PARAMETERS IN IMAGE>>                             06885000
      IF = AND LASTFLAG AND XREG = 0 THEN GOTO EXITOK;                  06890000
   IF LOGICAL (S0) > 255 THEN ERROREXIT (MYCOMMANDHANG, 20, 1);         06895000
   TOS := TOS LOR (TOS LOR (TOS & LSL(8)));                             06900000
   IF XREG >= MAXPARMS THEN                                             06905000
      BEGIN                                                             06910000
      CC := CCG;                                                        06915000
      GOTO EXIT;                                                        06920000
      END;                                                              06925000
   PARMS (XREG) := TOS;                                                 06930000
   XREG := XREG+1;                                                      06935000
   @PNTR := @PNTR+1;                                                    06940000
   IF NOT(LASTFLAG) THEN GOTO NEXTPARM;                                 06945000
EXITOK: CC := CCE;                                                      06950000
EXIT:   IF PARMCOUNT.(12:1) THEN NUMPARMS := XREG;                      06955000
   ERROREXIT (MYCOMMANDHANG, 0, 0);                                     06960000
END  <<MYCOMMAND>>;                                                     06965000
$PAGE                                                                   06970000
INTEGER PROCEDURE PRINTOPREPLY(MESSAGE,LENGTH,CONTROL,REPLY,            06975000
    REPLYLENGTH);                                                       06980000
VALUE LENGTH,CONTROL,REPLYLENGTH;                                       06985000
INTEGER                                                                 06990000
  LENGTH,      <<CONSOLE MESSAGE LENGTH-NEGATIVE FOR BYTES>>            06995000
  CONTROL,     <<OVERRIDE FOR STANDARD CONTROL-0=STANDARD CONTROL>>     07000000
  REPLYLENGTH; <<MAX ALLOWED REPLY LENGTH-NEGATIVE FOR BYTES>>          07005000
ARRAY                                                                   07010000
  MESSAGE,     <<TEXT TO BE OUTPUT TO CONSOLE>>                         07015000
  REPLY  ;     <<BUFFER FOR REPLY>>                                     07020000
OPTION PRIVILEGED;                                                      07025000
BEGIN                                                                   07030000
  LOGICAL PRINTOPRHANG:=[10/67,6/5]; <<INTRINSIC NUMBER=67>>            07035000
  LOGICAL POINTER TREPLY;                                               07040000
   ARRAY TEMP(0:25); BYTE ARRAY BTEMP(*)=TEMP;                 <<KS.02>>07045000
LOGICAL OUTVAL=PRINTOPREPLY;                                            07050000
  INTEGER S0=S-0;                                                       07055000
   INTEGER MAXCHARS;                                           <<06.EB>>07060000
  EQUATE CATNO=210;    <<MESSAGE NUMBER>>                               07065000
  IF REPLYLENGTH=0 THEN                                                 07070000
   BEGIN                                                                07075000
     IF LENGTH=0 THEN                                                   07080000
      BEGIN                                                             07085000
        CC:=CCL;                                                        07090000
        PRINTOPREPLY:=0;                                                07095000
        RETURN                                                          07100000
       END                                                              07105000
    ELSE BEGIN                                                          07110000
      PRINTOP(MESSAGE,LENGTH,CONTROL);                                  07115000
      IF= THEN CC:=CCE ELSE CC:=CCL;                                    07120000
      PRINTOPREPLY:=0;                                                  07125000
      RETURN;                                                           07130000
     END;                                                               07135000
    END;                                                                07140000
  ERRORON;                                                              07145000
<< CHECK PARAMETERS,BOUNDS>>                                            07150000
  TOS:=CHEK(PRINTOPRHANG,3,2D);                                         07155000
  ASSEMBLE(DDUP);                                                       07160000
  XREG:=@MESSAGE+(IF LENGTH <0 THEN(-LENGTH+1)&ASR(1)ELSE LENGTH)-1;    07165000
  IF NOT(TOS<=XREG<=TOS) THEN ERROREXIT(PRINTOPRHANG,6,1);              07170000
  XREG:=@REPLY+(IF REPLYLENGTH <0 THEN(-REPLYLENGTH+1)& ASR(1)          07175000
                                     ELSE REPLYLENGTH)-1;               07180000
  IF NOT(TOS<=XREG<=TOS) THEN  ERROREXIT(PRINTOPRHANG,6,4);             07185000
   MAXCHARS := IF REPLYLENGTH < 0 THEN -REPLYLENGTH            <<06.EB>>07190000
      ELSE REPLYLENGTH*2; << CONVERT TO BYTE COUNT >>          <<06.EB>>07195000
   IF MAXCHARS > 31 THEN MAXCHARS := 31;                       <<01458>>07200000
  IF LENGTH < 0 THEN                                           <<01458>>07205000
     BEGIN                                                     <<01458>>07210000
     IF LENGTH < -50 THEN LENGTH := -50;                       <<01458>>07215000
     END                                                       <<01458>>07220000
  ELSE                                                         <<01458>>07225000
     IF LENGTH > 25 THEN LENGTH := 25;                         <<01458>>07230000
   TOS:=@BTEMP;                                                <<KS.02>>07235000
   TOS:=@MESSAGE&LSL(1);                                       <<KS.02>>07240000
  TOS:=LENGTH;                                                          07245000
  IF < THEN TOS:=-TOS ELSE TOS:=TOS&ASL(1); <<BYTE COUNT>>              07250000
   CLEAN'MESSAGE(MESSAGE,S0);                                           07255000
   ASSEMBLE(MVB ,2); <<MOVE MESSAGE INTO TEMPORARY ARRAY>>     <<KS.02>>07260000
   BPS0:=0;         <<GENMSG NEEDS ZERO BYTE TERMINATOR>>      <<KS.02>>07265000
   DEL;                                                        <<KS.02>>07270000
  TOS:=REPLYLENGTH;                                                     07275000
  IF < THEN TOS:=(-TOS+1)&ASR(1); <<WORD COUNT>>                        07280000
  TOS:=TOS+1;<<1 MORE WD FOR RETURNED LENGTH>>                          07285000
  DUPLICATE;                                                            07290000
  ASSEMBLE(LRA S-0);                                                    07295000
  @TREPLY:=TOS;                                                         07300000
  ASSEMBLE (ADDS 0);                                                    07305000
   GENMSG(1,210,%1000,@BTEMP,MAXCHARS,,,,                      <<KS.02>>07310000
     0,MAXCHARS&LSL(8)+4,@TREPLY); << REPLEN=MAXCHARS,TYPE=4>> <<01458>>07315000
  IF <> THEN                                                   <<0U.EB>>07320000
    BEGIN                                                               07325000
      PRINTOPREPLY:=0;                                                  07330000
      CC:=CCL;                                                          07335000
      ERROREXIT(PRINTOPRHANG,0,0);                                      07340000
    END                                                                 07345000
    ELSE CC:=CCE;                                                       07350000
  TOS:=@REPLY&LSL(1);                                          <<00.06>>07355000
  TOS:=(@TREPLY+1)&LSL(1);                                     <<00.06>>07360000
  OUTVAL := MAXCHARS;                                          <<01458>>07365000
   IF OUTVAL>TREPLY THEN OUTVAL:=TREPLY;                                07370000
   MOVE *:=*,(OUTVAL);                                                  07375000
   IF REPLYLENGTH>0 THEN OUTVAL:=(OUTVAL+1)&ASR(1);                     07380000
                                                                        07385000
  ERROREXIT(PRINTOPRHANG,0,0);                                          07390000
END; <<PRINTOPREPLY>>                                                   07395000
$PAGE                                                                   07400000
$CONTROL SEGMENT= UTILITY2                                              07405000
PROCEDURE CTRANSLATE(CODE,INSTRING,OUTSTRING,STRINGLENGTH,              07410000
   TABLE);                                                              07415000
VALUE CODE,STRINGLENGTH;                                                07420000
INTEGER CODE,STRINGLENGTH;                                              07425000
BYTE ARRAY INSTRING,OUTSTRING,TABLE;                                    07430000
OPTION PRIVILEGED,VARIABLE;                                             07435000
BEGIN                                                                   07440000
     LOGICAL PMAP = Q-4;                                                07445000
     LOGICAL CTRANSHANG :=[10/61,6/6];                         <<WH.17>>07450000
     LOGICAL SPLITSTACK:=FALSE;                                         07455000
     INTEGER X =X;                                                      07460000
     INTEGER BERRTYPE;     <<BOUNDS VIOLATION TYPE>>                    07465000
     EQUATE                                                    <<01736>>07470000
          CODEMAX = 6;                                         <<01736>>07475000
     DOUBLE                                                    <<01736>>07480000
          BOUNDS;       << RETURN FROM CHEK. >>                <<01736>>07485000
     INTEGER                                                   <<01736>>07490000
          LOWERBOUND = BOUNDS,                                 <<01736>>07495000
          UPPERBOUND = BOUNDS + 1;                             <<01736>>07500000
     BYTE POINTER STRING;                                               07505000
     ARRAY ASCII'(0:255)=PB:=                                           07510000
          << EBCDIC TO ASCII CONVERSION TABLE >>                        07515000
          %000, %001, %002, %003, %234, %011, %206, %177,      <<01.02>>07520000
          %227, %215, %216, %013, %014, %015, %016, %017,      <<01.02>>07525000
          %020, %021, %022, %023, %235, %205, %010, %207,      <<01.02>>07530000
          %030, %031, %222, %217, %034, %035, %036, %037,      <<01.02>>07535000
          %200, %201, %202, %203, %204, %012, %027, %033,      <<01.02>>07540000
          %210, %211, %212, %213, %214, %005, %006, %007,      <<01.02>>07545000
          %220, %221, %026, %223, %224, %225, %226, %004,      <<01.02>>07550000
          %230, %231, %232, %233, %024, %025, %236, %032,      <<01.02>>07555000
          %040, %240, %241, %242, %243, %244, %245, %246,      <<01.02>>07560000
          %247, %250, %133, %056, %074, %050, %053, %041,      <<01.02>>07565000
          %046, %251, %252, %253, %254, %255, %256, %257,      <<01.02>>07570000
          %260, %261, %135, %044, %052, %051, %073, %136,      <<01.02>>07575000
          %055, %057, %262, %263, %264, %265, %266, %267,      <<01.02>>07580000
          %270, %271, %174, %054, %045, %137, %076, %077,      <<01.02>>07585000
          %272, %273, %274, %275, %276, %277, %300, %301,      <<01.02>>07590000
          %302, %140, %072, %043, %100, %047, %075, %042,      <<01.02>>07595000
          %303, %141, %142, %143, %144, %145, %146, %147,      <<01.02>>07600000
          %150, %151, %304, %305, %306, %307, %310, %311,      <<01.02>>07605000
          %312, %152, %153, %154, %155, %156, %157, %160,      <<01.02>>07610000
          %161, %162, %313, %314, %315, %316, %317, %320,      <<01.02>>07615000
          %321, %176, %163, %164, %165, %166, %167, %170,      <<01.02>>07620000
          %171, %172, %322, %323, %324, %325, %326, %327,      <<01.02>>07625000
          %330, %331, %332, %333, %334, %335, %336, %337,      <<01.02>>07630000
          %340, %341, %342, %343, %344, %345, %346, %347,      <<01.02>>07635000
          %173, %101, %102, %103, %104, %105, %106, %107,      <<01.02>>07640000
          %110, %111, %350, %351, %352, %353, %354, %355,      <<01.02>>07645000
          %175, %112, %113, %114, %115, %116, %117, %120,      <<01.02>>07650000
          %121, %122, %356, %357, %360, %361, %362, %363,      <<01.02>>07655000
          %134, %237, %123, %124, %125, %126, %127, %130,      <<01.02>>07660000
          %131, %132, %364, %365, %366, %367, %370, %371,      <<01.02>>07665000
          %060, %061, %062, %063, %064, %065, %066, %067,      <<01.02>>07670000
          %070, %071, %372, %373, %374, %375, %376, %377;      <<01.02>>07675000
     ARRAY EBCDIC'(0:255)=PB:=                                          07680000
          << ASCII TO EBCDIC CONVERSION TABLE >>                        07685000
          %000, %001, %002, %003, %067, %055, %056, %057,      <<01.02>>07690000
          %026, %005, %045, %013, %014, %015, %016, %017,      <<01.02>>07695000
          %020, %021, %022, %023, %074, %075, %062, %046,      <<01.02>>07700000
          %030, %031, %077, %047, %034, %035, %036, %037,      <<01.02>>07705000
          %100, %117, %177, %173, %133, %154, %120, %175,      <<01.02>>07710000
          %115, %135, %134, %116, %153, %140, %113, %141,      <<01.02>>07715000
          %360, %361, %362, %363, %364, %365, %366, %367,      <<01.02>>07720000
          %370, %371, %172, %136, %114, %176, %156, %157,      <<01.02>>07725000
          %174, %301, %302, %303, %304, %305, %306, %307,      <<01.02>>07730000
          %310, %311, %321, %322, %323, %324, %325, %326,      <<01.02>>07735000
          %327, %330, %331, %342, %343, %344, %345, %346,      <<01.02>>07740000
          %347, %350, %351, %112, %340, %132, %137, %155,      <<01.02>>07745000
          %171, %201, %202, %203, %204, %205, %206, %207,      <<01.02>>07750000
          %210, %211, %221, %222, %223, %224, %225, %226,      <<01.02>>07755000
          %227, %230, %231, %242, %243, %244, %245, %246,      <<01.02>>07760000
          %247, %250, %251, %300, %152, %320, %241, %007,      <<01.02>>07765000
          %040, %041, %042, %043, %044, %025, %006, %027,      <<01.02>>07770000
          %050, %051, %052, %053, %054, %011, %012, %033,      <<01.02>>07775000
          %060, %061, %032, %063, %064, %065, %066, %010,      <<01.02>>07780000
          %070, %071, %072, %073, %004, %024, %076, %341,      <<01.02>>07785000
          %101, %102, %103, %104, %105, %106, %107, %110,      <<01.02>>07790000
          %111, %121, %122, %123, %124, %125, %126, %127,      <<01.02>>07795000
          %130, %131, %142, %143, %144, %145, %146, %147,      <<01.02>>07800000
          %150, %151, %160, %161, %162, %163, %164, %165,      <<01.02>>07805000
          %166, %167, %170, %200, %212, %213, %214, %215,      <<01.02>>07810000
          %216, %217, %220, %232, %233, %234, %235, %236,      <<01.02>>07815000
          %237, %240, %252, %253, %254, %255, %256, %257,      <<01.02>>07820000
          %260, %261, %262, %263, %264, %265, %266, %267,      <<01.02>>07825000
          %270, %271, %272, %273, %274, %275, %276, %277,      <<01.02>>07830000
          %312, %313, %314, %315, %316, %317, %332, %333,      <<01.02>>07835000
          %334, %335, %336, %337, %352, %353, %354, %355,      <<01.02>>07840000
          %356, %357, %372, %373, %374, %375, %376, %377;      <<01.02>>07845000
     ARRAY JIS'(0:255)=PB:=                                    <<01.02>>07850000
          << EBCDIK TO JIS CONVERSION TABLE >>                 <<01.02>>07855000
          %000, %001, %002, %003, %234, %011, %206, %177,      <<01.02>>07860000
          %227, %215, %216, %013, %014, %015, %016, %017,      <<01.02>>07865000
          %020, %021, %022, %023, %235, %205, %010, %207,      <<01.02>>07870000
          %030, %031, %222, %217, %034, %035, %036, %037,      <<01.02>>07875000
          %200, %201, %202, %203, %204, %012, %027, %033,      <<01.02>>07880000
          %210, %211, %212, %213, %214, %005, %006, %007,      <<01.02>>07885000
          %220, %221, %026, %223, %224, %225, %226, %004,      <<01.02>>07890000
          %230, %231, %232, %233, %024, %025, %236, %032,      <<01.02>>07895000
          %040, %241, %242, %243, %244, %245, %246, %247,      <<00908>>07900000
          %250, %251, %133, %056, %074, %050, %053, %041,      <<00908>>07905000
          %046, %252, %253, %254, %255, %256, %257, %240,      <<00908>>07910000
          %260, %141, %135, %044, %052, %051, %073, %136,      <<01.02>>07915000
          %055, %057, %142, %143, %144, %145, %146, %147,      <<01.02>>07920000
          %150, %151, %174, %054, %045, %137, %076, %077,      <<01.02>>07925000
          %156, %160, %161, %162, %165, %164, %152, %153,      <<01.02>>07930000
          %154, %140, %072, %043, %100, %047, %075, %042,      <<01.02>>07935000
          %155, %261, %262, %263, %264, %265, %266, %267,      <<01.02>>07940000
          %270, %271, %272, %157, %273, %274, %275, %276,      <<01.02>>07945000
          %277, %300, %301, %302, %303, %304, %305, %306,      <<01.02>>07950000
          %307, %310, %311, %166, %163, %312, %313, %314,      <<01.02>>07955000
          %167, %176, %315, %316, %317, %320, %321, %322,      <<01.02>>07960000
          %323, %324, %325, %171, %326, %327, %330, %331,      <<01.02>>07965000
          %172, %170, %342, %343, %344, %345, %346, %347,      <<01.02>>07970000
          %340, %341, %332, %333, %334, %335, %336, %337,      <<01.02>>07975000
          %173, %101, %102, %103, %104, %105, %106, %107,      <<01.02>>07980000
          %110, %111, %350, %351, %352, %353, %354, %355,      <<01.02>>07985000
          %175, %112, %113, %114, %115, %116, %117, %120,      <<01.02>>07990000
          %121, %122, %356, %357, %360, %361, %362, %363,      <<01.02>>07995000
          %134, %237, %123, %124, %125, %126, %127, %130,      <<01.02>>08000000
          %131, %132, %364, %365, %366, %367, %370, %371,      <<01.02>>08005000
          %060, %061, %062, %063, %064, %065, %066, %067,      <<01.02>>08010000
          %070, %071, %372, %373, %374, %375, %376, %377;      <<01.02>>08015000
     ARRAY EBCDIK'(0:255)=PB:=                                 <<01.02>>08020000
          << JIS TO EBCDIK CONVERSION TABLE >>                 <<01.02>>08025000
          %000, %001, %002, %003, %067, %055, %056, %057,      <<01.02>>08030000
          %026, %005, %045, %013, %014, %015, %016, %017,      <<01.02>>08035000
          %020, %021, %022, %023, %074, %075, %062, %046,      <<01.02>>08040000
          %030, %031, %077, %047, %034, %035, %036, %037,      <<01.02>>08045000
          %100, %117, %177, %173, %133, %154, %120, %175,      <<01.02>>08050000
          %115, %135, %134, %116, %153, %140, %113, %141,      <<01.02>>08055000
          %360, %361, %362, %363, %364, %365, %366, %367,      <<01.02>>08060000
          %370, %371, %172, %136, %114, %176, %156, %157,      <<01.02>>08065000
          %174, %301, %302, %303, %304, %305, %306, %307,      <<01.02>>08070000
          %310, %311, %321, %322, %323, %324, %325, %326,      <<01.02>>08075000
          %327, %330, %331, %342, %343, %344, %345, %346,      <<01.02>>08080000
          %347, %350, %351, %112, %340, %132, %137, %155,      <<01.02>>08085000
          %171, %131, %142, %143, %144, %145, %146, %147,      <<01.02>>08090000
          %150, %151, %166, %167, %170, %200, %160, %213,      <<01.02>>08095000
          %161, %162, %163, %234, %165, %164, %233, %240,      <<01.02>>08100000
          %261, %253, %260, %300, %152, %320, %241, %007,      <<01.02>>08105000
          %040, %041, %042, %043, %044, %025, %006, %027,      <<01.02>>08110000
          %050, %051, %052, %053, %054, %011, %012, %033,      <<01.02>>08115000
          %060, %061, %032, %063, %064, %065, %066, %010,      <<01.02>>08120000
          %070, %071, %072, %073, %004, %024, %076, %341,      <<01.02>>08125000
          %127, %101, %102, %103, %104, %105, %106, %107,      <<00908>>08130000
          %110, %111, %121, %122, %123, %124, %125, %126,      <<00908>>08135000
          %130, %201, %202, %203, %204, %205, %206, %207,      <<01.02>>08140000
          %210, %211, %212, %214, %215, %216, %217, %220,      <<01.02>>08145000
          %221, %222, %223, %224, %225, %226, %227, %230,      <<01.02>>08150000
          %231, %232, %235, %236, %237, %242, %243, %244,      <<01.02>>08155000
          %245, %246, %247, %250, %251, %252, %254, %255,      <<01.02>>08160000
          %256, %257, %272, %273, %274, %275, %276, %277,      <<01.02>>08165000
          %270, %271, %262, %263, %264, %265, %266, %267,      <<01.02>>08170000
          %312, %313, %314, %315, %316, %317, %332, %333,      <<01.02>>08175000
          %334, %335, %336, %337, %352, %353, %354, %355,      <<01.02>>08180000
          %356, %357, %372, %373, %374, %375, %376, %377;      <<01.02>>08185000
     LOGICAL SUBROUTINE BOUNDCHK(CSTRING,CSTRINGLENGTH);                08190000
     VALUE CSTRING,CSTRINGLENGTH;                                       08195000
     INTEGER CSTRING,CSTRINGLENGTH;                                     08200000
     BEGIN                                                              08205000
          XREG := CSTRING&LSR(1);                                       08210000
          IF NOT SPLITSTACK  THEN        << NORMAL STACK >>             08215000
             BEGIN                                                      08220000
                  PUSH(S);    << CHECK FOR DL-DB ADDRESSING >>          08225000
                  IF TOS < XREG  THEN XREG := XREG + %100000;           08230000
             END;                                                       08235000
          IF NOT (LOWERBOUND<=XREG<=UPPERBOUND) THEN                    08240000
             BEGIN                                                      08245000
                   BERRTYPE:=5;                                         08250000
                   RETURN;                                              08255000
             END;                                                       08260000
          IF CSTRINGLENGTH <> 0  THEN                                   08265000
            BEGIN                                                       08270000
                 XREG:=XREG+((CSTRINGLENGTH + 1)&LSR(1))-1;             08275000
                 IF NOT (LOWERBOUND<=XREG<=UPPERBOUND)  THEN            08280000
                    BEGIN                                               08285000
                         BERRTYPE := 6;                                 08290000
                         RETURN;                                        08295000
                    END;                                                08300000
            END;                                                        08305000
         BOUNDCHK:=TRUE;                                                08310000
     END <<BOUNDCHK>>;                                                  08315000
     ERRORON;                                                           08320000
     CC := CCL;                                                <<00.04>>08325000
                                                               <<01736>>08330000
  << FOR THIS RELEASE DISALLOW SPLIT STACK CALLS. >>           <<01736>>08335000
  << TO IMPLEMENT, CHANGE LINE AFTER "CHEK" CALL: >>           <<01736>>08340000
  <<                                              >>           <<01736>>08345000
  << IF CARRY THEN SPLITSTACK := TRUE;            >>           <<01736>>08350000
                                                               <<01736>>08355000
     BOUNDS := CHEK(CTRANSHANG,%5,,,%5);                       <<01736>>08360000
     IF CARRY THEN ERROREXIT(CTRANSHANG,1,0);                  <<01736>>08365000
                                                               <<01736>>08370000
     IF NOT (0<=CODE<=CODEMAX) THEN ERROREXIT(CTRANSHANG,8,1);          08375000
     IF STRINGLENGTH < 0 THEN ERROREXIT(CTRANSHANG,8,4);                08380000
     IF STRINGLENGTH = 0 THEN GOTO FIN;                        <<00.04>>08385000
                            << WE'RE DONE IF LENGTH=0 >>                08390000
                                                                        08395000
     IF NOT BOUNDCHK(@INSTRING,STRINGLENGTH)  THEN                      08400000
     ERROREXIT(CTRANSHANG,BERRTYPE,2);                                  08405000
     IF PMAP.(13:1) THEN  <<OUTPUT STRING SPEC.>>                       08410000
     BEGIN                                                              08415000
          IF NOT BOUNDCHK(@OUTSTRING,STRINGLENGTH)  THEN                08420000
          ERROREXIT(CTRANSHANG,BERRTYPE,3);                             08425000
          @STRING:=@OUTSTRING;                                          08430000
     END ELSE                                                           08435000
     @STRING:=@INSTRING;                                                08440000
     TOS:=0D;                                                           08445000
     CASE * CODE OF                                                     08450000
     BEGIN                                                              08455000
     BEGIN COMMENT  CODE=0, USER TABLE.  ;                     <<01.02>>08460000
               IF NOT PMAP THEN ERROREXIT(CTRANSHANG,3,5) ELSE          08465000
               IF NOT BOUNDCHK(@TABLE,0)  THEN                          08470000
               ERROREXIT(CTRANSHANG,BERRTYPE,5);                        08475000
               XREG:=0;     <<BYTE STRING INDEX>>                       08480000
               WHILE TOS < STRINGLENGTH DO                              08485000
               BEGIN                                                    08490000
                    TOS:=INSTRING(XREG);                                08495000
                    ASSEMBLE(LDXB,STAX);                                08500000
                    TOS:=TABLE(XREG);                                   08505000
                    ASSEMBLE(STBX,NOP);                                 08510000
                    STRING(XREG):=TOS;                                  08515000
                    ASSEMBLE(INCX,LDXA);                                08520000
               END;                                                     08525000
          END;                                                          08530000
     BEGIN COMMENT  CODE=1, EBCDIC TO ASCII.  ;                <<01.02>>08535000
               XREG:=0;     <<BYTE STRING INDEX>>                       08540000
               WHILE TOS < STRINGLENGTH DO                              08545000
               BEGIN                                                    08550000
                    TOS:=INSTRING(XREG);                                08555000
                    ASSEMBLE(LDXB,STAX);                                08560000
                    TOS:=ASCII'(XREG);                                  08565000
                    ASSEMBLE(STBX,NOP);                                 08570000
                    STRING(XREG):=TOS;                                  08575000
                    ASSEMBLE(INCX,LDXA);                                08580000
               END;                                                     08585000
          END;                                                          08590000
     BEGIN COMMENT  CODE=2, ASCII TO EBCDIC.  ;                <<01.02>>08595000
               XREG:=0;     <<BYTE STRING INDEX>>                       08600000
               WHILE TOS < STRINGLENGTH DO                              08605000
               BEGIN                                                    08610000
                    TOS:=INSTRING(XREG);                                08615000
                    ASSEMBLE(LDXB,STAX);                                08620000
                    TOS:=EBCDIC'(XREG);                                 08625000
                    ASSEMBLE(STBX,NOP);                                 08630000
                    STRING(XREG):=TOS;                                  08635000
                    ASSEMBLE(INCX,LDXA);                                08640000
               END;                                                     08645000
          END;                                                          08650000
     BEGIN COMMENT  CODE=3, NATIVE TO ASCII.  ;                <<01.02>>08655000
          CC := CCL;  ERROREXIT(CTRANSHANG,8,1);               <<01.02>>08660000
     END;                                                      <<01.02>>08665000
     BEGIN COMMENT  CODE=4,  ASCII TO NATIVE.  ;               <<01.02>>08670000
          CC := CCL;  ERROREXIT(CTRANSHANG,8,1);               <<01.02>>08675000
     END;                                                      <<01.02>>08680000
     BEGIN COMMENT  CODE=5,  EBCDIK TO JIS.  ;                 <<01.02>>08685000
          XREG:=0;     << BYTE STRING INDEX >>                 <<01.02>>08690000
          WHILE TOS < STRINGLENGTH DO                          <<01.02>>08695000
          BEGIN                                                <<01.02>>08700000
               TOS:=INSTRING(XREG);                            <<01.02>>08705000
               ASSEMBLE(LDXB,STAX);                            <<01.02>>08710000
               TOS:=JIS'(XREG);                                <<01.02>>08715000
               ASSEMBLE(STBX,NOP);                             <<01.02>>08720000
               STRING(XREG):=TOS;                              <<01.02>>08725000
               ASSEMBLE(INCX,LDXA);                            <<01.02>>08730000
          END;                                                 <<01.02>>08735000
     END;                                                      <<01.02>>08740000
     BEGIN COMMENT  CODE=6,  JIS TO EBCDIK.  ;                 <<01.02>>08745000
          XREG:=0;     << BYTE STRING INDEX >>                 <<01.02>>08750000
          WHILE TOS < STRINGLENGTH DO                          <<01.02>>08755000
          BEGIN                                                <<01.02>>08760000
               TOS:=INSTRING(XREG);                            <<01.02>>08765000
               ASSEMBLE(LDXB,STAX);                            <<01.02>>08770000
               TOS:=EBCDIK'(XREG);                             <<01.02>>08775000
               ASSEMBLE(STBX,NOP);                             <<01.02>>08780000
               STRING(XREG):=TOS;                              <<01.02>>08785000
               ASSEMBLE(INCX,LDXA);                            <<01.02>>08790000
          END;                                                 <<01.02>>08795000
     END;                                                      <<01.02>>08800000
     END <<CASE>>;                                                      08805000
FIN:                                                           <<00.04>>08810000
     CC := CCE;                                                <<00.04>>08815000
     ERROREXIT(CTRANSHANG,0,0);                                         08820000
END <<CTRANSLATE>>;                                                     08825000
$PAGE "FCARD - 7260A CARD READER INTRINSIC "<<00.05-LINES 1165.004->>   08830000
PROCEDURE FCARD(RECODE,FILENUM,BUFADR,COUNT,STATUS);<<LINES 1165.223>>  08835000
INTEGER ARRAY BUFADR;                                                   08840000
INTEGER RECODE,FILENUM,COUNT,STATUS;                                    08845000
                                                                        08850000
BEGIN                                                                   08855000
                                                                        08860000
COMMENT                                                                 08865000
   ASSUMING THAT THE USER OF THE CARD READER HAS SATISFACTORILY         08870000
   INSTALLED THE CARD READER, THIS PROCEDURE WILL PERFORM THE ACTUAL    08875000
   ISSUEING OF REQUESTS AND RETURNING OF DATA/STATUS FOR THE USERS      08880000
   PROGRAM.                                                             08885000
                                                                        08890000
      DESCRIPTION OF INPUT PARAMETERS                                   08895000
      RECODE = O = OPEN THE CARD READER/TERMINAL PAIR AS A FILE         08900000
             = 1 = DEMAND A CARD                                        08905000
             = 2 = REJECT THE LAST CARD READ                            08910000
             = 3 = RETRANSMIT THE DATA                                  08915000
             = 4 = SUSPEND PROGRAM AWAITING THE "READY" SIGNAL          08920000
             =10 = CAUSE CARD READER TO GO "NOT READY" VIA STOP COMMAND 08925000
             =11 = SWITCH TO IMAGE                                      08930000
             =12 = SWITCH TO ASCII                                      08935000
             =13 = RING BELL                                            08940000
             =17 = TURN ECHO ON                                         08945000
             =18 = TURN ECHO OFF                                        08950000
             =20 = CLOSE FILE SPECIFIED IN FILENUM(RESULT OR RECODE=0)  08955000
                                                                        08960000
      FILENUM IS THE FILE NUMBER RETURNED FROM RECODE=0. IT MUST BE     08965000
             PROVIDED ON ALL REQUEST FOR CARD READER ACTION.            08970000
                                                                        08975000
      BUFADR IS THE ARRAY INTO WHICH CARD DATA WILL BE READ.            08980000
                                                                        08985000
      COUNT IS THE TRANSFER COUNT IN BYTES.                             08990000
                                                                        08995000
      STATUS = O = DATA IN BUFADR                                       09000000
             # O = ACTUAL STATUS AS RETURNED                            09005000
                                                                        09010000
      DESCRIPTION OF OUTPUT PARAMETERS                                  09015000
      RECODE = 0 = REQUEST GOT A RETURN FROM THE CARD READER            09020000
         THEN: 1 IF RECODE WAS 0 THEN FILE NUMBER IS RETURNED IN FILENUM09025000
               2 IF CARD READER REQUEST REQUIRED A RESPONSE             09030000
                  A BUFADR CONTAINS RESPONSE                            09035000
                  B COUNT IS NUMBER OF BYTES OR WORDS (IF IN IMAGE MODE)09040000
                  C FILENUM IS UNCHANGED                                09045000
                  D STATUS IS CONTROL CHAR IF BUFADR IS NOT DATA        09050000
               3 IF REQUEST DOES NOT REQUIRE A RESPONSE THEN NONE OF    09055000
                 THE  RETURN PARAMETERS ARE SIGNIFICANT                 09060000
               4 IF RECODE WAS 20 THE FILE SPECIFIED IN FILENUM IS      09065000
                 CLOSED.                                                09070000
      RECODE = 1 = ILLEGAL REQUEST CODE                                 09075000
             = 2 = UNABLE TO OPEN FILE                                  09080000
             = 4 = FREAD OR FWRITE ERROR                                09085000
             = 5 = UNABLE TO CLOSE FILE                                 09090000
             = 6 = :EOJ, :EOD, :DATA, OR :JOB FOUND IN INPUT            09095000
             = 7 = FILE ERROR ON EITHER ECHO ON OR ECHO OFF             09100000
             = 8 = DATA DROPOUT - USUAL RECOVERY IS TO RETRANSMIT       09105000
                                                                        09110000
                                                                        09115000
;                                                                       09120000
INTEGER BYTECOUNT;                                                      09125000
INTRINSIC FCHECK;                                                       09130000
INTEGER ECHO;                                                           09135000
INTEGER LDN,ERROR,Z,N,Z5:=%6415,Z6:=0;                                  09140000
  INTEGER I;                                                            09145000
BYTE ARRAY CONCHAR(0:7);                                                09150000
BYTE ARRAY LDEV(0:2);                                                   09155000
BYTE ARRAY CHAROUT(0:4);                                                09160000
BYTE ARRAY RPACK(*)=BUFADR;                                             09165000
INTEGER POINTER PTR;                                                    09170000
INTRINSIC FOPEN,FREAD,FWRITE,FCONTROL,FCLOSE,FGETINFO,ASCII,PRINT;      09175000
                                                                        09180000
SUBROUTINE REPACK;                                                      09185000
BEGIN                                                                   09190000
  FOR I:=0 UNTIL (COUNT-2) DO RPACK(I):=RPACK(I+1);                     09195000
  COUNT:=COUNT-1;                                                       09200000
  RETURN;                                                               09205000
END;                                                                    09210000
                                                                        09215000
SUBROUTINE IMAGE5;                                                      09220000
BEGIN                                                                   09225000
  FOR I:=0 UNTIL (COUNT/2)-1 DO BEGIN                                   09230000
    BUFADR(I).(4:6):=BUFADR(I+1).(10:6);                                09235000
    BUFADR(I).(10:6):=BUFADR(I+1).(2:6);                                09240000
    BUFADR(I).(0:4):=0;                                                 09245000
  END;                                                                  09250000
  COUNT:=(COUNT/2)-1;                                                   09255000
  RETURN;                                                               09260000
END;                                                                    09265000
                                                                        09270000
SUBROUTINE FILERROR;                                                    09275000
BEGIN                                                                   09280000
   FCHECK(FILENUM,ERROR);                                               09285000
   IF ERROR.(8:8)=33 THEN RECODE:=8                                     09290000
                     ELSE RECODE:=4;                                    09295000
  RETURN;                                                               09300000
END;                                                                    09305000
                                                                        09310000
                                                                        09315000
   IF (0<=RECODE<=4) OR (10<=RECODE<=13) OR (RECODE=20)                 09320000
                     OR (17<=RECODE<=18) THEN GO NOTILL;                09325000
   RECODE:=1; RETURN;      <<ILLEGAL REQUEST CODE>>                     09330000
                                                                        09335000
NOTILL: <<REQUEST CODE IS LEGAL VALUE>>                                 09340000
   <<BRANCH TO AREA NAMED BY RECODE>>                                   09345000
   IF RECODE = 0 THEN GO OPENFILE;                                      09350000
   IF (17<=RECODE<=18) THEN GO ECHOSWITCH;                              09355000
   IF RECODE = 20 THEN GO CLOSEFILE;                                    09360000
                                                                        09365000
   <<INITIALIZE CONTROL CHARACTER BUFFER>>                              09370000
   MOVE CONCHAR(0) :=(%31,%13,%10,%11,%11,%22,%24,%07);                 09375000
   CHAROUT(0):=%24; CHAROUT(1):=%24; CHAROUT(2):=%21;CHAROUT(4):=%21;   09380000
   <<CONVERT BYTE ADDRESS TO WORD ADDRESS>>                             09385000
   @PTR:=@CHAROUT & LSR(1);                                             09390000
   IF (10<=RECODE<=13) THEN CHAROUT(3):=CONCHAR(RECODE-6)               09395000
                       ELSE CHAROUT(3):=CONCHAR(RECODE-1);              09400000
   IF RECODE > 3 THEN BYTECOUNT:=-5 ELSE BYTECOUNT:=-4;                 09405000
                                                                        09410000
   <<SEND THE REQUEST TO THE CARD READER>>                              09415000
   FWRITE(FILENUM,PTR,BYTECOUNT,%320);                                  09420000
   <<CHECK FOR WRITE ERROR>>                                            09425000
   IF <> THEN GO ERROR4;                                                09430000
    IF RECODE = 4 THEN GO READYWAIT;                                    09435000
   IF RECODE > 3 THEN GO GOODEXIT;                                      09440000
                                                                        09445000
   <<REQUEST REQUIRES RETURN FROM READER SO GIVE A READ REQUEST>>       09450000
   FCONTROL(FILENUM,41,Z5);  <<SET UP TRANSPARENT MODE OF READ >>       09455000
   COUNT:=FREAD(FILENUM,BUFADR,-240);                                   09460000
   <<CHECK FOR READ ERROR>>                                             09465000
   IF > THEN                                                            09470000
     BEGIN                                                              09475000
       FCONTROL(FILENUM,41,Z6); GOTO ERROR6;  END;                      09480000
   IF < THEN BEGIN                                                      09485000
             FCONTROL(FILENUM,41,Z6); << DISABLE TRANSPARENT MODE >>    09490000
             FILERROR;                                                  09495000
             RETURN;                                                    09500000
             END;                                                       09505000
   FCONTROL(FILENUM,41,Z6); << DISABLE TRANSPARENT MODE AFTER READ >>   09510000
                                                                        09515000
   <<CHECK FOR STATUS IN 1ST BYTE OF BUFFER>>                           09520000
   STATUS:=BUFADR(0).(0:8);                                             09525000
   IF (STATUS=%14) OR (STATUS=%13) OR (STATUS=%22) OR                   09530000
       (STATUS=%07) OR (STATUS=%11) OR (STATUS=%37)                     09535000
       THEN GO GOODEXIT      <<CARD READER GAVE STATUS>>                09540000
     ELSE BEGIN STATUS:=0;IF BUFADR(0)="QH" THEN IMAGE5 ELSE            09545000
            IF RPACK(0)=(%12) THEN REPACK;                              09550000
          END;                                                          09555000
                                                                        09560000
GOODEXIT:                                                               09565000
   <<INDICATE SUCCESSFUL REQUEST>>                                      09570000
   RECODE:=0; RETURN;                                                   09575000
                                                                        09580000
READYWAIT:                                                              09585000
   <<SEND SET OF CHARS TO READER THAT WILL CAUSE IT NOT TO RESPOND>>    09590000
   CHAROUT(0):=%11;  <<CAUSES A STOP-STOP-EXECUTE TO BE WRITTEN TO CR>> 09595000
   FWRITE(FILENUM,PTR,BYTECOUNT,%320);                                  09600000
   IF <> THEN GO ERROR4;                                                09605000
   <<BECAUSE THE CR IS NOW IN A SLEEP STATE THE NEXT FREAD WILL BE>>    09610000
   <<IGNORED BUT THE SYSTEM WILL STILL BE AWAITING INPUT. PUSH READY>>  09615000
                                                                        09620000
READYLOOP:                                                              09625000
FCONTROL(FILENUM,29,PTR); <<ENABLE USER BLK MODE>>                      09630000
   COUNT:=FREAD(FILENUM,BUFADR,-240);                                   09635000
   IF > THEN GO ERROR6;                                                 09640000
   IF < THEN BEGIN                                                      09645000
             FILERROR;                                                  09650000
FCONTROL(FILENUM,28,PTR); <<DISABLE USER BLK MODE>>                     09655000
             IF RECODE = 4 THEN RETURN                                  09660000
                           ELSE GO READYLOOP;                           09665000
             END;                                                       09670000
   <<CHECK THAT 1ST BYTE IS READY CHARACTER>>                           09675000
   IF BUFADR(0).(0:8) <> %22 THEN GO READYLOOP     <<WAIT FOR READY>>   09680000
                             ELSE BEGIN                                 09685000
                                  STATUS:=BUFADR(0).(0:8);              09690000
                                  GO GOODEXIT;                          09695000
                                  END;                                  09700000
                                                                        09705000
OPENFILE: <<OPEN TERMINAL FOR INPUT AND OUTPUT>>                        09710000
   <<FIRST GET THE LOGICAL DEV # OF $STDLIST>>                          09715000
   FILENUM:=FOPEN(,%14);   <<OPEN $STDLIST>>                            09720000
   IF <> THEN GO ERROR2;                                                09725000
   FGETINFO(FILENUM,,,,,,LDN);   <<GET LOG DEV #>>                      09730000
   FCLOSE(FILENUM,0,0);    <<CLOSE $STDLIST>>                           09735000
   <<CONVERT LOGICAL DEV # TO ASCII STRING>>                            09740000
   Z:=100;                                                              09745000
   FOR N:=0 UNTIL 2 DO                                                  09750000
      BEGIN                                                             09755000
      LDEV(N):=LDN/Z + %60;                                             09760000
      LDN:=LDN MOD Z;  Z:=Z/10;                                         09765000
      END;                                                              09770000
   <<OPEN FILE VIA LOGICAL DEV # FOR INPUT AND OUTPUT>>                 09775000
   FILENUM:=FOPEN(,%2404,4,100,LDEV);                                   09780000
   IF <> THEN GO ERROR2;                                                09785000
   GO GOODEXIT;                                                         09790000
                                                                        09795000
CLOSEFILE:  <<CLOSE TERMINAL INPUT/OUTPUT FILE>>                        09800000
   FCLOSE(FILENUM,0,0);          <<CLOSE LOG DEV # FILE>>               09805000
   IF <> THEN GO ERROR5                                                 09810000
         ELSE GO GOODEXIT;                                              09815000
                                                                        09820000
ECHOSWITCH:  <<ALLOW THE USER CONTROL OF ECHO>>                         09825000
   <<RECODE = 17 = ECHO OFF - RECODE = 18 ECHO ON>>                     09830000
   IF RECODE = 17 THEN ECHO:=12     <<TURN ECHO ON>>                    09835000
                  ELSE ECHO:=13;    <<TURN ECHO OFF>>                   09840000
   FCONTROL(FILENUM,ECHO,Z);                                            09845000
   IF = THEN GO GOODEXIT;                                               09850000
   <<ECHO ON OR OFF ERROR>>                                             09855000
   RECODE := 7; RETURN;                                                 09860000
                                                                        09865000
ERROR2: <<UNABLE TO OPEN FILE >>                                        09870000
   RECODE:=2; RETURN;                                                   09875000
                                                                        09880000
ERROR4:  <<FWRITE ERROR>>                                               09885000
   RECODE:=4; RETURN;                                                   09890000
                                                                        09895000
ERROR5: <<UNABLE TO CLOSE FILE >>                                       09900000
   RECODE:=5; RETURN;                                                   09905000
                                                                        09910000
ERROR6: <<ENCOUNTERED :EOJ, :EOD, :DATA, OR :JOB IN INPUT STREAM>>      09915000
   RECODE:=6; RETURN;                                                   09920000
END;                                                                    09925000
$PAGE "PTAPE - PAPER TAPE SPOOLING PROCEDURE "                 <<00.05>>09930000
$PAGE "Horizon Process Outer Block"                            <<06899>>09935000
PROCEDURE HRZNSYSPROC;                                         <<06899>>09940000
OPTION PRIVILEGED,UNCALLABLE;                                  <<*7883>>09945000
BEGIN                                                          <<06899>>09950000
                                                               <<06899>>09955000
<<*********************************************************>>  <<06899>>09960000
<<                                                         >>  <<06899>>09965000
<< This procedure is the outer block of the system process >>  <<06899>>09970000
<< for the Horizon Data Base Management subsystem.  This   >>  <<06899>>09975000
<< procedure is never called, rather, it is PROCREATEd as  >>  <<06899>>09980000
<< a system process by the procedure AWAKEHORIZON.  If     >>  <<06899>>09985000
<< Horizon is on this system, the LOADPROC will succeed    >>  <<06899>>09990000
<< this process will live on until the system shutdown     >>  <<06899>>09995000
<< causes it to terminate.  If Horizon is not on this      >>  <<06899>>10000000
<< system, then this system process is short-lived.        >>  <<06899>>10005000
<<                                                         >>  <<06899>>10010000
<< Note:  this process will need a MAXDATA of 20000, and   >>  <<06899>>10015000
<<        it should be PREP'd with IA,BA,PM,PH, and DS.    >>  <<06899>>10020000
<<        Also note that any changes to the variables of   >>  <<06899>>10025000
<<        this procedure should be reflected in PROGEN.    >>  <<06899>>10030000
<<                                                         >>  <<06899>>10035000
<<*********************************************************>>  <<06899>>10040000
                                                               <<06899>>10045000
<< LOADPROC is used to check if the procedure is on the    >>  <<06899>>10050000
<< system.  If it is, it is loaded and called.             >>  <<06899>>10055000
   MOVE PROCNAME := "HRZNPRCSS ";                              <<06899>>10060000
   IDENTNUM := LOADPROC( PROCNAME, 2, PLABEL );                <<06899>>10065000
   IF = THEN    << Successful load >>                          <<06899>>10070000
   BEGIN                                                       <<06899>>10075000
                                                               <<06899>>10080000
      TOS := PLABEL;                                           <<06899>>10085000
      ASSEMBLE( PCAL 0 );                                      <<06899>>10090000
      UNLOADPROC( IDENTNUM );                                  <<06899>>10095000
                                                               <<06899>>10100000
   END;                                                        <<06899>>10105000
                                                               <<06899>>10110000
<< Note:  we don't care if LOADPROC got an error.  We      >>  <<06899>>10115000
<< assume that any error is caused be Horizon not being on >>  <<06899>>10120000
<< the system.                                             >>  <<06899>>10125000
                                                               <<06899>>10130000
END;  << Horizon Process. >>                                   <<06899>>10135000
$PAGE "PTAPE:  Paper Tape Management."                         <<06899>>10140000
PROCEDURE PTAPE(TFILE,DFILE);                                  <<00.05>>10145000
  VALUE TFILE, DFILE;                                          <<00.05>>10150000
  INTEGER TFILE, DFILE;                                        <<00.05>>10155000
  OPTION PRIVILEGED;                                           <<00.05>>10160000
  <<                                                       >>  <<00.05>>10165000
  <<READS PAPER TAPE FROM TFILE AND SPOOLS IT TO DFILE     >>  <<00.05>>10170000
  <<RETURN: CCE - SUCCESSFUL                               >>  <<00.05>>10175000
  <<        CCL - TFILE NOT A TERMINAL                     >>  <<00.05>>10180000
  <<        CCG - NO RESOURCES, SYSTEM ERROR OR TOO MUCH DA>>  <<00.05>>10185000
  <<                                                       >>  <<00.05>>10190000
  BEGIN                                                        <<00.05>>10195000
    DOUBLE DISKADR := 0D;                                      <<02852>>10200000
    INTEGER DISKADR0 = DISKADR,                                <<02852>>10205000
            DISKADR1 = DISKADR0 + 1;                           <<02852>>10210000
    INTEGER I, TEMP, DEVICETYPE, LDEV;                         <<00.05>>10215000
                                                               <<00.05>>10220000
    LOGICAL TOGGLE = LDEV+1;  << OVEN/EVEN BYTE FLAG/CNTR >>   <<00.05>>10225000
    INTEGER ITOGGLE = TOGGLE;  << FOR TOGGLING TOGGLE >>       <<00.05>>10230000
                                                               <<00.05>>10235000
    LOGICAL ESCFLAG = TOGGLE+1;  << LAST CHAR WAS ESC>>        <<00.05>>10240000
    LOGICAL DELFLAG = ESCFLAG+1;  << SET FOR LINE DELETE >>    <<00.05>>10245000
    INTEGER RETURNCC= DELFLAG+1;  << RETURN COND CODE  >>      <<00.05>>10250000
    INTEGER BCNT = RETURNCC+1;  << REC BUFFER BYTE INDEX >>    <<00.05>>10255000
                                                               <<00.05>>10260000
    INTEGER SAVECRITICAL = BCNT+1;                             <<00.05>>10265000
    INTEGER SBUFX = SAVECRITICAL+1;  <<  SBUF INDEX >>         <<00.05>>10270000
    INTEGER DSTX = SBUFX+1;    << DUMY DST INDEX >>            <<00.05>>10275000
                                                               <<00.05>>10280000
    DOUBLE DADDR = DSTX+1;    << SPOOL BUFFER DISC ADDR >>     <<00.05>>10285000
    INTEGER DADR0 = DADDR, DADR1 = DADDR+1;                    <<00.05>>10290000
                                                               <<00.05>>10295000
    BYTE ARRAY RBUF(*) = DADDR+2;    << RECORD BUFFER >>       <<00.05>>10300000
    INTEGER ARRAY IRBUF(*) = RBUF;                             <<00.05>>10305000
    INTEGER POINTER SYSBUF = 6;  << SYSTEM TABLE POINTER >>    <<00.05>>10310000
    INTEGER POINTER DSTP   = 2;   << SYSTEM TABLE POINTER >>   <<00.05>>10315000
                                                               <<00.05>>10320000
    EQUATE                                                     <<00.05>>10325000
    PTINUMB   =[8/191, 8/2],  << PTAPE INTRINSIC NUMBER >>     <<00.05>>10330000
    TSUBTYPE  = 16,        << TERMINAL DEVICE TYPE >>          <<00.05>>10335000
    PTAPEFUNC = 29,        << PTAPE SPOOLING FUNC >>           <<00.05>>10340000
    READFUNC  = 0,         << READ FUNC >>                     <<00.05>>10345000
    SYSDISK   = 1,         << SYSTEM DISC LOG DEV >>           <<00.05>>10350000
    GOODIO    = 1,         << GOOD I/O STATUS RETURN >>        <<00.05>>10355000
    CR        = %15,       << CARRIAGE RETURN CHAR >>          <<00.05>>10360000
    Y'C       = %31;       << CONTROL-Y CHAR >>                <<00.05>>10365000
                                                               <<00.05>>10370000
    DEFINE                                                     <<00.05>>10375000
    IOSTAT    = (8:8)#,                                        <<00.05>>10380000
    CHARMASK  = (8:8)#;                                        <<00.05>>10385000
                                                               <<00.05>>10390000
    ASSEMBLE(DZRO,DZRO);<< TOGGLE,ESCFLAG,DELFLAG,RETURNCC>>   <<00.05>>10395000
    ASSEMBLE(INCA,DZRO);<< RETURNCC := CCL, BCNT, SAVECRIT>>   <<00.05>>10400000
                                                               <<00.05>>10405000
    ASSEMBLE( PCAL SETCRITICAL );  << SET SAVECRITICAL >>      <<00.05>>10410000
    ERRORON;                                                   <<00.05>>10415000
    FGETINFO(TFILE,,,,,DEVICETYPE,LDEV);                       <<00.05>>10420000
    IF <> OR DEVICETYPE.(8:8)<>TSUBTYPE THEN                   <<00.05>>10425000
      GOTO OUT1;   << INVALID TFILE OR DEV NOT TERMINAL >>     <<00.05>>10430000
                                                               <<00.05>>10435000
    RETURNCC := CCG;                                           <<00.05>>10440000
    TOS := GETSYSBUF(2,TRUE);  << GET 2 SBUFS/SET SBUFX >>     <<00.05>>10445000
    TOS := GET'DISC'SPACE( SYSDISK, 256D, DISKADR );           << 8564>>10450000
    IF S0 <> 0 THEN GOTO OUT2;                                 <<02852>>10455000
                                                               <<00.05>>10460000
    TOS := DISKADR0.(8:8); << Double disk address of space >>  <<02852>>10465000
    TOS := DISKADR1;                                           <<02852>>10470000
                                                               <<00.05>>10475000
    TOS := ATTACHIO(LDEV,0,0,SBUFX,PTAPEFUNC,32767,            <<00.05>>10480000
                       DADR0,DADR1,%11);                       <<00.05>>10485000
                                                               <<00.05>>10490000
    DEL;                                                       <<00.05>>10495000
    IF TOS.IOSTAT<>GOODIO THEN GOTO OUT4;     << AN ERROR >>   <<00.05>>10500000
    ASSEMBLE(ADDS 128);   << FORM TARGET DATA BUFFER  >>       <<00.05>>10505000
                                                               <<00.05>>10510000
                                                               <<00.05>>10515000
       << GET NEXT BUFFER OF SPOOLED DATA >>                   <<00.05>>10520000
                                                               <<00.05>>10525000
READNEXT:                                                      <<00.05>>10530000
    TOS := ATTACHIO(SYSDISK, 0, 0,SBUFX,READFUNC,128,          <<00.05>>10535000
              DADR0, DADR1, %11 );   << BLOCKED, SBUFRS >>     <<00.05>>10540000
    DEL;    TOGGLE := 0;                                       <<00.05>>10545000
                                                               <<00.05>>10550000
    IF TOS.IOSTAT=GOODIO THEN                                  <<00.05>>10555000
      BEGIN                                                    <<00.05>>10560000
        I := SBUFX;  << INIT X FOR CHAR FETCHES >>             <<00.05>>10565000
                                                               <<00.05>>10570000
NEXTCHAR:                                                      <<00.05>>10575000
        TOS := SYSBUF( I );  << GET TWO CHARACTERS >>          <<00.05>>10580000
        IF NOT TOGGLE THEN TOS := TOS&LSR(8) ELSE I:=I+1;      <<00.05>>10585000
        TEMP := TOS.CHARMASK;                                  <<00.05>>10590000
                                                               <<00.05>>10595000
        IF ESCFLAG THEN << CHECK FOR ESC ";" OR ESC ":" >>     <<00.05>>10600000
          BEGIN                                                <<00.05>>10605000
            ESCFLAG := FALSE;                                  <<00.05>>10610000
            IF TEMP=";" OR TEMP=":" THEN GOTO DELCHAR;         <<00.05>>10615000
          END;                                                 <<00.05>>10620000
                                                               <<00.05>>10625000
        IF TEMP=CR OR TEMP=Y'C THEN << EOR OR EOM >>           <<00.05>>10630000
          BEGIN                                                <<00.05>>10635000
            IF NOT DELFLAG THEN  << NOT A DELETED REC >>       <<00.05>>10640000
              BEGIN                                            <<00.05>>10645000
                FWRITE(DFILE, IRBUF,-BCNT, 0 );                <<00.05>>10650000
                IF <> THEN GOTO OUT4;  << AN ERROR >>          <<00.05>>10655000
              END;                                             <<00.05>>10660000
                                                               <<00.05>>10665000
            ESCFLAG := DELFLAG := BCNT := 0;                   <<00.05>>10670000
                                                               <<00.05>>10675000
            IF TEMP=Y'C THEN  << END OF SPOOL OPERATION >>     <<00.05>>10680000
              BEGIN                                            <<00.05>>10685000
                RETURNCC := CCE;    << SET CCE >>              <<00.05>>10690000
                GOTO OUT4;                                     <<00.05>>10695000
              END;                                             <<00.05>>10700000
          END                                                  <<00.05>>10705000
        ELSE                                                   <<00.05>>10710000
          BEGIN                                                <<00.05>>10715000
            IF TEMP=%30 THEN  DELFLAG := TRUE; << DEL REC>>    <<00.05>>10720000
                                                               <<00.05>>10725000
            IF TEMP=%10 THEN  << CTRL H, CHAR DELETE >>        <<00.05>>10730000
              BEGIN                                            <<00.05>>10735000
DELCHAR:                                                       <<00.05>>10740000
                IF BCNT<>0 THEN  BCNT := BCNT - 1;             <<00.05>>10745000
              END                                              <<00.05>>10750000
                                                               <<00.05>>10755000
            ELSE IF NOT DELFLAG AND TEMP<>0                    <<00.05>>10760000
             AND TEMP<>%12 AND TEMP<>%21                       <<00.05>>10765000
             AND TEMP<>%23 AND TEMP<>%177 THEN <<SAVE CHAR >>  <<00.05>>10770000
              BEGIN << NOT A NULL, LF, XON, XOFF, RUBOUT >>    <<00.05>>10775000
                IF TEMP=%33 THEN ESCFLAG := TRUE;              <<00.05>>10780000
                                                               <<00.05>>10785000
                RBUF(BCNT) := TEMP;  << SAVE CHAR >>           <<00.05>>10790000
                IF BCNT=255 THEN GOTO OUT4; << REC TOO LONG >> <<00.05>>10795000
                BCNT := BCNT + 1;                              <<00.05>>10800000
              END;                                             <<00.05>>10805000
          END;                                                 <<00.05>>10810000
                                                               <<00.05>>10815000
        IF ITOGGLE<>255 THEN << NOT END OF BUFFER >>           <<00.05>>10820000
          BEGIN                                                <<00.05>>10825000
            ITOGGLE := ITOGGLE + 1;    << TOGGLE TOGGLE >>     <<00.05>>10830000
            GOTO NEXTCHAR;  << GET ANOTHER CHARACTER >>        <<00.05>>10835000
          END;                                                 <<00.05>>10840000
                                                               <<00.05>>10845000
        DADDR := DADDR + 1 D;                                  <<00.05>>10850000
        GOTO READNEXT;  << GET ANOTHER SPOOLED BUFFER >>       <<00.05>>10855000
        HELP;  << FOR HELP PLABEL *********************** >>   <<00.05>>10860000
      END;                                                     <<00.05>>10865000
                                                               <<00.05>>10870000
OUT4:                                                          <<00.05>>10875000
    RETURN'DISC'SPACE( SYSDISK, DISKADR, 256D );               << 8564>>10880000
OUT2:                                                          <<00.05>>10885000
    RETURNSYSBUF(SBUFX);                                       <<00.05>>10890000
                                                               <<00.05>>10895000
OUT1:                                                          <<00.05>>10900000
    RESETCRITICAL(SAVECRITICAL);                               <<00.05>>10905000
    CC := RETURNCC;                                            <<00.05>>10910000
    ERROREXIT(PTINUMB, 0, 0 );                                 <<00.05>>10915000
  END;    << PTAPE - PAPER TAPE SPOOLING  >>                   <<00.05>>10920000
$PAGE "PRINT FILE INFO"                                        <<01549>>10925000
INTRINSIC FFILEINFO,FGETINFO,FCHECK;                           <<01794>>10930000
PROCEDURE PRINT'FILE'INFO(FILENUM);                            <<01549>>10935000
VALUE FILENUM;                                                 <<01549>>10940000
INTEGER FILENUM;                                               <<01549>>10945000
   BEGIN <<DISPLAY ALL INFORMATION ABOUT FILE 'FILENUM'>>      <<01549>>10950000
   DEFINE                                                      <<01549>>10955000
   AOPCOPY         = AOPTIONS.(3:1)#,       << FILE TO BE COPIED>>      10960000
   AOPNOWAIT       = AOPTIONS.(4:1)#,       << NO-WAIT I/O MODE >>      10965000
   AOPMULTAC       = AOPTIONS.(5:2)#,       << MULTI ACCESS MODE >>     10970000
   AOPGLOBALMULTAC = AOPTIONS.(5:1)#,       << GLOBAL MULTI ACCESS >>   10975000
   AOPINHIBITBUF   = AOPTIONS.(7:1)#,       << INHIBIT BUFFERING >>     10980000
   AOPACMODE       = AOPTIONS.(8:2)#,       << ACCESS MODE >>  <<01549>>10985000
   AOPSEMI         = (AOPACMODE = 2)#,                         <<01674>>10990000
   AOPLOCKING      = AOPTIONS.(10:1)#,      << DYNAMIC LOCKING >>       10995000
   AOPMULTIREC     = AOPTIONS.(11:1)#,      << MULTI-RECORD >> <<01549>>11000000
   AOPACTYPE       = AOPTIONS.(12:4)#;      << ACCESS TYPE >>  <<01549>>11005000
                                                               <<01549>>11010000
   DEFINE  <<FOPTIONS fields>>                                 <<01549>>11015000
   FOPFILETYPE   = FOPTIONS.(2:3)#,       << TYPE OF FILE >>   <<01549>>11020000
   FOPKSAMFILE   = (FOPFILETYPE=1)#,                           <<01567>>11025000
   FOPMSGFILE    = (FOPFILETYPE=6)#,                           <<01549>>11030000
   FOPNOEQUATE   = FOPTIONS.(5:1)#,       << NO FILE EQUATION >>        11035000
   FOPLABELLED   = FOPTIONS.(6:1)#,                            <<01549>>11040000
   FOPCONTROL    = FOPTIONS.(7:1)#,       << CARRIAGE CONTROL >>        11045000
   FOPFORMAT     = FOPTIONS.(8:2)#,       << RECORD FORMAT >>  <<01549>>11050000
   FOPDESIGNATOR = FOPTIONS.(10:3)#,      << DESIGNATOR >>     <<01549>>11055000
   FOPASCII      = FOPTIONS.(13:1)#,      << ASCII >>          <<01549>>11060000
   FOPDOMAIN     = FOPTIONS.(14:2)#;                           <<01549>>11065000
                                                               <<01549>>11070000
   INTEGER RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,DEVSTAT,<<01794>>11075000
           ERRORCODE,TLOG,NUMRECS,USERLABELS,NUMWRITERS,NUMREADERS;     11080000
   DOUBLE  BLKNUM,RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,        <<01549>>11085000
           DEXTSIZE:=0D,LABADDR;                               <<01674>>11090000
   INTEGER ECODE,X=X;                                          <<01674>>11095000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,DRT,UNIT,                   <<03051>>11100000
           EXTSIZE=DEXTSIZE+1;                                 <<01549>>11105000
   BYTE ARRAY                                                  <<01549>>11110000
      FILENAME(0:27),CREATORID(0:7),NUMWRITERSB(*)=NUMWRITERS, <<01549>>11115000
      NUMREADERSB(*)=NUMREADERS;                               <<01549>>11120000
   INTEGER ARRAY BUFFER(0:25);                                 <<01549>>11125000
   BYTE ARRAY LINE(*)=BUFFER;                                  <<01549>>11130000
   BYTE ARRAY DOMAIN(0:11)=PB:="NEWSYSJOBALL";                 <<01549>>11135000
   BYTE ARRAY RECFMT(0:7)=PB:=",F,V,U,?";                      <<01549>>11140000
   BYTE ARRAY FILEQUATION(0:7)=PB:=",FEQ,DEQ";                 <<01549>>11145000
   BYTE ARRAY FILE'TYPE(0:31)=PB:=                             <<01549>>11150000
      "    ,KSM,RIO,???,CIR,???,MSG,???";                      <<01549>>11155000
   BYTE ARRAY EXCL(0:15)=PB:=",DEF,EXC,XXX,SHR";               <<01549>>11160000
                                                               <<01549>>11165000
   DEFINE                                                      <<01549>>11170000
      DISABLE       = ASSEMBLE(SED 0)#,                        <<01549>>11175000
      ENABLE        = ASSEMBLE(SED 1)#,                        <<01549>>11180000
      CHECKDB       = DISABLE;                                 <<01549>>11185000
                      PUSH(DB);                                <<01549>>11190000
                      X:=ABSOLUTE(5)-5;                        <<01549>>11195000
                      TOS:=ABSOLUTE(X); X:=X+1; TOS:=ABSOLUTE(X);       11200000
                      ENABLE;                                  <<01549>>11205000
                      ASSEMBLE(DCMP)#,                         <<01549>>11210000
      PRINTINFOHANG = [10/21,6/1]#,                            <<01549>>11215000
      ILLEGALDB     = 1#;                                      <<01549>>11220000
                                                               <<01549>>11225000
   ENTRY PRINTFILEINFO;                                        <<01549>>11230000
                                                               <<01549>>11235000
   SUBROUTINE PRINTLINE;                                       <<01549>>11240000
      BEGIN <<SEND BUFFER TO $STDLIST>>                        <<01549>>11245000
      PRINT(BUFFER, -50, %40);                                 <<01549>>11250000
      END;  <<PRINTLINE>>                                      <<01549>>11255000
                                                               <<01549>>11260000
                                                               <<01549>>11265000
   SUBROUTINE BINCONV(N, FIELD, DIGITS);                       <<01549>>11270000
   VALUE N, DIGITS;                                            <<01549>>11275000
   INTEGER N,DIGITS;                                           <<01549>>11280000
   BYTE FIELD;                                                 <<01549>>11285000
      BEGIN <<CONVERT BINARY N TO BINARY FIELD (WIDTH=DIGITS)>><<01549>>11290000
      ASSEMBLE(LDX DIGITS;  LOAD N;                            <<01549>>11295000
      LOOP:DECX,NOP;  BL DONE;                                 <<01549>>11300000
           DUP;  ANDI 1;  ORI %60;                             <<01549>>11305000
           STB S-4,I,X;  <<FIELD(X):=TOS>>                     <<01549>>11310000
           LSR 1;  BR LOOP;                                    <<01549>>11315000
      DONE:DEL);                                               <<01549>>11320000
      END;  <<BINCONV>>                                        <<01549>>11325000
   SUBROUTINE MAKEROOM(ADDR,NEEDED);                           <<01549>>11330000
   VALUE ADDR,NEEDED;                                          <<01549>>11335000
   BYTE POINTER ADDR;                                          <<01549>>11340000
   INTEGER NEEDED;                                             <<01549>>11345000
      BEGIN                                                    <<01549>>11350000
      IF LOGICAL(@ADDR(NEEDED)) > LOGICAL(@LINE(47)) THEN      <<04489>>11355000
         BEGIN  <<MUST INDEX TO THE NEXT LINE>>                <<01549>>11360000
         PRINTLINE;                                            <<01549>>11365000
         MOVE LINE:=                                           <<01549>>11370000
            "!                                                !";       11375000
         @ADDR:=@LINE(13);                                     <<01549>>11380000
         END                                                   <<01549>>11385000
      ELSE                                                     <<01549>>11390000
         BEGIN  <<USE CURRENT LINE, INSERT COMMA>>             <<01549>>11395000
         ADDR:=",";                                            <<01549>>11400000
         @ADDR:=@ADDR+1;                                       <<01549>>11405000
         END;                                                  <<01549>>11410000
      RETURN 1;                                                <<01549>>11415000
      END;  <<MAKEROOM>>                                       <<01549>>11420000
   SUBROUTINE PRINTFOPTIONS;                                   <<01549>>11425000
      BEGIN                                                    <<01549>>11430000
      MOVE LINE:="!  FOPTIONS:                                     !";  11435000
      MOVE LINE(13):=DOMAIN(3*FOPDOMAIN),(3),2;                <<01549>>11440000
      <<BINARY OR ASCII>>                                      <<01549>>11445000
      IF FOPASCII THEN                                         <<01549>>11450000
         MOVE *:=",ASCII",2                                    <<01549>>11455000
      ELSE                                                     <<01549>>11460000
         MOVE *:=",BINARY",2;                                  <<01549>>11465000
      <<DEFAULT FILE DESIGNATOR>>                              <<01549>>11470000
      IF FOPDESIGNATOR <= 6 THEN                               <<01549>>11475000
         CASE FOPDESIGNATOR OF                                 <<01549>>11480000
            BEGIN                                              <<01549>>11485000
            MOVE *:=",FORMAL",2;                               <<01549>>11490000
            MOVE *:=",$STDLIST",2;                             <<01549>>11495000
            MOVE *:=",$NEWPASS",2;                             <<01549>>11500000
            MOVE *:=",$OLDPASS",2;                             <<01549>>11505000
            MOVE *:=",$STDIN",2;                               <<01549>>11510000
            MOVE *:=",$STDINX",2;                              <<01549>>11515000
            MOVE *:=",$NULL",2;                                <<01549>>11520000
            END;                                               <<01549>>11525000
      <<RECORD FORMAT>>                                        <<01549>>11530000
      MOVE *:=RECFMT(2*FOPFORMAT),(2),2;                       <<01549>>11535000
      <<CARRIAGE CONTROL>>                                     <<01549>>11540000
      IF FOPCONTROL THEN MOVE *:=",CCTL",2 ELSE MOVE*:=",NOCCTL",2;     11545000
      <<ALLOW FILE EQUATIONS>>                                 <<01549>>11550000
      MOVE *:=FILEQUATION(FOPNOEQUATE*4),(4),2;                <<01549>>11555000
      <<FILE TYPE>>                                            <<01549>>11560000
      IF FOPFILETYPE <> 0 THEN                                 <<01549>>11565000
         MOVE *:=FILE'TYPE(FOPFILETYPE*4),(4),2;               <<01549>>11570000
      IF FOPLABELLED THEN                                      <<01549>>11575000
         BEGIN  <<LABELED TAPE>>                               <<01549>>11580000
         MAKEROOM(*,5);                                        <<01549>>11585000
         MOVE *:="LABEL",2;                                    <<01549>>11590000
         END                                                   <<01549>>11595000
      ELSE                                                     <<01549>>11600000
         BEGIN                                                 <<01549>>11605000
         MAKEROOM(*,7);                                        <<01549>>11610000
         MOVE *:="NOLABEL",2;                                  <<01549>>11615000
         END;                                                  <<01549>>11620000
      DEL;                                                     <<01549>>11625000
      PRINTLINE;                                               <<01549>>11630000
      END;  <<PRINTFOPTIONS>>                                  <<01549>>11635000
                                                               <<01549>>11640000
                                                               <<01549>>11645000
   SUBROUTINE PRINTAOPTIONS;                                   <<01549>>11650000
      BEGIN                                                    <<01549>>11655000
      MOVE LINE:="!  AOPTIONS:                                     !";  11660000
      <<ACCESS TYPE>>                                          <<01549>>11665000
      TOS:=@LINE(13);                                          <<01549>>11670000
      IF AOPACTYPE <= 6 THEN                                   <<01549>>11675000
         CASE AOPACTYPE OF                                     <<01549>>11680000
            BEGIN                                              <<01549>>11685000
            MOVE *:="INPUT",2;                                 <<01549>>11690000
            MOVE *:="OUTPUT",2;                                <<01549>>11695000
            MOVE *:="OUTKEEP",2;                               <<01549>>11700000
            MOVE *:="APPEND",2;                                <<01549>>11705000
            MOVE *:="IN/OUT",2;                                <<01549>>11710000
            MOVE *:="UPDATE",2;                                <<01549>>11715000
            MOVE *:="EXECUTE",2;                               <<01549>>11720000
            END;                                               <<01549>>11725000
      <<MULTIRECORD ACCESS>>                                   <<01549>>11730000
      IF AOPMULTIREC THEN MOVE *:=",MR",2 ELSE MOVE *:=",NOMR",2;       11735000
      <<LOCKABLE>>                                             <<01549>>11740000
      IF AOPLOCKING THEN MOVE *:=",LOCK",2 ELSE MOVE *:=",NOLOCK",2;    11745000
      <<EXCLUSIVE OPTIONS>>                                    <<01549>>11750000
      IF AOPSEMI THEN                                          <<01549>>11755000
         MOVE *:=",SEMI",2                                     <<01549>>11760000
      ELSE                                                     <<01549>>11765000
         MOVE *:=EXCL(4*AOPACMODE),(4),2;                      <<01549>>11770000
      <<BUFFER OR NO-BUFFER>>                                  <<01549>>11775000
      IF AOPINHIBITBUF THEN MOVE *:=",NOBUF",2 ELSE MOVE *:=",BUF",2;   11780000
                                                               <<01549>>11785000
      <<MULTI ACCESS>>                                         <<01549>>11790000
      IF AOPMULTAC = 1 THEN                                    <<01549>>11795000
         BEGIN                                                 <<01549>>11800000
         MAKEROOM(*,5);                                        <<01549>>11805000
         MOVE *:="MULTI",2;                                    <<01549>>11810000
         END                                                   <<01549>>11815000
      ELSE IF AOPGLOBALMULTAC THEN                             <<01549>>11820000
         BEGIN                                                 <<01549>>11825000
         MAKEROOM(*,6);                                        <<01549>>11830000
         MOVE *:="GMULTI",2;                                   <<01549>>11835000
         END                                                   <<01549>>11840000
      ELSE                                                     <<01549>>11845000
         BEGIN                                                 <<01549>>11850000
         MAKEROOM(*,7);                                        <<01549>>11855000
         MOVE *:="NOMULTI",2;                                  <<01549>>11860000
         END;                                                  <<01549>>11865000
      IF AOPNOWAIT THEN                                        <<01549>>11870000
         BEGIN  <<NO WAIT>>                                    <<01549>>11875000
         MAKEROOM(*,6);                                        <<01549>>11880000
         MOVE *:="NOWAIT",2;                                   <<01549>>11885000
         END                                                   <<01549>>11890000
      ELSE                                                     <<01549>>11895000
         BEGIN                                                 <<01549>>11900000
         MAKEROOM(*,5);                                        <<01549>>11905000
         MOVE *:="WAIT",2;                                     <<01549>>11910000
         END;                                                  <<01549>>11915000
      IF AOPCOPY THEN                                          <<01549>>11920000
         BEGIN  <<COPY>>                                       <<01549>>11925000
         MAKEROOM(*,4);                                        <<01549>>11930000
         MOVE *:="COPY",2;                                     <<01549>>11935000
         END                                                   <<01549>>11940000
      ELSE                                                     <<01549>>11945000
         BEGIN                                                 <<01549>>11950000
         MAKEROOM(*,6);                                        <<01549>>11955000
         MOVE *:="NOCOPY",2;                                   <<01549>>11960000
         END;                                                  <<01549>>11965000
      DEL;                                                     <<01549>>11970000
      PRINTLINE;                                               <<01549>>11975000
      END;  <<PRINTAOPTIONS>>                                  <<01549>>11980000
                                                               <<01549>>11985000
                                                               <<01549>>11990000
   SUBROUTINE PRINTDETAILS;                                    <<01549>>11995000
      BEGIN                                                    <<01549>>12000000
      MOVE LINE:="!  FILE NAME IS ############################     !";  12005000
      MOVE LINE(16):=FILENAME,(28);                            <<01549>>12010000
      PRINTLINE;                                               <<01549>>12015000
                                                               <<01549>>12020000
      PRINTFOPTIONS;                                           <<01549>>12025000
      PRINTAOPTIONS;                                           <<01549>>12030000
                                                               <<01549>>12035000
      <<DEVICE>>                                               <<01549>>12040000
      MOVE LINE:="!  DEVICE TYPE: #      DEVICE SUBTYPE: #         !";  12045000
      ASCII(DEVTYPE.(8:8),10,LINE(16));                        <<01549>>12050000
      ASCII(DEVTYPE.(0:8),10,LINE(39));                        <<01549>>12055000
      PRINTLINE;                                               <<01549>>12060000
      MOVE LINE:="!  LDEV: #        DRT: #         UNIT: #         !";  12065000
      ASCII(LDNUM,10,LINE(9));                                 <<01549>>12070000
      FFILEINFO(FILENUM,47,DRT,48,UNIT);                       <<03051>>12075000
      ASCII(DRT,10,LINE(23));                                  <<03051>>12080000
      ASCII(UNIT,10,LINE(39));                                 <<03051>>12085000
      PRINTLINE;                                               <<01549>>12090000
                                                               <<01549>>12095000
      MOVE LINE:="!  RECORD SIZE: #      BLOCK SIZE: #     (WORDS) !";  12100000
      IF RECSIZE<0 THEN                                        <<01549>>12105000
         BEGIN <<FILE TYPE IS ASCII>>                          <<01549>>12110000
         MOVE LINE(42):="BYTES";                               <<01549>>12115000
         RECSIZE:=-RECSIZE;  BLKSIZE:=-BLKSIZE;                <<01549>>12120000
         END;                                                  <<01549>>12125000
      ASCII(RECSIZE,10,LINE(16));                              <<01549>>12130000
      ASCII(BLKSIZE,10,LINE(35));                              <<01549>>12135000
      PRINTLINE;                                               <<01549>>12140000
                                                               <<01549>>12145000
      MOVE LINE:=                                              <<01549>>12150000
         "!  EXTENT SIZE: #      MAX EXTENTS: #            !"; <<01549>>12155000
      DASCII (DEXTSIZE,10,LINE(16));                           <<01549>>12160000
      ASCII(NUMEXTENTS,10,LINE(36));                           <<01549>>12165000
      PRINTLINE;                                               <<01549>>12170000
                                                               <<01549>>12175000
      MOVE LINE:=                                              <<01549>>12180000
         "!  RECPTR: #           RECLIMIT: #               !"; <<01549>>12185000
      DASCII(RECPTR,10,LINE(11));                              <<01549>>12190000
      DASCII(FLIMIT,10,LINE(33));                              <<01549>>12195000
      PRINTLINE;                                               <<01549>>12200000
                                                               <<01549>>12205000
      MOVE LINE:=                                              <<01549>>12210000
         "!  LOGCOUNT: #            PHYSCOUNT: #           !"; <<01549>>12215000
      DASCII(LOGCOUNT,10,LINE(13));                            <<01549>>12220000
      DASCII(PHYSCOUNT,10,LINE(37));                           <<01549>>12225000
      PRINTLINE;                                               <<01549>>12230000
                                                               <<01549>>12235000
      MOVE LINE:=                                              <<01549>>12240000
         "!  EOF AT: #           LABEL ADDR: %#            !"; <<01549>>12245000
      DASCII(EOF,10,LINE(11));                                 <<01549>>12250000
      DASCII(LABADDR, 8, LINE(36));                            <<01549>>12255000
      PRINTLINE;                                               <<01549>>12260000
                                                               <<01549>>12265000
      MOVE LINE:=                                              <<01549>>12270000
         "!  FILE CODE: #      ID IS #         ULABELS: #  !"; <<01549>>12275000
      ASCII(FILECODE,10,LINE(14));                             <<01549>>12280000
      MOVE LINE(27):=CREATORID,(8);                            <<01549>>12285000
      ASCII(USERLABELS,10,LINE(46));                           <<01549>>12290000
      PRINTLINE;                                               <<01549>>12295000
                                                               <<01549>>12300000
      MOVE LINE:=                                              <<01549>>12305000
         "!  PHYSICAL STATUS: ????????????????             !"; <<01549>>12310000
      IF NOT FOPKSAMFILE AND DEVTYPE.(8:8) <> 16 THEN          <<01580>>12315000
         BEGIN                                                 <<01567>>12320000
         DEVSTAT:=DEVICESTATUS(LDNUM);                         <<01794>>12325000
         IF >= THEN BINCONV(DEVSTAT,LINE(20),16);              <<01794>>12330000
         PRINTLINE;                                            <<01567>>12335000
         END;                                                  <<01567>>12340000
      IF FOPMSGFILE THEN                                       <<01549>>12345000
         BEGIN  <<MESSAGE FILE, PRINT # READERS AND WRITERS>>  <<01549>>12350000
         FFILEINFO(FILENUM,34,NUMWRITERSB,35,NUMREADERSB);     <<01549>>12355000
         MOVE LINE:=                                           <<01549>>12360000
            "!  NUMBER WRITERS:     NUMBER READERS:           !";       12365000
         ASCII(NUMWRITERS,10,LINE(19));                        <<01549>>12370000
         ASCII(NUMREADERS,10,LINE(39));                        <<01549>>12375000
         PRINTLINE;                                            <<01549>>12380000
         END;                                                  <<01549>>12385000
      END;  <<PRINTDETAILS>>                                   <<01549>>12390000
                                                               <<01549>>12395000
                                                               <<01549>>12400000
PRINTFILEINFO:   <<UNPRIMED ENTRY POINT>>                      <<01549>>12405000
   ERRORON;                                                    <<01549>>12410000
   CHECKDB;                                                    <<01549>>12415000
   IF <> THEN ERROREXIT(PRINTINFOHANG,ILLEGALDB,0);            <<01549>>12420000
   <<SKIP A LINE AND PRINT HEADING>>                           <<01549>>12425000
   MOVE LINE:="  ";  PRINT(BUFFER, -1, %40);                   <<01549>>12430000
   MOVE LINE:="+-F-I-L-E---I-N-F-O-R-M-A-T-I-O-N---D-I-S-P-L-A-Y+";     12435000
   PRINTLINE;                                                  <<01549>>12440000
   FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);              <<01613>>12445000
   IF FILENUM <> 0 THEN                                        <<01549>>12450000
      BEGIN  <<PRINT ALL THE FILE INFORMATION>>                <<01549>>12455000
      FGETINFO(FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,,     12460000
      <<HDADDR>>,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,<<03051>>12465000
      BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABELS,CREATORID,LABADDR);<<03051>>12470000
      IF <> OR NOT STATUS.(0:1) AND (1 <= FILENUM <= 2) THEN   <<01580>>12475000
         BEGIN <<UNDEFINED FILE NUMBER>>                       <<01549>>12480000
         MOVE LINE:=                                           <<01549>>12485000
            "!  FILE NUMBER #      IS UNDEFINED.              !";       12490000
         ASCII(FILENUM,10,LINE(15));                           <<01549>>12495000
         PRINTLINE;                                            <<01549>>12500000
         FILENUM:=0;                                           <<01549>>12505000
         END                                                   <<*8212>>12510000
      ELSE  << get device #, all else is ok >>                 <<*8212>>12515000
      BEGIN                                                    << 8337>>12520000
        FFILEINFO(FILENUM,50,LDNUM); <<GET LOG. DEV. #>>       << 8337>>12525000
        IF <> THEN                                             << 8337>>12530000
           LDNUM := -1;                                        << 8337>>12535000
           PRINTDETAILS;                                       << 8337>>12540000
      END; << IF <> >>                                         << 8337>>12545000
      END;  << end print all the file information>>            <<*8212>>12550000
                                                               <<01549>>12555000
   <<PRINT FILE CHECK INFORMATION>>                            <<01549>>12560000
   ECODE:=ERRORCODE.(8:8);                                     <<01549>>12565000
   MOVE LINE:="!  ERROR NUMBER: #     RESIDUE: #        (WORDS) !";     12570000
   ASCII(ECODE,10,LINE(17));                                   <<01549>>12575000
   IF TLOG=0 THEN                                              <<01549>>12580000
      MOVE LINE(41):="       "                                 <<01549>>12585000
   ELSE IF < THEN                                              <<01549>>12590000
      BEGIN TLOG:=-TLOG; MOVE LINE(42):="BYTES" END;           <<01549>>12595000
   ASCII(TLOG,10,LINE(32));                                    <<01549>>12600000
   PRINTLINE;                                                  <<01549>>12605000
                                                               <<01549>>12610000
   MOVE LINE:="!  BLOCK NUMBER: #            NUMREC: #          !";     12615000
   DASCII(BLKNUM,10,LINE(17));                                 <<01549>>12620000
   ASCII(NUMRECS,10,LINE(38));                                 <<01549>>12625000
   PRINTLINE;                                                  <<01549>>12630000
                                                               <<01549>>12635000
   MOVE LINE:="+------------------------------------------------+";     12640000
   PRINTLINE;                                                  <<01549>>12645000
   ERROREXIT(PRINTINFOHANG,0,0);                               <<01549>>12650000
   END;  <<PRINT'FILE'INFO>>                                   <<01549>>12655000
$PAGE "PROCEDURE LOG"                                          <<01711>>12660000
<< Procedure LOG was moved from segment Pcreate to Utility1 >> <<01711>>12665000
<< for MPE-IV (C-MIT) to reduce the length of Pcreate.      >> <<01711>>12670000
$CONTROL SEGMENT=UTILITY1                                      <<01711>>12675000
PROCEDURE LOG;                                                 <<01711>>12680000
OPTION UNCALLABLE;                                             <<01711>>12685000
                                                               <<01711>>12690000
COMMENT:                                                       <<01711>>12695000
         CHECKS IF LOG REQUIRED FOR THAT RECORD                <<01711>>12700000
         FORMATS LOG RECORD ACCORDING TO CATALOGUE             <<01711>>12705000
         OUTPUTS RECORD TO BUFFER                              <<01711>>12710000
         ACTIVATES LOG PROCESS IF BUFFER FULL                  <<01711>>12715000
         DB MAY BE POINTING ANYWHERE BUT HAS TO BE SPECIFIED   <<01711>>12720000
            IN CATALOGUE : FIRST WORD OF ENTRY .(0:2)          <<01711>>12725000
         ;                                                     <<01711>>12730000
                                                               <<01711>>12735000
BEGIN                                                          <<01711>>12740000
                                                               <<01711>>12745000
      INTEGER S0 = S-0;                                        <<01711>>12750000
                                                               <<01711>>12755000
      DEFINE                                                   <<01711>>12760000
        DISAPROC        = ASSEMBLE (PSDB)#,                    <<01711>>12765000
        ENAPROC         = ASSEMBLE (PSEB)#,                    <<01711>>12770000
        DISABLE         = ASSEMBLE (SED 0)#,                   <<01711>>12775000
        ENABLE          = ASSEMBLE (SED 1)#;                   <<01711>>12780000
      DEFINE STATE      = (0:2)#;                              <<06897>>12785000
                                                               <<01711>>12790000
      EQUATE                                                   <<01711>>12795000
                                                                        12800000
      SYSDB       = 512,         <<SYSTEM DB OFFSET>>                   12805000
                                                                        12810000
      LOGPINX     = SYSDB+%150,  <<LOG PROCESS PCB INDEX>>              12815000
      LOGINFO     = SYSDB+%167,  <<LOGGING AREA>>                       12820000
      BUF0X       = SYSDB+%172,  <<BUFFER 0 DST NR.>>                   12825000
      BUF1X       = SYSDB+%173,  <<BUFFER 1 DST NR.>>                   12830000
      BUFSIZEX    = SYSDB+%174,  <<BUFFER SIZE (SECTORS)>>              12835000
      FREEX       = SYSDB+%175,  <<FREE AREA POINTER>>                  12840000
      FLAGX       = SYSDB+%176,  <<FLAG WORD>>                          12845000
      LOGREC0X    = SYSDB+%177,  <<BUFFER 0 RECORDS WRITTEN>>           12850000
      LOGREC1X    = SYSDB+%200,  <<BUFFER 1 RECORDS WRITTEN>>           12855000
      FILESIZE0X  = SYSDB+%201,  <<FILE SIZE (BLOCKS) - 1ST HALF>>      12860000
      FILESIZE1X  = SYSDB+%202,  <<FILE SIZE (BLOCKS) - 2ND HALF>>      12865000
      FNX         = SYSDB+%205,  <<FILE NUMBER>>                        12870000
      BLOCKS0X    = SYSDB+%206,  <<BLOCKS WRITTEN - 1ST HALF>>          12875000
      BLOCKS1X    = SYSDB+%207,  <<BLOCKS WRITTEN - 2ND HALF>>          12880000
      LOST0X      = SYSDB+%210,  <<TOTAL RECORDS LOST - 1ST HALF>>      12885000
      LOST1X      = SYSDB+%211,  <<TOTAL RECORDS LOST - 2ND HALF>>      12890000
      JINITLOSTX  = SYSDB+%212,  <<RECORDS LOST - JOB INITIATION>>      12895000
      JTERMLOSTX  = SYSDB+%213,  <<RECORDS LOST - JOB TERMINATION>>     12900000
                                                                        12905000
      EMPTY       = 0,           <<EMPTY BUFFER STATE>>                 12910000
      CURRENT     = 1,           <<CURRENT BUFFER STATE>>               12915000
      FULL        = 2,           <<FULL BUFFER STATE>>                  12920000
                                                                        12925000
      DIRSIR      = 8,           <<DIRECTORY SIR>>                      12930000
      BUFSIR      = 26,          <<LOG BUFFER SIR NR.>>                 12935000
      FILESIR     = 37,          <<FILE SYSTEM SIR NR.>>                12940000
      MINSIZE     = 12,                                                 12945000
     LPROC     = 7; << SYS PROC. NR. OF LOG PROC >>            <<06594>>12950000
                                                                        12955000
$INCLUDE INCLSIR                                               <<06263>>12960000
                                                                        12965000
COMMENT:                                                       <<04594>>12970000
     The following is an explanation of the 3 words called     <<04594>>12975000
the logging mask found in SYSGLOB cells 167-171.  For each     <<04594>>12980000
rectype (Log Type) the corresponding bit in the correspond-    <<04594>>12985000
ing word is turned on (bit=1) if the logging for that          <<04594>>12990000
RECTYPE is enabled, and off (0) is not enabled.  RECTYPE 0     <<04594>>12995000
used to determine if system logging is enabled or disabled.    <<04594>>13000000
                                                               <<04594>>13005000
RECTYPE   Word  Bit          RECTYPE    Word   Bit             <<04594>>13010000
-------   ----  ---     |    -------    ----   ---             <<04594>>13015000
   0       0     15     |      25        1       6             <<04594>>13020000
   1       0     14     |      26        1       5             <<04594>>13025000
   2       0     13     |      27        1       4             <<04594>>13030000
   3       0     12     |      28        1       3             <<04594>>13035000
   4       0     11     |      29        1       2             <<04594>>13040000
   5       0     10     |      30        1       1             <<04594>>13045000
   6       0      9     |      31        1       0             <<04594>>13050000
   7       0      8     |      32        2      15             <<04594>>13055000
   8       0      7     |      33        2      14             <<04594>>13060000
   9       0      6     |      34        2      13             <<04594>>13065000
  10       0      5     |      35        2      12             <<04594>>13070000
  11       0      4     |      36        2      11             <<04594>>13075000
  12       0      3     |      37        2      10             <<04594>>13080000
  13       0      2     |      38        2       9             <<04594>>13085000
  14       0      1     |      39        2       8             <<04594>>13090000
  15       0      0     |      40        2       7             <<04594>>13095000
  16       1     15     |      41        2       6             <<04594>>13100000
  17       1     14     |      42        2       5             <<04594>>13105000
  18       1     13     |      43        2       4             <<04594>>13110000
  19       1     12     |      44        2       3             <<04594>>13115000
  20       1     11     |      45        2       2             <<04594>>13120000
  21       1     10     |      46        2       1             <<04594>>13125000
  22       1      9     |      47        2       0             <<04594>>13130000
  23       1      8     |      48  Out of Bounds               <<04594>>13135000
  24       1      7     |                                      <<04594>>13140000
=============================================================  <<04594>>13145000
;                                                              <<04594>>13150000
                                                                        13155000
                                                                        13160000
      ENTRY LOG1,                                                       13165000
            LOG2,                                                       13170000
            LOG3,                                                       13175000
            LOG4,                                                       13180000
            LOG5,                                                       13185000
            LOG6,                                                       13190000
            LOG7,                                                       13195000
            LOG8,                                                       13200000
            LOG9,                                                       13205000
            LOG10,                                                      13210000
      LOG11,                                                   <<01711>>13215000
      LOG12,                                                   <<01711>>13220000
      LOG13,                                                   <<01711>>13225000
      LOG14,                                                   <<01711>>13230000
      LOG15,                                                   <<01765>>13235000
      LOG16,                                                   <<04853>>13240000
      LOG17,  << X.21 Call Progress Signals >>                 <<04853>>13245000
      LOG18,  << X.21 DCE Provided Information >>              <<04853>>13250000
      LOG46,                                                   <<03104>>13255000
      LOG47;                                                   <<03104>>13260000
COMMENT                                                        <<01711>>13265000
   THE CATALOGUE CONSISTS OF 16-BYTE ENTRIES FOR EACH LOG TYPE:<<06896>>13270000
      1 ST BYTE.(0:2) = DB MODE AT CALL                        <<01711>>13275000
         0=STACK                                               <<01711>>13280000
         1=EXTRA DATA SEGMENT                                  <<01711>>13285000
         2=SYSTEM GLOBAL AREA                                  <<01711>>13290000
      1 ST BYTE.(2:6) = # OF PARAMETER WORDS                   <<01711>>13295000
         (COUNT FOR EXIT INSTRUCTION)                          <<01711>>13300000
      SUBSEQUENT FOUR-BIT ENTRIES DESCRIBE EACH PARAMETER:     <<01711>>13305000
         0=END OF PARAMETER LIST                               <<01711>>13310000
         1=WORD BY VALUE                                       <<01711>>13315000
         2=BYTE BY VALUE                                       <<01711>>13320000
         3=DOUBLEWORD BY VALUE                                 <<01711>>13325000
         4=TRIPLEWORD BY VALUE                                 <<01711>>13330000
         5=QUADRUPLE ARRAY BY REFERENCE                        <<01711>>13335000
         6=WORD ARRAY BY REFERENCE                             <<01711>>13340000
         7=BYTE ARRAY BY REFERENCE                             <<01711>>13345000
         8=27-BYTE ARRAY BY REFERENCE                          <<01711>>13350000
      ***WITH REFERENCE DATA, ADDR IN 1ST WORD, LENGTH         <<01711>>13355000
         IN SECOND WORD**************                          <<01711>>13360000
;                                                              <<01711>>13365000
      BYTE ARRAY CAT0(*)=PB := 5,%63,0,0,0,0,0,0,              <<06896>>13370000
                0,0,0,0,0,0,0,0;                               <<06896>>13375000
      BYTE ARRAY CAT1(*)=PB := 12,%61,%104,%60,0,0,0,0,        <<06896>>13380000
                0,0,0,0,0,0,0,0;                               <<06896>>13385000
      BYTE ARRAY CAT2(*)=PB := 13,%125,%125,%21,%21,%61,%20,0, <<06896>>13390000
                0,0,0,0,0,0,0,0;                               <<06896>>13395000
      BYTE ARRAY CAT3(*)=PB := 7,%21,%63,0,0,0,0,0,            <<06896>>13400000
                0,0,0,0,0,0,0,0;                               <<06896>>13405000
      BYTE ARRAY CAT4(*)=PB := 9,%21,%21,%23,%20,0,0,0,        <<07171>>13410000
                0,0,0,0,0,0,0,0;                               <<06896>>13415000
      BYTE ARRAY CAT5(*)=PB := 11,%201,%61,%63,%20,0,0,0,      <<06896>>13420000
                0,0,0,0,0,0,0,0;                               <<06896>>13425000
      BYTE ARRAY CAT6(*)=PB := 4,%21,%20,0,0,0,0,0,            <<06896>>13430000
                0,0,0,0,0,0,0,0;                               <<06896>>13435000
      BYTE ARRAY CAT7(*)=PB := 2,%20,0,0,0,0,0,0,              <<06896>>13440000
                0,0,0,0,0,0,0,0;                               <<06896>>13445000
      BYTE ARRAY CAT8(*)=PB := %35,%104,%104,%104,%104,%101,   <<04205>>13450000
                0,0,0,0,0,0,0,0,0,0;                           <<06896>>13455000
      BYTE ARRAY CAT9(*)=PB:=16,%23,%63,%21,%167,%160,0,0,     <<06896>>13460000
                0,0,0,0,0,0,0,0;                               <<06896>>13465000
      BYTE ARRAY CAT10(*)=PB:=6,%24,%120,0,0,0,0,0,            <<06896>>13470000
                0,0,0,0,0,0,0,0;                               <<06896>>13475000
      BYTE ARRAY CAT11(*)=PB := 16,%21,%21,%21,%21,%21,%21,%21,<<07170>>13480000
              %20,0,0,0,0,0,0,0;                               <<07170>>13485000
BYTE ARRAY CAT12(*)=PB:=5,%21,%140,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13490000
BYTE ARRAY CAT13(*)=PB:=9,%21,%146,%140,0,0,0,0,               <<06896>>13495000
                     0,0,0,0,0,0,0,0;                          <<06896>>13500000
BYTE ARRAY CAT14(*)=PB:=3,%140,0,0,0,0,0,0,0,0,0,0,0,0,0,0;    <<06896>>13505000
   BYTE ARRAY CAT15(*)=PB:=4,%27,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13510000
   BYTE ARRAY CAT16(*)=PB:=6,%107,0,0,0,0,0,0,0,0,0,0,0,0,0,0; <<06896>>13515000
   BYTE ARRAY CAT17(*)=PB:=3,%21,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13520000
   BYTE ARRAY CAT18(*)=PB:=5,%21,%60,0,0,0,0,0,0,0,0,0,0,0,0,0;<<06896>>13525000
   BYTE ARRAY CAT19(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13530000
   BYTE ARRAY CAT20(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13535000
   BYTE ARRAY CAT21(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13540000
   BYTE ARRAY CAT22(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13545000
   BYTE ARRAY CAT23(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13550000
   BYTE ARRAY CAT24(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13555000
   BYTE ARRAY CAT25(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13560000
   BYTE ARRAY CAT26(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13565000
   BYTE ARRAY CAT27(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13570000
   BYTE ARRAY CAT28(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13575000
   BYTE ARRAY CAT29(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13580000
   BYTE ARRAY CAT30(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13585000
   BYTE ARRAY CAT31(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13590000
   BYTE ARRAY CAT32(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13595000
   BYTE ARRAY CAT33(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13600000
   BYTE ARRAY CAT34(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13605000
   BYTE ARRAY CAT35(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13610000
   BYTE ARRAY CAT36(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13615000
   BYTE ARRAY CAT37(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13620000
   BYTE ARRAY CAT38(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13625000
   BYTE ARRAY CAT39(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13630000
   BYTE ARRAY CAT40(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13635000
   BYTE ARRAY CAT41(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13640000
   BYTE ARRAY CAT42(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13645000
   BYTE ARRAY CAT43(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13650000
   BYTE ARRAY CAT44(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13655000
   BYTE ARRAY CAT45(*)=PB := 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;  <<06896>>13660000
   BYTE ARRAY CAT46(*)=PB:=11,%21,%21,%21,%21,%160,0,0,        <<06896>>13665000
               0,0,0,0,0,0,0,0;                                <<06896>>13670000
   BYTE ARRAY CAT47(*)=PB:=6,%21,%27,0,0,0,0,0,0,0,0,0,0,0,0,0;<<06896>>13675000
<<>>                                                           <<01711>>13680000
   EQUATE NUMLOGS=47;                                          <<03104>>13685000
<<>>                                                           <<01711>>13690000
      ARRAY CATL(*)=CAT0(0);                                            13695000
      BYTE ARRAY BCAT(*)=CAT0(0);                                       13700000
      LOGICAL NEXIT;  <<SDEC FOR LOG EXIT>>                             13705000
      INTEGER BX;  <<BUFFER INDEX>>                                     13710000
      INTEGER PINX;  <<PIN FOR CURRENT PROCESS>>                        13715000
      INTEGER PARMX;  <<LOG PARAMETER INDEX>>                           13720000
      INTEGER N;  <<PARAMETER NR.>>                                     13725000
      INTEGER PTYPE;  <<PARAMETER TYPE NR.>>                            13730000
      INTEGER T;  <<UTILITY VARIABLE>>                                  13735000
      INTEGER TEMP;     <<TEMP VARIABLE USED FOR I/O LOGGING>> <<01711>>13740000
      INTEGER RECTYPE;  <<LOG RECORD TYPE NR.>>                         13745000
      INTEGER BSIZE;  <<BUFFER SIZE IN WORDS>>                          13750000
      INTEGER FREEP;  <<FREE BUFFER AREA INDEX>>                        13755000
      INTEGER CB;  <<CURRENT LOG BUFFER NR.>>                           13760000
      INTEGER ORIG'BUF;  <<CURRENT BUF WHEN ENTER LOG>>        <<01711>>13765000
      INTEGER DST;  <<BUFFER DST NR.>>                                  13770000
      INTEGER S;  <<FOR GETSIR>>                                        13775000
      INTEGER CR;  <<FOR SETCRITICAL>>                                  13780000
      LOGICAL SUSP := FALSE;                                            13785000
      LOGICAL LOGPF;  <<CALLING PROCESS IS LOG PROCESS?>>               13790000
      INTEGER DBMODE;  <<DB SETTING: 0=STACK,1=DATA SEG.,2=ABSOLUTE>>   13795000
      INTEGER INDEX'WORD,INDEX,OFFSET;                         <<04205>>13800000
      INTEGER SIRTABINX;                                       <<06263>>13805000
      ARRAY PARMLIST(*)=Q+0;                                            13810000
      LOGICAL FULLF;                                                    13815000
      LOGICAL PCBPT;                                           <<06594>>13820000
LOGICAL PXFIXEDLOC;                                            <<06593>>13825000
ARRAY QARRAY(*) = Q + 0;                                       <<06593>>13830000
<<>>                                                           <<01711>>13835000
         EQUATE BUFMAX=200;<<MAXIMUM LOG RECORD SIZE>>         <<01711>>13840000
<<  THIS VALUE SHOULD BE LARGE ENOUGH TO CONTAIN GOOD SIZE>>   <<01711>>13845000
<<  CONSOLE OPERATOR MESSAGES, SUCH AS, LARGE TELLOP'S    >>   <<01711>>13850000
<<  CONSOLE LOGGING MESSAGES LARGER THAN BUFMAX ARE TRUNCATED>><<01711>>13855000
<<>>                                                           <<01711>>13860000
         BYTE ARRAY BUFB(0:BUFMAX)=Q; <<INTERMEDIATE BUFFER>>  <<01711>>13865000
      ARRAY BUF(*)=BUFB;                                                13870000
      INTEGER CALENDARSTAMP = BUF+3;  <<DAY AND YEAR>>                  13875000
      DOUBLE CLOCKSTAMP = BUF+4;  <<TIME OF DAY>>                       13880000
                                                                        13885000
<<------------------------------------------------------------------->> 13890000
                                                                        13895000
INTEGER SUBROUTINE NEXTPTYPE (N);                                       13900000
   <<RETURNS THE PARAMETER TYPE NUMBER CORRESPONDING TO THE SPECIFIED   13905000
     PARAMETER NUMBER.                                                  13910000
                                                                        13915000
     INPUT VARIABLES:                                                   13920000
         N - PARAMETER NUMBER                                           13925000
                                                                        13930000
     OUTPUT VARIABLES:                                                  13935000
         NEXTPTYPE - PARAMETER TYPE NUMBER                              13940000
                                                                        13945000
   >>                                                                   13950000
   VALUE N;                                                             13955000
   INTEGER N;                                                           13960000
BEGIN                                                                   13965000
                                                               <<04205>>13970000
                                                               <<04205>>13975000
  <<********************************************************>> <<04205>>13980000
  << First obtain WORD index into CATL array based on the   >> <<04205>>13985000
  << value of RECTYPE and N.                                >> <<04205>>13990000
  <<********************************************************>> <<04205>>13995000
                                                               <<04205>>14000000
  INDEX := (RECTYPE * 8) + ((N+1) /4);                         <<06896>>14005000
  INDEX'WORD := CATL(INDEX);                                   <<04205>>14010000
                                                               <<04205>>14015000
  <<********************************************************>> <<04205>>14020000
  << Now, obtain proper 4 bit field of 16 bit word based on >> <<04205>>14025000
  << the current value of N.                                >> <<04205>>14030000
  <<********************************************************>> <<04205>>14035000
                                                               <<04205>>14040000
  OFFSET := N MOD 4;                                           <<04205>>14045000
  CASE * OFFSET  OF                                            <<04205>>14050000
    BEGIN                                                      <<04205>>14055000
      NEXTPTYPE := INDEX'WORD.(4:4);                           <<04205>>14060000
      NEXTPTYPE := INDEX'WORD.(8:4);                           <<04205>>14065000
      NEXTPTYPE := INDEX'WORD.(12:4);                          <<04205>>14070000
      NEXTPTYPE := INDEX'WORD.(0:4);                           <<04205>>14075000
    END;                                                       <<04205>>14080000
                                                               <<04205>>14085000
END;  << N E X T P T Y P E >>                                           14090000
                                                                        14095000
<<------------------------------------------------------------------->> 14100000
                                                                        14105000
SUBROUTINE FORMATLOGREC;                                                14110000
   <<FORMATS A LOG RECORD FROM THE PARAMETERS TO THE LOG PROCEDURE      14115000
     AND INSERTS THE RECORD INTO THE LOCAL BUFFER BUF>>                 14120000
      BEGIN                                                             14125000
                                                                        14130000
      <<* * * FORMAT COMMON PREFACE TO LOG RECORD * * *>>               14135000
                                                                        14140000
      BUF(1) := RECTYPE;  <<RECORD TYPE>>                               14145000
      CALENDARSTAMP := CALENDAR;  <<DAY AND YEAR>>                      14150000
      CLOCKSTAMP := CLOCK;  <<TIME OF DAY>>                             14155000
      TOS := 0;  <<DUMMY JOB TYPE AND NR.>>                             14160000
     PCBPT := CURPRC;                                          <<06594>>14165000
     IF PROCSTATE.SYSTEMPROCFLAG = 0 THEN << USER PROCESS >>   <<06594>>14170000
         BEGIN                                                          14175000
         PXFIXED;                                              <<06593>>14180000
         S0 := PXFXJOBNUM;                                     <<06593>>14185000
         S0.(0:2) := PXFXJOBTYPE;                              <<06593>>14190000
         END;                                                           14195000
      BUF(6) := TOS;  <<JOB TYPE AND NR.>>                              14200000
                                                                        14205000
      <<* * * FORMAT UNIQUE PART OF LOG RECORD * * *>>                  14210000
                                                                        14215000
      BX := 7;  <<INDEX IN LOCAL BUFFER>>                               14220000
      N := 1;  <<PARM. NR.>>                                            14225000
      DO BEGIN                                                          14230000
         PTYPE := NEXTPTYPE(N);  <<PARM. TYPE NR.>>                     14235000
         IF LOGICAL(PTYPE) > 8 THEN SUDDENDEATH(%41);  <<INVALID?>>     14240000
         CASE * PTYPE OF                                                14245000
            BEGIN                                                       14250000
                                                                        14255000
            <<0 - PARM. LIST TERMINATOR>>                               14260000
                                                                        14265000
            GO OUT;                                                     14270000
                                                                        14275000
            <<1 - 1 WORD BY VALUE>>                                     14280000
                                                                        14285000
            GO TO B;                                                    14290000
                                                                        14295000
            <<2 - 1 BYTE BY VALUE>>                                     14300000
                                                                        14305000
            GO TO B;                                                    14310000
                                                                        14315000
            <<3 - 2 WORDS BY VALUE>>                                    14320000
                                                                        14325000
            GO TO C;                                                    14330000
                                                                        14335000
            <<4 - 3 WORDS BY VALUE>>                                    14340000
                                                                        14345000
            BEGIN                                                       14350000
            BUF(BX) := PARMLIST(PARMX);                                 14355000
            BX := BX+1; PARMX := PARMX+1;                               14360000
C:          BUF(BX) := PARMLIST(PARMX);                                 14365000
            BX := BX+1; PARMX := PARMX+1;                               14370000
B:          BUF(BX) := PARMLIST(PARMX);                                 14375000
            BX := BX+1; PARMX := PARMX+1                                14380000
            END;                                                        14385000
                                                                        14390000
            <<5 - 4 WORDS BY REFERENCE>>                                14395000
                                                                        14400000
            BEGIN                                                       14405000
            TOS := PARMLIST(PARMX);                                     14410000
            MOVE BUF(BX) := *,(4);                                      14415000
            BX := BX+4;                                                 14420000
            PARMX := PARMX+1                                            14425000
            END;                                                        14430000
                                                                        14435000
            <<6 - WORD ARRAY BY REFERENCE>>                             14440000
                                                                        14445000
            BEGIN                                                       14450000
            TOS := PARMLIST(PARMX);  <<WORD ARRAY ADR.>>                14455000
            T := PARMLIST(PARMX := PARMX+1);                            14460000
            IF T>((BUFMAX/2)-BX) THEN T:=(BUFMAX/2)-BX;        <<01711>>14465000
            MOVE BUF(BX) := *,(T);                                      14470000
            BX := BX+T;                                                 14475000
            PARMX := PARMX+1                                            14480000
            END;                                                        14485000
                                                                        14490000
            <<7 - BYTE ARRAY BY REFERENCE>>                             14495000
                                                                        14500000
            BEGIN                                                       14505000
            TOS := PARMLIST(PARMX);  <<BYTE ARRAY ADR.>>                14510000
            T := PARMLIST(PARMX := PARMX+1);  <<LENGTH>>                14515000
            IF T>(BUFMAX-(BX*2)) THEN T:=BUFMAX-(BX*2);        <<01711>>14520000
            MOVE BUFB(BX&LSL(1)) := *,(T);                              14525000
            PARMX := PARMX+1;                                           14530000
            BX := BX+(T+1)&LSR(1)                                       14535000
            END;                                                        14540000
                                                                        14545000
            <<8 - 27 BYTE ARRAY BY REFERENCE>>                          14550000
                                                                        14555000
            BEGIN                                                       14560000
            TOS := PARMLIST(PARMX);                                     14565000
            MOVE BUFB(BX&LSL(1)) := *,(27);                             14570000
            PARMX := PARMX+1;                                           14575000
            BX := BX+14                                                 14580000
            END                                                         14585000
                                                                        14590000
            END;  <<OF CASE>>                                           14595000
         N := N+1  <<NEXT PARM. NR.>>                                   14600000
         END UNTIL ((N=31) OR (BX>(BUFMAX/2)));                <<06896>>14605000
                                                                        14610000
      <<* * * COMPLETE PREFACE INITIALIZATION * * *>>                   14615000
                                                                        14620000
OUT:  IF RECTYPE= 11                                           <<01711>>14625000
      THEN  BEGIN                                              <<01711>>14630000
            TEMP:= 0;                                          <<01711>>14635000
            DO BEGIN                                           <<01711>>14640000
               BUF(BX):= PARMLIST(PARMX);                      <<01711>>14645000
               BX:= BX+1;                                      <<01711>>14650000
               PARMX:= PARMX+1;                                <<01711>>14655000
               TEMP:= TEMP+1;                                  <<01711>>14660000
               END                                             <<01711>>14665000
            UNTIL TEMP>= INTEGER(BUF(7).(0:8));                <<01711>>14670000
            END;                                               <<01711>>14675000
      BUF := (BX-1)&LSL(1);  <<NR. OF BYTES IN BUFFER>>        <<01711>>14680000
      BUF(2) := BX-1;  <<RECORD LENGTH>>                                14685000
      BUF(BX) := -1  <<RECORD LINK>>                                    14690000
      END;  << F O R M A T L O G R E C >>                               14695000
<<------------------------------------------------------------------->> 14700000
                                                                        14705000
                                                                        14710000
                                                                        14715000
      << PROCEDURE BODY >>                                              14720000
LOG1:                                                                   14725000
LOG2:                                                                   14730000
LOG3:                                                                   14735000
LOG4:                                                                   14740000
LOG5:                                                                   14745000
LOG6:                                                                   14750000
LOG7:                                                                   14755000
LOG8:                                                                   14760000
LOG9:                                                                   14765000
LOG10:                                                                  14770000
LOG11:                                                         <<01711>>14775000
LOG12:                                                         <<01711>>14780000
LOG13:                                                         <<01711>>14785000
LOG14:                                                         <<01711>>14790000
   LOG15:                                                      <<01711>>14795000
LOG16:                                                         <<01765>>14800000
LOG17:                                                         <<04853>>14805000
LOG18:                                                         <<04853>>14810000
LOG46:                                                         <<03104>>14815000
LOG47:                                                         <<03104>>14820000
      LOGPF := FALSE;  <<PRESUMED NOT TO BE LOG PROCESS>>               14825000
      CR := SETCRITICAL;  <<SET CRITICAL MODE>>                         14830000
      RECTYPE := PARMLIST(-4);  <<RECORD TYPE NR.>>                     14835000
      IF LOGICAL(RECTYPE) > NUMLOGS THEN                       <<04223>>14840000
         BEGIN                                                 <<04223>>14845000
         SOFT'DEATH(%40); << LOG NUMBER GIVEN IS GREATER     >><<04223>>14850000
         RETURN;         << THAN THE HIGHEST ALLOWED LOG #.  >><<04223>>14855000
         END;                                                  <<04223>>14860000
                                                               <<04223>>14865000
<< EXTRACT FROM TABLES IN THIS PROCEDURE THE NUMBER OF   >>    <<04223>>14870000
<< PARAMETERS TO CUT BACK THE STACK.                     >>    <<04223>>14875000
      TOS := CATL(RECTYPE * 8   ).(2:6);  <<PARM. CUTBACK>>    <<06896>>14880000
                                                               <<03104>>14885000
      IF = THEN          <<IF TBL ENTRY IS 0 THEN SOFT'DEATH>  <<04223>>14890000
         BEGIN           <<ELSE JUST RETURN TO THE USER. THE >><<04223>>14895000
         SOFT'DEATH(%40); <<USER WILL NOT KNOW NOTHING HAS   >><<04223>>14900000
         RETURN;         <<BEEN LOGGED IS IF SYSTEM DOES NOT >><<04223>>14905000
         END;            <<CRASH.  THIS IS NO DIFFERENT THAN >><<04223>>14910000
                         <<IF THAT LOG TYPE IS NOT ENABLED.  >><<04223>>14915000
                                                               <<04223>>14920000
                                                               <<04223>>14925000
                                                               <<04223>>14930000
<<  I/O ERROR LOGGING CAN HAVE VARIABLE AMOUNT OF INFOR- >>    <<04223>>14935000
<<  MATION ON TOS.  PARMLIST(-5) GIVES THE NUMBER OF     >>    <<04223>>14940000
<<  ADDITIONAL WORDS TO CUT BACK THE STACK BY.           >>    <<04223>>14945000
                                                               <<04223>>14950000
      IF RECTYPE= 11 THEN  TOS:= TOS+PARMLIST(-5)+1;           <<03104>>14955000
      NEXIT := S0;  <<NB OF EXITS FROM LOG>>                            14960000
      PARMX := -TOS-3;  <<Q REL INDEX OF 1ST PARAM>>                    14965000
      DBMODE := CATL(RECTYPE  * 8  ).(0:2);<<DB MODE AT CALL>> <<06896>>14970000
      PINX := CURPRC;                                          <<06594>>14975000
      <<WATCH OUT FOR FILE LABEL AND DIRECTORY SIRS>>                   14980000
      IF RECTYPE = 5 THEN  <<CHECK FOR POSSIBLE DEADLOCK>>              14985000
         BEGIN                                                 <<06263>>14990000
         SIRTABINX := FILESIR*SIRTABENTRYLENGTH;               <<06263>>14995000
         IF SIR'HOLDER = PINX THEN GOTO RET;                   <<06263>>15000000
         SIRTABINX := DIRSIR*SIRTABENTRYLENGTH;                <<06263>>15005000
         IF SIR'HOLDER = PINX THEN GOTO RET;                   <<06263>>15010000
  <<  check for logging being enabled/disabled  >>             <<04594>>15015000
         END;                                                  <<06263>>15020000
      IF NOT ABSOLUTE(LOGINFO) THEN  <<NO LOGGING?>>                    15025000
         BEGIN                                                          15030000
   << check the softfail bit  >>                               <<04594>>15035000
         IF ABSOLUTE(FLAGX).(11:1) THEN  <<SUSPENDED?>>                 15040000
            BEGIN                                                       15045000
            SUSP := TRUE;                                               15050000
            GOTO L4                                                     15055000
            END;                                                        15060000
RET:     RESETCRITICAL(CR);                                             15065000
         TOS := %31400 LOR NEXIT;                                       15070000
         ASSEMBLE(XEQ 0)                                                15075000
         END;                                                           15080000
L4:                                                                     15085000
  <<  check logging mask to see if logging for the specified >><<04594>>15090000
  <<  log type (RECTYPE) is enabled/disabled .               >><<04594>>15095000
      IF NOT (ABSOLUTE(LOGINFO+RECTYPE&LSR(4))&LSR(RECTYPE MOD 16))     15100000
         THEN GOTO RET;  <<NO LOGGING FOR THAT RECORD?>>                15105000
                                                                        15110000
      IF SUSP THEN  <<SUSPENDED?>>                                      15115000
         BEGIN                                                          15120000
         TOS := ABSOLUTE(LOST0X); TOS := ABSOLUTE(X := X+1);            15125000
         TOS := TOS+1D;                                                 15130000
         ABSOLUTE(X) := TOS; ABSOLUTE(X := X-1) := TOS;                 15135000
         X := RECTYPE;                                                  15140000
         IF X = 2 OR X = 3 THEN  <<JOB INIT/TERM?>>                     15145000
            ABSOLUTE(X) := ABSOLUTE(LOST0X+X)+1;                        15150000
         GOTO RET                                                       15155000
         END;                                                           15160000
                                                                        15165000
      FULLF := FALSE;                                                   15170000
      FORMATLOGREC;                                                     15175000
      IF PINX = ABSOLUTE(LOGPINX) THEN << LOG PROCESS >>       <<06594>>15180000
         BEGIN                                                          15185000
         LOGPF := TRUE;  <<SET LOG PROCESS FLAG>>                       15190000
         DISAPROC;                                                      15195000
         SIRTABINX := BUFSIR*SIRTABENTRYLENGTH;                <<06263>>15200000
         TOS := SIR'HOLDER;                                    <<06263>>15205000
         ENAPROC;                                                       15210000
         IF TOS <> 0 THEN GO RET;  <<ANOTHER PROCESS HAS THE SIR?>>     15215000
         END;                                                           15220000
      S := GETSIR(BUFSIR);  <<GET LOG BUFFER SIR>>                      15225000
      ORIG'BUF:=CB:= ABSOLUTE(FLAGX).(13:1); <<CURRENT BUFFER>><<01711>>15230000
L1:   DST := ABSOLUTE(BUF0X+CB).(2:14); << BUFFER DST >>       <<06897>>15235000
      BSIZE := ABSOLUTE(BUFSIZEX)&LSL(7);  <<BUFFER SIZE IN WORDS>>     15240000
      FREEP := ABSOLUTE(FREEX);  <<FREE AREA INDEX>>                    15245000
      IF (BX+1) <= BSIZE-FREEP THEN  <<ROOM LEFT IN BUFFER?>>           15250000
         BEGIN                                                          15255000
                                                                        15260000
         <<SET DB TO STACK>>                                            15265000
                                                                        15270000
         CASE DBMODE OF                                                 15275000
            BEGIN                                                       15280000
                                                                        15285000
            ;                          <<DB AT STACK>>                  15290000
                                                                        15295000
L3:         TOS := EXCHANGEDB(0);      <<DB AT XTRA DATA SEGMENT>>      15300000
                                                                        15305000
            BEGIN                      <<DB IS SET IN ABSOLUTE MODE>>   15310000
            PUSH(DB);                                                   15315000
            RESETDB(-1);               <<TO DATA SEGMENT>>              15320000
            GOTO L3                                                     15325000
            END                                                         15330000
                                                                        15335000
            END;  <<END CASE>>                                          15340000
                                                                        15345000
         <<MOVE INFO INTO CURRENT BUFFER>>                              15350000
                                                                        15355000
         TOS := DST; TOS := FREEP;  <<TARGET DST AND OFFSET>>           15360000
         TOS := @BUF;  <<SOURCE ADR.>>                                  15365000
         TOS := BX+1;  <<COUNT>>                                        15370000
  << move information to be logged to buffer data seg.       >><<04594>>15375000
         ASSEMBLE(MTDS 2);  <<MOVE LOG RECORD>>                         15380000
         FREEP := TOS;  <<RESET FREE AREA POINTER>>                     15385000
         DEL;                                                           15390000
  << write back then number of records written if buffer.    >><<04594>>15395000
         ABSOLUTE(X) := ABSOLUTE(LOGREC0X+CB)+1;  <<LOG REC>>           15400000
                                                                        15405000
         <<RESET DB TO ORIG. VALUE>>                                    15410000
                                                                        15415000
         CASE DBMODE OF                                                 15420000
            BEGIN                                                       15425000
                                                                        15430000
            ;             <<TO STACK>>                                  15435000
                                                                        15440000
            BEGIN                      <<TO XTRA DATA SEGMENT>>         15445000
            ASSEMBLE(ZERO,XCH);                                         15450000
            EXCHANGEDB(*)                                               15455000
            END;                                                        15460000
                                                                        15465000
            BEGIN                      <<TO ABSOLUTE ADDRESS>>          15470000
            ASSEMBLE(ZERO,XCH);                                         15475000
            EXCHANGEDB(*);                                              15480000
            SETSYSDB;                                                   15485000
            SET(DB)                                                     15490000
            END                                                         15495000
                                                                        15500000
            END;  <<END CASE>>                                          15505000
                                                                        15510000
         IF BSIZE-FREEP > MINSIZE THEN  <<ROOM LEFT IN BUF?>>           15515000
            BEGIN                                                       15520000
            ABSOLUTE(FREEX) := FREEP-1;                                 15525000
            DISAPROC;                                          <<01711>>15530000
            RELSIR(BUFSIR,S);                                           15535000
            IF FULLF THEN                                      <<01711>>15540000
               BEGIN <<IF BUF STILL FULL AWAKE LOB PROC.>>     <<01711>>15545000
               IF ABSOLUTE(BUF0X+ORIG'BUF).STATE = FULL AND    <<06897>>15550000
                  ABSOLUTE(LOGINFO)                            <<01711>>15555000
               THEN AWAKE(ABSOLUTE(LOGPINX),%20,0);            <<01711>>15560000
               END;                                            <<01711>>15565000
            ENAPROC;                                           <<01711>>15570000
            GOTO RET                                                    15575000
            END;                                                        15580000
                                                                        15585000
L2:      DISABLE;                                                       15590000
         ABSOLUTE(BUF0X+CB).STATE := FULL;  <<FULL STATE>>     <<06897>>15595000
L5:      CB := (CB+1).(15:1);  <<SWITCH CURRENT BUFFER INDEX>> <<01711>>15600000
<<  set bit is FLAGX saying which buffer is current.         >><<04594>>15605000
         ABSOLUTE(FLAGX).(13:1) := CB;                                  15610000
         ABSOLUTE(FREEX) := 0;                                          15615000
         TOS := ABSOLUTE(BUF0X+CB);                                     15620000
         IF S0.STATE = CURRENT THEN SUDDENDEATH(%41);          <<06897>>15625000
                                                                        15630000
         IF TOS.STATE = FULL THEN  <<DELAY?>>                  <<06897>>15635000
            BEGIN  << buffers are full >>                      <<04594>>15640000
  << check to see if system logging is enabled/disabled.   >>  <<04594>>15645000
            IF NOT ABSOLUTE(LOGINFO) THEN  <<NO LOGGING?>>              15650000
               BEGIN   << Logging is disabled >>               <<04594>>15655000
               ENABLE;                                                  15660000
               RELSIR(BUFSIR,S);  <<Release buffer SIR>>       <<04594>>15665000
               GO RET                                                   15670000
               END;                                                     15675000
            CB := (CB+1).(15:1);                                        15680000
            ABSOLUTE(FLAGX).(13:1) := CB;                               15685000
            ENABLE;                                                     15690000
            <<IF LOG PROCESS IS THE CALLER THEN IGORE LOG RECORD>>      15695000
            IF LOGPF THEN  <<LOG PROCESS IS CALLER?>>                   15700000
               BEGIN                                                    15705000
               RELSIR(BUFSIR,S);                                        15710000
               GO RET                                                   15715000
               END;                                                     15720000
            DELAY(1000D);                                               15725000
            DISABLE;                                           <<01711>>15730000
            GOTO L5                                            <<01711>>15735000
            END;                                                        15740000
                                                                        15745000
         ABSOLUTE(X).STATE := CURRENT;  <<CURRENT STATE>>      <<06897>>15750000
         ENABLE;                                                        15755000
         IF FULLF THEN GOTO L1;                                         15760000
         DISAPROC;                                             <<01711>>15765000
         RELSIR(BUFSIR,S);                                              15770000
         << IF THE ORIGNAL BUFFER IS STILL FULL THEN >>        <<01711>>15775000
         << AWAKE LOG PROCESS TO FLUSH BUFFER        >>        <<01711>>15780000
         IF ABSOLUTE(BUF0X+ORIG'BUF).STATE = FULL AND          <<06897>>15785000
            ABSOLUTE(LOGINFO)                                  <<01711>>15790000
         THEN AWAKE(ABSOLUTE(LOGPINX),%20,0);                  <<01711>>15795000
         ENAPROC;                                              <<01711>>15800000
         GOTO RET                                                       15805000
         END;                                                           15810000
                                                                        15815000
      IF FULLF THEN SUDDENDEATH(35);  <<SYSTEM ERROR>>         <<01711>>15820000
      FULLF := TRUE;                                           <<01711>>15825000
      GOTO L2;                                                 <<01711>>15830000
      HELP;   << FOR LINKING OF BREAKPOINTS >>                 <<01711>>15835000
                                                               <<01711>>15840000
                                                               <<01711>>15845000
END;  << L O G >>                                              <<01711>>15850000
<< ******************************************************** >> <<07232>>15855000
<< ******************************************************** >> <<07232>>15860000
<< *******                                          ******* >> <<07232>>15865000
<< *******          The procedure JOBINFO           ******* >> <<07232>>15870000
<< *******                                          ******* >> <<07232>>15875000
<< ******************************************************** >> <<07232>>15880000
<< ******************************************************** >> <<07232>>15885000
                                                               <<07232>>15890000
PROCEDURE JOBINFO(JSIND,JSNNN,STATUS,ITEMNUM1,ITEM1,ERROR1,    <<07232>>15895000
                                     ITEMNUM2,ITEM2,ERROR2,    <<07232>>15900000
                                     ITEMNUM3,ITEM3,ERROR3,    <<07232>>15905000
                                     ITEMNUM4,ITEM4,ERROR4,    <<07232>>15910000
                                     ITEMNUM5,ITEM5,ERROR5);   <<07232>>15915000
                                                               <<07232>>15920000
VALUE JSIND,ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4,ITEMNUM5;      <<07232>>15925000
INTEGER JSIND,ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4,             <<07232>>15930000
        ITEMNUM5,ERROR1,ERROR2,ERROR3,ERROR4,ERROR5;           <<07232>>15935000
DOUBLE JSNNN;                                                  <<07232>>15940000
LOGICAL ARRAY STATUS;                                          <<07232>>15945000
LOGICAL ARRAY ITEM1,ITEM2,ITEM3,ITEM4,ITEM5;                   <<07232>>15950000
OPTION VARIABLE,PRIVILEGED;                                    <<07232>>15955000
                                                               <<07232>>15960000
COMMENT:  There will be many, many, many comments              <<07232>>15965000
          in the space of these many, many, many lines;        <<07232>>15970000
COMMENT:  Welcome to JOBINFO!  The intrinsic that nobody wanted<<07232>>15975000
          written, but screamed that it wasn't when they needed<<07232>>15980000
          it...                                               ;<<07232>>15985000
COMMENT:                                                       <<07232>>15990000
          With every call to JOBINFO, you, the caller, recieve:<<07232>>15995000
          1.  Parameter checking in the main body.             <<07232>>16000000
          2.  A call to subroutine RETRIEVE'ITEM for every item<<07232>>16005000
              number in the parameter list.                    <<07232>>16010000
          3.  With the first call to RETRIEVE'ITEM, you get:   <<07232>>16015000
              a.  The job/session number of the job/session in <<07232>>16020000
                  question for the call.                       <<07232>>16025000
                  OR                                           <<07232>>16030000
                  The right to parse for the job/session number<<07232>>16035000
                  if you optioned to give the [JNAME,]USER.ACCT<<07232>>16040000
                  instead of the job/number, and then parse it <<07232>>16045000
                  using PARSE'NAMES.                           <<07232>>16050000
              b.  A validity check on the jobnumber, or if a   <<07232>>16055000
                  parse was done, the retrieval of the job/ses <<07232>>16060000
                  number if it is there - all done by FJOBNUM. <<07232>>16065000
                  FJOBNUM also returns the JMAT entry if the   <<07232>>16070000
                  job number is correct.                       <<07232>>16075000
              c.  Also, you get the stack in question AND its  <<07232>>16080000
                  JIT added to the Locality List-GET'USERS'DST.<<07232>>16085000
              d.  Plus the HOMEGROUP and User Local Attributes <<07232>>16090000
                  of the session/job in question are retrieved,<<07232>>16095000
                  even if you don't ask for them! It is easier <<07232>>16100000
                  this way-See JITINFO2.                       <<07232>>16105000
              e.  Lastly on the first call to RETRIEVE'ITEM,   <<07232>>16110000
                  the caller's capabilities are checked.       <<07232>>16115000
          4.  Now sit back and let RETRIEVE'ITEM and its Case  <<07232>>16120000
              statement get you the information as you request <<07232>>16125000
              by the item numbers in the parameter list.       <<07232>>16130000
                                                               <<07232>>16135000
                                                  ;            <<07232>>16140000
BEGIN                                                          <<07232>>16145000
                                                               <<07232>>16150000
<< Start of JOBINFO...>>                                       <<07232>>16155000
<< EQUATES for JSIND possibilities >>                          <<07232>>16160000
EQUATE                                                         <<07232>>16165000
   JOB'IND        = 2,   << JSNNN is a job >>                  <<07232>>16170000
   SES'IND        = 1,   << JSNNN is a session >>              <<07232>>16175000
   DUM'IND        = 0;   << JSNNN is a dummy number >>         <<07232>>16180000
<< Status EQUATES >>                                           <<07232>>16185000
EQUATE                                                         <<07232>>16190000
   STATUS'S            = 1,                                    <<07232>>16195000
   SUCCESS'CALL        = 0,  << Successful call >>             <<07232>>16200000
   SEMI'SUCCESS'CALL   = 1,  << Semi-success;1/more errornum>0 <<07232>>16205000
   UNSUCCESS'ERRORS    = 2,  << All ERRORNUM > 0 >>            <<07232>>16210000
   UNSUCCESS'SYNTAX    = 3,  << syntax error >>                <<07232>>16215000
   UNSUCCESS'CALL'N    = 4,  << non-existient JSNNN >>         <<07232>>16220000
   PROCESS'DIED        = 5,  << Died after get JOBNUM >>       <<07232>>16225000
   MAJOR'PROBLEM       = 6;  << Averted a system failure >>    <<07232>>16230000
<< error EQUATES >>                                            <<07232>>16235000
EQUATE                                                         <<07232>>16240000
   STATUS'E            = 2,                                    <<07232>>16245000
   SUCCESS'RETIV       = 0,  << All info found/returned >>     <<07232>>16250000
   INVALID'ITEM'NUM    = 1,  << Illegal item number >>         <<07232>>16255000
     << Info for ITEMNUM not found >>                          <<07232>>16260000
   INFO'NOT'PERT       = 2,  << Wished info of ITEMNUM not pert<<07232>>16265000
   INSUFF'CAP          = 3,  << User has insufficient caps >>  <<07232>>16270000
   INFO'GONE           = 4;  << Info gone to abort of JSnnn>>  <<07232>>16275000
<< Configurable/expandable EQUATE's for parameters >>          <<07232>>16280000
EQUATE                                                         <<07232>>16285000
   INTRISIC'NUM        = 180, << Intrinsic number >>           <<07232>>16290000
   NUM'PARMS           = 15,  << Number of parameters >>       <<07232>>16295000
   NUM'PARMS'AND'MASK  = 16,  << Parm mask >>                  <<07232>>16300000
   MAX'ITEMS           = 36,  << Items 1-36 available >>       << 7591>>16305000
   SPEC'ITEMS          =  4,  << 4 Items are ARRAY data >>     <<07232>>16310000
   MAX'ITEMS'REQ       = 5;   << Access up to 5 items >>       <<07232>>16315000
                                                               <<07232>>16320000
EQUATE UBND = -23;<< (Stack marker+18 parms+2 parm-masks) -1 >><<07232>>16325000
                                                               <<07232>>16330000
                                                               <<07232>>16335000
<< These are the run time error numbers >>                     <<07232>>16340000
EQUATE                                                         <<07232>>16345000
   ILLEGAL'DB = 1,                                             <<07232>>16350000
   OMITTED'REQ'PARM = 3,                                       <<07232>>16355000
   BV = 5;                                                     <<07232>>16360000
                                                               <<07232>>16365000
<<                                                    >>       <<07232>>16370000
<< JOBINFOHANG, JOBINFOHANG2, EXIT'ERROR AND PARMPTR  >>       <<07232>>16375000
<< in the the calles to ERROREXIT                     >>       <<07232>>16380000
<<                                                    >>       <<07232>>16385000
LOGICAL                                                        <<07232>>16390000
JOBINFOHANG:=[10/180,6/20], << For CHEK call >>                << 8424>>16395000
JOBINFOHANG2:=[10/180,6/4]; << For the 2nd CHEK call >>        <<07232>>16400000
INTEGER EXIT'ERROR:=0, << Run-time error number in ERROREXIT >><<07232>>16405000
        GERROR:=0,                                             <<07232>>16410000
        EXIT'PARM :=0; << Parameter in error in ERROREXIT    >><<07232>>16415000
                                                               <<07232>>16420000
LOGICAL ARRAY QARRAY(*) = Q+0;                                 <<07232>>16425000
LOGICAL PCBGLOBLOC;                                            <<07232>>16430000
LOGICAL                                                        <<07232>>16435000
   CJS'GOTTEN:=FALSE,                                          <<07232>>16440000
   SUCCESS:=TRUE,                                              <<07232>>16445000
   PARSE'IT:=FALSE,                                            <<07232>>16450000
   GOTININFO:=FALSE,                                           <<07232>>16455000
   GOTOUTINFO:=FALSE,                                          <<07232>>16460000
   FIRST'TRIPLE'SUPPLIED := FALSE,                             << 8756>>16465000
   PCBPT,                                                      <<07232>>16470000
   USE'CURRENT'JOB:=FALSE,                                     <<07232>>16475000
   TOTALOFFSET,                                                <<07232>>16480000
   JMAT'C,   << For JMAT class flag >>                         <<07232>>16485000
   WORD,SAVECRITICAL,                                          <<07232>>16490000
   OK,JIN,JOBNAME:=FALSE,EXEC,                                 <<07232>>16495000
   PARM'MASKQ4 = Q-4,                                          <<07232>>16500000
   PARM'MASKQ5 = Q-5;                                          <<07232>>16505000
LOGICAL POINTER PXPNTR;                                        <<07232>>16510000
EQUATE QI=5;                                                   <<07232>>16515000
DEFINE DISABLE = ASSEMBLE(SED 0)#,                             <<07232>>16520000
       ENABLE  = ASSEMBLE(SED 1)#;                             <<07232>>16525000
DEFINE CHECKUDB =                                              <<07232>>16530000
                 DISABLE;                                      <<07232>>16535000
                 PUSH(DB);                                     <<07232>>16540000
                 X:=ABSOLUTE(QI)-5;                            <<07232>>16545000
                 TOS:=ABSOLUTE(X);                             <<07232>>16550000
                 X:=X+1;                                       <<07232>>16555000
                 TOS:=ABSOLUTE(X);                             <<07232>>16560000
                 ENABLE;                                       <<07232>>16565000
                 ASSEMBLE(DCMP)#;                              <<07232>>16570000
                                                               <<07232>>16575000
INTEGER                                                        <<07232>>16580000
   IT,                                                         <<07232>>16585000
   NUMBER'ITEMS,                                               << 8962>>16590000
   J,                                                          <<07232>>16595000
   JITDSTN,                                                    <<07232>>16600000
   SIZE,                                                       <<07232>>16605000
   SAVEPCBSIR,                                                 <<07232>>16610000
   PIN'DSTN,                                                   <<07232>>16615000
   ITEM'INDEX,                                                 <<07232>>16620000
   C,                                                          <<07232>>16625000
   JMAT'SIR,                                                   <<07232>>16630000
   L,                                                          <<07232>>16635000
   ENTRYP,                                                     <<07232>>16640000
   COMMAND'LEN,                                                <<07232>>16645000
   LOOKIT,                                                     <<07232>>16650000
   JLIST,                                                      <<07232>>16655000
   LDEVO,LDEVLEN, << IN GETLDEV >>                             <<07232>>16660000
   OUTDEV,                                                     <<07232>>16665000
   INDEV,                                                      <<07232>>16670000
   LPDT'INDEX,                                                 <<07232>>16675000
   JMATINX,                                                    <<07232>>16680000
   PIN,                                                        <<07232>>16685000
   SPLEN,PLEN,MISTAKE;                                         <<07232>>16690000
DEFINE                                                         <<07232>>16695000
     PDISABLE = ASSEMBLE( PSDB )#,                             <<07232>>16700000
     PENABLE  = ASSEMBLE( PSEB )#,                             <<07232>>16705000
     REQ'PARMS'FIELD = (13:3)#,                                <<07232>>16710000
     JMATSIZE=2*JMATENTRYSIZE#,                                <<07232>>16715000
     SMCAPS=0).(0:1#,                                          <<07232>>16720000
     AMCAPS=0).(1:1#,                                          <<07232>>16725000
     SPJN=(1:15)#,                                             <<07232>>16730000
     JN=(2:14)#;                                               <<07232>>16735000
LOGICAL ARRAY LAST'COMIMAGE(0:139);                            <<07232>>16740000
BYTE ARRAY BLAST'COMIMAGE(*)=LAST'COMIMAGE;                    <<07232>>16745000
BYTE ARRAY BITEM1(*)=ITEM1,                                    <<07232>>16750000
           BITEM2(*)=ITEM2,                                    <<07232>>16755000
           BITEM3(*)=ITEM3,                                    <<07232>>16760000
           BITEM4(*)=ITEM4,                                    <<07232>>16765000
           BITEM5(*)=ITEM5;                                    <<07232>>16770000
DOUBLE ARRAY DITEM1(*)=ITEM1,                                  <<07232>>16775000
             DITEM2(*)=ITEM2,                                  <<07232>>16780000
             DITEM3(*)=ITEM3,                                  <<07232>>16785000
             DITEM4(*)=ITEM4,                                  <<07232>>16790000
             DITEM5(*)=ITEM5;                                  <<07232>>16795000
BYTE ARRAY DELIMS(0:3),TEMPARRAY(0:27);                        <<07232>>16800000
LOGICAL ARRAY LTEMPACCT(0:ACCTNAME'L-1),                       <<07232>>16805000
              LTEMPUSER(0:USERNAME'L-1);                       <<07232>>16810000
BYTE ARRAY TEMPACCT(*)=LTEMPACCT,                              <<07232>>16815000
           TEMPUSER(*)=LTEMPUSER;                              <<07232>>16820000
LOGICAL ARRAY ISPFSTUFF( 0:2 ),                                << 8961>>16825000
              OSPFSTUFF( 0:2 );                                << 8961>>16830000
LOGICAL ARRAY JMATARR(0:JMATSIZE-1);                           <<07232>>16835000
INTEGER ARRAY TEMP'JMATARR(0:JMATSIZE-1);                      <<07232>>16840000
LOGICAL ARRAY ACCTL(0:ACCTNAME'L-1),                           <<07232>>16845000
              JOBNL(0:JOBNAME'L-1),                            <<07232>>16850000
              HOMEGROUP(0:GRPNAME'L-1),                        <<07232>>16855000
              LOGONGROUP(0:GRPNAME'L-1),                       <<07232>>16860000
              USERL(0:USERNAME'L-1);                           <<07232>>16865000
BYTE ARRAY ACCTB(*)=ACCTL,                                     <<07232>>16870000
           JOBNB(*)=JOBNL,                                     <<07232>>16875000
           BHOMEGROUP(*)=HOMEGROUP,                            <<07232>>16880000
           BLOGONGROUP(*)=LOGONGROUP,                          <<07232>>16885000
           USERB(*)=USERL;                                     <<07232>>16890000
LOGICAL ARRAY DTIMEA(0:1);                                     <<07232>>16895000
DOUBLE JOBNUMBER;                                              <<07232>>16900000
DOUBLE DTIME;                                                  <<07232>>16905000
LOGICAL INTRO0=DTIME;                                          <<07232>>16910000
LOGICAL INTRO1=DTIME+1;                                        <<07232>>16915000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<07232>>16920000
LOGICAL ARRAY UCAPPTR (0:1);                                   <<07232>>16925000
BYTE POINTER                                                   <<07232>>16930000
     PARM,                                                     <<07232>>16935000
     PTR,                                                      <<07232>>16940000
     SPARM,                                                    <<07232>>16945000
     SAVEPTR;                                                  <<07232>>16950000
                                                               <<07232>>16955000
LOGICAL ARRAY STDIN(0:3),STDLIST(0:3);                         <<07232>>16960000
BYTE ARRAY BSTDIN(*)=STDIN;                                    <<07232>>16965000
BYTE ARRAY BSTDLIST(*)=STDLIST;                                <<07232>>16970000
<< variables for WHO intrisic >>                               <<07232>>16975000
LOGICAL WMODE,WTERM;                                           <<07232>>16980000
DEFINE USER'MODE = INTEGER(WMODE.(12:2))#;                     <<07232>>16985000
DOUBLE  WCAPS,USERLOCATTR;                                     <<07232>>16990000
BYTE ARRAY WUSER(0:7),                                         <<07232>>16995000
           WGROUP(0:7),                                        <<07232>>17000000
           WACCT(0:7),                                         <<07232>>17005000
           WHOME(0:7);                                         <<07232>>17010000
LOGICAL ARRAY DWCAPS(*)=WCAPS;                                 <<07232>>17015000
                                                               <<07232>>17020000
BYTE ARRAY NBUFFB(0:25);                                       <<07232>>17025000
BYTE ARRAY BUFFB(0:25);                                        <<07232>>17030000
LOGICAL ARRAY NBUFF(*) = NBUFFB;                               <<07232>>17035000
                                                               <<07232>>17040000
<< *********************************************************** <<07232>>17045000
<< *******                                             ******* <<07232>>17050000
<< *******         SUBROUTINE DEFINITIONS              ******* <<07232>>17055000
<< *******                                             ******* <<07232>>17060000
<< *********************************************************** <<07232>>17065000
                                                               <<07232>>17070000
<< ******************************************************** >> <<07232>>17075000
<< *******       Subroutine RUN'TIME'ERR            ******* >> <<07232>>17080000
<< ******************************************************** >> <<07232>>17085000
                                                               <<07232>>17090000
SUBROUTINE RUN'TIME'ERR(ERR);                                  <<07232>>17095000
VALUE ERR;                                                     <<07232>>17100000
INTEGER ERR;                                                   <<07232>>17105000
COMMENT:  Called for handling the following run time errors:   <<07232>>17110000
          1.  Illegal DB - DB not at own stack                 <<07232>>17115000
          2.  Parameter bounds violation                       <<07232>>17120000
          3.  A required parameter is missing                  <<07232>>17125000
          Will set the correct parameters for ERROR exit in    <<07232>>17130000
          main body and will GOTO ABORT                        <<07232>>17135000
          these error numbers correspond to the run time error <<07232>>17140000
          numbers found in the back of the MPE intrinsics      <<07232>>17145000
          manual.                                              <<07232>>17150000
                                                             ; <<07232>>17155000
BEGIN                                                          <<07232>>17160000
CASE ERR OF                                                    <<07232>>17165000
     BEGIN                                                     <<07232>>17170000
     ;                                                         <<07232>>17175000
     EXIT'ERROR:=1; << Illegal DB >>                           <<07232>>17180000
     ;                                                         <<07232>>17185000
     EXIT'ERROR:=3; << Omitted required parameter >>           <<07232>>17190000
     ;                                                         <<07232>>17195000
     EXIT'ERROR:=5; << Bounds violation on parameter >>        <<07232>>17200000
     END;                                                      <<07232>>17205000
GOTO ABORT;                                                    <<07232>>17210000
END;                                                           <<07232>>17215000
                                                               <<07232>>17220000
                                                               <<07232>>17225000
<< ******************************************************** >> <<07232>>17230000
<< *******         Subroutine JI'ERROR              ******* >> <<07232>>17235000
<< ******************************************************** >> <<07232>>17240000
                                                               <<07232>>17245000
SUBROUTINE JI'ERROR(SORE,ENUM,WHERE);                          <<07232>>17250000
VALUE SORE,ENUM,WHERE;                                         <<07232>>17255000
INTEGER SORE,ENUM,WHERE;                                       <<07232>>17260000
COMMENT: Called when JOBINFO will be terminated by a serious   <<07232>>17265000
         error such as a syntax error, assigns error numbers to<<07232>>17270000
         the ERROR numbers or to STATUS;                       <<07232>>17275000
BEGIN                                                          <<07232>>17280000
IF SORE = STATUS'S                                             <<07232>>17285000
   THEN BEGIN                                                  <<07232>>17290000
        STATUS(0):=ENUM;                                       <<07232>>17295000
        STATUS(1):=-1; << Pretend its a...SUBSYSTEM error >>   <<07232>>17300000
        GOTO ABORT;  << Label at bottom of JOBINFO main >>     <<07232>>17305000
   END                                                         <<07232>>17310000
   ELSE                                                        <<07232>>17315000
   BEGIN                                                       <<07232>>17320000
   CASE ITEM'INDEX OF                                          <<07232>>17325000
      BEGIN                                                    <<07232>>17330000
      ;                                                        <<07232>>17335000
      ERROR1:=ENUM;                                            <<07232>>17340000
      ERROR2:=ENUM;                                            <<07232>>17345000
      ERROR3:=ENUM;                                            <<07232>>17350000
      ERROR4:=ENUM;                                            <<07232>>17355000
      ERROR5:=ENUM                                             <<07232>>17360000
      END; << CASE >>                                          <<07232>>17365000
   STATUS:=SEMI'SUCCESS'CALL;                                  <<07232>>17370000
   END; << ELSE >>                                             <<07232>>17375000
END; << Subroutine JI'ERROR >>                                 <<07232>>17380000
<< ******************************************************** >> <<07232>>17385000
<< *******      Subroutine GETCHECKNAME             ******* >> <<07232>>17390000
<< ******************************************************** >> <<07232>>17395000
                                                               <<07232>>17400000
LOGICAL SUBROUTINE GETCHECKNAME(NAME,REQUIRED,PRECHAR,         <<07232>>17405000
                                POSTCHAR,ERRNO);               <<07232>>17410000
  VALUE REQUIRED, PRECHAR, POSTCHAR, ERRNO;                    <<07232>>17415000
  BYTE ARRAY NAME;                                             <<07232>>17420000
  BYTE PRECHAR,POSTCHAR;                                       <<07232>>17425000
  LOGICAL REQUIRED;                                            <<07232>>17430000
  INTEGER ERRNO;                                               <<07232>>17435000
COMMENT RETURNS TRUE IF OPTIONAL PARM IS FOUND;                <<07232>>17440000
                                                               <<07232>>17445000
BEGIN                                                          <<07232>>17450000
IF REQUIRED THEN                                               <<07232>>17455000
   BEGIN                                                       <<07232>>17460000
   IF PRECHAR <> 0 AND PRECHAR <> PTR THEN JI'ERROR(STATUS'S,3,<<07232>>17465000
                                                           46);<<07232>>17470000
   PLEN:=NEXTPARMD(DELIMS,PTR,PARM,PTR);                       <<07232>>17475000
   IF POSTCHAR <> 0 AND POSTCHAR <> PTR THEN JI'ERROR(STATUS'S,<<07232>>17480000
                                                        3,47); <<07232>>17485000
   IF PARM <> ALPHA THEN JI'ERROR(STATUS'S,UNSUCCESS'SYNTAX,3);<<07232>>17490000
   IF PLEN > 8 THEN JI'ERROR(STATUS'S,UNSUCCESS'SYNTAX,4);     <<07232>>17495000
   MOVE NAME:=PARM,(PLEN);                                     <<07232>>17500000
   END << BEGIN >>                                             <<07232>>17505000
   ELSE                                                        <<07232>>17510000
   BEGIN                                                       <<07232>>17515000
   << NOT REQUIRED, DON'T FETCH PARM IF MISSING >>             <<07232>>17520000
   IF PRECHAR = 0 OR PRECHAR = PTR                             <<07232>>17525000
      THEN BEGIN                                               <<07232>>17530000
           SPLEN:=PLEN;                                        <<07232>>17535000
           @SAVEPTR:=@PTR;                                     <<07232>>17540000
           @SPARM:=@PARM;                                      <<07232>>17545000
           << SAVE OLD STATE >>                                <<07232>>17550000
           PLEN:=NEXTPARMD(DELIMS,PTR,PARM,PTR);               <<07232>>17555000
           IF > THEN                                           <<07232>>17560000
                BEGIN                                          <<07232>>17565000
                IF POSTCHAR = 0 OR POSTCHAR = PTR              <<07232>>17570000
                   THEN BEGIN                                  <<07232>>17575000
                        GETCHECKNAME:=TRUE; << HAVE IT >>      <<07232>>17580000
                        IF PARM <>ALPHA THEN JI'ERROR(STATUS'S,<<07232>>17585000
                           3,5);                               <<07232>>17590000
                        IF PLEN >8 THEN JI'ERROR(STATUS'S,3,6);<<07232>>17595000
                        MOVE NAME:=PARM,(PLEN);                <<07232>>17600000
                        END                                    <<07232>>17605000
                        ELSE                                   <<07232>>17610000
                        BEGIN << DON'T HAVE IT >>              <<07232>>17615000
                        PLEN:=SPLEN;                           <<07232>>17620000
                        @PTR:=@SAVEPTR;                        <<07232>>17625000
                        @PARM:=@SPARM;                         <<07232>>17630000
                        END;                                   <<07232>>17635000
                END << BEGIN OF IF >  >>                       <<07232>>17640000
                ELSE                                           <<07232>>17645000
                BEGIN                                          <<07232>>17650000
                PLEN:=SPLEN;                                   <<07232>>17655000
                @PTR:=@SAVEPTR;                                <<07232>>17660000
                @PARM:=@SPARM;                                 <<07232>>17665000
                END;                                           <<07232>>17670000
            END;                                               <<07232>>17675000
       END;                                                    <<07232>>17680000
END; << SUBROUTINE GETCHECKNAME >>                             <<07232>>17685000
                                                               <<07232>>17690000
<< ******************************************************** >> <<07232>>17695000
<< ********        Subroutine PARSE'NAMES           ******* >> <<07232>>17700000
<< ******************************************************** >> <<07232>>17705000
                                                               <<07232>>17710000
SUBROUTINE PARSE'NAMES(ITEM,ERROR);                            <<07232>>17715000
BYTE ARRAY ITEM;                                               <<07232>>17720000
INTEGER ERROR;                                                 <<07232>>17725000
BEGIN                                                          <<07232>>17730000
   @PTR:=@ITEM;                                                <<07232>>17735000
   @PARM:=@ITEM;                                               <<07232>>17740000
   MOVE JOBNB(0):="        ";                                  <<07232>>17745000
   MOVE USERB(0):="        ";                                  <<07232>>17750000
   MOVE ACCTB(0):="        ";                                  <<07232>>17755000
   JOBNAME:=GETCHECKNAME(JOBNB,FALSE,0,",",MISTAKE);           <<07232>>17760000
   GETCHECKNAME(USERB,TRUE,0,0,MISTAKE);                       <<07232>>17765000
   GETCHECKNAME(ACCTB,TRUE,0,0,MISTAKE);                       <<07232>>17770000
   << Let's upshift the little bastards >>                     <<07232>>17775000
   MOVE ACCTB := ACCTB WHILE ANS;                              <<07232>>17780000
   MOVE USERB := USERB WHILE ANS;                              <<07232>>17785000
   MOVE JOBNB := JOBNB WHILE ANS;                              <<07232>>17790000
END;                                                           <<07232>>17795000
                                                               <<07232>>17800000
<< ******************************************************** >> <<07232>>17805000
<< *******           Subroutine JITINFO             ******* >> <<07232>>17810000
<< ******************************************************** >> <<07232>>17815000
INTEGER SUBROUTINE JITINFO(JOBNUMBER);                         <<07232>>17820000
DOUBLE JOBNUMBER;                                              <<07232>>17825000
COMMENT  This routine returns the current job number;          <<07232>>17830000
BEGIN                                                          <<07232>>17835000
PXGLOBAL; << Obtain the JIT DST from the stack >>              <<07232>>17840000
<< Get the JOBNUMBER >>                                        <<07232>>17845000
JITDSTN:=PXG'JITDST;                                           <<07232>>17850000
TOS:=@JITARR;                                                  <<07232>>17855000
TOS:=JITDSTN;                                                  <<07232>>17860000
TOS:=0;                                                        <<07232>>17865000
TOS:=JIT'ENTRY'SIZE;                                           <<07232>>17870000
ASSEMBLE(MFDS 4);                                              <<07232>>17875000
JOBNUMBER:=DOUBLE(JITJOBNUMBER);                               <<07232>>17880000
END;   << SUBROUTINE JITINFO >>                                <<07232>>17885000
                                                               <<07232>>17890000
<< ***************************************************** >>    <<07232>>17895000
<< *******    Subroutine JITINFO2                ******* >>    <<07232>>17900000
<< ***************************************************** >>    <<07232>>17905000
SUBROUTINE JITINFO2;                                           <<07232>>17910000
COMMENT: Get the JIT for that job/session;                     <<07232>>17915000
BEGIN                                                          <<07232>>17920000
TOS:=@JITARR;                                                  <<07232>>17925000
TOS:=JITDSTN;                                                  <<07232>>17930000
TOS:=0;                                                        <<07232>>17935000
TOS:=JIT'ENTRY'SIZE;                                           <<07232>>17940000
ASSEMBLE( MFDS 4 );                                            <<07232>>17945000
END; << JITINFO 2>>                                            <<07232>>17950000
                                                               <<07232>>17955000
                                                               <<07232>>17960000
<< ******************************************************** >> <<07232>>17965000
<< *******        Subroutine DETERMINE              ******* >> <<07232>>17970000
<< ******************************************************** >> <<07232>>17975000
SUBROUTINE DETERMINE(ITEMNUM);                                 <<07232>>17980000
VALUE ITEMNUM;                                                 <<07232>>17985000
INTEGER ITEMNUM;                                               <<07232>>17990000
COMMENT:  This is where we determine where the JSNNN is going  <<07232>>17995000
          to come from.  It can come from the JIT, the JMAT or <<07232>>18000000
          the user can specify it.                             <<07232>>18005000
          PARSE'IT set to TRUE is [JOBNB,]USERN.ACCTB must be  <<07232>>18010000
          parsed to obtain a jobnumber.                        <<07232>>18015000
          If JSNNN <> 0 this will take preference over all;    <<07232>>18020000
BEGIN                                                          <<07232>>18025000
PARSE'IT:=FALSE;                                               <<07232>>18030000
JITINFO( JOBNUMBER );  << Get job number from the stack >>     << 8824>>18035000
<< Check for invalid defaults >>                               << 8756>>18040000
<<   - called from session, expecting a job number default >>  << 8756>>18045000
IF ( ( USER'MODE = SES'IND ) LAND                              << 8756>>18050000
     ( JSIND    = JOB'IND ) LAND                               << 8756>>18055000
     ( JSNNN    = 0D      ))                                   << 8756>>18060000
   THEN IF FIRST'TRIPLE'SUPPLIED AND ITEMNUM = 1               << 8756>>18065000
           THEN PARSE'IT := TRUE                               << 8756>>18070000
           ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 60 );    << 8756>>18075000
                                                               << 8961>>18080000
IF (( USER'MODE = SES'IND ) LAND                               << 8961>>18085000
    ( JSIND     = SES'IND ) LAND                               << 8961>>18090000
    ( JSNNN     = 0D      ))                                   << 8961>>18095000
   THEN IF FIRST'TRIPLE'SUPPLIED AND ITEMNUM = 1               << 8961>>18100000
           THEN PARSE'IT := TRUE;                              << 8961>>18105000
                                                               << 8961>>18110000
IF (( USER'MODE = JOB'IND ) LAND                               << 8961>>18115000
    ( JSIND     = JOB'IND ) LAND                               << 8961>>18120000
    ( JSNNN     = 0D      ))                                   << 8961>>18125000
   THEN IF FIRST'TRIPLE'SUPPLIED AND ITEMNUM = 1               << 8961>>18130000
           THEN PARSE'IT := TRUE;                              << 8961>>18135000
                                                               << 8756>>18140000
<<   - called from job, expecting a session number default >>  << 8756>>18145000
IF ( ( USER'MODE = JOB'IND ) LAND                              << 8756>>18150000
     ( JSIND    = SES'IND ) LAND                               << 8756>>18155000
     ( JSNNN    = 0D      ))                                   << 8756>>18160000
   THEN IF FIRST'TRIPLE'SUPPLIED AND ITEMNUM = 1               << 8756>>18165000
           THEN PARSE'IT := TRUE                               << 8756>>18170000
           ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 61 );    << 8756>>18175000
                                                               << 8756>>18180000
<< JI'ERROR will abort the intrinsic; if no parsing, get   >>  << 8756>>18185000
<< job number                                              >>  << 8756>>18190000
IF PARSE'IT = FALSE                                            << 8756>>18195000
   THEN IF JSNNN = 0D OR JSNNN = JOBNUMBER                     << 8824>>18200000
           THEN USE'CURRENT'JOB := TRUE                        << 8824>>18205000
           ELSE JOBNUMBER := JSNNN;                            << 8824>>18210000
END;   << DETERMINE >>                                         << 8756>>18215000
                                                               <<07232>>18220000
                                                               <<07232>>18225000
<< ****************************************************** >>   <<07232>>18230000
<< *******      Subroutine RETRIV'SPEC'ITEM       ******* >>   <<07232>>18235000
<< ****************************************************** >>   <<07232>>18240000
SUBROUTINE RETRIV'SPEC'ITEM(ITEMNUM,ITEM,ERROR);               <<07232>>18245000
COMMENT:  Called to retrive data for the arrays;               <<07232>>18250000
VALUE ITEMNUM;                                                 <<07232>>18255000
INTEGER ITEMNUM,ERROR;                                         <<07232>>18260000
BYTE ARRAY ITEM;                                               <<07232>>18265000
BEGIN                                                          <<07232>>18270000
END;                                                           <<07232>>18275000
                                                               <<07232>>18280000
<< ****************************************************** >>   <<07232>>18285000
<< *******           Subroutine GETLDEV           ******* >>   <<07232>>18290000
<< ****************************************************** >>   <<07232>>18295000
SUBROUTINE GETLDEV(ITEM,WANT'IN);                              <<07232>>18300000
COMMENT:  This subroutine calls DEVSPEC to get the ldev#/ldev  <<07232>>18305000
          class.  If JMATCBIT then DEV is a class, otherwize a <<07232>>18310000
          number                                               <<07232>>18315000
          If WANT'IN, then the JMATJINDEV is returned, else    <<07232>>18320000
          JMATJLISTDEV is returned as a number or class        <<07232>>18325000
                                                            ;  <<07232>>18330000
VALUE WANT'IN;                                                 <<07232>>18335000
LOGICAL WANT'IN;                                               <<07232>>18340000
BYTE ARRAY ITEM;                                               <<07232>>18345000
BEGIN                                                          <<07232>>18350000
MOVE TEMP'JMATARR(0):=JMATARR,(JMATSIZE); << Save original >>  <<07232>>18355000
IF ((JMATJOBSTATE=JOBEXEC) LOR (JMATJOBSTATE=JOBSUSP))         <<07232>>18360000
                                                               <<07232>>18365000
   THEN BEGIN                                                  <<07232>>18370000
        JMATJINDEV:=JMATORIGJIN;                               <<07232>>18375000
        LPDT'INDEX:=INTEGER(LPDT'ENTRY'SIZE) *                 <<07232>>18380000
                    INTEGER(JMATJLISTDEV);                     <<07232>>18385000
                                                               <<07232>>18390000
        IF LPDT'VIRTUAL'DEVICE = 1                             <<07232>>18395000
           THEN << VIRTUAL >>                                  <<07232>>18400000
           JMATJLISTDEV:=JMATORIGJLIST                         <<07232>>18405000
           ELSE JMATCBIT:=FALSE;                               <<07232>>18410000
                                                               <<07232>>18415000
           IF WANT'IN THEN ASCII(JMATJINDEV,10,ITEM(0))        <<07232>>18420000
           ELSE                                                <<07232>>18425000
           BEGIN                                               <<07232>>18430000
           LDEVO:=JMATJLISTDEV;                                <<07232>>18435000
           IF JMATCBIT = 1 THEN LDEVO:=-LDEVO;<< Dev. Class >> <<07232>>18440000
           LDEVLEN:=DEVSPEC(LDEVO,ITEM);                       <<07232>>18445000
           END;                                                <<07232>>18450000
       END                                                     <<07232>>18455000
       ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,51);               <<07232>>18460000
MOVE JMATARR(0):=TEMP'JMATARR,(JMATSIZE);<< Back to original>><<<07232>>18465000
END; << SUBROUTINE GETLDEV >>                                  <<07232>>18470000
                                                               <<07232>>18475000
                                                               <<07232>>18480000
<< ******************************************************* >>  <<07232>>18485000
<< *******       Subroutine    GET'USERS'DST       ******* >>  <<07232>>18490000
<< ******************************************************* >>  <<07232>>18495000
SUBROUTINE GET'USERS'DST;                                      <<07232>>18500000
BEGIN                                                          <<07232>>18505000
<< Subroutine returns the JIT DST number for the job       >>  <<07232>>18510000
<< or session in question,  if the PIN for that job or     >>  <<07232>>18515000
<< session is not ALIVE, then PIN'DSTN is set to 0         >>  <<07232>>18520000
PIN:=JMATMAINPIN;                                              <<07232>>18525000
PCBPT:=PCBSIZE*PIN;                                            <<07232>>18530000
PIN'DSTN:=STKINFO.STKDSTFIELD;                                 <<07232>>18535000
IF PROCSTATE.ALIVEFLAG=1    << Yes, the process is alive! >>   <<07232>>18540000
   THEN                                                        <<07232>>18545000
   BEGIN                                                       <<07232>>18550000
   << This assignment of the user's JIT DST goes against >>    <<07232>>18555000
   << the philosophy of the MPE V include files, but it  >>    <<07232>>18560000
   << is the cleanest of the alternatives                >>    <<07232>>18565000
   EXCHANGEDB(PIN'DSTN);                                       <<07232>>18570000
   JITDSTN := DBARRAY( 11 );                                   << 8698>>18575000
   EXCHANGEDB(0);                                              <<07232>>18580000
   END                                                         <<07232>>18585000
   ELSE BEGIN                                                  <<07232>>18590000
        PIN'DSTN:=0;                                           <<07232>>18595000
        END;                                                   <<07232>>18600000
END;  << Subroutine GET'USERS'DST >>                           <<07232>>18605000
                                                               <<07232>>18610000
                                                               <<07232>>18615000
<< ******************************************************* >>  <<07232>>18620000
<< *******       Subroutine CURRENT'JOB'STEP       ******* >>  <<07232>>18625000
<< ******************************************************* >>  <<07232>>18630000
SUBROUTINE CURRENT'JOB'STEP(ITEM);                             <<07232>>18635000
BYTE ARRAY ITEM;                                               <<07232>>18640000
BEGIN                                                          <<07232>>18645000
<< Subroutine returns the current executing jobstep        >>  <<07232>>18650000
<< If USE'CURRENT'JOB, BLAST'COMIMAGE is got from current  >>  <<07232>>18655000
<< stack.  Else the PIN'DSTN is used. (from GET'USERS'DST) >>  <<07232>>18660000
<< The main mechanism for this is the MFDS intruction      >>  <<07232>>18665000
<<                                                         >>  <<07232>>18670000
                                                               <<07232>>18675000
<< PCBPT was set back in GET'USERS'DST >>                      <<07232>>18680000
IF PROCSTATE.ALIVEFLAG = 1                                     <<07232>>18685000
   THEN BEGIN                                                  <<07232>>18690000
        TOS:=@WORD;                                            <<07232>>18695000
        TOS:=PIN'DSTN;                                         <<07232>>18700000
        TOS:=0;                                                <<07232>>18705000
        TOS:=1;                                                <<07232>>18710000
        ASSEMBLE(MFDS 4);                                      <<07232>>18715000
        TOS:=@LAST'COMIMAGE;                                   <<07232>>18720000
        TOS:=PIN'DSTN;                                         <<07232>>18725000
        TOS:=WORD+%272;                                        <<07232>>18730000
        TOS:=140;                                              <<07232>>18735000
        ASSEMBLE(MFDS 4);                                      <<07232>>18740000
        SCAN BLAST'COMIMAGE UNTIL %6415,1;                     <<07232>>18745000
        COMMAND'LEN:=(TOS-@BLAST'COMIMAGE);                    <<07232>>18750000
        END                                                    <<07232>>18755000
   ELSE BEGIN                                                  <<07232>>18760000
        JI'ERROR(STATUS'S,PROCESS'DIED,5);                     <<07232>>18765000
        END;                                                   <<07232>>18770000
                                                               <<07232>>18775000
MOVE ITEM(0):=BLAST'COMIMAGE,(COMMAND'LEN);                    <<07232>>18780000
<< Obviously, if the user inputs a command appended with >>    <<07232>>18785000
<< the following statement isn't worth the toner its     >>    <<07232>>18790000
<< written with.  Looking for lengths of commands that   >>    <<07232>>18795000
<< are odd.                                              >>    <<07232>>18800000
IF BLAST'COMIMAGE(COMMAND'LEN-1)=" "                           <<07232>>18805000
   THEN COMMAND'LEN:=COMMAND'LEN-1;                            <<07232>>18810000
END; << Subroutine CURRENT'JOB'STEP >>                         <<07232>>18815000
                                                               <<07232>>18820000
<< ********************************************************* >><<07232>>18825000
<< *******           Subroutine FMT'J'U'A            ******* >><<07232>>18830000
<< ********************************************************* >><<07232>>18835000
SUBROUTINE FMT'J'U'A;                                          <<07232>>18840000
COMMENT:  Formats jsname,user.account in item.                 <<07232>>18845000
                                                             ; <<07232>>18850000
BEGIN                                                          <<07232>>18855000
L:=0;                                                          <<07232>>18860000
IF JMATUSERNAME <> %20040                                      <<07232>>18865000
   THEN MOVE JOBNL(0):=JMATJOBNAME,(4);                        <<07232>>18870000
MOVE ACCTL(0):=JMATACCTNAME,(4);                               <<07232>>18875000
MOVE USERL(0):=JMATUSERNAME,(4);                               <<07232>>18880000
IF JOBNL(0) <> %20040                                          <<07232>>18885000
    THEN BEGIN                                                 <<07232>>18890000
         MOVE BUFFB(0):=JOBNB,(8);                             <<07232>>18895000
         MOVE BUFFB(L+8):=",";                                 <<07232>>18900000
         L:=L+9;                                               <<07232>>18905000
         END;                                                  <<07232>>18910000
MOVE BUFFB(L):=USERB,(8);                                      <<07232>>18915000
MOVE BUFFB(L+8):=".";                                          <<07232>>18920000
L:=L+9;                                                        <<07232>>18925000
MOVE BUFFB(L):=ACCTB,(8);                                      <<07232>>18930000
<< REMOVE THE BLANKS >>                                        <<07232>>18935000
L:=0;                                                          <<07232>>18940000
J:=0;                                                          <<07232>>18945000
MOVE NBUFFB:="                          "; << 26 BLANKS    >>  <<07232>>18950000
                                           << COUNT THEM!! >>  <<07232>>18955000
WHILE L <= 25 DO                                               <<07232>>18960000
      BEGIN                                                    <<07232>>18965000
      IF BUFFB(L) <> " "                                       <<07232>>18970000
         THEN BEGIN                                            <<07232>>18975000
              MOVE NBUFFB(J):=BUFFB(L),(1);                    <<07232>>18980000
              J:=J+1;                                          <<07232>>18985000
              END;                                             <<07232>>18990000
      L:=L+1;                                                  <<07232>>18995000
      END;                                                     <<07232>>19000000
END;     << SUBROUTINE FMT'J'U'A >>                            <<07232>>19005000
                                                               <<07232>>19010000
<< ******************************************************* >>  <<07232>>19015000
<< *******         Subroutine CHECK'CAPS           ******* >>  <<07232>>19020000
<< ******************************************************* >>  <<07232>>19025000
SUBROUTINE CHECK'CAPS;                                         <<07232>>19030000
COMMENT:  Returns OK<-TRUE if user has capability to access    <<07232>>19035000
          certain information                             ;    <<07232>>19040000
BEGIN                                                          <<07232>>19045000
MOVE UCAPPTR(0) := JITUSERCAPS,(2);                            <<07232>>19050000
MOVE LTEMPACCT(0):=JMATACCTNAME,(4);                           <<07232>>19055000
MOVE LTEMPUSER(0):=JMATUSERNAME,(4);                           <<07232>>19060000
IF ( UCAPSM = 1) THEN OK:=TRUE                                 <<07232>>19065000
   ELSE IF(( UCAPAM = 1 )LAND(WACCT=TEMPACCT))  THEN OK:=TRUE  <<07232>>19070000
        ELSE IF ((TEMPUSER=WUSER)LAND(TEMPACCT=WACCT))         <<07232>>19075000
                THEN OK:=TRUE                                  <<07232>>19080000
                ELSE OK:=FALSE;                                <<07232>>19085000
END;                                                           <<07232>>19090000
                                                               <<07232>>19095000
<< ******************************************************** >> << 8756>>19100000
<< *******        Subroutine MOVE'NAME              ******* >> << 8756>>19105000
<< ******************************************************** >> << 8756>>19110000
SUBROUTINE MOVE'NAME( BITEM );                                 << 8756>>19115000
   BYTE ARRAY BITEM;                                           << 8756>>19120000
COMMENT:  Moves byte array BITEM to TEMPARRAY.  BITEM contains << 8756>>19125000
          the input string of JSNAME,USER.ACCOUNT terminated   << 8756>>19130000
          by a numeric zero.                                   << 8756>>19135000
          The maximum length allowed is 26 characters.         << 8756>>19140000
          ;                                                    << 8756>>19145000
BEGIN                                                          << 8756>>19150000
MOVE TEMPARRAY(0) := "                           ";            << 8756>>19155000
L := 0;                                                        << 8756>>19160000
WHILE L < 26 AND BITEM( L ) <> 0 DO                            << 8756>>19165000
  BEGIN                                                        << 8756>>19170000
  MOVE TEMPARRAY( L ) := BITEM( L ),(1);                       << 8756>>19175000
  L := L + 1;                                                  << 8756>>19180000
  END;                                                         << 8756>>19185000
                                                               << 8756>>19190000
END;  << Subroutine MOVE'NAME >>                               << 8756>>19195000
                                                               <<07232>>19200000
                                                               <<07232>>19205000
<< ******************************************************** >> <<07232>>19210000
<< ********        Subroutine RETRIV'ITEM           ******* >> <<07232>>19215000
<< ******************************************************** >> <<07232>>19220000
                                                               <<07232>>19225000
                                                               <<07232>>19230000
SUBROUTINE RETRIV'ITEM(ITEMNUM, ITEM,  ERROR, BITEM, DITEM);   <<07232>>19235000
COMMENT: Called to call retrieval routines based on ITEMNUM;   <<07232>>19240000
VALUE ITEMNUM;                                                 <<07232>>19245000
INTEGER ITEMNUM, ERROR;                                        <<07232>>19250000
LOGICAL ARRAY ITEM;                                            <<07232>>19255000
BYTE ARRAY BITEM;                                              <<07232>>19260000
DOUBLE ARRAY DITEM;                                            <<07232>>19265000
BEGIN                                                          <<07232>>19270000
IF JOBNUMBER = 0D THEN                                         <<07232>>19275000
   BEGIN                                                       <<07232>>19280000
   DETERMINE(ITEMNUM);                                         <<07232>>19285000
   IF  (PARSE'IT) << PARSE'IT is set in DETERMINE >>           <<07232>>19290000
      THEN BEGIN                                               <<07232>>19295000
           << Break apart JSNAME,USER.ACCT >>                  <<07232>>19300000
           << to search on that stuff for  >>                  <<07232>>19305000
           << the jobnumber                >>                  <<07232>>19310000
           MOVE'NAME( BITEM );<< JNM,USER.ACCT TO TEMPARRAY >> << 8756>>19315000
           PARSE'NAMES(TEMPARRAY,ERROR);                       <<07232>>19320000
           END;                                                <<07232>>19325000
   << FJOBNUM returns TRUE if desired entry is present >>      <<07232>>19330000
   IF  (PARSE'IT)                                              <<07232>>19335000
      THEN SUCCESS:=FJOBNUM(JMATARR,ENTRYP,0D,JSIND,JOBNL,     <<07232>>19340000
                            USERL,ACCTL);                      <<07232>>19345000
   IF  NOT(PARSE'IT)                                           <<07232>>19350000
      THEN SUCCESS:=FJOBNUM(JMATARR,ENTRYP,JOBNUMBER,JSIND,,,);<<07232>>19355000
   IF NOT SUCCESS THEN JI'ERROR(STATUS'S,UNSUCCESS'CALL'N,14); <<07232>>19360000
   JMATINX:=JMATENTRYSIZE;   << Base index for actual entry >> <<07232>>19365000
   JOBNUMBER:=DOUBLE(JMATJSNO);                                <<07232>>19370000
   JSNNN:=JOBNUMBER;                                           <<07232>>19375000
   CHECK'CAPS; << OK set TRUE if user has correct caps >>      <<07232>>19380000
   IF ((JMATJOBSTATE=JOBEXEC)LOR(JMATJOBSTATE=JOBCIINIT)       <<07232>>19385000
        LOR (JMATJOBSTATE = JOBSUSP)                           << 8202>>19390000
        LOR (JMATJOBSTATE = JOBSCHED) )                        << 8202>>19395000
      THEN                                                     << 8202>>19400000
       BEGIN                                                   <<07232>>19405000
       GET'USERS'DST;                                          <<07232>>19410000
       IF PIN'DSTN = 0 THEN JI'ERROR(STATUS'S,PROCESS'DIED,66);<<07232>>19415000
       JITINFO2;                                               <<07232>>19420000
       EXEC:=TRUE;                                             <<07232>>19425000
       END                                                     <<07232>>19430000
       ELSE EXEC:=FALSE;                                       <<07232>>19435000
   END; << BEGIN Now should have JOBNUMBER >>                  <<07232>>19440000
IF ((ITEMNUM < 1) LOR (ITEMNUM > MAX'ITEMS))                   <<07232>>19445000
   THEN JI'ERROR(STATUS'E,1,15)                                <<07232>>19450000
   ELSE                                                        <<07232>>19455000
   BEGIN                                                       <<07232>>19460000
   CASE ITEMNUM OF                                             <<07232>>19465000
   BEGIN                                                       <<07232>>19470000
   << 0 >> << Nothin' >>;                                      <<07232>>19475000
   << 1 >> << Format [jsname,]user.account >>                  <<07232>>19480000
           BEGIN                                               <<07232>>19485000
           FMT'J'U'A;                                          <<07232>>19490000
           IF FBNDVIOL(@ITEM,13,UBND) THEN RUN'TIME'ERR(BV);   <<07232>>19495000
           MOVE BITEM(0):=NBUFFB,(26);<< NBUFFB IN FMT'J'U'A >><<07232>>19500000
           END;                                                <<07232>>19505000
                                                               <<07232>>19510000
   << 2 >> << Session/Jobname >>                               <<07232>>19515000
           IF JMATJOBNAME = %20040 << Blanks >>                <<07232>>19520000
              THEN JI'ERROR(STATUS'E,INFO'NOT'PERT,49)         <<07232>>19525000
              ELSE BEGIN                                       <<07232>>19530000
                   IF FBNDVIOL(@ITEM,4,UBND)                   <<07232>>19535000
                      THEN RUN'TIME'ERR(BV);                   <<07232>>19540000
                   MOVE JOBNL:=JMATJOBNAME,(4);                <<07232>>19545000
                   MOVE BITEM(0):=JOBNB,(8);                   <<07232>>19550000
                   END;                                        <<07232>>19555000
                                                               <<07232>>19560000
   << 3 >> << User name >>                                     <<07232>>19565000
           BEGIN                                               <<07232>>19570000
           IF FBNDVIOL(@ITEM,4,UBND)                           <<07232>>19575000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19580000
           MOVE USERL:=JMATUSERNAME,(4);                       <<07232>>19585000
           MOVE BITEM(0):=USERB,(8);                           <<07232>>19590000
           END;                                                <<07232>>19595000
                                                               <<07232>>19600000
   << 4 >> << User logon group >>                              <<07232>>19605000
           BEGIN                                               <<07232>>19610000
           IF FBNDVIOL(@ITEM,4,UBND)                           <<07232>>19615000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19620000
           MOVE LOGONGROUP:=JMATGRPLOGON,(4);                  <<07232>>19625000
           MOVE BITEM(0):=BLOGONGROUP,(8);                     <<07232>>19630000
           END;                                                <<07232>>19635000
                                                               <<07232>>19640000
   << 5 >> << User acct name   >>                              <<07232>>19645000
           BEGIN                                               <<07232>>19650000
           IF FBNDVIOL(@ITEM,4,UBND)                           <<07232>>19655000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19660000
           MOVE ACCTL:=JMATACCTNAME,(4);                       <<07232>>19665000
           MOVE BITEM(0):=ACCTB,(8);                           <<07232>>19670000
           END;                                                <<07232>>19675000
                                                               <<07232>>19680000
   << 6 >> << User home group  >>                              <<07232>>19685000
           IF EXEC                                             <<07232>>19690000
              THEN BEGIN                                       <<07232>>19695000
               IF FBNDVIOL(@ITEM,4,UBND)                       <<07232>>19700000
                  THEN RUN'TIME'ERR(BV);                       <<07232>>19705000
               MOVE HOMEGROUP(0):=JITHOMEGROUP,(4);            <<07232>>19710000
               MOVE BITEM(0):=BHOMEGROUP,(8)<< FROM THE JIT >> <<07232>>19715000
               END                                             <<07232>>19720000
               ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,1);        <<07232>>19725000
                                                               <<07232>>19730000
   << 7 >> << Job/session intro time >>                        <<07232>>19735000
           BEGIN                                               <<07232>>19740000
           IF FBNDVIOL(@ITEM,2,UBND)                           <<07232>>19745000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19750000
           MOVE DTIMEA:=JMATTIME,(2);                          <<07232>>19755000
           INTRO0:=DTIMEA(0);                                  <<07232>>19760000
           INTRO1:=DTIMEA(1);                                  <<07232>>19765000
           DITEM:=DTIME;                                       <<07232>>19770000
           END;                                                <<07232>>19775000
                                                               <<07232>>19780000
   << 8 >> << Job/session intro date >>                        <<07232>>19785000
           BEGIN                                               <<07232>>19790000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>19795000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19800000
           ITEM:=JMATCALENDAR;                                 <<07232>>19805000
           END;                                                <<07232>>19810000
                                                               <<07232>>19815000
   << 9 >> << Input ldev/class name >>                         <<07232>>19820000
           BEGIN                                               <<07232>>19825000
           IF FBNDVIOL(@ITEM,4,UBND)                           <<07232>>19830000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19835000
           GETLDEV(BITEM,TRUE);                                <<07232>>19840000
           END;                                                <<07232>>19845000
                                                               <<07232>>19850000
   <<010>> << Output ldev/class name >>                        <<07232>>19855000
           BEGIN                                               <<07232>>19860000
           IF FBNDVIOL(@ITEM,4,UBND)                           <<07232>>19865000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19870000
           GETLDEV(BITEM,FALSE);                               <<07232>>19875000
           END;                                                <<07232>>19880000
                                                               <<07232>>19885000
   <<011>> << Current job step >>                              <<07232>>19890000
           IF JMATJOBSTATE = JOBEXEC THEN                      <<07232>>19895000
           IF NOT OK THEN JI'ERROR(STATUS'E,INSUFF'CAP,41)     <<07232>>19900000
           ELSE BEGIN                                          <<07232>>19905000
                CURRENT'JOB'STEP(BITEM);                       <<07232>>19910000
                IF FBNDVIOL(@ITEM,COMMAND'LEN,UBND)            <<07232>>19915000
                   THEN RUN'TIME'ERR(BV);                      <<07232>>19920000
                CJS'GOTTEN:=TRUE;                              <<07232>>19925000
                END                                            <<07232>>19930000
           ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,2);            <<07232>>19935000
                                                               <<07232>>19940000
   <<012>> << Current number of jobs >>                        <<07232>>19945000
           BEGIN                                               <<07232>>19950000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>19955000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19960000
           ITEM:=JMATJNUM;                                     <<07232>>19965000
           END;                                                <<07232>>19970000
                                                               <<07232>>19975000
   <<013>> << Current number of sessions >>                    <<07232>>19980000
           BEGIN                                               <<07232>>19985000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>19990000
              THEN RUN'TIME'ERR(BV);                           <<07232>>19995000
           ITEM:=JMATSNUM;                                     <<07232>>20000000
           END;                                                <<07232>>20005000
                                                               <<07232>>20010000
   <<014>> << Job/session inpri >>                             <<07232>>20015000
           BEGIN                                               <<07232>>20020000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20025000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20030000
           ITEM:=JMATINPRI;                                    <<07232>>20035000
           END;                                                <<07232>>20040000
                                                               <<07232>>20045000
   <<015>> << Job/session number >>                            <<07232>>20050000
           BEGIN                                               <<07232>>20055000
           IF FBNDVIOL(@ITEM,2,UBND)                           <<07232>>20060000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20065000
           DITEM:=DOUBLE(JMATJSNO);                            <<07232>>20070000
           END;                                                <<07232>>20075000
                                                               <<07232>>20080000
   <<016>> << Jobfence >>                                      <<07232>>20085000
           BEGIN                                               <<07232>>20090000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20095000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20100000
           ITEM:=JMATJOBFENCE;                                 <<07232>>20105000
           END;                                                <<07232>>20110000
                                                               <<07232>>20115000
   <<017>> << Job output priority >>                           <<07232>>20120000
           BEGIN                                               <<07232>>20125000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20130000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20135000
           ITEM:=JMATOUTPRI;                                   <<07232>>20140000
           END;                                                <<07232>>20145000
                                                               <<07232>>20150000
   <<018>> << Number of copies >>                              <<07232>>20155000
           BEGIN                                               <<07232>>20160000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20165000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20170000
           ITEM:=JMATNUMCOPIES;                                <<07232>>20175000
           END;                                                <<07232>>20180000
                                                               <<07232>>20185000
   <<019>> << System job limit >>                              <<07232>>20190000
           BEGIN                                               <<07232>>20195000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20200000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20205000
           ITEM:=JMATJLIMIT;                                   <<07232>>20210000
           END;                                                <<07232>>20215000
                                                               <<07232>>20220000
   <<020>> << System session limit >>                          <<07232>>20225000
           BEGIN                                               <<07232>>20230000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20235000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20240000
           ITEM:=JMATSLIMIT;                                   <<07232>>20245000
           END;                                                <<07232>>20250000
                                                               <<07232>>20255000
   <<021>> << Job defered?? >>                                 <<07232>>20260000
           BEGIN                                               <<07232>>20265000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20270000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20275000
           IF INTEGER(JMATINPRI) <= INTEGER(JMATJOBFENCE)      <<07232>>20280000
               THEN ITEM:=LOGICAL(1)                           <<07232>>20285000
               ELSE ITEM:=LOGICAL(0);                          <<07232>>20290000
           END;                                                <<07232>>20295000
                                                               <<07232>>20300000
   <<022>> << CI main pin >>                                   <<07232>>20305000
           BEGIN                                               <<07232>>20310000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20315000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20320000
           IF EXEC                                             <<07232>>20325000
              THEN IF NOT OK                                   <<07232>>20330000
                      THEN JI'ERROR(STATUS'E,INSUFF'CAP,42)    <<07232>>20335000
                      ELSE ITEM:=JMATMAINPIN                   <<07232>>20340000
              ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,3);         <<07232>>20345000
           END;                                                <<07232>>20350000
                                                               <<07232>>20355000
   <<023>> << Orig job spooled ? >>                            <<07232>>20360000
           BEGIN                                               <<07232>>20365000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20370000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20375000
           ITEM:=JMATSBIT;                                     <<07232>>20380000
           END;                                                <<07232>>20385000
                                                               <<07232>>20390000
   <<024>> << Restart option ?>>                               <<07232>>20395000
           BEGIN                                               <<07232>>20400000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20405000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20410000
           ITEM:=JMATRESTART;                                  <<07232>>20415000
           END;                                                <<07232>>20420000
                                                               <<07232>>20425000
   <<025>> << Job is sequenced ?? >>                           <<07232>>20430000
           BEGIN                                               <<07232>>20435000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20440000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20445000
           ITEM:=JMATSEQBIT;                                   <<07232>>20450000
           END;                                                <<07232>>20455000
                                                               <<07232>>20460000
   <<026>> << Term type >>                                     <<07232>>20465000
           BEGIN                                               <<07232>>20470000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20475000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20480000
           ITEM:=JMATFTBITS;                                   <<07232>>20485000
           END;                                                <<07232>>20490000
                                                               <<07232>>20495000
   <<027>> << CPU limit >>                                     <<07232>>20500000
           BEGIN                                               <<07232>>20505000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20510000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20515000
           ITEM:=JMATCPULIM;                                   <<07232>>20520000
           END;                                                <<07232>>20525000
                                                               <<07232>>20530000
   <<028>> << Session/job state >>                             <<07232>>20535000
           BEGIN                                               <<07232>>20540000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20545000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20550000
           ITEM:=JMATJOBSTATE;                                 <<07232>>20555000
           END;                                                <<07232>>20560000
                                                               <<07232>>20565000
   <<029>> << User's local attributes >>                       <<07232>>20570000
           BEGIN                                               <<07232>>20575000
           IF FBNDVIOL(@ITEM,2,UBND)                           <<07232>>20580000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20585000
           IF EXEC THEN                                        <<07232>>20590000
           MOVE ITEM(0):=JITLOCALATTR,(2)  << From the JIT >>  <<07232>>20595000
           ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,4);            <<07232>>20600000
           END;                                                <<07232>>20605000
   <<030>> << Input spoolfile number >>                        <<07232>>20610000
           BEGIN                                               <<07232>>20615000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20620000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20625000
           C:=0;                                               <<07232>>20630000
           L:=INTEGER(JMATJINDEV);                             <<07232>>20635000
           IF GOTININFO                                        <<07232>>20640000
              THEN ITEM:=ISPFSTUFF(0).SPJN                     <<07232>>20645000
              ELSE IF SPOOLINFO(0,JOBNUMBER,ISPFSTUFF,C,L,     <<07232>>20650000
                                                 STDIN)        <<07232>>20655000
                      THEN BEGIN                               <<07232>>20660000
                           ITEM:=ISPFSTUFF(0).SPJN;            <<07232>>20665000
                           GOTININFO:=TRUE;                    <<07232>>20670000
                           END                                 <<07232>>20675000
                      ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,30);<<07232>>20680000
           END;                                                <<07232>>20685000
   <<031>> << INput spoolfile status >>                        <<07232>>20690000
           BEGIN                                               <<07232>>20695000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20700000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20705000
           C:=0;                                               <<07232>>20710000
           L:=INTEGER(JMATJINDEV);                             <<07232>>20715000
           IF GOTININFO                                        <<07232>>20720000
              THEN ITEM:=ISPFSTUFF(1)                          <<07232>>20725000
              ELSE IF SPOOLINFO(0,JOBNUMBER,ISPFSTUFF,C,L,     <<07232>>20730000
                                                 STDIN)        <<07232>>20735000
                      THEN BEGIN                               <<07232>>20740000
                           ITEM:=ISPFSTUFF(1);                 <<07232>>20745000
                           GOTININFO:=TRUE;                    <<07232>>20750000
                           END                                 <<07232>>20755000
                      ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,31);<<07232>>20760000
           END;                                                <<07232>>20765000
   <<032>> << Output spoolfile number >>                       <<07232>>20770000
           IF EXEC THEN                                        <<07232>>20775000
           BEGIN                                               <<07232>>20780000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20785000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20790000
           C:=INTEGER(JMATCBIT);                               <<07232>>20795000
           L:=INTEGER(JMATJLISTDEV);                           <<07232>>20800000
           IF GOTOUTINFO                                       <<07232>>20805000
              THEN ITEM:=OSPFSTUFF(0).SPJN                     <<07232>>20810000
              ELSE IF SPOOLINFO(1,JOBNUMBER,OSPFSTUFF,C,L,     <<07232>>20815000
                                                 STDLIST)      <<07232>>20820000
                      THEN BEGIN                               <<07232>>20825000
                           ITEM:=OSPFSTUFF(0).SPJN;            <<07232>>20830000
                           GOTOUTINFO:=TRUE;                   <<07232>>20835000
                           END                                 <<07232>>20840000
                      ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,32);<<07232>>20845000
           END                                                 <<07232>>20850000
           ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,5);            <<07232>>20855000
                                                               <<07232>>20860000
   <<033>> << Output spoolfile status >>                       <<07232>>20865000
           IF EXEC THEN                                        <<07232>>20870000
           BEGIN                                               <<07232>>20875000
           IF FBNDVIOL(@ITEM,1,UBND)                           <<07232>>20880000
              THEN RUN'TIME'ERR(BV);                           <<07232>>20885000
           C:=INTEGER(JMATCBIT);                               <<07232>>20890000
           L:=INTEGER(JMATJLISTDEV);                           <<07232>>20895000
           IF GOTOUTINFO                                       <<07232>>20900000
              THEN ITEM:=OSPFSTUFF(1)                          <<07232>>20905000
              ELSE IF SPOOLINFO(1,JOBNUMBER,OSPFSTUFF,C,L,     <<07232>>20910000
                                                 STDLIST)      <<07232>>20915000
                      THEN BEGIN                               <<07232>>20920000
                           ITEM:=OSPFSTUFF(1);                 <<07232>>20925000
                           GOTOUTINFO:=TRUE;                   <<07232>>20930000
                           END                                 <<07232>>20935000
                      ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,33);<<07232>>20940000
           END                                                 <<07232>>20945000
           ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,6);            <<07232>>20950000
                                                               <<07232>>20955000
   <<34>> << Current jobstep length-not including CR >>        <<07232>>20960000
          BEGIN                                                <<07232>>20965000
          IF FBNDVIOL(@ITEM,1,UBND)                            <<07232>>20970000
             THEN RUN'TIME'ERR(BV);                            <<07232>>20975000
          IF EXEC THEN                                         <<07232>>20980000
          IF NOT OK THEN JI'ERROR(STATUS'E,INSUFF'CAP,41)      <<07232>>20985000
             ELSE IF CJS'GOTTEN THEN ITEM:=COMMAND'LEN         <<07232>>20990000
                  ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,41)     <<07232>>20995000
          ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,7);             <<07232>>21000000
          END;                                                 <<07232>>21005000
                                                               <<07232>>21010000
   <<35>> << :SET STDLIST = DELETE stuff >>                    <<07232>>21015000
          BEGIN                                                <<07232>>21020000
          IF FBNDVIOL(@ITEM,1,UBND) THEN RUN'TIME'ERR(BV);     <<07232>>21025000
          IF NOT OK                                            <<07232>>21030000
             THEN JI'ERROR(STATUS'E,INSUFF'CAP,6)              <<07232>>21035000
             ELSE IF JMATJSTYPE <> 2                           <<07232>>21040000
                     THEN JI'ERROR(STATUS'E,INFO'NOT'PERT,7)   <<07232>>21045000
                     ELSE ITEM:=JMATACCTPASS;                  <<07232>>21050000
          END;                                                 <<07232>>21055000
                                                               <<07232>>21060000
                                                               <<07232>>21065000
   <<36>> << JIT DST number >>                                 <<07232>>21070000
          BEGIN                                                <<07232>>21075000
          IF FBNDVIOL(@ITEM,1,UBND)                            <<07232>>21080000
             THEN RUN'TIME'ERR(BV);                            <<07232>>21085000
          IF EXEC THEN                                         <<07232>>21090000
          IF NOT OK THEN JI'ERROR(STATUS'E,INSUFF'CAP,41)      <<07232>>21095000
                    ELSE ITEM:=JITDSTN                         <<07232>>21100000
          ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,8);             <<07232>>21105000
          END;                                                 <<07232>>21110000
                                                               <<07232>>21115000
   <<37>> << PIN NUMBER >>                                     <<07232>>21120000
          BEGIN                                                <<07232>>21125000
          IF FBNDVIOL(@ITEM,1,UBND)                            <<07232>>21130000
             THEN RUN'TIME'ERR(BV);                            <<07232>>21135000
          IF EXEC THEN                                         <<07232>>21140000
          IF NOT OK THEN JI'ERROR(STATUS'E,INSUFF'CAP,41)      <<07232>>21145000
                    ELSE ITEM:=PIN'DSTN                        <<07232>>21150000
                                                               <<07232>>21155000
          ELSE JI'ERROR(STATUS'E,INFO'NOT'PERT,9);             <<07232>>21160000
          END;                                                 <<07232>>21165000
                                                               <<07232>>21170000
   END; << CASE >>                                             <<07232>>21175000
   END; << ELSE BEGIN >>                                       <<07232>>21180000
ITEM:=ITEM;                                                    <<07232>>21185000
END; << Subroutine RETRIV'ITEM >>                              <<07232>>21190000
<< ******************************************************* >>  <<07232>>21195000
<< ******* Subroutine UPDATESTATUS                 ******* >>  <<07232>>21200000
<< ******************************************************* >>  <<07232>>21205000
SUBROUTINE UPDATESTATUS;                                       <<07232>>21210000
COMMENT THIS SUBROUTINE TAKES OVER WHERE JI'ERROR LEFT OFF;    <<07232>>21215000
BEGIN                                                          <<07232>>21220000
IF GERROR = 0                                                  <<07232>>21225000
   THEN STATUS:=SUCCESS'CALL;                                  <<07232>>21230000
IF GERROR = NUMBER'ITEMS                                       << 8962>>21235000
   THEN STATUS:=UNSUCCESS'ERRORS;                              <<07232>>21240000
END; << SUBROUTINE UPDATESTATUS >>                             <<07232>>21245000
                                                               <<07232>>21250000
                                                               <<07232>>21255000
                                                               <<07232>>21260000
                                                               <<06898>>21265000
                                                               <<07232>>21270000
                                                               <<07232>>21275000
<< ******************************************************** >> <<07232>>21280000
<< ******* Subroutine ITEMS1                        ******* >> <<07232>>21285000
<< ******************************************************** >> <<07232>>21290000
SUBROUTINE ITEMS1;                                             <<07232>>21295000
COMMENT: Determines if any syntax errors occured on the        <<07232>>21300000
         first triple.  If not, it gets the information;       <<07232>>21305000
BEGIN                                                          <<07232>>21310000
FIRST'TRIPLE'SUPPLIED := FALSE;                                << 8756>>21315000
IF INTEGER(PARM'MASKQ4.(1:3)) <> 0                             <<07232>>21320000
   THEN IF INTEGER(PARM'MASKQ4.(1:3)) = 7                      <<07232>>21325000
           THEN BEGIN                                          <<07232>>21330000
           ERROR1 := 0;                                        <<07232>>21335000
           NUMBER'ITEMS := NUMBER'ITEMS + 1;                   << 8962>>21340000
           FIRST'TRIPLE'SUPPLIED := TRUE;                      << 8756>>21345000
           RETRIV'ITEM(ITEMNUM1,ITEM1,ERROR1,BITEM1,DITEM1);   <<07232>>21350000
           IF ERROR1 <> 0 THEN GERROR := GERROR + 1;           <<07232>>21355000
           END                                                 <<07232>>21360000
           ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 80 );    << 8455>>21365000
END;                                                           <<07232>>21370000
                                                               <<07232>>21375000
<< ******************************************************** >> <<07232>>21380000
<< ******* Subroutine ITEMS2                        ******* >> <<07232>>21385000
<< ******************************************************** >> <<07232>>21390000
SUBROUTINE ITEMS2;                                             <<07232>>21395000
COMMENT: Determines if any syntax errors occured on the        <<07232>>21400000
         second triple.  If not, it gets the information;      <<07232>>21405000
BEGIN                                                          <<07232>>21410000
IF INTEGER(PARM'MASKQ4.(4:3)) <> 0                             <<07232>>21415000
   THEN IF INTEGER(PARM'MASKQ4.(4:3)) = 7                      <<07232>>21420000
           THEN BEGIN                                          <<07232>>21425000
           ERROR2 := 0;                                        <<07232>>21430000
           NUMBER'ITEMS := NUMBER'ITEMS + 1;                   << 8962>>21435000
           RETRIV'ITEM(ITEMNUM2,ITEM2,ERROR2,BITEM2,DITEM2);   <<07232>>21440000
           IF ERROR2 <> 0 THEN GERROR := GERROR + 1;           <<07232>>21445000
           END                                                 <<07232>>21450000
           ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 81 );    << 8455>>21455000
END;                                                           <<07232>>21460000
                                                               <<07232>>21465000
<< ******************************************************** >> <<07232>>21470000
<< ******* Subroutine ITEMS3                        ******* >> <<07232>>21475000
<< ******************************************************** >> <<07232>>21480000
SUBROUTINE ITEMS3;                                             <<07232>>21485000
COMMENT: Determines if any syntax errors occured on the        <<07232>>21490000
         third triple.  If not, it gets the information;       <<07232>>21495000
BEGIN                                                          <<07232>>21500000
IF INTEGER(PARM'MASKQ4.(7:3)) <> 0                             <<07232>>21505000
   THEN IF INTEGER(PARM'MASKQ4.(7:3)) = 7                      <<07232>>21510000
        THEN BEGIN                                             <<07232>>21515000
        ERROR3 := 0;                                           <<07232>>21520000
        NUMBER'ITEMS := NUMBER'ITEMS + 1;                      << 8962>>21525000
        RETRIV'ITEM(ITEMNUM3,ITEM3,ERROR3,BITEM3,DITEM3);      <<07232>>21530000
        IF ERROR3 <> 0 THEN GERROR := GERROR + 1;              <<07232>>21535000
        END                                                    <<07232>>21540000
        ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 82 );       << 8455>>21545000
END;                                                           <<07232>>21550000
                                                               <<07232>>21555000
<< ******************************************************** >> <<07232>>21560000
<< ******* Subroutine ITEMS4                        ******* >> <<07232>>21565000
<< ******************************************************** >> <<07232>>21570000
SUBROUTINE ITEMS4;                                             <<07232>>21575000
COMMENT: Determines if any syntax errors occured on the        <<07232>>21580000
         fourth triple.  If not, it gets the information;      <<07232>>21585000
BEGIN                                                          <<07232>>21590000
IF INTEGER(PARM'MASKQ4.(10:3)) <> 0                            <<07232>>21595000
   THEN IF INTEGER(PARM'MASKQ4.(10:3)) = 7                     <<07232>>21600000
        THEN BEGIN                                             <<07232>>21605000
        ERROR4 := 0;                                           <<07232>>21610000
        NUMBER'ITEMS := NUMBER'ITEMS + 1;                      << 8962>>21615000
        RETRIV'ITEM(ITEMNUM4,ITEM4,ERROR4,BITEM4,DITEM4);      <<07232>>21620000
        IF ERROR4 <> 0 THEN GERROR := GERROR + 1;              <<07232>>21625000
        END                                                    <<07232>>21630000
        ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 83 );       << 8455>>21635000
END;                                                           <<07232>>21640000
                                                               <<07232>>21645000
<< ******************************************************** >> <<07232>>21650000
<< ******* Subroutine ITEMS5                        ******* >> <<07232>>21655000
<< ******************************************************** >> <<07232>>21660000
SUBROUTINE ITEMS5;                                             <<07232>>21665000
COMMENT: Determines if any syntax errors occured on the        <<07232>>21670000
         fifth triple.  If not, it gets the information;       <<07232>>21675000
BEGIN                                                          <<07232>>21680000
IF INTEGER(PARM'MASKQ4.(13:3)) <> 0                            <<07232>>21685000
   THEN IF INTEGER(PARM'MASKQ4.(13:3)) = 7                     <<07232>>21690000
        THEN BEGIN                                             <<07232>>21695000
        ERROR5 := 0;                                           <<07232>>21700000
        NUMBER'ITEMS := NUMBER'ITEMS + 1;                      << 8962>>21705000
        RETRIV'ITEM(ITEMNUM5,ITEM5,ERROR5,BITEM5,DITEM5);      <<07232>>21710000
        IF ERROR5 <> 0 THEN GERROR := GERROR + 1;              <<07232>>21715000
        END                                                    <<07232>>21720000
        ELSE JI'ERROR( STATUS'S, UNSUCCESS'SYNTAX, 84 );       << 8455>>21725000
END;                                                           <<07232>>21730000
                                                               <<07232>>21735000
                                                               <<07232>>21740000
<< *********************************************************** <<07232>>21745000
<< *******                                             ******* <<07232>>21750000
<< *******   Start of the outer block of JOBINFO...    ******* <<07232>>21755000
<< *******   It all happens here.... in River City;    ******* <<07232>>21760000
<< *******                                             ******* <<07232>>21765000
<< *********************************************************** <<07232>>21770000
                                                               <<07232>>21775000
SAVECRITICAL := SETCRITICAL;                                   <<07232>>21780000
JMAT'SIR := GETSIR( JMATSIR );                                 <<07232>>21785000
                                                               <<07232>>21790000
                                                               <<07232>>21795000
ERRORON;                                                       <<07232>>21800000
<<                                                           >><<07232>>21805000
<< Test for ommission of required parameters.  No defaults   >><<07232>>21810000
<< if any are omitted.  Run-time error condition             >><<07232>>21815000
IF ((PARM'MASKQ5.REQ'PARMS'FIELD <> 3) LOR                     <<07232>>21820000
    (PARM'MASKQ4.(0:1) <> 1))                                  <<07232>>21825000
   THEN RUN'TIME'ERR(OMITTED'REQ'PARM);                        <<07232>>21830000
<<                                                           >><<07232>>21835000
<< Test for split-stack mode.  Split-stack mode is not       >><<07232>>21840000
<< acceptable.  Run-time error condition.                    >><<07232>>21845000
WHERES'DB;  << A new function >>                               <<07232>>21850000
IF <> THEN RUN'TIME'ERR(ILLEGAL'DB);                           <<07232>>21855000
<<                                                           >><<07232>>21860000
WHO(WMODE,WCAPS,,WUSER,WGROUP,WACCT,WHOME,WTERM); << WHO?? >>  <<07232>>21865000
MOVE BSTDIN:="$STDIN  ";                                       <<07232>>21870000
MOVE BSTDLIST:="$STDLIST";                                     <<07232>>21875000
MOVE DELIMS:=(",.",0);                                         <<07232>>21880000
STATUS:=0; << Assume a successful call due to great users! >>  <<07232>>21885000
ITEM'INDEX:=1;  << Can increment to 5 ITEMNUM's >>             <<07232>>21890000
JOBNUMBER:=0D;                                                 <<07232>>21895000
GERROR := 0;                                                   <<07232>>21900000
NUMBER'ITEMS := 0;                                             << 8962>>21905000
WHILE ITEM'INDEX <= MAX'ITEMS'REQ DO                           <<07232>>21910000
    BEGIN                                                      <<07232>>21915000
    CASE ITEM'INDEX OF                                         <<07232>>21920000
         BEGIN                                                 <<07232>>21925000
         ;                                                     <<07232>>21930000
         ITEMS1;                                               <<07232>>21935000
         ITEMS2;                                               <<07232>>21940000
         ITEMS3;                                               <<07232>>21945000
         ITEMS4;                                               <<07232>>21950000
         ITEMS5;                                               <<07232>>21955000
       END;  << CASE >>                                        <<07232>>21960000
    ITEM'INDEX:=ITEM'INDEX+1;                                  <<07232>>21965000
    END; << WHILE DO >>                                        <<07232>>21970000
UPDATESTATUS;  << THE FINAL STATUS UPDATE BEFORE THE RETURN >> <<07232>>21975000
                                                               <<07232>>21980000
ABORT:  << Emergency use only...from JI'ERROR >>               <<07232>>21985000
                                                               <<07232>>21990000
RELSIR( JMATSIR, JMAT'SIR );                                   <<07232>>21995000
RESETCRITICAL( SAVECRITICAL );                                 <<07232>>22000000
                                                               <<07232>>22005000
ERROREXIT(JOBINFOHANG,EXIT'ERROR,EXIT'PARM);                   <<07232>>22010000
                                                               <<07232>>22015000
END; << JOBINFO >>                                             <<07232>>22020000
$CONTROL SEGMENT=MAIN                                          <<07232>>22025000
END.                                                           <<07232>>22030000
