.MCALL	.MODULE
.MODULE	PISFUN,15,<PI SPFUN Processing>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
	.MCALL	.ASSUME,.QELDF
 
	PISFUN		;Define PISFUN symbols

.IRPC	X,<05>
.MACRO	CK.R'X	LABEL,CHANGE=+2
.IIF LT CHANGE,CK.R'X=CK.R'X''CHANGE
.IIF NB LABEL,				.ASSUME CK.R'X EQ LABEL
.IIF GT CHANGE,CK.R'X=CK.R'X''CHANGE
.ENDM
.ENDR
 
 
.IIF	NDF	MMG$T	MMG$T=0
	.QELDF
 
	.ENABL	LSB

	.PSECT	SPFUN,I

.IF NE MMG$T

ABORT::	ASH	#3,R4		;Get job number in same bits as in Q.JNUM
	MOV	INCQE,R5	;R5 -> internal queue (0 or 1 elements)
	BEQ	3$		;If queue is empty there's nothing to do
	CMPB	R4,GIDJBN	;Is GIDIS aborting?
	BNE	2$		;Branch if not

	CLR	RUNFLG		;Indicate that server is not running
	MOVB	#-1,GIDJBN	;Don't allow aborts to match job #
1$:	CLRB	Q$FUNC(R5)	;Requeue internally queued request as error
	CLR	R4		;Signify no queue element on handler queue
	MOV	#DRFIN,-(SP)	;Set up as though we were called from PIREQ
$REL	.-2	DRFIN	PIRK	; by loading same address on stack
	JMP	SWITCH		;Go emulate a F.STOP request

2$:	MOVB	Q$JNUM(R5),-(SP) ;Get queue element's job number
	BICB	#207,@SP	;Isolate it
	CMPB	(SP)+,R4	;Is this the aborting job's queue element?
	BEQ	1$		;Abort the queue element
3$:	RETURN

.ENDC	;NE MMG$T

SPFUN::
	MOV	@#PICQE,R0		;Point to current queue element
$REL	.-2	PICQE	PIRK
	MOV	R0,R4			;R4 -> Q.BLK
					CK.R0=Q$BLKN
					CK.R0 Q$BLKN,+2
	MOV	(R0)+,R5		;Save block number
					CK.R0 Q$FUNC,0
	TSTB	@R0			;SPFUN request?
	BPL	BADCMD			;No, error

.IF NE	MMG$T
	MOV	@#VD$SLT,R1		;Get pointer to video registers
$REL	.-2	VD$SLT	PIRK
	ADD	#VD$CSR,R1		;Point to video CSR
					CK.R0 Q$FUNC,0
	CMPB	#F.UNLK,@R0		;GIDIS unlock text request?
	BNE	4$			;Branch if not

UNLOCK:	CALLR	@#UNLTXT		;Enable text mode and return
$REL	.-2	UNLTXT	PIRK
					CK.R0 Q$FUNC,0
4$:	CMPB	#F.LOCK,@R0		;GIDIS lock text request?
	BNE	10$			;Branch if not

LOCK:	BIS	#PR7,@#PS
	MOV	SP,@#PRIO0		;Indicate that video is busy
$REL	.-2	PRIO0	PIRK
	BIT	#VDDIE$,@R1		;Is transfer done interrupt enabled?
	BEQ	5$			;Branch if not
	MOV	#100000,@#REENAB	;Turn interrupts back on later
$REL	.-2	REENAB	PIRK
	BIC	#VDDIE$,@R1		;Disable video transfer done interrupt
5$:	BIC	#PR7,@#PS

	MOV	#VIDMOD,R3		;R3 -> Video mode word
$REL	.-2	VIDMOD	PIRK
	TST	@R3			;Are we already in GIDIS mode?
	BNE	8$			;Branch if so
	MOV	SP,@R3			;Change video mode to GIDIS
6$:	CMP	@#SCRBOT,@#ROWYCO	;Wait until scrolling is completed
$REL	.-4	SCRBOT	PIRK
$REL	.-2	ROWYCO	PIRK
	BLT	6$			;Keep waiting
	MOV	R1,R5
	SUB	#VD$CSR,R5
;;;
	CLR	R3			;Disable and
	CALL	@#$DECTCE		; erase cursor (if it is on)
$REL	.-2	$DECTCE	PIRK
;;;
	JSR	R5,CNTXTS		;Do a video context switch
	 .WORD	TX$REG-.		; from TEXT
7$:	 .WORD	TX$REG-.		;  to GIDIS
	MOV	#<GD$REG-7$>,7$	;   after the first time
8$:	RETURN
TXTMOD::JSR	R5,CNTXTS		;Do a video context switch
	 .WORD	GD$REG-.		; from GIDIS
	 .WORD	TX$REG-.		; to TEXT
	RETURN

CNTXTS:	MOV	R5,R2			;Point to "from"
	ADD	(R5)+,R2		; context (PICly)
	MOV	R5,R3			;Point to "to"
	ADD	(R5)+,R3		; context (PICly)
	MOV	@SP,R1
	ADD	#VD$CSR,R1
9$:	TST	@R1			;Wait for transfer to finish
	BPL	9$			;Branch if still busy
	MOV	@R1,(R2)+		;Save video CSR
	MOV	(R3)+,(R1)+		;Restore video CSR
	MOV	@R1,(R2)+		;Save video plane 1 control
	MOV	(R3)+,(R1)+		;Restore video plane 1 control
	MOV	@R1,(R2)+		;Save video plane 2 and 3 control
	MOV	(R3)+,(R1)+		;Restore video plane 2 and 3 control
	TST	(R1)+			;Skip video color map
	TST	(R1)+			;Skip video scroll register
;;;	MOV	@R1,(R2)+		;Save video scroll register
;;;	MOV	(R3)+,(R1)+		;Restore video scroll register
	MOV	@R1,(R2)+		;Save video X coordinate
	MOV	(R3)+,(R1)+		;Restore video X coordinate
	MOV	@R1,(R2)+		;Save video Y coordinate
	MOV	(R3)+,(R1)+		;Restore video Y coordinate
	TST	(R1)+			;Skip video counter
	MOV	@R1,(R2)+		;Save video pattern
	MOV	(R3)+,(R1)+		;Restore video pattern
	RTS	R5

GD$REG:
GD$CSR:	 .WORD	0
GD$P1C:	 .WORD	0
GD$OPC:	 .WORD	0
;;;GD$SCL:	 .WORD	0
GD$X:	 .WORD	0
GD$Y:	 .WORD	0
GD$PAT:	 .WORD	0
TX$REG:
TX$CSR:	 .WORD	0
TX$P1C:	 .WORD	0
TX$OPC:	 .WORD	0
;;;TX$SCL:	 .WORD	0
TX$X:	 .WORD	0
TX$Y:	 .WORD	0
TX$PAT:	 .WORD	0

.ENDC	;NE MMG$T
					CK.R0 Q$FUNC,0
10$:	CMPB	#FN$CHR,@R0		;Char Cell read?
	BEQ	CHREAD			;Yes
					CK.R0 Q$FUNC,0
	CMPB	#FN$UPD,@R0		;Handler data access?
	BEQ	HANDAT			;Yes

	CLR	R5
	BISB	Q$FUNC(R4),R5
	BEQ	BADCMD

	MOV	#<MAXCYC>,@#BYESCR	;Reset screen black-out counter
	 $REL	.-2,BYESCR,PIRK
.IF EQ	MMG$T
	JSR	R1,11$
	 .BYTE	F.STRT
	 .BYTE	F.WAIT
	 .BYTE	F.STOP
	 .BYTE	F.WRIT
	 .BYTE	F.READ
	 .BYTE	F.LOCK
	 .BYTE	F.UNLK
	 .BYTE	0
	.EVEN

11$:	TST	(SP)+
12$:	TSTB	@R1
	BEQ	IOEXIT
	CMPB	R5,(R1)+
	BNE	12$
	.BR	BADCMD

.IFF	;EQ MMG$T
	CMP	R5,#F.STRT
	BEQ	START

	TST	RUNFLG
	BEQ	BADCMD

	CMP	R5,#F.WAIT
	BEQ	WAIT
	CMP	R5,#F.STOP
	BEQ	STOP

	TST	INCQE
	BNE	13$
.IFTF	;EQ MMG$T
BADCMD:	BIS	#HDERR$,@-(R4)		;Set the hard error bit.
.IFT	;EQ MMG$T
IOEXIT:	RETURN
.IFF	;EQ MMG$T
	BR	IOEXIT

13$:	CMP	R5,#F.WRIT
	BEQ	WRITE
	CMP	R5,#F.READ
	BNE	IOEXIT
	.BR	READ

READ:	MOV	#F.READ,-(SP)		
	BR	RDWRT

WRITE:	MOV	#F.WRIT,-(SP)		
	.BR	RDWRT

RDWRT:	MOV	R4,R5
	MOV	INCQE,R4
	CALL	$PUTWD			;Store the .SPFUN code
	MOV	Q$WCNT(R5),-(SP)
	CALL	$PUTWD			;Store the byte length
	MOV	Q$BUFF(R5),-(SP)
	CALL	$PUTWD			;Store the PAR1 biased buffer address
	MOV	Q$PAR(R5),-(SP)
	CALL	$PUTWD			;Store the buffer PAR1 value
	MOV	R5,R4
	.BR	SWITCH

WAIT:	.BR	SWITCH

SWITCH:	MOV	INCQE,R5
	MOV	R4,INCQE
	MOV	#PILQE,R4
$REL	.-2	PILQE	PIRK
	MOV	R5,(R4)+
	MOV	R5,@R4
	BNE	IOEXIT
	TST	(SP)+			;Get rid of return address for .DRFIN
	RETURN

INCQE:	 .WORD	0
START:	MOV	SP,(PC)+		;Indicate that server is running
RUNFLG:	 .WORD	0			;0 - not running; 1 - running
	MOVB	Q$JNUM(R4),-(SP)	;Save GIDIS's job number
	BICB	#207,@SP		; in case of abort
	MOVB	(SP)+,(PC)+
GIDJBN:	 .WORD	0

	MOV	@#VD$SLT,-(SP)
$REL	.-2	VD$SLT	PIRK
	CALL	$PUTWD			;Return the CSR
	BR	IOEXIT

STOP:	CLR	RUNFLG			;Indicate that server is not running
	MOVB	#-1,GIDJBN		;Don't allow aborts to match job #
;+
; We should probably run down the queue here and return hard error for any
; outstanding requests.
;-
	MOV	INCQE,R5		;Anything on internal queue?
	BEQ	IOEXIT			;Branch if not
	CLR	Q$FUNC(R5)		;Requeue internally queued request
	MOV	Q$LINK(R4),Q$LINK(R5)	; on monitor's handler queue
	MOV	R5,Q$LINK(R4)		;  as an illegal request
	CLR	INCQE			;Say that internal queue is empty
	.BR	IOEXIT			;Return F.STOP queue element

IOEXIT:	RETURN

$PUTWD:	MOV	@#$PTWRD,-(SP)
$REL	.-2	$PTWRD	PIRK
	CALLR	@(SP)+

;$PUTWD:	CALLR	@$PTWRD+PIKBAS-P1ADDR
;....PC	= .
;$REL	.-2	$PTWRD+PIKBAS-P1ADDR-....PC
.ENDC	;NE MMG$T
HANDAT:
					CK.R0 Q$FUNC,+2
	TST	(R0)+			;Point to address
					CK.R0 Q$BUFF,+2
	MOV	(R0)+,R4		;Load it
.IF	NE MMG$T
					CK.R0 Q$WCNT,0
	MOV	Q$PAR-Q$WCNT(R0),R3	; and the par offset
.IFTF	;NE MMG$T
	CMP	#MAXBLK,R5		;Is the block number legal?
	BLO	BADCMD			;No, ignore this SPFUN
.IFF	;NE MMG$T
	ASL	R5			;Make into index
	ASL	R5			;2 word index for FB
.IFT	;NE MMG$T
	MOV	R5,R2			;Copy value
	ASL	R5			;Multiply by 2
	ADD	R2,R5			;Now by 3
	ASL	R5			;Now by 6 for 3 word index for XM
.IFTF	;NE MMG$T
	ADD	#HANPTR,R5		;Point to pointer
$REL	.-2	HANPTR	PIK
					CK.R0 Q$WCNT,0
	TST	@R0			;What is the sign of the wordcount?
	BPL	14$			;Setup is correct, do it
					;Reverse direction of copy
	MOV	R4,R2			;Set up user buffer pointer
.IFT	;NE MMG$T
	MOV	R3,R1			;Set up user buffer PAR1 value
.IFTF	;NE MMG$T
	CALLR	MOVETO			;Transfer from user buffer to PI table

14$:	CALLR	MOVEFR			;Transfer from PI table to user buffer

.IFTF	;NE MMG$T

CHREAD:
					CK.R0=Q$FUNC
					CK.R0 Q$FUNC,+2
	TST	(R0)+			;Point to address
					CK.R0 Q$BUFF,+2
	MOV	(R0)+,R4		;Load it
.IFT	;NE MMG$T
					CK.R0 Q$WCNT,0
	MOV	Q$PAR-Q$WCNT(R0),R3	; and the par offset
.IFTF	;NE MMG$T
					CK.R0 Q$WCNT,0
	TST	@R0			;Is this a read operation?
	BLE	BADCMD			;Branch if not
	DEC	R5			;Is this a legal line number?
	BMI	BADCMD			;Branch if not
	CMP	R5,#<CHRLIN-1>		;Is this a legal line number?
	BGT	BADCMD			;Branch if not
	ASL	R5			;Generate a word index
	MOV	R5,-(SP)		;Save word index for char cell stuff
	MOV	#80.,CHRLEN		;Assume we are in 80 column mode
	MOVB	@#D$COLM,(PC)+		;Get 80/132 column mode flag
COLMFL:	 .WORD	0			;0 = 80 columns / 1 = 132 columns
$REL	.-4	D$COLM	PIRK
	BEQ	15$			;Branch if we are
	MOV	#132.,CHRLEN		;We're in 132 column mode
15$:	MOV	#COLADR,R5		;Point to column mode flag pointer
$REL	.-2	COLADR	PIK
	CALL	MOVEFR			;Move column mode flag to user buffer
	MOV	@SP,R2			;Need in R2 for XM BLKMOV routine
	MOV	#LINADR,R5		;Point to line attributes pointer
$REL	.-2	LINADR	PIK
	CALL	MOVIFR			;Move line attributes to user buffer
	MOV	(SP)+,R2		;Get line number word index
	MOV	#PTRADR,R5		;Point to char cell line pointer
$REL	.-2	PTRADR	PIK
	MOV	R4,-(SP)		;Save user buffer pointer
	MOV	#CHRADR,R4		;Point to char cell 22-bit pointer
$REL	.-2	CHRADR	PIK
.IFT	;NE MMG$T
	MOV	R3,-(SP)		;Save user buffer PAR1 value
	MOV	@#KISAR1,R3		;22-bit char cell pointer is in
					; PIK (current mapping)
.IFTF	;NE MMG$T
	CALL	MOVIFR			;Get pointer to character cell line
.IFT	;NE MMG$T
	MOV	(SP)+,R3		;Restore user buffer PAR1 value
.IFTF	;NE MMG$T
	MOV	(SP)+,R4		;Restore user buffer pointer
	MOV	#CHRADR,R5		;Get pointer to char cell line
$REL	.-2	CHRADR	PIK
	.BR	MOVEFR			;Do the memory-to-memory transfer

	.DSABL	LSB

MOVEFR:	CLR	R2			;Non-indexed move so clear index
MOVIFR:	ADD	(R5)+,R2		;Add address pointer to index in R2
.IFT	;NE MMG$T
	MOV	(R5)+,R1		;Get PAR1 value
.IFTF	;NE MMG$T
	MOV	@R5,R5			;Get word count of transfer
	BR	$BLKMV			;Do memory-to-memory transfer

MOVETO:	CLR	R4			;Non-indexed move so clear index
MOVITO:	ADD	(R5)+,R4		;Add address pointer to index in R4
.IFT	;NE MMG$T
	MOV	(R5)+,R3		;Get PAR1 value
.IFTF	;NE MMG$T
	MOV	@R5,R5			;Get word count of transfer
	.BR	$BLKMV			;Do memory-to-memory transfer

$BLKMV:
.IFT	;NE MMG$T
	MOV	@#P1EXT,R0		;Point to RMON fixed offset
$REL	.-2	P1EXT	RMONK
	CALLR	BLKMOV(R0)		;Do the block move

.IFF	;NE MMG$T
1$:	MOV	(R2)+,(R4)+		;Move a word
	SOB	R5,1$			;Until count is exhausted
	RETURN

LENXMP	= 4
.IFT	;NE MMG$T
LENXMP	= 6
.IFTF	;NE MMG$T
COLADR:	$XMPTR	COLMFL,1.,PIK,PIK	;Point to 80/132 column mode flag
LINADR:	$XMPTR	LINCEL,1,PIK,PIV	;Point to line attributes
PTRADR:	$XMPTR	CELSTR,1,PIK,PIV	;Point to char cell line pointers
CHRADR:	$XMPTR	CHRCEL,132.,PIK,PIV
CHRLEN	=: CHRADR+LENXMP-2		;Length is 80./132. if D$COLM is 0/1

HANPTR:
					.ASSUME PERM$S EQ .-HANPTR/LENXMP
$XMPTR	P.SETD	LENSET+1/2	PIK	PIK
					.ASSUME CURR$S EQ .-HANPTR/LENXMP
$XMPTR	C.SETD	LENSET+1/2	PIK	PIRK
					.ASSUME KBTB$S EQ .-HANPTR/LENXMP
$XMPTR	C.KBTB	Z.KBTB-C.KBTB+1/2	PIK	PIK
					.ASSUME FONT$S EQ .-HANPTR/LENXMP
$XMPTR	C.FONT	Z.FONT-C.FONT+1/2	PIK	PIV
					.ASSUME ANSR$S EQ .-HANPTR/LENXMP
$XMPTR	C.ANSR	LENANS+1/2	PIK	PIK
					.ASSUME REPL$S EQ .-HANPTR/LENXMP
$XMPTR	C.REPL	LENREP+1/2	PIK	PIK
					.ASSUME ANSR$P EQ .-HANPTR/LENXMP
$XMPTR	P.ANSR	LENANS+1/2	PIK	PIK
					.ASSUME REPL$P EQ .-HANPTR/LENXMP
$XMPTR	P.REPL	LENREP+1/2	PIK	PIK
					.ASSUME TABS$P EQ .-HANPTR/LENXMP
$XMPTR	P.TABS	LENTAB+1/2	PIK	PIK
					.ASSUME TABS$S EQ .-HANPTR/LENXMP
$XMPTR	C.TABS	LENTAB+1/2	PIK	PIV
					.ASSUME SetS$S EQ .-HANPTR/LENXMP
$XMPTR	C.SETS	LENSSt+1/2	PIK	PIRK
MAXBLK	=:	.-HANPTR-LENXMP/LENXMP
 
.ENDC;	NE MMG$T
	.END