{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFCHK867)}}
====== IDFCHK867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:DOWN|DOWN]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FMOPG|FMOPG]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LAMOP|LAMOP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINT|LINT]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MASK|MASK]], [[george:macro:MFREECELL|MFREECELL]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:MXB|MXB]], [[george:macro:NEW|NEW]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:ZMOPOFF|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