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

TITLE	EDIT.B FOR LIBOL
;AUTHOR D.B.TOLMAN
SUBTTL	PICTURE EDIT ROUTINE USING BUSINESS INSTRUCTION SET



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1975, 1981 BY DIGITAL EQUIPMENT CORPORATION


;V10**************************
;NAME	DATE		COMMENTS
;******************************

	TWOSEG
	RELOC	400000

	SEARCH	LBLPRM
	%%LBLP==%%LBLP
	BIS==:BIS

ENTRY EDIT.B

IFE	BIS,<

EDIT.B:	OUTSTR	[ASCIZ "?LIBOL is not configured to support KL-10 extended instruction set
"]
	JRST	KILL.##
	END>

;EDIT.B PERFORMS EDITING UPON AN ASCII OR SIXBIT FIELD AS
;	DIRECTED BY THE COBOL PICTURE CLAUSE.

;A PATTERN CONSISTING OF A STRING OF 9-BIT BYTES DIRECTS THE EDITING.
;	THE VALUES FOR THOSE BYTES ARE DESCRIBED IN BISGEN.MAC.

;THE ROUTINE IS CALLED BY:
;	MOVEI PARM,[<SOURCE POINTER>
;		    <DESTINATION POINTER>]
;	PUSHJ PP,EDIT.B
;	XWD	<PATTERN ADDRESS>,<EDIT CODE>
;	XWD	<FLOAT CHARACTER>,<FILL CHARACTER>	;IN DEST MODE

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

;THE BYTE POINTERS USED BY EDIT.B 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


;EDIT CODE - THE EDIT CODE SPECIFIES THE TYPE OF TRANSLATION IF ANY
;	AND WHETHER THE MOVE IS MUMERIC OR NOT.  THE FOLLOWING FORMULA
;	DEFINES THE CODE WHERE:
;
;	SIXBIT=0
;	ASCII=1
;	EBCDIC=2
; AND
;	ALPHA=0
;	NUMERIC=1
;
;	CODE = <DESTINATION CODE> + <SOURCE CODE>*3 + <EDIT TYPE>*9D
;
;BLANK WHEN ZERO OF A NON-EDITED FIELD IS PROCESSED BY EDIT.B AS AN
;	ALPHA MOVE SO THAT OVERPUNCHED CHARACTERS WILL NOT BE CONVERTED.
;	THE ALPHA TABLES DO NOTE THAT A NON-ZERO CHARACTER HAS PASSED
;	THROUGH VIA THE N FLAG.
;
;AFTER CODES - FOLLOWING THE PATTERN STOP CODE THERE IS AN 
;	ADDITIONAL AFTERCODE WHICH TELLS WHETHER OR NOT MORE WORK IS
;	TO BE DONE THAT THE EDIT INSTRUCTION COUNDN'T DO.
;		0 - DONE
;		1 - OVERWRITE THE DESTINATION STRING FROM THE BEGINNING
;			WITH THE FILL CHARACTER.   THE PATTERN BYTE 
;			FOLLOWING THIS CODE GIVES THE COUNT
;		2 - SET LEADING SIGN (1ST CHARACTER ) TO "-"
;
;FLOAT CHARACTER - CONTAINS 200000 FOR SIXBIT BLANK AND 
;	400000 FOR "$"
;
;THE CONTENTS OF ALL ACCUMULATORS EXCEPT 0, 1, 2, 3, PA AND PP ARE LOST

SUBTTL	DEFINITIONS

;REGISTERS
E0==BIST0	;POINTER TO E0 BLOCK
T0=BIST1	;TEMP
T1=BIST2	;TEMP

DEFINE	SRCPRM = <(PARM)>	;SOURCE POINTER PARAMETER
DEFINE	DSTPRM = <1(PARM)>	;DESTINATION POINTER PARAMETER

DEFINE	PATBN = <[POINT  2,PATRN,5]>	;INDEX OF NEXT PATTERN BYTE

PATTBL:	; TABLE OF POINTERS TO PATTERN BYTES INDEXED BY PATBN
	POINT	9,(PATRN),8
	POINT	9,(PATRN),17
	POINT	9,(PATRN),26
	POINT	9,(PATRN),35

EXTERNAL	MRKPTR		;MARK POINTER STORAGE

SUBTTL TRANSLATION  TABLE,,E0 BLOCK    POINTER TABLE

; THIS TABLE IS INDEXED BY EDIT CODE
;	 THE LEFT SIDE IS THE TRANSLATION TABLE ADDRESS
;	 AND THE THE RIGHR SIDE IS THE APPROPRIATE E0 BLOCK ADDRESS

TRTBLS:
	XWD	ALP.66##,	E0.6##
	XWD	ALP.67##,	E0.7##
	XWD	ALP.69##,	E0.9##
	XWD	ALP.76##,	E0.6##
	XWD	ALP.77##,	E0.7##
	XWD	ALP.79##,	E0.9##
	XWD	ALP.96##,	E0.6##
	XWD	ALP.97##,	E0.7##
	XWD	ALP.99##,	E0.9##
	XWD	NUM.66##,	E0.6##
	XWD	NUM.67##,	E0.7##
	XWD	NUM.69##,	E0.9##
	XWD	NUM.76##,	E0.6##
	XWD	NUM.77##,	E0.7##
	XWD	NUM.79##,	E0.9##
	XWD	NUM.96##,	E0.6##
	XWD	NUM.97##,	E0.7##
	XWD	NUM.99##,	E0.9##

SUBTTL	EDITING ROUTINE

EDIT.B:	;ENTRY FOR ALL EDITS

	MOVE	SRCPT,SRCPRM	;GET SOURCE POINTER
	MOVE	DSTPT,DSTPRM	;GET DESTINATION POINTER

	MOVE	T0,@(PP)	;XWD PATTERN,EDIT-CODE
	AOS	(PP)		;SKIP XWD FOR RETURN
	HLRZ	PATRN,T0	;SET UP PATTERN REGISTER
	TLO	B.FLAG,BFLG.S	;TURN SIGNIFICANCE ON TO START
	MOVE	E0,TRTBLS(T0)	;GET [TRANSLATION-TAB,,E0-ADDRESS]
				;BASED UPON EDIT CODE IN TO
	HLRM	E0,E0.TBL(E0)	;STORE TRANSLATION TABLE ADDRESS IN E0

	SKIPGE	T0,@(PP)	;GET [FLOAT,,FILL] CHARACTERS
	HRL	T0,E0.$(E0)	;GET DOLLAR SIGN
	AOS	(PP)		;SKIP XWD FOR RETURN
	HLRZM	T0,E0.FLT(E0)	;STORE FLOAT CHAR IN E0
	HRRZM	T0,E0.FIL(E0)	;STORE FILL CHAR IN E0

	MOVEI	MARKAD,MRKPTR	;SET UP ADDRESS OF MARK POINTER STORE

	EXTEND	B.FLAG,(E0)	;EDIT
	  JRST	ERROR		;PROBLEMS

	;NOW CHECK THE AFTER CODE TO SEE IF EVERYTHING IS DONE

	LDB	T0,PATBN	;CURRENT PATTERN BYTE INDEX
	LDB	T1,PATTBL(T0)	;GET BYTE
	XCT	AFTABL(T1)	;PROCEED ACCORDINGLY

AFTABL:
	POPJ	PP,		; 0 - DONE
	JRST	BWZ		; 1 - BWZ TO BE DONE
	JRST	LEADSG		; 2 - LEADING SIGN

SUBTTL AFTER PROCESSING

BWZ:	; OVERWRITE DESTINATION STRING WITH FILL CHARACTER FROM
	; THE BEGINNING
	; THIS IS HERE BECAUSE THERE IS NO WAY FOR EDIT INST
	; TO RETURN TO THE BEGINNING OF DESTINATION STRING 
	; WITHOUT ISSUING A SIGSET THERE, WHICH WE CANNOT BECAUSE
	; ITS NEEDED LATER

	;SET UP A MOVE STRING LEFT JUSTIFIED WITH NO SOURCE 
	;USE THE DESTINATION STRING BUT ITS COUNT IS ONLY THE
	;NUMBER OF CHARACTERS THAT NEED TO BE OVERWRITTEN.
	;NO SOURCE WILL CAUSE THE FILL CHARACTER TO BE WRITTEN
	;INTO ALL CHARACTERS OF THE DESTINATION STRING

	;MOVSLJ REGISTER SETUP
	MOVE	T0,PATTBL(T0)	;GET PATTERN BYTE POINTER
	ILDB	DSTCNT,T0	;GET COUNT
	MOVE	DSTPT,DSTPRM	;GET DESTINATION POINTER AGAIN
	SETZB	SRCCNT,SRCPT	;SET SOURCE POINTER AND COUNT TO 0

	;SET UP E0 BLOCK IN THE REGS ALSO
	MOVSI	T0+E0.INS,(MOVSLJ)	;LEFT JUSTIFIED MOVE
	MOVE	T0+E0.FIL,E0.FIL(E0)	;GET CURRENT FILL CHAR

	EXTEND	B.FLAG,T0	;DO IT
	  JRST	ERROR

	POPJ	PP,		;ALL DONE

LEADSG:	;LEADING  SIGN

	MOVE	DSTPT,DSTPRM	;GET DESTINATION POINTER
	MOVE	T0,E0.MI(E0)	;GET "-"
	IDPB	T0,DSTPT	;OVERWRITE 1ST CHARACTER WITH IT

	POPJ	PP,		;DONE

ERROR:	OUTSTR	[ASCIZ	'?LIBOL EDIT error - please submit SPR
']
	POPJ	PP,

	END			;EDIT.B