Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 1044 on 4/29/83 at 12:07 AM by NIXON                          
TITLE	SUBSCR FOR COBLIB
SUBTTL	SUBSCRIPT CALCULATOR		AL BLACKINGTON/CAM/DMN

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file
	SEARCH	LBLPRM		;DEFINE ASSEMBLY PARAMETERS

;CALL:	MOVEI	PA,<LOCATION OF PARAMETERS>
;	PUSHJ	PP,SUBSC.

;PARAMETERS:
;	WORD 1:	BYTE POINTER TO FIRST ELEMENT
;	WORD 2:	LH NUMBER OF SUBSCRIPTS
;		RH A CONSTANT TO BE PLACED IN BITS 6-17 OF RESULTANT
;		RH BITS 0-5 USED BY STRING/UNSTRING

;THE REMAINING WORDS OF THE PARAMETERS DESCRIBE EACH SUBSCRIPT, WITH
;	TWO WORDS PER SUBSCRIPT.

;	FIRST WORD:	LH "DEPENDING" VARIABLE (ZERO IF NONE)
;			RH THE SUBSCRIPT
;	SECOND WORD:	LH SIZE OF ITEM HAVING THE OCCURS CLAUSE
;			RH BIT 18 IS A 1 IF SUBSCRIPT IS A DATA-NAME
;			   BIT 19 = 1 IF SUBSCRIPT IS EXT LINKAGE INDEX
;			   BIT 20 = 1 IF "DEPENDING" VARIABLE IS EXT LINKAGE VALUE
;			   BIT 21 = 1 IF SUBSCRIPT IS IN LINKAGE SECTION (I.E. INDIRECT VALUE)
;			   BITS 24-35 CONTAIN THE MAXIMUM ALLOWED VALUE
;				FOR THE SUBSCRIPT.

ENTRY SUBSC.

ENTRY SUBE1.,SUBE2.,SUBE3.	;INLINE SUBSCRIPT ERROR ROUTINES

EXTERNAL KILL.	;A ROUTINE USED TO TERMINATE THE JOB IF AN ERROR IS DETECTED

;ACCUMULATOR DEFINITIONS

TA=5	;TEMP
TB=TA+1	;TEMP
TC=TB+1	;TEMP

SZ=12	;SIZE
BP=10	;BYTE POINTER

RT==12	;RESULTANT
CN=13	;CONSTANT FOR BITS 6-17 OF RESULTANT
	;  LH = EXTERNAL LINKAGE OFFSET
NS=14	;NUMBER OF SUBSCRIPTS
PA=16	;LOCATION OF PARAMETERS
PP=17	;PUSH-DOWN POINTER

SUBSC.:	MOVE	BP,0(PA)	;GET BYTE POINTER
	MOVEI	SZ,0		;CLEAR ACCUMULATED SIZE
	HLRZ	NS,1(PA)	;GET NUMBER OF SUBSCRIPTS
	HRRZ	CN,1(PA)	;GET CONSTANT
SUBSC1:	MOVEI	PA,2(PA)	;BUMP UP TO A SUBSCRIPT DESCRIPTOR
	HRRZ	TA,1(PA)	;GET "OCCURS" VALUE
	HRRZ	TB,0(PA)	;GET SUBSCRIPT VALUE OR ADDRESS
	TRNE	TA,1B19		;EXTERNAL LINKAGE SUBSCRIPT?
	JRST	SUBSC6		;YES
	HLRZ	TC,0(PA)	;GET "DEPENDING" VARIABLE'S ADDRESS
	TRZE	TA,1B20		;EXT LINKAGE SECTION?
	MOVE	TC,(TC)		;YES, GET REAL VARIABLE
	TRZE	TA,1B18		;IS SUBSCRIPT A LITERAL?
	MOVE	TB,0(TB)	;NO--GET CURRENT VALUE
	TRZE	TA,1B21		;IS IT IN LINKAGE SECTION?
	MOVE	TB,0(TB)	;YES, GET VALUE
	JUMPLE	TB,SUBE1.	;IS VALUE POSITIVE?
	CAILE	TB,(TA)		;YES--IN BOUNDS OF OCCURS?
	JRST	SUBE1.		;NO
	JUMPE	TC,SUBSC2	;IF NONE, SKIP SOME CODE
	SKIPG	TC,0(TC)	;GET VALUE OF DEPENDING VARIABLE
	JUMPLE	TC,SUBE2.	;IS IT POSITIVE?
	CAILE	TC,(TA)		;YES--IN BOUNDS OF OCCURS?
	JRST	SUBE2.		;NO--ERROR
	CAILE	TB,(TC)		;IS SUBSCRIPT GREATER THAN "DEPENDING"
	JRST	SUBE3.		;YES
SUBSC2:	HLRZ	TA,1(PA)	;PICK UP SIZE
	IMULI	TA,-1(TB)	;MULTIPLY BY SUBSCRIPT VALUE LESS 1
	ADD	SZ,TA		;ADD TO ACCUMULATED SIZE
SUBSC3:	SOJG	NS,SUBSC1	;IF MORE SUBSCRIPTS--LOOP
SUBSC7:	ADJBP	SZ,BP		;BUMP BYTE POINTER (RESULT IN SZ)
	TLNE	RT,760000	;ANY BYTES LEFT IN WORD?
	JRST	SUBSC5		;YES, OK
	TLZ	RT,770000	;NO, ADJUST BYTE POINTER
	ADD	RT,[440000,,1]	; TO BE BEFORE THE NEXT WORD
SUBSC5:	DPB	CN,[POINT 12,RT,17]	;SET BITS 6-17
	POPJ	PP,		;RETURN

SUBSC6:	ADD	BP,(TB)		;ADD EXTERNAL LINKAGE OFFSET TO INTERMEDIATE RESULT
	JRST	SUBSC7		;AND ADJUST THE BYTE POINTER

;INLINE SUBSCRIPT ERROR MESSAGES

SUBE1.:	OUTSTR	[ASCIZ "?LBLSVO Subscript value out of range"]
	JRST	KILL.

SUBE2.:	OUTSTR	[ASCIZ "?LBLDVO Depending variable out of range"]
	JRST	KILL.

SUBE3.:	OUTSTR	[ASCIZ "?LBLSGD Subscript value greater than value of depending variable"]
	JRST	KILL.

	END