Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/24/tagord.mac
There are 2 other files named tagord.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,tagord);
TEXT PROCEDURE tagord(tt); NAME tt; TEXT tt;
COMMENT Skips any blanks or tabs, starting at tt.Pos. If tt.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 or '_' (underline).
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 TAGORD.

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

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

	TITLE	tagord
	ENTRY	tagord
	SUBTTL	SIMULA utility, Lars Enderin Mar 1977

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


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	tt==XWAC1	;! ZFL for parameter
	t1==XWAC2	;! byte pointer
	t== XWAC1	;! Address of descriptor for tt
	sp==XWAC4	;! starting position of item

tagord:
	PROC
	EXCH	XWAC1,(XTAC)	;! Normalize ac contents
	EXCH	XWAC2,1(XTAC)
	SAVE	<XTAC,XWAC3,XWAC4>
	ADDI	t1,(tt)		;! Address of ZTV for tt
	L	t,t1		;! t:-tt
	LF	,ZTVSP(t)
	LF	X1,ZTVCP(t)
	LF	sp,ZTVLNG(t)
	ADDI	2*5(X1)		;! Offset to first byte of rest(tt)
	IDIVI	5
	LF	t1,ZTVZTE(t)
	ADDM	t1		;! Word address of first byte
	HLL	t1,ptab(X1)	;! Byte pointer to it
	LF	X1,ZTVLNG(t)
	LF	,ZTVCP(t)
	SUB	X1,		;! rest(t).Length
	JUMPLE	X1,L9	;! NOTEXT
	LOOP	;! Skipping spaces and tabs
		ILDB	t1	;! window:=t.Getchar
		AOS	1(t)
	AS
		CAIE	" "
		CAIN	"	"
		SOJG	X1,TRUE
	SA
	JUMPLE	X1,L9		;! NOTEXT
	LF	sp,ZTVCP(t)	;! Start pos of item
	SUBI	sp,1
	ST	X2	;! Save char
	IF	;! Bokstav(window)
		CAIGE	X2,"#"
		GOTO	FALSE
		CAIG	X2,"z"
		GOTO	L1
		CAIE	X2,"}"
		CAIN	X2,"{"
		GOTO	TRUE
		GOTO	FALSE
L1():!		CAIG	"$"
		GOTO	TRUE
		TRZ	X2," "
		CAIL	X2,"@"
		CAILE	X2,"Z"
		GOTO	FALSE
	THEN	;! Identifier
		LOOP
			SOJL	X1,out
			ILDB	t1
			AOS	1(t)
		AS	;! Bokstav(window) OR Digit(window) OR window='_'
			CAIGE	"#"
			GOTO	FALSE	;! "#" is lowest possible
			CAIG	"$"	;! "$" is next
			GOTO	TRUE
			CAIGE	"0"
			GOTO	FALSE
			CAIG	"9"
			GOTO	TRUE	;! Digit
			CAIGE	"@"
			GOTO	FALSE
			CAIG	"Z"
			GOTO	TRUE	;! Upper case Swedish letter
			CAIGE	"_"
			GOTO	FALSE
			CAIG	"z"
			GOTO	TRUE	;! Lower case or "_"
			CAIE	"}"
			CAIN	"{"
			GOTO	TRUE	;! Remaining lower case
			GOTO	FALSE
		SA
	ELSE	;! Numeric or other
		IF	;! Digit(window)
			CAIL	"0"
			CAILE	"9"
			GOTO	FALSE
		THEN	;! Find more digits, at most one "."
			LI	X2,1	;! First time through
		L8():!	LOOP
				SOJL	X1,out
				ILDB	t1
				AOS	1(t)
			AS	;! Digit(window)
				CAIL	"0"
				CAILE	"9"
				GOTO	FALSE
				GOTO	TRUE
			SA
			IF	;! First time we find a non-digit
				SOJL	X2,FALSE
			THEN	;! Accept a "." only
				CAIN	"."
				GOTO	L8	;! To find fraction
			FI
		ELSE	;! Account for the character
			AOS	1(t)
	FI	FI
	LF	,ZTVCP(t)	;! t.Pos-1
	CAILE	1(sp)
	SOS	1(t)
out:	LI	XWAC2,(t)
	LD	XWAC1,(XWAC2)
	MOVSI	X1,(sp)
	MOVSI	XWAC2,(XWAC2)
	SUB	XWAC2,X1
	ADD	XWAC1,X1
	SKIPN	XWAC2
L9():!	SETZB	XWAC1,XWAC2
	RESTORE
	EXCH	XWAC2,1(XTAC)
	EXCH	XWAC1,0(XTAC)
	POPJ	XPDP,
	EPROC

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

	LIT
	END;