Google
 

Trailing-Edge - PDP-10 Archives - BB-F494Z-DD_1986 - 10,7/lptdqs.mac
There are 7 other files named lptdqs.mac in the archive. Click here to see a list.
	TITLE	LPTDQS - Distributed Queue System driver for LPTSPL-10
	SUBTTL	Joseph A. Dziedzic	12-SEP-85

;
;
;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986.
;			ALL RIGHTS RESERVED.
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND 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.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.
;

	SEARCH	GLXMAC			;SEARCH GALAXY PARAMETERS
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS
	SEARCH	LPTMAC			;Search LPTSPL parameters
	PROLOG(LPTDQS)
	.TEXT	"/LOCALS /SEGMENT:LOW DQS/EXCLUDE:XFUNCT"

IF2,<PRINTX Assembling GALAXY-10 LPTDQS>


	.DIRECT	FLBLST
	SALL				;SUPPRESS MACRO EXPANSIONS

	ENTRY	LPTDQS			;LOAD IF LIBRARY SEARCH

;LPTDQS VERSION INFORMATION

	LDQEDT==2			;EDIT LEVEL (LPTDQS)
	SUBTTL	Table of Contents
	SUBTTL	Revision History

	COMMENT |

1	Create this module to implement DQS support.
	GCO 10228 3-Jun-85 /JAD

2	Update copyright statements. 12-SEP-85 /LEO

[End of Revision History]
|
	SUBTTL	Local Symbols

	TRYTIM==^D60			;SECONDS TO WAIT BETWEEN CONNECT TRIES
	SUBTTL	Tables -- Forms type entry format

	PHASE	0

FT.COD:!BLOCK	1			;SIXBIT CODE FOR FORMS ('NORMxx')
FT.NAM:!BLOCK	FRMSIZ			;ASCII FORMS NAME
FT.SIZ:!				;SIZE OF AN ENTRY

	DEPHASE
	SUBTTL	Tables -- Forms type file descriptor

FTYFD:	$BUILD	(FDMSIZ)		;SHORT FILESPEC BLOCK
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	;LENGTH
	  $SET	(.FDSTR,,'SYS   ')	;DEVICE
	  $SET	(.FDNAM,,'FORMST')	;NAME
	  $SET	(.FDEXT,,'DAT   ')	;EXTENSION
	$EOB

FTYFOB:	$BUILD	(FOB.SZ)		;FILE OPEN BLOCK
	  $SET	(FOB.FD,,FTYFD)		;ADDRESS OF FD
	  $SET	(FOB.CW,FB.BSZ,7)	;BYTE SIZE (ASCII)
	$EOB

	$DATA	FTYIFN,1		;IFN FOR FORMS TYPE FILE
	$DATA	FTYUDT,1		;CREATION DATE/TIME OF FORMS TYPE FILE
	$DATA	FTYLST,1		;LIST NAME FOR FORMS TYPE LIST
	$DATA	FTYTMP,FRMSIZ		;TEMPORARY STORAGE FOR FORMS NAME
	SUBTTL	Tables -- Function dispatch table

;This table contains the addresses of the DQS specific functions
;which will be called by LPTSPL at the required times.

LPTDQS::DEVDSP	(DQS,<Xerox 8700>)

OUTDIE==:LPTDIE##			;HACK FOR BLISS LIBRARY
J$LFCT==J$DWDS				;FAIRNESS COUNTER

DJMLST==1B35				;DJM LOST CONNECTION
SUBTTL	Miscellaneous Data Storage

WTOLEN==^D80				;LENGTH OF WTO BUFFER
WTOBUF:	BLOCK	WTOLEN			;THE BUFFER
WTOPTR:	BLOCK	1			;POINTER INTO BUFFER
WTOCNT:	BLOCK	1			;COUNT OF CHARACTERS IN BUFFER
SUBTTL	DQSINX - DQS/STREAM INITIALIZATION


DQSINX:	JUMPN	M,INIT.1		;CHECK FOR LPTSPL INITIALIZATION
	PUSHJ	P,WTOINI		;INTIALIZE LOCAL WTO BUFFER
	PUSHJ	P,G$INIT##		;FIREUP DQS LIBRARY
	$RETT				;AND RETURN

INIT.1:	LOAD	T1,SUP.FL(M),SUFSRV	;GET THE SERVER FLAG
	JUMPE	T1,INIT.2		;NOT A DQS PRINTER
	SKIPE	SUP.ST(M)		;ALTERNATE DEVICE?
	JRST	INIT.2			;YES--CAN'T HANDLE THAT
	MOVE	S1,STREAM##		;GET STREAM NUMBER
	MOVE	S1,JOBOBA##(S1)		;AND THE OBJECT BLOCK
	MOVE	S1,OBJ.ND(S1)		;GET STATION NUMBER
	MOVX	S2,DN.FLK		;KNOWN NODE
	PUSHJ	P,LPTDCN##		;MUST BE DECNET
	JUMPF	INIT.2			;ELSE RETURN
	MOVEI	T1,4			;SETUP UUO AC
	MOVE	T2,[DN.FLE!<.DNLNN,,3>]	;FLAGS, FUNCTION, AND LENGTH
	MOVEI	T3,1			;RETURN ONE NODE
	SETZ	T4,			;IT WILL GO HERE
	DNET.	T1,			;READ EXECUTOR NODE
	  JRST	INIT.4			;CAN'T
	CAMN	S1,T4			;SPOOLING TO SELF?
	JRST	INIT.3			;CAN'T DO THAT
	SETZM	J$LION(J)		;NO I/O INDEX FOR THIS BEAST
	MOVE	T1,['X8700 ']		;UNIT TYPE IDENTIFIER
	MOVEM	T1,J$LTYP(J)		;SAVE FOR QUASAR
	SETOM	J$LLCL(J)		;SAY WE SUPPORT LOWER CASE
	MOVSI	T1,LPTDQS		;BUILD A BLT POINTER
	HRRI	T1,J$$DEV(J)		; TO THE INITIALIZATION VECTOR
	BLT	T1,J$$DND(J)		;COPY OUR VECTOR
	SETZM	J$POSF(J)		;XEROX 8700 DOESN'T POSITION
	SETZM	J$FFDF(J)		;XEROX 8700 DOESN'T LIKE FORM FEEDS
	SETZM	J$MNTF(J)		;XEROX 8700 DOESN'T SUPPORT MOUNTABLE FORMS
	$RETT				;RETURN

INIT.2:	MOVNI	S1,1			;-1 MEANS DEVICE NOT FOR US
	$RETF				;RETURN

INIT.3:	SKIPA	S1,[%RSUNA]		;UNIT NOT AVAILABLE
INIT.4:	MOVEI	S1,%RSUDE		;UNIT WILL NEVER BE AVAILABLE
	$RETF				;RETURN
SUBTTL	DQSIPC - SPECIAL IPCF MESSAGE PROCESSING


DQSIPC:	MOVNI	S1,1			;WE HAVE NO SPECIAL MESSAGES
	$RETF				;RETURN
SUBTTL	DQSSCD - SCHEDULER CALL


DQSSCD:	$RETT				;DO NOTHING
SUBTTL	DQSWAK - WAKEUP TIME CHECK


DQSWAK:	$RETT				;RETURN
SUBTTL	DQSOPX - OPEN DEVICE

;Routine called to OPEN the DQS printer.

DQSOPX:	MOVE	S1,STREAM##		;GET STREAM NUMBER
	MOVE	S1,JOBOBA##(S1)		;AND THE OBJECT BLOCK
	MOVE	S1,OBJ.ND(S1)		;COPY TARGET NODE
	MOVX	S2,DN.FLR		;REACHABLE
	PUSHJ	P,LPTDCN##		;CHECK STATUS
	JUMPF	OPEN.2			;GIVE UP IF NOT AVAILABLE
	MOVE	S1,STREAM##		;GET OUR STREAM NUMBER
	MOVE	S1,JOBOBA##(S1)		;GET OUR OBJECT BLOCK ADDRESS
	BCALL.	(G$CHECKDQS##,<OBJ.ND(S1),OBJ.UN(S1)>) ;SEE IF DJM
	TRNE	S1,1			;IS THERE A DJM SERVER THERE?
	JRST	OPEN.1			;YES, OK TO PROCEED
	MOVE	S1,STREAM##		;GET OUR STREAM NUMBER AGAIN
	$WTO	(<Distributed Job Manager not running>,,@JOBOBA##(S1))
	JRST	OPEN.2			;GIVE UP

OPEN.1:	PUSHJ	P,TRYCON		;TRY TO CONNECT
	JUMPF	OPEN.2			;GIVE UP
	MOVSI	S1,(POINT 8,0)		;GET 8 BIT BYTE POINTER
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	PUSHJ	P,LPTRES##		;SETUP/RESET THE OUTPUT BUFFER POINTERS
	MOVX	S1,%RSUOK		;LOAD SUCCESS CODE
	$RETT				;ALL DONE

OPEN.2:	MOVX	S1,%RSUNA		;GET ERROR CODE (TRY AGAIN LATER)
	$RETT				;ALL DONE
SUBTTL	DQSCLS - CLOSE


DQSCLS:	$RETT				;DO NOTHING
SUBTTL	DQSFVU - LOAD VFU


DQSVFU:	$RETT				;DO NOTHING
SUBTTL	DQSRAM - LOAD RAM


DQSRAM:	$RETT				;DO NOTHING
SUBTTL	DQSLER - FILE LOOKUP ERROR PROCESSING


DQSLER:	$TEXT(<-1,,J$WTOR(J)>,<Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/^0>)
	MOVEI	S1,J$WTOR(J)		;ADDRESS OF ERROR STRING
	HRLI	S1,(POINT 7)		;ASCII BYTE POINTER
	BCALL.	(G$ZDATA##,<S1>)	;SEND THE DATA
	PUSHJ	P,CHKDJM		;CHECK FOR LOST CONNECTION
	PUSHJ	P,DQSOUT		;FLUSH LAST BUFFER(S)
	PUSHJ	P,G$EOF##		;SEND END OF FILE
	PUSHJ	P,CHKDJM		;CHECK FOR LOST CONNECTION
	$RETF				;RETURN
SUBTTL	DQSIER - FILE INPUT ERROR PROCESSING


DQSIER:	$TEXT	(<-1,,J$WTOR(J)>,<Error reading input file;^E/[-1]/^0>)
	MOVEI	S1,J$WTOR(J)		;ADDRESS OF STRING
	HRLI	S1,(POINT 7)		;ASCII BYTE POINTER
	BCALL.	(G$ZDATA##,<S1>)	;SEND THE TEXT
	PUSHJ	P,CHKDJM		;CHECK FOR LOST CONNECTION
	$RETF				;RETURN
SUBTTL	DQSFLS - FLUSH JOB


DQSFLS:	PUSHJ	P,LPTDIE##		;RELEASE STUFF
	PUSHJ	P,G$DISCONNECT##	;DISCONNECT
	MOVE	S1,STREAM##		;GET OUR STREAM NUMBER
	$WTO	(<Lost DJM connection>,,@JOBOBA##(S1))
	PUSHJ	P,TRYCON		;TRY THE CONNECT AGAIN
	$RET				;PASS ALONG TRUE/FALSE RETURN
SUBTTL	DQSOUT - OUTPUT A BUFFER


DQSOUT:	SKIPGE	S1,J$LBCT(J)		;GET BYTES REMAINING IN BUFFER
	SETZM	S1			;IF LESS,,MAKE IT ZERO
	SUB	S1,J$LIBC(J)		;CALC -BYTE COUNT IN BUFFER
	JUMPGE	S1,LPTRES##		;NOTHING TO PUT OUT,,RESET BUFR PTRS
	MOVMS	S1			;MAKE COUNT POSITIVE
	BCALL.	(G$DATA##,<J$LIBP(J),S1>) ;SHIP THE DATA
	TRNE	S1,1			;SUCCESSFUL RETURN?
	JRST	OUTP.1			;YES, RESET BUFR PTRS AND RETURN
	PUSHJ	P,REQJOB		;REQUEUE DUE TO LOST CONNECTION
	PUSHJ	P,INPFEF##		;FORCE END OF FILE
	$RETT				;QUIT

OUTP.1:	PUSHJ	P,LPTRES##		;RESET BUFFER POINTERS
	AOS	S1,J$LFCT(J)		;SEE IF TIME TO LET OTHER STREAMS RUN
	CAIG	S1,2			;MAGIC NUMBER
	$RETT				;NO, RETURN NOW
	SETZM	J$LFCT(J)		;YES, CLEAR FOR NEXT TIME AROUND
	SETZM	SLEEPT##		;NO SLEEP TIME WANTED
	$DSCHD	(0)			;LET OTHER STREAMS RUN
	$RETT				;RETURN
SUBTTL	DQSOER - OUTPUT ERROR PROCESSING


DQSOER:	$RETT				;NEVER CALLED
SUBTTL	DQSEOX - OUTPUT EOF PROCESSING


DQSEOX:	$RETT				;DO NOTHING
SUBTTL	DQSBJB - PER-REQUEST INITIALIZATION

;Routine to perform necessary initialization at the beginning of
;a request.

DQSBJB:	PUSHJ	P,.SAVE2##		;SAVE P1 AND P2
	MOVSI	S1,.EQCHK(J)		;START OF CHECKPOINT AREA
	HRRI	S1,.EQCHK+1(J)		;MAKE A BLT POINTER
	SETZM	.EQCHK(J)		;CLEAR FIRST WORD
	BLT	S1,.EQCHK+EQCKSZ-1(J)	;ZAP CHECKPOINT INFO
	PUSHJ	P,CNVFTY		;CONVERT LONG FORMS NAME
	MOVE	P1,S1			;COPY SOMEWHERE SAFE
	GETLIM	S1,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	GETLIM	S2,.EQLIM(J),NOT2	;GET SECOND HALF OF NOTE
	$TEXT	(<-1,,J$PNOT(J)>,<^W6/S1/^W/S2/^0>) ;ASCII-IZE IT
	$TEXT	(<-1,,J$PUSR(J)>,<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/^0>)
	MOVEI	P2,3			;TIMES TO LOOP BEFORE GIVING UP

REQI.1:	TXZE	S,DJMLST		;DID WE LOSE CONNECTION TO THE DJM?
	PUSHJ	P,DQSFLS		;YES, RECONNECT
	TXNE	S,ABORT			;ABORTED?
	$RETT				;YES, QUIT NOW
	MOVEI	T1,J$PUSR(J)		;ADDRESS OF USER NAME STRING
	HRLI	T1,(POINT 7)		;MAKE IT AN ASCII BYTE POINTER
	LOAD	T2,.EQSEQ(J),EQ.PRI	;PRIORITY
	CAILE	T2,4			;IN RANGE?
	MOVEI	T2,4			;NO, MAKE IT SO
	SKIPN	.EQCHR(J)		;CHARACTERISTICS SPECIFIED?
	SKIPA	T3,[[ASCIZ /LANDSCAPE/]] ;NO, LOAD ADDRESS OF DEFAULT STRING
	MOVEI	T3,.EQCHR(J)		;LOAD ADDRESS OF CHARACTERISTICS STRING
	HRLI	T3,(POINT 7)		;MAKE IT AN ASCII BYTE POINTER
	MOVEI	T4,J$PNOT(J)		;POINTER TO NOTE STRING
	HRLI	T4,(POINT 7)		;ASCII BYTE POINTER
	BCALL.	(G$CREATE##,<T1,.EQRID(J),.EQJOB(J),[1],T2,T3,P1,[0],<.EQSEQ(J),EQ.NOT>,.EQAFT(J),T4>)
	TRNN	S1,1			;SUCCESSFUL RETURN FROM G$CREATE?
	TXOA	S,DJMLST		;NO, THEN LOST DJM CONNECTION
	$RETT				;YES, RETURN
	SETZM	SLEEPT##		;NO SLEEP TIME WANTED
	$DSCHD	(0)			;LET OTHER STREAMS RUN
	SOJGE	P2,REQI.1		;TRY AGAIN
	PUSHJ	P,REQJOB		;ELSE REQUEUE JOB
	$RETT				;AND RETURN
SUBTTL	DQSEJB - END OF JOB


DQSEJB:	TXNE	S,ABORT			;ABORTING?
	$RETT				;DON'T COMMIT
	PUSHJ	P,G$END##		;DO A DQS END OF JOB/COMMIT
	PUSHJ	P,CHKDJM		;CHECK FOR LOST CONNECTION
	$RETT				;DO NOTHING
SUBTTL	DQSBFL - Begining of file processing

;Routine to perform per-file initialization.

DQSBFL:	MOVE	S1,.FPINF(E)		;GET FLAGS FOR FILE
	TXNE	S1,FP.REN		;IS IT /DISPOSE:RENAME?
	JRST	FILI.3			;YES, PROCESS THAT
	TXNN	S1,FP.SPL		;IS IT A SPOOLED FILE?
	JRST	FILI.2			;NO, CONTINUE ON
	TXNN	S1,FP.FLG		;IS IT ALSO A LOG FILE?
	JRST	FILI.1			;NO, JUST A PLAIN SPOOLED FILE
	$TEXT	(<-1,,J$PFL1(J)>,<Batch Log File^0>) ;USE A DEFAULT
	JRST	FILI.5			;CONTINUE

FILI.1:	MOVE	S1,J$DIFN(J)		;GET THE FILE'S IFN
	MOVX	S2,FI.SPL		;GET THE SPOOL NAME INFO CODE
	$CALL	F%INFO			;GET THE SPOOLED NAME
	JUMPE	S1,FILI.4		;NOTHING
	$TEXT	(<-1,,J$PFL1(J)>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
	JRST	FILI.5			;CONTINUE

FILI.2:	MOVE	S1,J$DFDA(J)		;GET THE FD ADDRESS
	$TEXT	(<-1,,J$PFL1(J)>,<^W/.FDNAM(S1)/.^W3/.FDEXT(S1)/^0>)
	JRST	FILI.5			;CONTINUE

FILI.3:	$TEXT	(<-1,,J$PFL1(J)>,<^W/.FPONM(E)/.^W3/.FPOXT(E)/^0>)
	JRST	FILI.5			;CONTINUE
FILI.4:	$TEXT	(<-1,,J$PFL1(J)>,<Spooled Printer File^0>)
FILI.5:	MOVEI	T1,J$PFL1(J)		;ADDRESS OF FILE NAME STRING
	HRLI	T1,(POINT 7)		;ASCII BYTE POINTER
	LOAD	T2,.FPINF(E),FP.NFH	;GET NO HEADERS BIT
	TRC	T2,1			;COMPLEMENT IT
	BCALL.	(G$FILESPEC##,<T1,<.FPINF(E),FP.FCY>,[0],T2,[1],[1],<.FPINF(E),FP.FSP>,[0],[0],[0]>)
	PJRST	CHKDJM			;CHECK FOR LOST CONNTECTION AND RETURN
SUBTTL	DQSEFL - END OF FILE


DQSEFL:	TXNE	S,RQB+ABORT+DJMLST	;REQUEUE OR ABORTING?
	$RETF				;YES, QUIT
	PUSHJ	P,@J$OUTP(J)		;FLUSH LAST BUFFER(S)
	PUSHJ	P,G$EOF##		;SEND END OF FILE
	PUSHJ	P,CHKDJM		;CHECK FOR LOST CONNECTION
	$RETF				;NEVER ALLOW MORE THAN 1 COPY TO PRINT
SUBTTL	DQSBAN - BANNER


DQSBAN:	$RETF				;NO BANNERS
SUBTTL	DQSWID - PAGE WIDTH CALCULATION


DQSWID:	$RETT				;USE STANDARD WIDTH COMPUTATION
SUBTTL	DQSHDR - HEADER


DQSHDR:	$RETF				;NO HEADERS
SUBTTL	DQSRUL - RULER


DQSRUL:	$RETT				;DO NOTHING
SUBTTL	DQSSHT - SHUTDOWN STREAM

;Routine called when a stream is shutdown.

DQSSHT:	PUSHJ	P,G$DISCONNECT##	;DISCONNECT FROM DJM
	$RETT				;THAT'S ALL
SUBTTL	DQSCHR - SPECIAL CHARACTER TRANSLATION


DQSCHR:	$RETT				;DO NOTHING
SUBTTL	DQSSTS - DEVICE STATUS MESSAGE


;Routine called to generate the status text for CHKPNT.

DQSSTS:	MOVE	S1,J$RFLN(J)		;GET RELATIVE FILE NUMBER
	LOAD	S2,.EQSPC(J),EQ.NUM	;GET TOTAL NUMBER OF FILES
	SUBM	S2,S1			;GET NUMBER PROCESSED
	ADDI	S1,1			;CORRECT IT
	$TEXT	(DEPBP##,<, transferring file ^D/S1/ of ^D/S2/^0>)
	$RETT				;RETURN
	SUBTTL	Connect to DJM

;Routine to attempt to connect to the Distributed Job Manager.

TRYCON:	PUSHJ	P,G$CONNECT##		;DO THE CONNECT
	TRNE	S1,1			;DID IT FAIL?
	$RETT				;NO, RETURN
	$DSCHD	(TRYTIM)		;GO AWAY FOR A WHILE
	TXNE	S,ABORT			;WERE WE ABORTED?
	$RETF				;YES, QUIT
	JRST	TRYCON			;NO, TRY AGAIN
	SUBTTL	Requeue job


; HERE TO CHECK FOR A LOST DJM NETWORK CONNECTION AND REQUEUE JOB
; (FROM BEGINING OF JOB) IF NECESSARY

CHKDJM:	TXNN	S,GOODBY		;JOB COMPLETED OR ON ITS WAY OUT?
	TRNE	S1,1			;OR DJM FUNCTION SUCCEED?
	$RETT				;YES TO EITHER

REQJOB:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	MOVE	S1,STREAM##		;GET THE STREAM NUMBER
	TXNN	S,RQB			;BEEN HERE ONCE BEFORE?
	$WTO	(<Job requeued>,<Reason: network failure>,@JOBOBA(S1))
	TXO	S,RQB+ABORT+DJMLST	;LITE THE REQUEUE+ABORT BITS
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW##(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC##(S1))		;YES,,KILL THE WTOR
	ANDCAM	S2,JOBSTW##(S1)		;ZAP THE OPR WAIT BIT
	SETZM	J$RNPP(J)		;CLEAR CURRENT PAGE NUMBER
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	$RETF				;INDICATE LOST CONNECTION
	SUBTTL	Convert Long Forms Name

;Routine to convert the long forms name to the encoded value.
;Returns the encoded name in S1.

CNVFTY:	PUSHJ	P,CHKFTY		;MAKE SURE WE HAVE A CURRENT FILE
	JUMPF	CNVF.1			;IF FAILURE, JUST USE DEFAULTS
	PUSHJ	P,FNDFTY		;FIND FORMS TYPE, RETURN CODE IN S1
	$RETIT				;RETURN IF WE LIKE IT
	MOVE	S2,STREAM##		;GET OUR STREAM NUMBER
	$WTO	(<^T/0(S1)/>,<Default forms type being used>,@JOBOBA##(S2))

CNVF.1:	MOVX	S1,'NORM00'		;GET THE DEFAULT
	$RETT				;RETURN
	SUBTTL	Find forms type

;Routine to find a forms type matching that of the current request.
;Returns:
;	TRUE with:
;	S1/ Encoded forms name
;	FALSE if no match or ambiguous with:
;	S1/ Address of ASCIZ error text


FNDFTY:	PUSHJ	P,.SAVE2##		;SAVE P1-P2
	SETZ	P1,			;CLEAR COUNT OF MATCHES
	MOVE	S1,FTYLST		;GET THE LIST HANDLE
	$CALL	L%FIRST			;POSITION TO FIRST ENTRY
	JUMPF	FNDF.3			;RETURN IF NULL LIST
FNDF.1:	MOVE	P2,S2			;POINT AT THE ENTRY
	MOVEI	S1,FT.NAM(P2)		;ADDRESS OF STRING
	MOVEI	S2,.EQFRM(J)		;ADDRESS OF FORMS TYPE IN EQ
	PUSHJ	P,STGCMP		;COMPARE THE STRINGS
	JUMPF	FNDF.2			;JUMP IF NO MATCH
	JUMPN	P1,FNDF.4		;AMBIGUOUS IF NOT FIRST MATCH
	MOVE	P1,P2			;COPY POINTER TO MATCHING NAME

FNDF.2:	MOVE	S1,FTYLST		;GET THE LIST HANDLE
	$CALL	L%NEXT			;POSITION TO NEXT ENTRY
	JUMPT	FNDF.1			;LOOP IF MORE TO CHECK
	JUMPE	P1,FNDF.5		;ERROR IF NO MATCH WAS FOUND
	MOVE	S1,FT.COD(P1)		;GET ENCODED NAME
	$RETT				;SUCCESS

FNDF.3:	MOVEI	S1,[ASCIZ /Null forms type list/] ;GET TEXT
	JRST	FNDF.6			;RETURN
FNDF.4:	MOVEI	S1,[ASCIZ /Ambiguous forms type abbreviation/] ;GET TEXT
	JRST	FNDF.6			;RETURN
FNDF.5:	MOVEI	S1,[ASCIZ /Unknown forms type/] ;GET TEXT
FNDF.6:	$RETF				;RETURN FAILURE
	SUBTTL	Compare two strings

;Routine to compare two ASCIZ strings.  Returns TRUE if match (partial
;match OK), FALSE if no match.

STGCMP:	HRLI	S1,(POINT 7)		;MAKE BYTE POINTERS
	HRLI	S2,(POINT 7)		;...
SCMP.1:	ILDB	T1,S1			;GET A CHARACTER
	JUMPE	T1,.RETT		;RETURN IF FIRST STRING EXHAUSTED
	CAIL	T1,"a"			;CONVERT LOWER CASE TO UPPER
	CAILE	T1,"z"			;...
	SKIPA				;...
	SUBI	T1,"a"-"A"		;...
	ILDB	T2,S2			;GET A CHARACTER
	JUMPE	T2,.RETT		;RETURN IF SECOND STRING EXHAUSTED
	CAIL	T2,"a"			;CONVERT LOWER CASE TO UUPER
	CAILE	T2,"z"			;...
	SKIPA				;...
	SUBI	T2,"a"-"A"		;...
	CAMN	T1,T2			;MATCH SO FAR?
	JRST	SCMP.1			;YES, KEEP LOOKING
	$RETF				;NO, RETURN FALSE
	SUBTTL	Check forms type list

;Routine to check that the forms type list is current.  If the forms
;type file is newer than our last glance we will build a new list.
;Return:
;	TRUE if successful (list exists)
;	FALSE if error (no list exists)

CHKFTY:	MOVEI	S1,FOB.SZ		;SIZE OF FILE OPEN BLOCK
	MOVEI	S2,FTYFOB		;ADDRESS OF IT
	$CALL	F%IOPN			;OPEN FOR INPUT
	JUMPF	CHKF.9			;ERROR
	MOVEM	S1,FTYIFN		;SAVE IFN FOR LATER
	MOVX	S2,FI.CRE		;NEED CREATION DATE/TIME
	$CALL	F%INFO			;ASK FOR FILE INFO
	CAMN	S1,FTYUDT		;FILE CHANGED?
	PJRST	RELFTY			;NO, RELEASE FILE AND RETURN
	MOVEM	S1,FTYUDT		;UPDATE THE CREATION DATE/TIME

	SKIPE	S1,FTYLST		;GET LIST HANDLE OF EXISTING LIST
	$CALL	L%DLST			;DELETE THE LIST
	$CALL	L%CLST			;CREATE A NEW LIST
	MOVEM	S1,FTYLST		;SAVE IT'S HANDLE

CHKF.1:	PUSHJ	P,REDFTY		;READ A FORMS TYPE FROM THE FILE
	JUMPF	RELFTY			;GO IF END OF FILE
	IDIVI	S1,^D16			;GET TWO HEX DIGITS
	ADDI	S1,'0'			;SIXBIT-IZE IT
	CAILE	S1,'9'			;PAST NUMERICS?
	ADDI	S1,'A'-'9'-1		;YES, GO TO ALPHABETICS
	ADDI	S2,'0'			;SIXBIT-IZE IT
	CAILE	S2,'9'			;PAST NUMERICS?
	ADDI	S2,'A'-'9'-1		;YES, GO TO ALPHABETICS
	MOVX	T1,'NORM  '		;STANDARD NAME
	DPB	S1,[POINT 6,T1,29]	;STORE LAST TWO CHARACTERS
	DPB	S2,[POINT 6,T1,35]	;...
	MOVE	S1,FTYLST		;GET LIST HANDLE
	MOVEI	S2,FT.SIZ		;LENGTH OF AN ENTRY
	$CALL	L%CENT			;CREATE THE ENTRY
	SKIPT				;DID IT SUCCEED?
	$STOP	(CCE,Can't create list entry)
	MOVEM	T1,FT.COD(S2)		;SAVE ENCODED NAME
	MOVSI	T1,FTYTMP		;FROM HERE
	HRRI	T1,FT.NAM(S2)		;TO HERE
	BLT	T1,FT.NAM+FRMSIZ-1(S2)	;COPY FORMS NAME
	JRST	CHKF.1			;LOOP FOR MORE

CHKF.9:	MOVE	S1,STREAM##		;GET OUR STREAM NUMBER
	$WTO	(<Cannot access forms type file ^F/FTYFD/>,<Default forms type being used>,@JOBOBA##(S1))
	$RETF				;RETURN
	SUBTTL	Release forms file

;Routine to release the forms file if it is opne.

RELFTY:	SKIPE	S1,FTYIFN		;GET IFN, SKIP IF NOT OPEN
	$CALL	F%REL			;RELEASE THE FILE
	SETZM	FTYIFN			;FORGET ABOUT IT
	$RETT				;RETURN
	SUBTTL	Read a line from forms type file


;Routine to read one line from the forms type file.  Returns the
;forms name in FTYTMP, the forms number in S1 if TRUE, FALSE if
;end of file.

REDFTY:	MOVEI	S1,FRMSIZ		;SIZE OF AREA
	MOVEI	S2,FTYTMP		;ADDRESS
	$CALL	.ZCHNK			;ZERO IT
REDF.0:	MOVE	S1,FTYIFN		;GET THE IFN
	$CALL	F%IBYT			;GET FIRST CHARACTER
	$RETIF				;IF ERROR
	CAXE	S2,"%"			;THE SPECIAL CHARACTER?
	JRST	[PUSHJ	P,REDF.X	;SKIP THIS LINE
		 JRST	REDF.0]		;TRY AGAIN
	$CALL	F%IBYT			;GET NEXT BYTE
	$RETIF				;IF ERROR
	CAXN	S2," "			;SPACE?
	JRST	.-3			;KEEP LOOKING FOR START OF FORMS NAME
	MOVX	T2,<FRMSIZ*5>-1		;MAXIMUM NUMBER OF BYTES
	SKIPA	T1,[POINT 7,FTYTMP]	;POINTER TO STORE IT

REDF.1:	$CALL	F%IBYT			;GET NEXT INPUT BYTE
	$RETIF				;IF ERROR
	CAIL	S2,"a"			;CONVERT LOWER CASE TO UPPER
	CAILE	S2,"z"			;...
	SKIPA				;...
	SUBI	S2,"a"-"A"		;...
	CAIL	S2,"A"			;ALPHABETIC?
	CAILE	S2,"Z"			;...
	SKIPA				;NO, KEEP CHECKING
	JRST	REDF.2			;OK, PROCEED
	CAIL	S2,"0"			;NUMERIC?
	CAILE	S2,"9"			;...
	CAIN	S2,"_"			;OR AN UNDERSCORE?
	SKIPA				;YES
	JRST	REDF.3			;NO, NOW LOOK FOR FORMS NUMBER
REDF.2:	SOSL	T2			;QUIT WHEN WE RUN OUT OF ROOM
	IDPB	S2,T1			;STORE THE BYTE IN STRING
	JRST	REDF.1			;KEEP LOOKING
REDF.3:	$CALL	F%IBYT			;GET A BYTE
	$RETIF				;IF ERROR
	CAIL	S2,"0"			;FOUND A DIGIT?
	CAILE	S2,"9"			;...
	JRST	REDF.3			;NO, KEEP LOOKING
	TDZA	T1,T1			;START WITH ZERO
REDF.4:	$CALL	F%IBYT			;GET ANOTHER BYTE
	$RETIF				;IF ERROR
	CAIL	S2,"0"			;FOUND A DIGIT?
	CAILE	S2,"9"			;...
	JRST	REDF.5			;NO, DONE WITH FORMS NUMBER
	IMULI	T1,^D10			;YES, OLD VALUE TIMES TEN
	ADDI	T1,-"0"(S2)		;ADD IN DIGIT JUST READ
	JRST	REDF.4			;LOOP

REDF.5:	PUSHJ	P,REDF.X		;READ UNTIL END OF LINE
	MOVE	S1,T1			;RETURN FORMS NUMBER IN S1
	$RETT				;ALL DONE

REDF.X:	$CALL	F%IBYT			;GET A BYTE
	$RETIF				;IF ERROR
	CAXE	S2,.CHLFD		;END OF LINE FEED?
	JRST	REDF.X			;NO, KEEP LOOKING
	$RETT				;YES
SUBTTL	Error Message Output from DQSLIB


;Routine called to output an error message (character by character)
;from the BLISS library DQSLIB.  Character is down one word on the
;stack on entry.

TT$CHR::AOS	S1,WTOCNT		;COUNT ANOTHER CHARACTER
	CAIL	S1,<WTOLEN*5>		;ROOM FOR MORE?
	PUSHJ	P,WTOFLS		;NO, FLUSH THE BUFFER
	MOVE	S1,-1(P)		;FETCH THE CHARACTER
	IDPB	S1,WTOPTR		;STORE IN LOCAL BUFFER
	CAIE	S1,.CHLFD		;END OF LINE?
	$RETT				;RETURN SUCCESS
WTOFLS:	SETZ	S1,			;GRAB A ZERO
	IDPB	S1,WTOPTR		;STUFF IT
	MOVE	S1,STREAM##		;GET OUR STREAM NUMBER
	$WTO	(<Error from DQSLIB>,<^T/WTOBUF/>,@JOBOBA##(S1))
					;FALL INTO WTOINI AND RETURN

;(Re-)initialize the local WTO buffer.

WTOINI:	SETZM	WTOCNT			;ZERO THE COUNT
	MOVE	S1,[POINT 7, WTOBUF]	;VIRGIN POINTER INTO BUFFER
	MOVEM	S1,WTOPTR		;SAVE IT
	$RETT				;RETURN
SUBTTL	Literal pool

DQSLIT:	LIT

DQSEND::!END