;
; *************************
; MCHRET CALL SUPERSEDED BY ANYRET AND ALLRET BELOW
; DESCRIPTION OF MCHRET DELETED.  SEE ONCRET FOR IT.
; *************************
;
	.MCALL	ULODHD
	ULODHD	START,END,ANYRET,ALLRET
;
; GLOBALS FOR TKB PATCH REFERENCE
;
	.GLOBL	VSRDPB	VRCDPB
;
; SYSTEM MACRO CALLS
;
	.MCALL	VSDR$	VRCD$	SRDA$S	CLEF$S	DIR$
	.MCALL	ALTP$S	WTSE$S	SETF$S	ASTX$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-3	;REC # INCREMENT & DIRECTION
;	WORD 4-5	;RECORD # (FLOATING POINT)
;	WORD 6		;COL # TO START COMPARISON
;	WORD 7		;LENGTH OF MATCH STRING
;	BYTE 16-?	;STRING ITSELF
;
; FORMAT OF DATA RECEIVED FROM DATA BASE TASK
;	WORD 1-2	;TASK NAME (FRMDBM)
;	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$	FRMDBM,,55.,,,2,2
VRCDPB:	VRCD$	FRMDBM,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
	LDF	(R3)+,AC0	;RETRIEVED RECORD # -> AC0
	MOV	R3,-(SP)	;SAVE R3 BECAUSE USED IN SUBROUTINE
	JSR	PC,@#NSTORE	;STORE THE RECORD #
	MOV	(SP)+,R3	;RESTORE REGISTER
	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
	ALTP$S			;BACK TO INSTALLED PRIORITY
	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 ANYRET AND ALLRET
; LOADABLE BASIC SUBROUTINES
; FOR RETRIEVAL OF RADIATION ONCOLOGY LEVEL1 RECORDS
; BY MATCHING EITHER ANY OR ALL OF THE MATCHING STRINGS
; BASIC CALLS:
;	CALL "ANYRET"(F0,R0,R1,S$,D$,D [,D1$,D1] [,D2$,D2]...)
;	CALL "ALLRET"(        "       "       "       "      )
; WHERE:
;	F0 IS RECORD INCREMENT
;		+2 FOR FORWARD SEARCH
;		-2 FOR BACKWARD SEARCH
;	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 "ANYRET" 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
;
ANYRET:	MOV	#1,TYPSAV	;REMEMBER THAT THIS IS "ANY"
	BR	COMRET
ALLRET:	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 COPIES OF THE
; DATA BASE MANAGER TO EXIST IN ACCOUNTS [205,16] (PEGGY)
; AND [205,20] (BONNIE).  IF THE SIGN-ON ACCOUNT IS NOT
; [205,15] (RADIATION ONCOLOGY) OR [205,16] (PEGGY), BONNIE'S
; COPY OF THE DATA BASE MANAGER IS USED, I.E., [205,20] IS
; ASSUMED.
;
	CMPB	@#UICSTO,#15	;IS IT [205,15] ?
	BEQ	1$		; IF YES, DON'T CHANGE DBM NAME
	CMPB	@#UICSTO,#16	;IS IT [205,16] ?
	BEQ	5$		; IF YES, CHANGE DBM NAME TO DBP (PEGGY)
	MOV	(PC)+,R4	; ASSUME [205,20], PUT NEW NAME IN R4
	.RAD50	/DBB/		; [205,20] NAME SHOULD BE FRMDBB (BONNIE)
	BR	6$
5$:	MOV	(PC)+,R4	; [205,16], PUT NEW NAME IN R4
	.RAD50	/DBP/		;   NAME SHOULD BE FRMDBP (PEGGY)
6$:	MOV	R4,S.DRTN+2(R2)	;STORE AWAY NEW NAME
	MOV	R4,VRCDPB-VSRDPB+R.VDTN+2(R2)	; IN 2 PLACES
1$:
;
	MOV	TYPSAV,(R5)+	;PUT IN TYPE OF RETRIEVAL
	MOV	(SP)+,(R5)+	;MOVE IN INCREMENT AND
	MOV	(SP)+,(R5)+	;DIRECTION (FLOATING NUMBER)
	MOV	(SP)+,(R5)+	;AND NOW STARTING
	MOV	(SP)+,(R5)+	;RECORD NUMBER
	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