{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFSEG867)}}
====== IDFSEG867 ======
(George Source)
**Macros used:** [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMERRX|COMERRX]], [[george:macro:EXTEND|EXTEND]], [[george:macro:FREELNKS|FREELNKS]], [[george:macro:GEOERR|GEOERR]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MHUNTX|MHUNTX]], [[george:macro:MSPLITCORE|MSPLITCORE]], [[george:macro:MXB|MXB]], [[george:macro:NAME|NAME]], [[george:macro:NEWMXB|NEWMXB]], [[george:macro:READED|READED]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:UP|UP]]
22FL #SEG IDFSEG8 [A C PUTMAN.
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^= #OPT K0IDFSEG=0
23DW #LIS K0IDFSEG>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF
23YG 8HIDFSEG
24D6 SEGENTRY K20IDFSEG,XIDF20
24XQ SEGENTRY K21IDFSEG,XIDF21
25CB SEGENTRY K22IDFSEG,XIDF22
25X2 SEGENTRY K23IDFSEG,XIDF23
26BL #
26W= #
27*W ZJPARAM +JPARMIS [%C PARAMETER MISSING
27TG ZJPARNAM +JPARNAM ["NAME"
28*6 ZJSETP1 +JSETP1 [EXPRESSION %C INVALID
28SQ ZJPARPER +JPARPER [PERIPHERAL TYPE ALREADY DEFINED
29#B # [FOR CONCEPTUAL %C
29S2 XCPB
2=?L #HAL CPB+CUNI,0
2=R= #HAL IDF+COINF,0
2?=W #
2?QG #
2#=6 YMXB [CHANGES X0,X2 (AND X1 POSSIBLY)
2#PQ SBX 7 FX1
2*9B MXB 2,NOFX12 [READ RECORD IF NOT IN CORE
2*P2 ADX 7 FX1
2B8L EXIT 7 0
2BN= #
2C7W #
2CMG YNEWMXB [CHANGES X0,X2
2D76 NEWMXB 2 [RECORD KNOWN TO BE IN CORE
2DLQ EXIT 7 0
2F6B #
2FL2 #
2G5L # THIS ENTRY POINT SERVICES THE MGETCELL MACRO.ON ENTRY
2GK= # ACOMMUNE3 CONTAINS THE CURRENT RECORD NO,ACOMMUNE5
2H4W # CONTAINS AN ADDRESS (REL TO START OF REC) IN WHICH
2HJG # TO STORE IDF PTR TO NEW CELL OBTAINED. ON EXIT
2J46 # ACOMMUNE3 CONTAINS RECORD NO,AND ACOMMUNE4 CONTAINS
2JHQ # CELL PTR REL TO START OF REC,OF FREE CELL OBTAINED
2K3B #
2KH2 #
2L2L XIDF20
2LG= LDX 4 ACOMMUNE3(2) [CURRENT RECORD NO
2L^W LDX 5 ACOMMUNE5(2) [ADDR FOR PTR TO CELL OBTAINED
2MFG CALL 7 YNEWMXB [X2 -> A1 OF CURRENT FRRB
2M^6 LDX 6 0(2)
2NDQ BNZ 6 YMGD [J IF FREE CELL IN CURRENT REC
2NYB LDN 3 1
2PD2 YMG SMO FX2
2PXL ADS 3 ACOMMUNE3
2QC= CALL 7 YNEWMXB [LOOK FOR NEXT REC IN CORE
2QWW BPZ 2 YMGC [J IF FOUND
2RBG SMO FX2
2RW6 LDX 1 ACOMMUNE3
2S*Q LDX 7 1 [PRESERVE RECORD NUMBER
2STB ADN 1 1
2T*2 READED 1,4 [READ NEXT RECORD
2TSL STO 7 ACOMMUNE3(2)
2W#= TESTREPNOT OVERFILE,YMGA [J IF FURTHER RECORD
2WRW EXTEND 3,XGEO [INCREASE FILE SIZE
2X?G SETNCORE 512,2,FILE,FRRB
2XR6 BRN YMGB
2Y=Q YMGA MHUNTW 2,FILE,FRRB
2YQB TESTREP NORIT,YMGB [HAS RECORD BEEN WRITTEN AWAY
2^=2 #
2^PL # NORIT REPLY SHOULD NOT BE RECEIVED AS WE ONLY GET
329= # ONE RECORD AT A TIME AND USE IT STRAIGHT AWAY
32NW #
338G LDN 2 A1(2)
33N6 BRN YMGC
347Q YMGB MSPLITCORE 2 [SPLIT INTO CELLS,LEAVING X2->A1
34MB YMGC LDX 6 0(2)
3572 BZE 6 YMG
35LL YMGD LDEX 1 6 [X2 -> A1 OF FRRB WITH FREE CELL
366= SMO FX2 [REL PTR OF CELL
36KW STO 1 ACOMMUNE4 [USED BY MGETCELL MACRO
375G ADX 1 2 [X1 IS ABS FREE CELL PTR
37K6 LDX 0 0(1) [DERING FREE CELL
384Q STO 0 0(2) [FROM FREE CHAIN
38JB BXGE 4 BRECNO(2),YMGE [J IF STILL ORIGINAL RECORD
3942 ADX 6 GSIGN [FREE CELL IN DIFFERENT RECORD
39HL LDX 3 2 [KEEP NEW RECORD PTR
3=3= SMO FX2
3=GW STO 4 ACOMMUNE3
3?2G CALL 7 YNEWMXB [FIND ORIGINAL RECORD
3?G6 LDX 0 BRECNO(3)
3?^Q SMO FX2 [RECORD NO OF NEW CELL
3#FB STO 0 ACOMMUNE3 [USED BY MGETCELL MACRO
3#^2 YMGE SMO 5
3*DL STO 6 0(2) [RING NEW CELL AS REQD
3*Y= STOZ 0(1)
3BCW LDN 2 1(1)
3BXG MOVE 1 CELLEN-1 [ZERO FILL NEW CELL
3CC6 UP
3CWQ XGEO GEOERR 1,LARGEIDF
3DBB #
3DW2 #
3F*L # THIS IS ENTRY FOR MNAME MACRO.THE IDF IS SEARCHED FOR A
3FT= # GIVEN CONCEPTUAL NAME.ON ENTRY IF ACOMMUNE1 IS ZERO
3G#W # THE CONCEPTUAL NAME IS FOUND IN A CPB/CUNI OR IDF/COINF BLK.
3GSG # IF ACOMMUNE1 IS NONZERO IT CONTAINS THE TYPE/SUBTYPE OF BLK
3H#6 # CONTAINING THE NAME AND ACOMMUNE2 CONTAINS PTR TO POSITION
3HRQ # DOWN BLK.ACOMMUNE4 CONTAINS DEVICE TYPE OF CONCEPTUAL,
3J?B # OR ZERO IF A NEUTRAL CONCEPTUAL IS REQD
3JR2 #
3K=L #
3KQ= XIDF21
3L9W LDX 0 ACOMMUNE1(2) [LD. PTR.
3LPG BNZ 0 XCHK
3M96 RBACK LDX 2 FPTR(2)
3MNQ LDX 0 ATYPE(2)
3N8B ANDX 0 HALFTOP
3NN2 BXE 0 XCPB(1),XCONT [J. IF CPB,CUNI
3P7L BXE 0 XCPB+1(1),XCONT [J. IF IDF,COINF
3PM= BXL 0 CACT,RBACK
3Q6W XGEO1 GEOERR 1,NOBLK [BLK. NOT FOUND
3QLG XCONT LDX 1 ANUM(2)
3R66 BNG 1 XERO [ERROR IN PARAMETERS
3RKQ BZE 1 XERO [ERROR IN PARAMETERS
3S5B LDCH 0 APARA(2)
3SK2 SBN 0 #40
3T4L BNG 0 XERO1 [ERROR NAME NOT VALID
3TJ= LDN 0 13
3W3W BXGE 1 0,XERO1 [ERROR
3WHG LDN 0 12
3X36 SBX 0 1 [X0=DIFFERENCE.
3XGQ LDN 3 0
3Y2B XSP LDCH 7 APARA(2) [LOAD CHAR. FROM INPUT.
3YG2 DCH 7 4(3)
3Y^L BCHX 2 £
3^F= BCHX 3 £
3^YW BCT 1 XSP
42DG BZE 0 XSTART
42Y6 LDN 7 #20 [SPACEFIL IF NECESSARY IF ACC.4,5&6.
43CQ XSP1 DCH 7 4(3)
43XB BCHX 3 £
44C2 BCT 0 XSP1 [GO BACK IF ANOTHER SPACE NEEDED.
44WL BRN XSTART
45B= XCHK MHUNTX 3,ACOMMUNE1(2) [X3=PTR. TO BLOCK CONTAINING INFO.
45TW LDX 7 ACOMMUNE2(2) [LD. INFO. FROM BLOCK.
46*G SMO 7
46T6 LDX 4 0(3) [LD. NAME FROM AREA IN BLOCK
47#Q ADN 7 1
47SB SMO 7
48#2 LDX 5 0(3)
48RL ADN 7 1
49?= SMO 7
49QW LDX 6 0(3)
4==G XSTART
4=Q6 LDX 2 FX2
4?9Q STOZ ACOMMUNE3(2) [KEEP REC.NO.
4?PB MXA CALL 7 YMXB [HUNT FOR THE RECORD.
4#92 LDX 7 BCONT(2) [LD. PTR. TO CONCEPTUAL
4#NL BZE 7 MXABA [J. NO CONCEPTUALS IN CHAIN.
4*8= LDX 0 7
4*MW MXAC1 BPZ 7 MXAA
4B7G LDXC 0 0 [REMOVE B0
4BM6 SRL 0 9
4C6Q LDX 2 FX2
4CLB STO 0 ACOMMUNE3(2) [ST. REC.NO.
4D62 LDX 3 7
4DKL CALL 7 YMXB [FIND NEXT RECORD
4F5= LDX 7 3
4FJW MXAA ANDN 7 #777 [MASK OUT CELL PTR.
4G4G LDX 3 2
4GJ6 ADX 3 7
4H3Q BXE 4 1(3),MXCA [J. IF 1ST WD. OF NAME EQUAL.
4HHB MXAB LDX 0 0(3) [LD. PTR. TO NEXT CONCEPTUAL.
4J32 BZE 0 MXC
4JGL LDX 7 0
4K2= BRN MXAC1 [J TO LOOK AT THE NEXT CELL
4KFW MXC SMO FX2 [SET TO NOT HERE CONCEPTUAL.
4K^G STOZ ACOMMUNE1 [MARK CONCEPTUAL NOT IN CHAIN.
4LF6 MXCB
4LYQ LDX 0 BRECNO(2) [LD. REC.NO.
4MDB SMO FX2
4MY2 STO 0 ACOMMUNE3 [ST. REC.NO.
4NCL SMO FX2
4NX= STO 7 ACOMMUNE2 [ST. CELL PTR.
4PBW UP
4PWG MXABA LDN 7 BCONT [LD. BASE OF CONCEPTUAL CHAIN
4QB6 BRN MXC
4QTQ MXCA BXU 5 2(3),MXAB [J. IF 2ND. WD. UNEQUAL.
4R*B BXU 6 3(3),MXAB [J. IF 3RD. WD. UNEQUAL.
4RT2 SMO FX2
4S#L LDX 0 ACOMMUNE4 [LD. INDICATOR TO SAY IF IPB OR MPX.
4SS= BZE 0 MXDA [J. NO CHECK WILL BE MADE.
4T?W LDCH 6 6(3) [LD.WD.6 OF CONCEP CELL.
4THN ... LDX 1 FX1
4TRG BZE 6 MXD [J. IF NEUTRAL CONCEP.
4W?6 SBN 0 #30
4WQQ BNZ 0 MXD1 [J. NOT EQUAL TO IPB
4X=B SBN 6 #40
4XQ2 BZE 6 MXDA [J. CONCEP = IPB.
4Y9L MXD2 LDX 2 FX2
4YP= LDX 0 ACOMMUNE1(2)
4^8W BNZ 0 YB
4^NG YA LDX 2 FPTR(2)
5286 LDX 0 ATYPE(2)
52MQ ANDX 0 HALFTOP
537B BXE 0 XCPB(1),MXD2A
53M2 BXE 0 XCPB+1(1),YC
546L BXL 0 CACT,YA
54L= BRN XGEO1
555W YB MHUNTX 2,ACOMMUNE1(2)
55KG YC NAME 2,CPB,CUNI
5656 MXD2A LDX 5 ZJPARPER(1)
56JQ CALL 6 SUBWRITE [WRITE AND CLOSE IDF
56NM ... LDX 0 CONTEXT(2) [LD. CONTEXT WD. IN CPAT
56SJ ... ANDX 0 BIT11 [B11 = 1 PROGRAM ISSUED COMMAND
56YF ... BZE 0 MXD2B [J NOT PIC
574B ... LDN 7 2
578? ... FREELNKS ,7 [FREE DOWNS EX. ONLINE TO IDFONLIN
57#8 ... [ AND IDFONLIN TO IDFSEG.
57D5 ...MXD2B COMERRX 5
57J2 MXD1 SBN 6 #20
583L BNZ 6 MXD2 [J. NOT MULT.CONCEP.
58H= BRN MXDA [J. CONCEP.= MULT
592W MXD3 LDCT 6 #400 [SET B0 OF WORD 6 =IPB
59GG BRN MXD4
5=26 MXD SBN 0 #30
5=FQ BZE 0 MXD3
5=^B LDCT 6 #200 [SET B1 OF WORD 7 = MULT.
5?F2 MXD4 ORS 6 6(3) [ADD. IN THRU. INDICATOR.
5?YL MXDA LDN 0 #77
5#D= SMO FX2
5#XW STO 0 ACOMMUNE1
5*CG BRN MXCB
5*X6 XERO LDX 1 FX1
5BBQ CALL 6 ZRENAM
5BWB LDX 5 ZJPARAM(1)
5CB2 LDX 7 ZJPARNAM(1)
5CTL CALL 6 SUBWRITE
5C^H ... LDX 0 CONTEXT(2) [LD. CONTEXT WD. IN CPAT
5D5D ... ANDX 0 BIT11 [BIT 11 = 1 PROGRAM ISSUED COMMAND
5D9* ... BZE 0 XER0A [J NOT PIC
5D*= ... LDN 7 2
5DF7 ... FREELNKS ,7 [FREE DOWNS. EX. ONL TO IDFONLIN
5DK4 ... [ AND IDFONLIN TO IDFSEG
5DN^ ...XER0A COMERRX 5,7
5DSW XERO1 LDX 1 FX1
5F#G CALL 6 ZRENAM
5FS6 LDX 5 ZJSETP1(1)
5G?Q CALL 6 SUBWRITE
5GD8 ... LDX 0 CONTEXT(2) [LD. CONTEXT WD. IN CPAT
5GJL ... ANDX 0 BIT11 [BIT 11 = 1 PROGRAM ISSUED COMMAND
5GP4 ... BZE 0 XER02
5GTG ... LDN 7 2
5G^Y ... FREELNKS ,7 [FREE DOWNS
5H6B ...XER02 COMERRX 5
5H?2 SUBWRITE
5HQL SBX 6 FX1
5J== IDFWRITE
5JPW CLOSE
5K9G ADX 6 FX1
5KP6 EXIT 6 0
5L8Q ZRENAM
5LNB SBX 6 FX1
5M82 LDX 0 ATYPE(2)
5MML ANDX 0 HALFTOP
5N7= BXE 0 XCPB(1),XOUT
5NLW NAME 2,CPB,CUNI [RE-NAME IDF/COINF A CPB/CUNI.
5P6G XOUT ADX 6 FX1
5PL6 EXIT 6 0
5Q5Q #
5QKB #
5R52 # ENTERED FROM MSEARCH MACRO TO SEARCH FOR A UNIT,CI,LINE OR
5RJL # IDENTIFIER DEPENDING ON THE VALUE IN ACOMMUNE2
5S4= # ON ENTRY ACOMMUNE3 CONTAINS THE RECORD NO AND ACOMMUNE2
5SHW # CONTAINS THE CELL PTR (REL TO START OF REC) OF THE
5T3G # BASE OF THE SEARCH.ACOMMUNE4 IS -VE IF CI CHANNEL REQD,IN
5TH6 # WHICH CASE CIPROPNO IS IN LS 22BITS.IF ACOMMUNE4 IS +VE
5W2Q # LINE/IDENTIFIER/UNIT NO REQD IS IN LS 12 BITS
5WGB #
5X22 #
5XFL XIDF22
5X^= LDX 1 ACOMMUNE2(2)
5YDW LDX 5 ACOMMUNE4(2)
5YYG LDX 0 1
5^D6 SBN 0 BLINE
5^XQ BNG 0 YMSC [J IF TO HUNT UNIT CHAIN
62CB STOZ ACOMMUNE5(2) [MARKER TO HUNT LINE/IDENTIFIER
62X2 BRN YMSD
63BL YMSC STO 1 ACOMMUNE5(2) [HUNT UNIT/CI CHANNEL
63W= YMSD CALL 7 YNEWMXB [FIND BASE RECORD
64*W ADX 1 2 [ABSOLUTE BASE PTR
64TG YMSF LDX 1 0(1)
65*6 BZE 1 YMSY [J IF END OF CHAIN
65SQ LDX 3 5
66#B BPZ 1 YMSL [J IF NO NEW RECORD REQD
66S2 LDX 6 1 [PRESERVE IDF CELL PTR
67?L LDX 2 FX2 [FOR USE BY MXB
67R= LDXC 1 1 [CLEAR B0
68=W SRL 1 9
68QG STO 1 ACOMMUNE3(2) [STORE RECORD NO REQD
69=6 CALL 7 YMXB [FIND NEXT RECORD
69PQ LDX 1 6
6=9B YMSL ANDN 1 #777
6=P2 SMO FX2
6?8L STO 1 ACOMMUNE2 [STORE CELL PTR WITHIN REC
6?N= ADX 1 2 [ABSOLUTE CELL PTR
6#7W SMO FX2
6#MG LDX 0 ACOMMUNE5 [MARKER OF TYPE OF SEARCH
6*76 BZE 0 YMSS [J TO COMPARE LINE/IDENT NOS
6*LQ LDX 0 BTYPE(1)
6B6B ANDN 0 #7777 [GEOG NO OR ZERO
6HG= BRN YMSU
6H^W YMSS LDX 0 BNO(1) [LINE/IDENTIFIER NUMBER
6JFG ANDN 0 #7777
6J^6 YMSU ANDN 3 #7777 [ONLY COMPARE BOTTOM 12 BITS
6KDQ YMSV BXU 0 3,YMSF [J IF NO MATCH
6KYB LDN 1 #77
6LD2 YMSY SMO FX2
6LXL STO 1 ACOMMUNE1 [INDICATE IF DEVICE FOUND
6MC= UP
6MWW #
6NBG #
6NW6 # THIS ENTRY POINT SERVICES THE MFREECELL MACRO.
6P*Q # THE CELL FREED IS CHAINED INTO THE CORRECT FREE
6PTB # CHAIN.ON ENTRY ACOMMUNE3 CONTAINS THE RECORD NO,
6Q*2 # AND ACOMMUNE2 THE WORD PTR WITHIN THE RECORD,OF
6QSL # THE WORD WHICH POINTS TO THE CELL TO BE FREED
6R#= # AND WILL,ON EXIT,CONTAIN IDF PTR TO NEXT CELL ON CHAIN
6RRW #
6S?G #
6SR6 XIDF23
6T=Q LDX 5 ACOMMUNE2(2)
6TQB LDX 6 ACOMMUNE3(2)
6W=2 CALL 7 YNEWMXB [FIND RECORD SPECIFIED IN ACOMMUNE3
6WPL ADX 2 5 [ABSOLUTE WD PTR
6X9= LDX 3 0(2) [J IF CELL TO BE FREED
6XNW BPZ 3 YMAF [IS IN THE SAME RECORD
6Y8G LDXC 0 3 [UNSET B0
6YN6 SRL 0 9 [NEXT RECORD REQD
6^7Q LDX 2 FX2 [FOR USE BY MXB
6^MB STO 0 ACOMMUNE3(2)
7272 CALL 7 YMXB [FIND NEXT RECORD
72LL BRN YMAG
736= YMAF SBX 2 5 [PTR TO START OF RECORD
73KW YMAG ANDN 3 #777
745G ADX 2 3 [ABS PTR TO CELL TO BE FREED
74K6 LDX 4 0(2) [PTR TO CELL AFTER FREE CELL
754Q LDX 1 2
75JB SBX 2 3 [PTR TO START OF RECORD
7642 LDX 0 0(2)
76HL STO 0 0(1) [PUT CELL IN FREE CHAIN
773= LDX 0 BRECNO(2) [RECORD NO OF FREE CELL
77GW SLL 0 9
782G ADX 0 3 [STORE PTR TO NEW FREE
78G6 STO 0 0(2) [CELL IN BASE CELL
78^Q BZE 4 YMAM [J IF NO FURTHER CELL ON CHAIN
79FB LDXC 0 4 [UNSET B0 IF SET
79^2 SRL 0 9 [REC NO OF CELL AFTER FREED CELL
7=DL ORX 4 GSIGN [SET B0 (IF NEC) TO SHOW DIFF REC
7=Y= BXU 0 6,YMAM
7?CW ERX 4 GSIGN [UNSET B0 IF RECORDS ARE THE SAME
7?XG YMAM BXE 6 BRECNO(2),YMAW [J IF ONLY ONE RECORD USED
7#C6 SMO FX2
7#WQ STO 6 ACOMMUNE3
7*BB CALL 7 YNEWMXB [FIND ORIGINAL RECORD
7*W2 YMAW ADX 2 5 [ABS WORD PTR IN ORIGINAL REC
7B*L STO 4 0(2)
7BT= UP
7C#W #
7CSG MENDAREA 35,K99IDFSEG
7D#6 #
7DRQ #END
^^^^ ...667541260001