Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-156/symbol.mac
There are 7 other files named symbol.mac in the archive. Click here to see a list.
Subttl	Table of contents for

;	   -- Section --					   -- Page --
;
;  1.	Table of contents............................................. 1
;  2.	Symbol module
;	  2.1	Initializations....................................... 2
;	  2.2	Macro definitions..................................... 3
;	  2.3	Conditional Assembly parameters....................... 6
;	  2.4	ERROR macro........................................... 8
;	  2.5	NUMOUT and SETBIT..................................... 10
;	  2.6	.TTL. Macro........................................... 11
;	  2.7	String macros......................................... 12
;	  2.8	SWITCH Macro.......................................... 13
;
;		     (End of table of contents)
Subttl  Symbol module -- Initializations

Universal  SYMBOL -- Symbol table definitions
.Directive .Nobin
Search	Monsym

;Author:
;	Douglas Bigelow
;	Wesleyan Computing Center
;
;Purpose of file:
;	To provide a library of macro routines and symbol definitions
;	that prove of general use in most Macro programs.

;Accumulator definitions

	F==0		; Flag accumulator
	A==1		; Jsys accumulators
	B==2
	C==3
	D==4
	T1==5		; Temporary accumulators
	T2==6
	T3==7
	T4==10
	P1==11		; "permanent" accumulators
	P2==12
	P3==13
	P4==14
	P==17		; Stack pointer


;Useful symbols
	STKSIZ==200	; Default stack size
	CM$NUL==0	; [SRA] No prompt string on PROMPT call (CMD UUOs)
	CM$OLD==-1	; [SRA] Use last prompt string		(CMD UUOs)

;Bit masks for PSI panic channels
	II%AOV==:1B<.ICAOV>	;Arithmetic overflow
	II%FOV==:1B<.ICFOV>	;Floating overflow
	II%POV==:1B<.ICPOV>	;Pushdown overflow
	II%EOF==:1B<.ICEOF>	;End of file
	II%DAE==:1B<.ICDAE>	;Data file error
	II%QTA==:1B<.ICQTA>	;Disk full or over quota
	II%ILI==:1B<.ICILI>	;Illegal instruction
	II%IRD==:1B<.ICIRD>	;Illegal memory read
	II%IWR==:1B<.ICIWR>	;Illegal memory write
	II%IFT==:1B<.ICIFT>	;Inferior fork termination or forced freeze
	II%MSE==:1B<.ICMSE>	;System resources exausted
	II%NXP==:1B<.ICNXP>	;Reference to non-existant page
Subttl  Symbol module -- Macro definitions

;Flag control macros
	DEFINE	FLGON(FLG..),<
		TXO	F,FLG.. >
	DEFINE	FLGOFF(FLG..),<
		TXZ	F,FLG.. >
	DEFINE	SKPON(FLG..),<
		TXNN	F,FLG.. >
	DEFINE	SKPOFF(FLG..),<
		TXNE	F,FLG.. >
	DEFINE	SETSKP(FLG..),<
		TXOE	F,FLG.. >
	DEFINE	CLRSKP(FLG..),<
		TXZE	F,FLG.. >
	DEFINE	SETSKS(FLG..),<
		TXON	F,FLG.. >
	DEFINE	CLRSKS(FLG..),<
		TXZN	F,FLG.. >
	DEFINE	IFON.(FLG..) <
		SKPON	FLG..
		 IFSKP.>
	DEFINE	IFOFF.(FLG..) <
		SKPOFF	FLG..
		 IFSKP.>
	DEFINE	ANON.(FLG..) <
		SKPON	FLG..
		 ANSKP.>
	DEFINE	ANOFF.(FLG..) <
		SKPOFF	FLG..
		 ANSKP.>
;Byte pointer setup

	DEFINE	BPL(AC,STR),<
		MOVE	AC,[POINT 7,[ASCIZ\STR\]]>	;Byte pointer to lit
	DEFINE	BPM(AC,STR),<
		MOVE	AC,[POINT 7,STR]>		;Byte pointer to mem
	DEFINE	BPM36(AC,STR),<
		MOVE	AC,[POINT 36,STR]>		;36 bit byte pointer

;Type a message on the terminal
	DEFINE TYPE(M..),<
		HRROI	A,[ASCIZ\M..
\]
		PSOUT>

;type a prompt-type message with no finishing CRLF
	DEFINE TYPNCR(M..),<
		HRROI	A,[ASCIZ\M..\]
		PSOUT>

;Macro to define an ascii string
	DEFINE	ASC(M..),<[ASCIZ \M..\]>

;Macros to include and exclude code
	DEFINE	EXCLUDE(M..),<>
	DEFINE	INCLUDE(M..),<M..>
	DEFINE	OMIT(M..),<M..==0>
	DEFINE	USE(M..),<M..==-1>

;Macro to define stack storage
	DEFINE	STACK(L..,S..),<
	IFB	<L..>,	<ARRAY	STAK..[STKSIZ]
			 MOVE	P,[IOWD STKSIZ,STAK..]>
	IFNB	<L..>,<
		.IFN	<L..>,LABEL,<
			ARRAY	STAK..[L..]
			MOVE	P,[IOWD L..,STAK..]>>
		.IF	<L..>,LABEL,<
			IFB	<S..>,<
				MOVE	P,[IOWD STKSIZ,L..]>
			IFNB	<S..>,<
				MOVE	P,[IOWD S..,L..]>>>


;Macro to do a STACK followed by CMDINI
	DEFINE	CMDSTK(L..,S..) <
		STACK	(L..,S..)
		CMDINI	@.-1>
;CMDT macro -- generates keyword table entries for .CMKEY function
;Use:
;	CMDT	key1, flags1, dispatch1
;	CMDT	key2, flags2, dispatch2
;	(etc.)
;where
;	Key		is the keyword,
;	Flags		are TBLUK% flags (CM%INV,CM%NOR, or CM%ABR),
;	dispatch	is the dispatch address or, if FLAGS
;			contains CM%ABR, the address of the
;			table entry for which this is an abreviation.
;Defaults:
;	Key, Flags	None
;	Dispatch	".key", ie. the keyword preceded by a dot.
;
;Added to SYMBOL by SRA on 30-Sep-82

DEFINE	CMDT(key,flags<0>,dispat) <
	f..==flags			; Evaluate flags
	IFB  <dispat>,<d..==.'key'>	; Default dispatch
	IFNB <dispat>,<d..==dispat>	; Specified dispatch
	XWD [				; Begin LH of table entry
	  IFN <f..>,<exp f..!cm%fw>	; Expand any flags
	  ASCIZ \'key'\],d..		; Keyword, RH of entry is dispatch
	PURGE	d..,f.. 		; Dispose of temporary symbols
>
Subttl  Symbol module -- Conditional Assembly parameters

;COMND Jsys feature  -- assembled if F..CMD is non-zero

DEFINE	F..CMD,<
	SEARCH	CMD
	.REQUIRE SYS:CMD.REL
	XLIST
	CMDSTG			; Define cmd storage
	LIST	>


;UUOCON feature -- assembled if F..UUO is non-zero
;This macro defines the LUUO symbols used here and in the calling program.

DEFINE	UUOLST,<

T%%MIN==:14			; Lowest uuo

IFN STRNG.,<			; [PBG] String package LUUO's
	DEFU	FIND,14 	; [PBG] Find a substring in the string
	DEFU	COPY,15 	; [PBG] Copy from string 1 to string 2
	DEFU	INSERT,16	; [PBG] Insert a string into a string
	DEFU	DELETE,17	; [PBG] Delete a number of chars from string1
	>			; [PBG] End of string package LUUO's
IFE STRNG.,<			; [PBG] String package omitted...
	DEFU	NOTIN,30	; [PBG] The find command
	DEFU	NOTIN,30	; [PBG] The copy command
	DEFU	NOTIN,30	; [PBG] The Insert command
	DEFU	NOTIN,30	; [PBG] The delete command
	>			; [PBG] End of string package LUUO's

IFN SORTER,<
	DEFU	SORT,20>	; Sort an array
IFE SORTER,<
	DEFU	NOTIN,20>	; Sort an array

IFN MEMORY,<			;; Memory management
	DEFU	INIMEM,21	;; Initialize memory locations
	DEFU	GETMEM,22	;; Get memory
	DEFU	GIVMEM,23>	; Give back memory
IFE MEMORY,<			;; Memory management
	DEFU	NOTIN,30	;; Initialize memory locations
	DEFU	NOTIN,30	;; Get memory
	DEFU	NOTIN,30>	; Give back memory

	DEFU	CRASH,24	; Crash (like jshlt code)
	DEFU	PRINT,25	; Fancy text printing routines
	DEFU	SETJFN,26	; Set output jfn for print routines
	DEFU	GETJFN,27	; Obtain a jfn
	DEFU	NOTIN,30	; Type out version information

IFN COMMAN,<			;; CMD package
	DEFU	CMDINI,31	;; [SRA] Initialize CMD package
	DEFU	PROMPT,32	;; [SRA] Start new command
	DEFU	RFLDE,33	;; [SRA] Read a field, return on errors
	DEFU	RFIELD,34	;; [SRA] Read a field
	DEFU	CFIELD,35	;; [SRA] Read a field and confirm
	DEFU	NOISE,36	;; [SRA] Parse a noise word
	DEFU	CONFRM,37>	;; [SRA] Get confirmation
IFE COMMAN,<			;; CMD package
	DEFU	NOTIN,30	;; [SRA] Initialize CMD package
	DEFU	NOTIN,30	;; [SRA] Start new command
	DEFU	NOTIN,30	;; [SRA] Read a field, return on errors
	DEFU	NOTIN,30	;; [SRA] Read a field
	DEFU	NOTIN,30	;; [SRA] Read a field and confirm
	DEFU	NOTIN,30	;; [SRA] Parse a noise word
	DEFU	NOTIN,30>	;; [SRA] Get confirmation


T%%MAX==:37			; Highest uuo
>
DEFINE  F..UUO,<
	.Request SYS:UUOCON	; Request the library file
	Xlist			; Don't list the storage

IFNDEF	SORTER,<SORTER==-1>	; -1 means use the code by default
IFNDEF	MEMORY,<MEMORY==-1>
IFNDEF	COMMAN,<COMMAN==0>	; 0 means omit the code by default
IFNDEF	STRNG.,<STRNG.==0>	; Omit the String package too

IFN MEMORY,<			; Memory module only
	Memlnk::block	1	; Link word
	Memblk::block	3	; Prototype memory block
>
	P..jfn::block	1	; Print routine jfn storage

IFN COMMAN,<			;; Storage needed?
    IFNDEF cmdbln,<
	Cmdbln==:<^d80*6>/5+1>	;; Length of command buffer - 6 lines
    IFNDEF atmbln,<
	Atmbln==:cmdbln>	;; Length of atom buffer - same
    IFNDEF cjfnln,<
	Cjfnln==:20>		;; Length of block for long form GTJFN
    IFNDEF cmdpln,<
	Cmdpln==:stksiz>	;; Amount of stack CMD can save
	Cmdbuf::block cmdbln	;; Command buffer
	Cmdacs::block 20	;; Ac's from beginning of command line
	Atmbuf::block atmbln	;; Holds last parsed field
	Sbk::	block 20	;; Comnd jsys state block
	Cjfnbk::block cjfnln	;; Gtjfn block for comnd jsys
	Repara::block	1	;; Reparse address for comnd
	Cmblt1::block	1	;; Blt pointers for CMD routines
	Cmblt2::block	1	;;  (initialized by Cmdini)
	Cmdpdl::block cmdpln>	;; Room to save stack

IFN STRNG.,<			; String storage
	S1::block 2		; Storage for the first pointer
	S2::block 2		; Storage for the second
>				; End of string storage


;Now define the symbols
	Define	DEFU(NAM,NUM),<OPDEF 'NAM'['NUM'B8]>

	UUOLST			; invoke the symbol definitions


;Now define the dispatch table
	Define DEFU(NAM,NUM),<%'NAM'##>

UUOTAB::UUOLST			; Define the dispatch table
	List			; Restore normal listing mode
>
Subttl  Symbol module -- ERROR macro

;This macro handles a variety of error conditions in one line of code.
;This is the macro format:
;	ERROR	(MESSAGE,ACTION,ADDRESS)
;where:
;	MESSAGE is the desired error message
;	ACTION	is one of the following:
;		EXIT	exit after typing message
;		AUTO	automatically continue after typing message
;		CONT	exit but go on if continued by user
;		JUMP	jump to "ADDRESS" after typing message
;		CJMP	exit, then jump to "ADDRESS" if continued
;		RETN	execute a popj instruction after typing message
;	ADDRESS is where to continue from on a JUMP action code
;

;[PBG]	DONT INCLUDE LEADING MESSAGE--
DEFINE	%ERR(MESSAGE,ACTION,ADDRESS),<
	TYPE	<MESSAGE>
	%ERR1 (ACTION,ADDRESS)
>

DEFINE	%ERR1(ACTION,ADDRESS),<
	IFIDN	<ACTION><EXIT>,<
		HALTF
		JRST	.	>
	IFIDN	<ACTION><AUTO>,<
		JRST	.+1	>
	IFIDN	<ACTION><CONT>,<
		HALTF
		JRST	.+1	>
	IFIDN	<ACTION><JUMP>,<
		JRST	ADDRESS >
	IFIDN	<ACTION><CJMP>,<
		HALTF
		JRST	ADDRESS >
	IFIDN	<ACTION><RETN>,<
		RET		>
>

;[PBG]	NOW DEFINE ERROR TO INCLUDE %ERR
	DEFINE	ERROR(MESSAGE,ACTION,ADDRESS),<
	HRROI	A,[ASCIZ\ Error at PC \]
	ESOUT%
	MOVEI	A,.PRIOU
	MOVEI	B,.-1
	MOVEI	C,10
	NOUT%
	 JFCL
	TYPNCR( -- )
	%ERR(MESSAGE,ACTION,ADDRESS)
>
;Now the ways to use the macro:
	DEFINE	SSTERR(A,B,C),<
		ERJMP	[ERROR	(A,B,C)]	>

	DEFINE	PRGERR(A,B,C),<
		JRST	[ERROR	(A,B,C)]	>

;[PBG] PBG Addition:
	DEFINE	PBGERR(A,B,C),<
		JRST	[%ERR	(A,B,C)]	>

;[PBG] The same definition:
	DEFINE	NOERR(A,B,C),<
		JRST	[%ERR	(A,B,C)]	>

;[PBG] A new error macro:
	DEFINE	DBLERR(MESS,ACT,ADD),<
		ERJMP[	TYPNCR <? MESS - >
			MOVEI	A,.PRIOU	; Output to the TTY
			HRLOI	B,.FHSLF	; The most recent err of self
			SETZ	C,
			ERSTR%			; Type the error message
			 JFCL
			 JFCL
			TYPE <> 		; Finish the error message
			%ERR1	(ACT,ADD)	; And do the action
			]>
SUBTTL  Symbol module -- NUMOUT and SETBIT

;	This macro accepts the number, or the accumulator
;	or memory containing the number, and it's base,
;	and outputs that number.
;	Added to SYMBOL by PBG 19-Jan-82.

DEFINE	NUMOUT (NUMBER,BASE<12>),<
	MOVEI	A,.PRIOU
	.IF	NUMBER,SYMBOL,<MOVE	B,NUMBER>
	.IF	NUMBER,NUMERIC,<MOVEI	B,NUMBER>
	MOVEI	C,BASE
	NOUT%
	 SSTERR (Nout error in NUMOUT macro,EXIT)
	>;End of NUMOUT macro


;SETBIT sets an accumulator to have bit n set, where n is contained in
;	the second accumulator in the arg list.

DEFINE	SETBIT(AC,VAL<20>),<
	IFL <17-AC>,<IF1,<PRINTX ? Illegal argument in SETBIT macro>>
	IFL <17-VAL>,<IF1,<PRINTX ? Illegal argument in SETBIT macro>>
	SKIPL	VAL
	 MOVNS	VAL
	MOVX	AC,1B0
	LSH	AC,(VAL)>
Subttl  Symbol module -- .TTL. Macro

; The purpose of the .TTL. macro is to construct a standard title
; line of the following form:
;
;	name -- sssssss (Version mn(e)-c)
;
; where name	- name of the module
;	ssssss	- the logo for the program
;	m	- major version number
;	n	- minor version number
;	e	- edit number for this module
;	c	- software maintainer code
;
; The .TTL. macro assumes the following symbols are defined:
;
;	Vmajor	- major version
;	Vminor	- minor version
;	Vedit	- edit number for this module
;	Vcust	- software maintainer code
;
; The .TTN. macro is just like .TTL. except that the version number is
; not loaded into location 137.
; The .TTV. macro is similar, but it makes a TOPS-20 style entry
; vector.  The symbol VSTART must be defined.  VREENT is an optional
; rentry address, and the version numbers are the third entry in the
; vector.  .TTV. creates a symbol VECTOR, which is used in the END
; statement of the program:	END  <VECTOR>  .

DEFINE	.TTL.	(NAME,TEXT)<
	.TTN.	(NAME,TEXT)
	PGVER.	(Vmajor,Vminor,Vedit,Vcust)
>

DEFINE	.TTV.	(NAME,TEXT)<
	.TTN.	(NAME,TEXT)
	R..==[error No reentry address,EXIT]
	IFNDEF	Vreent,<Vreent==R..>
	PURGE	R..
	EV::!	JRST	Vstart
		JRST	Vreent
		EXP	Vword
	Vector==<3,,EV>
>

DEFINE	.TTN.	(NAME,TEXT)<
	.XCREF
	DEFINE	M%%%%T(Q1,Q2,Q3,Q4,Q5,Q6)<
	IFDIF	<Q4><@>,<
		Title	'Q1' -- 'Q2' (Version 'Q3'Q4'('Q5')-'Q6')
>
	IFIDN	<Q4><@>,<
		Title	'Q1' -- 'Q2' (Version 'Q3'('Q5')-'Q6')
>>
	M%%%%T(NAME,TEXT,\Vmajor,\"<Vminor+100>,\Vedit,\Vcust)
	Search	Macsym,Monsym
	.Require SYS:MACREL
	.Directive FLBLST
	PURGE	M%%%%T
	.CREF
>

;VWORD macro -- makes a version word, doesn't do anything with it [SRA]
DEFINE	VWORD(maj<Vmajor>,min<Vminor>,ed<Vedit>,cust<Vcust>)
	<Byte(3)cust(9)maj(6)min(18)ed>
Subttl	Symbol module -- String macros
; This set of macros is to be used in conjunction with the String LUUO's
; found in UUOCON.  The ones here are kept to one line of in-line code
; by having them be in literals.  The macros are as follows:
;
; STPTR.(Str,StringAddress) Sets appropriate pointers to stringaddress
;		and puts them in str.  Str should be either S1 or S2.
;
; GCHAR.(Ac,N) Gets the Nth character from the string pointed to by S1
;		and puts in in AC Ac. N can either be a number or a
;		memory location.
;
; SCHAR.(Ac,N) Sets the Nth character in the string pointed to by S1 to
;		be the character in Ac.  N can be either a number or a
;		memory location.
;

DEFINE	STPTR.(STR,ADDR),<	; Set a pointer to a string
	JRST	[PUSH	P,16	; Save an AC
		 MOVE	16,[POINT 7,ADDR] ; Point to the string
		 MOVEM	16,@STR  ; Save the pointer
		 AOS	STR	; Point to the next word
		 MOVEM	16,@STR   ; And save it again
		 POP	P,16	; Restore the Ac and end the macro
		 JRST	.+1]>

DEFINE	GCHAR.(AC,N),<		; Get the Nth character of the string
	JRST	[.IF N,SYMBOL,<MOVE AC,N  ; If a mem loc, get the contents
			       SOS AC>	; And subtract 1
		 .IF N,NUMERIC,<MOVEI AC,N-1> ; Otherwise, get the number-1
		 ADJBP	AC,S1+1 ; Point to the wanted character
		 MOVEM	AC,S1	; Save the new pointer
		 ILDB	AC,S1	; Finally, get the character, end the macro
		 JRST	.+1]>

DEFINE	SCHAR.(AC,N),<		; Set the nth character of the string
	JRST	[PUSH	P,AC	; Save the character
		 .IF N,SYMBOL,<MOVE AC,N> ; If a mem loc, get the contents
		 .IF N,NUMERIC,<MOVEI AC,N> ; Otherwise, get the number
		 ADJBP	AC,S1+1 ; Point to the new character
		 MOVEM	AC,S1	; Save the new pointer
		 POP	P,AC	; Restore the AC
		 IDPB	AC,S1	; Save the character and end the macro
		 JRST	.+1]>
Subttl  Symbol module -- SWITCH Macro

; SWITCH Macro -- Defines bit positions.  The symbol "BITPOS" must be set
;		  to zero before invoking the first SWITCH macro.
;
;		  BITPOS=0

DEFINE	SWITCH	(NAME)<
	IFNDEF	BITPOS,<BITPOS==0>
	BITPOS=BITPOS+1
	IFG	<BITPOS-^D36>,<
		PRINTX	? Too many switches defined via SWITCH macro
	>
	NAME==1B<BITPOS-1>
>

;End of universal file
	END