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