CONCEPT85
(George Source)
Macros used: BXE, BXGE, BXL, CHEKLFN2, CHNUMCOD, CLOSE, COMBRKIN, COMERR, COMERRX, DOWN, ENDCOM, FNORM, FREECORE, FSCON, FSHCODE, GEOERR, GSCAN, IDFOPEN, IDFWRITE, MASK, MENDAREA, MFREE, MFREECELL, MFREEW, MGETCELL, MHUNT, MNAME, MONOUT, MXB, NAMETOP, NEWMXB, OPEN, OUTBLOCN, OUTPARAM, PARALYSE, PARAPASS, READLEX, SEG, SEGENTRY, SETNCORE, SPARABEG, SPARANOT, TESTNAME, TESTREP, TESTREP2, TESTREPNOT, TRACE, USEROPEN
- CONCEPT85.txt
22FL #OPT K0CONCEPT=0 22^= #OPT K6CONCEPT=0 23DW #LIS K0CONCEPT>K0ALLGEO>K0GREATGEO>K0COMMAND 23YG SEG CONCEPT,,PHIL TURNER 24D6 # 24XQ SEGENTRY K1CONCEPT,X1CONCEPT 25CB SEGENTRY K2CONCEPT,X2CONCEPT 25X2 # 26BL # THIS SEGMENT DEALS WITH WITH THE CONCEPTUAL COMMAND 26W= # 27*W MASK #37777000 27TG #77770000 28*6 #37777777 28SQ XINCR #1000 29#B XPBLK +0 29S2 X65 +64 2=?L XSAVE +0 2=R= XREPL 4HREPL 2?=W MASK1 #00010000 2?QG ZJPARAM +JPARMIS 2#=6 ZJPARNAM +JPARNAM 2#PQ ZJPARGEO +JPARGEO 2*9B ZJSETP1 +APFERR 2*P2 ZJDELON +JDELON 2B8L ZJOURA +JOURA 2BN= ZHALRDEF +HALRDEF 2C7W # 2CMG PFOTNALE +FOTNALE 2D76 PJNLFNF +JNLFNF 2DLQ XDICT +10 2F6B 8HMASTER 2FL2 SPACE 4H 2G5L 12HLEXICON 2GK= +1 2H4W +1 2HJG 4HB1 2J46 NMODES +4 2JHQ XERNOUSER +ERNOUSER ['USER NAME NOT FOUND' 2JNY ... FSHCODE AORB 2JW6 ...SLANG 4HBBBB 2K3B # 2KH2 # 2L2L PARAM 2LG= SBX 5 FX1 2L^W SPARAPASS 2MFG MHUNT 3,CPB,CUNI 2M^6 ADX 5 FX1 2NDQ LDX 2 ANUM(3) 2NYB BNG 2 PAR1 [NO PARAMETER 2PD2 BZE 2 PAR1 [NULL PARAMETER 2PXL EXIT 5 1 2QC= PAR1 2QWW LDX 2 FX2 2RBG EXIT 5 0 [ERROR EXIT 2RW6 # LOCATE UNIT OR LINE 2S*Q PASS SBX 7 FX1 2STB MHUNT 3,CPB,CUNI 2T*2 CHNUMCOD ,3 2TSL TESTREP CHNUMERR,XEND1 2W#= ADX 7 FX1 2WRW MHUNT 3,CPB,CUNI 2X?G EXIT 7 0 2XR6 # 2Y=Q XGETCELL 2YQB SBX 7 FX1 2^=2 MGETCELL 2,3 2^PL ADX 7 FX1 329= EXIT 7 0 32NW XCHECK 338G SBX 7 FX1 [ROUTINE TO CHECK NAME. 33N6 MNAME 2,3 347Q ADX 7 FX1 34MB EXIT 7 0 3572 SUBWRITE 35LL SBX 6 FX1 366= IDFWRITE 36KW CLOSE 375G ADX 6 FX1 37K6 EXIT 6 0 384Q # 38JB # MAIN PART OF ANALYSING COMMAND. 3942 # 39HL X1CONCEPT 3=3= XPARAM 3=GW CALL 5 PARAM [CONCEPTUAL NAME PARAMETER- 3?2G BRN XCOM1 [ERROR NO CONCEPTUAL NAME PARAMETER 3?G6 LDCH 4 APARA(3) 3?^Q SBN 4 #41 3#FB BNG 4 XCOM5 [ERROR NAME DOES NOT BEGIN WITH CHAR. 3#^2 SBN 4 #73-#41 3*DL BPZ 4 XCOM5 3*Y= SRL 2 2 [X2=NO. OF CHARS. IN COMMAND. 3BCW SBN 2 4 3BXG BPZ 2 XCOM5 [ERROR NAME > 3 WDS. 3CC6 CALL 5 PARAM [FIND LINE NO. PARAMETER 3CWQ BRN RX1 [NULL OR NO PARAMETER 3DBB SRL 2 12 3DW2 BZE 2 RX2 [J IF SINGLE PAR.-NO OF LINES OR 3F*L SBN 2 3 [IDENTIFIERS 3FT= BZE 2 RX3 [J IF QUAL.PAR. - LOWEST IDENTIFIER 3G#W BRN XCOM5 [OR LINE NO (NO OF L/I) 3GSG RX3 FREECORE 3 3H#6 LDN 6 2 3HRQ PARALYSE ,,6 [SPLIT N(M) INTO CMULTI 3HWW ...#UNS ANSTOOMANY 3J22 ... TESTREP2 TOOMANY,TOMP,UNPAIR,RSW 3J56 ...#UNS ANSTOOMANY 3J8= ...#SKI 3J?B TESTREP UNPAIR,RSW 3JR2 PARAPASS [N INTO CUNI 3K=L CALL 7 PASS [TRANSFORM DECIMAL INTO BINARY 3KQ= LDX 4 ACOMMUNE1(2) [STORE N 3L9W BZE 4 XCOM3 3LPG BNG 4 XCOM3 3M96 LDX 0 4 3MNQ SBN 0 #7777 3N8B BZE 0 RXX1 3NN2 BNG 0 RXX1 3P7L BRN XCOM3 3PM= RXX1 3Q6W FREECORE 3 3QLG PARAPASS 3R66 MHUNT 3,CPB,CMULTI 3RKQ FREECORE 3 3S5B BRN RX4 3SK2 # 3T4L SRSW SBX 7 FX1 3TJ= SPARANOT 2 3W3W ADX 7 FX1 3WHG EXIT 7 0 3X36 # 3XGQ RX2 LDN 4 1 3Y2B RX4 CALL 7 PASS 3YG2 LDX 0 ACOMMUNE1(2) [NO OF LINES/IDENTIFIERS 3Y^L BZE 0 XCOM3 3^F= BNG 0 XCOM3 3^YW ADX 0 4 42DG SBN 0 #7777 42Y6 BPZ 0 RX9 43CQ RX10 ADN 0 #7777 43XB SBX 0 4 44C2 BRN RX5 44WL RX9 BZE 0 RX10 45B= CALL 7 SRSW 45TW BRN XCOM3 46*G RX1 LDN 4 1 46T6 LDN 0 1 47#Q RX5 SLL 0 12 47SB ORX 4 0 [IN AWORK4 B0-B11 NO OF L/I 48#2 STO 4 AWORK4(2) [B12-B23 LOWEST L/I NO 48RL FREECORE 3 49?= #SKI K6CONCEPT>199-199 49QW TRACE 4,NOCONLIN 4==G # 4=Q6 # 4?9Q LDN 4 1 4?PB LDCT 5 #120 [4H: 4#92 STOZ 6 4#NL SPARABEG 1,4,5,6 [FIND USERNAME 4*8= CHEKLFN2 NUSEN,NLF [CHECK WHETHER THE USERNAME EXISTS 4*MW [AND HAS THE LOCAL FILE NAME FORMAT 4B7G #SKI K6CONCEPT>199-199 4BM6 TRACE 2,USER 4C6Q BRN USNEX 4CLB NUSEN 4D62 STOZ CPREFIX(2) [STOZ THE LOCATIONS WHERE SHOULD 4DKL STOZ CPREFIX+1(2) [BE THE USERNAME IN CPA 4F5= STOZ CPREFIX+2(2) 4FJW #SKI K6CONCEPT>199-199 4G4G TRACE CPREFIX(2),NOUSER 4GJ6 BRN RZ2 4H3Q # 4HHB # AT THIS POINT THERE MUST AFTER CPA EXIST CPB/CUNI BLOCK WITH 4J32 # THE CONCEPTUAL NAME AND CPB/CUNI BLOCK WITH USERNAME OR ZEROIZED 4JGL # APARA WHEN USERNAME NULL OR MISSING 4K2= # AWORK4 CONTAINS THE CONVERTED NO. 4KFW # 4K^G # OPEN A DUMMY FILE NAMED AFTER CONCEPTUAL MPX UNDER 4LF6 # THE USER DIRECTORY.USER NAME STORE IN CPA 4LYQ USNEX 4MDB SETNCORE 3,3,FILE,ADICT [SET UP A BLOCK FOR THE USERNAME 4MY2 [EXISTENCE CHECK 4NCL LDX 4 ACES 4NX= STO 4 CPREFIX(2) [SPACEFILE FILE USERNAME AREA IN 4PBW STO 4 CPREFIX+1(2) [CPA 4PWG STO 4 CPREFIX+2(2) 4QB6 STO 4 A1(3) [SPACEFILE ADICT BLOCK 4QTQ STO 4 A1+1(3) 4R*B STO 4 A1+2(3) 4RT2 LDN 4 A1(3) 4S#L MHUNT 3,CPB,CUNI 4SS= LDX 5 ANUM(3) 4T?W ANDN 5 #7777 4TRG ADN 5 3 4W?6 SRL 5 2 [USERNAME INTO ADDICT BLOCK 4WQQ LDN 3 APARA(3) 4X=B SMO 5 4XQ2 MOVE 3 0 4Y9L LDN 4 CPREFIX(2) [USERNAME INTO CPA 4YP= SMO 5 4^8W MOVE 3 0 4^NG SETNCORE 10,3,FILE,FABSNB [SET UP THE FILE ABSOLUTE NAME BLOCK 5286 LDN 4 A1(3) 52MQ LDN 3 XDICT(1) 537B MOVE 3 10 [INSERT NAME OF DICTIONARY-LEXICON 53M2 OPEN XBREAK,READR 546L TESTREP OPEN,RDICT [OPEN THE LEXICON 54L= BRN XBREAK 555W RDICT MFREEW FILE,FABSNB [FREE THE BLOCK WITH LEXICON NAME 55KG READLEX 5656 TESTREP NOUSER,NOUSER [J IF THE USER NOT FOUND IN LEXICON 56JQ MFREEW FILE,ASELFLEX [FREE THE LEXICON ABSOLUTE NAME BLOCK 574B CLOSE 57J2 #SKI K6CONCEPT>199-199 583L GSCAN CPREFIX(2),USERNAME,3 58H= RZ2 MFREE CPB,CUNI [FREE USERNAME CUNI BLOCK 592W # USERNAME IS NOW IN CPA -CPEFIX,CPREFIX+1,CPREFIX+2 59GG # 5=26 # 5=5= ...#UNS IDFMARK8 5=8B ... IDFOPEN ZBRKINI 5=?G ...#UNS IDFMARK8 5=BL ...#SKI 5=FQ Z2 IDFOPEN 5=^B LDN 3 0 5?F2 XNA SMO FX2 5?YL STOZ ACOMMUNE1 5#D= CALL 7 XCHECK 5#XW SMO FX2 5*CG LDX 0 ACOMMUNE1 [TEST IF NAME EXISTS 5*X6 BNZ 0 XDEL [NAME ALREADY EXISTS 5BBQ BRN XGET 5BWB X2CONCEPT 5CB2 # SUBROUTINE TO MOVE NAME AND NO. OF NULL LINES INTO BASE 5CTL # BASE CELL. TO GET ENOUGH ZEROISED CELL TO ACCMODATE THE 5D*= # NULL LINES. 5DSW # 5F#G XGET 5FS6 #SKI K6CONCEPT>99-99 5G?Q ( 5GRB TRACE 3,CELLPOG 5H?2 TRACE 2,RECPOG 5HQL ) 5J== CALL 7 XGETCELL 5JPW LDX 4 BRECNO(2) [LOAD REC.NO FROM BASE CELL 5K9G SLL 4 9 5KP6 ADX 4 3 [AWORK2 WILL CONTAIN IN B0-B14 RECORD 5L8Q SMO FX2 [NO OF RECORD CONTAINIG A FREE CELL, 5LNB STO 4 AWORK2 [B15-B23 RELATIVE ADDR OF THE FREE 5M82 [CELL IN THE RECORD 5MML ADX 3 2 [ADD TO THE POINTER TO THE RECORD 5N7= LDX 4 ACES [CONTAINING A FREE CELL THE RELATIVE 5NLW STO 4 1(3) [ADDR.OF A FREE CELL IN THE RECORD 5P6G LDN 4 1(3) [SPACEFILE WORDS 1-3 OF THE 5PL6 LDN 5 2(3) [CONCEPTUAL CELL 5Q5Q MOVE 4 2 5QKB MHUNT 1,CPB,CUNI [BLOCK WITH CONCEPTUAL NAME 5R52 LDN 5 1(3) 5RJL LDN 4 APARA(1) 5S4= LDX 0 ANUM(1) 5SHW ADN 0 3 [MOVE THE CONCEPTUAL NAME FROM 5T3G SRL 0 2 [CPB/CUNI INTO WORDS 1-3 OF THE 5TH6 SMO 0 [CONCEPTUAL CELL 5W2Q MOVE 4 0 5WGB SMO FX2 [STORE THE SIZE OF THE 5X22 LDX 4 AWORK4 [CONCEPTUAL IN WORD 4 5XFL LDX 0 4 5X^= ANDN 0 #7777 5YDW SBN 0 1 [IF LOWEST IDE/LINE NO EQ 1,THAN 5YYG BNZ 0 XZ1 [NEUTRAL CONCEPTUAL 5^D6 LDN 0 1 [OTHERWISE MARKED DEFAULT IPB 5^XQ BRN XZ2 62CB XZ1 LDX 0 4 62X2 ANDN 0 #7777 63BL ORX 0 GSIGN 63W= XZ2 STO 0 6(3) [LOWEST IDE/LINE NO 64*W SRL 4 12 64TG STO 4 4(3) 65*6 # 65SQ # 66#B SBX 3 2 [SPLIT AGAIN THE POINTER TO THE 66S2 [CURRENT RECORD FROM THE POINTER TO 67?L ADN 3 CELLEN-1 [THE CELL.DEFINE IN CURRENT CELL 67R= CALL 7 XGETCELL [WHERE THE POINTER TO THE NEXT CELL 68=W ADX 3 2 [SHOULD BE PUT - CREATE SUBSIDIARY 68QG SMO FX2 [CELL. HUNT FOR USERNAME 69=6 LDX 0 CPREFIX 69PQ BZE 0 XNOUN [BRANCH IF NOT USERNAME 6=9B LDN 5 0(3) 6=P2 SMO FX2 [MOVE THE USERNAME FROM CPA 6?8L LDN 4 CPREFIX [INTO SUBSIDIARY CELL 6?N= MOVE 4 3 6#7W XNOUN SMO FX2 6#MG LDX 4 AWORK4 [LOAD NO.OF CONCEPT LINES 6*76 SRL 4 12 6*LQ # 6B6B # 6BL2 # 6C5L XPXA SBX 3 2 [CREATE ANOTHER SUBSIDIARY 6CK= ADN 3 CELLEN-1 6D4W CALL 7 XGETCELL 6DJG ADX 3 2 6F46 SBN 4 CELLEN-1 6FHQ BNG 4 XIT1 6G3B BNZ 4 XPXA 6GH2 XIT1 6H2L # 6HG= # 6H^W SMO FX2 6JFG LDX 0 CPREFIX [IS THEIE A USERNAME? 6J^6 BZE 0 XEND 6KDQ MHUNT 2,CPB,CUNI 6KYB NAMETOP 2,FILE,FNAME [CREATE A RANDOM ACCESS FILE UNDER 6KYJ ... FSHCODE AORB 6KYQ ...( 6KYY ... FNORM [ CONVERT TO /FABSNB SO THAT LANG. 6K^6 ... MHUNT 3,FILE,FNAME 6K^# ... NAMETOP 3,CPB,CUNI 6K^G ... MHUNT 3,FILE,FABSNB [ CODE MAY BE SET FOR EACH M/C .... 6K^N ... FSHCODE A,XFSHA1 6K^W ...( 6L24 ... LDX 0 ACES 6L2= ... STO 0 A1+9(3) [ SET LANGUAGE CODE SPACES FOR M/C A 6L2D ...XFSHA1 6L2L ...) 6L2S ... FSHCODE B,XFSHB1 6L32 ...( 6L38 ... LDX 0 SLANG(1) [ SET LANGUAGE CODE 'BBBB' FOR M/C B 6L3B ... STO 0 A1+9(3) 6L3J ...XFSHB1 6L3Q ...) 6L3Y ...) 6L4? ...#UNS FTS1 6L88 ... USEROPEN XBRK,WRITE,CREATE,FROZEN 6L#5 ...#SKI FTS1<1$1 6LD2 USEROPEN XBRK,WRITE,CREATE [CREATE A RANDOM ACCESS FILE UNDER 6LXL TESTREPNOT OK,RERR [USER'S DIRECTORY NAMED AFTER 6MC= LDN 4 100 [THE CONCEPTUAL AND CONTRACT IT TO 6MWW FSCON 4,RSSS [NULL SIZE 6NBG RSSS CLOSE 6NW6 BRN XEND 6P*Q # 6PTB # 6Q*2 XCOM1 6QSL LDX 5 ZJPARAM(1) [PARAMETER MISSING 6R#= LDX 7 ZJPARNAM(1) [SUBMESSAGE - NAME. 6RRW BRN XCOMERR1 6S?G XCOM3 6SR6 LDX 5 ZJOURA(1) [COUNT OUT OF RANGE. 6T=Q BRN XCOMMERR1 6TQB XCOM4 6W=2 LDX 5 ZJDELON(1) [CONCEPT/UNIT IS ONLINED. 6WPL BRN XCOMMERR 6X9= RSW CALL 7 SRSW 6XNW XCOM5 LDX 5 ZJSETP1(1) [EXPRESSION INVALID 6Y8G BRN XCOMMERR1 6YN6 XCOM6 6^7Q LDX 5 ZHALRDEF(1) [EXIST BUT CANNOT BE DETACHED 6^MB BRN XCOMMERR 7272 XCOMERR 72LL CALL 6 SUBWRITE 736= XCOMERR1 73KW COMERRX 5,7 [ERROR WITH SUBMESSAGE 745G XCOMMERR 74K6 CALL 6 SUBWRITE 754Q XCOMMERR1 75JB COMERRX 5 [ERROR WITH MESSAGE FROM CPB/CUNI 7642 # 76HL # 773= RERR LDX 5 PFOTNALE(1) [FILE UNDER THIS NAME ALREADY 77GW CLOSE 782G BRN XCOMMERR1 78G6 NLF LDX 7 PJNLFNF(1) [NOT LOCAL NAME 78^Q NGN NGN 6 1 79FB XERR COMERRX 7,6 79^2 XBREAK 7=DL GEOERR 1,NOBRKIN [NO BREAKIN POSSIBLE WHILE OPENING 7=Y= NOUSER [THE DICTIONARY 7?CW CLOSE [CLOSE THE LEXICON 7?XG LDX 4 XERNOUSER(1) ['USER NOT FOUND MESSAGE' 7#C6 XCOMR COMERRX 4 7#WQ XBRK COMBRKIN 7*6J ...TOMP COMERR JTOOMANY 7*BB # 7*W2 # 7B*L # 7BT= # THIS PART DEALS WITH THE CASE WHEN THERE IS A CONCEPTUAL AREADY 7C#W # WITH THE NAME OF THE CONCEPTUAL WE ARE TRYING TO SET UP. IF ANY OF 7CSG # THE LINES HAVE BEEN USE WE GO OFF AND UNSET THEM. IF NOT WE USE 7D#6 # THE CELLS ALREADY SETUP FOR OUR NEW CONCEPTUAL. 7DRQ # 7F?B MASKA #67777777 7FR2 XROUND 7G=L LDN 5 CELLEN-1 [ROUND UP NO OF L/I TO THE NEAREST 7GQ= BZE 4 XCX [MULTIPLE OF 7 7H9W ADN 4 CELLEN-2 7HPG DVS 3 5 7J96 LDX 3 4 7JNQ MPY 3 5 7K8B XCX LDX 3 4 7KN2 EXIT 7 0 7L7L # 7LM= XMXB 7M6W SBX 7 FX1 7MLG LDX 2 FX2 7N66 MXB 2 7NKQ ADX 7 FX1 7P5B EXIT 7 0 7PK2 XDEL [X3=PTR. TO CONCEPTUALS 7Q4L LDX 4 BRECNO(2) [LD. REC. NO OF CURRENT REC. 7QJ= SLL 4 9 7R3W ADX 4 3 7RHG ADX 3 2 [X3=PTR.(ABSOLUTE) TO CONCEPTUAL. 7S36 SMO FX2 7SGQ STO 4 AWORK2 [ST.PTR. TO NEW CONCEPT IN AWORK2 7T2B LDX 4 4(3) [SIZE OF CONCEPTUAL - OLD ONE 7TG2 BNG 4 XCOM4 [ERROR IF CONCEPTUAL ONLINE 7T^L SMO FX2 7WF= STO 4 AWORK1 7WYW SMO FX2 7XDG LDX 0 AWORK4 7XY6 LDX 4 0 7YCQ ANDN 4 #7777 [LOWEST IDE/LINE NO 7YXB SRL 0 12 [NO OF LINES/IDE 7^C2 SMO FX2 7^WL STO 0 AWORK4 82B= LDX 0 4 82TW SBN 0 1 83*G BZE 0 XZ5 83T6 ORX 4 GSIGN 84#Q XZ5 STO 4 6(3) 84SB LDX 5 5(3) 85#2 SMO FX2 85RL STO 5 AWORK3 [COUNT OF ATTACHED LINES 86?= LDX 5 7(3) [LOAD THE POINTER TO THE 1ST 86QW LDX 6 5 87=G BPZ 5 XKOZ [CELL IS IN THE SAME RECORD J ELSE 87Q6 [HUNT FOR ANOTHER RECORD 889Q # 88PB SMO FX1 8992 ANDX 5 MASK 89NL SRL 5 9 8=8= SMO FX2 8=MW STO 5 ACOMMUNE3 [THE ROUTINE FINDS THE NEW RECORD 8?7G CALL 7 XMXB [X2 POINTS TO THE BEGINNING 8?M6 # 8#6Q XKOZ LDEX 1 6 8#LB ANDN 1 #777 8*62 ADX 1 2 [X1-POINTER TO THE 1ST SUB.CELL 8*KL LDX 5 2 [STORE THE POINTER TO THE RECORD 8B5= LDX 2 FX2 [WHICH CONTAINS THE 1ST SUBSIDIARY 8BJW TESTNAME 3,0(1),CPREFIX(2) [COMPARE THE USERNAMES 8C4G BNZ 7 XKUN [IF THE SAME J 8CJ6 LDX 0 0(1) [IF THE USERNAME IN IDF EQUALS ZERO 8D3Q BZE 0 XKRAV 8DHB OUTBLOCN 8 [AS THE WARNING TO THE OPERATOR 8F32 MHUNT 2,CPB,CUNI [OUTPUT MESSAGE:CONCEPTUAL %A IS 8FGL LDX 4 ANUM(2) [ALREADY OWNED BY THE USER %B,CANCEL 8G2= ANDN 4 #7777 [THIS CONCEPTUAL AND REDEFINE IT FROM 8GFW OUTPARAM 4,APARA,CPB,CUNI [SCRATCH 8G^G MONOUT CONCRED 8HF6 ... BRN TCLND1 8HYQ XKRAV LDN 6 CPREFIX(2) 8JDB LDN 7 0(1) [MOVE USERNAME INTO IDF 8JY2 MOVE 6 3 8KCL MHUNT 2,CPB,CUNI 8KX= NAMETOP 2,FILE,FNAME [CREATE A RANDOM ACCESS FILE UNDER 8KXD ... FSHCODE AORB 8KXL ...( 8KXS ... FNORM [ CONVERT TO /FABSNB SO THAT LANG. 8KY2 ... MHUNT 3,FILE,FNAME 8KY8 ... NAMETOP 3,CPB,CUNI 8KYB ... MHUNT 3,FILE,FABSNB [ CODE MAY BE SET FOR EACH M/C..... 8KYJ ... FSHCODE A,XFSHA2 8KYQ ...( 8KYY ... LDX 0 ACES 8K^6 ... STO 0 A1+9(3) [ .. SPACES FOR M/C A 8K^# ...XFSHA2 8K^G ...) 8K^N ... FSHCODE B,XFSHB2 8K^W ...( 8L24 ... LDX 0 SLANG(1) 8L2= ... STO 0 A1+9(3) [ ... 'BBBB' FOR M/C B 8L2D ...XFSHB2 8L2L ...) 8L2S ...) 8L37 ...#UNS FTS1 8L74 ... USEROPEN XBRK,WRITE,CREATE,FROZEN 8L=^ ...#SKI FTS1<1$1 8LBW USEROPEN XBRK,WRITE,CREATE [CREATE A RANDOM ACCESS FILE UNDER 8LWG TESTREPNOT OK,RERR [USER'S DIRECTORY NAMED AFTER 8MB6 LDN 4 100 [THE CONCEPTUAL AND CONTRACT IT TO 8MTQ FSCON 4,RWWW [NULL SIZE 8N*B RWWW CLOSE 8NT2 XKUN SMO FX2 8P#L LDX 5 AWORK3 [IS ANY LINE ATTACHED? 8PS= BZE 5 XHUN 8Q?W DOWN DELCON,2 8QRG XHUN 8R?6 LDX 2 FX2 8RQQ LDX 4 AWORK1(2) [NO OF OLD LINES 8S=B BXE 4 AWORK4(2),XC [J. IF CTS.= 8SQ2 BXGE 4 AWORK4(2),XB [J. OLD > NEW 8T9L CALL 7 XROUND [CALL SUBROUTINE TO ROUND TO NEAREST 8TP= BXGE 3 AWORK4(2),XC [IS ENOUGH ROOM? X3=CELL-ROUND-UP 8W8W LDX 6 3 8WNG STO 6 AWORK1(2) [ST. CT. NO. LINES IN NEW. 8X86 ADN 6 7 8XMQ LDX 4 AWORK4(2) [LD. CT. OF NO. LINES IN NEW 8Y7B LDX 5 AWORK2(2) [LD. PTR. TO CONCEPTUAL NAME 8YM2 LDX 3 AWORK2(2) 8^6L ANDN 3 #777 [MASK OUT CELL PTR. 8^L= XBA SMO FX1 925W ANDX 5 MASK 92KG SRL 5 9 9356 SMO FX2 93JQ STO 5 ACOMMUNE3 [ST. REC.NO. 944B CALL 7 XMXB [HUNT REC.MAY BE THERE BUT NEAR END N 94J2 XBAA ADX 3 2 [X3 PTRS. TO CONCEPTUAL CELLS. 953L BZE 6 XBAB [J. IF THIS IS LAST CELL 95H= SBN 6 7 [DECREASE CT. BY 7 962W LDX 3 7(3) [LD. PTR. TO NEXT CELL IN LIST 96GG BPZ 3 XBBA [IN THIS REC. 9726 LDX 5 3 97FQ ANDN 3 #777 97^B BRN XBA [BRANCH BACK TO READ DOWN ANOTHER CEL 98F2 XBBA ANDN 3 #777 98YL BRN XBAA [BRANCH BACK IN THIS CELL. 99D= XBAB SMO FX2 99XW LDX 6 AWORK1 [LD. CT. OF NO. OF LINES USED 9=CG SBX 3 2 9=X6 ADN 3 7 [LD. PTR. 9?BQ XBABX CALL 7 XGETCELL [GET ANOTHER 9?WB ADN 6 7 9#B2 BXGE 6 4,XC [J. IF ENOUGH CELLS FOR ALL LINES 9#TL ADN 3 7 9**= BRN XBABX [J. BACK TO GET ANOTHER CELL 9*SW # 9B#G # THIS PART DEALS WITH THE CASE WHEN THE OLD CONCEPTUAL HAS MORE 9BS6 # LINES THAN THE NEW CONCEPTUAL. 9C?Q # 9CRB XB STO 4 AWORK1(2) [ST. NO.LINES IN OLD. 9D?2 LDX 4 AWORK4(2) [LD. NO.LINES IN NEW CONCEPTUAL. 9DQL CALL 7 XROUND [CALL ROUTINE TO ROUND-UP NEW 9F== BXE 3 AWORK1(2),XC [J IF ROUNDED NEW EQUALS OLD 9FPW LDX 7 AWORK1(2) [LD. NO. OF LINES IN OLD 9G9G BXL 7 3,XC [J IF OLD LESS THAN NEW ROUNDED UP 9GP6 ADN 3 5 9H8Q LDN 7 7 9HNB DVS 2 7 [DIVIDE NO OF NEW LINES AND X3 WILL 9J82 SMO FX2 [CONTAIN THE NO OF SUB.CELLS WHICH 9JML [ARE NECESSARY FOR THE NEW CONCEPTUAL 9K7= LDX 6 AWORK2 [LD.POINTER TO NEW CONCEPTUAL 9KLW ADN 3 1 [FOR MK 6 IS THE NO OF SUBSIDIARY 9L6G ADN 6 7 [POINTER TO THE END OF CONCEPTUAL CEL 9LL6 [AND REC.NO 9M5Q SMO FX2 9MKB STO 6 AWORK1 9N52 SBN 6 7 9NJL LDX 5 3 9P4= XDA 9PHW LDX 3 6 9Q3G LDX 1 FX1 9QH6 ANDX 6 MASK(1) 9R2Q SRL 6 9 9RGB SMO FX2 9S22 STO 6 ACOMMUNE3 9SFL CALL 7 XMXB 9S^= ANDN 3 #777 [MASK CELL PTR. 9TDW ADX 3 2 [X3= ABSOLUTE PTR. 9TYG LDXC 6 7(3) 9WD6 XDBA BZE 5 XD 9WXQ ADN 6 7 9XCB SMO FX2 9XX2 STO 6 AWORK1 [ST. NEXT PTR. 9YBL SBN 6 7 9YW= SBN 5 1 [DECREASE CT. OF NO. OF CELLS NEEDED. 9^*W BRN XDA 9^TG XREC SBX 0 FX1 [SUBROUTINE TO HUNT FOR REC./CELL PTR =2*6 SMO FX2 =2SQ STO 0 ACOMMUNE6 =3#B LDX 3 7 =3S2 SMO FX1 =4?L ANDX 7 MASK =4R= SRL 7 9 =5=W SMO FX2 =5QG STO 7 ACOMMUNE3 =6=6 CALL 7 XMXB =6PQ ANDN 3 #777 =79B SMO FX2 =7P2 LDX 0 ACOMMUNE6 =88L ADX 0 FX1 =8N= EXIT 0 0 =97W XD LDX 7 6 =9MG XDAA CALL 0 XREC ==76 SMO 2 ==LQ LDX 7 7(3) =?6B SMO 2 =?L2 STO 7 0(3) =#5L SMO FX2 =#K= LDX 7 AWORK1 [CALCULTE PTR. TO CELL BEFORE ONE TO =*4W CALL 0 XREC =*JG MFREECELL 2,3 [FREE CELL =B46 SMO 2 =BHQ LDX 7 0(3) =C3B BNZ 7 XDAA =CH2 XC SMO FX2 =D2L LDX 3 AWORK2 [LD. PTR. TO OLD CONCEPTUAL. =DG= LDX 5 3 =D^W SRL 5 9 =FFG SMO FX2 =F^6 STO 5 ACOMMUNE3 [ST. REC.NO. FOR MACRO. =GDQ NEWMXB 2 [HUNT FOR REC. =GYB ANDN 3 #777 =HD2 ADX 3 2 [X3=PTR. (ABSOLUTE) TO NEW/OLD CONCEP =HXL SMO FX2 =JC= LDX 5 AWORK4 [LD. CT. OF NO. OF LINES.TO BE IN NEW =JWW STO 5 4(3) [ST. CT. IN CONCEPT =KBG XEND CALL 6 SUBWRITE =KW6 MFREE CPB,CUNI =L*Q XEND1 ENDCOM =LCF ...[ =LF8 ...TCLND1 =LGX ... CLOSE =LJL ... BRN XEND1 =LL* ...[ =LN4 ...ZBRKINI =LPR ... COMBRKIN =LRG ...[ =LTB # =M*2 MENDAREA 30,K99CONCEPT =MSL # =N#= #END ^^^^ ...10633533000500000000