perm filename CHECKI.MAC[SIM,SYS] blob sn#460004 filedate 1979-07-20 generic text, type T, neo UTF8
COMMENT * SIMULA specification;
OPTIONS(/E:CODE,checkint);
INTEGER PROCEDURE checkint(t);    NAME t;    TEXT t;

COMMENT CHECKINT analyses the text t from t.pos and on.
If a getint operation from this position is legal the
returned value is +1. If it would give an error - then
if the remaining text string is blank, the result is 0,
else -1. Pos is placed after a legal item (+1),
after the first nonblank illegal character (-1) or after
the text if the rest is empty (0).
;

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

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

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


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	result==ZBI%S
	t==result+1

checkint:PROC
	LI	XTAC,TXGI
	BRANCH	.check
	EPROC
;! INTEGER PROCEDURE .check(t,pf);!
;! NAME t;! TEXT t;! INTEGER PROCEDURE pf;!

	ENTRY	.check
.check:	PROC
	ST	XTAC,result(XCB)	;! Proc address
	LI	XWAC1,t
	HRLI	XWAC1,(XCB)
	EXEC	PHFT
	XWD	0,0
	HLRZ	XWAC3,XWAC1
	ADDI	XWAC3,(XWAC1)
	HRLZ	1(XWAC3)	;! Pos
	LD	XWAC5,(XWAC3)	;! Save old text var
	ADDM	(XWAC3)		;! Compute rest
	MOVN
	ADDM	1(XWAC3)
	ZF	ZTVCP(XWAC3)		;! Pos:=1
	LI	XWAC1,(XWAC3)
	HRROI	XTAC,XWAC1
	PUSHJ	XPDP,@result(XCB)	;! Call get... proc
	LI	XWAC1,1			;! Ok result
	IF	;! Error return
		JUMPL	XTAC,FALSE
	THEN	;! Result = 0 or -1
		LD	XWAC1,(XWAC3)	;! Text var
		HRLZ	XWAC2		;! Pos
		ADDM	XWAC1		;! added to offset
		MOVN
		ADDM	XWAC2		;! Subtracted from length
		LI	XTAC,XWAC1
		EXEC	TXST	;! Strip
		IF	;! rest(t).Strip==NOTEXT
			JUMPN	XWAC1,FALSE
		THEN	;! check := 0;! t.Setpos(0)
			HLRS	1(XWAC3)
		ELSE
			AOS	1(XWAC3)	;! Same defect as SIMULA spec - skip 1st illegal char
			SETO	XWAC1,
	FI	FI
	LF	,ZTVCP(XWAC3)
	ADDM	XWAC6
	STD	XWAC5,(XWAC3)
	ST	XWAC1,result(XCB)
	BRANCH	CSEP
	EPROC

	LIT
	END;