(George Source)
Macros used: ACROSS, CLOSE, COMBRKIN, ENDCOM, FINDPEREC, FJOCA, GEOERR, HLSXONCH, HUNTW, IDFCLON, IDFOFF, IDFUNON, INFORM, JALLOC, JEXOTIC, JWRONG, LGEOG, LONGSET, MENDAREA, MFREE, MFREEW, MHUNT, MONOUT, OPENDIR, OUTBLOCN, OUTPACK, OUTPARN, OUTPAUSE, PARANEXT, PARANUMB, PARSORT, PERON, PUTPERENT, RTTEST, SEGENTRY, SETALLOC, SPARABEG, SPARANOT, TESTREP, TESTREPNOT, TESTTRAP, UNITOFF, YIDFUNON, YUNITOFF, ZERRORX, ZERRORY
22FL #SEG ONLINEB8 [A C PUTMAN 22LS ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983. 22S3 #OPT K0ONLINEB=0 236D #LIS K0ONLINEB>K0ONLINE>K0COMMAND>K0ALLGEO 23DW 8HONLINEB 23YG # 24D6 SEGENTRY K1ONLINEB,SK1ONLINEB 24XQ SEGENTRY K2ONLINEB,SK2ONLINEB 25CB # 25X2 # THIS CHAPTER IS ENTERED BY ACROSSES FROM K1ONLINEA. 26BL # 26W= NAMCL #43540000 27*W XADEVS 27TG #HAL AMXOR+ADEVS,0 28*6 XALINES 28SQ #HAL AMXOR+ALINES,0 29#B # 29S2 # 2=?L # SEARCH FOR BLOCK OF TYPE IN X5 FROM AMOP WITH ADDRESS IN X1 2=R= # 2?=W SEEK LDX 1 FPTR(1) 2?QG LDX 0 ATYPE(1) 2#=6 TXU 0 5 [BLOCK TYPE REQUIRED IN X5 2#PQ BCC SBLK [HAVE FOUND BLOCK : EXIT 2*9B TXL 0 CACT 2*P2 BCS SEEK [NOT NEXT ACTIVITY ; TRY NEXT BLOCK 2B8L EXIT 7 0 [NO AMXOR/ALINES BLOCK 2BN= SBLK EXIT 7 1 2C7W # 2CMG # ACCESS PARAMETER BEGINNING WITH CL ( I.E. CONCEPTUAL NAME) IF ANY 2D76 # 2DLQ SPAR LDN 4 2 2F6B LDX 5 NAMCL(1) [4HCL00 2FL2 SBX 6 FX1 2G5L SPARABEG 1,4 2GK= MHUNT 3,CPB,CUNI 2H4W LDX 4 AWORK1(2) 2HJG LDX 0 ANUM(3) 2J46 SRL 4 15 [PERIPHERAL TYPE 2JHQ SMO FX1 2K3B BNG 0 (6) [WHOLE UNIT REQUIRED 2KH2 BZE 0 NONAM [NULL CONCEP NAME IS INVALID 2L2L SBN 0 13 2LG= BPZ 0 NONAM [>12 CHARS OR NOT SIMPLE 2L^W LDCH 0 APARA(3) 2MFG SBN 0 #41 2M^6 BNG 0 NONAM [FIRST CHAR NOT A LETTER 2NDQ STO 4 ACOMMUNE2(2) 2NYB IDFCLON XBRK,NCA,PNREC [MARK CONCEPTUAL ONLINE 2PD2 # 2PXL HUNTW 3,FILE,FABSNB 2QC= BNG 3 RNOUS [NO USER 2QWW OPENDIR XBRK,READ,QUERY [IS CONCEPTUAL IN USER'S DIRECTORY ? 2RBG TESTREPNOT NOFILE,RFX1 2RW6 RFXA OUTBLOCN 8 2S*Q OUTPARN 12,A1+4,FILE,FABSNB 2STB OUTPARN 12,A1+1,FILE,FABSNB 2T*2 INFORM 0,CLNFERAS 2TSL BRN RYERS [NOT ALLOWED TO USE THIS CONCEPTUAL 2W73 RFX1 TESTREP NAME,RFXA [TEST REPLY 2WFD TESTREPNOT OK,RGEXX 2WRW CHECKTRAPS 2X?G TESTTRAP WRITE 2XR6 TESTREP NOTRAP,RYERR [NOT ALLOWED IF NOT WRITE TRAP 2Y=Q CLOSE 2YQB RNOUS ADX 6 FX1 2^=2 EXIT 6 1 2^PL # 329= # PREPARE AND GIVE MONOUT : 'WAITING FOR PERIPHERAL' 32NW # 338G WATIN LONGSET #30,SET 33N6 SBX 7 FX1 347Q ADX 1 7 34MB BNZ 3 (1) [WRONG EVENT : ALREADY WAITING 3572 LDN 3 1 35LL WAIT2 OUTPACK AWORK1(2),1,PERINAME [PERIPHERAL MNEMONIC 366= MONOUT JXOTWT1 [WAITING FOR *%A 36KW SMO FX1 375G EXIT 7 1 37K6 # 384Q # ONLINE MULTIPLEXOR OR UNIPLEXOR ; CHECK NAME & REALTIME STATUS 38JB # 3942 SK1ONLINEB 39HL MFREEW CPAR,GPERCON 3=3= FJOCA 3,2 3=GW RTTEST RTON1,3 [J. IF REAL-TIME 3?2G BRN NRT [COMMAND ERROR 3?G6 #SKI G3 3?^Q ( 3#FB RTON1 CALL 6 SPAR [LOOK FOR CONCEP. NAME 3#^2 BRN WUNIT [NO CONCEP NAME : ONLINE WHOLE UNIT 3*DL ACROSS ONLINCL,1 [CONCEPTUAL MPX OR UPX. 3*Y= # 3BCW WUNIT MFREE CPB,CUNI [2ND COMMAND PARAMETER BLOCK 3BXG IDFUNON XBRK,NOMP,4 3CC6 ) 3CWQ #SKI G4 3DBB ( 3DW2 RTON1 LDX 4 AWORK1(2) 3F*L SRL 4 15 [PERIPHERAL TYPE 3FT= IDFUNON XBRK,NOMP,4 3G#W ) 3GG4 LDX 6 ACOMMUNE1(2) [DEVICE LIST POINTER 3GM= HLSXONCH XBRK,AWORK1(2),SLHON 3GSG FJOCA 3,2 [FIND CURRENT JOB BLOCK 3H#6 RTTEST RTON3,3 [J. IF JOB IS REALTIME. 3HD3 #SKI IDFMARK8 3HHY UNITOFF YBRK 3HMT #SKI IDFMARK8<1$1 3HRQ UNITOFF [RELEASE UNIT IN THE IDF 3J?B BRN NRT [J. TO OUTPUT ERROR MESSAGE. 3JR2 RTON3 LDN 0 1 [ADD 1 TO COUNT OF R. T. PERIPHERALS. 3K=L ADS 0 AEXCO(3) 3L9W LDX 5 XALINES(1) [FOR SEEK SUBROUTINE 3LPG LDN 3 0 [SWITCH : NOT YET WAITING 3M96 YEVE LDN 1 ADMULTACT-ADMP 3MNQ REF LDX 1 ADMP(1) [SEARCH DOWN MOP ACTIVITIES LIST 3N8B #SKI K6ONLINE>99-99 3NN2 BZE 1 VAB [GEOERR IF AMOP NOT FOUND 3P7L TXU 6 CPPTR(1) [DEVICE LIST POINTER IN X6 3PM= BCS REF [WRONG DEVICE : TRY AGAIN 3Q6W CALL 7 SEEK 3QLG BRN SDRM [MISSING : OK 3R66 WAN CALL 7 WATIN 3RKQ BRN WINT [REENTER OUTPAUSE 3S5B OUTPAUSE WAS,YEVE,,5,WINT 3SK2 BRN WAIT2 [TIME UP :REOUTPUT MESSAGE 3T4L # 3TJ= NOMP FINDPEREC 3,APFOTY,4,RET [NO SYSTEM ONES : LOOK FOR EXOTICS 3W3W BNG 3 NAMP [NO SUITABLE EXOTICS EITHER 3WHG JALLOC 3,RET 3WR# JWRONG 3,RET 3X36 JEXOTIC 3,THEX [J IF EXOTIC,FREE ONE FOUND 3XGQ BRN RET 3Y2B THEX LDX 6 3 3YG2 FJOCA 3,FX2 [FIND JOB BLOCK 3Y^L RTTEST RTON4,3 3^F= BRN NRT [JOB NOT REALTIME : ERROR 3^YW RTON4 LDN 0 1 42DG ADS 0 AEXCO(3) [UPDATE COUNT OF RT PERIPHERALS 42Y6 SDRM LDX 3 6 [DEVICE LIST ADDRESS 43CQ SETALLOC 3 43XB PERON 3 [MARK PERIPHERAL ONLINE 44C2 PUTPERENT AWORK1(2),3 [INSERT ONLINE ENTRY IN PRB 44WL XIT ENDCOM [UP,UP AND AWAY!!! 45B= # 45TW # ONLINE TELEPROCESSOR VIA IPB : CHECK MOPPED OFF AND MARK THE IDF 46*G # 46T6 SK2ONLINEB 47#Q MFREEW CPAR,GPERCON 47SB CALL 6 SPAR [LOOK FOR CONCEP NAME 48#2 BRN WIPB [WHOLE IPB 48RL ACROSS ONLINCL,2 49?= WIPB MFREE CPB,CUNI 49#7 ... LDN 6 0 49*4 ... PARANUMB 5,6 49*^ ... SBN 5 1 49BW ... BZE 5 WIPB2 49CR ... PARANEXT #36,6 49DN ... MFREE CPB,CUNI 49FK ... PARSORT XBRK,GROPE 49GG ... HUNTW 3,CPAR,JSCE 49HC ... BNG 3 NAMP 49J# ...WIPB1 LDX 3 JSCEP(3) 49K9 ... LGEOG 3,5 49L6 ... MFREE CPAR,JSCE 49M3 ... BRN WIPB3 49MY ...WIPB2 NGN 5 1 49NT ...WIPB3 SMO FX2 49PQ ... STO 5 ACOMMUNE1 49QW YIDFUNON XBRK,NAMP,4 49Y4 LDX 6 ACOMMUNE1(2) [DEVICE LIST POINTER 4=5= HLSXONCH XBRK,AWORK1(2),SLHON 4==G LDN 3 0 4?9Q LDX 5 XADEVS(1) [FOR SEEK SUBROUTINE 4?PB SEDEV LDN 1 IPBADDR-IPBL 4#92 REIP LDX 1 IPBL(1) 4#NL #SKI K6ONLINE>99-99 4*8= BZE 1 VAB [GEOERR IF AMOP NOT FOUND 4*MW TXU 6 CPPTR(1) 4B7G BCS REIP [WRONG DEVICE : TRY AGAIN 4BM6 CALL 7 SEEK [LOOK FOR AMXOR/ADEVS BLOCK 4C6Q BRN SDRM [ADEVS MISSING 4CLB WAP CALL 7 WATIN 4D62 BRN WIAG 4DKL OUTPAUSE WAY,SEDEV,,5,WIAG 4F5= BRN WAIT2 [TIME UP : REOUTPUT MESSAGE 4FJW # 4G4G WAS STO 6 ACOMMUNE1(2) 4G8C #SKI IDFMARK8 4G## UNITOFF YBRK 4GD9 #SKI IDFMARK8<1$1 4GJ6 UNITOFF 4GN3 FJOCA 3,2 [FIND CURRENT JOB BLOCK 4GRY LDN 0 1 4GXT SBS 0 AEXCO(3) [TAKE 1 FROM CT OF R.T. PERIPHS 4H3Q BRN XBRK 4HHB WAY STO 6 ACOMMUNE1(2) 4HM? #SKI IDFMARK8 4HR8 YUNITOFF YBRK 4HX5 #SKI IDFMARK8<1$1 4J32 YUNITOFF 4JGL # BREAKIN LABEL 4K2= XBRK COMBRKIN 4KFW # VARIOUS COMMAND ERRORS AND GEORGE ERRORS 4K^G # 4LF6 ZERRORY 4LYQ NAMP LDN 4 0 [ANALYSIS LEVEL 4MDB SPARANOT 1,4 ['*MX0' INTO CPB/CUNI 4MY2 NCA ZERRORX JNCA [NOT CURRENTLY AVAILABLE 4NCL NONAM ZERRORX JNOTCNAME [NOT A VALID CONCEPTUAL NAME 4NX= NRT ZERRORX JNRT [JOB IS NOT REAL-TIME 4P74 SLHON ZERRORX ERHLSONL 4PBW PNREC ZERRORX ERMCH [NOT RECOGNISED BY IDF 4PWG RYERR CLOSE [DIRECTORY OPENDIR'ED 4P^L RYERS 4Q4Q #SKI IDFMARK8 4Q7W IDFOFF YBRK,VAB 4Q?2 #SKI IDFMARK8<1$1 4QB6 IDFOFF VAB 4QTQ ZERRORX JNOTALL [NOT ALLOWED TO USE THIS CONCEPTUAL 4R*B # 4RT2 RGEXX GEOERR 1,CLNFDEF 4S#L VAB GEOERR 1,IDFERROR 4SS= SET GEOERR 1,LONGSET 4S^D #SKI IDFMARK8 4T6L YBRK GEOERR 1,IDFBRKIN 4T?W MENDAREA 20,K100ONLINEB 4TRG #END ^^^^ ...73004211000200000000