WHATPER867

(George Source)

Macros used: ACROSS, BSOFF, BXE, BXU, CLOSE, COMBRKIN, COMERRX, COOR3, DFJUMPN, DFJUMPS, DFLOAD, ENDCOM, ERRORX, FINDCORE, FON, FREECORE, GEOERR, GETCOREN, HUNTW, JDED, JENVNOT, JFREE, JOBLOCK, JONL, JSHARED, JSWIN, JTWIN, LADDP, LJOBNO, LTYPE, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, MONOUTX, NAME, NUMLINK, OFF, ON, OPEN, OPENSYS, OPSCON, OUTNUM, OUTPARN, PARANOTX, PARANUMB, PARSORTB, PTYPE, SAWCEJX, SEG, SEGENTRY, SETNCORE, UP, VFREEW

WHATPER867.txt
22FL    #LIS  K0WHATPER>K0ALLGEO>K0GREATGEO>K0COMMAND   
22LS ... SEG  WHATPER,,,,G203            [N.R.BOULT 
22S2 ...[   
22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
236B ...[     THIS EXCLUDES CODE UNDER #SKI G203
23?J ...[   
23DQ ...#OPT G203 = 0   
23KY ...#SKI G203&1 
23R6 ...# WITH UGUG EDIT M203 (ALLOW WHATPER FOR REMOTE DEVICES)
23YG          SEGENTRY K1WHATPER,QK1WHATPER 
24D6    #   
25X2    #   
266S ...      SEGENTRY K7WHATPER,QK7WHATPER [ REENTER FOR NEXT PARAM
26BL    # THIS SEGMENT IMPLEMENTS THE 1ST PART OF THE WHATPER OPERATORS COMMAND 
26W=    # IT ANALYSES AND CHECKS THE PARAMETER . IT HAS TWO PATHS: ONE FOR A
27*W    # GEOG NO PARAM AND ONE FOR DEVICE TYPE: A BLOCK OF CORE IS SET UP IN   
27TG    # BOTH CASES (THE LENGTH BEING CALCULATED BY SCANNING THE DEVICE LIST   
28*6    # IN THE LATTER CASE) AND ANY FILES NEEDED FOR INFORMATION. THEN ANY
28SQ    # INFORMATION FROM THE DEVICE LIST, AND APIA AND JOB BLOCK IF RELEVANT, 
29#B    # IS MOVED INTO THE BLOCK AND CONTROL PASSED TO WHATPERA. FOR THE SECOND
29S2    # CASE, IF THERE IS NOT ENOUGH ROOM IN THE BLOCK, GEOERR SHORTWPB   
2=?L    #     INFORMATION FOR OPENING  SYSTEM.PROPERTY  
2Y=Q    ZFABS          +10  
2YQB                   12HSYSTEM
2^=2                   12HPROPERTY  
2^PL                   +0   
329=                   +1   
32NW                   4HB1 
35BS    XFANON         +FANONCT 
35LL    PB    +28   
366=    SLOW  +9
36KW    QUICK +25   
375G    MTNO  +5
37K6    THREE +3
384Q    TWO   +2
38JB    SD    4H*DR 
3942    XFD   4H*FD 
39HL    UDALL 4H*DA 
3=3=          +13   
3=GW          +26   
3?2G    #     S/R TO CHECK IF DEVICE IS LIKELY TO HAVE ANY PROPERTIES   
3?G6    #     AND TO SET AWORK4=1 IF SO, ELSE =0. S/R USES X0&X4
3?^Q    PROPCHEC
3#FB          SBN   0  1
3#^2          BZE   0 SETP                 [TP? 
3*DL          SBN   0  1
3*Y=          BZE   0  SETP                [LP? 
3BCW          SBN   0  2
3BXG          BZE   0  SETP                [CP? 
3CC6          SBN   0  5
3CWQ          BZE   0  SETP                [DRUM?   
3DBB          SBN   0  16   
3DW2          BZE   0  SETP                [HD? 
3F*L          SBN   0  3
3FT=          BZE   0  SETP                [IPB28?  
3G#W          SMO      FX2  
3GSG          STOZ     AWORK4   
3H#6          EXIT  4  0
3HRQ    SETP  LDN   0  1
3J?B          SMO      FX2  
3JR2          STO   0  AWORK4   
3K=L          EXIT  4  0
3KQ=    QK1WHATPER  
3L9W          STOZ     AWORK1(2)
3L=B ...#SKI G203&1 
3L=W ...(   
3L?B ...      PARANUMB 7
3L?W ...      BZE   7  XJPARMIS 
3L#B ...      PARSORTB XBRK,ALL,NOCLUS,INCOUT,SMLCC 
3L#W ...      BRN      RU2  
3L*B ...RIPB  ACROSS   WHATPERX,1   
3L*W ...QK7WHATPER  
3LBB ...      MFREEW   CPAR,JSCE
3LBW ...      VFREEW   ADATA,AWPER  
3LCB ...      LDX   1  FX1  
3LCW ...      STOZ     AWORK1(2)
3LDB ...RU2 
3LDW ...      HUNTW    3,CPAR,JSCE  
3LFB ...      BNG   3  UP                  [ ERROR REPORTED IF NO BLOCK FOUND   
3LFW ...      LDCH  5  JSCEA(3)            [ BASIC PERIPHERAL TYPE  
3LGB ...      LDX   6  JSCEP(3)            [ DEVICE LIST PTR OR ZERO
3LGW ...      BZE   6  PTYPE               [ *PT FORMAT 
3LHB ...      ANDX  6  BITS22LS            [ MASK OUT INVALID CLUSTER BITS  
3LHW ...      STO   6  JSCEP(3) 
3LJB ...      SAWCEJX  JSCEB(3),SWIT,RIPB   
3LJW ...      JENVNOT  SWIT,CME 
3LKB ...      LDX   4  JSCEA(3) 
3LKW ...      ANDX  4  BSB18
3LLB ...      BNZ   4  SWIT 
3LLW ...      ACROSS   WHATPERB,2   
3LMB ...)   
3LMW ...#SKI G203&1$1   
3LNB ...(   
3LPG          PARSORTB XBRK,NOCLUS,INCOUT,SMLCC  [ANALYSE PERI DESC.
3PM=          HUNTW    3,CPAR,JSCE  
3Q6W          BNG   3  UP                  [J IF PARSORT FOUND ERROR
3Q=R          LDX   4  JSCEP(3) 
3QBN          ANDX  4  BITS22LS 
3QGK          STO   4  JSCEP(3)            [CLEAR CLUSTER BITS  
3QLG          LDX   4  JSCEQ(3) 
3R66          SRL   4  12   
3RKQ          PARANOTX 4                   [PASS PARAM FOR USE IN MESSAGES AND .
3S5B    [                                   ANALYSIS OF LOCAL PERI  
3SK2          MHUNTW   3,CPAR,JSCE  
3T4L          LDX   0  JSCEP(3) 
3TJ=          BZE   0  PTYPE               [J IF *PT TYPE PARAM 
3W3W          SAWCEJX  JSCEB(3),YLOCAL,XINVALID [J IF NOT MX LINE   
3WHG          JENVNOT  XINVALID,CME 
3X36          LDX   4  JSCEA(3) 
3XGQ          ANDX  4  BSB18
3Y2B          BNZ   4  XINVALID            [J IF SPECIFIED PCT  
3YG2          ACROSS   WHATPERB,2   
4PBW    YLOCAL  
4PWG          LDX   0  JSCEA(3) 
4QB6          ANDN  0  #777                [GET GEOG NUMBER 
4QTQ          STO   0  ACOMMUNE1(2) 
4R*B          FREECORE 3
4RT2 ...)   
546L    #   
54L=    #     CHECK  SWITCH WORD:- IF ANOTHER OPERATOR COMMAND IN PROGRESS  
555W    #                          WAIT UNTIL IT HAS FINISHED   
55KG    #   
5656    SWIT  BSOFF    AWHATBIT,NOWAIT     [J IF SWITCH OFF - ALL CLEAR 
56JQ          COOR3    #114                [WAIT A WHILE
574B          BRN      SWIT 
57J2    NOWAIT  
57TQ ...      CALL  4  WSON 
587H ...#SKI G203&1 
58?D ...(   
58C* ...      SETNCORE K54-K50+19,3,ADATA,AWPER [ BLOCK FOR DVLIST & JOBQ   
58H= ...      LDX   2  6                   [ DV LIST PTR
58M7 ...)   
58R4 ...#SKI G203&1$1   
58W^ ...(   
592W          LDX   4  ACOMMUNE1(2)        [CONVERTED NUMBER
59GG          BZE   4  XINVALID            [ERROR IF NOT
5=26          BNG   4  XINVALID            [POSITIVE NUMBER 
5=FQ          SETNCORE K54-K50+19,3,ADATA,AWPER [BLOCK FOR DEV LIST & JOBQ  
5=^B    #UNS AV7900S
5?F2          FINDPERE 2,APGEOG,4,,AV7900,SWOU  [X2 -> ENTRY (INCL. V7900)  
5?YL    #UNS AV7900S
5#D=    #SKI
5#XW          FINDPERE 2,APGEOG,4,,,SWOU        [X2 -> ENTRY
5*CG          BNG   2  UNINST   
5*M#    SWOU
5*X6          LTYPE    2,5                 [GET DEVICE TYPE 
5B6Y ...)   
5BBQ          CALL  0  SET7                [SET X7= -1 UNLESS MT WHEN SET X7=0  
5BWB          LDX   0  5
5CB2          CALL  4  PROPCHEC 
5CTL          BNG   7  NOFIL
5D5D ...#SKI G203&1$1   
5D*=          LDX   6  2
5DSW          CALL  4  SYSDOC              [SET X7 = NO OF FILES TO OPEN
5F#G          CALL  4  OPENFILES           [OPEN FILES + CREATE BLOCKS  
5FS6          MHUNTW   3,ADATA,AWPER
5G?Q          LDX   2  6                   [RESTORE POINTER 
5GRB    NOFIL LDX   7  5                   [SAVE X5 
5H?2          LDX   4  2
5HQL          LDN   5  1
5J==          STO   5  A1+1(3)             [COUNT OF RECS IN ADATA/AWPER BLK
5JPW          LDN   5  A1+5(3)  
5K9G          MOVE  4  K54-K50             [MOVE DLIST RECORD INTO /AWPER BLOCK 
5KP6          ADN   5  K54-K50  
5L8Q          JONL     2,ONLI   
5LNB          ADN   5  7
5M82          BRN      MAINR
5MML    ONLI  CALL  0  SRJOB
5N7=    MAINR LDX   3  5
5NLW          CALL  0  PIA  
5P6G          CALL  0  WPROPS   
5PL6          LDX   5  7                   [RESTORE DEV TYPE
5Q5Q          BRN      MAINS               [JOIN OUTPUT ROUTINE 
5QKB    #   
5R52    #           ROUTINE TO DEAL WITH CASE OF PERIPHERAL TYPE
5RJL    #   
5S4=    #     1ST SEARCH OF DEVICE LIST 
5SHW    #   
5SMR ...#SKI G203&1 
5SRN ...(   
5SXK ...PTYPE   
5T3G ...      LDX   4  JSCEQ(3) 
5T7C ...      ANDN  4  #7777
5T?# ...      SBN   4  3
5TC9 ...      BNZ   4  PFERR
5TH6 ...      LDX   4  JSCER(3) 
5TM3 ...)   
5TQY ...#SKI G203&1$1   
5TWT ...(   
5W2Q    PTYPE   
5WGB          LDX   5  JSCEA(3) 
5X22          SRL   5  18                  [PERI TYPE   
5XFL          FREECORE 3
5X^= ...)   
65SQ    SWIC  BSOFF    AWHATBIT,NOWT       [J IF ALL CLEAR -NO OTHER OP ACTIVITI
66#B          COOR3    #114                [WAIT FOR ONE TO FINISH  
66S2          BRN      SWIC 
673S ...NOWT  LDX   3  4
67?L ...      CALL  4  WSON 
67HD ...      LDX   4  3
67R= ...#SKI G203&1$1   
68=W ...(   
6#7W          MHUNT    3,CPB,CUNI   
6#MG          LDX   4  APARA(3) 
6#X# ...)   
6*76          BXU   4  XFD(1),NOTFD        [IF TYPE *FD 
6*LQ          LDN   5  13                  [THEN SET X5=13  
6B6B    NOTFD CALL  0  SET7 
6BL2          LDN   3  0                   [COUNT OF WORDS FOR ADATA,AWPER BLOCK
6C5L          LDN   6  0
6C=S          STOZ     ACOMMUNE1(2) 
6CD2          STOZ     ACOMMUNE2(2) 
6CK=    #UNS AV7900S
6D4W    SCAN1 FINDPERE 2,APFOTY,5,REENTRY,AV7900,SCN1,SCN3  
6DJG    #UNS AV7900S
6F46    #SKI
6FHQ    SCAN1 FINDPERE 2,APFOTY,5,REENTRY,,SCN1,SCN3
6G3B          BNG   2  ZEND                [ALL DONE?   
6G?8    SCN1
6GH2          ADN   3  K54-K50+14   
6H2L          BNG   7  REENTRY             [NO NEED TO OPEN FILES?  
6HG=          CALL  4  SYSDOC   
6H^W          BRN      REENTRY             [GET NEXT RECORD 
6J4F    SCN3
6J5Q ...      ADN   3  K54-K50+14   
6J74          LDN   0  1
6J9M          SMO      FX2  
6J#=          ADS   0  ACOMMUNE1
6JBT          JSWIN    2,REENTRY
6JFD          LDN   0  1
6JJ3          SMO      FX2  
6JLL          ADS   0  ACOMMUNE2
6JP9          BRN      REENTRY  
6JPG ...#SKI G203&1 
6JPR ...(   
6JQ4 ...ZEND
6JQ* ...      MHUNTW   1,CPAR,JSCE  
6JQL ...      LDX   4  JSCER(1) 
6JQX ...)   
6JR8 ...#SKI G203&1$1   
6JRF ...(   
6JRS    ZEND
6JWC          MHUNT    1,CPB,CUNI   
6J^6          LDX   4  APARA(1) 
6K8Y ...)   
6KDQ          LDX   1  FX1  
6KYB          BXU   4  UDALL(1),ZEND2   
6LD2          ADN   6  1
6LXL          BXE   6  THREE(1),ZEND1   
6MC=          SMO      6
6MWW          LDX   5  UDALL(1) 
6NBG          BRN      SCAN1
6NW6    ZEND1 LDN   5  6
6P*Q          BRN      ZEND4
6PTB    ZEND2 BXU   4  SD(1),ZEND4  
6Q*2          ADN   6  1
6QSL          BXE   6  TWO(1),ZEND3 
6R#=          LDN   5  25   
6RRW          BRN      SCAN1
6S?G    ZEND3 LDN   5  9
6SHY    ZEND4   
6SSC          LDX   2  FX2  
6STN          LDX   4  ACOMMUNE1(2) 
6SW# ...      STO   4  AWORK3(2)
6SW^          BZE   4  ZEND5
6SY=          LDX   6  ACOMMUNE2(2) 
6S^H          OUTNUM   4,0  
6T2S          OUTNUM   6,0  
6T2^ ...#SKI G203&1 
6T36 ...(   
6T3? ...      OUTPARN  3,JSCER,CPAR,JSCE
6T3D ...)   
6T3K ...#SKI G203&1$1   
6T3Q ...(   
6T45          OUTPARN  3,APARA,CPB,CUNI 
6T4P ...)   
6T5B          SMO      FX1  
6T6M          LDX   4  XFANON   
6T7Y          MONOUTX  4
6T8=    ZEND5   
6T8G ...      LDX   4  3
6T8Q ...      LDX   0  AWORK3(2)
6T92 ...ZEND6   
6T9= ...      SBN   0  1
6T9G ...      BNG   0  ZEND7
6T9Q ...      SBN   4  K54-K50+14   
6T=2 ...      BRN      ZEND6
6T== ...ZEND7   
6T=G ...      BZE   4  UNTYPE   
6T=Q          ADN   3  5                   [1 FOR INT PTR, 1 FOR REC COUNT, +3  
6TQB          BNG   7  XGET                [BRN IF NO OPENS REQUIRED
6W=2          LDX   0  5
6WPL          CALL  4  PROPCHEC 
6X9=          CALL  4  OPENFILES           [OPEN FILES + CREATE DATA BLOCKS 
6XNW    XGET  SETUPCOR 3,3,ADATA,AWPER     [BLOCK FOR PLIST ENTRIES ETC 
6Y8G    #   
6YN6    #     2ND PASS OF DEVICE LIST   
6^7Q          STO   5  7
6^MB          LDX   6  ALOGLEN(3)   
7272          SBN   6  4                   [X6 CONTAINS SPACE LEFT IN BLK   
72LL          STOZ     ACOMMUNE1(2)        [INITIALIZE FOR COUNT OF RECS
736=          LDN   5  A1+5(3)  
73KW          STOZ     AWORK3(2)
745G    #UNS AV7900S
74K6    SCAN2 FINDPERE 2,APFOTY,7,REENT,AV7900,SCN2 
754Q    #UNS AV7900S
75JB    #SKI
7642    SCAN2 FINDPERE 2,APFOTY,7,REENT,,SCN2   
76HL          BNG   2  PHEW 
76RD    SCN2
773=          LDN   4  1
77GW          SMO      FX2  
782G          ADS   4  ACOMMUNE1           [ADD 1 TO COUNT OF RECS  
78G6          LDX   4  2
78^Q          SBN   6  K54-K50+14   
79FB          BNG   6  SHORT               [J IF NO ROOM
79^2          MOVE  4  K54-K50             [MOVE DEVICE LIST REC INTO BLOCK 
7=DL          ADN   5  K54-K50             [AND UPDATE POINTER  
7=Y=          JONL     2,ONLIN  
7?CW          ADN   5  7
7?XG          BRN      TESTM
7#C6    ONLIN CALL  0  SRJOB
7#WQ    TESTM LDX   3  5
7*BB          CALL  0  PIA  
7*W2          LDX   0  7
7B*L          CALL  4  PROPCHEC 
7BT=          CALL  0  WPROPS   
7C#W          LDX   5  3
7CSG          ADN   5  5
7D#6          BRN      REENT
7DRQ    PHEW
7DTN ...#SKI G203&1 
7DXL ...(   
7D^J ...      MHUNTW   1,CPAR,JSCE  
7F3G ...      LDX   4  JSCER(1) 
7F5D ...)   
7F7B ...#SKI G203&1$1   
7F9# ...(   
7F?B          MHUNT    1,CPB,CUNI   
7FR2          LDX   4  APARA(1) 
7G2S ...)   
7G=L          LDX   1  FX1  
7GQ=          BXU   4  UDALL(1),PHEW2      [IF *DA PARAM
7H9W          LDX   2  FX2  
7HPG          LDX   4  AWORK3(2)
7J96          ADN   4  1
7JNQ          BXE   4  THREE(1),PHEW1      [THEN GET THE NEXT   
7K8B          STO   4  AWORK3(2)
7KN2          SMO      4
7L7L          LDX   7  UDALL(1)            [UDAS DEV TYPE IN X7 
7LM=          BRN      SCAN2
7M6W    PHEW1 LDN   7  6
7MLG          BRN      PHEW4
7N66    PHEW2 BXU   4  SD(1),PHEW4  
7NKQ          LDX   2  FX2  
7P5B          LDX   4  AWORK3(2)
7PK2          ADN   4  1
7Q4L          BXE   4  TWO(1),PHEW3 
7QJ=          STO  4   AWORK3(2)
7R3W          LDN   7  25   
7RHG          BRN      SCAN2
7S36    PHEW3 LDN   7  9
7SGQ    PHEW4 SBN   6  1
7T2B          BNG   6  SHORT
7TG2          MHUNTW   3,ADATA,AWPER
7T^L          SMO      FX2  
7WF=          LDX   5  ACOMMUNE1
7WYW          STO   5  A1+1(3)             [SAVE COUNT OF RECS IN ADATA/AWPER BL
7XDG          LDX   5  7                   [RESTORE PERIPHERAL TYPE 
7XY6    MAINS   
82TW    QENTRY2 
8=?B          CALL  0  SET7 
8=BG          BZE   7  MAINU
8=FL          ACROSS   WHATPERB,1   
8=JQ    MAINU   
8=MW          ACROSS   WHATPERA,1          [PROCESS DATA BLOCK + OUTPUT MESSAGES
8?7G    #   
8DHB    #   
8F32    #   
8FGL    #     S/R TO SET X7=0 FOR DEV TYPES 0 TO 5, DRUMS & IPB28'S, ELSE -1
8G2=    #   
8GFW    SET7  LDN   4  5
8G^G          SBX   4  5
8HF6          BPZ   4  YES  
8HYQ          ADN   4  4
8JDB          BZE   4  YES  
8JY2          ADN   4  16   
8KCL          BZE   4  YES  
8KX=          ADN   4  3
8LBW          BZE   4  YES  
8LWG          NGN   7  1
8MB6          EXIT  0  0
8MTQ    YES   LDN   7  0
8N*B          EXIT  0  0
8NT2    #   
8P#L    #     SUBROUTINE TO DECIDE WHETHER ITS NECESSARY TO OPEN SYSTEM.DOCUMENT
8PS=    #     AND SYSTEM.SERIAL . IF BOTH,X7 IS SET TO 2; IF ONLY SYS.DOC SET TO
8Q?W    SYSDOC  
8QRG          TXU   7  TWO(1)   
8R?6          BCC      XIT2                [EXIT IF X7=2
8RQQ          TXU   5  SLOW(1)  
8S=B          BCC      XIT2                [J IF DRUM TYPE9 
8SQ2          TXU   5  QUICK(1) 
8T9L          BCC      XIT2                [OR TYPE 25  
8TP=          TXU   5  PB(1)
8W8W          BCC      XIT2                [J IF IPB28  
8WNG          JONL     2,MTEST             [J IF ONLINE 
8X86          TXU   5  MTNO(1)  
8XMQ          BCC      MT                  [J IF MT 
8Y7B          JFREE    2,XIT2              [J IF IDLE   
8YM2          LDN   7  1
8^6L    XIT2  EXIT  4  0
8^L=    MTEST TXU   5  MTNO(1)  
925W          BCS      XIT2                [J IF NOT MT 
92KG    MT    DFJUMPS  2,WORK,XIT2         [J IF WORKTAPE   
9356          LDN   7  2
93JQ          EXIT  4  0
944B    #   
94J2    #     SUBROUTINE TO OPEN SYSTEM.DOCUMENT AND SYSTEM.SERIAL IF X7=2, AND 
953L    #     OPEN SYSTEM.DOCUMENT ONLY IF X7=1 
95H=    #   
962W    OPENFILES   
96GG          SMO      FX2                 [KEEP CT OF FILES OPENED 
9726          STO   7  AWORK1              [FOR COMMAND 
97FQ          SBX   4  FX1  
97^B          BZE   7  XIT3A               [J IF NOT DOC OR SERIAL TO BE OPENED 
98F2          OPENSYS  XBRK,DOCUMENT,READ   
98YL          TESTREPN OK,RONGREP   
99D=          GETCOREN 7,1  
99XW          FINDCORE 2
9=CG          NAME     2,ADATA,AWDOC
9=X6          TXU   7  TWO(1)   
9?BQ          BCS      XIT3A
9?WB          OPENSYS  RONGO,SERIAL,READ
9#B2          TESTREPN OK,RONGREP   
9#TL    XIT3A   
9**=          SMO      FX2  
9*SW          LDX   0  AWORK4   
9B#G          BZE   0  XIT3B               [J IF NO PROPERTIES  
9BS6          SETNCORE 10,2,FILE,FABSNB 
9C?Q          ADN   1  ZFABS
9CRB          ADN   2  A1   
9D?2          MOVE  1  10   
9DQL          OPEN     RONGO,READ          [OPEN SYSTEM.PROPERTY
9F==          TESTREPN OK,RONGREP   
9FPW          LDN   0  1
9G9G          ADS   0  AWORK1(2)           [UPDATE COUNT OF FILES OPEN  
9GP6    XIT3B   
9H8Q          ADX   4  FX1  
9HNB    XIT3  EXIT  4  0
9J82    #   
9JML    #     SUBROUTINE TO EXTRACT THE JOB AND USER NAMES FROM THE JOB BLOCK   
9K7=    SRJOB LJOBNO   2,1                 [GET JOB NUMBER  
9KLW          STO   2  4                   [PRESERVE X2 
9L6G          SMO      5
9LL6          STO   1  0
9M5Q          ADN   5  1
9MKB          SMO      FX2  
9N52          STO   0  ACOMMUNE5
9NJL          JOBLOCK  1,1  
9P4=    SRJ1  LDX   2  4
9PHW          SMO      FX2  
9Q3G          LDX   0  ACOMMUNE5
9QH6          BNG   1  XIT4 
9R2Q          LDX   4  ALOGLEN(1)   
9RGB          SBN   4  ASTJOB   
9S22          BZE   4  XIT4                [J IF NO USER
9SFL          LDN   4  JUSER(1) 
9S^=          MOVE  4  3
9TDW          ADN   5  3                   [UPDATE POINTER IN DATA BLOCK
9TYG          LDN   4  JNAME(1) 
9WD6          MOVE  4  3
9WXQ          ADN   5  3
9XCB          EXIT  0  0
9XX2    XIT4  ADN   5  6
9YBL          EXIT  0  0
9YW=    #   
9^*W    #     S/R TO CHECK IF DEV IS IPB(28),UDAS OR MT 
9^TG    #     IPB(TYPE 28): GETS NO OF LINKS USING IT   
=2*6    #     UDAS: CHECKS "IN USE BY SYSTEM" BIT   
=2SQ    #     MT: GETS TSN AND ALSO CHECKS IF TAPE LOADED,  
=3#B    #     AND IF NONSTANDARD, POOL OR WORKTAPE. 
=3S2    #   
=4?L    PIA 
=4R=          STOZ     4
=5=W          SMO      FX2  
=5QG          STO   0  ACOMMUNE5
=6=6          SMO      FX2  
=6PQ          STO   7  AWORK2   
=79B          SBN   7  5
=7P2          BZE   7  TAPE                [J IF MAG TAPE   
=88L          SBN   7  1
=8N=          BZE   7  UDAS                [J IF UDAS DEV TYPE 6
=97W          SBN   7  1
=9MG          BZE   7  UDAS                [OR 7
==76          SBN   7  6
==LQ          BZE   7  UDAS                [J IF UDAS - TYPE 13 
=?6B          SBN   7  13   
=?L2          BZE   7  UDAS                [J IF UDAS - TYPE 26 
=#5L    #SKI  IPCV1-1   
=#K=          BRN      XIT5 
=*4W    #SKI  IPCV1 
=*JG    (   
=B46          SBN   7  2
=BHQ          BNZ   7  XIT5                [J IF NOT IPB - TYPE 28  
=C3B          NUMLINK  2                   [X0 CONTAINS NO OF LINKS 
=CH2          LDX   4  0
=D2L          BRN      XIT5A
=DG=    )   
=KBG    UDAS  JTWIN    2,TWUD   
=KW6          BRN      UDAS1
=L*Q    TWUD  LDN   4  #200 
=LTB          LADDP    2,1  
=M*2          JSHARED  1,UDAS1  
=MSL          SRL   4  1
=N#=          JDED     1,UDAS1  
=NRW          SRL   4  1
=P?G    UDAS1 LDXC  5  2(1) 
=PR6          BCC      XIT5A
=Q=Q          ADN   4  #20  
=R=2          BRN      XIT5A
=RPL    TAPE  DFLOAD   2,TSN,4  
=S9=          STO   4  0(3)               [SAVE TSN 
=SNW          DFLOAD   2,NONS,4 
=T8G          BNZ   4  TAPLO               [J IF NONKTANDARD
=TN6          DFLOAD   2,WORK,4 
=W7Q          SLL   4  1
=WMB          BNZ   4  TAPLO               [J IF WORK   
=X72          DFLOAD   2,POOL,4 
=XLL          SLL   4  2
=Y6=    TAPLO DFJUMPN  2,LOAD,XIT5A        [J IF TAPE NOT LOADED
=YKW          ADN   4  #10  
=^5G    XIT5A STO   4  1(3) 
=^K6    XIT5  SMO      FX2  
?24Q          LDX   0  ACOMMUNE5
?2JB          ADN   3  2
?342          SMO      FX2  
?3HL          LDX   7  AWORK2   
?43=          EXIT  0  0
?4GW    #   
?52G    #     S/R TO MOVE APERPROP WORDS INTO ADATA/AWPER BLOCK 
?5G6    #   
?5^Q    WPROPS  
?6FB          SMO      FX2  
?6^2          LDX   5  AWORK4   
?7DL          BZE   5  NPROP               [J IF NOT SLOW O/P PERIPHERAL
?7Y=          LADDP    2,1  
?8CW          LDN   4  APERPROP(1)  
?8XG          LDX   5  3
?9C6          MOVE  4  ATTMAX              [MOVE PROP WORDS 
?9WQ          EXIT  0  0
?=BB    NPROP STOZ     0(3) 
?=W2          LDX   4  3
??*L          LDN   5  1(3) 
??T=          MOVE  4  ATTMAX-1            [ZEROISE PROP WORD AREA IN WP BLOCK  
?##W          EXIT  0  0
?#B? ...#   
?#CN ...#   
?#F5 ...#   
?#GG ...#   
?#HX ...#   
?#K# ...#   
?#LP ...WSON
?#N6 ...      OPSCON   WSSET,XIT6   
?#PH ...WSSET ON       AWHATBIT 
?#QY ...XIT6  EXIT  4  0
?#SG    #   
?*#6    #     COMMAND ERROR REPORTING   
?*RQ    #   
?B?B    XJPARMIS
?BR2          CALL  1  MISTAKE  
?C=L          +JPARMIS  
?CQ=    XINVALID
?DPG          OFF      AWHATBIT 
?F96          CALL  1  MISTAKE  
?FNQ          +JSETP1   
?G8B    UNINST  
?H7L          OFF      AWHATBIT            [MARK AS ALL CLEAR   
?HM=          CALL  1  MISTAKE  
?J6W          +JNOPER   
?JLG    PFERR CALL  1  MISTAKE  
?K66          +ERRPERC  
?KKQ    UNTYPE  
?LK2          OFF      AWHATBIT            [MARK AS ALL CLEAR   
?M4L          CALL  1  MISTAKE  
?MJ=          +FUNTYPE  
?N3W    MISTAKE 
?N4^ ...#SKI G203&1 
?N64 ...(   
?N77 ...      HUNTW    3,CPAR,JSCE  
?N8= ...      BNG   3  RU1  
?N9* ...      LDX   7  JSCEQ(3) 
?N=D ...      SRL   7  12   
?N?H ...      LDX   6  0(1) 
?N#L ...      PARANOTX 7                   [ GET PARAMETER BLOCK FOR ERROR  
?N*P ...      ERRORX   6
?NBS ...      MFREE    CPB,CUNI 
?NCX ...      BRN      QK7WHATPER          [ GO BACK FOR NEXT PARAM 
?NF2 ...RU1 
?NG5 ...)   
?NHG          COMERRX  0(1) 
?P36    RONGO   
?PGQ          LDX   7  AWORK1(2)
?Q2B          BZE   7  UP   
?QG2    XCL   CLOSE                        [CLOSE ALL FILES OPEN FOR COMMAND
?Q^L          BCT   7  XCL  
?RF=    XBRK  COMBRKIN  
?RHT ...#SKI G203&1$1   
?RLD ...(   
?RP3 ...QK7WHATPER  
?RRL ...      GEOERR   1,NO-WP7 
?RW9 ...)   
?RYW    RONGREP 
?SDG          GEOERR   1,WRONGREP   
?SY6    SHORT   
?TCQ          GEOERR   1,SHORTWPB          [NOT ENOUGH ROOM IN WP BLOCK 
?TXB    UP  
?WWL          FON      #114 
?XB=          ENDCOM
?XTW          MENDAREA 50,K99WHATPER
?Y*G    #END
^^^^ ...211557750004