PROGRAM UCL !User Command Language translator C C Author: Steve Cribbs June 1984 C Atomic Energy of Canada Limited C Pinawa, Manitoba C Canada R0E 1L0 C INTEGER NB,FLAG,LCW,PT,TPTRS(11),NCMDS,CPTRS,NXTUCL(4),CHNL LOGICAL*1 VIEW,PASSON BYTE STRING,COMAND,TRANSC(15),TRANSF,CMDS COMMON /UCL01/ NB,STRING(81) COMMON /UCL02/ LCW,COMAND(81) COMMON /UCL03/ NCMDS,CPTRS(11),CMDS(36) COMMON /UCL04/ TRANSF(81,11),VIEW,PASSON !Must be LAST COMMON BLOCK DATA NXTUCL /3RSY ,3RDEC,3RUCL,3RSAV/ DATA TRANSF /81*0,81*0,81*0,81*0,81*0,81*0,81*0,81*0,81*0, # 81*0,81*0/, VIEW /.FALSE./, PASSON /.FALSE./ DATA TPTRS /1,2,3,4,5,6,7,8,9,10,11/ DATA TRANSC /0,0,0,0,0,0,0,0,0,0,'E','D','I','T',0/ CALL RCHAIN(FLAG,NB,41) IF(FLAG .NE. -1) CALL RENTRY !KMON RUN UCL command C C Isolate first word of command line received C CALL ISOLTC C C Attempt to match it with one of our defined commands C PT = MATCHC() IF(PT .NE. 0) GO TO 20 C C No match made, either pass the string on or quit C IF(.NOT. PASSON) GO TO 10 CHNL = IGETC() IF(CHNL .LT. 0) CALL XITSTA('UCL','F','No channel available') CALL CLOSEC(CHNL) !Incase it's already open IF(LOOKUP(CHNL,NXTUCL) .LT. 0) # CALL XITSTA('UCL','F','SY:DECUCL.SAV not found') CALL CLOSEC(CHNL) CALL IFREEC(CHNL) CALL CHAIN(NXTUCL,NB,(NB+2)/2) !Pass it on C 10 CALL XITSTA('UCL','F','Unrecognized command') C C Match made, trap more than one match situation C 20 IF(PT .EQ. -1) CALL XITSTA('UCL','F','Ambiguous command') C C Preserve rest of command line (if any) C LCW = LCW + 1 !Point to field delimiter (space char.) IF(LCW .GT. NB .OR. LEN(STRING(LCW)) .EQ. 0) GO TO 30 IF(PT .LE. 10) LCW = LCW + 1 !For F? commands, omit leading space CALL SCOPY(STRING(LCW),TRANSF(1,PT),80) CALL SAVEC !Preserve command translations on disk C C Translate the command word C 30 CALL SCOPY(TRANSC(TPTRS(PT)),STRING) C C Append rest of command string C CALL CONCAT(STRING,TRANSF(1,PT),STRING,80) C C Possibly display on user's terminal C IF(VIEW) CALL PRINT(STRING) C C Pass the command string to KMON C CALL KMNCHN(LEN(STRING)+1,STRING) END SUBROUTINE ISOLTC C C Isolate command word: C Copy the command word from the input string C C Note: KMON converts multiple space and tab field separators C to single space characters (1 space per field separator). C INTEGER NB,LCW,LEN,I,J BYTE STRING,COMAND COMMON /UCL01/ NB,STRING(81) COMMON /UCL02/ LCW,COMAND(81) NB = LEN(STRING) !Require string length in bytes COMAND(1) = 0 I = INDEX(STRING,' ') !Find first SPACE field separator J = INDEX(STRING,'/') ! " " SLASH " " LCW = NB IF(I .NE. 0 .AND. I .LT. LCW) LCW = I - 1 IF(J .NE. 0 .AND. J .LT. LCW) LCW = J - 1 CALL SCOPY(STRING,COMAND,LCW) !Leave field separator with FLSPEC RETURN END INTEGER FUNCTION MATCHC() C C Attempt to match command with one of the list of recognized C commands. Allow abbreviations; trap ambiguous command names. C The function value returned provides a pointer to the matched C command, 0 if no match was made or -1 if more than one command C matching the input string was made. C INTEGER NCMDS,LCW,CPTRS,I BYTE COMAND,CMDS,MASKR(81) COMMON /UCL02/ LCW,COMAND(81) COMMON /UCL03/ NCMDS,CPTRS(11),CMDS(36) DATA NCMDS /11/ ,CPTRS /1,4,7,10,13,16,19,22,25,28,31/ DATA CMDS /'F','0',0,'F','1',0,'F','2',0,'F','3',0,'F','4' # ,0,'F','5',0,'F','6',0,'F','7',0,'F','8',0,'F','9',0, # 'M','E','D','I','T',0/ MATCHC = 0 DO 1000 I = 1,NCMDS CALL SCOPY(CMDS(CPTRS(I)),MASKR,LCW) IF(ISCOMP(COMAND,MASKR) .NE. 0) GO TO 1000 IF(MATCHC .NE. 0) GO TO 10 MATCHC = I 1000 CONTINUE RETURN 10 MATCHC = -1 !Ambiguous command: more than one match RETURN END SUBROUTINE SAVEC C C Copy Command definitions to memory and disk storage C INTEGER CHNL,NCMDS,UCLBLK(4),FBLK LOGICAL*1 VIEW,PASSON BYTE CMDS,TRANSF COMMON /UCL03/ NCMDS,CPTRS(11),CMDS(36) COMMON /UCL04/ TRANSF(81,11),VIEW,PASSON !Must be LAST COMMON BLOCK DATA UCLBLK /3RSY0,3RUCL,0,3RSAV/ CALL SCCA(I) !Ignore Control-C's until write complete CHNL = IGETC() IF(CHNL .LT. 0) CALL XITSTA('UCL','F','No channel available') CALL CLOSEC(CHNL) !Incase it's already open IF(LOOKUP(CHNL,UCLBLK) .LT. 0) # CALL XITSTA('UCL','F','LOOKUP failure') FBLK = IADDR(TRANSF(1,1)) / 512 IF(IWRITE((81*NCMDS+3)/2,TRANSF(1,1),FBLK,CHNL) .LT. 0) # CALL XITSTA('UCL','F','IWRITE failure') CALL CLOSEC(CHNL) CALL IFREEC(CHNL) CALL SCCA !Re-enable Control-C aborts RETURN END