	TITLE	'MDBS/PLI INITIALIZATION AND CHAIN PROGRAM'
;PROGRAM
;		MDBS/PLI INITIALIZATION AND CHAIN PROGRAM
;PROGRAMMER
;		ROBERT M. WHITE
;DATE WRITTEN
;		JULY 19, 1980
;(C)COPYRIGHT	1980,H & W COMPUTER SYSTEMS, INC.
;PURPOSE
;		THIS ROUTINE PERFORMS TWO MAIN THE FUNCTIONS.  THE FIRST
;		IS TO INITIALIZE THE SYSTEM FOR A PL/1 PROGRAM TO UTILIZE
;		MDBS.  THE SECOND TO PERFORM A CHAINING FUNCTION SO THAT
;		PL/1 PROGRAMS CAN BE OVERLAYED IN MEMORY.  FOR INITIALIZA-
;		TION, THE PL/1 PROGRAM IS GIVEN FROM 0300H TO 7FFFH IN
;		MEMORY.  MDBS IS GIVEN FROM 8003H TO THE BEGINNING OF BDOS.
;		NOTE THAT A JUMP IS INSERTED AT 8000H TO FAKE OUT PL/1.
;		TO IT, THE JUMP IS ACTUALLY BDOS AND WILL LIMIT ALL DYNAMIC
;		STORAGE ALLOCATIONS TO AREAS BELOW IT.
;REMARKS
;		1.  IT IS ASSUMED THAT A FILE NAMED "MDBS.COM" EXISTS 
;		    WHICH CONTAINS A RELOCATED VERSION OF MDBS.REL TO
;		    8003H AND CONTAINS THE END-OF-TPA PTR INITIALIZED.
;		    THE FOLLOWING WAS USED TO DO THIS.
;				RLC<CR>
;				8003<CR>
;				DDT<CR>
;				M8000,BEE2,100<CR>   BEE2 WAS GIVEN BY RLC.
;				A100<CR>     THIS ADDS FAKE JMP TO BDOS.
;				JMP 0<CR>
;				<CR>
;				S109<CR>     THIS SUBS IN HIGH MEM PTR.
;				FF<CR>
;				DF<CR>
;				.<CR>
;				^C
;				SAVE 64 MDBS.COM<CR>


	MACLIB	MACRO
DFCB	EQU	005CH		;DEFAULT FCB
OVLBGN	EQU	0800H		;BEGINNING ADDRESS OF OVERLAY AREA
DMSBGN	EQU	8003H		;BEGINNING ADDRESS OF MDBS DMS ENTRY

;		DO INITIALIZATION.
	TRMDFN			;DEFINE TERMINAL DEFINITION.
MAIN:	CSEG
	LXI	SP,STACK	;SET STACK.

;		CAUSE INITIALIZATION TO BE BYPASSED AFTER FIRST CALL.
INITSKP:
	NOP			;BRANCH FOR HEREAFTER.
	NOP
	NOP
	MVI	A,(JMP)		;CAUSE READ TO BE BYPASSED NEXT TIME.
	STA	INITSKP
	LXI	H,INITBYP
	SHLD	INITSKP+1
	CLS			;CLEAR THE SCREEN.


;		READ IN MDBS.
	PRINT	<'READING IN MDBS.',CR,LF>
	LXI	D,MDBSFCB	;FCB FOR MDBS.
	LXI	H,DMSBGN-3	;START ADDRESS.
	CALL	RDINPGM		;READ IN MDBS.
	ORA	A		;SUCCESSFUL?
	JZ	MDBSOK		;...YES.
	PRINT	<'*** MDBS COULD NOT BE LOADED, ABORTING... ***',CR,LF>
	JMP	0
MDBSOK:
	PRINT	<'MDBS HAS BEEN SUCCESSFULLY READ IN.',CR,LF>

;		SET NEW BDOS ENTRY.
	LXI	H,DMSBGN-3	;SET NEW BDOS ENTRY POINT TO FOOL PL/1.
	SHLD	6

;		OPEN THE DATABASE.
	PRINT	<'OPENING THE DATABASE.',CR,LF>
	LXI	B,O1		;SET UP PARMS.
	LXI	D,O2
	LXI	H,O3
	MVI	A,37		;SET FOR OPEN.
	CALL	DMSBGN		;CALL MDBS.
	ORA	A		;CHECK RETURN CODE.
	JZ	DBSOK		;...SUCCESS.
	PUSH	PSW
	PRINT	<'*** DATABASE RETURN CODE IS '>
	POP	PSW
	MOV	L,A
	MVI	H,0
	DECOUT
	PRINT	<'. ***',CR,LF>
	PRINT	<'*** DATABASE COULD NOT BE OPENED. ***',CR,LF>
	JMP	0
DBSOK:
	PRINT	<'DATABASE HAS BEEN SUCCESSFULLY OPENED.',CR,LF>

;		SET WARM START TO CLOSE DB.
	LHLD	1		;GET CURRENT WARM START PTR.
	INX	H
	SHLD	WSTRTP		;SAVE IT.
	MOV	E,M		;GET CURRENT WARM START ADDRESS.
	INX	H
	MOV	D,M
	XCHG			;SAVE IT.
	SHLD	WSTRTA
	XCHG
	LXI	D,ENDPGM	;SET NEW WARM START PTR.
	MOV	M,D
	DCX	H
	MOV	M,E

;		MOVE FIRST PGM NAME TO DEFAULT FCB.
	MOVE	PGMFCB,DFCB,32
INITBYP: DS	0

;		READ IN PLI PROGRAM.
	PRINT	<CR,LF,'READING IN NEXT PROGRAM...',CR,LF>
	LXI	D,DFCB		;SET FOR DEFAULT FCB.
	LXI	H,OVLBGN	;START ADDRESS.
	CALL	RDINPGM		;READ IN THE PLI PGM.
	ORA	A		;SUCCESSFUL?
	JZ	OVLBGN		;...YES.
	PRINT	<'*** CHAINED PL/1 PROGRAM COULD NOT BE LOADED... ***',CR,LF>
	JMP	0
	PAGE
;****************************************************************
;*                          END OF RUN                          *
;****************************************************************

;		CLOSE THE DATABASE.
ENDPGM:
	MVI	A,3		;SET FOR CLOSE.
	CALL	DMSBGN		;ISSUE IT TO MDBS.

;		RESTORE TRUE WARM START PTR.
	LHLD	WSTRTA		;GET WARM START ADDRESS.
	XCHG			;SAVE IT.
	LHLD	WSTRTP		;GET ADDRESS OF WHERE TO PUT IT.
	MOV	M,E		;REPLACE IT WITH THE ORIGINAL ADDRESS.
	INX	H
	MOV	M,D

;		NOW DO TRUE WARM START.
	JMP	0
	PAGE
;****************************************************************
;*                  READ IN A PROGRAM                           *
;****************************************************************

;		OPEN THE FCB.
RDINPGM:
	SAVE	D,H
	DISKIO	OPEN		;ISSUE OPEN.
	RESTORE H,D
	CPI	255		;SUCCESSFUL?
	RZ 			;...NO, RETURN.

;		SET ADDRESS FOR NEXT REGISTER.
RDINLOOP:
	SAVE	D,H
	XCHG
	DISKIO	SETDMA
	RESTORE H,D

;		READ A RECORD.
	SAVE	D,H
	DISKIO	READ
	RESTORE	H,D
	ORA	A		;SUCCESSFUL?
	JZ	RDINOK		;...YES.
	XRA	A		;RETURN W/O ERROR.
	RET
RDINOK:

;		BUMP PTR AND LOOP.
	PUSH	D
	LXI	D,128		;CP/M RECORD LENGTH.
	DAD	D		;ADD IT TO PTR.
	POP	D
	JMP	RDINLOOP


;		PROGRAM CONSTANTS.
WSTRTA: DW	0		;WARM START ENTRY
WSTRTP:	DW	0		;WARM START ENTRY PTR
O1:	DB	'MODIFY  '	;MDBS OPEN PARMS.
O2:	DB	'ACCTSYS.DB      '
O3:	DB	'USER            '
	DB	'PASSWORD        '
MDBSFCB: DB	1,'MDBSDMS ','COM',0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	DB	0
PGMFCB: DB	1,'ACCTMENU','COM',0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	DB	0
	DS	64		;PROGRAM STACK
STACK:
	END
