;
; SUBROUTINE PEDRET
; LOADABLE BASIC SUBROUTINE
; TO SEND DATA TO A DATA BASE HANDLING TASK AND RECEIVE A RECORD
; BACK WHICH MATCHES A SENDING KEY.
;
	.MCALL	ULODHD
	ULODHD	START,END,FANYRT,FALLRT
;
; SYSTEM MACRO CALLS
;
	.MCALL	VSDR$	VRCD$	SRDA$S	CLEF$S	DIR$
	.MCALL	ALTP$S	WTSE$S	SETF$S	ASTX$S	GTSK$S
;
; DEFINE FLOATING REGISTERS USED
;
AC0=%0
;
; FORMAT OF DATA WHICH IS SENT TO DATA BASE TASK
;
;	WORD 1		;CONTAINS OPERATION TYPE (1)
;	WORD 2		;FILE #
;	WORD 3-4	;RECORD # (DOUBLE PRECISION)
;	WORD 5		;COL # TO START COMPARISON
;	WORD 6		;LENGTH OF MATCH STRING
;	BYTE 14-?	;STRING ITSELF
;
; FORMAT OF DATA RECEIVED FROM DATA BASE TASK
;	WORD 1-2	;TASK NAME (PEDDBM)
;	WORD 3-4	;DBL. PREC. REC #
;	WORD 5		;LEN OF STRING
;	BYTE 12-?	;RECORD STRING
;	WORD 		;ZERO FOR STOPPER
;
EVFL	= 1	;DEFINE EVENT FLAG
STPRI	= 45.	;AND STANDBY PRIORITY
START:
VSRDPB:	VSDR$	PEDDBM,,55.,,,2,2
VRCDPB:	VRCD$	PEDDBM,2,2	;DUMMY PARAMS FOR ADD AND LEN SO CAN CALL AGAIN
COMEND:	JSR	PC,SYNC		;GO SEND DATA AND RECEIVE SOME BACK
	MOV	@#ENUDAT,R3	;START OF RECEIVED DATA -> R3
	ADD	#4,R3		;SKIP OVER SENDING TASK NAME
	MOV	SP,R5		;ADD OF RECORD # STORE -> R5
	TST	R0		;CHECK ON STATUS
	BLT	3$		;IF NEG, BRANCH
	SETL			;GET RECEIVED RECORD # -> AC0
	LDCLF	(R3)+,AC0	;
	SETI			;BACK TO SINGLE INTEGER MODE
	JSR	PC,@#NSTORE	;STORE THE RECORD #
	ADD	#12,R5		;MOVE R5 UP TO NEXT STORE DATA
	MOV	(R3)+,R4	;STRING LEN -> R4
	BEQ	4$		;IF NO STRING, DON'T MODIFY
	JSR	PC,@#SSTORE	;STORE THE STRING
4$:	ADD	#24,SP		;CLEAN THE STACK
	RTS	PC		;AND RETURN TO CALLING PROGRAM
3$:	LDCIF	R0,AC0		;ERROR CODE -> AC0
	JSR	PC,@#NSTORE	;PUT IT AWAY
	BR	4$		;AND FINISH UP
;
; FOLLOWING CODE SYNCHRONIZES THE SENDING OF A DATA BLOCK TO THE
; DATA BASE MANAGING PROGRAM AND THE RECEIPT OF DATA BACK FROM IT.
;
SYNC:	CLEF$S	#EVFL		;CLEAR EVENT FLAG 1
	MOV	R2,R0		;COPY THE ONE ADDRESS WE KNOW
	ADD	#AST-VSRDPB,R0	;MAKE IT POINT TO AST ROUTINE
	SRDA$S	R0		;DECLARE IT
	DIR$	R2		;SEND DATA TO DBM TASK
	MOV	@#0,R0		;CHECK DIRECTIVE STATUS
	BLT	2$		;IF NEG, BRANCH
	ALTP$S	,#STPRI		;PUT PRIORITY DOWN TO STANDBY
	WTSE$S	#EVFL		;AND WAIT FOR THE EVENT FLAG
2$:	SRDA$S	#0		;UN-DECLARE RECEIVE AST
	RTS	PC		;WE'VE RECEIVED THE DATA
;
; NOW THE AST ROUTINE
;
AST:	ALTP$S			;BACK TO DEFAULT PRIORITY
	MOV	R2,R0		;COPY THE ADDRESS WE KNOW
	ADD	#VRCDPB-VSRDPB,R0 ;MAKE R0 POINT TO RECEIVE DPB
	MOV	@#ENDUSR,R3	;CALCULATE
	SUB	@#ENUDAT,R3	;AVAILABLE STORAGE
	SUB	#4,R3		;SUBTRACT SPACE FOR SENDER NAME
	CMP	R3,#203		;IS IT BIGGER THAN MAX WE CAN USE
	BLE	1$		;IF NOT, BRANCH
	MOV	#203,R3		;IF SO, REPLACE WITH MAX
1$:	MOV	R3,R.VDBL(R0)	;AND PUT LEN AND
	MOV	@#ENUDAT,R3	;ADDRESS IN DPB
	MOV	R3,R.VDBA(R0)
	DIR$	R0		;RECEIVE THE DATA
	MOV	@#0,R0		;RECORD STATUS OF RECEIVE
	SETF$S	#EVFL		;SET EVENT FLAG TO RESUME MAIN TASK
	ASTX$S			;AND EXIT FROM AST
;
; SUBROUTINES FANYRT AND FALLRT
; LOADABLE BASIC SUBROUTINES
; FOR RETRIEVAL OF PEDIATRIC BIOCHEM LEVEL 1 - 4 RECORDS
; BY MATCHING EITHER ANY OR ALL OF THE MATCHING STRINGS
; BASIC CALLS:
;	CALL "FANYRT"(F0,R0,R1,S$,D$,D [,D1$,D1] [,D2$,D2]...)
;	CALL "FALLRT"(        "       "       "       "      )
; WHERE:
;	F0 IS FILE # FOR RETRIEVAL
;	R0 IS RECORD # TO START FROM
;	R1 IS VARIABLE TO RECEIVE FOUND RECORD #
;		0 = NONE FOUND (S$ UNCHANGED)
;		- = FAILED DIRECTIVE STATUS
;	S$ IS STRING VARIABLE TO RECEIVE FOUND RECORD
;	D$ D1$ ETC. ARE STRINGS FOR THE MATCH
;	D  D1  ETC. ARE CORRESPONDING COL #'S TO START AT
; NOTE:
;	THE SUM OF THE LENGTHS OF THE MATCHING STRINGS PLUS
;	4* THE NUMBER OF STRINGS SHOULD BE LESS THAN OR EQUAL
;	TO THE RECEIVED STRING LENGTH (S$). IF NOT, THE USER
;	RISKS A MEMORY PROTECT ERROR.
;
; FOR THE ROUTINE "FANYRT" A MATCH ON ANY STRING (KEY)
;	WILL RETRIEVE THAT RECORD. FOR THE ROUTINE "ALLRET"
;	ALL STRINGS (KEYS) MUST MUST MATCH
;
TYPSAV:	.WORD	0	;PLACE TO SAVE TYPE OF CALL
;
FANYRT:	MOV	#1,TYPSAV	;REMEMBER THAT THIS IS "ANY"
	BR	COMRET
FALLRT:	MOV	#2,TYPSAV	;REMEMBER THAT THIS IS "ALL"
;
COMRET:	JSR	R4,@#GTRGPI	;GET ARGUMENTS IN PI FASHION
	.BYTE	1,1,2,4,0
	.EVEN
	MOV	30(SP),R0	;LEN OF STRING S$ -> R0
	ADD	#16,R0		;ADD LEN OF OTHER PARAMS
	JSR	PC,@#TSTU00	;CHECK FOR ROOM, R5 AT ENUDAT
	BHIS	1$		;IF OK, BRANCH
	OVFERR			;ELSE OVERFLOW ERROR
1$:	MOV	PC,R2		;LET'S RECORD WHERE WE ARE
PCREF1:	SUB	#PCREF1-VSRDPB,R2 ;AND CALCULATE START OF DPB
	MOV	R5,S.DRBA(R2)	;MOVE IN ADDRESS OF BLOCK
	MOV	#6,S.DRBL(R2)	;LEN OF OTHER PARAMS
;
; FOLLOWING CODE INSERTED TO ENABLE DEBUGGING COPY OF THE
; DATA BASE MANAGER TO EXIST IN ACCOUNTS [250,104] AND [250,103].
; ONLY 103 AND 104 ARE CHECKED.
;
	SUB	#40,SP		;GET ROOM ON STACK FOR BUFFER
	MOV	SP,R4		;BUFFER ADDRESS -> R4
	GTSK$S	R4		;GET TASK PARAMS ON STACK
	CMPB	16(SP),#104	;IS LAST PART OF ACCOUNT 104?
	BNE	5$		;IF NOT, CHECK FOR ACCOUNT #103
	MOV	(PC)+,R4	;IF SO, PUT NEW NAME IN R4
	.RAD50	/DBD/		;104 TASK NAME SHOULD BE "PEDDBD"
	MOV	R4,S.DRTN+2(R2)	;STORE AWAY NEW NAME
	MOV	R4,VRCDPB-VSRDPB+R.VDTN+2(R2) ;IN 2 PLACES
	JMP 	1$
5$:	CMPB	16(SP),#103	;IS LAST PART OF ACCOUNT 103?
	BNE	1$		;IF NOT, DON'T DO ANYTHING
	MOV	(PC)+,R4	;IF SO, PUT NEW NAME IN R4
	.RAD50	/DBP/		;103 TASK NAME SHOULD BE "PEDDBP"
	MOV	R4,S.DRTN+2(R2)	;STORE AWAY NEW NAME
	MOV	R4,VRCDPB-VSRDPB+R.VDTN+2(R2);IN 2 PLACES
1$:	ADD	#40,SP		;CLEAN UP STACK
;
	MOV	TYPSAV,(R5)+	;PUT IN TYPE OF RETRIEVAL
	SETI			;MAKE SURE INTEGER MODE
	LDF	(SP)+,AC0	;GET FILE # FROM STACK
	STCFI	AC0,(R5)+	;PUT SINGLE WD IN SEND LIST
	SETL			;SET LONG INTEGER
	LDF	(SP)+,AC0	;GET START RECORD # -> AC0
	STCFL	AC0,(R5)+	;AND PUT IT IN SEND LIST
	SETI			;LEAVING FOUND REC # ADD
				;AND STRING ADD ON STACK
	MOV	@#ENUDAT,-(SP)	;SAVE END OF USER DATA
	MOV	R5,-(SP)	;SAVE R5
	MOV	R2,-(SP)	;AND  R2
2$:	MOV	R5,R4		;CALCULATE TEMPORARY END OF
	ADD	#4,R4		;USER DATA SO WE DON'T OVERWRITE
	MOV	R4,@#ENUDAT	;SEND BUFFER
	JSR	R4,@#GTRGPI	;GET SOME MORE ARGUMENTS
	.BYTE	3,1,0		;STRING AND COL #
	.EVEN
	MOV	10(SP),R2	;RESTORE R2
	MOV	12(SP),R5	;AND R5
	LDF	4(SP),AC0	;COL # -> AC0
	STCFI	AC0,(R5)+	;INTO SEND BUFFER
	MOV	(SP),R0		;LEN OF STRING -> R0
	ADD	#5,R0		;ROUND UP TO NEXT WORD
	ASR	R0		;PLUS OTHER PARAMS
	ADD	R0,S.DRBL(R2)	;AND ADD IT TO BUFFER LENGTH
	MOV	(SP)+,R0	;LEN OF STRING -> R0 AGAIN
	MOV	(SP)+,R3	;ADD -> R3
	MOV	R0,(R5)+	;PUT AWAY LEN IN SEND BUFFER
	BEQ	4$		;IF ZERO, BRANCH
3$:	MOVB	(R3)+,(R5)+	;MOVE IN THE STRING
	SOB	R0,3$
4$:	INC	R5		;ROUND UP
	BIC	#1,R5		;R5
	ADD	#4,SP		;CLEAN OFF THE COLUMN # PARAMS
	MOV	R5,2(SP)	;RE-SAVE R5
	JSR	PC,@#SKIP00	;GET NEXT NON-BLANK CHAR -> R2
	DEC	R1		;BACK UP TEXT PTR
	CMPB	R2,#',		;IS NEXT THING A COMMA?
	BEQ	2$		;IF SO, TRY FOR MORE
	JSR	PC,@#PARCHK	;CHECK FOR AT END
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R5	;AND R5
	MOV	(SP)+,@#ENUDAT	;RESTORE PREVIOUS END OF USER DATA
	CLR	(R5)+		;PUT IN STOPPER
	JMP	COMEND		;AND GO TO COMMON CODE
END:
	.END