Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,NOCHECK,absadr);
INTEGER PROCEDURE absadr;!(x);! Any type x;
COMMENT Returns the core address of the quantity x:
Simple arithmetic quantity: Address of the value.
Simple REF: a copy of the value. TEXT: Byte pointer to first byte.
ARRAY: Copy of array address.
Returns zero if an address cannot be returned.
;

!*;! MACRO-10 code !*;!

	TITLE	absadr
	ENTRY	absadr
	SUBTTL	SIMULA utility, Lars Enderin Oct 1977

;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***


	sall
	search	simmac,simmcr,simrpa
	macinit

absadr:	PROC
	EXCH XWAC1,(XTAC)
	EXCH XWAC2,1(XTAC)
	JUMPE XWAC1,L8
	LF X1,ZFLAKD(,XWAC1)
	IF ;! Simple
	  CAIE X1,QSIMPLE
	   GOTO FALSE
	THEN
	  LF X1,ZFLATP(,XWAC1)
	  JUMPE X1,L8
	  IF ;! Arithmetic, character or boolean
	    CAILE X1,QBOOLEAN
	    GOTO FALSE
	  THEN ;! Get the address
	    ADDI XWAC1,(XWAC2)
	    HRRZS XWAC1
	    GOTO L9
	  FI
	  IF ;! TEXT
	    CAIE X1,QTEXT
	    GOTO FALSE
	  THEN ;! Byte pointer to first byte
	    IFONA ZFLVTD(XWAC1)
	     GOTO L8
	    ADDI XWAC2,(XWAC1)
	    LD XWAC1,(XWAC2)
	    LF ,ZTVSP(,XWAC1)
	    IDIVI 5
	    HLL bp(X1)
	    LI XWAC1,2(XWAC1)
	    ADDM XWAC1
	    GOTO L9
	  FI
	  IF ;! REF
	    CAIE X1,QREF
	    GOTO FALSE
	  THEN ;! Just get the value
	    ADDI XWAC2,(XWAC1)
	    IFOFFA ZFLVTD(XWAC1)
	     L XWAC1,(XWAC2)
	    HRRZS XWAC1
	    GOTO L9
	  FI
	  GOTO L8
	FI
	;! Not simple, should be array
	ADDI XWAC1,(XWAC2)
	L XWAC1,(XWAC1)
	GOTO L9
L8():!	SETZ XWAC1,
L9():!	EXCH XWAC2,1(XTAC)
	EXCH XWAC1,(XTAC)
	RET
	EPROC

bp:	POINT 7,2,-1
	POINT 7,2,6
	POINT 7,2,13
	POINT 7,2,20
	POINT 7,2,27
	LIT
	END;