; IBMPAT - Pattern matching routines for IBMSPL

;
;
;		  COPYRIGHT (c) 1979, 1980, 1981, 1982
;                    DIGITAL EQUIPMENT CORPORATION
;
;     This software is furnished under a license and may  be  used
;     and copied only in accordance with the terms of such license
;     and with the inclusion of the above copyright notice.   This
;     software  or any other copies thereof may not be provided or
;     otherwise made available to any other person.  No  title  to
;     and ownership of the software is hereby transferred.
;
;     The information  in  this  software  is  subject  to  change
;     without  notice  and should not be construed as a commitment
;     by DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL assumes no responsibility for the use or reliability
;     of  its  software  on  equipment  which  is  not supplied by
;     DIGITAL.
;
;	TITLE	IBMPAT - Pattern matching routines for IBMSPL
COMMENT	&

  This module provides the patterns to which incoming records are matched
for two purposes: for 2780/3780 to distinguish console message output from
printer output (though both are actually sent by IBM to the printer) and
to recognize switches embedded in user output which directs IBMSPL where
to put and what to do with the files it receives.  This latter function
was called "log file recognition" (or just "recognition" for short) in 
D60SPL.

	&


	SEARCH	IBMMAC
	SEARCH	GLXMAC,QSRMAC
	PROLOG	(PAT)

IF2,<PRINTX	Pass 2.>

	SALL

;Version information

	PATVER==1		; Major version
	PATMIN==0		; Minor version
	PATEDT==23		; Edit number
	PATWHO==0		; Who edited last (0=DEC)

	%%.PAT==<VRSN. (PAT)>


; Print title/version information to log during compilation

Define VOUTX ($S1,$S2,$S3,$S4)
 <TITLE $S1 $S2'$S3'('$S4')
  PRINTX $S1 $S2'$S3'('$S4')>

IF1,<
 IFN <PATMIN>,<VOUTX (IBMPAT Pattern matching for IBMSPL,\PATVER,\"<"A"+PATMIN>,\PATEDT)>
 IFE <PATMIN>,<VOUTX (IBMPAT Pattern matching for IBMSPL,\PATVER,,\PATEDT)>
    > ;End IF1

	EXT	<INSENT,FNDENT,CLRSWT>	;external routines
	SUBTTL	Revision history

COMMENT	&

Edit	Date		Who	What

0(1-4)	9-May-79	K. Reti	Initial Program development
0(5)	15-May-79	KR	Add SUBTTL for clarity, add PSTR switch
0(6)	17-May-79	KR	Change switch type register to TK (from S)
				(it conflicted with pattern macros use of
				P-1 to store PDL pointer)
0(7)	23-May-79	KR	Generalize .PSTR0 and comment it (also make
				it more efficient)
0(10)	1-Jun-79	KR	Fix .PSTR0 bug
1(11)	4-Jun-79	KR	Fix bugs in DOSWT
1(12)	4-Jun-79	KR	Fix bugs in edit 11
1(13)	18-Jun-79	KR	Add TOPS10 PNAME code to DOSWT
1(14)	29-Jun-79	KR	Add TOPS10 routine GETPPN
1(15)	3-Jul-79	KR	Added /DEST switch
1(16)	18-Sep-79	SMJ	Change string that USER name is matched against
				 to include . and -.
1(17)	19-Sep-79	SMJ	Code clean up and work on making comments
				 readable.
1(20)	20-Sep-79	SMJ	Add /ACCOUNT switch.

1(21)	23-SEP-80	RLS	FIX SLDS(/LDISP PROCESSOR) TO MAKE DISPOSITION
				ENTRY FOR "DELETE" ALSO.
1(22)	7-Oct-80	KR	Fix PATLOG to handle timestamp without
				preceding character and no timestamp
1(23)	4-Nov-80	KR	Fix GETSIX to handle lower case input.

1(24)	6-May-81	RAK	Fix PATLOG to assure that irregular character
				patterns are not recognized as timestamps and
				that timestamps are properly recognized.

	&
SUBTTL Macros

; Macro - STRNG
;
; Function - To define a word containing the count and address of
;	and ASCIZ string.
;
; Parameters - String


DEFINE STRNG (A) <
	QQ==0			;;counter for characters in string
	IRPC A,<
	  QQ==QQ+1
	   >;end IRPC A
	XWD	QQ,[ASCII/'A'/]
    >;End DEFINE STRNG



; Macro - PATSTR
;
; Function - To define a pattern string and store the STRNG pointer to it.
;
; Parameters - String for pattern

DEFINE PATSTR (A) <
	PSTR	[STRNG 'A']
    >;End DEFINE PATSTR
SUBTTL Console Output Patterns

COMMENT	&

  This pattern matches up to three characters at the beginning of
a line from the set of space (' '), asterisk ('*') and dollar sign
('$'), followed by either 1 digit or two digits, followed by two
repetitions of .nn where "n" is a digit.  For a 2780/3780 printer
file to be considered a log file, all the lines in it must match
this pattern.

	&

ZZZ==0

	ENTRY	PATLOG

PATLOG:	PAT	<PBEG,<POR,<<TIMOPT,TIMBAR,IEFOPT,BLKOPT>>>>
BLKOPT:	PAT	<PBEG,<PSPN,BLANK>,PEND>
IEFOPT:	PAT	<PBEG,<PSPN,BLANK>,<PEX,IE>,<POR,<<EFF,EEE>>>,<PSPN,<NUMBS,3>>>
IE:	PSTR	[XWD ^D2,[ASCII /IE/]]
EFF:	PCHR	F
EEE:	PCHR	E
TIMOPT:	PAT	<PBEG,<PSPN,<BEGCHR,3>>,<PEX,TMSTP>>
TIMBAR:	PAT	<PBEG,<PEX,TMSTP>>
BEGCHR:	XWD	^D3,[ASCII /$* /]
BLANK:	XWD	^D1,[ASCII / /]
TMSTP:	PAT	<PBEG,<POR,<<DIG2,DIG1>>>,<PEX,DTDG>,<PEX,DTDG>>
DIG1:	PAT	<PBEG,<PSPN,<NUMBS,1>>>
DIG2:	PAT	<PBEG,<PSPN,<NUMBS,2>>>
DTDG:	PAT	<PBEG,<PSPN,<DC,1>>,<PSPN,<NUMBS,2>>>
DC:	XWD	2,[ASCIZ /.:/]
NUMBS:	XWD	^D10,[ASCII /0123456789/]

SUBTTL	Patterns for matching user switches

COMMENT	&

  The following pattern matches any of the eight legal switches for output
disposition (i.e. PNAME [programmer name], LNAME [log name], LDISP [log
disposition], LFORM [log form type], LSTR [structure for held log file],
LDEST [destination node for printing], ACCOU [user account string], and
ENDLI [end of log parameters]).

	&

	ENTRY	PATSWT
TK==15					;;register for saving POR choice
					;;cannot be P-1 (i.e. 16)

PATSWT:	PAT	<PFLT,<PEX,SLSH>,<POR,<<PNAM,LNAM,LDSP,LFRM,LST,LDST,ACNT,ENDL>,TK,SWTNAM>>,<PARB,<COLN,0,1>>,<PEX,<ARGTAB(TK),VALUE>>>
SLSH:	PCHR	</>
COLN:	PCHR	<:>
SWTNAM:	EXP	0
VALUE:	EXP	0

; The following patterns merely match the strings given as arguments to
;the PATSTR macro.

PNAM:	PATSTR	PNAME
LNAM:	PATSTR	LNAME
LDSP:	PATSTR	LDISP
LFRM:	PATSTR	LFORM
LST:	PATSTR	LSTR
LDST:	PATSTR	DEST
ACNT:	PATSTR	ACCOU
ENDL:	PATSTR	ENDLI

;  This table is a dispatch to the patterns which match the rest of the
;switch (after the :); the main pattern dispatches to it displaced by the
;value in S, which has the index into the POR for which switch was matched.
;Therefore it must be in the same order as the list of switches in the
;POR.

ARGTAB:	JRST	USER
	JRST	NAME
	JRST	DSPARG
	JRST	FRMARG
	JRST	STRARG
	JRST	STRARG			;just a sixbit value like structure
	JRST	ACTARG
	JRST	.RETT			;equivalent of NUL

;  The following pattern matches the user (PNAME) argument; it is the PPN
;for TOPS10 and the directory name for TOPS20.

TOPS10 <
USER:	PAT	<PBEG,<PEX,<OCT,PROJ>>,<PEX,CCMA>,<PEX,<OCT,PROG>>>
CCMA:	PCHR	<,>
OCT:	PAT	<PBEG,<PSPN,OCTDIG>>
OCTDIG:	XWD	^D8,[ASCII/01234567/]
PROJ:	EXP	0				;where info about PROJ goes
PROG:	EXP	0				;where info about PROG goes
>;end TOPS10

TOPS20 <
USER:	PAT	<PBEG,<PSPN,LEGNAM>>
>;end TOPS20

;  The next pattern matches the six-character output-file name.

NAME:	PAT	<PBEG,<PSPN,FILCHR>>

;  The next pattern matches the rest of the disposition field: HOLD or DELETE.

DSPARG:	PAT	<PBEG,<POR,<<HLD,DEL>,,DISP>>>
HLD:	PATSTR	HOLD
DEL:	PATSTR	DELETE
DISP:	EXP	0

;  The next pattern matches the rest of the LFORM field -- namely the forms name.

FRMARG:	PAT	<PBEG,<PSPN,FILCHR,FORM>>
FORM:	EXP	0

;  The next pattern matches the rest of the LSTR field -- the structure
; for a held file.

STRARG:	PAT	<PBEG,<PSPN,LEGAL,STRUC>>
STRUC:	EXP	0

;  The next pattern matches the reset of the ACCOUNT field, which is the
; actual account string.

ACTARG:	PAT	<PBEG,<PSPN,LEGNAM>>

;  The following are character strings needed by the above patterns:

LEGAL:	STRNG	ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789
LEGNAM:	STRNG	<ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-.$>
FILCHR:	STRNG	ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789
	SUBTTL	Pattern macro support routines

;  The following routines are needed by the pattern matching macros

; Routine - .PSTR0
;
; Function - Create a byte pointer to start of string. This string is
;	offset byte a number of bytes from the actual string origin
;	which is word aligned.
;
; Parameters -
;	T1/	Offset in bytes from origin
;	P4/	String origin
;
; Returns -
;	P1/	Byte pointer

.PSTR0:	MOVEI	P1,0(P4)		;get address of beginning of record
	HRLI	P1,440700		;make into a byte pointer
	JUMPE	T1,.RET			;if no displacement, we are doone
	PUSH	P,T1			;save T1
	PUSH	P,T2			; and T2
	IDIVI	T1,5			;get word displacement into T1 and byte
					; displacement into T2
	ADD	P1,T1			;add word displacement to byte pointer
	MOVE	T1,[EXP 44
		    EXP 44-7
		    EXP 44-<2*7>
		    EXP 44-<3*7>
		    EXP 44-<4*7>](T2)	;pick up new position field
	DPB	T1,[POINT 6,P1,5]	;store in byte pointer
	POP	P,T2
	POP	P,T1
.RET:	POPJ	P,


; Routine - .PSTR2
;
; Function - To add and decrement the string position counters

.PSTR2:	ADD	T1,T3
	SUB	T2,T3
.PSTR3:	SETZ	T3,
	POPJ	P,
	SUBTTL	Switch value processing routines

; Routine - DOSWT
;
; Function - This routine is called by IBMSPL to process a switch type
;	that has been parsed (matched) and if needed to make the
;	appropriate queue create entry.

	ENTRY	DOSWT

DOSWT:					;routine to process switch values
	MOVE	P1,VALUE		;get what matched
	SKIPL	TK			;if negative, error
	CAIL	TK,SWTABE-SWTAB		;check if in range	
	$RETF				;return if not
	JRST	@SWTAB(TK)		;dispatch to proper switch handler

SWTAB:	JRST	SPNM			;PNAME
	JRST	SLNM			;LNAME
	JRST	SLDS			;LDISP
	JRST	SLFR			;LFORM
	JRST	SLST			;LSTR
	JRST	SDST			;DEST
	JRST	SACT			;ACCOU
	JRST	SENDL			;ENDLI
SWTABE==.


SPNM:					;here to process programmer name
TOPS10 <MOVE	S1,[XWD 2,.QCOID]	;block for PPN
	MOVEM	S1,QUEENT		;store as first word
	$CALL	GETPPN			;get the binary PPN
	JUMPE	S1,.RETT		;skip if illegal PPN
	MOVEM	S1,QUEENT+1		;save it for later
	JRST	COMSWT			; Go store value in queue create msg
    >;End TOPS10

TOPS20 <MOVEI	S1,.QCNAM		; Prototype first word
	JRST	SACT1			; Go process ASCIZ string type
    >;End TOPS20


SACT:					; Here to process ACCOUNT strings
	MOVEI	S1,.QCACT		; Queue create message entry type
SACT1:	MOVEM	S1,QUEENT		; Into entry
	MOVEI	P2,QUEENT+1		; Point to where string should go
	$CALL	GETASC			; Make ASCIZ string
	AOS	T2			; Adjust word count to include header
	HRLM	T2,QUEENT		;  and save in header
	JRST	COMSWT			; Go store value in queue create msg

SLFR:					;here to process log-file forms
	MOVE	S1,[XWD 2,.QCFRM]	;get header
	JRST	COMWRD			;rest is like any 1-word switch

SLST:					;here to process log-file structure
	MOVE	S1,[XWD 2,.IBMST]	;special code for IBM structure block
	JRST	COMWRD			;rest is like other 1-word switches

SDST:					;here to process destination node
	MOVE	S1,[XWD 2,.QCNOD]	;get block type
	JRST	COMWRD			;rest is like other 1-word switches too

SLNM:					;here to process log-file name
	MOVE	S1,[XWD 2,.QCJBN]	;get header word

COMWRD:					;common processing for 1-word switches
	MOVEM	S1,QUEENT		;store as header word
	$CALL	GETSIX			;get sixbit equivalent of value
	JUMPE	S1,@.RETT		;forget it if arg is blank
	MOVEM	S1,QUEENT+1		;save it in entry

COMSWT:					;common switch processing
	MOVEI	S1,QUEENT		;point to the entry
	$CALL	INSENT			;insert the entry
	JUMPF	.RETT			;ignore it if we cannot
	$RETT				; and exit

SLDS:					;here to process log-file disposition
	$CALL	GETSIX			;get sixbit argument
	CAME	S1,[SIXBIT /HOLD/]	;see if hold
	CAMN	S1,[SIXBIT /DELETE/]	; or delete
	CAIA				; make entry
	$RET				;ignore everything else
	CAME	S1,[SIXBIT /DELETE/]	;get appropriate switch value
	TDZA	S1,S1			; 0 => hold
	MOVEI	S1,1			; 1 => delete
	MOVEM	S1,QUEENT+1		; put value in entry
	MOVE	S1,[2,,.QCODP]		; get length,,type
	MOVEM	S1,QUEENT
	JRST	COMSWT			; and stuff it

SENDL:					;here to process end-of-list switch
	PJRST	CLRSWT			;exit by clearing flag which causes
					; us to look for switches

GETASC:					;subroutine to copy from record buffer
					; to an ASCIZ string at address 0(P2)
					;returns words copied in T1,
					; destroys T3,S1,P1,P2
	HRRZ	T1,P1			;get displacement in bytes off P4
	HLRZ	T2,P1			;get count
	JUMPE	T2,GETAS1		;no source, so merely deposit zero byte
	PUSH	P,T2			;save byte count
	$CALL	.PSTR0			;make a byte pointer in P1
	HRLI	P2,440700		;make destination pointer in P2
GETAS0:					;character loop
	ILDB	S1,P1			;get byte
	IDPB	S1,P2			;put byte
	SOJG	T2,GETAS0		;loop till no more
	POP	P,T2			;get count of bytes copied
GETAS1:					;here when all bytes copied
	SETZ	S1,
	IDPB	S1,P2			;put in null byte
	AOS	T2			;include in count
	IDIVI	T2,5			;calculate number of words
	SKIPE	T3			;if exact, don't round up
	AOS	T2			;not exact, so add another word
	$RET				;return to caller

GETSIX:					;here to convert value into SIXBIT in S1
	HRRZ	T1,P1			;get displacement in bytes off P4
	HLRZ	T2,P1			;get count
	SETZ	S1,
	JUMPLE	T2,.RET			;no source, so merely use zero
	$CALL	.PSTR0			;make a byte pointer in P1
	MOVEI	T1,6			;count of character to shift
GETSX0:					;character loop
	SETZ	S2,			;assume zero
	JUMPE	T2,GETSX1		;if no more source characters, we were right
	ILDB	S2,P1			;get byte
	CAIL	S2,"a"			;if 			[1(23)]
	CAILE	S2,"z"			; lowercase 		[1(23)]
	CAIA				;  convert 		[1(23)]
	SUBI	S2,40			;   to upper 		[1(23)]
	SUBI	S2,40			;convert to SIXBIT
	SOS	T2			;one fewer character to worry about
GETSX1:					;here to add this character to
	LSH	S1,6			;make room
	ADD	S1,S2			;add in next character
	SOJG	T1,GETSX0		;loop till no more
	$RET				;return to caller

TOPS10 <
GETPPN:					;subroutine to get a PPN
	HRRZ	T1,P1			;get byte displacement off P4
	HLRZ	T2,P1			; and count
	MOVE	P2,T2			;copy count to where GETOCT wants it
	SETZ	S1,			;initialize result to 0
	JUMPLE	T2,.RET			;if no source, return a zero PPN
	$CALL	.PSTR0			;make a byte pointer in P1
	$CALL	GETOCT			;get an octal number in S1
	CAIE	S2,","			;make sure we had a legal separator
	JRST	GETPER			;else declare an error
	MOVE	T1,S1			;save project number
	$CALL	GETOCT			;get an octal number in S1
	HRL	S1,T1			;get other half
	$RETT				;return true
GETPER:					;here if illegal PPN specified
	SETZ	S1,			;get a zero value
	$RET				;and return

GETOCT:					;here to get an octal number
	SETZ	S1,			;zero result
GETOC0:					;loop to get digits
	ILDB	S2,P1			;get next character into S2
	CAIL	S2,60			;if less than 0
	CAILE	S2,67			; or greater than 7
	JRST	GETOC1			; finish up
	SUBI	S2,60			;get only octal digit
	LSH	S1,3			;make room for digit
	ADD	S1,S2			;stash new digit
	SOJG	P2,GETOC0		;count it, and repeat loop if not last
GETOC1:					;here when done
	$RET
>;end TOPS10

QUEENT:	BLOCK	^D20			;area in which to build queue entry

	END