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

TITLE	EXAM FOR LIBOL
SUBTTL	COBOL EXAMINE VERB		AL BLACKINGTON/CAM



;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


	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP

;REVISION HISTORY:

;V10*****

;	17-APR-75	/ACK	ADD ABILITY TO EXAMINE EBCDIC STRINGS.

;*****

	HISEG
	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