Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/edit.mac
There are 36 other files named edit.mac in the archive. Click here to see a list.
TITLE	EDIT FOR LIBOL		
SUBTTL	PICTURE EDIT ROUTINE		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

;V10**************************
;NAME	DATE		COMMENTS
;DBT	4/22/75		SUPPRESS BLANKS AND ZEROS THAT
;			OCCUR IN A FLOATING STRING
;
;			ADD CODE FOR "V" IN MASK
;ACK	8-MAY-75	ADD ABILITY TO EDIT DISPLAY-9 ITEMS.
;******************************
;EDIT 401 FIX SO THAT ZERO SUPPRESION IS TURNED OFF WHEN 9'S FIEDL SEEN

	HISEG
	SALL

ENTRY EDIT.S, EDIT.U
EXTERNAL  RET.2


;EDIT.S AND EDIT.U PERFORM EDITING UPON AN ASCII OR SIXBIT FIELD AS
;	DIRECTED BY THE COBOL PICTURE CLAUSE.
;EDIT.S IS USED WHEN BOTH THE INPUT FIELD AND THE PICTURE ARE SIGNED,
;	EDIT.U IS USED OTHERWISE.

;A MASK CONSISTING OF A STRING OF 4-BIT BYTES DIRECTS THE EDITING.
;	THE VALUES FOR THOSE BYTES IS SHOWN IN THE TABLE "DSPACH" BELOW.

;THE ROUTINE IS CALLED BY:
;	MOVEI PA,<ADDRESS OF FIRST OF 2 OR 3 BYTE POINTERS>
;	PUSHJ PP,EDIT.S  (OR EDIT.U)
;	XWD <PARAMETERS>,<LOCATION OF FIRST MASK BYTE>

;THE PARAMETERS IN THE LEFT HALF OF THE XWD ARE:
;	BITS 0-5	THE BYTE RESIDUE FOR A BYTE PRECEDING THE FIRST MASK BYTE.
;	BITS 6-11	THE SIGN USED IN THE PICTURE, IN SIXBIT  (+ OR SPACE=-)
;	BITS 12-17	THE SUPPRESSION OR FLOAT CHARACTER, IN SIXBIT
;			   (*, +, CURRENCY SYMBOL, OR SPACE = Z OR -).


;THE BYTE POINTERS DESCRIBED BELOW MAY BE EITHER SIXBIT OR ASCII.

;THE BYTE POINTERS USED BY EDIT.S POINT TO:
;	1) THE BYTE CONTAING THE INPUT SIGN CHARACTER
;	2) THE BYTE BEFORE THE FIRST INPUT CHARACTER
;	3) THE BYTE BEFORE THE FIRST OUTPUT CHARACTER

;THE BYTE POINTERS USED BY EDIT.U POINT TO:
;	1) THE BYTE BEFORE THE FIRST INPUT CHARACTER
;	2) THE BYTE BEFORE THE FIRST OUTPUT CHARACTER

;ALL BYTE POINTERS MAY HAVE AN INDIRECT ADDRESS


;THE CONTENTS OF ALL ACCUMULATORS EXCEPT 0, 1, 2, 3, PA AND PP ARE LOST
SEARCH	LBLPRM

	%%LBLP==:%%LBLP

; ACCUMULATORS

SW=4		;SWITCHES
CH==CH		;INPUT/OUTPUT CHARACTER
FC=6		;HOLDS THE FLOAT OR SUPPRESSION CHARACTER
TA=7		;TEMPORARY
SN=10		;THE SIGN CHARACTER TO BE INSERTED
MC=11		;HOLDS A MASK CHARACTER
DP=12		;BYTE POINTER FOR DECIMAL POINT IN OUTPUT
IP=13		;BYTE POINTER FOR INPUT FIELD
OP=14		;BYTE POINTER FOR OUTPUT FIELD
MP=15		;BYTE POINTER FOR MASK FIELD
PA=16		;ADDRESS OF PARAMETERS (SET BY UUO.)
PP=17		;PUSH-DOWN POINTER

; SWITCH SETTINGS

NEGTIV=1	;1 IF INPUT FIELD IS NEGATIVE
NOSUPP=2	;0 IF SUPPRESSION IN PROGRESS
NOFLOT=4	;0 IF FLOATING IN PROGRESS
NOZERO=10	;1 IF INPUT NOT ALL ZEROES
BWZ=20		;1 IF BLANK-WHEN-ZERO REQUESTED
FFLOAT=40	;1 IF FLOATING HAS STARTED
FSUPP=100	;1 IF SUPPRESSION HAS STARTED
SWSET=NOFLOT!NOSUPP	;INITIAL SETTING OF SWITCHES

; EDITING CHARACTERS

$SPACE=0	;SPACE
$DOLL=4		;DOLLAR SIGN
$STAR=12	;ASTERISK
$ZERO=20	;ZERO
$PLUS=13	;+
$MINUS=15	;-
$SLASH=='/'	;"/"
$CR=62043	;"RC"
$ECR==331303	;EBCDIC "RC"
$DB=42044	;"BD"
$EDB==302304	;EBCDIC "BD"
$SS=0		;TWO SPACES
$ESS==100100	;TWO EBCDIC SPACES
$CHECK=12	;*
$NINE=31	;9
$A=41		;A (+1)
$I=51		;I (+9)
$R=62		;R (-9)
$J=52		;J (-1)
$MZERO=32	;: (-0)
$PZERO=37	;? (+0)

EXTERNAL POINT.,COMMA.,MONEY.
; INPUT IS SIGNED AND A SIGN IS IN PICTURE

EDIT.S:	MOVEI SW,SWSET	;CLEAR SWITCHES
	MOVE TA,0(PA)	;PICK UP POINTER TO INPUT SIGN
	LDB CH,TA	;PICK UP THE SIGN CHARACTER
	TLNE	TA,	1000		;IS INPUT EBCDIC?
	LDB	CH,	PTR97.##	;YES, CONVERT TO ASCII.
	TLNE TA,100	;IS INPUT SIXBIT?
	SUBI CH,40	;NO, CONVERT TO SIXBIT
	SIGN	6,CH	;IS THE CHARACTER SIGNED
	SKIPE CH	;IS IT NEGATIVE
	IORI SW,NEGTIV	;YES--SET NEGATIVE FLAG
	AOJA PA, EDIT.B


; INPUT IS UNSIGNED, OR NO SIGN IN PICTURE

EDIT.U:	MOVEI SW,SWSET	;CLEAR SWITCHES


; SET UP THE PARAMETERS

EDIT.B:	MOVEI DP,0	;CLEAR DECIMAL POINT BYTE POINTER
IFE BIS,<
	MOVE	IP,0(16)	;GET IP
	MOVE	OP,1(16)	;AND OP
>
IFN BIS,<
	DMOVE	IP,0(16)	;GET IP AND OP
>
	MOVE MP,@(PP)	;GET MASK PARAMETER
	LDB FC,[POINT 6,MP,17]	;GET FLOAT CHARACTER
	LDB SN,[POINT 6,MP,11]	;PICK UP THE SIGN IN PARAMETER
	TRNE SW,NEGTIV	;IS INPUT NEGATIVE?
	MOVEI SN,$MINUS	;YES--CHANGE SIGN TO "-"
	TLZE OP,40	;IS BLANK-WHEN-ZERO REQUESTED?
	IORI SW,BWZ	;YES--SET FLAG
	PUSH PP,OP	;SAVE THE OUTPUT POINTER

	MOVEI TA,400	;CHANGE MP TO A BYTE POINTER
	DPB TA,[POINT 12,MP,17]


; THIS IS THE MAIN LOOP
; A TERMINATION CHARACTER IN THE MASK WILL GET US OUT

EDIT1:	ILDB MC,MP		;GET A MASK CHARACTER

	CAIG MC,FLCODE		;IS AN INPUT CHARACTER NEEDED?
	ILDB CH,IP		;YES--PICK ONE UP

	TLNE	IP,	1000		;IS INPUT EBCDIC?
	LDB	CH,	PTR97.##	;YES, CONVERT TO ASCII.
	TLNE IP,100		;IS INPUT SIXBIT?
	SUBI CH,40		;NO, CONVERT

EDIT2:	XCT DSPACH(MC)		;GO TO A ROUTINE

EDIT3:	TLNE OP,100		;IS OUTPUT SIXBIT?
	ADDI CH,40		;NO, CONVERT
	TLNE	OP,	1000		;IS OUTPUT EBCDIC?
	LDB	CH,	PTR79.##	;YES, CONVERT.
EDIT4:	IDPB CH,OP		;PUT A CHARACTER INTO OUTPUT FIELD
	JRST EDIT1		;LOOP
; THE DISPATCH TABLE

; THE FIRST FEW ENTRIES GO TO SUBROUTINES WHICH REQUIRE A INPUT CHARACTER.
; THE VALUE OF "FLCODE" IS SET TO THE LAST OF THESE ENTRIES.

FLCODE=3

DSPACH:	JRST PUTALF		;00 INSERT ALPHA CHARACTER (X)
	JRST PUTNUM		;01 INSERT A NUMERIC CHARACTER (9)
	JRST SUPP		;02 SUPPRESS (Z,*)
	JRST FLOAT		;03 FLOAT A CHARACTER ($$,++,--)
	JRST COMMA		;04 INSERT COMMA
	JRST SPACE		;05 INSERT A BLANK (B)
	JRST	ZERO		;06 INSERT A ZERO
	MOVE CH,MONEY.		;07 INSERT A CURRENCY SIGN
	MOVE CH,SN		;10 INSERT A SIGN (+,-)
	JRST PERIOD		;11 INSERT A PERIOD
	JRST CREDIT		;12 INSERT A "CR"
	JRST DEBIT		;13 INSERT A "DB"
	JRST	VPOINT		;14-V NO INSERT JUST NOTE IT
IFN ANS68,<
	BLOCK 2			;15-16 UNUSED
>
IFN ANS74,<
	JRST	SLASH		;15 INSERT A SLASH
	0			;16 UNUSED
>
	JRST ALLDUN		;17 TERMINATE
; INSERT A NUMERIC CHARACTER INTO OUTPUT STRING

PUTNUM:	PUSHJ PP,NUMTST		;CHANGE TO NUMERIC IF NECESSARY
	IORI	SW,NOSUPP	; [401] TURN ON NO ZERO SUPPRESSION

ENDFLT:	PUSHJ PP,PUTFLT		;KILL ANY FLOATING
	JRST EDIT3		;RETURN

; PUT AN ALPHANUMERIC CHARACTER INTO OUTPUT STRING

PUTALF:	CAIE CH,$ZERO		;IS INPUT CHARACTER 0?
	TROA SW,NOSUPP+NOZERO	;NO--TURN ON APPROPRIATE FLAGS
	IORI SW,NOSUPP		;YES--TURN ON SUPPRESS ONLY
	JRST EDIT3		;RETURN

; SUPPRESS LEADING ZEROES

SUPP:	TRON SW,FSUPP		;FIRST ONE?
	ANDCMI SW,NOSUPP	;YES--TURN OFF "NO SUPPRESSION" FLAG
	PUSHJ PP,NUMTST		;CHANGE TO NUMERIC IF NECESSARY
	TRNN SW,NOSUPP		;ARE WE STILL SUPPRESSING?
	MOVE CH,FC		;YES--MUST BE ZERO--SUPPRESS
	JRST EDIT3		;RETURN

; INSERT A DECIMAL POINT INTO OUTPUT STRING

PERIOD:	IORI SW,NOSUPP		;TURN ON "NO SUPPRESSION" FLAG
	MOVE CH,POINT.		;GET A DECIMAL POINT
	CAIN FC,$STAR		;SUPPRESSING WITH STARS?
	MOVE DP,OP		;YES--SAVE BYTE POINTER TO DECIMAL POINT
	JRST ENDFLT		;RETURN

; INSERT A SPACE INTO OUTPUT STRING

SPACE:	MOVEI	CH,$SPACE	;BLANK
	JRST	FXDINS

; INSERT A ZERO INTO OUTPUT STRING

ZERO:	MOVEI	CH,$ZERO	;ZERO
	JRST	FXDINS

IFN ANS74,<
; INSERT A SLASH INTO OUTPUT STRING

SLASH:	MOVEI	CH,$SLASH	;SLASH
	JRST	FXDINS
>

; INSERT A COMMA INTO OUTPUT STRING

COMMA:	MOVE CH,COMMA.		;GET THE COMMA

FXDINS:
	TRNN SW,NOSUPP		;ARE WE SUPPRESSING?
	MOVE CH,FC		;YES--REPLACE THE CHARACTER
	TRNN SW,NOFLOT		;NO--ARE WE FLOATING?
	MOVEI CH,$SPACE		;YES--REPLACE WITH SPACE
	JRST EDIT3		;RETURN

; NOTE THAT A "V" HAS PASSED

VPOINT:	IORI	SW,NOSUPP	;TURN ON NO SUPPRESSION FLAG
	PUSHJ	PP,PUTFLT	;PUT OUT FLOATER IF NECESSARY
	JRST	EDIT1		;BACK TO THE TOP - NO INSERT
; INSERT A "CR" INTO OUTPUT STRING

CREDIT:	MOVEI CH,$CR		;GET "CR"
	JRST .+2

; INSERT A "DB" INTO OUTPUT STRING

DEBIT:	MOVEI CH,$DB		;GET "DB"


	PUSHJ PP,PUTFLT		;KILL ANY FLOATING

	TRNN SW,NEGTIV		;IS INPUT NEGATIVE?
	MOVEI CH,$SS		;NO--REPLACE WITH SPACES
	TLNN	OP,	1000		;IS OUTPUT EBCDIC?
	JRST		DEBIT3		;NO, GO ON.
	CAIN	CH,	$SS		;ARE WE PUTTING OUT SPACES?
	MOVEI	CH,	$ESS		;YES, MAKE THEM EBCDIC.
	CAIN	CH,	$CR		;ARE WE PUTTING OUT "CR"?
	MOVEI	CH,	$ECR		;YES, MAKE IT EBCDIC.
	CAIN	CH,	$DB		;ARE WE PUTTING OUT "DB"?
	MOVEI	CH,	$EDB		;YES, MAKE IT EBCDIC.
	JRST		DEBIT7		;GO ON.
DEBIT3:	TLNE OP,100		;IS OUTPUT SIXBIT?
	ADDI CH,40040		;NO--CONVERT
DEBIT7:	IDPB CH,OP		;STASH THE FIRST CHARACTER
	LSH CH,-^D9		;SHIFT THE OTHER OVER
	JRST EDIT4		;RETURN

; FLOAT A CHARACTER OVER LEADING ZEROES

FLOAT:	TRON SW,FFLOAT		;FIRST ONE?
	ANDCMI SW,NOFLOT	;YES--TURN OFF "NO FLOATING" FLAG
	PUSHJ PP,NUMTST		;CONVERT TO NUMERIC IF NECESSARY
	CAIE CH,$ZERO		;IS IT ZERO?
	JRST ENDFLT		;NO

FLOAT2:	TRNN SW,NOFLOT		;YES--ARE WE STILL FLOATING?
	MOVEI CH,$SPACE		;YES--REPLACE THE ZERO WITH SPACE
	JRST EDIT3		;RETURN
; THE INPUT MASK IS EXHAUSTED--FINISH UP

ALLDUN:	PUSHJ PP,PUTFLT		;PUT OUT ANY FLOAT CHARACTER, IF NECESSARY
	POP PP,IP		;GET BACK THE OUTPUT POINTER
	TRNE SW,BWZ		;SHOULD WE BLANK THE FIELD?
	TRNE SW,NOZERO
	JRST RET.2		;NO--QUIT

	CAIN FC,$STAR		;YES FILL THE FIELD WITH
	SKIPA CH,FC			;STARS OR
	TDCA CH,CH			;SPACES
	IBP DP			;SET UP BYTE POINTER IF STAR SUPPRESSION

	TLNE OP,100		;IS OUTPUT SIXBIT?
	ADDI CH,40		;NO, CONVERT
	TLNE	OP,	1000		;IS OUTPUT EBCDIC?
	LDB	CH,	PTR79.##	;YES, CONVERT.

BWZLUP:	IBP IP
	CAME IP,DP		;IS THIS THE DECIMAL POINT?
	DPB CH,IP		;NO  (OR WE ARE NOT SUPPRESSING WITH STARS)
	CAME IP,OP		;FIELD BEEN FILLED?
	JRST BWZLUP		;NO--LOOP
	JRST RET.2		;ALL DONE--QUIT
; THIS ROUTINE CONVERTS THE INPUT CHARACTER TO NUMERIC, IF POSSIBLE.

; IF THE CHARACTER IS NOT ONE OF THE FORMS OF "0", THE NOSUPP AND NOZERO
;	FLAGS ARE SET.

NUMTST:	CVTNM	6,CH		;CONVERT TO STANDARD DIGIT
	CAIE CH,$ZERO		;ZERO?
	IORI SW,NOZERO+NOSUPP	;NO--SET FLAGS
	POPJ PP,		;YES--RETURN


;THIS ROUTINE PUTS OUT THE FLOAT CHARACTER IF NEEDED

PUTFLT:	TROE SW,NOFLOT		;ARE WE STILL FLOATING?
	POPJ PP,		;NO--CHARACTER HAS BEEN PUT OUT--RETURN

	MOVE TA,MONEY.		;PICK UP CURRENCY SYMBOL
	CAME TA,FC		;IS IT SAME AS FLOAT CHARACTER?
	MOVE FC,SN		;NO--MUST BE A SIGN--GET IT

	TLNE OP,100		;IS OUTPUT SIXBIT?
	ADDI FC,40		;NO--CONVERT.
	TLNE	OP,	1000		;IS OUTPUT EBCDIC?
	LDB	CH,	PTR79.##	;YES, CONVERT.
	IDPB FC,OP		;PUT OUT THE CHARACTER
	POPJ PP,
	END