Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
edit.mac
There are 36 other files named edit.mac in the archive. Click here to see a list.
TITLE EDIT FOR LIBOL V12C
SUBTTL PICTURE EDIT ROUTINE 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.
;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
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
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