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 ; 8003 ; DDT ; M8000,BEE2,100 BEE2 WAS GIVEN BY RLC. ; A100 THIS ADDS FAKE JMP TO BDOS. ; JMP 0 ; ; S109 THIS SUBS IN HIGH MEM PTR. ; FF ; DF ; . ; ^C ; SAVE 64 MDBS.COM 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 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