Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
subscr.mac
There are 9 other files named subscr.mac in the archive. Click here to see a list.
; 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