Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/absadr.mac
There are 2 other files named absadr.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:QUICK,NOCHECK,absadr);
00300	INTEGER PROCEDURE absadr;!(x);! Any type x;
00400	COMMENT Returns the core address of the quantity x:
00500	Simple arithmetic quantity: Address of the value.
00600	Simple REF: a copy of the value. TEXT: Byte pointer to first byte.
00700	ARRAY: Copy of array address.
00800	Returns zero if an address cannot be returned.
00900	;
01000	
01100	!*;! MACRO-10 code !*;!
01200	
01300		TITLE	absadr
01400		ENTRY	absadr
01500		SUBTTL	SIMULA utility, Lars Enderin Oct 1977
01600	
01700	;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
01800	;!*** Copying is allowed.					***
01900	
02000	
02100		sall
02200		search	simmac,simmcr,simrpa
02300		macinit
02400	
02500	absadr:	PROC
02600		EXCH XWAC1,(XTAC)
02700		EXCH XWAC2,1(XTAC)
02800		JUMPE XWAC1,L8
02900		LF X1,ZFLAKD(,XWAC1)
03000		IF ;! Simple
03100		  CAIE X1,QSIMPLE
03200		   GOTO FALSE
03300		THEN
03400		  LF X1,ZFLATP(,XWAC1)
03500		  JUMPE X1,L8
03600		  IF ;! Arithmetic, character or boolean
03700		    CAILE X1,QBOOLEAN
03800		    GOTO FALSE
03900		  THEN ;! Get the address
04000		    ADDI XWAC1,(XWAC2)
04100		    HRRZS XWAC1
04200		    GOTO L9
04300		  FI
04400		  IF ;! TEXT
04500		    CAIE X1,QTEXT
04600		    GOTO FALSE
04700		  THEN ;! Byte pointer to first byte
04800		    ADDI XWAC2,(XWAC1)
04900		    LD XWAC1,(XWAC2)
05000		    LF ,ZTVSP(,XWAC1)
05100		    IDIVI 5
05200		    HLL bp(X1)
05300		    LI XWAC1,2(XWAC1)
05400		    ADDM XWAC1
05500		    GOTO L9
05600		  FI
05700		  IF ;! REF
05800		    CAIE X1,QREF
05900		    GOTO FALSE
06000		  THEN ;! Just get the value
06100		    ADDI XWAC2,(XWAC1)
06200		    IFOFFA ZFLVTD(XWAC1)
06300		     L XWAC1,(XWAC2)
06400		    HRRZS XWAC1
06500		    GOTO L9
06600		  FI
06700		  GOTO L8
06800		FI
06900		;! Not simple, should be array
07000		ADDI XWAC1,(XWAC2)
07100		SKIPA XWAC1,(XWAC1)
07200	L8():!	 SETZ XWAC1,
07300	L9():!	EXCH XWAC2,1(XTAC)
07400		EXCH XWAC1,(XTAC)
07500		RET
07600		EPROC
07700	
07800	bp:	POINT 7,2,-1
07900		POINT 7,2,6
08000		POINT 7,2,13
08100		POINT 7,2,20
08200		POINT 7,2,27
08300		LIT
08400		END;