Google
 

Trailing-Edge - PDP-10 Archives - AP-D608C-SB - algsys.mac
There are 8 other files named algsys.mac in the archive. Click here to see a list.
;
;
;
;
;
;
;	COPYRIGHT (C) 1975,1976,1977,1978
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
;	SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY 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 EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
;	AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
;	SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
;	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
;	NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;
;; COPYRIGHT 1971,1972,1973,1974 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

; THIS FILE MUST BE COMPILED AFTER ALGPRM, AND BEFORE ALGLIB

	SEARCH	ALGPRM		; SEARCH MAIN PARAMETER FILE

	SALL

%UNIVERSAL(ALGSYS,ALGOL LIBRARY PARAMETER FILE)
SUBTTL	LIBRARY MACROS

	; %ENTER - GENERATES ENTRY %NNNA OR %NNNI AS MANY TIMES AS NEEDED

	DEFINE	%ENTER(ALIAS),<
	IRP	ALIAS	<
		IFE	PROC-KA10,
			<ENTRY	%'ALIAS'A
>
		IFN	PROC-KA10,
			<ENTRY	%'ALIAS'I
>>>


	; LIBENT - GENERATES POST-MORTEM BLOCK, POINTER TO IT & PARAM CALL
	;  FOR LIBRARY ROUTINES THAT LOOK LIKE GENUINE ALGOL PROCEDURES
	;
	; CALL - LIBENT(ALIAS-#,NAME,V)
	;
	; WHERE:	ALIAS-# IS THE 1-,2- OR 3-DIGIT ALIAS NUMBER
	;		(WHICH AGREES WITH THE LIB MACRO IN ALGCON)
	;		FROM WHICH THE PROCEDURE'S ENTRY-POINT NAME IS FORMED,
	;		VIZ: %NNNA FOR KA10 OBJECT OR %NNNI FOR KI10.
	;
	;		NAME IS THE SIXBIT NAME OF THE PROCEDURE:
	;		THIS IS DUMPED INTO THE POST-MORTEM BLOCK
	;		FOR THE RUN-TIME TRACE PACKAGE TO TYPE OUT.
	;
	;		V  IS OPTIONAL. IF PRESENT, THE PROCEDURE HAS A
	;		VARIABLE NUMBER OF PARAMETERS (SEE, FOR EXAMPLE, IMAX)
	;		AND V WILL BE THE OFFSET ON THE LOCAL STACK WHERE PARAM
	;		WILL STORE THE NUMBER OF ACTUALS.
	;
	; THE MACRO GENERATES EVERYTHING THAT IS NEEDED FOR PROCEDURE ENTRY,
	;   EXCEPT FOR THE SEARCH ALGPRM,ALGSYS WHICH MUST PRECEDE IT.
	;   THE JSP AX,PARAM  OR  PAR0 IS GENERATED, AND THE P.M. BLOCK
	;   POINTER, BUT NOT THE DESCRIPTOR-WORDS THAT FOLLOW.  ENTRY
	;   STATEMENTS ARE GENERATED, AND THE NAME IS PUT INTO THE CREF FOR
	;   EASE OF FINDING THE PROCEDURE IN A LARGE LIBRARY-LISTING.

	DEFINE	LIBENT(ALIAS,NAME,V,%X) <
	IFE	PROC-KA10,<
	ENTRY	%'ALIAS'A
>
	IFN	PROC-KA10,<
	ENTRY	%'ALIAS'I
>

	IFNDEF	%ALGDR,<
	EXTERNAL	%ALGDR
	SALL
	%SUBTTL(ALGLIB,ALGOL LIBRARY)
>
%X:	Z			;; PROFILE WORD
	ZZZ==1			;; ALLOW 1 FOR THE *
	IRPC	NAME,<ZZZ==ZZZ+1>;; COUNT BYTES
	XWD	<ZZZ/6+1>,ZZZ	;; WORDS,,BYTES
	SIXBIT\NAME'*\
	IFE	<<ZZZ/6>*6-ZZZ>,<
	Z			;; SIXBITZ WORD !
	>
	IFNB	<V>, <
	XWD	DL,V		;; VARIABLE # PARAMS
NAME:				;; FOR CREF
LABEL(ALIAS):	JSP	AX,PAR0>
	IFB	<V>, <
NAME:				;; FOR CREF
LABEL(ALIAS):	JSP	AX,PARAM>
	EXP	%X		;; POINTER TO PMB BLOCK
	PURGE	NAME		;; JUST IN CASE
>

	; STDENT - DOES THE SAME THINGS AS LIBENT, FOR
	; STANDARD FUNCTIONS (LIKE SIN) WHICH DON'T CALL
	; PARAM. IT MAKES A P.M. BLOCK, AND PLANTS A CALL
	; TO THE OTS ROUTINE TRSTD WHICH DOES TRACING
	; IF REQUIRED.
	;
	; CALL - STDENT(ALIAS-#,NAME)
	;
	; WHERE THE PARAMETERS ARE AS FOR LIBENT

	DEFINE	STDENT(ALIAS,NAME,%X) <
	IFE	PROC-KA10,<
	ENTRY	%'ALIAS'A
>
	IFN	PROC-KA10,<
	ENTRY	%'ALIAS'I
>

	IFNDEF	%ALGDR,<
	EXTERNAL	%ALGDR
	SALL
	%SUBTTL(ALGLIB,ALGOL LIBRARY)
>

%X:	Z			;; PROFILE WORD
	ZZZ==1
	IRPC	NAME,<ZZZ==ZZZ+1>;; COUNT CHARS IN NAME.
	XWD	<ZZZ/6+1>,ZZZ	;; WORDS,,CHARS
	SIXBIT\NAME'*\
	IFE	<<ZZZ/6>*6-ZZZ>,<
	Z			;; SIXBITZ WORD !
>

NAME:				;; FOR CREF
LABEL(ALIAS):			;; ENTRY
	PUSHJ	SP,TRSTD
	EXP	%X
	PURGE	NAME
>

	; LABEL MACRO - GENERATES %NNNA OR %NNNI FOR KA OR KI

	IFE	PROC-KA10,<
	DEFINE LABEL(M),<%'M'A>>
	IFN	PROC-KA10,<
	DEFINE LABEL(M),<%'M'I>>

	; EXTLAB MACRO - GENERATES EXTERN %NNNA OR %NNNI AS MANY TIMES
	; AS NEEDED

	DEFINE EXTLAB(M),<
	IRP	M	<
	IFE	PROC-KA10,
	<EXTERN	%'M'A
>
	IFN	PROC-KA10,
	<EXTERN %'M'I
>>>
SUBTTL LONG REAL ARITHMETIC MACROS

			DEFINE DOP(X,N,B)
<	DEFINE X'N(Z)
<	IFE PROC-KA10, <
	IFNDEF %'B'A,<
	EXTERNAL %'B'A
>
	MOVEI	AX,Z
	PUSHJ	SP,LABEL(B)>
	IFE PROC-KI10, <
	IFIDN <N> <0>, <
	X	A0,Z>
	IFIDN <N> <3>, <
	X	A3,Z>
	IFIDN <N> <6>, <
	X	A6,Z>
	IFIDN <N> <9>, <
	X	A11,Z>>
>
>

	DOP	DFAD,0,17
	DOP	DFSB,0,20
	DOP	DFMP,0,21
	DOP	DFDV,0,22

	DOP	DFAD,3,25
	DOP	DFSB,3,26
	DOP	DFMP,3,27
	DOP	DFDV,3,30

	DOP	DFAD,6,33
	DOP	DFSB,6,34
	DOP	DFMP,6,35
	DOP	DFDV,6,36

	DOP	DFAD,9,41
	DOP	DFSB,9,42
	DOP	DFMP,9,43
	DOP	DFDV,9,44

SUBTTL LONG REAL CONSTANT MACRO
;
;	THIS MACRO WAS LIFTED STRAIGHT FROM FORTRAN
;	TO ALLOW THE CONDITIONAL ASSEMBLY OF LONG
;	REAL CONSTANTS IN EITHER KI OR KA FORMAT
;
;

	IFE PROC-KI10, <
	DEFINE DOUBLE(A,B) <
	A
	B>
>

	IFE PROC-KA10, <
	DEFINE DOUBLE (A,B)<
	ZZ1.==A&<777000,,0>
	IFL ZZ1.,<ZZ1.==-ZZ1.-<1000,,0>>
	ZZ1.==ZZ1.-<033000,,0>
	IFE B,<ZZ1.==0>
	ZZ2.==ZZ1.+<<B+200>_-8>&<000777,,777777>
	IFL ZZ1.,<ZZ2.==0>
	A
	ZZ2.
	SUPPRESS ZZ1.,ZZ2.>
	>
SUBTTL ALGOTS ROUTINE ADDRESS MACROS

	DEFINE R(A,B)
	<DEFINE B
	<@%ALGDR+A>>

	DEFINE JRST(A)
	<Q=Q+1
	R \Q,A>



; WHEN THIS IS CHANGED, DEFINITIONS AT OR ABOUT LINE 974 OF
; ALGMAC MAY HAVE TO BE CHANGED ALSO.

	DEFINE ALGDIR <
	Q=-1

	JRST	INITIA		; 0- INITIALIZATION
	JRST	PARAM		; 1- PROCEDURE PARAMETER ORGANIZATION
	JRST	PAR0		; 2-DITTO, VARIABLE LENGTH
	JRST	GOLAB		; 3-GOTO LABEL
	JRST	ARRAY		; 4-ARRAY LAYOUT
	JRST	OARRAY		; 5-OWN ARRAY LAYOUT
	JRST	CHKARR		; 6-CHECK ARRAY SUBSCRIPTS
	JRST	COMPAR		; 7-COMPARE STRINGS
	JRST	PBYTE		; 10-BYTE POINTER
	JRST	BLKBEG		; 11-BLOCK BEGIN
	JRST	BLKEND		; 12-BLOCK END
	JRST	CPYSTR		; 13-COPY STRING
	JRST	CPYARR		; 14-COPY ARRAY
	JRST	GETOWN		; 15-GET OWN SPACE
	JRST	GETCLR		; 16-GET OWN SPACE - ZEROED
	JRST	MONIT		; 17-MONITOR
	JRST	MONIT0		; 20-MONITOR WITH BREAK
	JRST	RDOCT		; 21-READ OCTAL WORD
	JRST	PROCT		; 22-PRINT OCTAL HALFWORD
	JRST	INBYTE		; 23-INPUT BYTE
	JRST	OUBYTE		; 24-OUTPUT BYTE
	JRST	NXTBYT		; 25-NEXT INPUT BYTE (LOOK AHEAD)
	JRST	BRKBYT		; 26-BREAK OUTPUT
	JRST	INCHAR		; 27-READ CHARACTER
	JRST	OUCHAR		; 30-OUTPUT CHARACTER
	JRST	BRKCHR		; 31-BREAKCHARACTER
	JRST	READ.		; 32-READ
	JRST	PRINT.		; 33-PRINT
	JRST	SELIN		; 34-SELECT INPUT
	JRST	SELOUT		; 35-SELECT OUTPUT
	JRST	INPT		; 36-INPUT
	JRST	OUTPT		; 37-OUTPUT
	JRST	RELESE		; 40-RELEASE
	JRST	OPFILE		; 41-OPEN FILE
	JRST	CLFILE		; 42-CLOSE FILE
	JRST	XFILE		; 43-TRANSFER FILE
	JRST	BSPACE		; 44-BACKSPACE
	JRST	ENFILE		; 45-ENDFILE
	JRST	REWND.		; 46-REWIND
	JRST	STRASS		; 47-STRING ASSIGNMENT
	JRST	FUNCT		; 50-OVERLAY HANDLER
	JRST	TRLPRT		; 51-PRINT TRACE LIST
	JRST	TRLAB		; 52-TRACE LABEL ENTRY
	JRST	TRSTD		; 53-TRACE STANDARD FUNCTION
	JRST	STRDEC		; 54-DECLARE STRINGS
	JRST	DDDUMP		; 55-DDT DUMP ROUTINE.
	JRST	INCHR0		; [E145] 56-READ CHARACTER WITH EOF LEGAL

>
	ALGDIR			; CALL ALGDIR MACRO

	PURGE JRST		; KILL JRST MACRO

SUBTTL	VARIOUS DEFINITIONS

; GETTAB NUMBERS

.GTCNF==11			; CONFIGURATION TABLE
%CNYER==56			; YEAR
%CNMON==57			; MONTH
%CNDAY==60			; DAY
%CNHOR==61			; HOUR
%CNMIN==62			; MINUTE
%CNSEC==63			; SECOND

	END