LOCATE84
(George Source)
Macros used: ANSOK2, BFCBX, BXE, BXGE, BXL, BXU, FINDEXB, FREECORE, GEOERR, JMBS, KEYRECI, LFRECNUM, MENDAREA, MHUNT, NAME, NEXTENT, PSTAC, READAGAIN, READDICT, READDICU, SEGENTRY, SETREP, SETREP2, SFSTACK, STEP, TRACE, UP, WIND
- LOCATE84.txt
22FL ...#SEG LOCATE84 [JUDY BIDGOOD 22^= #OPT K0LOCATE=K0OPEN>K0FILESTORE>K0ALLGEO 23DW #LIS K0LOCATE 23YG #OPT K6LOCATE=K6OPEN>K6FILESTORE>K6ALLGEO 24D6 8HLOCATE 24XQ SEGENTRY K2LOCATE,READDICU 25CB SEGENTRY K3LOCATE,SYSER 25X2 SEGENTRY K4LOCATE,SYSOUT 26BL SEGENTRY K5LOCATE,READDICT 26N2 ... SEGENTRY K7LOCATE,ZUSEJOB 26^B ... SEGENTRY K8LOCATE,ZSYSJOB 27=Q ... SEGENTRY K9LOCATE,USEJOB 27J6 ... SEGENTRY K10LOCATE,SYSJOB 27TG # 28*6 [ THIS SEGMENT IMPLEMENTS THE MACROS READDICT AND READDICU FOR INDEXED 28SQ [ DICTIONARY,SSEARCH FOR INDEXED SYSTEM.SERIAL AND GETSOUT FOR INDEXED 29#B [ SYSTEM.OUTPUT. 29S2 # ENTRY PTS ARE AS FOLLOWS :- 2=?L # K5LOCATE - READDICT 2=R= # K4LOCATE - GETSOUT 2?=W # K3LOCATE - SSEARCH 2?QG # K2LOCATE - READDICU 2#=6 # 2#PQ # 2*9B # READDICT FINDS A USERNAME ENTRY IN DICTIONARY. 2*P2 # READDICU FINDS THE DICTIONARY UPDATE RECORD. 2B8L # SSEARCH FINDS A TSN ENTRY IN SYSTEM SERIAL. 2BN= # 2C7W # USES OF AWORK WORDS :- 2CMG # AWORK1 - CONTAINS THE KEY OF THE ENTRY TO BE FOUND. 2D76 # AWORK2 - BITS 15-23 HOLD INDEX NUMBER OF FILE TO BE SEARCHED. 2DLQ # B0 SET, LEAVE ADICTENT IN CORE WHEN DICTIONARY FOUND 2F6B # NEGATIVE IF SSEARCH. 2FL2 # AWORK3 - CONTAINS FILE DEPTH. 2G5L # AWORK4 - FOR GETSOUT MACRO, HOLDS SUBKEY OF ENTRY REQD. 2GK= # FOR USER JOBLIST, PRESERVES X6 DURING TNEXTENT SUBROUTINE 2H4W # 2HJG ZGEOER2 2J46 GEOERR 1,INDEXNO 2JHQ ZGEOER3 2K3B GEOERR 1,NOKEY! 2KH2 ZBENT 2L2L GEOERR 1,FILEBENT 2LG= # 2L^W # THIS SUBROUTINE POSITIONS THE FILE ON THE FIRST RECORD OF THE 2MFG # BLOCK WITH HIGH ENOUGH KEY TO CONTAIN THE REQUIRED ENTRY. 2M^6 # 2NDQ XBLOCK 2NYB SBX 7 FX1 [DECROMENT LINK 2PD2 FINDEXB AWORK3(2),3 [X3->FI/FINDEXF BLOCK 2PXL LDX 2 A1(3) 2QC= SBN 2 3 [X2 IS NO OF BLOCKS. 2QWW BZE 2 TEXIT [J IF NO BLOCKS IN FILE. 2RBG STOZ 0 2RW6 XLOOP 2S*Q ADN 0 1 [X0 INDICATES CURRENT BLOCK OF FILE. 2STB LDX 1 INDEXREC(3) 2T*2 SMO FX2 2TSL BXGE 1 AWORK1,YEXIT [J IF FOUND A BLOCK WITH LARGE 2W#= ADN 3 1 [ENOUGH KEY. 2WRW BCT 2 XLOOP [BRANCH IF MORE BLOCKS IN FILE. 2X?G TEXIT 2XR6 ADX 7 FX1 [INCREMENT LINK. 2Y=Q LDX 2 FX2 2YQB EXIT 7 0 [EXIT NOT FOUND. 2^=2 YEXIT 2^PL #SKI K6LOCATE>599-599 329= TRACE 1,YBLOCK 32NW LDX 2 FX2 338G LDX 1 0 33N6 STO 7 GEN6 347Q CALL 7 SFSTACK1 [X3->FCA 34MB LDX 7 GEN6 3572 ADN 1 FBLKS-1 [F'BLK PTS TO REQUIRED BLOCK. 35LL STO 1 FREADBLOCK(3) [F'WORD -VE IMPLIES ABOUT TO READ 366= NGS 1 FREADWORD(3) [1ST. RECORD OF THIS BLOCK. 36KW LDX 2 AWORK3(2) [DEPTH 375G STEP 0(2) [X3->FIRST REC. IN FURB. 37K6 ADX 7 FX1 [INCREMENT LINK. 384Q EXIT 7 1 [EXIT OKAY 38JB # 3942 # 39HL # THIS SUBROUTINE STORES DEPTH AND GIVES X3->FCA,X1->FCB. 3=3= # 3=GW POINTERS 3?2G STO 0 GEN6 [STORE LINK. 3?G6 LDX 0 ACOMMUNE9(2) [DEPTH. 3?^Q CALL 7 SFSTACK 3#FB PSTAC 1,3 3#^2 BFCBX 1,1 3*DL BRN (GEN6) 3*Y= # 3BCW # GIVEN FILE DEPTH IN X6,THIS SUBROUTINE GIVES A PTR. TO THE FCA IN X3 3BXG # 3CC6 SFSTACK 3CWQ STO 0 AWORK3(2) [STORE DEPTH. 3DBB SFSTACK1 3DW2 SFSTACK AWORK3(2),3 3F*L EXIT 7 0 3FT= # 3G#W # THIS ROUTINE SAME AS SENT BUT FOR :SYSTEM AND :USER.JOBLIST 3GSG # 3H#6 TENT 3HRQ SBX 7 FX1 3J?B TENT1 3JR2 LDX 0 FRH+1(3) [IS RECORD INDEXED 3K=L BPZ 0 REXIT [YES 3KQ= LDX 2 AWORK3(2) [NO 3L9W STEP 0(2) [GET NEXT RECORD 3LPG BZE 3 ZBENT 3M96 BRN TENT1 3MNQ REXIT 3N8B ADX 7 FX1 3NN2 EXIT 7 0 3P7L # 3PM= # THIS SUBROUTINE GETS THE NEXT ENTRY IN JOBLIST BY SKIPPING 3Q6W # OVER THE RECORDS OF THE CURRENT ENTRY 3QLG # 3R66 TNEXTENT 3RKQ SBX 7 FX1 3S5B STO 6 AWORK4(2) 3SK2 LDN 6 4 [X6 CONTAINS NO OF RECORDS TO SKIP 3T4L TNEXTENT1 3TJ= LDX 1 AWORK3(2) 3W3W STEP 0(1) 3WHG SBN 6 1 3X36 BNZ 3 TOK 3XGQ BZE 6 PEXIT 3Y2B BRN ZBENT 3YG2 TOK 3Y^L LDX 0 FRH+1(3) 3^F= BNG 0 TNEXTENT1 3^YW BNZ 6 ZBENT 42DG PEXIT 42Y6 LDX 6 AWORK4(2) 43CQ ADX 7 FX1 43XB EXIT 7 0 44C2 # 44WL # THIS SUBROUTINE IS ENTERED WITH X3->1ST. REC. IN 1ST. BLOCK OF SYSTEM 45B= # OUTPUT WITH HIGH ENOUGH KEY TO CONTAIN THE SOUGHT ENTRY. IT POSITIONS 45TW # THE FILE ON THE FIRST ENTRY IN THIS BLOCK. 46*G # 46T6 SENT 47#Q SBX 7 FX1 47SB SENT1 48#2 LDX 0 GSIGN 48RL BXE 0 GOUTYPE-A1(3),XEXIT 49?= LDX 2 AWORK3(2) 49QW STEP 0(2) 4==G BZE 3 ZBENT 4=Q6 BRN SENT1 4?9Q # THIS SUBROUTINE GETS THE NEXT ENTRY IN SYSTEM.OUTPUT,BY SKIPPING 4?PB # OVER THE RECORDS IN THE CURRENT ENTRY. 4#92 SNEXTENT 4#NL SBX 7 FX1 4*8= LFRECNUM 6,GMODE-A1(3) [X6 CONTAINS NO. OF RECS. TO SKIP. 4*MW SNEXTENT1 4B7G LDX 1 AWORK3(2) 4BM6 STEP 0(1) 4C6Q SBN 6 1 4CLB BNZ 3 SOK 4D62 BZE 6 XEXIT 4DKL BRN ZBENT 4F5= SOK 4FJW LDX 0 GSIGN 4G4G BXU 0 GOUTYPE-A1(3),SNEXTENT1 4GJ6 BNZ 6 ZBENT 4H3Q XEXIT 4HHB ADX 7 FX1 4J32 EXIT 7 0 4JGL # 4JMS ...ZSYSJOB [SYSTEM JOBLIST - ZERO DEPTH 4JT2 ... STOZ ACOMMUNE9(2) 4K2= SYSJOB [ENTRY FOR SYSTEM JOBLIST 4KFW LDX 0 ACOMMUNE7(2) [STORE KEY 4K^G STO 0 AWORK1(2) 4LYQ CALL 0 POINTERS [X1,X3, FCB,FCA 4MDB LDN 0 #77 4MY2 ANDX 0 FINFC(1) 4NCL SBN 0 INDEXJOB [CHECK INDEX NO. 4NX= BNZ 0 ZGEOER2 4PBW LDN 0 INDEXJOB 4PWG STO 0 AWORK2(2) [STORE INDEX NO 4QB6 BRN NUMOK 4QH# ...ZUSEJOB [USER JOBLIST - ZERO DEPTH 4QNG ... STOZ ACOMMUNE9(2) 4QTQ USEJOB [ENTRY FOR USER.JOBLIST 4R*B LDX 4 ACOMMUNE1(2) 4RT2 LDX 5 ACOMMUNE2(2) 4S#L LDX 6 ACOMMUNE3(2) [PICK UP USERNAME 4SS= LDN 0 4 4T?W SUM 7 3 [CALCULATE KEY 4TRG STO 7 AWORK1(2) [ & STORE IT 4WQQ CALL 0 POINTERS 4X=B LDN 0 #77 4XQ2 ANDX 0 FINFC(1) 4Y9L SBN 0 INDEXUSERJ [CHECK INDEXNO. 4YP= BNZ 0 ZGEOER2 4^8W LDN 0 INDEXUSERJ 4^NG STO 0 AWORK2(2) [STORE INDEX NO. 5286 BRN NUMOK 52MQ [ 537B READDICT [READDICT MACRO ENTRY. 53M2 [ 546L LDX 0 ACOMMUNE1(2) 54L= BNZ 0 XDICT 555W MHUNT 3,FILE,ADICT [X3 -> ADICT BLOCK. 55KG LDX 4 A1(3) 5656 LDX 5 A1+1(3) 56JQ LDX 6 A1+2(3) [X4,X5,X6 CONTAIN THE USERNAME REQD. 574B FREECORE 3 [FREE THE FILE/ADICT BLOCK. 57J2 BRN XDICTENT 583L XDICT 58H= LDX 4 ACOMMUNE1(2) 592W LDX 5 ACOMMUNE2(2) 59GG LDX 6 ACOMMUNE3(2) 5=26 XDICTENT 5=FQ LDX 0 ACOMMUNE7(2) [INDICATES WHETHER ADICTENT REQD. 5=^B BRN TINDEXNUM 5?F2 UPDATE1 5?YL #32656044 5#D= UPDATE2 5#XW #41644520 5*CG [ 5*X6 READDICU [READDICU MACRO ENTRY 5BBQ [ 5BWB LDX 6 ACOMMUNE7(2) [STORE PARAM IN X6. 5CB2 LDX 4 UPDATE1(1) [STORE *UPDATE IN X4,X5 5CTL LDX 5 UPDATE2(1) 5D*= LDN 0 0 [INDICATES ADICTENT REQD. 5DSW TINDEXNUM 5F#G ADN 0 INDEXDICT [INDICATES DICTIONARY 5FS6 STO 0 AWORK2(2) 5G?Q LDN 0 4 5GRB SUM 7 3 5H?2 STO 7 AWORK1(2) [AWORK1 CONTAINS KEY FOR ENTRY REQD. 5HQL CALL 0 POINTERS [STORE DEPTH AND GET POINTERS. 5J== LDN 0 #77 5JPW ANDX 0 FINFC(1) [PICK UP INDEX NO. 5K9G SBN 0 INDEXDICT 5KP6 BZE 0 NUMOK 5L8Q BRN ZGEOER2 [ERROR IF NOT DICTIONARY 5LNB [ 5M82 SYSER [SSEARCH MACRO ENTRY 5MML [ 5N7= CALL 0 POINTERS [STORE DEPTH AND GET POINTERS. 5NLW LDN 0 #77 5P6G ANDX 0 FINFC(1) 5PL6 SBN 0 INDEXSER 5Q5Q BNZ 0 ZGEOER2 [ERROR IF NOT SYSTEM.SERIAL 5QKB LDN 7 INDEXSER 5R52 STO 7 AWORK2(2) [INDICATES SSEARCH ENTRY 5RJL LDX 6 ACOMMUNE7(2) [PICK UP KEY AND STORE IN AWORK1 5S4= STO 6 AWORK1(2) 5SHW BRN NUMOK 5T3G [ 5TH6 SYSOUT [GETSOUT MACRO ENTRY 5W2Q [ 5WGB CALL 0 POINTERS [STORE DEPTH AND GET POINTERS. 5X22 LDN 0 #77 [X1->FCB,X3->FCA 5XFL ANDX 0 FINFC(1) 5X^= SBN 0 INDEXOUT 5YDW BNZ 0 ZGEOER2 [ERROR IF NOT SYSTEM.OUTPUT 5YYG LDN 0 INDEXOUT 5^D6 STO 0 AWORK2(2) [INDICATES GETSOUT 5^XQ LDX 0 ACOMMUNE7(2) [INDEX KEY 62CB STO 0 AWORK1(2) 62X2 LDX 0 ACOMMUNE1(2) [SUB KEY 63BL STO 0 AWORK4(2) [STORE SUBKEY OF ENTRY 63W= NUMOK 64*W JMBS XMODE,3,BAMREAD,BAMGEN [J IF OPEN IN READ OR GENERAL MOD 64TG GEOERR 1,LOCATE? 65*6 XMODE 65SQ CALL 7 XBLOCK [X3 -> 1ST REC IN BLOCK WITH RT. KEY. 66#B BRN NOFILEW [J IF NO SUCH BLOCK. 66S2 LDEX 0 AWORK2(2) 67?L SBN 0 INDEXOUT 67R= BZE 0 SYSOUT1 [J IF SYSTEM OUTPUT 68=W SBN 0 INDEXUSERJ-INDEXOUT 68QG BNZ 0 XCALCKEY [J IF NOT USER JOBLIST 69=6 CALL 7 TENT [GET NEXT INDEXED RECORD 69PQ BRN XCALCKEY 6=9B SYSOUT1 6=P2 CALL 7 SENT [X3->1ST ENTRY IN BLOCK. 6?8L BRN XCALCKEY [CALCULATE KEY. 6?N= NEXTENT1 6#7W LDEX 0 AWORK2(2) 6#MG SBN 0 INDEXOUT 6*76 BZE 0 SYSOUT3 [J IF SYSTEM OUTPUT 6*LQ SBN 0 INDEXUSERJ-INDEXOUT 6B6B BNZ 0 NEXTENT [J IF NOT USER JOBLIST 6BL2 CALL 7 TNEXTENT 6C5L BZE 3 NOTUSER1 6CK= BRN XCALCKEY 6D4W SYSOUT3 6DJG CALL 7 SNEXTENT 6F46 BZE 3 NOTUSER1 6FHQ BRN XCALCKEY 6G3B NEXTENT 6GH2 LDX 1 AWORK3(2) [X1 CONTAINS FILE DEPTH. 6H2L STEP 0(1) [GET NEXT ENTRY. 6HG= BZE 3 NOFILEK [J IF NONE. 6H^W XCALCKEY 6JFG LDEX 0 AWORK2(2) 6J^6 KEYRECI 0,,3,ZGEOER3,0 6KDQ BXL 0 AWORK1(2),NEXTENT1 [GET NEXT ENT IF NOT UP TO REQD KEY. 6KYB BXE 0 AWORK1(2),XEQUAL 6LD2 BRN NOFILEK [ERROR IF NO REC. WITH RT. KEY. 6LXL XEQUAL 6MC= LDEX 0 AWORK2(2) 6MWW SBN 0 INDEXDICT 6NBG BZE 0 RDICT [J IF READDICT OR READDICU 6NW6 SBN 0 INDEXOUT-INDEXDICT 6P*Q BZE 0 SYSOUT2 6PTB SBN 0 INDEXUSERJ-INDEXOUT 6Q*2 BNZ 0 SETREP 6QSL TXU 4 JLJOBNAME(3) 6R#= TXU 5 JLJOBNAME+1(3) 6RRW TXU 6 JLJOBNAME+2(3) 6S?G BCS NEXTENT1 6SR6 BRN SETREP 6T=Q SYSOUT2 6TQB LDX 0 AWORK4(2) 6W=2 BZE 0 NOTUSER1 [J IF ZERO SUBKEY IN NOW ENTRY. 6WFS ... BXL 0 GOUTKEY2-A1(3),NOTUSER1 [ J-IF LARGER SUBKEY 6WPL BXU 0 GOUTKEY2-A1(3),NEXTENT1 [J IF SUBKEYS UNEQUAL 6X9= BRN SETREP 6XNW RDICT 6Y8G TXU 4 CUSER-A1(3) [TEST IF NAME IN DICTIONARY ENTRY 6YN6 TXU 5 CUSER+1-A1(3) [IS EQUAL TO NAME REQD. 6^7Q TXU 6 CUSER+2-A1(3) 6^MB BCS NEXTENT1 [J IF NOT. 7272 LDX 0 AWORK2(2) 72LL BNG 0 SETREP [J IF NO ADICTENT REQD. 72^3 ... LDX 1 AWORK3(2) 73?D ... READAGAIN 0(1) 73KW MHUNT 1,FILE,FRB 745G NAME 1,FILE,ADICTENT 74K6 SETREP 754Q ANSOK2 75JB UPP 7642 UP 76HL # END OF SEARCH. UNSUCCESSFUL. THE FILE IS LEFT POSITIONED AT THE RIGHT 773= # PLACE FOR AN ENTRY TO BE INSERTED. 77GW NOFILEW 782G LDX 1 AWORK3(2) [X1 CONTAINS FILE DEPTH 78G6 WIND 0(1) 78^Q LDX 1 AWORK3(2) 79FB STEP 0(1) 79^2 NOFILEK 7=DL LDEX 0 AWORK2(2) 7=Y= SBN 0 INDEXDICT 7?CW BNZ 0 NOTUSER1 [J IF NOT READDICT OR READDICU 7?XG SETREP2 NOUSER 7#C6 BRN UPP 7#WQ NOTUSER1 7*BB SETREP2 NOFILE 7*W2 BRN UPP 7B*L MENDAREA 30,K99LOCATE 7BT= #END ^^^^ ...16660624000300000000