<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>      <<06989>>00005000
$CONTROL NOWARN                                                <<06989>>00010000
$CONTROL MAP,CODE,USLINIT                                               00015000
<<            IOCDPN0                  >>                               00020000
<< HP32002C MPE SOURCE C.00.00 >>                                       00025000
<<COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1976. ",           >>00030000
<<     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",     >>00035000
<<     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",   >>00040000
<<     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ">>00045000
<<     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ", >>00050000
<<     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.">>00055000
  << IOTEST    APR 26,1978   ,  MODULE XX   >>                          00060000
$TITLE " APRIL 26,1978 IO TEST PROGRAM"                                 00065000
$CONTROL PRIVILEGED, MAIN  = IOTEST                                     00070000
$THIRTY                                                                 00075000
BEGIN    << IO TEST PROGRAM, T. ELLESTAD >>                             00080000
COMMENT                                                        <<04830>>00085000
                                                                        00090000
                                                                        00095000
                                                                        00100000
                                                                        00105000
                                                                        00110000
  OP                FUNCTION                 PARAMETER      DEFAULT     00115000
                                                                        00120000
   A     FILL BUFFER WITH ASCII STRING       ASCII STRING   ")" TO "Z"  00125000
   ANOTE PRINT STRING ON LIST DEVICE         ASCII STRING   NULL STRING 00130000
   B     FILL BUFFER WITH PARAMETER          PARAM,COUNT     0, ALL     00135000
   C     SET COUNT PARAMETER TO ATTACHIO        COUNT           0       00140000
   CH    CHECK RESULTS OF UNBLOCKED I/O                                 00145000
   CIO   DO CIO INSTRUCTION                  CONTROL WORD     ERROR     00150000
   CL    CLEAR PROGRAM AREA                   FIRST,LAST       ALL      00155000
   CM    CLEAR MONITORING TABLE                                         00160000
   CMP   COMPARE TWO BUFFERS                  BUF1,BUF2   0    <<04830>>00165000
   D     DISPLAY ATTACHIO PARAMETERS                                    00170000
   DA    DISPLAY BUFFER IN ASCII            OFFSET,COUNT     0, XLOG    00175000
   DB    DISPLAY BUFFER IN OCTAL            OFFSET,COUNT     0, XLOG    00180000
   DE    CALL DEBUG                                                     00185000
   DEC   CONVERT PARAM TO DECIMAL              PARAM          ERROR     00190000
   DD    DISPLAY DIT                        OFFSET,COUNT       ALL      00195000
   DDRQ  DISPLAY DISC REQUESTS                TYPE, LDEV  0,1  <<04830>>00200000
   DIOQ  DISPLAY THE IO QUEUES                TYPE, LDEV  0,1  <<04830>>00205000
   DMON  DISPLAY THE SYSTEM MONITOR TABLE                      <<04830>>00210000
   DO    GET CMNDS AND/OR PROG FROM A FILE    FILE NAME                 00215000
   DQ    DISPLAY IOQS                       NUMBER OF IOQS     ALL      00220000
   DS    DISPLAY LAST STATUS AND XLOG                                   00225000
   DRT   SET DRT NUMBER                         DRT#          ERROR     00230000
   DSIO  DISPLAY SIO AREA                   OFFSET,COUNT       ALL      00235000
   E     EXECUTE ATTACHIO CALL N TIMES     EXECUTION COUNT      1       00240000
   EX    TERMINATE PROGRAM                                              00245000
   F     SET FUNCTION PARAMETER TO ATTACHIO  FUNCTION CODE      0       00250000
   FB    FREE BUFFER SPECIFIED                BUF NUMBER  ERROR<<04830>>00255000
   FL    SET FLAGS PARAMETER TO ATTACHIO        FLAGS           1       00260000
   GO    GOTO STATEMENT NUMBER               STATEMENT #  1ST STATEMENT 00265000
   H     CALL HELP                                                      00270000
   I     INCREMENTAL FILL OF BUFFER          INCREMENT          1       00275000
   L     SET LOGICAL DEVICE NUMBER             LDEV           ERROR     00280000
   LD    SET OPTION LIST DEVICE             SEE BELOW        $STDLIST   00285000
         0=$STDLIST, 1=FORMAL DESIGNATOR LIST, 2+=ATTACHIO LDEV         00290000
   LI    LIST PROGRAM                         FIRST,LAST       ALL      00295000
   M     MONITOR TERMINAL ACTIVITY         MONITORING CODE      0       00300000
   MB    MODIFY BUFFER                      OFFSET, COUNT     ERROR     00305000
   MD    MODIFY DIT                         OFFSET, COUNT     ERROR     00310000
   MQ    MODIFY FIRST IOQ                   OFFSET, COUNT     ERROR     00315000
   N     NULL INPUT EXECUTES 1 ATTACHIO       0/1 (OFF/ON)      1       00320000
   O     CONVERT PARAM TO OCTAL                PARAM          ERROR     00325000
   P     PRINT TERMINAL ACTIVITY TABLE     NUMBER OF ENTRIES   ALL      00330000
   PA    SET P1 PARAMETER TO ATTACHIO            P1             0       00335000
   PB    SET P2 PARAMETER TO ATTACHIO            P2             0       00340000
   Q     SET QMISC PARAMETER TO ATTACHIO       QMISC            0       00345000
   R     RUN PROGRAM N TIMES                   RUN COUNT        1       00350000
   RUN   CREATE AND RUN A PROGRAM           PROGRAM FILE NAME           00355000
   RIO   DO RIO INSTRUCTION                                             00360000
   SH    PRINT DO AND PROGRAM STATEMENTS       0/1 (OFF/ON)     1       00365000
   T     PRINT AVERAGE TIME FOR LAST ATTACHIO CALLS                     00370000
   TIO   DO TIO INSTRUCTION                                             00375000
   UB    ACQUIRE BUFFER SPECIFIED             BUF NUMBER      0<<04830>>00380000
   V     PUT RECORD NUMBER IN BUFFER           0/1 (OFF/ON)     1       00385000
   WIO   DO WIO INSTRUCTION                   WRITE DATA      ERROR     00390000
   X     EXPLAIN COMMANDS                                               00395000
                                                                        00400000
                                                                        00405000
                                                                        00410000
                                                                        00415000
                                                                        00420000
                                                                        00425000
                                                                        00430000
                                                                        00435000
   C?   -   INPUT A COMMAND                                             00440000
                                                                        00445000
   FORMAT OF COMMANDS:                                                  00450000
                                                                        00455000
      OP [ [ = ] PARAMETER [ , PARAMETER ] ]                            00460000
                                                                        00465000
  COMMANDS MAY BE ONE OR MORE LETTERS. THE OP'S ARE LISTED ABOVE WITH   00470000
  THE NUMBER OF CHARACTERS REQUIRED TO UNIQUELY SPECIFY THE COMMAND.    00475000
  COMMAND COMMENTS MAY BE ENCLOSED IN BRACKETS AS IN SPL. MORE THAN ONE 00480000
  COMMAND MAY BE INPUT AT A TIME BY SEPERATING THEM WITH SEMICOLONS.    00485000
                                                                        00490000
  PARAMETER MAY BE NULL, A NUMBER( % FOR OCTAL ) OR 1 TO 2 NON QUOTE    00495000
  CHARACTERS WITHIN QUOTES. THE ASCII AND ANOTE PARAMETER MAY BE NULL   00500000
  OR A STRING WITHIN QUOTES. IF A 2ND PARAMETER IS SPECIFIED, POSITIVE  00505000
  INDICATES WORDS AND NEGATIVE INDICATES BYTES. NO 2ND PARAMETER DEFAULT00510000
  IS 1. PARAMETERS ARE DELIMITED BY A COMMA OR CARRIAGE RETURN.         00515000
  NOTE, THERE IS NO DEFAULT USE OF OCTAL NUMBERS!                       00520000
                                                                        00525000
  SYNTAX OF PARAMETERS -                                                00530000
                                                                        00535000
    EXPRESSION ::= TERM ! TERM + TERM ! TERM - TERM ! - TERM            00540000
    TERM       ::= FACTOR ! FACTOR * FACTOR ! FACTOR / FACTOR           00545000
    FACTOR     ::= CONSTANT ! ( EXPRESSION )                            00550000
    CONSTANT   ::= NUMBER ! "CHAR" ! "CHARCHAR"                         00555000
                                                                        00560000
  COMMANDS OR A PROGRAM MAY BE GOTTEN FROM AN EDITOR FILE USING THE     00565000
  DO COMMAND. WHEN THE DO COMMAND IS EXECUTED, COMMANDS AND PROGRAM     00570000
  STATEMENTS IN THE EDITOR FILE SPECIFIED ARE EXECUTED AS IF THE HAD    00575000
  BEEN ENTERED ON THE INPUT DEVICE.                                     00580000
                                                                        00585000
  PROGRAMS MAY BE WRITtEN TO EXECUTE A SEQUENCE OF COMMANDS, MUCH AS    00590000
  IF THEY WERE ENTERED BY THE OPERATOR.  PROGRAM STATEMENTS ARE         00595000
  DISTINGUISHED BY BEGINING WITH A STATEMENT NUMBER. THE STATEMENTS ARE 00600000
  EXECUTED IN ORDER OF STATEMENT NUMBER WHEN THE PROGRAM IS RUN.        00605000
  A STATEMENT MAY BE REPLACE BY ENTERING THE REPLACEMENT STATEMENT      00610000
  WITH THE STATEMENT TO BE REPLACED NUMBER. A STATEMENT MAY BE DELETED  00615000
  BY ENTERING THE STATEMENT NUMBER WITH NO STATEMENT. THE STORED PROGRAM00620000
  IS RUN FROM THE BEGINNING N TIMES USING THE "R" COMMAND. THE          00625000
  PROGRAM MAY BE CLEARED AND LISTED WITH THE "CL" AND "LI" COMMANDS.    00630000
                                                                        00635000
  4100 WORD READ/WRITE BUFFER.                                          00640000
  UP TO 50 SAVED IOQ INDEXES FOR UNBLOCKED I/O                          00645000
                                                                        00650000
  IF THE SBUF FLAG IS SET THEN SBUFS ARE GOTTEN AND THE I/O IS DONE TO  00655000
  OR FROM THEM. SBUF I/O CAN ONLY BE DONE WITH WAIT CODES 1 AND 3. NO   00660000
                                                                        00665000
  THE DRT NUMBER IS SET FROM SYSTEM TABLES USING THE LDEV SPECIFICATION 00670000
                                                                        00675000
  CONTROL Y CAUSES THIS PROGRAM TO ABORT REPEATED OPERATIONS SUCH AS    00680000
  PRINTING TABLES, EXECUTING THE ATTACHIO CALLS AND PROGRAM EXECUTION.  00685000
    **********MODIFICATION HISTORY**********                   <<04830>>00690000
    DATE 8/23/82                                               <<04830>>00695000
    MARIA GONZALEZ :    SUMMER SEED STUDENT                    <<04830>>00700000
    ASSISTED BY BILL O'SHAUGHNESSY AND DAVE CASSAFER           <<04830>>00705000
                                                               <<04830>>00710000
                                                               <<04830>>00715000
  UB    THE UB COMMAND ALLOWS THE USER TO HAVE 16 EXTRA DATA   <<04830>>00720000
        SEGMENTS WITH 32K WORD CAPABILITY EACH. MORE SPACE TO  <<04830>>00725000
        TEST IO IS ESSENTIAL. THE USER CAN CHOOSE A BUFFER BY  <<04830>>00730000
        INPUTING "UB" FOLLOWED BY A NUMBER FROM 1 TO 16.       <<04830>>00735000
        "UB0" WILL RETURN THE USER TO THE INTERNAL BUFFER. THE <<04830>>00740000
        COMMANDS "MB","A","F0","F1" AND OTHERS USED WITH THE   <<04830>>00745000
        INTERNAL BUFFER CANNOT BE USED FOR THE EXTRA DATA SEG- <<04830>>00750000
        MENTS AT THE MOMENT. MAYBE SOME MODIFICATION WILL BE   <<04830>>00755000
        MADE LATER. INSTEAD, THE USER MUST USE DEBUG "DE" TO   <<04830>>00760000
        SUCCEED WITH THESE FUNCTIONS.                          <<04830>>00765000
                                                               <<04830>>00770000
  FB    THE FB COMMAND FREES THE EXTRA DATA SEGMENTS SPECIFIED.<<04830>>00775000
        THE USER MAY RELEASE EXTRA DATA SEGMENTS WHEN THEY WILL<<04830>>00780000
        NO LONGER BE IN USE. TO AVOID SYSTEM FAILURE THE PRO-  <<04830>>00785000
        GRAM CHECKS FOR THE ATTEMPT TO RELEASE ANY DATA SEG-   <<04830>>00790000
        MENTS WHICH HAVEN'T BEEN ALLOCATED. THE USER CAN ALLO- <<04830>>00795000
        CATE BUFFERS WITH THE "UB" COMMAND.                    <<04830>>00800000
                                                               <<04830>>00805000
  CMP   THE CMP COMMAND COMPARES ANY TWO EXTRA DATA SEGMENTS   <<04830>>00810000
        SPECIFIED. THE INTERNAL BUFFER CANNOT BE COMPARED.     <<04830>>00815000
        THE USER MUST INPUT THE COMMAND FOLLOWED BY TWO        <<04830>>00820000
        BUFFERS FROM 1-16. IF THE USER TRIES TO COMPARE A      <<04830>>00825000
        BUFFER WHICH HAS NOT BEEN ALLOCATED, AN ERROR MESSAGE  <<04830>>00830000
        WILL BE PRINTED. IF TWO BUFFERS ARE EQUAL, A MESSAGE   <<04830>>00835000
        WILL BE RETURNED SAYING SO. IF NOT, THE BYTE THAT DID  <<04830>>00840000
        NOT COMPARE WILL BE DISPLAYED.                         <<04830>>00845000
                                                               <<04830>>00850000
  DMON  DISPLAY THE MONITOR TABLE                              <<04830>>00855000
                                                               <<04830>>00860000
  DIOQ  THE DIOQ COMMAND DISPLAYS THE IOQ'S. THERE ARE THREE   <<04830>>00865000
        TYPES OF IOQ'S THAT CAN BE DISPLAYED: THE WHOLE IOQ    <<04830>>00870000
        LIST, THE FREE LIST AND THE LIST OF IOQ'S IN USE.      <<04830>>00875000
        INDICATE WHICH IOQ TO DISPLAY BY TYPING 0,1 OR 2       <<04830>>00880000
        RESPECTIVELY. THE USER CAN CHOOSE TO DISPLAY THE IOQ'S <<04830>>00885000
        FOR A SPECIFIC DEVICE. 0 REFERS TO ALL THE DEVICES.    <<04830>>00890000
        TO DISPLAY THE IOQ'S, INPUT "DIOQ" FOLLOWED BY A NUMBER<<04830>>00895000
        FOR THE TYPE OF IOQ DESIRED AND ANOTHER NUMBER FOR     <<04830>>00900000
        THE DEVICE.                                            <<04830>>00905000
                                                               <<04830>>00910000
  DDRQ  THE DDRQ COMMAND DISPLAYS THE DISC REQUEST TABLE.      <<04830>>00915000
        SIMILAR TO THE DIOQ COMMAND, THREE TYPES OF DRQ'S      <<04830>>00920000
        CAN BE DISPLAYED: THE WHOLE LIST, THE FREE LIST        <<04830>>00925000
        AND THE DRQ'S IN USE. INDICATE WHICH TYPE OF DRQ       <<04830>>00930000
        BY TYPING 0,1 OR 2 RESPECTIVELY. DRQ'S CAN BE          <<04830>>00935000
        DISPLAYED FOR A SPECIFIC DEVICE. 0 REFERS TO ALL       <<04830>>00940000
        DEVICES. TO DISPLAY DRQ'S INPUT "DDRQ" FOLLOWED        <<04830>>00945000
        BY A NUMBER FOR THE TYPE OF DRQ DESIRED AND            <<04830>>00950000
        ANOTHER NUMBER FOR THE DEVICE.                         <<04830>>00955000
                                                               <<04830>>00960000
$PAGE                                                                   00965000
                                                                        00970000
                                                                        00975000
  USER'S I/O BUFFER FUNCTIONS:                                          00980000
  ----------------------------                                          00985000
                                                                        00990000
  OP          PARAMETER          DEFAULT          EXAMPLE               00995000
                                                                        01000000
                                                                        01005000
  A           ASCII STRING       ")" TO "Z"       A"SOME TEXT"          01010000
                                                                        01015000
  FUNCTION:  FILL THE BUFFER WITH AN ASCII STRING. BUFFER               01020000
             REFERS TO A USER'S I/O BUFFER DECLARED WITHIN              01025000
             THIS PROGRAM. MAXIMUM SIZE IS 4100 WORDS. IF               01030000
             I/O IS PENDING, A PENDING MESSAGE WILL BE                  01035000
             PRINTED. NO PARAMETER INPUT DEFAULT TO THE                 01040000
             ENTIRE BUFFER FILLED WITH )*+,-./0123456789                01045000
             :,<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ REPETITIVELY.   <<04830>>01050000
                                                                        01055000
                                                                        01060000
  B           PARAM,COUNT        0,ALL            B0,128                01065000
                                                                        01070000
  FUNCTION:  FILL THE BUFFER WITH THE PARAMETER INPUT FOR               01075000
             THE SPECIFIED COUNT. IF NO COUNT SPECIFIED,                01080000
             ALL 4100 WORDS OF THE BUFFER WILL BE FILLED.               01085000
             NO PARAMETER RESULT IN ENTIRE BUFFER FILLED                01090000
             WITH ZEROS. IF I/O IS PENDING, A PENDING                   01095000
             MESSAGE WILL BE PRINTED.                                   01100000
                                                                        01105000
  CMP         BUF1,BUF2         0                CMP1,4        <<04830>>01110000
  FUNCTION:  COMPARES ANY TWO BUFFERS SPECIFIED WITH THE       <<04830>>01115000
             EXCEPTION OF THE INTERNAL BUFFER. IF THE BUFFERS  <<04830>>01120000
             ARE EQUAL A MESSAGE WILL APPEAR SAYING SO.        <<04830>>01125000
             IF NOT, THE BYTE THAT FAILED TO COMPARE WILL      <<04830>>01130000
             BE DISPLAYED. BUFFERS ARE NUMBERED FROM 1-16.     <<04830>>01135000
             0 REFERS TO BUFFER INTERNAL TO IOCDPN0 STACK.     <<04830>>01140000
                                                               <<04830>>01145000
                                                                        01150000
  DA          OFFSET,COUNT       0,XLOG           DA0,20                01155000
                                                                        01160000
  FUNCTION:  DISPLAY THE BUFFER IN ASCII FROM A GIVEN                   01165000
             OFFSET FOR A LENGTH OF COUNT. NO LENGTH                    01170000
             SPECIFIED RESULT IN THE LENGTH OF THE LAST                 01175000
             TRANSMISSION (XLOG) COUNT DISPLAYED.                       01180000
                                                                        01185000
                                                                        01190000
  DB          OFFSET,COUNT       0,XLOG           DB8,3                 01195000
                                                                        01200000
  FUNCTION:  DISPLAY THE BUFFER IN OCTAL WORDS FROM A                   01205000
             GIVEN OFFSET FOR A LENGTH OF COUNT. NO LENGTH              01210000
             SPECIFIED RESULT IN THE LENGTH OF THE LAST                 01215000
             TRANSMISSION (XLOG) COUNT DISPLAYED.                       01220000
                                                               <<04830>>01225000
                                                               <<04830>>01230000
  FB          PARAMETER            ERROR          FB10         <<04830>>01235000
  FUNCTION:  RELEASES AN EXTRA DATA SEGMENT SPECIFIED.         <<04830>>01240000
             EXTRA DATA SEGMENTS AVAILABLE ARE NUMBERED        <<04830>>01245000
             1-16. 0 REFERS TO THE BUFFER INTERNAL TO          <<04830>>01250000
             THE IOCDPN0 STACK.                                <<04830>>01255000
                                                               <<04830>>01260000
                                                                        01265000
                                                                        01270000
  I           INCREMENT          1                I2                    01275000
                                                                        01280000
  FUNCTION:  THE USER'S I/O BUFFER WILL BE FILLED RECUR-                01285000
             SIVELY AS FOLLOWS:  B(N)=B(N-1)+INCREMENT                  01290000
             WHERE N GOES FROM (1-4100) TO ACCOMMODATE                  01295000
             THE ENTIRE BUFFER.                                         01300000
                                                                        01305000
                                                                        01310000
  MB          OFFSET,COUNT       ERROR            MB7,1                 01315000
                                                                        01320000
  FUNCTION:  MODIFY THE USER'S I/O BUFFER FROM A GIVEN                  01325000
             OFFSET FOR A LENGTH OF COUNT. THE LOCATION                 01330000
             OF EACH CONSECUTIVE WORDS FOR MODIFICATION                 01335000
             WILL BE PROMPTED UNTIL SPECIFIED COUNT EXPIRES.            01340000
             ON PROMPTS FOR MODIFICATION, A <CR> DENOTES                01345000
             NO CHANGES MADE.                                           01350000
                                                                        01355000
                                                               <<04830>>01360000
                                                               <<04830>>01365000
  UB          PARAMETER           0              UB12          <<04830>>01370000
  FUNCTION:  ACQUIRES EXTRA DATA SEGMENT SPECIFIED. EXTRA      <<04830>>01375000
             DATA SEGMENTS AVAILABLE ARE NUMBERED 1-16.        <<04830>>01380000
             0 REFERS TO THE IOCDPN0 INTERNAL STACK.           <<04830>>01385000
             THE INTERNAL STACK ALLOWS YOU TO HAVE A MAX-      <<04830>>01390000
             IMUM SIZE OF 8196 WORDS. THE EXTRA DATA SEGMENTS  <<04830>>01395000
             ALLOW YOU TO HAVE 32000. THE COMMAND "MB" CANNOT  <<04830>>01400000
             BE USED FOR THE EXTRA DATA SEGMENTS. IF YOU NEED  <<04830>>01405000
             TO MAKE ANY CORRECTIONS USE DEBUG "DE".           <<04830>>01410000
             NOTE THAT ALL THE BUFFERS ARE RETURNED UPON  EXIT.<<04830>>01415000
                                                                        01420000
                                                                        01425000
  I/O TABLE RELATED FUNCTIONS:                                          01430000
  ----------------------------                                          01435000
                                                                        01440000
  OP          PARAMETER          DEFAULT          EXAMPLE               01445000
                                                                        01450000
                                                                        01455000
  DD          OFFSET,COUNT       ALL              DD                    01460000
                                                                        01465000
  FUNCTION:  DISPLAY THE DEVICE INFORMATION TABLE (DIT) FOR             01470000
             THE LDEV. CAN DISPLAY DIT FROM A GIVEN OFFSET              01475000
             FOR A LENGTH OF COUNT OR DISPLAY ENTIRE DIT                01480000
             WITH NO PARAMETER SPECIFIED. LDEV IS SET BY                01485000
             COMMAND "L LDEV#".                                         01490000
                                                                        01495000
                                                               <<04830>>01500000
                                                               <<04830>>01505000
  DMON                                                         <<04830>>01510000
  FUNCTION:  DISPLAY THE SYSTEM MONITOR TABLE                  <<04830>>01515000
                                                               <<04830>>01520000
                                                               <<04830>>01525000
                                                               <<04830>>01530000
                                                               <<04830>>01535000
  DIOQ        PARAMETER,LDEV#      0,1             DIOQL 0,12  <<04830>>01540000
             BE DISPLAY THE IOQ TABLE. THREE TYPES OF IOQ'S CAN<<04830>>01545000
             DISPLAYED. THERE IS A CHOICE OF THE WHOLE LIST,   <<04830>>01550000
             THE FREE LIST AND THE ACTIVE LIST. THEY CAN BE    <<04830>>01555000
             SPECIFIED BY THE NUMBERS 0,1 OR 2 RESPECTIVELY.   <<04830>>01560000
             YOU CAN DISPLAY THE IOQ'S FOR A SPECIFIC DEVICE.  <<04830>>01565000
             IF YOU WANT ALL THE DEVICES, TYPE 0 FOR LDEV#.    <<04830>>01570000
                                                               <<04830>>01575000
                                                               <<04830>>01580000
                                                               <<04830>>01585000
  DDRQ        PARAMETER,LDEV#      0,1             DDRQ 0,12   <<04830>>01590000
             DISPLAY THE DRQ TABLE. THREE TYPES OF DRQ'S CAN BE<<04830>>01595000
             DISPLAYED. THERE IS A CHOICE OF THE WHOLE LIST,   <<04830>>01600000
             THE FREE LIST AND THE ACTIVE LIST. THEY CAN BE    <<04830>>01605000
             SPECIFIED BY THE NUMBERS 0,1 OR 2 RESPECTIVELY.   <<04830>>01610000
             YOU CAN DISPLAY THE DRQ'S FOR A SPECIFIC LDEV.    <<04830>>01615000
             IF YOU WANT ALL THE DEVICES, TYPE 0 FOR LDEV#.    <<04830>>01620000
                                                               <<04830>>01625000
                                                               <<04830>>01630000
                                                               <<04830>>01635000
  DQ          NO.OF IOQS         ALL              DQ                    01640000
                                                                        01645000
  FUNCTION:  DISPLAY THE I/O QUEUE ELEMENT (IOQ) UP TO THE              01650000
             NUMBER OF IOQ ENTRIES ENTERED. NO PARAMETER                01655000
             DISPLAY ALL IOQ ENTRIES CURRENTLY PENDING.                 01660000
                                                                        01665000
                                                                        01670000
  DSIO        OFFSET,COUNT       ALL              DSIO                  01675000
                                                                        01680000
  FUNCTION:  DISPLAY THE SIO OR CHANNEL PROGRAM FOR THE                 01685000
             LDEV STARTING AT A GIVEN OFFSET FOR A LENGTH               01690000
             OF COUNT. NO PARAMETERS DISPLAY THE ENTIRE SIO             01695000
             OR CHANNEL PROGRAM.                                        01700000
                                                                        01705000
                                                                        01710000
  MD          OFFSET,COUNT       ERROR            MD3,1                 01715000
                                                                        01720000
  FUNCTION:  MODIFY THE DIT TABLE STARTING AT A GIVEN                   01725000
             OFFSET FOR A LENGTH OF COUNT. THE DIT IS THE               01730000
             ONE ASSOCIATED WITH LDEV, SET BY THE COMMAND               01735000
             "L LDEV#".                                                 01740000
                                                                        01745000
                                                                        01750000
  MQ          OFFSET,ERROR       ERROR            MQ0,3                 01755000
                                                                        01760000
  FUNCTION:  MODIFY THE FIRST IOQ ENTRY STARTING AT A GIVEN             01765000
             OFFSET FOR A LENGTH OF COUNT. THE IOQ ENTRY                01770000
             IS THE ONE ASSOCIATED WITH LDEV, SET BY THE                01775000
             COMMAND "L LDEV#".                                         01780000
                                                                        01785000
                                                                        01790000
                                                                        01795000
  ATTACHIO PARAMETERS FUNCTIONS:                                        01800000
  ------------------------------                                        01805000
                                                                        01810000
  OP          PARAMETER          DEFAULT          EXAMPLE               01815000
                                                                        01820000
                                                                        01825000
  D                                               D                     01830000
                                                                        01835000
  FUNCTION:  DISPLAY THE PARAMETERS SET UP FOR THE ATTACHIO             01840000
             CALL. THE PROCEDURE IS AS SHOWN:                           01845000
                                                                        01850000
   PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,FUNC,CNT,P1,P2,FLAGS)             01855000
                                                                        01860000
   IOCDPNO EQUIVALENCES:                                                01865000
                                                                        01870000
    L  -->  LDEV                                                        01875000
    Q  -->  QMISC                                                       01880000
    F  -->  FUNC                                                        01885000
    C  -->  CNT                                                         01890000
    PA -->  P1                                                          01895000
    PB -->  P2                                                          01900000
    FL -->  FLAGS                                                       01905000
                                                                        01910000
                                                                        01915000
  C           COUNT              0                C128                  01920000
                                                                        01925000
  FUNCTION:  SET THE COUNT IN THE ATTACHIO PARAMETER. NOTE              01930000
             THAT USER'S I/O BUFFER IS 4100 WORDS MAXIMUM.              01935000
                                                                        01940000
                                                                        01945000
  F           FUNCTION CODE      0                F2                    01950000
                                                                        01955000
  FUNCTION:  SET THE FUNCTION CODE IN THE ATTACHIO PARA-                01960000
             METER. GENERAL FUNCTION CODES ARE AS SHOWN:                01965000
                                                                        01970000
             0 -- READ                                                  01975000
             1 -- WRITE                                                 01980000
             2 -- OPEN FILE                                             01985000
             3 -- CLOSE FILE                                            01990000
             4 -- CLOSE DEVICE                                          01995000
            >5 -- DEVICE DEPENDENT                                      02000000
                                                                        02005000
                                                                        02010000
  FL          FLAGS              1                FL%11                 02015000
                                                                        02020000
  FUNCTION:  SET THE FLAG WORD IN THE ATTACHIO PARAMETER.               02025000
                                                                        02030000
             FLAGWORD (12:1) -- SYSTEM BUFFER FLAG                      02035000
                      (13:3) -- REQUEST TYPE (0-7)                      02040000
                                [1=BLOCKED,REST=UNBLOCKED]              02045000
                                                                        02050000
                                                                        02055000
  L           LDEV               ERROR            L7                    02060000
                                                                        02065000
  FUNCTION:  SET LOGICAL DEV# IN THE ATTACHIO PARAMETER.                02070000
                                                                        02075000
                                                                        02080000
  PA          P1                 0                PA1                   02085000
                                                                        02090000
                                                                        02095000
  FUNCTION:  SET P1 IN THE ATTACHIO PARAMETER, WHERE P1                 02100000
             IS DEVICE DEPENDENT.                                       02105000
                                                                        02110000
                                                                        02115000
  PB          P2                 0                PB%22                 02120000
                                                                        02125000
  FUNCTION:  SET P2 IN THE ATTACHIO PARAMETER, WHERE P2                 02130000
             IS DEVICE DEPENDENT.                                       02135000
                                                                        02140000
                                                                        02145000
  Q           QMISC              0                Q1                    02150000
                                                                        02155000
  FUNCTION:  SET QMISC IN THE ATTACHIO PARAMETER, WHERE                 02160000
             QMISC IS DEVICE DEPENDENT.                                 02165000
                                                                        02170000
                                                                        02175000
                                                                        02180000
  ATTACHIO EXECUTION RELATED FUNCTIONS:                                 02185000
  ------------------------------------                                  02190000
                                                                        02195000
  OP          PARAMETER          DEFAULT          EXAMPLE               02200000
                                                                        02205000
                                                                        02210000
  E           EXECUTION COUNT    1                E5                    02215000
                                                                        02220000
  FUNCTION:  EXECUTES THE ATTACHIO CALL FOR THE COUNT                   02225000
             SPECIFIED. NO COUNT SPECIFED, EXECUTION DONE               02230000
             ONCE ONLY.                                                 02235000
                                                                        02240000
                                                                        02245000
  CH                                              CH                    02250000
                                                                        02255000
  FUNCTION:  CHECK RESULTS OF UNBLOCKED I/O. CHECK IF ANY               02260000
             I/O PENDING. IF ANY I/O PENDING, A PENDING                 02265000
             MESSAGE WILL BE PRINTED. IF ANY ERRORS, STATUS             02270000
             WILL BE PRINTED.                                           02275000
                                                                        02280000
                                                                        02285000
  DS                                              DS                    02290000
                                                                        02295000
  FUNCTION:  DISPLAY LAST STATUS AND LOG RESULTING FROM                 02300000
             THE ATTACHIO CALL. IF ANY I/O PENDING, A                   02305000
             PENDING MESSAGE WILL BE PRINTED.                           02310000
                                                                        02315000
                                                                        02320000
  N           0/1 (OFF/ON)       0                N1                    02325000
                                                                        02330000
                                                                        02335000
  FUNCTION:  NULL INPUT FLAG SET EXECUTES ONE ATTACHIO                  02340000
             CALL IF A NULL INPUT IS ENCOUNTERED.                       02345000
                                                                        02350000
                                                                        02355000
  T                                               T                     02360000
                                                                        02365000
  FUNCTION:  DISPLAY THE AVERAGE EXECUTION TIME IN THE                  02370000
             LAST ATTACHIO CALL. BY AVERAGE, IT IS MEANT                02375000
             AN AVERAGE IS TAKEN IF EXECUTION DONE MORE                 02380000
             THAN ONCE. (IE. E20)                                       02385000
                                                                        02390000
                                                                        02395000
  V           0/1 (OFF/ON)       0                V1                    02400000
                                                                        02405000
  FUNCTION:  PRIOR TO EXECUTING ATTACHIO CALL, VFLAG SET                02410000
             PLACES THE EXECUTION COUNT INTO THE FIRST                  02415000
             WORD OF THE USER'S I/O BUFFER. ON AN ATTACHIO              02420000
             WRITE OF 5 RECORDS, ONE WOULD SEE THE NUMBER               02425000
             5 ON THE FIRST WORD OF THE FIFTH RECORD WHEN               02430000
             READ BACK.                                                 02435000
                                                                        02440000
                                                                        02445000
                                                                        02450000
  STORED PROGRAM, DO FILE RELATED FUNCTIONS:                            02455000
  ------------------------------------------                            02460000
                                                                        02465000
       A MAXIMUM OF 500 WORDS ARE ALLOCATED WITHIN THIS                 02470000
    PROGRAM FOR STORING COMMANDS IN WHICH THE USER WANTS                02475000
    TO SAVE FOR LATER EXECUTION. THIS IS CALLED THE STORED              02480000
    PROGRAM. WHEN A STATEMENT# PRECEDING A COMMAND IS                   02485000
    ENTERED, THE LINE IS STORED INTO THE PROGRAM AREA.                  02490000
    EXAMPLE LINES ARE AS SHOWN:                                         02495000
                                                                        02500000
       10 L7                                                            02505000
       20 F0                                                            02510000
       30 C128                                                          02515000
       40 E20                                                           02520000
                                                                        02525000
   THE STATEMENT NUMBER WITH STATEMENT ARE SEQUENTIALLY                 02530000
   INSERTED INTO THE PROGRAM AREA. STATEMENT ENTERED WITH               02535000
   SAME STATEMENT# ALREADY IN PROGRAM AREA WILL REPLACE                 02540000
   THE PREVIOUS STATEMENT. A STATEMENT# ENTERED WITH NO                 02545000
   STATEMENT WILL DELETE AN EXISTING STATEMENT IN THE                   02550000
   PROGRAM AREA.                                                        02555000
                                                                        02560000
                                                                        02565000
  OP          PARAMETER          DEFAULT          EXAMPLE               02570000
                                                                        02575000
                                                                        02580000
  CL          FIRST,LAST         ALL              CL20,40               02585000
                                                                        02590000
  FUNCTION:  CLEAR THE STORED PROGRAM STARTING FROM THE                 02595000
             FIRST STATEMENT# TO THE LAST STATEMENT#                    02600000
             ENTERED. IF NO PARAMETER, CLEAR THE ENTIRE                 02605000
             PROGRAM AREA.                                              02610000
                                                                        02615000
                                                                        02620000
  GO          STATEMENT#         1ST STATEMENT#   GO30                  02625000
                                                                        02630000
  FUNCTION:  BEGIN EXECUTING STORED PROGRAM STARTING AT                 02635000
             THE STATEMENT# ENTERED.                                    02640000
                                                                        02645000
                                                                        02650000
  LI          FIRST,LAST         ALL              LI10,50               02655000
                                                                        02660000
  FUNCTION:  LIST THE STORED PROGRAM STARTING FROM THE                  02665000
             FIRST STATEMENT# TO THE LAST STATEMENT#                    02670000
             ENTERED. IF NO PARAMETER, THE ENTIRE STORED                02675000
             PROGRAM IS LISTED.                                         02680000
                                                                        02685000
                                                                        02690000
  R           RUN COUNT          1                R5                    02695000
                                                                        02700000
  FUNCTION:  EXECUTE THE STORED PROGRAM FOR THE NUMBER OF               02705000
             TIMES SPECIFIED IN THE COUNT.                              02710000
                                                                        02715000
                                                                        02720000
  DO          FILENAME                                                  02725000
                                                                        02730000
  FUNCTION:  GET COMMANDS AND/OR PROGRAM FROM A DO FILE.                02735000
             COMMANDS GOTTEN ARE EXECUTED IMMEDIATELY AND               02740000
             PROGRAM STATEMENTS ENCOUNTERED ARE STORED                  02745000
             INTO THE PROGRAM AREA. DO FILE CAN BE SEEN                 02750000
             AS A PSEUDO BATCH TYPE OPERATION.                          02755000
             [NOTE:  COMMANDS OR STORED PROGRAM (STATE-                 02760000
             MENT# PRECEDING COMMANDS) CAN BE ENTERED                   02765000
             INTO A FILE UNDER THE 3000 EDITOR. SUCH A                  02770000
             FILE IS REFERRED BY IOCDPN0 AS A DO FILE.]                 02775000
                                                                        02780000
                                                                        02785000
  SH          0/1 (OFF/ON)       1                SH1                   02790000
                                                                        02795000
  FUNCTION:  WITH SHOW FLAG SET, EACH COMMAND (PROGRAM                  02800000
             STATEMENT) GOTTEN FROM A STORED PROGRAM OR                 02805000
             A DO FILE ARE PRINTED ON THE $STDLIST.                     02810000
                                                                        02815000
                                                                        02820000
                                                                        02825000
  UTILITY FUNCTIONS:                                                    02830000
  ------------------                                                    02835000
                                                                        02840000
  OP          PARAMETER          DEFAULT          EXAMPLE               02845000
                                                                        02850000
                                                                        02855000
  DE                                              DE                    02860000
                                                                        02865000
  FUNCTION:  ENTER INTO THE MPE FACILITY DEBUG.                         02870000
                                                                        02875000
                                                                        02880000
  H                                               H                     02885000
                                                                        02890000
  FUNCTION:  ENTER INTO MPE LOW LEVEL SYSTEM DEBUGGER                   02895000
             CALLED HELP.                                               02900000
                                                                        02905000
                                                                        02910000
                                                                        02915000
  I/O INSTRUCTION FUNCTIONS:                                            02920000
  --------------------------                                            02925000
                                                                        02930000
  [IMPLEMENTED ON THE SERIES 2 & 3 ONLY]                                02935000
                                                                        02940000
  OP          PARAMETER          DEFAULT          EXAMPLE               02945000
                                                                        02950000
                                                                        02955000
  CIO         CONTROL WORD       ERROR            CIO%140000            02960000
                                                                        02965000
  FUNCTION:  PERFORM CONTROL I/O INSTRUCTION TO DEVICE                  02970000
             WITH THE INPUT CONTROL WORD.                               02975000
                                                                        02980000
                                                                        02985000
  RIO                                             RIO                   02990000
                                                                        02995000
  FUNCTION:  PERFORM READ I/O INSTRUCTION TO DEVICE. IF                 03000000
             DEVICE READY, DATA WORD PRINTED. IF DEVICE                 03005000
             NOT READY, DEVICE STATUS IS PRINTED.                       03010000
                                                                        03015000
                                                                        03020000
  TIO                                             TIO                   03025000
                                                                        03030000
  FUNCTION:  PERFORM TEST I/O INSTRUCTION TO OBTAIN THE                 03035000
             STATUS FROM THE DEVICE FOR PRINTING.                       03040000
                                                                        03045000
                                                                        03050000
  WIO         WRITE DATA         ERROR            WIO1                  03055000
                                                                        03060000
  FUNCTION:  PERFORM WRITE I/O INSTRUCTION WITH DATA WORD               03065000
             TO THE DEVICE. IF DEVICE READY, DATA WORD IS               03070000
             TRANSMITTED. IF DEVICE NOT READY, DEVICE                   03075000
             STATUS IS PRINTED.                                         03080000
                                                                        03085000
                                                                        03090000
                                                                        03095000
  TERMINAL MONITORING FUNCTIONS:                                        03100000
  ------------------------------                                        03105000
                                                                        03110000
  OP          PARAMETER          DEFAULT          EXAMPLE               03115000
                                                                        03120000
                                                                        03125000
  CM                                              CM                    03130000
                                                                        03135000
  FUNCTION:  CLEAR MONITORING AREA. USED IN CONJUNCTION                 03140000
             WITH COMMANDS "M" AND "P". SINCE MONITORING                03145000
             ENTRIES ARE KEPT IN A SYSTEM BUFFER, THIS                  03150000
             FUNCTION ZERO THIS SBUF AREA.                              03155000
                                                                        03160000
                                                                        03165000
  M           MCODE              0                M%22                  03170000
                                                                        03175000
  FUNCTION:  SET TERMINAL MONITORING CODE. IN A TERMINAL                03180000
             DIT IN WORD %41, THE LAST 6 BITS APPLIES TO                03185000
             MONITOR FUNCTION AND CONTROL CODE. THESE ARE               03190000
             SET ACCORDINGLY BY TH MCODE INPUT FOR MONI-                03195000
             TORING TERMINAL ACTIVITIES. USED IN CONJUN-                03200000
             CTION WITH COMMANDS "CM" AND "P".                          03205000
                                                                        03210000
  P           #ENTRIES           ALL              P                     03215000
                                                                        03220000
  FUNCTION:  PRINT TERMINAL MONITOR TABLE FOR NUMBER OF                 03225000
             ENTRIES SPECIFIED (0-32). NO PARAMETER                     03230000
             RESULT IN ALL ENTRIES PRINTED. ENTRIES WILL                03235000
             NOT EXIST OR BE PRINTED UNLESS THE MONITORING              03240000
             CODE WAS PREVIOUSLY SET. USED IN CONJUNCTION               03245000
             WITH COMMANDS "CM" AND "M".                                03250000
                                                                        03255000
                                                                        03260000
                                                                        03265000
  MISCELLANEOUS FUNCTIONS:                                              03270000
  ------------------------                                              03275000
                                                                        03280000
  OP          PARAMETER          DEFAULT          EXAMPLE               03285000
                                                                        03290000
                                                                        03295000
  AN                                              AN"HELLO"             03300000
                                                                        03305000
  FUNCTION:  DISPLAY THE ASCII STRING INPUT ON THE LIST                 03310000
             DEVICE.                                                    03315000
                                                                        03320000
                                                                        03325000
  LD          0,1,2+             $STDLIST         LD6                   03330000
                                                                        03335000
  FUNCTION:  REDIRECT THE LIST DEVICE TO THE $STDLIST,                  03340000
             A FORMAL DESIGNATOR LIST, OR ANY LIST DEVICE               03345000
             LDEV#.                                                     03350000
                                                                        03355000
                                                                        03360000
  DRT         DRT#               ERROR            DRT16                 03365000
                                                                        03370000
  FUNCTION:  ENTRY OF DRT# TO OVERRIDE DRT# PICKED UP BY                03375000
             COMMAND "L LDEV#" WHICH GOT ITS DRT# THRU                  03380000
             THE ILT TABLE. USED IN CONJUNCTION WITH THE                03385000
             I/O INSTRUCTION FUNCTIONS, ALLOW ACCESS TO                 03390000
             DEVICE WITH INACCESSIBLE DRT# (IE. CAN DO A                03395000
             CIO TO A TERMINAL'S TCI BOARD).                            03400000
                                                                        03405000
                                                                        03410000
  DEC         PARAM              ERROR            DEC%100               03415000
                                                                        03420000
  FUNCTION:  CONVERT THE INPUT PARAMETER TO BE REPRESENTED              03425000
             AS A DECIMAL VALUE.                                        03430000
                                                                        03435000
                                                                        03440000
  OCT         PARAM              ERROR            OCT200                03445000
                                                                        03450000
  FUNCTION:  CONVERT THE INPUT PARAMETER TO BE REPRESENTED              03455000
             AS AN OCTAL VALUE.                                         03460000
                                                                        03465000
                                                                        03470000
  X                                                                     03475000
                                                                        03480000
  FUNCTION:  LIST EXPLANATIONS OF ALL THE COMMANDS.                     03485000
                                                                        03490000
                                                                        03495000
  EX                                              EX                    03500000
                                                                        03505000
  FUNCTION:  TERMINATE PROGRAM AND EXIT.                                03510000
                                                                        03515000
                                                                        03520000
  <MPE COMMANDS>                                                        03525000
                                                                        03530000
  FUNCTION:  MPE COMMANDS ENTERED ARE PASSED TO THE COMMAND             03535000
             INTRINSIC FOR EXECUTION.                                   03540000
                                                                        03545000
                                                                        03550000
                                                                        03555000
                                                                        03560000
                                                                        03565000
$PAGE                                                                   03570000
;   <<END OF COMMENT>>                                         <<04830>>03575000
                                                                        03580000
$INCLUDE INCLIQH                                               <<06989>>03585000
$INCLUDE INCLIOQ                                               <<06989>>03590000
$INCLUDE INCLDQH                                               <<06989>>03595000
$INCLUDE INCLDRQ                                               <<06989>>03600000
$INCLUDE INCLLDT5                                              <<J8654>>03605000
  DEFINE                                                                03610000
    ASMB        = ASSEMBLE#,                                            03615000
    ABS         = ABSOLUTE#,                                            03620000
    EXITPROC    = ASMB( EXIT 0 )#,                                      03625000
    ENABLE      = ASMB( SED 1 )#,                                       03630000
    DISABLE     = ASMB( SED 0 )#,                                       03635000
    LINK        =1#,                                           <<04830>>03640000
    FLAGS       =0#,                                           <<04830>>03645000
    UNIT        =2).(0:8#,                                     <<04830>>03650000
    LDEVICE     =2).(8:8#,                                     <<04830>>03655000
    MISC        =3#,                                           <<04830>>03660000
    PCB         =10).(0:8#,                                    <<04830>>03665000
    DST         =4#,                                           <<04830>>03670000
    ADDR        =5#,                                           <<04830>>03675000
    FUNC        =6).(8:8#,                                     <<04830>>03680000
    XFERCNT     =7#,                                           <<04830>>03685000
    PARM1       =8#,                                           <<04830>>03690000
    PARM2       =9#,                                           <<04830>>03695000
    STAT        =10).(13:3#,                                   <<04830>>03700000
    TOTAL'ENTRIES=0).(0:8#,                                    <<04830>>03705000
    ENTRY'SIZE  =1).(8:8#,                                     <<04830>>03710000
    FREE'INDEX  =2#,                                           <<04830>>03715000
    QUALIFIER   =10).(8:5#,                                    <<04830>>03720000
    POSTSERIES3 = (THISCPU=2 OR THISCPU=4 OR THISCPU=5)#;      <<00798>>03725000
                                                                        03730000
$INCLUDE INCLVUF                                               <<04929>>03735000
                                                               <<04929>>03740000
ENTRY FILEEDIT;                                                <<06989>>03745000
  EQUATE                                                                03750000
    PROGMAX     = 500,                                                  03755000
    IOQ'HEADER'SIZE =8,                                        <<04830>>03760000
    DRQ'HEADER'SIZE =16,                                       <<04830>>03765000
    CR          = %15,                                                  03770000
    QUOTE      = %42;                                          <<04830>>03775000
                                                                        03780000
  INTEGER ARRAY B(0:8196);    <<I/O BUFFER>>                   <<04830>>03785000
  INTEGER POINTER LPDTP = %10;  << LPDT POINTER >>                      03790000
  POINTER IOQTABLE = 5;         << IOQ TABLE POINTER >>                 03795000
  POINTER SBUF     = 6;         << SYSTEM BUFFER TABLE POINTER >>       03800000
  INTEGER POINTER BP;           << ADDRESS OF BUFFER IN MOVEDATA >>     03805000
                                                                        03810000
  INTEGER                                                               03815000
    X = X,  S0 = S-0,                                                   03820000
    DITP, SIOP, IOQP, DITL, SIOL, DRTP,                                 03825000
    LIMIT := 8192,  << SET INITIAL BUFFER MAX. SIZE >>         <<04956>>03830000
    BUF'OFFSET:=0,  <<   OFFSET INTO BUFFER OF IO OPERATIONS >><<06989>>03835000
    I,          << GENERAL INDEX & ALSO NEXT INPUT CHARACTER POINTER >> 03840000
    LASTI,      << I WHEN CHAR WAS CALLED LAST = LAST CHAR FETCHED >>   03845000
    J,K,        << GENERAL INDEXES >>                                   03850000
    L,  << INPUT MESSAGE LENGTH >>                                      03855000
    N,                                                                  03860000
    R,  << PARAMETER INPUT >>                                           03865000
    R1,   << HOLDS SECOND PARAMETER ON INPUT >>                         03870000
    R2, R3,                                                             03875000
    T,  << TEMPORARY >>                                                 03880000
    E,         << EXECUTION COUNT >>                                    03885000
    PC,                  <<PROGRAM COUNTER>>                   <<04830>>03890000
    BUF'USED,            <<NUMBER OF BUFFER USED>>             <<04830>>03895000
    COUNT,               <<GENERAL COUNTER>>                   <<04830>>03900000
    NUMCHAR,    <<HOLDS LENGTH OF ASCII CONVERSION>>           <<04830>>03905000
    BUFF'ONE,    <<FIRST BUFFER TO COMPARE>>                   <<04830>>03910000
    BUFF'TWO,    <<SECOND BUFFER TO COMPARE>>                  <<04830>>03915000
    FREE'BUF,            <<NUMBER OF BUFFER TO FREE>>          <<04830>>03920000
    PROGRUN,   << NUMBER OF TIMES TO RUN PROGRAM >>                     03925000
    LASTLINE,  << STATEMENT NUMBER OF LAST STATEMENT PROCESSED >>       03930000
    W2, W3,    << WORDS 2 AND 3 OF MONITORING ENTRY >>                  03935000
    T1,        << TEMPORARY >>                                          03940000
    CA, CB, SB, CF, CC,  << DSET STATES, -1 OFF, 0 UNKNOWN, 1 ON >>     03945000
    WAKEIOQX,            << HOLDS IOQX OF LAST UNBLOCKED IO WITH WAKE >>03950000
    IN,                  << $STDIN FILE NUMBER >>                       03955000
    CYI,                 << INDEX FOR CONTROL Y PROCEDURE >>            03960000
    DF,        << DO FILE FILE NUMBER >>                                03965000
    FNL,       << DO FILE NAME LENGTH >>                                03970000
    SOURCE,      << COMMAND SOURCE; 0-$STDIN, 1-PROGRAM, 2-DO FILE >>   03975000
    MAX'XDS'SIZE,          <<MAXIMUM EXTRA DATA SIZE>>         <<04830>>03980000
    FLG := 1,  << WAIT TYPE OR FLAGS WORD >>                            03985000
    XDS'SIZE :=32152,       <<EXTRA DATA SEGMENT SIZE>>        <<04830>>03990000
    MAX'XDS'SIZE'ADR:=%1111,<<EXTRA DATA SEGMENT MAXIMUM SIZE>><<04830>>03995000
    PROGEND := 0,  << INDEX TO END OF CURRENT PROGRAM >>                04000000
    FN := 0,   << + THEN FILE #, - THEN OPT LIST DEV, 0 $STDLIST >>     04005000
    DRTFLG := 0,  << IF SET DENOTES USER'S DRT# ENTRY >>       <<00924>>04010000
    VFLAG := 0, << IF NOT ZERO THEN ADD EXECUTION NUMBER TO BUFFER >>   04015000
    NFLAG := 0, << IF NOT ZERO THEN NULL INPUT CAUSES 1 ATTACHIO CALL >>04020000
    SHOW  := 0, << IF NOT ZERO THEN PRINT DO AND PROGRAM STATEMENTS >>  04025000
    MORE  := 0, << LENGTH OF REMAINING MULTIPLE COMMAND STATEMENT >>    04030000
    IOPCNT := 0,      << # OF PENDING I/O'S >>                          04035000
    SBUFX := 0,       << SBUF LIST HEAD INDEX >>                        04040000
    STATUS := 0,      << HOLDS RETURN STATUS AND IOQ INDICIES >>        04045000
    LASTLDEV := 0,  XLOG := 0,   LASTFUNC := 0,                         04050000
    C := 0,    << COUNT >>                                              04055000
    D := 0,    << LOGICAL DEVICE NUMBER >>                              04060000
    DX := 0,   << DRT NUMBER FOR DIRECT IO >>                           04065000
    F := 0,    << FUNCTION >>                                           04070000
    P1:= 0,                                                             04075000
    P2:= 0,                                                             04080000
    Q := 0;   << QMISC >>                                               04085000
                                                                        04090000
  LOGICAL                                                               04095000
    LW3 = W3, LN = N,                                                   04100000
    EFLAG := 0, << IF SET ERROR OR END OF PROGRAM >>                    04105000
    NOMORE := 0,<< IF SET THEN END EXECUTION >>                         04110000
    CYFLAG := 0,<< SET WHEN CONTROL Y IS PRESSED >>                     04115000
    LDEV'IS'DISC := false,  << LDEV is disc flag >>            <<03120>>04120000
    PROGFLAG := 0,  << IF SET, THEN GETTING COMMANDS FROM PROG AREA >>  04125000
    SFLAG,      << STOP THIS LEVEL OF DOMAIN, DO EOF OR END OF PROG >>  04130000
    BFLAG ,     << IF SET MODIFY/PRINT FROM BUFFER B ELSE ABSOLUTE >>   04135000
    QUOTEFLAG,  << IF SET THEN INSIDE A QUOTED PARAMETER >>             04140000
    NOPARAM,    << IF SET COMMAND DID NOT HAVE A PARAMETER >>           04145000
    EXISTS, <<CHECKS IF BUFFER IS ALLOCATED BEFORE COMPARING>> <<04830>>04150000
    MSTART,       << POINTER TO CURRENT MONITOR ENTRY >>       <<04830>>04155000
    SNAPSHOT'DST,    <<SNAPSHOT STORED IN A DATA SEGMENT>>     <<04830>>04160000
    DEV'CHECK:=FALSE,   << DEVICE WILL BE PRINTED IN DECIMAL>> <<04830>>04165000
    TWOPARAMS,     <<IF SET COMMAND HAD TWO PARAMETERS >>      <<04830>>04170000
    ACTVBUF:=0,    <<USED AS A BITMAP TO MARK BUFFERS USED>>   <<04830>>04175000
    IOQ'POINTER, <<POINTS TO THE NEXT IOQ>>                    <<04830>>04180000
    DUP,        << DUPLICATIVE INPUT DEVICE IF SET >>          <<*7479>>04185000
    Q'ENTRY'INDEX,                                             <<*7479>>04190000
    DRQ'ENTRY'INDEX=Q'ENTRY'INDEX,                             <<*7479>>04195000
    IOQ'ENTRY'INDEX=Q'ENTRY'INDEX;                             <<*7479>>04200000
                                                                        04205000
DOUBLE                                                                  04210000
  TIME;  << START TIME OR ELAPSED TIME FOR ATTACHIO CALLS >>            04215000
                                                                        04220000
    LOGICAL ARRAY COMPARE'BUF1(0:127);    <<DUMMY ARRAYS>>     <<04830>>04225000
    LOGICAL ARRAY COMPARE'BUF2(0:127);                         <<04830>>04230000
    INTEGER ARRAY PROG(0:PROGMAX);      << HOLDS PROGRAM >>             04235000
      <<                                                                04240000
         STORED PROGRAM FORMAT -                                        04245000
         WORD 0  STATEMENT NUMBER IN BINARY                             04250000
         WORD 1  STATEMENT LENGTH IN BYTES                              04255000
         WORDS 2 THRU N STATEMENT IN ASCII                              04260000
                                                                        04265000
         NEXT STATEMENT IS FOUND BY ADDING STATEMENT (LENGTH+5)/2       04270000
         STATEMENTS ARE STORE IN ORDER OF STATEMENT NUMBER.  EACH       04275000
         STATEMENT OCCUPING A BLOCK AS DESCRIBED ABOVE.                 04280000
      >>                                                                04285000
    INTEGER ARRAY M(0:70);   <<OPERATOR MESSAGES BUFFER>>      <<04830>>04290000
    INTEGER ARRAY IOQX(0:159); <<OPERATOR INDEXES FOR >>       <<04830>>04295000
                                <<TYPE 0 OR 1 I/O>>            <<04830>>04300000
    INTEGER ARRAY PA(0:79);    <<INPUT PROMPT AND PRINTX>>     <<04830>>04305000
                                <<MESSAGES>>                   <<04830>>04310000
    INTEGER ARRAY DSET(*) = CA;                                         04315000
    INTEGER ARRAY WA0 (*) = DB + 0;                                     04320000
    INTEGER ARRAY LDT (*) = DB + 0;                            <<J8654>>04325000
    INTEGER LDT'INDEX;                                         <<J8654>>04330000
    INTEGER ARRAY DSTARRAY(1:16):= 16(0); <<HOLDS DST NUMBER>> <<04830>>04335000
                                                                        04340000
    ARRAY M1(0:24):="     IOCDPN0 (V.UU.FF) TYPE X FOR",       <<04929>>04345000
                      "COMMAND LIST";                          <<01273>>04350000
    BYTE ARRAY BM1(*)=M1;  << NEED TO MOVE VUF IN >>           <<04929>>04355000
    BYTE ARRAY PRINT'DATA(0:79);     <<HOLDS IOQ VALUES>>      <<04830>>04360000
                                                                        04365000
    BYTE ARRAY PRINT'LINE(0:79);   <<HOLDS HEADER FOR IOQ >>   <<04830>>04370000
    BYTE ARRAY DEV'NO(0:5);  << DEVICE FOR IOQ DISPLAY>>       <<04830>>04375000
    BYTE ARRAY B'CMP'BUF1(*)=COMPARE'BUF1; <<BYTE COMPARE>>    <<04830>>04380000
    BYTE ARRAY B'CMP'BUF2(*)=COMPARE'BUF2;                     <<04830>>04385000
    BYTE ARRAY BYTENUM(0:20);     <<ARRAY FOR EQUIVALENCING>>  <<04830>>04390000
    LOGICAL ARRAY LBYTENUM(*)=BYTENUM;                         <<04830>>04395000
    BYTE ARRAY BPROG(*)   = PROG;                                       04400000
    BYTE ARRAY BB(*) = B;                                               04405000
    BYTE ARRAY BM(*) = M;                                               04410000
    byte array bpa(*) = pa;                                             04415000
    BYTE ARRAY LBUF(0:79);   << USED BY TABLE FORMATTERS >>    <<04830>>04420000
    BYTE ARRAY SAVE(0:71);      << HOLDS REST OF MULTIPLE CMND LINE >>  04425000
    BYTE ARRAY FNAME(0:29) := " IN ";  << HOLDS DO FILE NAME >>         04430000
    BYTE ARRAY LINENO(0:11) := " AT "; << DO FILE CURRENT LINE NUMBER >>04435000
    BYTE ARRAY LA(0: 4) := "LIST ";                                     04440000
    BYTE ARRAY LP(0: 2) := "LP ";                                       04445000
    BYTE ARRAY TM(0: 3) := " BCC";                                      04450000
    BYTE ARRAY PL(0: 5) := " ?CSH";                                     04455000
    BYTE ARRAY DS(0:29) := "INIT  CLR SACLR CAHANGUPSET CA";            04460000
    BYTE ARRAY DSTATE(0:47) := "NULWRT RDXONTRNBWTELFECREORWWT",        04465000
                                         "DLFDCRRPTECHSRDFRD";          04470000
    BYTE ARRAY ID(0:32) := "TPRTPWTPS??????DSCDS1DS2TMITMOTMR";         04475000
    ARRAY M2(0:11) := "INVALID STATEMENT NUMBER";                       04480000
    ARRAY M3(0:13) := "UNBLOCKED I/O NOT COMPLETED ";                   04485000
    ARRAY M4(0:10) := "ERROR, PROGRAM RUNNING";                         04490000
    BYTE ARRAY M5(0:15) := "TIME = NN.NNN MS";                          04495000
    ARRAY M6(0:21) := "WARNING:  DRT# CHANGED ONLY-",          <<00924>>04500000
                      "-OVERRIDES LDEV ";                      <<00924>>04505000
    ARRAY M7(0:14) := "WARNING:  LDEV OVERRIDES DRT# ";        <<00924>>04510000
    ARRAY M5W(*) = M5;                                                  04515000
    ARRAY M6W(0:11) := "TOO MANY UNBLOCKED IO'S ";                      04520000
    ARRAY M7W(0:14) := "ERROR, SBUF FLAG AND UNBLOCKED";                04525000
    ARRAY M8W(0: 6) := "NON RESPONDING";                                04530000
    BYTE ARRAY M9(0:14) := "RESULT = XXXXXX";                           04535000
    ARRAY M9W(*) = M9;                                                  04540000
    ARRAY M10W(0:4) := "NOT READY ";                                    04545000
    ARRAY M11W(0:650):=             <<EACH LINE IS 21 WORDS>>  <<04830>>04550000
      "A   ASCII BUF FILL    AN  DO ANOTE        ",            <<00924>>04555000
      "B   OCTAL BUF FILL    C   SET COUNT PARAM ",            <<00924>>04560000
      "CH  CHECK RESULTS     CIO DO CIO INSTR    ",            <<00924>>04565000
      "CL  CLR PROG AREA     CM  CLR MNTR TABLE  ",            <<00924>>04570000
      "CMP CMP TWO BUFRS                         ",            <<04830>>04575000
      "D   DISPLAY PARAMS    DA  SHOW BUF ASCII  ",            <<00924>>04580000
      "DB  SHOW BUF OCTAL    DE  CALL DEBUG      ",            <<00924>>04585000
      "DEC DECIMAL CONVERT   DD  DISPLAY DIT     ",            <<00924>>04590000
      "DDRQ DISPLAY DRQ'S    DIOQ DISPLAY IOQ'S " ,            <<04830>>04595000
      "DMON DISPLAY MNTR TBL                     ",            <<04830>>04600000
      "DRT SET DRT#          DO  READ CMND FILE  ",            <<00924>>04605000
      "DQ  DISPLAY IOQS      DS  DISPLAY STATUS  ",            <<00924>>04610000
      "DSI DISPLAY SIO PROG  E   CALL ATTACHIO   ",            <<00924>>04615000
      "EX  TERMINATE         F   SET FUNCTION    ",            <<00924>>04620000
      "FB  FREE BUFFER  #                        ",            <<04830>>04625000
      "FL  SET FLAGS         GO  GOTO STATEMENT# ",            <<00924>>04630000
      "H   CALL HELP         I   INCREMENT FILL  ",            <<00924>>04635000
      "L   SET LDEV          LD  SET LIST DEV    ",            <<00924>>04640000
      "LI  LIST PROGRAM      M   MONITOR TERM    ",            <<00924>>04645000
      "MB  MODIFY BUFFER     MD  MODIFY DIT      ",            <<00924>>04650000
      "MQ  MODIFY IOQ        N   NULL INPT DO E  ",            <<00924>>04655000
      "O   OCTAL CONVERT     P   PRT MNTR TABLE  ",            <<00924>>04660000
      "PA  SET P1            PB  SET P2          ",            <<00924>>04665000
      "Q   SET QMISC         R   RUN STORED PROG ",            <<00924>>04670000
      "RIO DO RIO INSTR      SH  PRINT DO & PROG ",            <<00924>>04675000
      "UB  USE BUFFER   #                        ",            <<04830>>04680000
      "V   ADD REC# IN BUF   WIO DO WIO INSTR    ",            <<00924>>04685000
      "X   EXPLAIN CMDS                          ";            <<00924>>04690000
    ARRAY M13W(0: 5) := "INVALID LDEV";                                 04695000
    ARRAY M14W(0: 7) := "COUNT TOO LARGE";                              04700000
    ARRAY M15W(0: 8) := "INVALID PARAMETER ";                           04705000
    ARRAY M16W(0:27) :=                                        <<06989>>04710000
    "DO YOU WISH TO CALL  HELP DEBUGGER  ON DEV 21?  (YES/NO)";<<06989>>04715000
    ARRAY M17W(0:13) := "INVALID NUMBER OF PARAMETERS";                 04720000
    ARRAY M18W(0:12) := "PROGRAM ABORT EOF DETECTED";          <<00924>>04725000
    ARRAY M20W(0: 7) := "TIME>32 SECONDS ";                             04730000
    ARRAY M21W(0 :6) := "IOSTATUS ERROR";                               04735000
    ARRAY M22W(0:16) := "ERROR,SBUF,READ AND REQUEST TYPE 3";           04740000
    ARRAY M23W(0: 2) := "NO IOQ";                                       04745000
    ARRAY M24W(0:10) := "INVALID COMMAND FORMAT";                       04750000
    ARRAY M25W(0:35) := "COMMANDS ARE 1 OR MORE LETTERS, PARAMS",       04755000
                        " ARE NUMBERS OR STRINGS IN QUOTES ";           04760000
    ARRAY M26W(0:26) := "PROGRAM STATEMENTS ARE PRECEDED BY A",         04765000
                        " STATEMENT NUMBER ";                           04770000
    ARRAY M27W(0:21) := "ERROR,NO PCB I/O AND SYSBUFS NOT SPECIFIED";   04775000
    ARRAY M30W(0: 5) := "INVALID DRT#";                        <<00924>>04780000
    ARRAY M31W(0:9) := "UNABLE TO GET BUFFER";                 <<04830>>04785000
    ARRAY M32W(0:16) := "BUFFERS AVAILABLE RANGE FROM 0-16.";  <<04830>>04790000
    ARRAY M33W(0:9) := "BUFFERS ARE EQUAL";                    <<04830>>04795000
    ARRAY M34W(0:16) :="THE BYTE THAT DOES NOT COMPARE IS:";   <<04830>>04800000
    ARRAY M35W(0:3) :=" OR %";                                 <<04830>>04805000
    ARRAY M36W(0:11) := "USING INTERNAL BUFFER";               <<04830>>04810000
    ARRAY M37W(0:12) := "ACTIVE BUFFER IS BUFFER #";           <<04830>>04815000
    ARRAY M38W(0:11) := ":  DATA SEGMENT # IS %";              <<04830>>04820000
    ARRAY M39W(0:15) := "BUFFER HAS NOT BEEN ALLOCATED";       <<04830>>04825000
    ARRAY M40W(0:17) := "FIRST BUFFER IN CMP IS NOT ALLOCATED";<<04830>>04830000
    ARRAY M41W(0:18):= "SECOND BUFFER IN CMP IS NOT ALLOCATED";<<04830>>04835000
    ARRAY M42W(0:18):= "INTERNAL BUFFER CANNOT BE COMPARED.";  <<04830>>04840000
    ARRAY M43W(0:13):= " USE EXTRA DATA SEGMENTS.";            <<04830>>04845000
                                                                        04850000
                                                               <<06989>>04855000
                                                               <<06989>>04860000
                                                               <<06989>>04865000
                                                               <<06989>>04870000
  DEFINE   PTITLE =                                            <<06989>>04875000
      ("FILEPATCH A00.00 (C) HEWLETT-PACKARD CO., 1979")#,     <<06989>>04880000
        TURNOFFTRAPS = PUSH (STATUS);                          <<06989>>04885000
                       TOS.(2:1):=0;                           <<06989>>04890000
                       SET (STATUS) #;                         <<06989>>04895000
                                                               <<06989>>04900000
<< FORMAT CONTROL >>                                           <<06989>>04905000
EQUATE                                                         <<06989>>04910000
   STAY = %320,                                                <<06989>>04915000
   DOUBLES = %60,                                              <<06989>>04920000
   EJECT = %61;                                                <<06989>>04925000
<< MISC >>                                                     <<06989>>04930000
   DOUBLE CAPD;                                                <<06989>>04935000
   LOGICAL CAP=CAPD,MODE;                                      <<06989>>04940000
   INTEGER LEN;                                                <<06989>>04945000
   INTEGER XREG = X;                                           <<06989>>04950000
   LOGICAL DELP = Q-2;                                         <<06989>>04955000
   DEFINE SYSSUP=CAP.(5:1)#;                                   <<06989>>04960000
   DEFINE SYSMGR=CAP.(0:1)#;                                   <<06989>>04965000
   DEFINE CRLF=%15,%12#;                                       <<06989>>04970000
   DEFINE MODEI = MODE #;                                      <<06989>>04975000
   DEFINE MODED = MODE & LSR(1) #;                             <<06989>>04980000
   LOGICAL SAVES, ERRORL;                                      <<06989>>04985000
   INTEGER ARRAY DUMMY (*) = DB+0;                             <<06989>>04990000
<< MYCOMMAND STUFF >>                                          <<06989>>04995000
BYTE ARRAY DICT (0:109) :=                                     <<06989>>05000000
   9, 4, "FILE", 1, 1, 0,                                      <<06989>>05005000
   11, 6, "MODIFY", 2, 3, 1,                                   <<06989>>05010000
9, 4, "DUMP", 1, 3, 2,                                         <<06989>>05015000
   9, 4, "LIST", 0, 1, 3,                                      <<06989>>05020000
   9, 4, "EXIT", 0, 0, 4,                                      <<06989>>05025000
   10, 5, "INSTR", 0, 0, 5,                                    <<06989>>05030000
   9,4,"FIND",0,0,6,                                           <<06989>>05035000
   10,5,"DEBUG",0,0,7,                                         <<06989>>05040000
   10,5,"WIDTH",0,0,8,                                         <<06989>>05045000
   9,4,"HELP",0,0,9,                                           <<06989>>05050000
   9,4,"COPY",0,0,10,                                          <<06989>>05055000
   0;                                                          <<06989>>05060000
   EQUATE MAXP = 3;                                            <<06989>>05065000
   DOUBLE ARRAY PARMS (0:MAXP);                                <<06989>>05070000
DOUBLE SECTA,BASEA;                                            <<06989>>05075000
   ARRAY LPARMS (*) = PARMS;                                   <<06989>>05080000
   BYTE POINTER DEFN;                                          <<06989>>05085000
   INTEGER NP;                                                 <<06989>>05090000
   INTEGER                                                     <<06989>>05095000
        MIN,MOUT,                                              <<06989>>05100000
        NUMS,  NUMWDS=NUMS, WDPOS, LINEP, COLN,  MXLEN;        <<06989>>05105000
   INTEGER RECLEN := 0,FOPTION;                                <<06989>>05110000
   INTEGER FNUM := 0;                                          <<06989>>05115000
   LOGICAL DDU := 1, << FNL := 0,>>  SHORT := FALSE;           <<06989>>05120000
LOGICAL NONUM :=FALSE;                                         <<06989>>05125000
<< DISC BUFFER >>                                              <<06989>>05130000
   ARRAY DBUF (*)=B; BYTE ARRAY DBBUF(*) = DBUF;               <<J8654>>05135000
<< OTHER BUFFERS >>                                            <<06989>>05140000
   ARRAY BUF(0:65) ;                                           <<06989>>05145000
   BYTE ARRAY BBUF (*) = BUF;                                  <<06989>>05150000
   ARRAY PBUF (*) = BUF(5);                                    <<06989>>05155000
   BYTE ARRAY PBBUF (*) = PBUF;                                <<06989>>05160000
   ARRAY NUMBUF(0:34) :=                                       <<06989>>05165000
"      01234567012345670123456701234567",                      <<06989>>05170000
      "01234567012345670123456701234567";                      <<06989>>05175000
   BYTE ARRAY MSG(0:255);                                      <<06989>>05180000
   ARRAY MSG'(*)=MSG;                                          <<06989>>05185000
   ARRAY PROMPT (0:0) := "> ";                                 <<06989>>05190000
   EQUATE PROMPTL = -1;                                        <<06989>>05195000
   ARRAY ERR (0:4) := " **ERROR";                              <<06989>>05200000
   EQUATE ERRL = -8;                                           <<06989>>05205000
   ARRAY SMES (0:29) := "RECORD %                                ";     05210000
   ARRAY NOFILE(0:9) := "FILE NOT DESIGNATED ";                <<06989>>05215000
   ARRAY NOTFIXED(0:14) := "FILE NOT FIXED LENGTH RECORDS";    <<06989>>05220000
   BYTE ARRAY FILENAME(0:29);                                  <<06989>>05225000
   BYTE ARRAY BSMESN(*) = SMES(4);                             <<06989>>05230000
   BYTE ARRAY SBMESN1(*) = SMES(17);                           <<06989>>05235000
   EQUATE SMESL = 20;                                          <<06989>>05240000
   ARRAY WR (0:3) := "WRITTEN";                                <<06989>>05245000
   EQUATE WRL = -7;                                            <<06989>>05250000
   BYTE ARRAY FDL(0:8):="DEDILIST ";                           <<06989>>05255000
   BYTE ARRAY FDL1(0:8) := "DEDITTY ";                         <<06989>>05260000
                                                               <<06989>>05265000
INTRINSIC                                                      <<06989>>05270000
   ACTIVATE,CREATE,FOPEN,FWRITE,FGETINFO,FCLOSE,FCHECK,        <<06989>>05275000
   FCONTROL,FRELATE,                                           <<06989>>05280000
   COMMAND,RESETCONTROL,XCONTRAP,XSYSTRAP,READX,               <<06989>>05285000
   DBINARY,DASCII,WHO,READ,PRINT,BINARY,ASCII,DEBUG,QUIT,      <<06989>>05290000
   MYCOMMAND,FERRMSG,FREAD,FWRITEDIR,FREADDIR,FGETINFO;        <<06989>>05295000
                                                               <<06989>>05300000
 <<>>                                                          <<06989>>05305000
 <<>>                                                          <<06989>>05310000
                                                                        05315000
DOUBLE PROCEDURE ATTACHIO(L,Q,D,B,F,C,P1,P2,FL);                        05320000
  VALUE   L,Q,D,B,F,C,P1,P2,FL;                                         05325000
  INTEGER L,Q,D,B,F,C,P1,P2,FL;                                         05330000
  OPTION EXTERNAL;                                                      05335000
                                                                        05340000
DOUBLE PROCEDURE P'ATTACHIO(LDEV, QMISC, DSTX, ADDRESS, FNCT,  <<06989>>05345000
                            CNT, P1, P2, FLAG'S,               <<06989>>05350000
                            EXTBASE, EXTSIZE);                 <<06989>>05355000
                                                               <<06989>>05360000
VALUE                       LDEV, QMISC, DSTX, ADDRESS, FNCT,  <<06989>>05365000
                            CNT, P1, P2, FLAG'S,               <<06989>>05370000
                            EXTBASE, EXTSIZE;                  <<06989>>05375000
                                                               <<06989>>05380000
INTEGER                     LDEV, QMISC, DSTX, ADDRESS, FNCT,  <<06989>>05385000
                            CNT, P1, P2, FLAG'S;               <<06989>>05390000
                                                               <<06989>>05395000
DOUBLE                      EXTBASE;                           <<06989>>05400000
                                                               <<06989>>05405000
LOGICAL                     EXTSIZE;                           <<06989>>05410000
                                                               <<06989>>05415000
OPTION VARIABLE,EXTERNAL;                                      <<06989>>05420000
                                                               <<06989>>05425000
                                                               <<06989>>05430000
                                                               <<06989>>05435000
                                                               <<06989>>05440000
                                                               <<06989>>05445000
INTEGER PROCEDURE EXPRESSION;   OPTION FORWARD;                         05450000
                                                                        05455000
INTEGER PROCEDURE EXCHANGEDB(DSTN);                                     05460000
  VALUE DSTN;  INTEGER DSTN;  OPTION EXTERNAL;                          05465000
                                                               <<04830>>05470000
                                                               <<04830>>05475000
INTEGER PROCEDURE GETDATASEG(MSIZE,VMSIZE);                    <<04830>>05480000
   VALUE MSIZE, VMSIZE;                                        <<04830>>05485000
   INTEGER MSIZE,VMSIZE;                                       <<04830>>05490000
   OPTION EXTERNAL;                                            <<04830>>05495000
                                                               <<04830>>05500000
PROCEDURE RELDATASEG(EN);                                      <<04830>>05505000
   VALUE EN;                                                   <<04830>>05510000
   INTEGER EN;                                                 <<04830>>05515000
   OPTION EXTERNAL;                                            <<04830>>05520000
                                                               <<04830>>05525000
                                                                        05530000
INTEGER PROCEDURE GETSYSBUF(N,IFLAG);                                   05535000
  VALUE N,IFLAG;  INTEGER N;  LOGICAL IFLAG;                            05540000
  OPTION EXTERNAL;                                                      05545000
                                                                        05550000
PROCEDURE HELP;  OPTION EXTERNAL;                                       05555000
                                                                        05560000
DOUBLE PROCEDURE IOSTATUS(IOQX);                                        05565000
  VALUE IOQX;  INTEGER IOQX;                                            05570000
  OPTION EXTERNAL;                                                      05575000
                                                                        05580000
PROCEDURE RETURNSYSBUF(SBUFX);                                          05585000
  VALUE SBUFX;  INTEGER SBUFX;                                          05590000
  OPTION EXTERNAL;                                                      05595000
                                                                        05600000
PROCEDURE SETWAKE(IOQX);                                                05605000
  VALUE IOQX;  INTEGER IOQX;                                            05610000
  OPTION EXTERNAL;                                                      05615000
                                                                        05620000
INTEGER PROCEDURE THISCPU;   OPTION EXTERNAL;                           05625000
                                                                        05630000
DOUBLE PROCEDURE TIMER;  OPTION EXTERNAL;                               05635000
                                                                        05640000
PROCEDURE WAIT(WF,SF);                                                  05645000
  VALUE WF, SF;  INTEGER WF,SF;                                         05650000
  OPTION EXTERNAL;                                                      05655000
integer procedure GETDRT(DRTN,OFFSET);                         <<03120>>05660000
value DRTN,OFFSET;                                             <<03120>>05665000
integer DRTN,OFFSET;                                           <<03120>>05670000
option external;                                               <<03120>>05675000
                                                               <<03120>>05680000
$PAGE "  SERVICE PROCEDURES"                                            05685000
                                                                        05690000
COMMENT                                                        <<04929>>05695000
                                                               <<04929>>05700000
   THE FOLLOWING PROCEDURE CHECKS THE CAPABILITY OF THE        <<04929>>05705000
   CALLING USER TO MAKE SURE THAT HE/SHE/IT POSSESSES          <<04929>>05710000
   SYSTEM MANAGER CAPABILITY.  IF THE USER IS NOT SYSTEM       <<04929>>05715000
   MANAGER THAN IT ABORTS THE PROGRAM BY CALLING TERMINATE.    <<04929>>05720000
;                                                              <<04929>>05725000
                                                               <<04929>>05730000
PROCEDURE CHECK'CAPE;                                          <<04929>>05735000
BEGIN                                                          <<04929>>05740000
DOUBLE CAPD;      << CAPABILITIES FROM WHO INTRINSIC >>        <<04929>>05745000
INTEGER I;   << LENGTH OF MESSAGE >>                           <<04929>>05750000
LOGICAL CAP=CAPD;                                              <<04929>>05755000
LOGICAL ARRAY MSG(0:39);                                       <<04929>>05760000
                                                               <<06989>>05765000
DEFINE                                                         <<04929>>05770000
SYSMGR'MSG = (" ** PROGRAM REQUIRES SYS. MGR. CAPABILITY **")#;<<04929>>05775000
INTRINSIC PRINT,TERMINATE,WHO;                                 <<04929>>05780000
                                                               <<04929>>05785000
   WHO(,CAPD);   << GET CAPABILITY FROM WHO INTRINSIC >>       <<04929>>05790000
   IF NOT SYSMGR THEN                                          <<04929>>05795000
     BEGIN                                                     <<04929>>05800000
     MOVE MSG := SYSMGR'MSG,2;                                 <<04929>>05805000
     I := TOS - @MSG;                                          <<04929>>05810000
     PRINT(MSG,I,0);                                           <<04929>>05815000
     TERMINATE;                                                <<04929>>05820000
     END;                                                      <<04929>>05825000
END;                                                           <<04929>>05830000
INTEGER PROCEDURE CHAR;                                                 05835000
  <<                                                                    05840000
     THIS PROCEDURE RETURNS THE CURRENT CHARACTER BEING POINTED TO BY   05845000
     THE POINTER I IN THE BUFFER BM.  IF THE CHARACTER IS A BLANK AND   05850000
     THEN QUOTE FLAG IS NOT SET, I IS INCREMENTED UNTIL A NON BLANK     05855000
     CHARACTER IS FOUND. IT ALSO STEPS OVER COMMENT FIELDS.             05860000
  >>                                                                    05865000
  BEGIN                                                                 05870000
  IF I<>LASTI THEN BEGIN   << LOOKING AT A NEW CHARACTER >>             05875000
    IF NOT QUOTEFLAG THEN WHILE INTEGER(BM(I))=" " DO I := I + 1;       05880000
    IF INTEGER(BM(I))=QUOTE THEN QUOTEFLAG := NOT QUOTEFLAG;            05885000
                                                                        05890000
    IF NOT QUOTEFLAG AND BM(I)="<<" THEN BEGIN                          05895000
      J := I + 2;   << STEP OVER COMMENT DELIMITER >>                   05900000
      WHILE J<L AND BM(J)<>">>" DO J := J + 1;                          05905000
      IF J<L THEN BEGIN    << DELETE COMMENT FIELD >>                   05910000
        MOVE BM(I) := BM(J+2),(L-J);                                    05915000
        L := L + I - J - 2;    << NEW LENGTH >>                         05920000
        CHAR;    << SCAN TO NON COMMENT >>                              05925000
        END;                                                            05930000
      END;                                                              05935000
    END;                                                                05940000
                                                                        05945000
  CHAR := BM(I);    LASTI := I;                                         05950000
  END;   << CHAR >>                                                     05955000
                                                                        05960000
                                                                        05965000
$PAGE                                                          <<04830>>05970000
                                                                        05975000
PROCEDURE STRIPBLANKS;                                                  05980000
  <<                                                                    05985000
     THIS PROCEDURE STRIPS LEADING AND TRAILING BLANKS FORM THE LINE IN 05990000
     THE BUFFER M. IT ALSO CLEARS THE QUOTE FLAG.                       05995000
  >>                                                                    06000000
  BEGIN                                                                 06005000
  WHILE INTEGER(BM(L-1))=%40 AND L>0 DO L := L - 1;                     06010000
  BM(L) := CR;                                                          06015000
                                                                        06020000
  DO BEGIN    << SCAN OFF LEADING BLANKS >>                             06025000
    I := 0;    LASTI := -1;    QUOTEFLAG := FALSE;                      06030000
    CHAR;     << FIND FIRST NON BLANK >>                                06035000
    L := L - I;                                                         06040000
    IF I<>0 THEN MOVE BM := BM(I),(L+1);                                06045000
  END UNTIL I=0;   << NO LEADING BLANKS >>                              06050000
  END;   << STRIP BLANKS >>                                             06055000
$PAGE                                                                   06060000
                                                                        06065000
PROCEDURE SETSTATUS(DUMMY);                                             06070000
  VALUE DUMMY;   INTEGER DUMMY;                                         06075000
  <<                                                                    06080000
    THIS PROCEDURE TAKES THE CURRENT CONDITION CODE AND SETS IT INTO    06085000
    THE MARKER OF THE PREVIOUS CALLER, THUS PASSING THE CURRENT         06090000
    STATUS OF THE CALLER OF THE PROCEDURE TO THE CALLERS CALLER.        06095000
  >>                                                                    06100000
  BEGIN                                                                 06105000
    ARRAY MARKERSTATUS(*) = Q - 1;                                      06110000
    INTEGER DELTAQ = Q - 0;                                             06115000
                                                                        06120000
    DEFINE CC = (6:2)#;                                                 06125000
                                                                        06130000
    MARKERSTATUS(-DELTAQ).CC := MARKERSTATUS.CC;                        06135000
  END;    << SET STATUS >>                                              06140000
                                                                        06145000
                                                                        06150000
$PAGE                                                          <<04830>>06155000
                                                                        06160000
INTEGER PROCEDURE DEVTYPE(LDEV);                                        06165000
  VALUE LDEV;  INTEGER LDEV;                                            06170000
  <<                                                                    06175000
    RETURNS THE DEVICE TYPE OF LOGICAL DEVICE LDEV                      06180000
  >>                                                                    06185000
  BEGIN                                                                 06190000
    INTEGER TEMP;  INTEGER ARRAY WA2(*) = DB + 2;                       06195000
                                                               <<J8654>>06200000
    TEMP := EXCHANGEDB(LDT'DST);  << SET DB TO LDT >>          <<J8654>>06205000
    IF LDEV<LDT'NUM'ENTRIES THEN                               <<J8654>>06210000
      BEGIN                                                    <<J8654>>06215000
        LDT'INDEX := LDEV*LDT'ENTRY'SIZE;                      <<J8654>>06220000
        DEVTYPE := LDT'DEVICE'TYPE;                            <<J8654>>06225000
      END                                                      <<J8654>>06230000
      ELSE DEVTYPE := -1;                                      <<J8654>>06235000
    EXCHANGEDB(TEMP);  << RESTORE DB TO STACK >>                        06240000
  END;   << DEV TYPE >>                                                 06245000
$PAGE                                                                   06250000
                                                                        06255000
$PAGE                                                          <<04830>>06260000
INTEGER PROCEDURE FACTOR;                                               06265000
  <<                                                                    06270000
    THIS PROCEDURE RETURNS A FACTOR OF AN EXPRESSION, WHICH MAY BE      06275000
    A NUMBER, A LITERAL WITHIN QUOTES OF 1 OR 2 CHARACTERS LENGTH       06280000
    OR AN EXPRESSION INCLOSED IN PARENTHESIS.                           06285000
                                                                        06290000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    06295000
    CCL = NULL FACTOR,  CCE = GOOD FACTOR,  CCG = ERROR                 06300000
  >>                                                                    06305000
  BEGIN                                                                 06310000
    INTEGER TEMP;                                                       06315000
                                                                        06320000
    IF I=L THEN  << NULL FACTOR >>                                      06325000
      BEGIN   SETSTATUS(-1);  RETURN;  END;                             06330000
                                                                        06335000
                                                               <<06989>>06340000
    IF CHAR="P" THEN  <<  THEN PA OR PB MUST BE PRESENT  >>    <<06989>>06345000
      BEGIN                                                    <<06989>>06350000
        I := I + 1;    << STEP OVER P    >>                    <<06989>>06355000
        IF CHAR="A" OR CHAR="B" THEN                           <<06989>>06360000
                                                               <<06989>>06365000
          BEGIN                                                <<06989>>06370000
            SETSTATUS(0);    << SET CCE FROM CALLER'S STATUS >><<06989>>06375000
            FACTOR := IF CHAR="A" THEN P1 ELSE P2;             <<06989>>06380000
            I := I+1;  << STEP OVER A OR B >>                  <<06989>>06385000
          END                                                  <<06989>>06390000
                                                               <<06989>>06395000
        ELSE  SETSTATUS(1); << ERROR >>                        <<06989>>06400000
                                                               <<06989>>06405000
        RETURN;                                                <<06989>>06410000
      END;                                                     <<06989>>06415000
                                                               <<06989>>06420000
    IF CHAR="B" THEN << GET THE VALUE FROM THE BUFFER  B >>    <<06989>>06425000
      BEGIN                                                    <<06989>>06430000
        I := I + 1;   << STEP OVER  B  >>                      <<06989>>06435000
        IF CHAR="("  THEN                                      <<06989>>06440000
          BEGIN                                                <<06989>>06445000
            I := I + 1;   << STEP OVER   (   >>                <<06989>>06450000
            FACTOR := B(EXPRESSION);  << GET INDEX VALUE >>    <<06989>>06455000
            IF CHAR <> ")" THEN SETSTATUS(1)  << NO) SET CCG >><<06989>>06460000
              ELSE BEGIN SETSTATUS(0); I := I+1; END;          <<06989>>06465000
                   << SET CCE AND STEP OVER   )   >>           <<06989>>06470000
            RETURN;                                            <<06989>>06475000
          END                                                  <<06989>>06480000
        ELSE  SETSTATUS(1);   << SET CCG FOR NO PAREN >>       <<06989>>06485000
        RETURN;                                                <<06989>>06490000
                                                               <<06989>>06495000
      END;                                                     <<06989>>06500000
                                                               <<06989>>06505000
    IF CHAR="O" THEN  <<  THEN "FFSET"  MUST BE PRESENT  >>    <<06989>>06510000
      BEGIN                                                    <<06989>>06515000
        I := I + 1;    << STEP OVER P    >>                    <<06989>>06520000
        IF BM(I) = "FFSET"      THEN                           <<06989>>06525000
                                                               <<06989>>06530000
          BEGIN                                                <<06989>>06535000
            SETSTATUS(0);    << SET CCE FROM CALLER'S STATUS >><<06989>>06540000
            FACTOR := BUF'OFFSET;                              <<06989>>06545000
            I := I+5;  << STEP OVER "FFSET">>                  <<06989>>06550000
          END                                                  <<06989>>06555000
                                                               <<06989>>06560000
        ELSE  SETSTATUS(1); << ERROR >>                        <<06989>>06565000
                                                               <<06989>>06570000
        RETURN;                                                <<06989>>06575000
      END;                                                     <<06989>>06580000
                                                               <<06989>>06585000
    IF CHAR="C" THEN  <<  THEN THE CURRENT COUNT IS RETURNED>> <<06989>>06590000
      BEGIN                                                    <<06989>>06595000
                                                               <<06989>>06600000
                             <<  CCE IS SET BY EQUALITY ABOVE>><<06989>>06605000
            SETSTATUS(0);    << SET CCE FROM CALLER'S STATUS >><<06989>>06610000
            I := I+1;        << STEP OVER CHARACTER "C" >>     <<06989>>06615000
            FACTOR := C;                                       <<06989>>06620000
                                                               <<06989>>06625000
                                                               <<06989>>06630000
        RETURN;                                                <<06989>>06635000
      END;                                                     <<06989>>06640000
    IF CHAR="(" THEN  << AN EXPRESSION EXPECTED >>                      06645000
      BEGIN                                                             06650000
        I := I + 1;    << STEP OVER PAREN >>                            06655000
        FACTOR := EXPRESSION;                                           06660000
        IF <> OR CHAR<>")" THEN SETSTATUS(1)  << ERROR >>               06665000
          ELSE BEGIN SETSTATUS(0);  I := I + 1;  END;                   06670000
        RETURN;                                                         06675000
      END;                                                              06680000
                                                                        06685000
    IF CHAR=QUOTE THEN  << LITERAL FACTOR >>                            06690000
      BEGIN                                                             06695000
        I := I + 1;     << STEP OVER QUOTE >>                           06700000
        TEMP := CHAR;                                                   06705000
        IF I<L THEN I := I+1;  << STEP OVER CHAR >>                     06710000
        IF CHAR<>QUOTE THEN  << TWO CHARACTER LITERAL >>                06715000
          BEGIN                                                         06720000
            TEMP := TEMP&LSL(8) + CHAR;                                 06725000
            IF I<L THEN I := I + 1;   << STEP OVER 2ND CHAR >>          06730000
          END;                                                          06735000
        FACTOR := TEMP;                                                 06740000
        IF CHAR<>QUOTE THEN SETSTATUS(1)   << NO CLOSING QUOTE >>       06745000
        ELSE BEGIN SETSTATUS(0);  I := I + 1;  END;                     06750000
        RETURN;                                                         06755000
      END;                                                              06760000
                                                                        06765000
    X := IF CHAR="%" THEN I+1 ELSE I;                                   06770000
    MOVE BM(X) := BM(X) WHILE N, 1;  << FIND LENGTH OF NUMBER >>        06775000
    TEMP := TOS - @BM - I;   << LENGTH OF NUMBER >>                     06780000
    IF <> THEN                                                          06785000
      BEGIN                                                             06790000
        FACTOR := BINARY(BM(I),TEMP);  << CONVERT NUMBER >>             06795000
        IF = THEN << NO ERROR >>                                        06800000
          BEGIN  SETSTATUS(0);  I := I + TEMP;  RETURN;  END;           06805000
      END;                                                              06810000
                                                                        06815000
    SETSTATUS(1);   << ERROR >>                                         06820000
  END;   << FACTOR >>                                                   06825000
                                                                        06830000
$PAGE                                                          <<04830>>06835000
INTEGER PROCEDURE TERM;                                                 06840000
  <<                                                                    06845000
    THIS PROCEDURE RETURNS A TERM OF AN EXPRESSION WHICH MAY BE A       06850000
    FACTOR OR A FACTOR TIMES A FACTOR OR A FACTOR DIVIDED BY A FACTOR.  06855000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    06860000
                                                                        06865000
    CCL = NULL TERM,  CCE = GOOD TERM,  CCG = ERROR                     06870000
  >>                                                                    06875000
  BEGIN                                                                 06880000
    INTEGER OPERATOR, TEMP, RESULT;                                     06885000
                                                                        06890000
    RESULT := FACTOR;                                                   06895000
    SETSTATUS(0);    << SET RETURN STATUS >>                            06900000
    IF <> THEN RETURN;    << RETURN RESULTS STATUS >>                   06905000
                                                                        06910000
    WHILE CHAR="*" OR CHAR="/" DO                                       06915000
      BEGIN                                                             06920000
        OPERATOR := CHAR;                                               06925000
        I := I + 1;   << STEP OVER OPERATOR >>                          06930000
        TEMP := FACTOR;                                                 06935000
        IF <> THEN   << AN ERROR CONDITION >>                           06940000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        06945000
        RESULT := IF OPERATOR="*" THEN RESULT*TEMP ELSE RESULT/TEMP;    06950000
        IF OVERFLOW THEN  BEGIN   SETSTATUS(1);   RETURN;   END;        06955000
      END;                                                              06960000
                                                                        06965000
    TERM := RESULT;                                                     06970000
  END;   << TERM  >>                                                    06975000
$PAGE                                                                   06980000
                                                                        06985000
INTEGER PROCEDURE EXPRESSION;                                           06990000
  <<                                                                    06995000
    THIS PROCEDURE RETURNS AN EXPRESSION WHICH MAY BE A TERM PRECEDED   07000000
    BY A UNARY MINUS OR THE SUM OR DIFERENCES OF A SET OF TERMS.        07005000
                                                                        07010000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    07015000
    CCL = NULL EXPRESSION,  CCE = GOOD EXPRESSION,  CCG = ERROR         07020000
  >>                                                                    07025000
  BEGIN                                                                 07030000
    INTEGER OPERATOR, TEMP, SUM;                                        07035000
                                                                        07040000
    IF CHAR="-" THEN   << A UNARY MINUS >>                              07045000
      BEGIN                                                             07050000
        I := I + 1;   << STEP OVER MINUS >>                             07055000
        TEMP := TERM;                                                   07060000
        IF <> THEN   << AN ERROR CONDITION >>                           07065000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        07070000
        SETSTATUS(0);   << SET GOOD RETURN STATUS >>                    07075000
        SUM := - TEMP;                                                  07080000
      END                                                               07085000
    ELSE                                                                07090000
      BEGIN                                                             07095000
        SUM := TERM;                                                    07100000
        SETSTATUS(0);  << SET RETURN STATUS >>                          07105000
        IF <> THEN RETURN;    << PASS BACK STATUS >>                    07110000
      END;                                                              07115000
                                                                        07120000
    WHILE CHAR="+" OR CHAR="-" DO                                       07125000
      BEGIN                                                             07130000
        OPERATOR := CHAR;                                               07135000
        I := I + 1;   << STEP OVER OPERATOR >>                          07140000
        TEMP := TERM;                                                   07145000
        IF <> THEN   << AN ERROR CONDITION >>                           07150000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        07155000
        SUM := IF OPERATOR="+" THEN SUM+TEMP ELSE SUM-TEMP;             07160000
        IF OVERFLOW THEN  BEGIN   SETSTATUS(1);   RETURN;   END;        07165000
      END;                                                              07170000
                                                                        07175000
    EXPRESSION := SUM;                                                  07180000
  END;   << EXPRESSION >>                                               07185000
$PAGE                                                                   07190000
                                                                        07195000
PROCEDURE PRINT'(ADR, L, C);                                            07200000
  VALUE   L, C;                                                         07205000
  INTEGER L, C;   ARRAY ADR;                                            07210000
  <<                                                                    07215000
    CALLS PRINT IF THE CONTROL Y FLAG IS CLEAR OTHERWISE NO OPERATION   07220000
  >>                                                                    07225000
  BEGIN   IF NOT CYFLAG THEN PRINT(ADR, L, C);   END;                   07230000
                                                                        07235000
                                                                        07240000
                                                                        07245000
PROCEDURE PRINTX(ADR, L);                                               07250000
    VALUE L;  INTEGER L;   ARRAY ADR;                                   07255000
  <<                                                                    07260000
    PRINTS EXCEPTION CONDITIONS. IF COMMAND GOTTEN FROM DO FILE THEN THE07265000
    DO FILE NAME AND LINE NUMBER ARE APPEND OR IF GETTING FROM A STORED 07270000
    PROGRAM THEN THE STATEMENT NUMBER IS APPENDED                       07275000
  >>                                                                    07280000
    BEGIN                                                               07285000
    TOS := L;                                                           07290000
    TOS := IF < THEN -TOS ELSE TOS*2;  << FORM POSITIVE BYTE COUNT >>   07295000
    L := TOS;                                                           07300000
    MOVE PA := ADR,((L+1)/2);  << MOVE MESSAGE >>                       07305000
                                                                        07310000
    CASE SOURCE OF                                                      07315000
      BEGIN                                                             07320000
      BEGIN   END;   << $STDIN >>                                       07325000
                                                                        07330000
      BEGIN     << STORED PROGRAM >>                                    07335000
      MOVE BPA(L) := " AT STATEMENT ";   L := L + 14;                   07340000
      L := ASCII(LASTLINE, 10, BPA(L)) + L;                             07345000
      END;                                                              07350000
                                                                        07355000
      BEGIN     << DO FILE >>                                           07360000
      MOVE BPA(L) := FNAME,(FNL+4);   L := FNL + 4 + L;                 07365000
      IF INTEGER(LINENO(4))<>" " THEN  << HAS A LINE NUMBER >>          07370000
        BEGIN   MOVE BPA(L) := LINENO,(12);   L := L +12;    END;       07375000
      END;                                                              07380000
      END;    << SOURCE CASE >>                                         07385000
                                                                        07390000
    PRINT'(PA, -L, 0);                                                  07395000
    END;    << PRINT X >>                                               07400000
                                                                        07405000
                                                                        07410000
                                                                        07415000
PROCEDURE OUTPUT(ADR,L,CNTRL);                                          07420000
  VALUE L, CNTRL;  INTEGER L, CNTRL;  ARRAY ADR;                        07425000
  <<                                                                    07430000
    OUTPUTS TO $STDLIST, LIST FILE OR LDEV VIA ATTACHIO                 07435000
  >>                                                                    07440000
  BEGIN                                                                 07445000
    IF NOT CYFLAG THEN  << OUTPUT THE MESSAGE >>                        07450000
      IF FN<>0 THEN   << CHECK FOR ALTERNATE LIST DEVICE >>             07455000
        IF < THEN ATTACHIO(-FN,0,0,@ADR,1,L,CNTRL,0,1)                  07460000
        ELSE FWRITE(FN, ADR, L, CNTRL)                                  07465000
      ELSE PRINT'(ADR, L, CNTRL);                                       07470000
  END;  << OUTPUT >>                                                    07475000
                                                                        07480000
                                                                        07485000
                                                                        07490000
PROCEDURE PRINTE(ADR,L);                                                07495000
  VALUE L;  INTEGER L;  ARRAY ADR;                                      07500000
  <<                                                                    07505000
      THIS ROUTINE PRINTS ERROR MESSAGES. IF COMMAND IS GOTTEN FROM A   07510000
      STORED PROGRAM THEN THE STATEMENT NUMBER OR IF THE COMMAND IS     07515000
      GOTTEN FROM THE DO FILE THEN DO FILE NAME AND LINE NUMBER ARE     07520000
      APPENDED TO THE MESSAGE.                                          07525000
  >>                                                                    07530000
  BEGIN                                                                 07535000
    PRINTX( ADR, L );                                                   07540000
    EFLAG := TRUE;                                                      07545000
  END;    << PRINTE >>                                                  07550000
                                                                        07555000
                                                                        07560000
                                                                        07565000
PROCEDURE PRINTSTATUS;                                                  07570000
  BEGIN                                                                 07575000
    MOVE BM := "LDEV = ";       X := 7;                                 07580000
    X := ASCII(LASTLDEV, 10, BM(X)) + X;                                07585000
    MOVE BM(X) := ", FUNC = ";  X := X + 9;                             07590000
    X := ASCII(LASTFUNC, 10, BM(X)) + X;                                07595000
    MOVE BM(X) := ", XLOG = ";   X := X + 9;                            07600000
    X := ASCII(XLOG, 10, BM(X)) + X;                                    07605000
    TOS := @BM(X);   << SAVE ADDRESS TO MOVE "STATUS = " >>             07610000
    ASCII(STATUS.(8:8), 8, BM(X:=X+8));                                 07615000
    MOVE * := ", STATUS = ";                                            07620000
    PRINTX(M, -(X+6));                                                  07625000
  END;  << PRINT STATUS >>                                              07630000
                                                                        07635000
                                                                        07640000
                                                                        07645000
PROCEDURE PRINTBUFFER( ADR, COUNT );                                    07650000
  VALUE ADR, COUNT;  INTEGER ADR, COUNT;                                07655000
  <<                                                                    07660000
    THIS PROCEDURE PRINTS THE NUMBER OF WORDS COUNT IN OCTAL, AT ADR    07665000
    IN BUFFER B OR AT ABSOLUTE ADDRESS ADR.  THE WORDS ARE PRINTED      07670000
    8 TO A LINE WITH AN ASSOCIATED ADDRESS SPECIFIED BY ADR             07675000
  >>                                                                    07680000
  BEGIN                                                                 07685000
    INTEGER I, J, L, T;                                                 07690000
                                                                        07695000
    WHILE COUNT>0 DO                                                    07700000
      BEGIN                                                             07705000
        J := IF COUNT>8 THEN 8 ELSE COUNT;                              07710000
        IF BFLAG THEN  << OUPUT BUFFER RELATIVE >>                      07715000
          BEGIN MOVE BM := "   "; ASCII(ADR, -10, BM(3)); L := 4; END   07720000
        ELSE BEGIN  ASCII(ADR, 8, BM);  L := 6;  END;                   07725000
        MOVE BM(L) := ": ";     L := L + 2;                             07730000
        FOR I := 1 UNTIL J DO                                           07735000
          BEGIN                                                         07740000
            T := IF BFLAG THEN B(ADR) ELSE ABS(ADR);  << GET A WORD >>  07745000
            ASCII( T, 8, BM(L) );   L := L + 8;                         07750000
            MOVE BM(L-2) := "  ";    ADR := ADR + 1;                    07755000
          END;                                                          07760000
        OUTPUT( M, -L, 0);                                              07765000
        COUNT := COUNT - 8;                                             07770000
      END;                                                              07775000
  END;   << PRINT BUFFER >>                                             07780000
                                                                        07785000
                                                                        07790000
                                                                        07795000
PROCEDURE PRINTRESULT(RESULT);                                          07800000
  VALUE RESULT;    INTEGER RESULT;                                      07805000
  <<                                                                    07810000
    CHECKS CC FOR < AND PRINTS NORESPONDING OR IF > THEN PRINTS NOT     07815000
    READY AND PRINTS RESULT WORD IF > OR X ODD.                         07820000
  >>                                                                    07825000
  IF < THEN PRINTX(M8W, 7)   << NON RESPONDING >>                       07830000
  ELSE IF > OR LOGICAL(X) THEN                                          07835000
    BEGIN    << NOT READY OR PRINT TIO/RIO RESULT >>                    07840000
    IF > THEN PRINTX(M10W, -9);   << NOT READY >>                       07845000
    TOS := ASCII(RESULT, 8, M9(9));   << CONVERT RESULT TO OCTAL >>     07850000
    PRINTX(M9W, -15);                                                   07855000
    END;    << PRINT RESULT >>                                          07860000
$PAGE                                                                   07865000
                                                                        07870000
PROCEDURE CY;                                                           07875000
  <<                                                                    07880000
    CONTROL Y TRAP PROCEDURE                                            07885000
  >>                                                                    07890000
  BEGIN                                                                 07895000
    INTEGER Q1 = Q+1;  << EXIT N PARAMETER >>                           07900000
                                                                        07905000
    FCONTROL(IN, 16, T);   << WAIT, THEN DISABLE CONTROL Y >>           07910000
    PRINT(M, 0, 0);    CYI := 0;    << CR/LF >>                         07915000
                                                                        07920000
    CASE SOURCE OF BEGIN                                                07925000
      BEGIN   M := "..";   BM(2) := ".";   CYI := 3;   END; << $STDIN >>07930000
                                                                        07935000
      BEGIN    << GETTING FROM STORED PROGRAM >>                        07940000
      MOVE BM := "CONTROL Y BREAK AFTER STATEMENT ";                    07945000
      CYI := ASCII(LASTLINE, 10, BM(32)) + 32;                          07950000
      END;                                                              07955000
                                                                        07960000
      BEGIN    << GETTING FROM DO FILE >>                               07965000
      MOVE BM := "CONTROL Y BREAK";                                     07970000
      MOVE BM(15) := FNAME,(FNL+4);   CYI := 19 + FNL;                  07975000
      IF INTEGER(LINENO(4))<>" " THEN  << APPEND LINE NUMBER >>         07980000
        BEGIN  MOVE BM(CYI) := LINENO,(12);   CYI := CYI + 12;   END;   07985000
      END;                                                              07990000
      END;   << SOURCE CASE >>                                          07995000
                                                                        08000000
    PRINT(M, -CYI, 0);                                                  08005000
    FCONTROL(IN, 17, T);   << WAIT, THEN ENABLE  CONTROL Y >>  <<06989>>08010000
    RESETCONTROL;           << REENABLE CONTROL Y >>           <<06989>>08015000
    CYFLAG := EFLAG := TRUE;                                            08020000
    TOS := %31400+Q1.(8:8);   << FORM EXIT N INSTRUCTION >>             08025000
    ASMB( XEQ );                                                        08030000
  END;                                                                  08035000
$PAGE                                                                   08040000
                                                                        08045000
PROCEDURE STEP'PC(PC);                                                  08050000
  INTEGER PC;                                                           08055000
  <<                                                                    08060000
    STEPS THE VARIABLE PC ONE STATEMENT IN THE STORED PROGRAM. IT DOES  08065000
    NOT STEP PAST THE PROGRAM END.                                      08070000
  >>                                                                    08075000
  BEGIN  IF PC<PROGEND THEN PC := (PROG(PC+1)+5)/2 + PC;  END;          08080000
                                                                        08085000
                                                                        08090000
                                                                        08095000
INTEGER PROCEDURE FINDLINE(LN, NEXT);                                   08100000
  VALUE   LN, NEXT;   INTEGER LN;    LOGICAL NEXT;                      08105000
  <<                                                                    08110000
    THIS PROCEDURE FINDS THE LINE LN AND RETURNS THE INDEX INTO PROG OF 08115000
    THE SPECIFIED LINE. IF THE LINE IS NOT IN FOUND, IT RETURNS THE     08120000
    INDEX OF THE PREVIOUS LINE OR THE NEXT LINE IF NEXT IS SET.         08125000
  >>                                                                    08130000
  BEGIN                                                                 08135000
  INTEGER I := 0, j := 0;                                               08140000
                                                                        08145000
  WHILE I<PROGEND AND PROG(I)<LN DO                                     08150000
    BEGIN    J := I;    STEP'PC(I);    END;                             08155000
  IF NOT NEXT AND PROG(I)>LN THEN I := J;  << RETURN LAST >>            08160000
  FINDLINE := I;                                                        08165000
  END;   << FIND LINE >>                                                08170000
$PAGE                                                                   08175000
                                                                        08180000
PROCEDURE BCONVERT(N,INDEX);                                            08185000
  VALUE N, INDEX;  INTEGER N, INDEX;                                    08190000
  <<                                                                    08195000
    CONVERTS N TO ASCII OCTAL AND PUTS LAST 3 DIGITS INTO BYTE ARRAY    08200000
    BM BEGINING AT INDEX                                                08205000
  >>                                                                    08210000
  BEGIN                                                                 08215000
    BYTE ARRAY BA( 0:5 );                                               08220000
    ASCII(N,8,BA);  << CONVERT NUMBER TO OCTAL >>                       08225000
    MOVE BM(INDEX) := BA(3),(3);                                        08230000
  END;   << BCONVERT >>                                                 08235000
                                                                        08240000
                                                                        08245000
                                                                        08250000
PROCEDURE SYSTRAP(P1,P2,P3,P4,P5,P6,P7,P8);                             08255000
  VALUE P1, P2, P3, P4, P5, P6, P7, P8;                                 08260000
  INTEGER P1, P2, P3, P4, P5, P6, P7, P8;                               08265000
  BEGIN                                                                 08270000
  EFLAG := TRUE;                                                        08275000
  TOS := P1.(11:5) + %031410;                                           08280000
  ASMB( XEQ 0 );                                                        08285000
  END;  << SYS TRAP >>                                                  08290000
                                                               <<04830>>08295000
                                                               <<04830>>08300000
PROCEDURE SKIPLINES(XTIMES);                                   <<04830>>08305000
VALUE XTIMES;                                                  <<04830>>08310000
INTEGER XTIMES;                                                <<04830>>08315000
<<The following will be used as an equivalent to linefeed.>>   <<04830>>08320000
<<XTIMES will tell us how many times to linefeed>>             <<04830>>08325000
BEGIN                                                          <<04830>>08330000
  LOGICAL ARRAY LINEFEED(0:0); <<DUMMY  USED LIKE A LINEFEED>> <<04830>>08335000
  INTEGER NUMBER;                                              <<04830>>08340000
  FOR NUMBER:=0 UNTIL XTIMES DO                                <<04830>>08345000
    PRINT(LINEFEED,0,0);    << PRINT NOTHING>>                 <<04830>>08350000
END;     << OF SKIPLINES >>                                    <<04830>>08355000
                                                               <<04830>>08360000
                                                               <<04830>>08365000
                                                               <<04830>>08370000
                                                               <<04830>>08375000
PROCEDURE HEADER;                                              <<04830>>08380000
<< Prints the header to the IOQ list >>                        <<04830>>08385000
BEGIN                                                          <<04830>>08390000
  MOVE PRINT'LINE:=80(" ");                                    <<04830>>08395000
  SKIPLINES(1);                                                <<04830>>08400000
  MOVE PRINT'LINE(44):="STATUS: 0.XX -> PENDING";              <<04830>>08405000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08410000
  MOVE PRINT'LINE(52):="1.XX -> SUCCESSFUL";                   <<04830>>08415000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08420000
  MOVE PRINT'LINE(52):="2.XX -> END OF FILE";                  <<04830>>08425000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08430000
  MOVE PRINT'LINE(52):="3.XX -> UNUSUAL CONDITION";            <<04830>>08435000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08440000
  MOVE PRINT'LINE(52):="4.XX -> IRRECOVERABLE ERROR";          <<04830>>08445000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08450000
  SKIPLINES(2);                                                <<04830>>08455000
  MOVE PRINT'LINE:="TABL DEV        UN-      DST/  OFFSET    ";<<04830>>08460000
  MOVE PRINT'LINE(41):="  XFER                               ";<<04830>>08465000
  MOVE PRINT'LINE(78):=" ";                                    <<04830>>08470000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08475000
  MOVE PRINT'LINE:="INDX B10  IOQP  IT  PCB  BANK   ADDR  ";   <<04830>>08480000
  MOVE PRINT'LINE(38):="FNC  CNT   FLAGS  PARM1 PARM2 MISC   ";<<04830>>08485000
  MOVE PRINT'LINE(76):="    ";                                 <<04830>>08490000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>08495000
  SKIPLINES(1);                                                <<04830>>08500000
END;       <<OF HEADER>>                                       <<04830>>08505000
                                                               <<04830>>08510000
                                                               <<04830>>08515000
                                                               <<04830>>08520000
PROCEDURE PRINT'INFO(NDEX,DISPLACEMENT);                       <<04830>>08525000
VALUE NDEX, DISPLACEMENT;                                      <<04830>>08530000
INTEGER NDEX;                                                  <<04830>>08535000
LOGICAL DISPLACEMENT;                                          <<04830>>08540000
<<Takes the information for the IOQ elements and converts it>> <<04830>>08545000
<<to octal. The device number is displayed in decimal>>        <<04830>>08550000
<<NDEX will indicate where on the line the printed informa->>  <<04830>>08555000
<<tion will apprear. DISPLACEMENT is the info to be converted>><<04830>>08560000
<<and printed. If the device is about to be printed, >>        <<04830>>08565000
<<DEV'CHECK will be true allowing it to be printed in decimal>><<04830>>08570000
BEGIN                                                          <<04830>>08575000
   BYTE ARRAY ELEMENT(0:10);  <<HOLDS THE OCTAL VALUE>>        <<04830>>08580000
   IF DEV'CHECK THEN     << LDEV WILL BE PRINTED IN DECIMAL >> <<04830>>08585000
      BEGIN                                                    <<04830>>08590000
        NUMCHAR:=ASCII(DISPLACEMENT,10,ELEMENT);               <<04830>>08595000
        MOVE PRINT'DATA(NDEX):=ELEMENT,(NUMCHAR);              <<04830>>08600000
      END                                                      <<04830>>08605000
   ELSE                                                        <<04830>>08610000
     BEGIN                                                     <<04830>>08615000
     NUMCHAR:=ASCII(DISPLACEMENT,8,ELEMENT);                   <<04830>>08620000
     MOVE PRINT'DATA(NDEX):=ELEMENT(6-NUMCHAR),(NUMCHAR);      <<04830>>08625000
   END;     << OF IF >>                                        <<04830>>08630000
END;     << OF PRINT'INFO >>                                   <<04830>>08635000
                                                               <<06989>>08640000
                                                               <<06989>>08645000
LOGICAL PROCEDURE AIOQ(WORDOFFSET);                            <<06989>>08650000
VALUE WORDOFFSET;                                              <<06989>>08655000
<<Procedure IOQ is given the DST# of the table to extract>>    <<06989>>08660000
<<information from. WORDOFFSET zeroes into the proper entry>>  <<06989>>08665000
<<and location of the word we want to extract. The info>>      <<06989>>08670000
<<is then returned.>>                                          <<06989>>08675000
LOGICAL WORDOFFSET;                                            <<06989>>08680000
BEGIN                                                          <<06989>>08685000
  LOGICAL MFDSWORD;                                            <<06989>>08690000
  <<EXTRACT INFORMATION FROM IOQ TABLE OR ELEMENT>>            <<06989>>08695000
  TOS:=@MFDSWORD;   <<STORE WORD IN MFDSWORD>>                 <<06989>>08700000
  TOS:=SNAPSHOT'DST;       <<DST FOR TABLE>>                   <<06989>>08705000
  TOS:=WORDOFFSET;         <<WORD TO BE EXTRACTED>>            <<06989>>08710000
  TOS:=1;                                                      <<06989>>08715000
  ASSEMBLE (MFDS4); <<DELETE FOUR WORDS ON TOS>>               <<06989>>08720000
  AIOQ:=MFDSWORD;                                              <<06989>>08725000
END;     <<OF IOQ >>                                           <<06989>>08730000
                                                               <<06989>>08735000
                                                               <<06989>>08740000
PROCEDURE FORMAT'IOQ(DEV,IOQ'ENTRY'INDEX,QUEUE'DST);           <<06989>>08745000
VALUE DEV,IOQ'ENTRY'INDEX,QUEUE'DST;                           <<06989>>08750000
INTEGER IOQ'ENTRY'INDEX;                                       <<06989>>08755000
INTEGER DEV,QUEUE'DST;                                         <<06989>>08760000
<<FORMAT'IOQ passes to PRINT'INFO the index to which the >>    <<06989>>08765000
<<info to be printed should be placed on a line and the >>     <<06989>>08770000
<<right location of where the information is contained.>>      <<06989>>08775000
<<DEV holds the value of the device the user wants the IOQ's>> <<06989>>08780000
<<displayed for. If DEV equals 0, then IOQ's for all devices>> <<06989>>08785000
<<are displayed. OFFSET points to the entry number referenced>><<06989>>08790000
BEGIN   <<SET UP OF HOW TO PRINT INFO OF IOQ ELEMENT>>         <<06989>>08795000
INTEGER REL'INDEX;                                             <<06989>>08800000
  DEFINE IOQ = AIOQ#;                                          <<06989>>08805000
  DEFINE IQH = AIOQ#;                                          <<06989>>08810000
MOVE PRINT'DATA:=80(" ");                                      <<06989>>08815000
REL'INDEX:=INTEGER(IOQ'QLINK);                                 <<06989>>08820000
                                                               <<06989>>08825000
 IF (DEV=0) OR IOQ'LDEV  =                                     <<06989>>08830000
 LOGICAL(DEV) THEN                                             <<06989>>08835000
   BEGIN                                                       <<06989>>08840000
     PRINT'INFO(0,IOQ'POINTER);                                <<06989>>08845000
     DEV'CHECK:=TRUE;<<CHECK FOR DEVICE FOR DECIMAL PRINTING>> <<06989>>08850000
     PRINT'INFO( 5,IOQ'LDEV);                                  <<06989>>08855000
     DEV'CHECK:=FALSE;   << CONTINUE OCTAL PRINTING >>         <<06989>>08860000
     PRINT'INFO(9,IOQ'QLINK);                                  <<06989>>08865000
     PRINT'INFO(16,IOQ'UNIT);                                  <<06989>>08870000
     PRINT'INFO(20,IOQ'PCB.(1:15));                            <<06989>>08875000
     PRINT'INFO(24,IOQ'BUFDST);                                <<06989>>08880000
     PRINT'INFO(31,IOQ'BUFADR);                                <<06989>>08885000
     PRINT'INFO(38,IOQ'FUNC);                                  <<06989>>08890000
     PRINT'INFO(42,IOQ'COUNT);                                 <<06989>>08895000
     PRINT'INFO(49,IOQ'FLAGS);                                 <<06989>>08900000
     PRINT'INFO(56,IOQ'PARM1);                                 <<06989>>08905000
     PRINT'INFO(62,IOQ'PARM2);                                 <<06989>>08910000
     PRINT'INFO(69,IOQ'QMISC);                                 <<06989>>08915000
     PRINT(PRINT'DATA,-79,%40);                                <<06989>>08920000
     MOVE PRINT'DATA:=80(" ");                                 <<06989>>08925000
     MOVE PRINT'DATA(9):="=";                                  <<06989>>08930000
     PRINT'INFO(10,REL'INDEX);                                 <<06989>>08935000
     MOVE PRINT'DATA(15):=":QUE RELATIVE INDEX.";              <<06989>>08940000
     MOVE PRINT'DATA(37):="STATUS OF THE ABOVE EQUALS ";       <<06989>>08945000
     PRINT'INFO(64,IOQ'STAT );                                 <<06989>>08950000
     MOVE PRINT'DATA(65):=".";                                 <<06989>>08955000
     PRINT'INFO(66,IOQ'STAT );                                 <<06989>>08960000
     PRINT(PRINT'DATA,-79,%40);                                <<06989>>08965000
   END;    << OF IF >>                                         <<06989>>08970000
END;     << OF FORMAT'IOQ >>                                   <<06989>>08975000
                                                               <<04830>>08980000
                                                               <<04830>>08985000
$PAGE                                                                   08990000
                                                                        08995000
PROCEDURE GETINPUT(PL, CMND);                                           09000000
  VALUE PL, CMND;    INTEGER PL;    LOGICAL CMND;                       09005000
  <<                                                                    09010000
    THIS ROUTINE GETS A COMMAND FROM $STDIN (SOURCE=0), THE STORED      09015000
    PROGRAM AREA (SOURCE=1) OR THE DO FILE (SOURCE=2). IT ALSO STRIPS   09020000
    LEADING AND TRAILING BLANKS FROM THE COMMAND.                       09025000
  >>                                                                    09030000
  BEGIN                                                                 09035000
  L := MORE;                                                            09040000
  IF <> THEN   << GET MORE OF MULTIPLE COMMAND LINE >>                  09045000
    BEGIN   MOVE BM := SAVE(1),(L);   MORE := 0;    L := L - 1;   END   09050000
  ELSE CASE SOURCE OF BEGIN                                             09055000
    BEGIN     << OUTPUT PROMPT AND READ FROM INPUT DEVICE >>            09060000
    IF CMND THEN FCONTROL(IN, 16, T);   << DISABLE CONTROL Y >>         09065000
    IF EFLAG THEN RETURN;  << CY OCCURED WHILE WAITING TO DISABLE >>    09070000
    PRINT'( pa, PL, %320 );                                             09075000
    L := READX( M, -72 );                                      <<00924>>09080000
    IF <> THEN << :EOD,:EOF: READ >>                           <<00924>>09085000
      NOMORE := EFLAG := TRUE;                                 <<00924>>09090000
    IF NOT DUP THEN PRINT'(M,-L,0);  << DUPLICATE INPUT >>              09095000
    FCONTROL(IN, 17, T);   << ENABLE CONTROL Y >>                       09100000
    IF EFLAG THEN  << EOD/NO LENGTH ABORT >>                   <<00924>>09105000
      BEGIN PRINTE(M18W,13); RETURN; END;                      <<00924>>09110000
    STRIPBLANKS;                                                        09115000
    END;                                                                09120000
                                                                        09125000
    DO BEGIN      << GET COMMAND FROM STORED PROGRAM >>                 09130000
    IF PC=PROGEND THEN BEGIN    << END OF PROGRAM >>                    09135000
      PC := 0;    << RESET PROGRAM FETCH POINTER >>                     09140000
      PROGRUN := PROGRUN - 1;                                           09145000
      IF < THEN SFLAG := TRUE;     << END OF PROGRAM RUNS >>            09150000
      END                                                               09155000
    ELSE BEGIN                                                          09160000
      LASTLINE := PROG(PC);                                             09165000
      L := PROG(PC+1);  << STATEMENT LENGTH >>                          09170000
      MOVE BM := BPROG((PC+2)&LSL(1)),(L);                              09175000
      STEP'PC(PC);    << STEP TO NEXT STATEMENT >>                      09180000
      STRIPBLANKS;                                                      09185000
      IF SHOW<>0 THEN  << PRINT PROMPT AND PROGRAM STATEMENT >>         09190000
        BEGIN   PRINT'(pa, PL, %320);   PRINT'(M, -L, 0);   END;        09195000
      END;                                                              09200000
    END UNTIL SFLAG OR L<>0;                                            09205000
                                                                        09210000
    BEGIN      << GET COMMAND DO FILE >>                                09215000
    L := FREAD(DF, M, -80);                                             09220000
    IF = THEN                                                           09225000
      BEGIN                                                             09230000
      IF L>72 THEN   << SAVE LINE NUMBER >>                             09235000
        BEGIN   MOVE LINENO(4) := BM(72),(8);   L := 72;   END          09240000
      ELSE LINENO(4) := " ";  << NO LINE NUMBER >>                      09245000
      STRIPBLANKS;                                                      09250000
      IF SHOW<>0 THEN  << PRINT PROMPT AND PROGRAM STATEMENT >>         09255000
        BEGIN   PRINT'(PA, PL, %320);   PRINT'(M, -L, 0);   END;        09260000
      END                                                               09265000
    ELSE SFLAG := TRUE;                                                 09270000
    END;                                                                09275000
    END;   << SOURCE CASE >>                                            09280000
                                                                        09285000
  I := 0;                                                               09290000
  IF CMND AND NOT ("0"<=CHAR<="9") AND CHAR<>"%" THEN                   09295000
    WHILE I<L DO BEGIN  << LOOK FOR MULTIPLE COMMANDS >>                09300000
      IF INTEGER(BM(I))=QUOTE THEN BEGIN  << SCAN OFF QUOTED STRING >>  09305000
        J := I + 1;  << STEP OVER LEADING QUOTE >>                      09310000
        WHILE J<L AND INTEGER(BM(J))<>QUOTE DO J := J + 1;              09315000
        IF J<L THEN I := J;   << STEP OVER QUOTED STRING >>             09320000
        END;                                                            09325000
                                                                        09330000
      IF BM(I)="<<" THEN BEGIN    << SCAN OVER COMMENT >>               09335000
        J := I + 2;   << STEP OVER COMMENT DELIMITER >>                 09340000
        WHILE J<L AND BM(J)<>">>" DO J := J + 1;                        09345000
        IF J<L THEN I := J;   << STEP OVER COMMENT >>                   09350000
        END;                                                            09355000
                                                                        09360000
      IF INTEGER(BM(I))=";" THEN BEGIN  << MULTIPLE COMMANDS >>         09365000
        MORE := L - I;   << SET LENGTH OF REMAINING COMMAND >>          09370000
        MOVE SAVE := BM(I),(MORE);   << SAVE REMAINING COMMANDS >>      09375000
        L := I;          << NEW LENGTH AND TERMINATE SCAN >>            09380000
        END                                                             09385000
      ELSE I := I + 1;   << STEP TO NEXT CHARACTER >>                   09390000
      END;                                                              09395000
  STRIPBLANKS;                                                          09400000
  END;    << GET INPUT >>                                               09405000
  COMMENT                                                      <<04830>>09410000
    PROCEDURE CORE LOADS FROM A 2 WORD LOCATION CONSISTING OF  <<04830>>09415000
    BANK AND OFFSET AND RETURNS THE LOADED WORD AS THE FUNCTION<<04830>>09420000
    VALUE OF CORE;                                             <<04830>>09425000
                                                               <<04830>>09430000
  LOGICAL PROCEDURE CORE(LOCATION);                            <<04830>>09435000
    VALUE LOCATION;                                            <<04830>>09440000
    DOUBLE LOCATION;                                           <<04830>>09445000
      BEGIN                                                    <<04830>>09450000
      TOS := LOCATION;           << PUT ADDRESS  ON TOS >>     <<04830>>09455000
      ASSEMBLE(LSEA;DELB,DELB); << LOAD, DEL BANK AND OFFSET >><<04830>>09460000
      CORE := TOS;                                             <<04830>>09465000
      END;                                                     <<04830>>09470000
                                                               <<04830>>09475000
                                                               <<04830>>09480000
                                                               <<04830>>09485000
                                                               <<04830>>09490000
                                                               <<04830>>09495000
                                                               <<04830>>09500000
                                                               <<04830>>09505000
                                                               <<04830>>09510000
  LOGICAL PROCEDURE SNAPSHOT(LOCATION,LENGTH);                 <<04830>>09515000
    VALUE LOCATION,LENGTH;                                     <<04830>>09520000
    DOUBLE LOCATION;                                           <<04830>>09525000
    INTEGER LENGTH;                                            <<04830>>09530000
  <<Procedure SNAPSHOT takes a picture of the IOQ or the DRQ,>><<04830>>09535000
  <<stores it in a data seg to be recalled later for display>> <<04830>>09540000
  <<LOCATION contains the location of the table to access.>>   <<04830>>09545000
  <<LENGTH passes the size of the data segment. SNAPSHOT>>     <<04830>>09550000
  <<returns the extra data segment number. >>                  <<04830>>09555000
    BEGIN                                                      <<04830>>09560000
      EQUATE MAX'XDS'SIZE'ADR = %1111;                         <<04830>>09565000
      EQUATE MSTARTPTR = %1034;                                <<06989>>09570000
      LOGICAL ARRAY DUMMYBUF(0:15);                            <<04830>>09575000
      LOGICAL MAX'XDS'SIZE,DSTNO,RESIDENT:=FALSE;              <<04830>>09580000
      MAX'XDS'SIZE := ABSOLUTE(MAX'XDS'SIZE'ADR);              <<04830>>09585000
      ABSOLUTE(MAX'XDS'SIZE'ADR) := LENGTH + 128;              <<04830>>09590000
      SNAPSHOT := DSTNO := GETDATASEG(LENGTH,0);               <<04830>>09595000
      IF < THEN PRINT(LBUF,10,0);                              <<04830>>09600000
      ABSOLUTE(MAX'XDS'SIZE'ADR) := MAX'XDS'SIZE;              <<04830>>09605000
      WHILE NOT RESIDENT DO                                    <<04830>>09610000
        BEGIN                                                  <<04830>>09615000
        TOS := @DUMMYBUF;                                      <<04830>>09620000
        TOS := DSTNO;  <<DATA SEGMENT OF TABLE SPECIFIED>>     <<04830>>09625000
        TOS := 0;   << OFFSET >>                               <<04830>>09630000
        TOS := 2;                                              <<04830>>09635000
        ASSEMBLE(MFDS 4);                                      <<04830>>09640000
        DISABLE;                                               <<04830>>09645000
        IF ABSOLUTE(DSTNO*4 +ABSOLUTE(2) ).(0:1)=1             <<04830>>09650000
          THEN ENABLE                                          <<04830>>09655000
          ELSE                                                 <<04830>>09660000
            BEGIN                                              <<04830>>09665000
            TOS := ABSOLUTE(DSTNO*4 + ABSOLUTE(2) + 2);        <<04830>>09670000
            TOS := ABSOLUTE(DSTNO*4 + ABSOLUTE(2) + 3);        <<04830>>09675000
            TOS := LOCATION;                                   <<04830>>09680000
            TOS := LENGTH;                                     <<04830>>09685000
            ASSEMBLE(MABS 5);                                  <<04830>>09690000
            RESIDENT := TRUE;                                  <<04830>>09695000
            MSTART:=CORE( MSTARTPTR D );                       <<06989>>09700000
                                                               <<06989>>09705000
            ENABLE;                                            <<04830>>09710000
            END; << ELSE >>                                    <<04830>>09715000
        END;  << WHILE >>                                      <<04830>>09720000
                                                               <<04830>>09725000
    END;   << SNAPSHOT >>                                      <<04830>>09730000
                                                               <<04830>>09735000
                                                               <<04830>>09740000
PROCEDURE PRINTMON;                                            <<04830>>09745000
  BEGIN                                                        <<04830>>09750000
    DOUBLE MONPTR:=%1017D,LOCMON,CLOC,ENDMON,STMON:=%1260D;    <<04830>>09755000
      LOGICAL  MSIZE;                                          <<04830>>09760000
      LOGICAL WORK1,WORK2,MFDSWORD,MONDST;                     <<04830>>09765000
   EQUATE MEASINFOTABPTR = %1261;                              <<04830>>09770000
                                                               <<04830>>09775000
LOGICAL SUBROUTINE MON(CORELOC);                               <<04830>>09780000
  VALUE CORELOC;                                               <<04830>>09785000
  DOUBLE CORELOC;                                              <<04830>>09790000
    BEGIN                                                      <<04830>>09795000
    TOS := LOGICAL(CORELOC-LOCMON);                            <<04830>>09800000
    TOS := 1;   << MOVE COUNT >>                               <<04830>>09805000
    TOS := @MFDSWORD;                                          <<04830>>09810000
    TOS := MONDST;                                             <<04830>>09815000
    ASSEMBLE( DXCH );  << SWITCH SEGMENT OFFSET AND LENGTH>>   <<04830>>09820000
                       <<WITH PREVIOUS TWO WORDS >>            <<04830>>09825000
    ASSEMBLE(MFDS4);                                           <<04830>>09830000
    MON := MFDSWORD;                                           <<04830>>09835000
    END;                                                       <<04830>>09840000
                                                               <<04830>>09845000
SUBROUTINE EVENT(ENUMB);                                       <<04830>>09850000
  VALUE ENUMB;                                                 <<04830>>09855000
  INTEGER ENUMB;                                               <<04830>>09860000
  BEGIN                                                        <<04830>>09865000
      MOVE BYTENUM := "          ";                            <<04830>>09870000
      IF 0<=ENUMB<=8 THEN                                      <<04830>>09875000
      CASE ENUMB OF                                            <<04830>>09880000
      BEGIN   << CASES >>                                      <<04830>>09885000
                                                               <<04830>>09890000
         BEGIN     <<0>>                                       <<04830>>09895000
            MOVE BYTENUM:="QONSEG";                            <<04830>>09900000
         END;                                                  <<04830>>09905000
         BEGIN     <<1>>                                       <<04830>>09910000
            MOVE BYTENUM:="MAKEOC";                            <<04830>>09915000
         END;                                                  <<04830>>09920000
         BEGIN     <<2>>                                       <<04830>>09925000
            MOVE BYTENUM:="SPECIALRQ";                         <<04830>>09930000
         END;                                                  <<04830>>09935000
         BEGIN     <<3>>                                       <<04830>>09940000
            GO TO PNUMB;                                       <<04830>>09945000
         END;                                                  <<04830>>09950000
         BEGIN     <<4>>                                       <<04830>>09955000
            MOVE BYTENUM:="FETCHSEG";                          <<04830>>09960000
         END;                                                  <<04830>>09965000
         BEGIN     <<5>>                                       <<04830>>09970000
            MOVE BYTENUM:="SEGIO";                             <<04830>>09975000
         END;                                                  <<04830>>09980000
         BEGIN     <<6>>                                       <<04830>>09985000
            MOVE BYTENUM:="SIODONE";                           <<04830>>09990000
         END;                                                  <<04830>>09995000
         BEGIN;    <<7>>                                       <<04830>>10000000
            MOVE BYTENUM:="CGARBAGE";                          <<04830>>10005000
         END;                                                  <<04830>>10010000
         BEGIN     <<8>>                                       <<04830>>10015000
            MOVE BYTENUM:="SWAPIN";                            <<04830>>10020000
         END;                                                  <<04830>>10025000
      END                                                      <<04830>>10030000
      ELSE IF ENUMB=12 THEN MOVE BYTENUM:="ALLOCMEM"           <<04830>>10035000
      ELSE IF ENUMB=13 THEN MOVE BYTENUM:="DEALLOCM"           <<04830>>10040000
      ELSE IF ENUMB=24 THEN MOVE BYTENUM:="EXCHDB"             <<04830>>10045000
      ELSE IF ENUMB=40 THEN MOVE BYTENUM:="QUIESCE"            <<04830>>10050000
      ELSE IF ENUMB=%300 THEN MOVE BYTENUM:="INTERRUPT"        <<04830>>10055000
      ELSE IF ENUMB=%301 THEN MOVE BYTENUM:="SIOP-INST"        <<04830>>10060000
      ELSE IF ENUMB=%302 THEN MOVE BYTENUM:="SIODM-ENT"        <<04830>>10065000
      ELSE IF ENUMB=%303 THEN MOVE BYTENUM:="SIODM-EXT"        <<04830>>10070000
      ELSE                                                     <<04830>>10075000
PNUMB:                                                         <<04830>>10080000
        IF BYTENUM="  " THEN                                   <<04830>>10085000
         BEGIN        <<PUT OUT NUMBER ONLY>>                  <<04830>>10090000
         ASCII(ENUMB,8,BYTENUM);                               <<06989>>10095000
         END;         <<PUT OUT NUMBER ONLY>>                  <<04830>>10100000
      IF BYTENUM<>"    " THEN PRINT(LBYTENUM,-10,%320);        <<04830>>10105000
 END;  <<EVENT SUBROUTINE>>                                    <<04830>>10110000
                                                               <<06989>>10115000
                                                               <<06989>>10120000
<<MOVE DBUFFER(23):="******    MONITOR TABLE    ******"; >>    <<06989>>10125000
<<PRINTLINE;    >>                                             <<06989>>10130000
<<SKIPLINES(3);   >>                                           <<06989>>10135000
   WORK1 := CORE(%1011D);                                      <<06989>>10140000
   TOS := WORK1 LAND %37;                                      <<06989>>10145000
   TOS := (WORK1 LAND %177740) + %1000; << OFFSET IN BANK >>   <<06989>>10150000
   LOCMON := TOS;                                              <<06989>>10155000
  MSIZE:=CORE(LOCMON-1D);                                      <<06989>>10160000
  IF MSIZE < 8 THEN MSIZE:=%2000;                              <<06989>>10165000
  IF MSIZE > 8192 THEN MSIZE:=%2000;                           <<06989>>10170000
  MONDST := SNAPSHOT(LOCMON,MSIZE);                            <<06989>>10175000
  ENDMON:=LOCMON+DOUBLE(MSIZE);                                <<06989>>10180000
   << MSTART IS SET IN SNAPSHOT WHILE DISABLED >>              <<06989>>10185000
   IF (MSTART:=MSTART-8)<8 THEN MSTART:=CORE(LOCMON-1D)-8;     <<06989>>10190000
  IF MSTART>(MSIZE-8) THEN GO BAILOUT;                         <<06989>>10195000
  MOVE LBUF:="LOC   PIN    EVENT";                             <<06989>>10200000
  MOVE LBUF(18):="                         PIN  EVENT ";       <<06989>>10205000
  PRINT(LBUF,-78,0);                                           <<06989>>10210000
   CLOC:=DOUBLE(MSTART)+LOCMON;                                <<06989>>10215000
  IF CLOC < 1D THEN GO BAILOUT;                                <<06989>>10220000
  CYFLAG := 0;                                                 <<06989>>10225000
  WHILE (MSIZE > 8) AND NOT CYFLAG DO                          <<06989>>10230000
  BEGIN                                                        <<06989>>10235000
    MOVE BYTENUM := "             ";                           <<06989>>10240000
   PRINT(LBYTENUM(2),0*DASCII(CLOC,8,BYTENUM)-8,%320);         <<06989>>10245000
    WORK2:=0;            <<COLUMN COUNTER>>                    <<06989>>10250000
    WHILE MSIZE > 0 LAND WORK2 < 1 DO                          <<06989>>10255000
     BEGIN               <<WHILE ROOM ACROSS PAGE>>            <<06989>>10260000
      WORK1:= MON(CLOC); <<PICK UP PIN AND EVENT>>             <<06989>>10265000
      MOVE BYTENUM := "          ";                            <<06989>>10270000
     PRINT(LBYTENUM(2),-5+0*ASCII(WORK1,8,BYTENUM),%320);      <<06989>>10275000
      EVENT(MON(CLOC+1D));   <<EVENT>>                         <<06989>>10280000
      MOVE BYTENUM := "          ";                            <<06989>>10285000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+2D),8,BYTENUM),%320);  <<06989>>10290000
      MOVE BYTENUM := "          ";                            <<06989>>10295000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+3D),8,BYTENUM),%320);  <<06989>>10300000
      MOVE BYTENUM := "          ";                            <<06989>>10305000
     PRINT(LBYTENUM,-8+0*ASCII(MON(CLOC+4D),8,BYTENUM),%320);  <<06989>>10310000
      MOVE BYTENUM := "          ";                            <<06989>>10315000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+5D),8,BYTENUM),%320);  <<06989>>10320000
      MOVE BYTENUM := "          ";                            <<06989>>10325000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+6D),8,BYTENUM),%320);  <<06989>>10330000
      MOVE BYTENUM := "          ";                            <<06989>>10335000
     PRINT(LBYTENUM,-8+0*ASCII(MON(CLOC+7D),8,BYTENUM),%320);  <<06989>>10340000
      CLOC:=CLOC-8D;        <<NEXT LOCATION>>                  <<06989>>10345000
      IF CLOC < LOCMON+8D                                      <<06989>>10350000
        THEN CLOC:=ENDMON-8D;  << TABLE WRAPS AROUND >>        <<06989>>10355000
      MSIZE:=MSIZE-8;       <<FOUR FEWER WORDS LEFT>>          <<06989>>10360000
      WORK2:=WORK2+1;       <<COUNT COLUMNS DONE>>             <<06989>>10365000
     END;                <<DONE ACROSS PAGE>>                  <<06989>>10370000
   PRINT(LBYTENUM,0,0);  <<PRINT FORMATTED LINE>>              <<06989>>10375000
  END;                                                         <<06989>>10380000
BAILOUT:                                                       <<06989>>10385000
CYFLAG := 0;                                                   <<06989>>10390000
IF MONDST <> 0 THEN RELDATASEG(MONDST);                        <<06989>>10395000
END;  <<  PROCEDURE PRINTMON  >>                               <<06989>>10400000
                                                               <<06989>>10405000
                                                               <<06989>>10410000
PROCEDURE PRINT'IOQ (TYPE'IOQ,DEV,DSEGNUM,HEADER'SIZE);        <<06989>>10415000
VALUE TYPE'IOQ,DEV,DSEGNUM,HEADER'SIZE;                        <<06989>>10420000
INTEGER TYPE'IOQ,DEV,DSEGNUM,HEADER'SIZE;                      <<06989>>10425000
<<Procedure PRINT'IOQ either prints the IOQ or the DRQ.>>      <<06989>>10430000
<<There are three types of each: the whole, free or active >>  <<06989>>10435000
<<list. TYPE'IOQ tells the type of either table wanted, DEV>>  <<06989>>10440000
<<holds the device specified, DSEGNUM and HEADER'SIZE holds >> <<06989>>10445000
<<the values of the IOQ or the DRQ. PRINT'IOQ calls SNAP'SHOT>><<06989>>10450000
<<which returns the dataseg# that will be used in IOQ. >>      <<06989>>10455000
<<PRINT'IOQ checks TYPE'IOQ and according to what the value >> <<06989>>10460000
<<is,does the calculations so that FORMAT'IOQ can display it.>><<06989>>10465000
BEGIN                                                          <<06989>>10470000
  EQUATE MAX'FREE'LIST'SIZE = 2048;                            <<06989>>10475000
  INTEGER                                                      <<06989>>10480000
     LENGTH'IOQ,COUNT,SEARCHCOUNT,NO'FREE,IOQ'ENTRY'INDEX;     <<06989>>10485000
  DOUBLE  LOC'IOQ;                                             <<06989>>10490000
  LOGICAL FREE, IOQ'ENTRIES, IOQ'ENTRY'SIZE;                   <<06989>>10495000
  LOGICAL ARRAY FREE'LIST(0:MAX'FREE'LIST'SIZE);               <<06989>>10500000
  EQUATE DSTBANK=2, DSTOFFSET=3;                               <<06989>>10505000
  DEFINE DSTBASE=ABSOLUTE(2)#;                                 <<06989>>10510000
  DEFINE IOQ = AIOQ#;                                          <<06989>>10515000
  DEFINE IQH = AIOQ#;                                          <<06989>>10520000
  TOS:=ABSOLUTE(DSTBASE+ DSEGNUM *4+DSTBANK);<<ENTER IOQ'DST>> <<06989>>10525000
  TOS:=ABSOLUTE(DSTBASE + DSEGNUM *4 + DSTOFFSET);             <<06989>>10530000
  LOC'IOQ:=TOS;                                                <<06989>>10535000
  LENGTH'IOQ:=ABSOLUTE(DSTBASE + DSEGNUM *4 + 0).(3:13)*4;     <<06989>>10540000
  SNAPSHOT'DST:=SNAPSHOT(LOC'IOQ,LENGTH'IOQ);                  <<06989>>10545000
  IOQ'ENTRY'SIZE:=IQH'ENT'SIZE;                                <<06989>>10550000
  IOQ'ENTRIES:=IQH'TOT'ENT;                                    <<06989>>10555000
            <<FREEZE IOQ AND COPY>>                            <<06989>>10560000
  COUNT:=0;                                                    <<06989>>10565000
  CYFLAG := 0;                                                 <<06989>>10570000
  IF TYPE'IOQ = 0 THEN  <<PRINT WHOLE IOQ>>                    <<06989>>10575000
   DO                                                          <<06989>>10580000
     BEGIN                                                     <<06989>>10585000
       IOQ'POINTER:=INTEGER(HEADER'SIZE)   +                   <<06989>>10590000
        COUNT * INTEGER(IQH'ENT'SIZE);                         <<06989>>10595000
       FORMAT'IOQ(DEV,IOQ'POINTER,DSEGNUM);                    <<06989>>10600000
       COUNT:=COUNT+1;                                         <<06989>>10605000
     END                                                       <<06989>>10610000
   UNTIL (COUNT>=INTEGER(IOQ'ENTRIES)) OR CYFLAG               <<06989>>10615000
  ELSE                                                         <<06989>>10620000
  BEGIN                                                        <<06989>>10625000
        <<FREE OR ACTIVE LIST>>                                <<06989>>10630000
  IF (TYPE'IOQ = 1) OR (TYPE'IOQ = 2) THEN                     <<06989>>10635000
     BEGIN                                                     <<06989>>10640000
       IOQ'POINTER:=IQH'FREEHEAD;      <<INDEX TO FIRST FREE>> <<06989>>10645000
       DO                                                      <<06989>>10650000
         BEGIN                                                 <<06989>>10655000
           IOQ'ENTRY'INDEX := IOQ'POINTER;                     <<06989>>10660000
           FREE'LIST(COUNT):=IOQ'POINTER; <<STORE FREE IOQ'S>> <<06989>>10665000
           IF TYPE'IOQ=1 THEN                                  <<06989>>10670000
              FORMAT'IOQ(DEV,IOQ'POINTER,DSEGNUM);             <<06989>>10675000
           COUNT:=COUNT+1;    <<KEEP COUNT OF FREE IOQ'S>>     <<06989>>10680000
           IOQ'POINTER:=IOQ(IOQ'POINTER + LINK); <<NEXT FREE>> <<06989>>10685000
           NO'FREE := COUNT;                                   <<06989>>10690000
         END    <<OF DO>>                                      <<06989>>10695000
       UNTIL COUNT>=INTEGER(IOQ'ENTRIES) OR IOQ'POINTER=0      <<06989>>10700000
        OR   COUNT >= MAX'FREE'LIST'SIZE   OR   CYFLAG;        <<06989>>10705000
      END;                                                     <<06989>>10710000
  IF TYPE'IOQ = 2 THEN   <<PRINT ACTIVE LIST>>                 <<06989>>10715000
     BEGIN                                                     <<06989>>10720000
       COUNT:=0;                                               <<06989>>10725000
       WHILE COUNT<INTEGER(IQH'TOT'ENT)  AND  NOT CYFLAG DO    <<06989>>10730000
          BEGIN                                                <<06989>>10735000
            SEARCHCOUNT:=0;                                    <<06989>>10740000
            FREE:=FALSE; <<IF FREE WILL EXIT AND NOT PRINT>>   <<06989>>10745000
            WHILE (SEARCHCOUNT<NO'FREE)  AND NOT FREE DO       <<06989>>10750000
            <<COMPARE ENTRIES IN WHOLE LIST W/ FREE LIST >>    <<06989>>10755000
               BEGIN                                           <<06989>>10760000
                 IF INTEGER(IQH'ENT'SIZE)                      <<06989>>10765000
                 *COUNT+HEADER'SIZE=                           <<06989>>10770000
                 INTEGER(FREE'LIST(SEARCHCOUNT)) THEN          <<06989>>10775000
                    FREE := TRUE;                              <<06989>>10780000
                 << USED TO SEARCH FREE LIST>>                 <<06989>>10785000
                 SEARCHCOUNT:=SEARCHCOUNT + 1;                 <<06989>>10790000
               END;                                            <<06989>>10795000
            IF NOT FREE THEN    << IN USE  >>                  <<06989>>10800000
              BEGIN                                            <<06989>>10805000
               IOQ'POINTER:=INTEGER(HEADER'SIZE)   +           <<06989>>10810000
                COUNT * INTEGER(IQH'ENT'SIZE);                 <<06989>>10815000
               FORMAT'IOQ(DEV, IOQ'POINTER,DSEGNUM);           <<06989>>10820000
              END;                                             <<06989>>10825000
            COUNT:=COUNT+1;     <<GO THROUGH ALL ENTRIES>>     <<06989>>10830000
          END; <<OF WHILE>>                                    <<06989>>10835000
     END;                                                      <<06989>>10840000
   END;   << OF ELSE >>                                        <<06989>>10845000
CYFLAG := 0;                                                   <<06989>>10850000
END;      << OF PRINT'IOQ >>                                   <<06989>>10855000
                                                                        10860000
PROCEDURE CHECKIOPENDING( FLGX );                                       10865000
  VALUE FLGX;  LOGICAL FLGX;                                            10870000
  <<                                                                    10875000
    CHECKS IF ANY I/O PENDING, RETURNS IOQS AND PRINTS STATUS IF        10880000
    ANY ERROR AND FLGX SET AND IF ANY I/O PENDING AND FLGX.(14:1)       10885000
    SET THEN PRINTS I/O PENDING MESSAGE.                                10890000
                                                                        10895000
    FLGX.(14:1) - ENABLE PRINTING OF I/O PENDING MESSAGE                10900000
        .(15:1) - ENABLE PRINTING OF ERROR STATUS                       10905000
  >>                                                                    10910000
  BEGIN                                                                 10915000
    K := 0;                                                             10920000
                                                                        10925000
    WHILE K<IOPCNT DO  << CHECK FOR I/O PENDING >>                      10930000
     IF IOQX(K)<>0 THEN                                                 10935000
      BEGIN                                                             10940000
        TOS := IOSTATUS(IOQX(K));                                       10945000
        XLOG := TOS;    STATUS := TOS;                                  10950000
                                                                        10955000
        IF <> THEN  << NOT DONE YET >>                                  10960000
          BEGIN                                                         10965000
            IF < THEN   << IOQX IS BAD OR SOME ERROR >>                 10970000
              BEGIN                                                     10975000
                PRINTX(M21W, 7);  << IOSTATUS ERROR >>                  10980000
                IOQX(K) := IOQX(IOPCNT);   << FILL HOLE >>              10985000
                IOPCNT := IOPCNT - 1;    << DECREMENT PENDING COUNT >>  10990000
              END;                                                      10995000
                                                                        11000000
            K := K + 1;      << STEP TO NEXT >>                         11005000
            STATUS := XLOG := 0;   << CLEAR RETURNS >>                  11010000
          END                                                           11015000
        ELSE                                                            11020000
          BEGIN                                                         11025000
            IOPCNT := IOPCNT - 1;                                       11030000
            Q'ENTRY'INDEX := LOGICAL(IOQX(K)) LAND %37777;     <<*7479>>11035000
            LASTLDEV := IF IOQX(K).(1:1)=1  << THEN DISC >>    <<*7479>>11040000
                          THEN DRQ'LDEV ELSE IOQ'LDEV;         <<*7479>>11045000
            LASTFUNC := IF IOQX(K).(1:1)=1  << THEN DISC >>    <<*7479>>11050000
                          THEN DRQ'FUNC ELSE IOQ'FUNC;         <<*7479>>11055000
            IOQX(K) := IOQX(IOPCNT);   << MOVE LAST TO HOLE >>          11060000
            IF FLGX AND STATUS.(13:3)<>1 THEN PRINTSTATUS;              11065000
          END;                                                          11070000
      END;                                                              11075000
                                                                        11080000
    IF IOPCNT<>0 AND FLGX.(14:1) THEN PRINTX(M3, -27); << I/O PENDING >>11085000
  END;   << CHECK IO PENDING >>                                         11090000
$PAGE                                                                   11095000
                                                                        11100000
LOGICAL PROCEDURE CONVERTPARAMS;                                        11105000
  <<                                                                    11110000
    THIS PROCEDURE CONVERTS 1 OR 2 PARAMETERS TO BINARY FROM OCTAL      11115000
    DECIMAL OR LITERALS IN QUOTES.   RESULTS ARE PLACED IN R AND R1     11120000
    AND THE FLAGS NOPARAM AND TWOPARAMS ARE SET DEPENDING ON THE        11125000
    PARAMETERS.   RETURNS TRUE IF A GOOD PARAMETER IS FOUND.            11130000
  >>                                                                    11135000
  BEGIN                                                                 11140000
    TWOPARAMS := NOPARAM := FALSE;                                      11145000
    R := 0;     R1 := 1;                                                11150000
                                                                        11155000
    IF I=L THEN NOPARAM := TRUE      << NO PARAMETERS >>                11160000
    ELSE IF INTEGER(BM)="A" THEN  << ASCII COMMAND >>                   11165000
      BEGIN   << PROCESS ASCII LITERAL PARAMETER >>                     11170000
        IF CHAR<>QUOTE THEN RETURN;   << NO STARTING QUOTE, ERROR >>    11175000
        I := I + 1;   << STEP OVER QUOTE >>                             11180000
        R1 := I;      << SAVE STRING BEGINNING POINTER >>               11185000
        WHILE CHAR<>QUOTE DO  << SCAN FOR ENDING QUOTE >>               11190000
          IF I<L THEN I := I + 1 ELSE RETURN;  << ERROR >>              11195000
        R := I - R1;  << SAVE LENGTH OF STRING >>                       11200000
        I := I + 1;   << STEP OVER ENDING QUOTE >>                      11205000
      END                                                               11210000
    ELSE IF M="DO" THEN CONVERTPARAMS := TRUE  << THE DO COMMAND >>     11215000
    ELSE     << PROCESS NUMERIC PARAMETER >>                            11220000
      BEGIN                                                             11225000
        R := EXPRESSION;                                                11230000
        IF <> THEN RETURN;   << ERROR >>                                11235000
        IF CHAR="," THEN   << LOOK FOR 2ND PARAMETER >>                 11240000
          BEGIN                                                         11245000
            I := I + 1;    << STEP OVER COMMA >>                        11250000
            R1 := EXPRESSION;                                           11255000
            IF <> THEN RETURN;   << ERROR >>                            11260000
            TWOPARAMS := TRUE;                                          11265000
          END                                                           11270000
        ELSE R1 := 1;   << DEFAULT 2ND PARAM >>                         11275000
      END;                                                              11280000
                                                                        11285000
    IF I=L THEN CONVERTPARAMS := TRUE;   << GOOD FORMAT >>              11290000
   END;    <<CONVERT PARAMS>>                                  <<04830>>11295000
                                                               <<04830>>11300000
                                                               <<04830>>11305000
PROCEDURE SETBIT(V,BITNO);                                     <<04830>>11310000
VALUE BITNO; LOGICAL V, BITNO;                                 <<04830>>11315000
<<Set the bit corresponding to the buffer'no being used>>      <<04830>>11320000
BEGIN                                                          <<04830>>11325000
    TOS:=V;                                                    <<04830>>11330000
    X:=BITNO;                                                  <<04830>>11335000
    ASSEMBLE(TSBC 0,X);                                        <<04830>>11340000
    V:=TOS;                                                    <<04830>>11345000
END;         <<OF SETBIT>>                                     <<04830>>11350000
                                                               <<04830>>11355000
                                                               <<04830>>11360000
                                                               <<04830>>11365000
INTEGER PROCEDURE FINDBIT(V);                                  <<04830>>11370000
LOGICAL V;                                                     <<04830>>11375000
<<Find the bit corresponding to the buffer'no being used>>     <<04830>>11380000
BEGIN                                                          <<04830>>11385000
    TOS:=V;                                                    <<04830>>11390000
    ASSEMBLE(SCAN);                                            <<04830>>11395000
    FINDBIT:=X;                                                <<04830>>11400000
END;    <<OF FINDBIT>>                                         <<04830>>11405000
                                                               <<04830>>11410000
                                                               <<04830>>11415000
                                                               <<04830>>11420000
PROCEDURE UB(BUFFER'NO);                                       <<04830>>11425000
VALUE BUFFER'NO;                                               <<04830>>11430000
INTEGER BUFFER'NO;                                             <<04830>>11435000
<<Access BUFFER'NO specified. UB will make sure that the >>    <<04830>>11440000
<<buffer to be used is in range or whether the buffer is >>    <<04830>>11445000
<<already in use. UB will then get the extra data segment >>   <<04830>>11450000
<<to provide more space. >>                                    <<04830>>11455000
BEGIN                                                          <<04830>>11460000
    IF (0>BUFFER'NO) OR (BUFFER'NO>16) THEN                    <<04830>>11465000
      BEGIN     <<OUT OF RANGE>>                               <<04830>>11470000
        PRINTE(M32W,17);                                       <<04830>>11475000
        BUF'USED:=0;                                           <<04830>>11480000
        RETURN;                                                <<04830>>11485000
        END;                                                   <<04830>>11490000
    IF DSTARRAY(BUFFER'NO)<>0 OR BUFFER'NO=0 THEN              <<04830>>11495000
      BEGIN     <<EXTRA DATA SEGMENT ALREADY CREATED>>         <<04830>>11500000
          ACTVBUF:=0;    <<TURN OFF ALL BITS>>                 <<04830>>11505000
      END                                                      <<04830>>11510000
    ELSE                                                       <<04830>>11515000
      BEGIN                                                    <<04830>>11520000
          MAX'XDS'SIZE:=ABSOLUTE(MAX'XDS'SIZE'ADR);            <<04830>>11525000
          ABSOLUTE(MAX'XDS'SIZE'ADR):=XDS'SIZE;                <<04830>>11530000
          L:=GETDATASEG(XDS'SIZE,0);                           <<04830>>11535000
          IF < THEN PRINTE(M31W,10);                           <<04830>>11540000
          ACTVBUF:=0;                                          <<04830>>11545000
          DSTARRAY(BUFFER'NO):=L;     <<HOLDS DST #>>          <<04830>>11550000
          ABSOLUTE(MAX'XDS'SIZE'ADR):=MAX'XDS'SIZE;            <<04830>>11555000
      END;                                                     <<04830>>11560000
      IF BUFFER'NO <>0 THEN SETBIT(ACTVBUF,(BUFFER'NO-1));     <<04830>>11565000
END;  << OF UB >>                                              <<04830>>11570000
                                                               <<04830>>11575000
                                                               <<04830>>11580000
PROCEDURE FB(BUFFER'NO);                                       <<04830>>11585000
LOGICAL BUFFER'NO;                                             <<04830>>11590000
<<Release acquired BUFFER'NO. The buffer will be checked to >> <<04830>>11595000
<<see whether it's in range and whether a buffer which >>      <<04830>>11600000
<<is not in use is specified. Those buffers cannot be freed.>> <<04830>>11605000
BEGIN    <<OUT OF RANGE>>                                      <<04830>>11610000
    IF (0>BUFFER'NO) OR (BUFFER'NO>16) THEN                    <<04830>>11615000
      BEGIN                                                    <<04830>>11620000
        PRINTE(M32W,17);                                       <<04830>>11625000
        RETURN;                                                <<04830>>11630000
      END                                                      <<04830>>11635000
    ELSE IF BUFFER'NO=0 OR DSTARRAY(BUFFER'NO)=0 THEN          <<04830>>11640000
      BEGIN            <<INTERNAL BUF OR DOESN'T EXIST>>       <<04830>>11645000
          PRINTE(M39W,15);                                     <<04830>>11650000
          RETURN;                                              <<04830>>11655000
      END                                                      <<04830>>11660000
    ELSE                                                       <<04830>>11665000
      BEGIN                                                    <<04830>>11670000
        RELDATASEG(DSTARRAY(BUFFER'NO));                       <<04830>>11675000
        IF BUFFER'NO=LOGICAL(FINDBIT(ACTVBUF)+1) THEN          <<04830>>11680000
           BEGIN                                               <<04830>>11685000
             ACTVBUF:=0;      <<TURN OFF BITS>>                <<04830>>11690000
             BUF'USED:=0;  <<NOW USING INTERNAL BUFFER>>       <<04830>>11695000
           END;                                                <<04830>>11700000
        DSTARRAY(BUFFER'NO):=0;      <<SET TO ZERO>>           <<04830>>11705000
      END;                                                     <<04830>>11710000
END;      << OF FB>>                                           <<04830>>11715000
                                                               <<04830>>11720000
                                                               <<04830>>11725000
$PAGE "DOMAIN SUBROUTINES"                                              11730000
                                                                        11735000
PROCEDURE COMPARE(BUF1,BUF2);                                  <<04830>>11740000
LOGICAL BUF1,BUF2;                                             <<04830>>11745000
<<Compare two buffers, BUF1 and BUF2. Only extra data segs >>  <<04830>>11750000
<<can be compared. >>                                          <<04830>>11755000
BEGIN                                                          <<04830>>11760000
    INTEGER LOOPCOUNT:=-1,OFFSET:=0,BLOCK'WORDS:=128,          <<04830>>11765000
    WORDSLEFT, MOVE'COUNT,CMP'COUNT, BAD'BYTE;                 <<04830>>11770000
    DOUBLE FINDBYTE;                                           <<04830>>11775000
    WORDSLEFT:=C;     <<VALUE FROM COUNT COMMAND>>             <<04830>>11780000
    DO BEGIN                                                   <<04830>>11785000
           LOOPCOUNT:=LOOPCOUNT+1;                             <<04830>>11790000
           << ONLY 128 OR LESS AT ONCE >>                      <<04830>>11795000
           IF WORDSLEFT>BLOCK'WORDS THEN                       <<04830>>11800000
              MOVE'COUNT:=BLOCK'WORDS                          <<04830>>11805000
           ELSE                                                <<04830>>11810000
              MOVE'COUNT:=WORDSLEFT;                           <<04830>>11815000
           CMP'COUNT:=2*MOVE'COUNT; <<FOR BYTE COMPARISON>>    <<04830>>11820000
           TOS:=@COMPARE'BUF1;  << TARGET DB RELATIVE ADDR>>   <<04830>>11825000
           TOS:=DSTARRAY(BUF1);   <<SOURCE>>                   <<04830>>11830000
           TOS:=OFFSET;                                        <<04830>>11835000
           TOS:=MOVE'COUNT; <<NUMBER OF WORDS TO COMPARE>>     <<04830>>11840000
           ASSEMBLE(MFDS4);                                    <<04830>>11845000
           TOS:=@COMPARE'BUF2;                                 <<04830>>11850000
           TOS:=DSTARRAY(BUF2);                                <<04830>>11855000
           TOS:=OFFSET;                                        <<04830>>11860000
           TOS:=MOVE'COUNT;                                    <<04830>>11865000
           ASSEMBLE(MFDS4);                                    <<04830>>11870000
           OFFSET:=OFFSET+MOVE'COUNT;                          <<04830>>11875000
           WORDSLEFT:=WORDSLEFT-BLOCK'WORDS;                   <<04830>>11880000
       END                                                     <<04830>>11885000
    UNTIL (B'CMP'BUF1<>B'CMP'BUF2,(CMP'COUNT),3)               <<04830>>11890000
         OR (WORDSLEFT<=0);                                    <<04830>>11895000
    IF (B'CMP'BUF1<>B'CMP'BUF2,(CMP'COUNT),0) THEN             <<04830>>11900000
       BEGIN    <<PRINT BYTE THAT DOES NOT COMPARE>>           <<04830>>11905000
          BAD'BYTE:=TOS;                                       <<04830>>11910000
          DDEL;                                                <<04830>>11915000
          FINDBYTE:=DOUBLE(LOOPCOUNT)*DOUBLE(BLOCK'WORDS)*2D + <<04830>>11920000
          DOUBLE(CMP'COUNT) - DOUBLE(BAD'BYTE);                <<04830>>11925000
          PRINT(M34W,17,%320);                                 <<04830>>11930000
          NUMCHAR:=DASCII(FINDBYTE,10,BYTENUM);                <<04830>>11935000
          PRINT(LBYTENUM,-NUMCHAR,%320);                       <<04830>>11940000
          PRINT(M35W,-5,%320);                                 <<04830>>11945000
          NUMCHAR:=DASCII(FINDBYTE,8,BYTENUM);                 <<04830>>11950000
          PRINTE(BYTENUM,-11);                                 <<04830>>11955000
       END                                                     <<04830>>11960000
    ELSE                                                       <<04830>>11965000
       PRINT(M33W,9,%40);     <<BUFFERS ARE EQUAL>>            <<04830>>11970000
END;    << OF COMPARE >>                                       <<04830>>11975000
$CONTROL SEGMENT=FED'SEG                                       <<*7479>>11980000
                                                               <<06989>>11985000
PROCEDURE DO'EXPLAIN;                                          <<06989>>11990000
BEGIN                                                          <<06989>>11995000
  ARRAY OUT'MESSAGE(0:21);                                     <<06989>>12000000
  BYTE ARRAY BYTES'OUT(*)=OUT'MESSAGE;                         <<06989>>12005000
    ARRAY M12W(0:1600)= PB :=        <<EACH LINE IS 21 WORDS>> <<06989>>12010000
      "A   ASCII BUF FILL    AN  DO ANOTE        ",            <<06989>>12015000
      "B   OCTAL BUF FILL    C   SET COUNT PARAM ",            <<06989>>12020000
      "CH  CHECK RESULTS     CL  CLR PROG AREA   ",            <<06989>>12025000
      "CMP  CMP TWO BUFRS                        ",            <<06989>>12030000
      "D   DISPLAY PARAMS    DA  SHOW BUF ASCII  ",            <<06989>>12035000
      "DB  SHOW BUF OCTAL    DE  CALL DEBUG      ",            <<06989>>12040000
      "DEC DECIMAL CONVERT   DD  DISPLAY DIT     ",            <<06989>>12045000
      "DIOQ  DISPLAY IOQ'S :  N,LDEV.  N=0,1,OR 2",            <<06989>>12050000
      "DDRQ  DISPLAY DRQ'S:  0=ALL,1=FREE,2=INUSE",            <<06989>>12055000
      "DMON  DISPLAY SYSTEM MONITOR TABLE        ",            <<06989>>12060000
      "DRT SET DRT#          DO  READ CMND FILE  ",            <<06989>>12065000
      "DQ  DISPLAY IOQS      DS  DISPLAY STATUS  ",            <<06989>>12070000
      "DSI DISPLAY SIO PROG  E   CALL ATTACHIO   ",            <<06989>>12075000
      "EX  TERMINATE         F   SET FUNCTION    ",            <<06989>>12080000
      "FB  FREE BUFFER  #                        ",            <<06989>>12085000
      "FL  SET FLAGS         GO  GOTO STATEMENT# ",            <<06989>>12090000
      "H   CALL HELP         I   INCREMENT FILL  ",            <<06989>>12095000
      "L   SET LDEV          LD  SET LIST DEV    ",            <<06989>>12100000
      "LI  LIST PROGRAM      MB  MODIFY BUFFER   ",            <<06989>>12105000
      "MD  MODIFY DIT        MQ  MODIFY IOQ      ",            <<06989>>12110000
      "N   NULL INPUT DO E   O   OCTAL CONVERT   ",            <<06989>>12115000
      "OFFSET # SPECIFIES AN OFFSET INTO BUFFER  ",            <<06989>>12120000
      "PA  SET P1            PB  SET P2          ",            <<06989>>12125000
      "MORE?   (HIT CR TO CONTINUE.)             ",            <<06989>>12130000
      "Q   SET QMISC         R   RUN STORED PROG ",            <<06989>>12135000
      "SH  PRINT DO & PROG   T   PRINT TIME      ",            <<06989>>12140000
      "UB  USE BUFFER   #                        ",            <<06989>>12145000
                                                               <<06989>>12150000
      "V   ADD REC# IN BUF   X   EXPLAIN CMDS    ",            <<06989>>12155000
      "                                          ",            <<06989>>12160000
      "IN MOST COMMANDS WHERE A NUMBER COULD BE  ",            <<06989>>12165000
      "USED YOU MAY HAVE AN EXPRESSION.  THE     ",            <<06989>>12170000
      "EXPRESSION MAY INCLUDE NUMBERS OR ANY OF  ",            <<06989>>12175000
      "THE FOLLOWING VARIABLES:                  ",            <<06989>>12180000
      "C:     THE COUNT PARAMETER TO ATTACHIO    ",            <<06989>>12185000
      "PA:   THE P1 PARAMETER TO ATTACHIO        ",            <<06989>>12190000
      "PB:   THE P2 PARAMETER TO ATTACHIO        ",            <<06989>>12195000
      "OFFSET:  THE OFFSET INTO ATTACHIO'S BUFFER",            <<06989>>12200000
      "B(N):  THE NTH WORD OF THE INTERNAL BUFFER",            <<06989>>12205000
      "       WHERE N IS AN EXPRESSION.          ",            <<06989>>12210000
      "SOME COMMON USES OF THE ABOVE ARE:        ",            <<06989>>12215000
      "     PB  PB+1      INCREMENTS P2          ",            <<06989>>12220000
      "     PB  B(45) + B(39)/256                ",            <<06989>>12225000
      "                                          ",            <<*7479>>12230000
      "MORE?   (HIT CR TO CONTINUE.)             ",            <<*7479>>12235000
      "THE  E  COMMAND NOW CALLS P'ATTACHIO.     ",            <<*7479>>12240000
      "        THIS MEANS THAT IT DOES  'REAL IO'",            <<*7479>>12245000
      "        THAT HAS A DIRECT PATH DOWN TO THE",            <<*7479>>12250000
      "        DRIVER.                           ",            <<*7479>>12255000
      "THE  EA COMMAND IS A NEW COMMAND THAT     ",            <<*7479>>12260000
      "        CALLS ATTACHIO.  WARNING: ATTACHIO",            <<*7479>>12265000
      "        MAY CALL SDISC, CIPER, CACHING, OR",            <<*7479>>12270000
      "        P'ATTACHIO.  IT MAY NOT DO IO.    ",            <<*7479>>12275000
      "MORE?    (HIT CR TO CONTINUE.)            ",            <<06989>>12280000
      "                                          ",            <<06989>>12285000
      "C?UB #:  YOU MAY USE AN EXTRA DATA SEGMENT",            <<06989>>12290000
      "AS THE BUFFER TO ATTACHIO BY DOING THE    ",            <<06989>>12295000
      "UB N COMMAND.  THIS GETS AN EXTRA DATA SEG",            <<06989>>12300000
      "WHICH WILL BE USED UNTIL THE NEXT UB CMND.",            <<06989>>12305000
      "YOU MAY SWITCH BETWEEN EXTRA DATA SEGS    ",            <<06989>>12310000
      "WITH THE UB COMMAND.  TWO EXTRA DATA SEGS ",            <<06989>>12315000
      "CAN BE COMPARED WITH THE CB M,N  COMMAND: ",            <<06989>>12320000
      "BUFFERS M AND N ARE COMPARED FOR THE COUNT",            <<06989>>12325000
      "SPECIFIED BY THE COUNT COMMAND (C).       ",            <<06989>>12330000
      "BUFFER DATA SEGS MAY BE FREED WITH THE    ",            <<06989>>12335000
      "FB N  COMMAND.                            ",            <<06989>>12340000
      "END.                                      ";            <<06989>>12345000
                                                               <<06989>>12350000
   FOR I:=0 UNTIL 10000                                        <<06989>>12355000
     DO                                                        <<06989>>12360000
     BEGIN                                                     <<06989>>12365000
       MOVE OUT'MESSAGE := M12W(I*21),(21);                    <<06989>>12370000
       IF BYTES'OUT = "END." THEN RETURN;                      <<06989>>12375000
       PRINT'(OUT'MESSAGE,21,0);                               <<06989>>12380000
       IF BYTES'OUT = "MORE?" THEN                             <<06989>>12385000
         BEGIN                                                 <<06989>>12390000
           R := READ(OUT'MESSAGE, -1);                         <<06989>>12395000
           IF R <> 0 THEN RETURN;                              <<06989>>12400000
         END;                                                  <<06989>>12405000
     END;   <<  FOR LOOP  >>                                   <<06989>>12410000
                                                               <<06989>>12415000
END;   <<  DO'EXPLAIN  >>                                      <<06989>>12420000
                                                               <<06989>>12425000
PROCEDURE FILE'COPY;                                           <<06989>>12430000
                                                               <<06989>>12435000
COMMENT                                                        <<06989>>12440000
   THIS IS A GENERAL FILE COPY PROCEDURE.                      <<06989>>12445000
   THE USER MUST SET UP FILE EQUATIONS FOR THE FILES "FROM"    <<06989>>12450000
   AND "TO".   "FROM"   DEFAULTS TO $STDIN.                    <<06989>>12455000
;                                                              <<06989>>12460000
                                                               <<06989>>12465000
                                                               <<06989>>12470000
BEGIN                                                          <<06989>>12475000
  INTEGER FROM,TOFN,TRANSFER'COUNT,I;                          <<06989>>12480000
  BYTE ARRAY FILE'NAME(0:9);                                   <<06989>>12485000
  MOVE FILE'NAME := "FROM   ";                                 <<06989>>12490000
  FROM := FOPEN(FILE'NAME,%47);                                <<06989>>12495000
  IF <> THEN RETURN;                                           <<06989>>12500000
  MOVE FILE'NAME := "TO     ";                                 <<06989>>12505000
  TOFN   := FOPEN(FILE'NAME,%3,1);                             <<06989>>12510000
  IF <> THEN GO TO CLOSE'FROM;                                 <<06989>>12515000
  FOR I:=0 UNTIL 32000                                         <<06989>>12520000
   DO                                                          <<06989>>12525000
   BEGIN                                                       <<06989>>12530000
     TRANSFER'COUNT := FREAD(FROM,B,-16384);                   <<06989>>12535000
     IF <> THEN GO TO  CLOSE'BOTH;                             <<06989>>12540000
     IF CYFLAG THEN                                            <<06989>>12545000
      BEGIN                                                    <<06989>>12550000
        CYFLAG := 0;                                           <<06989>>12555000
        GO TO CLOSE'BOTH;                                      <<06989>>12560000
      END;                                                     <<06989>>12565000
     FWRITE(TOFN,B,-TRANSFER'COUNT,0);                         <<06989>>12570000
     IF <> THEN GO TO CLOSE'BOTH;                              <<06989>>12575000
   END;                                                        <<06989>>12580000
                                                               <<06989>>12585000
CLOSE'BOTH:                                                    <<06989>>12590000
  FCLOSE(TOFN,0,0);                                            <<06989>>12595000
CLOSE'FROM:                                                    <<06989>>12600000
  FCLOSE(FROM,0,0);                                            <<06989>>12605000
                                                               <<06989>>12610000
END;      <<    PROCEDURE   FILE'COPY   >>                     <<06989>>12615000
                                                               <<06989>>12620000
 <<>>                                                          <<06989>>12625000
 PROCEDURE REALIO(FN,INOUT,FORM,TYPE,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9);    12630000
  VALUE FN,INOUT,TYPE;                                         <<06989>>12635000
  BYTE ARRAY FORM;                                             <<06989>>12640000
  INTEGER TYPE,R1,R2,R3,R4,R5,R6,R7,R8,R9,R0;                  <<06989>>12645000
  LOGICAL INOUT;  INTEGER FN;                                  <<06989>>12650000
  OPTION VARIABLE;                                             <<06989>>12655000
  BEGIN                                                        <<06989>>12660000
   DEFINE FREEFORM = NOT PMASK.(4:1)#;                         <<06989>>12665000
   ARRAY QPARMS(*)=Q-14;                                       <<06989>>12670000
   REAL POINTER RPARM;                                         <<06989>>12675000
   BYTE ARRAY FFORMAT(0:6);                                    <<06989>>12680000
   INTEGER BIT,IOFN,J,K,L,M,N;                                 <<06989>>12685000
   LOGICAL PMASK=Q-4;                                          <<06989>>12690000
  INTRINSIC FOPEN,FCLOSE,FMTINIT',IIO',RIO',TFORM';            <<06989>>12695000
   <<>>                                                        <<06989>>12700000
   MOVE FFORMAT := "() ";                                      <<06989>>12705000
   IF FN = 0 THEN                                              <<06989>>12710000
      IOFN := FOPEN(,IF INOUT THEN %40 ELSE %10)               <<06989>>12715000
     ELSE   IOFN := FN;                                        <<06989>>12720000
   IF FREEFORM THEN FMTINIT'(FFORMAT,-IOFN,0D,%200 LOR INOUT,@DONE)     12725000
               ELSE FMTINIT'(FORM,-IOFN,0D,INOUT,@DONE);       <<06989>>12730000
   BIT := 9;                                                   <<06989>>12735000
   FOR K:= 0 UNTIL 9  DO                                       <<06989>>12740000
    BEGIN                                                      <<06989>>12745000
    IF PMASK&LSR(BIT) THEN                                     <<06989>>12750000
      BEGIN                                                    <<06989>>12755000
       @RPARM:=QPARMS(K);                                      <<06989>>12760000
       CASE  TYPE   OF                                         <<06989>>12765000
         BEGIN                                                 <<06989>>12770000
           IIO'(RPARM);                                        <<06989>>12775000
           RIO'(RPARM);                                        <<06989>>12780000
         END;                                                  <<06989>>12785000
      END;                                                     <<06989>>12790000
     BIT := BIT - 1;                                           <<06989>>12795000
    END;                                                       <<06989>>12800000
<< IIO'(PMASK);       TO PRINT THE PMASK     >>                <<06989>>12805000
   TFORM';                                                     <<06989>>12810000
   DONE:                                                       <<06989>>12815000
   IF FN= 0 THEN FCLOSE(IOFN,0,0);                             <<06989>>12820000
  RETURN;                                                      <<06989>>12825000
  END;                                                         <<06989>>12830000
 <<>>                                                          <<06989>>12835000
         PROCEDURE FINDINFILE(IIN,IOUT,IFN);                   <<06989>>12840000
         INTEGER IIN,IOUT,IFN;                                 <<06989>>12845000
         BEGIN                                                 <<06989>>12850000
         LOGICAL FOUND;                                        <<06989>>12855000
         INTEGER I,J,K,L,IFINDVS,INIT,INOV,ICOUNT,ITEMP,JTEMP; <<06989>>12860000
         INTEGER ARRAY INBUF(0:4096),FINDBUF(0:128),IV(0:64);  <<06989>>12865000
         BYTE ARRAY FORMAT'BUF(0:137);                         <<06989>>12870000
         INTRINSIC FREAD,FOPEN,FPOINT,FCLOSE,FWRITE;           <<06989>>12875000
         FOUND := FALSE;                                       <<06989>>12880000
         FPOINT(IFN,0D);                                       <<06989>>12885000
         FOR INIT:=1301 UNTIL 1365  DO                         <<06989>>12890000
           BEGIN                                               <<06989>>12895000
           IV(INIT-1300) := INIT;                              <<06989>>12900000
           END;                                                <<06989>>12905000
                                                               <<06989>>12910000
         MOVE FORMAT'BUF :=  (                                 <<06989>>12915000
            "( ' INPUT WORDS TO BE FOUND SEPARATED BY COMMAS.",<<06989>>12920000
            "  DONT FORGET % ') "                              <<06989>>12925000
                             );                                <<06989>>12930000
         REALIO(IOUT,0,FORMAT'BUF,0);                          <<06989>>12935000
         REALIO(IIN,1,,0,IV(1),IV(2),IV(3),IV(4),IV(5),        <<06989>>12940000
                         IV(6),IV(7),IV(8),IV(9),IV(10));      <<06989>>12945000
       << FIND OUT HOW MANY WORDS WERE INPUT >>                <<06989>>12950000
         FOR  K:=1 UNTIL 64   DO                               <<06989>>12955000
         IF IV(K) <> 1300+K THEN  IFINDVS := K;                <<06989>>12960000
                                                               <<06989>>12965000
          COMMENT  REALIO(IOUT,0,,0,IV(1),IV(2));              <<06989>>12970000
                                                               <<06989>>12975000
         MOVE  FORMAT'BUF := "( 'NUMBER OF WORDS:  ',I2) ";    <<06989>>12980000
         REALIO(IOUT,0,FORMAT'BUF,0,IFINDVS);                  <<06989>>12985000
                                                               <<06989>>12990000
                                                               <<06989>>12995000
       << NOW GO LOOK FOR THE WORDS THAT WERE INPUT >>         <<06989>>13000000
         FOR I:=1 UNTIL 10000  DO                              <<06989>>13005000
         BEGIN  << 500 >>                                      <<06989>>13010000
                                                               <<06989>>13015000
           MOVE FORMAT'BUF:= "( ' RECORD NUMBER:  ', I4)";     <<06989>>13020000
           ITEMP := I-1;                                       <<06989>>13025000
           REALIO(IOUT,0,FORMAT'BUF,0,ITEMP);                  <<06989>>13030000
                                                               <<06989>>13035000
           ICOUNT := FREAD(IFN,INBUF(1),4096);                 <<06989>>13040000
           IF  <>   THEN GO TO L10000;                         <<06989>>13045000
                                                               <<06989>>13050000
           FOR  J:=1 UNTIL ICOUNT+1-IFINDVS   DO               <<06989>>13055000
           BEGIN                                               <<06989>>13060000
             FOUND := TRUE;                                    <<06989>>13065000
             FOR INOV:=1  UNTIL  IFINDVS   DO                  <<06989>>13070000
             BEGIN                                             <<06989>>13075000
             COMMENT REALIO(IOUT,0,,0,INOV);                   <<06989>>13080000
             IF INBUF(J+INOV-1)  <>  IV(INOV)  THEN FOUND:=FALSE;       13085000
             END;                                              <<06989>>13090000
                                                               <<06989>>13095000
                                                               <<06989>>13100000
           IF FOUND  THEN                                      <<06989>>13105000
           BEGIN                                               <<06989>>13110000
           MOVE FORMAT'BUF :=                                  <<06989>>13115000
              "( ' SEQUENCE FOUND  AT:  HIT CR TO CONTINUE.   ') ";     13120000
           REALIO(IOUT,0,FORMAT'BUF,0);                        <<06989>>13125000
           MOVE FORMAT'BUF :=                                  <<06989>>13130000
            "(' NUMBERED FROM 0:  RECORD #: ', I4,';  WORD #: ',I4) ";  13135000
           ITEMP := I-1;   JTEMP := J-1;                       <<06989>>13140000
           REALIO(IOUT,0,FORMAT'BUF,0,ITEMP,JTEMP);            <<06989>>13145000
           FREAD(IIN,INBUF,-1);                                <<06989>>13150000
           END;  <<  IF  FOUND  >>                             <<06989>>13155000
          END;    <<  FOR LOOP ON  J = 1 UNTIL ICOUNT >>       <<06989>>13160000
L500:    END;                                                  <<06989>>13165000
L10000:                                                        <<06989>>13170000
                                                               <<06989>>13175000
         END;  << FINDINFILE >>                                <<06989>>13180000
                                                               <<06989>>13185000
                                                               <<06989>>13190000
                                                               <<06989>>13195000
                                                               <<06989>>13200000
INTEGER PROCEDURE NUM (N);                                     <<06989>>13205000
   VALUE N;                                                    <<06989>>13210000
   INTEGER N;                                                  <<06989>>13215000
BEGIN                                                          <<06989>>13220000
   TOS := 0;                                                   <<06989>>13225000
   TOS := LPARMS (N & ASL(1));                                 <<06989>>13230000
   TOS := LPARMS (XREG+1).(0:8);                               <<06989>>13235000
   NUM := BINARY (*, *);                                       <<06989>>13240000
   IF <> THEN DELP := ERRORL;                                  <<06989>>13245000
   END    <<NUM>>;                                             <<06989>>13250000
PROCEDURE FILE'ERR( FNUM);                                     <<06989>>13255000
   VALUE FNUM;                                                 <<06989>>13260000
   INTEGER FNUM;                                               <<06989>>13265000
BEGIN                                                          <<06989>>13270000
   ARRAY MSG(0:39);                                            <<06989>>13275000
   INTEGER ERRCODE, MSGLEN;                                    <<06989>>13280000
                                                               <<06989>>13285000
   FCHECK( FNUM, ERRCODE);                                     <<06989>>13290000
   FERRMSG( ERRCODE, MSG, MSGLEN);                             <<06989>>13295000
   PRINT( MSG, -MSGLEN, 0);                                    <<06989>>13300000
END;                                                           <<06989>>13305000
                                                               <<06989>>13310000
PROCEDURE LIO (BUF, LEN, CNTRL);                               <<06989>>13315000
   VALUE LEN, CNTRL;                                           <<06989>>13320000
   ARRAY BUF;                                                  <<06989>>13325000
   INTEGER LEN, CNTRL;                                         <<06989>>13330000
BEGIN                                                          <<06989>>13335000
   ARRAY LERR (0:40);                                          <<06989>>13340000
   BYTE ARRAY BLERR (*) = LERR;                                <<06989>>13345000
   IF FNL = 0 THEN GO FWERR;                                   <<06989>>13350000
   IF (LEN > MXLEN) THEN LEN := MXLEN;                         <<06989>>13355000
   IF (-LEN > (MXLEN & ASL(1))) THEN LEN := MXLEN;             <<06989>>13360000
   FWRITE(FNL,BUF,LEN,CNTRL);                                  <<06989>>13365000
   IF <> THEN                                                  <<06989>>13370000
    BEGIN <<FWRITE ERROR OR EOF>>                              <<06989>>13375000
FWERR:                                                         <<06989>>13380000
      MOVE BLERR_(" **FWRITE ERR ON LIST #"),2;                <<06989>>13385000
      LEN_TOS-@BLERR;                                          <<06989>>13390000
      FCHECK(FNL,CNTRL);                                       <<06989>>13395000
      PRINT(LERR,-LEN-ASCII(CNTRL,10,BLERR(LEN)),0);           <<06989>>13400000
      DELP := ERRORL;                                          <<06989>>13405000
      END;                                                     <<06989>>13410000
   END    <<LIO>>;                                             <<06989>>13415000
                                                               <<06989>>13420000
                                                               <<06989>>13425000
PROCEDURE DIO (AFUNC, SECTN);                                  <<06989>>13430000
   VALUE AFUNC, SECTN;                                         <<06989>>13435000
   INTEGER AFUNC;DOUBLE SECTN;                                 <<06989>>13440000
BEGIN                                                          <<06989>>13445000
   INTEGER LEN,SECTN1=SECTN,SECTN2=SECTN+1;                    <<06989>>13450000
    ARRAY MSG'(0:39);                                          <<06989>>13455000
    BYTE ARRAY MSG(*)=MSG';                                    <<06989>>13460000
   INTEGER ERRCODE, MSGLENGTH;                                 <<06989>>13465000
                                                               <<06989>>13470000
   IF AFUNC = 1 THEN                                           <<06989>>13475000
      FWRITEDIR( FNUM, DBUF, RECLEN, SECTN)                    <<06989>>13480000
   ELSE                                                        <<06989>>13485000
      FREADDIR( FNUM, DBUF, RECLEN, SECTN);                    <<06989>>13490000
                                                               <<06989>>13495000
   IF <> THEN                                                  <<06989>>13500000
      BEGIN                                                    <<06989>>13505000
      FILE'ERR( FNUM);                                         <<06989>>13510000
      DELP := ERRORL;                                          <<06989>>13515000
      END;                                                     <<06989>>13520000
END; <<DIO>>                                                   <<06989>>13525000
                                                               <<06989>>13530000
                                                               <<06989>>13535000
                                                               <<06989>>13540000
                                                               <<06989>>13545000
                                                               <<06989>>13550000
PROCEDURE AFILEEDT;                                            <<06989>>13555000
                                                               <<06989>>13560000
                                                               <<06989>>13565000
  BEGIN                                                        <<06989>>13570000
<< "EXECUTOR"S >>                                              <<06989>>13575000
   SWITCH COMSWITCH :=                                         <<06989>>13580000
      FILE, MODIFY, DUMP, LIST, EXIT,                          <<06989>>13585000
      LOOP,FIND,DBUG,WIDTH,HELP,COPY;                          <<06989>>13590000
   MOVE MSG := PTITLE,2;                                       <<06989>>13595000
   LEN := TOS-@MSG;                                            <<06989>>13600000
   PRINT(MSG',-LEN,0);                                         <<06989>>13605000
   WHO(MODE,CAPD);                                             <<06989>>13610000
   TURNOFFTRAPS;                                               <<06989>>13615000
    XCONTRAP(@CY, T);   << ENABLE CONTROL Y >>                 <<06989>>13620000
   ERRORL := @ERROR'; <<SET ERROR ADDRESS>>                    <<06989>>13625000
   MOVE MSG_("TYPE 'HELP' FOR INFO"),2;                        <<06989>>13630000
   LEN_TOS-@MSG;                                               <<06989>>13635000
   PRINT(MSG',-LEN,0);                                         <<06989>>13640000
   PUSH (S);                                                   <<06989>>13645000
   SAVES := TOS;                                               <<06989>>13650000
ASCII (DDU,8,SBMESN1);                                         <<06989>>13655000
   GO SETLIST;                                                 <<06989>>13660000
LOOP:                                                          <<06989>>13665000
   TOS := SAVES;                                               <<06989>>13670000
   SET (S);                                                    <<06989>>13675000
   IF MODEI THEN PRINT (PROMPT, PROMPTL, STAY);                <<06989>>13680000
   LEN := READ (BUF, -72);                                     <<06989>>13685000
   << CHECK IF READ IS OK >>                                   <<06989>>13690000
   IF > THEN GO EXIT;                                          <<06989>>13695000
   IF < THEN                                                   <<06989>>13700000
READERR:                                                       <<06989>>13705000
        BEGIN                                                  <<06989>>13710000
            MOVE MSG:=("**HARDWARE END OF FILE ENCOUNTERED"),2;<<06989>>13715000
            LEN := TOS - @MSG;                                 <<06989>>13720000
            PRINT(MSG',-LEN,0);                                <<06989>>13725000
            QUIT(0);                                           <<06989>>13730000
        END;                                                   <<06989>>13735000
   IF NOT(MODED) THEN PRINT (BUF, -LEN, 0);                    <<06989>>13740000
   BBUF (LEN) := %15;                                          <<06989>>13745000
   MYCOMMAND (BUF, , MAXP, NP, PARMS, DICT, DEFN);             <<06989>>13750000
   IF <> THEN                                                  <<06989>>13755000
ERROR:                                                         <<06989>>13760000
      BEGIN                                                    <<06989>>13765000
      PRINT (ERR, ERRL, 0);                                    <<06989>>13770000
ERROR':                                                        <<06989>>13775000
      IF MODEI THEN GOTO LOOP;                                 <<06989>>13780000
      QUIT (0);                                                <<06989>>13785000
      END;                                                     <<06989>>13790000
   IF NOT(INTEGER(DEFN) <= NP <= INTEGER(DEFN(1))) THEN GOTO ERROR;     13795000
   GOTO COMSWITCH (INTEGER(DEFN(2)));                          <<06989>>13800000
   GOTO ERROR;                                                 <<06989>>13805000
                                                               <<06989>>13810000
FIND:                                                          <<06989>>13815000
    MIN := FOPEN(,32);                                         <<06989>>13820000
    MOUT := FOPEN(,8);                                         <<06989>>13825000
    FINDINFILE(MIN,MOUT,FNUM);                                 <<06989>>13830000
    FCLOSE(MIN,0,0);                                           <<06989>>13835000
    FCLOSE(MOUT,0,0);                                          <<06989>>13840000
    GO TO LOOP;                                                <<06989>>13845000
   IF NP=0 THEN                                                <<06989>>13850000
    BEGIN  <<RESET BASE ADDRESS TO 0D>>                        <<06989>>13855000
     BASEA := 0D;                                              <<06989>>13860000
     GO LOOP;                                                  <<06989>>13865000
    END;                                                       <<06989>>13870000
   TOS:=0D; << TO PREVENT STACK UNDERFLOW IN TOOTHPICK >>      <<06989>>13875000
   TOS := LPARMS;                                              <<06989>>13880000
   TOS := LPARMS(1).(0:8);                                     <<06989>>13885000
   BASEA := DBINARY(*,*);                                      <<06989>>13890000
   IF <> THEN                                                  <<06989>>13895000
    BEGIN                                                      <<06989>>13900000
     BASEA := 0D;                                              <<06989>>13905000
ADRINV:                                                        <<06989>>13910000
     MOVE BUF := "INVALID RECORD ADDRESS";                     <<06989>>13915000
     PRINT(BUF,-22,0);                                         <<06989>>13920000
     GO ERROR;                                                 <<06989>>13925000
    END;                                                       <<06989>>13930000
   DIO (0,SECTA); <<CHECK IF ADDRESS IS VALID>>                <<06989>>13935000
   IF FNUM = 0 THEN                                            <<06989>>13940000
      BEGIN                                                    <<06989>>13945000
      PRINT( NOFILE, -19, 0);                                  <<06989>>13950000
      GO LOOP;                                                 <<06989>>13955000
      END;                                                     <<06989>>13960000
                  <<FOR THIS DISC>>                            <<06989>>13965000
   GO LOOP;                                                    <<06989>>13970000
                                                               <<06989>>13975000
DBUG:                                                          <<06989>>13980000
   DEBUG;                                                      <<06989>>13985000
   GO LOOP;                                                    <<06989>>13990000
                                                               <<06989>>13995000
HELP:                                                          <<06989>>14000000
   MOVE MSG_(CRLF," COPY   USES FILE EQS FOR FROM & TO ",CRLF, <<06989>>14005000
             " DEBUG",CRLF,                                    <<06989>>14010000
      " FILE <FILE NAME>",CRLF, " FIND  carriage return ",CRLF,<<06989>>14015000
   " DUMP [<REL REC #>] [,<# OF REC>] [,<A = ASCII>]",CRLF,    <<06989>>14020000
   " EXIT",CRLF,                                               <<06989>>14025000
      " LIST [<DEVICE CLASS>] OR ",                            <<06989>>14030000
    "[<LOG DEV #>]",CRLF," MODIFY <RECORD NUM, REL WD ADDR [,NUM ",     14035000
      "WDS]>",CRLF, " WIDTH",CRLF),2;                          <<06989>>14040000
   LEN_TOS-@MSG;                                               <<06989>>14045000
   PRINT(MSG',-LEN,0);                                         <<06989>>14050000
   GO LOOP;                                                    <<06989>>14055000
WIDTH:                                                         <<06989>>14060000
   MOVE BUF := "NARROW FORMAT?";                               <<06989>>14065000
   PRINT(BUF,-14,0);                                           <<06989>>14070000
   READ(BUF,-71);                                              <<06989>>14075000
  << CHECK FOR THE READ CC'S >>                                <<06989>>14080000
  IF > THEN GO EXIT;                                           <<06989>>14085000
  IF < THEN GO READERR;                                        <<06989>>14090000
   SHORT := IF BBUF = "Y" THEN TRUE ELSE FALSE;                <<06989>>14095000
   GO LOOP;                                                    <<06989>>14100000
                                                               <<06989>>14105000
FILE:                                                          <<06989>>14110000
   IF FNUM <> 0 THEN                                           <<06989>>14115000
      BEGIN                                                    <<06989>>14120000
      FCLOSE( FNUM, 0, 0);                                     <<06989>>14125000
      IF <> THEN FILE'ERR( FNUM);                              <<06989>>14130000
      RECLEN := 0;                                             <<06989>>14135000
      END;                                                     <<06989>>14140000
   @DEFN := LPARMS;                                            <<06989>>14145000
   FNUM := FOPEN( DEFN, 3, 4);                                 <<06989>>14150000
   IF <> THEN                                                  <<06989>>14155000
      BEGIN                                                    <<06989>>14160000
      FILE'ERR( FNUM);                                         <<06989>>14165000
      GO LOOP;                                                 <<06989>>14170000
      END;                                                     <<06989>>14175000
   FGETINFO( FNUM, FILENAME, FOPTION, ,RECLEN);                <<06989>>14180000
   IF RECLEN < 0 THEN RECLEN := (-RECLEN+1)&LSR(1);            <<06989>>14185000
   IF FOPTION.(8:2) <> 0 THEN                                  <<06989>>14190000
      BEGIN                                                    <<06989>>14195000
      PRINT( NOTFIXED, -29, 0);                                <<06989>>14200000
      FCLOSE( FNUM, 0, 0);                                     <<06989>>14205000
      IF <> THEN FILE'ERR( FNUM);                              <<06989>>14210000
      FNUM := 0;                                               <<06989>>14215000
      RECLEN := 0;                                             <<06989>>14220000
      END;                                                     <<06989>>14225000
   GO LOOP;                                                    <<06989>>14230000
                                                               <<06989>>14235000
LIST:                                                          <<06989>>14240000
   FCLOSE(FNL,1,0);                                            <<06989>>14245000
   IF NP=0 THEN                                                <<06989>>14250000
    BEGIN                                                      <<06989>>14255000
SETLIST:                                                       <<06989>>14260000
     FNL := FOPEN(FDL1,%10);                                   <<06989>>14265000
     IF <> THEN GO LISTERR;                                    <<06989>>14270000
     GO GETLEN;                                                <<06989>>14275000
    END;                                                       <<06989>>14280000
   XREG := 4;                                                  <<06989>>14285000
   WHILE BBUF(XREG) = " " DO XREG := XREG+1;<<STRIP BLANKS>>   <<06989>>14290000
   IF BBUF(XREG) = "0" THEN GO SETLIST;<<LDEV 0>>              <<06989>>14295000
   FNL := FOPEN(FDL,,%101,,BBUF(XREG));                        <<06989>>14300000
   IF <> THEN GO LISTERR;                                      <<06989>>14305000
GETLEN:                                                        <<06989>>14310000
   FGETINFO(FNL,,,,MXLEN);                                     <<06989>>14315000
   IF <> THEN DEBUG;                                           <<06989>>14320000
   IF MXLEN < 0 THEN MXLEN := -MXLEN & ASR(1);                 <<06989>>14325000
   MXLEN := MXLEN-1;  <<AVOID FULL LINE ON CRT>>               <<06989>>14330000
   GO LOOP;                                                    <<06989>>14335000
LISTERR:                                                       <<06989>>14340000
   MOVE BUF := "UNABLE TO OPEN LIST DEVICE";                   <<06989>>14345000
   PRINT(BUF,-26,0);                                           <<06989>>14350000
   GO ERROR;                                                   <<06989>>14355000
                                                               <<06989>>14360000
DUMP:                                                          <<06989>>14365000
IF FNUM = 0 THEN                                               <<06989>>14370000
   BEGIN                                                       <<06989>>14375000
   PRINT( NOFILE, -19, 0);                                     <<06989>>14380000
   GO LOOP;                                                    <<06989>>14385000
   END;                                                        <<06989>>14390000
ASSEMBLE(DZRO);                                                <<06989>>14395000
TOS:=LPARMS;                                                   <<06989>>14400000
TOS:=LPARMS(1).(0:8);                                          <<06989>>14405000
SECTA:=DBINARY(*,*);                                           <<06989>>14410000
   SECTA := SECTA + BASEA;                                     <<06989>>14415000
   IF SECTA < 0D THEN GO ADRINV;                               <<06989>>14420000
   TOS := IF NP > 1 THEN NUM(1) ELSE 1;                        <<06989>>14425000
   ASSEMBLE (TEST);                                            <<06989>>14430000
   IF = THEN GOTO LOOP;                                        <<06989>>14435000
   NUMS := TOS;                                                <<06989>>14440000
   BBUF(9) := ":";                                             <<08902>>14445000
   LIO (DUMMY, 0, DOUBLES);                                    <<06989>>14450000
XREG:=LPARMS(4);                                               <<06989>>14455000
ASSEMBLE(LDB DB+0,X);                                          <<06989>>14460000
IF TOS.(8:8) = "A" AND NP = 3 THEN                             <<06989>>14465000
NONUM :=TRUE                                                   <<06989>>14470000
ELSE                                                           <<06989>>14475000
  BEGIN                                                        <<06989>>14480000
  NONUM :=FALSE;                                               <<06989>>14485000
  IF NP = 3 THEN                                               <<06989>>14490000
   BEGIN                                                       <<06989>>14495000
    MOVE MSG :="THIRD PARM INVALID";                           <<06989>>14500000
    PRINT (MSG',-18,0);                                        <<06989>>14505000
    GO ERROR;                                                  <<06989>>14510000
    END;                                                       <<06989>>14515000
   END;                                                        <<06989>>14520000
   DO BEGIN                                                    <<06989>>14525000
      DASCII (SECTA, 8, BSMESN);                               <<06989>>14530000
      LIO (SMES, SMESL, DOUBLES);                              <<06989>>14535000
      DIO (0, SECTA);                                          <<06989>>14540000
      LINEP := 0;                                              <<06989>>14545000
    IF NONUM THEN GO ASCIIONLY;                                <<06989>>14550000
      DO BEGIN                                                 <<06989>>14555000
         ASCII (LINEP, 8, BBUF(3));                            <<08902>>14560000
         COLN := 0;                                            <<06989>>14565000
         DO BEGIN                                              <<06989>>14570000
            ASCII (DBUF(LINEP+COLN), 8, PBBUF(COLN & ASL(3))); <<06989>>14575000
            PBUF (XREG & ASR(1) +3) := %20040;                 <<08902>>14580000
            END                                                <<06989>>14585000
         UNTIL (COLN := COLN+1) >= 8;                          <<06989>>14590000
         BUF(36) := "  ";                                      <<06989>>14595000
         MOVE BUF(37) := DBUF(LINEP),(8);                      <<06989>>14600000
         XREG := 73;                                           <<06989>>14605000
         WHILE (XREG := XREG+1) < 90 DO                        <<06989>>14610000
          BEGIN                                                <<06989>>14615000
           TOS := BBUF(XREG);                                  <<06989>>14620000
           IF S0 < %40 THEN BBUF(XREG) := %56;                 <<06989>>14625000
           IF TOS > %137 THEN BBUF(XREG) := %56;               <<06989>>14630000
          END;                                                 <<06989>>14635000
         LEN := IF SHORT THEN 35 ELSE 43;                      <<06989>>14640000
         LIO (BUF(2), LEN, 0);                                 <<06989>>14645000
         END                                                   <<06989>>14650000
      UNTIL (LINEP := LINEP+8) >= RECLEN;                      <<06989>>14655000
      LIO (DUMMY, 0, DOUBLES);                                 <<06989>>14660000
      IF SHORT THEN                                            <<06989>>14665000
       BEGIN  <<PRINT ASCII CHARS. BELOW OCTALS>>              <<06989>>14670000
ASCIIONLY:                                                     <<06989>>14675000
        XREG := -1;                                            <<06989>>14680000
        WHILE (XREG := XREG + 1) < 256 DO                      <<06989>>14685000
         BEGIN  <<REPLACE NON-PRINTING CHARS WITH ".">>        <<06989>>14690000
          IF DBBUF(XREG) <  %40 THEN DBBUF(XREG) := ".";       <<06989>>14695000
          IF DBBUF(XREG) > %137 THEN DBBUF(XREG) := ".";       <<06989>>14700000
         END;                                                  <<06989>>14705000
    IF NOT NONUM THEN LIO(NUMBUF,35,0);                        <<06989>>14710000
        PBUF := "  ";  MOVE PBUF(1) := PBUF,(32);              <<06989>>14715000
        LINEP := -32;                                          <<06989>>14720000
        WHILE (LINEP := LINEP + 32) < RECLEN DO                <<06989>>14725000
         BEGIN  <<MOVE CHARS AND PRINT 4 LINES>>               <<06989>>14730000
          ASCII((LINEP & ASL(1)),8,BBUF(1));  <<BYTE NUMBER>>  <<06989>>14735000
          MOVE PBUF := DBUF(LINEP),(32);                       <<06989>>14740000
    BUF (4) :="  ";                                            <<06989>>14745000
          LIO(BUF(2),35,0);  <<PRINT IT>>                      <<06989>>14750000
         END;                                                  <<06989>>14755000
       LIO (DUMMY, 0, DOUBLES);                                <<06989>>14760000
       END;                                                    <<06989>>14765000
      SECTA := SECTA+1D;                                       <<06989>>14770000
      NUMS := NUMS-1;                                          <<06989>>14775000
      END                                                      <<06989>>14780000
   UNTIL =;                                                    <<06989>>14785000
   GOTO LOOP;                                                  <<06989>>14790000
                                                               <<06989>>14795000
MODIFY:                                                        <<06989>>14800000
   IF FNUM = 0 THEN                                            <<06989>>14805000
      BEGIN                                                    <<06989>>14810000
      PRINT( NOFILE, -19, 0);                                  <<06989>>14815000
      GO LOOP;                                                 <<06989>>14820000
      END;                                                     <<06989>>14825000
   TOS := 0;                                                   <<08902>>14830000
                                                               <<08902>>14835000
   ASSEMBLE(DZRO);                                             <<08902>>14840000
   TOS:=LPARMS;                                                <<08902>>14845000
   TOS:=LPARMS(1).(0:8);                                       <<08902>>14850000
   SECTA:=DBINARY(*,*);                                        <<08902>>14855000
   SECTA := SECTA + BASEA;                                     <<08902>>14860000
                                                               <<08902>>14865000
   IF SECTA < 0D THEN GO ADRINV;                               <<08902>>14870000
   WDPOS :=  NUM(1);                                           <<08902>>14875000
                                                               <<08902>>14880000
                                                               <<08902>>14885000
                                                               <<08902>>14890000
   NUMWDS := IF NP > 2 THEN NUM(2) ELSE 1;                     <<08902>>14895000
   MOVE PBBUF(-5) := 40(" ");                                  <<08902>>14900000
   PBBUF(-1) := ":";                                           <<08902>>14905000
   PBUF(-0) := %20040;                                         <<08902>>14910000
   PBUF(3) := ",%";                                            <<08902>>14915000
RDSECT:                                                        <<08902>>14920000
   DASCII (SECTA, 8, BSMESN);                                  <<08902>>14925000
   PRINT (SMES, SMESL, 0);                                     <<08902>>14930000
   DIO (0, SECTA);                                             <<08902>>14935000
REQWD:                                                         <<08902>>14940000
   ASCII (WDPOS, 8, BBUF(2));                                  <<08902>>14945000
   ASCII (DBUF(WDPOS), 8, PBBUF);                              <<08902>>14950000
   PRINT (BUF(1),08, STAY);                                    <<08902>>14955000
   LEN := READ (BUF( 9), -72);                                 <<08902>>14960000
    IF > THEN GO EXIT;                                         <<08902>>14965000
    IF < THEN GO READERR;                                      <<08902>>14970000
   IF NOT (MODED) THEN PRINT (BUF(9), -LEN, 0);                <<08902>>14975000
   IF BBUF(18) = "*" THEN GOTO SKIPSTORE;                      <<08902>>14980000
   IF BBUF (XREG) = "/" THEN GOTO LOOP;                        <<08902>>14985000
   TOS := BINARY (BBUF(17), LEN+1);                            <<08902>>14990000
   IF <> THEN GOTO REQWD;                                      <<08902>>14995000
   DBUF(WDPOS) := TOS;                                         <<08902>>15000000
SKIPSTORE:                                                     <<08902>>15005000
   WDPOS := WDPOS+1;                                           <<08902>>15010000
   NUMWDS := NUMWDS-1;                                         <<08902>>15015000
   IF (NUMWDS > 0) AND (WDPOS < RECLEN) THEN GOTO REQWD;       <<08902>>15020000
   DIO (1, SECTA);                                             <<08902>>15025000
   PRINT (WR, WRL, 0);                                         <<08902>>15030000
   IF NUMWDS = 0  THEN GOTO LOOP;                              <<08902>>15035000
   SECTA := SECTA+1D;                                          <<08902>>15040000
   WDPOS := 0;                                                 <<08902>>15045000
   GOTO RDSECT;                                                <<08902>>15050000
                                                               <<06989>>15055000
                                                               <<06989>>15060000
COPY:                                                          <<06989>>15065000
  FILE'COPY;                                                   <<06989>>15070000
  GO LOOP;                                                     <<06989>>15075000
EXIT:                                                          <<06989>>15080000
   END;   <<EDIT/DUMP>>                                        <<06989>>15085000
                                                               <<06989>>15090000
                                                               <<06989>>15095000
$CONTROL SEGMENT=DOMAIN'SEG                                    <<*7479>>15100000
PROCEDURE DOMAIN;                                              <<06989>>15105000
  COMMENT                                                      <<06989>>15110000
    THIS ROUTINE GETS A COMMAND, PARSES IT AND ENTERS IT IS THE STORED  15115000
    PROGRAM AREA OR EXECUTES IT IMMEDIATELY.                   <<06989>>15120000
  ;                                                            <<06989>>15125000
$PAGE "DOMAIN SUBROUTINES"                                     <<06989>>15130000
BEGIN                                                                   15135000
  INTEGER TSOURCE, TFNL, TDF;                                           15140000
  BYTE ARRAY TFNAME(0:29);                                              15145000
  BYTE ARRAY TLINENO(0:11);                                             15150000
                                                                        15155000
SUBROUTINE PTEST( LOWER, UPPER );                                       15160000
  VALUE LOWER, UPPER;   INTEGER LOWER, UPPER;                           15165000
  <<                                                                    15170000
    THIS SUBROUTINE CHECKS THAT THE NUMBER OF PARAMERS IS WITHIN        15175000
    THE BOUNDS LOWER AND UPPER IF NOT AN INVALID PARAMER MESSAGE        15180000
    IS ISSUED.                                                          15185000
  >>                                                                    15190000
  BEGIN                                                                 15195000
  N :=0;     << HOLDS NUMBER OF PARAMETERS >>                           15200000
  IF NOT NOPARAM THEN N := N +1;                                        15205000
  IF TWOPARAMS THEN N := N + 1;                                         15210000
                                                                        15215000
  IF NOT ( LOWER<= N <=UPPER ) THEN  << INVALID NUMBER OF PARAMS >>     15220000
    BEGIN    PRINTE(M17W, 14);   EXITPROC;   END;                       15225000
  END;   << PTEST >>                                                    15230000
                                                                        15235000
SUBROUTINE SETPOINTERS( LDEV );                                         15240000
  VALUE LDEV;   INTEGER LDEV;                                           15245000
  <<                                                                    15250000
    SETS THE ABSOLUTE POINTERS DITP, IOQP, ILTP AND SIOP AND THE        15255000
    LENGTHS DITL AND SIOL. ALSO SETS THE DRT NUMBER INTO DX.            15260000
  >>                                                                    15265000
  BEGIN                                                                 15270000
  IF NOT (1<=LDEV<=LPDTP(0)) OR LPDTP(LDEV*4)<0  THEN          <<06989>>15275000
    BEGIN   PRINTE(M13W, 6);   EXITPROC;    END;  << INVALID LDEV >>    15280000
                                                                        15285000
  DITP := LPDTP(LDEV*4 + 2) + %1000;                           <<06989>>15290000
                                                               <<03120>>15295000
  << Set flag if this is a DISC DIT >>                         <<03120>>15300000
  LDEV'IS'DISC := if ABS(DITP).(0:2) = 1 then                  <<03120>>15305000
                    true                                       <<03120>>15310000
                  else                                         <<03120>>15315000
                    false;                                     <<03120>>15320000
                                                               <<03120>>15325000
  IOQP := ABS(DITP+2) + %1000;                                          15330000
  X := ABS(X:=X+3) + %1000;   X := X + 7;  << X PTS DRT# >>    <<01366>>15335000
if DRTFLG = 0 then                                             <<03120>>15340000
  DX := ABS(X).(7:9);  << Fetch DRT >>                         <<03120>>15345000
  DRTP := DX*4;  << CALCULATE DRT ENTRY >>                     <<00924>>15350000
  SIOP := ABS(X:=X+1) + %1000;                                          15355000
  SIOL := (ABS(X:=X+4)&LSR(8))*2;  << LENGTH IS SIOL*2 >>      <<01366>>15360000
  DITL := ABS(ABS(DITP+4)+%1005).(0:8);                                 15365000
  END;    << SET POINTERS >>                                            15370000
                                                                        15375000
SUBROUTINE MOVEDATA;                                                    15380000
  <<                                                                    15385000
    THIS ROUTINE MOVES DATA TO OR FROM SYSTEM BUFFERS AND THE MAIN      15390000
    I/O BUFFER.                                                         15395000
  >>                                                                    15400000
  BEGIN                                                                 15405000
  T := SBUFX;   @BP := @B;                                              15410000
  TOS := XLOG;                                                          15415000
  N := (IF < THEN -(TOS&ASR(1)) ELSE TOS) + @BP; << READ MOVE LIMIT >>  15420000
                                                                        15425000
  FOR J := 1 UNTIL R DO BEGIN   << MOVE FROM/TO EACH SYSTEM BUFFER >>   15430000
    X := T;       << SET STARTING ADDRESS OF SYSBUF >>                  15435000
    FOR K := 1 UNTIL 128 DO BEGIN    << MOVE EACH WORD >>               15440000
      IF F<>0 THEN SBUF(X) := BP  << WRITE WORD MOVE >>                 15445000
      ELSE IF @BP<N THEN BP := SBUF(X) ELSE K := 128;                   15450000
      @BP := @BP + 1;      X := X + 1;                                  15455000
      END;                                                              15460000
    T := SBUF(T-1);   << STEP TO NEXT SYSBUF >>                         15465000
    END;                                                                15470000
  END;   << MOVE DATA >>                                                15475000
                                                                        15480000
                                                                        15485000
                                                                        15490000
INTEGER SUBROUTINE SAVEIOQX;                                            15495000
  <<                                                                    15500000
    THIS ROUTINE SAVES THE IOQ INDEX FROM AN UNBLOCKED ATTACHIO CALL    15505000
    IN THE ARRAY IOQX. IT RETURNS THE LAST IOQX SAVED.                  15510000
  >>                                                                    15515000
  IF STATUS<>0 THEN BEGIN    << VALID IOQ INDEX >>                      15520000
    SAVEIOQX := IOQX(IOPCNT) := STATUS;                                 15525000
    IOPCNT := IOPCNT + 1;                                               15530000
    STATUS := XLOG := 0;                                                15535000
    END                                                                 15540000
  ELSE BEGIN        << NO IOQ AVAILABLE >>                              15545000
    MOVE BM := "NO IOQ'S AVAILABLE";                                    15550000
    PRINTE(M, 9);                                                       15555000
    EXITPROC;                                                           15560000
  END;   << SAVE IOQX >>                                                15565000
                                                                        15570000
                                                                        15575000
                                                                        15580000
SUBROUTINE MODIFYBUFFER( ADR );                                         15585000
  VALUE ADR;  INTEGER ADR;                                              15590000
  <<                                                                    15595000
    OUTPUTS WORD ADR OF BUFFER B OR AT ABSOLUTE ADDRESS ADR, GIVING IT  15600000
    THE ADDRESS ADR AND INPUTS A NEW WORD TO REPLACE IT. MODIFICATION   15605000
    MAY BE PREMATURELY TERMINATED WITH A NULL INPUT.                    15610000
  >>                                                                    15615000
  BEGIN                                                                 15620000
    DO BEGIN   << GET REPLACMENT WORD >>                                15625000
      MOVE BPA := "   ";                                                15630000
      IF BFLAG THEN BEGIN  ASCII(ADR, -10, BPA(3));  J := 4;  END       15635000
      ELSE BEGIN  ASCII(ADR, 8, BPA);  J := 6;  END;                    15640000
      MOVE BPA(J) := ": ";      J := J + 2;                             15645000
      ASCII(IF BFLAG THEN B(ADR) ELSE ABS(ADR), 8, BPA(J));             15650000
      MOVE BPA(J+6) := " := ";                                          15655000
      GETINPUT(-(J+10), FALSE);  << GET REPLACEMENT >>                  15660000
      IF L=0 OR EFLAG OR SFLAG THEN EXITPROC;                           15665000
      TWOPARAMS := 1;  << ALLOW ONLY ONE PARAMETER >>                   15670000
      R := EXPRESSION;  << GET REPLACEMENT >>                           15675000
      IF <> OR I<>L THEN PRINTX(M17W, 14)   << INVALID NUMBER >>        15680000
    END UNTIL =;   << GOOD REPLACEMENT FOUND >>                         15685000
    IF BFLAG THEN B(ADR) := R ELSE ABS(ADR) := R;                       15690000
  END;   << MODIFY BUFFER >>                                            15695000
                                                                        15700000
SUBROUTINE CHECKPARAMS( LIMIT );                                        15705000
  VALUE LIMIT;  INTEGER LIMIT;                                          15710000
  <<                                                                    15715000
    THIS SUBROUTINE CONVERTS R1 TO WORDS IF IF IT WAS A NEGATIVE BYTE   15720000
    COUNT AND CHECKS THAT R IS POSITIVE AND THAT R + R1 IS LESS         15725000
    THAN OR EQUAL TO LIMIT.                                             15730000
  >>                                                                    15735000
  BEGIN                                                                 15740000
    IF R1<0 THEN R1 := -(R1&ASR(1));                                    15745000
    IF NOT ( R1<=R+R1<=LIMIT ) THEN                                     15750000
      BEGIN   PRINTE(M15W, -17);   EXITPROC;  END;  << BAD PARAM >>     15755000
  END;   << CHECK PARAMS >>                                             15760000
                                                                        15765000
SUBROUTINE CHECKPROG(EPRINT);                                           15770000
  VALUE EPRINT;   LOGICAL EPRINT;                                       15775000
  <<                                                                    15780000
    IF NULL STORED PROGRAM PRINT ERROR WITH PRINTE OR PRINTX            15785000
  >>                                                                    15790000
  IF PROGEND=0 THEN BEGIN    << NO STORED PROGRAM >>                    15795000
    MOVE BM := "NO PROGRAM";                                            15800000
    IF EPRINT THEN PRINTE(M, 5) ELSE PRINTX(M, 5);                      15805000
    EXITPROC;                                                           15810000
    END;    << CHECK PROG >>                                            15815000
$PAGE "  DO MAIN "                                                      15820000
                                                                        15825000
    DO BEGIN                                                            15830000
    BFLAG := FALSE;       PA := "C?";                                   15835000
    GETINPUT(-2, TRUE);  << GET COMMAND >>                              15840000
    IF EFLAG OR SFLAG THEN RETURN;  << END OF LEVEL >>                  15845000
    IF L=0 AND NFLAG<>0 THEN   << NULL INPUT, CALL ATTACHIO ONCE >>     15850000
      BEGIN    M := CR;    BM := "E";    L := 1;    END;                15855000
    END UNTIL L<>0;                                                     15860000
                                                                        15865000
    <<**************************************************************>>  15870000
    <<                                                              >>  15875000
    <<  STATEMENT# ENCOUNTERED--EDIT PROGRAM AREA (#)               >>  15880000
    <<                                                              >>  15885000
    <<**************************************************************>>  15890000
                                                                        15895000
                                                                        15900000
    IF "0"<=CHAR<="9" OR X="%" THEN  << BEGINS WITH NUMBERIC >>         15905000
      BEGIN   << HAS A LINE NUMBER SO ENTER INTO PROGRAM AREA >>        15910000
      IF PROGFLAG THEN  << NO MODIFICATION ALLOWED >>                   15915000
        BEGIN   PRINTE(M4, 11);    RETURN;   END;                       15920000
      R := EXPRESSION;   << GET STATEMENT NUMBER >>                     15925000
      IF <> OR NOT (1<=R<=9999) THEN  << INVALID STMNT NUMBER >>        15930000
        BEGIN   PRINTE(M2, 12);   RETURN;   END;                        15935000
                                                                        15940000
      L := L - I;   << LENGTH OF STATEMENT >>                           15945000
      K := PROGEND + (L+5)/2;  << COULD BE NEW PROGEND >>               15950000
      J := 0;                                                           15955000
      WHILE J<PROGEND AND PROG(J)<R DO STEP'PC(J);                      15960000
      IF J<PROGEND AND PROG(J)=R THEN  << STATEMENT FOUND >>            15965000
        BEGIN   << DELETE CURRENT STATEMENT >>                          15970000
        R2 := (PROG(J+1)+5)/2; << LENGTH DELETED >>                     15975000
        K := K - R2;  << WILL BE NEW PROGEND >>                         15980000
        IF K<=PROGMAX THEN    << DELETE AND FILL UP HOLE >>             15985000
          BEGIN                                                         15990000
          PROGEND := PROGEND - R2;                                      15995000
          MOVE PROG(J) := PROG(J+R2),(PROGEND-J);                       16000000
          END;                                                          16005000
        END;                                                            16010000
                                                                        16015000
      IF L>0 THEN BEGIN    << ENTER STATEMENT IN PROGRAM AREA >>        16020000
        IF K>PROGMAX THEN                                               16025000
          BEGIN    << STATEMENT WONT FIT >>                             16030000
          MOVE M := "PROGRAM AREA FULL";                                16035000
          PRINTE(M, -17);        RETURN;                                16040000
          END;                                                          16045000
                                                                        16050000
        T := J-PROGEND;  << NEGATIVE LENGTH TO MOVE >>                  16055000
        IF < THEN MOVE PROG(K-1) := PROG(PROGEND-1),(T);                16060000
        PROG(J) := R;    PROG(J+1) := L;                                16065000
        MOVE BPROG((J+2)&LSL(1)) := BM(I),(L);                          16070000
        PROGEND := K;                                                   16075000
        END;                                                            16080000
      RETURN;   << PROGRAM STATEMENT PROCESSED >>                       16085000
      END;                                                              16090000
                                                                        16095000
    MOVE BM := BM WHILE AS, 1;                                          16100000
    I := TOS - @BM;    << STEP OVER COMMAND >>                          16105000
    T := BM;     CHAR;                                                  16110000
                                                                        16115000
    <<**************************************************************>>  16120000
    <<                                                              >>  16125000
    <<  ALLOW EXECUTION OF AN MPE COMMAND (MPE CMD)                 >>  16130000
    <<                                                              >>  16135000
    <<**************************************************************>>  16140000
                                                                        16145000
    COMMAND(BM, R, R);                                                  16150000
    IF = THEN RETURN;;   << MPE COMMAND EXECUTED >>                     16155000
                                                                        16160000
    <<**************************************************************>>  16165000
    <<                                                              >>  16170000
    <<  RUN OR ACTIVATE A PROCESS (RUN)                             >>  16175000
    <<                                                              >>  16180000
    <<**************************************************************>>  16185000
                                                                        16190000
    IF BM="RUN" THEN  << TRY TO RUN A PROGRAM >>                        16195000
      BEGIN                                                             16200000
      XSYSTRAP(@SYSTRAP, T);                                            16205000
      BM(L) := " ";   CREATE(BM(I), , R, , 1);                          16210000
      IF = THEN ACTIVATE(R, 3);                                         16215000
      IF <> THEN  << SOME KIND OF TROUBLE >>                            16220000
        BEGIN  MOVE M := "RUN ERROR";  PRINTE(M, -9);  END;             16225000
      XCONTRAP(@CY, T);                                                 16230000
      RETURN;                                                           16235000
      END;                                                              16240000
                                                                        16245000
    IF CHAR="=" THEN  << STEP OVER EQUAL >>                             16250000
      BEGIN I := I + 1;   IF I=L THEN I := -1;    END;                  16255000
    IF I<0 OR NOT CONVERTPARAMS THEN    << INVALID PARAMETER >>         16260000
      BEGIN  PRINTE(M15W, -17);   RETURN;   END;                        16265000
                                                                        16270000
    <<**************************************************************>>  16275000
    <<                                                              >>  16280000
    <<  LIST COMMANDS WITH EXPLANATIONS (X)                         >>  16285000
    <<                                                              >>  16290000
    <<**************************************************************>>  16295000
                                                                        16300000
    IF T="X" THEN BEGIN       << LIST COMMANDS >>                       16305000
      PRINT'(M25W, 36, 0 );    PRINT'(M26W, 27,%60);                    16310000
      IF D=0 THEN GO TO DEFAULT;  << DEFAULT MENU >>           <<01411>>16315000
      SETPOINTERS( D );                                        <<01366>>16320000
      <<MENU FOR SERIES33, ICF44 AND ICF55>>                   <<01407>>16325000
      IF POSTSERIES3                                           <<06989>>16330000
       THEN                                                    <<06989>>16335000
 DEFAULT:                                                      <<06989>>16340000
         DO'EXPLAIN                                            <<06989>>16345000
      ELSE  << SERIES 2 & 3 MENU >>                            <<00924>>16350000
                                                               <<06989>>16355000
        FOR I:=0 UNTIL 27 DO PRINT'(M11W(I*21),21,0);          <<04830>>16360000
      PRINT'(M, 0, 0);       RETURN;                           <<00924>>16365000
      END;                                                              16370000
                                                               <<04830>>16375000
                                                               <<04830>>16380000
   <<***************************************************>>     <<04830>>16385000
   <<                                                   >>     <<04830>>16390000
   <<        DISPLAY MONITOR TABLE                      >>     <<04830>>16395000
   <<                                                   >>     <<04830>>16400000
   <<***************************************************>>     <<04830>>16405000
                                                               <<04830>>16410000
   IF BM="DMON" THEN BEGIN                                     <<04830>>16415000
       PRINTMON;                                               <<04830>>16420000
       RETURN;                                                 <<04830>>16425000
       END;                                                    <<04830>>16430000
                                                               <<06989>>16435000
   <<***************************************************>>     <<06989>>16440000
   <<                                                   >>     <<06989>>16445000
   <<   SET THE OFFSET TO WHICH IO WILL BE DONE INTO    >>     <<06989>>16450000
   <<                  THE  BUFFER                      >>     <<06989>>16455000
   <<                                                   >>     <<06989>>16460000
   <<***************************************************>>     <<06989>>16465000
                                                               <<06989>>16470000
   IF BM="OFFSET" THEN BEGIN  <<  SET BUFFER OFFSET     >>     <<06989>>16475000
                         BUF'OFFSET := R;                      <<06989>>16480000
                         RETURN;                               <<06989>>16485000
                       END;                                    <<06989>>16490000
                                                               <<06989>>16495000
                                                               <<04830>>16500000
                                                                        16505000
   <<***************************************************>>     <<04830>>16510000
   <<                                                   >>     <<04830>>16515000
   <<          ACQUIRE BUFFER SPECIFIED                 >>     <<04830>>16520000
   <<                                                   >>     <<04830>>16525000
   <<***************************************************>>     <<04830>>16530000
                                                               <<04830>>16535000
   IF M="UB" THEN BEGIN  <<USE BUFFER SPECIFIED>>              <<04830>>16540000
       BUF'USED:=R;                                            <<04830>>16545000
       UB(BUF'USED);                                           <<04830>>16550000
       RETURN;                                                 <<04830>>16555000
       END;                                                    <<04830>>16560000
                                                               <<04830>>16565000
   <<***************************************************>>     <<04830>>16570000
   <<                                                   >>     <<04830>>16575000
   <<          FREE BUFFER SPECIFIED                    >>     <<04830>>16580000
   <<                                                   >>     <<04830>>16585000
   <<***************************************************>>     <<04830>>16590000
                                                               <<04830>>16595000
   IF M="FB" THEN BEGIN  <<FREE BUFFER SPECIFIED>>             <<04830>>16600000
       FREE'BUF:=R;                                            <<04830>>16605000
       FB(FREE'BUF);                                           <<04830>>16610000
       RETURN;                                                 <<04830>>16615000
       END;                                                    <<04830>>16620000
                                                               <<04830>>16625000
                                                               <<04830>>16630000
   <<***************************************************>>     <<04830>>16635000
   <<                                                   >>     <<04830>>16640000
   <<           COMPARE TWO BUFFERS                     >>     <<04830>>16645000
   <<                                                   >>     <<04830>>16650000
   <<***************************************************>>     <<04830>>16655000
                                                               <<04830>>16660000
   IF BM="CMP" THEN BEGIN    <<COMPARE TWO BUFFERS>>           <<04830>>16665000
       EXISTS:=TRUE;  <<CHECKS IF BUFFERS ARE ALLOCATED>>      <<04830>>16670000
       BUFF'ONE:=R;                                            <<04830>>16675000
       BUFF'TWO:=R1;                                           <<04830>>16680000
       IF (BUFF'ONE<0) OR (BUFF'ONE>16)   OR                   <<04830>>16685000
          (BUFF'TWO<0) OR (BUFF'TWO>16) THEN                   <<04830>>16690000
              BEGIN       <<OUT OF RANGE>>                     <<04830>>16695000
                  PRINTE(M32W,17);                             <<04830>>16700000
                  RETURN;                                      <<04830>>16705000
              END;                                             <<04830>>16710000
       IF (BUFF'ONE=0) OR (BUFF'TWO=0) THEN                    <<04830>>16715000
          BEGIN                                                <<04830>>16720000
            PRINTE(M42W,-35);                                  <<04830>>16725000
            PRINTE(M43W,-25);                                  <<04830>>16730000
            RETURN;                                            <<04830>>16735000
          END                                                  <<04830>>16740000
       ELSE                                                    <<04830>>16745000
         BEGIN  <<IF DSTARRAY(index) =0 THEN A DATA SEG >>     <<04830>>16750000
              <<DOES NOT EXIST AND NO COMPARISON WILL BE DONE>><<04830>>16755000
                                                               <<04830>>16760000
            IF DSTARRAY(BUFF'ONE)=0 THEN                       <<04830>>16765000
               BEGIN                                           <<04830>>16770000
                   EXISTS:=FALSE;                              <<04830>>16775000
                   PRINTE(M40W,-36);                           <<04830>>16780000
               END;                                            <<04830>>16785000
            IF DSTARRAY(BUFF'TWO)=0 THEN                       <<04830>>16790000
               BEGIN                                           <<04830>>16795000
                   EXISTS:=FALSE;                              <<04830>>16800000
                   PRINTE(M41W,-37);                           <<04830>>16805000
               END;                                            <<04830>>16810000
         END;                                                  <<04830>>16815000
       IF EXISTS=FALSE THEN RETURN                             <<04830>>16820000
       ELSE                                                    <<04830>>16825000
          COMPARE(BUFF'ONE,BUFF'TWO);                          <<04830>>16830000
        RETURN;                                                <<04830>>16835000
        END;                                                   <<04830>>16840000
                                                               <<04830>>16845000
                                                               <<04830>>16850000
                                                               <<04830>>16855000
   <<***************************************************>>     <<04830>>16860000
   <<                                                   >>     <<04830>>16865000
   <<          DISPLAY WHOLE IOQ, FREELIST              >>     <<04830>>16870000
   <<                 OR IOQ'S IN USE                   >>     <<04830>>16875000
   <<***************************************************>>     <<04830>>16880000
   IF  BM="DIOQ" THEN BEGIN                                    <<04830>>16885000
       NUMCHAR:=ASCII(R1,10,DEV'NO);                           <<04830>>16890000
       MOVE PRINT'LINE:=80(" ");                               <<04830>>16895000
       CASE R OF      <<HEADING>>                              <<04830>>16900000
       BEGIN                                                   <<04830>>16905000
         BEGIN                                                 <<04830>>16910000
           MOVE PRINT'LINE(30):="ALL IOQ'S";                   <<04830>>16915000
           IF R1<>0 THEN                                       <<04830>>16920000
             BEGIN                                             <<04830>>16925000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>16930000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>16935000
             END;                                              <<04830>>16940000
            PRINT(PRINT'LINE,-79,%40);                         <<04830>>16945000
         END;                                                  <<04830>>16950000
         BEGIN                                                 <<04830>>16955000
           MOVE PRINT'LINE(29):="FREE IOQ'S";                  <<04830>>16960000
           IF R1<>0 THEN                                       <<04830>>16965000
             BEGIN                                             <<04830>>16970000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>16975000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>16980000
             END;                                              <<04830>>16985000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>16990000
         END;                                                  <<04830>>16995000
         BEGIN                                                 <<04830>>17000000
           MOVE PRINT'LINE(28):="IOQ'S IN USE";                <<04830>>17005000
           IF R1<>0 THEN                                       <<04830>>17010000
             BEGIN                                             <<04830>>17015000
               MOVE PRINT'LINE(41):="FOR LDEV";                <<04830>>17020000
               MOVE PRINT'LINE(50):=DEV'NO, (NUMCHAR);         <<04830>>17025000
             END;                                              <<04830>>17030000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>17035000
         END;                                                  <<04830>>17040000
       END;                                                    <<04830>>17045000
       HEADER;                                                 <<04830>>17050000
       << ENT'SIZE IN BELOW IS REALLY HEADER SIZE >>           <<06989>>17055000
       PRINT'IOQ(R,R1,IOQ'DST,IQH'ENT'SIZE);                   <<06989>>17060000
       RELDATASEG(SNAPSHOT'DST);                               <<04830>>17065000
       RETURN;                                                 <<04830>>17070000
       END;                                                    <<04830>>17075000
                                                               <<04830>>17080000
                                                               <<04830>>17085000
                                                               <<04830>>17090000
                                                               <<04830>>17095000
   <<***************************************************>>     <<04830>>17100000
   <<                                                   >>     <<04830>>17105000
   <<          DISPLAY WHOLE DRQ, FREE DRQ'S            >>     <<04830>>17110000
   <<                OR DRQ'S IN USE                    >>     <<04830>>17115000
   <<***************************************************>>     <<04830>>17120000
                                                               <<04830>>17125000
   IF BM="DDRQ" THEN BEGIN                                     <<04830>>17130000
       NUMCHAR:=ASCII(R1,10,DEV'NO);                           <<04830>>17135000
       MOVE PRINT'LINE:=80(" ");                               <<04830>>17140000
       CASE R OF      <<HEADING>>                              <<04830>>17145000
       BEGIN                                                   <<04830>>17150000
         BEGIN                                                 <<04830>>17155000
           MOVE PRINT'LINE(30):="ALL DRQ'S";                   <<04830>>17160000
           IF R1<>0 THEN                                       <<04830>>17165000
             BEGIN                                             <<04830>>17170000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>17175000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>17180000
             END;                                              <<04830>>17185000
            PRINT(PRINT'LINE,-79,%40);                         <<04830>>17190000
         END;                                                  <<04830>>17195000
         BEGIN                                                 <<04830>>17200000
           MOVE PRINT'LINE(29):="FREE DRQ'S";                  <<04830>>17205000
           IF R1<>0 THEN                                       <<04830>>17210000
             BEGIN                                             <<04830>>17215000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>17220000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>17225000
             END;                                              <<04830>>17230000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>17235000
         END;                                                  <<04830>>17240000
         BEGIN                                                 <<04830>>17245000
           MOVE PRINT'LINE(28):="DRQ'S IN USE";                <<04830>>17250000
           IF R1<>0 THEN                                       <<04830>>17255000
             BEGIN                                             <<04830>>17260000
               MOVE PRINT'LINE(41):="FOR LDEV";                <<04830>>17265000
               MOVE PRINT'LINE(50):=DEV'NO, (NUMCHAR);         <<04830>>17270000
             END;                                              <<04830>>17275000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>17280000
         END;                                                  <<04830>>17285000
       END;                                                    <<04830>>17290000
       HEADER;                                                 <<04830>>17295000
       << ENT'SIZE IN BELOW IS REALLY HEADER SIZE >>           <<06989>>17300000
       PRINT'IOQ(R,R1,DRQ'DST,DQH'ENT'SIZE);                   <<06989>>17305000
       RELDATASEG(SNAPSHOT'DST);                               <<04830>>17310000
       RETURN;                                                 <<04830>>17315000
       END;                                                    <<04830>>17320000
                                                               <<04830>>17325000
                                                               <<04830>>17330000
    <<**************************************************************>>  17335000
    <<                                                              >>  17340000
    <<  TERMINATE PROGRAM EXECUTION & EXIT (EX)                     >>  17345000
    <<                                                              >>  17350000
    <<**************************************************************>>  17355000
                                                                        17360000
    IF M="EX" THEN BEGIN     << END PROGRAM EXECUTION >>                17365000
      FOR COUNT:=16 STEP -1 UNTIL 1 DO  <<DST MUST BE FREED>>  <<04830>>17370000
         IF DSTARRAY(COUNT)<>0 THEN FB(COUNT);                 <<04830>>17375000
      PTEST( 0, 0);                                                     17380000
      NOMORE := EFLAG := TRUE;                                          17385000
      RETURN;                                                           17390000
      END;                                                              17395000
                                                                        17400000
    <<**************************************************************>>  17405000
    <<                                                              >>  17410000
    <<  PERFORM OCTAL CONVERSION (O)                                >>  17415000
    <<                                                              >>  17420000
    <<**************************************************************>>  17425000
                                                                        17430000
    IF T="O" THEN BEGIN     << OCTAL CONVERSION >>                      17435000
      PTEST( 1, 1 );                                                    17440000
      M := "=%";   ASCII( R, 8, BM(2) );                                17445000
      PRINT'( M, 4, 0 );        RETURN;                                 17450000
      END;                                                              17455000
                                                                        17460000
    <<**************************************************************>>  17465000
    <<                                                              >>  17470000
    <<  PERFORM DECIMAL CONVERSION (DEC)                            >>  17475000
    <<                                                              >>  17480000
    <<**************************************************************>>  17485000
                                                                        17490000
    IF BM="DEC" THEN BEGIN        << DECIMAL CONVERSION >>              17495000
      PTEST( 1, 1 );       M := "= ";                                   17500000
      PRINT'( M, -(ASCII( R, 10, BM(2) ) + 2), 0 );                     17505000
      RETURN;                                                           17510000
      END;                                                              17515000
                                                                        17520000
    <<**************************************************************>>  17525000
    <<                                                              >>  17530000
    <<  REDIRECT LIST OPTION (LD)                                   >>  17535000
    <<                                                              >>  17540000
    <<**************************************************************>>  17545000
                                                                        17550000
    IF M="LD" THEN  << SET OPTIONAL LIST DEVICE >>                      17555000
      BEGIN                                                             17560000
        PTEST( 0, 1 );                                                  17565000
        IF FN>0 THEN FCLOSE(FN, 0, 0);                                  17570000
        FN := 0;                                                        17575000
                                                                        17580000
        IF R=1 THEN  << OPEN NEW LIST DEVICE >>                         17585000
          BEGIN                                                         17590000
            FN := FOPEN(LA,4,1,,LP);                                    17595000
            IF <> THEN   << TROUBLE >>                                  17600000
              BEGIN                                                     17605000
                MOVE BM := "FOPEN FAILED";                              17610000
                PRINTE(M, 6);     FN := 0;                              17615000
              END;                                                      17620000
          END                                                           17625000
       ELSE IF R<>0 THEN  << CHECK LDEV FOR LIST DEVICE >>              17630000
          BEGIN                                                         17635000
            T := DEVTYPE(R);                                            17640000
            IF T<>16 AND T<>32 THEN  << NOT A LIST DEVICE >>            17645000
              BEGIN                                                     17650000
                MOVE BM := "INVALID LIST DEVICE";                       17655000
                PRINTE(M, -19);                                         17660000
              END                                                       17665000
            ELSE FN := -R;                                              17670000
          END;                                                          17675000
        RETURN;                                                         17680000
      END;                                                              17685000
                                                                        17690000
    <<**************************************************************>>  17695000
    <<                                                              >>  17700000
    <<  LIST STORED PROGRAM (LI)                                    >>  17705000
    <<                                                              >>  17710000
    <<**************************************************************>>  17715000
                                                                        17720000
    IF M="LI" THEN BEGIN     << LIST PROGRAM >>                         17725000
      CHECKPROG(FALSE);  << CHECK IF ANY PROGRAM >>                     17730000
      IF NOPARAM THEN BEGIN  R := 1;   R1 := 9999;   END                17735000
      ELSE IF NOT TWOPARAMS THEN R1 := R;                               17740000
                                                                        17745000
      IF R1<10000 AND 1<=R<=R1 THEN  << VALID LINE NUMBERS >>           17750000
        BEGIN                                                           17755000
        MOVE BM := "     ";                                             17760000
        I  := FINDLINE(R,  TRUE );  << FIND THIS OR NEXT >>             17765000
        R1 := FINDLINE(R1, FALSE);  << THIS OR PREVIOUS >>              17770000
                                                                        17775000
        WHILE I<PROGEND AND I<=R1 DO  << GET NEXT STATEMENT >>          17780000
          BEGIN                                                         17785000
            ASCII(PROG(I),10,BM);                                       17790000
            J := PROG(X:=X+1);  << LENGTH OF STATEMENT >>               17795000
            MOVE BM(5) := BPROG(I*2+4), (J);                            17800000
            OUTPUT(M, -(J+5), 0);      STEP'PC(I);                      17805000
          END;                                                          17810000
        END                                                             17815000
      ELSE PRINTE(M2, 12);  << INVALID STATEMENT >>                     17820000
      RETURN;                                                           17825000
      END;                                                              17830000
                                                                        17835000
    <<**************************************************************>>  17840000
    <<                                                              >>  17845000
    <<  CLEAR STORED PROGRAM (CL)                                   >>  17850000
    <<                                                              >>  17855000
    <<**************************************************************>>  17860000
                                                                        17865000
    IF M="CL" THEN BEGIN    << CLEAR PROGRAM AREA >>                    17870000
      IF NOT PROGFLAG THEN   << NOT RUNNING SO MODS OK >>               17875000
        IF NOPARAM THEN PROGEND := 0                                    17880000
        ELSE BEGIN   << FIND STARTING AND ENDING STATEMENTS & DELETE >> 17885000
          IF NOT TWOPARAMS THEN R1 := R;                                17890000
          IF R1<10000 AND 1<=R<=R1 THEN  << VALID STATEMENT NUMBERS >>  17895000
            BEGIN                                                       17900000
            I  := FINDLINE(R,  TRUE );  << FIND THIS OR NEXT >>         17905000
            T := FINDLINE(R1, FALSE);  << FIND THIS OR PREVIOUS >>      17910000
            STEP'PC(T);  << STEP PAST LAST STATEMENT >>                 17915000
                                                                        17920000
            IF I<PROGEND AND I<T THEN BEGIN   << DELETE STATEMENTS >>   17925000
              PROGEND := PROGEND - T;   << LENGTH TO MOVE >>            17930000
              MOVE PROG(I) := PROG(T),(PROGEND);                        17935000
              PROGEND := PROGEND + I;   << NEW LENGTH >>                17940000
              END;                                                      17945000
            END                                                         17950000
          ELSE PRINTE(M2, 12);   << INVALID STATEMENT NUMBER >>         17955000
        END                                                             17960000
      ELSE PRINTE(M4, 11);   << ERROR, PROGRAM RUNNING >>               17965000
      RETURN;                                                           17970000
      END;                                                              17975000
                                                                        17980000
    <<**************************************************************>>  17985000
    <<                                                              >>  17990000
    <<  RUN STORED PROGRAM (R)                                      >>  17995000
    <<                                                              >>  18000000
    <<**************************************************************>>  18005000
                                                                        18010000
    IF T="R" AND M<>"RI" THEN BEGIN     << RUN STORED PROGRAM >>        18015000
      CHECKPROG(TRUE);   << ERROR IF NO PROGRAM >>                      18020000
      PTEST( 0, 1 );     IF NOPARAM THEN R := 1;                        18025000
      R := R - 1;        CHECKPARAMS(%77777);                           18030000
                                                                        18035000
      IF NOT PROGFLAG THEN BEGIN      << EXECUTE ON A NEW LEVEL >>      18040000
        PC := 0;             PROGRUN := R;                              18045000
        PROGFLAG := TRUE;    TSOURCE := SOURCE;   SOURCE := 1;          18050000
        DO DOMAIN UNTIL SFLAG OR EFLAG;                                 18055000
        SFLAG := PROGFLAG := FALSE;     SOURCE := TSOURCE;              18060000
        END                                                             18065000
      ELSE PRINTE(M4, 11);  << ERROR, ALREADY RUNNING >>                18070000
      RETURN;                                                           18075000
      END;                                                              18080000
                                                                        18085000
    <<**************************************************************>>  18090000
    <<                                                              >>  18095000
    <<  GO TO PROGRAM STATEMENT & BEGIN EXECUTION (GO)              >>  18100000
    <<                                                              >>  18105000
    <<**************************************************************>>  18110000
                                                                        18115000
    IF M="GO" THEN BEGIN     << GOTO PROGRAM STATEMENT >>               18120000
      CHECKPROG(TRUE);   << ERROR IF NO PROGRAM >>                      18125000
      PTEST( 0, 1 );      CHECKPARAMS(10000);                           18130000
                                                                        18135000
      I := 0;                                                           18140000
      IF NOT NOPARAM THEN WHILE I<PROGEND AND PROG(I)<>R DO STEP'PC(I); 18145000
      IF I=PROGEND THEN   << STATEMENT NOT FOUND >>                     18150000
        PRINTE(M2, 12)    << INVALID STATEMENT NUMBER >>                18155000
      ELSE IF NOT PROGFLAG OR SOURCE=1 THEN                             18160000
        BEGIN   << NOT EXECUTING OR EXECUTING HERE >>                   18165000
        PC := I;    << SET NEW PROGRAM COUNTER >>                       18170000
        IF NOT PROGFLAG THEN  << START EXECUTION ON A NEW LEVEL >>      18175000
          BEGIN                                                         18180000
          PROGFLAG := TRUE;      PROGRUN := 0;                          18185000
          TSOURCE := SOURCE;     SOURCE := 1;                           18190000
          DO DOMAIN UNTIL EFLAG OR SFLAG;                               18195000
          SOURCE := TSOURCE;     SFLAG := PROGFLAG := FALSE;            18200000
          END;                                                          18205000
        END                                                             18210000
      ELSE PRINTE(M4, 11);  << ERROR, ALREADY RUNNING ELSEWHERE >>      18215000
      RETURN;                                                           18220000
      END;                                                              18225000
                                                                        18230000
    <<**************************************************************>>  18235000
    <<                                                              >>  18240000
    <<  GET COMMANDS FROM DO FILE (DO)                              >>  18245000
    <<                                                              >>  18250000
    <<**************************************************************>>  18255000
                                                                        18260000
    IF M="DO" THEN BEGIN     << GET COMMANDS FROM A DO FILE >>          18265000
      PTEST( 1, 1 );                                                    18270000
      BM(L) := " ";     TDF := DF;                                      18275000
      DF := FOPEN(BM(I), 5);   << OLD, FIXED >>                         18280000
      IF = THEN   << OPENED OK,   EXECUTE ON NEXT LEVEL >>              18285000
        BEGIN                                                           18290000
        MOVE TFNAME := FNAME,(30);                                      18295000
        MOVE TLINENO := LINENO,(12);                                    18300000
        TSOURCE := SOURCE;   TFNL := FNL;   SOURCE := 2;                18305000
        FNL := L - I;   MOVE FNAME(4) := BM(I),(FNL);                   18310000
        DO DOMAIN UNTIL SFLAG OR EFLAG;                                 18315000
        SFLAG := FALSE;   SOURCE := TSOURCE;    FNL := TFNL;            18320000
        MOVE LINENO := TLINENO,(12);                                    18325000
        MOVE FNAME  := TFNAME ,(30);                                    18330000
        FCLOSE(DF, 0, 0);                                               18335000
        END                                                             18340000
      ELSE   << OPEN FAILED >>                                          18345000
        BEGIN                                                           18350000
        MOVE BM := BM(I),(L-I);                                         18355000
        MOVE BM(L-I) := " FOPEN FAILED";                                18360000
        PRINTE(M, I-L-13);                                              18365000
        END;                                                            18370000
                                                                        18375000
      DF := TDF;                                                        18380000
      RETURN;                                                           18385000
      END;                                                              18390000
                                                                        18395000
    <<**************************************************************>>  18400000
    <<                                                              >>  18405000
    <<  CALL HELP (H)                                               >>  18410000
    <<                                                              >>  18415000
    <<**************************************************************>>  18420000
                                                                        18425000
    IF T="H" THEN BEGIN       << CALL HELP >>                           18430000
      PTEST( 0, 0 );                                                    18435000
      PRINTX(M16W, -56);  << CALL HELP (YES/NO)? MESSAGE >>    <<06989>>18440000
      READ( M,-3);   << WAIT FOR MESSAGE TO FINISH >>          <<06989>>18445000
      IF BM = "YES" THEN  << CALL HELP >>                      <<06989>>18450000
      HELP;    RETURN;                                                  18455000
      END;                                                              18460000
                                                                        18465000
    <<**************************************************************>>  18470000
    <<                                                              >>  18475000
    <<  CALL DEBUG (DE)                                             >>  18480000
    <<                                                              >>  18485000
    <<**************************************************************>>  18490000
                                                                        18495000
    IF M="DE" THEN     << CALL DEBUG >>                                 18500000
      BEGIN   PTEST( 0, 0 );  DEBUG;   RETURN;  END;                    18505000
                                                                        18510000
    <<**************************************************************>>  18515000
    <<                                                              >>  18520000
    <<  ENTRY OF DRT# (DRT)                                         >>  18525000
    <<                                                              >>  18530000
    <<**************************************************************>>  18535000
                                                                        18540000
    IF BM="DRT" THEN  << DRT# ENTRY >>                         <<00924>>18545000
      BEGIN                                                    <<00924>>18550000
        PTEST( 1, 1 );                                         <<00924>>18555000
        IF R<4 OR POSTSERIES3 AND R<8 THEN <<INVALID DRT#>>    <<01407>>18560000
          BEGIN PRINTE(M30W,6); RETURN; END;                   <<00924>>18565000
        DX := R; DRTFLG := 1;  << SET USER'S DRT ENTRY FLG >>  <<00924>>18570000
        PRINTX(M6,22);  << DRT# OVERRIDES LDEV >>              <<00924>>18575000
        RETURN;                                                <<00924>>18580000
      END;                                                     <<00924>>18585000
                                                                        18590000
    <<**************************************************************>>  18595000
    <<                                                              >>  18600000
    <<  DISPLAY BUFFER IN ASCII (DA)                                >>  18605000
    <<                                                              >>  18610000
    <<**************************************************************>>  18615000
                                                                        18620000
    IF M="DA" THEN BEGIN    << DISPLAY BUFFER IN ASCII >>               18625000
      IF NOPARAM THEN  BEGIN   R := 0;   R1 := XLOG;  END;              18630000
      IF R1=0 THEN R1 := C;                                             18635000
      R2 := R1;   IF > THEN R2 := -(R2*2);                              18640000
      CHECKPARAMS( LIMIT );                                             18645000
                                                                        18650000
      WHILE R2<0 DO   << PRINT A LINE IN ASCII >>                       18655000
        BEGIN                                                           18660000
          OUTPUT( B(R), IF R2<-64 THEN -64 ELSE R2, 0 );                18665000
          R2 := R2 + 64;   R := R + 32;                                 18670000
        END;                                                            18675000
      RETURN;                                                           18680000
      END;                                                              18685000
                                                                        18690000
    <<**************************************************************>>  18695000
    <<                                                              >>  18700000
    <<  DISPLAY BUFFER IN OCTAL (DB)                                >>  18705000
    <<                                                              >>  18710000
    <<**************************************************************>>  18715000
                                                                        18720000
    IF M="DB" THEN BEGIN    << PRINT BUFFER IN OCTAL >>                 18725000
      IF NOPARAM THEN  BEGIN  R := 0;  R1 := XLOG;  END;                18730000
      CHECKPARAMS( LIMIT );       BFLAG := TRUE;  << PRINT BUFFER >>    18735000
      PRINTBUFFER( R, R1 );                                             18740000
      RETURN;                                                           18745000
      END;                                                              18750000
                                                                        18755000
    <<**************************************************************>>  18760000
    <<                                                              >>  18765000
    <<  DISPLAY DIT TABLE FOR LDEV (DD)                             >>  18770000
    <<                                                              >>  18775000
    <<**************************************************************>>  18780000
                                                                        18785000
    IF M="DD" THEN BEGIN      << DISPLAY DIT >>                         18790000
      SETPOINTERS( D );                                                 18795000
      IF NOPARAM THEN  BEGIN  R := 0;  R1 := DITL;  END;                18800000
      CHECKPARAMS( DITL );                                              18805000
      PRINTBUFFER( DITP+R, R1 );                                        18810000
      RETURN;                                                           18815000
      END;                                                              18820000
                                                                        18825000
    <<**************************************************************>>  18830000
    <<                                                              >>  18835000
    <<  DISPLAY IOQ ENTRY FOR LDEV (DQ)                             >>  18840000
    <<                                                              >>  18845000
    <<**************************************************************>>  18850000
                                                                        18855000
    IF M="DQ" THEN    << DISPLAY  FIRST IOQ >>                          18860000
      BEGIN                                                             18865000
        PTEST( 0, 1 );  SETPOINTERS( D );                               18870000
        IF NOPARAM THEN R := 254;                                       18875000
        CHECKPARAMS( 255 );                                             18880000
        IF IOQP=%1000 THEN    << NO IOQ >>                              18885000
          BEGIN  PRINTX(M23W,3);  RETURN;  END;                         18890000
                                                                        18895000
        WHILE IOQP<>%1000 AND (R:=R-1)>=0 DO                            18900000
          BEGIN                                                         18905000
            OUTPUT(M, 0, 0); << Leave a space >>               <<03120>>18910000
            PRINTBUFFER(IOQP, if LDEV'IS'DISC then 16          <<03120>>18915000
                                else 11);                      <<03120>>18920000
            IOQP := ABS(IOQP+1) + %1000;   << STEP TO NEXT IOQ >>       18925000
          END;                                                          18930000
        OUTPUT(M, 0, 0); << Leave a space >>                   <<03120>>18935000
        RETURN;                                                         18940000
      END;                                                              18945000
                                                                        18950000
    <<**************************************************************>>  18955000
    <<                                                              >>  18960000
    <<  DISPLAY DRT TABLE AND SIO OR CHANNEL PROGRAM AREA (DS)      >>  18965000
    <<                                                              >>  18970000
    <<**************************************************************>>  18975000
                                                                        18980000
    IF BM="DSI" THEN   << DISPLAY DRT AND SIO AREA >>                   18985000
      BEGIN                                                             18990000
        SETPOINTERS( D );                                               18995000
        IF NOPARAM THEN  BEGIN  R := 0;  R1 := SIOL;  END;              19000000
        CHECKPARAMS( SIOL );                                            19005000
        << Print header >>                                     <<03120>>19010000
        move BM := "4 words of DRT ",2;                        <<03120>>19015000
        N := tos - @BM;                                        <<03120>>19020000
        N := N + ASCII(DX,10,BM(N));                           <<03120>>19025000
        move BM(N) := "- ";                                    <<03120>>19030000
        N := (N+2)/2;                                          <<03120>>19035000
        OUTPUT(M,N,0);                                         <<03120>>19040000
                                                               <<03120>>19045000
        << Print DRT words >>                                  <<03120>>19050000
        M := "  ";                                             <<03120>>19055000
        move M(1) := M,(14);                                   <<03120>>19060000
        N := -1;                                               <<03120>>19065000
        while (N:=N+1) < 4 do                                  <<03120>>19070000
          ASCII(GETDRT(DX,N),8,BM(N*7));                       <<03120>>19075000
        OUTPUT(M,-27,0);                                       <<03120>>19080000
                                                               <<03120>>19085000
        << Print header for SIO area >>                        <<03120>>19090000
        move  M := "SIO program area-",2;                      <<03120>>19095000
        N := tos - @M;                                         <<03120>>19100000
        OUTPUT(M,N,0);                                         <<03120>>19105000
                                                               <<03120>>19110000
        PRINTBUFFER( SIOP+R, R1 );                                      19115000
        RETURN;                                                         19120000
      END;                                                              19125000
                                                                        19130000
    <<**************************************************************>>  19135000
    <<                                                              >>  19140000
    <<  MODIFY DIT TABLE FOR LDEV (MD)                              >>  19145000
    <<                                                              >>  19150000
    <<**************************************************************>>  19155000
                                                                        19160000
    IF M="MD" THEN   << MODIFY DIT >>                                   19165000
      BEGIN                                                             19170000
        PTEST( 1, 2 );    SETPOINTERS( D );                             19175000
        CHECKPARAMS( DITL );      R2 := R;  R3 := R1;                   19180000
        WHILE (R3:=R3-1)>=0 DO                                          19185000
          BEGIN    MODIFYBUFFER(DITP+R2);   R2 := R2 + 1;   END;        19190000
        RETURN;                                                         19195000
      END;                                                              19200000
                                                                        19205000
    <<**************************************************************>>  19210000
    <<                                                              >>  19215000
    <<  MODIFY IOQ ENTRY FOR LDEV (MQ)                              >>  19220000
    <<                                                              >>  19225000
    <<**************************************************************>>  19230000
                                                                        19235000
    IF M="MQ" THEN   << MODIFY IOQ >>                                   19240000
      BEGIN                                                             19245000
        PTEST( 1, 2 );     SETPOINTERS( D );                            19250000
        IF IOQP=%1000 THEN    << NO IOQ >>                              19255000
          BEGIN   PRINTX(M23W, 3);   RETURN;  END;                      19260000
        CHECKPARAMS( 11 );     R2 := R;   R3 := R1;                     19265000
        WHILE (R3:=R3-1)>=0 DO                                          19270000
          BEGIN   MODIFYBUFFER(IOQP+R2);  R2 := R2 + 1;   END;          19275000
        RETURN;                                                         19280000
      END;                                                              19285000
                                                                        19290000
    <<**************************************************************>>  19295000
    <<                                                              >>  19300000
    <<  MODIFY THE BUFFER (MB)                                      >>  19305000
    <<                                                              >>  19310000
    <<**************************************************************>>  19315000
                                                                        19320000
    IF M="MB" THEN    << MODIFY BUFFER >>                               19325000
      BEGIN                                                             19330000
        PTEST( 1, 2 );    CHECKPARAMS( LIMIT );                         19335000
        R2 := R;    R3 := R1;     BFLAG := TRUE;                        19340000
        WHILE (R3:=R3-1)>=0 DO                                          19345000
          BEGIN   MODIFYBUFFER( R2 );   R2 := R2 + 1;  END;             19350000
        RETURN;                                                         19355000
      END;                                                              19360000
                                                                        19365000
    <<**************************************************************>>  19370000
    <<                                                              >>  19375000
    <<  CHECK FOR PENDING I/O (CH)                                  >>  19380000
    <<                                                              >>  19385000
    <<**************************************************************>>  19390000
                                                                        19395000
    IF M="CH" THEN  << CHECK PENDING I/O >>                             19400000
      BEGIN                                                             19405000
        PTEST( 0, 0 );                                                  19410000
        CHECKIOPENDING( 3 );  << PRINT ERRORS AND PENDING MSG >>        19415000
        RETURN;                                                         19420000
      END;                                                              19425000
                                                                        19430000
    <<**************************************************************>>  19435000
    <<                                                              >>  19440000
    <<  DISPLAY STATUS AND XLOG (DS)                                >>  19445000
    <<                                                              >>  19450000
    <<**************************************************************>>  19455000
                                                                        19460000
    IF M="DS"THEN      << PRINT STATUS AND XLOG >>                      19465000
      BEGIN                                                             19470000
        CHECKIOPENDING( 2 );  << I/O PENDING MSG ONLY >>                19475000
        PTEST( 0, 0 );         PRINTSTATUS;                             19480000
        RETURN;                                                         19485000
      END;                                                              19490000
                                                                        19495000
    <<**************************************************************>>  19500000
    <<                                                              >>  19505000
    <<  TEST I/O (TIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]           >>  19510000
    <<                                                              >>  19515000
    <<**************************************************************>>  19520000
                                                                        19525000
    IF BM="TIO" THEN      << DO TIO >>                                  19530000
      BEGIN                                                             19535000
        PTEST( 0, 0 );                                                  19540000
        SETPOINTERS( D );                                      <<01366>>19545000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>19550000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>19555000
          BEGIN                   <<I/O SYSTEMS, TP, & ICF'S>> <<01407>>19560000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>19565000
          RETURN;                                              <<01366>>19570000
          END;                                                 <<01366>>19575000
        TOS := DX;   << DRT NUMBER >>                                   19580000
        ASMB( TIO 0 );                                                  19585000
        X := TRUE;     PRINTRESULT( * );    << PRINT RESULT OF TIO >>   19590000
        RETURN;                                                         19595000
      END;                                                              19600000
                                                                        19605000
    <<**************************************************************>>  19610000
    <<                                                              >>  19615000
    <<  READ I/O (RIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]           >>  19620000
    <<                                                              >>  19625000
    <<**************************************************************>>  19630000
                                                                        19635000
    IF M="RI" THEN     << RIO >>                                        19640000
      BEGIN                                                             19645000
        SETPOINTERS( D );                                      <<01366>>19650000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>19655000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>19660000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>19665000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>19670000
          RETURN;                                              <<01366>>19675000
          END;                                                 <<01366>>19680000
        PTEST( 0, 0 );                                                  19685000
        TOS := DX;  << DRT NUMBER >>                                    19690000
        ASMB( RIO 0 );                                                  19695000
        X := TRUE;     PRINTRESULT( * );    << PRINT RESULT OF RIO >>   19700000
        RETURN;                                                         19705000
      END;                                                              19710000
                                                                        19715000
    <<**************************************************************>>  19720000
    <<                                                              >>  19725000
    <<  CONTROL I/O (CIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]        >>  19730000
    <<                                                              >>  19735000
    <<**************************************************************>>  19740000
                                                                        19745000
    IF M="CI" THEN  << DO CIO >>                                        19750000
      BEGIN                                                             19755000
        SETPOINTERS( D );                                      <<01366>>19760000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>19765000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>19770000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>19775000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>19780000
          RETURN;                                              <<01366>>19785000
          END;                                                 <<01366>>19790000
        PTEST( 1, 1 );                                                  19795000
        TOS := DX;    TOS := R;   << DRT NUMBER AND CONTROL WORD >>     19800000
        ASMB( CIO 1 );                                                  19805000
        X := FALSE;    PRINTRESULT( * );   << PRINT IF NOT READY ONLY >>19810000
        RETURN;                                                         19815000
      END;                                                              19820000
                                                                        19825000
    <<**************************************************************>>  19830000
    <<                                                              >>  19835000
    <<  WRITE I/O (WIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]          >>  19840000
    <<                                                              >>  19845000
    <<**************************************************************>>  19850000
                                                                        19855000
    IF M="WI" THEN  << DO WIO >>                                        19860000
      BEGIN                                                             19865000
        SETPOINTERS( D );                                      <<01366>>19870000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>19875000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>19880000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>19885000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>19890000
          RETURN;                                              <<01366>>19895000
          END;                                                 <<01366>>19900000
        PTEST( 1, 1 );                                                  19905000
        TOS := DX;   TOS := R;    << DRT NUMBER AND WIO WORD >>         19910000
        ASMB( WIO 1 );                                                  19915000
        X := FALSE;    PRINTRESULT( * );  << PRINT IF NOT READY ONLY >> 19920000
        RETURN;                                                         19925000
      END;                                                              19930000
                                                                        19935000
    <<**************************************************************>>  19940000
    <<                                                              >>  19945000
    <<  CLEAR TERMINAL MONITORING AREA (CM)                         >>  19950000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  19955000
    <<                                                              >>  19960000
    <<**************************************************************>>  19965000
                                                                        19970000
    IF M="CM" THEN  << CLEAR MONITORING AREA >>                         19975000
      BEGIN                                                             19980000
        SETPOINTERS( D );                                      <<01366>>19985000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>19990000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>19995000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>20000000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>20005000
          RETURN;                                              <<01366>>20010000
          END;                                                 <<01366>>20015000
        X := ABS(%1066)+%777;                                           20020000
        IF X<>%777 THEN  << A SBUF TO CLEAR >>                          20025000
          FOR I := 0 UNTIL 128 DO ABS(X:=X+1) := 0;                     20030000
        RETURN;                                                         20035000
      END;                                                              20040000
                                                                        20045000
    <<**************************************************************>>  20050000
    <<                                                              >>  20055000
    <<  SET TERMINAL MONITORING CODE (M)                            >>  20060000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  20065000
    <<                                                              >>  20070000
    <<**************************************************************>>  20075000
                                                                        20080000
    IF T="M" THEN   << SET MONITORING CODE >>                           20085000
      BEGIN                                                             20090000
        SETPOINTERS( D );                                      <<01366>>20095000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>20100000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>20105000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>20110000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>20115000
          RETURN;                                              <<01366>>20120000
          END;                                                 <<01366>>20125000
        PTEST(0,1);  SETPOINTERS( D );                                  20130000
        R1 := 0;   CHECKPARAMS( %77 );                                  20135000
        IF DEVTYPE( D )=16 THEN    << IT IS A TERMINAL >>               20140000
          BEGIN  DISABLE;  ABS(DITP+33).(10:6) := R;   ENABLE;  END     20145000
        ELSE PRINTE( M13W, 6);   << INVALID LDEV >>                     20150000
        RETURN;                                                         20155000
      END;                                                              20160000
                                                                        20165000
    <<**************************************************************>>  20170000
    <<                                                              >>  20175000
    <<  PRINT TERMINAL MONITOR TABLE (P)                            >>  20180000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  20185000
    <<                                                              >>  20190000
    <<**************************************************************>>  20195000
                                                                        20200000
    IF T="P" AND M<>"PA" AND M<>"PB" THEN  << PRINT TERM MNTR TABLE >>  20205000
      BEGIN                                                             20210000
        SETPOINTERS( D );                                      <<01366>>20215000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>20220000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>20225000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>20230000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>20235000
          RETURN;                                              <<01366>>20240000
          END;                                                 <<01366>>20245000
        IF ABS(%1066)=0 THEN RETURN;  << NOTHING TO PRINT >>            20250000
        IF NOPARAM THEN R := 32;  << MAX NUMBER OF ENTRIES >>           20255000
        I := ABS(X) + %1000;    J := ABS(I);  << BASE & INDEX OF NEXT >>20260000
        K := J - 4*R + 1;  << START OF AREA >>                          20265000
        IF < THEN  << LESS THAN # REQUESTED MONITORED SO FAR >>         20270000
          BEGIN   K := 1;   R := J/4;  END;                             20275000
        IF R=0 THEN RETURN;  << NOTHING TO PRINT >>                     20280000
                                                                        20285000
        M := "  ";   MOVE M(1) := M,(40);                               20290000
        MOVE BM(36) := "MODEM T L R B P D Q";                           20295000
        OUTPUT(M, -55, 0 );  << FIRST LINE OF HEADER >>                 20300000
        MOVE BM := "TIME  ID  DS UNIT  P1     P2   MNTR";               20305000
        MOVE BM(36) := "ABSFC M P P R R F F FNC P1 STAT RQS";           20310000
        OUTPUT(M, -71, %60);  << 2ND LINE OF HEADER, DBL SPACE >>       20315000
                                                                        20320000
        CA := CF := CC := 0;  << SET IN UNKNOWN STATE >>                20325000
                                                                        20330000
        FOR R1 := 1 UNTIL R DO  << PRINT ENTRIES >>                     20335000
          BEGIN                                                         20340000
            M := "  ";   MOVE M(1) := M,(40);                           20345000
            K := K MOD 128;    J := I + K;  << J = BASE OF ENTRY >>     20350000
            T := ABS(J);    N := ABS(X:=X+1);                           20355000
            W2 := ABS(X:=X+1);  W3 := ABS(X:=X+1);                      20360000
                                                                        20365000
            TOS := 0;   << RETURN FOR DASCII >>                         20370000
            IF T.(4:12)<>%7777 THEN  << VALID TIME >>                   20375000
              BEGIN                                                     20380000
                X := T.(4:2)+1;   << EXPONENT OF TIME >>                20385000
                TOS := 0;    TOS := T.(6:10);  << MANTISSA >>           20390000
                WHILE DXBZ DO TOS := TOS&DLSL(3);                       20395000
              END                                                       20400000
            ELSE TOS := 99999 D;  << TIME OVER FLOW >>                  20405000
            DASCII( *, 10, BM);   << CONVERT TIME >>                    20410000
                                                                        20415000
            T := T.(0:4);         << SET T TO ENTRY ID >>               20420000
            MOVE BM(6) := ID(T*3),(3);  << CALLER ID >>                 20425000
            MOVE BM(10) := DSTATE(N.(12:4)*3),(3);  << DSTATE >>        20430000
            ASCII(N.(0:4),-10,BM(15));  << CONVERT UNIT NUMBER >>       20435000
                                                                        20440000
            IF T<>%10 AND T<>%11 THEN  << CONVERT P1 >>                 20445000
              ASCII(W2, 8, BM(17))                                      20450000
            ELSE                                                        20455000
              BEGIN << CONVERT FUNCTION & P1 OR STATUS >>               20460000
                ASCII(W2.(0:7), -10, BM(58));  << FUNCTION >>           20465000
                IF T=%10 THEN BCONVERT(W2.(7:9),60) << P1 >>            20470000
                  ELSE BCONVERT(W2.(8:8),64);  << STAT >>               20475000
              END;                                                      20480000
            IF T<>%10 AND T<>%11 AND T<>2 AND T<>5 THEN                 20485000
              ASCII(W3, 8, BM(24));  << CONVERT P2 >>                   20490000
                                                                        20495000
            IF T=5 THEN  << DSET CONTROL >>                             20500000
              BEGIN                                                     20505000
                IF W3=0 OR W3=2 THEN CA := 1                            20510000
                  ELSE IF W3=4 THEN CA := -1;                           20515000
                MOVE BM(24) := DS(W3*6),(6);                            20520000
              END                                                       20525000
            ELSE IF T=6 THEN  << DSET 1, CF AND CC >>                   20530000
              BEGIN                                                     20535000
                CF := IF LW3.(14:1) THEN 1 ELSE -1;                     20540000
                CC := IF LW3 THEN 1 ELSE -1;                            20545000
              END                                                       20550000
            ELSE IF T=7 THEN  << DSET 2, CB AND SB >>                   20555000
              BEGIN                                                     20560000
                CB := IF LW3.(14:1) THEN 1 ELSE -1;                     20565000
                SB := IF LW3 THEN 1 ELSE -1;                            20570000
              END                                                       20575000
            ELSE  << JUST SET CB AND SB >>                              20580000
              BEGIN  CB := N.(5:1);  SB := N.(6:1);  END;               20585000
                                                                        20590000
            FOR T1 := 0 UNTIL 4 DO << SET CA,CB,SB,CF,CC >>             20595000
              IF DSET(T1)<>0 THEN  << STATE IS KNOWN >>                 20600000
                BM(36+T1) := IF DSET(T1)>0 THEN "1" ELSE "0";           20605000
                                                                        20610000
            IF LN.( 6:1) THEN BM(34) := "P";  << PAIR >>                20615000
            IF LN.( 7:1) THEN BM(31) := "U";                            20620000
            IF LN.( 8:1) THEN BM(32) := "A";                            20625000
            IF LN.( 9:1) THEN BM(33) := "R";                            20630000
            IF LN.(10:1) THEN BM(52) := "F";  << BRK FLUSH >>           20635000
            IF LN.(11:1) THEN BM(48) := "B";  << BINARY READ >>         20640000
                                                                        20645000
            IF T=%10 OR T=%11 OR T=2 THEN                               20650000
              BEGIN  << P2 HAS REQUEST DATA >>                          20655000
                IF LW3.(0:1) THEN BM(54) := "F";  << CY FLUSH >>        20660000
                IF LW3.(1:1) THEN BM(50) := "P";  << PRIMED >>          20665000
                BM(42) := TM(W3.(2:2));  << SET TMODE >>                20670000
                BM(44) := PL(W3.(4:3));  << LAST PREMPT LEVEL >>        20675000
                BM(46) := PL(W3.(7:3));  << REQUEST P LEVEL >>          20680000
                BCONVERT(W3.(10:6),68);  << REQUEST STATE >>            20685000
              END;                                                      20690000
                                                                        20695000
            OUTPUT(M, -71, 0);  << PRINT ENTRY >>                       20700000
            K := K + 4;  << STEP TO NEXT ENTRY >>                       20705000
          END;                                                          20710000
                                                                        20715000
        RETURN;                                                         20720000
      END;                                                              20725000
                                                                        20730000
    <<**************************************************************>>  20735000
    <<                                                              >>  20740000
    <<  DISPLAY AVG EXECUTION TIME FOR ATTACHIO CALL (T)            >>  20745000
    <<                                                              >>  20750000
    <<**************************************************************>>  20755000
                                                                        20760000
    IF T="T" THEN       << PRINT OUT AVE ATTACHIO CALL TIME >>          20765000
      BEGIN                                                             20770000
        PTEST( 0, 0 );         @BP := @M5W;                             20775000
        TOS := REAL(TIME)/REAL(E);  << AVE EXECUTION TIME >>            20780000
        ASMB(DDUP,FIXR);   DELB;                                        20785000
        IF CARRY THEN @BP := @M20W;    << MORE THAN 32 SECONDS >>       20790000
                                                                        20795000
        IF TOS<=32 THEN  << PRINT TIME IN MILLISECONDS >>               20800000
          BEGIN   TOS := TOS*REAL(1000);   TOS := "MS";   END           20805000
        ELSE TOS := "S ";  << PRINT IN SECONDS >>                       20810000
        M5W(7) := TOS;                                                  20815000
                                                                        20820000
        ASMB(FIXR,DELB);     X := 13;                                   20825000
        WHILE X>7 DO  << CONVERT TO ASCII >>                            20830000
          BEGIN                                                         20835000
            ASMB(ZERO, XCH);   << FORM A DOUBLE >>                      20840000
            TOS := 10;     ASMB(LDIV,DECX);                             20845000
            IF X=9 THEN X := X-1;  << STEP OVER DECIMAL POINT >>        20850000
            M5(X) := TOS+%60;                                           20855000
          END;                                                          20860000
                                                                        20865000
        PRINTX(BP, 8);   << PRINT TIME OR GREATER THAN 32 SECONDS >>    20870000
        RETURN;                                                         20875000
      END;                                                              20880000
                                                                        20885000
    <<**************************************************************>>  20890000
    <<                                                              >>  20895000
    <<  DISPLAY ATTACHIO CALL PARAMETERS (D)                        >>  20900000
    <<                                                              >>  20905000
    <<**************************************************************>>  20910000
                                                                        20915000
    IF T="D" THEN  << DISPLAY ATTACHIO PARMETERS >>                     20920000
      BEGIN                                                             20925000
        PTEST( 0, 0 );                                                  20930000
        MOVE BM := "LDEV = ";     X := 7;                               20935000
        X := ASCII(D, 10, BM(X)) + X;                                   20940000
        MOVE BM(X) := ", FUNC = ";       X := X + 9;                    20945000
        X := ASCII(F, 10, BM(X)) + X;                                   20950000
        MOVE BM(X) := ", COUNT = ";      X := X + 10;                   20955000
        X := ASCII(C, 10, BM(X)) + X;                                   20960000
        MOVE BM(X) := ", FLAGS = ";      X := X + 10;                   20965000
        TOS := ASCII(FLG, 8, BM(X));     X := X + 6;                    20970000
        BM(X) := CR; BM(X:=X+1) := %12;  X := X + 1;                    20975000
        MOVE BM(X) := "QMISC = ";        X := X + 8;                    20980000
        TOS := ASCII(Q,  8, BM(X));      X := X + 6;                    20985000
        MOVE BM(X) := ", P1 = ";         X := X + 7;                    20990000
        TOS := ASCII(P1, 8, BM(X));      X := X + 6;                    20995000
        MOVE BM(X) := ", P2 = ";         X := X + 7;                    21000000
        TOS := ASCII(P2, 8, BM(X));      X := X + 6;                    21005000
        MOVE BM(X) := ", OFFSET = ";             X := X + 11;  <<06989>>21010000
        TOS := ASCII(BUF'OFFSET, 8, BM(X));      X := X + 6;   <<06989>>21015000
        PRINTX(M, -X);                                                  21020000
      IF BUF'USED=0 THEN                                       <<04830>>21025000
           PRINT(M36W,11,%40)                                  <<04830>>21030000
       ELSE   <<PRINT BUFFER AND DATA SEGMENT BEING USED>>     <<04830>>21035000
           BEGIN                                               <<04830>>21040000
              PRINT(M37W,-25,%320);                            <<04830>>21045000
              NUMCHAR:=ASCII(BUF'USED,10,BYTENUM);             <<04830>>21050000
              PRINT(LBYTENUM,-NUMCHAR,%320);                   <<04830>>21055000
              PRINT (M38W,-22,%320);                           <<04830>>21060000
              NUMCHAR:=ASCII(DSTARRAY(BUF'USED),8,BYTENUM);    <<04830>>21065000
             PRINT(LBYTENUM,-6,%40);                           <<04830>>21070000
          END;                                                 <<04830>>21075000
        RETURN;                                                         21080000
      END;                                                              21085000
                                                                        21090000
    <<**************************************************************>>  21095000
    <<                                                              >>  21100000
    <<  ASCII FILL THE BUFFER (A) OR ANOTE (AN)                     >>  21105000
    <<                                                              >>  21110000
    <<**************************************************************>>  21115000
                                                                        21120000
    IF T="A" THEN  << ASCII BUFFER FILL OR ANOTE >>                     21125000
      BEGIN                                                             21130000
        IF M<>"AN" THEN BEGIN    << ASSUME ASCII >>                     21135000
          CHECKIOPENDING( 2 );   << PRINT PENDING MSG ONLY >>           21140000
          IF NOPARAM THEN  << NO PARMETER SO INCREMENTAL FILL >>        21145000
            FOR I := 0 UNTIL LIMIT*2 DO BB(I) := 41 + I MOD 50          21150000
          ELSE  BEGIN   MOVE BB := BM(R1),(R);   C := -R;   END;        21155000
          END                                                           21160000
        ELSE BEGIN   << DO ANOTE >>                                     21165000
          MOVE BM := BM(R1),(R);                                        21170000
          OUTPUT(M, -R, 0);                                             21175000
          END;                                                          21180000
        RETURN;                                                         21185000
      END;                                                              21190000
                                                                        21195000
    <<**************************************************************>>  21200000
    <<                                                              >>  21205000
    <<  FILL BUFFER WITH PARAMETER INPUT (B)                        >>  21210000
    <<                                                              >>  21215000
    <<**************************************************************>>  21220000
                                                                        21225000
    IF T="B" THEN  << FILL BUFFER WITH PARAMETER >>                     21230000
      BEGIN                                                             21235000
        CHECKIOPENDING( 2 );   << PRINT PENDING MSG ONLY >>             21240000
        IF NOPARAM THEN R1 := LIMIT                                     21245000
          ELSE IF NOT TWOPARAMS THEN R1 := LIMIT;                       21250000
        R2 := R;     R := 0;                                            21255000
        CHECKPARAMS( LIMIT );                                           21260000
        FOR I:=0 UNTIL R1 DO B(I) := R2;                                21265000
        RETURN;                                                         21270000
      END;                                                              21275000
                                                                        21280000
    <<**************************************************************>>  21285000
    <<                                                              >>  21290000
    <<  SET LOGICAL DEVICE NUMBER (L)                               >>  21295000
    <<                                                              >>  21300000
    <<**************************************************************>>  21305000
                                                                        21310000
    IF T="L" THEN                                                       21315000
      BEGIN                                                             21320000
        PTEST( 1, 1 );                                         <<01222>>21325000
        IF DRTFLG=1 THEN  << USER'S DRT# FLAG SETS >>          <<01222>>21330000
          BEGIN  << PRINT WARNING MESSAGE >>                   <<01222>>21335000
          PRINTX(M7,15);  << LDEV OVERRIDES DRT# >>            <<01222>>21340000
          DRTFLG := 0;  << RESET USER'S DRT# FLAG >>           <<01222>>21345000
          END;                                                 <<01222>>21350000
        SETPOINTERS( R );  D := R;                             <<01222>>21355000
        RETURN;                                                <<01222>>21360000
      END;                                                              21365000
                                                                        21370000
    PTEST( 0, 1 );    << TEST FOR 0 OR 1 PARAMETER >>                   21375000
                                                                        21380000
    <<**************************************************************>>  21385000
    <<                                                              >>  21390000
    <<  SET COUNT FOR ATTACHIO CALL (C)                             >>  21395000
    <<                                                              >>  21400000
    <<**************************************************************>>  21405000
                                                                        21410000
    IF T="C" THEN                                                       21415000
      BEGIN    C := R;    RETURN;    END;                               21420000
                                                                        21425000
    <<**************************************************************>>  21430000
    <<                                                              >>  21435000
    <<  SET FUNCTION CODE FOR ATTACHIO CALL (F)                     >>  21440000
    <<                                                              >>  21445000
    <<**************************************************************>>  21450000
                                                                        21455000
    IF T="F" AND M<>"FL" THEN                                           21460000
      BEGIN    F := R;    RETURN;    END;                               21465000
                                                                        21470000
    <<**************************************************************>>  21475000
    <<                                                              >>  21480000
    <<  SET P1 FOR ATTACHIO CALL (PA)                               >>  21485000
    <<                                                              >>  21490000
    <<**************************************************************>>  21495000
                                                                        21500000
    IF M="PA" THEN                                                      21505000
      BEGIN    P1 := R;   RETURN;    END;                               21510000
                                                                        21515000
    <<**************************************************************>>  21520000
    <<                                                              >>  21525000
    <<  SET P2 FOR ATTACHIO CALL (PB)                               >>  21530000
    <<                                                              >>  21535000
    <<**************************************************************>>  21540000
                                                                        21545000
    IF M="PB" THEN                                                      21550000
      BEGIN    P2 := R;   RETURN;    END;                               21555000
                                                                        21560000
    <<**************************************************************>>  21565000
    <<                                                              >>  21570000
    <<  SET QMISC FOR ATTACHIO CALL (Q)                             >>  21575000
    <<                                                              >>  21580000
    <<**************************************************************>>  21585000
                                                                        21590000
    IF T="Q" THEN                                                       21595000
      BEGIN    Q := R;    RETURN;    END;                               21600000
                                                                        21605000
    IF NOPARAM THEN R := 1;    << DEFAULT PARM TO 1 >>                  21610000
                                                                        21615000
    <<**************************************************************>>  21620000
    <<                                                              >>  21625000
    <<  SET FLAG WORD FOR ATTACHIO CALL (FL)                        >>  21630000
    <<                                                              >>  21635000
    <<**************************************************************>>  21640000
                                                                        21645000
    IF M="FL" THEN    << SET FLAGS WORD >>                              21650000
      BEGIN    FLG := R;      RETURN;    END;                           21655000
                                                                        21660000
    <<**************************************************************>>  21665000
    <<                                                              >>  21670000
    <<  SET OR CLEAR SHOW FLAG (SH)                                 >>  21675000
    <<                                                              >>  21680000
    <<**************************************************************>>  21685000
                                                                        21690000
    IF M="SH" THEN   << SET OR CLEAR SHOW FLAG >>                       21695000
      BEGIN    SHOW := R;     RETURN;    END;                           21700000
                                                                        21705000
    <<**************************************************************>>  21710000
    <<                                                              >>  21715000
    <<  SET OR CLEAR ADD REC# TO BUFFER FLAG (V)                    >>  21720000
    <<                                                              >>  21725000
    <<**************************************************************>>  21730000
                                                                        21735000
    IF T="V" THEN  << SET ADD RECORD NUMBER FLAG >>                     21740000
      BEGIN    VFLAG := R;    RETURN;    END;                           21745000
                                                                        21750000
    <<**************************************************************>>  21755000
    <<                                                              >>  21760000
    <<  SET OR CLEAR NULL INPUT FLAG (N)                            >>  21765000
    <<                                                              >>  21770000
    <<**************************************************************>>  21775000
                                                                        21780000
    IF T="N" THEN   << SET NULL INPUT FLAG >>                           21785000
      BEGIN    NFLAG := R;    RETURN;    END;                           21790000
                                                                        21795000
    <<**************************************************************>>  21800000
    <<                                                              >>  21805000
    <<  INCREMENTAL BUFFER FILL (I)                                 >>  21810000
    <<                                                              >>  21815000
    <<**************************************************************>>  21820000
                                                                        21825000
    IF T="I" THEN  << INCREMENT BUFFER FILL >>                          21830000
      BEGIN                                                             21835000
        CHECKIOPENDING( 2 );   << JUST PRINT I/O PENDING MSG >>         21840000
        B := 0;                                                         21845000
        FOR I := 1 UNTIL LIMIT DO B(I) := B(I-1)+R;                     21850000
        RETURN;                                                         21855000
      END;                                                              21860000
                                                                        21865000
    <<**************************************************************>>  21870000
    <<                                                              >>  21875000
    <<  CALL ATTACHIO R TIMES (E)                                   >>  21880000
    <<                                                              >>  21885000
    <<**************************************************************>>  21890000
                                                                        21895000
    IF T="E" THEN    << CALL ATTACHIO R TIMES >>                        21900000
      BEGIN                                                             21905000
        E := R;    << SAVE EXECUTION COUNT >>                           21910000
        SETPOINTERS( D );   << CHECK LDEV >>                            21915000
        SBUFX := WAKEIOQX := I := 0;                                    21920000
        R1 := @B;    R2 := FLG;                                         21925000
                                                                        21930000
        TOS := C;                                                       21935000
        IF < THEN        << HAVE BYTE COUNT >>                 <<00924>>21940000
          TOS := -(TOS&ASR(1));  << MAKE WORDS>>               <<00924>>21945000
        R := (S0+127)/128;   << #SBUFS IF SBUF FLG SET >>      <<00924>>21950000
        IF ACTVBUF<>0 THEN LIMIT:=32000 ELSE LIMIT:=8196;      <<04830>>21955000
        IF TOS>LIMIT AND F<2 THEN   << COUNT TO LARGE >>                21960000
          BEGIN  PRINTE(M14W, -15);   RETURN;   END;                    21965000
                                                                        21970000
        IF C<>0 THEN  << CHECK FOR SBUFS ETC >>                         21975000
          IF LOGICAL(FLG.(12:1)) THEN  << SBUF SPECIFIED >>             21980000
            BEGIN                                                       21985000
              IF NOT LOGICAL(FLG) THEN  << SBUF AND UNBLOCKED >>        21990000
                BEGIN  PRINTE(M7W, 15);   RETURN;   END;                21995000
                                                                        22000000
              IF F=0 AND FLG.(14:2)=3 THEN  << READ AND NOPCB IO >>     22005000
                BEGIN   PRINTE(M22W, 17);   RETURN;   END;              22010000
                                                                        22015000
              SBUFX := R1 := GETSYSBUF( R, TRUE );                      22020000
            END                                                         22025000
          ELSE IF FLG=3 THEN   << NOPCB IO AND NO SBUF >>               22030000
            BEGIN   PRINTE(M27W, 21);   RETURN;   END;                  22035000
                                                                        22040000
        CHECKIOPENDING( 0 );   << COMPLETE ANY PENDING I/O >>           22045000
                                                                        22050000
        TIME := TIMER;      << SAVE START TIME >>                       22055000
        WHILE (I:=I+1)<=E AND NOT CYFLAG DO BEGIN                       22060000
          IF IOPCNT>=50 THEN   << TOO MANY UNBLOCKED IO'S >>            22065000
            BEGIN   PRINTE(M6W, -23);   RETURN;   END;                  22070000
                                                                        22075000
          IF VFLAG<>0 THEN    << ADD EXECUTION NUMBER >>                22080000
            BEGIN   MOVE B := "      ";   ASCII(I, 10, B);   END;       22085000
                                                                        22090000
          IF SBUFX<>0 AND F=1 THEN MOVEDATA;  << MOVE WRITE DATA >>     22095000
          LASTLDEV := D;   LASTFUNC := F;                               22100000
     IF BM = "EA" THEN    << EA  MEANS CALL ATTACHIO >>        <<*7479>>22105000
                                                               <<*7479>>22110000
      IF ACTVBUF=0 THEN                                        <<*7479>>22115000
       TOS:=ATTACHIO(D,Q,0,R1+BUF'OFFSET,F,C,P1,P2,R2)         <<*7479>>22120000
      ELSE                                                     <<*7479>>22125000
       TOS:=ATTACHIO(D,Q,DSTARRAY(FINDBIT(ACTVBUF)+1),         <<*7479>>22130000
                      BUF'OFFSET,F,C,P1,P2,R2)                 <<*7479>>22135000
     ELSE                                                      <<*7479>>22140000
                                                               <<*7479>>22145000
      IF ACTVBUF=0 THEN                                        <<*7479>>22150000
       TOS:=P'ATTACHIO(D,Q,0,R1+BUF'OFFSET,F,C,P1,P2,R2)       <<*7479>>22155000
      ELSE                                                     <<*7479>>22160000
       TOS:=P'ATTACHIO(D,Q,DSTARRAY(FINDBIT(ACTVBUF)+1),       <<*7479>>22165000
                        BUF'OFFSET,F,C,P1,P2,R2);              <<*7479>>22170000
          XLOG := TOS;      STATUS := TOS;                              22175000
                                                                        22180000
          CASE FLG.(14:2) OF                                            22185000
            BEGIN                                                       22190000
              SAVEIOQX;    << UNBLOCKED, NOWAKE >>                      22195000
                                                                        22200000
              BEGIN    << BLOCKED >>                                    22205000
                IF SBUFX<>0 AND F=0 THEN MOVEDATA;  << MOVE READ DATA >>22210000
                IF STATUS.(13:3)<>1 THEN PRINTSTATUS;                   22215000
              END;                                                      22220000
                                                                        22225000
              WAKEIOQX := SAVEIOQX;    << UNBLOCKED WITH WAKE >>        22230000
                                                                        22235000
              STATUS := XLOG := 0;   << NOPCB I/O >>                    22240000
            END;                                                        22245000
        END;   << CALL ATTACHIO >>                                      22250000
        TIME := TIMER - TIME;   << FOR TOTAL ELAPSED TIME >>            22255000
                                                                        22260000
        IF SBUFX<>0 AND FLG.(14:2)=1 THEN   << RETURN SBUFS >>          22265000
          BEGIN   RETURNSYSBUF(SBUFX);     SBUFX := 0;   END;           22270000
                                                                        22275000
        IF WAKEIOQX<>0 THEN   << WAIT ON UNBLOCKED WITH WAKE >>         22280000
          BEGIN                                                         22285000
            DISABLE;                                                    22290000
            SETWAKE(WAKEIOQX);   << TEST IF COMPLETED >>                22295000
            IF = THEN WAIT(%120, 0);   << NOT COMPLETED SO WAIT >>      22300000
            ENABLE;                                                     22305000
          END;                                                          22310000
      END                                                               22315000
    ELSE PRINTE(M24W,-15);   << INVALID COMMAND >>                      22320000
    END;     << DO MAIN >>                                              22325000
$PAGE  "OUTER BLOCK"                                                    22330000
                                                                        22335000
      CHECK'CAPE;  << MAKE SURE CALLER IS SYS MGR >>           <<04929>>22340000
    PUSH(STATUS);  TOS.(2:1) := 0;  SET(STATUS);  << DISABLE TRAPS >>   22345000
    XCONTRAP(@CY, T);   << ENABLE CONTROL Y >>                          22350000
    IN := FOPEN( , %40);   << OPEN $STDIN >>                            22355000
    DUP := FRELATE(IN, FOPEN(,%10))&CSL(1);                             22360000
      MOVE BM1(14) := OFFICIAL'VUUFF;   << PUT VUF IN TITLE >> <<04929>>22365000
     PRINT'(M1,23,0);      <<HEADER MESSAGE>>                  <<04830>>22370000
                                                                        22375000
    DO BEGIN    << LOWEST LOOP >>                                       22380000
      SOURCE := 0;   << $STDIN >>                                       22385000
      DO DOMAIN UNTIL EFLAG;                                            22390000
      EFLAG := FALSE;    MORE := 0;                                     22395000
                                                                        22400000
      IF CYFLAG THEN                                                    22405000
        BEGIN    RESETCONTROL;     CYFLAG := FALSE;    END;             22410000
    END UNTIL NOMORE;                                                   22415000
                                                                        22420000
  GO TO THE'END;                                               <<06989>>22425000
FILEEDIT:                                                      <<06989>>22430000
   AFILEEDT;                                                   <<06989>>22435000
THE'END:                                                       <<06989>>22440000
END.    << TEST IO >>                                                   22445000
