Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
exam.mac
There are 5 other files named exam.mac in the archive. Click here to see a list.
TITLE EXAM FOR LIBOL V12C
SUBTTL COBOL EXAMINE VERB AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH LBLPRM ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
;REVISION HISTORY:
;V10*****
; 17-APR-75 /ACK ADD ABILITY TO EXAMINE EBCDIC STRINGS.
;*****
HISEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
SALL
;THIS ROUTINE PERFORMS THOSE ACTIONS NECESSARY FOR THE IMPLEMENTATION
; OF THE COBOL "EXAMINE" STATEMENT.
;THE ROUTINE IS CALLED BY A "PUSHJ PP,EXAM." WITH THE ADDRESS IN "PA"
; OF A BYTE POINTER TO THE FIELD TO BE EXAMINED.
; FOLLOWING THE PUSHJ IS A PARAMETER WORD CONTAINING:
; BIT 1 1 = NUMERIC
; BIT 2 EXAMINE FOR "LEADING"
; BIT 3 EXAMINE FOR "FIRST"
; BIT 4 EXAMINE FOR "UNTIL FIRST"
; BIT 5 "REPLACING
; BITS 6-17 SIZE OF THE FIELD
; BITS 18-26 THE CHARACTER TO EXAMINE FOR.
; THIS IS A SIXBIT CHARACTER IF THE FIELD
; IS IN DISPLAY-6 USAGE, AN ASCII CHARACTER
; IF THE FIELD IS IN DISPLAY-7 USAGE OR AN
; EBCDIC CHARACTER IF THE FIELD IS IN
; DISPLAY-9 USAGE.
; BITS 27-35 THE CHARACTER TO REPLACE WITH, AGAIN
; EITHER SIXBIT, ASCII OR EBCDIC.
;THE ROUTINE EXITS WITH THE NEW CONTENTS OF THE COBOL
; CONSTANT "TALLY" IN ACCUMULATOR "TL".
;IN ADDITION TO "TL", AC'S SW,PT,CH,EC,RC & CT ARE DESTROYED.
ENTRY EXAM.
; ACCUMULATORS
TL=0 ;TALLY
CH=4 ;A CHARACTER FROM THE INPUT FIELD
SW=5 ;SWITCHES
PT=6 ;BYTE POINTER TO THE INPUT FIELD
EC=10 ;THE CHARACTER WE ARE LOOKING FOR
RC=11 ;THE CHARACTER TO REPLACE WITH
CT=13 ;NUMBER OF CHARACTERS LEFT TO EXAMINE
NR=14 ;ENTRANCE POINT OF ROUTINE USED TO CONVERT CHARACTER
;TO NUMERIC
TE=15 ;TEMPORARY
PA=16 ;ADDRESS OF PARAMETERS (SET BY ROUTINE UUO.)
PP=17 ;PUSH-DOWN POINTER
; FLAGS
REPL==(1B5) ;"REPLACING"
UNTIL==(1B4) ;"UNTIL FIRST"
FIRST==(1B3) ;"FIRST"
LEAD==(1B2) ;"LEADING"
NUMER==1B<^D18+0> ;FIELD IS NUMERIC
; MISCELLANEOUS CONSTANTS
PNTRC: POINT 9,SW,35 ;TO PICK UP RC
PNTEC: POINT 9,SW,26 ;TO PICK UP EC
FSIZE: POINT 12,SW,17 ;FIELD SIZE
EXTERNAL RET.2
EXAM.: MOVEI TL,0 ;CLEAR TALLY
MOVE PT,0(PA) ;GET POINTER
MOVE SW,@0(PP) ;SET SWITCHES
LDB CT,FSIZE ;SET FIELD SIZE
LDB RC,PNTRC ;GET REPLACEMENT CHARACTER
LDB EC,PNTEC ;GET EXAMINE CHARACTER
MOVEI NR,DCV.6 ;ASSUME SIXBIT
TLNN PT,100 ;IS IT?
JRST EXAM1 ;YES, GO ON.
MOVEI NR,DCV.7 ;ASSUME ASCII
TLNE PT,1000 ;IS IT?
MOVEI NR,DCV.9 ;NO, MUST BE DISPLAY-9.
EXAM1: ILDB CH,PT ;GET AN INPUT CHARACTER
TLNE SW,NUMER ;IS IT SIGNED NUMERIC?
PUSHJ PP,(NR) ;YES--CONVERT TO A DIGIT
CAIN EC,(CH) ;IS IT EQUAL TO EXAMINE CHAR?
JRST EXAM5 ;YES
; INPUT CHARACTER IS UNEQUAL TO EC
TLNE SW,LEAD ;NO--LOOKING FOR "LEADING"?
JRST RET.2 ;YES--QUIT
TLNN SW,UNTIL ;NO--LOOKING FOR "UNTIL FIRST"?
JRST EXAM3 ;NO
; A HIT--TALLY AND (MAYBE) REPLACE
EXAM2: ADDI TL,1 ;A HIT--INCREMENT TALLY
TLNE SW,REPL ;ARE WE REPLACING?
PUSHJ PP,EXAM7 ;YES--REPLACE THE CHARACTER
EXAM3: SOJG CT,EXAM1 ;ARE WE DONE?
JRST RET.2 ;YES--RETURN
; INPUT CHARACTER IS EQUAL TO EC
EXAM5: TLNE SW,UNTIL ;LOOKING FOR "UNTIL FIRST"?
JRST RET.2 ;YES--QUIT
TLNN SW,FIRST ;NO--LOOKING FOR "FIRST"?
JRST EXAM2 ;NO
ADDI TL,1 ;YES--BUMP TALLY
TLNE SW,REPL ;ARE WE REPLACING?
PUSHJ PP,EXAM7 ;YES--REPLACE THE CHARACTER
JRST RET.2
;REPLACE THE CHARACTER.
;IF FIELD IS NUMERIC, AND THIS IS THE SIGN CHARACTER, AND
; THE CHARACTER IS NEGATIVE, REPLACE WITH A NEGATIVE CHARACTER.
EXAM7: MOVE TE,RC ;GET REPLACEMENT CHARACTER
CAIN CT,1 ;IS THIS THE SIGN CHARACTER?
TLNN SW,NUMER ;YES--IS FIELD NUMERIC
JRST EXAM8 ;NO--STRAIGHT REPLACEMENT
JUMPGE CH,EXAM8 ;IF CHARACTER POSITIVE--NO CONVERSION
TLNE PT,1000 ;EBCDIC FIELD?
JRST EXAM9 ;YES, GO MAKE IT NEGATIVE.
TLNN PT,100 ;ASCII FIELD?
MOVEI TE,40(RC) ;NO--CONVERT IT TO ASCII
CAIN TE,"0" ;IS IT ZERO?
MOVEI TE,":" ;YES--USE NEGATIVE ZERO CHARACTER
CAIE TE,":" ;IS IT NOW NEGATIVE ZERO?
ADDI TE,31 ;NO--GET NEGATIVE
TLNN PT,100 ;ASCII FIELD?
SUBI TE,40 ;NO--CONVERT BACK TO SIXBIT
EXAM8: DPB TE,PT
POPJ PP,
EXAM9: ANDI TE,357 ;360 BECOMES 340, 361 BECOMES 341, ETC.
JRST EXAM8
DCV.6: CVTSNM 6,CH,CH;
POPJ PP,
DCV.7: CVTSNM 7,CH,CH;
POPJ PP,
DCV.9: CVTSNM ^D9,CH,CH;
POPJ PP,
END