.TITLE FNDFOR .IDENT /280183/ .ENABL LC ; ; ; ; Written by Ray Di Marco ; 28-Jan-83 ; ; ; ;----------------------------------------------------------------- ; ; ; This program is part of the DBSMNG package, and allows a fortran user to ; achieve a RELATIONAL search capability. The user generates a ordered file ; using the SRTFOR and SORTER packages that gives the correlation between the ; contents of fields and database record numbers. This file is formatted ; exactly as that used by the sorting package (ie SORTER.DAT), and is called ; the relational index. ; ; The module allows the fortran user to access the relational file. A user may ; read any specific record in the file (first record is #1), request a search ; for the best matching record etc. ; ; The major work required on the part of the user is actually setting up the ; relational file. The use of the sorting routines supplied as part of the ; DBSMNG package can greatly simplify this work. ; ; *** An example fortran program is included in this documentation *** ; .SBTTL DOCUMENTATION - ENTRY POINTS ; ; THE ENTRY POINTS TO THE MODULE ARE - ; ; FNDFIN --- INITIALIZE MODULE. THIS ENTRY OPENS THE ; RELATIONAL FILE AND RESETS POINTERS ETC. ; MUST BE CALLED PRIOR TO ANY OTHER CALLS TO ; MODULE. ; ; ; FNDFOR --- USED TO ACCESS/INVOKE FACILITIES PROVIDED ; BY MODULE. ; ; ; .SBTTL DOCUMENTATION - CALLING SEQUENCES ; ; ; CALL FNDFIN () ; Initializes system for file "DK:SORTER.DAT" ; ; CALL FNDFIN (STRING) ; Initilaizes system for file specified in .ASCIZ string. ; ; ; CALL FNDFOR (0) ; ; RESETS/REWINDS THE RELATIONAL FILE ; ; CALL FNDFOR (1,I) ; ; POSITIONS POINTER TO I'th RECORD OF RELATIONAL FILE ; ; CALL FNDFOR (2,ISIZE,NUMREC,ISTATUS,ICHAIN) ; ; RETURNS PARAMETERS TO CALLER. 'ISIZE' IS THE RECORD ; SIZE IN BYTES, 'NUMREC' IS THE NUMBER OF RECORDS, ; 'ISTATUS' IS THE STATUS FLAG SET UP WITH THE LAST ; PUT CALL, AND 'ICHAIN' IS NON-ZERO IFF THE PROGRAM ; WAS CHAINED TO. ; ; CALL FNDFOR (3,TARGET,IREC,MATCHS) ; ; Causes search to be initiated for entries that match ; string 'TARGET'. If MATCH is non-zero on return, IREC ; points to first exact match, and MATCHS holds number of ; exact matchs. If no matchs was found, IREC points to ; best guess. ; ; CALL FNDFOR (4,BUF,NUM) ; ; MOVE 'NUM' BYTE FROM FILE INTO THE 'BUF' ; .IF EQ,-1 PROGRAM SEARCH C ======= ====== C LOGICAL*1 BUF(70),TARGET(70),ANS,IRECB(2) EQUIVALENCE (IREC,IRECB) C CALL FNDFIN ('ZB5:SORTER.DAT') ! initialize FND CALL FNDFOR (2,IFNSZ,IFNNM,I,I) ! get entry size C 1000 WRITE (7,1100) ! prompt 1100 FORMAT (1X,'?',$) READ (7,1200) TARGET ! get target 1200 FORMAT (80A1) CALL FNDFOR (3,TARGET,IFNRC,IFLAG) ! attempt to find IF (IFLAG.EQ.1) GOTO 4000 ! found -> skip WRITE (7,1300) IFLAG 1300 FORMAT (I10/) C 2000 CALL FNDFOR (1,IFNRC) ! position at best CALL FNDFOR (4,BUF,IFNSZ) ! read string BUF(IFNSZ+1) = "200 ! terminate string CALL PRINT (BUF(3)) ! print string WRITE (7,2100) ! Prompt 2100 FORMAT (1X,'?',$) READ (5,2200) ANS ! get answer 2200 FORMAT (A1) IF (ANS.EQ.' ') GOTO 1000 ! new target IF (ANS.EQ.'M') GOTO 4000 ! have match IF (ANS.EQ.'N') IFNRC = IFNRC+1 ! next record IF (ANS.EQ.'P') IFNRC = IFNRC-1 ! previous record GOTO 2000 ! loop C 4000 CALL FNDFOR (1,IFNRC) ! position at best CALL FNDFOR (4,BUF,IFNSZ) ! read string IRECB(1)= BUF(1) ! setup lob IRECB(2)= BUF(2) ! setup hob WRITE (7,4100) IREC,(BUF(J),J=3,IFNSZ) 4100 FORMAT (1X,'Match @',I4,2X,70A1) STOP END .ENDC .SBTTL DECLARATIONS ; ; .MCALL .PUSH,.POP ; STACKING .MCALL .PRINT,.EXIT,.CHAIN ; RT11 .MCALL FILSPT FILSPT ; ; .GLOBL FNDFIN ; INITILAIZATION .GLOBL FNDFOR ; NORMAL ENTRY ; .GLOBL IGETC ; 'SYSLIB' .GLOBL SFLINT,SFLNME,SFLINP,SFLINC,SFLRST ; SRTFIO .GLOBL SFLPSN,SFLPAR,SFLFDB ; SRTFIO ; ; ; JSW = 44 ; JSW ADDRESS JSW.CH = 400 ; CHAIN BIT ; ; .PSECT CODE ; open code area ; ====== ==== ; .SBTTL MACRO DEFINITIONS ; ; .MACRO ERRON CND,MES,?X,?Y,?Z B'CND X BR Y X: .PRINT #'Z TRAP 0 Z: .ASCII /"FNDFOR"-fatal-/ .ASCII /MES/<200> .EVEN Y: .ENDM ERRON ; ; .SBTTL ROUTINE - 'FNDFIN' ... INITIALIZE ROUTINE ; ; ; Calling sequences are ; ; CALL FNDFIN ; or ; CALL FNDFIN (NAME) Name is .asciz string ; ; First form initializes for default file 'DK:SORTER.DAT', while ; second form causes file specified in argument to be used. ; ; FNDFIN: TST INITFL ; TEST INITIALIZE FLAG ERRON , INC INITFL ; SET FLAG ; CMPB (R5),#1 ; allowed 0 or 1 args ERRON HI, BNE 1000$ ; no argument -> skip MOV 2(R5),R0 ; R0 -> name MOV #SFLNME,R1 ; R1 -> destination 400$: MOVB (R0)+,(R1)+ ; copy ... BNE 400$ ; ... till hit delimiter ; 1000$: CALL IGETC ; GET A CHANNEL MOV R0,SFLFDB+FDB.CH ; SET UP CHANNEL ERRON MI, CALL SFLINT ; OPEN DATA FILE CMP SFLPAR,#3 ; minimum record size = 3 ERRON LO, CMP SFLINT+2,#2 ; need at least 2 records ERRON LOS, RETURN ; EXIT ; ; INITFL: .WORD 0 ; INITIALIZATION FLAG ; .SBTTL ENTRY - 'FNDFOR' ... DISPATCHER ; ; ; FNDFOR: TST INITFL ; INITIALIZED? ERRON , CMP (R5),#1 ; RIGHT NUMBER OF ARGUMENTS? ERRON LO, ; MOV @2(R5),R0 ; FUNCTION NUMBER -> R0 CMP R0,1000$-2 ; LEGAL FUNCTION? ERRON HIS, ASL R0 ; FUNCTION CODE*2 -> R0 JMP @1000$(R0) ; PROCEED TO FUNCTION ; ; .WORD <1100$-1000$>/2 ; NUMBER FUNCTIONS 1000$: .WORD SFLRST ; RESET/REWIND FILE .WORD POSITN ; POSITION @ an entry .WORD GETPAR ; GET PARAMETERS .WORD SEARCH ; Search for a record .WORD GETDAT ; GET DATA 1100$: .WORD 0 ; EOT ; ; .SBTTL PRIMITIVE - "POSITN" ... Position at entry ; ; POSITN: CMP (R5),#2 ; Need 2 arguments ERRON NE,<'POSITN' NEED 2 PARAMETERS!> MOV @4(R5),R0 ; R0 = record number wanted JMP SFLPSN ; position file ; ; .SBTTL PRIMITIVE - 'GETPAR' ... RETURN PARAMETERS TO CALLER ; ; ; GETPAR: CMP (R5),#5 ; NEED 5 ARGUMENTS ERRON NE,<'GETPAR' NEED 5 PARAMETES!> MOV SFLPAR,@4(R5) ; RETURN SIZE MOV SFLPAR+2,@6(R5) ; RETURN NUMRECS MOV SFLPAR+200,@10(R5) ; RETURN STATUS MOV @#JSW,@12(R5) ; RETURN JSW BIC #^CJSW.CH,@12(R5) ; LEAVE CHAIN FLAG ONLY RETURN ; EXIT ; ; ; .SBTTL Routine - "SEARCH" ... search for target ; ; SEARCH: CMPB (R5),#4 ; want 4 arguments ERRON NE, ; MOV SFLPAR+2,R4 ; R4 = number of entries CALL 5000$ ; R4 = R4 / 2 MOV R4,R3 ; R3 = starting entry ; 2000$: CMP R3,SFLPAR+2 ; in range? BLOS 2010$ ; yes -> skip MOV SFLPAR+2,R3 ; no --> force into range 2010$: MOV R3,R0 ; R0 = next entry to search CALL SFLPSN ; position on entry R0 CALL 5000$ ; R4 = step size BEQ 2400$ ; out of steps -> done ADD R4,R3 ; assume going to step up CALL 5400$ ; compare TAR to REC BHI 2000$ ; TAR > REC -> step up SUB R4,R3 ; we are not stepping up ... SUB R4,R3 ; ... we are stepping down BGT 2000$ ; loop not wrapped arround MOV #1,R3 ; don't allow wrap arround BR 2000$ ; loop ; ; 2400$: CMP R3,#1 ; at first entry? BHI 2440$ ; no -> skip MOV #2,R3 ; force to second 2440$: DEC R3 ; skip back 1 record CLR @10(R5) ; no matchs as yet DEC R3 ; preloop fudge 2500$: INC R3 ; try next record CMP R3,SFLPAR+2 ; all done? BHI 2600$ ; yes -> terminate MOV R3,R0 ; R0 = match area CALL SFLPSN ; position file CALL 5400$ ; compare TAR with REC BLO 2700$ ; TAR < REC -> terminate BHI 2500$ ; TAR > REC -> loop INC @10(R5) ; found another match CMP @10(R5),#1 ; first match found BNE 2500$ ; no -> loop MOV R3,@6(R5) ; save address of first match BR 2500$ ; loop ; ; 2600$: MOV SFLPAR+2,R3 ; insure have legal index 2700$: TST @10(R5) ; got a match? BNE 2770$ ; yes -> skip MOV R3,@6(R5) ; return first exceeding MOV @6(R5),R0 ; R0 = record 2770$: CALL SFLPSN ; position file RETURN ; exit ; ; ; 5000$: CMP R4,#1 ; last step = 1? BEQ 5040$ ; yes -> skip INC R4 ; R4 = number+1 5040$: ASR R4 ; R4 = number/2 rounded up BIC #100000,R4 ; ensure sign bit clear RETURN ; bye ; ; 5400$: MOV SFLPAR,R2 ; R2 = record size MOV 4(R5),R1 ; R1 = TARGET CALL SFLINC ; discard first byte CALL SFLINC ; discard second byte SUB #2,R2 ; 2 bytes not to check 5600$: CALL SFLINC ; R0 = next input character CMPB (R1)+,R0 ; comp TAR to REC byte BNE 5700$ ; skip no match SOB R2,5600$ ; loop if matched 5700$: RETURN ; all done ; .SBTTL PRIMITIVE - 'GETDAT' ... GET DATA FROM FILE ; ; GETDAT: CMP (R5),#3 ; NEED THREE ARGS ERRON NE,<'GETDAT' NEED THREE ARGUMENTS!> MOV 4(R5),R0 ; R0 --> BUFFER MOV @6(R5),R1 ; R1 === NUM BYTES CALL SFLINP ; GET DATA RETURN ; EXIT ; ; ; .END