Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/fetcha.mac
There is 1 other file named fetcha.mac in the archive. Click here to see a list.
COMMENT* SIMULA specification;
OPTIONS(/E:QUICK,fetchar);
CHARACTER PROCEDURE fetchar(t,p);
TEXT t; INTEGER p;
!	IF p>0 AND p<=t.Length
!	THEN fetchar:= t.Sub(p,1);

!*;! MACRO-10 code !;!

	TITLE	fetchar
	ENTRY	fetchar
	SUBTTL	SIMULA utility, Lars Enderin Dec 1975

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

	sall
	search SIMMCR,SIMMAC
	macinit

fetchar:LF	X1,ZTVLNG(XTAC)	;! t.Length
	SETZ			;! Initial value = Char(0)
	IF	;! p is in range
		SOSL	2(XTAC)
		CAMG	X1,2(XTAC)
		GOTO	FALSE
	THEN	;! Compute byte pointer, pick up char
		LF	,ZTVSP(XTAC)	;! offset
		ADD	,2(XTAC)	;! +p-1
		IDIVI	5
		ADD	(XTAC)
		ADDI	2
		HLL	ptab(X1)
		LDB
	FI
	ST	(XTAC)
	RETURN

ptab:	POINT	7,2,06
	POINT	7,2,13
	POINT	7,2,20
	POINT	7,2,27
	POINT	7,2,34
	END;