$CONTROL MAP,CODE,USLINIT                                               00010000
<<            IOCDPN0                  >>                               00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
<<COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1976. ",           >>00016000
<<     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",     >>00018000
<<     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",   >>00020000
<<     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ">>00022000
<<     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ", >>00024000
<<     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.">>00026000
  << IOTEST    APR 26,1978   ,  MODULE XX   >>                          00028000
$TITLE " APRIL 26,1978 IO TEST PROGRAM"                                 00030000
$CONTROL PRIVILEGED, MAIN  = IOTEST                                     00032000
$THIRTY                                                                 00034000
BEGIN    << IO TEST PROGRAM, T. ELLESTAD >>                             00036000
COMMENT                                                        <<04830>>00038000
                                                                        00040000
                                                                        00042000
                                                                        00044000
                                                                        00046000
                                                                        00048000
  OP                FUNCTION                 PARAMETER      DEFAULT     00050000
                                                                        00052000
   A     FILL BUFFER WITH ASCII STRING       ASCII STRING   ")" TO "Z"  00054000
   ANOTE PRINT STRING ON LIST DEVICE         ASCII STRING   NULL STRING 00056000
   B     FILL BUFFER WITH PARAMETER          PARAM,COUNT     0, ALL     00058000
   C     SET COUNT PARAMETER TO ATTACHIO        COUNT           0       00060000
   CH    CHECK RESULTS OF UNBLOCKED I/O                                 00062000
   CIO   DO CIO INSTRUCTION                  CONTROL WORD     ERROR     00064000
   CL    CLEAR PROGRAM AREA                   FIRST,LAST       ALL      00066000
   CM    CLEAR MONITORING TABLE                                         00068000
   CMP   COMPARE TWO BUFFERS                  BUF1,BUF2   0    <<04830>>00070000
   D     DISPLAY ATTACHIO PARAMETERS                                    00072000
   DA    DISPLAY BUFFER IN ASCII            OFFSET,COUNT     0, XLOG    00074000
   DB    DISPLAY BUFFER IN OCTAL            OFFSET,COUNT     0, XLOG    00076000
   DE    CALL DEBUG                                                     00078000
   DEC   CONVERT PARAM TO DECIMAL              PARAM          ERROR     00080000
   DD    DISPLAY DIT                        OFFSET,COUNT       ALL      00082000
   DDRQ  DISPLAY DISC REQUESTS                TYPE, LDEV  0,1  <<04830>>00084000
   DIOQ  DISPLAY THE IO QUEUES                TYPE, LDEV  0,1  <<04830>>00086000
   DMON  DISPLAY THE SYSTEM MONITOR TABLE                      <<04830>>00088000
   DO    GET CMNDS AND/OR PROG FROM A FILE    FILE NAME                 00090000
   DQ    DISPLAY IOQS                       NUMBER OF IOQS     ALL      00092000
   DS    DISPLAY LAST STATUS AND XLOG                                   00094000
   DRT   SET DRT NUMBER                         DRT#          ERROR     00096000
   DSIO  DISPLAY SIO AREA                   OFFSET,COUNT       ALL      00098000
   E     EXECUTE ATTACHIO CALL N TIMES     EXECUTION COUNT      1       00100000
   EX    TERMINATE PROGRAM                                              00102000
   F     SET FUNCTION PARAMETER TO ATTACHIO  FUNCTION CODE      0       00104000
   FB    FREE BUFFER SPECIFIED                BUF NUMBER  ERROR<<04830>>00106000
   FL    SET FLAGS PARAMETER TO ATTACHIO        FLAGS           1       00108000
   GO    GOTO STATEMENT NUMBER               STATEMENT #  1ST STATEMENT 00110000
   H     CALL HELP                                                      00112000
   I     INCREMENTAL FILL OF BUFFER          INCREMENT          1       00114000
   L     SET LOGICAL DEVICE NUMBER             LDEV           ERROR     00116000
   LD    SET OPTION LIST DEVICE             SEE BELOW        $STDLIST   00118000
         0=$STDLIST, 1=FORMAL DESIGNATOR LIST, 2+=ATTACHIO LDEV         00120000
   LI    LIST PROGRAM                         FIRST,LAST       ALL      00122000
   M     MONITOR TERMINAL ACTIVITY         MONITORING CODE      0       00124000
   MB    MODIFY BUFFER                      OFFSET, COUNT     ERROR     00126000
   MD    MODIFY DIT                         OFFSET, COUNT     ERROR     00128000
   MQ    MODIFY FIRST IOQ                   OFFSET, COUNT     ERROR     00130000
   N     NULL INPUT EXECUTES 1 ATTACHIO       0/1 (OFF/ON)      1       00132000
   O     CONVERT PARAM TO OCTAL                PARAM          ERROR     00134000
   P     PRINT TERMINAL ACTIVITY TABLE     NUMBER OF ENTRIES   ALL      00136000
   PA    SET P1 PARAMETER TO ATTACHIO            P1             0       00138000
   PB    SET P2 PARAMETER TO ATTACHIO            P2             0       00140000
   Q     SET QMISC PARAMETER TO ATTACHIO       QMISC            0       00142000
   R     RUN PROGRAM N TIMES                   RUN COUNT        1       00144000
   RUN   CREATE AND RUN A PROGRAM           PROGRAM FILE NAME           00146000
   RIO   DO RIO INSTRUCTION                                             00148000
   SH    PRINT DO AND PROGRAM STATEMENTS       0/1 (OFF/ON)     1       00150000
   T     PRINT AVERAGE TIME FOR LAST ATTACHIO CALLS                     00152000
   TIO   DO TIO INSTRUCTION                                             00154000
   UB    ACQUIRE BUFFER SPECIFIED             BUF NUMBER      0<<04830>>00156000
   V     PUT RECORD NUMBER IN BUFFER           0/1 (OFF/ON)     1       00158000
   WIO   DO WIO INSTRUCTION                   WRITE DATA      ERROR     00160000
   X     EXPLAIN COMMANDS                                               00162000
                                                                        00164000
                                                                        00166000
                                                                        00168000
                                                                        00170000
                                                                        00172000
                                                                        00174000
                                                                        00176000
                                                                        00178000
   C?   -   INPUT A COMMAND                                             00180000
                                                                        00182000
   FORMAT OF COMMANDS:                                                  00184000
                                                                        00186000
      OP [ [ = ] PARAMETER [ , PARAMETER ] ]                            00188000
                                                                        00190000
  COMMANDS MAY BE ONE OR MORE LETTERS. THE OP'S ARE LISTED ABOVE WITH   00192000
  THE NUMBER OF CHARACTERS REQUIRED TO UNIQUELY SPECIFY THE COMMAND.    00194000
  COMMAND COMMENTS MAY BE ENCLOSED IN BRACKETS AS IN SPL. MORE THAN ONE 00196000
  COMMAND MAY BE INPUT AT A TIME BY SEPERATING THEM WITH SEMICOLONS.    00198000
                                                                        00200000
  PARAMETER MAY BE NULL, A NUMBER( % FOR OCTAL ) OR 1 TO 2 NON QUOTE    00202000
  CHARACTERS WITHIN QUOTES. THE ASCII AND ANOTE PARAMETER MAY BE NULL   00204000
  OR A STRING WITHIN QUOTES. IF A 2ND PARAMETER IS SPECIFIED, POSITIVE  00206000
  INDICATES WORDS AND NEGATIVE INDICATES BYTES. NO 2ND PARAMETER DEFAULT00208000
  IS 1. PARAMETERS ARE DELIMITED BY A COMMA OR CARRIAGE RETURN.         00210000
  NOTE, THERE IS NO DEFAULT USE OF OCTAL NUMBERS!                       00212000
                                                                        00214000
  SYNTAX OF PARAMETERS -                                                00216000
                                                                        00218000
    EXPRESSION ::= TERM ! TERM + TERM ! TERM - TERM ! - TERM            00220000
    TERM       ::= FACTOR ! FACTOR * FACTOR ! FACTOR / FACTOR           00222000
    FACTOR     ::= CONSTANT ! ( EXPRESSION )                            00224000
    CONSTANT   ::= NUMBER ! "CHAR" ! "CHARCHAR"                         00226000
                                                                        00228000
  COMMANDS OR A PROGRAM MAY BE GOTTEN FROM AN EDITOR FILE USING THE     00230000
  DO COMMAND. WHEN THE DO COMMAND IS EXECUTED, COMMANDS AND PROGRAM     00232000
  STATEMENTS IN THE EDITOR FILE SPECIFIED ARE EXECUTED AS IF THE HAD    00234000
  BEEN ENTERED ON THE INPUT DEVICE.                                     00236000
                                                                        00238000
  PROGRAMS MAY BE WRITtEN TO EXECUTE A SEQUENCE OF COMMANDS, MUCH AS    00240000
  IF THEY WERE ENTERED BY THE OPERATOR.  PROGRAM STATEMENTS ARE         00242000
  DISTINGUISHED BY BEGINING WITH A STATEMENT NUMBER. THE STATEMENTS ARE 00244000
  EXECUTED IN ORDER OF STATEMENT NUMBER WHEN THE PROGRAM IS RUN.        00246000
  A STATEMENT MAY BE REPLACE BY ENTERING THE REPLACEMENT STATEMENT      00248000
  WITH THE STATEMENT TO BE REPLACED NUMBER. A STATEMENT MAY BE DELETED  00250000
  BY ENTERING THE STATEMENT NUMBER WITH NO STATEMENT. THE STORED PROGRAM00252000
  IS RUN FROM THE BEGINNING N TIMES USING THE "R" COMMAND. THE          00254000
  PROGRAM MAY BE CLEARED AND LISTED WITH THE "CL" AND "LI" COMMANDS.    00256000
                                                                        00258000
  4100 WORD READ/WRITE BUFFER.                                          00260000
  UP TO 50 SAVED IOQ INDEXES FOR UNBLOCKED I/O                          00262000
                                                                        00264000
  IF THE SBUF FLAG IS SET THEN SBUFS ARE GOTTEN AND THE I/O IS DONE TO  00266000
  OR FROM THEM. SBUF I/O CAN ONLY BE DONE WITH WAIT CODES 1 AND 3. NO   00268000
                                                                        00270000
  THE DRT NUMBER IS SET FROM SYSTEM TABLES USING THE LDEV SPECIFICATION 00272000
                                                                        00274000
  CONTROL Y CAUSES THIS PROGRAM TO ABORT REPEATED OPERATIONS SUCH AS    00276000
  PRINTING TABLES, EXECUTING THE ATTACHIO CALLS AND PROGRAM EXECUTION.  00278000
    **********MODIFICATION HISTORY**********                   <<04830>>00280000
    DATE 8/23/82                                               <<04830>>00282000
    MARIA GONZALEZ :    SUMMER SEED STUDENT                    <<04830>>00284000
    ASSISTED BY BILL O'SHAUGHNESSY AND DAVE CASSAFER           <<04830>>00286000
                                                               <<04830>>00288000
                                                               <<04830>>00290000
  UB    THE UB COMMAND ALLOWS THE USER TO HAVE 16 EXTRA DATA   <<04830>>00292000
        SEGMENTS WITH 32K WORD CAPABILITY EACH. MORE SPACE TO  <<04830>>00294000
        TEST IO IS ESSENTIAL. THE USER CAN CHOOSE A BUFFER BY  <<04830>>00296000
        INPUTING "UB" FOLLOWED BY A NUMBER FROM 1 TO 16.       <<04830>>00298000
        "UB0" WILL RETURN THE USER TO THE INTERNAL BUFFER. THE <<04830>>00300000
        COMMANDS "MB","A","F0","F1" AND OTHERS USED WITH THE   <<04830>>00302000
        INTERNAL BUFFER CANNOT BE USED FOR THE EXTRA DATA SEG- <<04830>>00304000
        MENTS AT THE MOMENT. MAYBE SOME MODIFICATION WILL BE   <<04830>>00306000
        MADE LATER. INSTEAD, THE USER MUST USE DEBUG "DE" TO   <<04830>>00308000
        SUCCEED WITH THESE FUNCTIONS.                          <<04830>>00310000
                                                               <<04830>>00312000
  FB    THE FB COMMAND FREES THE EXTRA DATA SEGMENTS SPECIFIED.<<04830>>00314000
        THE USER MAY RELEASE EXTRA DATA SEGMENTS WHEN THEY WILL<<04830>>00316000
        NO LONGER BE IN USE. TO AVOID SYSTEM FAILURE THE PRO-  <<04830>>00318000
        GRAM CHECKS FOR THE ATTEMPT TO RELEASE ANY DATA SEG-   <<04830>>00320000
        MENTS WHICH HAVEN'T BEEN ALLOCATED. THE USER CAN ALLO- <<04830>>00322000
        CATE BUFFERS WITH THE "UB" COMMAND.                    <<04830>>00324000
                                                               <<04830>>00326000
  CMP   THE CMP COMMAND COMPARES ANY TWO EXTRA DATA SEGMENTS   <<04830>>00328000
        SPECIFIED. THE INTERNAL BUFFER CANNOT BE COMPARED.     <<04830>>00330000
        THE USER MUST INPUT THE COMMAND FOLLOWED BY TWO        <<04830>>00332000
        BUFFERS FROM 1-16. IF THE USER TRIES TO COMPARE A      <<04830>>00334000
        BUFFER WHICH HAS NOT BEEN ALLOCATED, AN ERROR MESSAGE  <<04830>>00336000
        WILL BE PRINTED. IF TWO BUFFERS ARE EQUAL, A MESSAGE   <<04830>>00338000
        WILL BE RETURNED SAYING SO. IF NOT, THE BYTE THAT DID  <<04830>>00340000
        NOT COMPARE WILL BE DISPLAYED.                         <<04830>>00342000
                                                               <<04830>>00344000
  DMON  DISPLAY THE MONITOR TABLE                              <<04830>>00346000
                                                               <<04830>>00348000
  DIOQ  THE DIOQ COMMAND DISPLAYS THE IOQ'S. THERE ARE THREE   <<04830>>00350000
        TYPES OF IOQ'S THAT CAN BE DISPLAYED: THE WHOLE IOQ    <<04830>>00352000
        LIST, THE FREE LIST AND THE LIST OF IOQ'S IN USE.      <<04830>>00354000
        INDICATE WHICH IOQ TO DISPLAY BY TYPING 0,1 OR 2       <<04830>>00356000
        RESPECTIVELY. THE USER CAN CHOOSE TO DISPLAY THE IOQ'S <<04830>>00358000
        FOR A SPECIFIC DEVICE. 0 REFERS TO ALL THE DEVICES.    <<04830>>00360000
        TO DISPLAY THE IOQ'S, INPUT "DIOQ" FOLLOWED BY A NUMBER<<04830>>00362000
        FOR THE TYPE OF IOQ DESIRED AND ANOTHER NUMBER FOR     <<04830>>00364000
        THE DEVICE.                                            <<04830>>00366000
                                                               <<04830>>00368000
  DDRQ  THE DDRQ COMMAND DISPLAYS THE DISC REQUEST TABLE.      <<04830>>00370000
        SIMILAR TO THE DIOQ COMMAND, THREE TYPES OF DRQ'S      <<04830>>00372000
        CAN BE DISPLAYED: THE WHOLE LIST, THE FREE LIST        <<04830>>00374000
        AND THE DRQ'S IN USE. INDICATE WHICH TYPE OF DRQ       <<04830>>00376000
        BY TYPING 0,1 OR 2 RESPECTIVELY. DRQ'S CAN BE          <<04830>>00378000
        DISPLAYED FOR A SPECIFIC DEVICE. 0 REFERS TO ALL       <<04830>>00380000
        DEVICES. TO DISPLAY DRQ'S INPUT "DDRQ" FOLLOWED        <<04830>>00382000
        BY A NUMBER FOR THE TYPE OF DRQ DESIRED AND            <<04830>>00384000
        ANOTHER NUMBER FOR THE DEVICE.                         <<04830>>00386000
                                                               <<04830>>00388000
$PAGE                                                                   00390000
                                                                        00392000
                                                                        00394000
  USER'S I/O BUFFER FUNCTIONS:                                          00396000
  ----------------------------                                          00398000
                                                                        00400000
  OP          PARAMETER          DEFAULT          EXAMPLE               00402000
                                                                        00404000
                                                                        00406000
  A           ASCII STRING       ")" TO "Z"       A"SOME TEXT"          00408000
                                                                        00410000
  FUNCTION:  FILL THE BUFFER WITH AN ASCII STRING. BUFFER               00412000
             REFERS TO A USER'S I/O BUFFER DECLARED WITHIN              00414000
             THIS PROGRAM. MAXIMUM SIZE IS 4100 WORDS. IF               00416000
             I/O IS PENDING, A PENDING MESSAGE WILL BE                  00418000
             PRINTED. NO PARAMETER INPUT DEFAULT TO THE                 00420000
             ENTIRE BUFFER FILLED WITH )*+,-./0123456789                00422000
             :,<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ REPETITIVELY.   <<04830>>00424000
                                                                        00426000
                                                                        00428000
  B           PARAM,COUNT        0,ALL            B0,128                00430000
                                                                        00432000
  FUNCTION:  FILL THE BUFFER WITH THE PARAMETER INPUT FOR               00434000
             THE SPECIFIED COUNT. IF NO COUNT SPECIFIED,                00436000
             ALL 4100 WORDS OF THE BUFFER WILL BE FILLED.               00438000
             NO PARAMETER RESULT IN ENTIRE BUFFER FILLED                00440000
             WITH ZEROS. IF I/O IS PENDING, A PENDING                   00442000
             MESSAGE WILL BE PRINTED.                                   00444000
                                                                        00446000
  CMP         BUF1,BUF2         0                CMP1,4        <<04830>>00448000
  FUNCTION:  COMPARES ANY TWO BUFFERS SPECIFIED WITH THE       <<04830>>00450000
             EXCEPTION OF THE INTERNAL BUFFER. IF THE BUFFERS  <<04830>>00452000
             ARE EQUAL A MESSAGE WILL APPEAR SAYING SO.        <<04830>>00454000
             IF NOT, THE BYTE THAT FAILED TO COMPARE WILL      <<04830>>00456000
             BE DISPLAYED. BUFFERS ARE NUMBERED FROM 1-16.     <<04830>>00458000
             0 REFERS TO BUFFER INTERNAL TO IOCDPN0 STACK.     <<04830>>00460000
                                                               <<04830>>00462000
                                                                        00464000
  DA          OFFSET,COUNT       0,XLOG           DA0,20                00466000
                                                                        00468000
  FUNCTION:  DISPLAY THE BUFFER IN ASCII FROM A GIVEN                   00470000
             OFFSET FOR A LENGTH OF COUNT. NO LENGTH                    00472000
             SPECIFIED RESULT IN THE LENGTH OF THE LAST                 00474000
             TRANSMISSION (XLOG) COUNT DISPLAYED.                       00476000
                                                                        00478000
                                                                        00480000
  DB          OFFSET,COUNT       0,XLOG           DB8,3                 00482000
                                                                        00484000
  FUNCTION:  DISPLAY THE BUFFER IN OCTAL WORDS FROM A                   00486000
             GIVEN OFFSET FOR A LENGTH OF COUNT. NO LENGTH              00488000
             SPECIFIED RESULT IN THE LENGTH OF THE LAST                 00490000
             TRANSMISSION (XLOG) COUNT DISPLAYED.                       00492000
                                                               <<04830>>00494000
                                                               <<04830>>00496000
  FB          PARAMETER            ERROR          FB10         <<04830>>00498000
  FUNCTION:  RELEASES AN EXTRA DATA SEGMENT SPECIFIED.         <<04830>>00500000
             EXTRA DATA SEGMENTS AVAILABLE ARE NUMBERED        <<04830>>00502000
             1-16. 0 REFERS TO THE BUFFER INTERNAL TO          <<04830>>00504000
             THE IOCDPN0 STACK.                                <<04830>>00506000
                                                               <<04830>>00508000
                                                                        00510000
                                                                        00512000
  I           INCREMENT          1                I2                    00514000
                                                                        00516000
  FUNCTION:  THE USER'S I/O BUFFER WILL BE FILLED RECUR-                00518000
             SIVELY AS FOLLOWS:  B(N)=B(N-1)+INCREMENT                  00520000
             WHERE N GOES FROM (1-4100) TO ACCOMMODATE                  00522000
             THE ENTIRE BUFFER.                                         00524000
                                                                        00526000
                                                                        00528000
  MB          OFFSET,COUNT       ERROR            MB7,1                 00530000
                                                                        00532000
  FUNCTION:  MODIFY THE USER'S I/O BUFFER FROM A GIVEN                  00534000
             OFFSET FOR A LENGTH OF COUNT. THE LOCATION                 00536000
             OF EACH CONSECUTIVE WORDS FOR MODIFICATION                 00538000
             WILL BE PROMPTED UNTIL SPECIFIED COUNT EXPIRES.            00540000
             ON PROMPTS FOR MODIFICATION, A <CR> DENOTES                00542000
             NO CHANGES MADE.                                           00544000
                                                                        00546000
                                                               <<04830>>00548000
                                                               <<04830>>00550000
  UB          PARAMETER           0              UB12          <<04830>>00552000
  FUNCTION:  ACQUIRES EXTRA DATA SEGMENT SPECIFIED. EXTRA      <<04830>>00554000
             DATA SEGMENTS AVAILABLE ARE NUMBERED 1-16.        <<04830>>00556000
             0 REFERS TO THE IOCDPN0 INTERNAL STACK.           <<04830>>00558000
             THE INTERNAL STACK ALLOWS YOU TO HAVE A MAX-      <<04830>>00560000
             IMUM SIZE OF 8196 WORDS. THE EXTRA DATA SEGMENTS  <<04830>>00562000
             ALLOW YOU TO HAVE 32000. THE COMMAND "MB" CANNOT  <<04830>>00564000
             BE USED FOR THE EXTRA DATA SEGMENTS. IF YOU NEED  <<04830>>00566000
             TO MAKE ANY CORRECTIONS USE DEBUG "DE".           <<04830>>00568000
             NOTE THAT ALL THE BUFFERS ARE RETURNED UPON  EXIT.<<04830>>00570000
                                                                        00572000
                                                                        00574000
  I/O TABLE RELATED FUNCTIONS:                                          00576000
  ----------------------------                                          00578000
                                                                        00580000
  OP          PARAMETER          DEFAULT          EXAMPLE               00582000
                                                                        00584000
                                                                        00586000
  DD          OFFSET,COUNT       ALL              DD                    00588000
                                                                        00590000
  FUNCTION:  DISPLAY THE DEVICE INFORMATION TABLE (DIT) FOR             00592000
             THE LDEV. CAN DISPLAY DIT FROM A GIVEN OFFSET              00594000
             FOR A LENGTH OF COUNT OR DISPLAY ENTIRE DIT                00596000
             WITH NO PARAMETER SPECIFIED. LDEV IS SET BY                00598000
             COMMAND "L LDEV#".                                         00600000
                                                                        00602000
                                                               <<04830>>00604000
                                                               <<04830>>00606000
  DMON                                                         <<04830>>00608000
  FUNCTION:  DISPLAY THE SYSTEM MONITOR TABLE                  <<04830>>00610000
                                                               <<04830>>00612000
                                                               <<04830>>00614000
                                                               <<04830>>00616000
                                                               <<04830>>00618000
  DIOQ        PARAMETER,LDEV#      0,1             DIOQL 0,12  <<04830>>00620000
             BE DISPLAY THE IOQ TABLE. THREE TYPES OF IOQ'S CAN<<04830>>00622000
             DISPLAYED. THERE IS A CHOICE OF THE WHOLE LIST,   <<04830>>00624000
             THE FREE LIST AND THE ACTIVE LIST. THEY CAN BE    <<04830>>00626000
             SPECIFIED BY THE NUMBERS 0,1 OR 2 RESPECTIVELY.   <<04830>>00628000
             YOU CAN DISPLAY THE IOQ'S FOR A SPECIFIC DEVICE.  <<04830>>00630000
             IF YOU WANT ALL THE DEVICES, TYPE 0 FOR LDEV#.    <<04830>>00632000
                                                               <<04830>>00634000
                                                               <<04830>>00636000
                                                               <<04830>>00638000
  DDRQ        PARAMETER,LDEV#      0,1             DDRQ 0,12   <<04830>>00640000
             DISPLAY THE DRQ TABLE. THREE TYPES OF DRQ'S CAN BE<<04830>>00642000
             DISPLAYED. THERE IS A CHOICE OF THE WHOLE LIST,   <<04830>>00644000
             THE FREE LIST AND THE ACTIVE LIST. THEY CAN BE    <<04830>>00646000
             SPECIFIED BY THE NUMBERS 0,1 OR 2 RESPECTIVELY.   <<04830>>00648000
             YOU CAN DISPLAY THE DRQ'S FOR A SPECIFIC LDEV.    <<04830>>00650000
             IF YOU WANT ALL THE DEVICES, TYPE 0 FOR LDEV#.    <<04830>>00652000
                                                               <<04830>>00654000
                                                               <<04830>>00656000
                                                               <<04830>>00658000
  DQ          NO.OF IOQS         ALL              DQ                    00660000
                                                                        00662000
  FUNCTION:  DISPLAY THE I/O QUEUE ELEMENT (IOQ) UP TO THE              00664000
             NUMBER OF IOQ ENTRIES ENTERED. NO PARAMETER                00666000
             DISPLAY ALL IOQ ENTRIES CURRENTLY PENDING.                 00668000
                                                                        00670000
                                                                        00672000
  DSIO        OFFSET,COUNT       ALL              DSIO                  00674000
                                                                        00676000
  FUNCTION:  DISPLAY THE SIO OR CHANNEL PROGRAM FOR THE                 00678000
             LDEV STARTING AT A GIVEN OFFSET FOR A LENGTH               00680000
             OF COUNT. NO PARAMETERS DISPLAY THE ENTIRE SIO             00682000
             OR CHANNEL PROGRAM.                                        00684000
                                                                        00686000
                                                                        00688000
  MD          OFFSET,COUNT       ERROR            MD3,1                 00690000
                                                                        00692000
  FUNCTION:  MODIFY THE DIT TABLE STARTING AT A GIVEN                   00694000
             OFFSET FOR A LENGTH OF COUNT. THE DIT IS THE               00696000
             ONE ASSOCIATED WITH LDEV, SET BY THE COMMAND               00698000
             "L LDEV#".                                                 00700000
                                                                        00702000
                                                                        00704000
  MQ          OFFSET,ERROR       ERROR            MQ0,3                 00706000
                                                                        00708000
  FUNCTION:  MODIFY THE FIRST IOQ ENTRY STARTING AT A GIVEN             00710000
             OFFSET FOR A LENGTH OF COUNT. THE IOQ ENTRY                00712000
             IS THE ONE ASSOCIATED WITH LDEV, SET BY THE                00714000
             COMMAND "L LDEV#".                                         00716000
                                                                        00718000
                                                                        00720000
                                                                        00722000
  ATTACHIO PARAMETERS FUNCTIONS:                                        00724000
  ------------------------------                                        00726000
                                                                        00728000
  OP          PARAMETER          DEFAULT          EXAMPLE               00730000
                                                                        00732000
                                                                        00734000
  D                                               D                     00736000
                                                                        00738000
  FUNCTION:  DISPLAY THE PARAMETERS SET UP FOR THE ATTACHIO             00740000
             CALL. THE PROCEDURE IS AS SHOWN:                           00742000
                                                                        00744000
   PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,FUNC,CNT,P1,P2,FLAGS)             00746000
                                                                        00748000
   IOCDPNO EQUIVALENCES:                                                00750000
                                                                        00752000
    L  -->  LDEV                                                        00754000
    Q  -->  QMISC                                                       00756000
    F  -->  FUNC                                                        00758000
    C  -->  CNT                                                         00760000
    PA -->  P1                                                          00762000
    PB -->  P2                                                          00764000
    FL -->  FLAGS                                                       00766000
                                                                        00768000
                                                                        00770000
  C           COUNT              0                C128                  00772000
                                                                        00774000
  FUNCTION:  SET THE COUNT IN THE ATTACHIO PARAMETER. NOTE              00776000
             THAT USER'S I/O BUFFER IS 4100 WORDS MAXIMUM.              00778000
                                                                        00780000
                                                                        00782000
  F           FUNCTION CODE      0                F2                    00784000
                                                                        00786000
  FUNCTION:  SET THE FUNCTION CODE IN THE ATTACHIO PARA-                00788000
             METER. GENERAL FUNCTION CODES ARE AS SHOWN:                00790000
                                                                        00792000
             0 -- READ                                                  00794000
             1 -- WRITE                                                 00796000
             2 -- OPEN FILE                                             00798000
             3 -- CLOSE FILE                                            00800000
             4 -- CLOSE DEVICE                                          00802000
            >5 -- DEVICE DEPENDENT                                      00804000
                                                                        00806000
                                                                        00808000
  FL          FLAGS              1                FL%11                 00810000
                                                                        00812000
  FUNCTION:  SET THE FLAG WORD IN THE ATTACHIO PARAMETER.               00814000
                                                                        00816000
             FLAGWORD (12:1) -- SYSTEM BUFFER FLAG                      00818000
                      (13:3) -- REQUEST TYPE (0-7)                      00820000
                                [1=BLOCKED,REST=UNBLOCKED]              00822000
                                                                        00824000
                                                                        00826000
  L           LDEV               ERROR            L7                    00828000
                                                                        00830000
  FUNCTION:  SET LOGICAL DEV# IN THE ATTACHIO PARAMETER.                00832000
                                                                        00834000
                                                                        00836000
  PA          P1                 0                PA1                   00838000
                                                                        00840000
                                                                        00842000
  FUNCTION:  SET P1 IN THE ATTACHIO PARAMETER, WHERE P1                 00844000
             IS DEVICE DEPENDENT.                                       00846000
                                                                        00848000
                                                                        00850000
  PB          P2                 0                PB%22                 00852000
                                                                        00854000
  FUNCTION:  SET P2 IN THE ATTACHIO PARAMETER, WHERE P2                 00856000
             IS DEVICE DEPENDENT.                                       00858000
                                                                        00860000
                                                                        00862000
  Q           QMISC              0                Q1                    00864000
                                                                        00866000
  FUNCTION:  SET QMISC IN THE ATTACHIO PARAMETER, WHERE                 00868000
             QMISC IS DEVICE DEPENDENT.                                 00870000
                                                                        00872000
                                                                        00874000
                                                                        00876000
  ATTACHIO EXECUTION RELATED FUNCTIONS:                                 00878000
  ------------------------------------                                  00880000
                                                                        00882000
  OP          PARAMETER          DEFAULT          EXAMPLE               00884000
                                                                        00886000
                                                                        00888000
  E           EXECUTION COUNT    1                E5                    00890000
                                                                        00892000
  FUNCTION:  EXECUTES THE ATTACHIO CALL FOR THE COUNT                   00894000
             SPECIFIED. NO COUNT SPECIFED, EXECUTION DONE               00896000
             ONCE ONLY.                                                 00898000
                                                                        00900000
                                                                        00902000
  CH                                              CH                    00904000
                                                                        00906000
  FUNCTION:  CHECK RESULTS OF UNBLOCKED I/O. CHECK IF ANY               00908000
             I/O PENDING. IF ANY I/O PENDING, A PENDING                 00910000
             MESSAGE WILL BE PRINTED. IF ANY ERRORS, STATUS             00912000
             WILL BE PRINTED.                                           00914000
                                                                        00916000
                                                                        00918000
  DS                                              DS                    00920000
                                                                        00922000
  FUNCTION:  DISPLAY LAST STATUS AND LOG RESULTING FROM                 00924000
             THE ATTACHIO CALL. IF ANY I/O PENDING, A                   00926000
             PENDING MESSAGE WILL BE PRINTED.                           00928000
                                                                        00930000
                                                                        00932000
  N           0/1 (OFF/ON)       0                N1                    00934000
                                                                        00936000
                                                                        00938000
  FUNCTION:  NULL INPUT FLAG SET EXECUTES ONE ATTACHIO                  00940000
             CALL IF A NULL INPUT IS ENCOUNTERED.                       00942000
                                                                        00944000
                                                                        00946000
  T                                               T                     00948000
                                                                        00950000
  FUNCTION:  DISPLAY THE AVERAGE EXECUTION TIME IN THE                  00952000
             LAST ATTACHIO CALL. BY AVERAGE, IT IS MEANT                00954000
             AN AVERAGE IS TAKEN IF EXECUTION DONE MORE                 00956000
             THAN ONCE. (IE. E20)                                       00958000
                                                                        00960000
                                                                        00962000
  V           0/1 (OFF/ON)       0                V1                    00964000
                                                                        00966000
  FUNCTION:  PRIOR TO EXECUTING ATTACHIO CALL, VFLAG SET                00968000
             PLACES THE EXECUTION COUNT INTO THE FIRST                  00970000
             WORD OF THE USER'S I/O BUFFER. ON AN ATTACHIO              00972000
             WRITE OF 5 RECORDS, ONE WOULD SEE THE NUMBER               00974000
             5 ON THE FIRST WORD OF THE FIFTH RECORD WHEN               00976000
             READ BACK.                                                 00978000
                                                                        00980000
                                                                        00982000
                                                                        00984000
  STORED PROGRAM, DO FILE RELATED FUNCTIONS:                            00986000
  ------------------------------------------                            00988000
                                                                        00990000
       A MAXIMUM OF 500 WORDS ARE ALLOCATED WITHIN THIS                 00992000
    PROGRAM FOR STORING COMMANDS IN WHICH THE USER WANTS                00994000
    TO SAVE FOR LATER EXECUTION. THIS IS CALLED THE STORED              00996000
    PROGRAM. WHEN A STATEMENT# PRECEDING A COMMAND IS                   00998000
    ENTERED, THE LINE IS STORED INTO THE PROGRAM AREA.                  01000000
    EXAMPLE LINES ARE AS SHOWN:                                         01002000
                                                                        01004000
       10 L7                                                            01006000
       20 F0                                                            01008000
       30 C128                                                          01010000
       40 E20                                                           01012000
                                                                        01014000
   THE STATEMENT NUMBER WITH STATEMENT ARE SEQUENTIALLY                 01016000
   INSERTED INTO THE PROGRAM AREA. STATEMENT ENTERED WITH               01018000
   SAME STATEMENT# ALREADY IN PROGRAM AREA WILL REPLACE                 01020000
   THE PREVIOUS STATEMENT. A STATEMENT# ENTERED WITH NO                 01022000
   STATEMENT WILL DELETE AN EXISTING STATEMENT IN THE                   01024000
   PROGRAM AREA.                                                        01026000
                                                                        01028000
                                                                        01030000
  OP          PARAMETER          DEFAULT          EXAMPLE               01032000
                                                                        01034000
                                                                        01036000
  CL          FIRST,LAST         ALL              CL20,40               01038000
                                                                        01040000
  FUNCTION:  CLEAR THE STORED PROGRAM STARTING FROM THE                 01042000
             FIRST STATEMENT# TO THE LAST STATEMENT#                    01044000
             ENTERED. IF NO PARAMETER, CLEAR THE ENTIRE                 01046000
             PROGRAM AREA.                                              01048000
                                                                        01050000
                                                                        01052000
  GO          STATEMENT#         1ST STATEMENT#   GO30                  01054000
                                                                        01056000
  FUNCTION:  BEGIN EXECUTING STORED PROGRAM STARTING AT                 01058000
             THE STATEMENT# ENTERED.                                    01060000
                                                                        01062000
                                                                        01064000
  LI          FIRST,LAST         ALL              LI10,50               01066000
                                                                        01068000
  FUNCTION:  LIST THE STORED PROGRAM STARTING FROM THE                  01070000
             FIRST STATEMENT# TO THE LAST STATEMENT#                    01072000
             ENTERED. IF NO PARAMETER, THE ENTIRE STORED                01074000
             PROGRAM IS LISTED.                                         01076000
                                                                        01078000
                                                                        01080000
  R           RUN COUNT          1                R5                    01082000
                                                                        01084000
  FUNCTION:  EXECUTE THE STORED PROGRAM FOR THE NUMBER OF               01086000
             TIMES SPECIFIED IN THE COUNT.                              01088000
                                                                        01090000
                                                                        01092000
  DO          FILENAME                                                  01094000
                                                                        01096000
  FUNCTION:  GET COMMANDS AND/OR PROGRAM FROM A DO FILE.                01098000
             COMMANDS GOTTEN ARE EXECUTED IMMEDIATELY AND               01100000
             PROGRAM STATEMENTS ENCOUNTERED ARE STORED                  01102000
             INTO THE PROGRAM AREA. DO FILE CAN BE SEEN                 01104000
             AS A PSEUDO BATCH TYPE OPERATION.                          01106000
             [NOTE:  COMMANDS OR STORED PROGRAM (STATE-                 01108000
             MENT# PRECEDING COMMANDS) CAN BE ENTERED                   01110000
             INTO A FILE UNDER THE 3000 EDITOR. SUCH A                  01112000
             FILE IS REFERRED BY IOCDPN0 AS A DO FILE.]                 01114000
                                                                        01116000
                                                                        01118000
  SH          0/1 (OFF/ON)       1                SH1                   01120000
                                                                        01122000
  FUNCTION:  WITH SHOW FLAG SET, EACH COMMAND (PROGRAM                  01124000
             STATEMENT) GOTTEN FROM A STORED PROGRAM OR                 01126000
             A DO FILE ARE PRINTED ON THE $STDLIST.                     01128000
                                                                        01130000
                                                                        01132000
                                                                        01134000
  UTILITY FUNCTIONS:                                                    01136000
  ------------------                                                    01138000
                                                                        01140000
  OP          PARAMETER          DEFAULT          EXAMPLE               01142000
                                                                        01144000
                                                                        01146000
  DE                                              DE                    01148000
                                                                        01150000
  FUNCTION:  ENTER INTO THE MPE FACILITY DEBUG.                         01152000
                                                                        01154000
                                                                        01156000
  H                                               H                     01158000
                                                                        01160000
  FUNCTION:  ENTER INTO MPE LOW LEVEL SYSTEM DEBUGGER                   01162000
             CALLED HELP.                                               01164000
                                                                        01166000
                                                                        01168000
                                                                        01170000
  I/O INSTRUCTION FUNCTIONS:                                            01172000
  --------------------------                                            01174000
                                                                        01176000
  [IMPLEMENTED ON THE SERIES 2 & 3 ONLY]                                01178000
                                                                        01180000
  OP          PARAMETER          DEFAULT          EXAMPLE               01182000
                                                                        01184000
                                                                        01186000
  CIO         CONTROL WORD       ERROR            CIO%140000            01188000
                                                                        01190000
  FUNCTION:  PERFORM CONTROL I/O INSTRUCTION TO DEVICE                  01192000
             WITH THE INPUT CONTROL WORD.                               01194000
                                                                        01196000
                                                                        01198000
  RIO                                             RIO                   01200000
                                                                        01202000
  FUNCTION:  PERFORM READ I/O INSTRUCTION TO DEVICE. IF                 01204000
             DEVICE READY, DATA WORD PRINTED. IF DEVICE                 01206000
             NOT READY, DEVICE STATUS IS PRINTED.                       01208000
                                                                        01210000
                                                                        01212000
  TIO                                             TIO                   01214000
                                                                        01216000
  FUNCTION:  PERFORM TEST I/O INSTRUCTION TO OBTAIN THE                 01218000
             STATUS FROM THE DEVICE FOR PRINTING.                       01220000
                                                                        01222000
                                                                        01224000
  WIO         WRITE DATA         ERROR            WIO1                  01226000
                                                                        01228000
  FUNCTION:  PERFORM WRITE I/O INSTRUCTION WITH DATA WORD               01230000
             TO THE DEVICE. IF DEVICE READY, DATA WORD IS               01232000
             TRANSMITTED. IF DEVICE NOT READY, DEVICE                   01234000
             STATUS IS PRINTED.                                         01236000
                                                                        01238000
                                                                        01240000
                                                                        01242000
  TERMINAL MONITORING FUNCTIONS:                                        01244000
  ------------------------------                                        01246000
                                                                        01248000
  OP          PARAMETER          DEFAULT          EXAMPLE               01250000
                                                                        01252000
                                                                        01254000
  CM                                              CM                    01256000
                                                                        01258000
  FUNCTION:  CLEAR MONITORING AREA. USED IN CONJUNCTION                 01260000
             WITH COMMANDS "M" AND "P". SINCE MONITORING                01262000
             ENTRIES ARE KEPT IN A SYSTEM BUFFER, THIS                  01264000
             FUNCTION ZERO THIS SBUF AREA.                              01266000
                                                                        01268000
                                                                        01270000
  M           MCODE              0                M%22                  01272000
                                                                        01274000
  FUNCTION:  SET TERMINAL MONITORING CODE. IN A TERMINAL                01276000
             DIT IN WORD %41, THE LAST 6 BITS APPLIES TO                01278000
             MONITOR FUNCTION AND CONTROL CODE. THESE ARE               01280000
             SET ACCORDINGLY BY TH MCODE INPUT FOR MONI-                01282000
             TORING TERMINAL ACTIVITIES. USED IN CONJUN-                01284000
             CTION WITH COMMANDS "CM" AND "P".                          01286000
                                                                        01288000
  P           #ENTRIES           ALL              P                     01290000
                                                                        01292000
  FUNCTION:  PRINT TERMINAL MONITOR TABLE FOR NUMBER OF                 01294000
             ENTRIES SPECIFIED (0-32). NO PARAMETER                     01296000
             RESULT IN ALL ENTRIES PRINTED. ENTRIES WILL                01298000
             NOT EXIST OR BE PRINTED UNLESS THE MONITORING              01300000
             CODE WAS PREVIOUSLY SET. USED IN CONJUNCTION               01302000
             WITH COMMANDS "CM" AND "M".                                01304000
                                                                        01306000
                                                                        01308000
                                                                        01310000
  MISCELLANEOUS FUNCTIONS:                                              01312000
  ------------------------                                              01314000
                                                                        01316000
  OP          PARAMETER          DEFAULT          EXAMPLE               01318000
                                                                        01320000
                                                                        01322000
  AN                                              AN"HELLO"             01324000
                                                                        01326000
  FUNCTION:  DISPLAY THE ASCII STRING INPUT ON THE LIST                 01328000
             DEVICE.                                                    01330000
                                                                        01332000
                                                                        01334000
  LD          0,1,2+             $STDLIST         LD6                   01336000
                                                                        01338000
  FUNCTION:  REDIRECT THE LIST DEVICE TO THE $STDLIST,                  01340000
             A FORMAL DESIGNATOR LIST, OR ANY LIST DEVICE               01342000
             LDEV#.                                                     01344000
                                                                        01346000
                                                                        01348000
  DRT         DRT#               ERROR            DRT16                 01350000
                                                                        01352000
  FUNCTION:  ENTRY OF DRT# TO OVERRIDE DRT# PICKED UP BY                01354000
             COMMAND "L LDEV#" WHICH GOT ITS DRT# THRU                  01356000
             THE ILT TABLE. USED IN CONJUNCTION WITH THE                01358000
             I/O INSTRUCTION FUNCTIONS, ALLOW ACCESS TO                 01360000
             DEVICE WITH INACCESSIBLE DRT# (IE. CAN DO A                01362000
             CIO TO A TERMINAL'S TCI BOARD).                            01364000
                                                                        01366000
                                                                        01368000
  DEC         PARAM              ERROR            DEC%100               01370000
                                                                        01372000
  FUNCTION:  CONVERT THE INPUT PARAMETER TO BE REPRESENTED              01374000
             AS A DECIMAL VALUE.                                        01376000
                                                                        01378000
                                                                        01380000
  OCT         PARAM              ERROR            OCT200                01382000
                                                                        01384000
  FUNCTION:  CONVERT THE INPUT PARAMETER TO BE REPRESENTED              01386000
             AS AN OCTAL VALUE.                                         01388000
                                                                        01390000
                                                                        01392000
  X                                                                     01394000
                                                                        01396000
  FUNCTION:  LIST EXPLANATIONS OF ALL THE COMMANDS.                     01398000
                                                                        01400000
                                                                        01402000
  EX                                              EX                    01404000
                                                                        01406000
  FUNCTION:  TERMINATE PROGRAM AND EXIT.                                01408000
                                                                        01410000
                                                                        01412000
  <MPE COMMANDS>                                                        01414000
                                                                        01416000
  FUNCTION:  MPE COMMANDS ENTERED ARE PASSED TO THE COMMAND             01418000
             INTRINSIC FOR EXECUTION.                                   01420000
                                                                        01422000
                                                                        01424000
                                                                        01426000
                                                                        01428000
                                                                        01430000
$PAGE                                                                   01432000
;   <<END OF COMMENT>>                                         <<04830>>01434000
                                                                        01436000
  DEFINE                                                                01438000
    ASMB        = ASSEMBLE#,                                            01440000
    ABS         = ABSOLUTE#,                                            01442000
    EXITPROC    = ASMB( EXIT 0 )#,                                      01444000
    ENABLE      = ASMB( SED 1 )#,                                       01446000
    DISABLE     = ASMB( SED 0 )#,                                       01448000
    LINK        =1#,                                           <<04830>>01450000
    FLAGS       =0#,                                           <<04830>>01452000
    UNIT        =2).(0:8#,                                     <<04830>>01454000
    LDEVICE     =2).(8:8#,                                     <<04830>>01456000
    MISC        =3#,                                           <<04830>>01458000
    PCB         =10).(0:8#,                                    <<04830>>01460000
    DST         =4#,                                           <<04830>>01462000
    ADDR        =5#,                                           <<04830>>01464000
    FUNC        =6).(8:8#,                                     <<04830>>01466000
    XFERCNT     =7#,                                           <<04830>>01468000
    PARM1       =8#,                                           <<04830>>01470000
    PARM2       =9#,                                           <<04830>>01472000
    STAT        =10).(13:3#,                                   <<04830>>01474000
    TOTAL'ENTRIES=0).(0:8#,                                    <<04830>>01476000
    ENTRY'SIZE  =1).(8:8#,                                     <<04830>>01478000
    FREE'INDEX  =2#,                                           <<04830>>01480000
    QUALIFIER   =10).(8:5#,                                    <<04830>>01482000
    POSTSERIES3 = (THISCPU=2 OR THISCPU=4 OR THISCPU=5)#;      <<00798>>01484000
                                                                        01486000
  EQUATE                                                                01488000
    PROGMAX     = 500,                                                  01490000
    IOQDST      =11,                                           <<04830>>01492000
    DRQ'DST     =56,                                           <<04830>>01494000
    IOQ'HEADER'SIZE =8,                                        <<04830>>01496000
    DRQ'HEADER'SIZE =16,                                       <<04830>>01498000
    CR          = %15,                                                  01500000
    QUOTE      = %42;                                          <<04830>>01502000
                                                                        01504000
  INTEGER ARRAY B(0:8196);    <<I/O BUFFER>>                   <<04830>>01506000
  INTEGER POINTER LPDTP = %10;  << LPDT POINTER >>                      01508000
  POINTER IOQTABLE = 5;         << IOQ TABLE POINTER >>                 01510000
  POINTER SBUF     = 6;         << SYSTEM BUFFER TABLE POINTER >>       01512000
  INTEGER POINTER BP;           << ADDRESS OF BUFFER IN MOVEDATA >>     01514000
                                                                        01516000
  INTEGER                                                               01518000
    X = X,  S0 = S-0,                                                   01520000
    DITP, SIOP, IOQP, DITL, SIOL, DRTP,                                 01522000
    LIMIT,                                                     <<04830>>01524000
    I,          << GENERAL INDEX & ALSO NEXT INPUT CHARACTER POINTER >> 01526000
    LASTI,      << I WHEN CHAR WAS CALLED LAST = LAST CHAR FETCHED >>   01528000
    J,K,        << GENERAL INDEXES >>                                   01530000
    L,  << INPUT MESSAGE LENGTH >>                                      01532000
    N,                                                                  01534000
    R,  << PARAMETER INPUT >>                                           01536000
    R1,   << HOLDS SECOND PARAMETER ON INPUT >>                         01538000
    R2, R3,                                                             01540000
    T,  << TEMPORARY >>                                                 01542000
    E,         << EXECUTION COUNT >>                                    01544000
    PC,                  <<PROGRAM COUNTER>>                   <<04830>>01546000
    BUF'USED,            <<NUMBER OF BUFFER USED>>             <<04830>>01548000
    COUNT,               <<GENERAL COUNTER>>                   <<04830>>01550000
    NUMCHAR,    <<HOLDS LENGTH OF ASCII CONVERSION>>           <<04830>>01552000
    BUFF'ONE,    <<FIRST BUFFER TO COMPARE>>                   <<04830>>01554000
    BUFF'TWO,    <<SECOND BUFFER TO COMPARE>>                  <<04830>>01556000
    FREE'BUF,            <<NUMBER OF BUFFER TO FREE>>          <<04830>>01558000
    PROGRUN,   << NUMBER OF TIMES TO RUN PROGRAM >>                     01560000
    LASTLINE,  << STATEMENT NUMBER OF LAST STATEMENT PROCESSED >>       01562000
    W2, W3,    << WORDS 2 AND 3 OF MONITORING ENTRY >>                  01564000
    T1,        << TEMPORARY >>                                          01566000
    CA, CB, SB, CF, CC,  << DSET STATES, -1 OFF, 0 UNKNOWN, 1 ON >>     01568000
    WAKEIOQX,            << HOLDS IOQX OF LAST UNBLOCKED IO WITH WAKE >>01570000
    IN,                  << $STDIN FILE NUMBER >>                       01572000
    CYI,                 << INDEX FOR CONTROL Y PROCEDURE >>            01574000
    DF,        << DO FILE FILE NUMBER >>                                01576000
    FNL,       << DO FILE NAME LENGTH >>                                01578000
    SOURCE,      << COMMAND SOURCE; 0-$STDIN, 1-PROGRAM, 2-DO FILE >>   01580000
    MAX'XDS'SIZE,          <<MAXIMUM EXTRA DATA SIZE>>         <<04830>>01582000
    FLG := 1,  << WAIT TYPE OR FLAGS WORD >>                            01584000
    XDS'SIZE :=32152,       <<EXTRA DATA SEGMENT SIZE>>        <<04830>>01586000
    MAX'XDS'SIZE'ADR:=%1111,<<EXTRA DATA SEGMENT MAXIMUM SIZE>><<04830>>01588000
    PROGEND := 0,  << INDEX TO END OF CURRENT PROGRAM >>                01590000
    FN := 0,   << + THEN FILE #, - THEN OPT LIST DEV, 0 $STDLIST >>     01592000
    DRTFLG := 0,  << IF SET DENOTES USER'S DRT# ENTRY >>       <<00924>>01594000
    VFLAG := 0, << IF NOT ZERO THEN ADD EXECUTION NUMBER TO BUFFER >>   01596000
    NFLAG := 0, << IF NOT ZERO THEN NULL INPUT CAUSES 1 ATTACHIO CALL >>01598000
    SHOW  := 0, << IF NOT ZERO THEN PRINT DO AND PROGRAM STATEMENTS >>  01600000
    MORE  := 0, << LENGTH OF REMAINING MULTIPLE COMMAND STATEMENT >>    01602000
    IOPCNT := 0,      << # OF PENDING I/O'S >>                          01604000
    SBUFX := 0,       << SBUF LIST HEAD INDEX >>                        01606000
    STATUS := 0,      << HOLDS RETURN STATUS AND IOQ INDICIES >>        01608000
    LASTLDEV := 0,  XLOG := 0,   LASTFUNC := 0,                         01610000
    C := 0,    << COUNT >>                                              01612000
    D := 0,    << LOGICAL DEVICE NUMBER >>                              01614000
    DX := 0,   << DRT NUMBER FOR DIRECT IO >>                           01616000
    F := 0,    << FUNCTION >>                                           01618000
    P1:= 0,                                                             01620000
    P2:= 0,                                                             01622000
    Q := 0;   << QMISC >>                                               01624000
                                                                        01626000
  LOGICAL                                                               01628000
    LW3 = W3, LN = N,                                                   01630000
    EFLAG := 0, << IF SET ERROR OR END OF PROGRAM >>                    01632000
    NOMORE := 0,<< IF SET THEN END EXECUTION >>                         01634000
    CYFLAG := 0,<< SET WHEN CONTROL Y IS PRESSED >>                     01636000
    LDEV'IS'DISC := false,  << LDEV is disc flag >>            <<03120>>01638000
    PROGFLAG := 0,  << IF SET, THEN GETTING COMMANDS FROM PROG AREA >>  01640000
    SFLAG,      << STOP THIS LEVEL OF DOMAIN, DO EOF OR END OF PROG >>  01642000
    BFLAG ,     << IF SET MODIFY/PRINT FROM BUFFER B ELSE ABSOLUTE >>   01644000
    QUOTEFLAG,  << IF SET THEN INSIDE A QUOTED PARAMETER >>             01646000
    NOPARAM,    << IF SET COMMAND DID NOT HAVE A PARAMETER >>           01648000
    EXISTS, <<CHECKS IF BUFFER IS ALLOCATED BEFORE COMPARING>> <<04830>>01650000
    MSTART,       << POINTER TO CURRENT MONITOR ENTRY >>       <<04830>>01652000
    SNAPSHOT'DST,    <<SNAPSHOT STORED IN A DATA SEGMENT>>     <<04830>>01654000
    DEV'CHECK:=FALSE,   << DEVICE WILL BE PRINTED IN DECIMAL>> <<04830>>01656000
    TWOPARAMS,     <<IF SET COMMAND HAD TWO PARAMETERS >>      <<04830>>01658000
    ACTVBUF:=0,    <<USED AS A BITMAP TO MARK BUFFERS USED>>   <<04830>>01660000
    IOQ'POINTER, <<POINTS TO THE NEXT IOQ>>                    <<04830>>01662000
    DUP;        << DUPLICATIVE INPUT DEVICE IF SET >>                   01664000
                                                                        01666000
DOUBLE                                                                  01668000
  TIME;  << START TIME OR ELAPSED TIME FOR ATTACHIO CALLS >>            01670000
                                                                        01672000
    LOGICAL ARRAY COMPARE'BUF1(0:127);    <<DUMMY ARRAYS>>     <<04830>>01674000
    LOGICAL ARRAY COMPARE'BUF2(0:127);                         <<04830>>01676000
    INTEGER ARRAY PROG(0:PROGMAX);      << HOLDS PROGRAM >>             01678000
      <<                                                                01680000
         STORED PROGRAM FORMAT -                                        01682000
         WORD 0  STATEMENT NUMBER IN BINARY                             01684000
         WORD 1  STATEMENT LENGTH IN BYTES                              01686000
         WORDS 2 THRU N STATEMENT IN ASCII                              01688000
                                                                        01690000
         NEXT STATEMENT IS FOUND BY ADDING STATEMENT (LENGTH+5)/2       01692000
         STATEMENTS ARE STORE IN ORDER OF STATEMENT NUMBER.  EACH       01694000
         STATEMENT OCCUPING A BLOCK AS DESCRIBED ABOVE.                 01696000
      >>                                                                01698000
    INTEGER ARRAY M(0:70);   <<OPERATOR MESSAGES BUFFER>>      <<04830>>01700000
    INTEGER ARRAY IOQX(0:159); <<OPERATOR INDEXES FOR >>       <<04830>>01702000
                                <<TYPE 0 OR 1 I/O>>            <<04830>>01704000
    INTEGER ARRAY PA(0:79);    <<INPUT PROMPT AND PRINTX>>     <<04830>>01706000
                                <<MESSAGES>>                   <<04830>>01708000
    INTEGER ARRAY DSET(*) = CA;                                         01710000
    INTEGER ARRAY WA0 (*) = DB + 0;                                     01712000
    INTEGER ARRAY DSTARRAY(1:16):= 16(0); <<HOLDS DST NUMBER>> <<04830>>01714000
                                                                        01716000
    ARRAY M1(0:24):="TEST IOCDPN1 (C.00.00) TYPE X FOR",       <<04830>>01718000
                      "COMMAND LIST";                          <<01273>>01720000
    BYTE ARRAY PRINT'DATA(0:79);     <<HOLDS IOQ VALUES>>      <<04830>>01722000
                                                                        01724000
    BYTE ARRAY PRINT'LINE(0:79);   <<HOLDS HEADER FOR IOQ >>   <<04830>>01726000
    BYTE ARRAY DEV'NO(0:5);  << DEVICE FOR IOQ DISPLAY>>       <<04830>>01728000
    BYTE ARRAY B'CMP'BUF1(*)=COMPARE'BUF1; <<BYTE COMPARE>>    <<04830>>01730000
    BYTE ARRAY B'CMP'BUF2(*)=COMPARE'BUF2;                     <<04830>>01732000
    BYTE ARRAY BYTENUM(0:20);     <<ARRAY FOR EQUIVALENCING>>  <<04830>>01734000
    LOGICAL ARRAY LBYTENUM(*)=BYTENUM;                         <<04830>>01736000
    BYTE ARRAY BPROG(*)   = PROG;                                       01738000
    BYTE ARRAY BB(*) = B;                                               01740000
    BYTE ARRAY BM(*) = M;                                               01742000
    byte array bpa(*) = pa;                                             01744000
    BYTE ARRAY LBUF(0:79);   << USED BY TABLE FORMATTERS >>    <<04830>>01746000
    BYTE ARRAY SAVE(0:71);      << HOLDS REST OF MULTIPLE CMND LINE >>  01748000
    BYTE ARRAY FNAME(0:29) := " IN ";  << HOLDS DO FILE NAME >>         01750000
    BYTE ARRAY LINENO(0:11) := " AT "; << DO FILE CURRENT LINE NUMBER >>01752000
    BYTE ARRAY LA(0: 4) := "LIST ";                                     01754000
    BYTE ARRAY LP(0: 2) := "LP ";                                       01756000
    BYTE ARRAY TM(0: 3) := " BCC";                                      01758000
    BYTE ARRAY PL(0: 5) := " ?CSH";                                     01760000
    BYTE ARRAY DS(0:29) := "INIT  CLR SACLR CAHANGUPSET CA";            01762000
    BYTE ARRAY DSTATE(0:47) := "NULWRT RDXONTRNBWTELFECREORWWT",        01764000
                                         "DLFDCRRPTECHSRDFRD";          01766000
    BYTE ARRAY ID(0:32) := "TPRTPWTPS??????DSCDS1DS2TMITMOTMR";         01768000
    ARRAY M2(0:11) := "INVALID STATEMENT NUMBER";                       01770000
    ARRAY M3(0:13) := "UNBLOCKED I/O NOT COMPLETED ";                   01772000
    ARRAY M4(0:10) := "ERROR, PROGRAM RUNNING";                         01774000
    BYTE ARRAY M5(0:15) := "TIME = NN.NNN MS";                          01776000
    ARRAY M6(0:21) := "WARNING:  DRT# CHANGED ONLY-",          <<00924>>01778000
                      "-OVERRIDES LDEV ";                      <<00924>>01780000
    ARRAY M7(0:14) := "WARNING:  LDEV OVERRIDES DRT# ";        <<00924>>01782000
    ARRAY M5W(*) = M5;                                                  01784000
    ARRAY M6W(0:11) := "TOO MANY UNBLOCKED IO'S ";                      01786000
    ARRAY M7W(0:14) := "ERROR, SBUF FLAG AND UNBLOCKED";                01788000
    ARRAY M8W(0: 6) := "NON RESPONDING";                                01790000
    BYTE ARRAY M9(0:14) := "RESULT = XXXXXX";                           01792000
    ARRAY M9W(*) = M9;                                                  01794000
    ARRAY M10W(0:4) := "NOT READY ";                                    01796000
    ARRAY M11W(0:650):=             <<EACH LINE IS 21 WORDS>>  <<04830>>01798000
      "A   ASCII BUF FILL    AN  DO ANOTE        ",            <<00924>>01800000
      "B   OCTAL BUF FILL    C   SET COUNT PARAM ",            <<00924>>01802000
      "CH  CHECK RESULTS     CIO DO CIO INSTR    ",            <<00924>>01804000
      "CL  CLR PROG AREA     CM  CLR MNTR TABLE  ",            <<00924>>01806000
      "CMP CMP TWO BUFRS                         ",            <<04830>>01808000
      "D   DISPLAY PARAMS    DA  SHOW BUF ASCII  ",            <<00924>>01810000
      "DB  SHOW BUF OCTAL    DE  CALL DEBUG      ",            <<00924>>01812000
      "DEC DECIMAL CONVERT   DD  DISPLAY DIT     ",            <<00924>>01814000
      "DDRQ DISPLAY DRQ'S    DIOQ DISPLAY IOQ'S " ,            <<04830>>01816000
      "DMON DISPLAY MNTR TBL                     ",            <<04830>>01818000
      "DRT SET DRT#          DO  READ CMND FILE  ",            <<00924>>01820000
      "DQ  DISPLAY IOQS      DS  DISPLAY STATUS  ",            <<00924>>01822000
      "DSI DISPLAY SIO PROG  E   CALL ATTACHIO   ",            <<00924>>01824000
      "EX  TERMINATE         F   SET FUNCTION    ",            <<00924>>01826000
      "FB  FREE BUFFER  #                        ",            <<04830>>01828000
      "FL  SET FLAGS         GO  GOTO STATEMENT# ",            <<00924>>01830000
      "H   CALL HELP         I   INCREMENT FILL  ",            <<00924>>01832000
      "L   SET LDEV          LD  SET LIST DEV    ",            <<00924>>01834000
      "LI  LIST PROGRAM      M   MONITOR TERM    ",            <<00924>>01836000
      "MB  MODIFY BUFFER     MD  MODIFY DIT      ",            <<00924>>01838000
      "MQ  MODIFY IOQ        N   NULL INPT DO E  ",            <<00924>>01840000
      "O   OCTAL CONVERT     P   PRT MNTR TABLE  ",            <<00924>>01842000
      "PA  SET P1            PB  SET P2          ",            <<00924>>01844000
      "Q   SET QMISC         R   RUN STORED PROG ",            <<00924>>01846000
      "RIO DO RIO INSTR      SH  PRINT DO & PROG ",            <<00924>>01848000
      "UB  USE BUFFER   #                        ",            <<04830>>01850000
      "V   ADD REC# IN BUF   WIO DO WIO INSTR    ",            <<00924>>01852000
      "X   EXPLAIN CMDS                          ";            <<00924>>01854000
    ARRAY M12W(0:600):=              <<EACH LINE IS 21 WORDS>> <<04830>>01856000
      "A   ASCII BUF FILL    AN  DO ANOTE        ",            <<00924>>01858000
      "B   OCTAL BUF FILL    C   SET COUNT PARAM ",            <<00924>>01860000
      "CH  CHECK RESULTS     CL  CLR PROG AREA   ",            <<00924>>01862000
      "CMP  CMP TWO BUFRS                        ",            <<04830>>01864000
      "D   DISPLAY PARAMS    DA  SHOW BUF ASCII  ",            <<00924>>01866000
      "DB  SHOW BUF OCTAL    DE  CALL DEBUG      ",            <<00924>>01868000
      "DEC DECIMAL CONVERT   DD  DISPLAY DIT     ",            <<00924>>01870000
      "DIOQ  DISPLAY IOQ'S                       ",            <<04830>>01872000
      "DMON  DISPLAY DRQ'S                       ",            <<04830>>01874000
      "DMON  DISPLAY MNTR TBL                    ",            <<04830>>01876000
      "DRT SET DRT#          DO  READ CMND FILE  ",            <<00924>>01878000
      "DQ  DISPLAY IOQS      DS  DISPLAY STATUS  ",            <<00924>>01880000
      "DSI DISPLAY SIO PROG  E   CALL ATTACHIO   ",            <<00924>>01882000
      "EX  TERMINATE         F   SET FUNCTION    ",            <<00924>>01884000
      "FB  FREE BUFFER  #                        ",            <<04830>>01886000
      "FL  SET FLAGS         GO  GOTO STATEMENT# ",            <<00924>>01888000
      "H   CALL HELP         I   INCREMENT FILL  ",            <<00924>>01890000
      "L   SET LDEV          LD  SET LIST DEV    ",            <<00924>>01892000
      "LI  LIST PROGRAM      MB  MODIFY BUFFER   ",            <<00924>>01894000
      "MD  MODIFY DIT        MQ  MODIFY IOQ      ",            <<00924>>01896000
      "N   NULL INPUT DO E   O   OCTAL CONVERT   ",            <<00924>>01898000
      "PA  SET P1            PB  SET P2          ",            <<00924>>01900000
      "Q   SET QMISC         R   RUN STORED PROG ",            <<00924>>01902000
      "SH  PRINT DO & PROG   T   PRINT TIME      ",            <<00924>>01904000
      "UB  USE BUFFER   #                        ",            <<04830>>01906000
      "V   ADD REC# IN BUF   X   EXPLAIN CMDS    ";            <<00924>>01908000
    ARRAY M13W(0: 5) := "INVALID LDEV";                                 01910000
    ARRAY M14W(0: 7) := "COUNT TOO LARGE";                              01912000
    ARRAY M15W(0: 8) := "INVALID PARAMETER ";                           01914000
    ARRAY M16W(0: 5) := "HELP CALLED ";                                 01916000
    ARRAY M17W(0:13) := "INVALID NUMBER OF PARAMETERS";                 01918000
    ARRAY M18W(0:12) := "PROGRAM ABORT EOF DETECTED";          <<00924>>01920000
    ARRAY M20W(0: 7) := "TIME>32 SECONDS ";                             01922000
    ARRAY M21W(0 :6) := "IOSTATUS ERROR";                               01924000
    ARRAY M22W(0:16) := "ERROR,SBUF,READ AND REQUEST TYPE 3";           01926000
    ARRAY M23W(0: 2) := "NO IOQ";                                       01928000
    ARRAY M24W(0:10) := "INVALID COMMAND FORMAT";                       01930000
    ARRAY M25W(0:35) := "COMMANDS ARE 1 OR MORE LETTERS, PARAMS",       01932000
                        " ARE NUMBERS OR STRINGS IN QUOTES ";           01934000
    ARRAY M26W(0:26) := "PROGRAM STATEMENTS ARE PRECEDED BY A",         01936000
                        " STATEMENT NUMBER ";                           01938000
    ARRAY M27W(0:21) := "ERROR,NO PCB I/O AND SYSBUFS NOT SPECIFIED";   01940000
    ARRAY M30W(0: 5) := "INVALID DRT#";                        <<00924>>01942000
    ARRAY M31W(0:9) := "UNABLE TO GET BUFFER";                 <<04830>>01944000
    ARRAY M32W(0:16) := "BUFFERS AVAILABLE RANGE FROM 0-16.";  <<04830>>01946000
    ARRAY M33W(0:9) := "BUFFERS ARE EQUAL";                    <<04830>>01948000
    ARRAY M34W(0:16) :="THE BYTE THAT DOES NOT COMPARE IS:";   <<04830>>01950000
    ARRAY M35W(0:3) :=" OR %";                                 <<04830>>01952000
    ARRAY M36W(0:11) := "USING INTERNAL BUFFER";               <<04830>>01954000
    ARRAY M37W(0:12) := "ACTIVE BUFFER IS BUFFER #";           <<04830>>01956000
    ARRAY M38W(0:11) := ":  DATA SEGMENT # IS %";              <<04830>>01958000
    ARRAY M39W(0:15) := "BUFFER HAS NOT BEEN ALLOCATED";       <<04830>>01960000
    ARRAY M40W(0:17) := "FIRST BUFFER IN CMP IS NOT ALLOCATED";<<04830>>01962000
    ARRAY M41W(0:18):= "SECOND BUFFER IN CMP IS NOT ALLOCATED";<<04830>>01964000
    ARRAY M42W(0:18):= "INTERNAL BUFFER CANNOT BE COMPARED.";  <<04830>>01966000
    ARRAY M43W(0:13):= " USE EXTRA DATA SEGMENTS.";            <<04830>>01968000
                                                                        01970000
INTRINSIC FCONTROL, FREAD, FRELATE, FOPEN, FCLOSE, FWRITE,              01972000
          DASCII, ASCII, BINARY, DEBUG, PRINT, READ, READX,    <<00924>>01974000
          XSYSTRAP, RESETCONTROL, XCONTRAP,                             01976000
          CREATE, ACTIVATE, COMMAND;                                    01978000
                                                                        01980000
DOUBLE PROCEDURE ATTACHIO(L,Q,D,B,F,C,P1,P2,FL);                        01982000
  VALUE   L,Q,D,B,F,C,P1,P2,FL;                                         01984000
  INTEGER L,Q,D,B,F,C,P1,P2,FL;                                         01986000
  OPTION EXTERNAL;                                                      01988000
                                                                        01990000
INTEGER PROCEDURE EXPRESSION;   OPTION FORWARD;                         01992000
                                                                        01994000
INTEGER PROCEDURE EXCHANGEDB(DSTN);                                     01996000
  VALUE DSTN;  INTEGER DSTN;  OPTION EXTERNAL;                          01998000
                                                               <<04830>>02000000
                                                               <<04830>>02002000
INTEGER PROCEDURE GETDATASEG(MSIZE,VMSIZE);                    <<04830>>02004000
   VALUE MSIZE, VMSIZE;                                        <<04830>>02006000
   INTEGER MSIZE,VMSIZE;                                       <<04830>>02008000
   OPTION EXTERNAL;                                            <<04830>>02010000
                                                               <<04830>>02012000
PROCEDURE RELDATASEG(EN);                                      <<04830>>02014000
   VALUE EN;                                                   <<04830>>02016000
   INTEGER EN;                                                 <<04830>>02018000
   OPTION EXTERNAL;                                            <<04830>>02020000
                                                               <<04830>>02022000
                                                                        02024000
INTEGER PROCEDURE GETSYSBUF(N,IFLAG);                                   02026000
  VALUE N,IFLAG;  INTEGER N;  LOGICAL IFLAG;                            02028000
  OPTION EXTERNAL;                                                      02030000
                                                                        02032000
PROCEDURE HELP;  OPTION EXTERNAL;                                       02034000
                                                                        02036000
DOUBLE PROCEDURE IOSTATUS(IOQX);                                        02038000
  VALUE IOQX;  INTEGER IOQX;                                            02040000
  OPTION EXTERNAL;                                                      02042000
                                                                        02044000
PROCEDURE RETURNSYSBUF(SBUFX);                                          02046000
  VALUE SBUFX;  INTEGER SBUFX;                                          02048000
  OPTION EXTERNAL;                                                      02050000
                                                                        02052000
PROCEDURE SETWAKE(IOQX);                                                02054000
  VALUE IOQX;  INTEGER IOQX;                                            02056000
  OPTION EXTERNAL;                                                      02058000
                                                                        02060000
INTEGER PROCEDURE THISCPU;   OPTION EXTERNAL;                           02062000
                                                                        02064000
DOUBLE PROCEDURE TIMER;  OPTION EXTERNAL;                               02066000
                                                                        02068000
PROCEDURE WAIT(WF,SF);                                                  02070000
  VALUE WF, SF;  INTEGER WF,SF;                                         02072000
  OPTION EXTERNAL;                                                      02074000
integer procedure GETDRT(DRTN,OFFSET);                         <<03120>>02076000
value DRTN,OFFSET;                                             <<03120>>02078000
integer DRTN,OFFSET;                                           <<03120>>02080000
option external;                                               <<03120>>02082000
                                                               <<03120>>02084000
$PAGE "  SERVICE PROCEDURES"                                            02086000
                                                                        02088000
INTEGER PROCEDURE CHAR;                                                 02090000
  <<                                                                    02092000
     THIS PROCEDURE RETURNS THE CURRENT CHARACTER BEING POINTED TO BY   02094000
     THE POINTER I IN THE BUFFER BM.  IF THE CHARACTER IS A BLANK AND   02096000
     THEN QUOTE FLAG IS NOT SET, I IS INCREMENTED UNTIL A NON BLANK     02098000
     CHARACTER IS FOUND. IT ALSO STEPS OVER COMMENT FIELDS.             02100000
  >>                                                                    02102000
  BEGIN                                                                 02104000
  IF I<>LASTI THEN BEGIN   << LOOKING AT A NEW CHARACTER >>             02106000
    IF NOT QUOTEFLAG THEN WHILE INTEGER(BM(I))=" " DO I := I + 1;       02108000
    IF INTEGER(BM(I))=QUOTE THEN QUOTEFLAG := NOT QUOTEFLAG;            02110000
                                                                        02112000
    IF NOT QUOTEFLAG AND BM(I)="<<" THEN BEGIN                          02114000
      J := I + 2;   << STEP OVER COMMENT DELIMITER >>                   02116000
      WHILE J<L AND BM(J)<>">>" DO J := J + 1;                          02118000
      IF J<L THEN BEGIN    << DELETE COMMENT FIELD >>                   02120000
        MOVE BM(I) := BM(J+2),(L-J);                                    02122000
        L := L + I - J - 2;    << NEW LENGTH >>                         02124000
        CHAR;    << SCAN TO NON COMMENT >>                              02126000
        END;                                                            02128000
      END;                                                              02130000
    END;                                                                02132000
                                                                        02134000
  CHAR := BM(I);    LASTI := I;                                         02136000
  END;   << CHAR >>                                                     02138000
                                                                        02140000
                                                                        02142000
$PAGE                                                          <<04830>>02144000
                                                                        02146000
PROCEDURE STRIPBLANKS;                                                  02148000
  <<                                                                    02150000
     THIS PROCEDURE STRIPS LEADING AND TRAILING BLANKS FORM THE LINE IN 02152000
     THE BUFFER M. IT ALSO CLEARS THE QUOTE FLAG.                       02154000
  >>                                                                    02156000
  BEGIN                                                                 02158000
  WHILE INTEGER(BM(L-1))=%40 AND L>0 DO L := L - 1;                     02160000
  BM(L) := CR;                                                          02162000
                                                                        02164000
  DO BEGIN    << SCAN OFF LEADING BLANKS >>                             02166000
    I := 0;    LASTI := -1;    QUOTEFLAG := FALSE;                      02168000
    CHAR;     << FIND FIRST NON BLANK >>                                02170000
    L := L - I;                                                         02172000
    IF I<>0 THEN MOVE BM := BM(I),(L+1);                                02174000
  END UNTIL I=0;   << NO LEADING BLANKS >>                              02176000
  END;   << STRIP BLANKS >>                                             02178000
$PAGE                                                                   02180000
                                                                        02182000
PROCEDURE SETSTATUS(DUMMY);                                             02184000
  VALUE DUMMY;   INTEGER DUMMY;                                         02186000
  <<                                                                    02188000
    THIS PROCEDURE TAKES THE CURRENT CONDITION CODE AND SETS IT INTO    02190000
    THE MARKER OF THE PREVIOUS CALLER, THUS PASSING THE CURRENT         02192000
    STATUS OF THE CALLER OF THE PROCEDURE TO THE CALLERS CALLER.        02194000
  >>                                                                    02196000
  BEGIN                                                                 02198000
    ARRAY MARKERSTATUS(*) = Q - 1;                                      02200000
    INTEGER DELTAQ = Q - 0;                                             02202000
                                                                        02204000
    DEFINE CC = (6:2)#;                                                 02206000
                                                                        02208000
    MARKERSTATUS(-DELTAQ).CC := MARKERSTATUS.CC;                        02210000
  END;    << SET STATUS >>                                              02212000
                                                                        02214000
                                                                        02216000
$PAGE                                                          <<04830>>02218000
                                                                        02220000
INTEGER PROCEDURE DEVTYPE(LDEV);                                        02222000
  VALUE LDEV;  INTEGER LDEV;                                            02224000
  <<                                                                    02226000
    RETURNS THE DEVICE TYPE OF LOGICAL DEVICE LDEV                      02228000
  >>                                                                    02230000
  BEGIN                                                                 02232000
    INTEGER TEMP;  INTEGER ARRAY WA2(*) = DB + 2;                       02234000
                                                                        02236000
    TEMP := EXCHANGEDB(14);  << SET DB TO LDT >>                        02238000
    IF WA0.(0:8)>=LDEV THEN DEVTYPE := WA2(WA0.(8:8)*LDEV).(10:6);      02240000
    EXCHANGEDB(TEMP);  << RESTORE DB TO STACK >>                        02242000
  END;   << DEV TYPE >>                                                 02244000
$PAGE                                                                   02246000
                                                                        02248000
$PAGE                                                          <<04830>>02250000
INTEGER PROCEDURE FACTOR;                                               02252000
  <<                                                                    02254000
    THIS PROCEDURE RETURNS A FACTOR OF AN EXPRESSION, WHICH MAY BE      02256000
    A NUMBER, A LITERAL WITHIN QUOTES OF 1 OR 2 CHARACTERS LENGTH       02258000
    OR AN EXPRESSION INCLOSED IN PARENTHESIS.                           02260000
                                                                        02262000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    02264000
    CCL = NULL FACTOR,  CCE = GOOD FACTOR,  CCG = ERROR                 02266000
  >>                                                                    02268000
  BEGIN                                                                 02270000
    INTEGER TEMP;                                                       02272000
                                                                        02274000
    IF I=L THEN  << NULL FACTOR >>                                      02276000
      BEGIN   SETSTATUS(-1);  RETURN;  END;                             02278000
                                                                        02280000
    IF CHAR="(" THEN  << AN EXPRESSION EXPECTED >>                      02282000
      BEGIN                                                             02284000
        I := I + 1;    << STEP OVER PAREN >>                            02286000
        FACTOR := EXPRESSION;                                           02288000
        IF <> OR CHAR<>")" THEN SETSTATUS(1)  << ERROR >>               02290000
          ELSE BEGIN SETSTATUS(0);  I := I + 1;  END;                   02292000
        RETURN;                                                         02294000
      END;                                                              02296000
                                                                        02298000
    IF CHAR=QUOTE THEN  << LITERAL FACTOR >>                            02300000
      BEGIN                                                             02302000
        I := I + 1;     << STEP OVER QUOTE >>                           02304000
        TEMP := CHAR;                                                   02306000
        IF I<L THEN I := I+1;  << STEP OVER CHAR >>                     02308000
        IF CHAR<>QUOTE THEN  << TWO CHARACTER LITERAL >>                02310000
          BEGIN                                                         02312000
            TEMP := TEMP&LSL(8) + CHAR;                                 02314000
            IF I<L THEN I := I + 1;   << STEP OVER 2ND CHAR >>          02316000
          END;                                                          02318000
        FACTOR := TEMP;                                                 02320000
        IF CHAR<>QUOTE THEN SETSTATUS(1)   << NO CLOSING QUOTE >>       02322000
        ELSE BEGIN SETSTATUS(0);  I := I + 1;  END;                     02324000
        RETURN;                                                         02326000
      END;                                                              02328000
                                                                        02330000
    X := IF CHAR="%" THEN I+1 ELSE I;                                   02332000
    MOVE BM(X) := BM(X) WHILE N, 1;  << FIND LENGTH OF NUMBER >>        02334000
    TEMP := TOS - @BM - I;   << LENGTH OF NUMBER >>                     02336000
    IF <> THEN                                                          02338000
      BEGIN                                                             02340000
        FACTOR := BINARY(BM(I),TEMP);  << CONVERT NUMBER >>             02342000
        IF = THEN << NO ERROR >>                                        02344000
          BEGIN  SETSTATUS(0);  I := I + TEMP;  RETURN;  END;           02346000
      END;                                                              02348000
                                                                        02350000
    SETSTATUS(1);   << ERROR >>                                         02352000
  END;   << FACTOR >>                                                   02354000
                                                                        02356000
$PAGE                                                          <<04830>>02358000
INTEGER PROCEDURE TERM;                                                 02360000
  <<                                                                    02362000
    THIS PROCEDURE RETURNS A TERM OF AN EXPRESSION WHICH MAY BE A       02364000
    FACTOR OR A FACTOR TIMES A FACTOR OR A FACTOR DIVIDED BY A FACTOR.  02366000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    02368000
                                                                        02370000
    CCL = NULL TERM,  CCE = GOOD TERM,  CCG = ERROR                     02372000
  >>                                                                    02374000
  BEGIN                                                                 02376000
    INTEGER OPERATOR, TEMP, RESULT;                                     02378000
                                                                        02380000
    RESULT := FACTOR;                                                   02382000
    SETSTATUS(0);    << SET RETURN STATUS >>                            02384000
    IF <> THEN RETURN;    << RETURN RESULTS STATUS >>                   02386000
                                                                        02388000
    WHILE CHAR="*" OR CHAR="/" DO                                       02390000
      BEGIN                                                             02392000
        OPERATOR := CHAR;                                               02394000
        I := I + 1;   << STEP OVER OPERATOR >>                          02396000
        TEMP := FACTOR;                                                 02398000
        IF <> THEN   << AN ERROR CONDITION >>                           02400000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        02402000
        RESULT := IF OPERATOR="*" THEN RESULT*TEMP ELSE RESULT/TEMP;    02404000
        IF OVERFLOW THEN  BEGIN   SETSTATUS(1);   RETURN;   END;        02406000
      END;                                                              02408000
                                                                        02410000
    TERM := RESULT;                                                     02412000
  END;   << TERM  >>                                                    02414000
$PAGE                                                                   02416000
                                                                        02418000
INTEGER PROCEDURE EXPRESSION;                                           02420000
  <<                                                                    02422000
    THIS PROCEDURE RETURNS AN EXPRESSION WHICH MAY BE A TERM PRECEDED   02424000
    BY A UNARY MINUS OR THE SUM OR DIFERENCES OF A SET OF TERMS.        02426000
                                                                        02428000
    RETURNED IS THE VALUE WITH THE CONDITION CODE SPECIFING VALIDITY    02430000
    CCL = NULL EXPRESSION,  CCE = GOOD EXPRESSION,  CCG = ERROR         02432000
  >>                                                                    02434000
  BEGIN                                                                 02436000
    INTEGER OPERATOR, TEMP, SUM;                                        02438000
                                                                        02440000
    IF CHAR="-" THEN   << A UNARY MINUS >>                              02442000
      BEGIN                                                             02444000
        I := I + 1;   << STEP OVER MINUS >>                             02446000
        TEMP := TERM;                                                   02448000
        IF <> THEN   << AN ERROR CONDITION >>                           02450000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        02452000
        SETSTATUS(0);   << SET GOOD RETURN STATUS >>                    02454000
        SUM := - TEMP;                                                  02456000
      END                                                               02458000
    ELSE                                                                02460000
      BEGIN                                                             02462000
        SUM := TERM;                                                    02464000
        SETSTATUS(0);  << SET RETURN STATUS >>                          02466000
        IF <> THEN RETURN;    << PASS BACK STATUS >>                    02468000
      END;                                                              02470000
                                                                        02472000
    WHILE CHAR="+" OR CHAR="-" DO                                       02474000
      BEGIN                                                             02476000
        OPERATOR := CHAR;                                               02478000
        I := I + 1;   << STEP OVER OPERATOR >>                          02480000
        TEMP := TERM;                                                   02482000
        IF <> THEN   << AN ERROR CONDITION >>                           02484000
          BEGIN   SETSTATUS(1);   RETURN;   END;                        02486000
        SUM := IF OPERATOR="+" THEN SUM+TEMP ELSE SUM-TEMP;             02488000
        IF OVERFLOW THEN  BEGIN   SETSTATUS(1);   RETURN;   END;        02490000
      END;                                                              02492000
                                                                        02494000
    EXPRESSION := SUM;                                                  02496000
  END;   << EXPRESSION >>                                               02498000
$PAGE                                                                   02500000
                                                                        02502000
PROCEDURE PRINT'(ADR, L, C);                                            02504000
  VALUE   L, C;                                                         02506000
  INTEGER L, C;   ARRAY ADR;                                            02508000
  <<                                                                    02510000
    CALLS PRINT IF THE CONTROL Y FLAG IS CLEAR OTHERWISE NO OPERATION   02512000
  >>                                                                    02514000
  BEGIN   IF NOT CYFLAG THEN PRINT(ADR, L, C);   END;                   02516000
                                                                        02518000
                                                                        02520000
                                                                        02522000
PROCEDURE PRINTX(ADR, L);                                               02524000
    VALUE L;  INTEGER L;   ARRAY ADR;                                   02526000
  <<                                                                    02528000
    PRINTS EXCEPTION CONDITIONS. IF COMMAND GOTTEN FROM DO FILE THEN THE02530000
    DO FILE NAME AND LINE NUMBER ARE APPEND OR IF GETTING FROM A STORED 02532000
    PROGRAM THEN THE STATEMENT NUMBER IS APPENDED                       02534000
  >>                                                                    02536000
    BEGIN                                                               02538000
    TOS := L;                                                           02540000
    TOS := IF < THEN -TOS ELSE TOS*2;  << FORM POSITIVE BYTE COUNT >>   02542000
    L := TOS;                                                           02544000
    MOVE PA := ADR,((L+1)/2);  << MOVE MESSAGE >>                       02546000
                                                                        02548000
    CASE SOURCE OF                                                      02550000
      BEGIN                                                             02552000
      BEGIN   END;   << $STDIN >>                                       02554000
                                                                        02556000
      BEGIN     << STORED PROGRAM >>                                    02558000
      MOVE BPA(L) := " AT STATEMENT ";   L := L + 14;                   02560000
      L := ASCII(LASTLINE, 10, BPA(L)) + L;                             02562000
      END;                                                              02564000
                                                                        02566000
      BEGIN     << DO FILE >>                                           02568000
      MOVE BPA(L) := FNAME,(FNL+4);   L := FNL + 4 + L;                 02570000
      IF INTEGER(LINENO(4))<>" " THEN  << HAS A LINE NUMBER >>          02572000
        BEGIN   MOVE BPA(L) := LINENO,(12);   L := L +12;    END;       02574000
      END;                                                              02576000
      END;    << SOURCE CASE >>                                         02578000
                                                                        02580000
    PRINT'(PA, -L, 0);                                                  02582000
    END;    << PRINT X >>                                               02584000
                                                                        02586000
                                                                        02588000
                                                                        02590000
PROCEDURE OUTPUT(ADR,L,CNTRL);                                          02592000
  VALUE L, CNTRL;  INTEGER L, CNTRL;  ARRAY ADR;                        02594000
  <<                                                                    02596000
    OUTPUTS TO $STDLIST, LIST FILE OR LDEV VIA ATTACHIO                 02598000
  >>                                                                    02600000
  BEGIN                                                                 02602000
    IF NOT CYFLAG THEN  << OUTPUT THE MESSAGE >>                        02604000
      IF FN<>0 THEN   << CHECK FOR ALTERNATE LIST DEVICE >>             02606000
        IF < THEN ATTACHIO(-FN,0,0,@ADR,1,L,CNTRL,0,1)                  02608000
        ELSE FWRITE(FN, ADR, L, CNTRL)                                  02610000
      ELSE PRINT'(ADR, L, CNTRL);                                       02612000
  END;  << OUTPUT >>                                                    02614000
                                                                        02616000
                                                                        02618000
                                                                        02620000
PROCEDURE PRINTE(ADR,L);                                                02622000
  VALUE L;  INTEGER L;  ARRAY ADR;                                      02624000
  <<                                                                    02626000
      THIS ROUTINE PRINTS ERROR MESSAGES. IF COMMAND IS GOTTEN FROM A   02628000
      STORED PROGRAM THEN THE STATEMENT NUMBER OR IF THE COMMAND IS     02630000
      GOTTEN FROM THE DO FILE THEN DO FILE NAME AND LINE NUMBER ARE     02632000
      APPENDED TO THE MESSAGE.                                          02634000
  >>                                                                    02636000
  BEGIN                                                                 02638000
    PRINTX( ADR, L );                                                   02640000
    EFLAG := TRUE;                                                      02642000
  END;    << PRINTE >>                                                  02644000
                                                                        02646000
                                                                        02648000
                                                                        02650000
PROCEDURE PRINTSTATUS;                                                  02652000
  BEGIN                                                                 02654000
    MOVE BM := "LDEV = ";       X := 7;                                 02656000
    X := ASCII(LASTLDEV, 10, BM(X)) + X;                                02658000
    MOVE BM(X) := ", FUNC = ";  X := X + 9;                             02660000
    X := ASCII(LASTFUNC, 10, BM(X)) + X;                                02662000
    MOVE BM(X) := ", XLOG = ";   X := X + 9;                            02664000
    X := ASCII(XLOG, 10, BM(X)) + X;                                    02666000
    TOS := @BM(X);   << SAVE ADDRESS TO MOVE "STATUS = " >>             02668000
    ASCII(STATUS.(8:8), 8, BM(X:=X+8));                                 02670000
    MOVE * := ", STATUS = ";                                            02672000
    PRINTX(M, -(X+6));                                                  02674000
  END;  << PRINT STATUS >>                                              02676000
                                                                        02678000
                                                                        02680000
                                                                        02682000
PROCEDURE PRINTBUFFER( ADR, COUNT );                                    02684000
  VALUE ADR, COUNT;  INTEGER ADR, COUNT;                                02686000
  <<                                                                    02688000
    THIS PROCEDURE PRINTS THE NUMBER OF WORDS COUNT IN OCTAL, AT ADR    02690000
    IN BUFFER B OR AT ABSOLUTE ADDRESS ADR.  THE WORDS ARE PRINTED      02692000
    8 TO A LINE WITH AN ASSOCIATED ADDRESS SPECIFIED BY ADR             02694000
  >>                                                                    02696000
  BEGIN                                                                 02698000
    INTEGER I, J, L, T;                                                 02700000
                                                                        02702000
    WHILE COUNT>0 DO                                                    02704000
      BEGIN                                                             02706000
        J := IF COUNT>8 THEN 8 ELSE COUNT;                              02708000
        IF BFLAG THEN  << OUPUT BUFFER RELATIVE >>                      02710000
          BEGIN MOVE BM := "   "; ASCII(ADR, -10, BM(3)); L := 4; END   02712000
        ELSE BEGIN  ASCII(ADR, 8, BM);  L := 6;  END;                   02714000
        MOVE BM(L) := ": ";     L := L + 2;                             02716000
        FOR I := 1 UNTIL J DO                                           02718000
          BEGIN                                                         02720000
            T := IF BFLAG THEN B(ADR) ELSE ABS(ADR);  << GET A WORD >>  02722000
            ASCII( T, 8, BM(L) );   L := L + 8;                         02724000
            MOVE BM(L-2) := "  ";    ADR := ADR + 1;                    02726000
          END;                                                          02728000
        OUTPUT( M, -L, 0);                                              02730000
        COUNT := COUNT - 8;                                             02732000
      END;                                                              02734000
  END;   << PRINT BUFFER >>                                             02736000
                                                                        02738000
                                                                        02740000
                                                                        02742000
PROCEDURE PRINTRESULT(RESULT);                                          02744000
  VALUE RESULT;    INTEGER RESULT;                                      02746000
  <<                                                                    02748000
    CHECKS CC FOR < AND PRINTS NORESPONDING OR IF > THEN PRINTS NOT     02750000
    READY AND PRINTS RESULT WORD IF > OR X ODD.                         02752000
  >>                                                                    02754000
  IF < THEN PRINTX(M8W, 7)   << NON RESPONDING >>                       02756000
  ELSE IF > OR LOGICAL(X) THEN                                          02758000
    BEGIN    << NOT READY OR PRINT TIO/RIO RESULT >>                    02760000
    IF > THEN PRINTX(M10W, -9);   << NOT READY >>                       02762000
    TOS := ASCII(RESULT, 8, M9(9));   << CONVERT RESULT TO OCTAL >>     02764000
    PRINTX(M9W, -15);                                                   02766000
    END;    << PRINT RESULT >>                                          02768000
$PAGE                                                                   02770000
                                                                        02772000
PROCEDURE CY;                                                           02774000
  <<                                                                    02776000
    CONTROL Y TRAP PROCEDURE                                            02778000
  >>                                                                    02780000
  BEGIN                                                                 02782000
    INTEGER Q1 = Q+1;  << EXIT N PARAMETER >>                           02784000
                                                                        02786000
    FCONTROL(IN, 16, T);   << WAIT, THEN DISABLE CONTROL Y >>           02788000
    PRINT(M, 0, 0);    CYI := 0;    << CR/LF >>                         02790000
                                                                        02792000
    CASE SOURCE OF BEGIN                                                02794000
      BEGIN   M := "..";   BM(2) := ".";   CYI := 3;   END; << $STDIN >>02796000
                                                                        02798000
      BEGIN    << GETTING FROM STORED PROGRAM >>                        02800000
      MOVE BM := "CONTROL Y BREAK AFTER STATEMENT ";                    02802000
      CYI := ASCII(LASTLINE, 10, BM(32)) + 32;                          02804000
      END;                                                              02806000
                                                                        02808000
      BEGIN    << GETTING FROM DO FILE >>                               02810000
      MOVE BM := "CONTROL Y BREAK";                                     02812000
      MOVE BM(15) := FNAME,(FNL+4);   CYI := 19 + FNL;                  02814000
      IF INTEGER(LINENO(4))<>" " THEN  << APPEND LINE NUMBER >>         02816000
        BEGIN  MOVE BM(CYI) := LINENO,(12);   CYI := CYI + 12;   END;   02818000
      END;                                                              02820000
      END;   << SOURCE CASE >>                                          02822000
                                                                        02824000
    PRINT(M, -CYI, 0);                                                  02826000
    CYFLAG := EFLAG := TRUE;                                            02828000
    TOS := %31400+Q1.(8:8);   << FORM EXIT N INSTRUCTION >>             02830000
    ASMB( XEQ );                                                        02832000
  END;                                                                  02834000
$PAGE                                                                   02836000
                                                                        02838000
PROCEDURE STEP'PC(PC);                                                  02840000
  INTEGER PC;                                                           02842000
  <<                                                                    02844000
    STEPS THE VARIABLE PC ONE STATEMENT IN THE STORED PROGRAM. IT DOES  02846000
    NOT STEP PAST THE PROGRAM END.                                      02848000
  >>                                                                    02850000
  BEGIN  IF PC<PROGEND THEN PC := (PROG(PC+1)+5)/2 + PC;  END;          02852000
                                                                        02854000
                                                                        02856000
                                                                        02858000
INTEGER PROCEDURE FINDLINE(LN, NEXT);                                   02860000
  VALUE   LN, NEXT;   INTEGER LN;    LOGICAL NEXT;                      02862000
  <<                                                                    02864000
    THIS PROCEDURE FINDS THE LINE LN AND RETURNS THE INDEX INTO PROG OF 02866000
    THE SPECIFIED LINE. IF THE LINE IS NOT IN FOUND, IT RETURNS THE     02868000
    INDEX OF THE PREVIOUS LINE OR THE NEXT LINE IF NEXT IS SET.         02870000
  >>                                                                    02872000
  BEGIN                                                                 02874000
  INTEGER I := 0, j := 0;                                               02876000
                                                                        02878000
  WHILE I<PROGEND AND PROG(I)<LN DO                                     02880000
    BEGIN    J := I;    STEP'PC(I);    END;                             02882000
  IF NOT NEXT AND PROG(I)>LN THEN I := J;  << RETURN LAST >>            02884000
  FINDLINE := I;                                                        02886000
  END;   << FIND LINE >>                                                02888000
$PAGE                                                                   02890000
                                                                        02892000
PROCEDURE BCONVERT(N,INDEX);                                            02894000
  VALUE N, INDEX;  INTEGER N, INDEX;                                    02896000
  <<                                                                    02898000
    CONVERTS N TO ASCII OCTAL AND PUTS LAST 3 DIGITS INTO BYTE ARRAY    02900000
    BM BEGINING AT INDEX                                                02902000
  >>                                                                    02904000
  BEGIN                                                                 02906000
    BYTE ARRAY BA( 0:5 );                                               02908000
    ASCII(N,8,BA);  << CONVERT NUMBER TO OCTAL >>                       02910000
    MOVE BM(INDEX) := BA(3),(3);                                        02912000
  END;   << BCONVERT >>                                                 02914000
                                                                        02916000
                                                                        02918000
                                                                        02920000
PROCEDURE SYSTRAP(P1,P2,P3,P4,P5,P6,P7,P8);                             02922000
  VALUE P1, P2, P3, P4, P5, P6, P7, P8;                                 02924000
  INTEGER P1, P2, P3, P4, P5, P6, P7, P8;                               02926000
  BEGIN                                                                 02928000
  EFLAG := TRUE;                                                        02930000
  TOS := P1.(11:5) + %031410;                                           02932000
  ASMB( XEQ 0 );                                                        02934000
  END;  << SYS TRAP >>                                                  02936000
                                                               <<04830>>02938000
                                                               <<04830>>02940000
PROCEDURE SKIPLINES(XTIMES);                                   <<04830>>02942000
VALUE XTIMES;                                                  <<04830>>02944000
INTEGER XTIMES;                                                <<04830>>02946000
<<The following will be used as an equivalent to linefeed.>>   <<04830>>02948000
<<XTIMES will tell us how many times to linefeed>>             <<04830>>02950000
BEGIN                                                          <<04830>>02952000
  LOGICAL ARRAY LINEFEED(0:0); <<DUMMY  USED LIKE A LINEFEED>> <<04830>>02954000
  INTEGER NUMBER;                                              <<04830>>02956000
  FOR NUMBER:=0 UNTIL XTIMES DO                                <<04830>>02958000
    PRINT(LINEFEED,0,0);    << PRINT NOTHING>>                 <<04830>>02960000
END;     << OF SKIPLINES >>                                    <<04830>>02962000
                                                               <<04830>>02964000
                                                               <<04830>>02966000
                                                               <<04830>>02968000
                                                               <<04830>>02970000
PROCEDURE HEADER;                                              <<04830>>02972000
<< Prints the header to the IOQ list >>                        <<04830>>02974000
BEGIN                                                          <<04830>>02976000
  MOVE PRINT'LINE:=80(" ");                                    <<04830>>02978000
  SKIPLINES(1);                                                <<04830>>02980000
  MOVE PRINT'LINE(44):="STATUS: 0.XX -> PENDING";              <<04830>>02982000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>02984000
  MOVE PRINT'LINE(52):="1.XX -> SUCCESSFUL";                   <<04830>>02986000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>02988000
  MOVE PRINT'LINE(52):="2.XX -> END OF FILE";                  <<04830>>02990000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>02992000
  MOVE PRINT'LINE(52):="3.XX -> UNUSUAL CONDITION";            <<04830>>02994000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>02996000
  MOVE PRINT'LINE(52):="4.XX -> IRRECOVERABLE ERROR";          <<04830>>02998000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>03000000
  SKIPLINES(2);                                                <<04830>>03002000
  MOVE PRINT'LINE:="TABL DEV        UN-      DST/  OFFSET    ";<<04830>>03004000
  MOVE PRINT'LINE(41):="  XFER                               ";<<04830>>03006000
  MOVE PRINT'LINE(78):=" ";                                    <<04830>>03008000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>03010000
  MOVE PRINT'LINE:="INDX B10  IOQP  IT  PCB  BANK   ADDR  ";   <<04830>>03012000
  MOVE PRINT'LINE(38):="FNC  CNT   FLAGS  PARM1 PARM2 MISC   ";<<04830>>03014000
  MOVE PRINT'LINE(76):="    ";                                 <<04830>>03016000
  PRINT(PRINT'LINE,-79,%40);                                   <<04830>>03018000
  SKIPLINES(1);                                                <<04830>>03020000
END;       <<OF HEADER>>                                       <<04830>>03022000
                                                               <<04830>>03024000
                                                               <<04830>>03026000
                                                               <<04830>>03028000
PROCEDURE PRINT'INFO(NDEX,DISPLACEMENT);                       <<04830>>03030000
VALUE NDEX, DISPLACEMENT;                                      <<04830>>03032000
INTEGER NDEX;                                                  <<04830>>03034000
LOGICAL DISPLACEMENT;                                          <<04830>>03036000
<<Takes the information for the IOQ elements and converts it>> <<04830>>03038000
<<to octal. The device number is displayed in decimal>>        <<04830>>03040000
<<NDEX will indicate where on the line the printed informa->>  <<04830>>03042000
<<tion will apprear. DISPLACEMENT is the info to be converted>><<04830>>03044000
<<and printed. If the device is about to be printed, >>        <<04830>>03046000
<<DEV'CHECK will be true allowing it to be printed in decimal>><<04830>>03048000
BEGIN                                                          <<04830>>03050000
   BYTE ARRAY ELEMENT(0:10);  <<HOLDS THE OCTAL VALUE>>        <<04830>>03052000
   IF DEV'CHECK THEN     << LDEV WILL BE PRINTED IN DECIMAL >> <<04830>>03054000
      BEGIN                                                    <<04830>>03056000
        NUMCHAR:=ASCII(DISPLACEMENT,10,ELEMENT);               <<04830>>03058000
        MOVE PRINT'DATA(NDEX):=ELEMENT,(NUMCHAR);              <<04830>>03060000
      END                                                      <<04830>>03062000
   ELSE                                                        <<04830>>03064000
     BEGIN                                                     <<04830>>03066000
     NUMCHAR:=ASCII(DISPLACEMENT,8,ELEMENT);                   <<04830>>03068000
     MOVE PRINT'DATA(NDEX):=ELEMENT(6-NUMCHAR),(NUMCHAR);      <<04830>>03070000
   END;     << OF IF >>                                        <<04830>>03072000
END;     << OF PRINT'INFO >>                                   <<04830>>03074000
                                                               <<04830>>03076000
                                                               <<04830>>03078000
LOGICAL PROCEDURE IOQ(WORDOFFSET);                             <<04830>>03080000
VALUE WORDOFFSET;                                              <<04830>>03082000
<<Procedure IOQ is given the DST# of the table to extract>>    <<04830>>03084000
<<information from. WORDOFFSET zeroes into the proper entry>>  <<04830>>03086000
<<and location of the word we want to extract. The info>>      <<04830>>03088000
<<is then returned.>>                                          <<04830>>03090000
LOGICAL WORDOFFSET;                                            <<04830>>03092000
BEGIN                                                          <<04830>>03094000
  LOGICAL MFDSWORD;                                            <<04830>>03096000
  <<EXTRACT INFORMATION FROM IOQ TABLE OR ELEMENT>>            <<04830>>03098000
  TOS:=@MFDSWORD;   <<STORE WORD IN MFDSWORD>>                 <<04830>>03100000
  TOS:=SNAPSHOT'DST;       <<DST FOR TABLE>>                   <<04830>>03102000
  TOS:=WORDOFFSET;         <<WORD TO BE EXTRACTED>>            <<04830>>03104000
  TOS:=1;                                                      <<04830>>03106000
  ASSEMBLE (MFDS4); <<DELETE FOUR WORDS ON TOS>>               <<04830>>03108000
  IOQ:=MFDSWORD;                                               <<04830>>03110000
END;     <<OF IOQ >>                                           <<04830>>03112000
                                                               <<04830>>03114000
                                                               <<04830>>03116000
PROCEDURE FORMAT'IOQ(DEV,OFFSET,QUEUE'DST);                    <<04830>>03118000
VALUE DEV,OFFSET,QUEUE'DST;                                    <<04830>>03120000
LOGICAL OFFSET;                                                <<04830>>03122000
INTEGER DEV,QUEUE'DST;                                         <<04830>>03124000
<<FORMAT'IOQ passes to PRINT'INFO the index to which the >>    <<04830>>03126000
<<info to be printed should be placed on a line and the >>     <<04830>>03128000
<<right location of where the information is contained.>>      <<04830>>03130000
<<DEV holds the value of the device the user wants the IOQ's>> <<04830>>03132000
<<displayed for. If DEV equals 0, then IOQ's for all devices>> <<04830>>03134000
<<are displayed. OFFSET points to the entry number referenced>><<04830>>03136000
BEGIN   <<SET UP OF HOW TO PRINT INFO OF IOQ ELEMENT>>         <<04830>>03138000
INTEGER REL'INDEX;                                             <<04830>>03140000
MOVE PRINT'DATA:=80(" ");                                      <<04830>>03142000
REL'INDEX:=INTEGER(IOQ(OFFSET+LINK)+%1000-                     <<04830>>03144000
           (ABSOLUTE(QUEUE'DST*4+ABSOLUTE(2)+3)));             <<04830>>03146000
 IF (DEV=0) OR IOQ(OFFSET+LDEVICE)=                            <<04830>>03148000
 LOGICAL(DEV) THEN                                             <<04830>>03150000
   BEGIN                                                       <<04830>>03152000
     PRINT'INFO(0,IOQ'POINTER);                                <<04830>>03154000
     DEV'CHECK:=TRUE;<<CHECK FOR DEVICE FOR DECIMAL PRINTING>> <<04830>>03156000
     PRINT'INFO( 5,IOQ(OFFSET + LDEVICE));                     <<04830>>03158000
     DEV'CHECK:=FALSE;   << CONTINUE OCTAL PRINTING >>         <<04830>>03160000
     PRINT'INFO(9,IOQ(OFFSET+LINK));                           <<04830>>03162000
     PRINT'INFO(16,IOQ(OFFSET + UNIT));                        <<04830>>03164000
     PRINT'INFO(20,IOQ(OFFSET + PCB));                         <<04830>>03166000
     PRINT'INFO(24,IOQ(OFFSET + DST));                         <<04830>>03168000
     PRINT'INFO(31,IOQ(OFFSET + ADDR));                        <<04830>>03170000
     PRINT'INFO(38,IOQ(OFFSET + FUNC));                        <<04830>>03172000
     PRINT'INFO(42,IOQ(OFFSET + XFERCNT));                     <<04830>>03174000
     PRINT'INFO(49,IOQ(OFFSET + FLAGS));                       <<04830>>03176000
     PRINT'INFO(56,IOQ(OFFSET + PARM1));                       <<04830>>03178000
     PRINT'INFO(62,IOQ(OFFSET + PARM2));                       <<04830>>03180000
     PRINT'INFO(69,IOQ(OFFSET + MISC));                        <<04830>>03182000
     PRINT(PRINT'DATA,-79,%40);                                <<04830>>03184000
     MOVE PRINT'DATA:=80(" ");                                 <<04830>>03186000
     MOVE PRINT'DATA(9):="=";                                  <<04830>>03188000
     PRINT'INFO(10,REL'INDEX);                                 <<04830>>03190000
     MOVE PRINT'DATA(15):=":QUE RELATIVE INDEX.";              <<04830>>03192000
     MOVE PRINT'DATA(37):="STATUS OF THE ABOVE EQUALS ";       <<04830>>03194000
     PRINT'INFO(64,IOQ(OFFSET + STAT));                        <<04830>>03196000
     MOVE PRINT'DATA(65):=".";                                 <<04830>>03198000
     PRINT'INFO(66,IOQ(OFFSET + STAT));                        <<04830>>03200000
     PRINT(PRINT'DATA,-79,%40);                                <<04830>>03202000
   END;    << OF IF >>                                         <<04830>>03204000
END;     << OF FORMAT'IOQ >>                                   <<04830>>03206000
                                                               <<04830>>03208000
                                                               <<04830>>03210000
$PAGE                                                                   03212000
                                                                        03214000
PROCEDURE GETINPUT(PL, CMND);                                           03216000
  VALUE PL, CMND;    INTEGER PL;    LOGICAL CMND;                       03218000
  <<                                                                    03220000
    THIS ROUTINE GETS A COMMAND FROM $STDIN (SOURCE=0), THE STORED      03222000
    PROGRAM AREA (SOURCE=1) OR THE DO FILE (SOURCE=2). IT ALSO STRIPS   03224000
    LEADING AND TRAILING BLANKS FROM THE COMMAND.                       03226000
  >>                                                                    03228000
  BEGIN                                                                 03230000
  L := MORE;                                                            03232000
  IF <> THEN   << GET MORE OF MULTIPLE COMMAND LINE >>                  03234000
    BEGIN   MOVE BM := SAVE(1),(L);   MORE := 0;    L := L - 1;   END   03236000
  ELSE CASE SOURCE OF BEGIN                                             03238000
    BEGIN     << OUTPUT PROMPT AND READ FROM INPUT DEVICE >>            03240000
    IF CMND THEN FCONTROL(IN, 16, T);   << DISABLE CONTROL Y >>         03242000
    IF EFLAG THEN RETURN;  << CY OCCURED WHILE WAITING TO DISABLE >>    03244000
    PRINT'( pa, PL, %320 );                                             03246000
    L := READX( M, -72 );                                      <<00924>>03248000
    IF <> THEN << :EOD,:EOF: READ >>                           <<00924>>03250000
      NOMORE := EFLAG := TRUE;                                 <<00924>>03252000
    IF NOT DUP THEN PRINT'(M,-L,0);  << DUPLICATE INPUT >>              03254000
    FCONTROL(IN, 17, T);   << ENABLE CONTROL Y >>                       03256000
    IF EFLAG THEN  << EOD/NO LENGTH ABORT >>                   <<00924>>03258000
      BEGIN PRINTE(M18W,13); RETURN; END;                      <<00924>>03260000
    STRIPBLANKS;                                                        03262000
    END;                                                                03264000
                                                                        03266000
    DO BEGIN      << GET COMMAND FROM STORED PROGRAM >>                 03268000
    IF PC=PROGEND THEN BEGIN    << END OF PROGRAM >>                    03270000
      PC := 0;    << RESET PROGRAM FETCH POINTER >>                     03272000
      PROGRUN := PROGRUN - 1;                                           03274000
      IF < THEN SFLAG := TRUE;     << END OF PROGRAM RUNS >>            03276000
      END                                                               03278000
    ELSE BEGIN                                                          03280000
      LASTLINE := PROG(PC);                                             03282000
      L := PROG(PC+1);  << STATEMENT LENGTH >>                          03284000
      MOVE BM := BPROG((PC+2)&LSL(1)),(L);                              03286000
      STEP'PC(PC);    << STEP TO NEXT STATEMENT >>                      03288000
      STRIPBLANKS;                                                      03290000
      IF SHOW<>0 THEN  << PRINT PROMPT AND PROGRAM STATEMENT >>         03292000
        BEGIN   PRINT'(pa, PL, %320);   PRINT'(M, -L, 0);   END;        03294000
      END;                                                              03296000
    END UNTIL SFLAG OR L<>0;                                            03298000
                                                                        03300000
    BEGIN      << GET COMMAND DO FILE >>                                03302000
    L := FREAD(DF, M, -80);                                             03304000
    IF = THEN                                                           03306000
      BEGIN                                                             03308000
      IF L>72 THEN   << SAVE LINE NUMBER >>                             03310000
        BEGIN   MOVE LINENO(4) := BM(72),(8);   L := 72;   END          03312000
      ELSE LINENO(4) := " ";  << NO LINE NUMBER >>                      03314000
      STRIPBLANKS;                                                      03316000
      IF SHOW<>0 THEN  << PRINT PROMPT AND PROGRAM STATEMENT >>         03318000
        BEGIN   PRINT'(PA, PL, %320);   PRINT'(M, -L, 0);   END;        03320000
      END                                                               03322000
    ELSE SFLAG := TRUE;                                                 03324000
    END;                                                                03326000
    END;   << SOURCE CASE >>                                            03328000
                                                                        03330000
  I := 0;                                                               03332000
  IF CMND AND NOT ("0"<=CHAR<="9") AND CHAR<>"%" THEN                   03334000
    WHILE I<L DO BEGIN  << LOOK FOR MULTIPLE COMMANDS >>                03336000
      IF INTEGER(BM(I))=QUOTE THEN BEGIN  << SCAN OFF QUOTED STRING >>  03338000
        J := I + 1;  << STEP OVER LEADING QUOTE >>                      03340000
        WHILE J<L AND INTEGER(BM(J))<>QUOTE DO J := J + 1;              03342000
        IF J<L THEN I := J;   << STEP OVER QUOTED STRING >>             03344000
        END;                                                            03346000
                                                                        03348000
      IF BM(I)="<<" THEN BEGIN    << SCAN OVER COMMENT >>               03350000
        J := I + 2;   << STEP OVER COMMENT DELIMITER >>                 03352000
        WHILE J<L AND BM(J)<>">>" DO J := J + 1;                        03354000
        IF J<L THEN I := J;   << STEP OVER COMMENT >>                   03356000
        END;                                                            03358000
                                                                        03360000
      IF INTEGER(BM(I))=";" THEN BEGIN  << MULTIPLE COMMANDS >>         03362000
        MORE := L - I;   << SET LENGTH OF REMAINING COMMAND >>          03364000
        MOVE SAVE := BM(I),(MORE);   << SAVE REMAINING COMMANDS >>      03366000
        L := I;          << NEW LENGTH AND TERMINATE SCAN >>            03368000
        END                                                             03370000
      ELSE I := I + 1;   << STEP TO NEXT CHARACTER >>                   03372000
      END;                                                              03374000
  STRIPBLANKS;                                                          03376000
  END;    << GET INPUT >>                                               03378000
  COMMENT                                                      <<04830>>03380000
    PROCEDURE CORE LOADS FROM A 2 WORD LOCATION CONSISTING OF  <<04830>>03382000
    BANK AND OFFSET AND RETURNS THE LOADED WORD AS THE FUNCTION<<04830>>03384000
    VALUE OF CORE;                                             <<04830>>03386000
                                                               <<04830>>03388000
  LOGICAL PROCEDURE CORE(LOCATION);                            <<04830>>03390000
    VALUE LOCATION;                                            <<04830>>03392000
    DOUBLE LOCATION;                                           <<04830>>03394000
      BEGIN                                                    <<04830>>03396000
      TOS := LOCATION;           << PUT ADDRESS  ON TOS >>     <<04830>>03398000
      ASSEMBLE(LSEA;DELB,DELB); << LOAD, DEL BANK AND OFFSET >><<04830>>03400000
      CORE := TOS;                                             <<04830>>03402000
      END;                                                     <<04830>>03404000
                                                               <<04830>>03406000
                                                               <<04830>>03408000
                                                               <<04830>>03410000
                                                               <<04830>>03412000
                                                               <<04830>>03414000
                                                               <<04830>>03416000
                                                               <<04830>>03418000
                                                               <<04830>>03420000
  LOGICAL PROCEDURE SNAPSHOT(LOCATION,LENGTH);                 <<04830>>03422000
    VALUE LOCATION,LENGTH;                                     <<04830>>03424000
    DOUBLE LOCATION;                                           <<04830>>03426000
    INTEGER LENGTH;                                            <<04830>>03428000
  <<Procedure SNAPSHOT takes a picture of the IOQ or the DRQ,>><<04830>>03430000
  <<stores it in a data seg to be recalled later for display>> <<04830>>03432000
  <<LOCATION contains the location of the table to access.>>   <<04830>>03434000
  <<LENGTH passes the size of the data segment. SNAPSHOT>>     <<04830>>03436000
  <<returns the extra data segment number. >>                  <<04830>>03438000
    BEGIN                                                      <<04830>>03440000
      EQUATE MAX'XDS'SIZE'ADR = %1111;                         <<04830>>03442000
      EQUATE MEASINFOTABPTR = %1261;                           <<04830>>03444000
      LOGICAL ARRAY DUMMYBUF(0:15);                            <<04830>>03446000
      LOGICAL MAX'XDS'SIZE,DSTNO,RESIDENT:=FALSE;              <<04830>>03448000
      MAX'XDS'SIZE := ABSOLUTE(MAX'XDS'SIZE'ADR);              <<04830>>03450000
      ABSOLUTE(MAX'XDS'SIZE'ADR) := LENGTH + 128;              <<04830>>03452000
      SNAPSHOT := DSTNO := GETDATASEG(LENGTH,0);               <<04830>>03454000
      IF < THEN PRINT(LBUF,10,0);                              <<04830>>03456000
      ABSOLUTE(MAX'XDS'SIZE'ADR) := MAX'XDS'SIZE;              <<04830>>03458000
      WHILE NOT RESIDENT DO                                    <<04830>>03460000
        BEGIN                                                  <<04830>>03462000
        TOS := @DUMMYBUF;                                      <<04830>>03464000
        TOS := DSTNO;  <<DATA SEGMENT OF TABLE SPECIFIED>>     <<04830>>03466000
        TOS := 0;   << OFFSET >>                               <<04830>>03468000
        TOS := 2;                                              <<04830>>03470000
        ASSEMBLE(MFDS 4);                                      <<04830>>03472000
        DISABLE;                                               <<04830>>03474000
        IF ABSOLUTE(DSTNO*4 +ABSOLUTE(2) ).(0:1)=1             <<04830>>03476000
          THEN ENABLE                                          <<04830>>03478000
          ELSE                                                 <<04830>>03480000
            BEGIN                                              <<04830>>03482000
            TOS := ABSOLUTE(DSTNO*4 + ABSOLUTE(2) + 2);        <<04830>>03484000
            TOS := ABSOLUTE(DSTNO*4 + ABSOLUTE(2) + 3);        <<04830>>03486000
            TOS := LOCATION;                                   <<04830>>03488000
            TOS := LENGTH;                                     <<04830>>03490000
            ASSEMBLE(MABS 5);                                  <<04830>>03492000
            RESIDENT := TRUE;                                  <<04830>>03494000
            MSTART:=CORE(DOUBLE(CORE(MEASINFOTABPTR D))        <<04830>>03496000
                    +%1100D);                                  <<04830>>03498000
            ENABLE;                                            <<04830>>03500000
            END; << ELSE >>                                    <<04830>>03502000
        END;  << WHILE >>                                      <<04830>>03504000
                                                               <<04830>>03506000
    END;   << SNAPSHOT >>                                      <<04830>>03508000
                                                               <<04830>>03510000
                                                               <<04830>>03512000
PROCEDURE PRINTMON;                                            <<04830>>03514000
  BEGIN                                                        <<04830>>03516000
    DOUBLE MONPTR:=%1017D,LOCMON,CLOC,ENDMON,STMON:=%1260D;    <<04830>>03518000
      LOGICAL  MSIZE;                                          <<04830>>03520000
      LOGICAL WORK1,WORK2,MFDSWORD,MONDST;                     <<04830>>03522000
   EQUATE MEASINFOTABPTR = %1261;                              <<04830>>03524000
                                                               <<04830>>03526000
LOGICAL SUBROUTINE MON(CORELOC);                               <<04830>>03528000
  VALUE CORELOC;                                               <<04830>>03530000
  DOUBLE CORELOC;                                              <<04830>>03532000
    BEGIN                                                      <<04830>>03534000
    TOS := LOGICAL(CORELOC-LOCMON);                            <<04830>>03536000
    TOS := 1;   << MOVE COUNT >>                               <<04830>>03538000
    TOS := @MFDSWORD;                                          <<04830>>03540000
    TOS := MONDST;                                             <<04830>>03542000
    ASSEMBLE( DXCH );  << SWITCH SEGMENT OFFSET AND LENGTH>>   <<04830>>03544000
                       <<WITH PREVIOUS TWO WORDS >>            <<04830>>03546000
    ASSEMBLE(MFDS4);                                           <<04830>>03548000
    MON := MFDSWORD;                                           <<04830>>03550000
    END;                                                       <<04830>>03552000
                                                               <<04830>>03554000
SUBROUTINE EVENT(ENUMB);                                       <<04830>>03556000
  VALUE ENUMB;                                                 <<04830>>03558000
  INTEGER ENUMB;                                               <<04830>>03560000
  BEGIN                                                        <<04830>>03562000
      MOVE BYTENUM := "          ";                            <<04830>>03564000
      IF 0<=ENUMB<=8 THEN                                      <<04830>>03566000
      CASE ENUMB OF                                            <<04830>>03568000
      BEGIN   << CASES >>                                      <<04830>>03570000
                                                               <<04830>>03572000
         BEGIN     <<0>>                                       <<04830>>03574000
            MOVE BYTENUM:="QONSEG";                            <<04830>>03576000
         END;                                                  <<04830>>03578000
         BEGIN     <<1>>                                       <<04830>>03580000
            MOVE BYTENUM:="MAKEOC";                            <<04830>>03582000
         END;                                                  <<04830>>03584000
         BEGIN     <<2>>                                       <<04830>>03586000
            MOVE BYTENUM:="SPECIALRQ";                         <<04830>>03588000
         END;                                                  <<04830>>03590000
         BEGIN     <<3>>                                       <<04830>>03592000
            GO TO PNUMB;                                       <<04830>>03594000
         END;                                                  <<04830>>03596000
         BEGIN     <<4>>                                       <<04830>>03598000
            MOVE BYTENUM:="FETCHSEG";                          <<04830>>03600000
         END;                                                  <<04830>>03602000
         BEGIN     <<5>>                                       <<04830>>03604000
            MOVE BYTENUM:="SEGIO";                             <<04830>>03606000
         END;                                                  <<04830>>03608000
         BEGIN     <<6>>                                       <<04830>>03610000
            MOVE BYTENUM:="SIODONE";                           <<04830>>03612000
         END;                                                  <<04830>>03614000
         BEGIN;    <<7>>                                       <<04830>>03616000
            MOVE BYTENUM:="CGARBAGE";                          <<04830>>03618000
         END;                                                  <<04830>>03620000
         BEGIN     <<8>>                                       <<04830>>03622000
            MOVE BYTENUM:="SWAPIN";                            <<04830>>03624000
         END;                                                  <<04830>>03626000
      END                                                      <<04830>>03628000
      ELSE IF ENUMB=12 THEN MOVE BYTENUM:="ALLOCMEM"           <<04830>>03630000
      ELSE IF ENUMB=13 THEN MOVE BYTENUM:="DEALLOCM"           <<04830>>03632000
      ELSE IF ENUMB=24 THEN MOVE BYTENUM:="EXCHDB"             <<04830>>03634000
      ELSE IF ENUMB=40 THEN MOVE BYTENUM:="QUIESCE"            <<04830>>03636000
      ELSE IF ENUMB=%300 THEN MOVE BYTENUM:="INTERRUPT"        <<04830>>03638000
      ELSE IF ENUMB=%301 THEN MOVE BYTENUM:="SIOP-INST"        <<04830>>03640000
      ELSE IF ENUMB=%302 THEN MOVE BYTENUM:="SIODM-ENT"        <<04830>>03642000
      ELSE IF ENUMB=%303 THEN MOVE BYTENUM:="SIODM-EXT"        <<04830>>03644000
      ELSE                                                     <<04830>>03646000
PNUMB:                                                         <<04830>>03648000
        IF BYTENUM="  " THEN                                   <<04830>>03650000
         BEGIN        <<PUT OUT NUMBER ONLY>>                  <<04830>>03652000
         PRINT(LBYTENUM,-ASCII(ENUMB,8,BYTENUM)-1,%320);       <<04830>>03654000
         END;         <<PUT OUT NUMBER ONLY>>                  <<04830>>03656000
      IF BYTENUM<>"    " THEN PRINT(LBYTENUM,-10,%320);        <<04830>>03658000
 END;  <<EVENT SUBROUTINE>>                                    <<04830>>03660000
                                                               <<04830>>03662000
                                                               <<04830>>03664000
<<MOVE DBUFFER(23):="******    MONITOR TABLE    ******"; >>    <<04830>>03666000
<<PRINTLINE;    >>                                             <<04830>>03668000
<<SKIPLINES(3);   >>                                           <<04830>>03670000
   LOCMON:=DOUBLE(CORE(MONPTR)+%1000);                         <<04830>>03672000
  MSIZE:=CORE(LOCMON-1D);                                      <<04830>>03674000
  IF MSIZE < 4 THEN MSIZE:=8192;                               <<04830>>03676000
  IF MSIZE > 8192 THEN MSIZE:=8192;                            <<04830>>03678000
  MONDST := SNAPSHOT(LOCMON,MSIZE);                            <<04830>>03680000
  ENDMON:=LOCMON+DOUBLE(MSIZE);                                <<04830>>03682000
   << MSTART IS SET IN SNAPSHOT WHILE DISABLED >>              <<04830>>03684000
   IF (MSTART:=MSTART-4)<4 THEN MSTART:=CORE(LOCMON-1D)-4;     <<04830>>03686000
  IF MSTART>(MSIZE-4) THEN GO BAILOUT;                         <<04830>>03688000
  MOVE LBUF:="LOC   PIN    EVENT";                             <<04830>>03690000
  MOVE LBUF(18):="                         PIN  EVENT ";       <<04830>>03692000
  PRINT(LBUF,-78,0);                                           <<04830>>03694000
   CLOC:=DOUBLE(MSTART)+LOCMON;                                <<04830>>03696000
  IF CLOC < 1D THEN GO BAILOUT;                                <<04830>>03698000
  WHILE MSIZE > 4 DO                                           <<04830>>03700000
  BEGIN                                                        <<04830>>03702000
    MOVE BYTENUM := "             ";                           <<04830>>03704000
   PRINT(LBYTENUM(6),0*DASCII(CLOC,8,BYTENUM)-6,%320);         <<04830>>03706000
    WORK2:=0;            <<COLUMN COUNTER>>                    <<04830>>03708000
    WHILE MSIZE > 0 LAND WORK2 < 2 DO                          <<04830>>03710000
     BEGIN               <<WHILE ROOM ACROSS PAGE>>            <<04830>>03712000
      WORK1:= MON(CLOC); <<PICK UP PIN AND EVENT>>             <<04830>>03714000
      MOVE BYTENUM := "          ";                            <<04830>>03716000
     PRINT(LBYTENUM(2),-5+0*ASCII(WORK1.(0:8),8,BYTENUM),%320);<<04830>>03718000
      EVENT(WORK1.(8:8));   <<EVENT>>                          <<04830>>03720000
      MOVE BYTENUM := "          ";                            <<04830>>03722000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+1D),8,BYTENUM),%320);  <<04830>>03724000
      MOVE BYTENUM := "          ";                            <<04830>>03726000
     PRINT(LBYTENUM,-7+0*ASCII(MON(CLOC+2D),8,BYTENUM),%320);  <<04830>>03728000
      MOVE BYTENUM := "          ";                            <<04830>>03730000
     PRINT(LBYTENUM,-8+0*ASCII(MON(CLOC+3D),8,BYTENUM),%320);  <<04830>>03732000
      CLOC:=CLOC-4D;        <<NEXT LOCATION>>                  <<04830>>03734000
      IF CLOC < LOCMON+4D                                      <<04830>>03736000
        THEN CLOC:=ENDMON-4D;  << TABLE WRAPS AROUND >>        <<04830>>03738000
      MSIZE:=MSIZE-4;       <<FOUR FEWER WORDS LEFT>>          <<04830>>03740000
      WORK2:=WORK2+1;       <<COUNT COLUMNS DONE>>             <<04830>>03742000
     END;                <<DONE ACROSS PAGE>>                  <<04830>>03744000
   PRINT(LBYTENUM,0,0);  <<PRINT FORMATTED LINE>>              <<04830>>03746000
  END;                                                         <<04830>>03748000
BAILOUT:                                                       <<04830>>03750000
IF MONDST <> 0 THEN RELDATASEG(MONDST);                        <<04830>>03752000
END;  <<  PROCEDURE PRINTMON  >>                               <<04830>>03754000
                                                               <<04830>>03756000
                                                               <<04830>>03758000
PROCEDURE PRINT'IOQ (TYPE'IOQ,DEV,DATASEG,HEADER'SIZE);        <<04830>>03760000
VALUE TYPE'IOQ,DEV,DATASEG,HEADER'SIZE;                        <<04830>>03762000
INTEGER TYPE'IOQ,DEV,DATASEG,HEADER'SIZE;                      <<04830>>03764000
<<Procedure PRINT'IOQ either prints the IOQ or the DRQ.>>      <<04830>>03766000
<<There are three types of each: the whole, free or active >>  <<04830>>03768000
<<list. TYPE'IOQ tells the type of either table wanted, DEV>>  <<04830>>03770000
<<holds the device specified, DATASEG and HEADER'SIZE holds >> <<04830>>03772000
<<the values of the IOQ or the DRQ. PRINT'IOQ calls SNAP'SHOT>><<04830>>03774000
<<which returns the dataseg# that will be used in IOQ. >>      <<04830>>03776000
<<PRINT'IOQ checks TYPE'IOQ and according to what the value >> <<04830>>03778000
<<is,does the calculations so that FORMAT'IOQ can display it.>><<04830>>03780000
BEGIN                                                          <<04830>>03782000
  INTEGER LENGTH'IOQ, COUNT, SEARCHCOUNT, NO'FREE;             <<04830>>03784000
  DOUBLE  LOC'IOQ;                                             <<04830>>03786000
  LOGICAL FREE, IOQ'ENTRIES, IOQ'ENTRY'SIZE;                   <<04830>>03788000
  LOGICAL ARRAY FREE'LIST(0:250);                              <<04830>>03790000
  EQUATE DSTBANK=2, DSTOFFSET=3;                               <<04830>>03792000
  DEFINE DSTBASE=ABSOLUTE(2)#;                                 <<04830>>03794000
  TOS:=ABSOLUTE(DSTBASE+DATASEG *4+DSTBANK); <<ENTER IOQ'DST>> <<04830>>03796000
  TOS:=ABSOLUTE(DSTBASE + DATASEG *4 + DSTOFFSET);             <<04830>>03798000
  LOC'IOQ:=TOS;                                                <<04830>>03800000
  LENGTH'IOQ:=ABSOLUTE(DSTBASE + DATASEG *4 + 0).(3:13)*4;     <<04830>>03802000
  SNAPSHOT'DST:=SNAPSHOT(LOC'IOQ,LENGTH'IOQ);                  <<04830>>03804000
  IOQ'ENTRY'SIZE:=IOQ( ENTRY'SIZE);                            <<04830>>03806000
  IOQ'ENTRIES:=IOQ(TOTAL'ENTRIES);                             <<04830>>03808000
            <<FREEZE IOQ AND COPY>>                            <<04830>>03810000
  COUNT:=0;                                                    <<04830>>03812000
  IF TYPE'IOQ = 0 THEN  <<PRINT WHOLE IOQ>>                    <<04830>>03814000
   DO                                                          <<04830>>03816000
     BEGIN                                                     <<04830>>03818000
       IOQ'POINTER:=INTEGER(IOQ'ENTRY'SIZE)   <<NEXT ENTRY>>   <<04830>>03820000
       *COUNT + HEADER'SIZE;                                   <<04830>>03822000
       FORMAT'IOQ(DEV,IOQ'POINTER,DATASEG);                    <<04830>>03824000
       COUNT:=COUNT+1;                                         <<04830>>03826000
     END                                                       <<04830>>03828000
   UNTIL COUNT>=INTEGER(IOQ'ENTRIES)                           <<04830>>03830000
  ELSE                                                         <<04830>>03832000
  BEGIN                                                        <<04830>>03834000
        <<FREE OR ACTIVE LIST>>                                <<04830>>03836000
  IF (TYPE'IOQ = 1) OR (TYPE'IOQ = 2) THEN                     <<04830>>03838000
     BEGIN                                                     <<04830>>03840000
       IOQ'POINTER:=IOQ(FREE'INDEX);   <<INDEX TO FIRST FREE>> <<04830>>03842000
       DO                                                      <<04830>>03844000
         BEGIN                                                 <<04830>>03846000
           FREE'LIST(COUNT):=IOQ'POINTER; <<STORE FREE IOQ'S>> <<04830>>03848000
           IF TYPE'IOQ=1 THEN                                  <<04830>>03850000
              FORMAT'IOQ(DEV,IOQ'POINTER,DATASEG);             <<04830>>03852000
           COUNT:=COUNT+1;    <<KEEP COUNT OF FREE IOQ'S>>     <<04830>>03854000
           IOQ'POINTER:=IOQ(IOQ'POINTER + LINK); <<NEXT FREE>> <<04830>>03856000
           NO'FREE := COUNT;                                   <<04830>>03858000
         END    <<OF DO>>                                      <<04830>>03860000
       UNTIL COUNT>=INTEGER(IOQ'ENTRIES) OR IOQ'POINTER=0;     <<04830>>03862000
      END;                                                     <<04830>>03864000
  IF TYPE'IOQ = 2 THEN   <<PRINT ACTIVE LIST>>                 <<04830>>03866000
     BEGIN                                                     <<04830>>03868000
       COUNT:=0;                                               <<04830>>03870000
       WHILE COUNT<INTEGER(IOQ'ENTRIES)  DO                    <<04830>>03872000
          BEGIN                                                <<04830>>03874000
            SEARCHCOUNT:=0;                                    <<04830>>03876000
            FREE:=FALSE; <<IF FREE WILL EXIT AND NOT PRINT>>   <<04830>>03878000
            WHILE (SEARCHCOUNT<NO'FREE)  AND NOT FREE DO       <<04830>>03880000
            <<COMPARE ENTRIES IN WHOLE LIST W/ FREE LIST >>    <<04830>>03882000
               BEGIN                                           <<04830>>03884000
                 IF INTEGER(IOQ'ENTRY'SIZE)                    <<04830>>03886000
                 *COUNT+HEADER'SIZE=                           <<04830>>03888000
                 INTEGER(FREE'LIST(SEARCHCOUNT)) THEN          <<04830>>03890000
                    FREE := TRUE;                              <<04830>>03892000
                 << USED TO SEARCH FREE LIST>>                 <<04830>>03894000
                 SEARCHCOUNT:=SEARCHCOUNT + 1;                 <<04830>>03896000
               END;                                            <<04830>>03898000
            IF NOT FREE THEN    << IN USE  >>                  <<04830>>03900000
              BEGIN                                            <<04830>>03902000
               IOQ'POINTER:=INTEGER(IOQ'ENTRY'SIZE)            <<04830>>03904000
               *COUNT+HEADER'SIZE;                             <<04830>>03906000
               FORMAT'IOQ(DEV, IOQ'POINTER,DATASEG);           <<04830>>03908000
              END;                                             <<04830>>03910000
            COUNT:=COUNT+1;     <<GO THROUGH ALL ENTRIES>>     <<04830>>03912000
          END; <<OF WHILE>>                                    <<04830>>03914000
     END;                                                      <<04830>>03916000
   END;   << OF ELSE >>                                        <<04830>>03918000
END;      << OF PRINT'IOQ >>                                   <<04830>>03920000
                                                                        03922000
PROCEDURE CHECKIOPENDING( FLGX );                                       03924000
  VALUE FLGX;  LOGICAL FLGX;                                            03926000
  <<                                                                    03928000
    CHECKS IF ANY I/O PENDING, RETURNS IOQS AND PRINTS STATUS IF        03930000
    ANY ERROR AND FLGX SET AND IF ANY I/O PENDING AND FLGX.(14:1)       03932000
    SET THEN PRINTS I/O PENDING MESSAGE.                                03934000
                                                                        03936000
    FLGX.(14:1) - ENABLE PRINTING OF I/O PENDING MESSAGE                03938000
        .(15:1) - ENABLE PRINTING OF ERROR STATUS                       03940000
  >>                                                                    03942000
  BEGIN                                                                 03944000
    K := 0;                                                             03946000
                                                                        03948000
    WHILE K<IOPCNT DO  << CHECK FOR I/O PENDING >>                      03950000
     IF IOQX(K)<>0 THEN                                                 03952000
      BEGIN                                                             03954000
        TOS := IOSTATUS(IOQX(K));                                       03956000
        XLOG := TOS;    STATUS := TOS;                                  03958000
                                                                        03960000
        IF <> THEN  << NOT DONE YET >>                                  03962000
          BEGIN                                                         03964000
            IF < THEN   << IOQX IS BAD OR SOME ERROR >>                 03966000
              BEGIN                                                     03968000
                PRINTX(M21W, 7);  << IOSTATUS ERROR >>                  03970000
                IOQX(K) := IOQX(IOPCNT);   << FILL HOLE >>              03972000
                IOPCNT := IOPCNT - 1;    << DECREMENT PENDING COUNT >>  03974000
              END;                                                      03976000
                                                                        03978000
            K := K + 1;      << STEP TO NEXT >>                         03980000
            STATUS := XLOG := 0;   << CLEAR RETURNS >>                  03982000
          END                                                           03984000
        ELSE                                                            03986000
          BEGIN                                                         03988000
            IOPCNT := IOPCNT - 1;                                       03990000
            LASTLDEV := IOQTABLE(IOQX(K)+2).(8:8);                      03992000
            LASTFUNC := IOQTABLE(IOQX(K)+6).(8:8);                      03994000
            IOQX(K) := IOQX(IOPCNT);   << MOVE LAST TO HOLE >>          03996000
            IF FLGX AND STATUS.(13:3)<>1 THEN PRINTSTATUS;              03998000
          END;                                                          04000000
      END;                                                              04002000
                                                                        04004000
    IF IOPCNT<>0 AND FLGX.(14:1) THEN PRINTX(M3, -27); << I/O PENDING >>04006000
  END;   << CHECK IO PENDING >>                                         04008000
$PAGE                                                                   04010000
                                                                        04012000
LOGICAL PROCEDURE CONVERTPARAMS;                                        04014000
  <<                                                                    04016000
    THIS PROCEDURE CONVERTS 1 OR 2 PARAMETERS TO BINARY FROM OCTAL      04018000
    DECIMAL OR LITERALS IN QUOTES.   RESULTS ARE PLACED IN R AND R1     04020000
    AND THE FLAGS NOPARAM AND TWOPARAMS ARE SET DEPENDING ON THE        04022000
    PARAMETERS.   RETURNS TRUE IF A GOOD PARAMETER IS FOUND.            04024000
  >>                                                                    04026000
  BEGIN                                                                 04028000
    TWOPARAMS := NOPARAM := FALSE;                                      04030000
    R := 0;     R1 := 1;                                                04032000
                                                                        04034000
    IF I=L THEN NOPARAM := TRUE      << NO PARAMETERS >>                04036000
    ELSE IF INTEGER(BM)="A" THEN  << ASCII COMMAND >>                   04038000
      BEGIN   << PROCESS ASCII LITERAL PARAMETER >>                     04040000
        IF CHAR<>QUOTE THEN RETURN;   << NO STARTING QUOTE, ERROR >>    04042000
        I := I + 1;   << STEP OVER QUOTE >>                             04044000
        R1 := I;      << SAVE STRING BEGINNING POINTER >>               04046000
        WHILE CHAR<>QUOTE DO  << SCAN FOR ENDING QUOTE >>               04048000
          IF I<L THEN I := I + 1 ELSE RETURN;  << ERROR >>              04050000
        R := I - R1;  << SAVE LENGTH OF STRING >>                       04052000
        I := I + 1;   << STEP OVER ENDING QUOTE >>                      04054000
      END                                                               04056000
    ELSE IF M="DO" THEN CONVERTPARAMS := TRUE  << THE DO COMMAND >>     04058000
    ELSE     << PROCESS NUMERIC PARAMETER >>                            04060000
      BEGIN                                                             04062000
        R := EXPRESSION;                                                04064000
        IF <> THEN RETURN;   << ERROR >>                                04066000
        IF CHAR="," THEN   << LOOK FOR 2ND PARAMETER >>                 04068000
          BEGIN                                                         04070000
            I := I + 1;    << STEP OVER COMMA >>                        04072000
            R1 := EXPRESSION;                                           04074000
            IF <> THEN RETURN;   << ERROR >>                            04076000
            TWOPARAMS := TRUE;                                          04078000
          END                                                           04080000
        ELSE R1 := 1;   << DEFAULT 2ND PARAM >>                         04082000
      END;                                                              04084000
                                                                        04086000
    IF I=L THEN CONVERTPARAMS := TRUE;   << GOOD FORMAT >>              04088000
   END;    <<CONVERT PARAMS>>                                  <<04830>>04090000
                                                               <<04830>>04092000
                                                               <<04830>>04094000
PROCEDURE SETBIT(V,BITNO);                                     <<04830>>04096000
VALUE BITNO; LOGICAL V, BITNO;                                 <<04830>>04098000
<<Set the bit corresponding to the buffer'no being used>>      <<04830>>04100000
BEGIN                                                          <<04830>>04102000
    TOS:=V;                                                    <<04830>>04104000
    X:=BITNO;                                                  <<04830>>04106000
    ASSEMBLE(TSBC 0,X);                                        <<04830>>04108000
    V:=TOS;                                                    <<04830>>04110000
END;         <<OF SETBIT>>                                     <<04830>>04112000
                                                               <<04830>>04114000
                                                               <<04830>>04116000
                                                               <<04830>>04118000
INTEGER PROCEDURE FINDBIT(V);                                  <<04830>>04120000
LOGICAL V;                                                     <<04830>>04122000
<<Find the bit corresponding to the buffer'no being used>>     <<04830>>04124000
BEGIN                                                          <<04830>>04126000
    TOS:=V;                                                    <<04830>>04128000
    ASSEMBLE(SCAN);                                            <<04830>>04130000
    FINDBIT:=X;                                                <<04830>>04132000
END;    <<OF FINDBIT>>                                         <<04830>>04134000
                                                               <<04830>>04136000
                                                               <<04830>>04138000
                                                               <<04830>>04140000
PROCEDURE UB(BUFFER'NO);                                       <<04830>>04142000
VALUE BUFFER'NO;                                               <<04830>>04144000
INTEGER BUFFER'NO;                                             <<04830>>04146000
<<Access BUFFER'NO specified. UB will make sure that the >>    <<04830>>04148000
<<buffer to be used is in range or whether the buffer is >>    <<04830>>04150000
<<already in use. UB will then get the extra data segment >>   <<04830>>04152000
<<to provide more space. >>                                    <<04830>>04154000
BEGIN                                                          <<04830>>04156000
    IF (0>BUFFER'NO) OR (BUFFER'NO>16) THEN                    <<04830>>04158000
      BEGIN     <<OUT OF RANGE>>                               <<04830>>04160000
        PRINTE(M32W,17);                                       <<04830>>04162000
        BUF'USED:=0;                                           <<04830>>04164000
        RETURN;                                                <<04830>>04166000
        END;                                                   <<04830>>04168000
    IF DSTARRAY(BUFFER'NO)<>0 OR BUFFER'NO=0 THEN              <<04830>>04170000
      BEGIN     <<EXTRA DATA SEGMENT ALREADY CREATED>>         <<04830>>04172000
          ACTVBUF:=0;    <<TURN OFF ALL BITS>>                 <<04830>>04174000
      END                                                      <<04830>>04176000
    ELSE                                                       <<04830>>04178000
      BEGIN                                                    <<04830>>04180000
          MAX'XDS'SIZE:=ABSOLUTE(MAX'XDS'SIZE'ADR);            <<04830>>04182000
          ABSOLUTE(MAX'XDS'SIZE'ADR):=XDS'SIZE;                <<04830>>04184000
          L:=GETDATASEG(XDS'SIZE,0);                           <<04830>>04186000
          IF < THEN PRINTE(M31W,10);                           <<04830>>04188000
          ACTVBUF:=0;                                          <<04830>>04190000
          DSTARRAY(BUFFER'NO):=L;     <<HOLDS DST #>>          <<04830>>04192000
          ABSOLUTE(MAX'XDS'SIZE'ADR):=MAX'XDS'SIZE;            <<04830>>04194000
      END;                                                     <<04830>>04196000
      IF BUFFER'NO <>0 THEN SETBIT(ACTVBUF,(BUFFER'NO-1));     <<04830>>04198000
END;  << OF UB >>                                              <<04830>>04200000
                                                               <<04830>>04202000
                                                               <<04830>>04204000
PROCEDURE FB(BUFFER'NO);                                       <<04830>>04206000
LOGICAL BUFFER'NO;                                             <<04830>>04208000
<<Release acquired BUFFER'NO. The buffer will be checked to >> <<04830>>04210000
<<see whether it's in range and whether a buffer which >>      <<04830>>04212000
<<is not in use is specified. Those buffers cannot be freed.>> <<04830>>04214000
BEGIN    <<OUT OF RANGE>>                                      <<04830>>04216000
    IF (0>BUFFER'NO) OR (BUFFER'NO>16) THEN                    <<04830>>04218000
      BEGIN                                                    <<04830>>04220000
        PRINTE(M32W,17);                                       <<04830>>04222000
        RETURN;                                                <<04830>>04224000
      END                                                      <<04830>>04226000
    ELSE IF BUFFER'NO=0 OR DSTARRAY(BUFFER'NO)=0 THEN          <<04830>>04228000
      BEGIN            <<INTERNAL BUF OR DOESN'T EXIST>>       <<04830>>04230000
          PRINTE(M39W,15);                                     <<04830>>04232000
          RETURN;                                              <<04830>>04234000
      END                                                      <<04830>>04236000
    ELSE                                                       <<04830>>04238000
      BEGIN                                                    <<04830>>04240000
        RELDATASEG(DSTARRAY(BUFFER'NO));                       <<04830>>04242000
        IF BUFFER'NO=LOGICAL(FINDBIT(ACTVBUF)+1) THEN          <<04830>>04244000
           BEGIN                                               <<04830>>04246000
             ACTVBUF:=0;      <<TURN OFF BITS>>                <<04830>>04248000
             BUF'USED:=0;  <<NOW USING INTERNAL BUFFER>>       <<04830>>04250000
           END;                                                <<04830>>04252000
        DSTARRAY(BUFFER'NO):=0;      <<SET TO ZERO>>           <<04830>>04254000
      END;                                                     <<04830>>04256000
END;      << OF FB>>                                           <<04830>>04258000
                                                               <<04830>>04260000
                                                               <<04830>>04262000
$PAGE "DOMAIN SUBROUTINES"                                              04264000
                                                                        04266000
PROCEDURE COMPARE(BUF1,BUF2);                                  <<04830>>04268000
LOGICAL BUF1,BUF2;                                             <<04830>>04270000
<<Compare two buffers, BUF1 and BUF2. Only extra data segs >>  <<04830>>04272000
<<can be compared. >>                                          <<04830>>04274000
BEGIN                                                          <<04830>>04276000
    INTEGER LOOPCOUNT:=-1,OFFSET:=0,BLOCK'WORDS:=128,          <<04830>>04278000
    WORDSLEFT, MOVE'COUNT,CMP'COUNT, BAD'BYTE;                 <<04830>>04280000
    DOUBLE FINDBYTE;                                           <<04830>>04282000
    WORDSLEFT:=C;     <<VALUE FROM COUNT COMMAND>>             <<04830>>04284000
    DO BEGIN                                                   <<04830>>04286000
           LOOPCOUNT:=LOOPCOUNT+1;                             <<04830>>04288000
           << ONLY 128 OR LESS AT ONCE >>                      <<04830>>04290000
           IF WORDSLEFT>BLOCK'WORDS THEN                       <<04830>>04292000
              MOVE'COUNT:=BLOCK'WORDS                          <<04830>>04294000
           ELSE                                                <<04830>>04296000
              MOVE'COUNT:=WORDSLEFT;                           <<04830>>04298000
           CMP'COUNT:=2*MOVE'COUNT; <<FOR BYTE COMPARISON>>    <<04830>>04300000
           TOS:=@COMPARE'BUF1;  << TARGET DB RELATIVE ADDR>>   <<04830>>04302000
           TOS:=DSTARRAY(BUF1);   <<SOURCE>>                   <<04830>>04304000
           TOS:=OFFSET;                                        <<04830>>04306000
           TOS:=MOVE'COUNT; <<NUMBER OF WORDS TO COMPARE>>     <<04830>>04308000
           ASSEMBLE(MFDS4);                                    <<04830>>04310000
           TOS:=@COMPARE'BUF2;                                 <<04830>>04312000
           TOS:=DSTARRAY(BUF2);                                <<04830>>04314000
           TOS:=OFFSET;                                        <<04830>>04316000
           TOS:=MOVE'COUNT;                                    <<04830>>04318000
           ASSEMBLE(MFDS4);                                    <<04830>>04320000
           OFFSET:=OFFSET+MOVE'COUNT;                          <<04830>>04322000
           WORDSLEFT:=WORDSLEFT-BLOCK'WORDS;                   <<04830>>04324000
       END                                                     <<04830>>04326000
    UNTIL (B'CMP'BUF1<>B'CMP'BUF2,(CMP'COUNT),3)               <<04830>>04328000
         OR (WORDSLEFT<=0);                                    <<04830>>04330000
    IF (B'CMP'BUF1<>B'CMP'BUF2,(CMP'COUNT),0) THEN             <<04830>>04332000
       BEGIN    <<PRINT BYTE THAT DOES NOT COMPARE>>           <<04830>>04334000
          BAD'BYTE:=TOS;                                       <<04830>>04336000
          DDEL;                                                <<04830>>04338000
          FINDBYTE:=DOUBLE(LOOPCOUNT)*DOUBLE(BLOCK'WORDS)*2D + <<04830>>04340000
          DOUBLE(CMP'COUNT) - DOUBLE(BAD'BYTE);                <<04830>>04342000
          PRINT(M34W,17,%320);                                 <<04830>>04344000
          NUMCHAR:=DASCII(FINDBYTE,10,BYTENUM);                <<04830>>04346000
          PRINT(LBYTENUM,-NUMCHAR,%320);                       <<04830>>04348000
          PRINT(M35W,-5,%320);                                 <<04830>>04350000
          NUMCHAR:=DASCII(FINDBYTE,8,BYTENUM);                 <<04830>>04352000
          PRINTE(BYTENUM,-11);                                 <<04830>>04354000
       END                                                     <<04830>>04356000
    ELSE                                                       <<04830>>04358000
       PRINT(M33W,9,%40);     <<BUFFERS ARE EQUAL>>            <<04830>>04360000
END;    << OF COMPARE >>                                       <<04830>>04362000
PROCEDURE DOMAIN;                                                       04364000
  <<                                                                    04366000
    THIS ROUTINE GETS A COMMAND, PARSES IT AND ENTERS IT IS THE STORED  04368000
    PROGRAM AREA OR EXECUTES IT IMMEDIATELY.                            04370000
  >>                                                                    04372000
BEGIN                                                                   04374000
  INTEGER TSOURCE, TFNL, TDF;                                           04376000
  BYTE ARRAY TFNAME(0:29);                                              04378000
  BYTE ARRAY TLINENO(0:11);                                             04380000
                                                                        04382000
SUBROUTINE PTEST( LOWER, UPPER );                                       04384000
  VALUE LOWER, UPPER;   INTEGER LOWER, UPPER;                           04386000
  <<                                                                    04388000
    THIS SUBROUTINE CHECKS THAT THE NUMBER OF PARAMERS IS WITHIN        04390000
    THE BOUNDS LOWER AND UPPER IF NOT AN INVALID PARAMER MESSAGE        04392000
    IS ISSUED.                                                          04394000
  >>                                                                    04396000
  BEGIN                                                                 04398000
  N :=0;     << HOLDS NUMBER OF PARAMETERS >>                           04400000
  IF NOT NOPARAM THEN N := N +1;                                        04402000
  IF TWOPARAMS THEN N := N + 1;                                         04404000
                                                                        04406000
  IF NOT ( LOWER<= N <=UPPER ) THEN  << INVALID NUMBER OF PARAMS >>     04408000
    BEGIN    PRINTE(M17W, 14);   EXITPROC;   END;                       04410000
  END;   << PTEST >>                                                    04412000
                                                                        04414000
SUBROUTINE SETPOINTERS( LDEV );                                         04416000
  VALUE LDEV;   INTEGER LDEV;                                           04418000
  <<                                                                    04420000
    SETS THE ABSOLUTE POINTERS DITP, IOQP, ILTP AND SIOP AND THE        04422000
    LENGTHS DITL AND SIOL. ALSO SETS THE DRT NUMBER INTO DX.            04424000
  >>                                                                    04426000
  BEGIN                                                                 04428000
  IF NOT (1<=LDEV<=LPDTP(0).(0:8)) OR LPDTP(LDEV*2)<=0 THEN             04430000
    BEGIN   PRINTE(M13W, 6);   EXITPROC;    END;  << INVALID LDEV >>    04432000
                                                                        04434000
  DITP := LPDTP(LDEV*2) + %1000;                                        04436000
                                                               <<03120>>04438000
  << Set flag if this is a DISC DIT >>                         <<03120>>04440000
  LDEV'IS'DISC := if ABS(DITP).(0:2) = 1 then                  <<03120>>04442000
                    true                                       <<03120>>04444000
                  else                                         <<03120>>04446000
                    false;                                     <<03120>>04448000
                                                               <<03120>>04450000
  IOQP := ABS(DITP+2) + %1000;                                          04452000
  X := ABS(X:=X+3) + %1000;   X := X + 7;  << X PTS DRT# >>    <<01366>>04454000
if DRTFLG = 0 then                                             <<03120>>04456000
  DX := ABS(X).(7:9);  << Fetch DRT >>                         <<03120>>04458000
  DRTP := DX*4;  << CALCULATE DRT ENTRY >>                     <<00924>>04460000
  SIOP := ABS(X:=X+1) + %1000;                                          04462000
  SIOL := (ABS(X:=X+4)&LSR(8))*2;  << LENGTH IS SIOL*2 >>      <<01366>>04464000
  DITL := ABS(ABS(DITP+4)+%1005).(0:8);                                 04466000
  END;    << SET POINTERS >>                                            04468000
                                                                        04470000
SUBROUTINE MOVEDATA;                                                    04472000
  <<                                                                    04474000
    THIS ROUTINE MOVES DATA TO OR FROM SYSTEM BUFFERS AND THE MAIN      04476000
    I/O BUFFER.                                                         04478000
  >>                                                                    04480000
  BEGIN                                                                 04482000
  T := SBUFX;   @BP := @B;                                              04484000
  TOS := XLOG;                                                          04486000
  N := (IF < THEN -(TOS&ASR(1)) ELSE TOS) + @BP; << READ MOVE LIMIT >>  04488000
                                                                        04490000
  FOR J := 1 UNTIL R DO BEGIN   << MOVE FROM/TO EACH SYSTEM BUFFER >>   04492000
    X := T;       << SET STARTING ADDRESS OF SYSBUF >>                  04494000
    FOR K := 1 UNTIL 128 DO BEGIN    << MOVE EACH WORD >>               04496000
      IF F<>0 THEN SBUF(X) := BP  << WRITE WORD MOVE >>                 04498000
      ELSE IF @BP<N THEN BP := SBUF(X) ELSE K := 128;                   04500000
      @BP := @BP + 1;      X := X + 1;                                  04502000
      END;                                                              04504000
    T := SBUF(T-1);   << STEP TO NEXT SYSBUF >>                         04506000
    END;                                                                04508000
  END;   << MOVE DATA >>                                                04510000
                                                                        04512000
                                                                        04514000
                                                                        04516000
INTEGER SUBROUTINE SAVEIOQX;                                            04518000
  <<                                                                    04520000
    THIS ROUTINE SAVES THE IOQ INDEX FROM AN UNBLOCKED ATTACHIO CALL    04522000
    IN THE ARRAY IOQX. IT RETURNS THE LAST IOQX SAVED.                  04524000
  >>                                                                    04526000
  IF STATUS<>0 THEN BEGIN    << VALID IOQ INDEX >>                      04528000
    SAVEIOQX := IOQX(IOPCNT) := STATUS;                                 04530000
    IOPCNT := IOPCNT + 1;                                               04532000
    STATUS := XLOG := 0;                                                04534000
    END                                                                 04536000
  ELSE BEGIN        << NO IOQ AVAILABLE >>                              04538000
    MOVE BM := "NO IOQ'S AVAILABLE";                                    04540000
    PRINTE(M, 9);                                                       04542000
    EXITPROC;                                                           04544000
  END;   << SAVE IOQX >>                                                04546000
                                                                        04548000
                                                                        04550000
                                                                        04552000
SUBROUTINE MODIFYBUFFER( ADR );                                         04554000
  VALUE ADR;  INTEGER ADR;                                              04556000
  <<                                                                    04558000
    OUTPUTS WORD ADR OF BUFFER B OR AT ABSOLUTE ADDRESS ADR, GIVING IT  04560000
    THE ADDRESS ADR AND INPUTS A NEW WORD TO REPLACE IT. MODIFICATION   04562000
    MAY BE PREMATURELY TERMINATED WITH A NULL INPUT.                    04564000
  >>                                                                    04566000
  BEGIN                                                                 04568000
    DO BEGIN   << GET REPLACMENT WORD >>                                04570000
      MOVE BPA := "   ";                                                04572000
      IF BFLAG THEN BEGIN  ASCII(ADR, -10, BPA(3));  J := 4;  END       04574000
      ELSE BEGIN  ASCII(ADR, 8, BPA);  J := 6;  END;                    04576000
      MOVE BPA(J) := ": ";      J := J + 2;                             04578000
      ASCII(IF BFLAG THEN B(ADR) ELSE ABS(ADR), 8, BPA(J));             04580000
      MOVE BPA(J+6) := " := ";                                          04582000
      GETINPUT(-(J+10), FALSE);  << GET REPLACEMENT >>                  04584000
      IF L=0 OR EFLAG OR SFLAG THEN EXITPROC;                           04586000
      TWOPARAMS := 1;  << ALLOW ONLY ONE PARAMETER >>                   04588000
      R := EXPRESSION;  << GET REPLACEMENT >>                           04590000
      IF <> OR I<>L THEN PRINTX(M17W, 14)   << INVALID NUMBER >>        04592000
    END UNTIL =;   << GOOD REPLACEMENT FOUND >>                         04594000
    IF BFLAG THEN B(ADR) := R ELSE ABS(ADR) := R;                       04596000
  END;   << MODIFY BUFFER >>                                            04598000
                                                                        04600000
SUBROUTINE CHECKPARAMS( LIMIT );                                        04602000
  VALUE LIMIT;  INTEGER LIMIT;                                          04604000
  <<                                                                    04606000
    THIS SUBROUTINE CONVERTS R1 TO WORDS IF IF IT WAS A NEGATIVE BYTE   04608000
    COUNT AND CHECKS THAT R IS POSITIVE AND THAT R + R1 IS LESS         04610000
    THAN OR EQUAL TO LIMIT.                                             04612000
  >>                                                                    04614000
  BEGIN                                                                 04616000
    IF R1<0 THEN R1 := -(R1&ASR(1));                                    04618000
    IF NOT ( R1<=R+R1<=LIMIT ) THEN                                     04620000
      BEGIN   PRINTE(M15W, -17);   EXITPROC;  END;  << BAD PARAM >>     04622000
  END;   << CHECK PARAMS >>                                             04624000
                                                                        04626000
SUBROUTINE CHECKPROG(EPRINT);                                           04628000
  VALUE EPRINT;   LOGICAL EPRINT;                                       04630000
  <<                                                                    04632000
    IF NULL STORED PROGRAM PRINT ERROR WITH PRINTE OR PRINTX            04634000
  >>                                                                    04636000
  IF PROGEND=0 THEN BEGIN    << NO STORED PROGRAM >>                    04638000
    MOVE BM := "NO PROGRAM";                                            04640000
    IF EPRINT THEN PRINTE(M, 5) ELSE PRINTX(M, 5);                      04642000
    EXITPROC;                                                           04644000
    END;    << CHECK PROG >>                                            04646000
$PAGE "  DO MAIN "                                                      04648000
                                                                        04650000
    DO BEGIN                                                            04652000
    BFLAG := FALSE;       PA := "C?";                                   04654000
    GETINPUT(-2, TRUE);  << GET COMMAND >>                              04656000
    IF EFLAG OR SFLAG THEN RETURN;  << END OF LEVEL >>                  04658000
    IF L=0 AND NFLAG<>0 THEN   << NULL INPUT, CALL ATTACHIO ONCE >>     04660000
      BEGIN    M := CR;    BM := "E";    L := 1;    END;                04662000
    END UNTIL L<>0;                                                     04664000
                                                                        04666000
    <<**************************************************************>>  04668000
    <<                                                              >>  04670000
    <<  STATEMENT# ENCOUNTERED--EDIT PROGRAM AREA (#)               >>  04672000
    <<                                                              >>  04674000
    <<**************************************************************>>  04676000
                                                                        04678000
                                                                        04680000
    IF "0"<=CHAR<="9" OR X="%" THEN  << BEGINS WITH NUMBERIC >>         04682000
      BEGIN   << HAS A LINE NUMBER SO ENTER INTO PROGRAM AREA >>        04684000
      IF PROGFLAG THEN  << NO MODIFICATION ALLOWED >>                   04686000
        BEGIN   PRINTE(M4, 11);    RETURN;   END;                       04688000
      R := EXPRESSION;   << GET STATEMENT NUMBER >>                     04690000
      IF <> OR NOT (1<=R<=9999) THEN  << INVALID STMNT NUMBER >>        04692000
        BEGIN   PRINTE(M2, 12);   RETURN;   END;                        04694000
                                                                        04696000
      L := L - I;   << LENGTH OF STATEMENT >>                           04698000
      K := PROGEND + (L+5)/2;  << COULD BE NEW PROGEND >>               04700000
      J := 0;                                                           04702000
      WHILE J<PROGEND AND PROG(J)<R DO STEP'PC(J);                      04704000
      IF J<PROGEND AND PROG(J)=R THEN  << STATEMENT FOUND >>            04706000
        BEGIN   << DELETE CURRENT STATEMENT >>                          04708000
        R2 := (PROG(J+1)+5)/2; << LENGTH DELETED >>                     04710000
        K := K - R2;  << WILL BE NEW PROGEND >>                         04712000
        IF K<=PROGMAX THEN    << DELETE AND FILL UP HOLE >>             04714000
          BEGIN                                                         04716000
          PROGEND := PROGEND - R2;                                      04718000
          MOVE PROG(J) := PROG(J+R2),(PROGEND-J);                       04720000
          END;                                                          04722000
        END;                                                            04724000
                                                                        04726000
      IF L>0 THEN BEGIN    << ENTER STATEMENT IN PROGRAM AREA >>        04728000
        IF K>PROGMAX THEN                                               04730000
          BEGIN    << STATEMENT WONT FIT >>                             04732000
          MOVE M := "PROGRAM AREA FULL";                                04734000
          PRINTE(M, -17);        RETURN;                                04736000
          END;                                                          04738000
                                                                        04740000
        T := J-PROGEND;  << NEGATIVE LENGTH TO MOVE >>                  04742000
        IF < THEN MOVE PROG(K-1) := PROG(PROGEND-1),(T);                04744000
        PROG(J) := R;    PROG(J+1) := L;                                04746000
        MOVE BPROG((J+2)&LSL(1)) := BM(I),(L);                          04748000
        PROGEND := K;                                                   04750000
        END;                                                            04752000
      RETURN;   << PROGRAM STATEMENT PROCESSED >>                       04754000
      END;                                                              04756000
                                                                        04758000
    MOVE BM := BM WHILE AS, 1;                                          04760000
    I := TOS - @BM;    << STEP OVER COMMAND >>                          04762000
    T := BM;     CHAR;                                                  04764000
                                                                        04766000
    <<**************************************************************>>  04768000
    <<                                                              >>  04770000
    <<  ALLOW EXECUTION OF AN MPE COMMAND (MPE CMD)                 >>  04772000
    <<                                                              >>  04774000
    <<**************************************************************>>  04776000
                                                                        04778000
    COMMAND(BM, R, R);                                                  04780000
    IF = THEN RETURN;;   << MPE COMMAND EXECUTED >>                     04782000
                                                                        04784000
    <<**************************************************************>>  04786000
    <<                                                              >>  04788000
    <<  RUN OR ACTIVATE A PROCESS (RUN)                             >>  04790000
    <<                                                              >>  04792000
    <<**************************************************************>>  04794000
                                                                        04796000
    IF BM="RUN" THEN  << TRY TO RUN A PROGRAM >>                        04798000
      BEGIN                                                             04800000
      XSYSTRAP(@SYSTRAP, T);                                            04802000
      BM(L) := " ";   CREATE(BM(I), , R, , 1);                          04804000
      IF = THEN ACTIVATE(R, 3);                                         04806000
      IF <> THEN  << SOME KIND OF TROUBLE >>                            04808000
        BEGIN  MOVE M := "RUN ERROR";  PRINTE(M, -9);  END;             04810000
      XCONTRAP(@CY, T);                                                 04812000
      RETURN;                                                           04814000
      END;                                                              04816000
                                                                        04818000
    IF CHAR="=" THEN  << STEP OVER EQUAL >>                             04820000
      BEGIN I := I + 1;   IF I=L THEN I := -1;    END;                  04822000
    IF I<0 OR NOT CONVERTPARAMS THEN    << INVALID PARAMETER >>         04824000
      BEGIN  PRINTE(M15W, -17);   RETURN;   END;                        04826000
                                                                        04828000
    <<**************************************************************>>  04830000
    <<                                                              >>  04832000
    <<  LIST COMMANDS WITH EXPLANATIONS (X)                         >>  04834000
    <<                                                              >>  04836000
    <<**************************************************************>>  04838000
                                                                        04840000
    IF T="X" THEN BEGIN       << LIST COMMANDS >>                       04842000
      PRINT'(M25W, 36, 0 );    PRINT'(M26W, 27,%60);                    04844000
      IF D=0 THEN GO TO DEFAULT;  << DEFAULT MENU >>           <<01411>>04846000
      SETPOINTERS( D );                                        <<01366>>04848000
      <<MENU FOR SERIES33, ICF44 AND ICF55>>                   <<01407>>04850000
      IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND                <<01407>>04852000
         DEVTYPE(D) <> 16 THEN                                 <<01407>>04854000
      FOR I:=0 UNTIL 25 DO PRINT'(M12W(I*21),21,0)             <<04830>>04856000
      ELSE  << SERIES 2 & 3 MENU >>                            <<00924>>04858000
      DEFAULT:                                                 <<01411>>04860000
        FOR I:=0 UNTIL 27 DO PRINT'(M11W(I*21),21,0);          <<04830>>04862000
      PRINT'(M, 0, 0);       RETURN;                           <<00924>>04864000
      END;                                                              04866000
                                                               <<04830>>04868000
                                                               <<04830>>04870000
   <<***************************************************>>     <<04830>>04872000
   <<                                                   >>     <<04830>>04874000
   <<        DISPLAY MONITOR TABLE                      >>     <<04830>>04876000
   <<                                                   >>     <<04830>>04878000
   <<***************************************************>>     <<04830>>04880000
                                                               <<04830>>04882000
   IF BM="DMON" THEN BEGIN                                     <<04830>>04884000
       PRINTMON;                                               <<04830>>04886000
       RETURN;                                                 <<04830>>04888000
       END;                                                    <<04830>>04890000
                                                               <<04830>>04892000
                                                                        04894000
   <<***************************************************>>     <<04830>>04896000
   <<                                                   >>     <<04830>>04898000
   <<          ACQUIRE BUFFER SPECIFIED                 >>     <<04830>>04900000
   <<                                                   >>     <<04830>>04902000
   <<***************************************************>>     <<04830>>04904000
                                                               <<04830>>04906000
   IF M="UB" THEN BEGIN  <<USE BUFFER SPECIFIED>>              <<04830>>04908000
       BUF'USED:=R;                                            <<04830>>04910000
       UB(BUF'USED);                                           <<04830>>04912000
       RETURN;                                                 <<04830>>04914000
       END;                                                    <<04830>>04916000
                                                               <<04830>>04918000
   <<***************************************************>>     <<04830>>04920000
   <<                                                   >>     <<04830>>04922000
   <<          FREE BUFFER SPECIFIED                    >>     <<04830>>04924000
   <<                                                   >>     <<04830>>04926000
   <<***************************************************>>     <<04830>>04928000
                                                               <<04830>>04930000
   IF M="FB" THEN BEGIN  <<FREE BUFFER SPECIFIED>>             <<04830>>04932000
       FREE'BUF:=R;                                            <<04830>>04934000
       FB(FREE'BUF);                                           <<04830>>04936000
       RETURN;                                                 <<04830>>04938000
       END;                                                    <<04830>>04940000
                                                               <<04830>>04942000
                                                               <<04830>>04944000
   <<***************************************************>>     <<04830>>04946000
   <<                                                   >>     <<04830>>04948000
   <<           COMPARE TWO BUFFERS                     >>     <<04830>>04950000
   <<                                                   >>     <<04830>>04952000
   <<***************************************************>>     <<04830>>04954000
                                                               <<04830>>04956000
   IF BM="CMP" THEN BEGIN    <<COMPARE TWO BUFFERS>>           <<04830>>04958000
       EXISTS:=TRUE;  <<CHECKS IF BUFFERS ARE ALLOCATED>>      <<04830>>04960000
       BUFF'ONE:=R;                                            <<04830>>04962000
       BUFF'TWO:=R1;                                           <<04830>>04964000
       IF (BUFF'ONE<0) OR (BUFF'ONE>16)   OR                   <<04830>>04966000
          (BUFF'TWO<0) OR (BUFF'TWO>16) THEN                   <<04830>>04968000
              BEGIN       <<OUT OF RANGE>>                     <<04830>>04970000
                  PRINTE(M32W,17);                             <<04830>>04972000
                  RETURN;                                      <<04830>>04974000
              END;                                             <<04830>>04976000
       IF (BUFF'ONE=0) OR (BUFF'TWO=0) THEN                    <<04830>>04978000
          BEGIN                                                <<04830>>04980000
            PRINTE(M42W,-35);                                  <<04830>>04982000
            PRINTE(M43W,-25);                                  <<04830>>04984000
            RETURN;                                            <<04830>>04986000
          END                                                  <<04830>>04988000
       ELSE                                                    <<04830>>04990000
         BEGIN  <<IF DSTARRAY(index) =0 THEN A DATA SEG >>     <<04830>>04992000
              <<DOES NOT EXIST AND NO COMPARISON WILL BE DONE>><<04830>>04994000
                                                               <<04830>>04996000
            IF DSTARRAY(BUFF'ONE)=0 THEN                       <<04830>>04998000
               BEGIN                                           <<04830>>05000000
                   EXISTS:=FALSE;                              <<04830>>05002000
                   PRINTE(M40W,-36);                           <<04830>>05004000
               END;                                            <<04830>>05006000
            IF DSTARRAY(BUFF'TWO)=0 THEN                       <<04830>>05008000
               BEGIN                                           <<04830>>05010000
                   EXISTS:=FALSE;                              <<04830>>05012000
                   PRINTE(M41W,-37);                           <<04830>>05014000
               END;                                            <<04830>>05016000
         END;                                                  <<04830>>05018000
       IF EXISTS=FALSE THEN RETURN                             <<04830>>05020000
       ELSE                                                    <<04830>>05022000
          COMPARE(BUFF'ONE,BUFF'TWO);                          <<04830>>05024000
        RETURN;                                                <<04830>>05026000
        END;                                                   <<04830>>05028000
                                                               <<04830>>05030000
                                                               <<04830>>05032000
                                                               <<04830>>05034000
   <<***************************************************>>     <<04830>>05036000
   <<                                                   >>     <<04830>>05038000
   <<          DISPLAY WHOLE IOQ, FREELIST              >>     <<04830>>05040000
   <<                 OR IOQ'S IN USE                   >>     <<04830>>05042000
   <<***************************************************>>     <<04830>>05044000
   IF  BM="DIOQ" THEN BEGIN                                    <<04830>>05046000
       NUMCHAR:=ASCII(R1,10,DEV'NO);                           <<04830>>05048000
       MOVE PRINT'LINE:=80(" ");                               <<04830>>05050000
       CASE R OF      <<HEADING>>                              <<04830>>05052000
       BEGIN                                                   <<04830>>05054000
         BEGIN                                                 <<04830>>05056000
           MOVE PRINT'LINE(30):="ALL IOQ'S";                   <<04830>>05058000
           IF R1<>0 THEN                                       <<04830>>05060000
             BEGIN                                             <<04830>>05062000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>05064000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>05066000
             END;                                              <<04830>>05068000
            PRINT(PRINT'LINE,-79,%40);                         <<04830>>05070000
         END;                                                  <<04830>>05072000
         BEGIN                                                 <<04830>>05074000
           MOVE PRINT'LINE(29):="FREE IOQ'S";                  <<04830>>05076000
           IF R1<>0 THEN                                       <<04830>>05078000
             BEGIN                                             <<04830>>05080000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>05082000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>05084000
             END;                                              <<04830>>05086000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>05088000
         END;                                                  <<04830>>05090000
         BEGIN                                                 <<04830>>05092000
           MOVE PRINT'LINE(28):="IOQ'S IN USE";                <<04830>>05094000
           IF R1<>0 THEN                                       <<04830>>05096000
             BEGIN                                             <<04830>>05098000
               MOVE PRINT'LINE(41):="FOR LDEV";                <<04830>>05100000
               MOVE PRINT'LINE(50):=DEV'NO, (NUMCHAR);         <<04830>>05102000
             END;                                              <<04830>>05104000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>05106000
         END;                                                  <<04830>>05108000
       END;                                                    <<04830>>05110000
       HEADER;                                                 <<04830>>05112000
       PRINT'IOQ(R,R1,IOQDST,IOQ'HEADER'SIZE);                 <<04830>>05114000
       RELDATASEG(SNAPSHOT'DST);                               <<04830>>05116000
       RETURN;                                                 <<04830>>05118000
       END;                                                    <<04830>>05120000
                                                               <<04830>>05122000
                                                               <<04830>>05124000
                                                               <<04830>>05126000
                                                               <<04830>>05128000
   <<***************************************************>>     <<04830>>05130000
   <<                                                   >>     <<04830>>05132000
   <<          DISPLAY WHOLE DRQ, FREE DRQ'S            >>     <<04830>>05134000
   <<                OR DRQ'S IN USE                    >>     <<04830>>05136000
   <<***************************************************>>     <<04830>>05138000
                                                               <<04830>>05140000
   IF BM="DDRQ" THEN BEGIN                                     <<04830>>05142000
       NUMCHAR:=ASCII(R1,10,DEV'NO);                           <<04830>>05144000
       MOVE PRINT'LINE:=80(" ");                               <<04830>>05146000
       CASE R OF      <<HEADING>>                              <<04830>>05148000
       BEGIN                                                   <<04830>>05150000
         BEGIN                                                 <<04830>>05152000
           MOVE PRINT'LINE(30):="ALL DRQ'S";                   <<04830>>05154000
           IF R1<>0 THEN                                       <<04830>>05156000
             BEGIN                                             <<04830>>05158000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>05160000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>05162000
             END;                                              <<04830>>05164000
            PRINT(PRINT'LINE,-79,%40);                         <<04830>>05166000
         END;                                                  <<04830>>05168000
         BEGIN                                                 <<04830>>05170000
           MOVE PRINT'LINE(29):="FREE DRQ'S";                  <<04830>>05172000
           IF R1<>0 THEN                                       <<04830>>05174000
             BEGIN                                             <<04830>>05176000
               MOVE PRINT'LINE(40):="FOR LDEV";                <<04830>>05178000
               MOVE PRINT'LINE(49):=DEV'NO, (NUMCHAR);         <<04830>>05180000
             END;                                              <<04830>>05182000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>05184000
         END;                                                  <<04830>>05186000
         BEGIN                                                 <<04830>>05188000
           MOVE PRINT'LINE(28):="DRQ'S IN USE";                <<04830>>05190000
           IF R1<>0 THEN                                       <<04830>>05192000
             BEGIN                                             <<04830>>05194000
               MOVE PRINT'LINE(41):="FOR LDEV";                <<04830>>05196000
               MOVE PRINT'LINE(50):=DEV'NO, (NUMCHAR);         <<04830>>05198000
             END;                                              <<04830>>05200000
           PRINT(PRINT'LINE,-79,%40);                          <<04830>>05202000
         END;                                                  <<04830>>05204000
       END;                                                    <<04830>>05206000
       HEADER;                                                 <<04830>>05208000
       PRINT'IOQ(R,R1,DRQ'DST,DRQ'HEADER'SIZE);                <<04830>>05210000
       RELDATASEG(SNAPSHOT'DST);                               <<04830>>05212000
       RETURN;                                                 <<04830>>05214000
       END;                                                    <<04830>>05216000
                                                               <<04830>>05218000
                                                               <<04830>>05220000
    <<**************************************************************>>  05222000
    <<                                                              >>  05224000
    <<  TERMINATE PROGRAM EXECUTION & EXIT (EX)                     >>  05226000
    <<                                                              >>  05228000
    <<**************************************************************>>  05230000
                                                                        05232000
    IF M="EX" THEN BEGIN     << END PROGRAM EXECUTION >>                05234000
      FOR COUNT:=16 STEP -1 UNTIL 1 DO  <<DST MUST BE FREED>>  <<04830>>05236000
         IF DSTARRAY(COUNT)<>0 THEN FB(COUNT);                 <<04830>>05238000
      PTEST( 0, 0);                                                     05240000
      NOMORE := EFLAG := TRUE;                                          05242000
      RETURN;                                                           05244000
      END;                                                              05246000
                                                                        05248000
    <<**************************************************************>>  05250000
    <<                                                              >>  05252000
    <<  PERFORM OCTAL CONVERSION (O)                                >>  05254000
    <<                                                              >>  05256000
    <<**************************************************************>>  05258000
                                                                        05260000
    IF T="O" THEN BEGIN     << OCTAL CONVERSION >>                      05262000
      PTEST( 1, 1 );                                                    05264000
      M := "=%";   ASCII( R, 8, BM(2) );                                05266000
      PRINT'( M, 4, 0 );        RETURN;                                 05268000
      END;                                                              05270000
                                                                        05272000
    <<**************************************************************>>  05274000
    <<                                                              >>  05276000
    <<  PERFORM DECIMAL CONVERSION (DEC)                            >>  05278000
    <<                                                              >>  05280000
    <<**************************************************************>>  05282000
                                                                        05284000
    IF BM="DEC" THEN BEGIN        << DECIMAL CONVERSION >>              05286000
      PTEST( 1, 1 );       M := "= ";                                   05288000
      PRINT'( M, -(ASCII( R, 10, BM(2) ) + 2), 0 );                     05290000
      RETURN;                                                           05292000
      END;                                                              05294000
                                                                        05296000
    <<**************************************************************>>  05298000
    <<                                                              >>  05300000
    <<  REDIRECT LIST OPTION (LD)                                   >>  05302000
    <<                                                              >>  05304000
    <<**************************************************************>>  05306000
                                                                        05308000
    IF M="LD" THEN  << SET OPTIONAL LIST DEVICE >>                      05310000
      BEGIN                                                             05312000
        PTEST( 0, 1 );                                                  05314000
        IF FN>0 THEN FCLOSE(FN, 0, 0);                                  05316000
        FN := 0;                                                        05318000
                                                                        05320000
        IF R=1 THEN  << OPEN NEW LIST DEVICE >>                         05322000
          BEGIN                                                         05324000
            FN := FOPEN(LA,4,1,,LP);                                    05326000
            IF <> THEN   << TROUBLE >>                                  05328000
              BEGIN                                                     05330000
                MOVE BM := "FOPEN FAILED";                              05332000
                PRINTE(M, 6);     FN := 0;                              05334000
              END;                                                      05336000
          END                                                           05338000
       ELSE IF R<>0 THEN  << CHECK LDEV FOR LIST DEVICE >>              05340000
          BEGIN                                                         05342000
            T := DEVTYPE(R);                                            05344000
            IF T<>16 AND T<>32 THEN  << NOT A LIST DEVICE >>            05346000
              BEGIN                                                     05348000
                MOVE BM := "INVALID LIST DEVICE";                       05350000
                PRINTE(M, -19);                                         05352000
              END                                                       05354000
            ELSE FN := -R;                                              05356000
          END;                                                          05358000
        RETURN;                                                         05360000
      END;                                                              05362000
                                                                        05364000
    <<**************************************************************>>  05366000
    <<                                                              >>  05368000
    <<  LIST STORED PROGRAM (LI)                                    >>  05370000
    <<                                                              >>  05372000
    <<**************************************************************>>  05374000
                                                                        05376000
    IF M="LI" THEN BEGIN     << LIST PROGRAM >>                         05378000
      CHECKPROG(FALSE);  << CHECK IF ANY PROGRAM >>                     05380000
      IF NOPARAM THEN BEGIN  R := 1;   R1 := 9999;   END                05382000
      ELSE IF NOT TWOPARAMS THEN R1 := R;                               05384000
                                                                        05386000
      IF R1<10000 AND 1<=R<=R1 THEN  << VALID LINE NUMBERS >>           05388000
        BEGIN                                                           05390000
        MOVE BM := "     ";                                             05392000
        I  := FINDLINE(R,  TRUE );  << FIND THIS OR NEXT >>             05394000
        R1 := FINDLINE(R1, FALSE);  << THIS OR PREVIOUS >>              05396000
                                                                        05398000
        WHILE I<PROGEND AND I<=R1 DO  << GET NEXT STATEMENT >>          05400000
          BEGIN                                                         05402000
            ASCII(PROG(I),10,BM);                                       05404000
            J := PROG(X:=X+1);  << LENGTH OF STATEMENT >>               05406000
            MOVE BM(5) := BPROG(I*2+4), (J);                            05408000
            OUTPUT(M, -(J+5), 0);      STEP'PC(I);                      05410000
          END;                                                          05412000
        END                                                             05414000
      ELSE PRINTE(M2, 12);  << INVALID STATEMENT >>                     05416000
      RETURN;                                                           05418000
      END;                                                              05420000
                                                                        05422000
    <<**************************************************************>>  05424000
    <<                                                              >>  05426000
    <<  CLEAR STORED PROGRAM (CL)                                   >>  05428000
    <<                                                              >>  05430000
    <<**************************************************************>>  05432000
                                                                        05434000
    IF M="CL" THEN BEGIN    << CLEAR PROGRAM AREA >>                    05436000
      IF NOT PROGFLAG THEN   << NOT RUNNING SO MODS OK >>               05438000
        IF NOPARAM THEN PROGEND := 0                                    05440000
        ELSE BEGIN   << FIND STARTING AND ENDING STATEMENTS & DELETE >> 05442000
          IF NOT TWOPARAMS THEN R1 := R;                                05444000
          IF R1<10000 AND 1<=R<=R1 THEN  << VALID STATEMENT NUMBERS >>  05446000
            BEGIN                                                       05448000
            I  := FINDLINE(R,  TRUE );  << FIND THIS OR NEXT >>         05450000
            T := FINDLINE(R1, FALSE);  << FIND THIS OR PREVIOUS >>      05452000
            STEP'PC(T);  << STEP PAST LAST STATEMENT >>                 05454000
                                                                        05456000
            IF I<PROGEND AND I<T THEN BEGIN   << DELETE STATEMENTS >>   05458000
              PROGEND := PROGEND - T;   << LENGTH TO MOVE >>            05460000
              MOVE PROG(I) := PROG(T),(PROGEND);                        05462000
              PROGEND := PROGEND + I;   << NEW LENGTH >>                05464000
              END;                                                      05466000
            END                                                         05468000
          ELSE PRINTE(M2, 12);   << INVALID STATEMENT NUMBER >>         05470000
        END                                                             05472000
      ELSE PRINTE(M4, 11);   << ERROR, PROGRAM RUNNING >>               05474000
      RETURN;                                                           05476000
      END;                                                              05478000
                                                                        05480000
    <<**************************************************************>>  05482000
    <<                                                              >>  05484000
    <<  RUN STORED PROGRAM (R)                                      >>  05486000
    <<                                                              >>  05488000
    <<**************************************************************>>  05490000
                                                                        05492000
    IF T="R" AND M<>"RI" THEN BEGIN     << RUN STORED PROGRAM >>        05494000
      CHECKPROG(TRUE);   << ERROR IF NO PROGRAM >>                      05496000
      PTEST( 0, 1 );     IF NOPARAM THEN R := 1;                        05498000
      R := R - 1;        CHECKPARAMS(%77777);                           05500000
                                                                        05502000
      IF NOT PROGFLAG THEN BEGIN      << EXECUTE ON A NEW LEVEL >>      05504000
        PC := 0;             PROGRUN := R;                              05506000
        PROGFLAG := TRUE;    TSOURCE := SOURCE;   SOURCE := 1;          05508000
        DO DOMAIN UNTIL SFLAG OR EFLAG;                                 05510000
        SFLAG := PROGFLAG := FALSE;     SOURCE := TSOURCE;              05512000
        END                                                             05514000
      ELSE PRINTE(M4, 11);  << ERROR, ALREADY RUNNING >>                05516000
      RETURN;                                                           05518000
      END;                                                              05520000
                                                                        05522000
    <<**************************************************************>>  05524000
    <<                                                              >>  05526000
    <<  GO TO PROGRAM STATEMENT & BEGIN EXECUTION (GO)              >>  05528000
    <<                                                              >>  05530000
    <<**************************************************************>>  05532000
                                                                        05534000
    IF M="GO" THEN BEGIN     << GOTO PROGRAM STATEMENT >>               05536000
      CHECKPROG(TRUE);   << ERROR IF NO PROGRAM >>                      05538000
      PTEST( 0, 1 );      CHECKPARAMS(10000);                           05540000
                                                                        05542000
      I := 0;                                                           05544000
      IF NOT NOPARAM THEN WHILE I<PROGEND AND PROG(I)<>R DO STEP'PC(I); 05546000
      IF I=PROGEND THEN   << STATEMENT NOT FOUND >>                     05548000
        PRINTE(M2, 12)    << INVALID STATEMENT NUMBER >>                05550000
      ELSE IF NOT PROGFLAG OR SOURCE=1 THEN                             05552000
        BEGIN   << NOT EXECUTING OR EXECUTING HERE >>                   05554000
        PC := I;    << SET NEW PROGRAM COUNTER >>                       05556000
        IF NOT PROGFLAG THEN  << START EXECUTION ON A NEW LEVEL >>      05558000
          BEGIN                                                         05560000
          PROGFLAG := TRUE;      PROGRUN := 0;                          05562000
          TSOURCE := SOURCE;     SOURCE := 1;                           05564000
          DO DOMAIN UNTIL EFLAG OR SFLAG;                               05566000
          SOURCE := TSOURCE;     SFLAG := PROGFLAG := FALSE;            05568000
          END;                                                          05570000
        END                                                             05572000
      ELSE PRINTE(M4, 11);  << ERROR, ALREADY RUNNING ELSEWHERE >>      05574000
      RETURN;                                                           05576000
      END;                                                              05578000
                                                                        05580000
    <<**************************************************************>>  05582000
    <<                                                              >>  05584000
    <<  GET COMMANDS FROM DO FILE (DO)                              >>  05586000
    <<                                                              >>  05588000
    <<**************************************************************>>  05590000
                                                                        05592000
    IF M="DO" THEN BEGIN     << GET COMMANDS FROM A DO FILE >>          05594000
      PTEST( 1, 1 );                                                    05596000
      BM(L) := " ";     TDF := DF;                                      05598000
      DF := FOPEN(BM(I), 5);   << OLD, FIXED >>                         05600000
      IF = THEN   << OPENED OK,   EXECUTE ON NEXT LEVEL >>              05602000
        BEGIN                                                           05604000
        MOVE TFNAME := FNAME,(30);                                      05606000
        MOVE TLINENO := LINENO,(12);                                    05608000
        TSOURCE := SOURCE;   TFNL := FNL;   SOURCE := 2;                05610000
        FNL := L - I;   MOVE FNAME(4) := BM(I),(FNL);                   05612000
        DO DOMAIN UNTIL SFLAG OR EFLAG;                                 05614000
        SFLAG := FALSE;   SOURCE := TSOURCE;    FNL := TFNL;            05616000
        MOVE LINENO := TLINENO,(12);                                    05618000
        MOVE FNAME  := TFNAME ,(30);                                    05620000
        FCLOSE(DF, 0, 0);                                               05622000
        END                                                             05624000
      ELSE   << OPEN FAILED >>                                          05626000
        BEGIN                                                           05628000
        MOVE BM := BM(I),(L-I);                                         05630000
        MOVE BM(L-I) := " FOPEN FAILED";                                05632000
        PRINTE(M, I-L-13);                                              05634000
        END;                                                            05636000
                                                                        05638000
      DF := TDF;                                                        05640000
      RETURN;                                                           05642000
      END;                                                              05644000
                                                                        05646000
    <<**************************************************************>>  05648000
    <<                                                              >>  05650000
    <<  CALL HELP (H)                                               >>  05652000
    <<                                                              >>  05654000
    <<**************************************************************>>  05656000
                                                                        05658000
    IF T="H" THEN BEGIN       << CALL HELP >>                           05660000
      PTEST( 0, 0 );                                                    05662000
      PRINTX(M16W, -11);  << HELP CALLED MESSAGE >>                     05664000
      READ( M, 0);   << WAIT FOR MESSAGE TO FINISH >>                   05666000
      HELP;    RETURN;                                                  05668000
      END;                                                              05670000
                                                                        05672000
    <<**************************************************************>>  05674000
    <<                                                              >>  05676000
    <<  CALL DEBUG (DE)                                             >>  05678000
    <<                                                              >>  05680000
    <<**************************************************************>>  05682000
                                                                        05684000
    IF M="DE" THEN     << CALL DEBUG >>                                 05686000
      BEGIN   PTEST( 0, 0 );  DEBUG;   RETURN;  END;                    05688000
                                                                        05690000
    <<**************************************************************>>  05692000
    <<                                                              >>  05694000
    <<  ENTRY OF DRT# (DRT)                                         >>  05696000
    <<                                                              >>  05698000
    <<**************************************************************>>  05700000
                                                                        05702000
    IF BM="DRT" THEN  << DRT# ENTRY >>                         <<00924>>05704000
      BEGIN                                                    <<00924>>05706000
        PTEST( 1, 1 );                                         <<00924>>05708000
        IF R<4 OR POSTSERIES3 AND R<8 THEN <<INVALID DRT#>>    <<01407>>05710000
          BEGIN PRINTE(M30W,6); RETURN; END;                   <<00924>>05712000
        DX := R; DRTFLG := 1;  << SET USER'S DRT ENTRY FLG >>  <<00924>>05714000
        PRINTX(M6,22);  << DRT# OVERRIDES LDEV >>              <<00924>>05716000
        RETURN;                                                <<00924>>05718000
      END;                                                     <<00924>>05720000
                                                                        05722000
    <<**************************************************************>>  05724000
    <<                                                              >>  05726000
    <<  DISPLAY BUFFER IN ASCII (DA)                                >>  05728000
    <<                                                              >>  05730000
    <<**************************************************************>>  05732000
                                                                        05734000
    IF M="DA" THEN BEGIN    << DISPLAY BUFFER IN ASCII >>               05736000
      IF NOPARAM THEN  BEGIN   R := 0;   R1 := XLOG;  END;              05738000
      IF R1=0 THEN R1 := C;                                             05740000
      R2 := R1;   IF > THEN R2 := -(R2*2);                              05742000
      CHECKPARAMS( LIMIT );                                             05744000
                                                                        05746000
      WHILE R2<0 DO   << PRINT A LINE IN ASCII >>                       05748000
        BEGIN                                                           05750000
          OUTPUT( B(R), IF R2<-64 THEN -64 ELSE R2, 0 );                05752000
          R2 := R2 + 64;   R := R + 32;                                 05754000
        END;                                                            05756000
      RETURN;                                                           05758000
      END;                                                              05760000
                                                                        05762000
    <<**************************************************************>>  05764000
    <<                                                              >>  05766000
    <<  DISPLAY BUFFER IN OCTAL (DB)                                >>  05768000
    <<                                                              >>  05770000
    <<**************************************************************>>  05772000
                                                                        05774000
    IF M="DB" THEN BEGIN    << PRINT BUFFER IN OCTAL >>                 05776000
      IF NOPARAM THEN  BEGIN  R := 0;  R1 := XLOG;  END;                05778000
      CHECKPARAMS( LIMIT );       BFLAG := TRUE;  << PRINT BUFFER >>    05780000
      PRINTBUFFER( R, R1 );                                             05782000
      RETURN;                                                           05784000
      END;                                                              05786000
                                                                        05788000
    <<**************************************************************>>  05790000
    <<                                                              >>  05792000
    <<  DISPLAY DIT TABLE FOR LDEV (DD)                             >>  05794000
    <<                                                              >>  05796000
    <<**************************************************************>>  05798000
                                                                        05800000
    IF M="DD" THEN BEGIN      << DISPLAY DIT >>                         05802000
      SETPOINTERS( D );                                                 05804000
      IF NOPARAM THEN  BEGIN  R := 0;  R1 := DITL;  END;                05806000
      CHECKPARAMS( DITL );                                              05808000
      PRINTBUFFER( DITP+R, R1 );                                        05810000
      RETURN;                                                           05812000
      END;                                                              05814000
                                                                        05816000
    <<**************************************************************>>  05818000
    <<                                                              >>  05820000
    <<  DISPLAY IOQ ENTRY FOR LDEV (DQ)                             >>  05822000
    <<                                                              >>  05824000
    <<**************************************************************>>  05826000
                                                                        05828000
    IF M="DQ" THEN    << DISPLAY  FIRST IOQ >>                          05830000
      BEGIN                                                             05832000
        PTEST( 0, 1 );  SETPOINTERS( D );                               05834000
        IF NOPARAM THEN R := 254;                                       05836000
        CHECKPARAMS( 255 );                                             05838000
        IF IOQP=%1000 THEN    << NO IOQ >>                              05840000
          BEGIN  PRINTX(M23W,3);  RETURN;  END;                         05842000
                                                                        05844000
        WHILE IOQP<>%1000 AND (R:=R-1)>=0 DO                            05846000
          BEGIN                                                         05848000
            OUTPUT(M, 0, 0); << Leave a space >>               <<03120>>05850000
            PRINTBUFFER(IOQP, if LDEV'IS'DISC then 16          <<03120>>05852000
                                else 11);                      <<03120>>05854000
            IOQP := ABS(IOQP+1) + %1000;   << STEP TO NEXT IOQ >>       05856000
          END;                                                          05858000
        OUTPUT(M, 0, 0); << Leave a space >>                   <<03120>>05860000
        RETURN;                                                         05862000
      END;                                                              05864000
                                                                        05866000
    <<**************************************************************>>  05868000
    <<                                                              >>  05870000
    <<  DISPLAY DRT TABLE AND SIO OR CHANNEL PROGRAM AREA (DS)      >>  05872000
    <<                                                              >>  05874000
    <<**************************************************************>>  05876000
                                                                        05878000
    IF BM="DSI" THEN   << DISPLAY DRT AND SIO AREA >>                   05880000
      BEGIN                                                             05882000
        SETPOINTERS( D );                                               05884000
        IF NOPARAM THEN  BEGIN  R := 0;  R1 := SIOL;  END;              05886000
        CHECKPARAMS( SIOL );                                            05888000
        << Print header >>                                     <<03120>>05890000
        move BM := "4 words of DRT ",2;                        <<03120>>05892000
        N := tos - @BM;                                        <<03120>>05894000
        N := N + ASCII(DX,10,BM(N));                           <<03120>>05896000
        move BM(N) := "- ";                                    <<03120>>05898000
        N := (N+2)/2;                                          <<03120>>05900000
        OUTPUT(M,N,0);                                         <<03120>>05902000
                                                               <<03120>>05904000
        << Print DRT words >>                                  <<03120>>05906000
        M := "  ";                                             <<03120>>05908000
        move M(1) := M,(14);                                   <<03120>>05910000
        N := -1;                                               <<03120>>05912000
        while (N:=N+1) < 4 do                                  <<03120>>05914000
          ASCII(GETDRT(DX,N),8,BM(N*7));                       <<03120>>05916000
        OUTPUT(M,-27,0);                                       <<03120>>05918000
                                                               <<03120>>05920000
        << Print header for SIO area >>                        <<03120>>05922000
        move  M := "SIO program area-",2;                      <<03120>>05924000
        N := tos - @M;                                         <<03120>>05926000
        OUTPUT(M,N,0);                                         <<03120>>05928000
                                                               <<03120>>05930000
        PRINTBUFFER( SIOP+R, R1 );                                      05932000
        RETURN;                                                         05934000
      END;                                                              05936000
                                                                        05938000
    <<**************************************************************>>  05940000
    <<                                                              >>  05942000
    <<  MODIFY DIT TABLE FOR LDEV (MD)                              >>  05944000
    <<                                                              >>  05946000
    <<**************************************************************>>  05948000
                                                                        05950000
    IF M="MD" THEN   << MODIFY DIT >>                                   05952000
      BEGIN                                                             05954000
        PTEST( 1, 2 );    SETPOINTERS( D );                             05956000
        CHECKPARAMS( DITL );      R2 := R;  R3 := R1;                   05958000
        WHILE (R3:=R3-1)>=0 DO                                          05960000
          BEGIN    MODIFYBUFFER(DITP+R2);   R2 := R2 + 1;   END;        05962000
        RETURN;                                                         05964000
      END;                                                              05966000
                                                                        05968000
    <<**************************************************************>>  05970000
    <<                                                              >>  05972000
    <<  MODIFY IOQ ENTRY FOR LDEV (MQ)                              >>  05974000
    <<                                                              >>  05976000
    <<**************************************************************>>  05978000
                                                                        05980000
    IF M="MQ" THEN   << MODIFY IOQ >>                                   05982000
      BEGIN                                                             05984000
        PTEST( 1, 2 );     SETPOINTERS( D );                            05986000
        IF IOQP=%1000 THEN    << NO IOQ >>                              05988000
          BEGIN   PRINTX(M23W, 3);   RETURN;  END;                      05990000
        CHECKPARAMS( 11 );     R2 := R;   R3 := R1;                     05992000
        WHILE (R3:=R3-1)>=0 DO                                          05994000
          BEGIN   MODIFYBUFFER(IOQP+R2);  R2 := R2 + 1;   END;          05996000
        RETURN;                                                         05998000
      END;                                                              06000000
                                                                        06002000
    <<**************************************************************>>  06004000
    <<                                                              >>  06006000
    <<  MODIFY THE BUFFER (MB)                                      >>  06008000
    <<                                                              >>  06010000
    <<**************************************************************>>  06012000
                                                                        06014000
    IF M="MB" THEN    << MODIFY BUFFER >>                               06016000
      BEGIN                                                             06018000
        PTEST( 1, 2 );    CHECKPARAMS( LIMIT );                         06020000
        R2 := R;    R3 := R1;     BFLAG := TRUE;                        06022000
        WHILE (R3:=R3-1)>=0 DO                                          06024000
          BEGIN   MODIFYBUFFER( R2 );   R2 := R2 + 1;  END;             06026000
        RETURN;                                                         06028000
      END;                                                              06030000
                                                                        06032000
    <<**************************************************************>>  06034000
    <<                                                              >>  06036000
    <<  CHECK FOR PENDING I/O (CH)                                  >>  06038000
    <<                                                              >>  06040000
    <<**************************************************************>>  06042000
                                                                        06044000
    IF M="CH" THEN  << CHECK PENDING I/O >>                             06046000
      BEGIN                                                             06048000
        PTEST( 0, 0 );                                                  06050000
        CHECKIOPENDING( 3 );  << PRINT ERRORS AND PENDING MSG >>        06052000
        RETURN;                                                         06054000
      END;                                                              06056000
                                                                        06058000
    <<**************************************************************>>  06060000
    <<                                                              >>  06062000
    <<  DISPLAY STATUS AND XLOG (DS)                                >>  06064000
    <<                                                              >>  06066000
    <<**************************************************************>>  06068000
                                                                        06070000
    IF M="DS"THEN      << PRINT STATUS AND XLOG >>                      06072000
      BEGIN                                                             06074000
        CHECKIOPENDING( 2 );  << I/O PENDING MSG ONLY >>                06076000
        PTEST( 0, 0 );         PRINTSTATUS;                             06078000
        RETURN;                                                         06080000
      END;                                                              06082000
                                                                        06084000
    <<**************************************************************>>  06086000
    <<                                                              >>  06088000
    <<  TEST I/O (TIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]           >>  06090000
    <<                                                              >>  06092000
    <<**************************************************************>>  06094000
                                                                        06096000
    IF BM="TIO" THEN      << DO TIO >>                                  06098000
      BEGIN                                                             06100000
        PTEST( 0, 0 );                                                  06102000
        SETPOINTERS( D );                                      <<01366>>06104000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06106000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06108000
          BEGIN                   <<I/O SYSTEMS, TP, & ICF'S>> <<01407>>06110000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06112000
          RETURN;                                              <<01366>>06114000
          END;                                                 <<01366>>06116000
        TOS := DX;   << DRT NUMBER >>                                   06118000
        ASMB( TIO 0 );                                                  06120000
        X := TRUE;     PRINTRESULT( * );    << PRINT RESULT OF TIO >>   06122000
        RETURN;                                                         06124000
      END;                                                              06126000
                                                                        06128000
    <<**************************************************************>>  06130000
    <<                                                              >>  06132000
    <<  READ I/O (RIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]           >>  06134000
    <<                                                              >>  06136000
    <<**************************************************************>>  06138000
                                                                        06140000
    IF M="RI" THEN     << RIO >>                                        06142000
      BEGIN                                                             06144000
        SETPOINTERS( D );                                      <<01366>>06146000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06148000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06150000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06152000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06154000
          RETURN;                                              <<01366>>06156000
          END;                                                 <<01366>>06158000
        PTEST( 0, 0 );                                                  06160000
        TOS := DX;  << DRT NUMBER >>                                    06162000
        ASMB( RIO 0 );                                                  06164000
        X := TRUE;     PRINTRESULT( * );    << PRINT RESULT OF RIO >>   06166000
        RETURN;                                                         06168000
      END;                                                              06170000
                                                                        06172000
    <<**************************************************************>>  06174000
    <<                                                              >>  06176000
    <<  CONTROL I/O (CIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]        >>  06178000
    <<                                                              >>  06180000
    <<**************************************************************>>  06182000
                                                                        06184000
    IF M="CI" THEN  << DO CIO >>                                        06186000
      BEGIN                                                             06188000
        SETPOINTERS( D );                                      <<01366>>06190000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06192000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06194000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06196000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06198000
          RETURN;                                              <<01366>>06200000
          END;                                                 <<01366>>06202000
        PTEST( 1, 1 );                                                  06204000
        TOS := DX;    TOS := R;   << DRT NUMBER AND CONTROL WORD >>     06206000
        ASMB( CIO 1 );                                                  06208000
        X := FALSE;    PRINTRESULT( * );   << PRINT IF NOT READY ONLY >>06210000
        RETURN;                                                         06212000
      END;                                                              06214000
                                                                        06216000
    <<**************************************************************>>  06218000
    <<                                                              >>  06220000
    <<  WRITE I/O (WIO) [IMPLEMENTED ON SERIES 2 & 3 ONLY]          >>  06222000
    <<                                                              >>  06224000
    <<**************************************************************>>  06226000
                                                                        06228000
    IF M="WI" THEN  << DO WIO >>                                        06230000
      BEGIN                                                             06232000
        SETPOINTERS( D );                                      <<01366>>06234000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06236000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06238000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06240000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06242000
          RETURN;                                              <<01366>>06244000
          END;                                                 <<01366>>06246000
        PTEST( 1, 1 );                                                  06248000
        TOS := DX;   TOS := R;    << DRT NUMBER AND WIO WORD >>         06250000
        ASMB( WIO 1 );                                                  06252000
        X := FALSE;    PRINTRESULT( * );  << PRINT IF NOT READY ONLY >> 06254000
        RETURN;                                                         06256000
      END;                                                              06258000
                                                                        06260000
    <<**************************************************************>>  06262000
    <<                                                              >>  06264000
    <<  CLEAR TERMINAL MONITORING AREA (CM)                         >>  06266000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  06268000
    <<                                                              >>  06270000
    <<**************************************************************>>  06272000
                                                                        06274000
    IF M="CM" THEN  << CLEAR MONITORING AREA >>                         06276000
      BEGIN                                                             06278000
        SETPOINTERS( D );                                      <<01366>>06280000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06282000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06284000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06286000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06288000
          RETURN;                                              <<01366>>06290000
          END;                                                 <<01366>>06292000
        X := ABS(%1066)+%777;                                           06294000
        IF X<>%777 THEN  << A SBUF TO CLEAR >>                          06296000
          FOR I := 0 UNTIL 128 DO ABS(X:=X+1) := 0;                     06298000
        RETURN;                                                         06300000
      END;                                                              06302000
                                                                        06304000
    <<**************************************************************>>  06306000
    <<                                                              >>  06308000
    <<  SET TERMINAL MONITORING CODE (M)                            >>  06310000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  06312000
    <<                                                              >>  06314000
    <<**************************************************************>>  06316000
                                                                        06318000
    IF T="M" THEN   << SET MONITORING CODE >>                           06320000
      BEGIN                                                             06322000
        SETPOINTERS( D );                                      <<01366>>06324000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06326000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06328000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06330000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06332000
          RETURN;                                              <<01366>>06334000
          END;                                                 <<01366>>06336000
        PTEST(0,1);  SETPOINTERS( D );                                  06338000
        R1 := 0;   CHECKPARAMS( %77 );                                  06340000
        IF DEVTYPE( D )=16 THEN    << IT IS A TERMINAL >>               06342000
          BEGIN  DISABLE;  ABS(DITP+33).(10:6) := R;   ENABLE;  END     06344000
        ELSE PRINTE( M13W, 6);   << INVALID LDEV >>                     06346000
        RETURN;                                                         06348000
      END;                                                              06350000
                                                                        06352000
    <<**************************************************************>>  06354000
    <<                                                              >>  06356000
    <<  PRINT TERMINAL MONITOR TABLE (P)                            >>  06358000
    <<  [IMPLEMENTED ON SERIES 2 & 3 ONLY]                          >>  06360000
    <<                                                              >>  06362000
    <<**************************************************************>>  06364000
                                                                        06366000
    IF T="P" AND M<>"PA" AND M<>"PB" THEN  << PRINT TERM MNTR TABLE >>  06368000
      BEGIN                                                             06370000
        SETPOINTERS( D );                                      <<01366>>06372000
        IF POSTSERIES3 OR ABS(DITP+3).(0:2)=1 AND              <<01407>>06374000
           DEVTYPE(D) <> 16 THEN  <<ILLEGAL COMMAND ON HPIB>>  <<00798>>06376000
          BEGIN                   <<I/O SYSTEM, TP, & ICF'S>>  <<01407>>06378000
          PRINTE(M24W,-15);  << ILLEGAL COMMAND >>             <<01366>>06380000
          RETURN;                                              <<01366>>06382000
          END;                                                 <<01366>>06384000
        IF ABS(%1066)=0 THEN RETURN;  << NOTHING TO PRINT >>            06386000
        IF NOPARAM THEN R := 32;  << MAX NUMBER OF ENTRIES >>           06388000
        I := ABS(X) + %1000;    J := ABS(I);  << BASE & INDEX OF NEXT >>06390000
        K := J - 4*R + 1;  << START OF AREA >>                          06392000
        IF < THEN  << LESS THAN # REQUESTED MONITORED SO FAR >>         06394000
          BEGIN   K := 1;   R := J/4;  END;                             06396000
        IF R=0 THEN RETURN;  << NOTHING TO PRINT >>                     06398000
                                                                        06400000
        M := "  ";   MOVE M(1) := M,(40);                               06402000
        MOVE BM(36) := "MODEM T L R B P D Q";                           06404000
        OUTPUT(M, -55, 0 );  << FIRST LINE OF HEADER >>                 06406000
        MOVE BM := "TIME  ID  DS UNIT  P1     P2   MNTR";               06408000
        MOVE BM(36) := "ABSFC M P P R R F F FNC P1 STAT RQS";           06410000
        OUTPUT(M, -71, %60);  << 2ND LINE OF HEADER, DBL SPACE >>       06412000
                                                                        06414000
        CA := CF := CC := 0;  << SET IN UNKNOWN STATE >>                06416000
                                                                        06418000
        FOR R1 := 1 UNTIL R DO  << PRINT ENTRIES >>                     06420000
          BEGIN                                                         06422000
            M := "  ";   MOVE M(1) := M,(40);                           06424000
            K := K MOD 128;    J := I + K;  << J = BASE OF ENTRY >>     06426000
            T := ABS(J);    N := ABS(X:=X+1);                           06428000
            W2 := ABS(X:=X+1);  W3 := ABS(X:=X+1);                      06430000
                                                                        06432000
            TOS := 0;   << RETURN FOR DASCII >>                         06434000
            IF T.(4:12)<>%7777 THEN  << VALID TIME >>                   06436000
              BEGIN                                                     06438000
                X := T.(4:2)+1;   << EXPONENT OF TIME >>                06440000
                TOS := 0;    TOS := T.(6:10);  << MANTISSA >>           06442000
                WHILE DXBZ DO TOS := TOS&DLSL(3);                       06444000
              END                                                       06446000
            ELSE TOS := 99999 D;  << TIME OVER FLOW >>                  06448000
            DASCII( *, 10, BM);   << CONVERT TIME >>                    06450000
                                                                        06452000
            T := T.(0:4);         << SET T TO ENTRY ID >>               06454000
            MOVE BM(6) := ID(T*3),(3);  << CALLER ID >>                 06456000
            MOVE BM(10) := DSTATE(N.(12:4)*3),(3);  << DSTATE >>        06458000
            ASCII(N.(0:4),-10,BM(15));  << CONVERT UNIT NUMBER >>       06460000
                                                                        06462000
            IF T<>%10 AND T<>%11 THEN  << CONVERT P1 >>                 06464000
              ASCII(W2, 8, BM(17))                                      06466000
            ELSE                                                        06468000
              BEGIN << CONVERT FUNCTION & P1 OR STATUS >>               06470000
                ASCII(W2.(0:7), -10, BM(58));  << FUNCTION >>           06472000
                IF T=%10 THEN BCONVERT(W2.(7:9),60) << P1 >>            06474000
                  ELSE BCONVERT(W2.(8:8),64);  << STAT >>               06476000
              END;                                                      06478000
            IF T<>%10 AND T<>%11 AND T<>2 AND T<>5 THEN                 06480000
              ASCII(W3, 8, BM(24));  << CONVERT P2 >>                   06482000
                                                                        06484000
            IF T=5 THEN  << DSET CONTROL >>                             06486000
              BEGIN                                                     06488000
                IF W3=0 OR W3=2 THEN CA := 1                            06490000
                  ELSE IF W3=4 THEN CA := -1;                           06492000
                MOVE BM(24) := DS(W3*6),(6);                            06494000
              END                                                       06496000
            ELSE IF T=6 THEN  << DSET 1, CF AND CC >>                   06498000
              BEGIN                                                     06500000
                CF := IF LW3.(14:1) THEN 1 ELSE -1;                     06502000
                CC := IF LW3 THEN 1 ELSE -1;                            06504000
              END                                                       06506000
            ELSE IF T=7 THEN  << DSET 2, CB AND SB >>                   06508000
              BEGIN                                                     06510000
                CB := IF LW3.(14:1) THEN 1 ELSE -1;                     06512000
                SB := IF LW3 THEN 1 ELSE -1;                            06514000
              END                                                       06516000
            ELSE  << JUST SET CB AND SB >>                              06518000
              BEGIN  CB := N.(5:1);  SB := N.(6:1);  END;               06520000
                                                                        06522000
            FOR T1 := 0 UNTIL 4 DO << SET CA,CB,SB,CF,CC >>             06524000
              IF DSET(T1)<>0 THEN  << STATE IS KNOWN >>                 06526000
                BM(36+T1) := IF DSET(T1)>0 THEN "1" ELSE "0";           06528000
                                                                        06530000
            IF LN.( 6:1) THEN BM(34) := "P";  << PAIR >>                06532000
            IF LN.( 7:1) THEN BM(31) := "U";                            06534000
            IF LN.( 8:1) THEN BM(32) := "A";                            06536000
            IF LN.( 9:1) THEN BM(33) := "R";                            06538000
            IF LN.(10:1) THEN BM(52) := "F";  << BRK FLUSH >>           06540000
            IF LN.(11:1) THEN BM(48) := "B";  << BINARY READ >>         06542000
                                                                        06544000
            IF T=%10 OR T=%11 OR T=2 THEN                               06546000
              BEGIN  << P2 HAS REQUEST DATA >>                          06548000
                IF LW3.(0:1) THEN BM(54) := "F";  << CY FLUSH >>        06550000
                IF LW3.(1:1) THEN BM(50) := "P";  << PRIMED >>          06552000
                BM(42) := TM(W3.(2:2));  << SET TMODE >>                06554000
                BM(44) := PL(W3.(4:3));  << LAST PREMPT LEVEL >>        06556000
                BM(46) := PL(W3.(7:3));  << REQUEST P LEVEL >>          06558000
                BCONVERT(W3.(10:6),68);  << REQUEST STATE >>            06560000
              END;                                                      06562000
                                                                        06564000
            OUTPUT(M, -71, 0);  << PRINT ENTRY >>                       06566000
            K := K + 4;  << STEP TO NEXT ENTRY >>                       06568000
          END;                                                          06570000
                                                                        06572000
        RETURN;                                                         06574000
      END;                                                              06576000
                                                                        06578000
    <<**************************************************************>>  06580000
    <<                                                              >>  06582000
    <<  DISPLAY AVG EXECUTION TIME FOR ATTACHIO CALL (T)            >>  06584000
    <<                                                              >>  06586000
    <<**************************************************************>>  06588000
                                                                        06590000
    IF T="T" THEN       << PRINT OUT AVE ATTACHIO CALL TIME >>          06592000
      BEGIN                                                             06594000
        PTEST( 0, 0 );         @BP := @M5W;                             06596000
        TOS := REAL(TIME)/REAL(E);  << AVE EXECUTION TIME >>            06598000
        ASMB(DDUP,FIXR);   DELB;                                        06600000
        IF CARRY THEN @BP := @M20W;    << MORE THAN 32 SECONDS >>       06602000
                                                                        06604000
        IF TOS<=32 THEN  << PRINT TIME IN MILLISECONDS >>               06606000
          BEGIN   TOS := TOS*REAL(1000);   TOS := "MS";   END           06608000
        ELSE TOS := "S ";  << PRINT IN SECONDS >>                       06610000
        M5W(7) := TOS;                                                  06612000
                                                                        06614000
        ASMB(FIXR,DELB);     X := 13;                                   06616000
        WHILE X>7 DO  << CONVERT TO ASCII >>                            06618000
          BEGIN                                                         06620000
            ASMB(ZERO, XCH);   << FORM A DOUBLE >>                      06622000
            TOS := 10;     ASMB(LDIV,DECX);                             06624000
            IF X=9 THEN X := X-1;  << STEP OVER DECIMAL POINT >>        06626000
            M5(X) := TOS+%60;                                           06628000
          END;                                                          06630000
                                                                        06632000
        PRINTX(BP, 8);   << PRINT TIME OR GREATER THAN 32 SECONDS >>    06634000
        RETURN;                                                         06636000
      END;                                                              06638000
                                                                        06640000
    <<**************************************************************>>  06642000
    <<                                                              >>  06644000
    <<  DISPLAY ATTACHIO CALL PARAMETERS (D)                        >>  06646000
    <<                                                              >>  06648000
    <<**************************************************************>>  06650000
                                                                        06652000
    IF T="D" THEN  << DISPLAY ATTACHIO PARMETERS >>                     06654000
      BEGIN                                                             06656000
        PTEST( 0, 0 );                                                  06658000
        MOVE BM := "LDEV = ";     X := 7;                               06660000
        X := ASCII(D, 10, BM(X)) + X;                                   06662000
        MOVE BM(X) := ", FUNC = ";       X := X + 9;                    06664000
        X := ASCII(F, 10, BM(X)) + X;                                   06666000
        MOVE BM(X) := ", COUNT = ";      X := X + 10;                   06668000
        X := ASCII(C, 10, BM(X)) + X;                                   06670000
        MOVE BM(X) := ", FLAGS = ";      X := X + 10;                   06672000
        TOS := ASCII(FLG, 8, BM(X));     X := X + 6;                    06674000
        BM(X) := CR; BM(X:=X+1) := %12;  X := X + 1;                    06676000
        MOVE BM(X) := "QMISC = ";        X := X + 8;                    06678000
        TOS := ASCII(Q,  8, BM(X));      X := X + 6;                    06680000
        MOVE BM(X) := ", P1 = ";         X := X + 7;                    06682000
        TOS := ASCII(P1, 8, BM(X));      X := X + 6;                    06684000
        MOVE BM(X) := ", P2 = ";         X := X + 7;                    06686000
        TOS := ASCII(P2, 8, BM(X));      X := X + 6;                    06688000
        PRINTX(M, -X);                                                  06690000
      IF BUF'USED=0 THEN                                       <<04830>>06692000
           PRINT(M36W,11,%40)                                  <<04830>>06694000
       ELSE   <<PRINT BUFFER AND DATA SEGMENT BEING USED>>     <<04830>>06696000
           BEGIN                                               <<04830>>06698000
              PRINT(M37W,-25,%320);                            <<04830>>06700000
              NUMCHAR:=ASCII(BUF'USED,10,BYTENUM);             <<04830>>06702000
              PRINT(LBYTENUM,-NUMCHAR,%320);                   <<04830>>06704000
              PRINT (M38W,-22,%320);                           <<04830>>06706000
              NUMCHAR:=ASCII(DSTARRAY(BUF'USED),8,BYTENUM);    <<04830>>06708000
             PRINT(LBYTENUM,-6,%40);                           <<04830>>06710000
          END;                                                 <<04830>>06712000
        RETURN;                                                         06714000
      END;                                                              06716000
                                                                        06718000
    <<**************************************************************>>  06720000
    <<                                                              >>  06722000
    <<  ASCII FILL THE BUFFER (A) OR ANOTE (AN)                     >>  06724000
    <<                                                              >>  06726000
    <<**************************************************************>>  06728000
                                                                        06730000
    IF T="A" THEN  << ASCII BUFFER FILL OR ANOTE >>                     06732000
      BEGIN                                                             06734000
        IF M<>"AN" THEN BEGIN    << ASSUME ASCII >>                     06736000
          CHECKIOPENDING( 2 );   << PRINT PENDING MSG ONLY >>           06738000
          IF NOPARAM THEN  << NO PARMETER SO INCREMENTAL FILL >>        06740000
            FOR I := 0 UNTIL LIMIT*2 DO BB(I) := 41 + I MOD 50          06742000
          ELSE  BEGIN   MOVE BB := BM(R1),(R);   C := -R;   END;        06744000
          END                                                           06746000
        ELSE BEGIN   << DO ANOTE >>                                     06748000
          MOVE BM := BM(R1),(R);                                        06750000
          OUTPUT(M, -R, 0);                                             06752000
          END;                                                          06754000
        RETURN;                                                         06756000
      END;                                                              06758000
                                                                        06760000
    <<**************************************************************>>  06762000
    <<                                                              >>  06764000
    <<  FILL BUFFER WITH PARAMETER INPUT (B)                        >>  06766000
    <<                                                              >>  06768000
    <<**************************************************************>>  06770000
                                                                        06772000
    IF T="B" THEN  << FILL BUFFER WITH PARAMETER >>                     06774000
      BEGIN                                                             06776000
        CHECKIOPENDING( 2 );   << PRINT PENDING MSG ONLY >>             06778000
        IF NOPARAM THEN R1 := LIMIT                                     06780000
          ELSE IF NOT TWOPARAMS THEN R1 := LIMIT;                       06782000
        R2 := R;     R := 0;                                            06784000
        CHECKPARAMS( LIMIT );                                           06786000
        FOR I:=0 UNTIL R1 DO B(I) := R2;                                06788000
        RETURN;                                                         06790000
      END;                                                              06792000
                                                                        06794000
    <<**************************************************************>>  06796000
    <<                                                              >>  06798000
    <<  SET LOGICAL DEVICE NUMBER (L)                               >>  06800000
    <<                                                              >>  06802000
    <<**************************************************************>>  06804000
                                                                        06806000
    IF T="L" THEN                                                       06808000
      BEGIN                                                             06810000
        PTEST( 1, 1 );                                         <<01222>>06812000
        IF DRTFLG=1 THEN  << USER'S DRT# FLAG SETS >>          <<01222>>06814000
          BEGIN  << PRINT WARNING MESSAGE >>                   <<01222>>06816000
          PRINTX(M7,15);  << LDEV OVERRIDES DRT# >>            <<01222>>06818000
          DRTFLG := 0;  << RESET USER'S DRT# FLAG >>           <<01222>>06820000
          END;                                                 <<01222>>06822000
        SETPOINTERS( R );  D := R;                             <<01222>>06824000
        RETURN;                                                <<01222>>06826000
      END;                                                              06828000
                                                                        06830000
    PTEST( 0, 1 );    << TEST FOR 0 OR 1 PARAMETER >>                   06832000
                                                                        06834000
    <<**************************************************************>>  06836000
    <<                                                              >>  06838000
    <<  SET COUNT FOR ATTACHIO CALL (C)                             >>  06840000
    <<                                                              >>  06842000
    <<**************************************************************>>  06844000
                                                                        06846000
    IF T="C" THEN                                                       06848000
      BEGIN    C := R;    RETURN;    END;                               06850000
                                                                        06852000
    <<**************************************************************>>  06854000
    <<                                                              >>  06856000
    <<  SET FUNCTION CODE FOR ATTACHIO CALL (F)                     >>  06858000
    <<                                                              >>  06860000
    <<**************************************************************>>  06862000
                                                                        06864000
    IF T="F" AND M<>"FL" THEN                                           06866000
      BEGIN    F := R;    RETURN;    END;                               06868000
                                                                        06870000
    <<**************************************************************>>  06872000
    <<                                                              >>  06874000
    <<  SET P1 FOR ATTACHIO CALL (PA)                               >>  06876000
    <<                                                              >>  06878000
    <<**************************************************************>>  06880000
                                                                        06882000
    IF M="PA" THEN                                                      06884000
      BEGIN    P1 := R;   RETURN;    END;                               06886000
                                                                        06888000
    <<**************************************************************>>  06890000
    <<                                                              >>  06892000
    <<  SET P2 FOR ATTACHIO CALL (PB)                               >>  06894000
    <<                                                              >>  06896000
    <<**************************************************************>>  06898000
                                                                        06900000
    IF M="PB" THEN                                                      06902000
      BEGIN    P2 := R;   RETURN;    END;                               06904000
                                                                        06906000
    <<**************************************************************>>  06908000
    <<                                                              >>  06910000
    <<  SET QMISC FOR ATTACHIO CALL (Q)                             >>  06912000
    <<                                                              >>  06914000
    <<**************************************************************>>  06916000
                                                                        06918000
    IF T="Q" THEN                                                       06920000
      BEGIN    Q := R;    RETURN;    END;                               06922000
                                                                        06924000
    IF NOPARAM THEN R := 1;    << DEFAULT PARM TO 1 >>                  06926000
                                                                        06928000
    <<**************************************************************>>  06930000
    <<                                                              >>  06932000
    <<  SET FLAG WORD FOR ATTACHIO CALL (FL)                        >>  06934000
    <<                                                              >>  06936000
    <<**************************************************************>>  06938000
                                                                        06940000
    IF M="FL" THEN    << SET FLAGS WORD >>                              06942000
      BEGIN    FLG := R;      RETURN;    END;                           06944000
                                                                        06946000
    <<**************************************************************>>  06948000
    <<                                                              >>  06950000
    <<  SET OR CLEAR SHOW FLAG (SH)                                 >>  06952000
    <<                                                              >>  06954000
    <<**************************************************************>>  06956000
                                                                        06958000
    IF M="SH" THEN   << SET OR CLEAR SHOW FLAG >>                       06960000
      BEGIN    SHOW := R;     RETURN;    END;                           06962000
                                                                        06964000
    <<**************************************************************>>  06966000
    <<                                                              >>  06968000
    <<  SET OR CLEAR ADD REC# TO BUFFER FLAG (V)                    >>  06970000
    <<                                                              >>  06972000
    <<**************************************************************>>  06974000
                                                                        06976000
    IF T="V" THEN  << SET ADD RECORD NUMBER FLAG >>                     06978000
      BEGIN    VFLAG := R;    RETURN;    END;                           06980000
                                                                        06982000
    <<**************************************************************>>  06984000
    <<                                                              >>  06986000
    <<  SET OR CLEAR NULL INPUT FLAG (N)                            >>  06988000
    <<                                                              >>  06990000
    <<**************************************************************>>  06992000
                                                                        06994000
    IF T="N" THEN   << SET NULL INPUT FLAG >>                           06996000
      BEGIN    NFLAG := R;    RETURN;    END;                           06998000
                                                                        07000000
    <<**************************************************************>>  07002000
    <<                                                              >>  07004000
    <<  INCREMENTAL BUFFER FILL (I)                                 >>  07006000
    <<                                                              >>  07008000
    <<**************************************************************>>  07010000
                                                                        07012000
    IF T="I" THEN  << INCREMENT BUFFER FILL >>                          07014000
      BEGIN                                                             07016000
        CHECKIOPENDING( 2 );   << JUST PRINT I/O PENDING MSG >>         07018000
        B := 0;                                                         07020000
        FOR I := 1 UNTIL LIMIT DO B(I) := B(I-1)+R;                     07022000
        RETURN;                                                         07024000
      END;                                                              07026000
                                                                        07028000
    <<**************************************************************>>  07030000
    <<                                                              >>  07032000
    <<  CALL ATTACHIO R TIMES (E)                                   >>  07034000
    <<                                                              >>  07036000
    <<**************************************************************>>  07038000
                                                                        07040000
    IF T="E" THEN    << CALL ATTACHIO R TIMES >>                        07042000
      BEGIN                                                             07044000
        E := R;    << SAVE EXECUTION COUNT >>                           07046000
        SETPOINTERS( D );   << CHECK LDEV >>                            07048000
        SBUFX := WAKEIOQX := I := 0;                                    07050000
        R1 := @B;    R2 := FLG;                                         07052000
                                                                        07054000
        TOS := C;                                                       07056000
        IF < THEN        << HAVE BYTE COUNT >>                 <<00924>>07058000
          TOS := -(TOS&ASR(1));  << MAKE WORDS>>               <<00924>>07060000
        R := (S0+127)/128;   << #SBUFS IF SBUF FLG SET >>      <<00924>>07062000
        IF ACTVBUF<>0 THEN LIMIT:=32000 ELSE LIMIT:=8196;      <<04830>>07064000
        IF TOS>LIMIT AND F<2 THEN   << COUNT TO LARGE >>                07066000
          BEGIN  PRINTE(M14W, -15);   RETURN;   END;                    07068000
                                                                        07070000
        IF C<>0 THEN  << CHECK FOR SBUFS ETC >>                         07072000
          IF LOGICAL(FLG.(12:1)) THEN  << SBUF SPECIFIED >>             07074000
            BEGIN                                                       07076000
              IF NOT LOGICAL(FLG) THEN  << SBUF AND UNBLOCKED >>        07078000
                BEGIN  PRINTE(M7W, 15);   RETURN;   END;                07080000
                                                                        07082000
              IF F=0 AND FLG.(14:2)=3 THEN  << READ AND NOPCB IO >>     07084000
                BEGIN   PRINTE(M22W, 17);   RETURN;   END;              07086000
                                                                        07088000
              SBUFX := R1 := GETSYSBUF( R, TRUE );                      07090000
            END                                                         07092000
          ELSE IF FLG=3 THEN   << NOPCB IO AND NO SBUF >>               07094000
            BEGIN   PRINTE(M27W, 21);   RETURN;   END;                  07096000
                                                                        07098000
        CHECKIOPENDING( 0 );   << COMPLETE ANY PENDING I/O >>           07100000
                                                                        07102000
        TIME := TIMER;      << SAVE START TIME >>                       07104000
        WHILE (I:=I+1)<=E AND NOT CYFLAG DO BEGIN                       07106000
          IF IOPCNT>=50 THEN   << TOO MANY UNBLOCKED IO'S >>            07108000
            BEGIN   PRINTE(M6W, -23);   RETURN;   END;                  07110000
                                                                        07112000
          IF VFLAG<>0 THEN    << ADD EXECUTION NUMBER >>                07114000
            BEGIN   MOVE B := "      ";   ASCII(I, 10, B);   END;       07116000
                                                                        07118000
          IF SBUFX<>0 AND F=1 THEN MOVEDATA;  << MOVE WRITE DATA >>     07120000
          LASTLDEV := D;   LASTFUNC := F;                               07122000
      IF ACTVBUF=0 THEN                                        <<04830>>07124000
                                                               <<04830>>07126000
       TOS:=ATTACHIO(D,Q,0,R1,F,C,P1,P2,R2)                    <<04830>>07128000
      ELSE                                                     <<04830>>07130000
       TOS:=ATTACHIO(D,Q,DSTARRAY(FINDBIT(ACTVBUF)+1),         <<04830>>07132000
       0,F,C,P1,P2,R2);                                        <<04830>>07134000
          XLOG := TOS;      STATUS := TOS;                              07136000
                                                                        07138000
          CASE FLG.(14:2) OF                                            07140000
            BEGIN                                                       07142000
              SAVEIOQX;    << UNBLOCKED, NOWAKE >>                      07144000
                                                                        07146000
              BEGIN    << BLOCKED >>                                    07148000
                IF SBUFX<>0 AND F=0 THEN MOVEDATA;  << MOVE READ DATA >>07150000
                IF STATUS.(13:3)<>1 THEN PRINTSTATUS;                   07152000
              END;                                                      07154000
                                                                        07156000
              WAKEIOQX := SAVEIOQX;    << UNBLOCKED WITH WAKE >>        07158000
                                                                        07160000
              STATUS := XLOG := 0;   << NOPCB I/O >>                    07162000
            END;                                                        07164000
        END;   << CALL ATTACHIO >>                                      07166000
        TIME := TIMER - TIME;   << FOR TOTAL ELAPSED TIME >>            07168000
                                                                        07170000
        IF SBUFX<>0 AND FLG.(14:2)=1 THEN   << RETURN SBUFS >>          07172000
          BEGIN   RETURNSYSBUF(SBUFX);     SBUFX := 0;   END;           07174000
                                                                        07176000
        IF WAKEIOQX<>0 THEN   << WAIT ON UNBLOCKED WITH WAKE >>         07178000
          BEGIN                                                         07180000
            DISABLE;                                                    07182000
            SETWAKE(WAKEIOQX);   << TEST IF COMPLETED >>                07184000
            IF = THEN WAIT(%120, 0);   << NOT COMPLETED SO WAIT >>      07186000
            ENABLE;                                                     07188000
          END;                                                          07190000
      END                                                               07192000
    ELSE PRINTE(M24W,-15);   << INVALID COMMAND >>                      07194000
    END;     << DO MAIN >>                                              07196000
$PAGE  "OUTER BLOCK"                                                    07198000
                                                                        07200000
    PUSH(STATUS);  TOS.(2:1) := 0;  SET(STATUS);  << DISABLE TRAPS >>   07202000
    XCONTRAP(@CY, T);   << ENABLE CONTROL Y >>                          07204000
    IN := FOPEN( , %40);   << OPEN $STDIN >>                            07206000
    DUP := FRELATE(IN, FOPEN(,%10))&CSL(1);                             07208000
     PRINT'(M1,23,0);      <<HEADER MESSAGE>>                  <<04830>>07210000
                                                                        07212000
    DO BEGIN    << LOWEST LOOP >>                                       07214000
      SOURCE := 0;   << $STDIN >>                                       07216000
      DO DOMAIN UNTIL EFLAG;                                            07218000
      EFLAG := FALSE;    MORE := 0;                                     07220000
                                                                        07222000
      IF CYFLAG THEN                                                    07224000
        BEGIN    RESETCONTROL;     CYFLAG := FALSE;    END;             07226000
    END UNTIL NOMORE;                                                   07228000
                                                                        07230000
END.    << TEST IO >>                                                   07232000
