prnval.asm

Dos6.0

	INC	SI		;skip the leading blank if write statement
	DEC	AX		;decrement the length
WTMKSD:
	cCall	MAKESD		;[BX]=*sd
	JMP	SHORT PRTIT2	;go print it
PRTUSG:
				; print using, so make QBI compatable.
	CMP	AH,COMA		; PRINT USING COMMA?
	JNE	NotComma	; brif not -- don't alter terminator
	MOV	b$TTYP,SEMI	; change comma to semicolon
NotComma:			
	CALL	[b$PUSG]	;print using is handled specially
	JMP	SHORT PRTEND	;process the terminator
PRTSTR: 			;when enter, BX=*sd
	MOV	AX,[BX] 	; AX = length of string
	TEST	[b$PRFG],WRSTM	; is write stmt on ?
	JZ	PRTIT1		;Brif not, go printing string
	MOV	AL,'"'		;'"' is the delimitor of write string
	PUSH	BX		; save psd
	CALL	[VWCH]		;print '"'
	POP	BX		; restore psd
	CALL	[VTYP]		;output the string
	CALL	[b$pSTDALCTMP]	; deallocate the temp if it is
	MOV	AL,'"'		;'"' is the delimitor of write string
	CALL	[VWCH]		;print it
	JMP	SHORT PRTEND	;process the terminator
PRTCLF:
	CALL	[VWCLF] 	;force a EOL
	cCall	BPEOS		;epilog for PRINT
	JMP	SHORT PRINTX	;exit to caller
PRTEND2:			; here if comma or semi and NOT write stmt
	INC	AX		; test for semi delimitor
	JNZ	PRINTX		; go exit, done if semi-colon
PRTCMA:
	CALL	[VPOS]		;[AH]=current cursor position
	MOV	AL,AH		;position in AL
	XOR	AH,AH		;prepare for DIV
				;Note: can't use CBW here, since the range
				;	is 0 - 255 (unsigned)
	MOV	CL,CLMWID	;get field length
	DIV	CL		;AH=remainder, is the position in this column
	SUB	CL,AH		;spaces needed to fill this column
	XCHG	AX,CX		; put count in AL
	CBW			;extend to a word
	PUSH	AX		;save count of patching spaces
	ADD	AX,CLMWID	;account for width of next column
	cCall	[VPRTCHK]	; CY if room is not enough to fit (possibly
				; a EOL was forced)
	POP	CX		;get back count in CX
	JB	PRINTX		;no need to patch spaces
	CALL	B$OutBlanks	; output CX blanks
PRINTX: 			;pop SI & exit to caller

	POP	SI		; restore
	POP	BP		
	POP	CX		; [CX] = return offset
	POP	DX		; [DX:CX] = return address
	POP	BX		; discard 1st word of parameter
	MOV	AL,BYTE PTR [b$?TYP]	; [AL] = type byte
	TEST	AL,VT_SD	; NZ if I2 or SD, i.e., if 1-word parm
	JNZ	PRINTX_5	; Jump if we don't need to pop more
	POP	BX		; Discard 2nd word of parameter
	TEST	AL,8		; R8 or currency (8-byte values)?
	JZ	PRINTX_5	; no, don't pop any more
	POP	BX		; discard 3rd word of parameter
	POP	BX		; discard 4th word of parameter
PRINTX_5:			
	PUSH	DX		; put back seg...
	PUSH	CX		; ... and offset of far return address
	RET			; and return

cEnd	nogen			;no code generated

	SUBTTL	supporting routines for print an item
	page
;***
;PRTCHK -- check whether there is room for the printing string
;
;Purpose:
;	Check whether there is room for the printing string.  If it isn't,
;	force a EOL if the current position is not in col. 1.
;
;	Prtchk(len_of_str)
;	register int len_of_str
;	{
;	    register int d_width
;	    register int current_pos
;
;	    if ((d_width=vwid()) != 255)
;		if ( (len_of_str > 255) ||
;		     ((d_width - (current_pos=vpos()) - len_of_str) < 0) )
;		{   if (current_pos != 0) /* 0-relative */
;			vclf()
;		    Set_CY
;		}
;	}
;
;Entry:
;	register AX = len_of_str
;
;Exit:
;	CY if room left is not enough (may or may not force a EOL)
;
;Uses:
;	None
;
;Exceptions:
;	None
;*******************************************************************************

cProc	B$PRTCHK,<NEAR,PUBLIC>	

cBegin
	XCHG	DX,AX		; length in DX
	CALL	[VWID]		;[AH] = device width
	CMP	AH,255		;is device a file ?
	JZ	CHKEXT		;exit (with NC)
	MOV	AL,AH		;[AL] = device width
	JMP	SHORT PRTCHK1	
cEnd	<nogen>

cProc	TTY_PRTCHK,<NEAR>	
cBegin				
	XCHG	DX,AX		; length in DX
	MOV	AL,b$CRTWIDTH	; AL = device width

PRTCHK1:			
	CALL	[VPOS]		;[AH] = current position
	OR	DH,DH		; more than 255 char to print?
	JNZ	FORCE		; force a EOL
	SUB	AL,AH		;amount left on line
	JB	FORCE		;If no room on line, need new line
	CMP	AL,DL		;will amount requested fit?
	JAE	CHKEXT		;exit (with NC)
FORCE:
	OR	AH,AH		;is current position 0 (at col 1)
	JZ	NOCRLF		;do not print EOL if at col 1
	CALL	[VWCLF] 	;force EOL
NOCRLF:
	STC			;indicate room is not enough
Near_Ret:			;near return for vector
CHKEXT:
cEnd				;end of PRTCHK

;***
;MAKESD -- make a static string descriptor
;
;Purpose:
;	Make a static string descriptor (in b$TempSD) which points to the
;	input string.  Major changes with revision [38].
;
;	WARNING !!! This routine assumes that the word preceding the string
;	WARNING !!! is available to be used as the string header
;
;Entry:
;	[SI] = address of the string
;	[AX] = length of the string
;
;Exit:
;	[BX] = address of static descriptor (b$TempSD)
;	b$TempSD & b$TempStrPtr set up as SD.
;
;Uses:
;	Backs up SI by 2.
;
;*******************************************************************************

cProc	MAKESD,<NEAR>		;private local routine

cBegin
	MOV	BX,OFFSET DGROUP:b$TempSD	; get the offset
	MOV	WORD PTR [BX],AX		; length goes first
	MOV	WORD PTR [BX+2],SI		; string pointer next
cEnd

;***
;BPEOS -- actual code to terminate a print statement.
;
;Purpose:
;	This routine is called by either the interface B$PEOS or B$PExx
;	(print an item which terminated with a EOL)
;	If FV_FARSTR, deallocate "using" string here if it was a temp.
;Entry:
;	b$PTRFIL is the pointer/handle to FDB
;Exit:
;	b$PTRFIL & b$PRFG are reset
;Uses:
;	none
;Exceptions:
;	I/O error or disk full error (when flush the buffer)
;*******************************************************************************

cProc	BPEOS,<NEAR>,<SI>	;was part of $PV4, SI saved

cBegin
	MOV	SI,[b$PTRFIL]	;get the pointer to FDB
	OR	SI,SI		;is file 0 ? (TTY)
	JZ	PEOSX		;Brif tty output, reset flags and exit
	MOV	[b$PTRFIL],TTY ; clear out active FDB block
	FDB_PTR ES,SI,SI	;(ES:)[SI] = *FDB
	CMP	SI,OFFSET DGROUP:b$LPTFDB ;is line printer ?
	JE	PEOSX		;Brif LPRINT
	TEST	FileDB.FD_FLAGS,FL_CHAR ;check for character device file
	JZ	PEOSX		;Brif not character device
	CALL	[b$pFLUSH]	; is character device, flush buffer
				; was save and restore registers AX,BX,CX &
				; DX in $PV4
PEOSX:
	TEST	[b$PRFG],WRSTM+LPSTM+CHANL ;was LPRINT, WRITE or # ?
	MOV	[b$PRFG],PRSTM ;reset the print flag
	JZ	NoSetVec
	MOV	SI,OFFSET DGROUP:TTYVEC
				;get source to fill in
	cCall	B$WCHSET	;reset vector to default, needs SI
NoSetVec:
cEnd				;pop SI & exit to caller

	SUBTTL	print/input interface -- B$PEOS [4]
	page
;***
;B$PEOS -- epilog for PRINT/WRITE/LPRINT/INPUT[#]/READ
;
;Purpose:
;	if print, then clear out active FDB block, and flush buffer in case
;		of a character device, also reset print flags
;	if input, reset input flag & variable
;
;	NOTE: this routine plays around with the stack pointer and stack frame
;		pointer (BP).  Be really careful when save something in the
;		stack.
;Entry:
;	[b$PTRFIL] is the pointer to FDB
;	[b$FInput] is the flag for input
;	[b$PRFG] is the flag for print
;Exit:
;	b$PTRFIL & b$PRFG & b$FInput (also b$GetOneVal) are reset
;Uses:
;	none
;Exceptions:
;	I/O error or disk full error (when flush the buffer (BPEOS))
;*******************************************************************************

cProc	B$PEOS,<PUBLIC,FAR>	

cBegin
	PUSH	BP		
	MOV	BP,SP		;set up stack frame explicitly, since error
				; could happen when flushing the buffer
	PUSH	ES		
	MOV	AL,[b$Finput]	; get flag
	OR	AL,AL		; test it
	JS	TryPrint	; either READ stmt or default, try print
	JNZ	RstFlags	; was disk input, just reset flags
	PUSH	SI		; save SI
	PUSH	DI		; save DI
	MOV	DI,[b$StkBottom]	; DI is the stack bottom
	DEC	DI		; one word above
	DEC	DI
	MOV	SI,SP		; SI points to the BP
	ADD	SI,10		;[12] SI points to ret_seg
	MOV	CX,3		; 3 words to move
	STD			; the move has to be from memory high to
				;  low to avoid overlapping
	PUSH	DS		
	POP	ES		
	REP	MOVSW		; mov BP and return addr to new location
	CLD			; clear direction

	MOV	BP,DI		; stack frame has to be changed
	ADD	BP,2		; new locaton of old BP (later on,
				;  "MOV SP,BP" will clean the stack)
	POP	DI		; get back DI
	POP	SI		; get back SI
RstFlags:			
	cCall	B$InpReset	; reset input flag if this is input stmt
	JMP	SHORT EosExit	
TryPrint:			; either print or READ stmt may be here,
				;  however, next call, BPEOS, won't hurt
				;  if it is READ stmt
	cCall	BPEOS		;try print flush the buffer and reset flags
EosExit:			


	POP	ES		
	MOV	SP,BP		;remove stack frame
	POP	BP		
cEnd				;pop BP & exit

	SUBTTL	set up print dispatch vector
	page
;***
;B$WCHSET -- set up print dispatch vector
;
;Purpose:
;	b$VECS is the dispatch vector for PRINT/WRITE/LPRINT, which contains
;	the address for different functions.  The functions are:
;		b$VECS:
;			VPOS	-- current cursor position
;			VWID	-- device line width
;			VWCLF	-- force EOL
;			VWCH	-- write one character
;			VTYP	-- write a string with a given *sd
;			VTYPCNT -- write a string with length in CX
;			VOUTCNT -- write a string char. by char.
;			VPRTCHK -- check if EOL needs to be forced
;Entry:
;	[SI] points to the source which will fill in the b$VECS
;Exit:
;	b$VECS is set up
;Uses:
;	SI
;Exceptions:
;	none
;*******************************************************************************

cProc	B$WCHSET,<PUBLIC,NEAR>,<DI,ES> ;save ES,DI

cBegin
	PUSH	DS		
	POP	ES		; can't assume ES=DS, set them equal
	MOV	DI,OFFSET DGROUP:b$VECS
	MOV	CX,SizeOfVecs	;count of words to copy
	REP	MOVSW
cEnd				;pop DI,ES and exit to caller


;*** 
; B$OutBlanks -- output a string of blanks.  Added with [22].
;
;Purpose:
;	Save some code, and eliminate a static buffer of blanks.
;	Doesn't print anything if count not in range 1-32767.
;
;Entry:
;	CX = number of blanks to output
;Exit:
;	None
;Uses:
;	Per convention
;Exceptions:
;	None
;
;******************************************************************************

cProc	B$OutBlanks,<PUBLIC,NEAR>,<SI,DI>	; Save SI,DI

cBegin
	OR	CX,CX		; negative or zero byte count
	JLE	OutExit 	; brif no blanks to output


DbAssertRel CX,BE,2*FILNAML,DK_TEXT,<B$OutBlanks: cnt too large>    

	PUSH	CX		;save cnt
	PUSH	SS		;ES = DGROUP
	POP	ES		
	MOV	DI,OFFSET DGROUP:b$Buf1 
	PUSH	DI		
	INC	CX		;round byte count to word count
	SHR	CX,1		
	MOV	AX,'  ' 	
    REP STOSW			;fill with spaces
	POP	SI		;DS:SI = string
	POP	CX		;CX = count
	CALL	[VOUTCNT]	;print the spaces


OutExit:
cEnd				;exit to caller

	page
;***
;NoGetValAssert - Assertion code for calls through [b$GetOneVal].
;
;Purpose:
;	The variable [b$GetVal] is reset with common code to point to
;	the default READ/INPUT entry point.  When no INPUT/READ statement
;	is used in a program linked /O, there is no need to drag in the
;	READ code.  So, b$GetVal is initialized to point to this routine
;	for this case.	If someone inadvertently tries to call through
;	b$GetVal when no READ/INPUT code is loaded, it will be caught here.
;	Added with revision [27].
;Entry:
;	none
;Exit:
;	none
;Uses:
;	none
;Exceptions:
;	none
;*******************************************************************************

cProc	NoGetValAssert,<NEAR>
cBegin
	DbHalt <DK_TEXT>,<Tried to call B$ReadVal when it wasn't loaded>
cEnd
	page
;***
;B$InpReset -- reset flag and variables for INPUT related statement
;
;Purpose:
;	Reset flag and variables for input related statement.
;	Moved to this file with [23]
;
;Entry:
;	none
;
;Exit:
;	[b$FInput]	= InpDefault
;	[b$GetOneItem] = OFFSET B$ReadItem
;	[b$PTRFIL]	= TTY
;
;Uses:
;	none
;
;Exceptions:
;	none
;*******************************************************************************

cProc	B$InpReset,<PUBLIC,NEAR>

cBegin
	MOV	[b$FInput],InpDefault
				;reset input flag

; If input was pulled in, then this points to B$ReadVal, if no READ/INPUT
; statement was used, then this really points to the assertion routine
; NoGetValAssert

	PUSH	AX		
	MOV	AX,[b$pGetValDefault] ;get default value for READ/INPUT

	MOV	[b$GetOneVal],AX ;reset get item routine
	POP	AX
	MOV	[b$PTRFIL],TTY ;reset to TTY
cEnd				;exit to caller

	SUBTTL	interface for WRITE preamble
	page
; B$WRIT moved here from PR0A.ASM and modified for greater /O modularity.
;Revision number [25] applies to entire routine.
;***
;B$WRIT -- preamble for WRITE statement [25]
;void B$WRIT(void)
;
;Purpose:
;	This is the only preamble for WRITE statement.	This routine sets up
;	flag for WRITE statement.  BASCOM 2.0 uses two preambles,
;	$WRI for WRITE and $WRD for WRITE #.
;
;	The flag, b$PRFG, is set to 4 (WRSTM) to indicate a WRITE statement
;	is processing.	If it is a WRITE #, then B$CHOU will OR the flag,
;	b$PRFG, with 1 (CHANL) to indicate a special channel is being used.
;Entry:
;	none
;Exit:
;	b$PRFG is set to WRSTM (WRITE statement is on going)
;	uses default vectors, same as PRINT.
;Uses:
;	none
;Exceptions:
;	none
;*******************************************************************************

cProc	B$WRIT,<PUBLIC,FAR,FORCEFRAME>	; stack frame generated explicitly

cBegin
	OR	[b$PRFG],WRSTM	; set flag indicating WRITE stmt is on going
	CALL	B$CNTRL		; check for control chars during print
cEnd				; return to caller

sEnd				;end of DK_TEXT
	END