Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/gd.mac
There are 9 other files named gd.mac in the archive. Click here to see a list.
; UPD ID= 1345 on 8/2/83 at 4:21 PM by NIXON
TITLE GD FOR COBOTS
SUBTTL CONVERT DISPLAY TO BINARY /ACK
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) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;REVISION HISTORY:
;V12A *****
;[630] 14-MAY-80 /DAW FIX CONVERSION OF ITEM WITH LEADING +
;
;V10 *****
; 13-AUG-76 [451] FIX NUMERIC MOVES FOR BIS
; 12-DEC-74 /ACK CREATION.
; 5/15/75 /DBT BIS
; 8/4/77 /DAW ADD CVTDB. ROUTINE - SETUP DONE INLINE
;*****
SEARCH LBLPRM ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
EXTERN EASTB. ;FORCE EASTAB TO BE LOADED
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
COMMENT \
NOTE THIS CODE MAY RUN IN SECTION 1 IF SORT IS IN A NON-ZERO SECTION
SO BE CAREFUL ABOUT INDEXING AND INDIRECTION.
THIS ROUTINE CONVERTS A DISPLAY ITEM TO A ONE OR TWO WORD BINARY ITEM.
CALL:
MOVE 16,[Z AC,PARAMETER ADDRESS]
PUSHJ 17,GD6./GD7./GD9.
PARAMETERS:
THE ACCUMULATOR FIELD OF AC 16 CONTAINS THE AC INTO WHICH THE FIRST
WORD OF THE RESULT IS TO BE PLACED.
THE RIGHT HALF OF AC 16 POINTS TO A WORD IN THE FOLLOWING FORMAT:
BITS 0-5 BYTE POINTER RESIDUE FOR THE INPUT FIELD.
BIT 6 1 IF THE FIELD IS SIGNED.
BITS 7-17 SIZE OF THE INPUT FIELD.
BITS 18-35 ADDRESS OF THE FIRST CHAR OF THE INPUT FIELD.
RETURNS:
CALL+1 ALWAYS.
REGISTERS USED:
CNT, CH, T1(ALIAS CH), T2, AC, AC+1, AC+2, IPTR, SW, JAC, CPTR
\
ENTRY GD6. ;IF THE INPUT IS SIXBIT.
ENTRY GD7. ;IF THE INPUT IS ASCII.
ENTRY GD9. ;IF THE INPUT IS EBCDIC.
ENTRY GDX.
ENTRY CVTDB. ;(BIS) SETUP DONE INLINE
ENTRY CVDBL. ;CVTDB. WITH LEADING SIGN
ENTRY CVDBT. ;CVTDB. WITH TRAILING SIGN
INTERN CVBKTB
EXTERN SPCCH. ;SPECIAL CHARACTER FLAG.
EXTERN LDGCH. ;LEADING CHARACTER FLAG.
EXTERN IBNCH. ;IMBEDDED "-" FLAG.
EXTERN NOLCH. ;MASK USED TO CHANGE CPTR SO IT NO LONGER
; PICKS UP THE LEADING CHARACTER FLAG.
EXTERN RET.1
EXTERN BSET1.,PACFL.,BPTNM.
; FLAGS FOR LEFT SIDE OF SW
SW.TER==1B5 ;ALREADY TYPED ERROR MESSAGE ONCE
LED.SG==3B35 ;LEADING SIGN MASK
LED.PL==1B35 ;LEADING +
LED.MI==1B34 ;LEADING -
IFN TOPS20,<SEARCH MONSYM,MACSYM>
IFE TOPS20,<SEARCH MACTEN>
DEFINE TYPE(ADDR),<
IFE TOPS20,<OUTSTR ADDR>
IFN TOPS20,<PUSH PP,1
HRROI 1,ADDR
PSOUT%
POP PP,1>
>;END DEFINE TYPE
DEFINE TYPET1,<
IFE TOPS20, OUTCHR 1
IFN TOPS20, PBOUT%
>;END DEFINE TYPET1
GD9.: MOVEI BISCH,9 ;EBCDIC INPUT
JRST GDX.
GD7.: SKIPA BISCH,[7] ;ASCII INPUT
GD6.: MOVEI BISCH,6 ;SIXBIT INPUT
;ENTRY FOR PNZ CALL
GDX.: JSP JAC,BSET1. ;GET PARAMETER
LDB BIST0,PACFL. ;GET RESULTANT AC
HRLM SRCCNT,(PP) ;SAVE THE SIZE.
GD0: EXTEND B.FLAG,CVDB.T-6(SW)
JRST ABRTCK ;ABORT CHECK
;UN ABORTED EXIT
NUMFIN: TXNE SW,SW.SGN ;CAN IT BE SIGNED?
JRST SIGNED ;YES
NEGIFM: TLNE B.FLAG,BFLG.M ;NEGATE IF M FLAG ON
JRST NEGATE
NONEG: HLRZ SRCCNT,(PP) ;GET THE SIZE BACK.
CAILE SRCCNT,^D10 ;ONE OR TWO WORD RESULT.
JRST NONEG2 ;TWO, GO ON.
MOVEM DSTLO,(BIST0) ;STORE RESULT.
POPJ PP, ;RETURN.
SIGNED: TLNN SW,LED.SG ;ANY LEADING SIGNS
JRST NONEG ;NONE
LEDSGN: TLNE SW,LED.PL ;LEADING PLUS???
JRST NEGIFM ;YES
NEGNOM: TLNE B.FLAG,BFLG.M ;NEGATE IF M NOT ON
JRST NONEG
NEGATE: HLRZ SRCCNT,(PP) ;GET THE SIZE BACK.
CAILE SRCCNT,^D10 ;ONE OR TWO WORD RESULT.
JRST NEGAT2 ;TWO, GO ON.
MOVNM DSTLO,(BIST0) ;STORE RESULT.
POPJ PP, ;RETURN.
NEGAT2: DMOVN DSTHI,DSTHI ;NEGATE THE RESULT
JUMPGE DSTHI,NONEG2 ;IF 0, DON'T TURN ON SIGN BIT
TLO DSTLO,(1B0) ;PUT BACK SIGN BIT
NONEG2: DMOVEM DSTHI,(BIST0) ;STORE RESULT
POPJ PP,
; E0 TABLE FOR EXTEND CNVDB INSTRUCTION
CVDB.T: CVTDBT CVDB.6## ;SIXBIT
CVTDBT CVDB.7## ;ASCII
0
CVTDBT CVDB.9## ;EBCDIC
;INSTRUCTION ABORTED - WHY??
ABRTCK: LDB BISCH,SRCPT ;GET OFFENDING CHARACTER
LDB BISCH,BPTNM.-6(SW) ;GET NUMERIC SYMBOL VALUE
ANDI BISCH,3
; ALL ABORTS WILL COME FROM SPECIAL CHARACTERS
; AND THUS THE NUMERIC VALUE WILL BE THE SPECIAL VALUE
JRST @SPCTA0(BISCH)
SPCTA0: IFIW GD0 ;IGNORE NULLS
IFIW PLCK ;GRAPHIC PLUS
IFIW MICK ;GRAPHIC MINUS
IFIW BKTAB ;TRAILING BLANK OR TAB
;GRAPHIC MINUS
MICK: TLNE SW,LED.SG ;ANY LEADING SIGNS YET
JRST LEDSG1 ;YES - DONE
SKIPN DSTHI ;ANY DIGITS YET?
SKIPE DSTHI+1
JRST TSTSGN ; [451] YES SEE IF RESULT S/B NEG
TLO SW,LED.MI ;NOTE LEADING GRAPHIC -
JRST GD0 ;RESTART
;GRAPHIC PLUS
PLCK: TLNE SW,LED.SG ;ANY LEADING SIGNS
JRST LEDSG1 ;YES - DONE
SKIPN DSTHI ;ANY DIGITS YET?
SKIPE DSTHI+1
JRST NONEG ;YES - DONE
TLO SW,LED.PL ;NOTE LEADING PLUS
JRST GD0 ;RESTART
;ABORT ON BLANK OR TAB
BKTAB: TLNN SW,LED.SG ;ANY LEADING SIGNS
JRST NEGIFM ;NO - GO BY M FLAG
TSTSGN: TXNE SW,SW.SGN ; [451] NEGATIVE IF INPUT IS SIGNED
JRST NEGATE
JRST NONEG ; [451] ELSE THE RESULT IS POSITIVE
;LEADING SIGN WITH ABORT SO THAT INSTRUCTION NEVER GOT A
; CHANCE TO NEGATE THE NUMBER IE. M FLAG MEANS NOTHING
LEDSG1: TLNN SW,LED.MI ;MINUS
JRST NONEG ;NO
JRST NEGATE ;YES.
;CVTDB ROUTINE
; CALLED FROM INLINE CODE AS FOLLOWS:
; MOVE AC5,BYTE.PTR.TO.INPUT.STRING
; MOVEI AC4,SIZE.OF.INPUT.STRING
; MOVE SW,[XWD FLAGS,BYTE.SIZE]
; PUSHJ PP,CVTDB##
; MOVE AC,AC10 -OR- DMOVE AC,AC7
;NOTE THAT THE SIGN BIT IS ALWAYS SET IN ACC "SW" SO LOCAL INDEXING WORKS
CVTDB.: EXTEND B.FLAG,CVDB.T-6(SW)
JRST CVABRT ;ABORT CHECK
TXNE SW,SW.SGN
JRST SIGN1 ;JUMP IF SIGNED
NEGIF1: TLNN B.FLAG,BFLG.M ;IF M FLAG ON..
POPJ PP,
JRST NEGAT1 ;NEGATE
SIGN1: TLNN SW,LED.SG ;LEADING SIGN?
POPJ PP, ;NOPE
TLNE SW,LED.PL ;LEADING PLUS?
JRST NEGIF1 ;YES, USE "M" FLAG
TLNE B.FLAG,BFLG.M ;NEGATE IF M NOT ON
POPJ PP,
NEGAT1: TXNE SW,SW.2WC
JRST NEG2 ;TWO WORD RESULT
MOVN DSTLO,DSTLO
POPJ PP,
NEG2: DMOVN DSTHI,DSTHI ;NEGATE 2-WORD RESULT
JUMPGE DSTHI,.+2 ; 0 - DON'T TURN ON SIGN BIT
TXO DSTLO,1B0 ;PUT BACK SIGN BIT
POPJ PP,
;HERE IF CONVERSION ABORTS
CVABRT: LDB BISCH,SRCPT ;GET OFFENDING CHARACTER
LDB BISCH,BPTNM.-6(SW) ;GET NUMBER SYMBOL VALUE
ANDI BISCH,3
JRST @SPCTA1(BISCH) ;DISPATCH ON CHARACTER TYPE
SPCTA1: IFIW CVTDB. ;NULL - IGNORE
IFIW CVPLCK ;GRAPHIC PLUS
IFIW CVMICK ;GRAPHIC MINUS
IFIW CVBKTB ;TRAILING BLANKS OR TABS
;PLUS
CVPLCK: TLNE SW,LED.SG ;ANY LEADING SIGNS SEEN YET?
JRST LEDSG2 ;YES, DONE
SKIPN DSTHI ;NO--ANY DIGITS YET?
SKIPE DSTHI+1
POPJ PP, ;YES--DONE
TLO SW,LED.PL ;REMEMBER LEADING PLUS
JRST CVTDB. ;CONTINUE CONVERSION
;MINUS
CVMICK: TLNE SW,LED.SG ;ANY LEADING SIGNS SEEN YET?
JRST LEDSG2 ;YES--DONE
SKIPN DSTHI
SKIPE DSTHI+1 ;ANY DIGITS YET?
JRST TSTSG1 ;YES, DONE
TLO SW,LED.MI ;REMEMBER LEADING MINUS
JRST CVTDB. ;CONTINUE CONVERSION
;BLANK OR TAB
CVBKTB: TLNN SW,LED.SG ;ANY LEADING SIGNS?
JRST NEGIF1 ;NO--GO BY "M" FLAG
TLNE SW,LED.PL ;[630] LEADING PLUS?
POPJ PP, ;[630] YES, POSITIVE ANSWER, RETURN
TSTSG1: TXNN SW,SW.SGN ;NEGATE IF INPUT IS SIGNED
POPJ PP, ;ELSE RESULT IS POSITIVE
JRST NEGAT1 ;SIGNED
LEDSG2: TLNN SW,LED.MI ;MINUS?
POPJ PP, ;NO
JRST NEGAT1 ;YES--NEGATE RESULT
; IF THERE IS A SEPARATE SIGN, BE REALLY PICKY ABOUT
; WHAT THE DATA LOOKS LIKE. A RUNTIME WARNING WILL BE GENERATED
; IF THERE IS JUNK.
CVDBL.: DMOVEM SRCCNT,CVARG.## ;SAVE ARGS INCASE ERRORS
PUSH PP,AC1 ;SAVE AC1
ILDB AC1,SRCPT ; GET FIRST CHARACTER - SHOULD BE GRAPHIC SIGN
PUSHJ PP,@TYPCA3-6(SW) ;CONVERT TO ASCII CHARACTER
CAIE AC1,"+" ;GRAPHIC PLUS
CAIN AC1,"-" ;OR GRAPHIC MINUS
JRST CVTDL1 ;YES, OK SO FAR
PUSHJ PP,CVTDL2 ;"Numeric conversion check.."
DMOVE SRCCNT,CVARG. ;GET BACK ARGS..
IBP SRCPT ;SKIP OVER FIRST CHAR..
CVTDL1: TLO SW,LED.PL ;ASSUME LEADING +
CAIN AC1,"-" ;UNLESS IT WAS GRAPHIC MINUS..
TLC SW,LED.PL!LED.MI ; TURN ON LED.MI, OFF LED.PL
POP PP,AC1 ;RESTORE AC1
SUBI B.FLAG,1 ;MAKE IT ONE LESS CHARACTER..
EXTEND B.FLAG,CSSCV-6(SW) ;CONVERT THE NUMBER..
JRST CVTDL2 ;ABORT CHECK (SHOULDN'T HAPPEN!)
TXNN SW,SW.SGN ;SKIP IF SIGNED.
POPJ PP, ;UNSIGNED RESULT - RETURN WITH MAGNITUDE
TLNE SW,LED.PL ;LEADING PLUS?
POPJ PP, ;YES, LEAVE AS IS
TXNE SW,SW.2WC ;CHECK FOR 2-WORD RESULT
JRST NEG2 ;GO NEGATE IT
MOVN DSTLO,DSTLO ;NEGATE 1-WORD RESULT
POPJ PP, ;RETURN
;NUMERIC CONVERSION INSTRUCTIONS
CSSCV: CVTDBT NUMS.6## ;SIXBIT
CVTDBT NUMS.7## ;ASCII
0
CVTDBT NUMS.9## ;EBCDIC
CVTDL2: TXOE SW,SW.TER ;IF ALREADY GAVE ERROR,
POPJ PP, ;JUST RETURN
TYPE [ASCIZ/%LBLCVT Numeric conversion check for leading separate sign item
/]
PJRST TYPCAG ;TYPE ARGUMENTS TO THE ROUTINE, THEN POPJ
TYPCAG: DMOVE SRCCNT,CVARG. ;RESTORE INITIAL ARGS.
TYPE <[ASCIZ/ [LBLCVD Invalid data was: !/]>
TYPCA1: SOJL SRCCNT,TYPCA2 ;JUMP WHEN ALL DONE
ILDB AC1,SRCPT ;GET CHARACTER IN AC1
PUSHJ PP,@TYPCA3-6(SW) ;CONVERT TO ASCII CHARACTER
TYPET1 ;TYPE IT
JRST TYPCA1 ;LOOP FOR WHOLE DATA ITEM
TYPCA3: IFIW TYPCA4 ;CONVERT SIXBIT TO ASCII
IFIW TYPCA5 ;ASCII TO ASCII PRINTABLE
0
IFIW TYPCA6 ;EBCDIC TO ASCII PRINTABLE
;Convert SIXBIT character to ASCII printable
TYPCA4: ADDI AC1,40 ;CONVERT SIXBIT TO ASCIZ
POPJ PP, ;RETURN - THEY'RE ALL PRINTABLE
;Convert ASCII character to ASCII printable
TYPCA5: SKIPN AC1 ;CONVERT NULLS TO
MOVEI AC1," " ;SPACES
CAIGE AC1," " ;IF CONTROL-CHARACTER..
MOVEI AC1,"\" ;WE WILL TYPE BACKSLASH
POPJ PP, ;RETURN
;Convert EBCDIC character to ASCII printable
TYPCA6: LDB AC1,IPT971## ;CONVERT EBCDIC TO ASCII
JRST TYPCA5 ;CONVERT TO PRINTABLE CHARACTER
;HERE WHEN DONE PRINTING THE INVALID DATA
TYPCA2: TYPE <[ASCIZ/!]
/]>
POPJ PP, ;RETURN WITH WHAT WE GOT.
;CONVERT DECIMAL TO BINARY, TRAILING SEPARATE SIGN
CVDBT.: DMOVEM SRCCNT,CVARG. ;SAVE ARGUMENTS, INCASE ERRORS
EXTEND B.FLAG,CSSCV-6(SW) ;CONVERT..
JRST CVTAT ;ABORT FOR TRAILING SIGN
CVTDT1: TYPE [ASCIZ/%LBLCVT Numeric conversion check for trailing separate sign
/]
PJRST TYPCAG ;TYPE ARGUMENT TO THE ROUTINE, THEN RETURN
;Normal case should get here as the instruction aborts on
; the last character, which will be + or -.
CVTAT: TRNE B.FLAG,-1 ;SHOULD BE NO CHARACTERS LEFT!
JRST CVTDT1 ;NO, RANDOM CHARACTER IN MIDDLE OF ITEM
PUSH PP,AC1 ;SAVE 1
LDB AC1,SRCPT ;GET OFFENDING CHARACTER
PUSHJ PP,@TYPCA3-6(SW) ;CONVERT TO ASCII CHARACTER
CAIN AC1,"+" ;GRAPHIC PLUS?
JRST CVTAT1 ;YES, RETURN
CAIE AC1,"-" ;GRAPHIC MINUS?
JRST [POP PP,AC1 ;No, FIX STACK
JRST CVTDT1] ;(Error: RANDOM CHARACTER IN SIGN POSITION)
POP PP,AC1 ;RESTORE T1
TXNN SW,SW.SGN ;NEGATE IT IF ANSWER IS SIGNED
POPJ PP, ;NO, JUST RETURN WITH POSITIVE NUMBER
JRST NEGAT1
;Number ends with graphic plus - leave answer as is.
CVTAT1: POP PP,AC1 ;RESTORE 1
POPJ PP, ;RETURN
END