{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: DELCON867)}}
====== DELCON867 ======
(George Source)
**Macros used:** [[george:macro:BXE|BXE]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERASE|ERASE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:MASK|MASK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREECELL|MFREECELL]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MNAME|MNAME]], [[george:macro:MXB|MXB]], [[george:macro:NEW|NEW]], [[george:macro:NEWMXB|NEWMXB]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:UP|UP]]
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