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

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,-CHECK,initem);
TEXT PROCEDURE initem;!(fileref); !REF(Infile Or Directfile) fileref;
COMMENT Skips any blanks or tabs, starting at Image.Pos. If Image.More
holds then, an item is identified according to the following rules:
a) If the first following character is a letter (a-z,A-Z), an identifier is found.
The identifier consists of the initial letter and any following letters and/or
decimal digits.
b) If the first character is a digit, we have a numeric item, consisting of a
string of digits with at most one decimal point "." included.
c) Any other character except blank or tab forms an item on its own.

Example: "IF car.wheel_size > 13.5" will be split into the items
	"IF", "car", ".", "wheel", "_", "size", ">", "13.5"
via successive calls to INITEM.

The value of INITEM is a subtext reference to the item within Image, or NOTEXT if
no item can be found starting at Image.Pos. Image.Pos will be placed after the item.
;

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

	TITLE	initem
	ENTRY	initem
	SUBTTL	SIMULA utility, Lars Enderin Jan 1976

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


	EXTERN	getitem

	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	fileref==XWAC1	;! ZFL for parameter
	simpleref==1B<%ZFLNTH>+<QSIMPLE>B<%ZFLAKD>+<QREF>B<%ZFLATP>
	simpleref==simpleref+<QDTVSI>B<%ZFLDTP>

initem:
	PROC
	EXCH	XWAC1,(XTAC)	;! Normalize ac contents
	EXCH	XWAC2,1(XTAC)
	STACK	XTAC
	HLRE	XTAC		;! - number of parameters
	IF	;! Not exactly one parameter
		AOJE	FALSE
	THEN	;! Error
		RTSERR	QDSCON,106
		GOTO	L2
	FI
	LF	,ZFLAKD(,XWAC1)
	IF	;! Not simple ref
		CAIN	QSIMPLE
		GOTO	FALSE
	THEN	;! Error
		RTSERR	QDSCON,113
		GOTO	L2
	FI
	LF	,ZFLATP(,XWAC1)
	IF	;! NOT REF
		CAIN	QREF
		GOTO	FALSE
	THEN
		RTSERR	QDSCON,107
		GOTO	L2
	FI
	LF	,ZFLZQU(,XWAC1)
	IF	;! Not an input file
		CAIE	IOIN
		CAIN	IODF
		GOTO	FALSE
	THEN	;! Wrong qualif
		JUMPE	L3	;! NONE has no qualif, stands for SYSIN
		RTSERR	QDSCON,111
L2():!		OUTSTR	[ASCIZ/
[SYSIN assumed for Initem]
/]
L3():!		LOWADR
		L	XWAC1,YSYSIN(XLOW)
	ELSE	;! Seems ok, evaluate reference
		ADDI	XWAC2,(XWAC1)
		L	XWAC1,(XWAC2)
		CAIN	XWAC1,NONE
		GOTO	L3		;! Sysin assumed for NONE
	FI
	L	XWAC2,XWAC1	;! Save over Lastitem
	LI	XTAC,XWAC1
	EXEC	IOLI
	IF	;! NOT Lastitem
		JUMPN	XWAC1,FALSE
	THEN	;! getitem(Image)
		L	XWAC1,XWAC2
		HRLI	XWAC1,(simpleref)
		LI	XWAC2,OFFSET(ZFIIMG)
		LI	XTAC,XWAC1
		EXEC	getitem
	ELSE	;! NOTEXT
		SETZB	XWAC1,XWAC2
	FI
	UNSTK	XTAC
	EXCH	XWAC2,1(XTAC)
	EXCH	XWAC1,(XTAC)
	RETURN
	EPROC
	END;