{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IPBSCANB867)}}
====== IPBSCANB867 ======
(George Source)

**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEND|ALTLEND]], [[george:macro:CCERROR|CCERROR]], [[george:macro:DOWN|DOWN]], [[george:macro:FPUT|FPUT]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:GETACTX|GETACTX]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFTPSCN|IDFTPSCN]], [[george:macro:INFORM|INFORM]], [[george:macro:INFORMX|INFORMX]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:PAIR|PAIR]], [[george:macro:SCONS|SCONS]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SREP|SREP]], [[george:macro:SUICIDE|SUICIDE]], [[george:macro:UP|UP]]

<code - IPBSCANB867.txt>22*P ... SEG  IPBSCANB,,,,G170  
22PD    # (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982.   
22T* ...#     THIS EXCLUDES CODE UNDER #SKI G170
22^=    #OPT  K0IPBSCANB=0  
23DW    #LIS K0IPBSCANB>K0IPB>K0ALLGEO  
23NN ...#OPT G170 = 0   
23YG ...#SKI G170&1 
248# ...# WITH UGUG EDIT M170 (CHANGE REMOTE *LP WIDTHS)
24D6    [   
24XQ    [   
25CB    [   
25X2    [                                  [PERFORMS SOME ACTIONS FOR WHICH...  
26BL    [                                     THERE IS NO ROOM IN IPBSCAN   
26W=    [   
27*W    [   
27TG          SEGENTRY K1IPBSCANB,SK1IPBSCANB   
28*6          SEGENTRY K2IPBSCANB,SK2IPBSCANB   
28MG          SEGENTRY K3IPBSCANB,SK3IPBSCANB   
28SQ    [   
28WN          FSHENTRY K4IPBSCANB,(GEOERR),(GEOERR),(GEOERR)
28YL          FSHENTRY K5IPBSCANB,(GEOERR),(GEOERR),(GEOERR)
292J          FSHENTRY K7IPBSCANB,(GEOERR),(GEOERR),(GEOERR)
294G          FSHENTRY K8IPBSCANB,(GEOERR),(GEOERR),(GEOERR)
296D          FSHENTRY K9IPBSCANB,(GEOERR),(GEOERR),(GEOERR)
298B          FSHENTRY K10IPBSCANB,(GEOERR),(GEOERR),(GEOERR)   
29=#    [   
29#B    [   
29S2    [   
29TY          SEGENTRY  K11IPBSCANB,SK11IPB 
29XW    [      ENTRY FOR SCANNING ACTIVITY AFTER CANCEL ATTACH CANCEL CONCEPTUAL
29^S    [      CONCEPTUAL MODE #1000 OR SUP. SEG 'IDENTIFIER FREE7  
2=3Q    [   
2=5N          SEGENTRY  K12IPBSCANB,SK12IPB 
2=7L    [  RETURN ENTRY AFTER GOING BACK TO IPBSCAN 
2=9J    [   TO DO THE NEBUL ROUTINE 
2===          SEGENTRY   K14IPBSCANB,SK14IPB
2==Y    [      REPLACE CODE FOR IPBSCAN ENTRY K2
2K3B    PAIR2 PAIR     IPBSCAN,3
2KH2    #SKI  0?-PAIR2<2$2  
2L2L    (   
2LG=    #REP  0?-PAIR2$3-1  
2L^W          +0
2MFG    )   
2M^6    PAIR3 PAIR     IPBSCAN,4
2NDQ    #   
2NYB    #DEF  ZLEN=PAIR3-PAIR2  
2PD2    #   
2PXL    XPAIR2  
2QC=    #HAL  CPAT,0
2QWW    XPLUS +CPATLEN  
2RBG    #SKI  2<ZLEN$ZLEN   
2RW6    (   
2S*Q    #REP  ZLEN-2
2STB          +0
2T*2    )   
2TSL    XPAIR3  
2W#=    #HAL  CONSA+I7023,0 
2WRW          +CONSALEN+I7023LEN
2W^N    #   
2X3L    PCLOSE  
2X5J          0,#400:0,#01260000           ["CLOSE" IDENTIFIER SUPERVISORY SEG  
2X7G    #DEF  PCLOSELEN=0?-PCLOSE   
2X?G    #   
2XR6    #   
2Y=Q    [   
2YQB    [   
2^=2    [   
2^PL    SK11IPB 
329=    [   
32NW    [                                   TO SET UP A DCB 
338G    [   
33=P          LDN   4  1
33#Y          LDN   7  0
33C7    [   
33FB    [   
33HK    [   
33KS    SK1IPBSCANB        [SETDB   
33N6          SETNCORE ADCBULKLEN,2,AMXOR,ADCB,,1,2 
33XY          BZE   7  SINIT
347Q          UP
3482    SINIT   
348=          HUNTW    3,IDF,CONCEP        [PRESENT FOR CC CL OR RELPER 
348G          BNG   3  SING                [ABSENT FOR DETACH OR OFF-TEST   
348Q          LDX   4  ALOGLEN(3)   
3492    SREP  ADX   3  4
349=          SRL   4  1
349G          LDX   6  A1-1(3)             [IDENTIFIER NUMBER   
349Q          LDX   5  A1-2(3)             [AMOP/IPBIN ADDRESS  
34=2    SING  LDX   1  FX2  
34==          STO   5  AWORK1(1)
34=G          STO   4  ICHARS(2)           [NO. OF IDENTIFIERS TO DEAL WITH 
34=Q          SMO   5   
34?2          LDX   0  CPPTR
34?=          STO   5  AMOPADDR(1)  
34?G          STO   0  CPPTR(1)            [DEVICE LIST POINTER 
34?Q          HUNT2J   3,AMXOR,ADEVS,5,NYMOA
34#2          SBX   6  A1+FOURTHWD(3)   
34#=          LDX   0  6
34#G          LDX   7  A1+FOURTHWD(3)      [LOWEST IDENT. NO. IN ADEVS BLOCK
34#Q          SLL   0  2
34*2          ADX   3  0                   [POINT TO ADEVS ENTRY
34*=          LDX   5  A1+BPTR(3)   
34*G          LDX   0  A1+FOURTHWD(3)   
34*Q          BNZ   5  NYMO                [BUSY : 7023 BEFORE ONLINE   
34B2          ANDX  0  BIT9 
34B=          BNZ   0  NOPE                [CLOSED : DO FULL INITIALISATION 
34BG          ADX   7  6                   [IDENTIFIER NUMBER   
34BQ          DOWN     IPBINB,10           [AS IF INPUT RECEIVED FROM IDLE IDENT
34C2          BRN      NYMO 
34C=    #   
34CG    NOPE  LDCT  0  #60  
34CQ          STO   7  ACOMMUNE5(1) 
34D2          LDX   7  A1+FOURTHWD(3)   
34D=          ANDX  7  0
34DG          BNZ   7  NYMO                [IDENTIFIER ALREADY BEING INITIALISED
34DQ          LDCT  0  #20  
34F2          ORS   0  A1+FOURTHWD(3)      [INDICATE INITIALISING   
34F=          LDEX  0  A1+FOURTHWD(3)   
34FB ...      ANDN  0  #77  
34FG          BZE   0  UCONS               [MOP CONSOLE 
34FQ          SBN   0  5
34G2          BZE   0  U7023               [7023 CONSOLE
34G=          SBN   0  5
34GG          BZE   0  UCONS               [MOP DISPLAY 
34H=          SBN   0  #20  
34HG          BZE   0  UCONS               [PSEUDO VDU  
34J2          ADN   3  A1   
34J=          ACROSS     IPBSCAN,11    [INITIALISE BULK DEVICES 
34JG    [  RETURN FROM IPBSCAN AFTER NEBUL  
34JQ    SK12IPB 
34K2          BRN      NYMO                [ANY MORE?   
34K=    U7023 LDN   0  ZLEN 
34KG    UCONS   
34KQ          LDN   7  0
34L?          LDX   3  0
34LS          LDX   1  FX1  
34MB    [   
3572    [   
35LL    [   
35WD    [           NECON   
366=    SK2IPBSCANB                         [GET ACT FOR MOP OR RJE CONSOLE 
36KW    [   
375G          ADX   1  3
37K6          LDX   5  XPAIR2(1)
384Q          GETACTX  5,XPLUS(1)          [CONSA/I7023 OR CPAT 
38JB          LDX   0  ACOMMUNE5(2)        [LOWEST IDENTIFIER NUMBER ON IPB 
3942          ADX   3  FX1  
39HL          ADX   0  6
3=3=          LDX   1  AMOPADDR(2)         [ADDRESS OF AMOP/IPBIN   
3=GW          LDX   5  CPPTR(1)            [POINTER TO DEVICE LIST  
3?2G          LDX   2  BPTR(2)  
3?G6          STO   1  AWORK1(2)
3?^Q          STO   0  ACC7(2)             [IDENTIFIER NUMBER.  
3#FB          STO   5  CPPTR(2) 
3#^2          LINKSET  2,PAIR2(3)          [STORE LINK TO K3 OR K4IPBSCAN   
3*DL          LDX   3  6
3*Y=          SLL   3  2
3BCW          STO   3  ACC6(2)             [RELATIVE ADEVS POINTER  
3BQ?          FPUT                    [START NEWLY CREATED ACTIVITY 
3C4N          BZE   7  NYMO 
3CC6          UP
3CDC    NYMO  MHUNTW   2,AMXOR,ADCB 
3CFN          LDX   4  ICHARS(2)
3CG^          BCT   4  SNE                 [NOT FINISHED : GO ON TO NEXT DEVICE 
3CJ=    NYMOA   
3CLS          SUICIDE   
3CQM    SNE   SLL   4  1
3CRY          MHUNTW   3,IDF,CONCEP 
3CT9          BRN      SREP 
3CWQ    [   
3CX^    [   
3CYB    [   
3CYR    [   
3C^8    SK3IPBSCANB 
3C^B ...ZIOUT          +JIDEDH  
3C^K    [   
3D22    # K3IPBSCANB IS A SUBROUTINE FOR IPBSCAN TO INFORM THE CENTRAL OPERATOR 
3D2C    # THAT "THE WRONG TP FOR MOP USE IS LOADED" AND TO SET UP A "CLOSE" 
3D2S    # IDENTIFIER SUPERVISORY SEGMENT
3D39    #   
3D3C ...      BNG   7  SMESS
3D3L          MHUNTW   3,AMXOR,ADCB 
3D3W ...      LDX   6  IDENTNO(3)   
3D46 ...      BNZ   7   SETUPCLOSE  
3D4D          SMO      IADIN(3)            [FIND THE OUTPUT ACTIVITY
3D4T          LDX   3  IPBRING  
3D5=          SBN   3  IPBRING  
3D5M          LDCT  5  #40                 [CHECK IF OP ALREADY INFORMED
3D64          ANDX  5  IPBSW(3) 
3D6F          BNZ   5  SETUPCLOSE          [TRUE : SKIP INFORM  
3D6W          LDCT  0  #40                 [SET "REPORTED DCP WRONG FOR MOP USE"
3D7?          ORS   0  IPBSW(3)            [FLAG
3D7N          LGEOG    CPPTR(3),4   
3D85          GEOPACK  4,4,UNITNO   
3D8G          OUTPACK  4,1,GEOPER   
3D8X          INFORM   1,IPBNOTW4,1        [THE WRONG TELEPROGRAM FOR MOP USE IS
3D9#                                       [LOADED IN UNIT %A   
3D9P    SETUPCLOSE  
3D9X ...      LDX   7  6
3D=6 ...      SETNCORE PCLOSELEN,3,AMXOR,IOUT   
3D=H          LDN   0  PCLOSE(1)
3D=Y          LDN   1  IMOPTY(3)
3D?*          MOVE  0  PCLOSELEN
3D?Q          DSA   7  IPBIDE(3)
3D#7          UP
3D#8 ...
3D#9 ...SMESS   
3D#= ...      LDX   7  ZIOUT(1) 
3D#? ...      MHUNTW   3,AMXOR,ADCB 
3D## ...      LDX   5  IDENTNO(3)   
3D#* ...      LDX   3  IADIN(3) 
3D#B ...      LGEOG    CPPTR(3),4   
3D#C ...      OUTNUM   4,0  
3D#D ...      OUTNUM   5,0  
3D#F ...      LDN   6  0
3D#G ...      INFORMX  6,7,1
3D#H ...      UP
3D#J    [   
4=B?    SUIC
4=HF          SUICIDE   
4=NP    [   
4=NR    PRESET2 
4=NT          0 
4=NX          SEGENTRY K31IPBSCANB          [FOR USE BY MOPWIDTH MACRO  
4=N^          0 
4=P3    #FID  0,5,6 
4=P5    #FID  15,23,72  
4=P6 ...#UNS ANOECHO
4=P7 ...#SKI
4=P8 ...(   
4=P9 ...      10,#76357632,#76207603,#76130000,0,8,#76672076,#27760177  
4=P= ...)   
4=P? ...#UNS ANOECHO
4=P# ...(   
4=P* ...      10,#76357632,#76207620,#76200000,0,8,#76672076,#27762077  
4=PB ...)   
4=PC ...      SEGENTRY K30IPBSCANB  
4=PD ...      0,#76037673,#76737673 
4=PF ...      0 
4=PG ...#DEF  P2MOPLEN=0?-PRESET2   
4=PH ...#   
4=PJ ...PRESET2V
4=PK          0 
4=PM    #FID  0,5,2 
4=PP    #FID  6,11,25   
4=PR    #FID  15,23,80  
4=PT          2,#76320000,0 
4=P^    #FID  6,6,1 
4=Q3          SEGENTRY K40IPBSCANB          [FOR USE BY VDUCODE MACRO   
4=Q5          0 
4=Q7          0 
4=Q9          6,#14357613,#06200000 
4=Q?          #40000014,#77763300,#76317420,#76067606   
4=Q*    YCONTEXT       #20242   
4=QC    #   
4=QF    # ENTRY POINT TO CHECK THE IDF IF INPUT IS RECEIVED FROM AN IDLE IDENT. 
4=QH    #   
4=QK    SK14IPB 
4=QM          MHUNTW   3,AMXOR,ADCB 
4=QP          LDN   5  1                   [SET MOPOFF MARKER   
4=QR          LDX   3  IADIN(3)            [AMOP/IPBIN ADDRESS  
4=QT          STO   3  AWORK1(2)
4=QX          LGEOG    CPPTR(3),4          [IPB GEOG NO.
4=R3          IDFTPSCN XBI,SYSOF,CPPTR(3),7[CHECK IDENTIFIER IN THE IDF 
4=R9          LDN   5  0                   [CLEAR TO SHOW MOPPED ON.
4=R?    SYSOF HUNT2J   3,AMXOR,ADEVS,,SUIC [J TO SUICIDE IF BLK NOT FOUND   
4=R*          ADX   3  6                   [POINTER TO CORRECT ADEVS ENTRY. 
4=RC ...#UNS  CCERROR   
4=RF ...(   
4=RH ...      LDCT  0  #100 
4=RK          ANDX  0  A1+FOURTHWD(3)   
4=RM          BNZ   0  NOTON
4=RP ...
4=RR ...)   
4=RT          BNZ   5  NOTON               [J. IF IDENTIFIER ALREADY MOPPED OFF.
4=RX          LDX   6  ACOMMUNE2(2)        [IDF REPLY   
4=R^          DEX   5  A1+FOURTHWD(3)   
4=S7          LDX   0  6
4=S* ...      ANDN 0 #6200  
4=SH          ERS   0  6
4=SM          ORS   6  A1+FOURTHWD(3)      [REMEMBER DEVICE TYPE
4=SP          LDEX  5  6
4=SQ ...      ANDN  5  #17  
4=SR          ANDN  6  #400 
4=ST          BNZ   6  NOTON               [TYPE UNKNOWN
4=T3          LDX   6  0                   [ADCB FORMAT 
4=T5          SRL   6  9
4=T9          LDX   3  A1+FPTR(3)   
4=T?          SBN   3  A1+FPTR             [POINT TO ADCB   
4=T*          DOWN   IPBSCAN,8  
4=TC          MHUNTW   3,AMXOR,ADCB 
4=TF          LDX   7  IDENTNO(3)   
4=TH          BZE   5  SCONS               [J. IF MOP CONSOLE   
4=TK          SBN   5  10   
4=TM          BZE   5  SDISP               [J. IF MOP DISPLAY   
4=TP          ADN   5  10   
4=TR          ALTLEND  3,ADCBULKLEN        [SHORTEN ADCB
4=TX          LDCT  0  #24                 [UNSET THE "SETTING UP" MARKER   
4=T^          STO   7  JSOURCE1(2)         [SET UP THE JOB SOURCE WORDS 
4=W3          ORX   4  CACT 
4=WR          STO   4  JSOURCE2(2)  
4=WT          SMO      A1+FPTR(3)   
4=WX          ANDX  0  FOURTHWD 
4=W^          SMO      A1+FPTR(3)   
4=X3          ERS   0  FOURTHWD 
4=X9          ORS   6  IWAIT(3)            [B21,22  
4=XC          LDX   0  ACOMMUNE2(2) 
4=XF          SRL   0  ADCB7502LP&#37-16
4=XH          ANDN  0  1
4=XK          ORX   6  0
4=XP          STO   6  IBULK(3) 
4=XT          SMO      5                   [J. ON PERIPHERAL TYPE.  
4=XX          BRN      TABL2-3  
4=X^    #   
4=Y3    TABL2 BRN      XLP  
4=Y5          BRN      XCR  
4=Y7          BRN      TMOF     [CLEAR RINGS THEN SUICIDE   
4=Y9          BRN      XTR  
4=Y?          BRN      XTP  
4=Y*    #   
4=YC    XCR   LDN   5  3                   [SET UP THE DEVICE TYPE. 
4=YF          DCH   5  JSOURCE1(2)  
4=YH          LDN   0  #4000               [TEST B12 OF FOURTHWD
4=YK          SMO      A1+FPTR(3)   
4=YM          ANDX  0  FOURTHWD 
4=YN ...      SMO      IADIN(3) 
4=YP ...      LDX   4  IPBSW
4=YQ ...      SLL   4  9
4=YR ...      BPZ   4  XVCR 
4=YS ...      BZE   0  XTR  
4=YT ...      BRN      XCRCH
4=YW ...XVCR
4=YX ...      BNZ   0  XTR  
4=YY ...XCRCH   
4=Y^ ...      LDCT  0  3
4=^2 ...      ERS   0  IMDNPU(3)
4=^3 ...XTR   LDX   4  YCONTEXT(1)  
4=^4 ...      LDN   5  #61  
4=^5 ...      LDCT  0  #10  
4=^6 ...      STO   4  CONTEXT(2)   
4=^7          ORS   0  IWAIT(3)            [INDICATE 'ONE SHOT INPUT' SENT  
4=^9          STO   5  AMXMSK(2)           [AND REPORT MASK.
4=^?          ACROSS   COMPROA,1            [GO AND READ INPUT. 
4=^*    #   
4=^C    XLP   LDN   4  2
4=^F          BRN      XOUT 
4=^H    XTP   LDN   4  1
4=^K    XOUT  DCH   4  JSOURCE1(2)         [SET THE DEVICE TYPE.
4=^M          LDX   5  ACOMMUNE4(2)        [CONSOLE PROPERTY NO. FROM IDFTPSCN. 
4=^P          STO   5  JSOURCE3(2)         [AND THE CONSOLE PROPERTY NO.
4=^Q ...#SKI G170&1 
4=^R ...      DOWN     UMMENDS,13   
4=^S ...      ACROSS   IPBLISTD,2          [GO TO OUTPUT HEADERS. (N.B. X5 > 0).
4=^T    #   
4=^X    SDISP LDN   4  PRESET2V(1)  
4=^^          BRN      SMOP 
4?23    SCONS LDN   4  PRESET2+1(1) 
4?25    SMOP  LDN   5  ICHARS(3)           [COMPLETE DCP INITIALISATION 
4?27          LDX   0  IBIL(3)  
4?29          MOVE  4  P2MOPLEN-1   
4?2?          SMO      IADIN(3) 
4?2*          LDX   4  CPPTR
4?2C          STO   0  IBIL(3)             [PRESERVE IPBIN'S BREAK-IN LEVEL 
4?2F          STO   4  CPPTR(2)            [POINTER TO IPB DEVICE LIST  
4?2H          LDXC  0  ISTATUS(3)   
4?2K          BCC      RCONS               [INITIALISE CPA  
4?2M          LDX   0  BIT11               [IDLE IDENTIFIER BECAME UNAVAILABLE :
4?2P          ORS   0  IWAIT(3)            [SET"INHIBIT INOPERABLE MESSAGE" FLAG
4?2R          BRN      RCONS               [J. TO INITIALISE CPA.   
4?2T    RCONS   
4?2X          ACROSS   IPBSCAN,12        [GO ACROSS TO RCONS ROUTINE
4?2^    #   
4?33    TMOF  LDX   3  A1+FPTR(3)          [ENTRY IF MOPOFF WHILE SETTING UP
4?35          SBN   3  A1   
4?37    NOTON SMO      A1+FPTR(3)          [CLEAR THE RING ELEMENTS.
4?39          STOZ     BPTR 
4?3?          LDCT  4  #24                 [UNSET THE SETTING UP BITS.  
4?3*          STOZ     A1+BPTR(3)   
4?3C          ANDX  4  A1+FOURTHWD(3)   
4?3F          ERS   4  A1+FOURTHWD(3)   
4?3H          BRN      SUIC                [CLEAR UP.   
4?3M    XBI   GEOERR   1,BREAKIN!          [CANT HAVE BREAK-IN  
4?8*    #END
^^^^ ...63212352002100000000
</code>