Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/qsrlpt.mac
There are no other files named qsrlpt.mac in the archive.
;XS:<5-GALAXY>QSRLPT.MAC.3, 23-Jan-87 14:00:37, Edit by KNIGHT
; Add junk for parsing and handling language types (like Postscript, Impress)
;SRC:<5-GALAXY>QSRLPT.MAC.2, 15-Aug-86 11:00:12, Edit by KNIGHT
;Add P%FSPL
;SRC:<5-GALAXY>QSRLPT.MAC.1, 22-Jul-86 10:44:14, Edit by KNIGHT
; Configure this for the NIC
	TITLE QSRLPT

	SEARCH GLXMAC		;Search GALAXY library
	PROLOGUE(QSRLPT)	;Standard prologue
	SEARCH QSRMAC,ORNMAC	;Search QUASAR and ORION definitions

	PARSET			;Define the parser externals

;Define a macro to do the parsing for a single unit number

DEFINE	$UNIT(NEXT,%UNI01),<
	.XCREF	%UNI01
	SUPPRESS %UNI01
%UNI01:	$NUMBER	(NEXT,^D10,,<$ACTION(CHKVAL)>)
>

DEFINE KEYDSP(NXT,KEY,CODE,FLAGS),<
	DSPTAB(NXT,.LP'CODE,KEY,FLAGS)
>;END KEYDSP

DEFINE SWIDSP(NXT,SWITCH,CODE,FLAGS),<
	DSPTAB(NXT,.ES'CODE,SWITCH,FLAGS)
>;END ORNSWI
SUBTTL	Parse definitions
;Keyword definitions

DEFINE KEYWORD,<
	X	FORM,FRM
	X	IMPRESS,IMP
	X	NO,NOP		;;F1 Don't shift
	X	PAPER,PAP
	X	PDE,PDE
	X	POSTSCRIPT,POS
	X	PRINTER,PRT
	X	STYLE,STY
	X	YES,YUP		;;F1 Do shift
>

;Now define the X macro to generate the needed symbols

DEFINE X(A,B),<
	IF1,<IFDEF .LP'B,< PRINTX ?Duplicate keyword code -- .LP'B>>
	.LP'B==..Z
	..Z==..Z+1
>

;Initialize the counter and call KEYWORD to generate the symbols

	..Z==0
	KEYWORD

;Define switch values

DEFINE SWITCH,<
	X	ALCNT,ALC
	X	ALIGN,ALI
	X	ALSLP,ALS
	X	BANNER,BAN	;;F22 
	X	CHAIN,CHA
	X	DRUM,DRU
	X	FILE-TYPE,TYP
	X	FONTS,FNT
;F22	X	FORMS,FRM  ;;F22 This is a keyword, not a switch
	X	HEADER,HEA
	X	LANPDE,LPG
	X	LINDEX,LIX
	X	LINES,LIN
	X	LLINE,LLN
	X	LWIDTH,LWD
	X	NODE,NOD
	X	NOTE,NOT
	X	PHASE,PHA
	X	PORPDE,PPG
	X	PINDEX,PIX
	X	PLINE,PLN
	X	PRTNAM,PNM
	X	PWIDTH,PWD
	X	PROGRAM,PRG	 ;F1 Used for printer program name mapping
	X	RAM,RAM
	X	RIBBON,RIB
	X	SHIFT,SFT	;;F1 User for default shift information
	X	SIZE,SIZ
	X	SYMMETRIC,SYM	;;F1 Whether paper needs to be turned in duplex
	X	TAPE,TAP
	X	TRAILER,TRA
	X	UNIT-NUMBER,UNI
	X	VFU,VFU
	X	WIDTH,WID
>

;Define the X macro to generate the needed symbols

DEFINE X(A,B),<
	IF1,<IFDEF .ES'B,< PRINTX ?Duplicate keyword code -- .ES'B>>
	.ES'B==..Z
	..Z==..Z+1
>

;Generate the symbols for switches

	..Z==400000
	SWITCH
SUBTTL	Parse tables

;Main dispatch table

LPTPAR:	$INIT (LPFORM)

LPFORM:	$KEYDSP(TYPTAB)

TYPTAB:	$STAB
	KEYDSP(FRMFDB,FORM,FRM)		
	KEYDSP(PAPFDB,PAPER,PAP)
	KEYDSP(PDEFDB,PDE,PDE)	
	KEYDSP(LPTFDB,PRINTER,PRT)
	KEYDSP(STYFDB,STYLE,STY)
	$ETAB
;Process a STYLE entry

STYFDB:	$FIELD(STYSWI)		;Get STYLE name

STYSWI:	$SWITCH(,STYABL,<$ALTER(CONFRM)>)

STYABL:	$STAB
	 SWIDSP(STY001,<LANPDE:>,LPG)
	 SWIDSP(STY002,<LINDEX:>,LIX)
	 SWIDSP(STY002,<LLINE:>,LIN)
	 SWIDSP(STY002,<LWIDTH:>,LWD)
	 SWIDSP(STY002,<PINDEX:>,PIX)
	 SWIDSP(STY002,<PLINE:>,PLN)
	 SWIDSP(STY001,<PORPDE:>,PPG)
	 SWIDSP(STY001,<PRTNAM:>,PNM)
	 SWIDSP(STY002,<PWIDTH:>,PWD)
	 $ETAB

STY001:	$FIELD(STYSWI)		;Parse PDE or device name

STY002:	$NUMBER(STYSWI,^D10)	;Parse switch value
;Process a FORMS entry

FRMFDB:	$FIELD(FRMSWI)		;Get FORM name

FRMSWI:	$SWITCH(,FRMTBL,<$ALTER(CONFRM)>)

FRMTBL:	$STAB
	 SWIDSP(FRM002,<ALCNT:>,ALC)
	 SWIDSP(FRM001,<ALIGN:>,ALI)
	 SWIDSP(FRM002,<ALSLP:>,ALS)
	 SWIDSP(FRM002,<BANNER:>,BAN) ;F22 Parse for number afterwards
	 SWIDSP(FRM001,<CHAIN:>,CHA)
	 SWIDSP(FRM001,<DRUM:>,DRU)
	 SWIDSP(FRM002,<HEADER:>,HEA)
	 SWIDSP(FRM002,<LINES:>,LIN)
	 SWIDSP(FRM003,<NOTE:>,NOT)
	 SWIDSP(FRM002,<PHASE:>,PHA)
	 SWIDSP(FRM001,<PRTNAM:>,PNM)
	 SWIDSP(FRM001,<RAM:>,RAM)
	 SWIDSP(FRM001,<RIBBON:>,RIB)
	 SWIDSP(FRM002,<SIZE:>,SIZ)	;F1 obscurity in GLXSCN...
	 SWIDSP(FRM001,<TAPE:>,TAP)
	 SWIDSP(FRM002,<TRAILER:>,TRA)
	 SWIDSP(FRM001,<VFU:>,VFU)
	 SWIDSP(FRM002,<WIDTH:>,WID)
	$ETAB

FRM001:	$FIELD(FRMSWI)		;Get a name

FRM002:	$NUMBER(FRMSWI,^D10)	;Parse switch value

FRM003:	$QUOTE(FRMSWI)		;Get QUOTED string
;Process a PAPER entry

PAPFDB:	$FIELD(PAPSWI)		;Get PAPER name

PAPSWI:	$SWITCH(,PAPTBL,<$ALTER(CONFRM)>)

PAPTBL:	$STAB
	 SWIDSP(PAP001,<PRTNAM:>,PNM)	 ;F1 Printer that this will be used on
	 SWIDSP(PAP002,<SHIFT:>,SFT)	 ;F1 Get default image shift info
	 SWIDSP(PAP006,<SYMMETRIC:>,SYM) ;F1 Get symmetric characteristic
	$ETAB

PAP001:	$FIELD(PAPSWI)			 ;F1 Get printer name and more switches

PAP002:	$KEYDSP(PAPKEY,<$ALTERNATE(PAP003)>) ;F1 Parse yes/no OR shift amount

PAPKEY:	$STAB				;F1 So we can use XEROX default values
	 KEYDSP(PAPSWI,<NO>,NOP)	;F1 Says don't do anything
	 KEYDSP(PAPSWI,<YES>,YUP)	;F1 Says use the XEROX's default
	$ETAB

     Remark If we don't like default XEROX shifting, we can set the amount

PAP003:	$NUMBER(PAP004,^D10)		;F1 Pick up front part

PAP004:	$COMMA(PAP005)			;F1 Comma and back part

PAP005:	$NUMBER(PAPSWI,^D10)		;F1 Offset for back, get more switches

PAP006:	$KEYDSP(PAPKEY)			;F1 Pick up either yes or no
;Process a PRINTER entry

LPTFDB:	$FIELD(LPTSWI)		;Get PRINTER name

LPTSWI:	$SWITCH(,LPTABL,<$ALTER(CONFRM)>)

LPTABL:	$STAB
	 SWIDSP(LPT004,<FILE-TYPE:>,TYP)
	 SWIDSP(LPT001,<NODE:>,NOD)
	 SWIDSP(LPT003,<PROGRAM:>,PRG)		;F1 Use specific program
	 SWIDSP(LPT002,<UNIT-NUMBER:>,UNI)
	$ETAB

LPT001:	$FIELD(LPTSWI)		;Get device or node name

LPT002:	$UNIT(LPTSWI)

LPT003:	$FIELD(LPTSWI)			;F1 Pick up a sixbit program name

LPT004:	$KEYDSP(LPTKEY)			;F1 Pick up either yes or no

LPTKEY: $STAB
	 KEYDSP(LPTSWI,<IMPRESS>,IMP)	;Understands ImPress
	 KEYDSP(LPTSWI,<POSTSCRIPT>,POS) ;Understands PostScript
	$ETAB
;Process a PDE entry

PDEFDB:	$FIELD(PDESWI)		;Get PDE name

PDESWI:	$SWITCH(,PDETBL,<$ALTER(CONFRM)>)

PDETBL:	$STAB
	 SWIDSP(PDE001,<FONTS:>,FNT)
	 SWIDSP(PDE002,<PRTNAM:>,PNM)
	 SWIDSP(PDE001,<SIZE:>,SIZ)
	$ETAB

PDE001:	$NUMBER(PDESWI,^D10)

PDE002:	$FIELD(PDESWI)

;For confirmation of an entry

CONFRM:	$CRLF
SUBTTL	Impure data storage

FILJFN:	BLOCK	1		;Save area for file JFN
PKTJFN:	BLOCK	1		;Save the printer keyword table JFN
PRTNAM:	BLOCK	1		;Printer name to which this applies
LOCAL:	BLOCK	1		;Local NODE name
PRTLST:	BLOCK	1		;Pointer to printer list
PARBLK:	BLOCK	PAR.SZ		;Space for parser call arguments
PARPAG:	BLOCK	1		;Place to parse in
PKTPAG:	BLOCK	1		;Page for printer keyword tables
PRTBLK:	BLOCK	PP.SIZ		;Values from a parsed PRINTER entry
STYBLK:	BLOCK	ST.SIZ		;Values from a parsed STYLE entry
FRMBLK:	BLOCK	FF.SIZ		;Values from a parsed FORM entry
PAPBLK:	BLOCK	PA.SIZ		;Values from a parsed PAPER block
PDEBLK:	BLOCK	PD.SIZ		;Values from a parsed PDE entry
INIPRT:	$BUILD (PP.SIZ)		;Initial values for a PRINTER entry
	  $SET (PP.UNI,,0)	;The default unit number
	  $SET (PP.PAP,,-1)	;Pointer to PAPER list
	  $SET (PP.STY,,-1)	;Pointer to STYLE list
	  $SET (PP.FRM,,-1)	;Pointer to FORM list
	  $SET (PP.PDE,,-1)	;Pointer to PDE list
	  $SET (PP.PRG,,'LPTSPL') ;F1 Default to LPTSPL
	$EOB 			;End of block

INISTY:	$BUILD (ST.SIZ)		;Size of initial STYLE block
	  $SET (ST.PPG,,0)	;Name of portrait PDE
	  $SET (ST.LPG,,0)	;Name of landscape PDE
	  $SET (ST.PGI,ST.PIX,1) ;Index for portrait printing
	  $SET (ST.PGI,ST.LIX,1) ;Index for landscape printing
	  $SET (ST.LEN,ST.PWD,^D85) ;Number of characters on portrait line
	  $SET (ST.LEN,ST.LWD,^D132) ;Number of characters on landscape line
	  $SET (ST.LEN,ST.PLN,^D60) ;Number of lines on portrait page
	  $SET (ST.LEN,ST.LLN,^D60) ;Number of lines on landscape page
	$EOB

INIFRM:	$BUILD (FF.SIZ)		;Size of default FORM block
	  $SET (FF.ALI,,0)	;No default name
	  $SET (FF.AWD,FF.ALC,5) ;Print five times
	  $SET (FF.AWD,FF.ALS,7) ;Sleep seven seconds
	  $SET (FF.BAN,,-1)	;F22 Default for print BANNERS from GALCNF
	  $SET (FF.HEA,,-1)	;F22 Default for print HEADERS from GALCNF
	  $SET (FF.TRA,,-1)	;F22 Default for print TRAILERS from GALCNF
	  $SET (FF.RAM,,-1)	;Default RAM
	  $SET (FF.MEM,,0)	;Use none of XEROX memory
	  $SET (FF.LEN,FF.WID,^D132) ;Characters on one line
	  $SET (FF.LEN,FF.LIN,^D60) ;Lines on one page
	  $SET (FF.PHA,,-1)	;Default for parity pages
	$EOB			;End of FORM block
	
INIPAP:	$BUILD (PA.SIZ)		;Default size of a PAPER block
	 $SET (PA.SFT,,0)	;F1 Default to non shifted image
	 $SET (PA.SYM,,0)	;F1 Paper default is asymmetric
	$EOB			;End of default block 

INIPDE:	$BUILD (PD.SIZ)		;Size of PDE block
	 $SET (PD.FNT,,0)	;Number of FONTS stored in this PDE
REPEAT 0,<$SET (PD.MEM,,XRXMEM)	;Size of PDE in bits of FONT>;REPEAT 0
	$EOB			;End of default PDE block

;F23 File descriptor for the LPFORM.INI file
;
FormFD:	Xwd FormFl,0		;F23 Count of words following
	Asciz \SYSTEM:LPFORM.INI\ ;F23 The actual file
	FormFl==.-FormFD	;F23 Compute the FD size
ERRORB:	0			;F23 Address of returned parser block
LINE:	0			;F23 Line of error in QSRLPT
SUBTTL Miscellaneous internal routines

;Routine to search a dispatch table for a value
;
;Call with:	S1/ Value to search for
;		S2/ Address of dispatch table
;
;Returns true:	S1/ Address of routine to dispatch to
;
;Returns false:	Value not found

FNDDSP:	MOVN T1,0(S2)		;Get negative of count of table entries
	HRL S2,T1		;Make an AOBJN word for searching table

FNDD.1:	HLRZ T2,1(S2)		;Fetch a value
	CAMN T2,S1		;Is this the one we want?
	JRST [	HRRZ S1,1(S2)	;Yes--get the dispatch address
		$RETT]		;Return it
	AOBJN S2,FNDD.1		;Search the whole table
	$RETF			;Return failure if not found

;Routine to decrement byte pointer in T1

DBP:	SOS	T1
	IBP	T1
	IBP	T1
	IBP	T1
	IBP	T1
	$RETT

FIXIT:	HRRZ	T4,CR.FLG(S2)	;Get adr of cmdblk
	MOVE	T1,.CMPTR(T4)	;Get command pointer
	MOVE	T2,.CMABP(T4)	;Get bp to atom buffer
FIXI.1:	ILDB	T3,T2
	JUMPE	T3,FIXI.2	;Done.. all fixed up
	PUSHJ	P,DBP		;Decrement the bp
	AOS	.CMCNT(T4)
	JRST	FIXI.1		;Try next character
FIXI.2:	MOVEM	T1,.CMPTR(T4)	;Store adjusted bp
	POPJ	P,0

;Action routine called on $UNIT macro to handle negative unit
;number arguments.

CHKVAL:	SKIPL	CR.RES(S2)	;Check that number
	$RETT			;It's good
	$CALL	FIXIT		;Fix it up
	$RETF
;Global routines
;
	INTERN	P%FUNI

;Routine to search for a given printer entry by unit number
;
;Call with:	S1/ Node name
;		S2/ Unit number to search for
;
;Returns true:	S2/ Pointer to printer entry
;
;Returns false:	Value not found
;
P%FUNI:	$CALL	.SAVE2		;Save P1 and P2
	DMOVE	P1,S1		;Load parameters
	SKIPGE	S1,PRTLST	;Does a list exist?
	$RETF			;No,,return false
	SKIPN	P1		;Node name provided?
	MOVE	P1,LOCAL	;Default to local node name
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFUNI1:	CAME	P1,PP.NOD(S2)	;Correct NODE?
	JRST	PFUNI2		;No,,look at next entry
	CAMN	P2,PP.UNI(S2)	;Is it this printer?
	$RETT			;Yes,,return true
	MOVE	S1,PRTLST	;Get pointer to printer list
PFUNI2:	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFUNI1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given printer entry by its name
;
;Call with:	S1/ Printer name to search for
;
;Returns true:	S2/ Pointer to printer entry
;
;Returns false:	Value not found
;

	INTERN	P%FNAM

P%FNAM:	$CALL	.SAVE1		;Save P1 
	MOVE	P1,S1		;Load parameters
	SKIPGE	S1,PRTLST	;Does a list exist?
	$RETF			;No,,return false
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFNAM1:	CAMN	P1,PP.NAM(S2)	;Is it this printer?
	$RETT			;Yes,,return true
	MOVE	S1,PRTLST	;Get pointer to printer list
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFNAM1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given printer entry by its spooler
;
;Call with:	S1/ Spooler name to search for
;
;Returns true:	S2/ Pointer to printer entry
;
;Returns false:	Value not found
;

	INTERN	P%FSPL

P%FSPL:	$CALL	.SAVE1		;Save P1 
	MOVE	P1,S1		;Load parameters
	SKIPGE	S1,PRTLST	;Does a list exist?
	$RETF			;No,,return false
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFSPL1:	CAMN	P1,PP.PRG(S2)	;Is it this printer?
	$RETT			;Yes,,return true
	MOVE	S1,PRTLST	;Get pointer to printer list
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFSPL1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given printer entry by file attribute
;
;Call with:	S1/ Attribute to search for
;
;Returns true:	S2/ Pointer to printer entry
;
;Returns false:	Value not found
;

	INTERN	P%FTYP

P%FTYP:	$CALL	.SAVE1		;Save P1 
	MOVE	P1,S1		;Load parameters
	SKIPGE	S1,PRTLST	;Does a list exist?
	$RETF			;No,,return false
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFTYP1:	CAMN	P1,PP.ATT(S2)	;Is it this printer?
	$RETT			;Yes,,return true
	MOVE	S1,PRTLST	;Get pointer to printer list
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFTYP1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given form entry given a specified printer block
;
;Call with:	S1/ Printer entry
;		S2/ FORM name
;
;Returns true:	S2/ Pointer to FORM entry
;
;Returns false:	Value not found
;
	INTERN P%FFRM

P%FFRM:	$SAVE	<P1,P2>		;Save P1 and P2
	MOVE	P1,S2		;Save the FORM name
	SKIPGE	S1,PP.FRM(S1)	;Does a list exist?
	$RETF			;No,,return false
	MOVE	P2,S1		;Save pointer to FORM list
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFFRM1:	CAMN	P1,FF.NAM(S2)	;Is it this FORM
	$RETT			;Yes,,return true
	MOVE	S1,P2		;Restore pointer
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFFRM1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given style entry given a specified printer block
;
;Call with:	S1/ Printer entry
;		S2/ STYLE name
;
;Returns true:	S2/ Pointer to STYLE entry
;
;Returns false:	Value not found
;
	INTERN P%FSTY

P%FSTY:	$SAVE	<P1,P2>		;Save P1 and P2
	MOVE	P1,S2		;Save the FONT name
	SKIPGE	S1,PP.STY(S1)	;Does a list exist?
	$RETF			;No,,return false
	MOVE	P2,S1		;Save pointer to STYLE list
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFSTY1:	CAMN	P1,ST.NAM(S2)	;Is it this STYLE
	$RETT			;Yes,,return true
	MOVE	S1,P2		;Restore pointer
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFSTY1		;Check the next entry
	$RETF			;Return false

;Routine to search for a given PDE entry given a specified printer block
;
;Call with:	S1/ Printer entry
;		S2/ PDE name
;
;Returns true:	S2/ Pointer to PDE entry
;
;Returns false:	Value not found
;
	INTERN P%FPDE

P%FPDE:	$SAVE	<P1,P2>		;Save P1 and P2
	MOVE	P1,S2		;Save the PDE name
	SKIPGE	S1,PP.PDE(S1)	;Does a list exist?
	$RETF			;No,,return false
	MOVE	P2,S1		;Save pointer to PDE list
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFPDE1:	CAMN	P1,PD.NAM(S2)	;Is it this one??
	$RETT			;Yes,,return true
	MOVE	S1,P2		;Restore pointer
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFPDE1		;Check the next entry
	$RETF			;Return false
;Routine to search for a given PAPER entry given a specified printer block
;
;Call with:	S1/ Printer entry
;		S2/ PAPER name
;
;Returns true:	S2/ Pointer to PAPER entry
;
;Returns false:	Value not found
;
	INTERN P%FPAP

P%FPAP:	$SAVE	<P1,P2>		;Save P1 and P2
	MOVE	P1,S2		;Save the PAPER name
	SKIPGE	S1,PP.PAP(S1)	;Does a list exist?
	$RETF			;No,,return false
	MOVE	P2,S1		;Save pointer to paper list
	$CALL	L%FIRST		;Position to the first entry
	$RETIF			;Empty list??
PFPAP1:	CAMN	P1,PA.NAM(S2)	;Is it this one?
	$RETT			;Yes,,return true
	MOVE	S1,P2		;Restore pointer
	$CALL	L%NEXT		;Go on to the next entry
	JUMPT	PFPAP1		;Check the next entry
	$RETF			;Return false
SUBTTL	P%LPOU - Destroy the LPFORM.INI linked list

	INTERN P%LPOU

P%LPOU:	$SAVE	<P1>		;Save P1 around the call
	SKIPGE	S1,PRTLST	;Has the list been built?
	$RETT			;No, return true
	$CALL	L%FIRST		;Position to the first entry
	JUMPF [	SETOM PRTLST	;Indicate that no list is there
		$RETT]		;Return true value
PLPOU1:	MOVE	P1,S2		;Save the list entry
	SKIPL	S1,PP.FRM(P1)	;Is there a FORM list?
	$CALL	L%DLST		;Delete the list
	SKIPL	S1,PP.STY(P1)	;Is there a STYLE entry?
	$CALL	L%DLST		;Delete the list
	SKIPL	S1,PP.PDE(P1)	;Is there a PDE entry?
	$CALL	L%DLST		;Delete the list
	SKIPL	S1,PP.PAP(P1)	;Is there a PAPER list?
	$CALL	L%DLST		;Yes, delete the list
	MOVE	S1,PRTLST	;Get the main list address
	$CALL	L%NEXT		;Go to the next printer
	JUMPT	PLPOU1		;Finish off all lists
	MOVE	S1,PRTLST	;Get the main list address
	$CALL	L%DLST		;Delete that too
	SETOM	PRTLST		;Indicate that the list is gone
	$RETT			;Return to caller
SUBTTL	P%BPKT - Build a new PRINTER-KEYWORD-TABLES.BIN file
	
	INTERN	P%BPKT

P%BPKT:	$CALL	.SAVE2		;Save P1 and P2
	SKIPGE	PRTLST		;Has the list been built ?
	$RETF			;No, return error
	MOVEI	S1,2		;Need two pages
	$CALL	M%AQNP		;A page each for the keyword tables and strings
	PG2ADR	S1		;Make an address
	MOVE	P1,S1		;Save the address for easy indexing
	MOVEM	S1,PKTPAG	;Save the address of the keyword tables
	MOVEI	P2,PAGSIZ(S1)	;And the address of the keyword strings
;
;Build the printer name table first
;
	MOVEI	S1,.MXOFF(P1)	;Get the address of the first table
	MOVEM	S1,.UTOFF(P1)	;Save the unit name address
	MOVE	S1,PRTLST	;Get the printer list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.E		;Error, release space and return error
P%BP.0:	MOVEI	S1,2(P2)	;Point to the sixbit version after the ascii
	MOVE	S2,PP.NAM(S2)	;Get the name of the printer
	MOVEM	S2,(S1)		;And save it there
	HRLI	S1,(POINT 6,)	;Make a sixbit pointer
	MOVE	S2,P2		;Get the current keyword string pointer
	HRLI	S2,(POINT 7,)	;Make a byte pointer
	$CALL	SIXASC		;Convert to ascii
	MOVE	S1,.UTOFF(P1)	;Get the address of the unit name table
	MOVE	S2,P2		;Get the ascii string pointer
	$CALL	S%TBLK		;Look up the entry
	TXNE	S2,TL%EXM	;If an exact match ?
	JRST	P%BP.1		;Yes, don't need to add it then
	MOVE	S1,.UTOFF(P1)	;Get the address of the unit name table
	HRRZ	S2,(S1)		;Get the number of entries now
	ADDI	S2,1		;Make room for one more
	HRRM	S2,(S1)		;And put the maximum back
	HRLZ	S2,P2		;Get the address of the ascii string
	HRRI	S2,2(P2)	;And the address of the sixbit string
	$CALL	S%TBAD		;Add the keyword to the table
	ADDI	P2,3		;Move the next string pointer
P%BP.1:	MOVE	S1,PRTLST	;Point to the printer list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP.0		;And loop
;
;Build the paper type table next
;
	HRRZ	S1,@.UTOFF(P1)	;Get the number of entries in previous table
	ADD	S1,.UTOFF(P1)	;Add in the address of the previous table
	ADDI	S1,1		;Add in the header of previous table
	MOVEM	S1,.PTOFF(P1)	;Save the paper type address
	MOVE	S1,PRTLST	;Get the printer list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.E		;Error, release space and return error
P%BP.2:	SKIPGE	S1,PP.PAP(S2)	;Does a list exist ?
	JRST	P%BP.5		;No, next printer
	MOVE	P3,S1		;Save pointer to paper list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.5		;Empty list
P%BP.3:	MOVEI	S1,2(P2)	;Point to the sixbit version after the ascii
	MOVE	S2,PA.NAM(S2)	;Get the name of the paper
	MOVEM	S2,(S1)		;And save it there
	HRLI	S1,(POINT 6,)	;Make a sixbit pointer
	MOVE	S2,P2		;Get the current keyword string pointer
	HRLI	S2,(POINT 7,)	;Make a byte pointer
	$CALL	SIXASC		;Convert to ascii
	MOVE	S1,.PTOFF(P1)	;Get the address of the paper name table
	MOVE	S2,P2		;Get the ascii string pointer
	$CALL	S%TBLK		;Look up the entry
	TXNE	S2,TL%EXM	;If an exact match ?
	JRST	P%BP.4		;Yes, don't need to add it then
	MOVE	S1,.PTOFF(P1)	;Get the address of the paper name table
	HRRZ	S2,(S1)		;Get the number of entries now
	ADDI	S2,1		;Make room for one more
	HRRM	S2,(S1)		;And put the maximum back
	HRLZ	S2,P2		;Get the address of the ascii string
	HRRI	S2,2(P2)	;And the address of the sixbit string
	$CALL	S%TBAD		;Add the keyword to the table
	ADDI	P2,3		;Move the next string pointer
P%BP.4:	MOVE	S1,P3		;Point to the paper list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP.3		;And loop
P%BP.5:	MOVE	S1,PRTLST	;Point to the printer list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP.2		;And loop
;
;Build the forms type table next
;
	HRRZ	S1,@.PTOFF(P1)	;Get the number of entries in previous table
	ADD	S1,.PTOFF(P1)	;Add in the address of the previous table
	ADDI	S1,1		;Add in the header of previous table
	MOVEM	S1,.FTOFF(P1)	;Save the forms type address
	MOVE	S1,PRTLST	;Get the printer list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.E		;Error, release space and return error
P%BP.6:	SKIPGE	S1,PP.FRM(S2)	;Does a list exist ?
	JRST	P%BP.9		;No, next printer
	MOVE	P3,S1		;Save pointer to forms list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.9		;Empty list
P%BP.7:	MOVEI	S1,2(P2)	;Point to the sixbit version after the ascii
	MOVE	S2,FF.NAM(S2)	;Get the name of the forms
	MOVEM	S2,(S1)		;And save it there
	HRLI	S1,(POINT 6,)	;Make a sixbit pointer
	MOVE	S2,P2		;Get the current keyword string pointer
	HRLI	S2,(POINT 7,)	;Make a byte pointer
	$CALL	SIXASC		;Convert to ascii
	MOVE	S1,.FTOFF(P1)	;Get the address of the forms name table
	MOVE	S2,P2		;Get the ascii string pointer
	$CALL	S%TBLK		;Look up the entry
	TXNE	S2,TL%EXM	;If an exact match ?
	JRST	P%BP.8		;Yes, don't need to add it then
	MOVE	S1,.FTOFF(P1)	;Get the address of the forms name table
	HRRZ	S2,(S1)		;Get the number of entries now
	ADDI	S2,1		;Make room for one more
	HRRM	S2,(S1)		;And put the maximum back
	HRLZ	S2,P2		;Get the address of the ascii string
	HRRI	S2,2(P2)	;And the address of the sixbit string
	$CALL	S%TBAD		;Add the keyword to the table
	ADDI	P2,3		;Move the next string pointer
P%BP.8:	MOVE	S1,P3		;Point to the forms list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP.7		;And loop
P%BP.9:	MOVE	S1,PRTLST	;Point to the printer list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP.6		;And loop
;
;Build the style table last
;
	HRRZ	S1,@.FTOFF(P1)	;Get the number of entries in previous table
	ADD	S1,.FTOFF(P1)	;Add in the address of the previous table
	ADDI	S1,1		;Add in the header of previous table
	MOVEM	S1,.STOFF(P1)	;Save the style types address
	MOVE	S1,PRTLST	;Get the printer list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP.E		;Error, release space and return error
P%BP10:	SKIPGE	S1,PP.STY(S2)	;Does a list exist ?
	JRST	P%BP13		;No, next printer
	MOVE	P3,S1		;Save pointer to styles list
	$CALL	L%FIRST		;Position to the first entry
	JUMPF	P%BP13		;Empty list
P%BP11:	MOVEI	S1,2(P2)	;Point to the sixbit version after the ascii
	MOVE	S2,ST.NAM(S2)	;Get the name of the style
	MOVEM	S2,(S1)		;And save it there
	HRLI	S1,(POINT 6,)	;Make a sixbit pointer
	MOVE	S2,P2		;Get the current keyword string pointer
	HRLI	S2,(POINT 7,)	;Make a byte pointer
	$CALL	SIXASC		;Convert to ascii
	MOVE	S1,.STOFF(P1)	;Get the address of the style name table
	MOVE	S2,P2		;Get the ascii string pointer
	$CALL	S%TBLK		;Look up the entry
	TXNE	S2,TL%EXM	;If an exact match ?
	JRST	P%BP12		;Yes, don't need to add it then
	MOVE	S1,.STOFF(P1)	;Get the address of the style name table
	HRRZ	S2,(S1)		;Get the number of entries now
	ADDI	S2,1		;Make room for one more
	HRRM	S2,(S1)		;And put the maximum back
	HRLZ	S2,P2		;Get the address of the ascii string
	HRRI	S2,2(P2)	;And the address of the sixbit string
	$CALL	S%TBAD		;Add the keyword to the table
	ADDI	P2,3		;Move the next string pointer
P%BP12:	MOVE	S1,P3		;Point to the style list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP11		;And loop
P%BP13:	MOVE	S1,PRTLST	;Point to the printer list
	$CALL	L%NEXT		;Get the next entry
	JUMPT	P%BP10		;And loop
	MOVN	S1,P1		;Get the address of the keyword table page
	MOVSI	S2,-4		;Fix up all table entries
	HRR	S2,P1		;From the beginning
	ADDM	S1,(S2)		;Fix up the offsets
	AOBJN	S2,.-1		;For all of the headers
	MOVSI	T2,-4		;Fix up all table entries
P%BP14:	HRRZ	S1,(S2)		;Get the size of the next table
	MOVNS	S1		;Negate the size
	HRL	S2,S1		;Move the count to the pointer
	ADDI	S2,1		;Move to the first entry
P%BP15:	HLRZ	S1,(S2)		;Get the ascii string address
	SUB	S1,P1		;Subtract the beginning
	HRLM	S1,(S2)		;And put it back
	HRRZ	S1,(S2)		;Get the sixbit string address
	SUB	S1,P1		;Subtract the beginning
	HRRM	S1,(S2)		;And put it back
	AOBJN	S2,P%BP15	;Do all of the table
	AOBJN	T2,P%BP14	;Do all four tables
	MOVX	S1,GJ%SHT!GJ%FOU
	HRROI	S2,[ASCIZ "SYSTEM:PRINTER-KEYWORD-TABLES.BIN"]
	GTJFN%
	$STOP	(PKG,Cannot GTJFN% for PKT file)
	HRRZS	S1
	MOVEM	S1,PKTJFN
	MOVX	S2,FLD(^D36,OF%BSZ)!OF%WR
	OPENF%
	$STOP	(PKO,Cannot OPENF% PKT file)
	HRLZ	S2,S1
	MOVE	S1,PKTPAG
	ADR2PG	S1
	HRLI	S1,.FHSLF
	MOVX	T1,PM%CNT!PM%WR!FLD(2,PM%RPT)
	PMAP%
	MOVE	S1,PKTJFN
	CLOSF%
	 ERJMP .+1
	MOVE	S1,PKTJFN
	RLJFN%
	 TRN
	MOVEI	S1,2		;Release two pages
	MOVE	S2,PKTPAG	;Get the address of the keyword tables
	ADR2PG	S2		;Make it a page number
	$CALL	M%RLNP		;Release them
	$RETT			;Return to caller

P%BP.E:	MOVEI	S1,2		;Release two pages
	MOVE	S2,PKTPAG	;Get the address of the keyword tables
	ADR2PG	S2		;Make it a page number
	$CALL	M%RLNP		;Release them
	$RETF			;Return false to caller

SIXASC:	MOVSI	T1,-6		;Six characters
SIXA.0:	ILDB	T2,S1		;Read a character
	SKIPE	T2		;If not zero
	ADDI	T2,"A"-'A'	;Convert to ascii
	IDPB	T2,S2		;And save the char
	AOBJN	T1,SIXA.0	;Loop for six chars
	$RETT			;Return to caller
SUBTTL	Main PARSE loop
SUBTTL	Main routine

	INTERN	P%LPIN

P%LPIN:	$CALL	.SAVE1		;Save P1
	SETOM	PRTLST		;No current print list
	SETZM	LINE		;F23 Nothing read in, yet
	$CALL	M%GPAG		;Get a page for command stuff
	MOVEM	S1,PARPAG	;Save the address
	$CALL	I%HOST		;Get local NODE name
	MOVEM	S1,LOCAL	;Local NODE name
	SETZB	S1,S2		;F23 Don't set up TIMER entry
	$CALL	P$INIT		;F23 Initialize the PARSER
	DMOVE	S1,[EXP FORMFD,0] ;F23 Address of LPFORM.INI file descriptor
	$CALL	P$TAKE##	;F23 Set up for a take file
	 JUMPF [$STOP (LPO,Cannot open LPFORM file: ^E[-1])] ;F23 DIE
	$CALL	COMAND		;F23 Finally get to a command
	MOVE	S1,PARPAG	;Get the page we used
	$CALL	M%RPAG		;Return it to the memory manager
	$RETT			;Return to caller
;
;F23 Parser for a command from the file
;
COMAND:	DMOVE S1,[LPTPAR ;PAR.TB ;F23 Address of main table
		  0]	 ;PAR.PM ;F23 Address of prompt string (none)
	DMOVEM	S1,PARBLK+PAR.TB ;F23 Init first two slots of parser block
	MOVE S1,PARPAG	 ;PAR.CM ;F23 Get address of the command message block
;	SETZ S2,	 ;PAR.SR ;F23 No source string (Allready ZERO)
	DMOVEM 	S1,PARBLK+PAR.CM ;F23 Init second half of parser block
;	MOVE	S1,PARPAG	 ;F23 address of comand page (allready there)
	MOVE	S2,S1		;Save it for the blt
	SETZM	(S2)		;Clear the first word
	HRL	S2,S2		;Construct the BLT pointer
	AOS	S2		;For a clear of memory
	BLT	S2,777(S1)	;Clear to the end
	MOVE	S2,[COM.SZ,,.OMCMD] ;F23 Size,,type of command header
	MOVEM	S2,.MSTYP(S1)	;F23 Save it
	AOS	LINE		;F23 Count up lines read
	DMOVE	S1,[EXP PAR.SZ,PARBLK]	;F23 Size,,address of the block
	$CALL	PARSER##	;Call the PARSER
	 JUMPF [MOVX S1,P.ENDT	;F23 Maybe end of Take (LPFORM.INI) file?
		TDNE S1,PRT.FL(S2) ;F23 Well, check for end of file
		 $RETT		;F23  Yes, it's ok to return
		MOVEI S1,@PRT.EM(S2) ;F23 Pick up address of error message
		JRST SAYOPR  ]	;F23 Complain of error
	MOVEM	S2,ERRORB	;F23 Save pointer to argument block
	MOVE	S1,PRT.CM(S2)	;Get address of command message block
	ADD	S1,COM.PB(S1)	;Add in the parser block offset
	$CALL	P$SETU		;Set up the parser
	$CALL	P$KEYW		;Try to parse a keyword
	JUMPF	ERROR		;F22 
	SETZM	PRTNAM		;No default printer
	MOVEI	S2,LPFTYP	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 complain if keyword not found
	JRST	0(S1)		;Dispatch to the command

LPFTYP:	$STAB			;
	.LPFRM,,.FORM		;FORM entry
	.LPPAP,,.PAPER		;PAPER entry
	.LPPDE,,.PDE		;PDE entry
	.LPPRT,,.PRT		;PRINTER entry
	.LPSTY,,.STYLE		;STYLE entry
	$ETAB			;
SUBTTL	Process a STYLE entry

.STYLE:	HRLI	S1,INISTY	;Construct BLT pointer (source)
	HRRI	S1,STYBLK	;Construct BLT pointer (destination)
	BLT	S1,STYBLK+ST.SIZ-1 ;Move the initial values
	$CALL	P$SIXF		;Get a 6 bit field type
	JUMPF	ERROR		;F22 Go complain
	MOVEM	S1,STYBLK+ST.NAM ;Save the STYLE name

STYPAR:	$CALL	P$SWIT		;Parse a switch
	JUMPF	STYEND		;Finish up with the STYLE block
	MOVEI	S2,STYYPE	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 Complain that keyword was not found
	JRST	0(S1)		;Dispatch to the command

STYYPE:	$STAB			;Dispatch for printer switches
	.ESLPG,,LANPDE
	.ESLIX,,LINDEX
	.ESLIN,,LLINE
	.ESLWD,,LWIDTH
	.ESPPG,,PORPDE
	.ESPIX,,PINDEX
	.ESPLN,,PLINE
	.ESPWD,,PWIDTH
	.ESPNM,,STYPNM		;UNIT switch
	$ETAB			;End of table
LANPDE:	$CALL	P$SIXF		;Get SIXBIT landscape PDE name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,STYBLK+ST.LPG ;Save the PDE name
	JRST	STYPAR		;Parse rest of the line
	
LINDEX:	$CALL	P$NUM		;Get the landscape PDE index
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.PGI,ST.LIX	;Save the index
	JRST	STYPAR		;Get the rest of the line

LLINE:	$CALL	P$NUM		;Get the landscape page length
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.LEN,ST.LLN	;Save the page length
	JRST	STYPAR		;Get the rest of the line

LWIDTH:	$CALL	P$NUM		;Get the landscape line width
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.LEN,ST.LWD	;Save the index
	JRST	STYPAR		;Get the rest of the line

PORPDE:	$CALL	P$SIXF		;Get SIXBIT portrait PDE name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,STYBLK+ST.PPG ;Save the PDE name
	JRST	STYPAR		;Get the rest of the switches
	
PINDEX:	$CALL	P$NUM		;Get the portrait PDE index
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.PGI,ST.PIX	;Save the index
	JRST	STYPAR		;Get the rest of the line

PLINE:	$CALL	P$NUM		;Get the portrait page length
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.LEN,ST.PLN	;Save the page length
	JRST	STYPAR		;Get the rest of the line

PWIDTH:	$CALL	P$NUM		;Get the portrait line width
	JUMPF	ERROR		;F22 Complain
	STORE	S1,STYBLK+ST.LEN,ST.PWD	;Save the index
	JRST	STYPAR		;Get the rest of the line

STYPNM:	$CALL	P$SIXF		;Get the printer name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTNAM	;Save the printer name
	JRST	STYPAR		;Go for other switches
;Done with parse - add to STYLE list of the requested printer

STYEND:	CAIE	S1,.CMCFM	;Was it a CONFIRM
	JRST	ERROR		;F22 Complain about it
	MOVE	S1,PRTNAM	;Get the printer name
	$CALL	P%FNAM		;Ask for the printer entry
	JUMPF	ERROR		;F22 Not defined printer
	MOVE	P1,S2		;Save the printer entry
	SKIPGE	S1,PP.STY(P1)	;Do we have a STYLE list
	JRST [	$CALL L%CLST	;No,,create one
		MOVEM S1,PP.STY(P1) ;Save the list name
		JRST .+1]	;Join common code
	MOVE	P1,S1		;Save the STYLE list address
	$CALL	L%LAST		;Position to the last entry
	MOVE	S1,P1		;Restore list pointer
	MOVEI	S2,ST.SIZ	;Load the length of an entry
	$CALL	L%CENT		;Create a new entry
	HRRI	S1,ST.SIZ-1(S2)	;Final word to store into
	HRLI	S2,STYBLK	;Source for a BLT pointer
	BLT	S2,(S1)		;Copy over the parsed block
	JRST	COMAND		;F23 Read the rest of the file
SUBTTL	Process a FORM entry

.FORM:	HRLI	S1,INIFRM	;Construct BLT pointer (source)
	HRRI	S1,FRMBLK	;Construct BLT pointer (destination)
	BLT	S1,FRMBLK+FF.SIZ-1 ;Move the initial values
	$CALL	P$SIXF		;Get a 6 bit field type
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.NAM ;Save the FORM name

FRMPAR:	$CALL	P$SWIT		;Parse a switch
	JUMPF	FRMEND		;Finish up with the FORM block
	MOVEI	S2,FRMTYP	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 No keyword found, complain
	JRST	0(S1)		;Dispatch to the command

FRMTYP:	$STAB
	.ESALC,,ALCOU
	.ESALI,,ALIGN
	.ESALS,,ALISLP
	.ESBAN,,BANNER		;F22 Dispatch to pick up banner sheets
	.ESCHA,,CHAIN
	.ESDRU,,DRUM
	.ESHEA,,HEAD
	.ESLIN,,LINES
	.ESNOT,,NOTE
	.ESPHA,,PHASE
	.ESRAM,,RAM
	.ESRIB,,RIBBON
	.ESSIZ,,FRMMEM
	.ESTAP,,TAPE
	.ESTRA,,TRAIL
	.ESPNM,,FFMPNM
	.ESVFU,,VFU
	.ESWID,,FRMWID
	$ETAB
ALCOU:	$CALL	P$NUM		;Get the count
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.AWD,FF.ALC ;Save the count
	JRST	FRMPAR		;Go for other switches

ALIGN:	$CALL	P$SIXF		;Parse SIXBIT align file name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.ALI ;Store the name
	JRST	FRMPAR		;Parse rest of the line

ALISLP:	$CALL	P$NUM		;Get the number of seconds
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.AWD,FF.ALS ;Save it
	JRST	FRMPAR		;Go for other switches

BANNER:	$CALL	P$NUM		;F22 Get flag word
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.BAN ;F22 Save it
	JRST	FRMPAR		;F22 Go for other switches

CHAIN:	$CALL	P$SIXF		;Parse SIXBIT chain name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.CHA ;Store the name
	JRST	FRMPAR		;Parse rest of the line

DRUM:	$CALL	P$SIXF		;Parse SIXBIT drum name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.DRU ;Store the name
	JRST	FRMPAR		;Parse rest of the line

HEAD:	$CALL	P$NUM		;Get flag word
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.HEA ;Save it
	JRST	FRMPAR		;Go for other switches

LINES:	$CALL	P$NUM		;Get page length
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.LEN,FF.LIN ;Save it
	JRST	FRMPAR		;Go for other switches

NOTE:	$CALL	P$QSTR		;Parse a quoted string for the note
	JUMPF	ERROR		;F22 Complain
	HRRI	S1,ARG.DA(S1)	;Get string address
	HRLI	S1,(POINT 7,)	;Form pointer
	MOVE	S2,[POINT 7,FRMBLK+FF.NOT] ;Point to the destination
NOTE1:	ILDB	T1,S1		;Get a byte
	JUMPE	T1,FRMPAR	;All done
	IDPB	T1,S2		;Put it where it belongs
	JRST	NOTE1		;Loop for all the bytes
PHASE:	$CALL	P$NUM		;Get the phase page indicator
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.PHA ;Save the value
	JRST	FRMPAR		;Go for other switches

RAM:	$CALL	P$SIXF		;Parse SIXBIT RAM name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.RAM ;Store the name
	JRST	FRMPAR		;Parse rest of the line

RIBBON:	$CALL	P$SIXF		;Parse SIXBIT ribbon name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.RIB ;Store the name
	JRST	FRMPAR		;Parse rest of the line

FRMMEM:	$CALL	P$NUM		;Get the size for XEROX memory
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.MEM ;Save the value
	JRST	FRMPAR		;Go for other switches

TRAIL:	$CALL	P$NUM		;Get flag word
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.TRA ;Save it
	JRST	FRMPAR		;Go for other switches

TAPE:	$CALL	P$SIXF		;Parse SIXBIT carriage-control tape
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.TAP ;Store the name
	JRST	FRMPAR		;Parse rest of the line

FFMPNM:	$CALL	P$SIXF		;Get the printer name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTNAM	;Save the printer name
	JRST	FRMPAR		;Go for other switches

VFU:	$CALL	P$SIXF		;Parse SIXBIT align file name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,FRMBLK+FF.VFU ;Store the name
	JRST	FRMPAR		;Parse rest of the line

FRMWID:	$CALL	P$NUM		;Get the number of characters on a line
	JUMPF	ERROR		;F22 Complain
	STORE	S1,FRMBLK+FF.LEN,FF.WID ;Save the unit number
	JRST	FRMPAR		;Go for other switches
;Insert the FORM entry

FRMEND:	CAIE	S1,.CMCFM	;Was it a CONFIRM
	JRST	ERROR		;F22 Complain
	MOVE	S1,PRTNAM	;Get the printer name
	$CALL	P%FNAM		;Ask for the printer entry
	JUMPF	ERROR		;F22 Complain, printer does not exist
	MOVE	P1,S2		;Save the printer entry
	SKIPGE	S1,PP.FRM(P1)	;Do we have a FORM list
	JRST [	$CALL L%CLST	;No,,create one
		MOVEM S1,PP.FRM(P1) ;Save the list name
		JRST .+1]	;Join common code
	MOVE	P1,S1		;Save the FORM list address
	$CALL	L%LAST		;Position to the last entry
	MOVE	S1,P1		;Restore list pointer
	MOVEI	S2,FF.SIZ	;Load the length of an entry
	$CALL	L%CENT		;Create a new entry
	HRRI	S1,FF.SIZ-1(S2)	;Final word to store into
	HRLI	S2,FRMBLK	;Source for a BLT pointer
	BLT	S2,(S1)		;Copy over the parsed block
	JRST	COMAND		;F23 Read the rest of the file
SUBTTL	Process a PAPER entry

.PAPER:	HRLI	S1,INIPAP	;Construct BLT pointer (source)
	HRRI	S1,PAPBLK	;Construct BLT pointer (destination)
	BLT	S1,PAPBLK+PA.SIZ-1 ;Move the initial values
	$CALL	P$SIXF		;Get a 6 bit field type
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PAPBLK+PA.NAM ;Save the paper name

PAPPAR:	$CALL	P$SWIT		;Parse a switch
	JUMPF	PAPEND		;Finish up with the paper block
	MOVEI	S2,PAPTYP	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 Complain that keyword was not found
	JRST	0(S1)		;Dispatch to the command

PAPTYP:	$STAB			;Valid switches for PAPER type
	.ESPNM,,PAPPNM		;Printer name
	.ESSFT,,PAPSFT		;F1 Shift index
	.ESSYM,,PAPSYM		;F1 Symmetric characteristic
	$ETAB			;End of table

PAPPNM:	$CALL	P$SIXF		;Get printer name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTNAM	;Save the printer name
	JRST	PAPPAR		;Parse the remainder of the block

;F1 Begin code addition for shift and symmetric stuff

PAPSFT:	$CALL	P$KEYW		;Maybe YES or NO typed?
	JUMPF	PAPNUM		;False means number was typed
	MOVEI	S2,SFTTYP	;Pointer to valid keywords for SHIFT
	$CALL	FNDDSP		;Try to find one.
	JUMPF	ERROR		;F22 Complain about this
	JRST	0(S1)		;Dispatch to the command

SFTTYP:	$STAB			;Valid keywords for SHIFT
	 .LPNOP,,NOPPAP		;No shift
	 .LPYUP,,YUPPAP		;Default shift
	$ETAB			;End of table

NOPPAP:	SETZM	PAPBLK+PA.SFT	;say no shifting
	JRST	PAPPAR		;Go parse some more things

YUPPAP:	SETOM	PAPBLK+PA.SFT	;say use default XEROX shifting
	JRST	PAPPAR		;Go parse some more things

	Remark Shift the image to be where we want it to be

PAPNUM:	$CALL	P$NUM		;Get a number
	JUMPF	ERROR		;F22 Complain about it
	STORE	S1,PAPBLK+PA.SFT,PA.FRT	;Stuff away as front shift
	$CALL	P$COMMA		;Parse seperator
	JUMPF	ERROR		;F22 Complain
	$CALL	P$NUM		;Get a number
	JUMPF	ERROR		;F22 Complain
	STORE	S1,PAPBLK+PA.SFT,PA.BAK	;Stuff away as back shift
	JRST	PAPPAR		;Go parse some more things

PAPSYM:	$CALL	P$KEYW		;Pick up the parsed keyword
	JUMPF	ERROR		;F22 Complain
	MOVEI	S2,SYMTYP	;Pointer to valid keywords for SYMMETRIC
	$CALL	FNDDSP		;Try to find one.
	JUMPF	ERROR		;F22 Complain
	JRST	0(S1)		;Dispatch to the command

SYMTYP:	$STAB			;Valid keywords for SYMMETRIC
	 .LPNOP,,NOPSYM		;Asymmetric
	 .LPYUP,,YUPSYM		;Symmetric
	$ETAB			;End of table

NOPSYM:	SETZM	PAPBLK+PA.SYM	;say asymmetric
	JRST	PAPPAR		;Go parse some more things

YUPSYM:	SETOM	PAPBLK+PA.SYM	;say symmetric
	JRST	PAPPAR		;Go parse some more things
;F1 End code addition
;Add to the list

PAPEND:	CAIE	S1,.CMCFM	;Was it a CONFIRM
	JRST	ERROR		;F22 Complain
	MOVE	S1,PRTNAM	;Get the printer name
	$CALL	P%FNAM		;Ask for the printer entry
	JUMPF	ERROR		;F22 Complain
	MOVE	P1,S2		;Save the printer entry
	SKIPGE	S1,PP.PAP(P1)	;Do we have a PAPER list
	JRST [	$CALL L%CLST	;No,,create one
		MOVEM S1,PP.PAP(P1) ;Save the list name
		JRST .+1]	;Join common code
	MOVE	P1,S1		;Save the PAPER list address
	$CALL	L%LAST		;Position to the last entry
	MOVE	S1,P1		;Restore list pointer
	MOVEI	S2,PA.SIZ	;Load the length of an entry
	$CALL	L%CENT		;Create a new entry
	HRRI	S1,PA.SIZ-1(S2)	;Final word to store into
	HRLI	S2,PAPBLK	;Source for a BLT pointer
	BLT	S2,(S1)		;Copy over the parsed block
	JRST	COMAND		;F23 Read the rest of the file
SUBTTL	Process a PDE entry

.PDE:	HRLI	S1,INIPDE	;Construct BLT pointer (source)
	HRRI	S1,PDEBLK	;Construct BLT pointer (destination)
	BLT	S1,PDEBLK+PD.SIZ-1 ;Move the initial values
	$CALL	P$SIXF		;Get a 6 bit field type
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PDEBLK+PD.NAM ;Save the PDE name

PDEPAR:	$CALL	P$SWIT		;Parse a switch
	JUMPF	PDEEND		;Finish up with the PDE block
	MOVEI	S2,PDETYP	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 Complain, keyword not found
	JRST	0(S1)		;Dispatch to the command

PDETYP:	$STAB			;Switches for a PDE entry
	.ESFNT,,PDEFNT		;FONTS switch
	.ESSIZ,,PDESIZ		;Size in FONT memory
	.ESPNM,,PDEPNM		;The printer to which this applies
	$ETAB			;End of the table

PDEFNT:	$CALL	P$NUM		;Get the number of FONTS
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PDEBLK+PD.FNT ;Save the fonts
	JRST	PDEPAR		;Continue with parse

PDESIZ:	$CALL	P$NUM		;Get the size in XEROX memory
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PDEBLK+PD.MEM ;Save the value
	JRST	PDEPAR		;Parse the rest of the line

PDEPNM:	$CALL	P$SIXF		;Get unit number
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTNAM	;Save the printer name
	JRST	PDEPAR		;Parse the remainder of the block

;Add the PDE to the list

PDEEND:	CAIE	S1,.CMCFM	;Was it a CONFIRM
	JRST	ERROR		;F22 Complain
	MOVE	S1,PRTNAM	;Get the printer name
	$CALL	P%FNAM		;Ask for the printer entry
	JUMPF	ERROR		;F22 Complain, printer not defined
	MOVE	P1,S2		;Save the printer entry
	SKIPGE	S1,PP.PDE(P1)	;Do we have a PDE list
	JRST [	$CALL L%CLST	;No,,create one
		MOVEM S1,PP.PDE(P1) ;Save the list name
		JRST .+1]	;Join common code
	MOVE	P1,S1		;Save the PDE list address
	$CALL	L%LAST		;Position to the last entry
	MOVE	S1,P1		;Restore list pointer
	MOVEI	S2,PD.SIZ	;Load the length of an entry
	$CALL	L%CENT		;Create a new entry
	HRRI	S1,PD.SIZ-1(S2)	;Final word to store into
	HRLI	S2,PDEBLK	;Source for a BLT pointer
	BLT	S2,(S1)		;Copy over the parsed block
	JRST	COMAND		;F23 Read the rest of the file
SUBTTL	Parse the entry for a printer

.PRT:	HRLI	S1,INIPRT	;Construct BLT pointer (source)
	HRRI	S1,PRTBLK	;Construct BLT pointer (destination)
	BLT	S1,PRTBLK+PP.SIZ-1 ;Move the initial values
	$CALL	P$SIXF		;Get a 6 bit field type
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTBLK+PP.NAM ;Save printer name
	MOVE	S1,LOCAL	;Get LOCAL node name
	MOVEM	S1,PRTBLK+PP.NOD ;Save as default NODE

PRTPAR:	$CALL	P$SWIT		;Parse a switch
	JUMPF	PRTEND		;Finish up with the print block
	MOVEI	S2,PRTYPE	;Get top level dispatch address
	$CALL	FNDDSP		;Dispatch to the proper keyword routine
	JUMPF	ERROR		;F22 Complain, keyword not found
	JRST	0(S1)		;Dispatch to the command

PRTYPE:	$STAB			;Dispatch for printer switches
	.ESTYP,,PRTTYP		;Language type
	.ESNOD,,PRTNOD		;NODE name
	.ESPRG,,PRTPRG		;F1 Printer Program Name
	.ESUNI,,PRTUNI		;UNIT-NUMBER switch
	$ETAB			;End of table

LTYPES:	$STAB			;Valid printer language keywords
	 .LPIMP,,.FPIMP		;Impress
	 .LPPOS,,.FPFPS		;Postscript
	$ETAB			;End of table

PRTTYP:	$CALL	P$KEYW		;Get a keyword
	JUMPF 	ERROR		;Lose, lose
	MOVEI 	S2,LTYPES	;Pointer to valid keywords
	$CALL 	FNDDSP
	JUMPF	ERROR
	MOVEM 	S1,PRTBLK+PP.ATT	;Save the language type
	JRST	PRTPAR

PRTUNI:	$CALL	P$NUM		;Get a unit number
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTBLK+PP.UNI ;Save the unit number
	JRST	PRTPAR		;Go for other switches

PRTNOD:	$CALL	P$SIXF		;Get SIXBIT node name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTBLK+PP.NOD ;Save the node name
	JRST	PRTPAR		;Go for other switches

PRTPRG:	$CALL	P$SIXF		;Get sixbit program name
	JUMPF	ERROR		;F22 Complain
	MOVEM	S1,PRTBLK+PP.PRG ;Save the program name
	JRST	PRTPAR		;Go for other switches

PRTEND:	CAIE	S1,.CMCFM	;Was it a CONFIRM
	JRST	ERROR		;F22 Complain
	SKIPGE	S1,PRTLST	;Do we have a printer list
	JRST [	$CALL L%CLST	;Create a list for it
		MOVEM S1,PRTLST ;Save the list name
		JRST .+1]	;Join common code
	$CALL	L%LAST		;Position to the last entry
	MOVE	S1,PRTLST	;Restore list pointer
	MOVEI	S2,PP.SIZ	;Load the length of an entry
	$CALL	L%CENT		;Create a new entry
	HRRI	S1,PP.SIZ-1(S2)	;Final word to store into
	HRLI	S2,PRTBLK	;Source for a BLT pointer
	BLT	S2,(S1)		;Copy over the parsed block
	JRST	COMAND		;F23 Read the rest of the file
	Subttl ERROR - Global error handler for QSRLPT, all [F22]

; We just do an $WTO of the input buffer.  This will type the line
; with the error in it to the operator so that a person will know 
; where to look when correcting the LPFORM.INI file.

ERROR:	MOVE	S1,ERRORB	;F23 get address of some kind of block
	MOVE	S2,PRT.CM(S1)	;F23 Address of message
	MOVE	S1,COM.CM(S2)	;F23 Get text offset
	ADDI	S1,1(S2)	;F23 Point to start of string

;F23 Finally ship the cruft off to Orion
;
;  The WTO flags mean: suppress job info, no dashes on output
;    suppress typeout of the object block and don't format
;
SAYOPR:	PUSH P,S1		;F23 Save our hard work!
	HRRZI S1,.FHSLF		;F23 This process
	GETER%			;F23 Get the last error
	 ERJMP [ SETZ S2,	;F23 Catch any further lossage
		 JRST .+1 ]	;F23 Join main line code
	POP P,S1		;F23 Restore our hard work!
	TLZ S2,-1		;F23 Keeps GLXTXT from getting confused
REPEAT 0,<
	$WTO (<**** LPFORM.INI parse error at line ^D/LINE/ ****>,
<^M^JLast GLXLIB error: ^E/[-1]/^M^JLast Tops-20 error: ^E/S2/^M^J^T/(S1)/>,
,$WTFLG(<WT.SJI!WT.NDA!WT.SOB!WT.NFO>))
>;REPEAT 0
	$WTO (<**** LPFORM.INI parse error at line ^D/LINE/ ****>,
<^M^JLast GLXLIB error: ^E/[-1]/^M^JLast Tops-20 error: ^E/S2/^M^J^T/(S1)/>,
,$WTFLG(<WT.SJI!WT.NDA!WT.NFO>))
	JRST	COMAND		;F23 Keep processing the file

	END