Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50463/05/vdlno.mac
There are 2 other files named vdlno.mac in the archive. Click here to see a list.
00100	COMMENT * vdlno, SIMULA specification;
00200	OPTIONS(/E:QUICK,vdlno);
00300	INTEGER PROCEDURE vdlno(t); TEXT t;
00400	COMMENT T is assumed to be a main text or an initial subtext of a main
00500	text which probably starts with a 5-digit decimal (line) number.
00600	VDLNO returns that number if valid, otherwise returns -1.
00700	;
00800	
00900	!*;! MACRO-10 code !*;!
01000	
01100		TITLE	vdlno
01200		ENTRY	vdlno
01300		SUBTTL	SIMULA utility, Lars Enderin Feb 1979
01400	
01500	;!*** Copyright 1979 by the Swedish Defence Research Institute. ***
01600	;!*** Copying is allowed.					***
01700	
01800	
01900		sall
02000		search	simmac,simmcr,simrpa
02100		macinit
02200	
02300		;! Local definitions ;!
02400	
02500		t==<result==0>
02600	
02700	vdlno:	PROC
02800		SKIPN X1, t(XTAC)	;! Address of text object
02900		 GOTO L9		;! NOTEXT gives -1
03000		L X0,2(X1)		;! First word of text
03100		XOR X0, ZEROS		;! Should have ones corresp. to
03200		TDNE X0, ZEROS		;! this mask
03300		 GOTO L9		;! Not all 5 chars were digits
03400		ADD X0, SIXES		;! Change range 0-9 to 6-15
03500		TDNE X0, ZEROS		;! No overflow if "9" was max digit
03600		 GOTO L9		;! Some non-digit was included
03700		SUB X0, SIXES		;! Restore to range 0-9 for each char
03800		TRO X0,1		;! Marker for end of ROTC loop
03900		SETZ X1,		;! Digit to be shifted to X1, clear
04000		ROTC X0, 7		;! Shift first digit to X1
04100		L XIAC, X1		;! Initial value for result
04200		LOOP
04300			SETZ X1,	;! Clear for next digit
04400			ROTC X0, 7	;! Place it in X1
04500			IMULI XIAC,^D10	;! Accumulated power of ten
04600			ADDI XIAC, (X1)	;! Next digit
04700		AS
04800			JUMPG X0, TRUE	;! Finished when 1 turns up as sign
04900		SA
05000		ST XIAC, result(XTAC)	;! Result = line number
05100		RET
05200	
05300	L9():!	SETOM result(XTAC)	;! Result = -1, no line number
05400		RET
05500	
05600	ZEROS:	BYTE (7) 60, 60, 60, 60, 60
05700	SIXES:	BYTE (7) 06, 06, 06, 06, 06
05800		EPROC
05900		LIT
06000		END;