(George Source)
Macros used: ALTLEN, BXE, BXGE, CHAIN, CLOSE, DOWN, FINDPEREC, FMOPG, FREECORE, GEOERR, HUNT2, HUNTMISB, IDFOPEN, IDFWRITE, JWRONG, LAMOP, LGEOG, LINT, LTYPE, MASK, MFREECELL, MGETCELL, MSEARCH, MXB, NEW, SEGENTRY, SETNCORE, TRACE, UP, ZMOPOFF
224M ...#SEG IDFCHK 227# ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 229^ ... 8HIDFCHK 22#L ...#LIS K0IDFCHK>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 22C? ...# 22FY ...# ENTERED AFTER IDFCLEAN AT EMS 22JK ...# K1 CHECKS IDF TO CREATE IDF ITERMID IF ANY 7020S 22M= ...# REMOVE PROP ATTNS IF CONFIG CHANGES MADE 22PX ...# SET UP APERI CONSOLE FROM CONSOLE PROP CHAIN 22SJ ...# K2 CALLED FROM SETIDF TO SET UP DEVICE LISTS 22X9 ...# AND AMOP IPBIN FOR EACH VIRTUAL 7900 IN IDF 22^W ...# K3 CALLED FROM MAKEVCC TO CREATE VIRTUAL 7900 234H ...# K4 CALLED FROM IPBSTART WHEN AN IPB SWITCHED IN 2378 ...# 239T ... SEGENTRY K1IDFCHK,XIDF1 23#G ... SEGENTRY K2IDFCHK,XIDF2 23C7 ... SEGENTRY K3IDFCHK,XIDF3 23FS ... SEGENTRY K4IDFCHK,XIDF4 23JF ...# 23M6 ...MASK #77770000 23PR ... 23SD ...RESCUE [CREATE X2 & X5 READY FOR TEST 23X5 ... LDX 2 FX2 23^Q ... LDX 5 AWORK1(2) [RESCUE IDF FORMATED POINTER 244C ...RESQ LDX 6 5 2474 ... SRL 6 9 249P ... ANDN 6 #7777 24#B ... STO 6 AWORK4(2) 24C3 ... CALL 7 REH 24FN ... ANDN 5 #777 24J* ... ADX 5 2 24M2 ... LDX 2 5 24PM ... LDX 3 0(2) 24S# ... EXIT 4 0 [X3 &X5 SET UP USING AWORK1. 24W^ ...XBATT 24^L ... SMO FX2 254? ... STO 7 ACOMMUNE8 [PRESERVE LINK . 256Y ... SMO FX1 259K ... LDX 0 MASK+1 [LD. MASK 25#= ... SMO 2 25BX ... ANDS 0 BNUMB(3) [REMOVE CLUSTER CONSOLE BIT 25FJ ... SMO 2 25J9 ... LDX 0 BASS(3) 25LW ... BZE 0 XBA1 [J.IF NOT ASSOCIATES TO BE DISCARDED 25PH ... ADN 3 BASS [OTHERWISE FREE ASSOC.CELL 25S8 ... CALL 7 XFCELL 25WT ... SBN 3 BASS [MAKE X3 POINT TO START OF CELL 25^G ...XBA1 SMO 2 2647 ... LDX 3 BATT(3) 266S ... BZE 3 XFIN [LD.PTR. TO ASSOCIATE CELL. 269F ... CALL 5 NX1 [HUNT ASS BLOCK 26#6 ... ADX 2 3 26BR ... LDX 0 BTYPE(2) [LD. CONS.PROP. 26FD ... BNZ 0 XCOPR 26J5 ... BRN XFIN 26LQ ...XCOPR 26PC ... STOZ BTYPE(2) [STOZ CONS.PROP.PTR 26S4 ... LDN 0 1 26WP ... SBS 0 BNO(2) [DECREASE CT. OF ATT. 26^B ... LDX 0 BNO(2) 2743 ... BNZ 0 XFIN [J. IF ANY LEFT 276N ... SMO FX2 [REMOVE CELLS. 279* ... LDX 3 AWORK1 27#2 ... CALL 5 NX1 27BM ... ADN 3 7 27F# ... CALL 7 XFCELL 27H^ ...XFIN SMO FX2 27LL ... LDX 7 ACOMMUNE8 27P? ... EXIT 7 0 27TG RECZERO 28*6 LDN 6 0 [HUNT FIRST REC. 28SQ RECFD LDX 2 FX2 29#B REH HUNT2 2,FILE,FRRB 29S2 TXU 6 BRECNO+A1(2) 2=?L BCS REH 2=R= ADN 2 A1 2?=W EXIT 7 0 2?QG ...NXCELL 2#=6 SMO FX2 [ 2#PQ STO 3 AWORK1 2#^J ... BPZ 3 SAME 2*9B ...NX2 LDX 6 3 2*F8 ... SBX 5 FX1 2*P2 SRL 6 9 2B8L ANDN 6 #7777 2B*S ... LDX 2 FX2 2BH2 ... STO 6 ACOMMUNE3(2) 2BN8 ... MXB 2 2BTB ... ADX 5 FX1 2C2J ...SAME 2C7W ANDN 3 #777 2CMG EXIT 5 0 2CMJ ...NEXCELL 2CML ... SMO FX2 2CMN ... STO 3 AWORK1 2CMQ ...NX1 2CMS ... LDX 6 3 2CMW ... SRL 6 9 2CMY ... ANDN 6 #7777 [RECORD NO 2CN2 ... CALL 7 RECFD [FIND ITS FRRB 2CN4 ... ANDN 3 #777 [OFFSET OF REQD CELL 2CN6 ... EXIT 5 0 2CNF ...# 2CPD ...XFCELL 2CQC ... MFREECELL 2,3 2CRB ... EXIT 7 0 2CS* ...# 2CT# ...# 2CW? ...XHCONS 2CX= ... HUNTMISB 2,APERI,CONSOLE 2CY9 ... EXIT 7 0 2C^8 ...# 2D27 ...# 2D36 ...XHTERM 2D45 ... HUNTMISB 1,IDF,ITERMID 2D54 ... EXIT 7 0 2DJN ... 2F4# ...YCELL [SETS UP IDF CELL FOR 7900 ACTIVITY 2FHY ...[ON ENTRY: X2 & X3 POINT TO PLACE WHERE UNIT FORWARD PTR. WILL BE 2G3J ...[STORED. X1 POINTS TO CURRENT 7900 ACTIVITY. 2GH8 ...[ON EXIT: X2 & X3 POINT TO UNIT CELL JUST CREATED. X1 POINTS TO NEXT 2H2S ...[IPB ACTIVITY IN THE CHAIN. 2HGD ... SBX 4 FX1 2J24 ... SMO FX2 [FOR EXIT INFO. 2JFN ... STO 1 AWORK2 2J^# ... LINT CPPTR(1),5 [INTERNAL UNIT NO. IN X5 2KDY ... LTYPE CPPTR(1),6 [TYPE IN X6 2KYJ ... LGEOG CPPTR(1),0 [GEOG.NO. IN X0 2LD8 ... SRC 6 6 2LXS ... ORS 0 6 [X6= TYPE & GEOG NO 2MCD ... JWRONG CPPTR(1),YS3A 2MX4 ... LDN 7 0 2NBN ... BRN YS3 2NW# ...YS3A LDCT 7 #200 2P*Y ...YS3 2PTJ ... MGETCELL 2,3 [GET A CELL FOR 7900 UNIT 2Q*8 ... ADX 3 2 2QSS ... STO 7 BNUMB(3) [ST. STATE OF UNIT. 2R#D ... STO 5 BNO(3) [ST. UNIT NO IN UNIT CELL. 2RS4 ... STO 6 BTYPE(3) [ST. TYPE/GEO.NO. IN UNIT CELL. 2S?N ... SMO FX2 2SR# ... LDX 1 AWORK2 [LD. PTR. TO IPB 2T=Y ... LDX 1 IPBL(1) 2TQJ ... ADX 4 FX1 2W=8 ... EXIT 4 0 2XP4 ...# 2Y8N ...# SUBROUTINE TO SET UP A DEVICE LIST AND AMOP/IPBIN ACTIVITY FOR 2YN# ...# A VIRTUAL 7900 . THIS SUBROUTINE COORDINATES . 2^7Y ...# ON ENTRY X6 = THE OPS UNIT NUMBER OF THE VIRTUAL 7900 IN B15-23 ; 2^MJ ...# B0=1 IF UNIT IS MOPPED ON IN THE IDF . 3278 ...# ON EXIT X3 -> THE V7900 DEVICE LIST ; X1= FX1 ; X2 = FX2 32LS ...# X6 IS UNCHANGED 336D ...# LINK IN X7 . 33L4 ...SV7900CORE 345N ... SBX 7 FX1 34K# ... SMO FX2 354Y ... STO 6 ACOMMUNE1 35JJ ... DOWN SETUP,8 3648 ... LDX 3 ACOMMUNE1(2) 36HS ... ADX 7 FX1 373D ... EXIT 7 0 37H4 ...# 382N ...# SUBROUTINE TO SET UP A DEVICE LIST AND AMOP/IPBIN ACTIVITY FOR 38G# ...# FOR EACH VIRTUAL 7900 DEFINED IN THE IDF . THIS S/R COORDINATES . 38^Y ...# ON EXIT X1 = FX1 ; X2 = FX2 ; X0,X3-7 ARE UNDEFINED 39FJ ...# AWORK1 AND AWORK2 ARE UNDEFINED 39^8 ...# LINK IN X7 . 3=DS ...# ########################################## 3=YD ...# 3?D4 ...# K2 3?XN ...# 3#C# ...# ######################################## 3#WY ...# 3*BJ ...XIDF2 3*W8 ...SETUPV7900S 3B*S ... SBX 7 FX1 [PRESERVE LINK IN AWORK3 3BTD ... LDX 2 FX2 3C*4 ... STO 7 AWORK3(2) 3CSN ...# SEARCH FOR A VIRTUAL 7900 UNIT CELL IN THE IDF 3D## ... LDN 0 BIPB [INITIALISE "PTR TO PREVIOUS UNIT 3DRY ... STO 0 AWORK2(2) [CELL" (FOR SDELETECELL) 3F?J ... CALL 7 RECZERO [HUNT BASE CELL 3FR8 ... LDX 3 BIPB(2) [TEST FOR MBM(7900) CHAIN 3G=S ... BZE 3 SETUPV7900X [NO 7900'S DEFINED IN IDF : EXIT 3GQD ...SNEXTUNIT 3H=4 ... CALL 5 NXCELL [GET (NEXT) 7900 UNIT CELL 3HPN ... [PRESERVES PTR TO THIS UNIT CELL 3J9# ... [IN AWORK1 3JNY ... SMO 2 3K8J ... LDX 6 BNO(3) [BNO.B0 = 1 IF A VIRTUAL 7900 3KN8 ... BPZ 6 SPREUNITPTR [NOT A VIRTUAL 7900 UNIT CELL 3L7S ...# CHECK-OUT THE VIRTUAL 7900 UNIT CELL 3LMD ...# NOTE B0 OF X6 WILL INDICATE EMS TO S/R SV7900CORE 3M74 ... SMO 2 3MLN ... LDX 0 BLINE(3) 3N6# ... BZE 0 SDELETECELL [NO IDENTIFIER CONFIGURATION : DELETE 3NKY ... SMO 2 [SET B0 OF X6 IF UNIT IS MOPPED ON 3P5J ... ANDX 6 BNUMB(3) 3PK8 ... ANDX 6 GSIGN 3Q4S ... SMO 2 [SET OPS UNIT NUMBER IN B15-23 OF X6 3QJD ... LDEX 0 BTYPE(3) 3R44 ... ORX 6 0 3RHN ...# SET UP THE DEVICE LIST AND ACTIVITY FOR THIS VIRTUAL 7900 3S3# ... CALL 7 SV7900CORE 3SGY ...# 3T2J ... LDX 3 AWORK1(2) [REFIND V7900 UNIT CELL 3TG8 ... CALL 5 NX2 3T^S ...SPREUNITPTR 3WFD ... SMO FX2 [PRESERVE PTR TO THIS UNIT CELL NOW 3W^4 ... LDX 0 AWORK1 [AS THE "PREVIOUS UNIT CELL PTR" 3XDN ... SMO FX2 [(FOR SDELETECELL) 3XY# ... STO 0 AWORK2 3YCY ...STESTMORE 3YXJ ... SMO 2 [ANY MORE 7900 UNIT CELLS ? 3^C8 ... LDX 3 0(3) 3^WS ... BNZ 3 SNEXTUNIT [ANOTHER 7900 UNIT CELL TO TEST 42BD ...SETUPV7900X 42W4 ... LDX 1 FX1 [SET X1 AND X2, RESTORE LINK EXIT 43*N ... LDX 2 FX2 43T# ... LDX 7 AWORK3(2) 44#Y ... ADX 7 1 44SJ ... UP 45#8 ...SDELETECELL 45RS ...# DELETE THE UNIT CELL OF A VIRTUAL 7900 WHICH LACKS AN 46?D ...# IDENTIFIER CONFIGURATION AND PROCESS NEXT 7900 UNIT CELL 46R4 ... SMO FX2 [REFIND THE PREVIOUS UNIT CELL 47=N ... LDX 3 AWORK2 [(WHICH POINTS TO THIS V7900 UNIT 47Q# ... CALL 5 NX2 [CELL TO BE DELETED) 489Y ... MFREECELL 2,3 48PJ ... BRN STESTMORE 49NS ...# 4=8D ...# ####################################### 4=N4 ...# 4?7N ...# K1 4?M# ...# 4#6Y ...# ######################################## 4#LJ ...# 4*68 ...XIDF1 7QJ= PART4 7R3W CALL 7 RECZERO [HUNT OFR ZERO RECORD 7RHG LDX 3 BUNIT(2) [LD.PTR. TO UNIT CELL 7S36 BZE 3 PART4A [J. NO.7007 7SGQ SMO FX2 7T2B STOZ AWORK3 [NO. OF 7020'S ON INSTALLATION. 7TG2 PT41 CALL 5 NEXCELL 7T^L SMO FX2 7WF= LDX 0 AWORK1 7WYW SMO FX2 7XDG STO 0 AWORK2 [AWORK2 = PTR. TO CURRENT UNIT CELL 7XY6 ADN 3 BLINE 7YCQ PT42 SMO 2 7YXB LDX 3 0(3) [LOAD PTR. TO LINE 7^C2 BNZ 3 PT43 [J. PTR. TO NEXT LINE NOT ZERO. 7^WL SMO FX2 82B= LDX 3 AWORK2 [LD. PTR. TO CURRENT UNIT 82TW CALL 5 NEXCELL 83*G SMO 2 83T6 LDX 3 0(3) [LD. PTR. TO NEXT UNIT 84#Q BNZ 3 PT41 [J. BACK TO LOOK AT NEXT UNIT. 84SB BRN PART4A [NO MORE UNITS. 85#2 PT43 85RL CALL 5 NEXCELL [AWORK1 = PTR. TO LINE CELL 86?= SMO 2 86QW LDX 5 BLINE(3) [LD. PTR. TO NEXT UNIT 87=G BZE 5 PT42 [J. NO 7020 ON THIS LINE 87Q6 ... CALL 7 XHTERM 889Q BNG 1 PT44 [J. NO BLK. SET UP 88PB LDX 7 ALOGLEN(1) 8992 SMO FX2 89NL SBX 7 AWORK3 [BUB. NO. OF WORDS USED 8=8= SMO 2 8=MW LDX 5 BNUMB(3) 8?7G ANDN 5 #7777 8?M6 ADX 5 5 8#6Q SBX 7 5 8#LB BPZ 7 PT46 [J. STILL ENOUGH ROOM. 8*62 ADX 5 ALOGLEN(1) 8*KL LDX 4 1 [X1 CANNOT BE PARAMETER 8B5= ALTLEN 4,5 [X5=NEW LENGTH OF ITERMID BLOCK 8BJW ... CALL 7 XHTERM 8C4G BRN PT45 8CJ6 PT44 SMO 2 8D3Q LDEX 4 BNUMB(3) [NO OF 7020S ON THIS LINE 8DHB ADX 4 4 8F32 ADN 4 2 8FGL SETUPCOR 4,1,IDF,ITERMID 8G2= LDN 0 2 8GFW STO 0 A1(1) 8G^G STO 0 AWORK3(2) 8HF6 LDX 2 BMISC+1 [CHAIN BLOCK INTO MISC CHAIN. 8HYQ CHAIN 1,2 8JDB LDX 1 BMISC+1 8JY2 PT45 SMO FX2 8KCL LDX 3 AWORK1 [RE-HUNT OFR LINE CELL. 8KX= CALL 5 NX1 8LBW PT46 SMO 2 8LWG LDX 3 BLINE(3) [LD. 8MB6 PT47 SMO FX2 8MTQ STO 3 AWORK4 [LD.PTR. TO UNIT CELL 8N*B CALL 5 NX1 [HUNT FOR 7020 CELL 8NT2 SMO 2 8P#L LDX 4 BNO(3) [LD. IDENTIFIER AND POLLING ADDRESS 8PS= SMO FX1 8Q?W ANDX 4 MASK [MASK OUT IDENTIFIER ONLY. 8QRG SMO 2 8R?6 LDX 0 4(3) 8RQQ ANDN 0 #77 [MASK OUT LINE NO. 8S=B ADX 4 0 [X4= IDENTIFIER AND LINE NO. 8SQ2 SMO 2 8T9L LDX 5 4(3) 8TP= SRL 5 6 8W8W ANDN 5 #777 8WNG FMOPG 2,5,NOTIPB [HUNT 7007 FOR AMOP WITH GIVEN AMOP. 8X86 ... CALL 7 XHTERM 8XMQ SMO FX2 8Y7B LDX 6 AWORK3 [LD. POSITION DOWN CELL 8YM2 SMO 6 8^6L STO 4 A1-1(1) [IDENT. AND LINE NO. 8^L= SMO 6 925W STO 2 A1(1) [PTR. TO AMOP 92KG SMO 6 9356 STOZ A1+1(1) [ZEROISE LAST WORD OF BLOCK 93JQ LDN 6 2 944B SMO FX2 [INCREASE CT. OF POSITION DOWN CELL. 94J2 ADS 6 AWORK3 953L ADS 6 A1(1) 95H= SMO FX2 962W LDX 3 AWORK4 96GG CALL 5 NX1 [HUNT FOR CU-RENT 7020 WELL. 9726 PT48 SMO 2 97FQ LDX 4 4(3) [LD. TO TEST IF LAST 7020 CELL. 97^B SMO 2 98F2 LDX 3 0(3) [LD. PTR. TO NEXT 7020 CELL 98YL BZE 3 PT49 [J. NO MORE 7020'S ON THIS LINE. 99D= BNG 4 PT47 [J. END OF THIS 7020 CELL. 99XW CALL 5 NX1 9=CG BRN PT48 [J. BACK TO NEXT 7020 CELL. 9=X6 PT49 SMO FX2 9?BQ LDX 3 AWORK1 [LD. PTR. TO LINE CELL. 9?WB CALL 5 NX1 9#B2 BRN PT42 9#TL PART4A 9**= CALL 7 RECZERO 9*SW LDX 0 7(2) [LAST WD. OF BASE CELL 9B#G BZE 0 XPROP [NO CHANGE 9BS6 STOZ 7(2) 9C?Q LDX 3 BEXOT(2) [LD. BASE OF CONSOLE CHAIN. 9CRB BZE 3 XWR 9D?2 NXT 9DQL CALL 5 NEXCELL [HUNT FOR UNIT CELL. AWORK1= PTR. TO. 9F== SMO 3 9FPW STOZ 2(2) 9G9G SMO 2 9GP6 STOZ 3(3) 9H8Q SMO 3 9HNB STOZ 5(2) 9J82 SMO 3 9JML LDN 5 5(2) 9K7= SMO 3 9KLW LDN 6 6(2) 9L6G MOVE 5 2 [MOVE ZEROS IN 9LL6 ADN 3 4 9M5Q XFRE SMO 2 9MKB LDX 0 0(3) 9N52 BZE 0 XRESC [NO MORE ATTRIBUTIONS FOR THIS CONSL. 9NJL ... CALL 7 XFCELL 9P4= BRN XFRE 9PHW XRESC 9Q3G CALL 4 RESCUE [RESCUE PTR. 9QH6 BNZ 3 NXT [BRANCH IF MORE PROP.CONSOLE CELLS. 9R2Q CALL 7 RECZERO [HUNT ZERO RECORD. 9RGB LDX 3 BUNIT(2) [LD. BASE 7007 CHAIN. 9S22 BZE 3 NO7007 [J. NO 7007 CHAIN. 9SFL XUN CALL 5 NEXCELL 9S^= SMO FX2 9TDW LDX 0 AWORK1 9TYG SMO FX2 9WD6 STO 0 AWORK3 [PRESERVE PTR. TO UNIT IN AWORK3 9WXQ CALL 7 XBATT [ROUTINE TO REMOVE CONS.PROP. 9XCB SMO FX2 9XX2 LDX 3 AWORK3 9YBL CALL 5 NX1 9YW= SMO 2 9^*W LDX 3 BLINE(3) [LD. PTR. TO UNIT CHAIN. 9^TG BZE 3 NOLIN [J. NO LINES =2*6 XLIN =2SQ CALL 5 NEXCELL [HUNT FOR A LINE. =3#B SMO FX2 =3S2 LDX 0 AWORK1 =4?L SMO FX2 =4R= STO 0 AWORK2 [PRESERVE PTR. TO LINE IN AWORK2. =5=W CALL 7 XBATT [ROUTINE TO REMOVE CONS.PROP. =5QG SMO FX2 =6=6 LDX 3 AWORK2 =6PQ CALL 5 NX1 =79B SMO 2 =7P2 LDX 3 BLINE(3) [LD. PTR. TO 7020 CHAIN. =88L BZE 3 NO7020 [J. NO 7020 CHAIN. =8N= Y7020 CALL 5 NEXCELL [HUNT 7020 CHAIN. =97W CALL 7 XBATT [REMOVE CONS.PROP. =9MG CALL 4 RESCUE ==76 BNZ 3 Y7020 [J. BACK TO CONTINUE FREE. 7020 CELLS ==LQ NO7020 =?6B LDX 2 FX2 =?L2 LDX 0 AWORK2(2) =#5L STO 0 AWORK1(2) [RESTORE AWORK2 LINE PTR. =#K= CALL 4 RESCUE =*4W BNZ 3 XLIN [J. BACK TO CONTINUE DOWN LINE CHAIN. =*JG NOLIN =B46 LDX 2 FX2 =BHQ LDX 0 AWORK3(2) =C3B STO 0 AWORK1(2) [UNIT PTR. =CH2 CALL 4 RESCUE [RESCUE UNIT. =D2L BNZ 3 XUN [J. BACK TO CONTINUE DOWN UNIT CHAIN. =DG= NO7007 =D^W CALL 7 RECZERO =FFG LDX 3 BIPB(2) [LD. PTR. TO 7007 CHAIN. =F^6 BZE 3 NO7900 [J. NO 7900 CHAIN. =GDQ XUNT CALL 5 NEXCELL =GYB SMO FX2 =HD2 LDX 0 AWORK1 =HXL SMO FX2 =JC= STO 0 AWORK2 [ST. PTR. TO 7900 UNIT. =JWW CALL 7 XBATT [REMOVE CONS.PROP. =KBG SMO FX2 =KW6 LDX 3 AWORK2 [LD. PTR.TO UNIT =L*Q CALL 5 NX1 [HUNT UNIT. =LTB SMO 2 =M*2 LDX 3 BLINE(3) =MSL BZE 3 XNOID =N#= XLINE CALL 5 NEXCELL [HUNT IDENTIFIER CHAIN. =NRW CALL 7 XBATT [REMOVE CONS.PROP. =P?G CALL 4 RESCUE =PR6 BNZ 3 XLINE [J.BACK NEXT LINE CELL. =Q=Q XNOID LDX 2 FX2 =QQB LDX 0 AWORK2(2) =R=2 STO 0 AWORK1(2) [ST. AWORK1. =RPL CALL 4 RESCUE [RESCUE UNIT NO =S9= BNZ 3 XUNT =SNW NO7900 [FINISHED WITH 7900'S. =T8G BRN XWR =TN6 # THIS SECTION DEALS WITH PROP.CONSOLE CHAIN SETS UP AN APERI/CONS =W7Q XPROP =WMB LDX 3 BEXOT(2) [LD. PTR. TO PROP.CONS. CHAIN. =X72 BZE 3 XP6 [NO PROP.CONS. CHAIN =XLL LDX 0 IPBADDR [LD.PTR. TO AMOP'S IPB'S. =Y6= BNZ 0 XSTA [J. THERE ARE SOME. =YKW LDX 0 ADMULTACT =^5G BZE 0 XWR [J. TO END NO COMM DEVICES. =^K6 XSTA ?24Q CALL 5 NEXCELL [CALL ROUTINE TO HUNT CELL ?26N ... SMO 3 [VALIDITY CHECKS FOR CONSOLE PROPS ?28L ... LDX 6 BNO(2) ?2=J ... BZE 6 ZZERR ?2JB SMO 3 ?342 LDX 6 BTYPE(2) [TEST IF 7023 CONSOLE ?3HL BZE 6 XP5 [J. CENTRAL OPERATOR ?43= LDX 3 6 ?4GW ... CALL 7 XHCONS ?52G BNG 2 XP1 [J. IF NO BLOCK. ?5G6 LDN 0 2 ?5^Q LDX 7 ALOGLEN(2) ?6FB SBX 7 A1(2) ?6^2 SBX 7 0 ?7DL BPZ 7 XP2 [J. LENGTH OKAY ?7Y= LDN 7 4 [ALTLEN MACRO MUST NOT USE X0,X1,X2 ?8CW ADX 7 ALOGLEN(2) ?8XG LDX 5 2 ?9C6 ALTLEN 5,7 [INCREASE APERI/CONSOLE LENGTH ?9WQ ... CALL 7 XHCONS ?=BB LDN 0 2 ?=W2 BRN XP2 [J. INCREASE CT. ??8C ...XX FINDPEREC 1,APGEOG,6,,AV7900,XX1 [FIND 7900 DEVICE LIST.(INC. V790 ??GS ...XX1 ??T= LDX 6 1 ?##W HUNTMISB 1,APERI,CONSOLE ?#SG ... BNG 6 XX2 [GEO.NO. NON-EXISTANT. ?*#6 LTYPE 6,6 ?*RQ SBX 6 5 ?B?B BNZ 6 XP3A ?BH8 ...XX2 ?BR2 LDX 0 A1(1) ?C=L SBN 0 2 ?CQ= ADX 1 0 ?D9W EXIT 7 0 [ON INSTALLATION ?DPG XP1 ?F96 SETNCORE 4,1,APERI,CONSOLE ?FNQ LDX 2 BMISC+1 ?G8B CHAIN 1,2 [CHAIN IN BLOCK INTO MISC. CHAIN. ?GN2 LDX 2 BMISC+1 ?H7L LDN 0 2 ?HM= STO 0 A1(2) [ST. COUNT OF 2 IN A1 OF BLOCK ?J6W XP2 ?JLG ADS 0 A1(2) [INCREASE CT. BY 2 ?K66 ADX 2 A1(2) ?KKQ STOZ A1-1(2) [ZEROIZE LAST WORD. ?L5B SBN 2 2 ?LK2 LDX 1 2 ?M4L [PTR. TO 7023 ?MJ= CALL 5 NX1 [HUNT FOR 7023 CONSOLE CELL ?N3W LDCT 0 #200 ?NHG SMO 2 ?P36 ANDX 0 BNUMB(3) ?PGQ BZE 0 XP3 [J. 7007 ?Q2B LDCT 4 #400 ?QG2 SMO 2 ?Q^L LDX 7 BTYPE(3) [GEO.NO. OF UNIT ?RF= LDX 5 7 ?RYW SRL 56 9 [X5=TYPE OF UNIT ?SDG SLC 6 9 ?SY6 ANDN 5 #77 [X6=GEO.NO. ?TCQ CALL 7 XX [CALL ROUTINE TO CHECK PLIST ?TXB BRN XA ?WC2 XP3A LDN 0 2 ?WWL SBS 0 A1(1) [KNOCK 1 OFF COUNT OF ENTRIES USED ?XB= BXGE 0 A1(1),XP3C [J TO FREE BLK IF NOW EMPTY ?XTW XP3B SMO FX2 ?Y*G LDX 3 AWORK1 ?YT6 CALL 5 NX1 [RE-HUNT PROP. CONSOLE CHAIN. ?^#Q BRN XP5 [J. TO LOOK AT PTR. ?^FY ...XP3C FREECORE 1 ?^M6 ... BRN XP3B ?^SB XA SMO 2 #2#2 LDX 7 BTYPE(3) #2RL ... ANDN 7 #777 [MASK OUT GEOG NO. #3?= SLL 7 12 #3QW SMO 2 #4=G ADX 7 BNO(3) [ADD IN IDENTIFIER INTO X7. #4Q6 BRN XP4 [J. FINISHED 7900. #59Q XP3 LDN 4 0 [B0=0=7007 #5PB SMO 2 #692 LDX 7 4(3) [GEO.NO. AND LINE NO. #6NL LDX 5 7 #78= SRL 56 6 #7MW ANDN 5 #777 #87G SLC 6 6 #8M6 ANDN 6 #77 #96Q LDN 0 #13 #9LB BNZ 6 ZP1 #=62 SBN 0 1 #=KL ZP1 LDX 6 5 #?5= LDX 5 0 #?JW CALL 7 XX [CALL ROUTINE. ##4G ZP SMO 2 ##J6 LDX 7 4(3) #*3Q ANDN 7 #77 #*HB SMO 2 #B32 LDX 0 BNO(3) #BGL SMO FX1 #C2= ANDX 0 MASK #CFW ADX 7 0 #C^G XP4 #DF6 STO 7 A1(1) #DYQ SMO FX2 #FDB LDX 3 AWORK1 #FY2 CALL 5 NX1 #GCL LDX 0 BITS22LS #GX= SMO 2 #HBW ANDX 0 BNO(3) [REST OF INFO. #HWG ADX 0 4 #JB6 STO 0 A1-1(1) #JTQ XP5 SMO 2 #K*B LDX 3 0(3) [LD.PTR. TO NEXT PROP.CONSOLE. #KT2 BNZ 3 XSTA #L#L ... CALL 7 XHCONS #LS= BNG 2 XWR #M?W ADN 2 A1+1 [LD. PTR TO FIRST PAIR #MRG XHUGA LDN 3 2(2) [LD. PTR. TO NEXT PAIR #N3# ... BZE 3 XET [J. IF PTR. ZERO #N?6 XHUG LDX 4 1(2) [LD. SECOND WD. OF PAIR. #NQQ BXE 4 1(3),XST #P=B [J. IF EQUAL TO 1ST PAIR. #PQ2 XBAK ADN 3 2 #Q9L LDX 4 0(3) #QP= BZE 4 XET [END OF CELL #R8W BRN XHUG #RNG XST #S86 LDCT 0 #200 #SMQ ORS 0 0(3) [B1 OF WD. PAIR #T7B BRN XBAK #TM2 XET ADN 2 2 #W6L LDX 4 0(2) #WL= BZE 4 XWR [J. TO GO UP #X5W SLL 4 1 #XKG BNG 4 XET [J. HAS BEEN LOOKED AT AND B1 IS SET. #Y56 BRN XHUGA #YJQ XP6 #^4B XWR #^J2 IDFWRITE [WRITE AWAY IDF. *23L CLOSE *2H= UP *2LT ...# *2QD ...ZZERR TRACE 2,IDFCHK *2W3 ... DOWN SETIDF,3 [SET ALARM BIT *2^L ... GEOERR 1,IDFINVAL [BEFORE FALLING IN A HEAP *359 ... *3D2 ...# *3HK ...# K3IDFCHK : TO CREATE A VIRTUAL 7900 IN CORE AND IDF . *3M8 ...# ENTRY FROM K1MAKEVCC (MAKEVCC COMMAND) *3QR ...# ON ENTRY ACOMMUNE1 = THE OPERATOR UNIT NUMBER OF THE VIRTUAL 7900 *3WB ...# TO BE CREATED . *3^^ ...# EXITS UP WITH ACOMMUNE1 = 0 IF THE VIRTUAL 7900 ALREADY EXISTS . *45J ...# EXITS UP WITH ACOMMUNE1 = THE VIRTUAL 7900 DEVICE LIST POINTER *497 ...# IF THE VIRTUAL 7900 IS CREATED . *4#Q ...# *4D* ...# ####################################### *4HY ...# *4MH ...# K3 *4R6 ...# *4WP ...# ####################################### *52# ...# *55X ...XIDF3 *59G ... LDEX 6 ACOMMUNE1(2) [PRESERVE UNIT NUMBER IN X6 *5*5 ... IDFOPEN *5DN ...# TEST IF THE VIRTUAL 7900 ALREADY EXISTS IN THE IDF *5J? ... LDN 3 BIPB [SEARCH THE 7900(MBM) CHAIN FOR A *5MW ... MSEARCH 2,3,6 [UNIT CELL WITH THE SAME UNIT NO. *5RF ... SMO FX2 *5X4 ... LDX 0 ACOMMUNE1 *62M ... BNZ 0 XUNITEXISTS [UNIT NUMBER MATCH : UNIT ALREADY *66= ... [EXISTS *69T ...# PRESERVE POINTERS TO THE LAST 7900 UNIT CELL IN AWORK3&4 *6*D ...# FOR YCELL CALL *6F3 ... LDX 0 BRECNO(2) *6JL ... SMO FX2 *6N9 ... STO 0 AWORK3 [STORE RECORD NO. OF LAST UNIT CELL *6RS ... SMO FX2 *6XC ... STO 3 AWORK4 [STORE UNIT CELL PTR WITHIN RECORD *732 ...# SET UP CORE BLOCKS FOR THE VIRTUAL 7900 *76K ... CALL 7 SV7900CORE [X6 INDICATES V7900 IS MOPPED OFF *7=8 ... STO 3 AWORK1(2) [PRESERVE THE V7900 DEVICE LIST PTR *7*R ...# SET APERI/AV7900.ATYPE.B12-23 NON-ZERO TO INDICATE THAT *7FB ...# THE VIRTUAL 7900 IS STILL BEING CREATED (FIELD WILL BE *7J^ ...# CLEARED BY K1MAKEVCC) *7NJ ... LDN 0 1 *7S7 ... DSA 0 ATYPE(3) *7XQ ...# SET UP UNIT CELL FOR THE VIRTUAL 7900 AT THE END OF THE *83* ...# 7900 CHAIN *86Y ... LAMOP 3,1 [SET X1 -> V7900 AMOP/IPBIN ACTIVITY *8=H ... LDX 3 AWORK4(2) [RESTORE RECORD PTR TO LAST UNIT CELL *8B6 ... LDX 2 AWORK3(2) [RESTORE UNIT CELL'S RECORD NO. *8FP ... SMO FX2 *8K# ... STO 2 ACOMMUNE3 [REFIND THE LAST UNIT CELL'S RECORD *8NX ... NEW 2 *8SG ... CALL 4 YCELL [SET UP A NEW 7900 UNIT CELL *8Y5 ... [AND MARK IT MOPPED OFF AND RIGHTED *93N ... [ON EXIT X3 -> UNIT CELL CREATED *97? ... LDCT 0 #400 [INDICATE UNIT IS A VIRTUAL 7900 *9=W ... ORS 0 BNO(3) *9BF ...# WRITE AWAY THE IDF, CLOSE IT, AND RETURN UP WITH *9G4 ...# ACOMMUNE1 SET AS ON ENTRY *9KM ... SMO FX2 *9P= ... LDX 3 AWORK1 [RESTORE THE V7900 DEVICE LIST PTR *9ST ... IDFWRITE *9YD ... CLOSE *=43 ... STO 3 ACOMMUNE1(2) [RETURN WITH THE V7900 DL PTR *=7L ... UP *=?9 ...# *=BS ...XUNITEXISTS *=GC ...# VIRTUAL 7900 ALREADY EXISTS IN THE IDF . CLOSE IDF AND *=L2 ...# RETURN WITH ACOMMUNE1 = 0 *=PK ... CLOSE *=T8 ... STOZ ACOMMUNE1(2) *=YR ... UP *?4B ...# *??J ...# ####################################### *?C7 ...# *?GQ ...# K4 *?L* ...# *?PY ...# ###################################### *?TH ...# *?^6 ...XIDF4 *#4P ... IDFOPEN *#8# ... SMO FX2 *#?X ... LDX 3 CPPTR *#CG ... LGEOG 3,6 [LD X6 GEOG NO OF UNIT *#H5 ... LDN 3 BIPB *#LN ... MSEARCH 2,3,6 [SEARCH IDF FOR 7900 *#Q? ... SMO FX2 *#TW ... LDX 0 ACOMMUNE1 *#^F ... BNZ 0 XUNEXI [J IF UNIT EXISTS IN IDF **54 ... FMOPG 1,6,IPB **8M ... CALL 4 YCELL [SET UP ENTRY IN IDF **#= ...XCL **CT ... IDFWRITE **HD ... CLOSE **M3 ... LGEOG ,6 **QL ... FMOPG 2,6,IPB **W9 ... LDX 0 BIT10 **^S ... ERS 0 IPBSW(2) [REMOVE BIT 10 MARKER FROM IPBSW *B5C ... UP *B92 ...[ RETURN BACK UP TO IPBSTART *B#K ...XUNEXI *BD8 ... SMO FX2 *BHR ... LDX 4 CPPTR *BMB ... JWRONG 4,XMPOFF [J. IF UNIT WRONGED *BQ^ ... LDCT 0 #200 *BWJ ... SMO 2 *C27 ... ERS 0 BNUMB(3) [MARK UNIT AS RIGHTED IN THE IDF *C5Q ...XMPOFF *C6L ... LDX 4 BRECNO(2) [FORM IDF STYLE POINTER *C7G ... SLL 4 9 *C8B ... ADX 4 3 *C9* ... ZMOPOFF XBRK,NMPOFF,4 [ MOP OFF UNIT IF NOT ALREADY *C#Y ...NMPOFF *CDH ... BRN XCL *CJ6 ...# *CP6 #END ^^^^ ...15107257000600000000