* * $Id: locati.s,v 1.1.1.1 1996/02/15 17:48:33 mclareni Exp $ * * $Log: locati.s,v $ * Revision 1.1.1.1 1996/02/15 17:48:33 mclareni * Kernlib * * #if defined(CERNLIB_QMIBMVF) * ** last mod 2 Oct 1990 15:00:59 LOCATI CSECT vector version of locati * tuned for 3090E CERN * section size 128 #if defined(CERNLIB_QMIBMXA) LOCATI AMODE 31 LOCATI RMODE ANY #endif ***************************************************************** PRINT NOGEN vector version of locati USING *,15 tuned for 3090E CERN *-------------------------- KSECT EQU 128 (section size 128) *-------------------------- STM 14,12,12(13) ***************************************************************** LM G4,G6,0(G1) get addresses ** LE F0,0(G6) get object L G1,0(G6) get object L G5,0(G5) get length SR G0,G0 zero g0 for work *-------------------------- C G5,K64 comp length with 64 BL L64 if lt 64 go to L64 *==================== S G5,K4096 comp length with 4096 BM P32 if lt 4096 go to p32 S G5,K4096 comp length with 8192 BM P64 if lt 8192 go to p64 B PSCAV else go to pscav *==================== P32 EQU * vector length lt 4096 A G5,K4064 reset to length-32 LA G8,32(G5) copy G5 in G8 (length) LR G11,G4 copy array address *==================== LA G4,KSECT(G4) add 128 (32 words) to begin addr LA G7,32 set G7 to stride (32) *==================== SR G6,G6 zero G6 for work ****************** vector loop SRL G8,5 divide length by 32 VLOOP EQU * vector loop on full vector VLVCU G8 with stride = 32 VCS LE,G1,G4(G7) search object VCZVM G6 count left zero in vmr BC 8,NF if none go to nf SLL G6,5 mult sum by 32 (stride) B NEXTK go to seq search *==================== NF EQU * not found in sect LTR G8,G8 test vector length BC 2,VLOOP if some more loop LR G6,G5 set g6 to length-32 NEXTK EQU * seq search with length = 32 LR G7,G6 copy k-1 SLL G6,2 (k-1)*4 AR G11,G6 array(k) address LR G3,G11 copy array address ****************** seq search VLVCA 32(0) with length=32 VCS LE,G1,G3 search object VCZVM G0 count left zeros (n-1) LR G2,G0 copy count in G2 SLL G2,2 mult by 4 (convert to addr) AR G0,G7 add displ C G1,0(G11,G2) comp object for equal BE EQUAL if eq branch LCR G0,G0 set (n-1) = -(n-1) LM 2,12,28(13) BR 14 * END SUBROUTINE *********** seq search EQUAL A G0,K1 set value to n LM 2,12,28(13) BR 14 * END SUBROUTINE *********** seq search * no sectionning ************ L64 EQU * no sect length le 32 LR G3,G4 get array addr VLVCU G5 set vector length (le.64) VCS LE,G1,G3 search object VCZVM G0 count left zeros (n-1) LR G2,G0 copy count in G2 SLL G2,2 mult by 4 (convert to addr) C G1,0(G4,G2) comp object for equal BE EQL64 if eq branch LCR G0,G0 if ne set (n-1)= -(n-1) LM 2,12,28(13) reset BR 14 return * END SUBROUTINE *********** EQL64 A G0,K1 set value to n LM 2,12,28(13) reset BR 14 return * END SUBROUTINE *********** ***************************************************************** PSCAV EQU * A G5,K8192 RESET G5 VALUE (LENGTH) SR G3,G3 nbel=0 LA G5,1(G5) nab = length + 1 DIX EQU * LR G6,G5 copy nab SR G6,G3 g7 = (nab-nbel) C G6,K128 BNH VECT then go vector (one sect max) LR G12,G5 copy nab in g12 AR G12,G3 g12 = (nab+nbel) SRL G12,1 g12 = (nab+nbel)/2 LR G11,G12 copy mid in g11 BCTR G12,0 mid-1 SLL G12,2 (mid-1)*4 for addressing C G1,0(G4,G12) if(object-array(mid)) 100,180,140 BE EQU 180 BL MINUS 100 PLUS EQU * 140 LR G3,G11 nbel=mid B DIX go to dix MINUS EQU * 100 LR G5,G11 nab=mid B DIX go to dix EQU LR G0,G11 locata=mid 180 #include "exitg.inc" VECT LR G8,G3 get nbel SLL G8,2 g8 = (nbel+1)*4 AR G8,G4 g8=array(nbel+1) LR G9,G8 g9=g8=array(nbel+1) VLVCU G6 vect length= (nab-nbel) VCS LE,G1,G8 search object VCZVM G0 get loc BC 8,NFS LR G2,G0 copy in g2 SLL G2,2 mult by 4 C G1,0(G9,G2) comp object array(loc) BE EQUV AR G0,G3 locata=loc+nbel LCR G0,G0 locata= - locata #include "exitg.inc" EQUV AR G0,G3 A G0,K1 locata=loc+nbel #include "exitg.inc" NFS S G0,K1 LOCATA= - LOCATA AR G0,G3 locata=loc+nbel LCR G0,G0 locata= - locata #include "exitg.inc" ***************************************************************** *==================== P64 EQU * A G5,K8128 reset G5 to length-64 LA G8,64(G5) copy length in G8 LR G11,G4 copy array address *==================== LA G4,256(G4) add 256 (64 words) to begin addr LA G7,64 set G7 to stride (64) *==================== SR G6,G6 zero G6 for work ****************** vector loop SRL G8,6 divide length by 64 VL64 EQU * vector loop on full vector VLVCU G8 with stride = 64 VCS LE,G1,G4(G7) search object VCZVM G6 count left zero in vmr BC 8,NF64 SLL G6,6 mult sum by 64 (stride) B SEQ64 *==================== NF64 EQU * not found in sect LTR G8,G8 test vector count BC 2,VL64 if some more loop LR G6,G5 set g6 to length-64 SEQ64 EQU * seq search with length = 64 LR G7,G6 copy k-1 SLL G6,2 (k-1)*4 AR G11,G6 array(k) address LR G3,G11 copy array address **** SR G0,G0 zero g0 for work ****************** seq search VLVCA 64(0) with length=64 VCS LE,G1,G3 search object VCZVM G0 count left zeros (n-1) LR G2,G0 copy count in G2 SLL G2,2 mult by 4 (convert to addr) AR G0,G7 add displ C G1,0(G11,G2) comp object for equal BE EQ64 if eq branch LCR G0,G0 set (n-1) = -(n-1) LM 2,12,28(13) BR 14 * END SUBROUTINE *********** seq search EQ64 A G0,K1 set value to n LM 2,12,28(13) BR 14 * END SUBROUTINE *********** seq search *==================== DS 0D K1 DC F'1' K32 DC F'32' K48 DC F'48' K64 DC F'64' K128 DC F'128' K2048 DC F'2048' K4064 DC F'4064' K4096 DC F'4096' K8128 DC F'8128' K8192 DC F'8192' #include "equats.inc" END #endif