{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SETIDF867)}}
====== SETIDF867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKREAD|BACKREAD]], [[george:macro:BS|BS]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:CONIN|CONIN]], [[george:macro:CREATEB|CREATEB]], [[george:macro:DOWN|DOWN]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FMOPG|FMOPG]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FWAIT|FWAIT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETACT|GETACT]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNT2OPT|HUNT2OPT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:INFORM|INFORM]], [[george:macro:JANON|JANON]], [[george:macro:JBS|JBS]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LINT|LINT]], [[george:macro:LNLI|LNLI]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MASK|MASK]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREECELL|MFREECELL]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MSPLITCORE|MSPLITCORE]], [[george:macro:MXB|MXB]], [[george:macro:NEW|NEW]], [[george:macro:OPENMAS|OPENMAS]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PAIR|PAIR]], [[george:macro:READED|READED]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:UP|UP]], [[george:macro:WHATBACK|WHATBACK]], [[george:macro:XYZ|XYZ]], [[george:macro:ZMOPOFF|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