Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - galaxy-sources/lptdqs.mac
There are 7 other files named lptdqs.mac in the archive. Click here to see a list.
	TITLE	LPTDQS - LPTSPL Support for Distributed Queueing System  
	SUBTTL	Gregory A. Scott
	
	SUBTTL	Preliminaries		
	.DIRECTIVE FLBLST

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	GLXMAC			;Search GLXLIB's symbols
	SEARCH	LPTMAC			;Search LPTSPL's symbols
	SEARCH	QSRMAC			;Search QUASAR's symbols
	SEARCH	ORNMAC			;Search ORION's symbols
IFN FTACNT,<
	SEARCH	ACTSYM			;Search for accounting symbols
>

	SALL				;Suppress macro expansion
	RELOC				;Relocatable code follows

	PROLOGUE(LPTDQS)		;Generate the necessary symbols

;All of these edit numbers don't make sense.

	DQSMAN==:0			;Maintenance edit number
	DQSDEV==:15			;Development edit number
	VERSIN (DQS)			;Generate edit number
	Subttl	Table of Contents

;		     Table of Contents for LPTDQS
;
;				  Section		      Page
;
;
;    1. Revision History . . . . . . . . . . . . . . . . . . .   4
;    2. Definitions
;        2.1    External and Internal Symbols  . . . . . . . .   5
;        2.2    DQS Protocol . . . . . . . . . . . . . . . . .   6
;            2.2.1    Message Types  . . . . . . . . . . . . .   7
;            2.2.2    Block Types  . . . . . . . . . . . . . .   8
;            2.2.3    Bytes in Message Header and Block  . . .  11
;            2.2.4    Message Byte Pointers  . . . . . . . . .  12
;        2.3    Assembly Parameters  . . . . . . . . . . . . .  13
;        2.4    Storage  . . . . . . . . . . . . . . . . . . .  14
;    3. Setup Message  . . . . . . . . . . . . . . . . . . . .  15
;        3.1    Build device name  . . . . . . . . . . . . . .  16
;        3.2    Open DECnet Link . . . . . . . . . . . . . . .  17
;    4. Shutdown Message . . . . . . . . . . . . . . . . . . .  18
;    5. Next Job Message . . . . . . . . . . . . . . . . . . .  19
;    6. Job Processing . . . . . . . . . . . . . . . . . . . .  20
;        6.1    Remote CREATE request  . . . . . . . . . . . .  21
;        6.2    Send Create Request  . . . . . . . . . . . . .  22
;        6.3    Send Files . . . . . . . . . . . . . . . . . .  25
;            6.3.1    Send Filespec Message  . . . . . . . . .  27
;            6.3.2    Check /FILE and /MODE Switches . . . . .  31
;            6.3.3    Send Error Messages  . . . . . . . . . .  32
;            6.3.4    Send Data Messages . . . . . . . . . . .  33
;                6.3.4.1    Ascii Mode . . . . . . . . . . . .  35
;                6.3.4.2    Eleven Format  . . . . . . . . . .  36
;                6.3.4.3    Fortran Format . . . . . . . . . .  37
;                6.3.4.4    Octal Mode . . . . . . . . . . . .  39
;                6.3.4.5    Suppress/Arrow Modes . . . . . . .  41
;            6.3.5    Send End Of File Message . . . . . . . .  43
;        6.4    Send EOR . . . . . . . . . . . . . . . . . . .  44
;        6.5    Receive Summary message  . . . . . . . . . . .  45
;        6.6    Send Commit Message  . . . . . . . . . . . . .  46
;        6.7    Receive End Message  . . . . . . . . . . . . .  47
;        6.8    Error Recovery
;            6.8.1    Restart Job  . . . . . . . . . . . . . .  48
;            6.8.2    Check DJB Objections . . . . . . . . . .  49
;            6.8.3    Unpack DQS Error . . . . . . . . . . . .  50
;    7. Message Packing Routines
;        7.1    Setup/Finish Message . . . . . . . . . . . . .  53
;        7.2    Put a Byte or Word . . . . . . . . . . . . . .  54
;        7.3    Put a Word or Longword . . . . . . . . . . . .  55
;        7.4    Put a String . . . . . . . . . . . . . . . . .  56
;        7.5    Put a Counted String . . . . . . . . . . . . .  57
;    8. Message Unpacking Routines
;        8.1    Get a Word or Longword . . . . . . . . . . . .  58
;        8.2    Get Variable Length Item . . . . . . . . . . .  59
;        8.3    Get A String . . . . . . . . . . . . . . . . .  60
	Subttl	Table of Contents (page 2)

;		     Table of Contents for LPTDQS
;
;				  Section		      Page
;
;
;    9. I/O Routines
;        9.1    Load or Store a Byte . . . . . . . . . . . . .  61
;        9.2    Send Data  . . . . . . . . . . . . . . . . . .  62
;        9.3    Receive Data . . . . . . . . . . . . . . . . .  63
;        9.4    Wait for Data  . . . . . . . . . . . . . . . .  65
;        9.5    Check on Link Status . . . . . . . . . . . . .  66
;   10. Report Log . . . . . . . . . . . . . . . . . . . . . .  67
;   11. End of LPTDQS  . . . . . . . . . . . . . . . . . . . .  68
	SUBTTL	Revision History

COMMENT \

*****  Release 6.0 - begin development edits  *****

   1	6.1036		20-Oct-87
	Add LPTDQS as the DQS printer handler for LPTSPL.

   2	6.1054		 3-Nov-87
	Fix various problems.  Why should the revision history make
	sense if the %&!@ edit numbers don't.  Fix leading space on 
	time queued, length of filespec seperator field.

   3	6.1056		4-Nov-87
	Remove reference to the checksum word CHECKS.

   4	6.1069		10-Nov-87
	Send protocol version number in ;BDATA field.  Send checkpoints
	each 100K characters transmitted instead of each minute.  Only
	call scheduler each 10K characters transmitted.  Insert full
	filespec code which is repeat 0ed out due to a DJM 1.0 bug.
	Never abort a job from the queue, always requeue it.

   5	6.1073	 	11-Nov-87
	Improve logging and error recovery, fix things from last edit.
	Add protocol trace facility.  Fix stupid smashed AC bug in DQSSND
	that kept me busy for days.  Remove repeat 0ed code in last edit.
	Turn on FTMJ.

   6	6.1075		13-Nov-87
	Use file reading routine in LPTSUB, do accounting properly.

   7	6.1075 		13-Nov-87
	Fix typeo in last edit.

  10	6.1102		24-Nov-87
	Shutdown if error in transmission to DQS DJM rather than requeueing.
	The /AFTER switch seems to confuse the users, we'll let QUASAR restart
	us after a little wait.  Also if the link was just disconnected, try 
	two times to get the job done.

  11	6.1111		 1-Dec-87
	Improve job requeued message.

  12	6.1116		 2-Dec-87 
	The data type being stream causes confusion since the VMS system will 
	think that it is implied carriage control.  Revert to undefined to
	not have the VMS system put in extra blank lines for us.  Also include
	the account string for printing on the remote system.  Use protocol 
	version 1.0 for now since 1.1 doesn't seem to read the separator packet
	properly.
 
  13	6.1224		 7-Mar-88
	Since use of recent DQS servers is not required, it seems we have to
	default the use of the DECnet link to one job per opening or mixtures
	of usernames if the first username queued is longer than the second
	username queued are generated on the remote VMS system (and are printed
	as such by the symbiont).  Setting FTMJ to 0 by default prevents the
	gastric distress caused by the rich meal of two DQS jobs in a row.

 14	6.1225		8-Mar-88
	Update copyright notice.

 15	6.1246		4-May-88
	Check /FILE and /MODE switches.  Support /FILE:ELEVEN and /FILE:FORTRAN
	(/FILE:ASCII was assumed for all files).  /FILE:COBOL and /REPORT are
	not currently supported.  Support /MODE:ARROW and /MODE:SUPPRESS and
	/MODE:OCTAL (/MODE:ASCII was assumed for all files).

\	;End of revision history
	SUBTTL	Definitions -- External and Internal Symbols

;Interns for LPTDQS

	INTERN	DQSINI,DQSREL,DQSFIX,DQSLOG,DQSJOB

;Globular symbols in LPTSPL

	EXTERN	CNTSTA,DETDEL,DIRNAM,DSCHD,ENDREQ,JOBACT	;[4]
	EXTERN	JOBOBA,LPTVNO,NXTFIL,RSETUP,SHUTIN,SNDQSR
	EXTERN	ENDJOB,ENDREQ,LPCNF,JOBCHK	;[4] 

;Globular symbols in LPTSUB

	EXTERN	ABTLNK,GETLNK,CASTIM,FNDCER,FORMS,INPOPN,INPCLS ;[5] 
	EXTERN	INPBYT,LFINF,LSTAF,LPMSG,LPERR,LOGCHR ;[5] [15]
	SUBTTL	Definitions -- DQS Protocol

;Steps in request creation:
;	Connect to remote DJM
;	For each job,
;		Send create message
;		For each file,
;			Send FILESPEC message
;			Send FILEDATA message(s)
;			Send EOF message
;		Send EOR message
;		Receive ERROR or SUMMARY message
;		Send COMMIT message (no errors) or WITHDRAW message (errors)
;		Receive END message from remote DJM
;	Disconnect from remote DJM
	SUBTTL	Definitions -- DQS Protocol -- Message Types

	RADIX	5+5			;Decimal radix

;Message types

	.MTCRE==2			;Create
	.MTPAR==3			;Parameter
	.MTFSP==4			;File spec
	.MTFDT==5			;File data
	.MTEOF==6			;End of file
	.MTEOR==7			;End of request
	.MTCOM==8			;Commit
	.MTWIT==9			;Withdraw
	.MTCAN==10			;Cancel
	.MTDIS==11			;Display
	.MTMOD==12			;Modify
	.MTSUM==13			;Summary
	.MTERR==15			;Error
	.MTEND==16			;End
	SUBTTL	Definitions -- DQS Protocol -- Block Types

;Block types for the ENVIRONMENT message (not used)

;	.BTPVN==1		;Protocol version
;	.BTBFS==3		;Buffer size
;	.BTSUP==4		;Supported features
;	.BTOST==5		;Operating system type

;Block types for the CREATE, MODIFY, CANCEL, DISPLAY, and SUMMARY
;messages - note that each message does not necessarily support
;all of the block types listed

	.BTJNB==1			;Job number
	.BTJNA==3			;Job name
	.BTJOW==4			;Job owner
	.BTQUE==5			;Queue name
	.BTJBS==6			;Job state
	.BTRJN==9			;Requestor job number
	.BTTXT==10			;Text
	.BTJCT==11			;Job count
	.BTPGL==12			;Page limit
	.BTPRI==13			;Priority
	  .MVPRI==5			;[2] Maximum priority allowed
	.BTAFT==14			;After time
	.BTNOA==16			;Notify action
	.BTPVN==18			;Protocol version number
	  .LNPVN==4			;[2] Length of protocol version
	.BTACT==19			;Account name
	.BTJID==20			;Jobid list
	.BTCAS==21			;Case type
	.BTFRM==22			;Forms type
	.BTCHR==23			;Characteristics
	  .LNCHR==^D16			;Length of characteristics byte string
	.BTAJB==24			;All jobs
	.BTNON==29			;Notify name
	.BTFNT==30			;Font name
	.BTP01==31			;Parameter 1
	.BTP02==32			;Parameter 2
	.BTP03==33			;Parameter 3
	.BTP04==34			;Parameter 4
	.BTP05==35			;Parameter 5
	.BTP06==36			;Parameter 6
	.BTP07==37			;Parameter 7
	.BTP08==38			;Parameter 8
	.BTNOT==39			;Note
	.BTTMQ==40			;Time queued

	;Continued on next page
	;Continued from previous page

;Block types for the file spec message

	.BTFNM==6			;File name
	.BTFTY==8			;File data type
	  FT.UDF==0			;[12] Undefined data type
	  FT.STM==1			;[5] Stream data type
	.BTFCC==11			;Copies
	.BTFSE==12			;Separator
	   SE.HDR==1			;File headers
	   SE.BST==4			;File burst pages
	   SE.TRL==8			;File trailers
	.BTFEP==14			;End page
	.BTFBL==15			;Blank lines
	.BTFPO==17			;Page option
	   PO.PAG==1			;Paginate
	   PO.LFS==2			;Listfilespec (not supported)
	.BTFOR==18			;Fab org
	.BTFAT==19			;Fab rat
	.BTFRS==20			;Fab mrs
	.BTFRN==21			;Fab mrn
	.BTFFM==22			;Fab rfm
	.BTFSZ==23			;Fab fsz
	.BTFBK==24			;Fab bks
	.BTFGB==25			;Fab gbc
	.BTFOP==26			;Fab fop
	.BTFAL==27			;Fab alq
	.BTFSP==28			;Start page
	.BTFST==29			;File setup

;Block types for the FILE DATA message

	.BTDAT==1			;Data transfer

;Block types for the ERROR message

	.BTEEL==1			;Error level
	.BTEEC==2			;Error class
	.BTECD==3			;Error code
	.BTEID==7			;Message id
	.BTETX==10			;Text

	;Continued on next page
	;Continued from previous page

;Status values

	.STHDJ==1			;Hold waiting for commit
	.STHUS==2			;Hold by user
	.STHOP==3			;Hold by operator
	.STHTI==4			;Hold until designated time
	.STHFT==5			;Hold waiting for file transfer
	.STHRW==6			;Hold waiting for resources
	.STSCH==7			;Scheduled for execution
	.STEXC==8			;Execution in progress
	.STSUS==9			;Execution suspended by user
	.STSOP==10			;Execution suspended by operator
	.STSRQ==11			;Execution suspended by job request
	.STSRW==12			;Execution suspended by resource wait
	.STCUS==13			;Job cancelled by user
	.STCOP==14			;Job cancelled by operator
	.STCMK==15			;Job marked for cancellation
	.STSUC==16			;Job completed (terminated normally)
	.STFAI==17			;Job completed (terminated abnormally)

;Case types

	.CTANY==1			;Any
	.CTLOW==2			;Lower
	.CTUPR==3			;Upper
	.CTLQP==4			;LQP

;Notify action bits

	NA.CMP==1			;Notify on completion
	NA.CHG==2			;Notify on change
	NA.TSK==4			;Notify task

;Error levels

	.ELFAT==4			;Fatal
	.ELWRN==3			;Warning
	.ELINF==2			;Informational
	.ELSUC==1			;Success

;Error classes

	.ECRMT==4			;Remote
	.ECDJS==3			;Djs
	.ECUNS==2			;Unsupported
	.ECPRT==1			;Protocol error

	RADIX	4+4
	SUBTTL	Definitions -- DQS Protocol -- Bytes in Message Header and Block

;The first "n" bytes in the DQS message are the message header.
;The contents of these bytes and their names are:

	.HDTYP==0			;Message type (.MTxxx)
	.HDFLG==1			;Flags (none defined?)
	.HDCTX==2			;Sender's context
	.HDBLK==3			;Number of blocks in body of message
	.HDLNL==4			;Low order byte of message length
	.HDLNH==5			;High order byte of message length
	.HDSIZ==6			;Size of message header

;The first "n" bytes in a DQS message block are the block header.
;The contents of these bytes and their names are:

	.BKTYP==0			;Block type (.btxxx)
	.BKLNH==1			;High order byte of block length
	.BKLNL==2			;Low order byte of block length
	.BKSIZ==3			;Size of block header
	SUBTTL	Definitions -- DQS Protocol -- Message Byte Pointers

;P.Ixxx are for incoming messages, P.Oxxx are for outgoing messages

;Macro to make byte pointers
;Arguments:	OFS - byte offset into message
;		ADR - address of message

	DEFINE	BYTPNT	(OFS,ADR),<
	$$$WRD==OFS/4		;;Word offset
	$$$POS==<<<OFS&3>+1>*8>-1 ;;Position of right-most bit
	POINT	8,$$$WRD+ADR,$$$POS
>; END DEFINE BYTPNT

P.ITYP:	BYTPNT	(.HDTYP,IBUFF)		;Type
P.OTYP:	BYTPNT	(.HDTYP,OBUFF)
P.IFLG:	BYTPNT	(.HDFLG,IBUFF)		;Flags
P.OFLG:	BYTPNT	(.HDFLG,OBUFF)
P.ICTX:	BYTPNT	(.HDCTX,IBUFF)		;Context
P.OCTX:	BYTPNT	(.HDCTX,OBUFF)
P.IBLK:	BYTPNT	(.HDBLK,IBUFF)		;Number of blocks
P.OBLK:	BYTPNT	(.HDBLK,OBUFF)
P.ILNH:	BYTPNT	(.HDLNH,IBUFF)		;High byte of message length
P.OLNH:	BYTPNT	(.HDLNH,OBUFF)
P.ILNL:	BYTPNT	(.HDLNL,IBUFF)		;Low byte of message length
P.OLNL:	BYTPNT	(.HDLNL,OBUFF)
	SUBTTL	Definitions -- Assembly Parameters

;Some assembly parameters

ND	FTMJ,0				;[13] Zero closes link after each job
ND	FTPT,0				;[5] Zero to remote protocol trace code
ND	RTYMAX,2			;[10] Times to retry this job

ND	PVMAJ,1				;[2] Major protocol version
ND	PVMIN,1				;[2] Minor protocol version
ND	PVEDT,0				;[2] Edit 0 (must be 0)
ND	PVUSR,0				;[2] User version 0 (must be 0)

ND	DQSWTM,^D60*^D1			;Seconds to wait for DJM response

ND	OCTWPL,^D4			;[15] /MODE:OCTAL words per line
ND	OCTLPB,^D16			;[15] /MODE:OCTAL lines per block
ND	OCTBPP,^D3			;[15] /MODE:OCTAL blocks per page

;[2] Spec allows 4096 byte data transfers

ND	BFSBYT,^D512			;Buffer size in bytes
XP	BFSWRD,<<BFSBYT+3>/4>		;Buffer size in words
	SUBTTL	Definitions -- Storage

;Here is the local storage used for LPTDQS

IFN FTPT,<				;[5] Protocol trace?
PTRACE:	BLOCK	1			;[5] If nonzero trace to log file
>					;[5] End of FTPT

PRTVER:	BLOCK	4			;[4] Protocol version

RETRYC:	BLOCK	1			;[10] Retry count for this job
BLKCNT:	BLOCK	1			;Count of bytes in this block

SAVBPP:	BLOCK	2			;[15] Saved /MODE:OCTAL bpp and lpb
SAVWPL:	BLOCK	1			;[15] Saved /MODE:OCTAL wpl
TRNRTN:	BLOCK	1			;[15] Routine to use to print file

TMPBUF:	BLOCK	BFSWRD			;Temporary buffer for building text

IBPTR:	BLOCK	1			;Input buffer byte pointer
IBCNT:	BLOCK	1			;Input buffer byte count
IBSLT:	BLOCK	1			;Input buffer saved last transfer count

IBUFF:	BLOCK	BFSWRD			;Input buffer

OBPTR:	BLOCK	1			;Output buffer byte pointer
OBCNT:	BLOCK	1			;Output buffer byte count
OBUFF:	BLOCK	BFSWRD			;Output buffer

ERRBEG:!
ERRCOD:	BLOCK	1			;Error code
ERRLVL:	BLOCK	1			;Error level
ERRCLS:	BLOCK	1			;Error class
ERRBUF:	BLOCK	30			;Error text buffer
ERREND==.-1				;End of zeroed block
	SUBTTL	Setup Message

;INIDQS is called during LPTSPL's setup to build the decnet dcn: device name,
;to open the decnet link and to allocate the buffer for any files that may need
;to be transferred to a remote node.  If accounting is enabled, then a listener
;is also started.  If the decnet dcn: jfn cannot be obtained or opened, or if
;The listener cannot be started, then a setup response message is sent to
;Quasar indicating that this lptspl is shutting down.  The operator is also
;informed that this LPTSPL is being shutdown.
;
;Call is:       J/Job Context Pointer
;               M/Address of the SETUP message
;Returns true:  S1/SETUP response code
;               The DECnet link is connected and the listener (if any) is 
;               started
;Returns false: A fatal error occurred (the DECnet DCN: JFN could not be
;               obtained or opened, or the listener could not be started)

;Attempt to open and connect the DECnet link

DQSINI:	$CALL	DQSDCN			;Build the DCN: device name
	$CALL	DQSLNK			;Open the DECnet link if not open now
	$RETIF				;Return bad, S1/response to setup code

;Link is open or opening, return OK code after doing a little housekeeping.

IFN FTACNT<
	SETOM	J$ACCT(J)		;Indicate accounting is enabled
>
IFN FTMJ,<
	$CALL	CASTIM			;Set the DECnet inactivity timer
>
	$CALL	DQSOBS			;Setup output buffer pointer/count
	MOVX	S1,%RSUOK		;Pick up the setup ok response code
	$RETT				;Return OK
	SUBTTL	Setup Message -- Build device name

;DQSDCN is called from INIDQS to build the DECnet DCN: device name that we will
;use in opening our DECnet link. The format of the DCN: device name is:
;	DCN:rnode-66
;
;where RNODE is the remote node name
;      66 is the corporate DECnet object for DQS
;
;Call is: J/Job Context Pointer
;Returns  The DCN: device name has been built and placed in the stream's
;         data base

DQSDCN:	$SAVE	<P1,P2,P3,P4>		;Save these ac

;Get node name, abort any old link if the node names don't match.

	MOVE	S2,JOBOBA		;Pick up the object block address
	MOVE	S2,OBJ.ND(S2)		;Pick up the listener's node name
	CAMN	S2,J$RNOD(J)		;Is this the same node name?
	$CALL	ABTLNK			;Abort link if present now
	MOVEM	S2,J$RNOD(J)		;Save in the data base

;[12] BDATA is the protocol version, returned by the remote for us to read only
;[12] if using object 66.  Object is either 66 (new) or 170 (old), 170 only
;[12] talks protocol version 1.0.  Note: Don't send BDATA if you wish to talk
;[12] protocol version 1.0.

;[12]	$TEXT(<-1,,J$CDCN(J)>,<DCN:^N/J$RNOD(J)/-66.;BDATA:^O3R0/[PVMAJ]/^O3R0/[PVMIN]/000000^0>) ;[4]
	$TEXT(<-1,,J$CDCN(J)>,<DCN:^N/J$RNOD(J)/-66.^0>) ;[12] 
	$RET				;Return to the caller
	SUBTTL	Setup Message -- Open DECnet Link

;DQSLNK is called by DQSINI (Setup Measage) and also if it is detected that the
;link is no longer connected while starting to process a print request (Nextjob
;Message).

;This routine opens a DECnet link to a remote DQS system.  If a connection
;cannot be obtained, then a check is made to see if the error is fatal.  If the
;error is fatal, then we return a code that shuts down the object.  If the
;error is not fatal, then DQSLNK will return an error to QUASAR that will have
;QUASAR try again later.

;Call is:       J/Job Context Pointer
;Returns true:  The DECnet link is connected
;Returns false: A fatal DECnet error was detected
;		S1/ setup code
;		J$ERRA(J)/ Address of the error string

DQSLNK:	SKIPLE	J$LCHN(J)		;Still have a connection?
	$CALL	ABTLNK			;Yep, zap it

;Try and get the link, return fatal error if it is fatal

	$CALL	GETLNK			;Obtain one and OPENF
	JUMPF	OPNLN3			;[4] Owie
	SETZM	PRTVER			;[4] Clear protocol version word
	SETZM	PRTVER+1		;[5] Clear returned protocol version

;Check the status of the link.  Return if it is open or opening.

	$CALL	DQSCHK			;Check the link status, return in T1
	$RETIT				;Return if true

	MOVEI	S1,%RSUNA		;That device is unavailable now
	$RET				;Return FALSE

;Here if fatal error, shut it down

OPNLN3:	MOVEI	S1,%RSUDE		;Fatal error 
	$RET				;Return FALSE with S1/ code
	SUBTTL	Shutdown Message

;DQSREL is called as part of the shutdown of a DQS LPTSPL.  It just aborts the
;link and returns.
;
;Call is: J/Job Context Pointer
;Returns: The cleanup has been performed

DQSREL:	SKIPLE	J$LCHN(J)		;Is there a DECnet DCN: device jfn?
	$CALL	ABTLNK			;Yes, release it
	$RET				;Return to the shutdown 
	SUBTTL	Next Job Message

;DQSFIX is called from routine NXTJOB when NXTJOB determines that this is
;a DQS LPTSPL.
;
;Call is: $CALL from NXTJOB
;         J/Job Context Pointer
;
;Returns: Selected job data words have been zeroed

DQSFIX:	SETZM	J$CONF(J)		;Zero out connection failure during job
	$RET				;Return to finish NXTJOB stuff
	SUBTTL	Job Processing

;DQSJOB processes a NEXTJOB message that is to be routed to a remote node.
;
;Call is: This routine is started by the job processing dispatch scheduler
;Returns: The print request has been forwarded to the node where the files
;         in the print request are to be printed.

DQSJOB:	LOAD	S1,.EQSEQ(J),EQ.IAS	;Get invalid account string bit
	STORE	S1,S,ABORT		;Save it as the abort bit
	SETZM	RETRYC			;[10] Clear DECnet retry counter

DQSJ1:	LOAD	E,.EQLEN(J),EQ.LOH	;Get length of header
	ADD	E,J			;Point to first file
	TXO	S,INJOB			;We are in a job now
	SETZM	J$RNFP(J)		;Back to first file for requeue

;Get proper forms number saved

	$CALL	FORMS			;Get proper forms number

;Insure that link is open and that it is OK

	SKIPLE	J$LCHN(J)		;Is there a link open?
	JRST	DQSJ3			;Yes
	$CALL	DQSLNK			;No, get one open
	JUMPF	RSTMSG			;Jump if failure

DQSJ3:	$CALL	DQSCHK			;Is the link status OK
	JUMPF	RSTMSG			;Fatal error

;Send the files over to the DJM

DQSJ4:	$CALL	RCREAT			;Send create message
	JUMPF	RSTMSG			;[10] Jump if failure

;Finish up and return.

IFN FTMJ,<				;If doing multiple jobs per link
	$CALL	CASTIM			;Set DECnet timeout interval
>					;End of IFN FTMJ
IFE FTMJ,<				;If only one job per link
	$CALL	ABTLNK			;DJM wants one job at a time
>					;End of IFE FTMJ
	PJRST	ENDJOB			;Finish up job in LPTSPL
	SUBTTL	Job Processing -- Remote CREATE request

;Here with link open to the remote to do the files that have been given to us.
;Returns: TRUE if everything OK
;         FALSE if not OK

;Steps in request creation:
;	(Connect to remote DJM)
;	Send create message
;	For each file,
;		Send FILESPEC message
;		Send FILEDATA message(s)
;		Send EOF message
;	Send EOR message
;	Receive ERROR or SUMMARY message
;	Send COMMIT message (no errors) or WITHDRAW message (errors)
;	Receive END message from remote DJM
;	(Disconnect from remote DJM)

RCREAT:	$CALL	SCREAT			;Send Creation message
	$RETIF				;[10] Return FALSE if problem
	$CALL	SFILES			;Send files
	$RETIF				;[10] Return FALSE if problem
	$CALL	SEOR			;Send end of request
	$RETIF				;[10] Return FALSE if problem
	$CALL	RSUMMA			;Recieve summary or error
	$RETIF				;[10] Return FALSE if problem
	$CALL	SCOMMI			;Send commit or withdraw
	$RETIF				;[10] Return FALSE if problem
	$CALL	REND			;Recieve end message
	$RET				;[10] Return TRUE or FALSE
	SUBTTL	Job Processing -- Send Create Request 

;Here to send a create request out the connection
;Returns TRUE if ok FALSE if not

SCREAT:	MOVX	S1,.MTCRE		;Type = create request
	$CALL	SETMSG			;Set up message header

;[2] Protocol version

;[5]	MOVE	S1,[.LNPVN,,.BTPVN]	;[2] Protocol version number
;[5]	MOVE	S2,[Point 8,[BYTE(8)PVMAJ,PVMIN,PVEDT,PVUSR]] ;[2] 
;[5]	$CALL	G$PCST			;[2] Output those four bytes

;Job name

	$TEXT	<-1,,TMPBUF>,<^W/.EQJOB(J)/^0> ;Generate job name
	MOVX	S1,.BTJNA		;Type = job name
	$CALL	G$PTMP			;Heave it out of the buffer

;Job owner

	$TEXT	<-1,,TMPBUF>,<^W/CNTSTA/::^T/.EQOWN(J)/^0>
	MOVX	S1,.BTJOW		;Type = job owner
	$CALL	G$PTMP			;Cram it

;Job account

	MOVEI	S2,.EQACT(J)		;[12] Point to account string
	HRLI	S2,(Point 7)		;[12]  and make a byte pointer
	MOVEI	S1,.BTACT		;[12] Load the account name
	SKIPE	.EQACT(J)		;[12] If there is an account
	$CALL	G$PSTG			;[12] Send it

;Job queue name

	MOVX	S1,.BTQUE		;Type = queue name
	MOVEI	S2,.EQRPN(J)		;Load queue name address
	$CALL	G$PSUC			;Force it to be uppercase this time

	;Continued on next page
	;Continued from previous page

;Requestor job number

	MOVX	S1,.BTRJN		;Type = requestor job number
	MOVE	S2,.EQRID(J)		;Use request number
	$CALL	G$PWRD			;Stuff it

;Job count (number of times to print this job) would go here

;Page limit would go here

;Priority

	MOVX	S1,.BTPRI		;Type = priority
	LOAD	S2,.EQSEQ(J),EQ.PRI	;Get external priority
	CAILE	S2,.MVPRI		;In range for DQS?
	MOVEI	S2,.MVPRI		;No, use the maximum for DQS
	$CALL	G$PWRD			;Another word of pleasure

;Notify action

;[12]	MOVX	S1,.BTNOA		;Type = notify action
;[12]	MOVEI	S2,NA.CMP!NA.CHG	;Notify on completion or change
;[12]	$CALL	G$PBYT			;Stuff it

;Notify name and case type (lower, upper, generic) would go here

;Forms type

	MOVX	S1,.BTFRM		;Type = forms code
	MOVE	S2,J$FNUM(J)		;Load forms number
	SKIPE	S2			;Is it normal forms?
	$CALL	G$PBYT			;No, cram it there

;Characteristics

	MOVE	S1,[.LNCHR,,.BTCHR]	;Length = 16, type = characteristics
	MOVEI	S2,.EQCHR(J)		;Load characteristics area address 
	HRLI	S2,(Point 8)		;Set byte pointer
	$CALL	G$PCST			;Probably will be LANDSCAPE a lot

	;Continued on next page
	;Continued from previous page

;Font name and Parameter_1 through Parameter_8 would go here

;Note string

	GETLIM	S1,.EQLIM(J),NOT1	;Get the first half of /NOTE:
	GETLIM	S2,.EQLIM(J),NOT2	;Get the second half
	SKIPN	S1			;Skip if not null
	JUMPE	S2,SCRE.2		;If null, ignore it
	$TEXT	<-1,,TMPBUF>,<^W6/S1/^W/S2/ ^T/.EQBOX(J)/^0> ;[2] Ascificate
	MOVX	S1,.BTNOT		;Type = note
	$CALL	G$PTMP			;Not null, stuff it

;Time queued

SCRE.2:	HRROI	S1,TMPBUF		;Point to the buffer
	MOVE	S2,.EQAFT(J)		;Load the after word
	MOVX	T1,OT%4YR		;Output like "21-Oct-1987 12:34:56"
	ODTIM%				;Output it
	 ERJMP 	.+1			;Ignore error
	LDB	S1,[POINT 7,TMPBUF,6]	;[2] get first character of time
	CAIN	S1," "			;[2] Is it a space?
	MOVEI	S1,"0"			;[2] Yes make it zero
	DPB	S1,[POINT 7,TMPBUF,6]	;[2] Store that character back
	MOVX	S1,.BTTMQ		;Type = after time
	$CALL	G$PTMP			;Copy that over for VMS

;Finish message up, send it, check for objections

	$CALL	FINMSG			;Finish message
	$CALL	DQSSND			;[4] Send it
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] Check objections and return
	SUBTTL	Job Processing -- Send Files

;Now loop for each file, sending a FILESPEC message, one or more
;FILEDATA messages, and an EOF message.
;Returns TRUE if ok FALSE if not

SFILES:	STKVAR	<BPLEN,BPCNT>		;A couple of safe places

SFIL.1:	SETZM	JOBCHK			;Send a checkpoint message soon
	$CALL	SNDFSP			;Send filespec message
	$RETIF				;Return if owie

;[15] Check /FILE and /MODE switches passed to us then open the file up.

	$CALL	FILMOD			;[15] Check /FILE and /PRINT switches
	JUMPF	SFIL.5			;[15] If error, report

	$CALL	INPOPN			;Open the file
	JUMPF	SFIL.6			;Jump if a problem

;[15] Log the start message, send the data, log the finish message

	$CALL	LSTAF			;[4] Log the start

	$CALL	SNDDAT			;Send the data
	$RETIF				;Return owie

	$CALL	LFINF			;[4] Output to log 
	$CALL	INPCLS			;[4] Close input file

	;Continued on next page
	;Continued from previous page
	
;Here with data or error message about file sent, count the file and send
;an end of file message.

SFIL.2:	AOS	J$RNFP(J)		;Count a file please
	$DSCHD(0)			;See if any IPCF messages for us
	TXNE	S,RQB!ABORT		;Should we just abort this?
	$RETF				;[10] Return owie
	$CALL	SNDEOF			;Send the EOF
	$RETIF				;Return if that didn't work

;Here to send over the next file.

	$CALL	DJMOBJ			;DJM objections?
	$RETIF				;Yes
	$CALL	NXTFIL			;Get the next filespec
	JUMPT	SFIL.1			;Process that file
	$RETT				;Return with all files sent

;[15] Problem with /FILE or /MODE from FILMOD routine.

SFIL.5:	$CALL	FILMER			;[15] Output can't print message
	$RETIF				;[15] Return if hell freezing over
	JRST	SFIL.2			;[15] Get the next file

;Can't find file error.

SFIL.6:	$CALL	CACFIL			;Output can't access text message
	$RETIF				;Return now if owie
	JRST	SFIL.2			;Try the next file
	SUBTTL	Job Processing -- Send Files -- Send Filespec Message

;Here to send the filespec message out.

SNDFSP:	MOVX	S1,.MTFSP		;Type = file spec
	$CALL	SETMSG			;Set up message header

;Filename string.

	LOAD	S2,.FPLEN(E),FP.LEN	;Get length of the FP 
	ADDI	S2,.FDSTG(E)		;Point to the filespec in the FD
	HRLI	S2,(Point 7)		;Make a byte pointer to that please

;[4] Depending on the DQS protocol version that we are talking to we have to
;[4] send just the filename or the full filespec block.  

	MOVE	S1,PRTVER+1		;[4] Get the other end's protocol ver
	CAML	S1,[BYTE(8)1,1,0,0]	;[4] Is it OK to send long filespec?
	JRST	SNDF.F			;[4] Yes, send full file

;Protocol is older, send only the part after the directory as to not
;confuse the poor DJM.

SNDF.0:	ILDB	S1,S2			;Get a character
	CAIE	S1,135			;Is it a close square bracket?
	CAIN	S1,76			; or is it a close angle bracket?
	JRST	SNDF.7			;Yes, ready to check for other things
	JUMPN	S1,SNDF.0		;Loop until a null seen
	JRST	SNDF.7			;[4] No angle bracket seen!

	;Continued on next page
	;Continued from previous page

;[4] Protocol is later version, we can pass full filespec, but we have to
;[4] VAXinate the TOPS-20 filename string passed to us.  This is done by
;[4] copying the file name string from the EQ into TMPBUF.  We also have to
;[4] change the dot before the generation into a semicolon.  We pass the rest
;[4] of the filename string as is.  Therefore, "WORK:<GSCOTT.LPTSPL>A.B.33"
;[4] gets turned into "_WORK:[GSCOTT.LPTSPL]A.B;3".

SNDF.F:	MOVE	T1,[Point 7,TMPBUF]	;[4] Point to temp storage
	MOVEI	S1,"_"			;[4] Load the VMS physical character
	IDPB	S1,T1			;[4] Store that in the buffer
	SETZ	T2,			;[4] Clear counter of dots
SNDF.1:	ILDB	S1,S2			;[4] Get a character
	CAIE	S1,"V"-100		;[4] Is it a control V?
	JRST	SNDF.2			;[4] No
	ILDB	S1,S2			;[4] Get the next character
	MOVEI	S1,"_"			;[4] Load an underscore for now
SNDF.2:	CAIE	S1,"."			;[4] Is it a dot?
	JRST	SNDF.4			;[4] Nope
	SOJN	T2,SNDF.4		;[4] Yep, jump if this dot is OK
	MOVEI	S1,";"			;[4] Make it a semicolon for VMS
SNDF.4:	CAIN	S1,74			;[4] Is it an open angle bracket?
	MOVEI	S1,"["			;[4] Yes, vaxinate it
	CAIE	S1,76			;[4] Is it a close angle bracket?
	JRST	SNDF.5			;[4] Nope
	MOVEI	S1,"]"			;[4] Yes, vaxinate it
	MOVEI	T2,2			;[4] Remember to eat two dots
SNDF.5:	IDPB	S1,T1			;[4] Store character
	JUMPN	S1,SNDF.1		;[4] Loop until a null seen
	MOVEI	S2,TMPBUF		;[4] Point to filename storage area

;Filespec is set up in TMPBUF, check for spooled files or not (to substitute
;filenames) then store the filename message for DQS.

SNDF.7:	MOVE	S1,.FPINF(E)		;[2] Get flags for file
	TXNE	S1,FP.SPL		;Is it a spooled file?
	MOVEI	S2,[ASCIZ/Spooled.File;1/] ;Yes
	TXNE	S1,FP.FLG		;Is it also a log file?
	MOVEI	S2,[ASCIZ/Batch_Log.File;1/] ;Yes
	MOVX	S1,.BTFNM		;Type = filename
	$CALL	G$PSTG			;Copy from address in S2

	;Continued on next page
	;Continued from previous page

;Data type

	MOVX	S1,.BTFTY		;Type = data type
	MOVEI	S2,FT.UDF		;[12] Undefined data
	$CALL	G$PBYT			;Stuff it

;Copy count

	MOVX	S1,.BTFCC		;Type = copy count
	LOAD	S2,.FPINF(E),FP.FCY	;Get the count
	CAILE	S2,1			;Don't bother if just one copy
	$CALL	G$PWRD			;Stuff it

;Separator

	MOVX	S1,.BTFSE		;Type = separator
	MOVE	S2,.FPINF(E)		;Get file info bits
	TXNE	S2,FP.NFH		;No file headers?
	TDZA	S2,S2			;[12] /noheader, clear s2 and skip
	MOVEI	S2,SE.HDR		;[12] /header, load header flag
	$CALL	G$PBYT			;[12] Send the byte

;Blank lines

	MOVX	S1,.BTFBL		;Type = blank line count
	LOAD	S2,.FPINF(E),FP.FSP	;Get the spacing
	SOS	S2			;[12] Get blank lines-1
	$CALL	G$PBYT			;[12] Blank lines is nonzero, store

	;Continued on next page
	;Continued from previous page

;Page options

	MOVX	S1,.BTFPO		;Type = page options
	SETZ	S2,			;None yet
	$CALL	G$PBYT			;Stuff it

;Start page

	MOVX	S1,.BTFSP		;Type = start page
	MOVE	S2,.FPFST(E)		;Get starting page
	CAILE	S2,1			;Don't bother if starting at beginning
	$CALL	G$PWRD			;Stuff it

;End of blocks

	$CALL	FINMSG			;Finish message
	$CALL	DQSSND			;[4] Send the message
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] See if DJM objections and return
	SUBTTL	Job Processing -- Send Files -- Check /FILE and /MODE Switches

;[15] Here to check out and /FILE and /MODE switches for this request.
;	LPTSPL's switch checking order inspired the order of checking here.
;	/FILE options supported are ASCII and ELEVEN.
;	/MODE options supported are ARROW, ASCII, and SUPPRESS.
;	/MODE:OCTAL and /FILE:(COBOL,FORTRAN) and /REPORT are not implemented.
;Returns FALSE if some problem, T1/ adr of bad switch in ASCIZ
;Returns TRUE if all is OK, sets ARROW and/or SUPFIL bits in S and TRNRTN.

FILMOD:	LOAD	S1,.FPINF(E),FP.FFF	;Get the /FILE switch
	LOAD	S2,.FPINF(E),FP.FPF	;Get the /PRINT switch
	TXZ	S,NEWLIN!ARROW!SUPFIL	;Assume no ARROW or SUPPRESS mode 
	MOVEI	T2,SNDASC		;Assume ASCII

	CAIE	S2,%FPLOC		;/MODE:OCTAL?
	JRST	FILM.2			;No
	MOVEI	T2,SNDOCT		;Yes, load OCTAL dump routine
	SETZM	OCTLPB			;First line, clear line per block
	JRST	FILM.7			;Store routine and return

FILM.2:	CAIE	S1,.FPFFO		;/FILE:FORTRAN?
	JRST	FILM.3			;No
	MOVEI	T2,SNDFOR		;Yes, load special transfer routine
	TXO	S,FCONV			; and first char is to be converted

FILM.3:	MOVEI	T1,[ASCIZ\/FILE:COBOL\]	;Load the switch name for error
	CAIN	S1,.FPFCO		;/FILE:COBOL?
	$RETF				;Yes

	MOVEI	T1,[ASCIZ\/REPORT\]	;Load switch name
	SKIPE	.FPFR1(E)		;/REPORT specified?
	$RETF				;Yes

	CAIN	S2,%FPLAR		;/MODE:ARROW?
	TXO	S,ARROW			;Yes, light flag for later
	CAIN	S2,%FPLSU		;/MODE:SUPPRESS?
	TXO	S,SUPFIL!ARROW		;Yes, light both arrow and it
	TXNE	S,ARROW!SUPFIL!SUPJOB	;/MODE:ARROW or /MODE:SUPPRESS?
	MOVEI	T2,SNDSLO		;Yes, use slow copy routine

	CAIN	S1,.FPF11		;/FILE:ELEVEN?
	MOVEI	T2,SNDELE		;Yes use special routine

;Store routine to use and return good.

FILM.7:	MOVEM	T2,TRNRTN		;Store routine to use today
	$RETT				;Nope, standard ASCII
	SUBTTL	Job Processing -- Send Files -- Send Error Messages

;[15] Here if switch specified for this file is not supported in DQS LPTSPL.
;Called after FILMOD returns FALSE, T1/ address of ASCIZ bad switch name.

FILMER:	LOAD	S2,.FPLEN(E),FP.LEN	;[15] Get length of the FP
	ADDI	S2,.FDSTG(E)		;[15] Point to the FD
	$TEXT(LOGCHR,<^I/LPERR/Can't transmit ^T/(S2)/, switch ^T/(T1)/ not implemented for DQS spooling>) ;[15] 
	MOVEI	S1,[ITEXT (<Switch ^T/(T1)/ is not implemented for DQS spooling>)] ;[15] 
	JRST	ERRFIL			;[15] Output that error message as file
					;[15] and then return

;Here when we can't access a file to put a little message out to the DJM that
;tells the user he lost.  We send this message rather than the file's contents.

CACFIL:	MOVEI	S1,[ITEXT (<^E/[-1]/>)]	;[15] Make a nice easy message
					;[15] and fall through to ERRFIL

;[15] Here to send error message as a file for the user to agonize over
;	Call with S1/ address of ITEXT with error in it

ERRFIL:	LOAD	S2,.FPLEN(E),FP.LEN	;Get length of the FP
	ADDI	S2,.FDSTG(E)		;Point to the FD
	$TEXT	(<-1,,TMPBUF>,<^M^J
	LPTSPL version ^V/LPTVNO/
	^T/LPCNF/
	^B/@JOBOBA/ at ^H/[-1]/
	^R/.EQJBB(J)/

	File ^T/(S2)/ cannot be transmitted
	^I/(S1)/^M^J^0>)		;[15] Create error message text

	MOVX	S1,.MTFDT		;Type = filedata
	$CALL	SETMSG			;Set up message header
	MOVX	S1,.BTDAT		;Type = data transfer
	$CALL	G$PTMP			;Stuff the string from TMPBUF
	$CALL	FINMSG			;Finish up message
	$CALL	DQSSND			;[4] Send it
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] Check objections and return
	SUBTTL	Job Processing -- Send Files -- Send Data Messages

;Output all of the file data here, called with file already open we just have
;to pump out the data. [4] Checkpoint every 100Kbytes so we update a little
;more often than once a job.

;[4] AC usage:	P1/ <number of bytes transmitted>/^D100K
;		P2/ <number of bytes transmittes>/^D10K
;		P3/ Pointer to length bytes of the data subblock in buffer
;		P4/ Count of free bytes in transmit buffer
;		T2/ Count of possible data bytes in that transmit buffer

SNDDAT:	$SAVE	<P1,P2,P3,P4>		;[4] Save some acs
	SETZB	P1,P2			;[4] Zero count of each 100K bytes

;[4] Top of loop to transmit the next data message.  First do housekeeping.
;[4] If there has been another 100K characters transmitted send a update
;[4] message to QUASAR so that all can see how the print jobs are going.

SNDD.0:	MOVE	S1,J$APRT(J)		;[4] Load bytes transmitted
	IDIVI	S1,^D100000		;[4] Get number of 100K bytes in S1
	EXCH	S1,P1			;[4] Swap to save new count in P1
	CAMLE	P1,S1			;[4] Transmitted another 100K yet?
	SETZM	JOBCHK			;[2] Yes send a checkpoint message

;[4] Perform a scheduling pass to catch IPCFs each 10K characters.  This alows
;[4] for a reasonable response to operaor or user commands yet keeps the
;[4] overhead down when transmitting data.  The call to the scheduler will also
;[4] send a checkpoint message to QUASAR.

	MOVE	S2,J$APRT(J)		;[4] Load the characters transmitted
	IDIVI	S2,^D10000		;[4] Get number of 10K characters
	EXCH	S2,P2			;[4] Swap to save new in P2 old in S1
	SKIPE	JOBCHK			;[4] If checkpoint force scheduling
	CAMLE	P2,S2			;[4] No, transmitted another 10K yet?
	$DSCHD(0)			;Scheduling pass (to update QUASAR)

;[4] See if the DJM or QUASAR has had any objections to us while all of this is
;[4] going on.  (IPCF messages are only processed occasionally.)

	$CALL	DJMOBJ			;DJM objection?
	$RETIF				;Return if so

	;Continued on next page
	;Continued from previous page

;Ready to transmit, set up the header first.

	MOVX	S1,.MTFDT		;Type = filedata
	$CALL	SETMSG			;Set up message header
	AOS	BLKCNT			;Count another block
	MOVX	S1,.BTDAT		;Type = filedata
	$CALL	PUTBYT			;Stuff the block type
	MOVE	P3,OBPTR		;Save pointer to hi length byte
	SETZ	S1,			;Get a zero
	$CALL	PUTBYT			;Store length of zero temporarily
	$CALL	PUTBYT			;...
	MOVE	T2,OBCNT		;[6] Get space left in buffer, the same
	MOVE	P4,OBCNT		;[6]  as maximum number of bytes send

;[15] Call specific routine to load up a bufferfull of data.  The caller is
;expected to preserve T2 and count P4 down by 1 each time PUTBYT is called.
;The formatting routine returns TRUE if more characters to send, FALSE if EOF.

	$CALL	@TRNRTN			;[15] Dispatch to print routine

;[15] Here with a bufferfull of characters, with P4/ free bytes in the buffer.
;Store the length of the data in the message and send it.  We are at end of
;file if entered with TF FALSE.

SNDD.4:	MOVE	S1,T2			;Get the free byte count back
	SUB	S1,P4			;[6] Minus space left equals data count
	ROT	S1,-^D8			;Shift high byte over
	IDPB	S1,P3			;Store the high order length byte
	ROT	S1,^D8			;Shift low byte back
	IDPB	S1,P3			;Store the low order length byte
	MOVE	P4,TF			;[15] Remember if more to do

	$CALL	FINMSG			;Finish message
	$CALL	DQSSND			;Send it
	$RETIF				;Return if owie

;Loop if more file to do (buffer full), otherwise return with all data sent.

	JUMPT	P4,SNDD.0		;[15] Jump if SNDxxx returned TRUE
	$RETT				;[15] Return if end of file seen here
	SUBTTL	Job Processing -- Send Files -- Send Data Messages -- Ascii Mode

;[15] Normal fast ASCII print loop to get a buffer full of characters.
;	P4/ count of free bytes in the buffer
;	Returns FALSE if end of file
;	Returns TRUE if more to do

SNDASC:	$CALL	INPBYT			;[6] Read a byte
	$RETIF				;[15] End of file
	SKIPN	S1,C			;[6] Copy the character
	JRST	SNDASC			;Null, throw it away
	$CALL	PUTBYT			;Stuff the byte
	SOJG	P4,SNDASC		;[6] Loop for the rest we can do
	$RETT				;[15] Send buffer full
	SUBTTL	Job Processing -- Send Files -- Send Data Messages -- Eleven Format

;[15] Routine for printing /FILE:ELEVEN files.
;No special formatting of the data is done, even if a /MODE switch specified.
;	P4/ count of free bytes in the buffer
;	Returns FALSE if end of file
;	Returns TRUE if more to do

SNDELE:	CAIGE	P4,4			;Room for all four bytes?
	$RETT				;Nope, send this buffer
	$CALL	INPBYT			;Get a word of 4 bytes of data
	$RETIF				;End of file probably
	LDB	S1,[POINT 8,C,17]	;Get the first byte
	$CALL	PUTBYT			;Store first one
	LDB	S1,[POINT 8,C,9]	;Get second byte
	$CALL	PUTBYT			;Store second one
	LDB	S1,[POINT 8,C,35]	;Get third byte
	$CALL	PUTBYT			;Store third one
	LDB	S1,[POINT 8,C,27]	;Get fourth byte
	$CALL	PUTBYT			;Store fourth one
	SUBI	P4,4			;Count those four bytes
	JRST	SNDELE			;Loop for next word
	SUBTTL	Job Processing -- Send Files -- Send Data Messages -- Fortran Format

;[15] Routine for printing /FILE:FORTRAN files.  FCONV is set when the next
;character expected is a format control character we need to convert, set at
;beginning of the file and at each linefeed.  Linefeeds from the file are not
;transmitted, this is done when the next character (format control) is read.
;	P4/ count of free bytes in the buffer
;	Returns FALSE if end of file
;	Returns TRUE if more to do

SNDFOR:	TXNE	S,FCONV			;Is next character a Fortran ctl char?
	JRST	SNFO.2			;Yes, ok sir, that'll be fine sir

SNFO.1:	$CALL	INPBYT			;There is room, read a byte from file
	$RETIF				;False is end of file probably
	SKIPN	S1,C			;Copy the character to where we want it
	JRST	SNFO.1			;Null, throw it away
	CAIN	S1,.CHLFD		;Line feed?
	TXOA	S,FCONV			;Don't send, next char is translated
	$CALL	SNDBYT			;Send character and count it from P4
	JUMPG	P4,SNDFOR		;Loop for more characters if room
	$RETT				;Return to transmit this buffer

;Here when the next character is to be interpreted as a Fortran forms
;character.  Check if there is room in the buffer for any possible translated
;string.  Convert to a forms motion character and transmit the appropriate
;character sequence.  Then return to above loop for more characters.

SNFO.2:	CAIGE	P4,4			;Insure room in buffer for translation
	$RETT				;No room, send this buffer along please
	TXZ	S,FCONV			;Looks like we will convert this one
SNFO.3:	$CALL	INPBYT			;Get the next byte please
	$RETIF				;Return if end of file
	JUMPE	C,SNFO.3		;Get another one if a null seen

	MOVSI	S2,-FTNTSZ		;Load size of that table
SNFO.4:	LDB	S1,[Point 7,FTNTAB(S2),6] ;Get character from translation table
	CAIE	S1,(C)			;Does it match character from file?
	AOBJN	S2,SNFO.4		;Nope, loop
					;No match will get the linefeed at end
	TXNE	S,SUPFIL!SUPJOB		;Suppressing forms motion?
	SETZ	S2,			;Yes, use entry for single space 
	MOVE	T1,[Point 7,FTNTAB(S2),6] ;Load pointer to data characters
SNFO.5:	ILDB	S1,T1			;Get a translated character
	JUMPE	S1,SNDFOR		;If at end, we can loop for next char
	$CALL	PUTBYT			;Store that character
	SOJA	P4,SNFO.5		;Loop for more

;[15] Table of translation characters.  The first character is the character to
;translate, and the rest of the characters in that word are the characters to
;translate to.  Obviously you can only have up to three characters translation.
;It is also not clear what the remote DJM's symbiont will do with things like
;vertical tab, control-P, and DC1-DC4 (control-Q, control-R, control-S, and
;control-T) but we faithfully translate them like LPTSPL does.  Single space
;must be first entry in table (for suppress check above and it is the most
;common translation character).

FTNTAB:	BYTE(7)	" ",.CHLFD		;Space means single space
	BYTE(7)	"0",.CHLFD,.CHLFD	;Zero means double space
	BYTE(7)	"1",.CHFFD		;One means go to channel 1
	BYTE(7)	"2",.CHCNP		;Two means skip 1/2 page (channel 2)
	BYTE(7)	"3",.CHVTB		;Three means skip 1/3 page (channel 3)
	BYTE(7)	"/",.CHCNT		;Slash means skip 1/6 page 
	BYTE(7)	"*",.CHCNS		;Star means suppress skip over perf
	BYTE(7)	"+",.CHCRT		;Plus means overprint
	BYTE(7)	",",.CHCNQ		;Comma means doublespace
	BYTE(7)	"-",.CHLFD,.CHLFD,.CHLFD ;Hyphen means triple line feed
	BYTE(7)	".",.CHCNR		;Dot means skip 3 lines 
	BYTE(7) 000,.CHLFD		;Anything else means same as space
	FTNTSZ==.-FTNTAB		;Size of this table
	SUBTTL	Job Processing -- Send Files -- Send Data Messages -- Octal Mode

;[15] Routine for printing /MODE:OCTAL.  We will print OCTWPL octal words per
;line, OCTLPB words per block, OCTBPP blocks per page.
;
;ACs:	P1/ block per page
;	P2/ lines per block
;	P3/ words per line
;	P4/ count of free bytes in the buffer
;Returns FALSE if end of file
;Returns TRUE if more to do

SNDOCT:	$SAVE	<P1,P2,P3>		;Get some space to work with
	DMOVE	P1,SAVBPP		;Load saved blocks/page and lines/block
	MOVE	P3,SAVWPL		; and word per line counters
	JUMPN	P1,SNDO.4		;Enter to do next line or reload cntrs

SNDO.1:	MOVEI	P1,OCTBPP		;Here to start a new page
SNDO.2:	MOVEI	P2,OCTLPB		;Here to start a new block 
SNDO.3:	MOVEI	P3,OCTWPL		;Here to start new line
SNDO.4:	CAIGE	P4,3+^D12+2+2+2+1	;Here to start new line, enough space?
	JRST	SNDO.7			;Nope

	MOVEI	S1," "			;Here to start new word, 
	$CALL	SNDBYT			; begin with one
	$CALL	SNDBYT			;  two
	$CALL	SNDBYT			;   three blanks
	$CALL	INPBYT			;Get a word from the file into C
	$RETIF				;Done if end of file

	MOVEI	T4,^D12			;Digits per word
	MOVE	T3,[POINT 3,C]		;Load byte pointer to the word
SNDO.5:	ILDB	S1,T3			;For each digit, get next digit
	MOVEI	S1,"0"(S1)		;Asciify that digit
	$CALL	SNDBYT			;Output that digit
	SOJG	T4,SNDO.5		;Loop for all 12 digits

	SOJG	P3,SNDO.4		;Loop for all of words on that line
	$CALL	SNDCRL			;End of line, output CRLF

	SOJG	P2,SNDO.3		;Loop for all lines in that block
	$CALL	SNDCRL			;End of block, output
	$CALL	SNDCRL			; two extra CRLFs to seperate block

	SOJG	P1,SNDO.2		;Loop for all blocks on this page
	MOVEI	S1,.CHFFD		;We have output blocks per page, so we 
	$CALL	SNDBYT			; need a form feed next
	JRST	SNDO.1			;Print next page
;Here when we need to transmit a buffer, save the blocks per page and lines per
;block output so far.

SNDO.7:	DMOVEM	P1,SAVBPP		;Save blocks/page and lines/block
	MOVEM	P3,SAVWPL		; and word per line counters
	$RETT				;Return now for transmission

;Local routine to send a CRLF along.

SNDCRL:	MOVEI	S1,.CHCRT		;Load a carriage return
	$CALL	SNDBYT			; output that character
	MOVEI	S1,.CHLFD		;Load a linefeed
					;Fall thru to SNDBYT

;Local routine to count down P4 by one and send a character.

SNDBYT:	SOJA	P4,PUTBYT		;Output byte and return
	SUBTTL	Job Processing -- Send Files -- Send Data Messages -- Suppress/Arrow Modes

;[15] Slow ASCII print loop.  This loop used only with /FILE:ASCII and either
;/MODE:ARROW or /MODE:SUPPRESS or operator's SUPPRESS command.  If /MODE:ASCII
;we use the fast ASCII loop.  Check for two character positions available since
;(almost) any control character can turn into a two character sequence.
;	P4/ count of free bytes in the buffer
;	Returns FALSE if end of file
;	Returns TRUE if more to do

SNDSLO:	CAIGE	P4,2			;Room for uparrow and character?
	$RETT				;Time to send it
	$CALL	INPBYT			;Read a byte
	$RETIF				;False is end of file probably
	SKIPN	S1,C			;Copy the character
	JRST	SNDSLO			;Null, throw it away
	CAIL	S1," "			;Is it a nonprintable char?
	JRST	SNDS.N			;Nope, no translation, go for it
	JRST	@CCTAB(S1)		;Dispatch based on character type

;Here for suppression of char if suppress mode, no translation if arrow mode.
;NEWLIN flag will be set to one if we have just printed forms motion char.

SNDS.S:	TXNN	S,SUPFIL!SUPJOB		;Suppress mode?
	JRST	SNDS.N			;Nope, no suppression please
	TXOE	S,NEWLIN		;Just has forms motion character?
	JRST	SNDSLO			;Yes, suppress this one
	MOVEI	S1,.CHCRT		;Suppressing forms motion, send return
	$CALL	PUTBYT			; out there followed by 
	MOVEI	S1,.CHLFD		;  line feed so all printers work ok
	$CALL	PUTBYT			;   but no more than one CRLF in a row
	SUBI	P4,2			;Count two characters loaded in buffer
	JRST	SNDSLO			; and continue in slow ascii loop

;Here for translation of the character into uparrow followed by 100+character.
	
SNDS.A:	MOVEI	S1,"^"			;Load uparrow character
	$CALL	PUTBYT			;(S1/) Output that uparrow
	MOVEI	S1,"@"(C)		;Make control character printable now
	SOJA	P4,SNDS.N		;Count uparrow, print printable version

;Here for no translation of the character.

SNDS.N:	$CALL	PUTBYT			;(S1/) Stuff the byte
	TXZ	S,NEWLIN		;Something now printed on this line
	SOJA	P4,SNDSLO		;Loop for the rest we can do
;[15] Table for slow ASCII print loop.
;	SNDS.A - Outputs uparrow-character if arrow or suppress mode
;	SNDS.N - Never translated to anything
;	SNDS.S - Outputs one CRLF if suppress mode, no translation if arrow

CCTAB:	EXP	SNDS.A			;(00) Null (Control-@)
	EXP	SNDS.A			;(01) Control-A
	EXP	SNDS.A			;(02) Control-B
	EXP	SNDS.A			;(03) Control-C
	EXP	SNDS.A			;(04) Control-D
	EXP	SNDS.A			;(05) Control-E
	EXP	SNDS.A			;(06) Control-F
	EXP	SNDS.A			;(07) Control-G
	EXP	SNDS.A			;(10) Control-H
	EXP	SNDS.N			;(11) Horizontal Tab
	EXP	SNDS.S			;(12) Line Feed
	EXP	SNDS.S			;(13) Vertical Tab (skips 1/3 page)
	EXP	SNDS.S			;(14) Form Feed
	EXP	SNDS.S			;(15) Carriage Return
	EXP	SNDS.A			;(16) Control-N
	EXP	SNDS.A			;(17) Control-O
	EXP	SNDS.S			;(20) Control-P (skips 1/2 page)
	EXP	SNDS.S			;(21) DC1 (skips 2 lines)
	EXP	SNDS.S			;(22) DC2 (skips 3 lines)
	EXP	SNDS.S			;(23) DC3 (skips 1 line no matter what)
	EXP	SNDS.S			;(24) DC4 (skips 1/6 page)
	EXP	SNDS.A			;(25) Control-U
	EXP	SNDS.A			;(26) Control-V
	EXP	SNDS.A			;(27) Control-W
	EXP	SNDS.A			;(30) Control-X
	EXP	SNDS.A			;(31) Control-Y
	EXP	SNDS.A			;(32) Control-Z
	EXP	SNDS.A			;(33) Escape (Control-[)
	EXP	SNDS.A			;(34) Control-\
	EXP	SNDS.A			;(35) Control-]
	EXP	SNDS.A			;(36) Control-^
	EXP	SNDS.A			;(37) Control-_
	SUBTTL	Job Processing -- Send Files -- Send End Of File Message

;Here after file is copied to send end of file message

SNDEOF:	$CALL	DJMOBJ			;Has the DJM objected to something?
	$RETIF				;Return if badness
	MOVX	S1,.MTEOF		;Type = end of file
	$CALL	SETMSG			;Set up message header
	$CALL	FINMSG			;Finish up message (no body)
	$CALL	DQSSND			;[4] Send it
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] Check objections and return
	SUBTTL	Job Processing -- Send EOR

;Here after all the files have been sent, send the END (COMMIT) message
;Returns TRUE or FALSE

SEOR:	MOVX	S1,.MTEOR		;Type = end of record
	$CALL	SETMSG			;Set up message header
	$CALL	DQSSND			;[4] Send it
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] Check objections and return
	SUBTTL	Job Processing -- Receive Summary message

;Here to try to read an expected summary message from DJM.
;Return TRUE if so.
;Return FALSE with error text stored.

RSUMMA:	$CALL	DQSWAT			;Wait for input from remote
	$RETIF				;Return if none or timeout

;Check message coming back for summary response.

	LDB	S1,P.ITYP		;Get message type
	CAIN	S1,.MTSUM		;Summary message?
	JRST	RSUM.1			;Yes, it went OK!

;Check message coming back from DJM.

	$CALL	UNPERR			;Unpack the error message
	$RETF				;Return owie

;Might want to propagate remote request (job) number to queuer?

RSUM.1:	$RETT				;Return OK
	SUBTTL	Job Processing -- Send Commit Message

;Here to send the commit message.
;Returns TRUE or FALSE.

SCOMMI:	$DSCHD(0)			;Scheduling pass (to get any IPCF)
	TXNE	S,RQB!ABORT		;Withdraw or commit?
	SKIPA	S1,[.MTWIT]		;Withdraw
	MOVX	S1,.MTCOM		;Type = commit
	$CALL	SETMSG			;Set up message header
	$CALL	FINMSG			;Finish up message (no body)
	$CALL	DQSSND			;[4] Send it
	$RETIF				;[4] Return if owie
	JRST	DJMOBJ			;[4] Check objections and return
	SUBTTL	Job Processing -- Receive End Message	

;Here to read an expected END message from DJM.  Return TRUE if so.
;Return FALSE with error text stored.

REND:	$CALL	DQSWAT			;Wait for some data
	$RETIF				;Return if problem

;We have a message is it what we expect?

	LDB	S1,P.ITYP		;Get message type
	CAIN	S1,.MTEND		;End message?
	$RETT				;Return OK

;Message had an error

	$CALL	UNPERR			;Unpack error
	$RETF				;Return owie
	SUBTTL	Job Processing -- Error Recovery -- Restart Job

;Here to restart the job in progress, call with J$ERRA(J) setup.  We know that
;if we abort the link now we will be all set in terms of (1) DQS protocol
;errors from stopping in odd places while transmitting and (2) problems around
;the time we are sending summary/commit messages.  It seems the safest (read:
;reliable) thing to just abort the link now and finish cleanly.  Next time we
;want to use the link we will reopen it.

RSTMSG:	$CALL	ABTLNK			;[10] Avoid confusion with DQS or us
	TXNE	S,RQB!ABORT		;Abort or requeue by operator?
	JRST	RSTM.3			;Yes, get out now

;[10] Count this as a retry.  See if we just dropped the ball and if so, abort
;current link and try this job again.

	AOS	S1,RETRYC		;[10] Count this is as a retry
	HRRZ	S2,J$LSTS(J)		;[10] Get the disconnect code
	CAIN	S2,.DCX0		;[10] Reject or disconnect by object?
	CAILE	S1,RTYMAX		;[10] Should we try again now?
	JRST	RSTM.2			;[10] Nope, "object not available"
	JRST	DQSJ1			;[10] Yes, retry this job

;[10] Transmission errors, respose to setup message to QUASAR who will
;reschedule us in a little bit, routines in LPTSPL will close the input file.

RSTM.2:	$WTO	(<Transmission Error>,<^R/.EQJBB(J)/^M^J^T/@J$ERRA(J)/>,@JOBOBA) ;[11]
	$TEXT	(LOGCHR,<^I/LPMSG/Transmission error   ^T/@J$ERRA(J)/>) ;[11]
	MOVEI	S1,%RSUNA		;[10] Not available right now
	$CALL	RSETUP			;[10] Tell QUASAR
	PJRST	SHUTIN			;[10] Shut us down please (abort link)

;[10] Here when operator aborted this request.

RSTM.3:	SETZM	J$RNFP(J)		;Back to first file for requeue
	SKIPE	S1,J$ERRA(J)		;What kind of error today?
	MOVEI	S1,[ASCIZ/DQS LPTSPL internal error - No error string set up/]
	MOVEM	S1,J$ERRA(J)		;Store final error address
	$CALL	INPCLS			;[4] Close input file if any
	PJRST	ENDJOB			;Requeue it
	SUBTTL	Job Processing -- Error Recovery -- Check DJB Objections

;Routine to see if the DJM is objecting.
;Check to see if it sent something back, probably an error message.
;Return TRUE if all is OK
;Return FALSE if not with J$ERRA(J) set up

DJMOBJ:	TXNE	S,RQB!ABORT		;Aborting?
	JRST	DJMO.3			;[5] Yes
	$CALL	DQSREC			;Get something back
	$RETIF				;Return if link broken

	SKIPN	IBCNT			;Was there anything there?
	$RETT				;No, return not owie

;Unpack the DJM's error message into text and send it out for all to see.

	$CALL	UNPERR			;Unpack the error message
	$RETF				;Return owie but requeue the job

;Here if RQB or ABORT lit

DJMO.3:	MOVEI	S1,[ASCIZ/Requeue by operator/]	;[5] Indicate what happened
	MOVEM	S1,J$ERRA(J)		;[5] Save that please
	$RETF				;[5] Return owie to abort job
	SUBTTL	Job Processing -- Error Recovery -- Unpack DQS Error 

;Call with IBUFF/ response from DJM (after reading any message that is)
;Returns with J$ERRA(J) set to address of error text

UNPERR:	$SAVE 	<P1>			;Free up P1
	SETZM	ERRBEG			;Zero out the 
	MOVE	S1,[ERRBEG,,ERRBEG+1]	; error areas as we call them
	BLT	S1,ERREND		;  many or few its all the same
	LDB	S1,P.ITYP		;Get the message type
	CAXN	S1,.MTERR		;Error message?
	JRST	UNPE.0			;No, protocol error

;Here if not error message, assume DQS protocol error

	MOVEI	S2,.ELINF		;[5] Get error level
	MOVEM	S2,ERRLVL		;[5] Protocol error is requeue
	$TEXT	(<-1,,ERRBUF>,<DQS protocol error, packet type ^D/S1/, length ^D/IBSLT/^0>) ;[5] 

;Here to return our error buffer address in S1, text in ERRBUF

UNPE.4:	SKIPN	ERRBUF			;Did we write anything there?
	$TEXT	(<-1,,ERRBUF>,<DQS error packet without error string, packet length ^D/IBSLT/^0>) ;[5] 
	MOVEI	S1,ERRBUF		;Point to my error buffer

UNPE.5:	MOVEM	S1,J$ERRA(J)		;Save it in the error address please
	$RET				;Return

;It was an error message, get all of the relevent parts out of it

UNPE.0:	$CALL	GETBYT			;Skip type
	$CALL	GETBYT			;Skip flags
	$CALL	GETBYT			;Skip context
	$CALL	GETBYT			;Get block count
	MOVE	P1,S1			;Save block count
	$CALL	GETWRD			;Get message length in S1
	MOVE	T2,IBSLT		;Get the saved last total byte count
	SUBI	T2,.HDSIZ		;See if buffer size less header size
	CAMN	S1,T2			;  equals the length of the packet
	JRST	UNPE.1			;Yes, unpack the message
	MOVEI	S1,[ASCIZ/Length error in DQS error packet/]
	JRST	UNPE.5			;Store that error and return

	;Continued on next page
	;Continued from previous page

;Remove the blocks from the message and store them.

UNPE.1:	SOJL	P1,UNPE.4		;Done if no more blocks
	$CALL	GETBYT			;Get the block type
	MOVE	T1,S1			;Save it
	$CALL	GETBYT			;Skip flags
	$CALL	GETBYT			;Get length
	MOVE	T2,S1			;Save it

;See if we're interested in this block type, and store the data
;temporarily if so.  Otherwise just skip this block.

	MOVSI	S1,-ERRTBL		;Length of table
UNPE.2:	HLRZ	S2,ERRTAB(S1)		;Get a block type
	CAME	S2,T1			;Match the one we have?
	AOBJN	S1,UNPE.2		;No, loop
	JUMPGE	S1,UNPE.3		;If no match, just skip the block
	HRRZ	S1,ERRTAB(S1)		;Get the processing routine
	$CALL	(S1)			;Call it
	JRST	UNPE.1			;Loop

UNPE.3:	SOJL	T2,UNPE.1		;Done when all bytes processed
	$CALL	GETBYT			;Get a byte
	JRST	UNPE.3			;Deja vu' time

	;Continued on next page
	;Continued from previous page

;Table of error codes and what to do with them

ERRTAB:	XWD	.BTEEL,LVL		;Error level
	XWD	.BTEEC,CLS		;Error class
	XWD	.BTECD,COD		;Error code
	XWD	.BTETX,TXT		;Error text
	ERRTBL==.-ERRTAB		;Length of this table

;Here on error level, class, or code

LVL:	$CALL	GETITM			;Get it
	MOVEM	S1,ERRLVL		;Save it
	$RETT				;Return

CLS:	$CALL	GETITM			;Get it
	MOVEM	S1,ERRCLS		;Save it
	$RETT				;Return

COD:	$CALL	GETITM			;Get it
	MOVEM	S1,ERRCOD		;Save it
	$RETT				;Return

;Here on error text

TXT:	MOVEI	S1,ERRBUF		;Point at where it goes
	PJRST	GETSTG			;Get it
	SUBTTL	Message Packing Routines -- Setup/Finish Message

;SETMSG - set up message header.
;Call:
;	S1/ message type
;Writes message type, flags (0), context(0), blocks(0 now), 
;low order length(0), high order length(0)

SETMSG:	SETZM	BLKCNT			;No blocks in this message yet
	$CALL	PUTBYT			;Insert the type
	SETZ	S1,			;Get a zero
	$CALL	PUTBYT			;No flags
;	MOVE	S1,.JQOBJ+OBJ.UN(J)	;Sender's context (?)
	$CALL	PUTBYT			;Slam dunk sender's context
	$CALL	PUTBYT			;No blocks yet
	$CALL	PUTBYT			;No low order size yet
	JRST	PUTBYT			;No high order size either

;FINMSG - finish a message
;Returns: always, message ready for transmission

FINMSG:	MOVX	S1,BFSBYT		;Get buffer size
	SUB	S1,OBCNT		;Subtract amount free to get length
	SUBI	S1,.HDSIZ		;Length doesn't include header
	DPB	S1,P.OLNL		;Store low byte of length
	LSH	S1,-^D8			;Shift off the low byte
	DPB	S1,P.OLNH		;Store high byte of length
	MOVE	S1,BLKCNT		;Get number of blocks
	DPB	S1,P.OBLK		;Store in message
	$RET				;Return
	SUBTTL	Message Packing Routines -- Put a Byte or Word

;G$PBYT - Put a byte
;Call:
;	S1/ block type
;	S2/ data item
;	outputs block type, 0, 1, data byte

G$PBYT:	AOS	BLKCNT			;Count another block
	$CALL	PUTBYT			;Store the block type
	SETZ	S1,			;Get a zero
	$CALL	PUTBYT			;Store high order length byte
	MOVEI	S1,1			;Length
	$CALL	PUTBYT			;Store low order length byte
	MOVE	S1,S2			;Data item
	PJRST	PUTBYT			;Store it and return
	SUBTTL	Message Packing Routines -- Put a Word or Longword

;G$PWRD - Put a word (2 bytes)
;Call:
;	S1/ block type
;	S2/ data item

G$PWRD:	AOS	BLKCNT			;Count another block
	$CALL	PUTBYT			;Store the block type
	SETZ	S1,			;Get a zero
	$CALL	PUTBYT			;Store high order length byte
	MOVEI	S1,2			;Length
	$CALL	PUTBYT			;Store low order length byte
	MOVE	S1,S2			;Copy the word to store
	$CALL	PUTBYT			;Store low order byte of word
	LSH	S1,-^D8			;Shift over high order byte
	PJRST	PUTBYT			;Store it and return

;G$PLWD - Put a longword (4 bytes)
;Call:
;	S1/ block type
;	S2/ data item

G$PLWD:	AOS	BLKCNT			;Count another block
	$CALL	PUTBYT			;Store the block type
	SETZ	S1,			;Get a zero
	$CALL	PUTBYT			;Store high order length byte
	MOVEI	S1,4			;Length
	$CALL	PUTBYT			;Store low order length byte
	MOVE	S1,S2			;Copy long word
	$CALL	PUTBYT			;Store low order byte
	LSH	S1,-^D8			;Shift next byte into position
	$CALL	PUTBYT			;Store it
	LSH	S1,-^D8			;Shift next byte into position
	$CALL	PUTBYT			;Store it
	LSH	S1,-^D8			;Shift high order byte into position
	PJRST	PUTBYT			;Store it and return
	SUBTTL	Message Packing Routines -- Put a String 

;G$PTMP - Put the string from TMPBUF
;G$PSTG - Put a string
;G$PSUC - Put a raised string
;Call:
;	S1/ block type
;	S2/ pointer to ASCIZ string
;	Stores block type, hi length, low length, characters

G$PTMP:	MOVEI	S2,TMPBUF		;Point to the temp buffer
G$PSTG:	TDZA	TF,TF			;Skip always
G$PSUC:	SETO	TF,			;We want to uppercase here
	$SAVE	<P1,P2,P3>		;Save an AC
	MOVE	P3,TF			;Load the uppercasify flag
	AOS	BLKCNT			;Count another block
	$CALL	PUTBYT			;Store the block type from S1
	MOVE	P1,OBPTR		;Save pointer to length byte
	$CALL	PUTBYT			;Store length of zero temporarily
	$CALL	PUTBYT			; in those two bytes
	MOVE	P2,OBCNT		;Load the current count
	TLNN	S2,-1			;Is there a pointer?
	HRLI	S2,(POINT 7)		;No, assume regular ascii

PSTG.1:	ILDB	S1,S2			;Get a byte
	JUMPE	S1,PSTG.2		;Jump if end
	JUMPE	P3,PSTG.3		;Jump of not raising
	CAIL	S1,"a"			;Is it going
	CAILE	S1,"z"			; to be lowercase?
	CAIA				;Nope
	SUBI	S1,"a"-"A"		;Yes raise the character

PSTG.3:	$CALL	PUTBYT			;Store it
	JRST	PSTG.1			;Loop

PSTG.2:	SUB	P2,OBCNT		;Minus number left gives number stored
	MOVE	S1,P2			;Load count back to S1
	ROT	S1,-^D8			;Shift high byte over
	IDPB	S1,P1			;Store the high order length byte
	ROT	S1,^D8			;Shift low byte back
	IDPB	S1,P1			;Store the low order length byte
	$RET				;Return
	SUBTTL	Message Packing Routines -- Put a Counted String

;G$PCST - Put a counted string
;Call:
;	S1/ count,,block type
;	S2/ pointer

G$PCST:	$SAVE	<P1>			;Save an AC for later
	AOS	BLKCNT			;Count another block
	$CALL	PUTBYT			;Stuff the type
	HLRZS	S1			;Isolate length
	ROT	S1,-^D8			;Shift high byte over
	$CALL	PUTBYT			;Stuff it
	ROT	S1,^D8			;Shift low byte back
	$CALL	PUTBYT			;Stuff it
	MOVE	P1,S1			;Copy count to T1

G$PCS1:	ILDB	S1,S2			;Get a byte
	$CALL	PUTBYT			;Stuff it
	SOJG	P1,G$PCS1		;Loop as required
	$RET				;Return
	SUBTTL	Message Unpacking Routines -- Get a Word or Longword

;Get a word (byte swapped) from the input message

GETWRD:	STKVAR	<ABYTE>			;Place for a bite
	$CALL	GETBYT			;Get first byte (low order)
	MOVEM	S1,ABYTE		;Save it there
	$CALL	GETBYT			;Get second byte (high order)
	LSH	S1,^D8			;Position it
	IOR	S1,ABYTE		;Include low order
	$RET				;Return, its in S1

;Get a longword (swapped) from the input message

GETLWD:	STKVAR	<AWORD>			;Place to save a word
	$CALL	GETWRD			;Get first word (low order)
	MOVEM	S1,AWORD		;Save it
	$CALL	GETWRD			;Get second word (high order)
	LSH	S1,^D16			;Position it
	IOR	S1,AWORD		;Include low order word
	$RET				;Return
	SUBTTL	Message Unpacking Routines -- Get Variable Length Item

;Get a byte/word/longword (based on length in T2)

GETITM:	SETZ	S1,			;Assume no match
	CAIN	T2,1			;Single byte?
	MOVEI	S1,GETBYT		;Yes
	CAIN	T2,2			;Word?
	MOVEI	S1,GETWRD		;Yes
	CAIN	T2,4			;Longword?
	MOVEI	S1,GETLWD		;Yes
	JUMPN	S1,(S1)			;Do it
	$RET				; Or not
	SUBTTL	Message Unpacking Routines -- Get A String

;Get a string (length in T2) and store it in block pointed to by S1

GETSTG:	TLNN	S1,-1			;Pointer supplied?
	HRLI	S1,(POINT 7)		;Nope
	MOVE	T1,S1			;Save pointer
GETS.1:	SOJL	T2,.RETT		;When done
	$CALL	GETBYT			;Get a byte
	IDPB	S1,T1			;Store it
	JRST	GETS.1			;Loop
	SUBTTL	I/O Routines -- Load or Store a Byte

;PUTBYT - Call to put a byte to the output buffer
;Call S1/ byte to put
;Returns FALSE with if no more room for byte
;Returns TRUE with character stored otherwise.

PUTBYT:	SOSGE	OBCNT			;Room for this byte?
	$RETF				;Return false
	IDPB	S1,OBPTR		;Store it
	$RETT				;Return

;GETBYT - returns a byte of data in S1 from the buffer.
;Returns FALSE with S1/-1 if no more characters
;Returns TRUE with S1/character otherwise.

GETBYT:	SOSGE	S1,IBCNT		;Room for this byte?
	$RETF				;Nope
	ILDB	S1,IBPTR		;Get it
	$RETT				;Return
	SUBTTL	I/O Routines -- Send Data

;Here to send data out to the DJM.
;Returns TRUE of ok, FALSE if not

DQSSND:	MOVX	T1,BFSBYT		;Buffer size (in bytes)
	SUB	T1,OBCNT		;Less bytes left gets bytes used
	ADDM	T1,J$APRT(J)		;Count bytes transmitted

;[5] Write message to log file for debugging

IFN FTPT,<				;[5] 
	SKIPN	PTRACE			;[5] Debugging?
	JRST	DQSS.1			;[5] No
	$TEXT	(LOGCHR,<^I/LPMSG/Sending (length ^D/T1/)^A>) ;[5] 
	MOVE	S2,T1			;[5] Copy count to S2
	MOVE	T2,[Point 8,OBUFF]	;[5] Load pointer to string
DQSS.0:	ILDB	S1,T2			;[5] Load a character
	$TEXT	(LOGCHR,< ^D/S1/^A>)	;[5] Output character
	SOJG	S2,DQSS.0		;[5] Loop for all characters
	$TEXT	(LOGCHR,<>)		;[5] Output crlf
>					;[5] End of FTPT

;[5] Send message, length is in T1.

DQSS.1:	MOVN	T1,T1			;[5] Make -ive bytes
	MOVE	S1,J$LCHN(J)		;Load the JFN
	MOVE	S2,[Point 8,OBUFF]	;Point to the buffer
	SOUTR%				;Send the message
	 ERJMP	DQSS.2			;[5] Owie if failure
					;Fall through to DQSOBS

;Here to setup output buffers for transmission
;Returns TRUE always

DQSOBS:	MOVX	S1,BFSBYT		;Initialize output byte count
	MOVEM	S1,OBCNT		;Store it there
	MOVE	S1,[Point 8,OBUFF]	;Reload the output buffer pointer
	MOVEM	S1,OBPTR		;Store the pointer
	$RETT				;Return OK

;[5] Here if error on the SOUTR, return an error for later.

DQSS.2:	$CALL	DQSOBS			;[5] Reset the buffer for next send
	$CALL	DQSCHK			;[5] Check and report on link status
	$RETF				;[5] Return owie
	SUBTTL	I/O Routines -- Receive Data

;Here to read data from the DJM.
;Returns TRUE if ok, OBCNT is nonzero if there was a message.
;Returns FALSE if link status not OK or the SINR failed.

DQSREC:	$CALL	DQSCHK			;Get link status
	$RETIF				;Punt if link owie
	SETZM	IBCNT			;Zero count of characters
	TXNN	T1,MO%EOM		;Message to read today?
	$RETT				;Return OK

;Read whatever is available

DQSR.1:	MOVE	S1,J$LCHN(J)		;Load the JFN
	SIBE%				;Skip input buffer empty
	 SKIPA	T2,S2			;Load byte count to T1
	$RETT				;Return if nothing there
	CAILE	T2,BFSBYT		;Can we read it?
	MOVEI	T2,BFSBYT		;No, load max buffer size (in bytes)
	MOVN	T1,T2			;Read just that many bytes
	MOVE	S2,[Point 8,IBUFF]	;Point to the buffer
	MOVEM	S2,IBPTR		;Save as pointer to buffer
	SINR%				;Get the message
	 ERJMP	DQSR.7			;[5] Failure, indicate that please
	MOVEM	T2,IBCNT		;Return the number of bytes read
	MOVEM	T2,IBSLT		;Save last total byte count

	;Continued on next page
	;Continued from previous page

;[5] Here to put protocol trace in the log file

IFN FTPT,<				;[5] 
	SKIPN	PTRACE			;[5] Debugging?
	$RETT				;Return OK
	$TEXT	(LOGCHR,<^I/LPMSG/Received (length ^D/T2/)^A>) ;[5] 
	MOVE	S2,[Point 8,OBUFF]	;[5] Load pointer to string
	JUMPE	T2,DQSR.4		;[5] Jump if no bytes to print
DQSR.3:	ILDB	S1,S2			;[5] Load a character
	$TEXT	(LOGCHR,< ^D/S1/^A>)	;[5] Output character
	SOJG	T2,DQSR.3		;[5] Loop for all characters
DQSR.4:	$TEXT	(LOGCHR,<>)		;[5] Output crlf
>					;[5] End of IFN FTPT
	$RETT				;[5] Return OK

;[5] Here if the SINR failed

DQSR.7:	MOVEM	T2,IBCNT		;[5] Return the number of bytes read
	MOVEM	T2,IBSLT		;[5] Save last total byte count
	CALL	DQSCHK			;[5] Get proper error returned
	$RETF				;[5] Return bad
	SUBTTL	I/O Routines -- Wait for Data

;This is the routine to call if you want to wait for data
;Returns TRUE if data recieved
;FALSE if no data or timeout or bad link, J$ERRA(J) set up

DQSWAT:	$SAVE	<P1>			;Get an AC to loop on
	MOVEI	P1,DQSWTM		;Wait a maximum of this long 
	SETZM	IBCNT			;Zero count of characters

DQSW.1:	$CALL	DQSCHK			;Get link status
	$RETIF				;Punt if link owie
	TXNE	T1,MO%EOM		;Message to read today?
	JRST	DQSR.1			;Yes, read it 
	SOJLE	P1,DQSW.2		;Loop for all of it

	$DSCHD(0)			;Perform scheduling pass
	
	MOVEI	S1,1			;Sleep for a second
	$CALL	I%SLP			;ZZZ...
	JRST	DQSW.1			;Loop for more

;Here if timed out

DQSW.2:	MOVEI	S1,[ASCIZ/No message received from DJM/]
	MOVEM	S1,J$ERRA(J)		;Save that error
	$RETF				;Return owie
	SUBTTL	I/O Routines -- Check on Link Status

;Here to see if the DJM is telling us something we should know.
;Returns TRUE if ok, T1/ link status
;Returns FALSE if not, S1/ error address

DQSCHK:	MOVE	S1,J$LCHN(J)		;Load the JFN
	MOVEI	S2,.MORLS		;Read link status
	MTOPR%				;Get the status of the link
	 ERJMP	DQSCH3			;Owie if can't read link status
	MOVEM	T1,J$LSTS(J)		;Store link status and disconnect code

;See if anything on wire if OK status

	TXNN	T1,MO%CON!MO%WCC	;[4] Link is connected or waiting?
	JRST	DQSCH2			;[4] Nope its owie
	TXNE	T1,MO%CON		;[4] Link connected?
	SKIPE	PRTVER			;[4] Yes, read protocol yet?
	$RETT				;[4] Yes, just return OK

;[4] Link is open and we haven't read the optional DECnet data, read it

	MOVE	S1,J$LCHN(J)		;[4] Get JFN
	MOVEI	S2,.MORDA		;[4] Read data
	MOVE	T1,[Point 8,PRTVER]	;[4] Point to protocol version area
	MTOPR%				;[4] Get the optional data
	ERJMP	DQSCH3			;[4] Owie, check it and report it
	MOVE	T1,J$LSTS(J)		;[5] Get link status/disconnect code
	$RETT				;[4] Return OK, PRTVER updated

;Here if problem, close the link and return

DQSCH2:	$CALL	FNDCER			;Get the DECnet error causing this
	MOVEM	S1,J$ERRA(J)		;Store error reason
	$CALL	ABTLNK			;Close and release the JFN
	$RETF				;Return owie

;Here if we can't get status of link

DQSCH3:	$CALL	S%ERR			;Pick up error string address
	SKIPT				;Unable to pick up error string adr?
	MOVEI	S1,[ASCIZ/Fatal error detected in checking DECnet link/]
	MOVEM	S1,J$ERRA(J)		;Save the error text address
	$RETF				;Return error to caller
	SUBTTL	Report Log

;Here to report the runtime and so on and then return.

DQSLOG:	MOVE	T3,J$GINP(J)		;Get number of pages
	MOVE	T2,J			;Get offset into page storage area

DQSL.1:	MOVE	S1,J$GBUF(T2)		;Get the next buffer address
	$LOG	(DQS LPTSPL Log,<^T/@S1/>,@JOBOBA,$WTFLG(WT.NFO)) ;Log a buffer
	CAME	T2,J			;Skip if this is the pre-allocated page
	PUSHJ	P,M%RPAG		;No, release it
	SOJLE	T3,ENDREQ		;Decrement count, jump if done
	AOJA	T2,DQSL.1		;Loop if not done
	SUBTTL End of LPTDQS

	END

;;;Local modes:
;;;Mode: MACRO
;;;Comment begin: ";[15] "
;;;Comment column: 40
;;;End: