DELCON867
(George Source)
Macros used: BXE, CLOSE, COMBRKIN, COMERRX, DOWN, ENDCOM, ERASE, FSHENTRY, IDFOPEN, IDFWRITE, MASK, MENDAREA, MFREE, MFREECELL, MHUNT, MHUNTW, MNAME, MXB, NEW, NEWMXB, SEGENTRY, SETNCORE, SETUPCORE, UP
- DELCON867.txt
22FL #SEG DELCON8 [PHILIP TURNER. 22PD ... [ (C) INTERNATIONAL COMPUTERS LIMITED 1982 22^= #OPT K0DELCON=0 23DW #LIS K0DELCON>K0ALLGEO>K0GREATGEO>K0COMMAND 23YG 8HDELCON 24D6 # 24XQ # 25CB # ENTRY FOR "CANCEL CONCEPTUAL" COMMAND. 25X2 # 26BL SEGENTRY K1DELCON,X1DELCON 26W= # 27*W # ENTRY DOWN FROM CONCEPT TO CLEAR ATTACHMENTS WHEN CHANGING SIZE. 27TG # 28*6 SEGENTRY K2DELCON,X2DELCON 28SQ # 28XW ...# ENTRY POINT TO DO 'ERASE' MACRO FOR A M/C 'B' COMMAND 2932 ...# 2966 ... FSHENTRY K3DELCON,X3DELCON,,X3DELCON 299= ...# 29#B # 29S2 # 2=?L MASK #37777000 2=R= #37777777 2?=W #7777777 2?QG #1000000 2#=6 ZJPARAM +JPARMIS 2#PQ ZJPARNAM +JPARNAM 2*9B ZJSETP1 +JSETP1 2*P2 ZJDELON +JDELON 2B8L ZJDELEX +JDELEX 2BN= # 2C7W # THIS PART DEALS WITH DELETING A COMPLETE CONCEPTUAL. 2CMG # 2D76 XMXB 2DLQ SBX 7 FX1 2F6B LDX 2 FX2 2FL2 MXB 2 2G5L ADX 7 FX1 2GK= EXIT 7 0 2H4W XNEWMXB 2HJG SBX 7 FX1 2J46 LDX 2 FX2 2JHQ NEWMXB 2 2K3B ADX 7 FX1 2KH2 EXIT 7 0 2L2L XFREECELL 2LG= SBX 7 FX1 2L^W MFREECELL 2,3 2MFG ADX 7 FX1 2M^6 EXIT 7 0 2NDQ XNAME 2NYB SBX 7 FX1 2PD2 MNAME 2,3 [CHECK NAME 2PXL ADX 7 FX1 2QC= EXIT 7 0 2QWW X1DELCON 2RBG XPARAM 2RW6 SPARAPASS 2S*Q MHUNT 3,CPB,CUNI [ANALYSE PARAMETERS. 2STB LDX 2 ANUM(3) 2T*2 BNG 2 XCOM2 [NO PARAMETERS. 2TSL BZE 2 XCOM2 [NULL PARAMETERS. 2W#= LDCH 4 APARA(3) 2WRW SBN 4 #41 2X?G BNG 4 XCOM1 2XR6 SBN 4 #73-#41 2Y=Q BPZ 4 XCOM1 [FIRST CHAR. NOT A LETTER 2YQB SRL 2 2 2^=2 SBN 2 4 2^PL BPZ 2 XCOM1 [ERROR CONCEPTUAL NAME > 3WDS. 2^SQ ...#UNS IDFMARK8 2^XW ... IDFOPEN ZBRKINI 3232 ...#UNS IDFMARK8 3266 ...#SKI 329= IDFOPEN [CALL MACRO TO OPEN IDF. 32NW LDN 3 0 338G XNA SMO FX2 33N6 STOZ ACOMMUNE1 [TO INDICATE IN CPB/CUNI BLK. 347Q CALL 7 XNAME [HUNT FOR CONCEPTUAL NAME 34MB XOK 3572 SMO FX2 35LL LDX 0 ACOMMUNE1 [OK IF NAME IN CORE ERROR IF NOT 366= BZE 0 XCOM3 36KW SMO 3 375G LDX 5 4(2) 37K6 BNG 5 XCOM4 [J. IF -VE ONLINED ERR. 384Q SMO FX2 38JB STO 5 AWORK4 3942 LDX 5 BRECNO(2) [LD. CURRENT REC.NO. 39HL SLL 5 9 3=3= ADX 5 3 3=GW SMO FX2 3?2G STO 5 AWORK2 [ST. PTR. TO NAME CELL. 3?G6 SMO 3 3?^Q LDX 5 5(2) 3#FB BZE 5 XNON 3#^2 CALL 0 XUSE [CALL ROUTINE WHICH FREES PTRS. TO LN 3*DL # 3*Y= # ROUTINE TO ERASE DIRECTORY ENTRY FOR "OWNED" CONCEPTUAL. 3BCW # 3BXG XNON 3CC6 LDX 2 FX2 3CWQ LDX 3 AWORK2(2) [PTR.TO THE 1ST CONCEPTUAL CELL 3DBB LDX 4 3 [NO OF THE RECORD WHICH CONTAINS THE 3DW2 SRL 4 9 [1ST CELL OF THE TO BE CANCELLED 3F*L ANDN 4 #777 [CONCEPTUAL 3FT= STO 4 ACOMMUNE3(2) 3G#W CALL 7 XMXB [X2-ABSOLUTE POINTER TO THE RECORD 3GSG ANDN 3 #777 [X3-REL.PTR TO THE 1ST CONCEP.CELL 3H#6 LDX 4 3 3HRQ ADX 3 2 [X3-ABS.PTR TO THE 1ST CONCEP,CEL 3J?B LDX 5 7(3) [X5-PTR TO THE 2ND CONCEP CELL 3JR2 BPZ 5 SARE [WHEN 2ND CONCEP,CELL IN THE SAME 3K=L [REC.JUMP ELSE SEARCH FOR ANOTHER 3KQ= LDXC 0 5 3L9W SRL 0 9 [NEXT REC.NO 3LPG SMO FX2 3M96 STO 0 ACOMMUNE3 3MNQ CALL 7 XMXB [X2-ABS,PTR TO THE NEXT REC 3N8B SARE LDEX 1 5 3NN2 LDX 3 4 [X3-REL.PTR TO THE 1ST CONCEP CELL 3P7L ADX 1 2 [ABS. PTR TO THE 2ND CONCEPT CELL 3PM= LDX 0 0(1) [IS USERNAME PRESENT? 3Q6W BZE 0 SECNO 3QLG # 3R66 LDN 5 0(1) [MOVE USERNAME FROM 2ND CONCEPT CELL 3RKQ SMO FX2 [TO ACOMMUNE1,2,3 3S5B LDN 6 ACOMMUNE1 3SK2 MOVE 5 3 3T4L LDX 4 BRECNO(2) [PRESERVE REC.NO 3TJ= SETNCORE 10,1,FILE,FABSNB [CREATE FILE FABSNB 3W3W LDN 0 10 3WHG STO 0 A1(1) 3X36 STOZ A1+7(1) 3XGQ STOZ A1+8(1) 3Y2B STOZ A1+9(1) 3YG2 LDN 5 ACOMMUNE1(2) [MOVE USERNAME 3Y^L LDN 6 A1+1(1) 3^F= MOVE 5 3 3^YW STO 4 ACOMMUNE3(2) [X2 ABS POINTER TO THE RECORD 42DG NEW 2 42Y6 ADX 2 3 43CQ LDN 5 1(2) [MOVE CONCEP,FILE NAME 43XB LDN 6 A1+4(1) 44C2 MOVE 5 3 44T5 ...X3DELCON [ ENTRY FROM M/C B TO DO 'ERASE' 44WL ERASE 45B= # 45TW # ROUTINE TO FIND THE CELL IN THE CONCEPTUAL LIST WHICH 46*G # POINTS TO THE CONCEPTUAL WHICH WE ARE FREEING 46T6 # 47#Q SECNO LDN 3 BCONT 47SB SMO FX2 48#2 STOZ ACOMMUNE3 48RL XM CALL 7 XMXB [HUNT REC. 49?= SMO 3 49QW LDXC 6 0(2) [X6 = PTR. TO NEXT CONCEPTUAL 4==G LDEX 5 6 [X5 = CELL POINTER. 4=Q6 XTS SMO FX2 4?9Q TXU 6 AWORK2 [J. IF EQUAL TO THE ONE TO BE FREED 4?PB BCC XIT 4#92 SBX 6 5 [X6=REC.NO. OF NEXT CONCEPTUAL. 4#NL LDX 3 5 [X3=CELL PTR. OF NEXT CONCEPTUAL 4*8= SRL 6 9 4*MW SMO FX2 4B7G STO 6 ACOMMUNE3 [ST. REC.NO. 4BM6 BRN XM [J. BACK FOR NEXT PTR. 4C6Q XIT LDX 6 BRECNO(2) [LD.REC.NO. 4CLB SLL 6 9 4D62 ADX 6 3 [AD. IN CELL PTR. 4DKL SMO FX2 4F5= STO 6 AWORK1 [ST. REC.NO. AND CELL PTR IN AWORK1 4FJW # 4G4G # GO THROUGH FREEING CELLS CONNECTED TO THIS CONCEPTUAC 4GJ6 # 4H3Q XHT SMO FX2 4HHB LDX 3 AWORK2 [LD. PTR. TO CONCEPTUAL TO BE FREED. 4J32 LDX 6 3 [BIT 0 IS NEVER SET. 4JGL SRL 6 9 4K2= SMO FX2 4KFW STO 6 ACOMMUNE3 [ST. REC.NO. FOR HUNT. 4K^G CALL 7 XNEWMXB [HUNT REC. IN CORE. 4LF6 ANDN 3 #777 [X3= CELL PTR. 4LYQ ADN 3 7 4MDB ADX 3 2 [X3= PTR. TO LAST WD. IN BASE OF CONC 4MY2 XHTA LDXC 6 0(3) 4NCL BCS XAP [J. IF -VE. AS IN ANOTHER REC. 4NX= XAB ANDN 6 #777 [X6 = CELL PTR. 4PBW SMO 6 [X2 = ABSOLUTE PTR. TO CELL. 4PWG LDXC 4 7(2) [LD. LAST WD. OF CELL 4QB6 LDN 0 0 [CLEAR C IF SET. 4QTQ SMO FX2 4R*B STO 4 AWORK4 [ST. PTR. TO NEXT CELL IN AWORK4. 4RT2 SMO FX2 4S#L LDX 3 AWORK2 [LD. PTR. FROM AWORK2 4SS= LDXC 6 3 4T?W SRL 6 9 4TRG SMO FX2 4W?6 STO 6 ACOMMUNE3 [REC.NO. FOR HUNT 4WQQ CALL 7 XNEWMXB [HUNT REC. IN CORE 4X=B ANDN 3 #777 4XQ2 ADN 3 7 [X3=PTR. TO LAST WD. OF CELL 4Y9L SMO FX2 4YP= LDX 6 AWORK4 [LD. NEXT CELL TO BE FREED 4^8W CALL 7 XFREECELL [FREE CELL 4^NG BZE 6 XFR [J. END OF CHAIN. 5286 LDX 7 6 [MUST BE +VE. 52MQ SRL 7 9 537B BXE 7 BRECNO(2),XST4 [J. IF EQUAL TO CONCEPT REC.NO. 53M2 LDCT 7 #400 [LD. INDICATOR. 546L ADX 6 7 [SET INDICATOR TO SAY IN ANOTHER REC. 54L= XST4 ADX 3 2 555W STO 6 0(3) [CELL 55KG BRN XHTA [J. BACK 5656 XAP LDX 3 6 [IN ANOTHER REC. 56JQ SRL 6 9 [BUT X6 IS +VE. 'COS OF LDXC. 574B SMO FX2 57J2 STO 6 ACOMMUNE3 [ST. REC.NO. 583L CALL 7 XMXB [HUNT REC. 58H= LDX 6 3 [X6=CELL PTR. 592W BRN XAB 59GG XFR LDX 2 FX2 [END PIECE TO FREE THE BASE CONCEPT. 5=26 LDX 3 AWORK1(2) [PTR. TO CELL BEFORE CONCEPT. IN AWK1 5=FQ LDXC 6 3 5=^B SRL 6 9 5?F2 STO 6 ACOMMUNE3(2) 5?YL CALL 7 XNEWMXB [HUNT FOR REC. 5#D= ANDN 3 #777 [X3=CELL PTR. 5#XW CALL 7 XFREECELL [FREE CELL 5*CG XEND CALL 6 SUBWRITE 5*X6 MFREE CPB,CUNI [FREE PARAMETER BLOCK 5BBQ ENDCOM 5BWB # 5CB2 # ROUTINE TO GO DOWN THROUGH CONCEPTUAL FREEING PTRS. 5CTL # 5D*= XUSE 5DSW SBX 0 FX1 5F#G LDX 2 FX2 5FS6 STO 0 ACOMMUNE6(2) [STORE LINK 5G?Q STOZ ACOMMUNE4(2) 5GRB ADX 5 5 5H?2 SETUPCORE 5,3,IDF,CONCEP 5HQL SRL 5 1 5J== XUA STO 5 AWORK1(2) [ST. IN AWORK1 NO. OF LINES USED 5JPW STOZ ACOMMUNE1(2) 5K9G LDX 3 AWORK2(2) [LD. WD. CONTAIN PTR TO CONCEPT NAME 5KP6 STO 3 AWORK3(2) [ST. ABOVE 5L8Q LDX 0 AWORK4(2) 5LNB STO 0 ACOMMUNE5(2) [FOR A NEW CONCEPTUAL 5M82 LDXC 4 3 5MML SRL 4 9 5N7= STO 4 ACOMMUNE3(2) [ST. REC NO. 5NLW CALL 7 XMXB [HUNT REC. 5P6G ANDN 3 #777 [MASK OUT CELL PTR 5PL6 ADX 3 2 5Q5Q # 5QKB SMO FX2 5R52 LDX 0 ACOMMUNE4 5RJL BZE 0 VYFR 5S4= STOZ 5(3) [CLEAR NO OF ATTACHED LINES 5SHW VYFR LDX 0 4(3) 5T3G SMO FX2 [SIZE OF THE ORIGINAL CONCEPTUAL 5TH6 STO 0 AWORK4 5W2Q LDN 4 2 [SET MARKER 5WGB RYSA LDN 1 7(3) [ONE MUST FIND IN MARK6 THE SECOND 5X22 LDX 3 0(1) [SUBSIDIARY CELL BECAUSE THE 5XFL SMO FX2 5X^= STO 3 AWORK3 5YDW BPZ 3 RFRAN [CONCEPTUAL CELL SUBSIDIARY POINTERS 5YYG LDXC 5 3 [START THERE 5^D6 SRL 5 9 5^XQ SMO FX2 62CB STO 5 ACOMMUNE3 62X2 CALL 7 XMXB 63BL RFRAN ANDN 3 #777 [CREATE ABSOLUTE ADDRESS OF THE 63W= ADX 3 2 [1ST WORD OF THE 2ND SUBSIDIARY 64*W BCT 4 RYSA [J. BACK TO STEP OVER USER NAME CELL. 64TG # 65*6 SMO FX2 [IN TOP BITS POSITION IN THE CELL 65SQ LDX 6 AWORK4 [IN THE BOTTOM BITS IS THE SIZE OF 66#B [THE ORIGINAL CONCEPTUAL 66S2 LDN 1 0(3) [LOAD POINTER TO THE 1ST WORD 67?L BRN XUS [OF SUSIDIARY CELL 67R= # 68=W XUSEA LDX 7 BRECNO(2) [LD. REC.NO. 68QG SMO FX2 69=6 STO 7 ACOMMUNE3 [ACOMMUNE3 = CURRENT REC.NO. 69PQ XUS LDX 3 0(1) [LD. PTR. TO LINE. 6=9B SMO FX2 6=P2 LDX 0 ACOMMUNE4 6?8L BZE 0 XUAB 6?N= STOZ 0(1) [STOZ PTR. 6#7W XUAB BPZ 3 XUSA [IN THIS REC 6#MG LDXC 5 3 [MASK OUT REC. NO. 6*76 SRL 5 9 6*LQ SMO FX2 6B6B STO 5 ACOMMUNE3 [ST. NEW REC.NO. 6BL2 XUSA BZE 3 XUSX 6C5L ANDN 3 #777 6CK= CALL 7 XMXB [HUNT FOR REC. 6D4W ADX 3 2 [X3=PTR.TO CELL. 6DJG SMO FX2 6F46 LDX 0 ACOMMUNE4 6FHQ BZE 0 XAAX 6G3B STOZ CONTCEP(3) [ZEROISE PTR. TO CONCEP. IN LINE CELL 6GH2 XUSX LDX 2 FX2 6H2L LDX 1 FX1 6HG= LDX 6 AWORK4(2) [AWORK=POSIT.DOWN CELL/CT.OF NO. LNS 6H^W LDCT 7 #700 6JFG ANDX 6 7 [MASK OUT POSITION DOWN CELL. 6J^6 SLC 6 3 6KDQ ADN 6 1 [INCREASE CT. BY ONE. 6KYB LDN 7 7 [POSITION DOWN CELL. 6LD2 SBX 7 6 6LXL BZE 7 XABX [REACHED THE END OF A CELL. 6MC= LDX 0 6 6MWW SRC 6 3 6NBG LDX 4 AWORK4(2) 6NW6 ANDX 4 MASK+2(1) [MASK OUT TOP BITS 6P*Q SBN 4 1 6PTB BZE 4 XITA 6Q*2 ADX 4 6 [ADD IN NEW PTR. DOWN CELL 6QSL LDX 6 0 6R#= STO 4 AWORK4(2) 6RRW BZE 3 XUX 6S?G LDN 7 1 6SR6 SBS 7 AWORK1(2) [DECREASE CT. OF NO. LINES USED 6T=Q LDX 7 AWORK1(2) 6TQB BZE 7 XITA [J. BACK IF ZERO WE HAVE UNSET ALL PT 6W=2 XUX LDX 3 AWORK3(2) 6WPL LDXC 5 3 [MASK OUT REC. NO. 6X9= SRL 5 9 6XNW STO 5 ACOMMUNE3(2) [ST. REC.NO. 6Y8G ANDN 3 #777 6YN6 CALL 7 XMXB 6^7Q ADX 3 2 6^MB LDX 1 6 7272 ADX 1 3 72LL BRN XUSEA 736= XITA SMO FX2 73KW LDX 0 ACOMMUNE4 745G BZE 0 XJOHN 74K6 SMO FX2 754Q LDX 0 ACOMMUNE5 75JB SMO FX2 7642 STO 0 AWORK4 76HL SMO FX2 773= LDX 0 ACOMMUNE6 77GW ADX 0 FX1 782G EXIT 0 0 78G6 XAAX MHUNTW 2,IDF,CONCEP [ 78^Q LDX 6 BTYPE(3) 79FB SMO FX2 79^2 LDX 7 ACOMMUNE1 7=DL SMO 7 7=Y= STO 6 A1(2) 7?CW LDX 6 BNO(3) 7?XG SMO 7 7#C6 STO 6 A1+1(2) 7#WQ LDN 7 2 7*BB SMO FX2 7*W2 ADS 7 ACOMMUNE1 7B*L BRN XUSX 7BT= XJOHN 7C#W LDX 2 FX2 7CSG LDX 0 ACOMMUNE5(2) 7D#6 STO 0 AWORK4(2) 7DRQ ... DOWN DETACHB,1 7F?B LDX 3 AWORK2(2) 7FR2 LDX 4 3 7G=L SMO FX1 7GQ= ANDX 4 MASK 7H9W SRL 4 9 7HPG STO 4 ACOMMUNE3(2) 7J96 CALL 7 XMXB 7JNQ ANDN 3 #777 7K8B SMO 3 7KN2 LDX 5 5(2) 7L7L LDX 2 FX2 7LM= STO 5 ACOMMUNE4(2) [SET PTR. THE OTHER WAY. 7M6W BRN XUA 7MLG [THIS PIECE IS FOR GETTING ANOTHER 7N66 XABX LDX 4 AWORK4(2) [CONCEPTUAL CELL. 7NKQ ANDX 4 MASK+2(1) [ZEROISE PTR. DOWN CELL 7P5B SBN 4 1 7PK2 BZE 4 XITA 7Q4L STO 4 AWORK4(2) 7QJ= BZE 3 XAX 7R3W LDN 7 1 7RHG SBS 7 AWORK1(2) [DECREASE CT. OF NO. LINES USED 7S36 LDX 7 AWORK1(2) 7SGQ BZE 7 XITA [WE HAVE REACHED THE END OF LNS. USED 7T2B XAX LDX 3 AWORK3(2) [LD.PTR. TO CURRENT CELL. 7TG2 LDX 5 3 7T^L ANDX 5 MASK(1) [MASK OUT REC NO. 7WF= SRL 5 9 7WYW STO 5 ACOMMUNE3(2) [ST. REC.NO. 7XDG ANDN 3 #777 7XY6 CALL 7 XMXB [HUNT FOR CELL 7YCQ SMO 2 7YXB LDX 4 7(3) 7^C2 LDX 3 4 7^WL ANDX 4 MASK(1) 82B= SRL 4 9 82TW SMO FX2 83*G STO 4 ACOMMUNE3 83T6 CALL 7 XMXB [HUNT REC. 84#Q LDX 4 BRECNO(2) [LD. REC.NO. 84SB SLL 4 9 85#2 ANDN 3 #777 [X3=CELL PTR. 85RL ADX 4 3 86?= SMO FX2 86QW STO 4 AWORK3 [ST. CURRENT REC.NO./CELL PTR. 87=G ADX 3 2 87Q6 LDN 1 0(3) 889Q BRN XUS 88PB X2DELCON 8992 CALL 0 XUSE 89NL UP 8=8= # 8=MW # 8?7G SUBWRITE [SUBROUTINE TO WRITE AWAY ALTERED BLOCKS. 8?M6 SBX 6 FX1 8#6Q IDFWRITE 8#LB CLOSE 8*62 ADX 6 1 8*KL EXIT 6 0 8B5= # 8BJW # 8BN2 ...ZBRKINI 8BR6 ... COMBRKIN 8BW= ...[ 8B^B ...[ 8C4G XCOM1 LDX 5 ZJSETP1(1) [EXPRESSION INVALID 8CJ6 BRN XCOMERR1 8D3Q XCOM2 LDX 5 ZJPARAM(1) [ERROR PARAMETER MISSING 8DHB LDX 7 ZJPARNAM(1) [SUBMESSAGE - NO NAME 8F32 COMERRX 5,7 8FGL XCOM3 LDX 5 ZJDELEX(1) [ERROR - DOES NOT EXIST 8G2= BRN XCOMERR 8GFW XCOM4 LDX 5 ZJDELON(1) [ERROR CONCEPT/UNIT ONLINED. 8G^G XCOMERR 8HF6 CALL 6 SUBWRITE 8HYQ XCOMERR1 8JDB COMERRX 5 8JY2 # 8KCL # 8KX= # 8LBW MENDAREA 50,K100DELCON 8LWG # 8MB6 # 8MTQ # 8N*B #END ^^^^ ...51550432000200000000