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