Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/ietsrc/ibmpat.mac
There are 30 other files named ibmpat.mac in the archive. Click here to see a list.
; IBMPAT - Pattern matching routines for IBMSPL
;
;
; COPYRIGHT (C) 1977,1978,1979,1980,1981,1982,1983,1984,1985,1986
; 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==25 ; 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.
1(25) 29-Aug-84 VLG Fix SDST to correctly handle nodenumbers
under TOPS10.
&
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
TOPS10 <
HRRZ T1,P1 ;get displacement in bytes off P4
HLRZ T2,P1 ;get count
JUMPLE T2,.RET ;no source, so merely use zero
$CALL .PSTR0 ;make a byte pointer in P1
MOVE S1,P1 ;put pointer in s1
NNUM: ILDB S2,P1 ;get next char
CAIL S2,"0" ;if less than 0
CAILE S2,"9" ; or greater than 9
JRST NNAM ; finish up, must be nodename
SOJG T2,NNUM ; get next digit
MOVEI S2,^D8 ; octal number
$CALL S%NUMI## ;get integer number
MOVEM S2,QUEENT+1 ;save it in entry
MOVE S1,[XWD 2,.QCNOD] ;get back block type
MOVEM S1,QUEENT ; put in que entry
JRST COMSWT ; finish processing
NNAM: MOVE S1,[XWD 2,.QCNOD] ;get back block type
> ; END TOPS10
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