Google
 

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