C TRANS.FTN CONVERT ASCII STRING TO VOTRAX RECORD SUBROUTINE TRANS(LUN,IEF,NCELL,IN,KERR) C WHERE: LUN = AN AVAILABLE LUN C IEF = AN AVAILABLE EVENT FLAG C NCELL = CELL CODE (0-4) C IN = ASCII INPUT STRING (PRECEDED AND FOLLOWED C BY A NULL) C KERR = ERROR FLAG (>=0: OK) IMPLICIT INTEGER(A-Z) PARAMETER NPAL="200,SIB="100,BRK="40,VCON="20,CON="10,EORI="4, C FVOW="2,VOW="1 PARAMETER STRL=900,VTRL=700,RULL=350,OUTL=40 BYTE IN(1),OUT(OUTL) BYTE ISP(0:95),ICON(0:95),STR,VOT,BAND,IK,IS,IKR,IKO COMMON /RULES/ IRUL(0:95),RULA(RULL),RULB(RULL),RULC(RULL), C RULD(RULL),STR(STRL),VOT(VTRL) DATA ISP/32*0,1,13,1,2,7,8,9,3*1,5,12,1,1,6,11*1,4,4*1,3,10, C 29*1,11,1/ DATA ICON/65*"40,"1,"30,"110,"230,"7,"10,"130,"10,"7,"330, C "10,"230,"30,"230,"1,"10,"10,"230,"310,"210,"1,"30,"30, C "110,"3,"330,5*"40/ C IF(RULA(1).NE.0) GO TO 2 OPEN(UNIT=LUN,NAME='RULES.PAR',TYPE='OLD',READONLY, C FORM='UNFORMATTED') READ (LUN) IRUL,RULA,RULB,RULC,RULD,STR,VOT CLOSE(UNIT=LUN) 2 I=1 3 IF(IN(I).EQ.0) GO TO 4 IN(I)=BAND("177,IN(I)) IF(IN(I).GE.96) IN(I)=IN(I)-32 I=I+1 GO TO 3 4 IP=1 JP=0 1 IK=IN(IP) IF(IK.EQ.0) GO TO 2000 IRP=IRUL(IK) IF(IRP.EQ.0) GO TO 1010 C C TRY TO MATCH B STRING C 10 IBP=IP IOP=RULB(IRP) IF(STR(IOP).NE.IK) GO TO 1010 101 IF(STR(IOP).EQ.0) GO TO 111 IF(IN(IBP).NE.STR(IOP)) GO TO 1000 IOP=IOP+1 IBP=IBP+1 GO TO 101 C C TRY TO MATCH A STRING C 111 IAP=IP-1 IOP=RULA(IRP) 112 IF(STR(IOP).EQ.0) GO TO 201 IS=ISP(STR(IOP)) GO TO (121,122,123,127,128,132,133,134,135,137,139,140,141),IS C NORMAL CHARACTER 121 IF(IN(IAP).NE.STR(IOP)) GO TO 1000 GO TO 160 C # 1 OR MORE VOWELS 122 IKR=1 GO TO 124 C ? 2 OR MORE VOWELS 123 IKR=2 124 IKO=0 125 IF(BAND(VOW,ICON(IN(IAP))).EQ.0) GO TO 126 IKO=IKO+1 IAP=IAP-1 GO TO 125 126 IF(IKO.LT.IKR) GO TO 1000 GO TO 162 C : 0 OR MORE CONSONANTS 127 IKR=0 GO TO 129 C * 1 OR MORE CONSONANTS 128 IKR=1 129 IKO=0 130 IF(BAND(CON,ICON(IN(IAP))).EQ.0) GO TO 131 IKO=IKO+1 IAP=IAP-1 GO TO 130 131 IF(IKO.LT.IKR) GO TO 1000 GO TO 162 C . VOICED CONSONANT 132 IF(BAND(VCON,ICON(IN(IAP))).EQ.0) GO TO 1000 GO TO 160 C $ CONSONANT FOLLOWED BY E OR I 133 IF(BAND(EORI,ICON(IN(IAP))).EQ.0) GO TO 1000 IAP=IAP-1 IF(BAND(CON,ICON(IN(IAP))).EQ.0) GO TO 1000 GO TO 160 C % SUFFIX 134 GO TO 2000 C & SIBILANT 135 IF(BAND(SIB,ICON(IN(IAP))).NE.0) GO TO 160 IF(IN(IAP).NE.'H') GO TO 1000 IAP=IAP-1 IF(IN(IAP).NE.'C'.AND.IN(IAP).NE.'S') GO TO 1000 GO TO 160 C @ NON-PALATAL 137 IF(BAND(NPAL,ICON(IN(IAP))).NE.0) GO TO 160 IF(IN(IAP).NE.'H') GO TO 1000 IAP=IAP-1 IF(IN(IAP).NE.'C'.AND.IN(IAP).NE.'S'.AND.IN(IAP).NE.'T') C GO TO 1000 GO TO 160 C ^ 1 CONSONANT 139 IF(BAND(CON,ICON(IN(IAP))).EQ.0) GO TO 1000 GO TO 160 C + FRONT VOWEL 140 IF(BAND(FVOW,ICON(IN(IAP))).EQ.0) GO TO 1000 GO TO 160 C ! BREAK CHARACTER 141 IF(BAND(BRK,ICON(IN(IAP))).EQ.0) GO TO 1000 160 IAP=IAP-1 162 IOP=IOP+1 GO TO 112 C C TRY TO MATCH C STRING C 201 ICP=IBP IOP=RULC(IRP) 212 IF(STR(IOP).EQ.0) GO TO 301 IS=ISP(STR(IOP)) GO TO (221,222,223,227,228,232,233,234,235,237,239,240,241),IS C NORMAL CHARACTER 221 IF(IN(ICP).NE.STR(IOP)) GO TO 1000 GO TO 260 C # 1 OR MORE VOWELS 222 IKR=1 GO TO 224 C ? 2 OR MORE VOWELS 223 IKR=2 224 IKO=0 225 IF(BAND(VOW,ICON(IN(ICP))).EQ.0) GO TO 226 IKO=IKO+1 ICP=ICP+1 GO TO 225 226 IF(IKO.LT.IKR) GO TO 1000 GO TO 262 C : 0 OR MORE CONSONANTS 227 IKR=0 GO TO 229 C * 1 OR MORE CONSONANTS 228 IKR=1 229 IKO=0 230 IF(BAND(CON,ICON(IN(ICP))).EQ.0) GO TO 231 IKO=IKO+1 ICP=ICP+1 GO TO 230 231 IF(IKO.LT.IKR) GO TO 1000 GO TO 262 C . VOICED CONSONANT 232 IF(BAND(VCON,ICON(IN(ICP))).EQ.0) GO TO 1000 GO TO 260 C $ CONSONANT FOLLOWED BY E OR I 233 IF(BAND(CON,ICON(IN(ICP))).EQ.0) GO TO 1000 ICP=ICP+1 IF(BAND(EORI,ICON(IN(ICP))).EQ.0) GO TO 1000 GO TO 260 C % SUFFIX 234 I=ICP+1 IF(BCOMP(IN(ICP),'E').EQ.1) GO TO 236 I=ICP+2 IF(BCOMP(IN(ICP),'ER').EQ.1) GO TO 236 IF(BCOMP(IN(ICP),'ES').EQ.1) GO TO 236 IF(BCOMP(IN(ICP),'ED').EQ.1) GO TO 236 I=ICP+3 IF(BCOMP(IN(ICP),'ING').EQ.1) GO TO 236 IF(BCOMP(IN(ICP),'ELY').EQ.1) GO TO 236 GO TO 1000 236 IF(BAND(BRK,ICON(IN(I))).EQ.1) GO TO 301 GO TO 1000 C & SIBILANT 235 IF(BAND(SIB,ICON(IN(ICP))).NE.0) GO TO 260 IF(IN(ICP).NE.'C'.AND.IN(ICP).NE.'S') GO TO 1000 ICP=ICP+1 IF(IN(ICP).NE.'H') GO TO 1000 GO TO 260 C @ NON-PALATAL 237 IF(BAND(NPAL,ICON(IN(ICP))).NE.0) GO TO 260 IF(IN(ICP).NE.'C'.AND.IN(ICP).NE.'S'.AND.IN(ICP).NE.'T') C GO TO 1000 ICP=ICP+1 IF(IN(ICP).NE.'H') GO TO 1000 GO TO 260 C ^ 1 CONSONANT 239 IF(BAND(CON,ICON(IN(ICP))).EQ.0) GO TO 1000 GO TO 260 C + FRONT VOWEL 240 IF(BAND(FVOW,ICON(IN(ICP))).EQ.0) GO TO 1000 GO TO 260 C ! BREAK CHARACTER 241 IF(BAND(BRK,ICON(IN(ICP))).EQ.0) GO TO 1000 260 ICP=ICP+1 262 IOP=IOP+1 GO TO 212 C C A[B]C MATCH --> RETURN D STRING C 301 IOP=RULD(IRP) 302 IF(VOT(IOP).EQ.0) GO TO 401 JP=JP+1 OUT(JP)=VOT(IOP) IOP=IOP+1 IF(JP.LT.OUTL-1) GO TO 302 OUT(OUTL)=0 CALL VSK(LUN,IEF,NCELL,OUT,KERR) IF(KERR.LT.0) RETURN JP=0 GO TO 302 401 IP=IBP GO TO 1 1000 IRP=IRP+1 GO TO 10 1010 IP=IP+1 GO TO 1 2000 IF(JP.EQ.0) RETURN OUT(JP+1)=0 CALL VSK(LUN,IEF,NCELL,OUT,KERR) RETURN END