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