Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0066/star.snb
There are 2 other files named star.snb in the archive. Click here to see a list.
00100		VER = '6.0.'
00200		&STLIMIT = 9999999
00300	*SNO*	DEFINE('LPAD(LPAD,N,SYM)')
00400	*SNO*	DEFINE('RPAD(RPAD,N,SYM)')
00500		&TRIM = 1
00600	*	TRACE('ADDR')	TRACE('INREG')	TRACE('R')
00700	*	TRACE('TYPE')		TRACE('L.TYPE') 	TRACE('R.TYPE')
00800	*	TRACE('R.F')		TRACE('L.F')		TRACE('LR')
00900	*	TRACE('ADDR')	TRACE('L.ADDR') TRACE('R.ADDR')
01000		DEFINE('ASS(T1,T2,T3,T4)')
01100		DEFINE('ASSNL(T2,T3,T4)T1','ASS')
01200		DEFINE('CALL(SUBROUT)')
01300		DEFINE('CALLSRT()')
01400		DEFINE('CHAR(STRING)')
01500		DEFINE('CKSBSET()')
01600		DEFINE('CKREG()')
01700		DEFINE('CKREGD()')
01800		DEFINE('CKTYPE(POS,CHAR)')
01900		DEFINE('CKTYPET(POS,CHAR,TYPE)','CKTYPE')
02000		DEFINE('CLRREG()')
02100		DEFINE('COMMENT(STATE)')
02200		DEFINE('COMPILE()ADDR,THISOP')
02300		DEFINE('COMPLR()')
02400		DEFINE('COMPOP()')
02500		DEFINE('DEC2OCT(N)')
02600		DEFINE('DO.CALL(OPERAND)')
02700		DEFINE('DS(BASE,LEN)')
02800		DEFINE('ENDOFF()')
02900		DEFINE('ERROR(MESS,ETYPE)')
03000		DEFINE('FILLTAB(FILLTAB,TEMP)')
03100		DEFINE('FLIP()')
03200		DEFINE('GEN()')
03300		DEFINE('GENCALL(LOC)')
03400		DEFINE('GENLAB(LABEL)')
03500		DEFINE('GENLD()')
03600		DEFINE('GENLOAD(R,ADDR)')
03700		DEFINE('GENLOG(OP,LOC)')
03800		DEFINE('GETCONT(PARM,WHEN)BASELOC,LREG')
03900		DEFINE('GETLAB()')
04000		DEFINE('GETREG()')
04100		DEFINE('GETTYPE(POS)')
04200		DEFINE('INIT()')
04300		DEFINE('OFFLOC(LOC)')
04400		DEFINE('OFFREG(R)')
04500		DEFINE('PUT(STRING)')
04600		DEFINE('PUTREG(R,ADDR)')
04700		DEFINE('RADIX(RADIX)')
04800		DEFINE('SETTYPE(POS,CHAR)')
04900		DEFINE('STATSRT()')
05000		DEFINE('TABSTM()')
05100	**
05200		IDTAB = TABLE(10,5)
05300		DATA('ID(TAB.LEN,TAB.OFF,TAB.TYPE,TAB.BASE,TAB.MASK,TAB.RANGE)')
05400		REENT.OFF = TABLE(10,5)
05500		DSCONT = TABLE(10,5)
05600	**
05700		BLANK = ' ' TAB
05800		CB = SPAN(BLANK)
05900		B = CB ! NULL
06000		DIGIT = '0123456789'
06100		NUMB = SPAN(DIGIT)
06200		LITERAL = (ANY('+-') ! '') NUMB
06300	.		! '=' ANY('AC') LEN(1) $ T1 BREAK(*T1) *T1
06400		LET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ#$'
06500		AVAR = ANY(LET) (SPAN(LET DIGIT) ! NULL)
06600		VAR = ANY(LET) (SPAN(DIGIT) ! NULL)
06700		MINUS = DUPL('-',28)
06800	**
06900		OPS = 'DO' ! 'IFANY' ! 'IF' ! 'BFIELDE' ! 'FIELD' !
07000	.		'BBLOCKE' ! 'BLOCK' ! 'BEGIN' ! 'FINISH' !
07100	.		'YBLOCKE' ! 'BBLOCK' ! 'BFIELD' ! 'YBLOCK' ! 'CALLS'
07200		CARD.PARSE = POS(0) (BREAK(BLANK) ! NULL) . LABEL CB
07300	.		OPS . OPCODE B REM . OPERAND
07400		OPER.PARSE = POS(0) '(' (
07500	.		BREAK(',') . LEFT ',' BREAK(',') . OPR ','
07600	.		BREAK(')') . RIGHT !
07700	.		BREAK(',') . OPR ',' BREAK(')') . LEFT '' . RIGHT
07800	.		) ')' RPOS(0)
07900		CALL.PARSE = POS(0) (
08000	.		BREAK(',') . SUB ',(' BAL . ARGS ')' !
08100	.		REM . SUB '' . ARGS
08200	.		) RPOS(0)
08300		BREAK.TAB = BREAK(',') . T1 ',' BREAK('"') . T2 '"'
08400	**
08500		BFIELD.PARSE = POS(0) VAR . N1 ',' AVAR . BASE
08600		FIELD.PARSE = POS(0) VAR . N1 ',' NUMB . OFF ',(' NUMB . LOW ','
08700	.		NUMB . HIGH ')'
08800		BLOCK.PARSE = POS(0)  VAR . N1 ',(' NUMB . OFF ','
08900	.		NUMB . LEN ')'
09000		BBLOCK.PARSE = POS(0) VAR . N1 ',(' AVAR . BASE  ','
09100	.		NUMB . LEN ')'
09200	**
09300		LF = 0
09400		BF = 1
09500		TF = 2
09600		DF = 3
09700	*******
09800	**
09900	** TYPE FLAGS TO IDENTIFY EACH TYPE
10000	**
10100	**POS	NAME		CONTENTS
10200	**---	----		--------
10300	**0	LF(LEN FLD)	Y(BYTE), W(WORD), 1(1 BIT), L(LT 1 WD), G(GT 1
10400	**1	BF(BASE FLD)	B(BASED), -(NONBASED)
10500	**2	TF(TYPE FLD)	B(BLOCK), F(FIELD)
10600	**3	DF(DEF FLD)	E(DEFINED), -(UNDEF)
10700	********
10800	**
10900	**
11000		SW.REG = '1'
11100		CLRREG()
11200		INIT()
11300		SCSC = SC SC
11400		BRANCH = LOGOP<'<>'>
11500		VER = 'VERSION ' VER '	' DATE() '   WECO<-ERC<-STONE'
11600		OUTPUT = VER
11700		COMMENT(OUTPUT)
11800		SWITCH.CK = POS(0) ('*' ! '')
11900	.		('+' REM . T1 . T2 !
12000	.		'-' REM . T1 '' . T2)
12100		GET.THIS.OP = POS(0) BAL . THISOP (',' ! ' ' REM ! RPOS(0))
12200		CK.LIT = POS(0) LITERAL RPOS(0)
12300		GET.VAR.X = POS(0) VAR . X
12400	**
12500		IDTAB<'#1'> = ID(100,0,'WBB-')
12600		IDTAB<'#2'> = ID(ADDR.WORD,0,'W-B-')
12700		IDTAB<'#3'> = ID(ADDR.WORD,0,'WBF-',SCSC '3')
12800		IDTAB<'#4'> = ID(ADDR.WORD,0,'WBF-',SCSC '4')
12900	**
13000	LOOP	CARD = INPUT		:F(END)
13100		STATENO = STATENO + 1
13200		OUTPUT = RPAD(STATENO,8) CARD
13300		CARD POS(72) REM =	:F(CKSW)
13400		CARD = TRIM(CARD)
13500	CKSW	CARD SWITCH.CK		:F(TRYCOM)
13600		$('SW.' T1) = T2	:(LOOP)
13700	TRYCOM	CARD POS(0) ANY('*/;')	:S(ASSEMC)
13800		IDENT(CARD)		:S(ASSEMC)
13900		CARD CARD.PARSE 	:F(ASSEMB)
14000		( COMMENT(MINUS) COMMENT(OUTPUT) )
14100		THENSW = '1'
14200		( IDENT(OPCODE,'FINISH') ENDOFF() )
14300		( STATSRT() CALL(OPCODE) )	:(LOOP)
14400	**
14500	ASSEMC	COMMENT(CARD)		:(LOOP)
14600	**
14700	ASSEMB	PUT(CARD)		:(LOOP)
14800	**
14900	********
15000	** STATEMENT HANDLING
15100	********
15200	DO	COMPILE()		:F(RETURN)S(DO)
15300	**
15400	IFANY	BTYPE = 'Y'
15500	IFANY2	LAB1 = GETLAB()
15600		LAB2 = GETLAB()
15700		THENSW =
15800		LLAB = IDENT(BTYPE,'Y') LAB1	:S(IFANY1)
15900		LLAB = LAB2
16000	IFANY1	COMPILE()			:S(IFANY1)
16100		GENLAB(LAB2)
16200		( IDENT(THENSW) ERROR('NO THEN IN IF') )	:(RETURN)
16300	**
16400	IF	BTYPE = 'N'			:(IFANY2)
16500	**
16600	BFIELD	T = 'WBF-' :(TB)
16700	BBLOCK	T = 'WBB-' :(TB)
16800	YBLOCK	T = 'Y-B-' :(TB)
16900	YBBLOCK T = 'YBB-' :(TB)
17000	BFIELDE T = 'WBFE' :(TB)
17100	BBLOCKE T = 'WBBE' :(TB)
17200	BLOCK	T = 'W-B-' :(TB)
17300	FIELD	T = '--F-' :(TB)
17400	TB	TYPE = T
17500		LEN = 1
17600		Y =
17700		OPCODE POS(0) 'Y' . Y =
17800		OPCODE RPOS(1) 'E' =
17900		OPERAND $(OPCODE '.PARSE')	:S(TABSTOR)
18000		ERROR('SYNTAX') 		:(RETURN)
18100	TABSTOR	LOW = REMDR(LOW,WSIZE)
18200		HIGH = REMDR(HIGH,WSIZE)
18300		RANGE = LOW ',' HIGH
18400		( EQ(LOW,0) EQ(HIGH + 1,WSIZE) SETTYPE(LF,'W') )
18500		( EQ(LOW,HIGH) IDENT(OPCODE,'FIELD') SETTYPE(LF,'1') )
18600		T1 = HIGH + 1 - LOW
18700		( EQ(T1,HSIZE) EQ(REMDR(LOW,HSIZE),0) SETTYPE(LF,'H') )
18800		( EQ(T1,BSIZE) EQ(REMDR(LOW,BSIZE),0) SETTYPE(LF,'Y') )
18900		( GT(LEN,1) \CKTYPE(BF,'B') ERROR('WARNING..NON-BASED LEN>1') )
19000		LEN = DIFFER(Y,'Y') ADDR.WORD * LEN
19100		OFF = DIFFER(Y,'Y') ADDR.WORD * OFF
19200		( CKTYPE(LF,'-') ERROR('ILLEGAL RANGE...BYTE ASSUMED')
19300	.		SETTYPE(LF,'Y') )
19400		TABSTM()
19500		( CKTYPE(DF,'E') DS(BASE,LEN) )
19600		IDTAB<N1> = ID(LEN,OFF,TYPE,BASE,MASK,RANGE)
19700		MASK =
19800		LOW = ; HIGH = ; OFF = ; BASE = :(RETURN)
19900	**
20000	DO.CALL
20100	CALLS	OPERAND CALL.PARSE		:F(ERR)
20200		CALLLAB = GETLAB()
20300		NARG = 0
20400		TAB.BASE(IDTAB<'#1'>) = CALLLAB
20500		TP2 = IDTAB<'#2'>
20600		TAB.OFF(TP2) = 0
20700		REENT.OFF<CALLLAB> = DIFFER(SW.REENT) TOTSTORE
20800		CALLSRT()
20900	CALLLP	ARGS POS(0) SPAN(LET DIGIT) . ARG (',' ! RPOS(0)) = :F(CALLEND)
21000		NARG = NARG + 1
21100		OPERAND = '(#1#2,<-[,' ARG ')'
21200		COMPILE()
21300		TAB.OFF(TP2) = TAB.OFF(TP2) + ADDR.WORD :(CALLLP)
21400	CALLEND CLRREG() GENCALL(SUB)		:(RETURN)
21500	**
21600	COMPILE	OPERAND "=C" LEN(1) $ T1 BREAK(*T1) . T2 *T1
21700	.		= "=A'" CHAR(T2) "'"	:S(COMPILE)
21800		OPERAND GET.THIS.OP =		:F(COMPERR)
21900		THISOP OPER.PARSE		:S(COMP1)
22000		IDENT(THISOP,'THEN')		:S(O.THEN)
22100		ERROR('FUNNY OPERAND')		:(FRETURN)
22200	COMPERR DIFFER(OPERAND)
22300	.		ERROR('INCORRECT OPERAND:' OPERAND)	:(FRETURN)
22400	COMP1	SAVECOM = THISOP
22500		IDENT(THENSW)			:S(O.LOG)
22600		OP = JUMPLOC<OPR>
22700		DIFFER(OP)			:S(GOTOP)
22800		OPR POS(0) ('<-<-' ! '->->') . OPR REM . RIGHT	:S(COMP1)
22900	COMPUN1 OPR POS(0) '<-[/' =			:F(COMPUN)
23000		( DS(SCSC '4',ADDR.WORD) DS(SCSC '3',ADDR.WORD) )
23100		CKSBSET()				:F(COMFULL)
23200		RIGHT = EQ(RIGHT,1) OPR			:S(COMPLS)
23300		RIGHT = RIGHT * CONVERT(OPR,'INTEGER')	:F(COMMUL)
23400	COMPLS	OPR = '+'				:(COMP1)
23500	COMMUL	OPERAND = '(#4,<-,' RIGHT '),'
23600	.		'(#4,*,' OPR '),(' LEFT ',+,#4),'
23700	.		OPERAND 			:(COMPILE)
23800	COMFULL OPERAND = '(#3,<-[,' LEFT '),(#4,<-[,' RIGHT
23900	.		'),(#4,-,#3),'
24000	.		'(#4,*,' OPR '),(' LEFT ',+,#4),'
24100	.		OPERAND 			:(COMPILE)
24200	COMPUN	OPR POS(0) AVAR RPOS(0)			:S(COMPUN2)
24300		ERROR('UNDEFINED OPERATION...' OPR)	:(RETURN)
24400	COMPUN2	DO.CALL(OPR ',(' LEFT ',' RIGHT ')')	:(RETURN)
24500	GOTOP	IDENT(OPR,'GOTO')		:S(O.GOTO)
24600		OPR = IDENT(OPR,'<-[') CKSBSET() '+'	:S(COMP1)
24700		COMPLR()
24800		OPGO = 'O.' OP			:($OPGO)
24900	**
25000	O.THEN	THENSW = '1'
25100		( IDENT(BTYPE,'Y') GENLOG(BRANCH,LAB2)
25200	.		GENLAB(LAB1) )		:(RETURN)
25300	**
25400	O.LOG	LEFT CK.LIT			:F(O.LOGOK)
25500		T1 = LEFT ; LEFT = RIGHT ; RIGHT = T1
25600		OPR = REPLACE(OPR,'<>','><')
25700	O.LOGOK	COMPLR()
25800		OP = IDENT(BTYPE,'N') COMPOP()	:S(O.LOG1)
25900		OP = LOGOP<OPR>
26000	O.LOG1	( IDENT(OP) ERROR('UNDEF RELATION OP') )
26100		GENLOG(OP,LLAB)			:(RETURN)
26200	**
26300	COMPOP	OPR '\' =			:S(COMPOP1)
26400		OPR = '\' OPR
26500	COMPOP1	COMPOP = LOGOP<OPR>		:(RETURN)
26600	**
26700	COMPLR	GETCONT(LEFT,2) ; L.ENTRY = ENTRY
26800		L.ADDR = ADDR	; L.TYPE = TYPE ; L.F = GETTYPE(LF)
26900		GETCONT(RIGHT,1) ; R.ENTRY = ENTRY
27000		R.ADDR = ADDR	; R.TYPE = TYPE ; R.F = GETTYPE(LF)
27100		IDENT(L.F,R.F)			:S(COMPLR1)
27200		TYPE = L.TYPE
27300		( \( CKTYPE(BF,'BF') DIFFER(SW.CONV) )
27400	.		 ERROR('LEFT AND RIGHT SIZES DIFFER') )	:S(COMPLR1)
27500		ERROR('WARNING...LEFT SIZE CHANGED TO SIZE OF RIGHT')
27600		L.F = R.F
27700		SETTYPE(LF,R.F)
27800		L.TYPE = TYPE
27900		TAB.TYPE( L.ENTRY ) = L.TYPE
28000		TAB.RANGE( L.ENTRY ) = TAB.RANGE( R.ENTRY )
28100		TAB.MASK( L.ENTRY ) = TAB.MASK( R.ENTRY )
28200	COMPLR1	LR = L.F R.F			:(RETURN)
28300	**
28400	GETCONT CHAR.CNT = 0 ; OFF = 0 ; LOAD.CNT = 0
28500		PARM GET.VAR.X =		:S(GETC)
28600		PARM CK.LIT			:F(GETERR)
28700		( IDENT(WHEN,2) ERROR('LITERAL ON THE LEFT') )
28800	CKCCH	TYPE = L.TYPE
28900		PARM POS(0) "=A" LEN(1) RTAB(1) . ADDR	:S(RETURN)
29000		ADDR = '#' RADIX(PARM)		:(RETURN)
29100	GETERR	( DIFFER(PARM) ERROR('STRANGE OPERAND...' PARM) )
29200	.						:(RETURN)
29300	GETC	GEN()
29400		PARM GET.VAR.X =		:S(GETC)F(GETERR)
29500	**
29600	GEN	CHAR.CNT = CHAR.CNT + 1
29700		ENTRY = IDTAB<X>
29800		( IDENT(ENTRY) ERROR('UNDEFINED ELEMENT...' X) ) :S(RETURN)
29900		TYPE = TAB.TYPE(ENTRY)
30000		OFF = OFF + TAB.OFF(ENTRY)
30100		( DIFFER(TAB.BASE(ENTRY)) GT(CHAR.CNT,1)
30200	.		ERROR('MISPLACED BASE:' X) )
30300		EQ(CHAR.CNT,1)			:F(GEBASE)
30400		( IDENT(TAB.BASE(ENTRY)) ERROR('MISPLACED BASE:' X) )
30500		BASELOC = TAB.BASE(ENTRY)
30600		TAB.MASK(ENTRY) = TAB.MASK(ENTRY) - 1
30700		ADDR =
30800		DIFFER(SW.REENT)		:F(GEBASE)
30900		( DIFFER(SW.REG) IDENT(BASELOC,'REG') )	:S(GEBASE)
31000		LREG = REENT.REG
31100		OFF = OFF + REENT.OFF<BASELOC>
31200		BASELOC =
31300	GEBASE	( CKTYPE(TF,'B') DIFFER(PARM) )	:S(RETURN)
31400		LOAD.CNT = LOAD.CNT + 1
31500		GENLD()
31600		OFF = ; BASELOC =		:(RETURN)
31700	**
31800	GENLD	R = GETREG()
31900		( DIFFER(ADDR) CKREG() CKREGD()
32000	.		PUTREG(R,ADDR) GENLOAD(R,ADDR) )
32100		OFF = EQ(OFF)			:S(NOOFF)
32200		OFF = RADIX(OFF)
32300	NOOFF	BASELOC = DIFFER(BASELOC) DIFFER(OFF) BASELOC '+'
32400		LREG = DIFFER(LREG) '(' LREG ')'
32500		ADDR = BASELOC OFF LREG
32600		LREG = R			:(RETURN)
32700	**
32800	PUT	PUNCH = STRING			:(RETURN)
32900	**
33000	**SNO*LPAD	LPAD = DUPL(SYM,N - SIZE(LPAD)) LPAD	:(RETURN)
33100	**SNO*RPAD	SYM = IDENT(SYM) ' '
33200	**SNO*	RPAD = RPAD DUPL(SYM,N - SIZE(RPAD))	:(RETURN)
33300	**
33400	GENLAB	( DIFFER(LABEL) ASS(LABEL) CLRREG() ) :(RETURN)
33500	**
33600	FILLTAB TEMP BREAK.TAB =		:F(RETURN)
33700		FILLTAB<T1> = T2		:(FILLTAB)
33800	**
33900	ERR	ERROR('SYNTAX') 		:(RETURN)
34000	**
34100	ERROR	MESS = DIFFER(THISOP) MESS ':' THISOP
34200		TTYOUT = DIFFER(CARD) STATENO TAB CARD CRLF
34300		CARD =
34400		TTYOUT = 'ERROR-' MESS CRLF
34500		OUTPUT = '**********' MESS
34600		COMMENT(OUTPUT) 		:(RETURN)
34700	**
34800	SETTYPE TYPE POS(POS) LEN(1) = CHAR	:(RETURN)
34900	**
35000	GETTYPE TYPE POS(POS) LEN(1) . GETTYPE	:(RETURN)
35100	**
35200	CKTYPE	TYPE POS(POS) CHAR		:F(FRETURN)S(RETURN)
35300	**
35400	DEC2OCT N = CONVERT(N,'INTEGER')	:F(FRETURN)
35500		( GT(N,MAXSIZE) ERROR('GT MAX SIZE...' N) ) :S(FRETURN)
35600		DEC2OCT = LT(N,0) '-' DEC2OCT(0 - N)	:S(RETURN)
35700	D2O	DEC2OCT = REMDR(N,8) DEC2OCT
35800		N = GT(N,7) N / 8		:F(RETURN)S(D2O)
35900	**
36000	FLIP	T1 = L.ADDR ; L.ADDR = R.ADDR ; R.ADDR = T1
36100		T1 = L.ENTRY ; L.ENTRY = R.ENTRY ; R.ENTRY = T1
36200		T1 = L.F ; L.F = R.F ; R.F = T1
36300		LR = L.F R.F			:(RETURN)
36400	**
36500	GETLAB	L.CNT = L.CNT + 1
36600		GETLAB = SC L.CNT		:(RETURN)
36700	**
36800	DS	( IDENT(BASE,'REG') DIFFER(SW.REG) )	:S(RETURN)
36900		SAVEDS (POS(0) ! '"') BASE ','	:S(RETURN)
37000		LEN = ((LEN + ADDR.WORD - 1) / ADDR.WORD)  * ADDR.WORD
37100		DIFFER(SW.REENT)		:F(DSNR)
37200		REENT.OFF<BASE> = TOTSTORE
37300		TOTSTORE = TOTSTORE + LEN	:(RETURN)
37400	DSNR	SAVEDS = SAVEDS BASE ',' LEN '"' :(RETURN)
37500	**
37600	CHAR	CHAR = GETLAB()
37700		SAVEDC = SAVEDC CHAR ',' STRING '"'	:(RETURN)
37800	**
37900	ENDOFF	IDTAB = CONVERT(IDTAB,'ARRAY')
38000		OUTPUT =
38100		OUTPUT =
38200		OUTPUT = 'NAME  LOCATN  LEN OFF #REF TYPE'
38300		OUTPUT = REPLACE(OUTPUT,LET,MINUS)
38400		I =
38500	ENDLP	I = I + 1
38600		NAME = IDTAB<I,1>		:F(RETURN)
38700		NAME POS(0) '#'			:S(ENDLP)
38800		ENTRY = IDTAB<I,2>
38900		NREF = -TAB.MASK(ENTRY)
39000		NREF = LE(NREF,0)
39100		OUTPUT = RPAD(NAME,6,'.') RPAD(TAB.BASE(ENTRY),8,'.')
39200	.		RPAD(TAB.LEN(ENTRY),4,'.') RPAD(TAB.OFF(ENTRY),4,'.')
39300	.		RPAD(NREF,5,'.') TAB.TYPE(ENTRY)
39400	.					:(ENDLP)
39500	**
39600	CALL				:($SUBROUT)
39700	********
39800	** OPTIMIZATION
39900	********
40000	**
40100	CKREG	LREG = IDENT(ADDR,'REG') DIFFER(SW.REG)
40200	.		BASE.REG		:S(FRETURN)
40300		DIFFER(SW.OPT1) 		:F(RETURN)
40400		ADDR POS(0) ANY(LET)		:F(RETURN)
40500		INREG '"' ADDR ',' BREAK('"') . LREG	:S(FRETURN)F(RETURN)
40600	**
40700	PUTREG	OFFREG(R)
40800		INREG = INREG ADDR ',' R '"'	:(RETURN)
40900	**
41000	OFFREG	INREG '"' BREAK(',') ',' R =	:F(RETURN)S(OFFREG)
41100	**
41200	CLRREG	INREG = '"'			:(RETURN)
41300	**
41400	OFFLOC	INREG '"' LOC ',' BREAK('"') =	:F(RETURN)S(OFFLOC)
41500	**
41600	CKSBSET OFF = 0 ; RT = RIGHT
41700		RT POS(0) LEFT =		:F(FRETURN)
41800	CKBLK	RT GET.VAR.X =			:F(FRETURN)
41900		ENTRY.X = IDTAB<X>
42000		( DIFFER(ENTRY.X) CKTYPET(TF,'B',TAB.TYPE(ENTRY.X)) )
42100	.					:F(FRETURN)
42200		OFF = OFF + TAB.OFF(ENTRY.X)
42300		DIFFER(RT)			:S(CKBLK)
42400		RIGHT = OFF			:(RETURN)
42500	**