Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/editb.mac
There are 7 other files named editb.mac in the archive. Click here to see a list.
; UPD ID= 1031 on 4/28/83 at 11:00 PM by NIXON
TITLE EDIT.B FOR COBOTS
;AUTHOR D.B.TOLMAN
SUBTTL PICTURE EDIT ROUTINE USING BUSINESS INSTRUCTION SET
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) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;V10**************************
;NAME DATE COMMENTS
;******************************
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
SEARCH LBLPRM
%%LBLP==%%LBLP
ENTRY EDIT.B
;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