IDFSEG867
(George Source)
Macros used: BXE, BXGE, BXL, BXU, CLOSE, COMERRX, EXTEND, FREELNKS, GEOERR, IDFWRITE, MENDAREA, MHUNTW, MHUNTX, MSPLITCORE, MXB, NAME, NEWMXB, READED, SEGENTRY, SETNCORE, TESTREP, TESTREPNOT, UP
- IDFSEG867.txt
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