Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/setret.mac
There are 16 other files named setret.mac in the archive. Click here to see a list.
; UPD ID= 1343 on 8/2/83 at 4:21 PM by NIXON
TITLE SETRET FOR COBLIB
SUBTTL SET-UP AND RETURN ROUTINES AL BLACKINGTON/CAM/ACK
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
SEARCH LBLPRM ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
IFN TOPS20,<SEARCH MACSYM>
IFE TOPS20,<SEARCH MACTEN>
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
;REVISION HISTORY:
;V10 *****
; 15-DEC-74 /ACK ADDED ROUTINES SET1. AND SET2.
; 5/15/75 /DBT ADDED BSET1. AND BSET2. FOR BIS
;*****
ENTRY RET.1,RET.2,RET.3
ENTRY SET1. ;TO PICK UP ONE PARAMETER AND BREAK IT DOWN.
ENTRY SET2. ;TO PICK UP TWO PARAMETERS AND BREAK THEM DOWN.
; 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,
; INITIALIZE THE SWITCHES AND
; PRESERVE THE INPUT CODE.
INPUT CONDITIONS:
(CH) = THE INPUT CODE:
6 ==> SIXBIT
7 ==> ASCII
8 ==> EBCDIC
EXIT CONDITIONS:
SET1.:
(SW)
BIT 0 ALWAYS 1
BIT 1 THE OPERATIONAL SIGN FLAG.
BITS 2-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
\
SET1.: HRRZI SW, (CH) ;CLEAR ALL SWITCHES AND SAVE THE INPUT CODE.
TXO SW,1B0 ;SET BIT 0 IN CASE RUNNING IN NON-ZERO SECTION.
MOVE IPTR, (PARM) ;GET THE INPUT PARAMETER.
TLZE IPTR, 4000 ;CLEAR THE SIGN FLAG.
TXO SW, SW.SGN ;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.
; 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.
TXO SW,1B0 ;SET BIT 0 IN CASE RUNNING IN NON-ZERO SECTION.
MOVE SRCPT, (PARM) ;GET THE INPUT PARAMETER.
TLZE SRCPT, 4000 ;CLEAR THE SIGN FLAG.
TXO SW, SW.SGN ;IF IT WAS ON, SET THE SIGN FLAG.
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.
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
\
IFN OPTR-IPTR-1,<PRINTX OPTR NOT = IPTR+1>
SET2.: DMOVE IPTR, (PARM) ;GET THE INPUT POINTER.
;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.
; 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