(George Source)
Macros used: BXE, BXU, CHEKPRIV, COMBRKIN, COMERRX, ENDCOM, ENRING, FCJOB, FPCACA, FPERENTA, FSHCODE, GETACTX, HUNT2, HUNTW, JV7900, LINKSET, MFREE, MFREEW, MHUNT, MHUNTW, OUTPARAM, PAIR, PARANOT, PARSORTX, PERCON, RELPERENT, ROLPA, RTTEST, SAWCEJX, SEG, SEGENTRY, TESTREP, TRACE
22FL #LIS K0ACCESS>K0COMMAND>K0GREATGEO>K0ALLGEO 22R2 ... SEG ACCESS,867,SECTION CENT 234B ...[ 23*Q ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LIMITED 1982 23M6 ...[ 23YG # THIS SEGMENT DEALS WITH ACCESS COMMANDS WHICH ARE ISSUED BY SPECIAL 242D #UNS AV7900S 244B ( 246# # SYSTEM JOBS CONCERNED WITH SCHEDULING OR ISSUED BY COMMUNICATIONS 248= # MANAGER TO CONNECT TO A VIRTUAL 7900 . IT CHECKS FOR INCORRECT 24=8 ) 24#6 #UNS AV7900S 24B4 #SKI 24D6 # SYSTEM JOBS CONCERNED WITH SCHEDULING. IT CHECKS FOR INCORRECT 24XQ # COMMANDS AND THEN SETS UP A PSEUDO OFF-LINE PERI ACTIVITY WHICH CAN 25CB # ACCESS CERTAIN GEORGE INFORMATION 25X2 # JOBS RUN UNDER :SYSTEM AND :MANAGER AND SYSTEM-STARTED JOBS ARE ABLE 26BL # TO ACCESS ALL THE PASSIVE ROUTINES, I.E. NOT HLSTEMPQ OR SCHEDCONTROL 26W= # - THIS HAS BEEN INTRODUCED TO COVER THE NEEDS OF 'GERONIMO' AND USER'S 27*W # LOGGING SYSTEMS. 27TG # 28*6 # ENTRY POINT 28SQ # 29#B SEGENTRY K1ACCESS,XK1 29S2 2=?L #DEF X=GENIE<1$1*7+1 2=R= #DEF XED=6*X 2=YD #UNS AV7900S 2?5L #DEF XPB=28*X 2?=W #DEF XFR=50*X 2?QG #DEF XFW=51*X 2#2# #DEF XFH=52*X 2#=6 #DEF XTM=#77*X 2#PQ ZERO +0 2*9B XEXT 8HHLSEXT 2*P2 2*T= SINF [TABLE OF PERMISSIBLE INFORMATION 2*^G [PARAMETERS FOR AC COMMAND 2B5Q #111 2B=2 +XFH 2BB= 9HHLSACTIVE 2BGG +10 2BLQ +XFH 2BR2 10HHLSPASSIVE 2BX= +4 2C3G +XED 2C7W 4HHLSQ [ THE TABLE CONSISTS OF TRIPLETS OF 2CMG +4 [ ITEMS. THE 1ST ITEM GIVES THE 2D76 +XED [ LENGTH (IN CHARACTERS) OF THE 3RD 2DLQ 4HJOBQ [ ITEM. THE 2ND ITEM IS THE PER 2F6B +8 [ TYPE PERMITTED. 2FL2 +XFR [BIT #100 OF 1ST ITEM INDICATES 2G5L 8HHLSBLOCK [NON-PASSIVE ROUTINE. 2KH2 +8 2L2L +XFR 2LG= 8HJOBBLOCK 2L^W +8 2MFG +XFR 2M^6 8HINSTPARA 2NDQ #110 2NYB +XFR 2PD2 8HHLSTEMPQ 2PRP +8 2Q7D +XED 2QH7 8HPERILIST 2QWW +10 2RBG +XED 2RW6 10HGEORGECORE 2S5Y #114 2S*Q +XFW 2SKJ 12HSCHEDCONTROL 2SLM #UNS AV7900S 2SMQ ( 2SNT +5 2SPY +XPB 2SR3 5HCOMMS 2SS6 ) 2SS8 ...[ 2SS= ...[ !! ANY NEW ENTRIES MUST GO IN BEFORE LPLIST !! 2SS# ...[ !! BECAUSE OF RESTORE-TIME MACRO LPS !! 2SSB ...[ 2SSD ... SEGENTRY K51ACCESS [MEND POINT FOR MACRO LPS 2SSG ... 0 [MENDED BY LPS ON TO +6, 2SSJ ...[ AND BY LPS OFF TO 0 2SSQ +XFH 2SSX 6HLPLIST 2STB +0 [0 INDICATES THE END OF THE TABLE 2T*2 SLINKS 2TR# PAIR HLSREAD,1 [HLSACTIVE CHANNEL 2W9L PAIR HLSREAD,2 [HLSPASSIVE CHANNEL 2WMY PAIR HLSREAD,15 [ROUTINE TO EXAMINE HLSQ 2X6= PAIR HLSREAD,7 [ROUTINE TO EXAMINE JOBQ 2XJJ PAIR HLSREAD,8 [ROUTINE TO READ NEXT HLSQ BLOCK 2Y2W PAIR HLSREAD,9 [ROUTINE TO READ NEXT JOB BLOCK 2YF8 PAIR HLSREAD,10 [ROUTINE TO READ INSTALLATION PARS. 2YXG PAIR HLSREAD,11 [ROUTINE TO READ FROM TEMP TO HLSQ 2^*S PAIR HLSREAD,12 [ROUTINE TO READ FROM PERIPHERAL LIST 2^S6 PAIR HLSREAD,13 [ROUTINE TO READ GEORGECORE 32=D PAIR HLSREAD,14 [GENERAL SCHEDULING ROUTINES 32=K #UNS AV7900S 32=X PAIR VIPBPERI,1 [VIRTUAL 7900 COMMS(WMC TYPE) CHANNEL 32=^ PAIR FHLIST,1 32?2 #UNS AV7900S 32?3 ( 32?4 # 32?9 # SUBROUTINE TO TEST IF DEVICE TYPE IS PB AND IF TRUE TO ASSUME 32?B # THE CHANNEL IS COMMS AND TO CHECK THAT THE THIRD PARAMETER 32?H # SPECIFIES AN ACCESSABLE VIRTUAL 7900 32?N # IF THIRD PARAMETER IS NOT A VIRTUAL 7900, ERROR "UNIT IS NOT A 32?T # SUITABLE DEVICE" 32#2 # IF THE VIRTUAL 7900 IS ALREADY "INITIALISED" OR IS BEING ACCESSED 32#7 # BY A DIFFERENT JOB, ERROR "UNIT IS ALREADY ALLOCATED" 32## # NOTE IF A PB OF THE SAME UNIT NUMBER IS ALREADY BEING ACCESSED 32#F # IT WILL BE FREED LATER BY MACRO PUTPERENT 32#L # ON ENTRY ACCOMMUNE3 = DEVICE TYPE(IN B3-7) ; X2 = FX2 32#R # AWORK3 WILL BE USED TO STORE THE VIRTUAL 7900 DEVICE LIST POINTER 32#Y # FOR SUBROUTINE VIRTUAL7900 32*5 # LINK IN X6 32*= VTYPEPB 32*C LDCT 4 XPB 32*J BXU 4 ACOMMUNE3(2),(6) [DEVICE TYPE NOT PB 32*P SBX 6 FX1 32*W LDN 3 3 [ANALYSE THE THIRD PARAMETER 32B3 PARSORTX XBREAKIN,3 32B8 ADX 6 FX1 32B* HUNTW 3,CPAR,JSCE 32BG BNG 3 VENDCOM [UNIT NO. PARAMETER MISSING/INVALID 32BM SAWCEJX JSCEB(3),VLOCALUNIT,XJUNITERR,XJUNITERR 32BS VLOCALUNIT 32B^ LDCH 0 JSCEA(3) 32C6 SBN 0 24 32C? BNZ 0 XJUNITERR [UNIT NOT A 7900 32CD JV7900 JSCEP(3),VAV7900 32CK BRN XJUNITERR [UNIT NOT A VIRTUAL 7900 32CQ VAV7900 32CX LDX 3 JSCEP(3) [SET X3 -> VIRTUAL 7900 DEVICE LIST 32D4 STO 3 AWORK3(2) [KEEP FOR VIRTUAL7900 S/R 32D9 LDX 0 JK52H(3) [COUNT OF GEORGE PERI'S 32DB BNZ 0 XJALOC [V7900 IS ALREADY INITIALISED 32DH LDN 0 AVOLPARING(3) 32DN BXE 0 AVOLPARING(3),VTYPEPBEXIT [OLPA RING EMPTY : NOT BEING 32DT [ACCESSED 32F2 LDX 3 AVOLPARING(3) 32F7 SBN 3 BWORKRING 32F# LDX 0 JOBNO(3) [JOB NUMBER OF AN AOLPT ON THE 32FF [OLPA RING 32FL LDX 4 JOBNO(2) [JOB NUMBER OF THIS PROGRAM 32FR BXU 0 4,XJALOC [BEING ACCESSED BY A DIFFERENT JOB 32FY VTYPEPBEXIT 32G5 MFREEW CPAR,JSCE 32G= EXIT 6 0 32GC # 32GJ # SUBROUTINE TO TEST IF DEVICE TYPE IS PB AND IF TRUE TO ASSUME 32GP # THE CHANNEL IS COMMS AND TO : 32GW # 1. INCREMENT COUNT OF REALTIME PERIPHERALS IF REALTIME IS ON 32H3 # 2. RING THE AOLPT TO THE BACK OF THE VIRTUAL 7900 OLPA RING 32H8 # AFTER SETTING ITS CPPTR WITH THE VIRTUAL 7900 DEVICE LIST PTR 32H* # (COMMS CHANNELS ARE PROCESSED IN ORDER OF SETUP) 32HG # ON ENTRY X3 -> THE AOLPT ; X2 = FX2 ; AWORK1 = DEVICE TYPE 32HM # IN B3-8 ; AND IF PB, AWORK3 -> THE VIRTUAL 7900 DEVICE LIST 32HS # EXITS+0 IF DEVICE TYPE IS PB, ELSE EXITS+1 32H^ # LINK IN X7 32J6 VIRTUAL7900 32J? LDCT 4 XTM [SET MASK FOR DEVICE TYPE 32JD ANDX 4 AWORK1(2) [EXTRACT DEVICE TYPE 32JK LDCT 0 XPB 32JQ BXE 0 4,VRTTEST [DEVICE TYPE IS PB 32JX EXIT 7 1 [DEVICE TYPE NOT PB 32K4 VRTTEST 32K9 FCJOB 1,2,,CPA [FIND THIS CPA'S JOB BLOCK 32KB RTTEST VREON,1 [J TO VREON IF RE ON HAS BEEN ISSUED 32KH BRN VRINGOLPA 32KN VREON 32KT LDN 0 1 [UP ITS COUNT OF RE PERIPHERALS BY 1 32L2 ADS 0 AEXCO(1) [THIS COUNT WILL BE DECREMENTED BY 32L7 [RELPER WHEN THE CHANNEL IS RELEASED 32L# VRINGOLPA 32LF LDX 0 AWORK3(2) [VIRTUAL 7900 DEVICE LIST POINTER 32LL STO 0 CPPTR(3) [SET AOLPT'S CPPTR -> THE VIRTUAL 32LR [7900 DEVICE LIST 32LY SMO AWORK3(2) 32M5 LDX 2 AVOLPARING+1 [PTR TO BWORKRING OF THE LAST AOLPT 32M= [ON THE OLPA RING, IF ANY . 32MC ENRING BWORKRING(3),2 [ENRING NEW AOLPT ON THE BACK OF THE 32MJ [VIRTUAL 7900 OLPA RING (AVOLPARING) 32MP EXIT 7 0 [X1=FX1 & X2=FX2 32MW # 32N3 ) 32NW 338G XK1 33N6 #SKI K6ACCESSCOM>499-499 347Q TRACE K7,ACCESS 34MB CHEKPRIV JOB,XEXT(1),NOTPERM,NOTOPEN 3572 NICEJOB 35LL PARANOT 1,ZERO(1) [PASS 1ST PARAMETER AT ANAL LEVEL 0 366= MHUNT 3,CPB,CUNI 36KW NGX 4 ANUM(3) 375G BPZ 4 NO1STP [J IF NO FIRST PARAM. 37K6 PERCON 384Q TESTREP PARERR,PFERR [J IF PERCON FOUND FORMAT ERROR 38JB MHUNTW 2,CPAR,GPERCON 3942 LDX 4 A1(2) 39HL SMO FX2 3=3= STO 4 AWORK1 3=GW LDCT 4 XTM [SET MASK FOR DEVICE TYPE. 3?2G ANDX 4 A1(2) [EXTRACT DEVICE TYPE 3?7N LDCT 5 XFH [CHECK WHETHER FH IS SPECIFIED 3?#W BXE 5 4,P1 [J IF FH 3?G6 LDCT 5 XED [CHECK WHETHER EDS IS SPECIFIED. 3?^Q BXE 5 4,P1 [J IF IT IS EDS 3#FB LDCT 5 XFR [CHECK WHETHER FILE READR. 3#^2 BXE 5 4,P1 [J.IF IT IS 3*DL LDCT 5 XFW [CHECK WHETHER FILE WRITER. 3*G* #UNS AV7900S 3*J4 ( 3*KR BXE 5 4,P1 [J IF FW 3*MG LDCT 5 XPB [CHECK WHETHER PB IS SPECIFIED 3*P9 BXU 5 4,WRONGP [ERROR IF NOT PB EITHER 3*QY ) 3*SM #UNS AV7900S 3*WB #SKI 3*Y= BXU 5 4,WRONGP [ERROR IF NOT ED OR FW 3BCW 3BXG P1 LDX 5 A1(2) [TYPE/UNIT WORD 3CC6 MFREE CPAR,GPERCON 3CWQ STO 5 AWORK2(2) [KEEP FOR PUTPERENT 3DBB PARANOT 2,ZERO(1) [PASS 2ND PARAM AT ANALYSIS LEVEL 0 3DW2 MHUNT 1,CPB,CUNI 3F*L LDX 6 ANUM(1) 3FT= BNG 6 NO2NDP [COMMAND ERROR IF NO 2ND PARAMETER 3G#W BZE 6 NO2NDP [J IF NULL PARAMETER 3GSG ANDN 6 #7777 [NO OF CHARACTERS IN X6 3H#6 LDX 2 FX2 3HRQ LDX 3 FX1 3J?B STO 4 ACOMMUNE3(2) [STO PERTYPE 3JR2 LDX 4 SINF(3) [LOAD CH.CT. FROM TABLE OF PARAMS 3K=L STO 1 ACOMMUNE4(2) [STORE PTR TO CPB/CUNI BLOCK 3KQ= LDN 7 0 [SET X7 TO 0 FOR 1ST POSSIBLE PARAM 3L9W P5 STO 3 ACOMMUNE1(2) [STORE INDEX FOR CHAPTER PARAM TABLE 3LPG STO 4 ACOMMUNE2(2) [STORE CH. CT. OF PARAM IN TABLE 3M96 ANDN 4 #77 [TO GET RID OF 'NON-PASSIVE' MARKER. 3MNQ BXU 4 6,P8 [J IF CH.CTS ARE DIFFERENT 3N8B P6 LDCH 5 SINF+2(3) [READ A CHAR FROM CHAPTER PARAM TABLE 3NN2 LDCH 0 APARA(1) [COMPARE WITH CHAR IN CPB/CUNI BLOCK 3P7L BXU 5 0,P7 [J IF DIF 3PM= BCHX 3 £ [ADVANCE INDEX IN TABLE 3Q6W BCHX 1 £ [ADVANCE INDEX IN CUNI BLOCK 3QLG BCT 4 P6 [COUNT DOWN ON CHARACTERS 3R66 ADN 7 SLINKS [IF PARAMS MATCH X7 SET PTG LINK PAIR 3RKQ LDX 3 ACOMMUNE1(2) 3S5B SMO SINF+1(3) 3SK2 LDCT 5 0 [PERMISSIBLE PERIF TYPE. 3T4L BXU 5 ACOMMUNE3(2),WRNGPR [COMMAND ERROR IF WRONG PERIPHERAL 3TJ= LDX 0 CONTEXT(2) 3W3W BNG 0 P9 [J IF SYSTEM-ISSUED 3WHG # IF :MANAGER OR :SYSTEM OR SYSTEM-STARTED JOB, DISSALLOW HLSTEMPQ 3X36 # AND SCHEDCONTROL:- 3XGQ LDN 0 #100 3Y2B ANDX 0 ACOMMUNE2(2) 3YG2 BNZ 0 NOTPERM [J IF 'NON-PASSIVE' MARKER IS SET. 3Y^L BRN P9 [NO COMMAND ERRORS. J TO OBEY COMMAND 3^F= P7 LDX 3 ACOMMUNE1(2) [RESTORE PTR IN SLINKS TABLE 3^YW LDX 4 ACOMMUNE2(2) [RESTORE CH.CT FOR CURRENT ITEM 428N ANDN 4 #77 42DG LDX 1 ACOMMUNE4(2) [RESTORE PTR TO /CUNI BLOCK 42Y6 P8 ADN 4 11 [ROUND UP,TO GET POINTER 43CQ SRL 4 2 [TO NEXT TABLE ENTRY 43XB ADX 3 4 44C2 LDX 4 SINF(3) [LD COUNT OF CHARS OF NEXT ENTRY 44WL BZE 4 NOMATCH [COMMAND ERROR IF NO MATCHING PARAM 45TW BUX 7 P5 47#Q 47SB P9 [SET UP ACTIVITY BLOCK 47SJ #UNS AV7900S 47SQ ( 47SY CALL 6 VTYPEPB [IF PB, ASSUME COMMS CHANNEL AND 47T6 [DEAL WITH 3RD PARAMETER 47T# ) 47TM LDN 3 #100 47WY ANDX 3 ACOMMUNE2(2) 47Y9 BZE 3 PASSIVE [J IF NOT ACTIVE 47Y* FSHCODE B,XCODEB1 47YF ( 47YK # THE ACTIVE CHANNEL IS NOT TO BE USED ON THE 'B' MACHINE IN A 47YP # SHARED FILESTORE SYSTEM. 47YT # 47Y^ BRN WRONGMACH 47^5 # 47^9 XCODEB1 47^* ) 47^G LDN 3 CONRECSIZE 482R PASSIVE 4885 LDN 4 +AOLPT 48#2 SLL 4 12 48CX LDN 5 AOLPTACLEN [LENGTH OF AOLPT 48HS ADX 5 3 48J4 LDN 6 3 48JS #UNS AV7900S 48K4 LDN 0 12+SLINKS 48K# #UNS AV7900S 48KJ #SKI 48KS LDN 0 11+SLINKS 48L4 BXU 0 7,NOTNIP [J IF NOT NIP 48L# LDN 5 AOLPTLEN+ASERLEN [LENGTH OF OLPA IN NIP CASE 48LJ LDN 6 10 [ATMARK FOR NIP 48LS NOTNIP 48M6 [ CORRECTION FOR B-0818 - CHECK IF SAME AS PREVIOUS 48M8 [ UNIT NO. & IF SO REMOVE OLD ONE 48M= FPCACA 3,2 [FIND PCA 48M# HUNT2 3,APERI,APERIRES 48MB FPERENTA 3,AWORK2(2),PB0818 [JUMP IF NO OLD UNIT NO. PRESENT 48MD RELPERENT AWORK2(2) [ELSE REMOVE ENTRY 48MG PB0818 48MJ [ END OF B-0818 INSERT 48MP GETACTX 4,5,1 [GET OFFLINE PERI ACTIVITY BLOCK 48RL [& MARK AS LONGLOCK BLOCK 49?= LDX 3 BPTR(2) [GET POINTER TO IT 49QW LDX 0 JOBNO(2) [READ JOBNO FROM PCA 4==G STO 0 JOBNO(3) [COPY JOBNO INTO OFF-LINE PERI ACT 4=Q6 ADX 1 7 4?9Q LINKSET 3,0(1) 4?BY LDX 5 GSIGN [MARK CHANNEL OPEN FOR ALLOT 4?J6 ORS 5 ALTMARK(3) 4?R^ #UNS AV7900S 4?WJ ( 4?^7 CALL 7 VIRTUAL7900 [IF PB,PERFORM ADDITIONAL TASKS 4#3Q LDN 6 9 [PB : SET OLPA'S ATMARK = 9 4#6* ) 4#CF STO 6 ATMARK(3) 4#NL # SOME OF HLSREAD CANNOT USE AWORK3 4*8= LDX 0 AWORK1(2) 4*MW STO 0 HLSPTYPE(3) 4B7G LDX 0 GSIGN [SET MARKER => EVENTS TO BE CHAINED 4BM6 STO 0 FRECHADD(3) 4C6Q PUTPEREN AWORK2(2),GSIGN [MARK ALLOCATED IN PRB 4CLB ROLPA [CHAIN AOLPT IN PCA CHAIN 4CRJ #UNS AV7900S 4CYQ VENDCOM [V7900 UNIT NO. PARAMETER MISSING/INV 4D62 WRNGTP [ WRONG PER TYPE 4DKL PFERR [ PERCON FORMAT ERROR 4F5= ENDCOM 4F78 #UNS AV7900S 4F96 ( 4F?4 # 4F*2 XBREAKIN [BREAKIN EVENT DURING PARSORT OF THE 4FBY [VIRTUAL 7900 UNIT NUMBER PARAMETER 4FDW COMBRKIN 4FGS ) 4FJW # COMMAND ERROR REPORTING: 4G4G XERRORTAB1 +INCDUMP [A 4GJ6 +JPARMIS [B 4H3Q +JPARMIS [C 4HHB +JPNAL [D 4J32 +JALOC [E 4JGL +IMPER [F 4JMS #UNS AV7900S 4JT2 +JUNITERR [G 4JWQ #UNS FSHB 4JYG +FSHACCESSER [H 4K2= XERRORTAB2 -1 [A 4KFW +APER [B 4K^G +JSETP3 [C 4LF6 -1 [D 4LYQ -1 [E 4MDB -1 [F 4MKJ #UNS AV7900S 4MQQ -1 [G 4MSG #UNS FSHB 4MW= -1 [H 4MY2 XERRORENT 4NCL NOTPERM CALL 1 XER [A 'NOT FOR GENERAL USE' 4NX= NO1STP CALL 1 XER [B NO FIRST PARAM 4PBW NO2NDP CALL 1 XER [C NO SECOND PARAM 4PWG WRONGP CALL 1 XER [D PER NOT *ED, *FR OR *FW 4Q3N #UNS AV7900S 4Q8W [ OR *FH OR *PB 4QB6 PERROR CALL 1 XER [E PER IN USE 4QTQ NOMATCH 4R*B WRNGPR CALL 1 XER [F NOT SCHEDULING INF 4RBJ #UNS AV7900S 4RCQ ( 4RDY P3ERR CALL 1 XER [G UNIT %A IS NOT A SUITABLE DEVICE 4RF4 ) 4RF8 #UNS FSHB 4RF# ( 4RFD WRONGMACH 4RFJ CALL 1 XER [H COMMAND NOT FOR USE ON 'B' MACHINE 4RFN ) 4RFS #UNS AV7900S 4RFY ( 4RG6 XJUNITERR [PARAMETER 3 IS NOT A VIRTUAL 7900 4RH# LDX 5 JSCEQ(3) [GET PARAMETER LENGTH 4RJG ANDN 5 #7777 4RKN OUTPARAM 5,JSCER,CPAR,JSCE [OUTPUT PERIPHERAL DESCRIPTION PARAM 4RLW BRN P3ERR 4RN4 XJALOC [UNIT %C IS ALREADY ALLOCATED 4RP= PARANOT 3,ZERO(1) [PASS 3RD PARAM AT ANALYSIS LEVEL 0 4RQD BRN PERROR 4RRL ) 4RT2 XER SBN 1 XERRORENT+1 4S#L LDX 0 XERRORTAB1(1) 4SS= LDX 1 XERRORTAB2(1) 4T?W COMERRX 0,1 4TRG 4WQQ #END ^^^^ ...62246501000100000000