IN :GEOSOURCE,FILEINPARS1(1)
,(4671012)
GOTO867(4),:GEO.GOTO867(4)
IFEXPAN867(3),:GEO.IFEXPAN867(3)
IFNUMS867(2),:GEO.IFNUMS867(2)
OPCA867(5),:GEO.OPCA867(5)
QUESCOM867(3),:GEO.QUESCOM867(3)
RIGHT867(4),:GEO.RIGHT867(4)
VCLASTWO867(6),:GEO.VCLASTWO867(6)
VERBCLAS867(3),:GEO.VERBCLAS867(3)
WHATPER867(4),:GEO.WHATPER867(4)
WHATPERA867(2),:GEO.WHATPERA867(2)
****
IN :GEOSOURCE,FILEINPARS2(1)
,(4671013)
ARCHIVE867(1),:GEO.ARCHIVE867(1)
CHNUMCON867(3),:GEO.CHNUMCON867(3)
LIBCOM867(3),:GEO.LIBCOM867(3)
NETOFLNE867(1),:GEO.NETOFLNE867(1)
OFFREL867(2),:GEO.OFFREL867(2)
ONLINEB867(2),:GEO.ONLINEB867(2)
SETPARAM867(6),:GEO.SETPARAM867(6)
SETPRAMB867(1),:GEO.SETPRAMB867(1)
SWITCH867(13),:GEO.SWITCH867(13)
WHATPERB867(4),:GEO.WHATPERB867(4)
WHATPERX867(18),:GEO.WHATPERX867(18)
****
IN :GEOSOURCE,RESPACK(1),T####
OFR MT0,ICLKGSNED867
RES G3MK8D
#LIS 3
#PRO ,6
#WOR ,6
#COR 50
[
[
 LOSEMACRO MOPSTATE
[
#MAC  MOPSTATE
      JALLOC   %A,MMOPSTATE1        [J. IF ALLOCATED TO AN ACTIVITY
      BRN      MMOPSTATE2
MMOPSTATE1
      JONL     %A,MMOPSTATE14       [J. ONLINE TO OBJECT PROG.
      LDX   1  %A
#STR  %C
(
[
[     IPB
[
      LAMOP    1,2
      LDCT  %B #030
      ANDX  %B IPBSW(2)             [MASK IPB SWITCH WORD
      BNZ   %B MMOPSTATE4           [J. IF EITHER BIT SET
      HUNT2J   1,AMXOR,ADEVS,2,MMOPSTATE3  [J IF ADEVS MISSING
      STOZ     %B
      BRN      MMOPSTATE8           [%B = ZERO MOPPED ON
MMOPSTATE3
      LDX   %B GSIGN                [%B = NEG MOPPED OFF
      BRN      MMOPSTATE8
MMOPSTATE4
      SLC   %B 6
      BRN      MMOPSTATE8           [%B = 1,2, OR 3
)
#STR  %C
#SKI
(
[
[     CHARACTER BUFFERING
[
      LAMOP   1,2                   [FIND AMOP
      HUNT2J   1,AMXOR,ALINES,2,MMOPSTATE13 [J IF ALINES MISSING MOP OFF
      LDX   0  ALOGLEN(1)
      SBN   0  4
      BZE   0  MMOPSTATE10          [J UNIPLEXOR
      ADN   1  4                    [STEP FIRST ENTRY IN ALINES
MMOPSTATE10
      LDX   2  FX2
      STOZ     %B                   [%B = ZERO MOPPED ON
      LDCT  0  #140
      ANDX  0  A1+FOURTHWD(1)       [MASK FOURTHWD B2 AND B3
      SLL   0  2
      BPZ   0  MMOPSTATE11          [J MOPPED ON OR BEING MOPPED ON
      LDN   %B 2                    [%B =2 BEING MOPPED OFF
MMOPSTATE11
      SLL   0  1
      BZE   0  MMOPSTATE8           [J. IF B3 NOT SET
      ADN   %B 1                    [%B = 1 BEING MOPPED ON
                                    [%B = 3 BEING MOPPED ON & OFF
      BRN      MMOPSTATE8
MMOPSTATE13
      LDX   %B GSIGN
      BRN      MMOPSTATE8           [%B = NEG MOPPED OFF
)
MMOPSTATE2
      LDN   %B 5
      BRN      MMOPSTATE8
MMOPSTATE14
      LDN   %B 4                    [UNIT ONLINED
MMOPSTATE8
#STR  %D
#SKI
(
      LDX   2  FX2
)
      LDX   1  FX1
#NOR
[
 MENDIT :GEO,RIGHT,867,4
 MENDIT :GEO,SWITCH,867,13
 MENDIT :GEO,WHATPERB,867,2004
 MENDIT :GEO,WHATPERX,867,18
 MENDIT :GEO,ONLINEB,867,2002
 MENDIT :GEO,LIBCOM,867,2003
[
[
[  G3UG MENDS
[
[ M205 ENHANCED WP FOR REMOTE DEVICES
[
#ALT G203=1
 MENDIT :GEO,WHATPER,867,4
 MENDIT :GEO,WHATPERA,867,2
 MENDIT :GEO,WHATPERB,867,2004
[
[ M250 ADDITIONAL NUMBER FORMATS
[
#ALT G250=1
 MENDIT :GEO,IFNUMS,867,2
 MENDIT :GEO,SETPARAM,867,6
 MENDIT :GEO,SETPRAMB,867,1
 MENDIT :GEO,CHNUMCON,867,3
[
[ M261 ADDITIONAL PARAMETERS IN GOTO
[
#ALT G261=1
 MENDIT :GEO,GOTO,867,4
[
[ M262 WHATGENS COMMAND
[
#ALT G262=1
 MENDIT :GEO,VCLASTWO,867,6
 MENDIT :GEO,SETPARAM,867,6
[
[ M263 HOWBIG COMMAND
[
#ALT G263=1
 MENDIT :GEO,VERBCLAS,867,3
 MENDIT :GEO,SETPARAM,867,6
[
[ M268 CHUCKOFF COMMAND
[
#ALT G268=1
 MENDIT :GEO,ARCHIVE,867,1
 MENDIT :GEO,VERBCLAS,867,3
[
[ M275 NEW IF CONDITIONS
[
#ALT G275=1
 MENDIT :GEO,IFEXPAN,867,3
[
[ M374 QUESTION TO INCLUDE JOB NUMBER
[
#ALT G374=1
 MENDIT :GEO,QUESCOM,867,3
[
[ M550 *LP OUTPUT TO *MT
[
#ALT G550=1
 MENDIT :GEO,VCLASTWO,867,6
 MENDIT :GEO,OFFREL,867,2
[
[
[  RESTORE TIME MACROS
[
[
 NEWSLETTER OFF
# FSRELOAD
 NOPARTRES
 BMJWLOSE GENRES
 ABSA ON
# ULRVTAPES
 COREMOVE 3
 HLSOFF
# FASTCONC
 INOPTIME CHAR,5
 INOPTIME MESS,5
 IPCREOFF
 NPUSIZE 597
 LISTDC2 ON
 DX
 STAPE PE
 UDASTYPE DA
 LFDBAID
 LFDEBATCHERS
 LFENDTHROW
 LFPAPERSAVE OFF
 LFTHROW OFF
# LPS ON
 WHATRET ON
 FSDESC
 FSFILE 3,6,G3FSRES3,310002
 FSFILE 4,6,G3FSRES4,310003
 FSFILE 5,6,G3FSRES5,310004
 FSFILE 10,6,G3SWAPRES,310001,SWAP
 ENDESC
#LIS 0
#DEL
#DEL
####
IN :GEO,LIBCOM867(2003),T####
22FL          SEG      LIBCOM,6,N.R.BOULT,LIBRARY
22LS ...[
22S2 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD
22^=    #
23DW          SEGENTRY K1LIBCOM,QK1LIBCOM
23YG          SEGENTRY K2LIBCOM,QK2LIBCOM
24D6          SEGENTRY K3LIBCOM,QK3LIBCOM
24XQ          SEGENTRY K4LIBCOM,QK4LIBCOM
25CB          SEGENTRY K5LIBCOM,QK5LIBCOM
25X2          SEGENTRY K7LIBCOM,QK7LIBCOM
26BL          SEGENTRY K8LIBCOM,QK8LIBCOM
26LD ...      FSHENTRY K9LIBCOM,QK9LIBCOM,,QK9LIBCOM
26W=    #              THIS SEGMENT DEALS WITH MOST OF THE ERROR REPORTING ON TH
27*W    #           PARAMETERS OF THE NEW, GET, RETURN, DEAD, TAPEWRING &
27TG    #           TAPERIGHT COMMANDS WHICH ENTER THE SEGMENT AT K1, K2, K3, K4
28*6    #           K7 & K8 RESPECTIVELY. THE ERRORS REPORTED ON ARE:-
28SQ    #              NO PARAMETER
29#B    #              ERROR IN FORMAT OF NAME
29S2    #              DEVICE TYPE QUALIFIER MISSING TO NAME
2=?L    #              DEVICE TYPE QUALIFIER NOT (*MT)
2=R=    #              NAME GIVEN (NEW,DEAD, TAPEWRING & TAPERIGHT ONLY)
2?=W    #              TAPE SERIAL NO. MISSING (AS FOR NAME GIVEN)
2?QG    #              PROPER USER DOES NOT OWN DIRECTORY (IN USER CONTEXT)
2#=6    #           IF THERE IS NO ERROR THE SEGMENT OPENS :SYSTEM.SERIAL (EXCEP
2#PQ    #           GET, TAPEWRONG & TAPERIGHT) BEFORE GOING ACROSS TO THE
2*9B    #           RELEVANT COMMAND. NEW, TAPEWRONG & TAPERIGHT ARE TREATED
2*P2    #           SPECIALLY AS THEY MAY HAVE MORE THEN ONE PARAMETER.
2B8L    ZNEW           +1
2BN=    ZGET           +2
2C7W    ZRETURN        +3
2CMG    ZDEAD          +4
2D76    ZREND          +5
2DLQ    ZTAPEWR        +7
2F6B    ZTAPERI        +8
2FL2    WORK           #67202020
2G5L    POOL           #60202020
2G89 ...#UNS  JDUMPTW
2G=S ...(
2G*C ...XDUMP          4HDUMP
2GD2 ...XNDMP          +4
2GGK ...)
2GK=    #
2H4W    #
2HJG    #
2J46    QK1LIBCOM
2JHQ          LDX   7  ZNEW(1)
2K3B          BRN      TCONA
2KH2    QK2LIBCOM
2L2L          LDX   7  ZGET(1)
2LG=          BRN      SUF
2L^W    QK3LIBCOM
2MFG          LDX   7  ZRETURN(1)
2M^6          BRN      SUF
2NDQ    QK4LIBCOM
2NYB          LDX   7  ZDEAD(1)
2PD2    TCONA
2PXL          LDN   0  #12                 [MOP AND NOUSER BITS
2QC=          ANDX  0  CONTEXT(2)
2QWW          BZE   0  SUG
2RBG          ERN   0  #12
2RW6          BNZ   0  SUG
2S*Q          COMERR   JNOMANCON           [COMMAND IN MOP AND NOUSER CONTEXT
2STB    QK5LIBCOM
2T*2          LDX   7  ZREND(1)
2TSL          BRN      SUF
2W#=    QK7LIBCOM
2WRW          LDX   7  ZTAPEWR(1)
2WS? ...#UNS  JDUMPTW
2WSN ...(
2WT5 ...      STOZ     AWORK1(2)
2WTG ...      LDN   0  #20
2WTX ...      ANDX  0  CONTEXT(2)
2WW# ...      BZE   0  TCON
2WWP ...[ OPERATOR CONTEXT - IF TWDUMP ON THEN A DUMP PARAMETER MAY HAVE
2WX6 ...[ BEEN SPECIFIED
2WXH ...      SEGENTRY K40LIBCOM
2WXY ...      BRN      SUG
2WY* ...      PARANOT  1
2WYQ ...      MHUNT    3,CPB,CUNI
2W^7 ...      LDX   4  ANUM(3)
2W^J ...      LDX   5  APARA(3)
2W^^ ...      FREECORE 3
2X2B ...      BZE   4  SUG
2X2R ...      BNG   4  MISS
2X38 ...      TXU   4  XNDMP(1)
2X3K ...      BCS      SUG
2X42 ...      TXU   5  XDUMP(1)
2X4C ...      BCS      SUG
2X4S ...[ DUMP PARAMETER SPECIFIED - SET MARKER IN AWORK1
2X59 ...[ AND UPDATE PARAPASS POINTER PAST FIRST PARAMETER
2X5L ...      LDN   0  1
2X63 ...      STO   0  AWORK1(2)
2X6D ...      PARAPASS
2X6T ...      MFREE    CPB,CUNI
2X7= ...      LDN   4  0
2X7M ...      PARANUMB 4,4
2X84 ...      SBN   4  1
2X8F ...      BZE   4  MISS
2X8W ...      ADN   4  1
2X9? ...      BRN      SUGA
2X9N ...)
2X=5 ...#UNS  JDUMPTW
2X=G ...#SKI
2X?G          BRN      TCON
2XR6    QK8LIBCOM
2Y=Q          LDX   7  ZTAPERI(1)
2YQB    TCON
2^=2          LDN   0  #21
2^PL          ANDX  0  CONTEXT(2)
329=          BNZ   0  SUG
32NW          COMERR   JOPUCON
32W4 ...#UNS  JDUMPTW
333= ...      SEGENTRY K41LIBCOM
338G    SUG
33N6          LDN   4  0
347Q          PARANUMB 4,4                 [GET NO. OF PARAMETERS
34CJ ...      BZE   4  MISS
34MB          ADN   4  1
34SJ ...#UNS  JDUMPTW
34^Q ...SUGA
3572          SETUPCORE 4,3,AONBS,GLIST    [SET UP AN AONBS/GLIST BLOCK
35LL          LDX   2  4
366=    SUG1
36KW          SMO      3
375G          STOZ     A1-1(2)             [AND EMPTY IT
37K6          BCT   2  SUG1
384Q    SUGL
38JB          CALL  5  PARAM
3942          BRN      NOMORE
39HL          BRN      SUGL
3=3=          BRN      SUGL                [TRY AGAIN
3=GW          MHUNT    1,AONBS,GLIST
3?2G          MHUNT    2,CPB,CUNI
3?G6          MHUNT    3,FILE,FABSNB
3?^Q          LDX   4  JPARNUM(2)
3#2Y ...#UNS  JDUMPTW
3#46 ...(
3#5# ...      SMO      FX1
3#6G ...      TXU   7  ZTAPEWR
3#7N ...      BCS      SUGL2
3#8W ...      SMO      FX2
3#=4 ...      LDX   0  AWORK1
3#?= ...      BZE   0  SUGL2
3##D ...[ IF TW DUMP USE ONE LESS THAN JPARNUM FOR PLACING TSN IN GLIST
3#*L ...      SBN   4  1
3#BS ...SUGL2
3#D2 ...)
3#FB          SMO      A1(3)
3#^2          LDX   5  A1+1(3)             [TAPE SERIAL NUMBER
3*DL    SUG1A
3*Y=          SBN   4  1
3BCW          BZE   4  SUG1B
3BXG          SMO      4
3CC6          BXU   5  A1(1),SUG1A
3CWQ          ERROR    ERALGIV             [TSN ALREADY GIVEN
3DBB          MHUNT    3,FILE,FABSNB
3DW2          BRN      SUG2
3F*L    SUG1B
3FFH ...#UNSET   FTS1
3FKD ...#SKIP
3FP* ...(
3FT=          SMO      FX1
3G#W          BXU   7  ZNEW,SUG1C          [BRANCH IF NOT NEW
3GJN ...)
3GSG          SMO      FX2
3H#6          LDX   0  CONTEXT
3HRQ          ANDN  0  1
3J?B          BZE   0  SUG1B1              [BRANCH UNLESS USER CONTEXT
3JR2          CALL  6  OWNCHECK            [PROPER USER OWNS DIR?
3K=L          BRN      SUGL                [NO
3KQ=          MHUNT    1,AONBS,GLIST
3L9W          MHUNT    2,CPB,CUNI
3LPG          MHUNT    3,FILE,FABSNB
3M96          SMO      A1(3)
3MNQ          LDX   5  A1+1(3)
3N8B          BRN      SUG1C
3NN2    SUG1B1
3NQK ...#UNSET   FTS1
3NT8 ...(
3NXR ...      SMO      FX1                 [NO USER CONTEXT - J IF
3P2B ...      BXU   7  ZNEW,SUG1C          [ANYTHING OTHER THAN NEW
3P4^ ...)
3P7L          SMO   A1(3)
3PM=          LDCH  0  A1-6(3)             [P OR W ?
0000 ...#SKI
0000 ...(
3Q6W          SBN   0  #60
3QLG          BNZ   0  SUG1C
0000 ...)
0000 ...      SBN   0  #67
0000 ...      BZE   0  SUG1C
3R66          ORX   5  GSIGN               [B0 SET IF POOL TAPE
3RKQ    SUG1C
3RLM ...#UNS  JDUMPTW
3RMJ ...(
3RNF ...      LDX   4  JPARNUM(2)
3RPB ...      SMO      FX1
3RQ? ...      TXU   7  ZTAPEWR
3RR8 ...      BCS      SUG2C
3RS5 ...      SMO      FX2
3RT2 ...      LDX   0  AWORK1
3RTX ...      BZE   0  SUG2C
3RWS ...[ IF TW DUMP USE ONE LESS THAN JPARNUM FOR PLACING TSN IN GLIST
3RXP ...      SBN   4  1
3RYL ...SUG2C
3R^H ...      SMO      4
3S2D ...)
3S3* ...#UNS  JDUMPTW
3S4= ...#SKI
3S5B          SMO      JPARNUM(2)
3SK2          STO   5  A1(1)               [STORE TSN
3T4L          LDN   0  1
3TJ=          ADS   0  A1(1)               [ADD 1 TO NO. OF TAPES
3W3W          SMO      FX1
3WHG          BXE   7  ZNEW,SUG3
3X36    SUG2
3XGQ          FREECORE 3
3Y2B    SUG3
3Y=8 ...      VFREEW   FILE,ADJUNCTS
3YG2          MFREE    CPB,CUNI
3Y^L          BRN      SUGL
3^F=    NOMORE
3^YW          MHUNT    1,AONBS,GLIST
42DG          LDX   0  A1(1)
42Y6          BZE   0  NULL
432P ...NOM1
435# ...      HUNTW    1,FI,FUTILITY       [ALL ADJUNCTS BLOCKS HAVE BEEN
437X ...      BNG   1  XIT                 [DISGUISED IN ORDER NOT TO UPSET
43=G ...      NAME     1,FILE,ADJUNCTS     [FNORM - THEY MUST NOW BE RENAMED
43*5 ...      BRN      NOM1                [ADJUNCTS
43CQ    XIT
43XB          LDX   1  FX1
44C2          BXE   7  ZTAPEWR(1),XIT5
44WL          BXE   7  ZTAPERI(1),XIT5
45B=          BXE   7  ZNEW(1),XIT1
45TW          BXE   7  ZGET(1),XIT2
46*G          BXE   7  ZDEAD(1),XIT4
46R4 ...QK9LIBCOM
46T6          OPENSYS  ZBRKIN,SERIAL,GENERAL
47#Q          TESTREP  OK,XIT3
47SB          GEOERR   1,GLIBREP
48#2    XIT1
48CX ...[
48HS ...      SMO      FX2
48MP ...      LDX   0  CONTEXT
48RL ...      ANDN  0  1
48XH ...      BZE   0  XIT1A                [J IF OPERATOR CONTEXT
493D ...      ACROSS   NEWOWN,1
497* ...XIT1A ACROSS   NEWPW,1
49?=    XIT2
49QW          ACROSS   GET,1
4==G    XIT3
4=Q6          BXU   7  ZRETURN(1),XIT4A
4?9Q          ACROSS   RETURN,1
4?PB    XIT4
4#92          ACROSS   DEAD,1
4#NL    XIT4A
4*8=          ACROSS   RENAMDIR,1
4*MW    XIT5
4B7G          ACROSS   TAPERING,1
4BM6    ZBRKIN
4C6Q          COMBRKIN
4CLB    SUF
4D62          CALL  5  PARAM               [GET NEXT ACCEPTABLE PARAMETER
4DKL          BRN      MISS
4F5=          BRN      NULL
4FJW          BRN      MISS
4G4G          CALL  6  OWNCHECK
4GJ6          BRN      NULL
4H3Q          BRN      XIT
4HHB    MISS
4J32          COMERR   JPARMIS
4JGL    NULL
4K2=          ENDCOM
4KFW    #     THIS SUBROUTINE PASSES THE NEXT PARAMETER IN A FILE/FABSNB BLOCK.
4K^G    #     ON ENTRY X5 IS LINK AND X7 HOLDS ENTRY POINT IDENTIFIER.
4LF6    #     EXIT AT LINK ADDRESS+1 IF PARAMETER NULL OR UNSUITABLE.
4LYQ    #     EXIT AT LINK ADD.+2 IF PARAMETER PASSED (FILE/FABSNB & CPB/CUNI).
4MDB    #     EXIT AT LINK ADD. IF NO MORE PARAMETERS.
4MY2    PARAM
4NCL          SBX   5  FX1
4NX=          SPARAPAS                     [GET NEXT PARAMETER
4PBW          MHUNT    3,CPB,CUNI
4PWG          LDX   0  ANUM(3)
4QB6          BZE   0  PNULL               [BRANCH IF NULL PARAMETER
4QTQ          BNG   0  PEND                [BRANCH IF NO MORE
4R*B          NAMETOP  3,FILE,FNAME
4RT2          FNORM    7
4S#L          MHUNT    3,FILE,FNAME
4SS=          NAMETOP  3,CPB,CUNI
4T6M ...      TESTREP  NAMEFORM,PNAMEF     [BRANCH IF FORMAT ERROR
4TF4 ...      PICKREP  6
4TRG          LDX   4  JPARNUM(3)
4W?6          BXE   7  ZGET(1),PARAM0B
4WQQ    PARAM0
4X=B          HUNT     3,FILE,FTRAP
4XQ2          BNG   3  PARAM0B
4Y9L          BXU   7  ZNEW(1),PARAM0A
4YP=          NAMETOP  3,AONBS,GROT        [SAVE FOR APPROPRIATE MESSAGE
4^8W          DSA   4  ATYPE(3)
4^NG          BRN      PARAM0
5286    PARAM0A
52MQ          FREECORE 3
537B          BRN      PARAM0
53M2    PARAM0B
542P ...      PUTREP   6
54BD ...      TESTREPN ADJUNCTS,PERR1
54Q7 ...      MHUNTW   3,FILE,ADJUNCTS
555W          LDX   0  A1+2(3)
55KG          SRL   0  15
5656 ...      BZE   0  PERR1A
56JQ          SBN   0  5
574B          BNZ   0  PERR2               [BRANCH IF NOT *MT
57J2          LDX   0  A1+2(3)
583L          ANDN  0  2
58H=          BZE   0  PARAM0C             [BRANCH IF NO PROPERTIES
592W          BXE   7  ZNEW(1),PARAM0D
59GG          BXE   7  ZGET(1),PARAM0D
5=26          BXE   7  ZREND(1),PARAM0D
5=FQ          BRN      PARAM0E
5=^B    PARAM0D
5?F2          MTEXPROP TAPE                [EXTRACT SPECIAL PROPERTIES
5?YL          TESTREP  ILLCOMB,PERR10,ILLMODE,PERR11
5#D=          LDX   3  ACOMMUNE1(2)
5#XW          SETNCORE 1,2,FLIB,FSPD
5*CG          DSA   4  ATYPE(2)
5*X6          STO   3  A1(2)               [STORE CHARACTERISTIC
5BBQ    #SKI  K6LIBCOM>199-199
5BWB          SWITRACE 3,LBCMSPD
5CB2    PARAM0E
5CTL          MFREE    FILE,FPROPS
5D*=    PARAM0C
5D*N ...#UNSET   FTS1
5DB6 ...(
5DBJ ...      SMO      FX2
5DC2 ...      LDX   2  CONTEXT
5DCD ...      ANDN  2  1                   [B23 = USER CONTEXT
5DCW ...      BZE   2  PARAMNU             [J IF NOT USER CONTEXT
5DD# ...      MHUNT    2,FILE,FABSNB
5DDQ ...      LDX   4  ATYPE(2)
5DF8 ...      ANDN  4  #200
5DFL ...      BNZ   4  PARAMNU             [J IF WORKTAPE
5DG4 ...      LDX   3  ALOGLEN(2)          [SET X3=LENGTH OF FABSNB
5DGG ...      SETUPCORE 3,2,FILE,FABSNB    [CREATE DUPLICATE FABSNB
5DGY ...      HUNT2    1,FILE,FABSNB,2
5DHB ...      LDX   4  ATYPE(1)
5DHS ...      STO   4  ATYPE(2)
5DJ= ...      LDN   3  A1(1)
5DJN ...      LDN   4  A1(2)
5DK6 ...      SMO      ALOGLEN(2)
5DKJ ...      MOVE  3  0
5DL2 ...      LDN   4  6                   [ADJUST RECORD HEADERIN
5DLD ...      SBS   4  A1(2)               [FILE-FABSNB FOR OPENING
5DLW ...      OPEN     ZBRKIN,READ,QUERY   [OF LOCAL USER DIRECTORY
5DM2 ...XFSHNBOPEN
5DM# ...      MFREE    FILE,FABSNB         [FREE THE EXTENDED FABSNB
5DMQ ...      TESTREP  OK,PARAMFZ          [OPEN OK?
5DN8 ...      REPALLERR
5DNC ...      VFREEW   FILE,ADJUNCTS
5DNL ...      BRN      PNEXT
5DP4 ...PARAMFZ
5DPG ...      TOPFCB   2                   [X2 POINT TO FCB
5DPY ...      JFREZFCB 2,PERR12            [CHECK FOR FROZEN QUALIFIER
5DQB ...      CLOSETOP                     [CLOSE DIRECTORY
5DQS ...)
5DR= ...#UNSET   FTS1
5DRN ...#SKIP
5DSW          MFREE    FILE,ADJUNCTS
5F24 ...PARAMNU
5F7= ...      LDX   2  FX2                 [RESTORE X2
5F#G          MHUNT    3,FILE,FABSNB
5FS6          NGN   0  #101
5G?Q          ANDS  0  ATYPE(3)            [MAKE SURE LANGUAGE NOT GIVEN
5GRB          LDX   4  ATYPE(3)
5H?2          ANDN  4  #2000               [TSN BIT
5HQL          BZE   4  PARAM1              [BRANCH IF NO TSN
5J==          SMO      A1(3)
5JPW          LDX   0  A1+1(3)
5K9G          BNG   0  PERR5               [BRANCH IF XENOTAPE
5KP6    PARAM1
5L8Q          BXE   7  ZRETURN(1),PARAM2B  [BRANCH IF RETURN
5LNB          BXU   7  ZGET(1),PARAM2      [BRANCH UNLESS GET COMMAND
5M82          BNZ   4  PERR6               [BRANCH IF TSN
5M?X ...      LDX   0  ACES                [OVERWRITE LANGUAGE CODE
5MCS ...      SMO      HDREC(3)            [WITH SPACES
5MHP ...      STO   0  A1-1(3)
5MML          BRN      PARAM2B
5N7=    PARAM2
5NLW          BZE   4  PERR3               [BRANCH IF NO TSN
5P6G          LDX   0  ATYPE(3)
5PL6          ANDN  0  #200
5Q5Q          BNZ   0  PERR8               [BRANCH IF WORKFILE
5QKB    PARAM2B
5R52          LDX   0  ATYPE(3)
5RJL          ANDN  0  #4000
5S4=          BNZ   0  PERR8               [BRANCH IF STREAM
5SHW          BXE   7  ZGET(1),PARAM4
5T3G          BXE   7  ZRETURN(1),PARAM4
5TH6          BXE   7  ZNEW(1),PARAM2A
5W2Q          BXE   7  ZREND(1),PARAM3
5WGB          LDX   0  A1(3)
5X22          SBN   0  10
5XFL          BNZ   0  PERR4               [BRANCH IF NAME GIVEN
5X^=          LDX   0  A1+4(3)
5YDW          BNZ   0  PERR4               [BRANCH IF NAME GIVEN
5YYG          BRN      PARAM4
5^D6    PARAM2A
5^XQ          LDX   0  CONTEXT(2)
62CB          ANDN  0  1
62X2          BNZ   0  PARAM4              [BRANCH IF USER CONTEXT
63BL          LDX   0  A1(3)
63W=          SBN   0  10
64*W          BNZ   0  PERR9
64TG          LDX   0  ATYPE(3)
65*6          ANDN  0  #4700
65SQ          BNZ   0  PERR9
66#B          LDX   0  A1+4(3)
66S2          BZE   0  PARAM4              [CODE OMITTED
67?L          LDX   4  ATYPE(3)
67R=          ANDN  4  #1000
68=W          BZE   4  PERR9
68QG          BXE   0  POOL(1),PARAM4
69=6          BXE   0  WORK(1),PARAM4
69PQ          BRN      PERR9
6=9B    PARAM3
6=P2          LDX   0  ATYPE(3)
6?8L          ANDN  0  #1000
6?N=          BZE   0  PERR7               [BRANCH IF NOT GENERAL LOCAL NAME
6#7W    PARAM4
6#MG          ADX   5  FX1
6*76          EXIT  5  3
6*LQ    #     OUTPUT ERROR MESSAGE
6*RY ...PERR1A
6*^6 ...      MFREEW   FILE,ADJUNCTS
6B6B    PERR1                              [DEVICE TYPE QUALIFIER MISSING
6BL2          LDX   3  ZAMISS(1)
6C5L          LDX   4  ZATYPEQ(1)
6CK= ...      BRN      PERX
6D4W    PERR2                              [DEVICE TYPE QUALIFIER IMPERMISSIBLE
6DJG          LDX   3  ZIMPER(1)
6F46          LDX   4  ZATYPEQ(1)
6FHQ          BRN      PERR
6G3B    PERR3                              [TAPE SERIAL NUMBER MISSING
6GH2          LDX   3  ZAMISS(1)
6H2L          LDX   4  ZERNOP(1)
6HG=          BRN      PERR
6H^W    PERR4                              [SHOULD BE TSN ONLY
6JFG          LDX   3  ZAMTDESC(1)
6J^6          LDX   4  ZJTSN(1)
6KDQ          BRN      PERR
6KYB    PERR5
6LD2          LDX   3  ZERXE(1)
6LXL          NGN   4  1
6MC=          BRN      PERR
6MWW    PERR6                              [TSN GIVEN FOR GET COMMAND
6NBG          LDX   3  ZAMTDESC(1)
6NW6          LDX   4  ZJNTSN(1)
6P*Q          BRN      PERR
6PTB    PERR7
6Q*2          LDX   3  ZAMTDESC(1)
6QSL          LDX   4  ZJLOCN(1)
6R#=          BRN      PERR
6RRW    PERR8
6S?G          LDX   3  ZERNAM(1)           [FORMAT ERROR  (+ OR ! IN MT DESC)
6SR6          NGN   4  1
6T=Q          BRN      PERR
6TQB    PERR9
6W=2          LDX   3  ZCODEWR(1)
6WPL          NGN   4  1
6X9=          BRN      PERR
6XNW    PERR10
6Y8G          LDX   3  ZPILL(1)
6YN6          NGN   4  1
6^7Q          BRN      PERR
6^MB    PERR11
7272          LDX   3  ZPMOD(1)
72LL          NGN   4  1
72N* ...#UNSET   FTS1
72Q4 ...(
72RR ...      BRN      PERR
72TG ...PERR12
72X9 ...      CLOSETOP                             [CLOSE DIRECTORY
72Y4 ...      MFREEW   FILE,ADJUNCTS
72YY ...      ERRTEST  3,PNEXT,FROZEN,NOFPRIV      [ERROR MESSAGE
732M ...      GEOERR   1,LIBFRREP
734B ...)
736=    PERR
73?D ...      MFREEW   FILE,ADJUNCTS
73DL ...PERX
73KW          ERRORX   3,4                 [OUTPUT APPROPRIATE ERROR MESSAGE
745G    PNEXT
74K6          MFREE    FILE,FABSNB
754Q          MHUNT    3,CPB,CUNI
75JB    PNEXT1
7642          ADN   5  1
76HL    PEND
773=          FREECORE 3
77GW          ADX   5  FX1
782G          EXIT  5  0
78G6    PNULL
78^Q          ADN   5  1
79FB          BRN      PNEXT1
79K? ...PNAMEF
79P8 ...      VFREEW   FILE,ADJUNCTS       [FNORM MAY LEAVE AN ADJUNCTS
79T5 ...      BRN      PNEXT1              [  EVEN THOUGH IT SHOULDN'T
79^2    #     ERROR MESSAGE IDENTIFIERS
7=DL    ZAMISS         +AMISS
7=Y=    ZATYPEQ        +ATYPEQ
7?CW    ZIMPER         +IMPER
7?XG    ZAMTDESC       +AMTDESC
7#C6    ZJTSN          +JTSN
7#WQ    ZERNOP         +ERNOP
7*BB    ZERXE          +ERXENOSER
7*W2    ZJNTSN         +JNTSN
7B*L    ZJLOCN         +JLOCN
7BT=    ZERNAM         +ERNAMEFORM
7C#W    ZCODEWR        +ERCODEWR
7CSG    ZPILL          +ERILLCOMB
7D#6    ZPMOD          +ERILLMODE
7DRQ    #              SUBROUTINE TO CHECK WHETHER PROPER USER OWNS ENTRANT
7F?B    #     EXIT AT LINK ADDRESS IF TAPE DOES NOT BELONG TO PROPER USER.
7FR2    #     EXIT AT LINK ADDRESS+1 IF TAPE BELONGS TO PROPER USER.
7G=L    #     X6 IS THE LINK ACC. AND X7 IS NOT USED
7GQ=    OWNCHECK
7H9W          SBX   6  FX1
7HPG          MHUNT    2,FILE,FABSNB
7J96          LDX   0  ATYPE(2)
7JNQ          ANDN  0  #200
7K8B          BNZ   0  OWN                 [BRANCH IF NAMED WORKTAPE
7KN2          LDX   0  A1(2)
7L7L          SBN   0  10
7LM=          BNZ   0  OWN1                [BRANCH IF LOCAL NAME OF DIR GIVEN
7M6W          LDX   3  A1+1(2)             [X3,4,5=NAME OF DIR
7MLG          LDX   4  A1+2(2)
7N66          LDX   5  A1+3(2)
7NKQ          CJOBLOCK 2                   [FIND JOB BLOCK
7P5B          TXU   3  JUSER(2)
7PK2          TXU   4  JUSER+1(2)
7Q4L          TXU   5  JUSER+2(2)
7QJ=          BCC      OWN                 [BRANCH IF PROPER DIR
7R3W          SETNCORE 4,2,FILE,FABSNB
7RHG          LDN   0  4
7S36          STO   0  A1(2)
7SGQ          STO   3  A1+1(2)
7T2B          STO   4  A1+2(2)
7TG2          STO   5  A1+3(2)
7T^L          CHECKOWNER
7WF=    OWN2
7WYW          TESTREP  OK,OWN
7XDG          TESTREPN NOFILE,OWN2A
7XY6          SETREP   NAME
7YCQ    OWN2A
7YXB          TESTREPN NOTOWNER,OWN2C
7^C2          BXE   7  ZTAPEWR(1),OWN2B
7^WL          BXE   7  ZTAPERI(1),OWN2B
82B=          BXU   7  ZREND(1),OWN2C
82TW    OWN2B
83*G          ERROR    ERNOTOWN
83T6          BRN      OWN3
84#Q    OWN2C
84M7 ...      ERRTEST  3,OWN3,LOST,TEMPLOST,NAME,NOUSER,VRYWRONG,NOTOWNER,WRONG-
84^J ...               ,NOINFACC,NOALLACC
85#2          GEOERR   1,LIBREP
85RL    OWN3
86?=          MFREE    CPB,CUNI
86QW          MFREE    FILE,FABSNB
86W2 ...#UNSET   FTS1
86^6 ...(
874= ...      MFREEW   FILE,ADJUNCTS
877B ...)
87=G          ADX   6  FX1
87Q6          EXIT  6  0                   [PROPER USER DOES NOT OWN ENTRANT
889Q    OWN
88#W ...#UNSET   FTS1
88D2 ...(
88DD ...      LDX   1  FX1
88FQ ...      BXE   7  ZRETURN(1),OWNYF    [NO ADJUNCTS NEEDED FOR RETURN
88G8 ...      BXU   7  ZREND(1),OWNNF      [OR RENAMDIR
88GL ...OWNYF
88H4 ...      MFREEW   FILE,ADJUNCTS
88HG ...      BRN      OWNEND
88HY ...OWNNF
88JB ...      BXE   7  ZGET(1),OWNEND
88JS ...      MHUNTW   1,FILE,ADJUNCTS     [WHERE MULTIPLE PARAMS ALLOWED
88K= ...      NAME     1,FI,FUTILITY       [ADJUNCTS NEEDS TEMPORARY DISGUISE
88KN ...OWNEND
88L= ...)
88PB          ADX   6  FX1
8992          EXIT  6  1                   [PROPER USER OWNS ENTRANT
89NL    OWN1
8=8=          LDN   0  6
8=MW          SBS   0  A1(2)
8?7G          OPEN     ZBRKIN,READ,LEAVE,QUERY
8?M6          MHUNT    3,FILE,FABSNB
8#6Q          LDN   0  6
8#LB          ADS   0  A1(3)
8*62          TESTREPN OK,OWN2
8*KL          MHUNT    1,FILE,ENT
8B5=          MHUNT    2,FILE,FABSNB
8BJW          ADN   1  EUSE1
8C4G          LDX   0  A1(2)
8CJ6          LDN   3  10
8D3Q          STO   3  A1(2)               [NEW HEADER
8DHB          ADN   2  A1+1
8F32          MOVE  1  3                   [USER NAME
8FGL          LDN   3  3(2)
8G2=          SBN   2  7
8GFW          ADX   2  0
8G^G          MOVE  2  8
8HF6          SBN   1  EUSE1
8HYQ          FREECORE 1
8JDB          MHUNT    2,FILE,FABSNB
8JY2          ALTLEND  2,12,FILE,FABSNB
8KCL          OWNERCHEC
8KX=          PICKREP  3
8LBW          CLOSETOP
8LWG          PUTREP   3
8MB6          BRN      OWN2
8MTQ          MENDAREA 50,K99LIBCOM
8N*B    #END
^^^^ ...06632676000300000000
####
IN :GEO,ONLINEB867(2002),T####
22FL    #SEG  ONLINEB8                     [A C PUTMAN
22LS ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983.
22S3    #OPT  K0ONLINEB=0
236D    #LIS  K0ONLINEB>K0ONLINE>K0COMMAND>K0ALLGEO
23DW          8HONLINEB
23YG    #
24D6          SEGENTRY K1ONLINEB,SK1ONLINEB
24XQ          SEGENTRY K2ONLINEB,SK2ONLINEB
25CB    #
25X2    # THIS CHAPTER IS ENTERED BY ACROSSES FROM K1ONLINEA.
26BL    #
26W=    NAMCL          #43540000
27*W    XADEVS
27TG    #HAL  AMXOR+ADEVS,0
28*6    XALINES
28SQ    #HAL  AMXOR+ALINES,0
29#B    #
29S2    #
2=?L    #     SEARCH FOR BLOCK OF TYPE IN X5 FROM AMOP WITH ADDRESS IN X1
2=R=    #
2?=W    SEEK  LDX   1  FPTR(1)
2?QG          LDX   0  ATYPE(1)
2#=6          TXU   0  5                   [BLOCK TYPE REQUIRED IN X5
2#PQ          BCC      SBLK                [HAVE FOUND BLOCK : EXIT
2*9B          TXL   0  CACT
2*P2          BCS      SEEK                [NOT NEXT ACTIVITY ; TRY NEXT BLOCK
2B8L          EXIT  7  0                   [NO AMXOR/ALINES BLOCK
2BN=    SBLK  EXIT  7  1
2C7W    #
2CMG    #     ACCESS PARAMETER BEGINNING WITH CL ( I.E. CONCEPTUAL NAME) IF ANY
2D76    #
2DLQ    SPAR  LDN   4  2
2F6B          LDX   5  NAMCL(1)            [4HCL00
2FL2          SBX   6  FX1
2G5L          SPARABEG 1,4
2GK=          MHUNT    3,CPB,CUNI
2H4W          LDX   4  AWORK1(2)
2HJG          LDX   0  ANUM(3)
2J46          SRL   4  15                  [PERIPHERAL TYPE
2JHQ          SMO      FX1
2K3B          BNG   0  (6)                 [WHOLE UNIT REQUIRED
2KH2          BZE   0  NONAM               [NULL CONCEP NAME IS INVALID
2L2L          SBN   0  13
2LG=          BPZ   0  NONAM               [>12 CHARS OR NOT SIMPLE
2L^W          LDCH  0  APARA(3)
2MFG          SBN   0  #41
2M^6          BNG   0  NONAM               [FIRST CHAR NOT A LETTER
2NDQ          STO   4  ACOMMUNE2(2)
2NYB          IDFCLON  XBRK,NCA,PNREC      [MARK CONCEPTUAL ONLINE
2PD2    #
2PXL          HUNTW    3,FILE,FABSNB
2QC=          BNG   3  RNOUS               [NO USER
2QWW          OPENDIR  XBRK,READ,QUERY     [IS CONCEPTUAL IN USER'S DIRECTORY ?
2RBG          TESTREPNOT  NOFILE,RFX1
2RW6    RFXA  OUTBLOCN 8
2S*Q          OUTPARN  12,A1+4,FILE,FABSNB
2STB          OUTPARN  12,A1+1,FILE,FABSNB
2T*2          INFORM   0,CLNFERAS
2TSL          BRN      RYERS               [NOT ALLOWED TO USE THIS CONCEPTUAL
2W73    RFX1  TESTREP  NAME,RFXA           [TEST REPLY
2WFD          TESTREPNOT OK,RGEXX
2WRW          CHECKTRAPS
2X?G          TESTTRAP WRITE
2XR6          TESTREP  NOTRAP,RYERR        [NOT ALLOWED IF NOT WRITE TRAP
2Y=Q          CLOSE
2YQB    RNOUS ADX   6  FX1
2^=2          EXIT  6  1
2^PL    #
329=    #     PREPARE AND GIVE MONOUT : 'WAITING FOR PERIPHERAL'
32NW    #
338G    WATIN LONGSET  #30,SET
33N6          SBX   7  FX1
347Q          ADX   1  7
34MB          BNZ   3  (1)                 [WRONG EVENT : ALREADY WAITING
3572          LDN   3  1
35LL    WAIT2 OUTPACK  AWORK1(2),1,PERINAME    [PERIPHERAL MNEMONIC
366=          MONOUT   JXOTWT1             [WAITING FOR *%A
36KW          SMO      FX1
375G          EXIT  7  1
37K6    #
384Q    #     ONLINE MULTIPLEXOR OR UNIPLEXOR ; CHECK NAME & REALTIME STATUS
38JB    #
3942    SK1ONLINEB
39HL          MFREEW   CPAR,GPERCON
3=3=          FJOCA    3,2
3=GW          RTTEST   RTON1,3             [J. IF REAL-TIME
3?2G          BRN      NRT                 [COMMAND ERROR
3?G6    #SKI  G3
3?^Q    (
3#FB    RTON1 CALL  6  SPAR                [LOOK FOR CONCEP. NAME
3#^2          BRN      WUNIT               [NO CONCEP NAME : ONLINE WHOLE UNIT
3*DL          ACROSS   ONLINCL,1           [CONCEPTUAL MPX OR UPX.
3*Y=    #
3BCW    WUNIT MFREE    CPB,CUNI            [2ND COMMAND PARAMETER BLOCK
0000 ...      NGN   5  1
0000 ...      SMO      FX2
0000 ...      STO   5  ACOMMUNE1
3BXG          IDFUNON  XBRK,NOMP,4
3CC6    )
3CWQ    #SKI  G4
3DBB    (
3DW2    RTON1 LDX   4  AWORK1(2)
3F*L          SRL   4  15                  [PERIPHERAL TYPE
3FT=          IDFUNON  XBRK,NOMP,4
3G#W    )
3GG4          LDX   6  ACOMMUNE1(2)        [DEVICE LIST POINTER
3GM=          HLSXONCH XBRK,AWORK1(2),SLHON
3GSG          FJOCA    3,2                 [FIND CURRENT JOB BLOCK
3H#6          RTTEST   RTON3,3             [J. IF JOB IS REALTIME.
3HD3    #SKI  IDFMARK8
3HHY          UNITOFF  YBRK
3HMT    #SKI  IDFMARK8<1$1
3HRQ          UNITOFF                      [RELEASE UNIT IN THE IDF
3J?B          BRN      NRT                 [J. TO OUTPUT ERROR MESSAGE.
3JR2    RTON3 LDN   0  1                   [ADD 1 TO COUNT OF R. T. PERIPHERALS.
3K=L          ADS   0  AEXCO(3)
3L9W          LDX   5  XALINES(1)          [FOR SEEK SUBROUTINE
3LPG          LDN   3  0                   [SWITCH : NOT YET WAITING
3M96    YEVE  LDN   1  ADMULTACT-ADMP
3MNQ    REF   LDX   1  ADMP(1)             [SEARCH DOWN MOP ACTIVITIES LIST
3N8B    #SKI  K6ONLINE>99-99
3NN2          BZE   1  VAB                 [GEOERR IF AMOP NOT FOUND
3P7L          TXU   6  CPPTR(1)            [DEVICE LIST POINTER IN X6
3PM=          BCS      REF                 [WRONG DEVICE : TRY AGAIN
3Q6W          CALL  7  SEEK
3QLG          BRN      SDRM                [MISSING : OK
3R66    WAN   CALL  7  WATIN
3RKQ          BRN      WINT                [REENTER OUTPAUSE
3S5B          OUTPAUSE WAS,YEVE,,5,WINT
3SK2          BRN      WAIT2               [TIME UP :REOUTPUT MESSAGE
3T4L    #
3TJ=    NOMP  FINDPEREC 3,APFOTY,4,RET     [NO SYSTEM ONES : LOOK FOR EXOTICS
3W3W          BNG   3  NAMP                [NO SUITABLE EXOTICS EITHER
3WHG          JALLOC   3,RET
3WR#          JWRONG   3,RET
3X36          JEXOTIC  3,THEX              [J IF EXOTIC,FREE ONE FOUND
3XGQ          BRN      RET
3Y2B    THEX  LDX   6  3
3YG2          FJOCA    3,FX2               [FIND JOB BLOCK
3Y^L          RTTEST   RTON4,3
3^F=          BRN      NRT                 [JOB NOT REALTIME : ERROR
3^YW    RTON4 LDN   0  1
42DG          ADS   0  AEXCO(3)            [UPDATE COUNT OF RT PERIPHERALS
42Y6    SDRM  LDX   3  6                   [DEVICE LIST ADDRESS
43CQ          SETALLOC 3
43XB          PERON    3                   [MARK PERIPHERAL ONLINE
44C2          PUTPERENT AWORK1(2),3        [INSERT ONLINE ENTRY IN PRB
44WL    XIT   ENDCOM                       [UP,UP AND AWAY!!!
45B=    #
45TW    #     ONLINE TELEPROCESSOR VIA IPB : CHECK MOPPED OFF AND MARK THE IDF
46*G    #
46T6    SK2ONLINEB
47#Q          MFREEW   CPAR,GPERCON
47SB          CALL  6  SPAR                [LOOK FOR CONCEP NAME
48#2          BRN      WIPB                [WHOLE IPB
48RL          ACROSS   ONLINCL,2
49?=    WIPB  MFREE    CPB,CUNI
49#7 ...      LDN   6  0
49*4 ...      PARANUMB 5,6
49*^ ...      SBN   5  1
49BW ...      BZE   5  WIPB2
49CR ...      PARANEXT #36,6
49DN ...      MFREE    CPB,CUNI
49FK ...      PARSORT  XBRK,GROPE
49GG ...      HUNTW    3,CPAR,JSCE
49HC ...      BNG   3  NAMP
49J# ...WIPB1 LDX   3  JSCEP(3)
49K9 ...      LGEOG    3,5
49L6 ...      MFREE    CPAR,JSCE
49M3 ...      BRN      WIPB3
49MY ...WIPB2 NGN   5  1
49NT ...WIPB3 SMO      FX2
49PQ ...      STO   5  ACOMMUNE1
49QW          YIDFUNON XBRK,NAMP,4
49Y4          LDX   6  ACOMMUNE1(2)        [DEVICE LIST POINTER
4=5=          HLSXONCH XBRK,AWORK1(2),SLHON
4==G          LDN   3  0
4?9Q          LDX   5  XADEVS(1)           [FOR SEEK SUBROUTINE
4?PB    SEDEV LDN   1  IPBADDR-IPBL
4#92    REIP  LDX   1  IPBL(1)
4#NL    #SKI   K6ONLINE>99-99
4*8=          BZE   1  VAB                 [GEOERR IF AMOP NOT FOUND
4*MW          TXU   6  CPPTR(1)
4B7G          BCS      REIP                [WRONG DEVICE : TRY AGAIN
4BM6          CALL  7  SEEK                [LOOK FOR AMXOR/ADEVS BLOCK
4C6Q          BRN      SDRM                [ADEVS MISSING
4CLB    WAP   CALL  7  WATIN
4D62          BRN      WIAG
4DKL          OUTPAUSE WAY,SEDEV,,5,WIAG
4F5=          BRN      WAIT2               [TIME UP : REOUTPUT MESSAGE
4FJW    #
4G4G    WAS   STO   6  ACOMMUNE1(2)
4G8C    #SKI  IDFMARK8
4G##          UNITOFF  YBRK
4GD9    #SKI  IDFMARK8<1$1
4GJ6          UNITOFF
4GN3          FJOCA    3,2                 [FIND CURRENT JOB BLOCK
4GRY          LDN   0  1
4GXT          SBS   0  AEXCO(3)            [TAKE 1 FROM CT OF R.T. PERIPHS
4H3Q          BRN      XBRK
4HHB    WAY   STO   6  ACOMMUNE1(2)
4HM?    #SKI  IDFMARK8
4HR8          YUNITOFF YBRK
4HX5    #SKI  IDFMARK8<1$1
4J32          YUNITOFF
4JGL    # BREAKIN LABEL
4K2=    XBRK  COMBRKIN
4KFW    #     VARIOUS COMMAND ERRORS AND GEORGE ERRORS
4K^G    #
4LF6          ZERRORY
4LYQ    NAMP  LDN   4  0                   [ANALYSIS LEVEL
4MDB          SPARANOT 1,4                 ['*MX0' INTO CPB/CUNI
4MY2    NCA   ZERRORX  JNCA                [NOT CURRENTLY AVAILABLE
4NCL    NONAM ZERRORX  JNOTCNAME           [NOT A VALID CONCEPTUAL NAME
4NX=    NRT   ZERRORX  JNRT                [JOB IS NOT REAL-TIME
4P74    SLHON ZERRORX  ERHLSONL
4PBW    PNREC ZERRORX  ERMCH               [NOT RECOGNISED BY IDF
4PWG    RYERR CLOSE                        [DIRECTORY OPENDIR'ED
4P^L    RYERS
4Q4Q    #SKI  IDFMARK8
4Q7W          IDFOFF   YBRK,VAB
4Q?2    #SKI  IDFMARK8<1$1
4QB6          IDFOFF   VAB
4QTQ          ZERRORX  JNOTALL             [NOT ALLOWED TO USE THIS CONCEPTUAL
4R*B    #
4RT2    RGEXX GEOERR   1,CLNFDEF
4S#L    VAB   GEOERR   1,IDFERROR
4SS=    SET   GEOERR   1,LONGSET
4S^D    #SKI  IDFMARK8
4T6L    YBRK  GEOERR   1,IDFBRKIN
4T?W          MENDAREA 20,K100ONLINEB
4TRG    #END
^^^^ ...73004211000200000000
####
IN :GEO,OPCA867(2005),T####
22FL    #LIS           K0OPCA>K0OBJPROG>K0ALLGEO>K0GREATGEO
22RB ...      SEG      OPCA,867,SECTION CENT,,G400
2357 ...[
2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23#^ ...[
23HF ...#UNS G400
23P^ ...#      THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK 2
23YG          SEGENTRY K1OPCA,XENT1
24D6    #     THIS SEGMENT IS ENTERED TO DECODE AN EVENT IN AN OBJECT PROGRAM
24XQ    #     IT EXAMINES EVENT1,2,3 & JUMPS OR SWITCHES TO APPROPRIATE ROUTINE
25CB    #     E0ENT1   POINTER TO CURRENT MEL
25X2    #     EVENT2   N(M) AFTER ALL MODIFICATION(EXTRACODE EVENTS ONLY)
26BL    #     EVENT3   X OR REPLACED X (15 GROUP EXTRACODES ONLY)
26W=    #     EVENT4   CONTENTS OF THE 1ST WORD OF THE PERIPHERAL CONTROL AREA
27*W    #              (157 EXTRA CODE ONLY)
27TG    #     EVENT5   COPY OF THE ORIGINAL ORDER(EXTRACODE EVENTS ONLY)
28*6    #     EVENT6   ERROR CODES:
28SQ    #
29#B    #              0=EXTRACODE NOT IMPLEMENTED BY EXEC
29S2    #              1=INOPERABLE PERIPHERAL
2=?L    #              2=PAGE REQUEST(GEORGE ERROR-PAGETURN SHOULD BE WOKEN UP)
2=R=    #              3=FLOATING POINT UNDERFLOW
2?=W    #              4=FLOATING POINT OVERFLOW
2?QG    #              5=PARITY FAILURE
2#=6    #              6=HARDWARE ILLEGAL
2#JH ...#              8=MEMBERS MILL TIMER OVERFLOWED
2#WY ...#              7,9 UPWARDS=VARIOUS ILLEGAL EXTRACODES
2*9B    # PRESETS
2*P2    QMASK          #77777700
2B8L    QMASK1         #60000000
2BN=    QMASK2         #07700000
2C7W    QMASK3         #77777
2CCN ...QMAXPOS        #37777777           [MAX. POSITIVE NUMBER IN WORD
2CMG    XCHOBEY        +CHOBEY
2D76    XK61           +K61
2DLQ    #  ENTRY POINTS
2F6B    #
2FL2    # THE STANDARD ENTRY POINT FOR THE PCA
2G5L    XENT1
2GK=    #SKIP          K6OPCA>99-99
2H4W    (
2HJG          TRACE    EVENT1(2),OPCEVEN1
2J46          TRACE    EVENT6(2),OPCEVEN6
2JHQ    )
2L2L    #SKIP          K6OPCA>999-999
2LG=    (
2L^W          HUNT     3,AOBJPROG
2M3? ...#UNS CA1D
2M4N ...(
2M65 ...      ADX   3  CA1D
2M7G ...      TRACE    9(3),OBJWORD9
2M8X ...      TRACE    8(3),OBJWORD8
2M=# ...      SBX   3  CA1D
2M?P ...)
2M*6 ...#UNS CA1D
2MBH ...#SKI
2MCY ...(
2MFG          TRACE    A1D+9(3),OBJWORD9
2M^6          TRACE    A1D+8(3),OBJWORD8
2N8Y ...)
2NDQ    )
2PD2          TESTPUC  ,XPUC
2PXL          BRN      XNPUC               [ J IF NON PUC
2QC=    XPUC  LDX   3  EVENT6(2)           [ERROR CODE
2QWW          BZE   3  XPEX                [J IF PUC EXTRACODE
2RBG          LDCT  5  #500                [PUC ILLEGAL -B0/2
2RW6          CALL  6  XTPFN               [FOR TP WD 31
2S*Q          MACCS    ,FX2
2STB          BRN      X31ST
2T*2    XPEX
2TSL          LDX   3  EVENT5(2)           [COPY OF EXTRACODE
2W#=          SLC   3  10                  [ISOLATE FUNCTION AND
2WRW          ANDN  3  #77                 [SAVE L.S. 6 BITS
2X?G          STO   3  7                   [REMBER LEAST SIG 6 BITS
2XR6          SBN   3  #65
2Y=Q          BNZ   3  XPEX1               [J IF NOT GIVE
2YQB          LDX   3  EVENT2(2)           [ENTER TP IF
2^=2          SBN   3  3                   [GIVE/3
2^PL          BZE   3  XPEX1
329=          SBN   3  1                   [GIVE/4
32NW          BZE   3  XPEX1
338G          SBN   3  1                   [GIVE 5
33N6          BZE   3  XPEX1               [OR
347Q          SBN   3  5                   [GIVE 10
34MB          BZE   3  XPEX1               [OR
3572          SBN   3  2                   [GIVE 12
35LL          BZE   3  XPEX1
366=          SBN   3  4
36KW          BNG   3  XGIVE               [REPORT PERM XCODES TO TP
375G    XPEX1 CALL  6  XTPFN
37K6          LDX   3  EVENT2(2)
384Q          SMO      4                   [SET TP WD 5 TO
38JB          STO   3  5                   [ N(M) OF XCOD
3942          LDX   3  EVENT5(2)           [COPY  OF EXTRA CODE
39HL          SLC   3  3
3=3=          ANDN  3  7                   [SET TP WD 4
3=GW          SMO      4                   [TO  X OF
3?2G          STO   3  4                   [ XCOD
3?G6          PMODES   3                   [PICK UP PUC MODES
3?^Q          ANDN  3  #50
3#FB          BZE   3  XP6
3#^2          LDCT  3  #177                [IF EBM OR 22 AM
3*DL          BRN      XP6A                [ISOLATE B2-23 OF PUC ONR
3*S* ...XP6   LDX   3  QMASK1(1)
3B84 ...      ORX   3  QMASK3(1)
3BHR ...XP6A
3BXG          MACCS    ,FX2
3CC6          SMO      0
3CWQ          LDX   5  8
3DBB          ANDX  5  3
3DW2          SMO      4                   [STORE ISOLATE OF PUC ONR
3F*L          STO   5  6                   [IN TP WD 6.
3FT=          SMO      7
3G#W          LDN   5  0
3GSG          SMO      4
3H#6          DCH   5  31
3HRQ          LDCT  5  #600                [SET B0/1 FOR PUC XCOD IN TP WD 31
3J?B    X31ST SMO      4
3JR2          ORS   5  31
3K=L          STEPBAC  0
3KQ=          EVENTFIN
3L9W    XTPFN FINDTP   ,4                  [FIND TP X0
3LPG          MACCS    ,4,4                [ADDRESS
3M96          EXIT  6  0
3MNQ    XNPUC
3N8B          LDX   0  EVENT6(2)
3N=^ ...[
3N*J ...#UNS  ADUALDME
3ND7 ...      SBN   0  10
3NGQ ...#UNS  ADUALDME
3NK* ...#SKI
3NN2 ...      SBN   0  9
3NXS ...[
3P7L          BPZ   0  XILL                [ILLEGAL EXTRACODE
3PM=          SMO      EVENT6(2)
3Q6W          BRN      TABERR
3QLG    TABERR
3R66          BRN      XTRACOD             [XTRAC NOT IMPLEMENTED BY EXEC
3RKQ          BRN      XGEOG               [INOPERABLE PERIPHERAL
3S5B          BRN      (GEOERR)
3SK2          BRN      XILL1               [FLOATING POINT:UNDERFLOW
3T4L          BRN      XILL1               [              :OVERFLOW
3TJ=          BRN      XILLPF              [PARITY FAILURE
3W3W          BRN      XILL1               [HARDWARE ILLEGAL
3WHG          BRN      XILL                [ILLEGAL EXTRACODE
3WJ6 ...#UNS  ADUALDME
3WJQ ...(
3WKB ...      BRN      XMTO
3WL2 ...      BRN      XILLOCP
3WLL ...XMTO
3WM= ...)
3WMY ...#     OTHERWISE,MEMBER MILL TIMER OVERFLOW( E.G. LOOPING PROGRAM HIGHER
3WQ7 ...#     PRIORITY THAN GEORGE)
3WSB ...#     WILL ONLY RE-ENTER FROM  UNPLUG IF NOT TIME UP(TO DO RUNPROG)
3WSD ...#              CORRECTION FOR B8250
3WSG ...#              (EXEC NOTICES MILL TIMER OVERFLOW, INCREMENTS WORD 39,
3WSJ ...#              LEAVES ONLY REMAINDER IN MEL, HENCE LITTLE CHANCE OF
3WSL ...#              TIME UP)
3WSN ...#              SO CONVERT OVERFLOW AND ADJUST VARIOUS TIMERS
3WSQ ...      LDX   5  QMAXPOS(1)          [MAXIMUM POSITIVE NUMBER IN WORD
3WSS ...      DVS   4  BEATTIME            [CONVERT TO MILLISECONDS
3WSW ...      LDN   6  AFW1
3WSY ...      ADX   6  FX2                 [X6 PTS TO 1ST MEL IN PCA
3WT2 ...      LDX   7  EVENT1(2)           [X7 PTS TO MEL WHICH OVERFLOWED TIME
3WT4 ...      SBX   7  6                   [X7 NOW PTS TO THISMEL,RELATIVE
3WT6 ...                                  [TO FIRST
3WT8 ...      SMO      7
3WT= ...      ADS   4  ATM1(2)             [ADD REMAINDER FROM CONVERSION TO
3WT# ...                                   [WHAT EXEC LEFT IN TIMER
3WTB ...      SMO      7
3WTD ...      LDX   6  ARM1(2)             [PICK UP MEMBER NUMBER
3WTG ...      SRL   6  18
3WTJ ...      SMO      6
3WTL ...      ADS   5  ATU1(2)             [ADD MILLISECONDS TO TIME USED THIS
3WTN ...                                   [MILL SCHEDULING PERIOD
3WTQ ...      FJOPCA   3,2                 [FIND JOB BLOCK
3WTS ...      LDN   4  0
3WTW ...      ADSC  5  HCLOCKTIME+1(3)     [ADD TO TIME CLOCKED BY PROGRAM
3WTY ...      ADS   4  HCLOCKTIME(3)
3WW2 ...      ADSC  5  GPROGTIME+1         [ADD TO TOTAL OBJECT PROGRAM TIME
3WW4 ...      ADS   4  GPROGTIME
3WW6 ...      ADSC  5  HTIMEJ+1(3)         [ADD TO JOB TIMER
3WW8 ...      ADS   4  HTIMEJ(3)
3WW= ...      SBSC  5  APROGTIME+1(3)      [SUBTRACT FROM TIME LEFT FOR PROG.
3WW# ...      SBS   4  APROGTIME(3)
3WWB ...      ADS   5  HTIMES(3)           [ADD TO SLOT TIME USED
3WWK ...      UNPLUG
3WYS ...      RUNPROG
3X36    XTRACOD
3XGQ    #SKI  K6OPCA>99-99
3Y2B    (
3YG2          TRACE    EVENT2(2),OPCEVEN2
3Y^L          TRACE    EVENT5(2),OPCEVEN5
3^F=    )
3^YW          LDX   3  EVENT5(2)           [COPY OF EXTRACODE
42DG          SLC   3  10                  [GET FUNCTION BITS
42Y6          ANDN  3  #177
43CQ          SBN   3  #150
0000 ...      BNG   3   XILL               [CATCH 137 PROBLEM
43XB          SMO      3                   [USE AS MODIFIER
44C2          BRN      XTABLE
44WL    # EXTRACODE SWITCH TABLE
45B=    XTABLE
45TW          BRN      XSUSBY
46*G          BRN      XREL
46T6          BRN      XDIS
47#Q          BRN      XISBY
47SB          BRN      XCONT
48#2          BRN      XSUSDP
48RL          BRN      XALLOT
49?=          BRN      XPERI
49QW          BRN      XSDDTY
4==G          BRN      XSDD
4=Q6          BRN      XSUSMA
4?9Q          BRN      XAUTO
4?PB          BRN      XSUSAR
4#92          BRN      XGIVE
4#NL          BRN      XRQSLP
4*8=          BRN      XTPINS
4*MW    #REP 8
4B7G          BRN      XGEO
4BM6    #     ACROSS TO DISEVENT TO DEAL WITH DISENGAGED PERIPHERAL
4C6Q    XGEOG ACROSS   DISEVENT,1
4CLB    #     HARDWARE ILLEGAL:ENTER ILLEGAL ROUTINE WITH NO MESSAGE SPECIFIED
4D62    XILL1
4DKL    #     ILLEGAL EXTRACODE
4F5=    XILL
4FJW          UNPLUG
4G4G          ILLEGAL
4GJ6    #     PARITY FAILURE
4H3Q    XILLPF
4HHB          UNPLUG   2
4HLM ...# OUTPUT CORE PARITY FAIL TO JL & CL
4HMQ ...      LDX   4  EVENT7(2)
4HNT ...      ADX   4  GEODATUM
4HPY ...      LDX   5  EVENT5(2)
4HR3 ...      OUTBLOCN 5
4HS6 ...      OUTPAR   TIMENOW
4HT9 ...      OUTPACK  4,1,OCTA
4HW# ...      OUTPACK  5,1,OCTB
4HXC ...      MONOUT   JLCPAR
4H^K ...# OUTPUT PARITY FAIL TO OBJECT PROGRAM
4J32          ILLEGAL  PARFAIL
4J45 ...#UNS  ADUALDME
4J58 ...(
4J6? ...XILLOCP
4J7B ...      UNPLUG   2
4J8F ...      OUTBLOCN 10
4J9J ...      FJOPCA   3,2,N
4J=M ...      OUTPACK  JUSER(3),3,USERNAME
4J?Q ...      FJOPCA   3,2,N
4J#T ...      OUTPACK  JNAME(3),3,JOBNAME
4J*Y ...      OUTPACK  EVENT7(2),1,NUMA
4JC3 ...      MONOUT   JPROGFAIL
4JD6 ...      ILLEGAL  PROCFAIL
4JF9 ...)
4JGL    # FURTHER DECODING OF EXTRACODES
4K2=    XSDDTY                        [160 GROUP
4KFW          CALL  4  XCHECK
4K^G          ACROSS   OPCAXCOD,1
4LF6    XSDD                               [161 GROUP
4LYQ          CALL  4  XCHECK
4MDB          ACROSS   OPCAXCOD,2
4MY2    # EXTRACODES NOT YET DEALT WITH
4NCL    XSUSBY
4NX=    XISBY
4PBW    XSUSDP
4PWG    XSUSMA
4QB6    XGEO
4QTQ    XILLXC
4R*B    XILLINS1
4RT2          UNPLUG
4S#L    XILLINS
4SS=          ILLEGAL  ILLINS
4T?W    XSUSAR
4TRG          LDX   3  EVENT5(2)
4W?6          SLC   3  3
4WQQ          ANDN  3  7
4X=B          SBN   3  7
4XQ2          BNZ   3  XILLXC
4Y9L    XACTP
4YP=          ACROSS   TPINS,2             [164/7 ORDER
4^8W    XTPINS
574B          ACROSS   TPINS,1             [167  ORDER
57J2    XCONT                              [CONT EXTRACODE
583L          ACROSS   CONTXCOD,1
58H=    # GIVE EXTRACODE
592W    XGIVE
5#^S ...      LDX   4  EVENT2(2)
5*3Q ...      SBN   4  4
5*5N ...      BZE   4  XGVE               [J IF N(M) = 4
5*7L ...      SBN   4  8
5*9J ...      BZE   4  XGVE               [J IF N(M) = 12
5*?G ...      ACROSS   GIVEA,1
5**D ...XGVE
5*CG          ACROSS   GIVE,1
5*X6    XRQSLP
5BBQ          LDX   4  EVENT5(2)
5BWB          SRL   4  21
5CB2          BZE   4  S1
5CTL          SBN   4  1
5D*=          BNZ   4  XILLXC
5DSW          ACROSS   REQESLIP,1          [WRITE REQUEST SLIP
5F#G    S1                                 [ENTRY FOR RRQ (X=0)
5FS6          LDN   6  16
5G?Q          CHECKB   EVENT2(2),6,XRESVIOL,,W
5GRB          MHUNTW   3,AOBRES            [FIND REQ. SLIP
5H?2          LDN   4  A1(3)               [START OF SLIP
5HQL    #     MOVE REQUEST SLIP TO PROGRAM AREA
5J==          LDX   5  EVENT2(2)
5JPW          FINMOVE  2,5,4,6,HLOCK1
5K9G          EVENTFIN
5KP6    #
5L8Q    # THIS SECTION DEALS WITH AUTO N(M) NON ZERO(ESTABLISH MEMBER)
5LNB    #
5M82    # THE MEMBER MUST EXIST AND NOT ALREADY ESTABLISHED
5MML    XAUTO LDX   5  EVENT5(2)
5N7=          BNG   5  XAIL1               [ERROR IF MEMBER NO > 3
5NLW          SLC   5  3
5P6G          ANDN  5  7                   [MEMBR TO BE ESTAOLISHED
5PL6          LDX   3  5                   [KEEP IT IN X3
5Q5Q          MPY   5  XK61(1)             [GET PTR TO RELEVANT SUSPENSION WORD
5QKB          SMO      6
5R52          LDX   4  ASU1(2)
5RJL          BNG   4  XAIL1               [ERROR IF MEMBER NONEXISTENT
5S4=          SLL   4  1
5SHW          BPZ   4  XAIL2               [ERROR IF MEMBER ALREADY ESTABLISHED
5T3G          LDX   4  EVENT2(2)           [ENTRY FOR NEW MEMBER
5TH6          CHECKA   4,,XRESVIOL,,XCHOBEY(1)
5W2Q          LDN   1  2(3)
5WGB          SLL   1  4                   [ADR OF ACC DUMP FOR NEW MEMBER
5X22          MACCS    ,2
5XFL          ADX   1  0
5X^=          STO   4  8(1)                [WORD 8 OF NEW MEMBER
5YDW          LDCT  4  #200
5YYG          SMO      6
5^D6          ERS   4  ASU1(2)             [CLEAR B1 IN SUSPENSION WORD
5^XQ          LDCT  5  #600
62CB          ORS   5  2                  [SET UP CHARACTER MODIFIER
62X2          LDCH  1  ALMT(2)             [MODES OF CURRENT MEMBER
63BL          SMO      6                   [TRANSFER MODES TO ESTABLISHED
63W=          DCH   1  ARM1(2)             [MEMBER
64*W          EVENTFIN
64TG    XAIL1 UNPLUG
65*6          ILLEGAL  AUTO
65SQ    XAIL2 UNPLUG
66#B          ILLEGAL  AUTO1
66S2    #
67?L    XRESVIOL
67R=          UNPLUG
68=W          ILLEGAL  RESVIOL
68QG    #
69=6    # CHECK VALUE OF X
69PQ    XCHECK
6=9B          LDX   3  EVENT5(2)           [COPY OF EXTRACODE
6=P2          SLC   3  3
6?8L          ANDN  3  7
6?N=          SBN   3  3
6#7W          BPZ   3  XILLXC
6#MG          EXIT  4  0
6*76    #     THIS DEALS WITH THE PERI EXTRACODE
6*LQ    Q4             +4                  [LENGTH OF CONTROL AREA
6B6B    XMT            +5                  [MAG TAPE TYPE
6BL2    XED            +6                  [EDS TYPE
6C5L    XFD            +13                 [FDS TYPE
6CK=    XMCF  +7
6D4W    XTYPE60        +60                 [TYPE 60
6DJG    XMX   +11
6F46    XIT   +10
6FHQ    XGD   +21
6G3B    XID   +14
6GH2    XIPB           +24
6H2L    XIPC           +28
6HG=    XMOD  #1000
6HL7 ...XOMODA #200
6HQ4 ...XOMODE #400
6H^W    TABA                               [BRANCHES/MONITOR TYPES FOR UNALLOC M
6JFG    #HAL  ZA3,0                        [ MODE #000
6J^6    #HAL  WN8,BBOPEN                   [      #100
6KDQ    #HAL  WN8,BBOPEN                   [      #200
6KYB    #HAL  WN8,BBOPEN                   [      #300
6LD2    #HAL  WN11,BBOPEN                  [      #400
6LXL    #HAL  ZA3,0                        [      #500
6MC=    #HAL  WN10,BBOPEN                  [      #600
6MWW    #HAL  ZA3,0                        [      #700
6NBG    #
6NW6    TABB1                              [BRANCHES/MONITOR TYPES FOR ALLOC MT
6P*Q    #HAL  WN5,BBCLOSE                  [ MODE #1007
6PTB    TABB2
6Q*2    #HAL  WN6,BBCLOSE                  [      #1000
6QSL    TABB3
6R#=    #HAL  WN9,BBRENAME                 [      #500
6RRW    #
6S?G                                       [BRANCHES/MONITOR TYPES FOR UNALLOC
6SR6                                       [ ED/FD/MC
6T=Q    TABC1
6TQB    #HAL  WM1,BBOPEN                   [MODES #100 #200 #300 #400
6W=2    TABC2
6WPL    #HAL  WM3,BBOPEN                   [MODE  #600
6WWS ...TABC3
6X42 ...#HAL  WM5,BBOPEN                   [MODES #1600 #1700
6X9=    WMX            #71777
6XF4 ...XEDC           #00600000
6XNW    #     THIS SECTION DEALS WITH A PERI
6Y8G    #     PROVIDED THE FIRST FOUR WORDS OF THE CONTROL AREA ARE WITHIN
6YN6    #     RESERVATIONS IT MAY BE ASSUMED THAT THE PERI IS ON AN UNALLOCATED
6^7Q    #     OR ONLINE DEVICE SINCE PERIS ON OFFLINE DEVICES ARE NOTIFIED TO
6^MB    #     AOLPT.
7272    #     THE TYPE & MODE ARE EXAMINED & IF THE PERI SHOULD BE DEALT WITH
72LL    #     BY GEORGE THE APPROPRIATE ROUTINE IS ENTERED
736=    #     OTHERWISE THE'ILLEGAL'ROUTINE IS ENTERED WITH NO MESSAGE SPECIFIED
73KW    #     SO THAT IT WILL TRY & FIND OUT WHAT IS WRONG
745G    #     IT WOULD BE AN IDEA IF THIS SEGMENT SENT THE MESSAGE'UNALLOCATED
74K6    #     X%A'IF THE DEVICE IS NOT ALLOCATED & IN FACT THIS IS DONE IN THE
754Q    #     CASE OF EDS-HOWEVER FOR THE TIME BEING THIS WILL BE LEFT TO THE
75JB    #     ILLEGAL ROUTINE.
7642    XPERI
76HL          CHECKB   EVENT2(2),Q4(1),ZA2,,W,,,,K1OPCA
773=          LDX   5  EVENT4(2)           [1ST WORD OF CONTROL AREA
77GW    #SKI  K6OPCA>99-99
782G          TRACE 5,PERIAREA
78G6          LDX   6  EVENT3(2)           [UNIT NO
79FB          LDCT  4  #377
79^2          ANDX  4  5                   [TYPE IN X4
7=3K ... SEGENTRY K90OPCA
7=68 ...      ANDN  6  #77                 [FOR MANYDA SPECIAL
7=8R ...      BXE   4  XEDC(1),TYPE6
7=?B ...      ANDN  6  #77
7=*^ ...TYPE6
7=DL          STO   4  GEN6                [REMEMBER IT
7=Y=          ORX   4  6                   [TYPE/UNIT NO IN X4
7?CW          CALL  7  XFPERENT
7?XG          SMO   FX2
7#C6          STO   2  AWORK2
7#WQ          BNG   2  ZA5                 [J IF UNALLOCATED
7*BB          LDX   2  1(2)
7*W2          ANDX  2  BITS22LS            [PTR TO DEVICE LIST
7B*L          SMO      FX2
7BT=          STO   2  AWORK4
7C#W          CHECKFLAG 2,ZNFW             [J IF NOT FLAGWAVER
7CSG          BRN      XRELP
7D#6    ZNFW
7DRQ          CHECKXOT 2,ZA5               [J IF NOT EXOTIC
7F?B          J151L    2,ZA2               [I-LEGAL IF REL ALLOWED
7FR2          BRN      XRELP
7G=L    ZA5
7GQ=          LDX   2  FX2
7H9W          LDX   7  GEN6                [TYPE
7HPG          SLC   7  9
7J96          TXU   7  XIPC(1)
7JNQ          BCC      PCI1                [J IF IPC
7K8B    # AT THIS STAGE WE SWITCH ON TYPE
7KN2    # NOTE THAT X4 IS IN THE SAME FORMAT AS THE RELPERENT REPLY
7L7L    # X5-TYPE/MODE WORD,X6-UNIT NR,X7-TYPE
7L#S ...      TXU   7  XMT(1)              [JUMP IF MAG TAPE
7LG2 ...      BCC      XADRIAN
7LM=          UNPLUG
7M6W          TXU   7  XIPB(1)
7MLG          BCC      XRELP
7P5B          TXU   7  XED(1)              [JUMP IF EDS
7PK2          BCC      XANDY
7Q4L          TXU   7  XFD(1)              [JUMP IF FDS
7QJ=          BCC      XANDY
7R3W          TXU   7  XMCF(1)
7RHG          BCC      XANDY
7S36          TXU   7  XTYPE60(1)          [TYPE 60-JUMP TO DEAL
7SGQ          BCS      ZA3                 [WITH ILLEGAL
7T2B          ANDN  5  #77
7TG2          SBN   5  #73
7T^L          BNG   5  XPROGISH
7WF=          SBN   5  2
7WYW          BPZ   5  XBEXT
7XDG          ACROSS   MEXTSJ,1
7XY6    XBEXT
7YCQ          ACROSS   BEXTSJ,1
7YXB    XPROGISH
7^C2          ACROSS   PROGISH,1
7^J8 ...PCI1  LDX   3  QMASK3(1)
7^PB ...      ANDX  3  5
7^R5 ...      TXU   3  XOMODA(1)
7^SS ...      BCC      PCI2                [J IF OPEN MODE #200
7^WJ ...      TXU   3  XOMODE(1)
8222 ...      BCS      PC1                 [JUMP IF NOT OPEN MODE #400
825D ...PCI2
828Y ...      LDN   1  BBOPEN
82B=          CALL  3  ZMONITOR
82TW    PC1   ACROSS   IPCOPENA,1
83*G    ZA2   UNPLUG
83T6    ZA3   ILLEGAL
84#Q    XADRIAN
84SB          LDX   0  AWORK2(2)
85#2          BPZ   0  WN1
85HS ...      UNPLUG
85RL          LDX   0  5
86?=          ANDN  0  #1077               [MODE ILLEGAL IF NOT #000 #100 #200
86QW          BNZ   0  ZA3                 [ #300 #400 #500 #600 #700-J IF ILLEG
87=G          LDX   0  5                   [ (#000,#500,#700 ILLEG BUT DETECTED
87Q6          SRL   0  6                   [ LATER)
889Q          ANDN  0  7
88PB          SMO      0
8992          LDX   3  TABA(1)             [GET BRANCH/MONTRG TYPE ACCORDING TO
89NL          BRN      TMON                [ MODE & J TO TEST FOR MONITORING
8=8=    WN1
8=9S ...      LDX   0  5
8=?B ...      ANDN  0  #1777               [MODE
8=#Y ...[     IF MODE 1 (WRITE) OR 5 (WRITE TAPE MARK) IN DIRECT
8=BG ...[     RESPONSE MODE,DON'T UNPLUG PROGRAM
8=D4 ...      SBN   0  1
8=FL ...      BZE   0  WN12
8=H8 ...      SBN   0  4
8=JQ ...      BZE   0  WN12
8=L# ...      UNPLUG
8=MW          LDX   0  5
8?7G          LDX   5  AWORK4(2)
8?M6          ANDN  0  #1777               [MODE
8#6Q          SBN   0  4
8#LB          BZE   0  WN2
8*62          SBN   0  2
8*KL          BZE   0  WN3                 [J IF MODE 6 -SKIP BACKWARD
8B5=          SBN   0  1
8BJW          BZE   0  WN4                 [J IF MODE 7 -REWIND
8C4G          SBN   0  #1000
8CJ6          BZE   0  WN5X                [J IF MODE #1007
8D3Q          ADN   0  7
8DHB          BZE   0  WN6X                [J IF MODE #1000
8F32          ADN   0  #300
8FGL          BZE   0  WN9X                [J IF MODE #500
8G2=          BRN      ZA3                 [J TO REPORT ILLEGAL
8GFW    WN2   ACROSS   OLMTB,7
8G^G    WN3   ACROSS   OLMTB,5
8HF6    WN4   ACROSS   OLMTB,3
8HYQ    WN5   ACROSS   OLMTB,11
8JDB    WN6   ACROSS   OLMTB,9
8JY2    WN8   ACROSS   OLMTC,1
8KCL    WN9   ACROSS   OLMTC,2
8KX=    WN10  ACROSS   OLMTC,3
8L9M ...WN11  ACROSS   GETONA,1
8LJ4 ...WN12  LDX   5  AWORK4(2)
8LP= ...      ACROSS   OLMTE,3
8LWG    WN5X  LDX   3  TABB1(1)
8MB6          BRN      TMON
8MTQ    WN6X  LDX   3  TABB2(1)
8N*B          BRN      TMON
8NT2    WN9X  LDX   3  TABB3(1)
8P#L          BRN      TMON
8PS=    XANDY
8Q?W          LDX   0  5
8QRG          ANDX  0  WMX(1)              [REMOVE ADDITIVE BITS FROM MODE
8R?6          LDN   3  4
8RQQ    WM2   SBN   0  #100
8S=B          BZE   0  WM1X                [J IF MODES #100 #200 #300 #400
8SQ2          BCT   3  WM2
8T9L          SBN   0  #200
8TP=          BZE   0  WM3X                [J IF OPEN SCRATCH(#600)
8W8W          SBN   0  #400
8WNG ...      BZE   0  WM1X                [JUMP IF CREATE (MODE #1200)
8XMQ          SBN   0  #400                [MODE #1600
8Y7B ...      BZE   0  WM5X
8YM2          SBN   0  #100
8Y^C ...      BZE   0  WM5X                [MODE #1700
8^?S ...                                   [OTHERWISE UNALLOCATED CHANNEL
8^L=          BRN      UNALLOC
925W    #
92KG    WM1   ACROSS   SOUP,2
9356    WM3   ACROSS   SCRATCH,1
93JQ    WM5   ACROSS   SQOPEN,1
944B    WM1X  LDX   3  TABC1(1)
94J2          BRN      TMON
953L    WM3X  LDX   3  TABC2(1)
95H=          BRN      TMON
95ND ...WM5X  LDX   3  TABC3(1)
95TL ...      BRN      TMON
962W    XRELP ANDN  5  #1777               [ISOLATE MODE
96GG          TXU   5  XMOD(1)             [#1000 IS ONLY VALID MODE
9726          BCS      ZA2
97FQ          BRN      ZREL2
97^B    #
98F2    TMON           [ENTRY WITH B0-11 OF X3 ADDR TO J TO IF NO MNTRG
98YL                   [           B12-23   X3 MNTRG TYPE
99D=                   [ X4=TYPE/UNIT NO OF PERIPHERAL X2=FX2
99XW          LDX   1  3
9=CG          ANDN  1  #7777               [MONITORING TYPE
9=X6          SRL   3  12                  [RETURN ADDRESS
9?BQ          BZE   1  TMON1               [J IF NO CHECKING
9?WB          BRN      ZMONITOS            [ELSE J TO TEST IF MNTRG REQUD
9#B2    TMON1 ADX   3  FX1
9#TL          EXIT  3  0
9**=    #
9*SW    #     THIS SECTION DEALS WITH THE EXTRACODES 'REL','DIS' AND 'ALLOT'
9B#G    #     ON ENTRY:ANM    HOLDS MEMBER NUMBER (B22-3)
9BS6    #              EVENT5 HOLDS COPY OF THE EXTRACODE
9C?Q    #              EVENT2 HOLDS N(M) OF INSTRUCTION
9CRB    #     THIS SECTION DEALS WITH REL.
9D?2    # THE EXTRACODE IS ILLEGAL IF THE PERIPH IS NOT OF AN ALLOWED TYPE
9DQL    # THESE ARE TR,TP,LP,CR,CP,FR,FW,TYPE 60
9F==    # IT IS ALSO ILLEGAL IF IT IS NOT        ALLOCATED TO
9FPW    # OTHERWISE THIS SEGMENT USES'RELPERENT'TO RELEASE THE PERIPH
9G9G    XUNALLOC
9GP6          UNPLUG
9H8Q    UNALLOC
9HNB          OUTPACK  4,1,PERINAME
9J82          ILLEGAL  UNALLOC
9JML    XREL
9K7=          CALL  7  XFTU                [FIND TYPE & UNIT NO.
9KLW          CALL  7  XFPERENT
9L6G          BNG   2  XUNALLOC
9LL6          LDX   3  1(2)
9M5Q          BNG   3  ZREL0
9MKB          ANDX  3  BITS22LS
9N52          J151L    3,ZREL1             [J IF REL ALLOWED
9NJL    ZREL0
9P4=          LDX   6  4
9PHW          SRL   6  15                  [TYPE IN X6
9Q3G          SBN   6  5
9QH6          BNG   6  ZREL1
9R2Q          SBN   6  45                  [JUMP IF FR
9RGB          BZE   6  ZREL1
9S22          SBN   6  1                   [     OR FW
9S?B ...      BZE   6  ZREL1
9SJQ ...      SBN   6  1                  [ OR FH
9SW6 ...      BZE   6  ZREL1
9T7G ...      SBN   6  8                   [OR UNLESS CI (TYPE 60)
9TDW          BNZ   6  XILLINS1            [JUMP IF NOT OF SUITABLE TYPE
9TYG    ZREL1
9WD6    #SKI  K6OPCA>999-999
9WXQ          TRACE    0(2),RELXCOD        [PRB  ENTRY FOR DEVICE TO BE'REL'ED
9XCB    ZREL2 LDN   1  BBREL
9XX2          CALL  3  ZMONITOR
9YBL          UNPLUG
9YW=          CAPCA                        [GET TO SUITABLE STATE TO
9^*W          RELPERENT 4
9^TG          RUNPROG                      [MAKE PROG RUNNABLE
=2*6    #     THIS SECTION DEALS WITH DIS.
=2SQ    # THE EXTRACODE IS ILLEGAL IF THE PERIPH IS NOT OF AN ALLOWED TYPE
=3#B    # THESE ARE TR,TP,LP,CR,CP,FR,FW.
=3S2    # IT IS ALSO ILLEGAL IF IT IS NOT ALLOCATED TO THE P_OG.
=4?L    # IT CAUSES AN ONLINE DEVICE TO BE DISENGAGED AND AN OFFLINE OUTPUT
=4R=    # DEVICE TO BE STEPPED ON TO THE NEXT STREAM
=5=W    XDIS
=5QG          CALL  7  XFTU                [LOOK UP TYPE & UNIT
=6=6          CALL  7  XFPERENT
=6PQ          BNG   2  XUNALLOC
=79B          LDX   3  1(2)
=7P2          BNG   3  ZDIS0               [J IF OFFLINE
=88L          J152L 3,ZDIS1
=8N=    ZDIS0
=97W          LDX   0  4
=9MG          SRL   0  15
==76          SBN   0  5                   [JUMP IF SLOW PERIPH
==LQ          BNG   0  ZDIS1
=?6B          SBN   0  45                  [ FR
=?L2          BZE   0  ZDIS1
=?TS ...      SBN   0  1                   [ FW
=#5L ...      BZE   0  ZDIS1
=#*D ...      SBN   0  1                   [ FH
=#K=          BNZ   0  XILLINS1
=*4W    ZDIS1
=*JG    #SKI  K6OPCA>999-999
=B46          TRACE    0(2),DISXCOD        [PRB ENTRY FOR DEVICE TO BE 'DIS'ED
=BHQ          LDX   4  0(2)                [PICK UP ENTRY
=C3B          LDN   1  BBDIS
=CH2          LDX   6  3
=D2L          CALL  3  ZMONITOR
=DG=          BNG   6  ZDIS3               [J IF OFFLINE
=D^W    NBUSY JBUSY    6,XBUSY
=FFG          DISENGPER 6
=F^6    ZDIS3 EVENTFIN
=GDQ    XBUSY COOR3    #41
=GYB          BRN      NBUSY
=HD2    #     THIS SECTION DEALS WITH ALLOT
=HXL    #  'ALLOT'IS NEVER ILLEGAL INSTEAD A REPLY IS GIVEN IN WORD 9 AS FOLLOWS
=JC=    #  B0=1-PERIPH NOT ALLOCATED
=JWW    #  B9=1-PROPS IMPLEMENTED & B10-17 GIVE PROPS  B9=0 NO PROPS
=KBG    #  B18-23-GEOGRAPHIC NUMBER-ZERO IF OFFLINE.
=KW6    XALLOT
=L*Q          CALL  7  XFTU                [FIND TYPE & UNIT
=LTB          CALL  7  XFPERENT            [LOOK UP ENTRY IN PRB
=M*2          LDCT  5  #400                [SET -VE REPLY IF UNALLOCATED
=MSL          BNG   2  ZALL3X
=N#=          LDX   0  1(2)
=NRW          BPZ   0  NOFL1               [J IF ONLINE
=P?G          CHECKSTATE 2,0
=PR6          BPZ   0  ZALL3
=Q=Q          SMO      FX2
=QQB          LDX   7  EVENT2
=R=2          SLC   7  11
=RPL          ANDN  7  3                   [ISOLATE B9,10 OF DN
=S9=          BZE   7  NOFL                [J IF  DRM   NOT TO BE SET OR UNSET
=SNW          BCT   7  SETDR               [J IF DRM TO BE SET  (B9 SET)
=T8G          FDRMOFF  2                   [UNSET DRM  (B10 SET)
=TN6          BRN      NOFL
=W7Q    SETDR FDRMON   2                   [SET DRM
=WMB    NOFL
=X72          STOZ     5                   [SET ZERO REPLY
=XLL          LDX   0  0(2)                [OFFLINE-TYPE
=Y6=          SRL   0  15
=YKW          SBN   0  5
=^5G          BZE   0  ZALLMT              [J IF MAG. TAPE
=^K6          SBN   0  4
?24Q          BZE   0  ZALLDR              [J IF DRUM
?2JB          SBN   0  16
?342          BZE   0  ZALLHD              [J IF HIGH SPEED DRUM
?3HL          SBN   0  3
?43=          BNZ   0  ZALL3               [ZERO REPLY IF NOT MT,HSD,DR,IPC
?4GW          LDX   3  1(2)                [PTR TO OLPA
?52G          LDX   5  IPPROPS-CHAINADD(3) [GET PROPERTIES
?5G6          BRN      ZALL3
?5^Q    #
?6FB    #     MAGNETIC TAPE
?6^2    ZALLMT
?7DL          SMO      1(2)
?7Y=          LDX   0  ATMARK-CHAINADD
?8CW          SBN   0  2
?8XG          BNZ   0  ZALLMT1
?9C6          LDX   3  1(2)
?9WQ          SBN   3  CHAINADD
?=BB          MTPTR    3,3
?=W2          BRN      NOFL2
??*L    ZALLMT1
??T=          LDN   5  #3000
?##W          BRN      ZONL1               [BS 9 13 14 IF MT OFFLINE
?#SG    #     DRUM TYPE 9
?*#6    ZALLDR
?*RQ          LDX   3  1(2)
?B?B          ANDX  3  BITS22LS            [PTR TO CHAINADD OF OLPA.
?BR2          LDX   3  CPPTR-CHAINADD(3)   [PTR TO DEVICE LIST
?C=L          BZE   3  ZALL3               [J IF OFFLINE
?CQ=          BRN      ZONL
?D9W    #     HSD TYPE
?DPG    ZALLHD
?F96          LDN   5  #400                [HSD MARKER IN REPLY
?FNQ          LDX   3  1(2)
?G8B          ANDX  3  BITS22LS            [PTR TO CHAINADD OF OLPA
?GN2          LDX   3  CPPTR-CHAINADD(3)   [PTR TO DEVICE LIST
?H7L          BRN      ZGEOG
?HM=    ZONL
?J6W          LPROP    3,5                 [GET PROPERTIES
?JLG          SLL  5  6                    [PROPS.INB9-18
?K66    ZGEOG LGEOG    3,4                 [GET GEOG.NO.
?KKQ          ANDN  4  #77                 [USE M.S. 6 BITS
?L5B          ORX   5  4                   [ACCUMULATE REPLIES
?LK2    ZONL1 LDCT  0  1
?M4L          SRL   0  1
?MJ=          ORX   5  0                   [SET B9=1 AS PROPS. IMPLEMENTED
?N3W    ZALL3
?NHG          MACCS ,FX2,3                 [PTR TO MEMBERS X0
?P36          LDCT  0  #377
?PGQ          ANDX  0  9(3)
?Q2B          ORX   5  0
?QG2          STO   5  9(3)                [SET REPLY
?Q^L    #SKI  K6OPCA>999-999
?RF=          TRACE 5,ALOTXCOD             [TRACE REPLY TO ALLOT
?RYW          EVENTFIN
?SDG    ZALL3X
?SY6          LDX   2  FX2
?TCQ          LDX   0  EVENT2(2)
?TXB          ANDN  0  512
?WC2          BNZ   0  ZALL3               [J IF ALLOT WAS NOT REQUESTING PERIPH
?WWL          LDN   1  BBALLOT
?XB=          CALL  3  ZMONITOR
?XTW          BRN      ZALL3
?Y*G    NOFL1
?YT6          LDX   3  1(2)
?^#Q    NOFL2 SMO      FX2
?^SB          LDX   7  EVENT2
#2#2          SLC   7  11
#2RL          ANDN   7  3
#3?=          BZE   7  ZONL                [J IF NO REQUEST
#3QW          BCT   7  SETDRON             [J IF DRM TO BE SET
#4=G          CLDRM    3                   [CLEAR DRM
#4Q6          BRN      ZONL
#59Q    SETDRON
#5PB          JDRMABLE 3,SETABLE
#692          BRN      ZONL
#6NL    SETABLE
#78=          SETDRM   3
#7MW          BRN      ZONL
#87G    #
#8M6    #                              SUBROUTINES
#96Q    #
#9LB    # THIS SUBROUTINE CALCULATES THE TYPE & UNIT NO FOR A 'REL'TYPE XCODE
#=62    # FROM EVENT2&3
#=KL    #
#?5=    # X7 HOLDS THE LINK
#?JW    #
##4G    # ON EXIT X4 HOLDS TYPE &UNIT NO.IN B0-8 & B9-23 RESPECTIVELY
##J6    XFTU
#*3Q    #SKI  K6OPCA>99-99
#*HB          TRACE    EVENT3(2),OPCEVEN3
#B32          LDX   5  EVENT3(2)           [UNIT NO
#C2=          LDN   4  #77
#CFW          ANDX  4  EVENT2(2)           [TYPE IN X4
#CJF ... SEGENTRY K91OPCA
#CM4 ...      ANDN  5  #77
#CPM ...      BXE   4  XED(1),TYPE6A       [FOR MANYDA SPECIAL
#CS= ...      ANDN  5  #77
#CWT ...TYPE6A
#C^G          LDN   0  13
#DF6          TXU   4  0
#DYQ          BCS      XFTU1
#FDB          LDN   4  6                   [REGARD TYPE 13 AS TYPE 6
#FY2    XFTU1
#GCL          SRC   4  9                   [TYPE IN BITS 0-9
#GX=          ORX   4  5
#HBW    #SKI  K6OPCA>999-999
#HWG          TRACE    4,TYPEUNIT
#JB6          EXIT  7  0
#JTQ    # THIS S/R SEARCHES THE PRB FOR A PERIPHERAL OF THE TYPE/UNIT NO
#K*B    # SPECIFIED IN B0-8/B9-23 OF X4
#KT2    #
#L#L    # ON ENTRY THE PROGRAM MUST BE PLUGGED IN &X2=FX2
#LS=    #
#M?W    # X7 HOLDS THE LINK
#MRG    #
#N?6    # ON EXIT 1)X2->TO THE ENTRY IF FOUND.OTHERWISE X2 IS -VE
#NQQ    #         2)X3 HOLDS A COUNT OF OFFLINE ENTRIES UP TO AND INCLUDING
#P=B    #           THE ONE FOUND
#PQ2    XFPERENT
#Q9L          LDX   2  APRB(2)
#QP=          FPERENT  4,2,2,3
#R8W          EXIT  7  0
#RNG    #
#S86    # THIS SUBROUTINE CHECKS IF 'OPEN PERI' TYPE MONITORING IS REQUIRED,AND,
#SMQ    # IF IT IS,GENERATES THE APPROPRIATE MONITOR EVENT.
#T7B    # ON ENTRY X4=TYPE/UNIT NO.OF PERIPHERAL,X1=MONITORING TYPE
#TM2    # PROGRAM MUST BE PLUGGED IN FOR ZMONITOR,UNPLUGGED FOR ZMONITOS
#W6L    # LINK IN X3 - ABSOLUTE IF ZMONITOR,REL TO START OF SEG IF ZMONITOS
#WL=    # ON EXIT:IF NO MNTRG,X0 DESTROYED,X1=FX1,X2=FX2
#X5W    #        :IF MNTRG,NO EXIT TO CALLING ROUTINE
#XKG    ZMONITOR
#Y56          SBX   3  FX1
#YJQ          ORX   1  GSIGN
#^4B    ZMONITOS
#^J2          SMO      FX2
*23L          STO   1  AWORK1
*2H=          ANDX  1  BITS22LS
*2JH ...#UNS G400
*2KS ...(
*2M5 ...      HUNT     2,IUSER,G400BLK
*2NB ...      BNG   2  XDSK2          [NOT EXIT MR
*2PM ...      LDX   0  A1(2)
*2QY ...      SBN   0  5
*2S9 ...      BNZ   0  XDSK2
*2TG ...      FREECORE   2
*2WR ...      BRN      XDSK1         [NORMAL PATH
*2Y4 ...XDSK2 LDX   2  FX2
*2^* ...)
*32W          TESTMON  ,1,4,ZMON1
*33H ...#UNS G400
*348 ...(
*34T ...      SMO    FX2
*35G ...      LDX   1  AWORK1
*367 ...      ANDX  1  BITS22LS
*36S ...      SBN   1  BBOPEN
*37F ...      BNZ   1  XDSK1
*386 ...      LDX   2  FX2
*38R ...      LDX   0  4
*39D ...      SRL   0  15              [TYPE - X0
*3=5 ...      SBN   0  5
*3=Q ...      SEGENTRY G400HKMT
*3?C ...      BRN      XDSK3
*3#4 ...      BZE   0  XDSK4         [DO HOOK
*3#P ...XDSK3
*3*B ...      SBN   0  1
*3B3 ...      SEGENTRY G400HKDA
*3BN ...      BRN      XDSK1
*3C* ...      BNZ   0  XDSK1          [CONTINUE
*3D2 ...XDSK4 ACROSS   DOMONOP,1
*3DM ...XDSK1
*3F# ...)
*3GG          ADX   3  FX1
*426          EXIT  3  0
*4FQ    ZMON1 LDX   6  4
*4^B          LDX   7  EVENT2(2)
*5F2          LDXC  5  AWORK1(2)
*5YL          BCC      ZMON2
*6D=          UNPLUG
*6XW    ZMON2 REPMON
*7CG    #
*7X6    #
*8BQ    #
*8WB          MENDAREA 25,K100OPCA
*9B2    #END
^^^^ ...07117125000500000000
####
IN :GEO,WHATPERB867(2004),T####
22FL    #LIS K0WHATPERB>K0ALLGEO>K0GREATGEO>K0COMMAND
22KH ... SEG WHATPERB,,,,G203
22PD ...[
22T* ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22^= ...[     THIS EXCLUDES CODE UNDER #SKI G203
2357 ...[
2394    #OPT K0WHATPERB=0
23BX ...#OPT G203 = 0
23JQ ...#SKI G203&1
23QK ...# WITH UGUG EDIT M203 (ALLOW WHATPER FOR REMOTE DEVICES)
23YG          SEGENTRY K1WHATPERB,QK1WHATPERB
24D6          SEGENTRY K2WHATPERB,QK2WHATPERB
24DB    [
24DG    STUC
24DL    #HAL  +EWDAS+ASTUC,0
24DQ    XOF
24DW    #HAL  +EWDAS+EXOF,0
24F2    XFUSSY         +FUSSY
24F6    XFSWO          +JUNITSWO
24F=    XWPMOP         +AWPMOP
24FB                   +AWPMOPG
24FG    XFRESUNEN      +FRESUNEN
24FL    XFRONG         +FWRONG
24FQ    XFIDLE         +FIDLE
24FW    XFONLINE       +FONLINE
24G2    XFOLJOB        +FOLJOB
24G6    XFFAIL      +FFAIL
24G=    #     S/R   TO CLOSE UP USER AND LOCAL NAMES
24GB    #     X3   -> USER NAME
24GG    #     X4    LINK
24GL    UPCLOSE
24GQ          SBX   4  FX1
24GW          LDN   7  ACOMMUNE1(2)
24H2          FLENME1  0,3,5
24H6          SBN   7  ACOMMUNE1(2)
24H=          SLC   7  2
24HB          LDN   0  24
24HG          SBX   0  7
24HL          BPZ   0  NOT25               [J IF < 25 CHARS
24HQ          HUNTW    3,ADATA,CSTORE
24HW          BPZ   3  PHOUND1
24J2          SETNCORE 7,3,ADATA,CSTORE
24J6    PHOUND1
24J=          ADN   2  ACOMMUNE1           [THIS NECESSARY AS
24JB          ADN   3  A1
24JG          MVCH  2  26                  [OUTPARAM USES ACOMMUNE7
24JL          OUTPARAM 7,A1,ADATA,CSTORE
24JQ          BRN      XIT
24JW    NOT25
24K2          OUTPARAM 7,ACOMMUNE1
24K6    XIT
24K=          ADX   4  FX1
24KB          EXIT  4  0
24KG    #
24KL    XHTAWP
24KQ          MHUNTW   3,ADATA,AWPER
24KW          EXIT  7  0
24L2    #
24L6    [
24L=    #UNS  ADMELI
24LB    (
24LG    [
24LL    [                        MESSAGES FOR STATE OF DME MX LINES
24LQ    [
24LW    ZCND  +9
24M2          9HCONNECTED
24M6    ZDCD  +12
24M=          12HDISCONNECTED
24MB    ZBECN +15
24MG          15HBEING CONNECTED
24ML    ZBEDC +18
24MQ          18HBEING DISCONNECTED
24MW    ZTOCN +15
24N2          15HTO BE CONNECTED
24N6    ZTODC +18
24N=          18HTO BE DISCONNECTED
24NB    WIRE4 +6
24NG          6H4-WIRE
24NL    WIRE2 +6
24NQ          6H2-WIRE
24NW    ZFAST +4
24P2          4HFAST
24P6    ZSLOW +4
24P=          4HSLOW
24PB    NORM  +6
24PG          6HNORMAL
24PL    STAND +7
24PQ          7HSTANDBY
24PW    ZOP   +8
24Q2          8HOPERABLE
24Q6    ZINOP +10
24Q=          10HINOPERABLE
24Q?    ZSWOUT         +14
24Q#                   14H,SWITCHED OUT)
24Q*    ZWTBSW         +28
24QB                   28H,WAITING TO BE SWITCHED OUT)
24QC    ZNULL          +1
24QD                   1H)
24QF    [
24QG    [
24QL    [                    BITS IN STATE OF DME MX LINE
24QQ          BITDEFS  AWORK1,0,YFOUR,YSLOW,YNORMAL,YBEING,YCN,YOP
24QW          BITDEFS  AWORK1,19,TRANSBIT
24R4          BITDEFS  AWORK2,0,PRCONT,NOCSC,YSWO,YWTBSW
24R=          FIELDDEF PORT,6,AWORK1,17
24RB          FIELDDEF SCOUPLER,6,AWORK1,11
24RG          FIELDDEF PROT,6,AWORK1,23
24RL    [
24RQ    ZOUTPAR                    [SUB TO OUTPUT PARAMS FOR MX LINE STATE
24RW          SBX   7  FX1
24S2          LDN   5  1(3)                [ADDR OF PARAM
24S6          LDN   6  ACOMMUNE1(2)
24S=          SMO      0(3)
24SB          MVCH  5  0                   [MOVE PARAM INTO ACOMM WDS.
24SG          OUTPARAM 0(3),ACOMMUNE1
24SL          ADX   7  FX1
24SQ          EXIT  7  0
24SW    )
24XQ    QK1WHATPERB
24XS    [
24XW          STO   5  AWORK2(2)           [SAVE PER TYPE
24XY          CALL  7  XHTAWP
24Y2          LDX   2  3                   [SAVE X3
24Y4          LDN   4  A1+5
24Y6          STO   4  A1(3)               [INTERNAL POINTER
24Y8          ADN   3  A1+5                [INT PTR TO FIRST REC HDDR
24Y=          BRN      ST1
24Y#    UPD   LDX   2  FX2
24YB          LDX   5  AWORK2(2)           [RESTORE PER TYPE
24YD          CALL  7  XHTAWP
24YG          LDX   2  3                   [SAVE X3
24YJ          LDX   4  A1+1(3)
24YL          SBN   4  1
24YN          BZE   4  NOUGH               [J IF NO MORE RECS IN BLK
24YQ          STO   4  A1+1(3)             [UPDATE COUNT OF RECS
24YS          LDN   4  K54-K50+14          [LENGTH OF THIS RECORD
24YW          ADS   4  A1(3)               [POINTER SET TO NEXT RECORD
24YY          ADX   3  A1(3)               [ABSOLUTE POINTER TO NEXT RECORD
24^2    ST1
24^3 ...      JENVNOT  ST2,CME
24^4          JSWOUT   3,SWITOUT           [J IF SWITCHED OUT
24^6 ...ST2   LGEOG    3,0
24^8          SMO      FX2
24^=          STO   0  AWORK3
24^#          LDX   0  5
24^B          SBN   0  6
24^D          BZE   0  UDAS                [J IF TYPE 6 (ED) TO UDAS
24^G          SBN   0  1
24^J          BZE   0  UDAS                [J IF TYPE 7 (MCF) TO UDAS
24^L          SBN   0  6
24^N          BZE   0  UDAS                [J IF TYPE 13 (FD) TO UDAS
24^Q          SBN   0  13
24^S          BZE   0  UDAS                [J IF TYPE 26 (EDS30) TO UDAS
24^W          JWRONG   3,WRONGED           [J IF WRONGED
24^Y          JONL     3,ONLINE            [J IF ONLINE
2522          LDX   0  5
2524          SBN   0  10
2526          BZE   0  MULT                [J IF UX
2528          SBN   0  1
252=          BZE   0  MULT                [MX
252#          SBN   0  13
252B          BZE   0  MULTB               [OR IPB (TYPE 24)
252D          JALLOC   3,OWNED
252G          BRN      XIDLE
252J    MULT
252Q          MOPSTATE 3,6
252Y          BRN      MXMS
2532    MULTB
2534          MOPSTATE 3,6,AMOP
2536    MXMS
2538          STOZ     4
0000 ...      BNG   6  ZZINOP
0000 ...#SKI
253= ...      BNG   6  INOP
253#          BZE   6  ON
253*          SBN   6  5
253B          BZE   6  OFF
253C          LDN   4  1
253D          ADN   6  4
253G          BZE   6  ON
253J          SBN   6  1
253L          BZE   6  OFF
253S          CALL  7  OUTNUM
253W          CALL  7  OUTMESS
253Y          +JONOFF
2542          BRN      MXMS1
2544    ON
2546          CALL  7  OUTNUM
2548          CALL  7  OUTMESS             [IF ALLOCATED THEN MOP ON
254=          +JON
254#          BRN      MXMS1
254B    OFF   CALL  7  OUTNUM
254D          CALL  7  OUTMESS
254G          +JOFF
254H ...      BRN      MXMS1
0000 ...ZZINOP
0000 ...#SKI
254J ...INOP
254K ...      CALL  7  OUTNUM
254L ...      CALL  7  OUTMESS
254M ...      +G203INOP
254N ...MXMS1
254P ...      SMO      4
254Q ...      LDX   7  XWPMOP(1)
254R ...      BRN      MONOUTX
254S    UDAS
254W          LDX   6  K54-K50+8(3)
254Y          JTWIN    3,NOTWIN
2552          NGN   6  1
2554    NOTWIN
2556          LDX   4  K54-K50+8(3)
2558          ANDN  4  #20
255=          BNZ   4  USUDA               [J IF IN USE BY SYSTEM
255#          JENG     3,SET               [J IF ENGAGED
255B          CALL  7  OUTNUM
255D          CALL  4  OUTWIN
255G          LDX   7  XFIDLE(1)
255J          BRN      MONOUTX
255L    USUDA CALL  7  OUTNUM
255N          CALL  4  OUTWIN
255Q          CALL  7  MONOUT
255S          +FUSSY
255W          BRN      UDOUT
255Y    SET   JHOLD    3,SETH
2562          CALL  7  OUTNUM
2564          CALL  4  OUTWIN
2566          BRN      UDENG
2568    SETH  CALL  7  OUTNUM
256=          CALL  7  OUTMESS
256#          +FHSET
256B          CALL  4  OUTWIN
256D    UDENG CALL  7  MONOUT
256G          +FENG
256J    UDOUT
256L          CALL  7  XHTAWP
256N          ADX   3  A1(3)
256Q          LGEOG    3,3
256S          LDN 2 BCCB                   [SEARCH CCB CHAIN FOR ASTUC BLOCKS
256W    ULOOP LDX   2  FPTR(2)
256Y          TXU   2  CXCC
2572          BCC      ZEND                [J IF END
2574          LDX   0  ATYPE(2)
2576          TXU   0  STUC(1)
2578          BCS      ZEND                [J IF NOT RIGHT TYPE
257=          TXU   3  GEOGU(2)
257#          BCS      ULOOP               [J IF NOT RIGHT UNIT
257B          LDXC  6  BACK1(2)
257D          CALL  7  OUTOCT              [O/P SERIAL NUMBER
257G          CALL  7  MONOUT
257J          +FSUSN
257L          LDN   4  1                   [SET HEADING NOT O/P MARKER
257N          STO   4  AWORK4(2)
257Q          LDN   2  BCCB
257S    #     THIS ROUTINE OUTPUTS NAMES OF FILES OPEN ON UNIT
257W    ULOOP1
257Y          LDX   2  BPTR(2)
2582          LDX   0  ATYPE(2)
2584          TXU   0  XOF(1)
2586          BCS      REST
2588          TXU   6  ASUSN(2)            [CHECK IF /EXOF BLOCK
258=          BCC      XOUT                [IS FOR CORRECT S.U.
258#          LDX   5  ALOGLEN(2)
258B          SBN   5  FDCELLS-A1
258D          BZE   5  ULOOP1
258G    XCELL SBN   5  6
258J          SMO      5
258L          TXU   6  FDCELLS(2)          [LOOK AT NEXT CELL IN BLOCK
258N          BCC      XOUT
258Q          BNZ   5  XCELL
258S          BRN      ULOOP1
258W    XOUT  MHUNTW   1,ADATA,AWPER
258Y          LDN   5  A1+2(1)
2592          LDN   4  FIP(2)              [FILENAME IS
2594          MOVE  4  3                   [MOVED TO ACTIVITY BLOCK
2596          LDX   5  BACK2(2)            [X5 CONTAINS EXOFILE NO
2598          LDX   4  FIP+4(2)
259=          SRL   4  12                  [X4 CONTAINS F.G.N.
259#          SMO      FX2
259B          LDX   0  AWORK4
259D          BZE   0  XOUT1
259G          CALL  7  MONOUT
259J          +FFLOP1
259L          CALL  7  MONOUT
259N          +FFLOP2
259Q          STOZ     AWORK4(2)           [UNSET HEADING NOT O/P MARKER
259S    XOUT1 MHUNTW   1,ADATA,AWPER
259W          LDX   0  A1+2(1)
259Y          BNZ   0  XOUT2               [J IF NOT A SCRATCH FILE
25=2          CALL  7  MONOUT
25=4          +FSCR
25=6          BRN      XOF1
25=8    XOUT2
25==          OUTBLOCN 6
25=#          OUTPARN  12,A1+2,ADATA,AWPER
25=B          OUTNUM   4,0,1               [AND FGN
25=D          CALL  7  MONOUT
25=G    #SKI  G3MARK>7-7
25=J          +FUDAS
25=L    #SKI  G3MARK<8$8
25=N          +JTIMD
25=Q    XOF1  FINDEXOF 2,5,REST            [FIND LAST RELEVANT /EXOF BLOCK
25=S          BRN      ULOOP1
25=W    REST  FINDSU   2,6,ZEND            [FIND LAST RELEVANT BLOCK
25=Y          BRN      ULOOP
25?2    ZEND  BRN      UPD
25?4    SWITOUT
25?6          CALL  7  OUTNUM
25?8          LDX   7  XFSWO(1)
25?=          BRN      MONOUTX
25?#    WRONGED
25?B          CALL  7  OUTNUM              [OUTPUT OPERATORS NO.
25?D          LDX   7  XFRONG(1)
25?G          BRN      MONOUTX
25?J    XIDLE
25?L          CALL  7  OUTNUM              [OUTPUT OPERATORS NO.
25?N          LDX   7  XFIDLE(1)
25?Q          BRN      MONOUTX
25?S    OWNED
25?W          JENG     3,USSY              [J IF NOT "RESERVED & UNENGAGED"
25?Y          CALL  7  OUTNUM              [OUTPUT OPERATORS NO.
25#2          LDX   7  XFRESUNEN(1)
25#4          BRN      MONOUTX
25#6    #     PERIPHERAL BEING USED BY SYSTEM
25#8    USSY
25#=          CALL  7  OUTNUM              [O/P GEOG NO
25##          LDX   7  XFUSSY(1)
25#B          BRN      MONOUTX
25#D    #
25#G    #     DEVICE ONLINE TO A JOB
25#J    #
25#L    ONLINE
25#N          CALL  7  OUTNUM
25#Q          LDX   7  XFONLINE(1)
25#S          MONOUTX  7
25#W          CALL  7  XHTAWP
25#Y          ADX   3  A1(3)
25*2          LJOBNO   3,4
25*4          LDX   0  4
25*6          CALL  7  OUTNUM2             [OUTPUT JOB NO.
25*8          CALL  7  XHTAWP
25*=          SMO      A1(3)
25*#          LDN   3  K54-K50+1(3)
25*B          CALL  4  UPCLOSE
25*D          CALL  7  XHTAWP
25*G          LDX   7  XFOLJOB(1)
25*J          ADX   3  A1(3)               [X3 IS ABSOLUTE POINTER
25*L          JFAIL    3,PHAIL
25*N          BRN      MONOUTX
25*Q    PHAIL
25*S          MONOUTX  7
25*W          LDX   7  XFFAIL(1)
25*Y    MONOUTX
25B2          MONOUTX  7
25B4          BRN      UPD
25B6    NOUGH LDX   2  FX2
25B8    RONG1
25BL          OFF      AWHATBIT            [GIVE THE ALL CLEAR
25BP ...#SKI G203&1
25BS ...      ACROSS   WHATPER,7
25BX ...#SKI G203&1$1
25C2 ...      FON      #114
25C8    TOENDCOM
25C=          ENDCOM
25CB    QK2WHATPERB
25CF    [
25CJ          MHUNTW   3,CPAR,JSCE
25CM          LDX   4  JSCEB(3)
25CQ          SRL   4  9
25CT          ANDN  4  #77                 [ISOLATE LINE NUM
25CY          LDN   5  0
25D3          LDX   3  JSCEP(3)
25D6          LINECTRL 4,3                 [ASK EXEC FOR STATE OF LINE
25D9          STO   4  AWORK1(2)           [SAVE REPLY
25D#          STO   5  AWORK2(2)
25DC          OUTBLOCN 21
25DD ...#SKI G203&1
25DF ...(
25DG ...      MHUNTW   3,CPAR,JSCE
25DH ...      LDX   6  JSCEQ(3)
25DJ ...      ANDN  6  #7777
25DK ...      OUTPARAM 6,JSCER,CPAR,JSCE
25DL ...)
25DM ...#SKI G203&1$1
25DN ...(
25DP ...      MHUNT    3,CPB,CUNI
25DQ ...      LDX   6  ANUM(3)
25DR ...      ANDN  6  #7777
25DS ...      OUTPARAM 6,APARA,CPB,CUNI
25DT ...)
25DW          BPZ   5  ZNPRC               [J IF NOT UNDER PROG CTRL
25DX          LDN   3  ZOP(1)
25DY          JBS      ZPOP,2,YOP
25D^          LDN   3  ZINOP(1)
25F2    ZPOP
25F3          CALL  7  ZOUTPAR
25F4    [
25F5          LDN   3  ZSWOUT(1)
25F6          JBS      ZOUTSW,2,YSWO
25F7          LDN   3  ZWTBSW(1)
25F8          JBS      ZOUTSW,2,YWTBSW
25F9          LDN   3  ZNULL(1)
25F=    ZOUTSW
25F?          CALL  7  ZOUTPAR
25F#          MONOUT   ALIPRSTAT
25F*          BRN      ZCOK
25FB    ZNPRC
25FC    [
25FD    [                                   NOW OUTPUT PARAMS SHOWING STATE
25FF          LDN   3  ZCND(1)             [CONNECTED
25FH          JBS      ZBEING,2,YBEING     [J IF CHANGE OF STATE IN PROGRESS
25FL          JBS      ZTOBE,2,NOCSC
25FP          JBS      ZOUTCN,2,YCN        [J IF CONNECTED
25FS          LDN   3  ZDCD(1)             [DISCONNECTED
25FX          BRN      ZOUTCN
25G2    ZTOBE LDN   3  ZTOCN(1)
25G5          JBS      ZOUTCN,2,YCN        [J IF TO BE CONNECTED
25G8          LDN   3  ZTODC(1)
25G?          BRN      ZOUTCN              [ELSE TO BE DISCONNECTED
25GB    ZBEING
25GF          LDN   3  ZBECN(1)
25GJ          JBS   ZOUTCN,2,YCN           [J IF BEING CONNECTED
25GM          LDN   3  ZBEDC(1)            [BEING DISCONNECTED
25GQ    ZOUTCN
25GT          CALL  7  ZOUTPAR
25GY    [                                   NOW OUTPUT NUMBER OF WIRES
25H3          LDN   3  WIRE4(1)
25H6          JBS      ZOUTWIRE,2,YFOUR
25H9          LDN   3  WIRE2(1)
25H#    ZOUTWIRE
25HC          CALL  7  ZOUTPAR
25HG    [                                   NOW OUTPUT SPEED
25HK          LDN   3  ZFAST(1)
25HN          JBC      ZOUTSP,2,YSLOW
25HR          LDN   3  ZSLOW(1)
25HW    ZOUTSP
25H^          CALL  7  ZOUTPAR
25J4    [                                   NOW STATUS (NORMAL OR STANDBY)
25J7          LDN   3  NORM(1)
25J=          JBS      ZOUTSTAT,2,YNORMAL
25J*          LDN   3  STAND(1)
25JD    ZOUTSTAT
25JH          CALL  7  ZOUTPAR
25JL    [                                   NOW OPERABILITY
25JP          LDN   3  ZOP(1)
25JS          JBS      ZOUTOP,2,YOP
25JX          LDN   3  ZINOP(1)
25K2    ZOUTOP
25K5          CALL  7  ZOUTPAR
25K8    [
25K?          MONOUT   AMXLSTAT            [OUTPUT STATE MESSAGE
25KB          VFREE    CPB,CUNI            [FINISHED WITH CUNI
25KF          LF       2,PORT,6
25KJ          OUTNUM   6,0                       [OUTPUT PORT PARAM
25KM          LF       2,SCOUPLER,6
25KQ          OUTNUM   6,0                       [AND COUPLER
25KT          JBC      NTRAN,2,TRANSBIT
25KY          OUTNULL                            [LET END OF MSG OUT IF TRANS
25L3    NTRAN MONOUT   ALIPCTR
25L6          JBC      ZCOK,2,NOCSC
25L9          MONOUT   CSCNRUN
25L#    ZCOK
25L* ...#SKI G203&1
25LB ...      ACROSS   WHATPER,7
25LC ...#SKI G203&1$1
25LG          FON      #114
25LK          ENDCOM
25LN    [
25LR    #     SUBROUTINES TO OUTPUT MESS IN LOCN FOLLOWING CALL
25LW    MONOUT
25L^          LDX   1  7
25M4          SBX   7  FX1
25M7          MONOUTX  0(1)
25M=          ADX   7  FX1
25M*          EXIT  7  1
25MD    OUTWIN
25MF ...      SBX   4  FX1
25MH          BNG   6  NTWIN
25MP          SLL   6  16
25MS          BNG   6  SHARED              [B16 SET IS SHARED
25MX          SLL   6  1
25N2          BNG   6  NDED                [B17 SET IS DEDICATED
25N5          CALL  7  OUTMESS
25N8          +ENTIN32                     [ELSE UNDEDICATED
25N?          BRN      NTWIN1
25NB    SHARED
25NF          CALL  7  OUTMESS
25NJ          +ENTIN33
25NM          BRN      NTWIN1
25NQ    NDED
25NT          CALL  7  OUTMESS
25NY          +ENTIN31
25N^ ...      BRN      NTWIN1
25P2 ...NTWIN
25P3 ...      JENVNOT  NTWIN1,CME
25P4 ...      JNCMESH  3,NTWIN1
25P5 ...      CALL  7  OUTMESS
25P6 ...      +CMESHWP
25P7 ...NTWIN1
25P8 ...      ADX   4  FX1
25P#          EXIT  4  0
25PC    OUTMESS
25PG          LDX   1  7
25PK          SBX   7  FX1
25PN          OUTMESSX 0(1)
25PR          ADX   7  FX1
25PW          EXIT  7  1
25P^    #           SUBROUTINE TO OUTPUT DECIMAL NO IN X0
25Q4    OUTNUM
25Q7          LGEOG    3,0                 [GET OPS NO
25Q=    OUTNUM2
25Q*          SBX   7  FX1
25QD          OUTNUM   0,0
25QH          ADX   7  FX1
25QL          EXIT  7  0
25QP    #
25QS    #           SUBROUTINE TO OUTPUT AN OCTAL NO. IN X6
25QX    #
25R2    OUTOCT
25R5          SBX   7  FX1
25R8          CONSERNO 6                   [CONVERT SERIAL NUMBER
25R?          MHUNTW   2,FLIB,FTSN
25RB          OUTPARAM A1(2),A1+1,FLIB,FTSN
25RF          ADX   7  FX1
25RJ          EXIT  7  0
25RM    MISTAKE
25RQ          COMERRX  0(1)
25X2    #END
^^^^ ...002770370004
####
