Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/lookah.mac
There is 1 other file named lookah.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:CODE,NOCHECK,lookahead);
CHARACTER PROCEDURE lookahead;

! INSPECT fileref DO
! BEGIN
!	IF Lastitem THEN
!	lookahead:=' ' ELSE
!	BEGIN
!		lookahead:= Inchar;
!		Setpos(Pos-1)
!	END;

COMMENT * ;! MACRO-10 code * ;!

	TITLE	lookahead
	SUBTTL	SIMULA utility, Lars Enderin Sept 1975

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

	ENTRY	lookahead
	sall
	search	simmcr,simmac
	macinit

	IMG==4	;! Offset of image in file object
	DEFINE	parvalue(x,par,map)<
		L	x,par(XCB)
		IF	;! No thunk
			JUMPGE	x,FALSE
		THEN	;! Simple access
			ADDI	x+1,(x)
			LD	x,(x+1)
		ELSE	;! Use PHFV
			LI	x,(XCB)
			HRLI	x,par
			EXEC	PHFV
			.n.==x-XWAC1
			IFE 	.n.,<Z>
			IFN	.n.,<XWD .n.,[map]>
			PURGE	.n.
		FI
		>
	result==ZBI%S
	fileref==result+1
lookahead:
	PROC
	SKIPN	fileref+2(XCB)
	SKIPN	fileref(XCB)
	RTSERR	106	;!  Not exactly one parameter
	LF	,ZFLZQU(XCB,fileref)
	IF	;! Not infile or directfile
		CAIE	IOIN
		CAIN	IODF
		GOTO	FALSE
	THEN	;! Wrong qualification
		RTSERR	111
	FI

	parvalue(XWAC1,fileref)
	IF	;! not NONE
		CAIN	XWAC1,NONE
		GOTO	FALSE
	THEN
		L	XWAC3,XWAC1
		IF	;! Lastitem
			LI	XTAC,XWAC1
			EXEC	IOLI
			JUMPE	XWAC1,FALSE
		THEN	;! lookahead:=' '
			LI	XWAC1," "
		ELSE
			LD	XWAC1,IMG(XWAC3)
			SETZ	X1,
			LF	X0,ZTVSP(,XWAC1)
			ADDI	(XWAC2)
			IF	JUMPE	FALSE
			THEN	IDIVI	5
				ADD	XWAC1,X0
			FI
			HLL	XWAC1,ptab+1(X1)
			ADDI	XWAC1,2
			LDB	XWAC1,XWAC1
	FI	FI
	ST	XWAC1,result(XCB)
	BRANCH	CSEP
	EPROC

ptab:	POINT	7,2,-1
	POINT	7,2,6
	POINT	7,2,13
	POINT	7,2,20
	POINT	7,2,27
	POINT	7,2,34

	LIT
	END;