$CONTROL USLINIT, CODE, MAP                                             00010000
                                                                        00015000
<<------------------------------------------------------------->>       00020000
<<                                                             >>       00025000
<<                    MPE Segmenter Driver                     >>       00030000
<<                     SEGDVR (Module 03)                      >>       00035000
<<                                                             >>       00040000
<<                      Version  A.01.07                       >>       00045000
<<                     January 15, 1982                        >>       00050000
<<                                                             >>       00055000
<<------------------------------------------------------------->>       00060000
                                                                        00065000
$COPYRIGHT "(C) COPYRIGHT HEWLETT-PACKARD COMPANY 1981.  ",  &          00070000
$          "THIS PROGRAM MAY BE USED WITH ONE COMPUTER ",    &          00075000
$          "AT A TIME AND SHALL NOT OTHERWISE BE ",          &          00080000
$          "RECORDED, TRANSMITTED OR STORED IN A RETRIEVAL ",&          00085000
$          "SYSTEM.  COPYING OR OTHER REPRODUCTION OF THIS ",&          00090000
$          "PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS ",       &          00095000
$          "PROHIBITED WITHOUT THE PRIOR WRITTEN CONSENT ",  &          00100000
$          "OF HEWLETT-PACKARD COMPANY."                                00105000
                                                                        00110000
$TITLE "       MPE SEGMENTER DRIVER - JANUARY 15, 1982"                 00115000
$CONTROL MAIN = SEGDVR                                                  00120000
$CONTROL SEGMENT = SEGDVR                                               00125000
                                                                        00130000
begin                                                                   00135000
$PAGE                                                                   00140000
EQUATE CCG = 0,  <<"GREATER THAN" CONDITION CODE>>                      00145000
       CCL = 1,  <<"LESS THAN" CONDITION CODE>>                         00150000
       CCE = 2;  <<"EQUAL" CONDITION CODE>>                             00155000
INTEGER STATUS = Q-1;  <<STATUS WORD OF STACK MARKER>>                  00160000
DEFINE CONDCODE = STATUS.(6:2)#;  <<CONDITION CODE BITS>>               00165000
LOGICAL PARM = Q-4;  <<CREATE PARAMETER>>                               00170000
DEFINE CAB' = ASSEMBLE(CAB)#,                                           00175000
       DEL' = ASSEMBLE(DEL)#,                                           00180000
       DUP' = ASSEMBLE(DUP)#,                                           00185000
       XCH' = ASSEMBLE(XCH)#;                                           00190000
INTEGER XREG = X;  <<X REGISTER>>                                       00195000
INTEGER S0 = S-0;                                                       00200000
INTEGER S1 = S-1;                                              <<04285>>00205000
INTEGER S3 = S-3;                                              <<04285>>00210000
LOGICAL LS0 = S-0;                                                      00215000
BYTE POINTER BPS0 = S-0;                                                00220000
INTEGER POINTER PS0 = S-0;                                              00225000
INTEGER POINTER PS4 = S-4;                                              00230000
DOUBLE DS2 = S-2;                                                       00235000
                                                                        00240000
EQUATE   ERR'PRIVUSER  =  17;                                           00245000
<<SUBSYSTEM VARIABLES>>                                                 00250000
                                                                        00255000
INTEGER RUNNER;                                                <<04586>>00260000
EQUATE MITBUILD=10;                                            <<04586>>00265000
ARRAY PROMPT (0:0)=DB _ "- ";  <<COMMAND PROMPT CHARACTER = "-">>       00270000
ARRAY DOUBLEPROMPT (0:0)=DB := "--";  <<DOUBLE PROMPT>>                 00275000
ARRAY MSG1 (0:29) :=                                                    00280000
"HP32050A.01.09  SEGMENTER/3000 (C) HEWLETT-PACKARD CO 1983";  <<v7955>>00285000
BYTE ARRAY MESS (0:375) :=                                     <<04101>>00290000
                                                                        00295000
   <<SEGMENTER ERRORS>>                                                 00300000
                                                                        00305000
   2,14,"INTERNAL ERROR",                                               00310000
   3,34,"UNABLE TO CREATE SEGMENTER PROCESS",                           00315000
   4,36,"UNABLE TO ACTIVATE SEGMENTER PROCESS",                         00320000
   5,40,"UNABLE TO SEND MAIL TO SEGMENTER PROCESS",                     00325000
   6,45,"UNABLE TO RECEIVE MAIL FROM SEGMENTER PROCESS",                00330000
                                                                        00335000
   <<COMMAND INTERPRETER ERRORS>>                                       00340000
                                                                        00345000
   10,20,"ILLEGAL COMMAND NAME",                                        00350000
   11,28,"ILLEGAL NUMBER OF PARAMETERS",                                00355000
   12,17,"ILLEGAL PARAMETER",                                           00360000
   13,23,"COMMAND BUFFER OVERFLOW",                                     00365000
   14,20,"ILLEGAL CONTINUATION",                                        00370000
   15,15,"INPUT I/O ERROR",                                             00375000
   16,16,"OUTPUT I/O ERROR",                                            00380000
   17,23,"INSUFFICIENT CAPABILITY",                            <<04101>>00385000
   18,17,"ILLEGAL DELIMITER";                                  <<04101>>00390000
INTEGER BLANK _ %006440;  <<CR - BLANK>>                                00395000
INTEGER AMPERSAND _ %006446;  <<CR - AMPERSAND>>                        00400000
INTEGER LPAREN _ %006450;  <<CR - LEFT PAREN>>                          00405000
INTEGER RPAREN _ %006451;  <<CR - RIGHT PAREN>>                         00410000
INTEGER COMMA _ %006454;  <<CR - COMMA>>                                00415000
LOGICAL INTERACTIVE;  <<INTERACTIVE INPUT?>>                            00420000
LOGICAL DUPLICATIVE;  <<DUPLICATIVE INPUT?>>                            00425000
LOGICAL PRIVUSER;  <<PRIVILEGED USER CAP FROM WHO >>                    00430000
LOGICAL INHIBITFILEEQ;  <<INHIBIT FILE EQUATION BIT>>                   00435000
EQUATE TTYBND = 79;  <<INPUT BUFFER BOUND>>                             00440000
EQUATE MAXTTY = 2+2*TTYBND;  <<MAX. NR. BYTES FOR COMMAND>>             00445000
INTEGER ARRAY TTY (0:TTYBND);  <<INPUT BUFFER>>                         00450000
BYTE ARRAY BTTY (*) = TTY;                                              00455000
BYTE ARRAY DELIMITERS(0:3):=",=;",%15;                         <<04285>>00460000
$PAGE  "SEGMENTER SUBSYSTEM VARIABLES"                         <<00207>>00465000
<<SEGMENTER SUBSYSTEM VARIABLES>>                                       00470000
                                                                        00475000
INTEGER PIN _ 0;  <<PIN OF SEGMENTER SUBSYSTEM>>                        00480000
INTEGER COMMANDNR;                                                      00485000
INTEGER ERRORNR;                                                        00490000
INTEGER NERRORPARM;                                                     00495000
INTEGER NUM1;                                                           00500000
INTEGER NUM2;                                                           00505000
INTEGER NUM3;                                                           00510000
INTEGER NUM4;                                                           00515000
INTEGER NUM5;                                                           00520000
INTEGER NUM6;                                                  <<00629>>00525000
BYTE ARRAY STRING1 (0:15);                                              00530000
BYTE ARRAY STRING2 (0:15);                                              00535000
BYTE ARRAY FNAME1 (0:35);                                               00540000
BYTE ARRAY FNAME2 (0:35);                                               00545000
$PAGE  "PROCEDURE DECLARATIONS"                                <<00207>>00550000
<<----------------------------------------------------------------------00555000
*                                                                      *00560000
*  PROCEDURE DECLARATIONS                                              *00565000
*                                                                      *00570000
---------------------------------------------------------------------->>00575000
                                                                        00580000
PROCEDURE ACTIVATE (PIN,CODE);                                          00585000
   VALUE PIN,CODE;                                                      00590000
   LOGICAL PIN,CODE;                                                    00595000
   OPTION VARIABLE,EXTERNAL;                                            00600000
INTEGER PROCEDURE ASCII (NUM,BASE,STRING);                              00605000
   VALUE NUM,BASE;                                                      00610000
   INTEGER NUM,BASE;                                                    00615000
   BYTE ARRAY STRING;                                                   00620000
   OPTION EXTERNAL;                                                     00625000
LOGICAL PROCEDURE BINARY (STRING,LENGTH);                               00630000
   VALUE LENGTH;                                                        00635000
   BYTE ARRAY STRING;                                                   00640000
   INTEGER LENGTH;                                                      00645000
   OPTION EXTERNAL;                                                     00650000
PROCEDURE CLEAR (BA,LEN);                                               00655000
   VALUE LEN;                                                           00660000
   BYTE ARRAY BA;                                                       00665000
   INTEGER LEN;                                                         00670000
   OPTION FORWARD;                                                      00675000
PROCEDURE CREATE (PROGNAME,ENTRYNAME,PIN,PARM,FLAGS,STACKSIZE,DLSIZE,   00680000
                  MAXDATA,PRIORITY,RANK);                               00685000
   VALUE PARM,FLAGS,STACKSIZE,DLSIZE,MAXDATA,PRIORITY,RANK;             00690000
   BYTE ARRAY PROGNAME,ENTRYNAME;                                       00695000
   INTEGER PIN,PARM,STACKSIZE,DLSIZE,MAXDATA,RANK;                      00700000
   LOGICAL FLAGS,PRIORITY;                                              00705000
   OPTION VARIABLE,EXTERNAL;                                            00710000
PROCEDURE DEBUG;                                                        00715000
   OPTION EXTERNAL;                                                     00720000
PROCEDURE GETCLASS (DESCRIP,TARGET);                                    00725000
   VALUE DESCRIP;                                                       00730000
   DOUBLE DESCRIP;                                                      00735000
   INTEGER TARGET;                                                      00740000
   OPTION FORWARD;                                                      00745000
PROCEDURE GETFILENAME (DESCRIP,TARGET);                                 00750000
   VALUE DESCRIP;                                                       00755000
   DOUBLE DESCRIP;                                                      00760000
   BYTE ARRAY TARGET;                                                   00765000
   OPTION FORWARD;                                                      00770000
PROCEDURE GETIDENT (DESCRIP,TARGET);                                    00775000
   VALUE DESCRIP;                                                       00780000
   DOUBLE DESCRIP;                                                      00785000
   BYTE ARRAY TARGET;                                                   00790000
   OPTION FORWARD;                                                      00795000
INTEGER PROCEDURE GETJCW;                                               00800000
   OPTION EXTERNAL;                                                     00805000
PROCEDURE GETNUMBER (IDENT,TARGET);                                     00810000
   BYTE ARRAY IDENT; INTEGER TARGET;                                    00815000
   OPTION FORWARD;                                                      00820000
PROCEDURE GETPRIVMODE;                                                  00825000
   OPTION EXTERNAL;                                                     00830000
PROCEDURE GETUSERMODE;                                                  00835000
   OPTION EXTERNAL;                                                     00840000
PROCEDURE GETXIDENT (DESCRIP,TARGET,INDEX);                             00845000
   DOUBLE DESCRIP;                                                      00850000
   BYTE ARRAY TARGET;                                                   00855000
   LOGICAL INDEX;                                                       00860000
   OPTION FORWARD;                                                      00865000
INTEGER PROCEDURE KEYWORD (DESCRIP,PARMS);                              00870000
   VALUE DESCRIP;                                                       00875000
   DOUBLE DESCRIP;                                                      00880000
   BYTE ARRAY PARMS;                                                    00885000
   OPTION FORWARD;                                                      00890000
INTEGER PROCEDURE MYCOMMAND (IMAGE,DELIMS,MAXPARMS,NRPARMS,PARMS,DICT,  00895000
                             DEFN);                                     00900000
   VALUE MAXPARMS;                                                      00905000
   BYTE ARRAY IMAGE,DELIMS,DICT;                                        00910000
   INTEGER MAXPARMS,NRPARMS;                                            00915000
   DOUBLE ARRAY PARMS;                                                  00920000
   BYTE POINTER DEFN;                                                   00925000
   OPTION VARIABLE,EXTERNAL;                                            00930000
PROCEDURE PRINT (MESSAGE,LENGTH,CONTROL);                               00935000
   VALUE LENGTH,CONTROL;                                                00940000
   ARRAY MESSAGE;                                                       00945000
   INTEGER LENGTH,CONTROL;                                              00950000
   OPTION EXTERNAL;                                                     00955000
PROCEDURE PRINTERROR;                                                   00960000
   OPTION FORWARD;                                                      00965000
INTEGER PROCEDURE READ (MESSAGE,EXPECTEDL);                             00970000
   VALUE EXPECTEDL;                                                     00975000
   ARRAY MESSAGE;                                                       00980000
   INTEGER EXPECTEDL;                                                   00985000
   OPTION EXTERNAL;                                                     00990000
PROCEDURE READCOMMAND;                                                  00995000
   OPTION FORWARD;                                                      01000000
LOGICAL PROCEDURE RECEIVEMAIL (PIN,BUFFER,WAITFLAG);                    01005000
   VALUE PIN,WAITFLAG;                                                  01010000
   LOGICAL PIN,WAITFLAG;                                                01015000
   INTEGER ARRAY BUFFER;                                                01020000
   OPTION EXTERNAL;                                                     01025000
PROCEDURE SEGMENTER (PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,        01030000
                     NUM6,STRING1,STRING2,FNAME1,FNAME2);      <<00629>>01035000
   VALUE COMMAND,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;                <<00629>>01040000
   INTEGER PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;    <<00629>>01045000
   BYTE ARRAY STRING1,STRING2,FNAME1,FNAME2;                            01050000
   OPTION VARIABLE,EXTERNAL;                                            01055000
LOGICAL PROCEDURE SENDMAIL (PIN,COUNT,BUFFER,WAITFLAG);                 01060000
   VALUE PIN,COUNT,WAITFLAG;                                            01065000
   LOGICAL PIN,COUNT,WAITFLAG;                                          01070000
   INTEGER ARRAY BUFFER;                                                01075000
   OPTION EXTERNAL;                                                     01080000
PROCEDURE SETJCW (PARM);                                                01085000
   VALUE PARM;                                                          01090000
   INTEGER PARM;                                                        01095000
   OPTION EXTERNAL;                                                     01100000
PROCEDURE SYSTEMDEBUG;                                                  01105000
   OPTION EXTERNAL;                                                     01110000
PROCEDURE WHO (MODE,CAPABILITY,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMN);   01115000
   LOGICAL MODE,TERMN;                                                  01120000
   DOUBLE CAPABILITY,LATTR;                                             01125000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 01130000
   OPTION VARIABLE,EXTERNAL;                                            01135000
INTRINSIC FGETINFO,GETPRIVMODE,GETUSERMODE;                    <<04960>>01140000
$PAGE    "CLEAR"                                               <<00207>>01145000
<<----------------------------------------------------------------------01150000
*                                                                      *01155000
*  PROCEDURE GROUP                                                     *01160000
*                                                                      *01165000
---------------------------------------------------------------------->>01170000
                                                                        01175000
PROCEDURE CLEAR (BA,LEN);                                               01180000
   VALUE LEN;                                                           01185000
   BYTE ARRAY BA;                                                       01190000
   INTEGER LEN;                                                         01195000
   BEGIN                                                                01200000
   TOS _ @BA; BPS0 _ " ";                                               01205000
   ASSEMBLE(DUP,INCB); MOVE * _ *,(LEN)                                 01210000
   END;                                                                 01215000
$PAGE  "GETNUMBER"                                             <<00207>>01220000
PROCEDURE GETNUMBER (IDENT,TARGET);                                     01225000
   <<EVALUATES THE NUMBER STRING (IDENT) AND INSERTS THE RESULT         01230000
     IN TARGET.  IT IS ASSUMED THAT LEADING BLANKS HAVE BEEN            01235000
     REMOVED, THAT THE NUMBER IS UNSIGNED AND THAT IT MAY BE            01240000
     PRECEEDED BY "%".  NOTE THAT THIS PROCEDURE USES THE CONDITION     01245000
     CODE TO INDICATE AN ERROR>>                                        01250000
   BYTE ARRAY IDENT; INTEGER TARGET;                                    01255000
   BEGIN                                                                01260000
   TOS _ 0;  <<FOR RESULT OF BINARY>>                                   01265000
   TOS _ @IDENT;                                                        01270000
   DUP';                                                                01275000
   IF BPS0 = "%" THEN TOS _ TOS+1;                                      01280000
   WHILE BPS0 = NUMERIC DO TOS _ TOS+1;                                 01285000
   TOS _ TOS-@IDENT;  <<NUMBER STRING LENGTH>>                          01290000
   TARGET _ BINARY(*,*);  <<EVALUATE NUMBER>>                           01295000
   TOS _ IF = THEN CCE ELSE CCL;  <<ERROR?>>                            01300000
   CONDCODE _ TOS                                                       01305000
   END;                                                                 01310000
$PAGE  "GETIDENT"                                              <<00207>>01315000
PROCEDURE GETIDENT (DESCRIP,TARGET);                                    01320000
   <<MOVES AN IDENTIFIER STRING FROM SOURCE TO TARGET AND    >><<02818>>01325000
   <<TRUNCATES THE STRING TO 15 CHAR'S IF NECESSARY. WARNING >><<02818>>01330000
   <<MSG IS OUTPUT FOR TRUNCATION. CONDCODE IS SET TO CCL IF >><<02818>>01335000
   <<STRING IS NULL (STRING WITH 0 LENGTH). IT IS ASSUMED    >><<02818>>01340000
   <<THAT TARGET HAS BEEN PRE-BLANKED SO THAT THE MOVED      >><<02818>>01345000
   <<IDENTIFIER WILL BE TERMINATED BY A BLANK                >><<02818>>01350000
   VALUE DESCRIP;                                                       01355000
   DOUBLE DESCRIP;                                                      01360000
   BYTE ARRAY TARGET;                                                   01365000
   BEGIN                                                                01370000
   ARRAY MSG(0:22);                                            <<03024>>01375000
   BYTE ARRAY MSGB(*)=MSG;                                     <<03024>>01380000
   BYTE POINTER IDENT = DESCRIP;                                        01385000
   INTEGER INFO = DESCRIP+1;                                            01390000
   BYTE LEN = DESCRIP+1;                                                01395000
   IF INTEGER(LEN) = 0 THEN GO ERR;                            <<02818>>01400000
   TOS _ @TARGET; TOS _ @IDENT;                                         01405000
   IF INTEGER(LEN) <= 15 THEN TOS := LEN                       <<03065>>01410000
   ELSE BEGIN                                                  <<02818>>01415000
          MOVE MSGB:="*** WARNING *** ";                       <<03024>>01420000
          PRINT (MSG,-16,0);                                   <<03024>>01425000
          MOVE MSGB:=("STRING LONGER THAN 15 CHAR'S, ",        <<03024>>01430000
                      "TRUNCATED TO 15 ");                     <<03024>>01435000
          PRINT (MSG,-46,0);                                   <<03024>>01440000
          TOS:=15;                                             <<02818>>01445000
        END;                                                   <<02818>>01450000
   MOVE * := *,(TOS);                                          <<02818>>01455000
   TOS:=CCE;                                                   <<02818>>01460000
   GO GETOUT;                                                  <<02818>>01465000
   ERR: TOS:=CCL;                                              <<02818>>01470000
   GETOUT: CONDCODE:=TOS;                                      <<02818>>01475000
   END;                                                                 01480000
$PAGE  "GETXIDENT"                                             <<00207>>01485000
PROCEDURE GETXIDENT (DESCRIP,TARGET,INDEX);                             01490000
   <<SAME SAME AS GETIDENT EXCEPT LOOKS FOR AN OPTIONAL INDEX.  IF      01495000
     ONE IS FOUND, IT'S VALUE IS PLACED IN INDEX; OTHERWISE THE         01500000
     DEFAULT INDEX OF 0 IS PLACED IN INDEX.  NOTE THAT THIS PROCEDURE   01505000
     USES THE CONDITION CODE TO INDICATE AN ERROR>>                     01510000
   DOUBLE DESCRIP;                                                      01515000
   BYTE ARRAY TARGET;                                                   01520000
   LOGICAL INDEX;                                                       01525000
   BEGIN                                                                01530000
   BYTE POINTER IDENT;                                         <<04285>>01535000
   POINTER I = DESCRIP;                                        <<04285>>01540000
   @IDENT:=I;                                                  <<04285>>01545000
   INDEX _ 0;  <<DEFALUT INDEX OF 0>>                                   01550000
   SCAN IDENT UNTIL COMMA,1;  <<LOOK FOR COMMA OR CR>>                  01555000
   SCAN IDENT UNTIL LPAREN,1;  <<LOOK FOR "(" OR CR>>                   01560000
   ASSEMBLE(DDUP,CMP);                                                  01565000
   IF > THEN  <<INDEX PRESENT?>>                                        01570000
      BEGIN                                                             01575000
      ASSEMBLE(DDUP);                                                   01580000
      SCAN * UNTIL RPAREN,1;  <<LOOK FOR ")" OR CR>>                    01585000
      ASSEMBLE(DDUP,CMP);                                               01590000
      IF < THEN  <<NO MATCHING ")"?>>                                   01595000
         BEGIN                                                          01600000
         NFG:                                                           01605000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           01610000
         GO GETOUT                                                      01615000
         END;                                                           01620000
      TOS _ TOS+1;  <<SKIP OVER ")">>                                   01625000
      SCAN * WHILE BLANK,1;  <<SKIP OVER TRAILING BLANKS>>              01630000
      IF TOS <> TOS THEN GO NFG;  <<GARBAGE BEFORE DELIMITER?>>         01635000
      ASSEMBLE(DUP,INCB);                                               01640000
      DO TOS _ TOS-1 UNTIL BPS0 <> " ";                                 01645000
      TOS:=TOS-@IDENT+1;                                       <<04285>>01650000
      IF < THEN GO NFG;                                        <<04285>>01655000
      I(1).(0:8) := TOS;  << IDENTIFIER LENGTH >>              <<04285>>01660000
      SCAN * WHILE BLANK,1;                                             01665000
      ASSEMBLE(DUP);    <<CHECK ILLEGAL INDEX>>                <<02819>>01670000
      IF BPS0 = "%" THEN TOS:=TOS+1;                           <<02819>>01675000
      WHILE BPS0 <> ")" DO                                     <<02819>>01680000
        IF BPS0 = NUMERIC THEN TOS:=TOS+1                      <<02819>>01685000
        ELSE WHILE BPS0 <> ")" DO                              <<02819>>01690000
               BEGIN                                           <<02819>>01695000
                  IF BPS0 <> " " THEN                          <<02819>>01700000
                     BEGIN                                     <<02819>>01705000
                       ASSEMBLE(DDEL);                         <<02819>>01710000
                       GO NFG                                  <<02819>>01715000
                     END;                                      <<02819>>01720000
                  TOS:=TOS+1;                                  <<02819>>01725000
               END;                                            <<02819>>01730000
      ASSEMBLE(DEL);                                           <<02819>>01735000
      GETNUMBER(*,INDEX);  <<EVALUATE INDEX>>                           01740000
      IF < THEN GO NFG  <<ERROR?>>                                      01745000
      END;                                                              01750000
   GETIDENT(DESCRIP,TARGET);                                            01755000
   IF < THEN                                                   <<02818>>01760000
      BEGIN                                                    <<02818>>01765000
         TOS:=CCL;                                             <<02818>>01770000
         GO GETOUT;                                            <<02818>>01775000
      END;                                                     <<02818>>01780000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    01785000
                                                                        01790000
   GETOUT:                                                              01795000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             01800000
   END;                                                                 01805000
$PAGE  "GETFILENAME"                                           <<00207>>01810000
PROCEDURE GETFILENAME (DESCRIP,TARGET);                                 01815000
   <<MOVES A FILE NAME IDENTIFIER STRING FROM SOURCE (IDENT) TO         01820000
     TARGET.  IT IS ASSUMED THAT TARGET HAS BEEN PRE-BLANKED SO         01825000
     SO THAT THE MOVED IDENTIFIER WILL BE TERMINATED BY A BLANK>>       01830000
   VALUE DESCRIP;                                                       01835000
   DOUBLE DESCRIP;                                                      01840000
   BYTE ARRAY TARGET;                                                   01845000
   BEGIN                                                                01850000
   BYTE POINTER IDENT = DESCRIP;                                        01855000
   LOGICAL INFO = DESCRIP+1;                                            01860000
   BYTE LEN = DESCRIP+1;                                                01865000
   IF (1 <= INTEGER(LEN) <= 35) THEN                           <<02820>>01870000
      BEGIN                                                    <<02820>>01875000
         CONDCODE:=CCE;                                        <<02820>>01880000
         MOVE TARGET:=IDENT,(LEN); <<MOVE FILE NAME>>          <<02820>>01885000
      END                                                      <<02820>>01890000
   ELSE  CONDCODE:=CCL;                                        <<02820>>01895000
   END;                                                                 01900000
$PAGE  "GETCLEASS"                                             <<00207>>01905000
PROCEDURE GETCLASS (DESCRIP,TARGET);                                    01910000
   <<CHECKS FOR A MATCH BETWEEN THE GIVEN IDENTIFIER AND THE SET        01915000
     OF LEGAL ONES.  NOTE THAT THIS PROCEDURE USES THE CONDITION        01920000
     CODE TO INDICATE AN ERROR>>                                        01925000
   VALUE DESCRIP;                                                       01930000
   DOUBLE DESCRIP;                                                      01935000
   INTEGER TARGET;                                                      01940000
   BEGIN                                                                01945000
   BYTE POINTER IDENT = DESCRIP;                                        01950000
   LOGICAL INFO = DESCRIP+1;                                            01955000
   BYTE ARRAY PARMS(0:19)=PB _ 7,"SEGMENT",4,"UNIT",5,"ENTRY",0;        01960000
   TOS _ 0; TOS _ DESCRIP; TOS _ @PARMS;                                01965000
   TOS _ KEYWORD(*,*);                                                  01970000
   TOS _ IF < THEN CCL ELSE CCE;                                        01975000
   CONDCODE _ TOS;                                                      01980000
   TARGET.(12:2) _ TOS                                                  01985000
   END;                                                                 01990000
$PAGE   "KEYWORD"                                              <<00207>>01995000
INTEGER PROCEDURE KEYWORD (DESCRIP,PARMS);                              02000000
   <<CHECKS FOR A MATCH BETWEEN THE GIVEN IDENTIFIER AND THE GIVEN      02005000
     KEYWORD LIST, WHICH MUST BE A PB-RELATIVE BYTE ARRAY.  NOTE        02010000
     THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN         02015000
     ERROR>>                                                            02020000
   VALUE DESCRIP;                                                       02025000
   DOUBLE DESCRIP;                                                      02030000
   BYTE ARRAY PARMS;                                                    02035000
   BEGIN                                                                02040000
   BYTE POINTER IDENT = DESCRIP;                                        02045000
   INTEGER INFO = DESCRIP+1;                                            02050000
   BYTE LEN = DESCRIP+1;                                                02055000
   INTEGER INDEX = KEYWORD;  <<KEYWORD LIST INDEX>>                     02060000
   BYTE ARRAY KEYLEN(0:0);  <<KEYWORD LENGTH>>                          02065000
   XREG _ @IDENT;                                                       02070000
   TOS _ @KEYLEN; TOS _ @PARMS;                                         02075000
   AGAIN:                                                               02080000
   MOVE * _ * PB,(1),1;  <<EXTRACT KEYWORD LENGTH>>                     02085000
   ASSEMBLE(XBX,DDUP);  <<LOAD @IDENT AND SAVE @KEYLEN+1>>              02090000
   TOS _ KEYLEN; ASSEMBLE(TEST);                                        02095000
   IF = THEN  <<KEYWORD LIST EXHAUSTED?>>                               02100000
      BEGIN                                                             02105000
      TOS _ CCL;                                                        02110000
      GO GETOUT                                                         02115000
      END;                                                              02120000
   IF INTEGER(LEN) = S0 THEN  <<NR. CHAR'S EQUAL?>>                     02125000
      IF * = * PB,(TOS) THEN  <<STRINGS MATCH?>>                        02130000
         BEGIN                                                          02135000
         TOS _ CCE;                                                     02140000
         GO GETOUT                                                      02145000
         END                                                            02150000
      ELSE                                                              02155000
   ELSE ASSEMBLE(DEL,DDEL);                                             02160000
   INDEX _ INDEX+1;  <<BUMP KEYWORD NR.>>                               02165000
   TOS _ TOS+INTEGER(KEYLEN);  <<NEXT KEYWORD IN LIST>>                 02170000
   ASSEMBLE(XBX,DECB);  <<SAVE @IDENT AND RESTORE @KEYLEN>>             02175000
   GO AGAIN;                                                            02180000
                                                                        02185000
   GETOUT:                                                              02190000
   CONDCODE _ TOS                                                       02195000
   END;                                                                 02200000
$PAGE  "READCOMMAND"                                           <<00207>>02205000
PROCEDURE READCOMMAND;                                                  02210000
   <<READS AND PARSES A COMMAND IMAGE.  THE PARAMETERS OF THE COMMAND   02215000
     ARE PLACED IN THE GLOBAL COMMAND PARAMETER VARIABLES.  NOTE THAT   02220000
     THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>      02225000
   BEGIN                                                                02230000
   BYTE ARRAY COMS (*)=PB := 5,"ADDRL",5,"ADDSL",6,"AUXUSL",            02235000
      7,"BUILDRL",7,"BUILDSL",8,"BUILDUSL",5,"CEASE",4,"COPY",4,"EXIT", 02240000
      4,"HIDE",6,"LISTRL",6,"LISTSL",7,"LISTUSL",6,"NEWSEG",7,"PREPARE",02245000
      8,"PURGERBM",7,"PURGERL",7,"PURGESL",6,"REVEAL",2,"RL",2,"SL",    02250000
3,"USE",3,"USL",5,"DEBUG",6,"COPYSL",7,"COPYUSL",7,"CLEANSL",  <<00207>>02255000
      8,"CLEANUSL",4,"PREP",7,"LISTAUX",4,"SHOW",8,"LISTPMAP", <<04585>>02260000
      8,"SETFPMAP",0;                                          <<04585>>02265000
   SWITCH COMSWITCH _ ADDRL,ADDSL,AUXUSL,BUILDRL,BUILDRL,BUILDRL,       02270000
     CEASE,COPY,EXIT,ADDRL,LISTRL,LISTSL,LISTUSL,NEWSEG,PREPARE<<00592>>02275000
     ,COPY,PURGERL,PURGERL,ADDRL,AUXUSL,AUXUSL,CEASE,AUXUSL,   <<00207>>02280000
      DEBUG',COPYUSL,COPYUSL,CLEANSL,CLEANSL,PREPARE,LISTUSL,  <<04585>>02285000
      SHOW,LISTPMAP,SETFPMAP;                                  <<04585>>02290000
   byte array PrepParms(*) = PB :=   << Legal -PREP parameters <<04102>>02295000
      2, "RL",                    << Specifies RL file >>      <<04102>>02300000
      6, "ZERODB",                << Zeroes uninitialized stack<<04102>>02305000
      4, "PMAP",                  << Produces PMAP listing >>  <<04102>>02310000
      7, "MAXDATA",               << Specifies max stack size ><<04102>>02315000
      5, "STACK",                 << Specifies initial Q to Z ><<04102>>02320000
      2, "DL",                    << Specifies initial DL to DB<<04102>>02325000
      5, "PATCH",                 << Specifies patch area size <<04102>>02330000
      3, "CAP",                   << Capabilities req'd to run <<04102>>02335000
      5, "NOSYM",                 << Turn off symbolic debug >><<04102>>02340000
      5, "FPMAP",                 << Pmap info in prog file  >><<04102>>02345000
      7, "NOFPMAP",                                            <<04102>>02350000
      8, "CHECKSUM",                                           <<04259>>02355000
      0;                                                       <<04102>>02360000
   BYTE ARRAY ADDSLPARMS(*)=PB:=                               <<04102>>02365000
      4, "PMAP",                                               <<04102>>02370000
      5, "NOSYM",                                              <<04102>>02375000
      5, "FPMAP",                                              <<04102>>02380000
      7, "NOFPMAP",                                            <<04102>>02385000
      8, "CHECKSUM",                                           <<04259>>02390000
      5, "PATCH",                                              <<04259>>02395000
      1, "C",                                                  <<04586>>02400000
      1, "S",                                                  <<04586>>02405000
      1, "P",                                                  <<04586>>02410000
      0;                                                       <<04102>>02415000
   BYTE ARRAY CAPS(0:30)=PB _ 2,"NS",2,"BA",2,"IA",2,"PM",2,"CR",2,"RT",02420000
      2,"MR",2,"CD",2,"DS",2,"PH",0;                                    02425000
   BYTE ARRAY SETFPMAPPARMS(*)=PB:=                            <<04585>>02430000
      6, "SYSTEM",                                             <<04585>>02435000
      7, "SESSION",                                            <<04585>>02440000
      9, "CONDITION",                                          <<04585>>02445000
      11,"UNCONDITION",                                        <<04585>>02450000
      2, "ON",                                                 <<04585>>02455000
      3, "OFF",                                                <<04585>>02460000
      0;                                                       <<04585>>02465000
   SWITCH BADPARM _ BADPARM1,BADPARM1,BADPARM2,BADPARM3;       <<02818>>02470000
   INTEGER I = Q+1;  <<PARAMETER NR.>>                                  02475000
   INTEGER NRPARMS = Q+2;  <<NR. PARAMETERS>>                           02480000
   INTEGER BADPARMNR = Q+3;  <<ILLEGAL PARAMETER NR.>>                  02485000
   LOGICAL SPECIFIED = Q+4;  <<PARAMETERS SPECIFIED BIT MAP>>           02490000
   DEFINE SYSSPECIFIED=SPECIFIED.(0:1)#,                       <<04585>>02495000
          SYSSESSIONSPECIFIED=SPECIFIED.(1:1)#,                <<04585>>02500000
          CONDPARMSPECIFIED=SPECIFIED.(2:1)#,                  <<04585>>02505000
          ONOFFSPECIFIED=SPECIFIED.(3:1)#;                     <<04585>>02510000
   LOGICAL CONTINUED = Q+5;  <<COMMAND CONTINUED?>>                     02515000
   LOGICAL FPMAPSPECIFIED = Q+5;                               <<04102>>02520000
   DOUBLE ARRAY DESCRIP (*) = Q+4;  <<PARAMETER DESCRIPTOR ARRAY>>      02525000
   ARRAY DESCRIPW(*)=Q+4;                                      <<04101>>02530000
   DOUBLE DESCRIP1 = DESCRIP+2;                                         02535000
   BYTE POINTER PARM1 = DESCRIP1;                                       02540000
   LOGICAL INFO1 = DESCRIP1+1;                                          02545000
   BYTE LEN1 = DESCRIP1+1;                                              02550000
   DOUBLE DESCRIP2 = DESCRIP+4;                                         02555000
   BYTE POINTER PARM2 = DESCRIP2;                                       02560000
   LOGICAL INFO2 = DESCRIP2+1;                                          02565000
   BYTE LEN2 = DESCRIP2+1;                                              02570000
   DOUBLE DESCRIP3 = DESCRIP+6;                                         02575000
   BYTE POINTER PARM3 = DESCRIP3;                                       02580000
   LOGICAL INFO3 = DESCRIP3+1;                                          02585000
   BYTE LEN3 = DESCRIP3+1;                                              02590000
                                                               <<04101>>02595000
   EQUATE COMMA'=0,                                            <<04101>>02600000
          EQUAL'=1,                                            <<04101>>02605000
          SEMICOLON'=2,                                        <<04101>>02610000
          CR'=3;                                               <<04285>>02615000
   EQUATE FILENAME = 1,                                        <<04285>>02620000
          SEGNAME  = 2,                                        <<04285>>02625000
          NUMFIELD = 3,                                        <<04285>>02630000
          ALPHANUM = 4;                                        <<04285>>02635000
   DEFINE DELIMITER'=INTEGER(DESCRIPW(I*2+1).(11:5))#;         <<04101>>02640000
                                                               <<04101>>02645000
   SUBROUTINE CHECKDELIMITER(DELIMITER,I);                     <<04101>>02650000
                                                               <<04101>>02655000
   VALUE DELIMITER,                                            <<04101>>02660000
         I;         <<PARAMETER INDEX>>                        <<04101>>02665000
   INTEGER DELIMITER,I;                                        <<04101>>02670000
                                                               <<04101>>02675000
   BEGIN                                                       <<04101>>02680000
      IF DELIMITER' <> DELIMITER THEN                          <<04101>>02685000
         BEGIN                                                 <<04101>>02690000
            ERRORNR:=18;                                       <<04101>>02695000
            GO TO NFG1;                                        <<04101>>02700000
         END;                                                  <<04101>>02705000
   END;   <<CHECKDELIMITER>>                                   <<04101>>02710000
                                                                        02715000
   SUBROUTINE GETNUM (NUM);                                             02720000
      <<EVALUATES THE NUMERIC PARAMETER ASSOCIATED WITH THE KEYWORDED   02725000
        PARAMETER SPECIFIED BY I>>                                      02730000
      INTEGER NUM;                                                      02735000
      BEGIN                                                             02740000
      I _ I+1;                                                          02745000
      IF I > NRPARMS THEN                                      <<04101>>02750000
         BEGIN                                                 <<04101>>02755000
           I:=I-1;                                             <<04101>>02760000
           GO TO NFGPARM;                                      <<04101>>02765000
         END;                                                  <<04101>>02770000
      CHECKDELIMITER(EQUAL',I-1);                              <<04101>>02775000
      TOS _ 0; TOS _ DESCRIP(I); TOS _ TOS.(0:8);                       02780000
      ASSEMBLE (DUP);                                          <<04101>>02785000
      IF TOS=0 THEN GO NFGPARM;                                <<04101>>02790000
      PS4 := BINARY(*,*);  <<EVAL. NUMBER>>                             02795000
      IF <> THEN GO NFGPARM;                                   <<04101>>02800000
      END;                                                              02805000
   SUBROUTINE CHECKSPECIAL (I,MODE);                           <<04285>>02810000
   VALUE I,MODE;                                               <<04285>>02815000
   INTEGER I,MODE;                                             <<04285>>02820000
   << THIS ROUTINE CHECKS ALPHA-NUMERIC PARAMETER THAT  >>     <<04285>>02825000
   << THIS PARAMETER DID NOT CONTAIN SPECIAL CHARACTERS >>     <<04285>>02830000
   BEGIN                                                       <<04285>>02835000
      TOS:=DESCRIPW(I*2+1).(0:8)-1; << PARM CHARACTER COUNT >> <<04285>>02840000
      TOS:=DESCRIPW(S3*2); << PARM ADDRESS >>                  <<04285>>02845000
      WHILE S1 >= 0 DO                                         <<04285>>02850000
         BEGIN                                                 <<04285>>02855000
            IF BPS0(S1) = SPECIAL THEN                         <<04285>>02860000
               BEGIN                                           <<04285>>02865000
                  IF S3=FILENAME THEN                          <<04285>>02870000
                     IF BPS0(S1)="*" OR BPS0(S1)="." OR BPS0   <<04387>>02875000
                       (S1)="$" OR BPS0(S1)="/" THEN GO NEXT;  <<04387>>02880000
                  IF S3=SEGNAME THEN                           <<04285>>02885000
                     IF BPS0(S1)="-" OR BPS0(S1)="_" OR        <<04387>>02890000
                        BPS0(S1)="'" THEN GO NEXT;             <<04387>>02895000
                  IF S3=NUMFIELD THEN                          <<04285>>02900000
                     IF BPS0(S1)="%" THEN                      <<04285>>02905000
                       GO TO NEXT;                             <<04285>>02910000
                  ERRORNR:=18;                                 <<04285>>02915000
                  GO TO NFG1;                                  <<04285>>02920000
               END;                                            <<04285>>02925000
   NEXT:    S1:=S1-1;                                          <<04285>>02930000
         END;                                                  <<04285>>02935000
      DDEL;                                                    <<04285>>02940000
   END;                                                        <<04285>>02945000
                                                                        02950000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           02955000
                                                                        02960000
   ASSEMBLE(DZRO,DZRO; ZERO);                                           02965000
   ASSEMBLE(ADDS 46);                                                   02970000
                                                                        02975000
   <<* * * INITIALIZE GLOBAL COMMAND PARAMETERS * * *>>                 02980000
                                                                        02985000
   NERRORPARM _ -1;  <<INIT. TO NO PARAMETER>>                          02990000
   ASSEMBLE(DZRO,DZRO; DZRO);                                  <<00629>>02995000
   NUM1 _ TOS; NUM2 _ TOS; NUM4 _ TOS; NUM5 _ TOS;                      03000000
   NUM6 := TOS;                                                <<00629>>03005000
   TOS.(11:1) _ INHIBITFILEEQ; NUM3 _ TOS;                              03010000
   CLEAR(STRING1,15); CLEAR(STRING2,15);                                03015000
   CLEAR(FNAME1,35); CLEAR(FNAME2,35);                                  03020000
                                                                        03025000
   <<* * * READ COMMAND * * *>>                                         03030000
                                                                        03035000
   NULLCOMMAND:                                                         03040000
   IF INTERACTIVE THEN  <<PROMPT?>>                                     03045000
      BEGIN                                                             03050000
      PRINT(PROMPT,-1,%320);  <<PROMPT = "-">>                          03055000
      IF < THEN  <<ERROR?>>                                             03060000
         BEGIN                                                          03065000
         PRINTERROR:                                                    03070000
         TOS := 16;                                                     03075000
         GO NFG                                                         03080000
         END                                                            03085000
      END;                                                              03090000
   I _ MAXTTY;  <<NR. BYTES AVAILABLE>>                                 03095000
   TOS := @TTY;  <<BUFFER ADR.>>                                        03100000
                                                                        03105000
   READMORE:                                                            03110000
   TOS := READ(PS0,-I);  <<READ A LINE>>                                03115000
   IF > THEN  <<END-OF-FILE?>>                                          03120000
      BEGIN                                                             03125000
      COMMANDNR := 8;  <<EXIT COMMAND>>                                 03130000
      GO BOUGHTIT                                                       03135000
      END;                                                              03140000
   IF < THEN  <<ERROR?>>                                                03145000
      BEGIN                                                             03150000
      TOS := 15;                                                        03155000
      GO NFG                                                            03160000
      END;                                                              03165000
   ASSEMBLE(TEST);                                                      03170000
   IF = THEN  <<ZERO CHAR'S?>>                                          03175000
      BEGIN                                                             03180000
      TOS := CONTINUED;                                                 03185000
      DDEL;                                                             03190000
      IF <> THEN GO DNULLCOMMAND;  <<CONTINUED?>>                       03195000
      DEL;                                                              03200000
      GO NULLCOMMAND                                                    03205000
      END;                                                              03210000
   IF NOT DUPLICATIVE THEN  <<ECHO LINE?>>                              03215000
      BEGIN                                                             03220000
      ASSEMBLE(DDUP,NEG);                                               03225000
      ASSEMBLE (ADDS 1);                                       <<04757>>03230000
      GETPRIVMODE;<< CALL FGETINFO FOR STDLIST NEED PRIV >>    <<04960>>03235000
      FGETINFO (2,,,,S0); << GET STDLIST REC SIZE >>           <<04757>>03240000
      IF = THEN                                                <<04960>>03245000
      IF \S0\ < \S1\ THEN                                      <<04757>>03250000
         S1 := TOS                                             <<04757>>03255000
      ELSE                                                     <<04757>>03260000
         DEL                                                   <<04960>>03265000
      ELSE                                                     <<04960>>03270000
         DEL;                                                  <<04960>>03275000
      GETUSERMODE;                                             <<04960>>03280000
      PRINT(*,*,0);                                                     03285000
      IF < THEN GO PRINTERROR  <<ERROR?>>                               03290000
      END;                                                              03295000
   IF S0 = I THEN  <<BUFFER OVERFLOW?>>                                 03300000
      BEGIN                                                             03305000
      TOS := 13;                                                        03310000
      GO NFG                                                            03315000
      END;                                                              03320000
   XREG := TOS;                                                         03325000
   TOS _ S0&LSL(1);                                                     03330000
   BPS0(XREG) := %15;  <<INSERT CR STOPPER>>                            03335000
   SCAN * UNTIL AMPERSAND,1;  <<LOOK FOR CONTINUATION CHAR.>>           03340000
   IF NOCARRY THEN  <<LINE CONTINUED?>>                                 03345000
      BEGIN                                                             03350000
      ASSEMBLE(DUP,INCA);                                               03355000
      SCAN * WHILE BLANK;  <<LOOK FOR CR>>                              03360000
      IF NOCARRY THEN  <<ILLEGAL CONTINUATION?>>                        03365000
         BEGIN                                                          03370000
         TOS := 14;                                                     03375000
         GO NFG                                                         03380000
         END;                                                           03385000
      IF LS0 THEN                                                       03390000
         BEGIN                                                          03395000
         BPS0 _ " ";  <<BLANK OUT AMPERSAND>>                           03400000
         TOS _ TOS+1                                                    03405000
         END;                                                           03410000
      TOS _ TOS&LSR(1);  <<GET NEW WORD LABEL>>                         03415000
      ASSEMBLE(DUP,CAB; SUB,NEG);                                       03420000
      I _ TOS&ASL(1)+I;  <<ADJUST NR. BYTES AVAILABLE>>                 03425000
      DNULLCOMMAND:                                                     03430000
      IF INTERACTIVE THEN  <<PROMPT AGAIN?>>                            03435000
         BEGIN                                                          03440000
         PRINT(DOUBLEPROMPT,-2,%320);  <<PROMPT = "--">>                03445000
         IF < THEN GO PRINTERROR  <<ERROR?>>                            03450000
         END;                                                           03455000
      CONTINUED := CONTINUED+1;  <<SET CONTINUED FLAG>>                 03460000
      GO READMORE                                                       03465000
      END;                                                              03470000
                                                                        03475000
   <<* * * RECOGNIZE COMMAND NAME * * *>>                               03480000
                                                                        03485000
   ASSEMBLE(DDEL,ZERO);  <<FOR COMMAND NR.>>                            03490000
   SCAN BTTY WHILE BLANK,1;  <<SKIP OVER LEADING BLANKS>>               03495000
   ASSEMBLE(DUP,DUP);                                                   03500000
   MOVE * _ * WHILE AS,0;  <<SKIP AND UPSHIFT COMMAND>>                 03505000
   ASSEMBLE(STAX,DDUP; DEL,SUB);  <<COMMAND LENGTH>>                    03510000
   TOS _ TOS&LSL(8);                                                    03515000
   TOS _ @COMS;  <<COMMAND NAME LIST>>                                  03520000
   COMMANDNR _ KEYWORD(*,*);  <<COMMAND NR.>>                           03525000
   IF < THEN  <<ILLEGAL COMMAND?>>                                      03530000
      BEGIN                                                             03535000
      TOS := 10;                                                        03540000
      GO NFG                                                            03545000
      END;                                                              03550000
                                                                        03555000
   <<* * * LOCATE COMMAND PARAMETERS * * *>>                            03560000
                                                                        03565000
   ASSEMBLE(ZERO,LDXA);                                                 03570000
   TOS:=MYCOMMAND(*,DELIMITERS,23,NRPARMS,DESCRIP(1));         <<04101>>03575000
   IF > THEN GO ERR1;  <<TOO MANY PARAMETERS?>>                         03580000
                                                                        03585000
   <<* * * INTERPRET COMMAND AND PARAMETERS * * *>>                     03590000
                                                                        03595000
   GO * COMSWITCH(COMMANDNR);                                           03600000
                                                                        03605000
   <<ADDRL>>                                                            03610000
                                                                        03615000
   ADDRL:                                                               03620000
   IF NRPARMS <> 1 THEN GO ERR1;                                        03625000
   GETXIDENT(DESCRIP1,STRING1,NUM1);                                    03630000
   IF < THEN GO BADPARM1;                                      <<02818>>03635000
   GO BOUGHTIT;                                                         03640000
                                                                        03645000
   <<ADDSL>>                                                            03650000
                                                                        03655000
   ADDSL:                                                               03660000
   NUM6 := -1;  <<DO NOT APPEND A PATCH AREA>>                 <<00629>>03665000
   IF NRPARMS < 1 THEN GO ERR1;                                <<04102>>03670000
   GETIDENT(DESCRIP1,STRING2);                                 <<04102>>03675000
   IF < THEN GO BADPARM1;                                      <<04102>>03680000
   FPMAPSPECIFIED:=0;                                          <<04102>>03685000
   FOR I:=2 UNTIL NRPARMS DO                                   <<04102>>03690000
      BEGIN                                                    <<04102>>03695000
         CHECKSPECIAL(I,ALPHANUM);                             <<04285>>03700000
         TOS:=0;                                               <<04102>>03705000
         TOS:=DESCRIP(I);                                      <<04102>>03710000
         TOS:=@ADDSLPARMS;                                     <<04102>>03715000
         TOS:=KEYWORD(*,*);                                    <<04102>>03720000
         IF < THEN GO NFGPARM;                                 <<04102>>03725000
         XREG:=TOS;                                            <<04102>>03730000
         CASE * XREG OF                                        <<04102>>03735000
            BEGIN                                              <<04102>>03740000
                                                               <<04102>>03745000
               << PMAP     >>                                  <<04102>>03750000
                                                               <<04102>>03755000
               BEGIN                                           <<04102>>03760000
                  I:=I-1;                                      <<04102>>03765000
                  IF NOT (DELIMITER' = COMMA' LOR              <<04102>>03770000
                          DELIMITER' = SEMICOLON') THEN        <<04102>>03775000
                     BEGIN                                     <<04102>>03780000
                        ERRORNR:=18;                           <<04102>>03785000
                        GO TO NFG1;                            <<04102>>03790000
                     END;                                      <<04102>>03795000
                  I:=I+1;                                      <<04102>>03800000
                  NUM3.(15:1):=1;                              <<04102>>03805000
               END;                                            <<04102>>03810000
                                                               <<04102>>03815000
               << NOSYM   >>                                   <<04102>>03820000
                                                               <<04102>>03825000
               BEGIN                                           <<04102>>03830000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04102>>03835000
                  NUM3.(9:1):=1;                               <<04102>>03840000
               END;                                            <<04102>>03845000
                                                               <<04102>>03850000
               << FPMAP >>                                     <<04102>>03855000
                                                               <<04102>>03860000
               BEGIN                                           <<04102>>03865000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04102>>03870000
                  IF FPMAPSPECIFIED THEN                       <<04102>>03875000
                     GO NFGPARM                                <<04102>>03880000
                  ELSE                                         <<04102>>03885000
                     BEGIN                                     <<04102>>03890000
                        NUM3.(8:1):=1;                         <<04102>>03895000
                        FPMAPSPECIFIED:=1;                     <<04102>>03900000
                     END;                                      <<04102>>03905000
               END;                                            <<04102>>03910000
                                                               <<04102>>03915000
               << NOFPMAP >>                                   <<04102>>03920000
                                                               <<04102>>03925000
               BEGIN                                           <<04102>>03930000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04102>>03935000
                  IF FPMAPSPECIFIED THEN                       <<04102>>03940000
                     GO NFGPARM                                <<04102>>03945000
                  ELSE                                         <<04102>>03950000
                     BEGIN                                     <<04102>>03955000
                        NUM3.(7:1):=1;                         <<04102>>03960000
                        FPMAPSPECIFIED:=1;                     <<04102>>03965000
                     END;                                      <<04102>>03970000
               END;                                            <<04102>>03975000
                                                               <<04259>>03980000
               << CHECKSUM >>                                  <<04259>>03985000
                                                               <<04259>>03990000
               BEGIN                                           <<04259>>03995000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04259>>04000000
                  NUM3.(6:1):=1;                               <<04259>>04005000
               END;                                            <<04259>>04010000
                                                               <<04259>>04015000
               << PATCH >>                                     <<04259>>04020000
                                                               <<04259>>04025000
               BEGIN                                           <<04259>>04030000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04259>>04035000
                  GETNUM(NUM6);                                <<04259>>04040000
               END;                                            <<04259>>04045000
                                                               <<04259>>04050000
               << CORE RESIDENT >>                             <<04586>>04055000
                                                               <<04586>>04060000
               BEGIN                                           <<04586>>04065000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04586>>04070000
                  IF RUNNER <> MITBUILD THEN GO NFGPARM;       <<04586>>04075000
                  NUM3.(1:1):=1;                               <<04586>>04080000
               END;                                            <<04586>>04085000
                                                               <<04586>>04090000
               << SYSTEM SEGMENT >>                            <<04586>>04095000
                                                               <<04586>>04100000
               BEGIN                                           <<04586>>04105000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04586>>04110000
                  IF RUNNER <> MITBUILD THEN GO NFGPARM;       <<04586>>04115000
                  NUM3.(2:1):=1;                               <<04586>>04120000
               END;                                            <<04586>>04125000
                                                               <<04586>>04130000
               << PERMANENT ALLOCATED SEGMENT >>               <<04586>>04135000
                                                               <<04586>>04140000
               BEGIN                                           <<04586>>04145000
                  CHECKDELIMITER(SEMICOLON',I-1);              <<04586>>04150000
                  IF RUNNER <> MITBUILD THEN GO NFGPARM;       <<04586>>04155000
                  NUM3.(0:1):=1;                               <<04586>>04160000
               END;                                            <<04586>>04165000
                                                               <<04586>>04170000
            END;  << CASE >>                                   <<04102>>04175000
      END; << FOR LOOP >>                                      <<04102>>04180000
   GO BOUGHTIT;                                                <<04102>>04185000
                                                                        04190000
   <<AUXUSL>>                                                           04195000
                                                                        04200000
   AUXUSL:                                                              04205000
   IF NRPARMS <> 1 THEN GO ERR1;                                        04210000
   CHECKSPECIAL(1,FILENAME);                                   <<04285>>04215000
   GETFILENAME(DESCRIP1,FNAME1);                                        04220000
   IF < THEN GO BADPARM1;                                               04225000
   GO BOUGHTIT;                                                         04230000
                                                                        04235000
   <<BUILDRL>>                                                          04240000
                                                                        04245000
   BUILDRL:                                                             04250000
   IF NRPARMS <> 3 THEN GO ERR1;                                        04255000
   CHECKSPECIAL(1,FILENAME);                                   <<04285>>04260000
   CHECKDELIMITER(COMMA',1);                                   <<04101>>04265000
   CHECKDELIMITER(COMMA',2);                                   <<04101>>04270000
   GETFILENAME(DESCRIP1,FNAME1);                                        04275000
   IF < THEN GO BADPARM1;                                               04280000
   NUM1 _ BINARY(PARM2,INTEGER(LEN2));                                  04285000
   IF <> THEN GO BADPARM2;  <<ERROR?>>                                  04290000
   NUM2 _ BINARY(PARM3,INTEGER(LEN3));                                  04295000
   IF <> THEN GO BADPARM3;  <<ERROR?>>                                  04300000
   GO BOUGHTIT;                                                         04305000
                                                                        04310000
   <<BUILDSL>>                                                          04315000
                                                                        04320000
   COMMENT SEE BUILDRL;                                                 04325000
                                                                        04330000
   <<BUILDUSL>>                                                         04335000
                                                                        04340000
   COMMENT SEE BUILDRL;                                                 04345000
                                                                        04350000
   <<CEASE>>                                                            04355000
                                                                        04360000
   CEASE:                                                               04365000
   NUM3 _ 8;  <<DEFAULT = ENTRY>>                                       04370000
   CEASE2:                                                              04375000
   IF NRPARMS = 1 THEN                                                  04380000
      BEGIN                                                             04385000
      CEASE1:                                                           04390000
      GETXIDENT(DESCRIP(NRPARMS),STRING1,NUM1);                         04395000
      IF < THEN GO * BADPARM(NRPARMS);                                  04400000
      CHECKSPECIAL(NRPARMS,SEGNAME); << RBM NAME HAS THE   >>  <<04285>>04405000
                                     << SAME FORMAT AS SEG >>  <<04285>>04410000
      GO BOUGHTIT                                                       04415000
      END;                                                              04420000
   IF NRPARMS = 2 THEN                                                  04425000
      BEGIN                                                             04430000
      CHECKSPECIAL(1,ALPHANUM);                                <<04285>>04435000
      CHECKDELIMITER(COMMA',1);                                <<04101>>04440000
      GETCLASS(DESCRIP1,NUM3);                                          04445000
      IF < THEN GO BADPARM1;                                            04450000
      GO CEASE1                                                         04455000
      END;                                                              04460000
   GO ERR1;                                                             04465000
                                                               <<00207>>04470000
   <<CLEANSL>>                                                 <<00207>>04475000
   CLEANSL:                                                    <<00207>>04480000
   IF NRPARMS > 1 THEN GO ERR1;                                <<00629>>04485000
   IF NRPARMS=1 THEN                                           <<00207>>04490000
     BEGIN                                                     <<00207>>04495000
       GETFILENAME(DESCRIP1,FNAME1);                           <<00207>>04500000
       IF < THEN GO TO BADPARM1;                               <<00207>>04505000
     END;                                                      <<00207>>04510000
   GO TO BOUGHTIT;                                             <<00629>>04515000
                                                               <<00207>>04520000
                                                               <<00207>>04525000
   <<CLEANUSL>>                                                <<00207>>04530000
                                                               <<00207>>04535000
   COMMENT: SEE CLEANSL;                                       <<00207>>04540000
                                                               <<00207>>04545000
<<COPYSL>>                                                     <<00207>>04550000
                                                               <<00207>>04555000
  COMMENT: SEE COPYUSL;                                        <<00207>>04560000
                                                               <<00207>>04565000
                                                               <<00207>>04570000
   <<COPYUSL>>                                                 <<00207>>04575000
   COPYUSL:                                                    <<00207>>04580000
   IF NOT (1<=NRPARMS<=2) THEN GO TO ERR1;                     <<00207>>04585000
   NUM1:=BINARY(PARM1,INTEGER(LEN1));                          <<00207>>04590000
   IF <> THEN GO BADPARM1;                                     <<00207>>04595000
   IF NOT (0<=NUM1<=30000) THEN GO BADPARM1;                   <<00207>>04600000
   IF NRPARMS=2 THEN                                           <<00207>>04605000
     BEGIN                                                     <<00207>>04610000
       CHECKSPECIAL(2,FILENAME);                               <<04285>>04615000
         CHECKDELIMITER(COMMA',1);                             <<04101>>04620000
       GETFILENAME(DESCRIP(2),FNAME1);                         <<00207>>04625000
       IF < THEN GO TO BADPARM2;                               <<00207>>04630000
     END;                                                      <<00207>>04635000
   GO TO BOUGHTIT;                                             <<00207>>04640000
                                                               <<00207>>04645000
                                                                        04650000
   <<COPY>>                                                             04655000
                                                                        04660000
   COPY:                                                                04665000
   NUM3 _ %4;  <<DEFAULT = UNIT>>                                       04670000
   GO CEASE2;                                                           04675000
                                                                        04680000
   <<EXIT>>                                                             04685000
                                                                        04690000
   EXIT:                                                                04695000
   IF NRPARMS <> 0 THEN GO ERR1;                                        04700000
   GO BOUGHTIT;                                                         04705000
                                                                        04710000
   <<HIDE>>                                                             04715000
                                                                        04720000
   COMMENT SEE ADDRL;                                                   04725000
                                                                        04730000
   <<LISTRL>>                                                           04735000
                                                                        04740000
   LISTRL:                                                              04745000
   IF NRPARMS <> 0 THEN GO ERR1;                                        04750000
   NUM3.(15:1) _ 1;  <<TURN ON LIST BIT>>                               04755000
   GO BOUGHTIT;                                                         04760000
                                                                        04765000
   <<LISTSL>>                                                           04770000
                                                                        04775000
LISTSL:                                                        <<00207>>04780000
   IF NRPARMS >1 THEN GO ERR1;                                 <<00207>>04785000
   NUM3.(15:1):=1;  <<TURN ON LIST>>                           <<00592>>04790000
   IF NRPARMS=1 THEN                                           <<00207>>04795000
     BEGIN                                                     <<00207>>04800000
       GETFILENAME(DESCRIP1,FNAME1);                           <<00592>>04805000
       IF < THEN GO TO BADPARM1;                               <<00207>>04810000
     END;                                                      <<00207>>04815000
   GO BOUGHTIT;                                                <<00592>>04820000
                                                                        04825000
<<LISTAUX>>                                                    <<03025>>04830000
                                                               <<03025>>04835000
COMMENT SEE LISTUSL;                                           <<03025>>04840000
                                                               <<03025>>04845000
   <<LISTUSL>>                                                          04850000
                                                                        04855000
LISTUSL:                                                       <<00592>>04860000
   IF NRPARMS > 1 THEN GO ERR1;                                <<00592>>04865000
   NUM3.(15:1):=1;  <<TURN LIST ON>>                           <<00592>>04870000
   IF NRPARMS = 1 THEN                                         <<00592>>04875000
      BEGIN                                                    <<00592>>04880000
      GETIDENT(DESCRIP1,STRING2);                              <<00592>>04885000
      IF < THEN GO BADPARM1;                                   <<00592>>04890000
      END;                                                     <<00592>>04895000
   GO BOUGHTIT;                                                <<00592>>04900000
                                                                        04905000
   <<NEWSEG>>                                                           04910000
                                                                        04915000
   NEWSEG:                                                              04920000
   IF NRPARMS <> 2 THEN GO ERR1;                                        04925000
   CHECKSPECIAL(1,SEGNAME);                                    <<04285>>04930000
   CHECKDELIMITER(COMMA',1);                                   <<04101>>04935000
   GETIDENT(DESCRIP1,STRING2);                                          04940000
   IF < THEN GO BADPARM1;                                      <<02818>>04945000
   GO CEASE1;                                                           04950000
                                                                        04955000
   <<PREPARE>>                                                          04960000
                                                                        04965000
   PREPARE:                                                             04970000
   IF NRPARMS < 1 THEN GO ERR1;                                <<04101>>04975000
   CHECKSPECIAL(1,FILENAME);                                   <<04285>>04980000
   GETFILENAME(DESCRIP1,FNAME1);                                        04985000
   IF < THEN GO BADPARM1;                                               04990000
   TOS _ -1; ASSEMBLE(DUP,DDUP);                               <<00629>>04995000
   NUM1 _ TOS; NUM2 _ TOS; NUM4 _ TOS; NUM6 _ TOS;             <<00629>>05000000
   FPMAPSPECIFIED:=0;                                          <<04102>>05005000
   FOR I _ 2 UNTIL NRPARMS DO                                           05010000
      BEGIN                                                             05015000
      CHECKSPECIAL(I,ALPHANUM);                                <<04285>>05020000
      CHECKDELIMITER(SEMICOLON',I-1);                          <<04101>>05025000
      TOS _ SPECIFIED;                                                  05030000
      TOS _ 0; TOS _ DESCRIP(I); TOS _ @PREPPARMS;                      05035000
      TOS _ KEYWORD(*,*);                                               05040000
      IF < THEN                                                         05045000
         BEGIN                                                          05050000
         NFGPARM:                                                       05055000
         TOS _ I;                                                       05060000
         GO ERR2                                                        05065000
         END;                                                           05070000
      XREG := TOS;  <<PARM. NR.>>                                       05075000
      ASSEMBLE(TSBC 0,X);                                               05080000
      IF <> THEN GO NFGPARM;  <<RE-SPECIFIED PARAMETER?>>               05085000
      SPECIFIED := TOS;                                                 05090000
      CASE * XREG OF                                                    05095000
         BEGIN                                                          05100000
                                                                        05105000
         <<RL>>                                                         05110000
                                                                        05115000
         BEGIN                                                          05120000
         I _ I+1;                                                       05125000
         IF I > NRPARMS THEN                                   <<04101>>05130000
            BEGIN                                              <<04101>>05135000
               I:=I-1;                                         <<04101>>05140000
               GO TO NFGPARM;                                  <<04101>>05145000
            END;                                               <<04101>>05150000
         CHECKSPECIAL(I,FILENAME);                             <<04285>>05155000
         CHECKDELIMITER(EQUAL',I-1);                           <<04101>>05160000
         GETFILENAME(DESCRIP(I),FNAME2);                                05165000
         IF < THEN GO NFGPARM                                           05170000
         END;                                                           05175000
                                                                        05180000
         <<ZERODB>>                                                     05185000
                                                                        05190000
         NUM3.(14:1) _ 1;                                               05195000
                                                                        05200000
         <<PMAP>>                                                       05205000
                                                                        05210000
         NUM3.(15:1) _ 1;                                               05215000
                                                                        05220000
         <<MAXDATA>>                                                    05225000
                                                                        05230000
         GETNUM(NUM4);                                                  05235000
                                                                        05240000
         <<STACK>>                                                      05245000
                                                                        05250000
         GETNUM(NUM1);                                                  05255000
                                                                        05260000
         <<DL>>                                                         05265000
                                                                        05270000
         GETNUM(NUM2);                                                  05275000
                                                               <<00629>>05280000
         <<00629>>                                             <<00629>>05285000
                                                               <<00629>>05290000
         GETNUM(NUM6);                                         <<00629>>05295000
                                                               <<00629>>05300000
                                                                        05305000
         <<CAP>>                                                        05310000
                                                                        05315000
         BEGIN                                                          05320000
         TOS _ 0;  <<INIT. CAP. BIT MAP>>                               05325000
         IF I+1 > NRPARMS THEN GO NFGPARM;                     <<04101>>05330000
         CHECKDELIMITER(EQUAL',I);                             <<04101>>05335000
         NEXTCAP:                                                       05340000
         I _ I+1;                                                       05345000
         IF I > NRPARMS THEN GO PUTCAP;                                 05350000
         CHECKSPECIAL(I,ALPHANUM);                             <<04285>>05355000
         TOS _ 0; TOS _ DESCRIP(I); TOS _ @CAPS;                        05360000
         TOS _ KEYWORD(*,*);                                            05365000
         IF < THEN  <<ILLEGAL CAPABILITY>>                              05370000
            GO TO NFGPARM;                                     <<04101>>05375000
         XREG _ TOS;                                                    05380000
         ASSEMBLE(TSBC 0,X);  <<SET CAP. BIT>>                          05385000
         IF <> THEN GO NFGPARM;  <<RE-SPECIFIED CAPABILITY>>            05390000
         IF DELIMITER' = SEMICOLON' OR                         <<04101>>05395000
            DELIMITER' = CR'                                   <<04101>>05400000
            THEN GO TO PUTCAP;                                 <<04101>>05405000
         CHECKDELIMITER(COMMA',I);                             <<04101>>05410000
         GO NEXTCAP;                                                    05415000
         PUTCAP:                                                        05420000
         NUM5 _ TOS&LSR(6)  <<STORE CAP. BIT MAP>>                      05425000
         END;                                                  <<00207>>05430000
                                                               <<00207>>05435000
         << NOSYM >>                                           <<04102>>05440000
                                                               <<00207>>05445000
         NUM3.(9:1):=1;                                        <<00207>>05450000
                                                               <<00207>>05455000
         << FPMAP >>                                           <<04102>>05460000
                                                               <<04102>>05465000
         IF FPMAPSPECIFIED THEN GO NFGPARM                     <<04102>>05470000
         ELSE BEGIN                                            <<04102>>05475000
                 FPMAPSPECIFIED:=1;                            <<04102>>05480000
                 NUM3.(8:1):=1;                                <<04102>>05485000
              END;                                             <<04102>>05490000
                                                               <<04102>>05495000
         << NOFPMAP >>                                         <<04102>>05500000
                                                               <<04102>>05505000
         IF FPMAPSPECIFIED THEN GO NFGPARM                     <<04102>>05510000
         ELSE BEGIN                                            <<04102>>05515000
                 FPMAPSPECIFIED:=1;                            <<04102>>05520000
                 NUM3.(7:1):=1;                                <<04102>>05525000
              END;                                             <<04102>>05530000
                                                               <<04259>>05535000
         << CHECKSUM >>                                        <<04259>>05540000
                                                               <<04259>>05545000
         NUM3.(6:1):=1;                                        <<04259>>05550000
                                                               <<04102>>05555000
         END                                                            05560000
      END;                                                              05565000
   GO BOUGHTIT;                                                         05570000
                                                                        05575000
   <<PURGERBM>>                                                         05580000
                                                                        05585000
   COMMENT SEE COPY;                                                    05590000
                                                                        05595000
   <<PURGERL>>                                                          05600000
                                                                        05605000
   PURGERL:                                                             05610000
   NUM3 _ 8;  <<DEFAULT = ENTRY>>                                       05615000
   IF NRPARMS = 1 THEN                                                  05620000
      BEGIN                                                             05625000
      PURGERL1:                                                         05630000
      CHECKSPECIAL(NRPARMS,SEGNAME);                                    05635000
      GETIDENT(DESCRIP(NRPARMS),STRING1);                               05640000
      IF < THEN GO * BADPARM(NRPARMS);                         <<02818>>05645000
      GO BOUGHTIT                                                       05650000
      END;                                                              05655000
   IF NRPARMS = 2 THEN                                                  05660000
      BEGIN                                                             05665000
      CHECKSPECIAL(1,ALPHANUM);                                <<04295>>05670000
      CHECKDELIMITER(COMMA',1);                                <<04101>>05675000
      GETCLASS(DESCRIP1,NUM3);                                          05680000
      IF < THEN GO BADPARM1;                                            05685000
      GO PURGERL1                                                       05690000
      END;                                                              05695000
   GO ERR1;                                                             05700000
                                                                        05705000
   <<PURGESL>>                                                          05710000
                                                                        05715000
   COMMENT SEE PURGERL;                                                 05720000
                                                                        05725000
                                                               <<00207>>05730000
   <<PURGEUSL>>                                                <<00207>>05735000
                                                               <<00207>>05740000
   COMMENT: SEE PURGERL;                                       <<00207>>05745000
                                                               <<00207>>05750000
   <<REVEAL>>                                                           05755000
                                                                        05760000
   COMMENT SEE ADDRL;                                                   05765000
                                                                        05770000
   <<RL>>                                                               05775000
                                                                        05780000
   COMMENT SEE AUXUSL;                                                  05785000
                                                                        05790000
   <<SL>>                                                               05795000
                                                                        05800000
   COMMENT SEE AUXUSL;                                                  05805000
                                                                        05810000
   <<USE>>                                                              05815000
                                                                        05820000
   COMMENT SEE CEASE;                                                   05825000
                                                                        05830000
   <<USL>>                                                              05835000
                                                                        05840000
   COMMENT SEE AUXUSL;                                                  05845000
                                                                        05850000
   <<SHOW>>                                                    <<04585>>05855000
                                                               <<04585>>05860000
   SHOW:                                                       <<04585>>05865000
   IF NRPARMS <> 0 THEN GO ERR1;                               <<04585>>05870000
   NUM3.(15:1) := 1;                                           <<04585>>05875000
   GO BOUGHTIT;                                                <<04585>>05880000
                                                               <<04585>>05885000
   <<LISTPMAP>>                                                <<04585>>05890000
                                                               <<04585>>05895000
   LISTPMAP:                                                   <<04585>>05900000
   IF NRPARMS > 2 OR NRPARMS < 1 THEN GO ERR1;                 <<04585>>05905000
   CHECKSPECIAL(1,FILENAME);                                   <<04585>>05910000
   GETFILENAME(DESCRIP1,FNAME1);                               <<04585>>05915000
   IF NRPARMS = 2 THEN                                         <<04585>>05920000
      BEGIN                                                    <<04585>>05925000
         CHECKDELIMITER(SEMICOLON',1);                         <<04585>>05930000
         CHECKSPECIAL(2,SEGNAME);                              <<04585>>05935000
         GETFILENAME(DESCRIP2,FNAME2);                         <<04585>>05940000
      END;                                                     <<04585>>05945000
   NUM3.(15:1) := 1;                                           <<04585>>05950000
   GO BOUGHTIT;                                                <<04585>>05955000
                                                               <<04585>>05960000
   <<SETFPMAP>>                                                <<04585>>05965000
                                                               <<04585>>05970000
   SETFPMAP:                                                   <<04585>>05975000
   IF NRPARMS > 3 THEN GO ERR1;                                <<04585>>05980000
   SYSSPECIFIED:=0;                                            <<04585>>05985000
   SYSSESSIONSPECIFIED:=0;                                     <<04585>>05990000
   CONDPARMSPECIFIED:=0;                                       <<04585>>05995000
   ONOFFSPECIFIED:=0;                                          <<04585>>06000000
   FOR I:=1 UNTIL NRPARMS DO                                   <<04585>>06005000
      BEGIN                                                    <<04585>>06010000
         CHECKSPECIAL(I,ALPHANUM);                             <<04585>>06015000
         IF I < NRPARMS THEN CHECKDELIMITER(SEMICOLON',1);     <<04585>>06020000
         TOS:=0;                                               <<04585>>06025000
         TOS:=DESCRIP(I);                                      <<04585>>06030000
         TOS:=@SETFPMAPPARMS;                                  <<04585>>06035000
         TOS:=KEYWORD(*,*);                                    <<04585>>06040000
         IF < THEN GO NFGPARM;                                 <<04585>>06045000
         XREG:=TOS;                                            <<04585>>06050000
         CASE * XREG OF                                        <<04585>>06055000
            BEGIN                                              <<04585>>06060000
                                                               <<04585>>06065000
               <<SYSTEM>>                                      <<04585>>06070000
                                                               <<04585>>06075000
               BEGIN                                           <<04585>>06080000
                  IF SYSSESSIONSPECIFIED THEN                  <<04585>>06085000
                     GO NFGPARM;                               <<04585>>06090000
                  SYSSESSIONSPECIFIED:=1;                      <<04585>>06095000
                  SYSSPECIFIED :=1;                            <<04585>>06100000
                  NUM1:=1;                                     <<04585>>06105000
               END;                                            <<04585>>06110000
                                                               <<04585>>06115000
               <<SESSION>>                                     <<04585>>06120000
                                                               <<04585>>06125000
               BEGIN                                           <<04585>>06130000
                   IF SYSSESSIONSPECIFIED THEN                 <<04585>>06135000
                      GO NFGPARM;                              <<04585>>06140000
                   SYSSESSIONSPECIFIED:=1;                     <<04585>>06145000
               END;                                            <<04585>>06150000
                                                               <<04585>>06155000
               <<CONDITION>>                                   <<04585>>06160000
                                                               <<04585>>06165000
               BEGIN                                           <<04585>>06170000
                  IF CONDPARMSPECIFIED OR NOT SYSSPECIFIED THEN<<04585>>06175000
                      GO NFGPARM;                              <<04585>>06180000
                   CONDPARMSPECIFIED:=1;                       <<04585>>06185000
               END;                                            <<04585>>06190000
                                                               <<04585>>06195000
               <<UNCONDITION>>                                 <<04585>>06200000
                                                               <<04585>>06205000
               BEGIN                                           <<04585>>06210000
                  IF CONDPARMSPECIFIED OR NOT SYSSPECIFIED THEN<<04585>>06215000
                     GO NFGPARM;                               <<04585>>06220000
                  CONDPARMSPECIFIED:=1;                        <<04585>>06225000
                  NUM2 := 1;                                   <<04585>>06230000
               END;                                            <<04585>>06235000
                                                               <<04585>>06240000
               <<ON>>                                          <<04585>>06245000
                                                               <<04585>>06250000
               BEGIN                                           <<04585>>06255000
                  IF ONOFFSPECIFIED THEN                       <<04585>>06260000
                     GO NFGPARM;                               <<04585>>06265000
                  ONOFFSPECIFIED:=1;                           <<04585>>06270000
               END;                                            <<04585>>06275000
                                                               <<04585>>06280000
               <<OFF>>                                         <<04585>>06285000
                                                               <<04585>>06290000
               BEGIN                                           <<04585>>06295000
                  IF ONOFFSPECIFIED THEN                       <<04585>>06300000
                     GO NFGPARM;                               <<04585>>06305000
                  ONOFFSPECIFIED := 1;                         <<04585>>06310000
                  NUM4:=1;                                     <<04585>>06315000
               END;                                            <<04585>>06320000
            END;                                               <<04585>>06325000
         END;                                                  <<04585>>06330000
   GO BOUGHTIT;                                                <<04585>>06335000
                                                               <<04585>>06340000
   <<DEBUG>>                                                            06345000
                                                                        06350000
   DEBUG':                                                              06355000
   IF NRPARMS <> 0 THEN GO ERR1;                                        06360000
   IF PRIVUSER THEN DEBUG                                               06365000
   ELSE                                                                 06370000
      BEGIN                                                             06375000
      TOS:= ERR'PRIVUSER;                                               06380000
      GO NFG;                                                           06385000
      END;                                                              06390000
                                                                        06395000
   BOUGHTIT:                                                            06400000
   TOS := CCE;  <<OK CONDITION CODE>>                                   06405000
   GO GETOUT;                                                           06410000
                                                                        06415000
   ERR1: TOS := 11; GO NFG;  <<ILLEGAL NR. PARM'S>>                     06420000
                                                                        06425000
   BADPARM3: BADPARMNR := BADPARMNR+1;  <<ILLEGAL THIRD PARAMETER>>     06430000
   BADPARM2: BADPARMNR := BADPARMNR+1;  <<ILLEGAL SECOND PARAMETER>>    06435000
   BADPARM1: BADPARMNR := BADPARMNR+1;  <<ILLEGAL FIRST PARAMETER>>     06440000
   TOS := BADPARMNR;  <<PARM. NR.>>                                     06445000
                                                                        06450000
   ERR2: NERRORPARM := TOS; TOS := 12;  <<ILLEGAL PARAMETER>>           06455000
                                                                        06460000
   NFG:                                                                 06465000
   ERRORNR := TOS;  <<ERROR NR.>>                                       06470000
   NFG1:                                                       <<04101>>06475000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                06480000
                                                                        06485000
   GETOUT:                                                              06490000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            06495000
   END;                                                                 06500000
$PAGE "PRINTERROR"                                             <<00207>>06505000
PROCEDURE PRINTERROR;                                                   06510000
   <<PRINTS AN ERROR MESSAGE ON THE JOB LIST DEVICE>>                   06515000
   BEGIN                                                                06520000
   XREG := ERRORNR;  <<ERROR NR.>>                                      06525000
   IF (2 <= XREG <=6) OR (10 <= XREG <= 18) THEN               <<04101>>06530000
      BEGIN                                                             06535000
      MOVE BTTY _ "*** ERROR *** ",2;                                   06540000
      IF NERRORPARM <> -1 THEN  <<NUMERIC PARAMETER?>>                  06545000
         BEGIN                                                          06550000
         TOS _ ASCII(NERRORPARM,10,BPS0);                               06555000
         TOS _ TOS+TOS                                                  06560000
         END;                                                           06565000
      PRINT(TTY,@BTTY-S0,0);  <<PRINT ERROR AND PARAMETER>>             06570000
      TOS _ @MESS;                                                      06575000
      WHILE INTEGER(BPS0) <> ERRORNR DO                                 06580000
         BEGIN                                                          06585000
         TOS _ TOS+1;                                                   06590000
         TOS _ TOS+BPS0;                                                06595000
         TOS _ TOS+1                                                    06600000
         END;                                                           06605000
      TOS _ @BTTY;                                                      06610000
      ASSEMBLE(XCH,INCA);                                               06615000
      TOS _ BPS0;                                                       06620000
      ASSEMBLE(INCB);                                                   06625000
      MOVE * _ *,(TOS),2;                                               06630000
      PRINT(TTY,@BTTY-S0,0)  <<PRINT MESSAGE>>                          06635000
      END;                                                              06640000
   XREG := XREG-1;  <<FOR XREG = 1 TEST>>                               06645000
   IF <> AND NOT INTERACTIVE THEN  <<SET ABORT BIT?>>                   06650000
      BEGIN                                                             06655000
      TOS := GETJCW;                                                    06660000
      TOS.(0:1) := 1;  <<SET ABORT BIT>>                                06665000
      SETJCW(*)                                                         06670000
      END                                                               06675000
   END;                                                                 06680000
$PAGE "OUTER BLOCK"                                            <<00207>>06685000
<<* * * INITIALIZE GLOBAL PARAMETERS * * *>>                            06690000
                                                                        06695000
TOS := 0;                                                               06700000
TOS := 0D;                                                              06705000
WHO(S0,DS2);                                                            06710000
DUPLICATIVE := S0.(14:1);  <<DUPLICATIVE BIT>>                          06715000
INTERACTIVE := TOS;  <<INTERACTIVE BIT>>                                06720000
PRIVUSER := TOS.(9:1); DEL;                                             06725000
INHIBITFILEEQ := NOT PARM.(14:1);  <<INHIBIT FILE EQUATION BIT>>        06730000
RUNNER:=PARM;                                                  <<04586>>06735000
PRINT(MSG1,-59,0);  <<"SEGMENTER SUBSYSTEM">>                           06740000
IF < THEN  <<ERROR?>>                                                   06745000
   BEGIN                                                                06750000
   ERRORNR := 16;  <<ERROR NR.>>                                        06755000
   GO PRINTIT                                                           06760000
   END;                                                                 06765000
                                                                        06770000
OB:                                                                     06775000
READCOMMAND;  <<PARSE COMMAND LINE>>                                    06780000
IF < THEN  <<SYNTAX ERROR?>>                                            06785000
   BEGIN                                                                06790000
   PRINTIT:                                                             06795000
   PRINTERROR;  <<PRINT ERROR MESSAGE>>                                 06800000
   GO OB  <<NEXT COMMAND>>                                              06805000
   END;                                                                 06810000
SEGMENTER(PIN,COMMANDNR,ERRORNR,NUM1,NUM2,NUM3,NUM4,NUM5,               06815000
   NUM6,STRING1,STRING2,FNAME1,FNAME2); <<SEND COMMAND>>       <<00629>>06820000
IF > THEN  <<NON-FATAL ERROR?>>                                         06825000
   BEGIN                                                                06830000
   GO PRINTIT                                                           06835000
   END;                                                                 06840000
IF < THEN  <<FATAL ERROR?>>                                             06845000
   BEGIN                                                                06850000
   PRINTERROR;  <<PRINT ERROR MESSAGE>>                                 06855000
   GO FINISHED                                                          06860000
   END;                                                                 06865000
IF COMMANDNR = 8 THEN GO FINISHED;  <<EXIT COMMAND?>>                   06870000
GO OB;  <<NEXT COMMAND>>                                                06875000
                                                                        06880000
FINISHED:                                                               06885000
end.                                                           <<02821>>06890000
