.TITLE ASCEBC
	.NLIST BEX,SEQ
;CONVERTS BETWEEN ASCII AND EBCDIC, DOES NOT SWAP BYTES
;	ROBERT DIGRAZIA
;	MIT, L973
;ADAPTED FROM CHARACTER CONVERTER OF SQUIBB, INC, DECUS #11-46
;	G. EVERHART
;	4/1978  ADDED FULL ASCII/EBCDIC TO TABLES

;
;	A S C I I  - -  E B C D I C     T R A N S L A T O R
;
;	THIS FILE CONTAINS 2 FORTRAN-CALLABLE ROUTINES WHICH WILL
;TRANSLATE ASCII TO EBCDIC OR VICE-VERSA. IF ASSEMBLED WITH THE
;PARAMETER "$$R5" DEFINED, THE ROUTINES WILL EXPECT TO BE CALLED
;VIA THE DOS-11 JSR R5 SEQUENCE. OTHERWISE THEY ASSUME R5 POINTS
;TO THE ARGUMENT BLOCK BUT THE ROUTINE IS CALLED VIA A JSR PC.
;(THIS IS THE NEW FORTRAN STANDARD AND THE DEFAULT FOR THE ASSEMBLY.)
;
;	ANY SIZE ARRAY MAY BE TRANSLATED, AND IN-PLACE TRANSLATION WILL
;FUNCTION CORRECTLY. ODD BYTE COUNTS ARE OK ALSO.
;
;	SINCE ASCII IS A 7-BIT CODE, AND EBCDIC IS AN 8-BIT CODE, EBCDIC
;HAS 256 CHARACTERS WHILE ASCII HAS 128. THESE ROUTINES WILL WORK CORRECTLY
;FOR THOSE CHARACTERS DEFINED IN BOTH CHARACTER SETS. FOR THE OTHERS, PSEUDO
;"ASCII" CODES ARE GENERATED FROM EBCDIC WITH THE 200 BIT SET WHEN GOING FROM
;EBCDIC TO ASCII, AND THESE CODES ARE CONVERTED TO THE ORIGINAL EBCDIC WHEN
;TRANSLATING FROM ASCII TO EBCDIC. IF THE OPTIONAL FOURTH ARGUMENT IS
;PRESENT, THE ASCII WILL BE EDITED AS FOLLOWS:
;	IF THE ARGUMENT IS ZERO, NO EDITING WILL OCCUR
;	IF THE ARGUMENT IS NEGATIVE, ASCII WILL BE FORCED TO 0-177 OCTAL AND
;			LOWER-TO-UPPER CASE CONVERSION WILL BE DONE
;	IF THE ARGUMENT IS POSITIVE, ASCII WILL BE FORCED TO 0-177 OCTAL ONLY.
;FORCING ASCII TO THIS RANGE MEANS THAT THE ASCII WILL BE CHANGED PRIOR TO
;TRANSLATION TO EBCDIC OR AFTER TRANSLATION FROM EBCDIC.
;
;THE CALL SEQUENCE IS:
;	CALL AE(INPUT,OUTPUT,NBYTES,MODE)  OR CALL AE(INPUT,OUTPUT,NBYTES)
;	CALL EA(INPUT,OUTPUT,NBYTES,MODE)  OR CALL EA(INPUT,OUTPUT,NBYTES)
;
	.GLOBL EA,AE	;EBCDIC-ASCII, ASCII-EBCDIC

;EBCDIC-ASCII   FORTRAN:    CALL EA(EBCDIC,ASCII,NBYTES)
;				EBCDIC=INPUT, ASCII=OUTPUT, NBYTES=#BYTES
;		ASSEMBLER:  JSR R5,EA
;			     BR Q
;			    .WORD EBCDIC	;ADDRESS OF EBCDIC CHARACTERS
;			    .WORD ASCII		;ADRS OF ASCII OUTPUT
;			    .WORD NBYTE		;ADDRESS OF WORD CONTAINING
;						NO. BYTES TO CONVERT
;			   Q:

R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
EA:	MOV R0,-(SP)
	MOV R1,-(SP)
	MOV R2,-(SP)
	MOV R3,-(SP)
	MOV R4,-(SP)
	MOV 2(R5),R1	; POINTER TO EBCDIC 
	MOV 4(R5),R2	; POINTER TO ASCII
	MOV @6(R5),R3	; BUFFR. LENGTH
	BLE RTE		;OMIT IF BYTE COUNT NOT > 0
	MOV #TABL1,R4	; POINTER TO TABLE 1
BYTE: 	MOVB (R1)+,R0	; MOVE INTO R0
	BIC #177400,R0	; LOSE SIGN EXTENSION
	ADD R4,R0	; ADD TABLE 1 ADDR.
	MOVB	@R0,R0	;GET DATA
	BIC	#177400,R0 ; LOSE SIGN EXTENSION IF ANY
	CMPB (R5),#4	;IS MODE ARGUMENT THERE?
	BNE	1$	;NO, CAN'T TRANSLATE ASCII NOW
	TST	@10(R5)	;YES, SEE WHAT WE OUGHT TO DO WITH ASCII
	BEQ	1$	;DO NOTHING. JUST COPY IT.
	BPL	2$	;POSITIVE--FORCE 0-177 ASCII RESULT.
	BIT	#100,R0	;COULD IT BE UPPER CASE ALPHA?
	BEQ	2$	;NO, JUST HAVE TO ZAP 200 BIT
	BIC	#40,R0	;YES, BE SURE IT IS UPPER CASE
2$:	BIC	#177600,R0 ; LOSE 200 BIT OF ASCII ONLY
1$:	MOVB R0,(R2)+	; PUT IN ASCII BUFFR.
	DEC R3	; DEC COUNT
	BGT BYTE
RTE:	MOV (SP)+,R4
	MOV (SP)+,R3
	MOV (SP)+,R2
	MOV (SP)+,R1
	MOV (SP)+,R0
	.IF	DF,$$R5
	RTS	R5	; YES RETURN
	.IFF
	RTS	PC	;RSX FORTRAN CALL
	.ENDC

;ASCII-EBCDIC
;		FORTRAN:	CALL AE(ASCII,EBCDIC,NBYTES)
;    OR				CALL AE(ASCII,EBCDIC,NBYTES,MODE)
;		ASSEMBLER:	JSR R5,AE ;IF $$R5 DEFINED IN THIS ASSEMBLY
;				BR X
;				.WORD ASCII
;				.WORD EBCDIC
;				.WORD NBYTE
;				X:
;	OR			JSR	PC,AE	;IF $$R5 NOT DEFINED
;
;		(R5)-->	.WORD	NARGS	;LOW BYTE HAS # ARGS
;			.WORD	ASCII
;			.WORD	EBCDIC
;			.WORD	NBYTE
;		(	.WORD	MODE	;OPTIONAL)
;					;ARGUMENTS AS IN EA
AE:	MOV R0,-(SP)	; SAVE REGISTERS
	MOV R1,-(SP)
	MOV R2,-(SP)
	MOV R3,-(SP)
	MOV R4,-(SP)
	MOV 2(R5),R1	; POINT TO ASCII DATA
	MOV 4(R5),R2	; POINT TO EBCDIC DATA
	MOV @6(R5),R3	; BUFF. LENGTH
	BLE RTA
	MOV #TABL2,R4	; PPINTER TO TABL 2
CHAR1:	MOVB (R1)+,R0	; GET CHAR.
	BIC #177400,R0	; LOSE SIGN EXTENSION
	CMPB (R5),#4	; MODE ARGUMENT EXIST?
	BNE	1$	;NO, SKIP ANY EDITING OF ASCII
	TST	@10(R5)	;IS MODE ARGUMENT +/0/- (WHICH?)
	BEQ	1$	;MODE=0. DO NO EDITING OF ASCII
	BGT	2$	;MODE>0. CLEAR 200 BIT OF ASCII.
	BIT	#100,R0	;COULD IT BE UPPER CASE?
	BEQ	2$	;NO, JUST CLEAR 200 BIT
	BIC	#40,R0	;YES, ENSURE UPPER CASE
2$:	BIC	#177600,R0 ;GUARANTEE IN 0-177 RANGE	
1$:	ADD R4,R0	; ADD TABL2 ADDR.
	MOVB (R0),(R2)+	;TO OUTPUT BFR
	DEC R3
	BGT CHAR1
RTA:	MOV (SP)+,R4
	MOV (SP)+,R3
	MOV (SP)+,R2
	MOV (SP)+,R1
	MOV (SP)+,R0	; RESTORE REGISTERS
	.IF	DF,$$R5
	RTS R5	; RETURN TO PROG.
	.IFF
	RTS	PC
	.ENDC
TABL1:	.BYTE 0	; NUL
	.BYTE 1,2,3	;CTL-A,CTL-B,CTL-C
.=TABL1+4
	.BYTE 201,11,202,177	; PF,HT,LC,DEL
	.BYTE 203,204,205,13,14,15,16,17,20,21,22,206
; FILL
.=TABL1+24
	.BYTE 207,210,10,211	; RES,CR,BS,IDL
	.BYTE 30,31,212,213,34,35,36,37,214,215,216,217,220
.=TABL1+45
	.BYTE 12,27,33	; LF,ETB,ESC
	.BYTE 221,222,223,224,225,5,6,7,226,227,26,230
.=TABL1+64
	.BYTE 231,232,233	; PN,RS,UC
	.BYTE 4 ;   EOT
	.BYTE 234,235,236,237,24,25,240,32
.=TABL1+100
	.BYTE 40	; SPACE
	.BYTE	241,242,243,244,245,246,247,250,251
.=TABL1+112
	.BYTE 252	; CENTS SIGN
	.BYTE 56,74	; .,<
	.BYTE 50,53,253	; (+ LOG OR
	.BYTE 46 ; &
	.BYTE 254,255,256,257,260,261,262,263,264
.=TABL1+132
	.BYTE 41,44,52,51 ; !$*)
	.BYTE 73,265	; SEMICOLON,LOGICAL NOT
.=TABL1+140
	.BYTE 55	; DASH
	.BYTE 57 ; /
	.BYTE 266,267,270,271,272,273,274,275,174
.=TABL1+153
	.BYTE 54,45,137,76	; COMMA,%,UNDERSCORE,>
	.BYTE 77 ;  ?
	.BYTE 276,277,300,301,302,303,304,305,306,140
.=TABL1+172
	.BYTE 72,43,100		; : # @
	.BYTE 47	; APPROST.
	.BYTE 75,42	; =,"
	.BYTE 310,141,142,143,144,145,146,147,150,151	;L.C. A-I
	.BYTE 136,312,313,314,315,316,317		;^------
.=TABL1+221
	.BYTE 152,153,154,155,156,157,160,161,162	;L.C. J-R
	.BYTE 320,321,322,323,324,325,326,176
.=TABL1+242
	.BYTE 163,164,165,166,167,170,171,172  ; S-Z
.=TABL1+252
	.BYTE 327,330,331,133,333,334,335,336,337	;---[-----
	.BYTE 340,341,342,343,344,345,346,347,350
	.BYTE 351,135,353,354				; -]--
.=TABL1+300
	.BYTE 173,101,102,103,104,105,106,107,110,111	; [,A-I
	.BYTE 355,356,357,360,361,362
.=TABL1+320	; CAPS
	.BYTE 175,112,113,114,115,116,117,120,121,122	; ],J-R
	.BYTE 363,364,365,366,367,370,134,371
.=TABL1+342
	.BYTE 123,124,125,126,127,130,131,132  ; S-Z
	.BYTE 372,373,374,375,376,307
.=TABL1+360
	.BYTE 60,61,62,63,64,65,66,67,70,71 ; 0-9
	.BYTE 23,133,135,'\,136,255.
	.EVEN
TABL2:	.BYTE 0,1,2,3	; NUL ---
	.BYTE 67,45.,46.,47.	; EOT ---
	.BYTE 26	; BS
	.BYTE 5,37.,11.,12.,13.	; -LF,VT,FF,CR
	.BYTE 14.,15.,16.,17.,18.,250.,60.,61.,50.
	.BYTE 38.,24.,25.,63.,39.,28.,29.,30.,31.
.=TABL2+40
	.BYTE 100,132,177	; SPACE !"
	.BYTE 173,133,154,120	; #$%&
	.BYTE 175	; '
	.BYTE 115,135,134,116 ; ()*+
	.BYTE 153,140,113,141  ; ,-./
	.BYTE 360,361,362,363,364,365,366,367	; 0-7
	.BYTE 370,371				; 8,9
	.BYTE 172,136,114	; :;<
					; =>?@A-E
	.BYTE 176,156,157,174,301,302,303,304,305
	.BYTE 306,307,310,311	; F-I
			; J-R
	.BYTE 321,322,323,324,325,326,327,330,331
	.BYTE 342,343,344,345,346,347,350,351 ; S-Z CAPS
	.BYTE 255
	.BYTE 253.  ; \
	.BYTE 275,212,109.,376
	.BYTE 201,202,203,204,205,206,207,210,211  ; A-I
	.BYTE 221,222,223,224,225,226,227,230,231  ; J-R
	.BYTE 242,243,244,245,246,247,250,251	; S-Z
	.BYTE 192.,106.,208.,121.,7
	.BYTE 4,6,8.,9.,10.,19.,20.,21.,23.,26.,27.,32.,33.,34.
	.BYTE 35.,36.,40.,41.,42.,43.,44.,48.,49. ;EXTRA EBCDIC CHARACTERS
	.BYTE 51.,52.,53.,54.,55.,56.,57.,58.,59.,62.
	.BYTE 65.,66.,67.,68.,69.,70.,71.,72.,73.,74.,79.
	.BYTE 81.,82.,83.,84.,85.,86.,87.,88.,89.,95.,98.,99.,100.
	.BYTE 101.,102.,103.,104.,105.,112.,113.,114.,115.,116.,117.
	.BYTE 118.,119.,120.,128.,138.,139.,140.,141.,142.,143.,144.
	.BYTE 154.,155.,156.,157.,158.,159.,160.,170.,171.,172.,173.
	.BYTE 174.,175.,176.,177.,178.,179.,180.,181.,182.,183.,184.
	.BYTE 185.,186.,187.,188.,189.,190.,191.,202.,203.,204.,205.
	.BYTE 206.,207.,218.,219.,220.,221.,222.,223.,225.,234.,235.
	.BYTE 236.,237.,238.,239.,255.
	.EVEN
	.END