Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50506/short.for
There are no other files named short.for in the archive.
COMMON/NUMKEY/NOTPNT(300),MCHPNT(300),KNTPNT,KNTXTR
COMMON/LTRKEY/LTRXTR(20)
DIMENSION LTRBFR(30),LTRABC(26),LWRABC(26)
C NUMBER OF UNIT FROM WHICH TEXT IS READ
DATA ITTY/5/
C DIMENSION OF LTRBFR ARRAY, NUMBER OF LETTERS TO READ
DATA LMTBFR/30/
C UPPER CASE LETTERS A THROUGH Z
DATA LTRABC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
11HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
21HX,1HY,1HZ/
C LOWER CASE LETTERS A THROUGH Z
DATA LWRABC/1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
11Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
21Hx,1Hy,1Hz/
C THE SPACE CHARACTER FOR FINDING SPACES IN TEXT
C ASTERISK FOR MARKING UNKNOWN LETTERS IN MESSAGE
DATA LTRSPC,LTRSEM/1H ,1H;/
C
C CALCULATE FACTOR FOR EXTRACTING BYTES FROM ARRAYS
IOFFST=KNTPNT+1
C
C GET NEXT LINE OF TEXT TO BE INTERPRETED
1001 WRITE(ITTY,1002)
1002 FORMAT(2H *,$)
READ(ITTY,1003)LTRBFR
1003 FORMAT(30A1)
C
C SET UP POINTERS WITHIN THE INPUT LINE BEING EVALUATED
LOCBFR=0
1004 MINPRT=LOCBFR+1
C
C SET UP POINTERS WITHIN THE TEST SEQUENCE
KMDNOW=0
LOCPNT=1
C
C GET NEXT CHARACTER TO BE TESTED
1005 MAXPRT=LOCBFR
LOCBFR=LOCBFR+1
IF(LOCBFR.GT.LMTBFR)GO TO 1014
C
C ATTEMPT TO IDENTIFY THE CHARACTER
1006 IF(LOCPNT.LE.0)GO TO 1014
IVALUE=NOTPNT(LOCPNT)
LOCABC=IVALUE
IF(IVALUE.LT.0)LOCABC=-LOCABC
LOCABC=LOCABC/IOFFST
1007 IF(LTRBFR(LOCBFR).EQ.LTRSEM)GO TO 1014
IF(LOCABC.LE.26)GO TO 1008
IF(LTRBFR(LOCBFR).EQ.LTRXTR(LOCABC-26))GO TO 1012
GO TO 1009
1008 IF(LTRBFR(LOCBFR).EQ.LTRABC(LOCABC))GO TO 1012
IF(LTRBFR(LOCBFR).EQ.LWRABC(LOCABC))GO TO 1012
C
C LETTERS DID NOT MATCH
1009 IF(IVALUE.GE.0)GO TO 1011
IVALUE=-IVALUE
C
C CHECK FOR SPACES BEFORE NEXT WORD
1010 IF(LTRBFR(LOCBFR).NE.LTRSPC)GO TO 1007
LOCBFR=LOCBFR+1
IF(LOCPNT.EQ.1)MINPRT=LOCBFR
IF(LOCBFR.LE.LMTBFR)GO TO 1010
GO TO 1014
C
C GET NEXT LETTER TO BE TESTED IF FAILURE
1011 LOCPNT=IVALUE-(IOFFST*LOCABC)
GO TO 1006
C
C LETTERS MATCHED
1012 IVALUE=MCHPNT(LOCPNT)
IF(IVALUE.GE.0)GO TO 1013
IVALUE=-IVALUE
KMDNEW=IVALUE/IOFFST
LOCPNT=IVALUE-(IOFFST*KMDNEW)
IF(KMDNEW.NE.0)KMDNOW=-KMDNEW
GO TO 1005
1013 KMDNEW=IVALUE/IOFFST
LOCPNT=IVALUE-(IOFFST*KMDNEW)
IF(KMDNEW.NE.0)KMDNOW=KMDNEW
GO TO 1005
C
C FIND RIGHTMOST PRINTING CHARACTER FOR USE IN MESSAGES
1014 MAXTST=LOCBFR
MAXSHO=MAXPRT
1015 IF(LOCBFR.GT.LMTBFR)GO TO 1017
IF(LTRBFR(LOCBFR).EQ.LTRSPC)GO TO 1016
IF(LTRBFR(LOCBFR).EQ.LTRSEM)GO TO 1017
MAXSHO=LOCBFR
1016 LOCBFR=LOCBFR+1
GO TO 1015
C
C CHECK IF KNOWN AND NOT FOLLOWED DIRECTLY BY LETTER
1017 IF(LOCPNT.EQ.1)GO TO 1024
IF(KMDNOW.EQ.0)GO TO 1022
IF(MAXTST.GT.MAXSHO)GO TO 1019
IF(MAXTST.GT.(MAXPRT+1))GO TO 1019
LTRNOW=LTRBFR(MAXTST)
DO 1018 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 1022
IF(LTRNOW.EQ.LWRABC(I))GO TO 1022
1018 CONTINUE
C
C REPORT WHAT WAS FOUND
1019 WRITE(ITTY,1020)KMDNOW,(LTRBFR(I),I=MINPRT,MAXPRT)
1020 FORMAT(8H COMMAND,1I3,2H: ,31A1)
IF(MAXTST.GT.MAXSHO)GO TO 1026
WRITE(ITTY,1021)(LTRBFR(I),I=MAXTST,MAXSHO)
1021 FORMAT(13H ARGUMENTS: ,31A1)
GO TO 1026
1022 WRITE(ITTY,1023)(LTRBFR(I),I=MINPRT,MAXSHO)
1023 FORMAT(13H UNKNOWN: ,31A1)
GO TO 1026
1024 WRITE(ITTY,1025)
1025 FORMAT(11H MISSING)
C
C GET NEXT STATEMENT ON SAME LINE
1026 IF(LOCBFR.LE.LMTBFR)GO TO 1004
GO TO 1001
END