.TITLE	DSCMAC - MACRO ROUTINES TO BE USED WITH DSCCPY
	.SBTTL	FIXFDB - PATCH FDB WITH INFORMATION FROM HEADER
	.IDENT	/V 1.00/
;+
; FIXFDB.MAC
;
; THIS ROUTINE PATCHES THE FDB OF A FORTRAN FILE GIVEN DATA FROM AN
;  OLD FILE HEADER.
; THE OFFSETS COPIED ARE:
;		FROM HEADER	TO FDB
;		----------------------
;		F.RTYP		H.UFAT
;     THROUGH   F.FFBY		H.UFAT+13
;
; THE FIRST 7. WORDS OF THE FDB ARE COPIED.
;
;
; CALL SEQUENCE:  FORTRAN
;
;	CALL FIXFDB (LUN, HEADER, IFERR)
;
;	LUN    = (ENTRY) INTEGER LUN OF OPEN FILE
;	HEADER = (ENTRY) IMAGE OF OLD FILE HEADER
;	IFERR  = (RETURN) ERROR CODE
;		          +1 (IS.SUC) IF OK
;			  -37. (IE.NLN) NO FILE ON LUN
;
; OTHER ROUTINES REQUIRED:
;
;	$FCHNL - GET ADDRESS OF FORTRAN FDB GIVEN FORTRAN LUN.
;
;-
	.GLOBL	$FCHNL
	.MCALL	FDOF$L,FHDOF$,IOERR$
;
	FDOF$L		; DEFINE FDB OFFSETS
	FHDOF$	DEF$L	; DEFINE HEADER BLOCK OFFSETS
	IOERR$	DEF$L	; DEFINE ERROR CODES
D.FDB=14		; OFFSET FROM FORTRAN FDB TO FCS FDB
;
FIXFDB::
	MOV	#IE.NLN,@6(R5)	; ASSUME ERROR RETURN
	MOV	@2(R5),R2	; PICK UP FORTRAN LUN
	JSR	PC,$FCHNL	; GO GET FORTRAN FDB ADDRESS
	BCS	900$		; IF CARRY SET, ERROR
;
	ADD	#D.FDB,R0	; POINT R0 TO FCS PART OF FDB.
	ADD	#F.RTYP,R0	; POINT RO TO START OF INFO TO COPY
	MOV	4(R5),R1	; POINT R1 TO HEADER
	ADD	#H.UFAT,R1	; POINT R1 TO USER-FILE-ATTRIBUTES PART.
	MOV	#14.,R2		; R2 COUNTS BYTES TO BE COPIED
10$:
	MOVB	(R1)+,(R0)+	; COPY A BYTE
	DEC	R2
	BNE	10$
;
; COPY COMPLETE, RETURN SUCCESS
	MOV	#IS.SUC,@6(R5)
900$:
	RTS	PC		; ALL DONE

	.SBTTL	ICPOS - RETURN THE INDEX OF A MATCHING CHARACTER (FUNCTION)
;+
; ICPOS.MAC
;
; THIS FUNCTION SCANS CHARACTERS FROM THE INPUT STRING -INSTR-
;   AND RETURNS AS ITS VALUE, THE INDEX OF THE FIRST CHARACTER
;   WHICH MATCHES -TC-.  IT SCANS THE AREA OF THE STRING FROM
;   -NS- TO -NE-
;
; CALLING SEQUENCE:   FORTRAN      (FUNCTION)
;
;	M = ICPOS (INSTR, NS, NE, TC)
;
;      INSTR  - BYTE ARRAY HAVING STRING TO SCAN
;      NS     - STARTING INDEX (FORTRAN INDEX) OF SCAN AREA
;      NE     - ENDING INDEX OF SCAN AREA
;      TC     - BYTE TO BE MATCHED.  
;
; WARNING -- THIS ROUTINE DOES 7-BIT MATCHING
;
; ERRORS:
;      IF THE CHARACTER -TC- CANNOT BE FOUND IN THE STRING, THE
;      FUNCTION VALUE RETURNS 0 (ZERO)
;
; OTHER ROUTINES REQUIRED:  NONE
;-
ICPOS::
	CLR	R0		; ASSUME NO MATCH
;
	MOV	@4(R5),R1	; PICK UP START INDEX
	DEC	R1		;
	MOV	@6(R5),R2	; PICK UP ENDING INDEX
	SUB	R1,R2		; COMPUTE NUMBER CHARS. TO DO
	BLE	990$		; IF (-), ALREADY DONE
;
	ADD	2(R5),R1	; R1 NOW HOLDS STRING START ADDRESS
	MOV	R1,-(SP)	; SAVE IT FOR LATER
;
	MOVB	@10(R5),R3	; PICK UP TARGET CHARACTER
	BIC	#177600,R3	; CHOP TO 7-BIT ASCII
;
10$:
	MOVB	(R1)+,R4	; PICK UP STRING CHARACTER
	BIC	#177600,R4	; MASK TO 7-BITS
	CMPB	R3,R4		; SEE IF MATCHES TARGET
	BEQ	20$		; BR IF IT DOES
	DEC	R2		; COUNT DOWN NBR. TO DO
	BGT	10$		; BR IF STILL SOME LEFT
;
	TST	(SP)+		; FALLS THRU IF NO MATCH, CLEAN STACK
	BR	990$		; AND RETURN
20$:
	MOV	R1,R0		; GOT A MATCH, COMPUTE MATCHING INDEX
	SUB	(SP)+,R0	; 
	ADD	@4(R5),R0
	DEC	R0
990$:
	RTS	PC		; DONE

	.SBTTL IFSTEQ - DETERMINE IF TWO STRINGS MATCH (WITH WILDCARD)
;+
; THIS FUNCTION DOES CHARACTER STRING MATCHING WITH WILD CARD AND
;   WILD CHARACTER MATCH.
;
; THE WILD-CARD CHARACTER (*) MATCHES THE ENTIRE FIELD.
; THE WILD-CHARACTER CHARACTER (?) MATCHES ANY ASCII CHARACTER.
;
; WILD CARDS AND WILD CHARACTERS MAY APPEAR IN EITHER STRING.
;  BUT THE WILD-CARD CHARACTER MUST BE THE FIRST CHARACTER
;  IN THE STRING IF IT IS PRESENT AT ALL
;
; CALL SEQUENCE:  FORTRAN
;
;       IFSTEQ (S1, S2, N)
;
;      S1     = (ENTRY) BYTE ARRAY, SOURCE STRING
;      S2     = (ENTRY) BYTE ARRAY, TARGET STRING
;      N      = (ENTRY) INTEGER NUMBER OF CHARACTERS TO COMPARE.
;
; OTHER ROUTINES REQUIRED:  NONE
;
;-
; DEFINE CONSTANTS
TRUE = 100000
FALSE = 0
WCARD = '*		; WILD CARD
WCHAR = '?		; WILD CHARACTER
;
IFSTEQ::
; ASSUME STRINGS DO NOT MATCH
	MOV	#FALSE,R0	; R0 IS LOGICAL FUNCTION RETURN
;
	MOV	@6(R5),R1	; PICK UP NUMBER CHARACTERS TO DO
	BLE	990$		; IF .LE. 0, RETURN IMMEDIATELY
;
	MOV	2(R5),R2	; R2 IS SOURCE STRING S1 ADDRESS
	MOV	4(R5),R3	; R3 IS SOURCE STRING S2 ADDRESS
;
	MOVB	(R2),R4		; PICK UP FIRST SOURCE CHARACTER
	BIC	#177600,R4	; MASK TO 7-BITS
	CMPB	R4,#WCARD	; SEE IF IT IS WILDCARD
	BEQ	900$		; IF EQ- IT IS, RETURN .TRUE.
	MOVB	(R3),R5		; PICK UP FIRST TARGET CHARACTER
	BIC	#177600,R5	; MASK TO 7-BITS
	CMPB	R5,#WCARD	; SEE IF IT IS WILDCARD
	BEQ	900$		; IF EQ -- IT IS, RETURN .TRUE.
10$:
	MOVB	(R2)+,R4	; R4 HOLDS SOURCE CHARACTER
	BIC	#177600,R4	; MASK TO 7-BITS
;
	MOVB	(R3)+,R5	; R5 NOW HOLDS TARGET CHARACTER
	BIC	#177600,R5	; MASK TO 7-BITS
;
	CMPB	R4,#WCHAR	; CHECK FOR WILD CHARACTER
	BEQ	20$		; IF EQ, YES, SKIP REST OF TEST
;
	CMPB	R5,#WCHAR	; CHECK S2 FOR WILD CHARACTER
	BEQ	20$		; IF EQ, YES
;
	CMPB	R4,R5		; NOW CHECK THE TWO CHARACTERS
	BNE	990$		; IF NE, DONT MATCH, STRINGS DONT MATCH
20$:
	DEC	R1		; COUNT DOWN NUMBER OF CHARACTERS TO DO
	BGT	10$		; AND CONTINUE IF CHARACTERS LEFT
;
900$:
	MOV	#TRUE,R0	; RETURN .TRUE. IF FALLS THRU OK
;
990$:
	RTS	PC		; DONE

	.SBTTL	PPASC - CONVERT BINARY WORD TO [UIC] STRING
;+
; PPASC.MAC
;
; FORTRAN CALLABLE BINARY UIC-TO-ASCII STRING CONVERSION
;
; CALL SEQUENCE:
;
;	CALL PPASC (IUICI, ICODEI, LSTRO, STRING)
;
;	IUICI = (ENTRY) INTEGER BINARY UIC TO CONVERT
;	ICODEI = (ENTRY) CODE WORD, CONTROLS OUTPUT STRING FORMAT
;		BIT 0 = 0 -- SUPPRESS LEADING ZEROS
;			1 -- DO NOT SUPPRESS LEADING ZEROS
;		BIT 1 = 0 -- PUT SEPARATORS (IE [,])
;			1 -- DO NOT PUT SEPARATORS
;	LSTRO = (RETURN) LENGTH OF STRING CONVERTED
;	STRING = (RETURN) STRING RESULT OF CONVERSION.
;
; ERRORS: NONE DETECTED
;
; OTHER ROUTINES REQUIRED:
;
;	.PPASC - SYSTEM ROUTINE TO CONVERT BINARY WORD TO ASCII [UIC]
;		 STRING.
;-
	.GLOBL	PPASC,.PPASC
;
PPASC::
	MOV	@2(R5),R3	; PICK UP UIC VALUE
	MOV	@4(R5),R4	; PICK UP CONTROL CODE
	MOV	10(R5),R2	; PICK UP RESULT STRING ADDRESS
;
	JSR	PC,.PPASC	; DO CONVERSION
;
	SUB	10(R5),R2	; COMPUTE LENGTH OF RESULTING STRING
	MOV	R2,@6(R5)	; RETURN IT TO USER
;
	RTS	PC		; DONE

	.SBTTL	UNSPAC - REMOVE ASCII WHITE CHARACTERS FROM STRING
;+
;  UNSPAC.MAC
;
; THIS ROUTINE REMOVES 'WHITE' ASCII CHARACTERS FROM A STRING.
;
; THE ONLY CHARACTERS WHICH WILL REMAIN FOLLOWING A CALL TO UNSPAC ARE:
;     ASCII CODES 041(8) THROUGH 176(8).
;
; THE PROCESSED STRING IS RETURNED TO THE STRING BUFFER LOW ADDRESSES.
;
; CALL SEQUENCE:  FORTRAN
;	CALL UNSPAC (STRING, NCHARS)
;
;	STRING = (ENTRY) BYTE ARRAY CONTAINING STRING TO BE SCANNED.
;		 (RETURNS) STRING AFTER REMOVAL OF WHITE SPACE.
;
;	NCHARS = (ENTRY) INTEGER NUMBER OF CHARACTERS IN STRING.
;		 (RETURNS) NUMBER OF CHARACTERS REMAINING.
;
; ERRORS DETECTED:  NONE
;
; OTHER ROUTINES REQUIRED: NONE
;
; GLOBAL REFERENCES: NONE
;
; 17-JAN-76, W. BURTON.
;-
	.GLOBL	UNSPAC
;
UNSPAC:
	MOV	2(R5),R0	; PICK UP STRING START ADDRESS
	MOV	R0,R1		; COPY IT FOR PUT-AWAY
	MOV	@4(R5),R2	; PICK UP CHARACTER COUNT TO DO
10$:
	BLE	900$		; IF .LE. 0, DONE
;
	MOVB	(R0)+,R3	; PICK UP A CHARACTER
	CMPB	R3,#40		; SEE IF IT -SPACE- OR LESS
	BLE	20$		; IF LE, YES
;
	CMPB	R3,#177		; IS IT DELETE
	BEQ	20$		; IF EQ, YES
;
	MOVB	R3,(R1)+	; RETURN THE CHARACTER
20$:
	DEC	R2
	BR	10$
900$:
	SUB	2(R5),R1	; COMPUTE CHARACTER COUNT RETURNED
	MOV	R1,@4(R5)
	RTS	PC		; DONE
;

	.SBTTL	UPCASE - CONVERT ASCII TO UPPER CASE
;+
; UPCASE.MAC
;
; THIS ROUTINE SCANS A BYTE ARRAY AND CONVERTS THE CHARACTERS TO UPPER
;  CASE, 7-BIT ASCII.
; THE HIGH ORDER (8TH) BIT IS FORCED OFF
;
; CALLING SEQUENCE:  FORTRAN
;
;	CALL UPCASE (INSTR, NCHARS)
;
;	INSTR  = (ENTRY) BYTE ARRAY OF CHARACTERS TO SCAN
;		 (RETURNS) ARRAY OF CHARACTERS WITH BIT-8 OFF AND CASE
;		           CONVERTED.
;
;	NCHARS = (ENTRY) NUMBER OF CHARACTERS IN THE STRING.
;
; ERRORS DETECTED: NONE
;
; OTHER ROUTINES REQUIRED:  NONE
;
; GLOBALS USED:  NONE
;
; 17-JAN-76, W. BURTON
;-
	.GLOBL	UPCASE
;
UPCASE::
	MOV	2(R5),R0	; PICK UP STRING ADDRESS
	MOV	@4(R5),R1	; PICK UP NUMBER OF CHARACTERS
10$:
	BLE	900$		; IF NUMBER .LE. 0, DONE
;
	MOVB	(R0),R2		; PICK UP A CHARACTER
	BIC	#177600,R2	; STRIP OFF HIGH-BIT
;
	CMPB	R2,#141		; SEE IF IT NEEDS CHANGING
	BMI	20$		; IF (-) IT DOES NOT
;
	CMPB	R2,#173		; SEE IF IT IS LEFT-CURLY-BRACKET
	BPL	20$		; OR ABOVE, DONT CONVERT IF +
;
	BIC	#40,R2		; CONVERT LOWER TO UPPER CASE
20$:
	MOVB	R2,(R0)+	; RETURN THE CHARACTER
;
	DEC	R1		; COUNT DOWN CHARS LEFT
	BR	10$
;
900$:
	RTS	PC		; DONE
	.END