TITLE	'PL/1 CHAIN ROUTINE'
	NAME	'PGMCHN'
;FILE		PL1CHAIN.ASM
;		* * * *  PL/1 PROGRAM CHAIN  * * * * 
;PURPOSE	THIS ROUTINE PROVIDES THE ABILITY FOR
;		A PROGRAM TO CHAIN TO ANOTHER PROGRAM
;		IN THE SPECIAL HDBS SETUP.
;PROGRAMMER	ROBERT M. WHITE
;DATE CODED	23 JUL 1980
;INPUT
;		PARM1 =  A CHARACTER VARIABLE THAT CONTAINS THE FILE
;			NAME OF THE PROGRAM TO BE CHAINED TO.  THE STRING
;			MUST BE FORMED AS IF IT WERE COMING FROM THE CON-
;			SOLE AND MUST END WITH A PROPER TERMINATOR.
;OUTPUT
;REMARKS
;EQUATES
;		* * *  MISCELLANEOUS  * * *
BC	EQU	B		;MULTIPLE REGISTERS
DE	EQU	D
HL	EQU	H

;		* * *  CP/M EQUATES  * * *
;		* *  ADDRESS ASSIGNMENTS  * *
CPMEXIT	EQU	0		;WARM START BOOT LOCATION
BDOS	EQU	5		;BDOS ENTRY POINT
TBUFF	EQU	0080H		;DEFAULT BUFFER LOCATION
TDDN	EQU	0004H		;CURRENT DEFAULT DRIVE NUMBER
TFCB	EQU	005CH		;DEFAULT FCB LOCATION 1
TFCB2	EQU	006CH		;DEFAULT FCB LOCATION 2 ( MUST BE MOVED)
TIOBYTE	EQU	0003H		;INTEL STANDARD I/O BYTE
TPABGN	EQU	0100H		;TRANSIENT PROGRAM AREA BEGINNING
;
;		* FCB EQUATES *
FCBET	EQU	0		;FCB ENTRY TYPE - DISK DEVICE
FCBFN	EQU	1		;FILE NAME, 8 CHARS, PADDED WITH BALNKS
FCBFT	EQU	9		;FILE TYPE, 3 CHARS, PADDED WITH BLANKS
FCBEX	EQU	12		;FILE EXTENT (0 - 15)
;		13-14		;*NOT USED*
FCBRC	EQU	15		;RECORD COUNT IN CURRENT EXTENT (0-128)
FCBDM	EQU	16		;DISK ALLOCATION MAP, USED BY CP/M
;				;  EACH BYTE OF THE MAP CONTAINS THE CP/M
;				;  GROUP NUMBER FOR THE ALLOCATED 1K OR
;				;  IT CONTAINS ZERO FOR NOT USED.
FCBNR	EQU	32		;NEXT RECORD NUMBER TO READ OR WRITE
;				;  THIS IS SET BY YOU PRIOR TO READING OR
;				;  WRITING A RECORD.  IT IS AUTOMATICLY
;				;  INCREMENTED UPON RETURN BY CP/M.
FCBR0	EQU	33		;RELATIVE RECORD NUMBER (3 - BYTES)
FCBR1	EQU	34		;   AS OF CP/M 2.0
FCBR2	EQU	35
FCBLEÎ	EQÕ	4¸		;FCÂ LENGTH (GUESSED)
;				;NOTE --
;				;	TO ACCESS A FILE DIRECTLY, YOU
;				;	USE FCBNR AND FCBEX TO GET TO THE
;				;	DESIRED RECORD.  IF FCBEX IS TO
;				;	BE CHANGED THE FILE MUST BE CLOSED
;				;	AND RE-OPENED. 
;				;	FCBEX = RECORD#/128
;				;	FCBNR = RECORD# MOD 128


;		DO INITIALIZATION.
PGMCHN:	CSEG
	PUBLIC	PGMCHN
	LXI	SP,STACK	;SET THE STACK.
	MOV	E,M		;GET STRING PTR.
	INX	H
	MOV	D,M
	XCHG			;SAVE IT.
	SHLD	STRPTR

;		INITIALIZE THE DEFAULT FCB.
	LXI	D,TFCB
	CALL	FCBINT

;		BUILD DEFAULT FCB FROM INPUT STRING.
	LXI	D,TFCB
	LHLD	STRPTR
	CALL	FCBMAK

;		JUMP TO CHAIN ROUTINE.
	JMP	0100H




;		* * *  INITIALIZE FCB  * * *
;PURPOSE
;		THIS ROUTINE ZEROES AN FCB.
;INPUT
;		DE => FCB
;OUTPUT
;		SAME AS INPUT
;
;
;		DO INITIALIZATION.
FCBINT: DS	0
	PUSH	DE		;SAVE REGS.
	PUSH	HL
;
;		ZERO ENTIRE FCB.
	MVI	C,FCBLEN	;SET LENGTH.
	MOV	H,D		;HL => FCB
	MOV	L,E
	MVI	M,0		;ZERO FCB.
	INX	HL
	DCR	C
	JNZ	$-4
;
;		BLANK NAME FIELDS.
	MVI	C,FCBFT-FCBFN+3	;SET LENGTH.
	LXI	HL,FCBFN	;HL => FCBFN
	DAD	DE
	MVI	M,' '		;MOVE SPACES TO FCB.
	INX	HL
	DCR	C
	JNZ	$-4
;
;		RETURN TO CALLER.
	POP	HL		;RESTORE REGS.
	POP	DE
	RET
;
;
;
;
;		* * *  MAKE AN FCB GIVEN FILE NAME  * * *
;PURPOSE
;		THIS ROUTINE BUILDS A FCB FILE NAME GIVEN A
;		STANDARD CP/M EXTERNAL FILE NAME OF THE FORM:
;			[D:]NNNNNNNN[.TTT]
;		WHERE D = OPTIONAL DISK DEVICE (A-Z)
;		      NNNNNNNN = FILE NAME
;		      TTT = OPTIONAL FILE TYPE
;INPUT
;		DE => FCB
;		HL => INPUT STRING
;OUTPUT
;		HL => NEXT CHAR AFTER INPUT STRING
;		CY:ON = ERROR ENCOUNTERED
;
;
;		DO INTIALIZATION.
FCBMAK: DS	0
	PUSH	BC		;SAVE REGS.
	PUSH	DE
;
;		CHECK FOR DISK CODE.
	INX	HL		;CHECK FOR ':'.
	MOV	A,M
	DCX	HL
	CPI	':'		;':' PRESENT?
	JNZ	MAK01		;...NO.
;
;		SET DISK CODE.
	MOV	A,M		;GET IT.
	SBI	'A'-1		;MAKE 1-26 FOR 'A'-'Z'
	JC	MAKEND		;...ERROR.
	CPI	26+1		;RANGE CHECK.
	CMC
	JC	MAKEND
	STAX	DE		;PUT IT IN FCB.
	INX	HL		;BUMP PTR PAST DISK DRIVE.
	INX	HL

;		GET FILE NAME.
MAK01:	DS	0
	INX	DE		;DE => FCBFN
	MVI	C,8		;SET FOR MAX OF 8 CHARS.
	CALL	MAKNAM		;GET IT.
;
;		GET OPTIONAL FILE TYPE.
	MOV	A,M		;GET NEXT CHAR.
	INX	HL
	CPI	'.'		;PROPER SEPARATOR?
	JNZ	MAKEND		;...NO.
	MVI	C,3		;SET FOR MAX OF 3 CHARS.
	CALL	MAKNAM		;GET IT.
;
;		RETURN TO CALLER.
MAKEND:	DS	0
	POP	DE		;RESTORE REGS.
	POP	BC
	RET
;
;		PROCESS THE NAME FIELD.
MAKNAM:	DS	0
	MOV	A,M		;GET NEXT CHAR.
	INX	HL		;BUMP PTR.
	CPI	'*'		;FILL REST WITH '?'?
	JZ	MAKNA2		;...YES, DO IT.
	CALL	MAKVAL		;VALID CHAR?
	JC	MAKNA4		;...NO, STOP.
MAKNA1: DS	0
	STAX	DE		;PUT CHAR IN FCB.
	INX	DE		;BUMP PTR.
	DCR	C		;DECR CNT.
	JNZ	MAKNAM		;LOOP FOR MAX CHARS.
	CALL	MAKVAL		;CHECK FOR TOO LONG.
	CMC
	RET
MAKNA2:	DS	0		;*** FILL REST WITH '?' ***
	MVI	A,'?'
MAKNA3:	DS	0
	MVI	B,0
	STAX	DE		;PUT '?' IN FCB.
	INX	DE
	DCR	C
	JNZ	$-3		;LOOP FOR REST OF FIELD.
	RET
MAKNA4:	DS	0		;*** SKIP FCB PTR TO END OF FIELD ***
	MVI	A,' '		;FILL REST WITH SPACES.
	JMP	MAKNA3
;
;		VALIDATE NAME CHARACTER.
MAKVAL:	DS	0
	CPI	'#'
	RZ
	CPI	'$'
	RZ
	CPI	'%'
	RZ
	CPI	'?'
	RZ
	CPI	'0'	;0-9
	RC
	CPI	'9'+1
	CMC
	RNC
	CPI	'A'	;A-Z
	RC
	CPI	'Z'+1
	CMC
	RNC
	RET


;		* * *  PROGRAM CONSTANTS AND VARIABLES  * * *
	DSEG
	DS	32		;PROGRAM STACK
STACK:
STRPTR: DW	0		;INPUT STRING PTR

;END		CHAIN.ASM
	END