{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: LOCATE84)}}
====== LOCATE84 ======
(George Source)
**Macros used:** [[george:macro:ANSOK2|ANSOK2]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:FINDEXB|FINDEXB]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JMBS|JMBS]], [[george:macro:KEYRECI|KEYRECI]], [[george:macro:LFRECNUM|LFRECNUM]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:NAME|NAME]], [[george:macro:NEXTENT|NEXTENT]], [[george:macro:PSTAC|PSTAC]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:READDICT|READDICT]], [[george:macro:READDICU|READDICU]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:STEP|STEP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:WIND|WIND]]
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