ONLINEC867
(George Source)
Macros used: ABANDCOM, ACROSS, CHECKFLAG, CHEKPRIV, CLOSE, COMBRKIN, COMERRX, DISENGPER, ENDCOM, FINDPEREC, FIXTRA, FJOCA, FREECORE, FREEPER, GEOERR, GEOPACK, GETACTX, IDFOPEN, IDFWRITE, INFORM, ISPROPN, JCANTENG, JENG, JFREE, JNREALT, JWRONG, LGEOG, LINK, LINKSET, LONGSET, MENDAREA, MFREE, MFREEW, MGETCELL, MHUNT, MHUNTW, MONOUT, MSEARCH, NAME, OPEN, OUTBLOCK, OUTBLOCN, OUTNUM, OUTPACK, OUTPAR, OUTPARAM, OUTPAUSE, P, PAIR, PERON, PUTPERENT, ROLPA, RTTEST, SEG, SEGENTRY, SETALLOC, SETDRM, SETNCORE, SPARABEG, SPARANOT, SPRIVJUMP, TESTRACE, V, VFREEW, WRONG, ZERRORX, ZERRORY
- ONLINEC867.txt
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