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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.