{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ONLINEC867)}}
====== ONLINEC867 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ACROSS|ACROSS]], [[george:macro:CHECKFLAG|CHECKFLAG]], [[george:macro:CHEKPRIV|CHEKPRIV]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:DISENGPER|DISENGPER]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREEPER|FREEPER]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:GETACTX|GETACTX]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:INFORM|INFORM]], [[george:macro:ISPROPN|ISPROPN]], [[george:macro:JCANTENG|JCANTENG]], [[george:macro:JENG|JENG]], [[george:macro:JFREE|JFREE]], [[george:macro:JNREALT|JNREALT]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINK|LINK]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LONGSET|LONGSET]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:NAME|NAME]], [[george:macro:OPEN|OPEN]], [[george:macro:OUTBLOCK|OUTBLOCK]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPAR|OUTPAR]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPAUSE|OUTPAUSE]], [[george:macro:P|P]], [[george:macro:PAIR|PAIR]], [[george:macro:PERON|PERON]], [[george:macro:PUTPERENT|PUTPERENT]], [[george:macro:ROLPA|ROLPA]], [[george:macro:RTTEST|RTTEST]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETDRM|SETDRM]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:SPRIVJUMP|SPRIVJUMP]], [[george:macro:TESTRACE|TESTRACE]], [[george:macro:V|V]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WRONG|WRONG]], [[george:macro:ZERRORX|ZERRORX]], [[george:macro:ZERRORY|ZERRORY]]
2278 ... SEG ONLINEC,,JOHN BAILEY,,G505
22#B ...[
22FJ ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22LQ ...[ THIS EXCLUDES CODE UNDER #SKI G505
22RY ...[
22^= #
2357 ...#OPT G505 = 0
2394 ...#SKI G505&1
23#^ ...# WITH UGUG EDIT M505 (3-SHIFT WORKING FOR MOP ONLINE PROGRAMS)
23DW SEGENTRY K1ONLINEC,SK1ONLINEC
23YG SEGENTRY K2ONLINEC,SK2ONLINEC
24D6 SEGENTRY K3ONLINEC,SK3ONLINEC
24XQ #
25CB #
25X2 # THIS CHAPTER IS ENTERED BY ACROSSES FROM K1ONLINEA.
26BL # ON ENTRY X3 CONTAINS THE PERIPHERAL TYPE.
26W= #
27*W TBLCI PAIR CIMOP,1
27KN #UNS JSKI04
27TG TBCI LINK CIBULK,1
28*6 NAMPR 4HPR
28LW VLAN 0,0,4HB1B0 [FGN=0 FOR HIGHEST GEN
28YM
294J FIXTRA CIPRIVA
298F 8H [CIPRIV WILL FILL THIS IN
29#B #
29S2 # OUTPARAM MESSAGE BEGINNING IN ACOMMUNE1 WITH CHAR COUNT IN X6
2=?L #
2=R= OUTPA SBX 0 FX1 [CALL ON X0
2?=W STO 0 AWORK4(2)
2?QG OUTPARAM 6,ACOMMUNE1
2#=6 SMO AWORK4(2)
2#PQ EXIT 1 0
2*9B #
2*P2 # OUTPACK THE PERIPHERAL NAME , E.G GP3 , FROM PERCON REPLY
2B8L #
2BN= OUT SBX 6 FX1
2C7W OUTPACK AWORK1(2),1,PERINAME
2CMG ADX 6 FX1
2D76 EXIT 6 0
2DLQ #
2F6B NAME SBX 6 1 [CHECK FORMAT OF NAME PARAMETER.
2FL2 SPARANOT 2
2G5L MHUNT 3,CPB,CUNI
2GK= ADX 6 1 [RELOCATE LINK.
2H4W NGX 0 ANUM(3)
2HJG BPZ 0 (6) [NULL OR MISSING
2J46 ADN 0 12
2JHQ BNG 0 XEND [NOT SIMPLE, OR > 12 CHARACTERS.
2K3B LDCH 0 APARA(3)
2KH2 SBN 0 #41
2L2L BNG 0 XEND [1ST. CHARACTER IS NOT A LETTER.
2LG= EXIT 6 1 [NAME IS IN LOCAL FILE NAME FORMAT.
2L^W #
2MFG STOLP SBX 4 FX1 [GET O.P. RED TAPE & CREATE NEW OLPA.
2M^6 FREECORE 1
2NDQ STO 4 AWORK4(2) [SAVE LINK.
2NYB LDCT 4 AOLPT/8 [GET NAME FOR NEW ACTIVITY.
2PD2 GETACTX 4,3,1 [GET OLPA IN LONGLOCK AREA
2PXL LDX 3 BPTR(2)
2QC= SMO AWORK4(2) [RETURN TO LINK.
2QWW EXIT 1 0
2RBG #
2RW6 #
2S*Q # ONLINE EXOTIC PERIPHERAL ; CHECK STATUS IN APERI/APLIST BLOCK
2STB #
2T*2 SK1ONLINEC
2TSL STO 3 AWORK2(2) [PRESERVE TYPE
2W#= LDN 5 0 [FIRST TIME THROUGH.
2WRW MFREEW CPAR,GPERCON
2X?G CALL 6 NAME [CHECK DESCRIPTION PARAMETER,
2XR6 LDX 5 GSIGN [SET SWITCH IF MISSING.
2Y=Q LDN 3 0 [SWITCH : NOT YET WAITING
2YQB PGET FINDPEREC 1,APFOTY,AWORK2(2),RENT [GET NEXT DEVICE OF TYPE SPEC.
2^=2 BNG 1 NOEN [NO ENTRY FOUND
2^C8 LDXC 0 JADDP(1)
2^JB BCS PERNA
2^PL JWRONG 1,RENT
329= JFREE 1,NALOC [UNALLOCATED DEVICE FOUND
32NW LDN 6 0 [SET 'ALLOCATED DEVICE EXISTS' MARKER
338G BRN RENT
33N6 NOEN BNZ 6 PERNA [J IF NO RIGHTED DEVICES EXIST
347Q LONGSET #30,SET
34MB BNZ 3 WTING [RE-ENTER WAIT : WRONG EVENT
3572 LDN 3 1
35LL WAIT2 CALL 6 OUT [OUTPUT PERIPHERAL MNEMONIC
366= MONOUT JXOTWT1 [WAITING FOR %A
36KW OUTBLOCN 10
375G OUTPAR USERNAME,JOBNAME
37K6 CALL 6 OUT [OUTPUT PERIPHERAL MNEMONIC
384Q INFORM 2,JXOTWT2,1 [:USERNAME.JOBNAME : WAITING FOR *%C
38JB OUTPAUSE XBI2,PGET,,15,WTING [WAIT FOR 15 MINS.
3942 BRN WAIT2
39HL #
3=3= NALOC LDX 3 1
3=GW LDX 1 FX1 [IN CASE JUMP TO COMMAND ERROR
3?2G LDX 2 FX2
3?G6 JNREALT 3,XFLG1 [J UNLESS REALTIME NEEDED
3?^Q FJOCA 2
3#^2 RTTEST RTOK,2 [TEST IF REAL-TIME 'ON'
3*DL BRN NRT [NO : COMMAND ERROR
3*Y= RTOK CHECKFLAG 3,NOF
3BCW SETALLOC 3
3BXG SETDRM 3 [SET DIRECT RESPONSE MODE
3CC6 LDN 0 1
3CWQ ADS 0 AEXCO(2)
3DBB BRN UNIFR
3DW2 #
3F*L NOF BNG 5 NDATA [ NON-FLAG-SETTER
3FT= LDN 0 1
3G#W ADS 0 AEXCO(2) [UPDATE COUNT OF RT EXOTICS
3GSG XFLG1 BNG 5 NDATA [J. IF NO DATA DESCRIPTION
3H#6 SETALLOC 3 [MARK ALLOCATED
3HRQ LGEOG 3,4
3J?B #SKI IPBMK7
3JR2 JCANTENG 3,REOUT [NO DIS IF NON-ENGAGEABLE
3K=L DISENGPER 3 [DISENGAGE ORDINARY EXOTIC
3KQ= PGET2 JENG 3,XDESC [J IF UNIT ENGAGED
3L9W LONGSET #77,SET,4 [WOKEN UP BY ENGAGE
3LPG BNG 5 WTIN2 [J. IF WAIT ALREADY INITIATED.
3M96 REOUT MHUNT 1,CPB,CUNI
3MNQ LDEX 6 ANUM(1)
3N8B LDX 0 6
3NN2 ADN 0 15 [ADD 1 FOR GEOG. NO. & 2 FOR RED TAPE
3P7L SRL 0 2
3PM= OUTBLOCK 0
3Q6W MHUNT 1,CPB,CUNI
3QLG LDN 0 APARA(1)
3R66 LDN 1 ACOMMUNE1(2)
3RKQ MOVE 0 3
3S5B CALL 0 OUTPA [%A = DATA NAME.
3SK2 #SKI JNLPACK
3T4L (
3TJ= GEOPACK 4,4,4
3W3W OUTPACK 4,1,GEOPER [%B = GEOG NO.
3WHG )
3X36 #SKI JNLPACK<1$1
3XGQ OUTNUM 4,0 [%B = GEOG NO.
3Y2B ORX 5 GSIGN
3YG2 WAIT3 INFORM 1,JXOTLOAD,0 [PLEASE CHECK DATA %A ON UNIT %B
3Y^L #SKI IPBMK7
3^F= JCANTENG 3,XDESC [NO WAIT FOR ENGAGE BUTTON IF NON-ENG
3^YW MHUNT 1,CPB,CUNI
42DG LDN 0 APARA(1)
42Y6 LDN 1 ACOMMUNE1(2)
43CQ MOVE 0 3
43XB CALL 0 OUTPA [%A = DATA NAME.
44C2 MONOUT JXOTWT3 [WAITING FOR %A TO BE CHECKED.
44WL STO 3 CPPTR(2) [IN CASE J TO XCD OR XBI1 (FREEPER)
45B= OUTPAUSE XBI1,PGET2,XCD,2,WTIN2 [WAIT FOR 2 MINS.
45TW ANDN 5 #777
46*G BRN REOUT
46T6 XDESC VFREEW GMON,AOUT [INFORM'S MESSAGE BLOCK
47#Q #
47SB UNIFR MFREE CPB,CUNI [FREE 2ND. COMMAND PARAMETER BLOCK.
48#2 PERON 3 [MARK PERIPHERAL ONLINE
48RL PUTPERENT AWORK1(2),3 [INSERT ONLINE ENTRY IN PRB
49?= XIT ENDCOM [UP,UP AND AWAY!!!
49QW #
4==G # ONLINE PSEUDO-ONLINE SLOW PERIPHERAL ; CREATE PRB ENTRY & NEW OLPA
4=Q6 #
4?9Q SK2ONLINEC
4?PB LDX 5 3 [SAVE TYPE.
4#92 MHUNTW 1,CPAR,GPERCON
4#NL LDX 6 A1+3(1)
4#Q* ...#SKI G505&1
4#S4 ...(
4#TR ... SRL 6 12
4#XG ... ANDN 6 #77 [ SHIFT BITS
4#^9 ... LDCT 0 #770
4*2Y ... ANDX 0 A1+3(1) [ IDENTIFY & CURSOR BITS
4*4M ... ORX 6 0
4*6B ...)
4*8= LDN 3 AOLPTLEN+ASERLEN
4*MW CALL 4 STOLP [MSWAPIN, AND CREATE NEW OLPA.
4B7G FJOCA 2
4BM6 SPRIVJUMP JSSTART,2,STARP [JUMP IF JSSTART PRIVILEGE
4C6Q ADN 7 3 [X7 = 4 IF O/P, 3 IF I/P.
4CLB ANDN 7 3 [SET ATMARK =0 FOR SLOW OUTPUT
4D62 STO 7 ATMARK(3) [ OR = 3 FOR INPUT PERIPHERAL.
4DKL BRN XF
4F5= STARP LDN 7 3
4FJW STO 7 ATMARK(3) [SET PSEUDO OFF-LINE MARKER
4G4G XF LDX 2 FX2
4GJ6 LDX 3 BPTR(2) [ADDRESS OF NEW OLPA
4H3Q STO 6 IDENTIND(3) [PERCON INFORMATION
4HHB LDX 0 AWORK1(2)
4J32 ORX 0 GSIGN
4JGL STO 0 IDENTINFO(3) [PERTYPNO REPLY
4K2= LDX 0 ACTNUM(3)
4KFW STO 0 AWORK2(2) [FOR FINDACTNO LATER
4K^G BNZ 7 SLIN [J IF INPUT OR JSSTART PRIVILEGED
4LF6 SETNCORE 10,3,FILE,FABSNB
4LYQ FJOCA 2
4MDB LDN 0 10
4MY2 STO 0 A1(3) [WORD COUNT
4NCL ADN 3 A1+1
4NX= ADN 2 JUSER
4PBW MOVE 2 3 [USER NAME
4PWG ADN 3 3
4QB6 SBN 2 JUSER-JNAME
4QTQ MOVE 2 3 [JOB NAME
4R*B ADN 3 3
4RT2 LDN 2 VLAN(1)
4S#L MOVE 2 3
4SS= OPEN XBI2,SYSTCOMM,APPEND,ERASING
4T?W LDN 4 #12 [OBJECT & ONLINE CATEGORIES
4TRG TESTRACE 4,RACE [REPORT ERROR IF NO TRACING
4W?6 BRN SLIN
4WQQ RACE MONOUT JMTRACE1 [NO TRACE OUTPUT FOR THIS COMMAND
4X=B SLIN ACROSS ASSIGN,11
4XQ2 #
4Y9L # ONLINE COMMAND ISSUER CHANNEL ; CREATE PRB ENTRY AND NEW OLPA
4YP= #
4^8W SK3ONLINEC
4^?F
4^B4 FIXTRA CIPRIVB
4^DM BRN NOCIPRIV [CIPRIV WILL NULL THIS
4^H= CHEKPRIV ,CIPRIVA,WRONG [J IF NOT GOT PRIV
4^KT NOCIPRIV
4^NG LDN 4 2
5286 LDX 5 NAMPR(1) [PRESET 4HPR
52MQ SPARABEG 1,4 [GET PROPERTY NAME IF EXISTANT
537B MHUNT 3,CPB,CUNI
53M2 LDX 0 ANUM(3)
546L #SKI JSKI04<1$1
54L= BPZ 0 XILN
555W #SKI JSKI04
55KG (
5656 BNG 0 XCI [BRANCH IF PROPERTY NON EXISTANT
56JQ BZE 0 XILN [BRANCH IF PROPERTY NULL
574B SBN 0 13
57J2 BPZ 0 XILN [BRANCH IF PROPERTY NAME >12 CHARS
583L LDCH 0 APARA(3)
58H= SBN 0 #41
592W BNG 0 XILN [BRANCH IF FIRST CHAR NON ALPHA
59GG P IDFANDPROP,XBI3 [GET READY TO OPEN IDF ETC.
5=26 #SKI JSKI18<1$1
5=FQ ISPROPN 7
5=^B #SKI JSKI18
5?F2 ISPROPN XBI3,7
5?YL BZE 7 XNE [BRANCH IF PROPERTY NO. NON EXISTANT
5#D= ANDX 7 BITS22LS
5#XW ADX 7 GSIGN
5*CG IDFOPEN XBI3 [OPEN IDF
5*X6 LDN 3 BIPB
5BBQ MSEARCH 2,3,7 [SEE IF CI CHANNEL ALREADY EXISTS...
5BWB SMO FX2
5CB2 LDX 0 ACOMMUNE1
5CTL BZE 0 XOF [...AND BRANCH IF IT DOESNT
5D*= ADX 3 2
5DSW LDCT 0 128
5F#G ANDX 0 BNUMB(3) [SEE IF CI CHANNEL ALREADY ONLINE...
5FS6 BZE 0 XRI [...COMMAND ERROR IF IT IS
5G?Q ERS 0 BNUMB(3) [MARK ONLINE(RIGHTED)
5GRB XWR IDFWRITE [WRITE NEW CI CHANNEL CELL
5H?2 CLOSE [CLOSE IDF
5HQL V IDFANDPROP
5J== NGNC 5 1 [X5=1 ENHANCED CI
5JPW )
5K9G XCI LDN 5 0 [X5=0 OLD BORING CI
5KP6 MHUNT 1,CPB,CUNI
5L8Q FREECORE 1 [FREE CUNI
5LNB MHUNTW 1,CPAR,GPERCON
5M82 LDN 3 AOLPTLEN [LENGTH OF OLPA
5MML LDX 6 A1(1)
5N7= CALL 4 STOLP [MSWAPIN, AND CREATE NEW OLPA.
5NLW LDCT 0 #400
5P6G STO 0 FRECHADD(3) [MARK PERIPHERAL AS ALLOTABLE
5PL6 STO 0 GIVE(3) [EXEC EVENT CHAINING REQUIRED
5Q5Q LDX 0 JOBNO(2)
5QKB STO 0 JOBNO(3) [GIVE IT THE SAME JOB NO.
5R52 BZE 5 XMPI
5R=8 #UNS JSKI04
5RCB (
5RJL STO 7 AWORK1(3) [IDENTIFIER NO. TO AWORK1
5S4= LDN 7 9
5SHW STO 7 ATMARK(3) [ENHANCED CI MARKER
5T3G LINKSET 3,TBCI(1) [LINK TO K1CISTART
5TH6 BRN XPUT
5TQY )
5W2Q XMPI SRC 6 6
5WGB DSA 0 6 [JOB NO. IN B12-23.
5X22 STO 6 CINUM(3) [UNIT NO./TYPE NO./JOB NO.
5XFL LDN 0 4
5X^= STO 0 ATMARK(3) [SET COMMAND ISSUER MARKER.
5YDW LDX 0 GSIGN
5YYG STO 0 CINUM+1(3) [SET -VE. TO SHOW OLPA JUST SET UP.
5^D6 LINKSET 3,TBLCI(1) [SET LINK TO K1CIMOP
5^XQ XPUT PUTPERENT AWORK1(2),GSIGN [OFFLINE PRB ENTRY ; REPLY IN X6
62CB ROLPA [CHAIN NEW OLPA IN POSITION
62X2 ENDCOM
63BL #SKI JSKI04
63W= (
64*W XOF MGETCELL 2,3 [GET FREE CELL FOR CI CHANNEL
64TG ADX 3 2
65*6 STO 7 CIPROPNO(3) [PROPERTY NO. TO CELL
65SQ LDCT 0 #300 [IPB TYPE
66#B STO 0 BTYPE(3)
66S2 BRN XWR
67?L )
67R= #
68=W # VARIOUS COMMAND ERRORS AND GEORGE ERRORS
68QG #
69=6 PBMIS +BMISS
69PQ ZERRORY
6=9B #SKI JSKI04
6=P2 (
6?8L XRI CLOSE [CLOSE IDF
6?N= V IDFANDPROP
6#7W ZERRORX BUNVP [CI PROPERTY IS NOT AVAILABLE
6#MG XNE V IDFANDPROP
6*76 ZERRORX BUNKP [CI PROPERTY NAME UNKNOWN
6*LQ )
6B6B XILN ZERRORX BINVP [CI PROPERTY NAME INVALID
6BL2 NRT ZERRORX JNRT
6C5L XCD FREEPER
6CK= PERNA SPARANOT 1
6D4W ZERRORX JPERNA [PERIPHERAL NOT AVAILABLE
6DJG XEND ZERRORX APFERR [DATA DESCRIPTION FORMAT ERROR
6F46 NMISS COMERRX PBMIS(1),0(2) [DESCRIPTION MISSING
6FHQ NDATA CALL 2 NMISS
6G3B +JDATMIS [DATA DESCRIPTION
6GH2 XBI1 FREEPER
6H2L XBI2 ABANDCOM
6HG= XBI3 COMBRKIN [IF BREAKIN TRY AGAIN
6HL7
6HQ4 WRONG
6HT^ ZERRORX ANOPRIV [NOT GOT REQUIRED PRIV
6H^W #
6JFG SET GEOERR 1,LONGSET
6J^6 MENDAREA 10,K100ONLINEC
6KDQ #END
^^^^ ...726216340001