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

; UPD ID= 2953 on 6/17/80 at 5:24 PM by WRIGHT                          
TITLE	SUBSCR FOR LIBOL
SUBTTL	SUBSCRIPT CALCULATOR		AL BLACKINGTON/CAM/DMN



;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, 1981 BY DIGITAL EQUIPMENT CORPORATION


	HISEG
	SEARCH	LBLPRM		;DEFINE ASSEMBLY PARAMETERS
	BIS==BIS

;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

IFE BIS,<
SZ=10	;SIZE (2 AC'S REQUIRED)
BP=12	;BYTE POINTER
>
IFN BIS,<
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

COMMENT .IF BIS=1 THEN THE VALUE OF SZ AND BP IS SWAPPED
	SO THAT THE ADJBP WILL PUT THE RESULTANT IN BP.

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:
IFE BIS,<
	LDB	TA,[POINT 3,BP,11]	;GET LOWER 3 BITS OF BYTE SIZE
	IDIV	SZ,BPWTAB(TA)	;COMPUTE # WORDS TO OFFSET
	ADD	BP,SZ		;ADD TO BYTE-POINTER
	JUMPLE	SZ+1,SUBSC5	;ANY BYTES LEFT OVER?
SUBSC4:	IBP	BP		;YES--BUMP BYTE POINTER
	SOJG	SZ+1,SUBSC4
>
IFN BIS,<
	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

;TABLE OF BYTES PER WORD

IFE BIS,<
BPWTAB:	4		;0 - 8 BIT EBCDIC
	4		;1 - 9 BIT EBCDIC
	0		;2 - ILLEGAL
	0		;3 - ILLEGAL
	1		;4 - 36 BIT BINARY
	0		;5 - ILLEGAL
	6		;6 - SIXBIT
	5		;7 - ASCII
>

;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