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

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,iashift);
BOOLEAN PROCEDURE iashift(a,destindex,fromindex,length,zero);
INTEGER ARRAY a; INTEGER destindex,fromindex,length; BOOLEAN zero;
COMMENT Moves length elements starting at a[fromindex] to a[destindex] ...
If zero is TRUE, clear rest of array (after destindex+length-1).
;
!*;! MACRO-10 code !*;!

	TITLE	iashift
	ENTRY	iashift
	SUBTTL	SIMULA utility, Lars Enderin Nov 1976

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


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	a==XWAC1
	destindex==XWAC2
	fromindex==XWAC3
	length==XWAC4
	zero==XWAC5
	result==XWAC1


iashift:PROC
	IF	;! Not standard Xtop
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Swap ac's
		EXCH	XWAC1,(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC4,3(XTAC)
		EXCH	XWAC5,4(XTAC)
	FI
	SKIPG	length
	SETZM	length
	LF	X1,ZARSUB(a)
	IMULI	X1,3
	ADDI	X1,3(a)	;! Address of first array element
	LF	XIAC,ZARLEN(a)
	ADDI	XIAC,(a)	;! First word after array
	STACK	X2
	ADD	destindex,OFFSET(ZARBAD)(a)
	CAIGE	destindex,(XIAC)
	CAIGE	destindex,(X1)
	GOTO	L7
	ADD	fromindex,OFFSET(ZARBAD)(a)
	CAIGE	fromindex,(XIAC)
	CAIGE	fromindex,(X1)
	GOTO	L7
	L	X2,destindex
	ADDI	X2,(length)	;! Last destination cell
	SUBI	1
	CAIGE	X2,(XIAC)
	CAIGE	X2,(X1)
	GOTO	L7		;! Out of bounds
	ADD	length,destindex	;! First word after moved segment
	CAILE	length,(XIAC)
	GOTO	L7
	IF	;! Not same segment
		CAIN	fromindex,(destindex)
		GOTO	FALSE
	THEN	;! Move it
		HRL	fromindex
		HRR	destindex
		BLT	(X2)
	FI
	IF	;! Rest to be cleared
		JUMPE	zero,FALSE
		CAILE	length,-1(XIAC)
		GOTO	FALSE
	THEN
		SETZM	(length)
		IF	;! More than one word
			CAIL	length,-1(XIAC)
			GOTO	FALSE
		THEN
			HRL	length
			HRRI	1(length)
			BLT	-1(XIAC)
	FI	FI
	GOTO	L8
L7():!	TDZA	result,result
L8():!	SETO	result,
L9():!	UNSTK	X2
	IF	;! Non-standard ac's
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Restore
		EXCH	XWAC5,4(XTAC)
		EXCH	XWAC4,3(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC1,(XTAC)
	FI
	RETURN
	EPROC
	LIT
	END;