15 22FL ...#SEG SETIDF8 [A C PUTMAN 13 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 7 22_= #OPT K0SETIDF=0 16 23DW #LIS K0SETIDF>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 21 23YG # THIS SEGMENT IS FOR MARKS GREATER THAN 5.IT DOES NOT PRESERVE ATTACHES 17 24D6 # IN AN EXISTING IDF AND CONTAINS ^TIDY UP^ FACILITIES. 7 24XQ 8HSETIDF 11 25CB ... SEGENTRY K2SETIDF,XIDF2 11 25X2 SEGENTRY K1SETIDF,XIDF1 19 25YP ... SEGENTRY K3SETIDF,XIDF3 [SETS MAJOR ERROR WARNING 17 262D ...# [CALLED BEFORE GEOERR 7 2648 #UNS FPARTRES 4 269B #SKI 17 26BL TNAME 12HSYSTEM [USER NAME FOR TRAPS 9 26W= MASK #37700000 9 27*W #77777 9 27TG #77770000 10 28*6 XPAIR PAIR IDFPROP,30 5 28SQ RECZERO 7 29#B LDN 6 0 8 29S2 RECFD LDX 2 FX2 10 2=?L REH HUNT2 2,FILE,FRRB 10 2=R= TXU 6 BRECNO+A1(2) 8 2?=W BCS REH 8 2?QG ADN 2 A1 7 2#=6 EXIT 7 0 21 2#PQ NEXCELL [FIND NEXT CELL GIVEN POINTER IN X3 8 2*9B SMO FX2 16 2*P2 STO 3 AWORK1 [MAY NEED LATER 8 2B8L NX1 BPZ 3 SAME 7 2BN= NX2 LDX 6 3 8 2C7W SBX 5 FX1 7 2CMG SRL 6 9 8 2D76 ANDN 6 #7777 8 2DLQ LDX 2 FX2 10 2F6B STO 6 ACOMMUNE3(2) 7 2FL2 MXB 2 8 2G5L ADX 5 FX1 8 2GK= SAME ANDN 3 #777 7 2H4W EXIT 5 0 8 2HJG WRITE SBX 7 FX1 7 2J46 IDFWRITE 6 2JHQ CLOSE 8 2K3B ADX 7 FX1 7 2KH2 EXIT 7 0 18 2L2L XOPEN [SUBROUTINE TO OPEN IDF. 8 2LG= SBX 7 FX1 7 2L_W IDFOPEN 8 2MFG ADX 7 FX1 7 2M_6 EXIT 7 0 17 2NDQ XCELL [SETS UP IDF CELLS FOR AN AMOP ACTIVITY 21 2NYB [ON ENTRY:X2 & X3 POINT TO PLACE WHERE UNIT FORWARD PTR WILL BE 15 2PD2 [STORED.X1 POINTS TO CURRENT AMOP ACTIVITY 20 2PXL [ON EXIT:X2 & X3 POINT TO UNIT CELL JUST CREATED.X1 POINTS TO 13 2QC= [NEXT AMOP ACTIVITY IN THE CHAIN 8 2QWW SBX 4 FX1 8 2RBG SMO FX2 16 2RW6 STO 1 AWORK2 [FOR FUTURE USE 15 2S*Q LTYPE CPPTR(1),5 [LOAD TYPE 16 2STB LGEOG CPPTR(1),7 [LOAD GEOG.NO. 18 2T*2 LNLI CPPTR(1),6 [LOAD SIZE OF MULTIPLEXER 8 2TSL BNZ 6 S1 18 2W#= LDN 6 1 [UNIPLEXOR-NO OF LINES 17 2WRW S1 JWRONG CPPTR(1),S3A [J. IF UNIT WRONGED 8 2X?G BRN S3 19 2XR6 S3A LDCT 0 #200 [SET MARKER - UNIT WRONGED 7 2Y=Q ORX 6 0 7 2YQB S3 SRC 5 6 17 2_=2 ORX 5 7 [X5 = TYPE & GEOG. NO 17 2_PL LINT CPPTR(1),7 [GET INT. NO. IN X7 8 329= MGETCELL 2,3 17 32NW LDX 0 BRECNO(2) [RECNO OF UNIT CELL 8 338G LDX 1 FX2 14 33N6 STO 0 AWORK3(1) [STORE 17 347Q STO 3 AWORK4(1) [FOR USE BEFORE EXIT 7 34MB ADX 3 2 14 3572 STO 7 BNO(3) [UNIT NO 15 35LL STO 5 BTYPE(3) [TYPE/GEOG NO 9 366= STO 6 BNUMB(3) 17 36KW LDCH 7 BTYPE(3) [PICK UP DEVICE TYPE 21 375G SBN 7 #12 [& MAKE X7=BNO FOR LINE CELL(0 OR 1) 7 37K6 SBX 3 2 19 384Q ADN 3 BLINE [X3 POINTS TO LINE CHAIN BASE 18 38JB ANDN 5 #777 [GEOG.NO FOR LINE CELLS 8 3942 S2 MGETCELL 2,3 7 39HL SMO 2 9 3=3= STO 7 BNO(3) 7 3=GW SMO 2 9 3?2G STO 5 BTYPE(3) 15 3?G6 ADN 7 1 [NEXT LINE NO 8 3?_Q BCT 6 S2 8 3#FB LDX 2 FX2 15 3#_2 LDX 6 AWORK3(2) [UNIT REC NO 16 3*DL LDX 3 AWORK4(2) [UNIT CELL PTR 14 3*Y= LDX 1 AWORK2(2) [AMOP PTR 15 3BCW LDX 1 ADMP(1) [NEW AMOP PTR 16 3BXG CALL 7 REH [FIND UNIT RECORD 8 3CC6 ADX 4 FX1 7 3CWQ EXIT 4 0 5 3DBB XCELPT 15 3DW2 ANDN 0 #7777 [HUNT FOR REC 8 3F*L SMO FX2 9 3FT= STO 0 ACOMMUNE3 7 3G#W NEW 2 7 3GSG EXIT 3 0 18 3H#6 XFREE [FREE CELLS IN A CHAIN. 8 3HRQ SBX 7 FX1 7 3J?B X4B SMO 2 8 3JR2 LDX 6 0(3) 17 3K=L BZE 6 T15 [J. END OF THE CHAIN. 8 3KQ= CALL 5 SFREE 17 3L9W BRN X4B [J. BACK NEXT CELL 8 3LPG T15 ADX 7 FX1 7 3M96 EXIT 7 0 5 3MNQ XBASS 8 3N8B SBX 6 FX1 8 3NN2 SMO FX2 14 3P7L STO 6 AWORK4 [ST. LINK 17 3PM= T12 CALL 5 NX2 [HUNT FOR MAIN CELL 8 3Q6W ADN 3 BASS 16 3QLG CALL 7 XFREE [FREE ASS. CHAIN 7 3R66 ADN 3 1 16 3RKQ CALL 7 XFREE [FREE ATT. CHAIN 8 3S5B SBN 3 BATT 8 3SK2 SMO FX2 15 3T4L LDX 6 AWORK4 [LD. LINK. 8 3TJ= ADX 6 FX1 14 3W3W EXIT 6 0 [EXIT. 8 3WHG SFREE SBX 5 FX1 8 3X36 MFREECELL 2,3 8 3XGQ ADX 5 FX1 7 3Y2B EXIT 5 0 16 3YG2 YCELL [SETS UP IDF CELL FOR 7900 ACTIVITY 20 3Y_L [ON ENTRY: X2 & X3 POINT TO PLACE WHERE UNIT FORWARD PTR. WILL BE 14 3_F= [STORED. X1 POINTS TO CURRENT 7900 ACTIVITY. 20 3_YW [ON EXIT: X2 & X3 POINT TO UNIT CELL JUST CREATED. X1 POINTS TO NEXT 10 42DG [IPB ACTIVITY IN THE CHAIN. 8 42Y6 SBX 4 FX1 16 43CQ SMO FX2 [FOR EXIT INFO. 9 43XB STO 1 AWORK2 18 44C2 LINT CPPTR(1),5 [INTERNAL UNIT NO. IN X5 15 44WL LTYPE CPPTR(1),6 [TYPE IN X6 16 45B= LGEOG CPPTR(1),0 [GEOG.NO. IN X0 7 45TW SRC 6 6 17 46*G ORS 0 6 [X6= TYPE & GEOG NO 10 46T6 JWRONG CPPTR(1),YS3A 7 47#Q LDN 7 0 8 47SB BRN YS3 8 48#2 YS3A LDCT 7 #200 4 48RL YS3 18 49?= MGETCELL 2,3 [GET A CELL FOR 7900 UNIT 7 49QW ADX 3 2 17 4==G STO 7 BNUMB(3) [ST. STATE OF UNIT. 19 4=Q6 STO 5 BNO(3) [ST. UNIT NO IN UNIT CELL. 20 4?9Q STO 6 BTYPE(3) [ST. TYPE/GEO.NO. IN UNIT CELL. 8 4?PB SMO FX2 16 4#92 LDX 1 AWORK2 [LD. PTR. TO IPB 9 4#NL LDX 1 IPBL(1) 8 4*8= ADX 4 FX1 7 4*MW EXIT 4 0 18 4*N? ...# SUBROUTINES TO DEAL WITH BEBMO BIT IN :MASTERS 18 4*NN ...# DIRECTORY. THIS IS SET TO INDICATE A DISASTROUS 16 4*P5 ...# ERROR REQUIRING IDF TO BE RECREATED. 4 4*PG ...# 6 4*PX ...TESTALARM 7 4*Q# ... LDN 6 0 9 4*QP ... BRN XALARM 5 4*R6 ...SETALARM 7 4*RH ... NGN 6 1 8 4*RY ...XALARM SBX 7 FX1 16 4*S* ... OPENMAS XBRK,GENERAL [OPEN :MASTER 9 4*SQ ... LDN 1 BTHREE 9 4*T7 ... LDN 2 ADMASTDIR 16 4*TJ ... BACKREAD ,BSBS,,1 [READ DIRECTORY 10 4*T_ ... MHUNTW 1,BSTB,BREAD 18 4*WB ... BZE 6 TESTX [JUMP IF JUST TESTING 9 4*WR ... BS 1,BEBMO 17 4*X8 ... CHAIN 1,2 [SET ALARM INDICATOR 18 4*XK ... BACKWRIT FREE,BSBS [AND WRITE BACK AGAIN 7 4*Y2 ... CLOSETOP 8 4*YC ... ADX 7 FX1 7 4*YS ...XRET EXIT 7 0 18 4*_9 ...TESTX JBS TESTON,1,BEBMO [JUMP IF ALARM BIT ON 16 4*_L ... LDN 6 1 [IF NOT SET FLAG 18 4B23 ...TESTON FREECORE 1 [LOSE BSTB BREAD BLOCK 7 4B2D ... CLOSETOP 8 4B2T ... ADX 7 FX1 17 4B3= ... BZE 6 XRET [RETURN IF ALARM ON 17 4B3M ... EXIT 7 1 [SKIP RETURN IF OFF 15 4B44 ...# ######################################## 4 4B4F ...# 7 4B4W ...# K2 4 4B5? ...# 15 4B5N ...# ######################################## 4 4B65 ...# 5 4B7G XIDF2 18 4B8N ...# [ENTERED HERE TO CHECK IPBS 7 4B9W ... STOZ 5 16 4B?4 ... LDN 4 #30 [DEVICE TYPE FOR IPBS 13 4B#= ... FINDPEREC 3,APFOTY,4,XNDL,,,XNANON 9 4B*D ... BNG 3 XNOMORE 20 4BBL ... BRN XNDL [LOOK IF ANY MORE 7900S IN DEV LIST 18 4BCS ...XNANON ADN 5 1 [ADD TO COUNT OF ANON UNITS 14 4BF2 ... BRN XNDL [LOOK FOR MORE 16 4BG8 ...XNOMORE BZE 5 XIPB [JUMP IF NO ANON IPBS 8 4BHB ... OUTNUM 5,0 17 4BJJ ... INFORM 1,IDFANUN,1 [OUTPUT WARNING MESSAG 4 4BKQ ...XIPB 15 4BM6 CALL 7 XOPEN [OPEN THE IDF 21 4C6Q LDX 4 BIPB(2) [TEST IF IPB CHAIN HAS BEEN SETUP. 16 4CLB BNZ 4 XEXI [J. IF IPB CHAIN 8 4D62 LDN 3 BIPB 15 4DKL LDX 1 IPBADDR [LD. IPB PTR. 4 4F5= XBRN 16 4F*4 ... JANON CPPTR(1),XUNZ [J. UNIT NO. ZERO 8 4FJW CALL 4 YCELL 4 4FSN ...XRT 7 4G4G SBX 3 2 8 4GJ6 BNZ 1 XBRN 17 4H3Q CALL 7 WRITE [WRITE AWAY THE IDF 14 4HHB ACROSS IPBSTART,2 [GO BACK. 4 4HKK ...XUNZ 8 4HMS ... LDX 0 BIT10 20 4HQ3 ... ORS 0 IPBSW(1) [SET BIT 10 IN IPBSW TO INDICATE 19 4HS= ... [UNIT NO IS ZERO IE ANON 17 4HWF ... LDX 1 IPBL(1) [LD. PTR TO NEXT UNIT 8 4HYN ... BRN XRT 18 4HYS ...# ENTER HERE FROM ANY IDF SEG THAT WANTS TO GEOERR 18 4HYY ...# SETS ALARM WARNING SO IDF WILL GET RECREATED 15 4H_4 ...# ######################################## 4 4H_8 ...# 7 4H_# ...# K3 4 4H_D ...# 15 4H_J ...# ######################################### 4 4H_N ...# 5 4H_S ...XIDF3 9 4H_Y ... CALL 7 SETALARM 5 4J24 ... UP 15 4J28 ...# ######################################### 4 4J2# ...# 7 4J2D ...# K1 4 4J2J ...# 15 4J2N ...# ######################################## 4 4J2S ...# 5 4J32 XIDF1 20 4JGL [THIS ENTRY POINT CHECKS IF AN IDF EXISTS:IF NOT IT 19 4K2= [CREATES ONE:OTHERWISE IT CHECKS THE EXISTING IDF 15 4K33 ... [BUT FIRST LOOK IF ALARM BIT SET 15 4K3S ... [IF SO, WE MUST RECREATE ANYWAY 4 4K4K ...# 9 4K5B ... CALL 7 TESTALARM 18 4K67 ... BRN REGEN [JUMP IF BIT SET,OTHERWISE SKIP RETN 7 4K72 #UNS FPARTRES 4 4K?Q ( 14 4KDG OPENSYS XBRK,IDF,WRITE,NOWAIT,QUERY 15 4KK= TESTREP2 OK,XREADY,NOFILE,XYZ,MAG,OFFLINE 4 4KQ2 ) 7 4KWQ #UNS FPARTRES 4 4L3G #SKI 4 4L8= ( 12 4L*9 OPENSYS XBRK,IDF,WRITE,QUERY 14 4LF6 TESTREP OK,XREADY [J IF OK 17 4LYQ TESTREP NOFILE,XYZ [J IF DOESN'T EXIST 4 4M8J ) 13 4M#F ...XHELP CALL 7 SETALARM [DISASTER 9 4MDB GEOERR 1,IDMODE 4 4MY2 XYZ 7 4M_P #UNS FPARTRES 4 4N3D ( 7 4N57 CREATEB 3 16 4N6W MBS 3,CEONLINE,CECOOR,CEALLINCS,CECARE 4 4N8K ) 7 4N=# #UNS FPARTRES 4 4N#3 #SKI 4 4N*Q ( 17 4NCL CREATEB [SET UP CREATE BLOCK 10 4NX= HUNT 3,FILE,CREATE 8 4PBW LDCT 4 #010 17 4PWG STO 4 CEINF2(3) [DON'T BREAK IN BIT 4 4Q6# ) 7 4QB6 LDN 4 4 19 4QTQ STO 4 CEORG(3) [SIZE OF RECORD =4X128=512 7 4R*B LDN 4 1 18 4RT2 STO 4 CEINF3(3) [SIZE OF FILE = 1 RECORD 9 4RWX WHATBACK 3,4,,,VSF 7 4RYX #UNS FPARTRES 4 4S4S #SKI 4 4S8P ( 11 4SS= SETNCORE 5,3,FILE,FTRAP 9 4T?W LDN 4 TNAME(1) 10 4TRG LDN 5 ETRUSER1(3) 16 4W?6 MOVE 4 3 [SET USER NAME 7 4WQQ LDN 4 5 16 4X=B STO 4 ETRAPRH(3) [SET BLOCK SIZE 19 4XQ2 LDN 4 CWRITE+CREAD [SET UP READ AND WRITE TRAPS 16 4Y9L STO 4 ETRAPMODES(3) [SET WRITE TRAPS 16 4YP= [FOR USER SYSTEM 4 4_8W ) 12 5249 OPENSYS XBRK,IDF,WRITE,CREATE 8 5286 BRN XOK 7 52=* #UNS FPARTRES 4 52#J ( 5 52BR OFFLINE 12 52F2 OPENSYS XBRK,IDF,WRITE,EMPTY 8 52H9 BRN XOK 4 52KD ) 4 52KP ...# 17 52L2 ...# NEED TO RECREATE IDF - OPEN EMPTY FILE 12 52L? ...REGEN OPENSYS XBRK,IDF,WRITE,EMPTY 12 52LJ ... TESTREP2 OK,WARN,NOFILE,XYZ 8 52LT ... BRN XHELP 18 52M6 ...WARN MONOUT IDFMESSA [TELL OP WE ARE RECREATING 8 52MC ... BRN XOKX 4 52MQ [ 17 537B XREADY [FILE ALREADY EXISTS 7 546L LDN 2 1 8 54L= READED 2,4 9 555W TESTREP OK,PART1 17 55KG TESTREP NORIT,XYZZ [NO RECORDS IN IDF 9 55T# ... CALL 7 SETALARM 14 5656 GEOERR 1,IDFREC [ILLEGAL 4 56JQ [ 17 574B XBRK GEOERR 1,IDFBRK [BREAKIN NOT ALLOWED 4 57J2 [ 10 583L XYZZ HUNT 3,FILE,FRRB 8 58H= BRN XYOK 17 592W XOK [INITIALISE RECORD 7 594K #UNS FPARTRES 4 596# ( 9 5983 LDX 3 JINCLAST 7 599Q SBN 3 1 15 59?F BZE 3 XOKX [J IF WAS 1 9 59*8 MONOUT IDFMESSA 4 59B3 ...) 4 59BX XOKX 12 59GG SETNCORE IDFREC,3,FILE,FRRB 4 5=26 XYOK 10 5=FQ STOZ ACOMMUNE3(2) 8 5=_B MSPLITCORE 3 4 5?F2 [ 21 5?YL # AN EFFICIENCY REWRITE ROUND HERE WOULD BE A GOOD IDEA IF TIME PERMITS 4 5#D= [ 11 5#XW [SET UP IDF CELLS FOR EACH AMOP 5 5*CG REMAKE 9 5*X6 CALL 7 RECZERO 20 5BBQ LDN 3 BUNIT [X2 & X3 NOW CORRECT FOR XCELL 19 5BWB LDX 1 ADMULTACT [FIRST AMOP PTR-IS NON ZERO 8 5CB2 BZE 1 XW 4 5CTL ZOOP 21 5D*= CALL 4 XCELL [TO SET UP UNIT & LINE CELLS IN IDF 8 5DSW BNZ 1 ZOOP 4 5F#G XW 16 5FS6 CALL 7 WRITE [WRITE AWAY INFO. 5 5G?Q YUP UP 20 5GRB XWA LDN 3 BUNIT [LD.PTR. TO BEGIN OF 7007 CHAIN 8 5H?2 BRN T6A 5 5HQL PART1 17 5J== CALL 7 RECZERO [LOCATE RECORD ZERO. 8 5JPW SMO FX2 9 5K9G STOZ AWORK3 9 5KP6 LDX 3 BUNIT(2) 21 5L8Q BZE 3 XWA [NO MULTIPLEXORS OR UNIPLEXORS IN IDF 16 5LNB NUNIT CALL 5 NEXCELL [GET A NEW UNIT 7 5M82 SMO 2 17 5MML LDX 4 BNUMB(3) [WILL BE USED LATER 8 5N7= LDCT 0 #300 21 5NLW ORX 4 0 [MARK WRONGED-REDEEM LATER PERHAPS 8 5P6G LDCT 0 #100 18 5PL6 ERX 4 0 [BUT MARK NOT ONLINE NOW! 7 5Q5Q SMO 2 9 5QKB LDX 6 BTYPE(3) 8 5R52 ANDN 6 #777 17 5RJL FMOPG 1,6,MOP [HUNT GEO.NO. AMOP 8 5S4= BNG 1 T3 16 5SHW T1 [RIGHT UNIT FOUND 21 5T3G STO 1 ACOMMUNE9(1) [SO SET ACOMMUNE9 NON-ZERO AS MARKER 18 5TH6 LNLI CPPTR(1),5 [LD.NO. OF LNS. ON UNIT 8 5W2Q BNZ 5 T10 7 5WGB LDN 5 1 4 5X22 T10 7 5XFL LDX 0 4 8 5X_= ANDN 0 #7777 7 5YDW TXU 0 5 8 5YYG BCC T11 7 5_D6 SMO 2 9 5_XQ STO 4 BNUMB(3) 4 62CB # 20 62X2 # DEALS WITH THE CASE WHEN UNIT EXISTS BUT NOT IN CORRECT FORM 4 63BL # 8 63W= LDX 1 FX2 9 64*W LDX 0 AWORK1(1) 9 64TG STO 0 AWORK2(1) 9 65*6 STO 6 AWORK4(1) 10 65SQ HUNT2OPT 1,AMXOR,AMESS 16 66#B BPZ 1 XHERA [J. BLOCK EXIST 20 66S2 SETNCORE BMULT,1,AMXOR,AMESS [SET UP BLOCK TO LENGTH SPECIFIED 7 67?L LDN 0 0 21 67R= STO 0 A1(1) [ZEROISE WORD TO MOVE INTO WHOLE OF 14 68=W LDN 6 A1(1) [BLOCK. 9 68QG LDN 7 A1+1(1) 18 69=6 MOVE 6 BMULT-1 [MOVE LENGTH OF BLOCK. 8 69PQ SMO FX2 9 6=9B LDX 3 AWORK2 8 6=P2 CALL 5 NX2 18 6?8L MHUNTW 1,AMXOR,AMESS [REHUNT IN CASE OF COOR. 5 6?N= XHERA 8 6#7W LDX 6 A1(1) 20 6#MG ADN 6 1 [INDICATES POSITION DOWN BLOCK. 8 6*76 SMO FX2 9 6*LQ LDX 5 AWORK4 7 6B6B SMO 6 17 6BL2 STO 5 A1(1) [STO. NEXT GEO.NO. 20 6C5L STO 6 A1(1) [STO. NEW POSITION DOWN BLOCK. 7 6CK= SMO 3 18 6D4W LDX 3 BLINE(2) [LD. PTR. TO LINE CELL 21 6DJG T12A CALL 5 NEXCELL [CALL CELL SEARCH AWORK1=LINE CELL. 7 6F46 SMO 3 20 6FHQ LDX 3 BLINE(2) [LD.PTR. TO 7020 CHAIN FROM LINE. 8 6G3B BZE 3 T13 21 6GH2 T12B CALL 6 XBASS [FREES ASS. & ATT CELLS OFF THIS CELL 7 6H2L SMO 3 8 6HG= LDX 3 0(2) 19 6H_W BNZ 3 T12B [J. IF NOT END OF 7020 CHAIN 17 6JFG T13 CALL 7 RECZERO [HUNT FOR FIRST REC. 8 6J_6 LDX 0 GSIGN 19 6KDQ ORS 0 7(2) [SET B0=1 TO SAY RE-CONFIG 8 6KYB SMO FX2 18 6LD2 LDX 3 AWORK1 [LD. PTR. TO LINE CHAIN 8 6LXL CALL 5 NX2 8 6MC= ADN 3 BLINE 16 6MWW CALL 7 XFREE [FREE 7020 CHAIN 8 6NBG SMO FX2 9 6NW6 LDX 3 AWORK1 21 6P*Q CALL 6 XBASS [FREE ASS. & ATT CELLS OFF LINE CELL. 7 6PTB SMO 3 21 6Q*2 LDX 3 0(2) [LD. PTR. TO NEXT CELL IN LINE CHAIN 19 6QSL BNZ 3 T12A [J. IF NOT END OF LINE CHAIN. 8 6R#= SMO FX2 18 6RRW LDX 3 AWORK2 [LD. PTR. TO UNIT CELL. 19 6S?G CALL 6 XBASS [FREE ASS AND ATT. CHAINS. 8 6SR6 ADN 3 BLINE 16 6T=Q CALL 7 XFREE [FREE LINE CHAIN 8 6TQB SBN 3 BLINE 7 6W=2 SMO 2 9 6WPL LDX 0 BTYPE(3) 8 6X9= ANDN 0 #777 8 6XNW SMO FX2 9 6Y8G STO 0 AWORK4 8 6YN6 SMO FX2 9 6_7Q LDX 3 AWORK3 8 6_MB BZE 3 XPA 21 7272 CALL 5 NX2 [HUNT FOR CELL BEFORE CURRENT UNIT 7 72LL XPC SMO 3 8 736= LDX 0 0(2) 8 73KW ERX 0 GSIGN 8 745G SMO FX2 9 74K6 STO 0 AWORK3 16 754Q CALL 5 SFREE [FREE UNIT CELL. 8 75JB SMO FX2 17 7642 LDX 6 AWORK4 [LD. GEO.NO. OF AMOP 17 76HL FMOPG 1,6,MOP [HUNT GEO.NO. AMOP 8 773= BNG 1 XERR 8 77GW CALL 4 XCELL 8 782G SMO FX2 17 78G6 LDX 1 AWORK2 [CURRENT AMOP PTR. 7 78_Q SMO 2 9 79FB LDX 4 BNUMB(3) 8 79_2 BRN T3 4 7=DL T11 17 7=Y= JWRONG CPPTR(1),T4 [J. IF UNIT WRONGED 8 7?CW LDCT 0 #200 15 7?XG ERX 4 0 [MARK RIGHTED 4 7#C6 T3 7 7#WQ SMO 2 18 7*BB STO 4 BNUMB(3) [AMENDED WORD REPLACED 17 7*W2 STO 3 5 [KEEP OLD CELL PTR 9 7B*L LDX 0 BRECNO(2) 7 7BT= SLL 0 9 7 7C#W ADX 0 3 8 7CSG SMO FX2 9 7D#6 STO 0 AWORK3 7 7DRQ SMO 2 8 7F?B LDX 3 0(3) 16 7FR2 BNZ 3 NUNIT [J.FOR NEXT UNIT 16 7G=L LDX 3 5 [RESTORE CELL PTR 9 7GQ= T6A LDX 1 ADMULTACT 8 7H9W BZE 1 T8 10 7HPG T6 LDX 7 ACOMMUNE9(1) 8 7J96 BZE 7 T5 9 7JNQ T7 LDX 1 ADMP(1) 8 7K8B BNZ 1 T6 4 7K?F T8 16 7K#G # BECAUSE VIRTUAL 7900 DEVICE LISTS AND 16 7K*H # INPUT ACTIVITIES (AMOP/IPBIN) ARE NOT 21 7KBJ # SET UP BY EXEC AND SETUPA, RESPECTIVELY, IT IS DONE HERE 13 7KCK # BY SUBROUTINE SETUPV7900S 15 7KDL ... DOWN IDFCHK,2 [CALL 7 SETUPV7900S 4 7KFM # 5 7KGN TIPBLIST 21 7KHP LDX 1 IPBADDR [TEST IF THE IPBLIST(IN CORE)IS EMPTY 21 7L7L ... BZE 1 XEXI [J. TO WRONG ANY IPB'S DEFINED IN FDF 8 7LM= T8A CALL 7 WRITE 17 7M6W HUNT2OPT 2,AMXOR,AMESS [HUNT MESSAGE BLOCK 19 7MLG BNG 2 XACR [J. TO GO ACROSS NO REORG. 11 7N66 GETACT GENERAL,IDFMESS 17 7NKQ MHUNTW 3,AMXOR,AMESS [HUNT MESSAGE BLOCK. 9 7P5B LDX 2 BPTR(2) 14 7PK2 LINKSET 2,XPAIR(1) [SET LINK 17 7Q4L CHAIN 3,2 [CHAIN IN DATA BLK. 9 7QJ= LDX 2 BPTR(3) 8 7R3W FWAIT #54 10 7RHG XACR ACROSS MOPSTART,2 18 7S36 T4 BPZ 4 T3 [NOT MOPPED ON SO JUMP 7 7SGQ NGNC 7 1 19 7T2B ANDX 4 7 [MARK MOPPED OFF IN UNIT CELL 7 7TG2 SMO 2 9 7T_L LDX 3 BLINE(3) 8 7WF= T41 CALL 5 NX1 7 7WYW SMO 2 19 7XDG ANDS 7 BNUMB(3) [MARK MOPPED OFF IN LINE CEL 7 7XY6 SMO 2 8 7YCQ LDX 3 0(3) 18 7YXB BNZ 3 T41 [J.FOR NEXT LINE CELL. 8 7_C2 SMO FX2 9 7_WL LDX 3 AWORK1 17 82B= CALL 5 NX2 [GET BACK TO UNIT CEL 8 82TW BRN T3 8 83*G T5 CALL 4 XCELL 8 83T6 BZE 1 T8 8 84#Q BRN T6 4 84SB XPA 9 85#2 CALL 7 RECZERO 8 85RL LDN 3 BUNIT 8 86?= BRN XPC 9 86QW XERR GEOERR 1,NO MOP 4 87=G # 10 87Q6 # DEALS WITH 7900 CHAIN 4 889Q # 15 88PB XEXI CALL 7 RECZERO [HUNT CELL. 9 8992 LDX 3 BIPB(2) 19 89NL BZE 3 T8A [J. NO IPB'S DEFINED IN IDF 16 8=8= XUNIT CALL 5 NEXCELL [IF IDENTIFIERS. 7 8=?B ... SMO 2 19 8=BG ... LDX 0 0(3) [STORE POINTER TO NEXT UNIT CELL 18 8=FL ... SMO FX2 [IT WILL BE NEEDED LATER 17 8=JQ ... STO 0 AWORK2 [IF WE DELETE THIS ONE 7 8=MW SMO 2 9 8?7G LDX 4 BNUMB(3) 17 8?M6 LDCT 0 #300 [MARK UNIT WRONGED 7 8#6Q ORX 4 0 8 8#LB LDCT 0 #100 18 8*62 ERX 4 0 [MARK UNIT NOT ONLINED. 7 8B5= SMO 2 18 8BJW LDX 6 BTYPE(3) [LD. TYPE.FROM UNIT CELL. 16 8BSN ANDN 6 #7777 [MASK OUT GEOG NO 20 8C8C ... BZE 6 XDROP [DROP FROM IDF IF ZERO UNIT NO 16 8CJ6 FMOPG 1,6,IPB [FIND AMOP/IPBIN 16 8D3Q BPZ 1 X5 [AND J.IF FOUND 4 8D3S ...# 19 8D3W ...REPQN OUTNUM 6,0 [UNIT IN IDF NOT ON INSTALLATION 10 8D3Y ... INFORM 1,IDELUNQ,1 17 8D42 ... CONIN [ASK OP IF HE WANTS TO DELETE 18 8D44 ... HUNTW 2,CONBUFF,EMSIN [FIND REPLY MESSAGE BLOCK 13 8D46 ... LDX 1 2 [SAVE ADDRESS 12 8D48 ... LDX 0 A1(2) [CHAR CT 14 8D4= ...NXTCH LDCH 5 A1+1(2) [GET NEXT CHAR 8 8D4# ... SBN 5 #20 15 8D4B ... BNZ 5 TESTN [JUMP IF NOT SPACE 7 8D4D ... BCHX 2 / 15 8D4G ... BCT 0 NXTCH [LOOK AT NEXT CHAR 8 8D4J ... FREECORE 1 14 8D4L ... BRN REPQN [REPEAT QUESTION 15 8D4N ...TESTN FREECORE 1 [FREE MESSAGE BLOCK 9 8D4Q ... SBN 5 #56-#20 13 8D4S ... BZE 5 NODEL [JUMP IF N 9 8D4W ... SBN 5 #71-#56 15 8D4Y ... BNZ 5 REPQN [REPEAT QN IF NOT Y 20 8D52 ... [WANT TO DELETE CONFIG, INCLUDING UNIT 8 8D54 ...XDROP SMO FX2 15 8D56 ... STO 6 ACOMMUNE2 [STORE GEOG UNIT NO 9 8D58 ... DOWN IDFCONF,3 18 8D5= ... NULL [REMEMBER IDFCONFA DOES UPPLUS1 16 8D5# ... LDX 6 AWORK1(2) [MUST REFIND RECORD 16 8D5B ... SRL 6 9 [AFTER COORDINATION 17 8D5D ... ANDN 6 #7777 [6 NOW CONTAINS RECORD NO 8 8D5G ... CALL 7 REH 8 8D5J ... SMO FX2 17 8D5L ... LDX 3 AWORK2 [RETREIVE POINTER TO NEXT UNIT 16 8D5N ... BNZ 3 XUNIT [GO AND DEAL WITH IT 16 8D5Q ... BRN XLAST [REACHED END OF CHAIN 8 8D5S ...NODEL SMO FX2 14 8D5W ... LDX 3 AWORK1 [REFIND UNIT CELL 8 8D5Y ... CALL 5 NX2 4 8D6* X7 6 8D8Y #UNS CRAMP 4 8D?H ( 7 8DB6 SMO 3 9 8DDP LDX 0 BLINE(2) 18 8DH# BNZ 0 X7X [J IF THERE IS A CONFIG 4 8DJK X71 16 8DKX NGNC 0 1 [OTHERWISE LEAVE 17 8DNG ANDX 4 0 [MOPPED ON BIT CLEAR 4 8DR5 X7X 4 8DTN ) 7 8DY? SMO 2 18 8F32 STO 4 BNUMB(3) [STO. WRONGED INDICATOR. 9 8F6X SEGENTRY K91SETIDF 18 8F=S LDN 0 AHRETAIN [MENDED BY RETAINAH MACRO 18 8F?7 ... BZE 0 XCCAH [JUMP IF ATTACHES TO BE LOST 7 8F?G ... SMO 2 9 8F?T ... LDX 6 BTYPE(3) 8 8F#8 ... ANDN 6 #7777 15 8F#H ... FMOPG 1,6,IPB [FIND AMOP ACT 18 8F#W ... BPZ 1 RETAH [JUMP-OK TO RETAIN ATTACHES 7 8F*9 ...XCC1 SMO 3 17 8F*J ... LDX 3 BLINE(2) [MUST CANCEL ATTACHES 15 8F*X ... BZE 3 X7B [JUMP IF NO IDES 16 8FB= ...XCC2 CALL 5 NX1 [FIN NEXT IDE CELL 8 8FBK ... SMO 2 19 8FBY ... LDX 7 CONTCEP(3) [SEE IF ATTACHED TO A CONCEPT 14 8FC? ... BZE 7 XCC3 [JUMP IF NOT 8 8FCL ... LDCT 7 #200 16 8FC_ ... SMO 2 [SET B1 AS FLAG SO 17 8FD# ... ORS 7 CONTCEP(3) [IDFCLEAN WILL DETACH IT 7 8FDM ...XCC3 SMO 3 16 8FF2 ... LDX 3 0(2) [GET PTR TO NEXT IDE 16 8FF* ... BNZ 3 XCC2 [DEAL WITH NEXT IDE 16 8FFN ... BRN X7B [FINISHED THIS IPB 5 8FG3 ...XCCAH 7 8FGL SMO 3 9 8G2= LDX 3 BLINE(2) 8 8GFW BZE 3 X7B 8 8G_G X7A CALL 5 NX1 7 8HF6 SMO 2 21 8HYQ STOZ CONTCEP(3) [ZEROISE CONCEPTUAL PTR. IN IDENTIFIE 7 8JDB SMO 3 8 8JY2 LDX 3 0(2) 8 8KCL BNZ 3 X7A 8 8KX= X7B SMO FX2 9 8LBW LDX 3 AWORK1 14 8LWG ... CALL 5 NX2 [REFIND UNIT CELL 7 8MB6 RETAH SMO 2 15 8MTQ LDX 3 0(3) [LD. FPTR. 17 8N*B BNZ 3 XUNIT [LOOK AT NEXT UNIT. 5 8NK8 ...XLAST 14 8NT2 LDX 1 IPBADDR [LD. BASS 8 8P#L ... BZE 1 T8A 21 8PS= X2E LDX 0 ACOMMUNE9(1) [TEST TO SEE IF UNIT ALREADY ON INST. 16 8Q?W BZE 0 X3 [NOT IN IDF JUMP. 9 8QRG X4 LDX 1 IPBL(1) 18 8R?6 BNZ 1 X2E [J. BACK IF MORE ENTRIES 9 8RQQ X8 LDX 1 IPBADDR 8 8S=B BZE 1 T8A 8 8SQ2 CALL 7 WRITE 16 8T9L ACROSS IPBSTART,3 [ACROSS TO SETUP 4 8TP= # 4 8W8W # 4 8WNG X3 19 8WY# ... JANON CPPTR(1),X3A [UNIT HAS ZERO GEOG NO. 8 8X86 SMO FX2 9 8XMQ LDX 3 AWORK1 7 8Y7B LDX 7 1 8 8YM2 CALL 5 NX2 7 8_6L LDX 1 7 17 8_L= CALL 4 YCELL [CALL SET UP ROUTINE. 8 925W BZE 1 X8 7 92KG SBX 3 2 16 9356 LDX 0 BRECNO(2) [LD. RECORD NO. 7 93JQ SLL 0 9 16 944B ADX 0 3 [ADD.IN CELL PTR. 8 94J2 SMO FX2 9 953L STO 0 AWORK1 14 95H= BRN X2E [J. BACK 4 95LB ...X3A 8 95PG ... LDX 0 BIT10 16 95SL ... ORS 0 IPBSW(1) [SET BIT 10 IN IPBSW 8 95XQ ... BRN X4 4 962W X5 17 96GG STO 2 ACOMMUNE9(1) [SET MARKER NON-ZERO. 17 9726 JWRONG CPPTR(1),X6 [J. IF UNIT WRONGED 8 97FQ LDCT 0 #200 15 97_B ERX 4 0 [MARK RIGHTED 8 98F2 BRN X7 8 98YL X6 LDX 2 FX2 18 99D= ZMOPOFF ,NMOPOFF,AWORK1(2) [MOP OFF THE WRONGED 7900 5 99XW NMOPOFF 9 9=CG LDX 3 AWORK1(2) 18 9B#G CALL 5 NX2 [GET BACK TO UNIT CELL. 8 9BS6 BRN X71 10 9C?Q MENDAREA 40,K99SETIDF 4 9CRB #END 8 ____ ...37657631000300000000