(George Source)
Macros used: ACROSS, BXE, CAPCA, CHECKA, CHECKB, CHECKFLAG, CHECKSTATE, CHECKXOT, CLDRM, COOR3, DISENGPER, EVENTFIN, FDRMOFF, FDRMON, FINDTP, FINMOVE, FJOPCA, FPERENT, FREECORE, HUNT, ILLEGAL, J151L, J152L, JBUSY, JDRMABLE, LGEOG, LPROP, MACCS, MENDAREA, MHUNTW, MONOUT, MTPTR, OUTBLOCN, OUTPACK, OUTPAR, PMODES, RELPERENT, REPMON, RUNPROG, SEG, SEGENTRY, SETDRM, STEPBAC, TESTMON, TESTPUC, TRACE, UNPLUG
22FL #LIS K0OPCA>K0OBJPROG>K0ALLGEO>K0GREATGEO 22RB ... SEG OPCA,867,SECTION CENT,,G400 2357 ...[ 2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23#^ ...[ 23HF ...#UNS G400 23P^ ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK 2 23YG SEGENTRY K1OPCA,XENT1 24D6 # THIS SEGMENT IS ENTERED TO DECODE AN EVENT IN AN OBJECT PROGRAM 24XQ # IT EXAMINES EVENT1,2,3 & JUMPS OR SWITCHES TO APPROPRIATE ROUTINE 25CB # E0ENT1 POINTER TO CURRENT MEL 25X2 # EVENT2 N(M) AFTER ALL MODIFICATION(EXTRACODE EVENTS ONLY) 26BL # EVENT3 X OR REPLACED X (15 GROUP EXTRACODES ONLY) 26W= # EVENT4 CONTENTS OF THE 1ST WORD OF THE PERIPHERAL CONTROL AREA 27*W # (157 EXTRA CODE ONLY) 27TG # EVENT5 COPY OF THE ORIGINAL ORDER(EXTRACODE EVENTS ONLY) 28*6 # EVENT6 ERROR CODES: 28SQ # 29#B # 0=EXTRACODE NOT IMPLEMENTED BY EXEC 29S2 # 1=INOPERABLE PERIPHERAL 2=?L # 2=PAGE REQUEST(GEORGE ERROR-PAGETURN SHOULD BE WOKEN UP) 2=R= # 3=FLOATING POINT UNDERFLOW 2?=W # 4=FLOATING POINT OVERFLOW 2?QG # 5=PARITY FAILURE 2#=6 # 6=HARDWARE ILLEGAL 2#JH ...# 8=MEMBERS MILL TIMER OVERFLOWED 2#WY ...# 7,9 UPWARDS=VARIOUS ILLEGAL EXTRACODES 2*9B # PRESETS 2*P2 QMASK #77777700 2B8L QMASK1 #60000000 2BN= QMASK2 #07700000 2C7W QMASK3 #77777 2CCN ...QMAXPOS #37777777 [MAX. POSITIVE NUMBER IN WORD 2CMG XCHOBEY +CHOBEY 2D76 XK61 +K61 2DLQ # ENTRY POINTS 2F6B # 2FL2 # THE STANDARD ENTRY POINT FOR THE PCA 2G5L XENT1 2GK= #SKIP K6OPCA>99-99 2H4W ( 2HJG TRACE EVENT1(2),OPCEVEN1 2J46 TRACE EVENT6(2),OPCEVEN6 2JHQ ) 2L2L #SKIP K6OPCA>999-999 2LG= ( 2L^W HUNT 3,AOBJPROG 2M3? ...#UNS CA1D 2M4N ...( 2M65 ... ADX 3 CA1D 2M7G ... TRACE 9(3),OBJWORD9 2M8X ... TRACE 8(3),OBJWORD8 2M=# ... SBX 3 CA1D 2M?P ...) 2M*6 ...#UNS CA1D 2MBH ...#SKI 2MCY ...( 2MFG TRACE A1D+9(3),OBJWORD9 2M^6 TRACE A1D+8(3),OBJWORD8 2N8Y ...) 2NDQ ) 2PD2 TESTPUC ,XPUC 2PXL BRN XNPUC [ J IF NON PUC 2QC= XPUC LDX 3 EVENT6(2) [ERROR CODE 2QWW BZE 3 XPEX [J IF PUC EXTRACODE 2RBG LDCT 5 #500 [PUC ILLEGAL -B0/2 2RW6 CALL 6 XTPFN [FOR TP WD 31 2S*Q MACCS ,FX2 2STB BRN X31ST 2T*2 XPEX 2TSL LDX 3 EVENT5(2) [COPY OF EXTRACODE 2W#= SLC 3 10 [ISOLATE FUNCTION AND 2WRW ANDN 3 #77 [SAVE L.S. 6 BITS 2X?G STO 3 7 [REMBER LEAST SIG 6 BITS 2XR6 SBN 3 #65 2Y=Q BNZ 3 XPEX1 [J IF NOT GIVE 2YQB LDX 3 EVENT2(2) [ENTER TP IF 2^=2 SBN 3 3 [GIVE/3 2^PL BZE 3 XPEX1 329= SBN 3 1 [GIVE/4 32NW BZE 3 XPEX1 338G SBN 3 1 [GIVE 5 33N6 BZE 3 XPEX1 [OR 347Q SBN 3 5 [GIVE 10 34MB BZE 3 XPEX1 [OR 3572 SBN 3 2 [GIVE 12 35LL BZE 3 XPEX1 366= SBN 3 4 36KW BNG 3 XGIVE [REPORT PERM XCODES TO TP 375G XPEX1 CALL 6 XTPFN 37K6 LDX 3 EVENT2(2) 384Q SMO 4 [SET TP WD 5 TO 38JB STO 3 5 [ N(M) OF XCOD 3942 LDX 3 EVENT5(2) [COPY OF EXTRA CODE 39HL SLC 3 3 3=3= ANDN 3 7 [SET TP WD 4 3=GW SMO 4 [TO X OF 3?2G STO 3 4 [ XCOD 3?G6 PMODES 3 [PICK UP PUC MODES 3?^Q ANDN 3 #50 3#FB BZE 3 XP6 3#^2 LDCT 3 #177 [IF EBM OR 22 AM 3*DL BRN XP6A [ISOLATE B2-23 OF PUC ONR 3*S* ...XP6 LDX 3 QMASK1(1) 3B84 ... ORX 3 QMASK3(1) 3BHR ...XP6A 3BXG MACCS ,FX2 3CC6 SMO 0 3CWQ LDX 5 8 3DBB ANDX 5 3 3DW2 SMO 4 [STORE ISOLATE OF PUC ONR 3F*L STO 5 6 [IN TP WD 6. 3FT= SMO 7 3G#W LDN 5 0 3GSG SMO 4 3H#6 DCH 5 31 3HRQ LDCT 5 #600 [SET B0/1 FOR PUC XCOD IN TP WD 31 3J?B X31ST SMO 4 3JR2 ORS 5 31 3K=L STEPBAC 0 3KQ= EVENTFIN 3L9W XTPFN FINDTP ,4 [FIND TP X0 3LPG MACCS ,4,4 [ADDRESS 3M96 EXIT 6 0 3MNQ XNPUC 3N8B LDX 0 EVENT6(2) 3N=^ ...[ 3N*J ...#UNS ADUALDME 3ND7 ... SBN 0 10 3NGQ ...#UNS ADUALDME 3NK* ...#SKI 3NN2 ... SBN 0 9 3NXS ...[ 3P7L BPZ 0 XILL [ILLEGAL EXTRACODE 3PM= SMO EVENT6(2) 3Q6W BRN TABERR 3QLG TABERR 3R66 BRN XTRACOD [XTRAC NOT IMPLEMENTED BY EXEC 3RKQ BRN XGEOG [INOPERABLE PERIPHERAL 3S5B BRN (GEOERR) 3SK2 BRN XILL1 [FLOATING POINT:UNDERFLOW 3T4L BRN XILL1 [ :OVERFLOW 3TJ= BRN XILLPF [PARITY FAILURE 3W3W BRN XILL1 [HARDWARE ILLEGAL 3WHG BRN XILL [ILLEGAL EXTRACODE 3WJ6 ...#UNS ADUALDME 3WJQ ...( 3WKB ... BRN XMTO 3WL2 ... BRN XILLOCP 3WLL ...XMTO 3WM= ...) 3WMY ...# OTHERWISE,MEMBER MILL TIMER OVERFLOW( E.G. LOOPING PROGRAM HIGHER 3WQ7 ...# PRIORITY THAN GEORGE) 3WSB ...# WILL ONLY RE-ENTER FROM UNPLUG IF NOT TIME UP(TO DO RUNPROG) 3WSD ...# CORRECTION FOR B8250 3WSG ...# (EXEC NOTICES MILL TIMER OVERFLOW, INCREMENTS WORD 39, 3WSJ ...# LEAVES ONLY REMAINDER IN MEL, HENCE LITTLE CHANCE OF 3WSL ...# TIME UP) 3WSN ...# SO CONVERT OVERFLOW AND ADJUST VARIOUS TIMERS 3WSQ ... LDX 5 QMAXPOS(1) [MAXIMUM POSITIVE NUMBER IN WORD 3WSS ... DVS 4 BEATTIME [CONVERT TO MILLISECONDS 3WSW ... LDN 6 AFW1 3WSY ... ADX 6 FX2 [X6 PTS TO 1ST MEL IN PCA 3WT2 ... LDX 7 EVENT1(2) [X7 PTS TO MEL WHICH OVERFLOWED TIME 3WT4 ... SBX 7 6 [X7 NOW PTS TO THISMEL,RELATIVE 3WT6 ... [TO FIRST 3WT8 ... SMO 7 3WT= ... ADS 4 ATM1(2) [ADD REMAINDER FROM CONVERSION TO 3WT# ... [WHAT EXEC LEFT IN TIMER 3WTB ... SMO 7 3WTD ... LDX 6 ARM1(2) [PICK UP MEMBER NUMBER 3WTG ... SRL 6 18 3WTJ ... SMO 6 3WTL ... ADS 5 ATU1(2) [ADD MILLISECONDS TO TIME USED THIS 3WTN ... [MILL SCHEDULING PERIOD 3WTQ ... FJOPCA 3,2 [FIND JOB BLOCK 3WTS ... LDN 4 0 3WTW ... ADSC 5 HCLOCKTIME+1(3) [ADD TO TIME CLOCKED BY PROGRAM 3WTY ... ADS 4 HCLOCKTIME(3) 3WW2 ... ADSC 5 GPROGTIME+1 [ADD TO TOTAL OBJECT PROGRAM TIME 3WW4 ... ADS 4 GPROGTIME 3WW6 ... ADSC 5 HTIMEJ+1(3) [ADD TO JOB TIMER 3WW8 ... ADS 4 HTIMEJ(3) 3WW= ... SBSC 5 APROGTIME+1(3) [SUBTRACT FROM TIME LEFT FOR PROG. 3WW# ... SBS 4 APROGTIME(3) 3WWB ... ADS 5 HTIMES(3) [ADD TO SLOT TIME USED 3WWK ... UNPLUG 3WYS ... RUNPROG 3X36 XTRACOD 3XGQ #SKI K6OPCA>99-99 3Y2B ( 3YG2 TRACE EVENT2(2),OPCEVEN2 3Y^L TRACE EVENT5(2),OPCEVEN5 3^F= ) 3^YW LDX 3 EVENT5(2) [COPY OF EXTRACODE 42DG SLC 3 10 [GET FUNCTION BITS 42Y6 ANDN 3 #177 43CQ SBN 3 #150 43XB SMO 3 [USE AS MODIFIER 44C2 BRN XTABLE 44WL # EXTRACODE SWITCH TABLE 45B= XTABLE 45TW BRN XSUSBY 46*G BRN XREL 46T6 BRN XDIS 47#Q BRN XISBY 47SB BRN XCONT 48#2 BRN XSUSDP 48RL BRN XALLOT 49?= BRN XPERI 49QW BRN XSDDTY 4==G BRN XSDD 4=Q6 BRN XSUSMA 4?9Q BRN XAUTO 4?PB BRN XSUSAR 4#92 BRN XGIVE 4#NL BRN XRQSLP 4*8= BRN XTPINS 4*MW #REP 8 4B7G BRN XGEO 4BM6 # ACROSS TO DISEVENT TO DEAL WITH DISENGAGED PERIPHERAL 4C6Q XGEOG ACROSS DISEVENT,1 4CLB # HARDWARE ILLEGAL:ENTER ILLEGAL ROUTINE WITH NO MESSAGE SPECIFIED 4D62 XILL1 4DKL # ILLEGAL EXTRACODE 4F5= XILL 4FJW UNPLUG 4G4G ILLEGAL 4GJ6 # PARITY FAILURE 4H3Q XILLPF 4HHB UNPLUG 2 4HLM ...# OUTPUT CORE PARITY FAIL TO JL & CL 4HMQ ... LDX 4 EVENT7(2) 4HNT ... ADX 4 GEODATUM 4HPY ... LDX 5 EVENT5(2) 4HR3 ... OUTBLOCN 5 4HS6 ... OUTPAR TIMENOW 4HT9 ... OUTPACK 4,1,OCTA 4HW# ... OUTPACK 5,1,OCTB 4HXC ... MONOUT JLCPAR 4H^K ...# OUTPUT PARITY FAIL TO OBJECT PROGRAM 4J32 ILLEGAL PARFAIL 4J45 ...#UNS ADUALDME 4J58 ...( 4J6? ...XILLOCP 4J7B ... UNPLUG 2 4J8F ... OUTBLOCN 10 4J9J ... FJOPCA 3,2,N 4J=M ... OUTPACK JUSER(3),3,USERNAME 4J?Q ... FJOPCA 3,2,N 4J#T ... OUTPACK JNAME(3),3,JOBNAME 4J*Y ... OUTPACK EVENT7(2),1,NUMA 4JC3 ... MONOUT JPROGFAIL 4JD6 ... ILLEGAL PROCFAIL 4JF9 ...) 4JGL # FURTHER DECODING OF EXTRACODES 4K2= XSDDTY [160 GROUP 4KFW CALL 4 XCHECK 4K^G ACROSS OPCAXCOD,1 4LF6 XSDD [161 GROUP 4LYQ CALL 4 XCHECK 4MDB ACROSS OPCAXCOD,2 4MY2 # EXTRACODES NOT YET DEALT WITH 4NCL XSUSBY 4NX= XISBY 4PBW XSUSDP 4PWG XSUSMA 4QB6 XGEO 4QTQ XILLXC 4R*B XILLINS1 4RT2 UNPLUG 4S#L XILLINS 4SS= ILLEGAL ILLINS 4T?W XSUSAR 4TRG LDX 3 EVENT5(2) 4W?6 SLC 3 3 4WQQ ANDN 3 7 4X=B SBN 3 7 4XQ2 BNZ 3 XILLXC 4Y9L XACTP 4YP= ACROSS TPINS,2 [164/7 ORDER 4^8W XTPINS 574B ACROSS TPINS,1 [167 ORDER 57J2 XCONT [CONT EXTRACODE 583L ACROSS CONTXCOD,1 58H= # GIVE EXTRACODE 592W XGIVE 5#^S ... LDX 4 EVENT2(2) 5*3Q ... SBN 4 4 5*5N ... BZE 4 XGVE [J IF N(M) = 4 5*7L ... SBN 4 8 5*9J ... BZE 4 XGVE [J IF N(M) = 12 5*?G ... ACROSS GIVEA,1 5**D ...XGVE 5*CG ACROSS GIVE,1 5*X6 XRQSLP 5BBQ LDX 4 EVENT5(2) 5BWB SRL 4 21 5CB2 BZE 4 S1 5CTL SBN 4 1 5D*= BNZ 4 XILLXC 5DSW ACROSS REQESLIP,1 [WRITE REQUEST SLIP 5F#G S1 [ENTRY FOR RRQ (X=0) 5FS6 LDN 6 16 5G?Q CHECKB EVENT2(2),6,XRESVIOL,,W 5GRB MHUNTW 3,AOBRES [FIND REQ. SLIP 5H?2 LDN 4 A1(3) [START OF SLIP 5HQL # MOVE REQUEST SLIP TO PROGRAM AREA 5J== LDX 5 EVENT2(2) 5JPW FINMOVE 2,5,4,6,HLOCK1 5K9G EVENTFIN 5KP6 # 5L8Q # THIS SECTION DEALS WITH AUTO N(M) NON ZERO(ESTABLISH MEMBER) 5LNB # 5M82 # THE MEMBER MUST EXIST AND NOT ALREADY ESTABLISHED 5MML XAUTO LDX 5 EVENT5(2) 5N7= BNG 5 XAIL1 [ERROR IF MEMBER NO > 3 5NLW SLC 5 3 5P6G ANDN 5 7 [MEMBR TO BE ESTAOLISHED 5PL6 LDX 3 5 [KEEP IT IN X3 5Q5Q MPY 5 XK61(1) [GET PTR TO RELEVANT SUSPENSION WORD 5QKB SMO 6 5R52 LDX 4 ASU1(2) 5RJL BNG 4 XAIL1 [ERROR IF MEMBER NONEXISTENT 5S4= SLL 4 1 5SHW BPZ 4 XAIL2 [ERROR IF MEMBER ALREADY ESTABLISHED 5T3G LDX 4 EVENT2(2) [ENTRY FOR NEW MEMBER 5TH6 CHECKA 4,,XRESVIOL,,XCHOBEY(1) 5W2Q LDN 1 2(3) 5WGB SLL 1 4 [ADR OF ACC DUMP FOR NEW MEMBER 5X22 MACCS ,2 5XFL ADX 1 0 5X^= STO 4 8(1) [WORD 8 OF NEW MEMBER 5YDW LDCT 4 #200 5YYG SMO 6 5^D6 ERS 4 ASU1(2) [CLEAR B1 IN SUSPENSION WORD 5^XQ LDCT 5 #600 62CB ORS 5 2 [SET UP CHARACTER MODIFIER 62X2 LDCH 1 ALMT(2) [MODES OF CURRENT MEMBER 63BL SMO 6 [TRANSFER MODES TO ESTABLISHED 63W= DCH 1 ARM1(2) [MEMBER 64*W EVENTFIN 64TG XAIL1 UNPLUG 65*6 ILLEGAL AUTO 65SQ XAIL2 UNPLUG 66#B ILLEGAL AUTO1 66S2 # 67?L XRESVIOL 67R= UNPLUG 68=W ILLEGAL RESVIOL 68QG # 69=6 # CHECK VALUE OF X 69PQ XCHECK 6=9B LDX 3 EVENT5(2) [COPY OF EXTRACODE 6=P2 SLC 3 3 6?8L ANDN 3 7 6?N= SBN 3 3 6#7W BPZ 3 XILLXC 6#MG EXIT 4 0 6*76 # THIS DEALS WITH THE PERI EXTRACODE 6*LQ Q4 +4 [LENGTH OF CONTROL AREA 6B6B XMT +5 [MAG TAPE TYPE 6BL2 XED +6 [EDS TYPE 6C5L XFD +13 [FDS TYPE 6CK= XMCF +7 6D4W XTYPE60 +60 [TYPE 60 6DJG XMX +11 6F46 XIT +10 6FHQ XGD +21 6G3B XID +14 6GH2 XIPB +24 6H2L XIPC +28 6HG= XMOD #1000 6HL7 ...XOMODA #200 6HQ4 ...XOMODE #400 6H^W TABA [BRANCHES/MONITOR TYPES FOR UNALLOC M 6JFG #HAL ZA3,0 [ MODE #000 6J^6 #HAL WN8,BBOPEN [ #100 6KDQ #HAL WN8,BBOPEN [ #200 6KYB #HAL WN8,BBOPEN [ #300 6LD2 #HAL WN11,BBOPEN [ #400 6LXL #HAL ZA3,0 [ #500 6MC= #HAL WN10,BBOPEN [ #600 6MWW #HAL ZA3,0 [ #700 6NBG # 6NW6 TABB1 [BRANCHES/MONITOR TYPES FOR ALLOC MT 6P*Q #HAL WN5,BBCLOSE [ MODE #1007 6PTB TABB2 6Q*2 #HAL WN6,BBCLOSE [ #1000 6QSL TABB3 6R#= #HAL WN9,BBRENAME [ #500 6RRW # 6S?G [BRANCHES/MONITOR TYPES FOR UNALLOC 6SR6 [ ED/FD/MC 6T=Q TABC1 6TQB #HAL WM1,BBOPEN [MODES #100 #200 #300 #400 6W=2 TABC2 6WPL #HAL WM3,BBOPEN [MODE #600 6WWS ...TABC3 6X42 ...#HAL WM5,BBOPEN [MODES #1600 #1700 6X9= WMX #71777 6XF4 ...XEDC #00600000 6XNW # THIS SECTION DEALS WITH A PERI 6Y8G # PROVIDED THE FIRST FOUR WORDS OF THE CONTROL AREA ARE WITHIN 6YN6 # RESERVATIONS IT MAY BE ASSUMED THAT THE PERI IS ON AN UNALLOCATED 6^7Q # OR ONLINE DEVICE SINCE PERIS ON OFFLINE DEVICES ARE NOTIFIED TO 6^MB # AOLPT. 7272 # THE TYPE & MODE ARE EXAMINED & IF THE PERI SHOULD BE DEALT WITH 72LL # BY GEORGE THE APPROPRIATE ROUTINE IS ENTERED 736= # OTHERWISE THE'ILLEGAL'ROUTINE IS ENTERED WITH NO MESSAGE SPECIFIED 73KW # SO THAT IT WILL TRY & FIND OUT WHAT IS WRONG 745G # IT WOULD BE AN IDEA IF THIS SEGMENT SENT THE MESSAGE'UNALLOCATED 74K6 # X%A'IF THE DEVICE IS NOT ALLOCATED & IN FACT THIS IS DONE IN THE 754Q # CASE OF EDS-HOWEVER FOR THE TIME BEING THIS WILL BE LEFT TO THE 75JB # ILLEGAL ROUTINE. 7642 XPERI 76HL CHECKB EVENT2(2),Q4(1),ZA2,,W,,,,K1OPCA 773= LDX 5 EVENT4(2) [1ST WORD OF CONTROL AREA 77GW #SKI K6OPCA>99-99 782G TRACE 5,PERIAREA 78G6 LDX 6 EVENT3(2) [UNIT NO 79FB LDCT 4 #377 79^2 ANDX 4 5 [TYPE IN X4 7=3K ... SEGENTRY K90OPCA 7=68 ... ANDN 6 #77 [FOR MANYDA SPECIAL 7=8R ... BXE 4 XEDC(1),TYPE6 7=?B ... ANDN 6 #77 7=*^ ...TYPE6 7=DL STO 4 GEN6 [REMEMBER IT 7=Y= ORX 4 6 [TYPE/UNIT NO IN X4 7?CW CALL 7 XFPERENT 7?XG SMO FX2 7#C6 STO 2 AWORK2 7#WQ BNG 2 ZA5 [J IF UNALLOCATED 7*BB LDX 2 1(2) 7*W2 ANDX 2 BITS22LS [PTR TO DEVICE LIST 7B*L SMO FX2 7BT= STO 2 AWORK4 7C#W CHECKFLAG 2,ZNFW [J IF NOT FLAGWAVER 7CSG BRN XRELP 7D#6 ZNFW 7DRQ CHECKXOT 2,ZA5 [J IF NOT EXOTIC 7F?B J151L 2,ZA2 [I-LEGAL IF REL ALLOWED 7FR2 BRN XRELP 7G=L ZA5 7GQ= LDX 2 FX2 7H9W LDX 7 GEN6 [TYPE 7HPG SLC 7 9 7J96 TXU 7 XIPC(1) 7JNQ BCC PCI1 [J IF IPC 7K8B # AT THIS STAGE WE SWITCH ON TYPE 7KN2 # NOTE THAT X4 IS IN THE SAME FORMAT AS THE RELPERENT REPLY 7L7L # X5-TYPE/MODE WORD,X6-UNIT NR,X7-TYPE 7L#S ... TXU 7 XMT(1) [JUMP IF MAG TAPE 7LG2 ... BCC XADRIAN 7LM= UNPLUG 7M6W TXU 7 XIPB(1) 7MLG BCC XRELP 7P5B TXU 7 XED(1) [JUMP IF EDS 7PK2 BCC XANDY 7Q4L TXU 7 XFD(1) [JUMP IF FDS 7QJ= BCC XANDY 7R3W TXU 7 XMCF(1) 7RHG BCC XANDY 7S36 TXU 7 XTYPE60(1) [TYPE 60-JUMP TO DEAL 7SGQ BCS ZA3 [WITH ILLEGAL 7T2B ANDN 5 #77 7TG2 SBN 5 #73 7T^L BNG 5 XPROGISH 7WF= SBN 5 2 7WYW BPZ 5 XBEXT 7XDG ACROSS MEXTSJ,1 7XY6 XBEXT 7YCQ ACROSS BEXTSJ,1 7YXB XPROGISH 7^C2 ACROSS PROGISH,1 7^J8 ...PCI1 LDX 3 QMASK3(1) 7^PB ... ANDX 3 5 7^R5 ... TXU 3 XOMODA(1) 7^SS ... BCC PCI2 [J IF OPEN MODE #200 7^WJ ... TXU 3 XOMODE(1) 8222 ... BCS PC1 [JUMP IF NOT OPEN MODE #400 825D ...PCI2 828Y ... LDN 1 BBOPEN 82B= CALL 3 ZMONITOR 82TW PC1 ACROSS IPCOPENA,1 83*G ZA2 UNPLUG 83T6 ZA3 ILLEGAL 84#Q XADRIAN 84SB LDX 0 AWORK2(2) 85#2 BPZ 0 WN1 85HS ... UNPLUG 85RL LDX 0 5 86?= ANDN 0 #1077 [MODE ILLEGAL IF NOT #000 #100 #200 86QW BNZ 0 ZA3 [ #300 #400 #500 #600 #700-J IF ILLEG 87=G LDX 0 5 [ (#000,#500,#700 ILLEG BUT DETECTED 87Q6 SRL 0 6 [ LATER) 889Q ANDN 0 7 88PB SMO 0 8992 LDX 3 TABA(1) [GET BRANCH/MONTRG TYPE ACCORDING TO 89NL BRN TMON [ MODE & J TO TEST FOR MONITORING 8=8= WN1 8=9S ... LDX 0 5 8=?B ... ANDN 0 #1777 [MODE 8=#Y ...[ IF MODE 1 (WRITE) OR 5 (WRITE TAPE MARK) IN DIRECT 8=BG ...[ RESPONSE MODE,DON'T UNPLUG PROGRAM 8=D4 ... SBN 0 1 8=FL ... BZE 0 WN12 8=H8 ... SBN 0 4 8=JQ ... BZE 0 WN12 8=L# ... UNPLUG 8=MW LDX 0 5 8?7G LDX 5 AWORK4(2) 8?M6 ANDN 0 #1777 [MODE 8#6Q SBN 0 4 8#LB BZE 0 WN2 8*62 SBN 0 2 8*KL BZE 0 WN3 [J IF MODE 6 -SKIP BACKWARD 8B5= SBN 0 1 8BJW BZE 0 WN4 [J IF MODE 7 -REWIND 8C4G SBN 0 #1000 8CJ6 BZE 0 WN5X [J IF MODE #1007 8D3Q ADN 0 7 8DHB BZE 0 WN6X [J IF MODE #1000 8F32 ADN 0 #300 8FGL BZE 0 WN9X [J IF MODE #500 8G2= BRN ZA3 [J TO REPORT ILLEGAL 8GFW WN2 ACROSS OLMTB,7 8G^G WN3 ACROSS OLMTB,5 8HF6 WN4 ACROSS OLMTB,3 8HYQ WN5 ACROSS OLMTB,11 8JDB WN6 ACROSS OLMTB,9 8JY2 WN8 ACROSS OLMTC,1 8KCL WN9 ACROSS OLMTC,2 8KX= WN10 ACROSS OLMTC,3 8L9M ...WN11 ACROSS GETONA,1 8LJ4 ...WN12 LDX 5 AWORK4(2) 8LP= ... ACROSS OLMTE,3 8LWG WN5X LDX 3 TABB1(1) 8MB6 BRN TMON 8MTQ WN6X LDX 3 TABB2(1) 8N*B BRN TMON 8NT2 WN9X LDX 3 TABB3(1) 8P#L BRN TMON 8PS= XANDY 8Q?W LDX 0 5 8QRG ANDX 0 WMX(1) [REMOVE ADDITIVE BITS FROM MODE 8R?6 LDN 3 4 8RQQ WM2 SBN 0 #100 8S=B BZE 0 WM1X [J IF MODES #100 #200 #300 #400 8SQ2 BCT 3 WM2 8T9L SBN 0 #200 8TP= BZE 0 WM3X [J IF OPEN SCRATCH(#600) 8W8W SBN 0 #400 8WNG ... BZE 0 WM1X [JUMP IF CREATE (MODE #1200) 8XMQ SBN 0 #400 [MODE #1600 8Y7B ... BZE 0 WM5X 8YM2 SBN 0 #100 8Y^C ... BZE 0 WM5X [MODE #1700 8^?S ... [OTHERWISE UNALLOCATED CHANNEL 8^L= BRN UNALLOC 925W # 92KG WM1 ACROSS SOUP,2 9356 WM3 ACROSS SCRATCH,1 93JQ WM5 ACROSS SQOPEN,1 944B WM1X LDX 3 TABC1(1) 94J2 BRN TMON 953L WM3X LDX 3 TABC2(1) 95H= BRN TMON 95ND ...WM5X LDX 3 TABC3(1) 95TL ... BRN TMON 962W XRELP ANDN 5 #1777 [ISOLATE MODE 96GG TXU 5 XMOD(1) [#1000 IS ONLY VALID MODE 9726 BCS ZA2 97FQ BRN ZREL2 97^B # 98F2 TMON [ENTRY WITH B0-11 OF X3 ADDR TO J TO IF NO MNTRG 98YL [ B12-23 X3 MNTRG TYPE 99D= [ X4=TYPE/UNIT NO OF PERIPHERAL X2=FX2 99XW LDX 1 3 9=CG ANDN 1 #7777 [MONITORING TYPE 9=X6 SRL 3 12 [RETURN ADDRESS 9?BQ BZE 1 TMON1 [J IF NO CHECKING 9?WB BRN ZMONITOS [ELSE J TO TEST IF MNTRG REQUD 9#B2 TMON1 ADX 3 FX1 9#TL EXIT 3 0 9**= # 9*SW # THIS SECTION DEALS WITH THE EXTRACODES 'REL','DIS' AND 'ALLOT' 9B#G # ON ENTRY:ANM HOLDS MEMBER NUMBER (B22-3) 9BS6 # EVENT5 HOLDS COPY OF THE EXTRACODE 9C?Q # EVENT2 HOLDS N(M) OF INSTRUCTION 9CRB # THIS SECTION DEALS WITH REL. 9D?2 # THE EXTRACODE IS ILLEGAL IF THE PERIPH IS NOT OF AN ALLOWED TYPE 9DQL # THESE ARE TR,TP,LP,CR,CP,FR,FW,TYPE 60 9F== # IT IS ALSO ILLEGAL IF IT IS NOT ALLOCATED TO 9FPW # OTHERWISE THIS SEGMENT USES'RELPERENT'TO RELEASE THE PERIPH 9G9G XUNALLOC 9GP6 UNPLUG 9H8Q UNALLOC 9HNB OUTPACK 4,1,PERINAME 9J82 ILLEGAL UNALLOC 9JML XREL 9K7= CALL 7 XFTU [FIND TYPE & UNIT NO. 9KLW CALL 7 XFPERENT 9L6G BNG 2 XUNALLOC 9LL6 LDX 3 1(2) 9M5Q BNG 3 ZREL0 9MKB ANDX 3 BITS22LS 9N52 J151L 3,ZREL1 [J IF REL ALLOWED 9NJL ZREL0 9P4= LDX 6 4 9PHW SRL 6 15 [TYPE IN X6 9Q3G SBN 6 5 9QH6 BNG 6 ZREL1 9R2Q SBN 6 45 [JUMP IF FR 9RGB BZE 6 ZREL1 9S22 SBN 6 1 [ OR FW 9S?B ... BZE 6 ZREL1 9SJQ ... SBN 6 1 [ OR FH 9SW6 ... BZE 6 ZREL1 9T7G ... SBN 6 8 [OR UNLESS CI (TYPE 60) 9TDW BNZ 6 XILLINS1 [JUMP IF NOT OF SUITABLE TYPE 9TYG ZREL1 9WD6 #SKI K6OPCA>999-999 9WXQ TRACE 0(2),RELXCOD [PRB ENTRY FOR DEVICE TO BE'REL'ED 9XCB ZREL2 LDN 1 BBREL 9XX2 CALL 3 ZMONITOR 9YBL UNPLUG 9YW= CAPCA [GET TO SUITABLE STATE TO 9^*W RELPERENT 4 9^TG RUNPROG [MAKE PROG RUNNABLE =2*6 # THIS SECTION DEALS WITH DIS. =2SQ # THE EXTRACODE IS ILLEGAL IF THE PERIPH IS NOT OF AN ALLOWED TYPE =3#B # THESE ARE TR,TP,LP,CR,CP,FR,FW. =3S2 # IT IS ALSO ILLEGAL IF IT IS NOT ALLOCATED TO THE P_OG. =4?L # IT CAUSES AN ONLINE DEVICE TO BE DISENGAGED AND AN OFFLINE OUTPUT =4R= # DEVICE TO BE STEPPED ON TO THE NEXT STREAM =5=W XDIS =5QG CALL 7 XFTU [LOOK UP TYPE & UNIT =6=6 CALL 7 XFPERENT =6PQ BNG 2 XUNALLOC =79B LDX 3 1(2) =7P2 BNG 3 ZDIS0 [J IF OFFLINE =88L J152L 3,ZDIS1 =8N= ZDIS0 =97W LDX 0 4 =9MG SRL 0 15 ==76 SBN 0 5 [JUMP IF SLOW PERIPH ==LQ BNG 0 ZDIS1 =?6B SBN 0 45 [ FR =?L2 BZE 0 ZDIS1 =?TS ... SBN 0 1 [ FW =#5L ... BZE 0 ZDIS1 =#*D ... SBN 0 1 [ FH =#K= BNZ 0 XILLINS1 =*4W ZDIS1 =*JG #SKI K6OPCA>999-999 =B46 TRACE 0(2),DISXCOD [PRB ENTRY FOR DEVICE TO BE 'DIS'ED =BHQ LDX 4 0(2) [PICK UP ENTRY =C3B LDN 1 BBDIS =CH2 LDX 6 3 =D2L CALL 3 ZMONITOR =DG= BNG 6 ZDIS3 [J IF OFFLINE =D^W NBUSY JBUSY 6,XBUSY =FFG DISENGPER 6 =F^6 ZDIS3 EVENTFIN =GDQ XBUSY COOR3 #41 =GYB BRN NBUSY =HD2 # THIS SECTION DEALS WITH ALLOT =HXL # 'ALLOT'IS NEVER ILLEGAL INSTEAD A REPLY IS GIVEN IN WORD 9 AS FOLLOWS =JC= # B0=1-PERIPH NOT ALLOCATED =JWW # B9=1-PROPS IMPLEMENTED & B10-17 GIVE PROPS B9=0 NO PROPS =KBG # B18-23-GEOGRAPHIC NUMBER-ZERO IF OFFLINE. =KW6 XALLOT =L*Q CALL 7 XFTU [FIND TYPE & UNIT =LTB CALL 7 XFPERENT [LOOK UP ENTRY IN PRB =M*2 LDCT 5 #400 [SET -VE REPLY IF UNALLOCATED =MSL BNG 2 ZALL3X =N#= LDX 0 1(2) =NRW BPZ 0 NOFL1 [J IF ONLINE =P?G CHECKSTATE 2,0 =PR6 BPZ 0 ZALL3 =Q=Q SMO FX2 =QQB LDX 7 EVENT2 =R=2 SLC 7 11 =RPL ANDN 7 3 [ISOLATE B9,10 OF DN =S9= BZE 7 NOFL [J IF DRM NOT TO BE SET OR UNSET =SNW BCT 7 SETDR [J IF DRM TO BE SET (B9 SET) =T8G FDRMOFF 2 [UNSET DRM (B10 SET) =TN6 BRN NOFL =W7Q SETDR FDRMON 2 [SET DRM =WMB NOFL =X72 STOZ 5 [SET ZERO REPLY =XLL LDX 0 0(2) [OFFLINE-TYPE =Y6= SRL 0 15 =YKW SBN 0 5 =^5G BZE 0 ZALLMT [J IF MAG. TAPE =^K6 SBN 0 4 ?24Q BZE 0 ZALLDR [J IF DRUM ?2JB SBN 0 16 ?342 BZE 0 ZALLHD [J IF HIGH SPEED DRUM ?3HL SBN 0 3 ?43= BNZ 0 ZALL3 [ZERO REPLY IF NOT MT,HSD,DR,IPC ?4GW LDX 3 1(2) [PTR TO OLPA ?52G LDX 5 IPPROPS-CHAINADD(3) [GET PROPERTIES ?5G6 BRN ZALL3 ?5^Q # ?6FB # MAGNETIC TAPE ?6^2 ZALLMT ?7DL SMO 1(2) ?7Y= LDX 0 ATMARK-CHAINADD ?8CW SBN 0 2 ?8XG BNZ 0 ZALLMT1 ?9C6 LDX 3 1(2) ?9WQ SBN 3 CHAINADD ?=BB MTPTR 3,3 ?=W2 BRN NOFL2 ??*L ZALLMT1 ??T= LDN 5 #3000 ?##W BRN ZONL1 [BS 9 13 14 IF MT OFFLINE ?#SG # DRUM TYPE 9 ?*#6 ZALLDR ?*RQ LDX 3 1(2) ?B?B ANDX 3 BITS22LS [PTR TO CHAINADD OF OLPA. ?BR2 LDX 3 CPPTR-CHAINADD(3) [PTR TO DEVICE LIST ?C=L BZE 3 ZALL3 [J IF OFFLINE ?CQ= BRN ZONL ?D9W # HSD TYPE ?DPG ZALLHD ?F96 LDN 5 #400 [HSD MARKER IN REPLY ?FNQ LDX 3 1(2) ?G8B ANDX 3 BITS22LS [PTR TO CHAINADD OF OLPA ?GN2 LDX 3 CPPTR-CHAINADD(3) [PTR TO DEVICE LIST ?H7L BRN ZGEOG ?HM= ZONL ?J6W LPROP 3,5 [GET PROPERTIES ?JLG SLL 5 6 [PROPS.INB9-18 ?K66 ZGEOG LGEOG 3,4 [GET GEOG.NO. ?KKQ ANDN 4 #77 [USE M.S. 6 BITS ?L5B ORX 5 4 [ACCUMULATE REPLIES ?LK2 ZONL1 LDCT 0 1 ?M4L SRL 0 1 ?MJ= ORX 5 0 [SET B9=1 AS PROPS. IMPLEMENTED ?N3W ZALL3 ?NHG MACCS ,FX2,3 [PTR TO MEMBERS X0 ?P36 LDCT 0 #377 ?PGQ ANDX 0 9(3) ?Q2B ORX 5 0 ?QG2 STO 5 9(3) [SET REPLY ?Q^L #SKI K6OPCA>999-999 ?RF= TRACE 5,ALOTXCOD [TRACE REPLY TO ALLOT ?RYW EVENTFIN ?SDG ZALL3X ?SY6 LDX 2 FX2 ?TCQ LDX 0 EVENT2(2) ?TXB ANDN 0 512 ?WC2 BNZ 0 ZALL3 [J IF ALLOT WAS NOT REQUESTING PERIPH ?WWL LDN 1 BBALLOT ?XB= CALL 3 ZMONITOR ?XTW BRN ZALL3 ?Y*G NOFL1 ?YT6 LDX 3 1(2) ?^#Q NOFL2 SMO FX2 ?^SB LDX 7 EVENT2 #2#2 SLC 7 11 #2RL ANDN 7 3 #3?= BZE 7 ZONL [J IF NO REQUEST #3QW BCT 7 SETDRON [J IF DRM TO BE SET #4=G CLDRM 3 [CLEAR DRM #4Q6 BRN ZONL #59Q SETDRON #5PB JDRMABLE 3,SETABLE #692 BRN ZONL #6NL SETABLE #78= SETDRM 3 #7MW BRN ZONL #87G # #8M6 # SUBROUTINES #96Q # #9LB # THIS SUBROUTINE CALCULATES THE TYPE & UNIT NO FOR A 'REL'TYPE XCODE #=62 # FROM EVENT2&3 #=KL # #?5= # X7 HOLDS THE LINK #?JW # ##4G # ON EXIT X4 HOLDS TYPE &UNIT NO.IN B0-8 & B9-23 RESPECTIVELY ##J6 XFTU #*3Q #SKI K6OPCA>99-99 #*HB TRACE EVENT3(2),OPCEVEN3 #B32 LDX 5 EVENT3(2) [UNIT NO #C2= LDN 4 #77 #CFW ANDX 4 EVENT2(2) [TYPE IN X4 #CJF ... SEGENTRY K91OPCA #CM4 ... ANDN 5 #77 #CPM ... BXE 4 XED(1),TYPE6A [FOR MANYDA SPECIAL #CS= ... ANDN 5 #77 #CWT ...TYPE6A #C^G LDN 0 13 #DF6 TXU 4 0 #DYQ BCS XFTU1 #FDB LDN 4 6 [REGARD TYPE 13 AS TYPE 6 #FY2 XFTU1 #GCL SRC 4 9 [TYPE IN BITS 0-9 #GX= ORX 4 5 #HBW #SKI K6OPCA>999-999 #HWG TRACE 4,TYPEUNIT #JB6 EXIT 7 0 #JTQ # THIS S/R SEARCHES THE PRB FOR A PERIPHERAL OF THE TYPE/UNIT NO #K*B # SPECIFIED IN B0-8/B9-23 OF X4 #KT2 # #L#L # ON ENTRY THE PROGRAM MUST BE PLUGGED IN &X2=FX2 #LS= # #M?W # X7 HOLDS THE LINK #MRG # #N?6 # ON EXIT 1)X2->TO THE ENTRY IF FOUND.OTHERWISE X2 IS -VE #NQQ # 2)X3 HOLDS A COUNT OF OFFLINE ENTRIES UP TO AND INCLUDING #P=B # THE ONE FOUND #PQ2 XFPERENT #Q9L LDX 2 APRB(2) #QP= FPERENT 4,2,2,3 #R8W EXIT 7 0 #RNG # #S86 # THIS SUBROUTINE CHECKS IF 'OPEN PERI' TYPE MONITORING IS REQUIRED,AND, #SMQ # IF IT IS,GENERATES THE APPROPRIATE MONITOR EVENT. #T7B # ON ENTRY X4=TYPE/UNIT NO.OF PERIPHERAL,X1=MONITORING TYPE #TM2 # PROGRAM MUST BE PLUGGED IN FOR ZMONITOR,UNPLUGGED FOR ZMONITOS #W6L # LINK IN X3 - ABSOLUTE IF ZMONITOR,REL TO START OF SEG IF ZMONITOS #WL= # ON EXIT:IF NO MNTRG,X0 DESTROYED,X1=FX1,X2=FX2 #X5W # :IF MNTRG,NO EXIT TO CALLING ROUTINE #XKG ZMONITOR #Y56 SBX 3 FX1 #YJQ ORX 1 GSIGN #^4B ZMONITOS #^J2 SMO FX2 *23L STO 1 AWORK1 *2H= ANDX 1 BITS22LS *2JH ...#UNS G400 *2KS ...( *2M5 ... HUNT 2,IUSER,G400BLK *2NB ... BNG 2 XDSK2 [NOT EXIT MR *2PM ... LDX 0 A1(2) *2QY ... SBN 0 5 *2S9 ... BNZ 0 XDSK2 *2TG ... FREECORE 2 *2WR ... BRN XDSK1 [NORMAL PATH *2Y4 ...XDSK2 LDX 2 FX2 *2^* ...) *32W TESTMON ,1,4,ZMON1 *33H ...#UNS G400 *348 ...( *34T ... SMO FX2 *35G ... LDX 1 AWORK1 *367 ... ANDX 1 BITS22LS *36S ... SBN 1 BBOPEN *37F ... BNZ 1 XDSK1 *386 ... LDX 2 FX2 *38R ... LDX 0 4 *39D ... SRL 0 15 [TYPE - X0 *3=5 ... SBN 0 5 *3=Q ... SEGENTRY G400HKMT *3?C ... BRN XDSK3 *3#4 ... BZE 0 XDSK4 [DO HOOK *3#P ...XDSK3 *3*B ... SBN 0 1 *3B3 ... SEGENTRY G400HKDA *3BN ... BRN XDSK1 *3C* ... BNZ 0 XDSK1 [CONTINUE *3D2 ...XDSK4 ACROSS DOMONOP,1 *3DM ...XDSK1 *3F# ...) *3GG ADX 3 FX1 *426 EXIT 3 0 *4FQ ZMON1 LDX 6 4 *4^B LDX 7 EVENT2(2) *5F2 LDXC 5 AWORK1(2) *5YL BCC ZMON2 *6D= UNPLUG *6XW ZMON2 REPMON *7CG # *7X6 # *8BQ # *8WB MENDAREA 25,K100OPCA *9B2 #END ^^^^ ...07117125000500000000