IDFSCON867

(George Source)

Macros used: BSXD, BXE, CLOSE, FMOPG, GEOERR, HUNT2, IDFOPEN, IDFWRITE, INFORM, LFBITSET, LGEOG, MENDAREA, MFREEALL, MHUNTW, MSEARCH, MXB, OPEN, OUTBLOCN, OUTNUM, POINTACT, RERING, SEGENTRY, SETNCORE, SETREP, SETUPCORE, UP, UPPLUS

IDFSCON867.txt
22FL    #SEG  IDFSCON8                     [A C PUTMAN  
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^=    #OPT  K0IDFSCON=0   
23DW    #LIS  K0IDFSCON>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 
23YG          8HIDFSCON 
24D6          SEGENTRY K20IDFSCON,XIDF20
24XQ          SEGENTRY K1IDFSCON,XIDF1  
25CB          SEGENTRY K4IDFSCON,XIDF4  
25X2          SEGENTRY K3IDFSCON,XIDF3  
26BL          SEGENTRY K30IDFSCON,XIDF30
26W=          SEGENTRY K35IDFSCON,XIDF35
27*W    ZMSEARCH           [SEARCH FOR A CELL   
27TG          SBX   7  FX1  
28*6          MSEARCH  2,3,4
28SQ          ADX   7  FX1  
29#B          EXIT  7  0
29S2    OPEN           [OPEN IDF AND SEE IF UNIT IN ACOMMUNE2 EXISTS:X2=FX2 
2=?L          SBX   5  FX1  
2=R=          LGEOG    ACOMMUNE2(2),4      [LOAD GEO.NO.
2?CJ ...      IDFOPEN  XBRK 
2?QG          CALL  7  ZMSEARCH            [SEARCH FOR UNIT CHAIN   
2#=6          SMO      FX2  
2#PQ          LDX   6  ACOMMUNE1
2*9B          BNZ   6  P1                  [UNIT FOUND OKAY 
2*P2          GEOERR   1,UNITILL           [WRONG UNIT NO IN %B OF MACRO
2B8L    P1    LDX   1  FX2  
2BN=          STO   3  AWORK2(1)           [STORE UNIT CELL POINTER 
2C7W          LDX   6  BRECNO(2)
2CMG          STO   6  AWORK1(1)           [STORE UNIT RECORD NO
2D76          ADX   3  2
2DLQ          LDX   6  BNUMB(3)            [FOR USE ON EXIT 
2F6B          ADX   5  FX1  
2FL2          EXIT  5  0
2FTS ...XBRK  UP
2G5L    ZCLOSE                             [FREE FILE/FRRB BLOCKS & CLOSE IDF   
2GK=          SBX   5  FX1  
2H4W          MFREEALL FILE,FRRB
2HJG          CLOSE 
2J46          ADX   5  FX1  
2JHQ          EXIT  5  0
2K3B    XWRITE  
2KH2          SBX   5  FX1  
2L2L          IDFWRITE  
2LG=          ADX   5  FX1  
2L^W          EXIT  5  0
2MFG    S7071              [SET UP B7071 BLOCK  
2M^6          SBX   5  FX1  
2NDQ          ANDN  6  #7777               [GET NO OF LINES-X6 ALREADY OKAY 
2NYB          LDCH  2  BTYPE(3)            [PICK UP DEVICE TYPE(#12 OR #13) 
2PD2          SBN   2  #12                 [MAKE X2 ZERO FOR UPX:ONE FOR MPX
2PXL          LDX   4  2                   [AND KEEP IN X4 AS FIRST LINE NO 
2QC=          ADX   2  6                   [MAKE X2 LENGTH OF B7071 BLOCK:MPX-  
2QWW          SETUPCORE 2,1,IDF,B7071      [HAS DUMMY LINE 0
2RBG          ADX   5  FX1  
2RW6          EXIT  5  0
2S*Q    YREC           [X3 CONTAINS FORWARD POINTER:X2 POINTS TO CURRENT RECORD 
2STB                   [ON EXIT X2 IS RECORD POINTER & X3 IS CELL POINTER   
2T*2          BPZ   3  SAME 
2TSL    YREC1   
2W#=          SBX   6  FX1  
2WRW          LDX   0  3
2X?G          SRL   0  9
2XR6          ANDN  0  #7777
2Y=Q          LDX   2  FX2  
2YQB          STO   0  ACOMMUNE3(2)        [STORE FORWARD REC.NO FOR MXB
2^=2          MXB      2
2^PL          ADX   6  FX1  
329=    SAME  ANDN  3  #777 
32NW          EXIT  6  0
338G    RECFIND        [HUNT-RECORD NO OF FILE/FRRB IN X3-FINAL POINTER IN X2   
33N6          LDX   2  FX2  
347Q    REC 
34MB          HUNT2    2,FILE,FRRB  
3572          TXU   3  BRECNO+A1(2) 
35LL          BCS      REC  
366=          ADN   2  A1   
36KW          EXIT  6  0
375G    SETUP              [X4 & X6 MUST BE PRESERVED:X4=LINE NO
37K6                       [ON EXIT:-CONNAME OR B7020 BLOCKS MAY HAVE BEEN MADE 
384Q                       [X7=ENTRY FOR B7071 BLOCK
38JB                       [X3=ABSOLUTE POINTER TO LINE CELL
3942          SBX   5  FX1  
39HL          SLL   6  12   
3=3=          ORX   4  6                   ["PACK" X4 & X6 INTO X4  
3=GW          LDX   1  FX2  
3?2G          LDX   3  AWORK1(1)           [RECORD NO OF UNIT CELL  
3?G6          CALL  6  RECFIND             [FIND RECORD 
3?^Q          LDX   3  AWORK2(1)
3#FB          LDN   3  BLINE(3) 
3#^2          CALL  7  ZMSEARCH            [SEARCH FOR LINE 
3*DL          SMO      FX2  
3*Y=          LDX   7  ACOMMUNE1
3BCW          BNZ   7  SET2 
3BXG          GEOERR   1,LINEILL           [ERROR IF LINE NON-EXISTENT  
3CC6    SET2  LDX   1  FX2  
3CWQ          STO   3  AWORK4(1)           [LINE CELL POINTER INTO STORE
3DBB          LDX   7  BRECNO(2)
3DW2          STO   7  AWORK3(1)           [LINE RECORD NO INTO STORE   
3F*L          ADX   3  2                   [ABSOLUTE POINTER TO LINE CELL IN X3 
3FT=          LDCT  7  #770 
3G#W          ANDX  7  BTYPE(3) 
3GSG          LDX   0  CONTCEP(3)   
3H#6          BNZ   7  SET3                [J.IF NOT NULL DEVICE
3HRQ          BZE   0  SET4                [J NOT ATTACHED  
3J?B          LDCT  7  #200                [SET ATTACHED BIT
3JR2    SET4  ORX   7  GSIGN               [SET UNKNOWN BIT 
3K=L    SETXIT  
3KQ=          LDX   6  4                   ["UNPACK" X4 & X6
3L9W          SRL   6  12   
3LPG          ANDN  4  #7777
3M96          ADX   5  FX1  
3MNQ          EXIT  5  0
3N8B    SET3  SLC   7  6                   [MOVE DEVICE TYPE IETO B18-23
3NN2          BNZ   0  SET5                [J.IF LINE ATTATCHED 
3P7L          LDN   0  2
3PM=          TXU   7  0
3Q6W          BCS      SETXIT              [NOT 7020 SO EXIT
3QLG          LDX   6  BNUMB(3)            [NO OF 7020'S:X6 HAS BEEN "PACKED"   
3R66          ANDN  6  #7777
3RKQ          STO   6  0
3S5B          SLL   6  3                   [MULT BY 8   
3SK2          SBX   6  0                   [REDUCE TO MULT BY 7 
3T4L          ADN   6  2                   [LENGTH OF B7020 BLOCK IN X6 
3TJ=          SETUPCORE  6,1,IDF,B7020  
3W3W          LDN   7  A1(1)               [X7 CONTAINED 2-WILL REPLACE LATER   
3WHG          LDN   0  A1+1(1)  
3X36          STOZ     A1(1)
3XGQ          SBN   6  1
3Y2B          SMO      6
3YG2          MOVE  7  0                   [ZEROIZE B7020 BLOCK-FOR NULL ENTRIES
3Y^L          LDX   3  AWORK3(2)           [LINE REC. NO
3^F=          CALL  6  RECFIND  
3^YW          SMO      FX2  
42DG          ADX   2  AWORK4              [X2=POINTER TO CELL  
42Y6          LDX   6  BNO(2)   
43CQ          SLL   6  12   
43XB          STO   6  APCTLIN(1)          [LINE NO 
44C2          LDX   6  BTYPE(2) 
44WL          ANDN  6  #7777
45B=          ORS   6  APCTLIN(1)          [UNIT NO 
45TW          LDX   6  BNUMB(2) 
46*G          ANDN  6  #7777
46T6          STO   6  APCTNO(1)           [NO OF PCT'S 
47#Q          LDX   3  BLINE(2)            [FORWARD POINTER TO 7020 CELL
47SB          SMO      FX2  
48#2          SBX   2  AWORK4              [X2=RECORD POINTER   
48RL          LDN   7  APCTLS              [X7 CONTAINED 2,SO CAN PUT IT BACK   
49?=    SET10 CALL  6  YREC                [FIND 7020 CELL  
49QW          MHUNTW   1,IDF,B7020  
4==G          ADX   3  2                   [FOR FUTURE CONVENIENCE  
4=Q6          LDX   6  BNO(3)              [PICK UP IDENT/POLLING ADD   
4?9Q          SMO      7
4?PB          STO   6  0(1)                [STORE IDENT/POLLING ADD IN B7020
4#92          BRN      SET7 
4#NL    SET9  CALL  6  YREC                [FIND CELL FOR NEXT INTERFACE
4*8=          MHUNTW   1,IDF,B7020  
4*MW          ADX   3  2
4B7G    SET7  LDCT  6  #400    [MAKE SURE 7020 CELLS ARE MARKED MOPPED ON:FOR-  
4BM6                           ["SCAN" SHOULD ALREADY BE,BUT NOT FOR "MOPON"
4C6Q          ORS   6  BTYPE+1(3)   
4C?Y ...#SKI  JSKI17<1$1
4CF6 ...(   
4CLB          LDX   6  BTYPE(3)            [GET DEVICE/INTERFACE NO.
4D62          LDCT  0  #770 
4DKL          ANDX  0  6
4F5=          ANDN  6  #77                 [X6=INTERFACE NO 
4FJW          SLC   0  6                   [X0=DEVICE TYPE  
4G4G          ADX   6  7                   [SO X6 IS POSITION IN B7020 BLOCK
4GJ6          SMO      6
4H3Q          STO   0  0(1)                [STORE DEVICE TYPE IN B7020 BLOCK
4H4D ...)   
4H56 ...#SKI  JSKI17
4H5S ...(   
4H6G ...      LDN   0  0
4H78 ...      LDX   6  BTYPE+1(3)   
4H7W ...      SLL   6  4
4H8J ...      BPZ   6  XSPOOLABLE          [J IF NOT SPOOLABLE  
4H9= ...      SLL   6  1
4H9Y ...      ANDX  6  CACT                [PRESERVE SPOOLING,UNATTENDED BITS   
4H=L ...      ORX   0  6
4H?# ...XSPOOLABLE  
4H#2 ...      LDX   6  BTYPE(3) 
4H#N ...      SLC   6  6
4H*B ...      ANDN  6  #77                 [INTERNAL DEVICE TYPE
4HB4 ...      ORX   0  6
4HBQ ...      LDX   6  BTYPE(3) 
4HCD ...      ANDN  6  #77                 [INTERFACE NUMBER
4HD6 ...      ADX   6  7                   [ADD PTR TO FIRST INTERFACE  
4HDS ...      SMO      6
4HFG ...      STO   0  0(1)                [STORE IN IDF/B7020 BLK  
4HG8 ...)   
4HHB          LDX   6  BTYPE+1(3)   
4J32          ANDN  6  #77  
4JGL          BZE   6  SET8                [J NO CONSOLE IN IT  
4JQD ...#SKI  JSKI17<1$1
4K2=          LDN   0  3                   [CONSOLE DEVICE TYPE 
4KFW          ADX   6  7
4K^G          SMO      6
4LF6          STO   0  0(1)                [STORE IN B7020 BLOCK
4LYQ    SET8  LDX   6  BTYPE+2(3)   
4MDB          LDX   3  0(3) 
4MY2          BPZ   6  SET9                [J.FOR NEXT INTERFACE
4NCL          ADN   7  7                   [UPDATE X7   
4NX=          BNZ   3  SET10               [J.FOR NEXT 7020 TERMINAL
4PBW          LDN   7  2                   [PUT BACK 7020 DEVICE TYPE IN X7 
4PWG    TIDY  LDX   1  FX2  
4QB6          LDX   3  AWORK3(1)           [REC NO FOR LINE 
4QTQ          CALL  6  RECFIND  
4R*B          LDX   3  AWORK4(1)           [CELL POINTER
4RT2          ADX   3  2
4S#L          BRN      SETXIT   
4SS=    SET5
4T?W          SETNCORE 4,1,IDF,CONNAME     [SET UP BLOCK TO CONTAIN CONCEPTUAL. 
4TRG          LDX   3  AWORK3(2)
4W?6          LDX   1  AWORK4(2)
4WQQ          CALL  6  RECFIND             [HUNT LINE CELL  
4X=B          SMO      2
4XQ2          LDX   3  CONTCEP(1)          [LD. PTR. TO CONCEPTUAL. 
4Y9L          CALL  6  YREC                [HUNT CONCEPTUAL.
4YP=          ADN   2  1(3) 
4^8W          MHUNTW   3,IDF,CONNAME       [RE-HUNT BLOCK.  
4^NG          ADN   3  A1+1 
5286          MOVE  2  3                   [MOVE IN CONCEPTUAL NAME 
52MQ          LDX   4  3(2)                [LD.CT. OF NO. OF LNS.   
537B          ANDN  4  #7777
53M2          SMO      FX2  
546L          STOZ     AWORK1   
54L=          LDX   3  6(2) 
555W          CALL  6  YREC1               [HUNT USER NAME CELL 
55KG          SMO      2
5656          LDX   3  7(3)                [PTR. TO LINE CELL.  
56JQ          SMO      FX2  
574B          LDX   7  AWORK3   
57J2          SLL   7  9
583L          SMO      FX2  
58H=          ADX   7  AWORK4              [X7 = REC.NO. & CELL PTR. OF LINE
592W    SET50 CALL  6  YREC                [HUNT LINE CELL. 
59GG    SET52   
5=26          LDN   0  1
5=FQ          SMO      FX2  
5=^B          ADS   0  AWORK1              [AWORK1= CONCEPTUAL LINE NO. 
5?F2          SMO      2
5?YL          LDX   0  0(3) 
5#D=          ANDX  0  BITS22LS            [MASK OUT REC.NO.&CELL PTR.  
5#XW          BXE   0  7,SET55             [J. IF EQUAL.
5*CG          LDX   0  4
5*X6          ANDN  4  #7777
5BBQ          SBN   4  1
5BWB          BZE   4  SET54
5CB2          SLC   0  3
5CTL          ANDN  0  #7   
5D*=          ADN   0  1
5DSW          LDN   6  7
5F#G          SBX   6  0
5FS6          BZE   6  SET53
5G?Q          SRC   0  3
5GRB          ADN   3  1
5H?2          ADX   4  0
5HQL          BRN      SET52
5J==    SET53 SMO      3
5JPW          LDX   3  1(2)                [LD. PTR.  TO&NEXT CONCEPT. CELL 
5K9G          BRN      SET50
5KP6    SET54 GEOERR   1,LOSTLINE   
5L8Q    SET55 MHUNTW   1,IDF,CONNAME       [HUNT CONCEPTUAL NAME BLK.   
5LNB          LDX   2  FX2  
5M82          LDX   0  AWORK1(2)
5MML          STO   0  A1(1)               [ST. CONCEPTUAL LINE IN BLOCK
5N7=          LDX   3  AWORK3(2)
5NLW          CALL  6  RECFIND  
5P6G          SMO      FX2  
5PL6          LDX   3  AWORK4   
5Q5Q          LDCT  7  #770 
5QKB          ADX   3  2
5R52          ANDX  7  BTYPE(3) 
5RJL          SLC   7  6
5S4=          LDCT  0  #200 
5SHW          ORX   7  0
5T3G          BRN      SETXIT   
5TH6    XIDF20  
5W2Q    #     THIS ENTRY POINT IS FOR SETTING INFORMATION ABOUT 7900'S. THE 
5WGB    #     INFORMATION WILL BE HELD IN IDF/IPBSCAN BLOCK.
5X22          LDX   5  ACOMMUNE3(2) 
5XFL          STOZ     AWORK4(2)
5X^=          STO   5  AWORK3(2)           [FOR USE AFTER OPEN  
5YDW          LDN   3  BIPB                [LD. BASE CHAIN  
5YYG          CALL  5  OPEN 
5^D6          BPZ   6  NOGO 
5^XQ          ANDN  6  #777 
62CB          BZE   6  SET  
62X2    XJUM  SBX   3  2
63BL          SMO      FX2  
63W=          LDX   4  AWORK3              [CONTAINS ZERO=ALL LINES 
64*W          BNZ   4  XONE                [CONTAINS A NO. MEANS INFO. ON THIS  
64TG          SMO      3
65*6          LDX   4  5(2) 
65SQ          SMO      3
66#B          LDX   3  BLINE(2)            [LD. PTR. TO IDENTIFIER CHAIN
66S2          SMO      FX2  
67?L          STO   3  AWORK3   
67R=          CALL  6  YREC                [HUNT FOR CELL.  
68=W          SMO      3
68QG          SBX   4  BNO(2)              [X4=DIFF. BETWEEN LARGE & SMALL IDNT 
69=6          BZE   4  XADD                [ONLY ONE
69PQ          ADN   4  2
6=9B    XSETU   
6=P2          SETUPCORE 4,1,IDF,IDENTIFIERS [SET UP BLOCK TO CONTAIN 7900 INFO .
6?8L          LDX   3  AWORK3(2)
6?N=          CALL  6  YREC1               [HUNT RECORY MAY HAVE COOR.  
6#7W          ADX   2  3
6#MG          LDX   5  BNO(2)   
6*76          LDX   4  5                   [ST. SMALLEST IDENTIFIER NO. 
6*LQ          SBN   4  1
6B6B          MHUNTW   1,IDF,IDENTIFIERS
6BL2          STO   4  A1(1)               [ST. SIN -1 INTO THE BLOCK SET UP
6C5L          LDN   4  A1+1 
6CK=    STTYP ADX   1  4                   [ADD. IN POSITION DOWN   
6D4W          LDN   7  0
6DJG          LDX   6  BTYPE(2) 
6F46          SRL   6  15                  [SOMETIME PUT IN HERE ABOUT CONCEPTUA
6FHQ          SRL   67 2
6G3B          BPZ   7  XJB                 [J. IF R.J.E MOD NOT SET 
6GH2          ORN   6  #2000
6H2L    XJB   SRL   67 1
6HG=          BPZ   7  XJA                 [J. IF UNKNOWN BITS IS NOT SET   
6H^W          LDCT  0  #004 
6JFG          ERS   0  BTYPE(2)            [UNSET UNKNOWN BIT   
6J^6    XJA   STO   6  0(1) 
6K3P ...      LDX   0  CONTCEP(2)   
6K6# ...      BZE   0  NOTAH               [J IF NOT ATTACHED   
6K8X ...      LDCT  0  #200 
6K?G ...      ORS   0  0(1)                [SET ATTACHED BIT
6KB5 ...NOTAH   
6KDQ          SMO      FX2  
6KYB          LDX   0  AWORK4   
6LD2          BZE   0  XNSET               [J. IF MOPPON BIT NOT REQUIRE SETTING
6LXL          LDCT  0  #400 
6MC=          ORS   0  BNUMB(2) 
6MWW    XNSET SBX   2  3
6NBG          SMO      2
6NW6          LDX   3  0(3)                [LD. FPTR. TO NEXT CELL  
6P*Q          BZE   3  XEN1 
6PTB          CALL  6  YREC                [HUNT FOR NEXT IDENTIFIER CELL   
6Q*2          ADX   2  3
6QSL    NXIDN MHUNTW   1,IDF,IDENTIFIERS   [HUNT BLOCK. 
6R#=          ADN   4  1                   [INCREASE POSITION DOWN BLK. 
6RRW          ADN   5  1                   [INCREASE IDENTIFIER NO. 
6S?G          TXU   5  BNO(2)              [TEST IDENTIFIER NO. 
6SR6          BCC      STTYP               [IDENTIFIERS EQUAL J BACK ST TYPE
6T=Q          LDX   6  GSIGN               [SET B0 -VE  
6TQB          ADX   1  4
6W=2          STO   6  0(1)                [ST. -VE TO INDICATE NO IDENTIFIER.  
6WPL          BRN      NXIDN
6X9=    XEN1
6XNW          SMO      FX2  
6Y8G          LDX   0  AWORK4   
6YN6          BNZ   0  XWR  
6^7Q          BRN      XEN2 
6^MB    XADD
7272          LDN   4  2
72LL          BRN      XSETU
736=    #   
73KW    #     THIS PIECE DEALS WITH THE CASE WHEN INFORMATION HAS BEEN REQUESTED
745G    #     ABOUT ONE PARTICULAR IDENTIFIER. THE IDENTIFIER NO. COMES IN HELD 
74K6    #     IN ACOMMUNE3 THIS HAS BEEN TRANSFERED TO AWORK3 IN CASE OF OVER-  
754Q    #     WRITING.  
75JB    #   
7642    XONE  SMO      2
76HL          LDEX  6  BTYPE(3) 
773=          ADN   3  BLINE               [BASE OF IDENTIFIER CHAIN
77GW          CALL  7  ZMSEARCH            [SEARCH FOR A CELL   
782G          SMO      FX2  
78G6          LDX   7  ACOMMUNE1           [TEST TO SEE 
78^Q          BZE   7  XNOIDE              [IDENT.NO. DOES NOT EXIST
79FB    XOK 
79^2          SMO      2
7=DL          LDX   0  CONTCEP(3)          [J. IF THE IDENTIFIER IS NOT ATTACHED
7=Y=          BZE   0  XF   
7?CW          LDX   7  BRECNO(2)
7?XG          SLL   7  9
7#C6          ADX   7  3
7#WQ          SMO      FX2  
7*BB          STO   7  AWORK2              [PRESERVE PTR. TO IDENTIFIER.
7*W2          LDX   3  0
7B*L          SETNCORE 4,1,IDF,CONNAME     [SET UP BLOCK TO CONTAIN CONCEP. NAME
7BT=          CALL  6  YREC1               [HUNT FOR THE CONCEPTUAL CELL.   
7C#W          ADN   2  1(3) 
7CSG          MHUNTW   3,IDF,CONNAME
7D#6          ADN   3  A1+1 
7DRQ          MOVE  2  3                   [MOVE CONCEPTUAL NAME INTO BLOCK.
7F?B          LDX   4  3(2) 
7FR2          ANDN  4  #7777
7G=L          LDX   0  5(2)                [LD. LOWEST IDENTIFIER NO.   
7GQ=          SBN   0  1
7H9W          SMO      FX2  
7HPG          STO   0  AWORK1   
7J96          LDX   3  6(2)                [LD. PTR. TO USER NAME CELL. 
7JNQ          CALL   6  YREC1   
7K8B          SMO      2
7KN2          LDX   3  7(3)                [LD. PTR. TO LINE CELL.  
7L7L          SMO      FX2  
7LM=          LDX   7  AWORK2   
7M6W    XA    CALL  6  YREC 
7MLG    XB    LDN   0  1
7N66          SMO      FX2  
7NKQ          ADS   0  AWORK1   
7P5B          SMO      2
7PK2          LDX   0  0(3) 
7Q4L          ANDX  0  BITS22LS 
7QJ=          BXE   0  7,XE 
7R3W          LDX   0  4
7RHG          LDCT  6  #700 
7S36          ANDX  6  0
7SGQ          ANDN  4  #7777
7T2B          SBN   4  1
7TG2          BZE   4  XD   
7T^L          SLC   6  3
7WF=          ADN   6  1
7WYW          LDN   0  7
7XDG          SBX   0  6
7XY6          BZE   0  XC   
7YCQ          SRC   6  3
7YXB          ADX   4  6
7^C2          ADN   3  1
7^WL          BRN      XB   
82B=    XC    SMO      2
82TW          LDX   3  1(3) 
83*G          BRN      XA   
83T6    XD    GEOERR   1,LOSTLINE   
84#Q    XE    MHUNTW   1,IDF,CONNAME
84SB          LDX   2  FX2  
85#2          LDX   0  AWORK1(2)
85RL          ANDN  0  #7777
86?=          STO   0  A1(1)
86QW          LDX   3  AWORK2(2)
87=G          CALL  6  YREC1
87Q6    XF    SMO      2
87TM ...      LDX   4  BTYPE(3)            [DEVICE TYPE AND GEOG NO 
87WH ...      LDEX  0  4                   [LD. GEOG.NO.
87XC ...      SMO      FX2  
87Y? ...      STO   0  AWORK1              [AWORK1 = GEOG. NO.  
89C5 ...XJ  
89GL ...      SMO      2
89L7 ...      LDX   7  BLINE(3)            [MODE/NPUSIZE IN CORRECT FORMAT  
89PN ...      SMO      2
89T9 ...      LDX   6  BNUMB(3) 
89YQ ...      ANDN  6  #7777               [LINE NUMBER 
8=4? ...XM  
8=8=          LDN   5  0
8?M6          SRL   4  15   
8?WY ...#SKI  JSKI17<1$1
8#6Q          SRL   45 2
8#7Y ...#SKI  JSKI17
8#96 ...(   
8#=# ...      SRL   45 1
8#?G ...      BPZ   5  XSPOOL              [J IF NOT SPOOLABLE  
8##N ...      LDCT  0  #30  
8#*W ...      SMO      2
8#C4 ...      ANDX  0  BNUMB(3)            [SPOOLING,UNATTENDED BITS
8#D= ...      SRL   0  6                   [MOVE TO BITS 10,11  
8#FD ...      ORX   4  0                   [PRESERVE FOR ACOMMUNE2  
8#GL ...XSPOOL  
8#GQ ...#UNS FL7502 
8#GW ...(   
8#H2 ...      BSXD     0,IDF7502LP  
8#H6 ...      SMO      2
8#H= ...      ANDX  0  BNUMB+1(3)   
8#HB ...      SRL   0  14-(IDF7502LP&#37)   
8#HG ...      ORX   4  0
8#HL ...)   
8#HS ...      SRL   45 1
8#K2 ...)   
8#LB          BPZ   5  XNOKB               [J. IF R.J.E MOD NOT SET 
8*62          ORN   4  #2000
8*KL    XNOKB SRL   45 1
8B5=          BPZ   5  XNOK                [J. IF UNKNOWN BIT NOT SET   
8BJW          ORN   4  #400 
8C4G ...XNOK  LDCH  0  4
8CJ6          SBN   0  3
8D3Q          BZE   0  XPRCON              [J.DEVICE IS A LP
8DHB          SBN   0  4
8F32          BZE   0  XPRCON              [J.DEVICE IS A TP.   
8FGL    XNOKA CALL  5  ZCLOSE              [CLOSE IDF   
8G2=          STO   4  ACOMMUNE2(2)        [ST. DEVICE NO.  
8GFW          STO   7  ACOMMUNE1(2)        [ST. MODE.   
8G^G          STO   6  ACOMMUNE3(2)        [ST. LINE NO.
8HF6          STO   3  ACOMMUNE4(2)        [ST. CONS.PROP. IF LP OR TP. 
8HYQ          BRN      SC3                 [J. TO EXIT. 
8JDB    XPRCON  
8JY2          LDX   5  6
8KCL          SMO      2
8KX=          LDX   3  BATT(3)             [LD. PTR. TO ATTRIBUTION CELL
8L2P ...      BNZ   3  XPRA 
8L68 ...      LDX   2  FX2  
8L9M ...      STOZ     ACOMMUNE1(2) 
8L*6 ...      LDN   0  ACOMMUNE1(2) 
8LDK ...      LDN   1  ACOMMUNE2(2)        [STO ZERO IN ACOMMUNE WDS. NO ATTRI. 
8LJ4 ...      MOVE  0  ATTMAX-1 
8LMH ...      BRN      XPRB 
8LR2 ...XPRA  CALL  6  YREC 
8LWG          SMO      FX2  
8MB6          LDN   1  ACOMMUNE1
8MTQ          SMO      2
8N*B          LDN   0  BTYPE(3)            [COPY ATTRIBUTIONS INTO ACOMMUNE 
8NT2          MOVE  0  ATTMAX              [WORDS   
8P#L ...XPRB  SETNCORE ATTMAX,1,GOUT,GPROPNOS   
8PS=          ADN   1  GPROPNUM 
8Q?W          LDN   0  ACOMMUNE1(2) 
8QRG          MOVE  0  ATTMAX              [... THEN INTO GPROPNOS BLOCK
8R?6          LDX   3  ACOMMUNE1(2)        [CONSOLE PROPERTY
8RGY ...      ANDX  3  BITS22LS 
8RHX ...      LDCH  0  4                   [LD. DEVICE TYPE 
8RJW ...      SRC   0  6
8RKT ...      ADX   0  AWORK3(2)           [ADD, IN IDENTIFIER  
8RLS ...      STO   0  JSOURCE1(2)         [ST DEVICE TYPE - IDENTIFIER 
8RMR ...      LDX   0  CACT                [SET B0 - B1 
8RNQ ...      ADX   0  AWORK1(2)           [ADD IN GEOG NO. 
8RPP ...      STO   0  JSOURCE2(2)  
8RQQ          LFBITSET G,2                 [SET FLAG G...   
8S=B          LFBITSET F,2                 [... AND F   
8SQ2          POINTACT OUT,2               [LOCATE SCHEDULER - RING INTO
8T9L          LDX   1  FX2                 [JOBRING 
8TP=          ADN   2  JOBRING  
8W8W          RERING   JOBRING(1),2 
8WNG          LDX   6  5
8X86          BRN      XNOKA
8XMQ    XNOIDE  
8Y7B          OUTBLOCN 4
8YM2          OUTNUM   6,0  
8^6L          OUTNUM   AWORK3(2),0  
8^L=          INFORM   1,IDEWRONG,1 
925W          LDN   3  0
92KG          LDN   4  #400 
9356          LDN   6  0
93JQ          LDN   7  0
944B          BRN      XNOKA
94J2    XIDF1   
953L          LDX   5  ACOMMUNE3(2) 
95H=          STO   5  AWORK3(2)           [FOR USE AFTER OPEN  
962W          LDN   3  BUNIT
96GG          CALL  5  OPEN 
9726          BPZ   6  NOGO 
97FQ          SMO      FX2  
97^B          LDX   4  AWORK3              [LINE NO OR ZERO 
98F2          BPZ   4  SC1  
98YL          CALL  5  S7071               [TO SET UP B7071 BLOCK   
99D=    SC2   CALL  5  SETUP               [GET DEVICE DATA IN X7   
99XW          MHUNTW   1,IDF,B7071  
9=CG          SMO      4
9=X6          STO   7  A1(1)               [STORE DEVICE DATA   
9?BQ          ADN   4  1                   [NEXT LINE   
9?WB          BCT   6  SC2                 [BRANCH ON COUNT OF NO OF LINES  
9#B2    XEN2
9#TL          SETREP   OK                  [SETREP OK.  
9**=    XEN   CALL  5  ZCLOSE   
9*K4 ...SC3   UPPLUS   2
9B#G    SC1   CALL  5  SETUP
9BS6          CALL  5  ZCLOSE              [CLOSE IDF   
9C?Q          STO   7  ACOMMUNE2(2)        [STO. DEVICE DATA.   
9CRB          BRN      SC3  
9D?2    ZNOGO CALL  5  XWRITE   
9DQL    NOGO  CALL  5  ZCLOSE              [ERROR-CLOSE IDF ETC.
9F2D ...      UPPLUS   1
9FPW    XIDF4   
9G9G          LDN   3  BIPB 
9GP6          STOZ     AWORK3(2)
9GW# ...      LDX   0  ACOMMUNE3(2) 
9H3G ...      STO   0  AWORK4(2)
9H8Q          BRN      XCONT
9HNB    XIDF3   
9J82          LDN   3  BUNIT
9JCS ...      STOZ     AWORK4(2)
9JML    XCONT   
9K7=          CALL  5  OPEN 
9K=B ...      SMO      FX2  
9K*G ...      LDX   0  AWORK4              [J. IF BIT5 NOT REQUIRED TO BE TESTED
9KDL ...      BZE   0  XUN  
9KHQ ...      FMOPG    1,4,IPB  
9KLW ...      BNG   1  XUN                 [GEOG NO. NOT IPB
9KQ2 ...      LDCT  0  #10  
9KT6 ...      ANDX  0  IPBSW(1)            [TEST BIT 5 - BEING MOPPED ON
9KY= ...      BNZ   0  NOGO                [J. IF BIT SET ERROR 
9L3B ...XUN   LDCT  5  #700 
9L6G          ANDX  5  6
9LL6          ANDN  6  #7777
9LTY ...      BNZ   5  NOGO                [J IF MOPPED ON,ONLINE OR WRONGED
9M5Q ...#UNS  CRAMP 
9M*J ...#SKI
9MKB ...      BZE   6  SET                 [J IF NO IDENTS ON 7900  
9MT8 ...RPEY
9N52          LDCT  5  #400 
9NJL          ORS   5  BNUMB(3)            [SET MOPON BIT-X3 POINTS TO UNIT CELL
9NPS ...#UNS  CRAMP 
9NX2 ...      BZE   6  SETT                [J IF NO IDENTS ON 7900  
9P4=          LDCH  5  BTYPE(3) 
9PHW          SBN   5  #30  
9Q3G          BZE   5  XJUMA               [J. IF IPB CHAIN 
9QH6          CALL  5  S7071               [SET UP B7071 BLOCK  
9R2Q    MN1   CALL  5  SETUP
9RGB          MHUNTW   1,IDF,B7071  
9S22          SMO      4
9SFL          STO   7  A1(1)
9S^=          ADN   4  1                   [NEXT LINE   
9TDW          LDCT  5  #400 
9TYG          ORS   5  BNUMB(3)            [MARK LINE MOPPED ON 
9WD6          BCT   6  MN1                 [FOR NEXT LINE   
9WXQ    XWR   CALL  5  XWRITE   
9XCB          BRN      XEN2 
9XX2    XJUMA   
9YBL          LDN   6  1
9YW=          SMO      FX2  
9^*W          STO   6  AWORK4   
9^TG          BRN      XJUM 
9^Y5 ...#UNS  CRAMP 
=22N ...(   
=25? ...SETT
=27W ...      CALL  5  XWRITE              [WRITE AWAY MOPPED ON BIT
=2=F ...)   
=2*6    SET 
=2SQ          SETREP   NULL                [SET REPLY NULL = NO LINES ON 7900.  
=3#B          BRN      NOGO 
=3S2    #     THIS PART DEALS WITH THE CASE WHEN UNKOWN BIT REQUIRES SETTING.   
=4?L    XIDF30  
=4R=          LDX   4  ACOMMUNE1(2)        [IDENTIFIER NO.  
=5=W          STO   4  AWORK3(2)           [SAVE
=5QG          LDN   3  BIPB 
=6=6          CALL  5  OPEN                [OPEN IDF.   
=6PQ          SMO      FX2  
=79B          LDX   4  AWORK3              [IDENTIFIER NO. TO BE SEARCH FOR.
=7P2          ADN   3  BLINE
=88L          SBX   3  2
=8N=          CALL  7  ZMSEARCH            [SEARCH FOR IDENTIFIER.  
=97W          SMO      FX2  
=9MG          LDX   0  ACOMMUNE1
==76          BNZ   0  PU2  
==LQ    PU3   GEOERR   1,IDENTILL          [IDENTIFIER ILL  
=?6B    PU2 
=?L2          LDCT  4  #4   
=#5L          SMO      2
=#K=          ORS   4  BTYPE(3)            [ORS IN MARKER.  
=*4W          BRN      ZNOGO
=*JG    #   
=B46    #     THIS BIT DEALS WITH THE CASE WHEN A NEW MODE  
=BHQ    #   
=C3B    XIDF35  
=CH2          LDX   4  ACOMMUNE3(2)        [LD. MODE TO BE STORED   
=D2L          STO   4  AWORK4(2)
=DG=          LDX   0  ACOMMUNE1(2)        [IDENTIFIER NO.  
=D^W          STO   0  AWORK3(2)
=FFG          LDN   3  BIPB 
=F^6          CALL  5  OPEN                [OPEN IDF
=GDQ          SMO      FX2  
=GYB          LDX   5  AWORK4              [MODE WORD.  
=HD2          SMO      FX2  
=HXL          LDX   4  AWORK3              [IDENTIFIER NO.  
=JC=          SBX   3  2
=JWW          ADN   3  BLINE
=KBG          CALL  7  ZMSEARCH            [SEARCH FOR IDENTIFIER CELL  
=KW6          SMO      FX2  
=L*Q          LDX   0  ACOMMUNE1
=LTB          BZE   0  PU3  
=LX^ ...      ADX   3  2
=N9F ...      STO   5  BLINE(3)            [MODE IN B0-8,NPUSIZE IN B9-23   
=N#=          BRN      ZNOGO
=NRW          MENDAREA 50,K100IDFSCON   
=P?G    #END
^^^^ ...20225530000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1