SUBTTL System dependent code
PAGE


;Operating system dependent functions for FIG-FORTH

; This is the ^C interrupt handler code fragment.  The FORTH IP
; (SI) is loaded with the address of a pointer to the FORTH word
; (ABORT).  The jump to NEXT starts execution of the interpreter.

CTRLC:		PUSH	SI
		MOV	SI,2[BRK]	;Note: should be CS:2[BRK]
		CMP	SI,0		;check @BREAK
		JNZ	CC1		;not zero, (ABORT)
		POP	SI
		IRET			;zero, don't break
CC1:
		POP	AX		;adjust stack
		MOV	SI,OFFSET BRK+2
		JMP	NEXT

; This is code to perform system dependent initialization
; SYSINIT is called just prior to COLD

SYSINIT		PROC	NEAR
		MOV	AL,23H		;^C interrupt no.
		MOV	DX,OFFSET CTRLC
		MOV	AH,25H		;set ^C addr.
		INT	21H
		RET
SYSINIT		ENDP

;=?+  @BREAK	CFA of function to get control on ^C	-- addr

	$VAR	86H,@BREA,K,BRK
	DW	PABOR			;normal ABORT

;=C*  BYE	exit FORTH				? -- ?

	$CODE	83H,BY,E,BYE
	INT	20H

	INCLUDE	4TH-DISK.ASM	;FIG disk interface

	IF	_FILES
	INCLUDE	4TH-FILE.ASM	;MSDOS file interface
	ENDIF

	$REPORT	<MS-DOS disk interface completed>
	$REPORT	<B/BUF	=>,%BUFSIZE
	$REPORT	<B/REC	=>,%RECSIZE
	$REPORT	<BLK/DSK	=>,%BLPDRIVE

;****************************************
;*					*
;*	i/o primitives :		*
;*					*
;*	PQTER, PKEY, PEMIT, PCR,	*
;*	CONOUT, LSTOUT			*
;*					*
;****************************************
;
	IF	_DIRECTCON
CONIN		EQU	7
CONOUT		EQU	6
	ELSE
CONIN		EQU	8		;MSDOS console i/o fctn, no echo
CONOUT		EQU	2		;MSDOS console output function
	ENDIF
CONSTAT		EQU	11		;MSDOS console status check fctn

LSTOUT		EQU	5		;MSDOS printer output function
	IF	IOBITS EQ 8
CMASK		EQU	0FFH		;Use all 8 bits
	ELSE
CMASK		EQU	07FH		;Use only low 7 bits
	ENDIF
;
PQTER:
	IF	_DIRECTCON
		MOV	DX,00FFH	;read keyboard instead
		MOV	AH,CONOUT	;direct keyboard i/o, no wait
		INT	21H
		SUB	AH,AH		;AL has char or 0
		JMP	APUSH
	ELSE
		MOV	AH,CONSTAT
		INT	21H
		SUB	AH,AH		;AL=0FFh if character avail.
		JMP	APUSH
	ENDIF

;=C*  (KEY)	read console primitive			-- c

		$CODE	85H,(KEY,),PKEY
		MOV	AH,CONIN
		INT	21H
		AND	AX,CMASK	;strip unwanted bits
		JMP	APUSH

;=C*  (EMIT)	console char. output primitive		c --

		$CODE	86H,(EMIT,),PEMIT
		POP	DX		;char to send
		CALL	POUT
		JMP	NEXT

;=C*  (CR)	console newline primitive		--

		$CODE	84H,(CR,),PCR
		MOV	DX,ACR		;send carriage return
		CALL	POUT
		MOV	DX,LF		;and a linefeed
		CALL	POUT
		JMP	NEXT

;Code called by i/o functions above to do console and list output
;If the variable PRINTER contains 0, the character is sent to the
;console only.  If PRINTER is positive, the character is sent to the
;LST device only.  If PRINTER is negative, the character is sent to
;both the printer and the console.

POUT:
		AND	DX,CMASK	;strip off undesired bits
		MOV	BX,2[PRTER]	;check PRINTER
		OR	BX,BX		;zero?
		JZ	CONS		;console output only
		MOV	AH,LSTOUT	;non-zero, send to LST
		INT	21H
		JS	PRONLY		;negative, printer output only
CONS:
	IF	_DIRECTCON AND (IOBITS EQ 8)
		CMP	DL,0FFH		;try to send 0FF via fn. 6
		JNE	CONS1		;would wreak havoc, so
		MOV	AH,2		;do normal console output
		INT	21H
		RET
	ENDIF
CONS1:		MOV	AH,CONOUT	;send it to the console
		INT	21H
PRONLY:		RET

	$REPORT	<MS-DOS i/o primitives completed>

	IF	_TIMEANDDATE
;********************************************************
;*							*
;*		TIME@, TIME!, DATE@, DATE!		*
;*							*
;********************************************************

;=C+  TIME@	fetch system time			-- n1 n2

		$CODE	85H,TIME,@
		MOV	AH,2CH		;Get time
		INT	21H
		PUSH	DX		;[sec sec/100]
		PUSH	CX		;[hr min]
		JMP	NEXT

;=C+  TIME!	set system time				n1 n2 --

		$CODE	85H,TIME,!!!!
		POP	CX		;[hr min]
		POP	DX		;[sec sec/100]
		MOV	AH,2DH		;set time
		INT	21H
		JMP	NEXT

;=C+  DATE@	fetch system date			-- n1 n2 n3

		$CODE	85H,DATE,@
		MOV	AH,2AH		;get date in CX&DX
		INT	21H
		PUSH	CX		;year
		MOV	AL,DH		;month is in DH
		XOR	AH,AH		;clear high bytes
		XOR	DH,DH
		JMP	DPUSH		;DL=day
		$CODE	85H,DATE,!!!!

;=C+  DATE!	set system date				n1 n2 n3 --

		POP	CX		;year
		POP	DX		;DL=day
		POP	AX
		MOV	DH,AL		;DH=month
		MOV	AH,2BH		;set date
		INT	21H
		JMP	NEXT

	$REPORT	<MS-DOS time and date functions included>
	ENDIF
 . . . . . . . . . .   39