Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - 70,6067/decnet/mlibxx.mac
There are 4 other files named mlibxx.mac in the archive. Click here to see a list.
	TITLE MACLIB -- MACRO SUBROUTINE LIBRARY
	SUBTTL SECTION X. --  INTERNAL LIBRARY SUPPORT ROUTINES
;
;	==================================================================
;
;	MAPC	DECsystem-10	MACRO SUBROUTINE LIBRARY
;
;	Developed by D. A. Wallace, DEC-10 Systems Group
;
;	These routines and all related documentation were developed at
;	Monsanto Agricultural Products Co., St. Louis, Mo. 63167.
;
;	==================================================================
;
COMMENT %

       		List of Routines in This Section:
        	--------------------------------

    ASC6..	Convert FORTRAN ASCII string argument to SIXBIT
    CKSA..	Check FORTRAN calling argument for string type
    CVAD..      Convert date values to ASCII string
    CVTA..	Convert from SIXBIT to ASCII
    CVJD..      Convert Julian date to numeric values
    DATJ..      Convert date values to Julian date
    DEFD..      Return current date for default
    GETD..      Parse date string to numeric values
    GETJ..	Get Job number argument
    GET6..  	Convert ASCII (in T2-T3) to SIXBIT (in T0)
    GT5A..      Get a literal or ASCII A5 input value
    SCNA..	Parse standard file argument call
    SCND..	Scan device argument and validate
    SCNP..	Scan PATH argument with default
    SCN6..	Scan for ASCII argument; convert to SIXBIT
    SCNX..	Continue next argument from SCN6..
    SIXA..      Convert SIXBIT (in T0) to ASCII in (T2-T3)
    VLDA..      Validate numeric values for date
;-
	Module Revision History:
	------------------------


	Edit 1:		11 Jan 80	DAW	Original
	     2:		28 Jul 81	DAW	Added SCN?.. routines
	     3:		24 Nov 81	DAW	Fix SCND.. to give LPTnn for LPT
						and make PATH decode more flexible
	     4:		11 Oct 82	DAW	Added new support modules for
						Version 3: SIXA../GET6.. and
						XDATE routines, fix SCNP.. for DP
	     5:		20 Apr 83	DAW	Replaced ASC6../TYPE.. for F77
						Deleted GTDV.., added GT5A..,
						Updated GETD../CVAD../FILSCN
						for F66/F77 compatibility

	     6:		 5 May 83	DAW	CKSA.. fixed to accept indirect arg
	     7:		10 Jun 83	DAW	CKSA.. boundary alignment fix
	     8:		 1 Aug 83	DAW	CVAD.. remove min. length test
END COMMENT%

	PRGEND
	TITLE	ASC6..
	SUBTTL	Convert FORTRAN string argument to SIXBIT
;
;	Author:		D A Wallace, DEC-10 Systems Group
;
;	Written:	11-Apr-83
;
;	Purpose:	To convert FORTRAN calling argument to SIXBIT value.
;			Input string pointer is checked for compatibility
;			with both F66 (V5A) and F77, upper or lower case.
;
;	Calling sequence:	MOVEI	T1,n(A)		; Input arg ref
;				PUSHJ	P,ASC6..##
;				Returns SIXBIT result in T0
;
;	Register Definitions

T0=0			; Temporary
T1=1			; Temporary
T2=2			; Temporary
CHR=3			; Character
SSP=4			; SIXBIT String pointer
A=16			; FORTRAN Argument pointer
P=17			; Stack pointer

	ENTRY	ASC6..

ASC6..::				; Convert ASCII string to SIXBIT

	PUSHJ	P,CKSA..##		; Validate calling argument
	MOVSI	SSP,(POINT 6,,)		; Setup byte pointer to T0 for result
	CAILE	T2,6			; Check length of arg
	  MOVEI	T2,6			;  If GT 6 set to 6 characters
	SETZ	T0,			; Clear result

ASC.1:	ILDB	CHR,T1			; Get next input char
	CAIG	CHR," "			; Check for terminating/illegal char
	  POPJ	P,			;  End of Input string, done
	CAIGE	CHR,"a"			; Check for lower case char
	ADDI	CHR,40			; Convert to SIXBIT
	IDPB	CHR,SSP			; Output char to result string
	SOJG	T2,ASC.1		; Loop for max char count
	POPJ	P,			; Max count reached, done

	PRGEND
	TITLE	ISR... Internal Support Routines
;
;	Register Definition
;
	T0=0
	T1=1
	T2=2
	CNT=3
	ASP=4			; ASCII string pointer
	CHR=5			; Character value
	SSP=6			; SIXBIT string pointer
	A=16
	P=17

	SEARCH UUOSYM

	SUBTTL GETJ.. -- Get Job argument for GETTAB
;
;	Get Job arg and return in LH for GETTAB
;
	ENTRY	GETJ..

GETJ..:	MOVE	T0,@0(A)	; Get Job number from caller
	CAIG	T0,0
	PJOB	T0,		; Default current user
	HRLZ	T0,T0		; Move Job number to left half of word
	POPJ	P,		; Return


	SUBTTL CVTA.. -- Convert from SIXBIT to ASCII
;
;	Call with SIXBIT String in T0 and T1, and no. output char in CNT
;	Will output to string buffer address in ASP
;
;
	ENTRY	CVTA..

CVTA..:	MOVSI	SSP,(POINT 6,0)	; Make byte pointer for SIXBIT input
	HRLI	ASP,(POINT 7,0)	; Make byte pointer for ASCII output
CLOOP:	ILDB	CHR,SSP		; Get next SIXBIT char
	ADDI	CHR,40		; Convert to ASCII
	IDPB	CHR,ASP		; Output to ASCII string
	SOJG	CNT,CLOOP	; Loop until all char converted
	POPJ	P,		; Done, return

	PRGEND
	TITLE GT5A..
	SUBTTL Get Literal or ASCII A5 Input value
;
;	Call with arg pointer in T1, returns value in T0
;

T0=0		; Temporary
T1=1		; Temporary
T2=2		; Temporary
T3=3		; Temporary
CH=4		; Char
P=17		; Stack pointer

	ENTRY	GT5A..

GT5A..:	PUSHJ	P,CKSA..##	; Get valid ASCII byte pointer to arg
	MOVSI	T3,(POINT 7,,)	; Setup result byte pointer in T3
	SETZ	T0,		; Clear result word
	CAIL	T2,5		; Check no. of char in string
	  MOVEI	T2,5		;   Too many, accept first 5

LOOP:	ILDB	CH,T1		; Get next input char
	CAIL	CH,"a"		; Test for upper/lower case
	  CAILE	CH,"z"
	JRST	OUT.1		; OK, go output char
	SUBI	CH,40		; Convert lower to upper case char
OUT.1:	IDPB	CH,T3		; Output char to result word
	SOJG	T2,LOOP		; Loop until all char checked
	POPJ	P,		; Done, return

	PRGEND
	TITLE FILSCN
	SUBTTL	File specification scanner support routines

;
;	Author:		D A Wallace, MAPC DEC-10 Systems Group
;
;	Written:	9-Jul-81
;
;
;	Routine to parse standardized calling arguments for file
;	specification of the form:
;
;		CALL XXXX(DEVICE,FILNAM,PATH,IERR)
;
;		where DEVICE = device name (eg. 'DSKZ:')
;		      FILNAM = file name ('MYFILE.EXT')
;		      PATH   = PROJ,,PROG + 'SFD1, ... SFD5')
;
;	Calling arguments are converted from ASCII to SIXBIT as required,
;	and stored in global file block (SF$BLK) defined in this module
;

;	Register Definitions

	T0=0		; Temporary
	T1=1
	T2=2
	T3=3
	T4=4
	ASP=5		; ASCII string pointer
	SSP=6		; SIXBIT string pointer
	CNT=7		; Char count
	DELIM=10	; Delimiter char
	G1=11		; Global
	G2=12
	IERR=15		; Global error code flag
	A=16		; Argument pointer
	P=17		; Stack pointer




	SEARCH UUOSYM

	INTERNAL SF$BLK, SCNA.., SCND.., SCNF.., SCNP.., SCN6..

SF$BLK:: 			; Global File Block for SCN...
FILDEV:	EXP 0			; File device
FILNAM:	EXP 0			; File name (SIXBIT)
FILEXT:	EXP 0			; File extension (SIXBIT)
	EXP 0
FILPTH:	XWD 0,PTHBLK		; File path pointer

PTHBLK:	XWD 0,-2		; Path block
	EXP 1
FILPPN:	0,,0			; PROJ,,PROG
	BLOCK 5			; SFD's (5)
	EXP 0

.PTHLN=. - PTHBLK
JOBDEV:	BLOCK 3			; Job structure block

	SUBTTL SCNA.. Parse standard calling arguments

	ENTRY	SCNA..

;
;	CALLING SEQUENCE:	PUSHJ	P,SCNA..##
;				  JRST	  error
;				results in SF$BLK for use with OPEN, LOOKUP

SCNA..::
	MOVEI	T1,0(A)		; [5] Get first calling argument
	MOVEI	G1,SF$BLK	; Set up pointer for results
	MOVEI	CNT,5		; Max length is 5 char
	PUSHJ	P,SCND..	; Scan for device name
	  JRST	SCN.ER		;   Bad device
	MOVEM	T0,0(G1)	; Store it

	MOVEI	T1,1(A)		; [5] Get second argument pointer
	PUSHJ	P,SCNF..	; Scan for file name-extension
	DMOVEM	T0,1(G1)	; Store it

	MOVEI	G2,PTHBLK	; Set up path block result pointer
	MOVEI	ASP,@2(A)	; Get third argument pointer
	PUSHJ	P,SCNP..	; Scan for path specification
	  JRST	SCN.ER		;   Bad path argument
	SETZ	IERR,		; Success, all arguments parsed
	AOS	(P)		; Take skip return
SCN.ER:	POPJ	P,		; Return
	SUBTTL	SCND.. Scan device and validate

;
;	CALLING SEQUENCE: MOVEI	ASP, addr
;			  MOVEI	CNT,n		(max length name)
;			  PUSHJ	P,SCND..
;			    JRST Not a disk (no skip)
;			  returns SIXBIT device name in T0
;			          Device DEVCHR bits in T1
;

DV.DSK==200000

	ENTRY SCND..

SCND..::
	MOVEI	DELIM,":"	; Device delimiter is colon
	PUSHJ	P,SCN6..	; Convert ASCII arg to SIXBIT
	JUMPE	T0,SCND.1	; [5] If zero get default device
	CAME	T0,[SIXBIT/LPT/]	; Check if line printer
	JRST	SCND.0		;  no, check if disk
	MOVE	T2,T0		; Save device name
	WHERE	T0,		; Get node number for LPT
	  SETZ	T0,		;   zero if err
	ANDI	T0,77		; Mask of node number returned
	IDIVI	T0,10		; Convert to SIXBIT number
	LSH	T0,14
	IORI	T0,202000
	LSH	T1,6
	ADD	T0,T1
	IOR	T0,T2		; Now add 'LPT'
	JRST	SCND.2
SCND.0:	CAME	T0,[SIXBIT/DSK/]	; Skip if generic DSK
	JRST	SCND.2		;  Specific device specified, go verify

SCND.1:	SETOM	JOBDEV		; Get first structure name
	MOVE	T0,[XWD 3,JOBDEV]
	JOBSTR	T0,
	  JRST	SCND.3		;  Got problem
	MOVE	T0,JOBDEV	; Get SIXBIT arg returned

SCND.2:	MOVE	T1,T0		; Check device name result in T0
	DEVCHR	T1,		; Make sure its a disk
	TLNE	T1,DV.DSK	; Skip if not disk
	AOS	(P)		;  else take skip return
SCND.3:	POPJ	P,		; Return
	SUBTTL SCNF.. Scan file name-extension

;
;	CALLING SEQUENCE:	MOVEI	ASP, addr
;				PUSHJ	P,SCNF..
;				returns T0 = filename (SIXBIT)
;				        T1 = extension
;

	ENTRY SCNF..

SCNF..::
	MOVEI	DELIM,"."	; Set delimiter to dot
	MOVEI	CNT,7		; Max filename is 6 char
	PUSHJ	P,SCN6..	; Get SIXBIT value
	EXCH	T2,T0		; Save it temporarily
	MOVEI	DELIM," "	; Set delimiter to space
	MOVEI	CNT,3		; Max extension is 3 char
	PUSHJ	P,SCNX..	; Get SIXBIT value from current string
	MOVEM	T0,T1		; Return extension value in T1
	EXCH	T2,T0		; Return file name in T0
	POPJ	P,		; Return
	SUBTTL SCNP.. Scan PATH specification

;
;	CALLING SEQUENCE:	MOVEI	G2,PTHBLK (result)
;				MOVEI	ASP, addr (input arg pointer)
;				PUSHJ	P, SCNP..
;				  JRST	 error
;				path block defined
;

	ENTRY SCNP..

SCNP..::
	MOVEI	T1,2(A)		; Get pointer to arg
	LDB	T2,[POINT 4,(T1),12]	; Get FORTRAN type code
	CAIE	T2,10		; Check if Double Precision arg
	JRST	SCNP.0		; No, go on
	HRL	T1,0(ASP)	; Get PROJ in LH
	HRR	T1,1(ASP)	; Get PROG in RH
	AOSA	ASP		; Increment pointer to SFDs
SCNP.0:	DMOVE	T1,0(ASP)	; Get PPN in packed word format
	JUMPN	T1,SCNP.1	; If PPN defined, go on

				; PPN undefined, user wants default
	PJOB	T1,		; Read current path for this job
	HRLM	T1,T1		; Set up arg for PATH call
	HRRI	T1,.PTFRD	;  to read current user path
	MOVEM	T1,0(G2)	; Set header in block
	MOVEI	T1,1
	MOVEM	T1,1(G2)
	MOVE	T1,G2
	HRLI	T1,.PTHLN
	PATH.	T1,		; Execute Monitor PATH call
	 JRST	SCNP.4		;  Got a problem
	 JRST	SCNP.3		; Success, default read into block

SCNP.1:	MOVEM	T1,2(G2)	; User has defined PPN, store in PATH blk
	SKIPN	T2		; Check if DP mode (T2=0)
	AOS	ASP		;  Yes, advance SFD pointer to next word
	AOS	ASP		; Increment pointer to SFD string
	SETZB	T0,T1		; Clear SFDs in PATH block
	DMOVEM	T0,4(G2)	; First SFD always set (0 default)	
	DMOVEM	T0,6(G2)
	MOVE	T2,[XWD -5,3]	; Setup AOBJN pointer to SFD
	ADD	T2,G2
	MOVEI	DELIM,","	; Delimiter is comma
	HRLI	ASP,(POINT 7,,)	; Define ASCII string pointer
SCNP.2:	MOVEI	CNT,7		; Max length is 7 char
	PUSHJ	P,SCNX..	; Get next SIXBIT value
	MOVEM	T0,(T2)		; Store SFD value
	JUMPE	T3,SCNP.3	;  Done if end of string = 0
	AOBJN	T2,SCNP.2	; Loop for five levels
SCNP.3:	AOS	(P)		; Success, take skip return
SCNP.4:	POPJ	P,		; Return
	SUBTTL SCN6.. Scan for SIXBIT value

;
;	CALLING SEQUENCE:	MOVEI	T1, addr ptr (ASCII string input arg)
;				MOVEI	DELIM,char (Special delimiter character)
;				MOVEI	CNT,n  (Maximum string length)
;				PUSHJ	P,SCN6.. (If new string)
;				     or
;				PUSHJ	P,SCNX.. (If continue current string)
;				returns converted ASCII argument in SIXBIT in T0

	ENTRY SCN6.., SCNX..

SCN6..::			; Entry to start from beginning of new string
	PUSHJ	P,CKSA..##	; [5] Check for valid byte pointer value
	MOVE	ASP,T1		; [5] Setup byte pointer for input string

SCNX..::			; Entry to continue from current string
	MOVSI	SSP,(POINT 6,,)	; Define SIXBIT byte pointer to T0 result
	CAIG	CNT,12		; Validate count (12 SIXBIT char max)
	 CAIG	CNT,0
	 MOVEI	CNT,6		; Default 6, assumed if out of range
	SETZB	T0,T1		; Clear result

SCN6.1:	ILDB	T3,ASP		; Get next ASCII input char
	CAIE	T3,0		; Check if end of string (CHR=0)
	CAIN	T3," "		;  or space delimiter
	  POPJ	P,		;  Yes, done
	CAMN	T3,DELIM	;  or special delimiter found
	  POPJ	P,		; Yes, done
	CAIGE	T3,"a"		; Convert ASCII to SIXBIT
	ADDI	T3," "
	IDPB	T3,SSP		; Output SIXBIT char to result
	SOJG	CNT,SCN6.1	; Loop for next char
	SETO	T3,		; Max number char scanned, chr = EOS (-1)
	POPJ	P,		; Return
 
	PRGEND
	TITLE XDATE
	SUBTTL External Date Support Routines
;
;	Author:		D A Wallace, MAPC DEC-10 Systems Group
;
;	Written:	20-Dec-79	Rev: 4-Oct-82 (From JULIAN)
;
;	Routines to provide common support for date parsing/conversion
;	for ASCJUL, CKDATE, DATASC, DATDEL, JULASC, JULDAT, JULIAN
;


	SUBTTL Registers and Date Tables
;
;	Register Definition
;
	T0=0			; Temporary
	T1=1			; Temporary
	T2=2			; Temporary
	T3=3			; Temporary
	ADP=4			; Byte pointer ASCII date string
	MO=5			; Month
	DAY=6			; Day
	YR=7			; Year
	DELIM=10		; Delimiter flag
	CNT=11			; Loop counter
	IERR=12			; Error flag
	A=16			; FORTRAN argument list pointer
	P=17			; Push down list


;
;	MACRO to declare ASCII storage allocation
;
	DEFINE	DA($1),<
	ASCII	/$1/>

	SALL

;
;	Table of Days in Months
;

	RADIX	10

IDAYS:	EXP	31,28,31,30,31,30,31,31,30,31,30,31

	RADIX	8


;
;	Table of ASCII Month Names
;
MONTHS:
	DA JAN
	DA FEB
	DA MAR
	DA APR
	DA MAY
	DA JUN
	DA JUL
	DA AUG
	DA SEP
	DA OCT
	DA NOV
	DA DEC

;
;	Table of ASCII Names for Months of Year
;
MONAME:	DA -Jan-
	DA -Feb-
	DA -Mar-
	DA -Apr-
	DA -May-
	DA -Jun-
	DA -Jul-
	DA -Aug-
	DA -Sep-
	DA -Oct-
	DA -Nov-
	DA -Dec-
	SUBTTL DEFD..  --  Default Current Date
;
;	CALLING SEQUENCE:	PUSHJ	P,DEFD..##
;				Returns current date in MO, DAY, YR
;
	ENTRY DEFD..

DEFD..::

	DATE	T0,		; Issue date Monitor call
	IDIVI	T0,^D31		; Convert to Integer values
	AOJ	T1,
	MOVE	DAY,T1		;  for DAY
	IDIVI	T0,^D12
	AOJ	T1,
	MOVE	MO,T1		;  for MONTH
	ADDI	T0,^D64
	MOVE	YR,T0		;  for YEAR
	POPJ	P,		; Return
	SUBTTL VLDA.. -- Validate Year, Month, Day Arguments

;	CALLING SEQUENCE:	MOVE	MO,<month>
;				MOVE	DAY,<day>
;				MOVE	YR,<year>
;				PUSHJ	P,VLDA..##
;				  JRST	Error
;				Returns with IERR=0 (OK) or -2 (bad date)


	ENTRY VLDA..

VLDA..::

	SETZ	IERR,		; Clear bad arg flag, assume no errors
	CAIL	YR,0		; Check for reasonable YEAR value
	  CAILE	YR,^D99		;   (00 - 99 or 1800-2200)
	  SKIPA
	  JRST	CKLPR		;  OK, Check if leap year
	CAIL	YR,^D1800
	  CAILE	YR,^D2200
	  JRST	BADARG

CKLPR:	MOVEI	T0,^D28		; Correct IDAYS of Feb if leap year
	MOVEM	T0,IDAYS+1	; Assume not a leap year
	MOVE	T0,YR		; Check if current year is leap year
	IDIVI	T0,^D400	; Is leap year if YR/400 rem in T1=0
	JUMPE	T1,SETLYR	;  Yes, calculate as leap year
	MOVE	T0,YR		; Check year for century
	IDIVI	T0,^D100	; Is year century year? (Rem T1=0)
	JUMPE	T1,CKMON	; Not a leap year if century year (eg 1900)
	MOVE	T0,YR
	IDIVI	T0,4
	CAIG	T1,0		; If remainder not leap year
SETLYR:	AOS	IDAYS+1		; Add day to Feb for leap year (Days=29)

CKMON:	CAIL	MO,1		;  Range check MONTH (1 - 12)
	  CAILE	MO,^D12
	  JRST	BADARG

	CAIL	DAY,1		;   Range check DAY (1 to No. days in Month)
	  CAMLE	DAY,IDAYS-1(MO)
	  JRST	BADARG

	AOSA	(P)		; No errors, take skip return
BADARG:	MOVNI	IERR,2		; Found bad argument

	POPJ	P,		; Return
	SUBTTL DATJ..  -- Convert MO, DAY, YR values to Julian Date

;	CALLING SEQUENCE:	MOVE	MO,<month>
;				MOVE	DAY,<day>
;				MOVE	YR,<year>
;				PUSHJ	P,DATJ..##
;				  JRST	Error (Bad input date)
;				Returns Julian Date (YYDDD) in T0
;

	ENTRY DATJ..

DATJ..::

	PUSHJ	P,VLDA..	; Validate arguments and correct for leap year
	  POPJ	P,		;   Return bad input arg IERR=-1
	MOVEI	T1,1		; Calc number of days since Jan. 1
	MOVE	T0,DAY
LOOP:	CAML	T1,MO		; Reached current month yet?
	JRST	JDATE		;  No more days to add
	ADD	T0,IDAYS-1(T1)	; Use existing day table rather than
	AOJA	T1,LOOP		; reference cumulative table

JDATE:	CAIL	YR,^D2000	; Check if YR .LT. 2000
	SUBI	YR,^D2000	; Correct YR
	CAIL	YR,^D1900	; Check if YR in 19XX format
	SUBI	YR,^D1900	;   Yes, make it just XX
	IMULI	YR,^D1000	; Pack YEAR/DAYS in Julian format
	ADD	T0,YR		;   YYDDD (Jan. 1, 1983 is 83001)
	AOS	(P)		; No, errors take skip return
	POPJ	P,		; Return with result in T0

	SUBTTL GETD..  --  Parse ASCII Date String

;
;	CALLING SEQUENCE:	MOVEI	T1,<date string arg pointer>
;				PUSHJ	P,GETD..##
;				  JRST	Error
;
;	Parses date string and returns values in YR, MON, DAY
;	Sets IERR=0 if OK <SKIP>, else IERR=-1 <NOSKIP>
;
	ENTRY GETD..

GETD..::

	PUSHJ	P,CKSA..##	; [5] Check for valid byte pointer
	MOVE	ADP,T1		; [5] Save ASCII byte pointer defined
	MOVEI	CNT,24		; [5] Define max length as 20. char
	CAIN	T0,15		; [5]  Check if Char arg
	 MOVE	CNT,T2		; [5]  Yes, use actual length defined
	SETZ	IERR,		; Assume no errors
	SKIPE	(ADP)		; Check if user wants default
	JRST	GETDAT		; No, parse string

	PUSHJ	P,DEFD..	; Get default values for current date
	JRST	DONE		; That's all we need

GETDAT:	SETZB	DELIM,YR	; [5] Clear delimiter flag and Year
	SETZB	MO,DAY		; Clear month and day values

NEXTCH:	ILDB	T0,ADP		; Get next character
	CAIN	T0," "		; Ignore leading blanks
	JRST	CNEXT
	CAIL	T0,"0"		; Check if digit (0-9)
	  CAILE	T0,"9"
	  JRST	GETMON		;   No, go check if Month

GETINT:	MOVE	T1,T0		; Convert to decimal
	SUBI	T1,60
ILOOP:	ILDB	T0,ADP		; Get next character
	CAIL	T0,"0"		; Check if digit (0-9)
	  CAILE	T0,"9"
	  JRST	CKDEL		;   No, check for delimiter
	SUBI	T0,60		;  Yes, convert to decimal
	IMULI	T1,^D10
	ADD	T1,T0
	CAIL	T1,^D100000	; [4] Check for Mode 4 YYMMDD
	  JRST	MODE4		; [4]    Yes, go decode
	SOJG	CNT,ILOOP	; Check for more digits
	JRST	GERR		; Invalid string format 

CKDEL:	ADDI	DELIM,1		; Increment delimiter counter
	CAIN	T0,"-"		; Ck if DD-Mon-YY
	  JRST	MODE1		;   Yes
	CAIE	T0,0		; Ck if null (ASCIZ end of string)
	CAIN	T0,40		; Ck if Space at end of string
	JRST	MODE2
	CAIN	T0,"/"		; Ck if MM/DD/YY
	  JRST	MODE2		;   Yes
	CAIN	T0,","		; Ck if Month DD, YEAR
	  JRST	MODE2		;   Yes
	  JRST	GERR		;   No, invalid string format


MODE1:	CAIE	MO,0		; Test if DD-Mon-YY or MM-DD-YY
	JRST	MOD1A
	CAIN	DELIM,2		; If delim is 2 and MO is zero, MM-DD-YY
	JRST	MODE3		;  Yes
MOD1A:	CAIN	DELIM,1		; Ck if first or third delimiter
	MOVE	DAY,T1		;  First, number is DAY
	CAIN	DELIM,3
	MOVE	YR,T1		;  Second, number is YEAR
	JRST	CNEXT

MODE2:	CAIN	DELIM,1		; Ck which delimiter (1-3)
	MOVE	MO,T1		;  First, number is MONTH
	CAIN	DELIM,2
	MOVE	DAY,T1		;  Second, number is DAY
	CAIN	DELIM,3
	MOVE	YR,T1		;  Third, number is YEAR
	JRST	CNEXT

MODE3:	MOVE	MO,DAY		; Format is MM-DD-YY,
	MOVE	DAY,T1		;   Swap Day and Month values
	JRST	CNEXT

MODE4:	IDIVI	T1,^D100	;[4] Mode 4 Format is YYMMDD as Integer
	MOVE	DAY,T2		;[4] First remainder is day
	IDIVI	T1,^D100	;[4] Unpack year and month
	MOVE	MO,T2		;[4] Remainder is month
	MOVE	YR,T1		;[4] Result is year
	JRST	DONE		;[4] Return results

GETMON:				; Parse MONTH argument (First char in T0)
	CAIE	MO,0		; Check if Month already defined
	MOVE	DAY,MO		;  Yes, assume format is DD Mon YY
	CAILE	T0,"Z"		; Check for lower case
	SUBI	T0,40		;  Yes, convert to upper
	ILDB	T1,ADP		; Get next char for Month
	CAILE	T1,"Z"		; Check for lower case
	SUBI	T1,40		;  Yes, convert to upper
	LSH	T0,7		; Append new char
	ADD	T0,T1
	ILDB	T1,ADP		; Get third char for Month
	CAILE	T1,"Z"		; Check if lower case
	SUBI	T1,40		;   Yes, convert to upper
	LSH	T0,7		; Append third char
	ADD	T0,T1
	LSH	T0,17		; Left justify in word
	SUBI	CNT,2		; Update char counter

	SETZ	T1,		; Check for valid Month argument
MLOOP:	CAMN	T0,MONTHS(T1)	;
	  JRST	SLEW		;  Found a match
	ADDI	T1,1		;  No match, check next value
	CAIG	T1,^D11
	JRST	MLOOP
	JRST	GERR		;  Not a valid Month argument

SLEW:	ADDI	T1,1		; Month number is table offset+1
	MOVE	MO,T1		; MONTH defined, ignore rest of Month string
DLOOP:	ILDB	T0,ADP		; Scan for next delimiter char
	CAIN	T0,"-"		;  Ck if Mode 1
	JRST	DFOUND		;  Yes
	CAIN	T0," "		;  Ck if Mode 3
	JRST	DFOUND		;  Yes
	SOJG	CNT,DLOOP	;  Keep on checking
	JRST	GERR		;  No more char left, bad format

DFOUND:	ADDI	DELIM,1		; Increment Delimiter Flag

CNEXT:	JUMPN	YR,DONE		; Done if year defined
	SOJG	CNT,NEXTCH	; Continue if more characters left
	JRST	GERR		;   Bad date format no more input char left

DONE:	AOSA	(P)		; Parse no error return <SKIP>
GERR:	SETO	IERR,		; Set error flag, bad date format
	POPJ	P,		; Return
	SUBTTL CVAD..  --  Convert Date Values to ASCII string

;	CALLING SEQUENCE:	MOVE	MO,<month>
;				MOVE	DAY,<day>
;				MOVE	YR,<year>
;				MOVEI	T1,<address of date arg pointer>
;				PUSHJ	P,CVAD..##
;				Returns with ASCII date in address defined
;				or ignores conversion if field too small
;

	ENTRY CVAD..

CVAD..::

	PUSHJ	P,CKSA..##	; [5] Check for valid byte pointer
	MOVE	ADP,T1		; [5] Save output string ASCII byte pointer
	MOVE	T0,DAY		; Get day value and convert to ASCII
	IDIVI	T0,^D10
	ADDI	T0,60
	CAIG	T0,60		; Check if leading zero
	SUBI	T0,20		;  Yes, convert to space
	IDPB	T0,ADP		; Output char to string buf
	ADDI	T1,60
	IDPB	T1,ADP		; Output last day digit
	MOVE	T1,MONAME-1(MO)	; Get ASCII Month name (-Mon-)
	MOVEI	CNT,5		; Set loop count for next 5 char
TLOOP:	LSHC	T0,7		; Get next char
	IDPB	T0,ADP		; Output to string buffer
	SOJG	CNT,TLOOP	; Loop until all 5 output

	MOVE	T0,YR		; Convert YEAR to ASCII digits
	CAIL	T0,^D2000	; Check if 21st century
	SUBI	T0,^D2000	;   Yes, correct to XX
	CAIL	T0,^D1900	; Convert 19XX to XX
	SUBI	T0,^D1900
	IDIVI	T0,^D10
	ADDI	T0,60
	IDPB	T0,ADP		; Output first digit to string buffer
	ADDI	T1,60
	IDPB	T1,ADP		; Output second digit
	MOVEI	T0," "		; Get a space to
	IDPB	T0,ADP		; pad last char with blank
	POPJ	P,		; Return
	SUBTTL CVJD..  --  Convert Integer Julian date to numeric

;
;	CALLING SEQUECE:	MOVE	T0,<Julian date value>
;				PUSHJ	P,CVTJ..##
;				  JRST	Error
;				Returns date in MO, DAY, YR registers
;				Returns IERR=0 (OK) or -1 (Bad date)

	ENTRY CVJD..

CVJD..::

	CAIL	T0,1		;  Ck if valid number
	  CAILE	T0,^D99366
	  JRST	JDERR		; Bad Julian value

	IDIVI	T0,^D1000	; Unpack YEAR and DAYS
	MOVE	YR,T0
	MOVE	DAY,T1
	CAIL	DAY,1		; Validate range of arguments
	  CAILE	DAY,^D366	;  Day must be 1-366
	  JRST	JDERR		;  Bad value
	IDIVI	T0,4		; Check if leap year
	MOVEI	T2,^D28		; Assume not
	CAIG	T1,0		; If remainder = 0, then leap year
	AOJ	T2,		;  Yes, Feb = 29 days
	MOVEM	T2,IDAYS+1	; Define no. days for Feb.

	MOVE	T0,DAY		; Convert Julian days to Month-days
	MOVEI	MO,1		; Init Month counter to Jan=1
NEXTM:	MOVE	DAY,T0		; Save residual days
	SUB	T0,IDAYS-1(MO)	; Subtract all days from this month
	CAIG	T0,0		; Compare if exceeded current month
	  SKIPA			;  Date is current month, done
	AOJG	MO,NEXTM	; Increment MONTH and check again
	AOSA	(P)		; Conversion OK, make skip return
JDERR:	SETO	IERR,		; Set error and return with no skip
	POPJ	P,

	PRGEND
	TITLE	SIXBIT/ASCII Conversion 

;	Author:		D A Wallace, MAPC DEC-10 Systems Group
;	Written:	18-Aug-82
;
;	Internal support routines for ASCII/SIXBIT conversion
;
;
T0=0
T1=1
T2=2
T3=3
CNT=4		; Loop count
CHR=5		; Current char
SSP=6		; SIXBIT Byte pointer
ASP=7	; ASCII Byte pointer
P=17		; Stack pointer

	SUBTTL SIXA..  SIXBIT to ASCII

	ENTRY SIXA..

;	Convert SIXBIT to ASCII
;	MOVE	T0,value
;	PUSHJ	P,SIXA..
;	returns ASCII string in T2-T3

SIXA..::

	MOVE	T2,[ASCII /     /]	; Init result to spaces
	MOVE	T3,T2
	CAIN	T0,0		; Check if NULL input
	POPJ	P,		;  Yes, done
	MOVEI	CNT,6		; Setup count for 6 char
	MOVEI	ASP,2		; Define ASCII string pointer to T2-T3
	HRLI	ASP,(POINT 7,,)
	MOVSI	SSP,(POINT 6,,)	; Setup SIXBIT byte pointer
SIX.1:	ILDB	CHR,SSP		; Get next SIXBIT char
	ADDI	CHR,40		; Convert to ASCII char
	IDPB	CHR,ASP		; Output to ASCII string
	SOJG	CNT,SIX.1	; Loop until all char converted
	POPJ	P,		; Return

	SUBTTL GET6.. ASCII to SIXBIT

	ENTRY GET6..


;	Convert ASCII string in T2-T3 to SIXBIT in T0
;	MOVE	T0,sixbit-value
;	PUSHJ	P,GET6..

GET6..::

	SETZ	T0,		; Clear result
	MOVEI	CNT,6		; Set count for 6 char
	MOVSI	ASP,(POINT 7,,)	; Setup ASCII string byte pointer
	ADDI	ASP,T2		;  to T2-T3
	MOVSI	SSP,(POINT 6,,)	; Setup SIXBIT byte pointer to T0

GET.1:	ILDB	CHR,ASP		; Get next ASCII char from string
	CAIE	CHR,0		; Check for end of string
	CAIN	CHR," "		;   as NULL or SP
	  POPJ	P,		;   End found, return
	CAIGE	CHR,"a"		; Convert from ASCII to SIXBIT
	ADDI	CHR,40
	IDPB	CHR,SSP		; Output SIXBIT char to result
	SOJG	CNT,GET.1	; Loop for next char
	POPJ	P,		; Count expired, return

	PRGEND
	TITLE	CKSA..
	SUBTTL	Routine to validate FORTRAN string arg
;
;	Author:		D A Wallace, DEC-10 Systems Group
;
;	Written:	10-Mar-83
;
;	Purpose:	General purpose routine to check FORTRAN calling
;			argument for character string.  Insures compatibility
;			with F66 (V5A) and F77 calling TYPES.
;
;	Calling sequence:	MOVEI	T1,n(A)		; Input arg ref
;				PUSHJ	P,CKSA..##
;				Returns   T0 = FORTRAN Type Code
;					  T1 = ASCII Byte Pointer to string
;					  T2 = Maximum no. char in string
;

;	Register Definition

T0=0			; Temporary, Type Code on return
T1=1			; Temporary, ASCII Byte pointer on return
T2=2			; Temporary, length of string on return
P=17			; Stack pointer

	ENTRY	CKSA..

CKSA..::				; Validate FORTRAN string argument

	LDB	T0,[POINT 4,(T1),12]	; Get TYPE value for calling arg
	MOVEI	T2,5			; Assume length is 5 char
	CAIN	T0,10			; Check if double precision
	MOVEI	T2,12			;   Yes, set length to 10.
	MOVEI	T1,@0(T1)		; [6] Get string pointer reference
	CAIN	T0,15			; Check of TYPE is character (F77)
	DMOVE	T1,(T1)			;   Yes, get byte pointer and size
	CAIE	T0,15			; [7] Check if need to make byte pointer
	HRLI	T1,(POINT 7,,)		; Yes, setup byte pointer not F-77 char
	POPJ	P,			; Return

	END