Google
 

Trailing-Edge - PDP-10 Archives - BB-J992D-SB_1984 - ibmmac.mac
There are 9 other files named ibmmac.mac in the archive. Click here to see a list.
;    IBMMAC - IBMSPL specific macros and definitions

;
;
;		  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.
;
	SUBTTL	IBMMAC Version 
	UNIVERSAL IBMMAC
	SEARCH	GLXMAC

	IMCVER==1		; Major version number
	IMCMIN==0		; Minor version number
	IMCEDT==30		; Edit number
	IMCWHO==0		; Who edited last (0=DEC)

	%%.IMC=:<VRSN. (IMC)>
	SUBTTL	Revision history
COMMENT	&

Edit	Date		Who	What

1-16	27-Apr-79	K. Reti	Initial program development
17	4-May-79	KR	Move NULL to IBMMAC, add REGS to it
20	15-May-79	KR	Add NOTRACE support to NULL
				comment some early macros
21	15-May-79	KR	make pattern matching macros more defensive
				about negative remaining counts (happens, but
				I don't know why yet)
22	19-May-79	KR	Don't preserve as many AC's on patterns (try
				to lessen overhead
23	19-May-79	KR	Undo edit 22 -- it didn't work
24	19-May-79	KR	change version numbering symbol to not conflict
				with GLXMAC's MACEDT
25	4-Jun-79	KR	Add symbol for structure block value (.IBMST)
26	15-Jun-79	KR	Add version number cracking macro
27	1-Nov-79	SMJ	Heave subroutine documention macros and version
				macros, replace version macros with something
				more efficient.
30	6-Oct-80	KR	Add PEND macro to match end of character string.

	&
	SUBTTL	DYNAMIC DATA STRUCTURE MACROS

COMMENT	&

  The following macros allow easy definition of indexed data structures; they
are used in IBMSPL to define the format of the line blocks, the task blocks, the
active task list entries, and the port list entries.  The fields within a block
are identified by a common prefix, e.g. T.ACS, T.ATE (from the task block). The
body of the symbol is limited to three characters by the fact that the structure
definition macros in GLXMAC generate their "structure" macro by appending a 
character to the end of the symbol (surely the worst way for creating ambiguity!)

  The definition of a block has two parts -- a start (DATAST macro) and one or
more entries ($ and $. macros). The DATAST macro specifies the prefix
to use on all entries that follow as well as an index register (which
is presumed to point to the beginning of the block).

  The $ and $. macros generate symbols of the following forms:

	prfx.body	which is the structure definition symbol (see DEFSTR or
			MSKSTR in GLXMAC); as such, its value is the mask of the
			position of this element within a word.

	prfx.body%	which is the structure macro (again see DEFSTR or MSKSTR)
			and contains the positioning information (including the
			index register). Because the index register is included,
			LOAD and STORE (and other structure-invoking macros) should
			leave their position fields blank, e.g. LOAD S1,,T.FOO.

	prfx%body	is a macro containing "merely offset(index reg)", so
			that instructions which do not have structure manipulating
			equivalents can be coded without reference to the 
			index register, e.g. IMUL S1,T%FOO.

	prfx$body	is a symbol containing just the word offset of this
			particular entry based on the index register; this is
			useful if you are using another register to do the
			indexing; it can be used with the prfx.body mask in
			structure references the hard way (i.e. by hand) for
			example LOAD S1,T$FOO(P1),QQ where QQ was previously
			equated to T.FOO.  [The more obvious construct
			LOAD S1,T$FOO(P1),T.FOO doesn't work because, since
			T.FOO% exists, the structure macro appends the supplied
			position info (T$FOO(P1)) to the stored position info
			(T$FOO(R1)) with a "+" to achieve an undesired result.]

  The $ and $. macros are identical except that $. entries merely redefine
previous $ entries; thus a fullword can be given a name, and then the two
halfwords comprising it can likewise be named.  Unfortunately, only one level
of subsetting exists at the moment.

	&

DEFINE DATAST(PRE,IDX)<

  DEFINE $ (NAM,SIZ,CNT,LVL) <
    $$ PRE,NAM,\..WD,IDX,\..BT,SIZ,CNT,LVL
   >;end DEFINE $

  DEFINE $$. (NAM,SIZ,OB,OW,BT,WD,CNT) <
    $$$. PRE,NAM,OB,OW,BT,WD,IDX,SIZ,CNT
   >;end DEFINE $$.

  DEFINE $$$$ (NAM,BIT,SIZ,WRD) <
    $$$$$ PRE,NAM,BIT,SIZ,IDX,WRD
   >;end DEFINE $$$$

  ..WD==0
  ..BT==-1

 >;end DEFINE DATAST



DEFINE $$ (P,N,W,I,B,S,C,L) <

 ..TM==0

 IFB <S>,<
  IFB <N>,<
   IFGE ..BT,<
     ..WD==..WD+1
     ..BT==-1
    >;end IFN ..BT
   ..TM==1
   >;end IFB N
  >;end IFB S

 IFE ..TM,<
   ..CT==1
   IFNB <C>,<..CT==C>
   ..SZ=^D36
   IFNB <S>,<..SZ==S>
   ..OB==..BT
   ..OW==..WD

   REPEAT ..CT,<
    ..BT=..BT+..SZ
     IFG <..BT-^D35>,<
       ..WD=..WD+1
       ..BT=..SZ-1
      >;end IFG <..BT-^D35>

     IFNB <N>,<
      IFE ..TM,<
	$$$$ N,\..BT,\..SZ,\..WD
        ..RX==10
        RADIX ^D10
	DEFSTR (P'.'N,P'$'N'('I),\..BT,\..SZ)
        RADIX ..RX
       >;end IFE ..TM
      ..TM==..TM+1
     >;End IFNB N

    IFNB <L>,<$$$ L,\..OB,\..OW,\..BT,\..WD>
   >;End Repeat ..CT
  >;End IFE ..TM
 >;End DEFINE $$


DEFINE $$$ (L,OB,OW,BT,WD) <

  DEFINE $. (NAM,SIZ,CNT) <
    $$. NAM,SIZ,OB,OW,BT,WD,CNT
   >;end DEFINE $.

  ..BT1==OB
  ..WD1==OW
 >;end DEFINE $$$



DEFINE $$$. (P,N,OB,OW,B,W,I,S,C) <
  ..TM1==0
  IFB <S>,<
    IFB <N>,<
      ..WD1==..WD1+1
      IFG <..WD1-W>,<PRINTX ?Sublevel overflowed top for P'.'N>
      ..BT1==0
      IFE <..WD1-W>,<
        IFG <..BT1-B>,<PRINTX ?Sublevel overflowed top bits for P'.'N>
       >;end IFE <..WD1-W>
      ..TM1==1
     >;end IFB,<N>
   >;end IFB,<S>

  IFE ..TM1,<
    ..CT1==1
    ..SZ1==^D36
    IFNB <C>,<..CT1==C>
    IFNB <S>,<..SZ1==S>

    REPEAT ..CT1,<
      ..BT1==..BT1+..SZ1
      IFG <..BT1-^D35>,<
	..WD1==..WD1+1
	IFG <..WD1-W>,<PRINTX ?Sub level overflows top for P'.'N>
	..BT1==..SZ1-1
	IFE <..WD1-W>,<
	  IFG <..BT1-B>,<PRINTX ?Sub level overflows top bits for P'.'N>
	 >;end IFE <..WD1-W>
       >;end IFG <..BT1-^D35>

      IFNB <N>,<
	IFE ..TM1,<
	  $$$$ N,\..BT1,\..SZ1,\..WD1
	  ..RX==10
	  RADIX ^D10
	  DEFSTR (P'.'N,P'$'N'('I),\..BT1,\..SZ1)
	  RADIX ..RX
	 >;end IFE ..TM1
	..TM1==..TM1+1
       >;end  IFNB <N>
     >;end REPEAT ..CT1
   >;end IFE ..TM1
 >;end DEFINE $$$.


DEFINE $$$$$ (P,N,B,S,I,W) <
  P'$'N=='W
  DEFINE P'%'N<P'$'N('I')>
 >;end DEFINE $$$$$
SUBTTL	STRUCTURE SKIP MACROS

DEFINE .SKP (CND,AC,Y,STR,%NO) <
	CAIA
	JRST	%NO
	LOAD	.SAC,Y,STR
IFNB <AC>,<
	SKIP'CND	AC,.SAC
>;end IFNB <AC>
IFB <AC>,<
	SKIP'CND	.SAC
>;end IFB <AC>
%NO:
>;end DEFINE .SKP

DEFINE .SKPGN (CND) <
IRP CND,<
DEFINE SKP'CND (AC,Y,STR) <
.SKP (CND,AC,Y,STR)
>;end DEFINE SKP'CND
>;end IRP CND
>;end DEFINE .SKPGN

	.SKPGN	<E,N,L,LE,G,GE>
SUBTTL	Miscellaneous Macros

; Macro to make a cross reference entry

DEFINE REF(ARG) <
IRP ARG,<
..RF==ARG
>;end IRP ARG
PURGE ..RF
>;end DEFINE REF

COMMENT	&

  In the following macros T1 generally holds the displacement (in bytes)
within the string of where to start matching; T2 holds number of characters
left in string (from T1); T3 holds, when calling a pattern, the number
of characters that the pattern must match (minimum) to succeed and P4
holds the address of the start of the string (off which T1 is the displacement).

  The macro PAT defines a "pattern", which is really a subroutine which returns
true or false (and as a side-effect stores some values of what matched what) based
on whether the pattern matches the string pointed to by T2 and P4. Its single
argument is a list of pattern "elements".  The first element must be either
PBEG or PFLT, for an anchored or non-anchored (floating) pattern match, respectively.
Successive elements can be any combination of the following:

PEX	This is an element that causes an exact match of a pattern
PARB	This is an element that causes any number of occurences of a pattern
	to match
PSPN	This is an element which matches as many characters as possible from a
	string (in any order). Note this does not work on patterns at the moment
POR	This is an element which matches any of a list of patterns.

  There are also several macros to make primitive patterns which can be the
arguments to some of the "pattern elements" listed above:

PCHR	Makes a pattern that matches 1 character (the argument is the character)
PSTR	Makes a pattern that matches a character string (the argument is the
	address of a word whose LH=length of string, and RH=address of string)
	&

DEFINE PAT (LIST) <
ZZZ==ZZZ+1
ZZ==0
	$SAVE	<T4,P1,P2,P3,P4,S1,S2,P-1>	;;save registers we need
	PUSH	P,T1				;;save start position for success
	MOVE	P-1,P				;;save current position of stack
	PATGO	INIT				;;go to the first pattern
	POP	P,T1				;;clean up stack
	JRST	.RETF				;;if we get here, we have failed
IRP LIST <					;;generate all the elements
	PAT.	LIST
>;;end IRP LIST
PATTG						;;generate tag for last PATGO
	MOVE	P,P-1				;;restore stack
	MOVE	T3,T1				;;get current position
	POP	P,T1				;;restore original position
	SUB	T3,T1				;;subtract start to get chars matched
	ADD	T2,T3				;;fix count remaining also
	JRST	.RETT				;;and indicate success
>;end DEFINE PAT

DEFINE PATGO (SPEC) <				;;macro to go to next pattern element
	PATGO.	\ZZ,\ZZZ,SPEC			;;generate call to ..Pn
>;end DEFINE PATGO

DEFINE PATGO. (PNUM,NUM,SPEC) <			;;macro to PUSHJ to next pattern element
IFB <SPEC>,<
	PUSHJ	P,.PSTR2			;;update pointers
>;END IFB <SPEC>
IFNB <SPEC>,<
	PUSHJ	P,.PSTR3
>;END IFNB <SPEC>
	PUSHJ	P,%'PNUM'P'NUM			;;call next element
>;end DEFINE PATGO.
DEFINE PAT. (ENTRY) <				;;macro to build body of pattern element
PAT.. ENTRY
>;end DEFINE PAT.

DEFINE PAT.. (TYPE,ARG) <			;;macro to generate call to element
PATTG
	TYPE	ARG
>;end PAT.

DEFINE PATTG <					;;defines label of current element and increments counter (so PATGO will go to next)
PATTG. \ZZ,\ZZZ
ZZ==ZZ+1
>;end DEFINE PATTG

DEFINE PATTG. (PNUM,NUM) <			;;actually build the tag
%'PNUM'P'NUM:
>;end DEFINE PATTG.

DEFINE PBEG (A) <				;;Anchored match beginning element
	PATGO					;;go to first pattern
	$RET					;;if we get here, we're not going to match
>;end PBEG

DEFINE PFLT (A) <				;;Unanchored match beginning element
	PATGO					;;go to first pattern
QQ==.						;;save address right after last PUSHJ to next pattern
	SOS	T2				;;if we fail, decrement count remaining
	JUMPLE	T2,.RETF			;;if we are all done, return failure
	AOS	T1				;;increment starting position
IFDEF FTDEBUG <
	SKIPG	T1				;;make sure position is positive
	HALT					;;error if not
>;end IFDEF FTDEBUG
	JRST	QQ-1				;;else try again at next character position
>;end DEFINE PFLT

DEFINE PEX (A,VAL) <				;;Exact match of pattern element
	$SAVE	<T1,T2,P3>			;;save registers we need
	MOVE	P3,T3				;;save must match count
	SETZ	T3,				;;clear must match for this call
	PUSHJ	P,A				;;call pattern
	JUMPF	.RET				;;if it fails, propagate failure
	CAMGE	T3,P3				;;did we match enough?
	$RET					;;no, propagate error
	PVALSV	VAL				;;yes, store value info if necessary
;	ADD	T1,T3				;;otherwise bump starting point
;	SUB	T2,T3				;;and decrement count remaining
	PATGO					;;and go to next element
	$RET					;;propagate failure
>;end DEFINE PEX

DEFINE PSTR (A) <				;;make a pattern to match a string
	$SAVE	<P1,P2,P3,T4>			;;save registers
	MOVE	P2,A				;;copy address of string pointer
	HLRZ	P3,P2				;;get length into P3
	CAMLE	T3,P3				;;is must match greater than length?
	JRST	.RETF				;;yes, too bad
	MOVE	T4,P3				;;copy length again
	HRLI	P2,440700			;;make P2 a byte pointer to string
	PUSHJ	P,.PSTR0			;;setup byte pointer to test string
	ILDB	S1,P1				;;get character from test string
	ILDB	S2,P2				;;and one from constant string
	CAME	S1,S2				;;skip if they are equal
	JRST	.RETF				;;failure if not
	SOJG	P3,.-4				;;loop over all characters of constant string
	MOVE	T3,T4				;;copy how many we matched
	JRST	.RETT				;;and return success
>;end DEFINE PSTR

DEFINE PCHR (A) <				;;make pattern to match a character
	CAILE	T3,1				;;do we have to match more than 1
	JRST	.RETF				;;yes, too bad
	$SAVE	<P1,T4>				;;save registers
	PUSHJ	P,.PSTR0			;;set up byte pointer to source
	ILDB	S1,P1				;;get current character
	CAIE	S1,"A"				;;is it ours?
	JRST	.RETF				;;no, fail
	MOVEI	T3,1				;;yes, we matched 1
	JRST	.RETT				;;return success
>;end DEFINE PCHR

DEFINE PARB (A,B<0>,C<-1>,VAL) <		;;arbitrary number of occurences of a pattern
	$SAVE	<T1,T2,P4>			;;save registers
	MOVEI	T3,B				;;get minimum to match
QQ==0
IFNB <VAL>,<QQ==PVALSZ>
	JUMPE	T3,.+3+QQ			;;if we don't have to, don't try
	PUSHJ	P,A				;;try to match some
	JUMPF	.RET				;;propagate failure if cannot
	PVALSV	VAL				;;store value if necessary
;	ADD	T1,T3				;;new start
;	SUB	T2,T3				;; and count
	PUSH	P,T1
	PUSH	P,T2
	PUSH	P,T3
	PATGO
	POP	P,T3
	POP	P,T2
	POP	P,T1
	AOS	T3
QQ==0
IFG C,<
QQ==2
	CAILE	T3,C
	$RET>
	CAMLE	T3,T2
	$RET
	JRST	.-<15+QQ>
>;end DEFINE PARB

DEFINE PSPN (A,B<-1>,VAL) <		;;maximum number of characters selected from set
	CAMLE	T3,T2			;;must we match more than left in string?
	JRST	.RETF			;;yes, fail
	$SAVE	<T1,T2,P1,P2,P3,T4>	;;save some registers
	PUSHJ	P,.PSTR0		;;set up input byte pointer
	SETZ	T4,			;;initialize counter
	MOVE	P2,A			;;get address of string and length
	HLRZ	P3,P2			;;copy length to P3
	HRLI	P2,440700		;;make into byte pointer
	PUSH	P,P3			;;save count
	PUSH	P,P2			;;save byte pointer
QQ==0					;;how much the next two instructions add
					;; if not included
IFG B,<	CAIL	T4,B			;;have we reached upper limit?
	JRST	.+10			;;yes, don't add any more
QQ==2>					;;how much these instructions add if included
	ILDB	S1,P1			;;get byte from string
	MOVE	P2,0(P)			;;get initial byte pointer for span characters
	MOVE	P3,-1(P)		;;get count of span characters
	ILDB	S2,P2			;;get a span character
	CAMN	S1,S2			;;see if this character fits
	AOJA	T4,.-<5+QQ>		;;yes, increment count and get another string character
	SOJG	P3,.-3			;;no, get another span character
	POP	P,S1
	POP	P,S1
	SKIPE	T4			;;if none, fail
	CAMGE	T4,T3			;;was number we got less than desired?
	JRST	.RETF			;;yes, fail
	MOVE	T3,T4			;;no, get number we matched
	PVALSV	VAL			;;save value matched
;	ADD	T1,T3			;;update start by length
;	SUB	T2,T3			;;calculate new length
	PATGO				;;go to next element
	JRST	.RET			;;if it fails, propagate failure
>;end DEFINE PSPN

DEFINE POR (A,B,VAL) <			;;match any of a set of patterns
	$SAVE	<P1,P2,P3,S1>		;;save some registers ?? S1 only to test
IFNB <B>,<SETOM	B>			;;if index given, set to -1
	MOVE	P3,T3			;;copy must match
	DMOVE	P1,T1			;; as well as start and length
IRP A,<	DMOVE	T1,P1			;;for each pattern, start at beginning
	MOVE	T3,P3			;; with appropriate length
	PUSHJ	P,A			;;test that pattern
IFNB <B>,<AOS	B>			;;keep track of index
QQ==0					;;assume no extra code
IFNB <VAL>,<QQ==PVALSZ>			;;if extra code included, count it
	JUMPF	.+3+QQ			;;if it failed, go to next pattern
	PVALSV	VAL			;;save value that matched
;	ADD	T1,T3			;;update start
;	SUB	T2,T3			;; and length remaining
	PATGO				;;go to next pattern
>;end IRP A
	JRST	.RETF			;;if we get here, fail
>;end DEFINE POR

DEFINE PEND <
	JUMPN	T2,.RETF
	PATGO
>;end DEFINE PEND

DEFINE PVALSV (ARG) <			;;macro to save matched string address
PVALSZ==2				;;words of code generated by this macro
IFNB <ARG>,<
	HRLM	T3,ARG			;;save length in LH
	HRRM	T1,ARG			;; and address in RH
>;end IFNB <ARG>
>;end DEFINE PVALSV
	SUBTTL	.  REGS -- standard register names macro
DEFINE REGS <
DEFINE R(N) <				;;Macro to generate R0,R1,...
	R'N==N
>;end DEFINE R

..==0					;Counter
	REPEAT 20,<
	R	\..			;generate register name
..==..+1
>;end REPEAT 20
>;end DEFINE REGS
SUBTTL	.  Global Symbols

.IBMST==400000				;code to identify structure block in
					; queue info file

	END