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