Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50517/setret.mac
There are 16 other files named setret.mac in the archive. Click here to see a list.
TITLE SETRET FOR RPGII V1
SUBTTL SET-UP AND RETURN ROUTINES AL BLACKINGTON/CAM/ACK/RBC
;USED TO BE
;COPYRIGHT 1974, 1975, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;BUT MODIFIED TO RPGII VERSION 1/14/76, BOB CURRIER
;REVISION HISTORY:
;V1 *****
; 15-DEC-74 /ACK ADDED ROUTINES SET1. AND SET2.
; 5/15/75 /DBT ADDED BSET1. AND BSET2. FOR BIS
; 1/14/76 /RBC MODIFIED TO SUPPORT RPGII.
;*****
SEARCH RPGPRM ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
BIS==:BIS
HISEG
ENTRY SET.1,SET.2,SET.3
ENTRY RET.1,RET.2,RET.3
ENTRY SET1. ;TO PICK UP ONE PARAMETER AND BREAK IT DOWN.
ENTRY SET1A. ;ANOTHER ENTRY POINT FOR SET1.
ENTRY SET2. ;TO PICK UP TWO PARAMETERS AND BREAK
; THEM DOWN.
; THE FOLLOWING ARE ENTRY POINTS FOR SETTING UP PARAMETERS IN AC'S
SET.3: MOVE 15,2(16) ;3 PARAMETERS DESIRED
SET.2: MOVE 14,1(16) ;2 PARAMETERS DESIRED
SET.1: MOVE 13,0(16) ;1 PARANETER DESIRED
POPJ 17,
; THE FOLLOWING ARE RETURN POINTS FOR THE SUB-ROUTINES
RET.3: AOS (17) ;RETURN TO CALL+3
RET.2: AOS (17) ;RETURN TO CALL+2
RET.1: POPJ 17, ;RETURN TO CALL+1
SUBTTL SET1. - SET UP ONE PARAMETER
COMMENT \
THIS ROUTINE SETS UP A SINGLE PARAMETER.
CALLS:
JSP JAC, SET1. ;TO PICK UP THE PARAMETERS,
OR JSP JAC, SET1A. ; INITIALIZE THE SWITCHES AND
; PRESERVE THE INPUT CODE.
INPUT CONDITIONS:
(CH) = THE INPUT CODE:
6 ==> SIXBIT
7 ==> ASCII
8 ==> EBCDIC
EXIT CONDITIONS:
SET1. & SET1A.:
(SW)
BIT 0 THE OPERATIONAL SIGN FLAG.
BITS 1-17 ZERO.
BITS 18-35 THE INPUT CODE.
(CNT) THE FIELD LENGTH.
(IPTR) THE INPUT BYTE POINTER.
(CH) THE INPUT BYTE SIZE.
RETURNS:
IF THE FIELD LENGTH IS ZERO WE RETURN TO CALLER'S CALLER AT CALL+1.
IF THE FIELD LENGTH IS NON ZERO WE RETURN TO CALLER AT CALL+1.
REGISTERS MODIFIED:
SW, CH, IPTR, CNT
\
SET1A.:
SET1.: HRRZI SW, (CH) ;CLEAR ALL SWITCHES AND SAVE THE
; INPUT CODE.
MOVE IPTR, (PARM) ;GET THE INPUT PARAMETER.
TLZE IPTR, 4000 ;CLEAR THE SIGN FLAG.
HRLI SW, (1B0) ;IF IT WAS ON, SET THE SIGN SWITCH.
LDB CNT, SLPTR1 ;GET THE STRING LENGTH.
TLZN IPTR, 3777 ;CLEAN UP THE BYTE POINTER.
POPJ PP, ;RETURN TO CALLER'S CALLER ON A
; NULL STRING.
TRNN SW, 7 ;IS THE INPUT EBCDIC.
MOVEI CH, ^D9 ;YES, THEN IT'S REALLY 9 BITS
; PER BYTE.
DPB CH, PTIBS. ;PUT IT IN THE BYTE POINTER.
JRST (JAC) ;RETURN.
IFE BIS,<XLIST>
IFN BIS,<
; BSET1. IS THE BIS EQUIVALENT OF SET1.
; BISCH IS THE SAME AS CH
; SRCPT IS THE SAME AS IPTR
; SRCCNT IS THE SAME AS CNT
; INPUT CODES ARE 6/7/9 IE BYTE SIZE
ENTRY BSET1.,BSET2.
BSET1.: HRRZI SW, (BISCH) ;CLEAR ALL SWITCHES AND SAVE THE
; INPUT CODE.
MOVE SRCPT, (PARM) ;GET THE INPUT PARAMETER.
TLZE SRCPT, 4000 ;CLEAR THE SIGN FLAG.
HRLI SW, (1B0) ;IF IT WAS ON, SET THE SIGN SWITBISCH.
LDB SRCCNT, BSLPT1 ;GET THE STRING LENGTH.
TLZN SRCPT, 3777 ;CLEAN UP THE BYTE POINTER.
POPJ PP, ;RETURN TO CALLER'S CALLER ON A
; NULL STRING.
DPB BISCH, BPTIBS ;PUT BYTE SIZE IN THE BYTE POINTER.
JRST (JAC) ;RETURN.
> ;END OF BIS
LIST
SUBTTL SET2. - SET UP TWO PARAMETERS.
COMMENT \
THIS ROUTINE SETS UP TWO PARAMETERS.
CALL:
JSP JAC, SET2.
INPUT CONDITIONS:
RH(PARM) POINTS AT THE FIRST PARAMETER.
EXIT CONDITIONS:
(IPTR) = THE INPUT BYTE POINTER.
(OPTR) = THE OUTPUT BYTE POINTER WITH A NULL S FIELD.
(CNT) = THE SIZE OF BOTH FIELDS.
RETURNS:
@CALL+1 IF THE SIZE OF THE FIELDS IS ZERO.
CALL+2 OTHERWISE.
REGISTERS MODIFIED:
IPTR, OTPR, CNT
\
SET2.: MOVE IPTR, (PARM) ;GET THE INPUT POINTER.
MOVE OPTR, 1(PARM) ;GET THE OUTPUT POINTER.
LDB CNT, SLPTR2 ;GET THE FIELD LENGTH.
JUMPE CNT, @(JAC) ;RETURN THROUGH CALL+1 ON A
; NULL STRING.
TLZ OPTR, 7777 ;CLEAN UP THE BYTE POINTER.
JRST 1(JAC) ;RETURN TO CALL+2.
;POINTERS TO VARIOUS FIELDS IN THE PARAMETERS.
SLPTR1: POINT 11,IPTR,17 ;POINTS AT THE LENGTH FIELD FOR ONE
; PARAMETER ROUTINES.
SLPTR2: POINT 11,OPTR,17 ;POINTS AT THE LENGTH FIELD FOR TWO
; PARAMETER ROUTINES.
INTERN PTIBS.
INTERN PTOBS.
INTERN PACFL.
PTIBS.: POINT 6,IPTR,11 ;POINTS AT THE S FIELD OF IPTR.
PTOBS.: POINT 6,OPTR,11 ;POINTS AT THE S FIELD OF OPTR.
PACFL.: POINT 4,PARM,12 ;POINTS AT THE AC FIELD OF THE AC
; CONTAINING THE POINTER TO THE PARAMETERS.
IFE BIS,<XLIST>
IFN BIS,<
; BSET2. IS THE BIS EQUIVALENT OF SET2.
;
; IT SETS UP SRCPT, DSTPT, SRCCNT, AND DSTCNT
BSET2.: MOVE SRCPT, (PARM) ;GET THE INPUT POINTER.
MOVE DSTPT, 1(PARM) ;GET THE OUTPUT POINTER.
LDB SRCCNT, BSLPT2 ;GET THE FIELD LENGTH.
JUMPE SRCCNT, @(JAC) ;RETURN THROUGH CALL+1 ON A
; NULL STRING.
MOVE DSTCNT, SRCCNT ;SOURCE AND DESTINATION SAME SIZE
TLZ DSTPT, 7777 ;CLEAN UP THE BYTE POINTER.
JRST 1(JAC) ;RETURN TO CALL+2.
;POINTERS TO VARIOUS FIELDS IN THE PARAMETERS.
BSLPT1:: POINT 11,SRCPT,17 ;POINTS AT THE LENGTH FIELD FOR ONE
; PARAMETER ROUTINES.
BSLPT2:: POINT 11,DSTPT,17 ;POINTS AT THE LENGTH FIELD FOR TWO
; PARAMETER ROUTINES.
INTERN BPTIBS
INTERN BPTOBS
BPTIBS: POINT 6,SRCPT,11 ;POINTS AT THE S FIELD OF SRCPT.
BPTOBS: POINT 6,DSTPT,11 ;POINTS AT THE S FIELD OF DSTPT.
>
END