Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/comp/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;