PROGRAM LDUDK C C Load the DEC VT200 series terminal's User Defined Keys (UDK) C C Created with: C R LINK C LDUDK.SAV,LDUDK.MAP=LDUDK,SCRNCH,GETDEF,UTIL,TCFL.CSL/I/W// C TSXLIB C // C $SHORT C C ^C C C Author: S.C. Cribbs Version 2.0 85/02/02 C Atomic Energy of Canada Limited C Pinawa, Manitoba C Canada R0E 1L0 C C Version 2.1 - Fixed Indirect File execution detection (85/03/18) C Version 2.2 - Added support for TSX+ at version 5.0 (85/05/24) C - Now just exits if (run from an RT-11 command file & C TT: set QUIET & UDK keys locked) at startup. C INTEGER TID(10),I,J,KP,KTRMID,LPRVTE,UDKSTS,EXTCDE,MONTYP LOGICAL*1 QUIET,GETDEF,RT11 BYTE INITRM(20),TM2007(9),SRESET(5),TFOREN(237),ERLOCK(251) BYTE STRING,ECONT,CLRHME(11),PID,BEEP(3),UDKLKD(236) BYTE CMENU1(255),CMENU2(192),CPRMPT(12),ST(4),PREAMB(7) BYTE CLUDKP(61),LKUDKP(74),YESNOP,CLRUDK(9),LOKUDK(9) BYTE BUFR(524),BADKEY(120) COMMON /UDK00/ PID(41) COMMON /UDK01/ STRING(82) COMMON /UDK02/ ECONT(54) COMMON /UDK03/ YESNOP(112) COMMON /UDK04/ EXTCDE DATA SRESET /"33,'[','!','p',"200/ !VT200 series soft reset DATA TM2007 /"33,'[','6','2',';','1','"','p',"200/ !VT200 series DATA INITRM /"33,'<',"33,'(','B',"17,"33,'>',"33,'[','1',';', # '2','4','r',"33,'[','0','m',"200/ DATA CLRHME /"33,'[','2','J',"33,'[','1',';','1','H',"200/ DATA JSW /"44/, BEEP /"7,"7,"200/ DATA PID /"33,'[','2','J',"33,'[','1',';','7','H',"33,'#', # '6','L','D','U','D','K',' ','/',' ','R','T','-','1','1',' ', # ' ',' ','V','e','r','s','i','o','n',' ','2','.','2',"200/ DATA CLUDKP /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[', # '1','0',';','2','3','H',"33,'[','1','m','C','l','e','a','r', # ' ','a','l','l',' ','p','r','e','s','e','n','t',' ','U','D', # 'K',' ','d','e','f','i','n','i','t','i','o','n','s','?',"33, # '[','0','m',"200/ DATA LKUDKP /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[', # '1','0',';','1','6','H',"33,'[','1','m','L','o','c','k',' ', # 't','h','e',' ','U','D','K',' ','d','e','f','i','n','i','t', # 'i','o','n','s',' ','a','g','a','i','n','s','t',' ','f','u', # 't','u','r','e',' ','c','h','a','n','g','e','?',"33,'[','0', # 'm',"200/ DATA ERLOCK /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33, # '[','6',';','1','4','H',"33,'[','1','m','T','h','e',' ','t', # 'e','r','m','i','n','a','l',' ','h','a','s',' ','l','o','c', # 'k','e','d',' ','i','t','s','e','l','f',' ','a','g','a','i', # 'n','s','t',' ','r','e','d','e','f','i','n','i','t','i','o', # 'n','.',"33,'[','0','m',"33,'[','8',';','2','0','H','T','h', # 'i','s',' ','i','s',' ','l','i','k','e','l','y',' ','b','e', # 'c','a','u','s','e',' ','i','t',"47,'s',' ','U','D','K',' ', # '2','5','6',' ','b','y','t','e',"33,'[','1','0',';','2','3', # 'H','s','t','o','r','a','g','e',' ','c','a','p','a','c','i', # 't','y',' ','h','a','s',' ','b','e','e','n',' ','e','x','c', # 'e','e','d','e','d','.',"33,'[','1','6',';','3','6','H',"33, # '[','5','m','W','A','R','N','I','N','G',"33,'[','0','m',"33, # '[','1','8',';','1','5','H','T','h','e',' ','k','e','y',' ', # 'd','e','f','i','n','i','t','i','o','n',' ','l','a','s','t', # ' ','e','n','t','e','r','e','d',' ','m','a','y',' ','b','e', # ' ','i','n','c','o','m','p','l','e','t','e','.',"200/ DATA YESNOP /"33,'[','2','1',';','1','2','H','T','y','p','e', # ' ','e','i','t','h','e','r',' ',"33,'[','7',';','1','m','Y', # "33,'[','0',';','1','m','e','s',"33,'[','0','m',' ',"33,'[', # '7','m','R','E','T','U','R','N',"33,'[','0','m',' ','o','r', # ' ','s','i','m','p','l','y',' ',"33,'[','7','m','R','E','T', # 'U','R','N',"33,'[','0','m',' ','t','o',' ','i','n','d','i', # 'c','a','t','e',' ',"33,'[','1','m','N','o',"33,'[','0','m', # '.',"33,'[','2','3',';','4','0','H',"200/ DATA CLRUDK /"33,'P','0',';','1','|',"33,'\',"200/ DATA LOKUDK /"33,'P','1',';','0','|',"33,'\',"200/ DATA PREAMB /"33,'P','1',';','1','|',0/ DATA ST /"33,'\',"200,0/ DATA CMENU1 /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[', # '8',';','2','1','H',"33,'[','1','m','N','a','m','e',' ','o', # 'f',' ','t','h','e',' ','k','e','y',' ','t','o',' ','b','e', # ' ','p','r','o','g','r','a','m','m','e','d',':',"33,'[','0', # 'm',"33,'[','1','5',';','9','H','T','y','p','e',' ','i','n', # ' ','a',' ','k','e','y',' ','n','a','m','e',' ','f','r','o', # 'm',' ','t','h','e',' ','l','i','s','t',' ','b','e','l','o', # 'w',' ','a','n','d',' ','t','h','e','n',' ','p','r','e','s', # 's',' ',"33,'[','7','m','R','E','T','U','R','N',"33,'[','0', # 'm',"33,'[','1','7',';','3','9','H','o','r',"33,'[','1','9', # ';','2','2','H','s','i','m','p','l','y',' ','p','r','e','s', # 's',' ',"33,'[','7','m','R','E','T','U','R','N',"33,'[','0', # 'm',' ','t','o',' ','e','x','i','t',' ','L','D','U','D','K', # '.',"33,'[','2','2',';','3','1','H','P','r','o','g','r','a', # 'm','m','a','b','l','e',' ','K','e','y','s',':',"33,'[','2', # '4',';','6','H',"33,'[','1',';','7','m','F','6',"33,'[','0', # 'm',' ',"33,'[','1',';','7','m','F','7',"33,'[','0','m',' ', # "33,'[',"200/ DATA CMENU2 /'1',';','7','m','F','8',"33,'[','0','m',' ',"33, # '[','1',';','7','m','F','9',"33,'[','0','m',' ',"33,'[','1', # ';','7','m','F','1','0',"33,'[','0','m',"33,'[','4','C',"33, # '[','1',';','7','m','F','1','1',"33,'[','0','m',' ',"33,'[', # '1',';','7','m','F','1','2',"33,'[','0','m',' ',"33,'[','1', # ';','7','m','F','1','3',"33,'[','0','m',' ',"33,'[','1',';', # '7','m','F','1','4',"33,'[','0','m',"33,'[','4','C',"33,'[', # '1',';','7','m','H','e','l','p',"33,'[','0','m',' ',"33,'[', # '1',';','7','m',' ',' ','D','o',' ',' ',"33,'[','0','m',' ', # "33,'[','4','C',"33,'[','1',';','7','m','F','1','7',"33,'[', # '0','m',' ',"33,'[','1',';','7','m','F','1','8',"33,'[','0', # 'm',' ',"33,'[','1',';','7','m','F','1','9',"33,'[','0','m', # ' ',"33,'[','1',';','7','m','F','2','0',"33,'[','0','m',"200/ DATA CPRMPT /"33,'[','8',';','5','6','H',"33,'[','0','K',"200/ DATA TFOREN /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33, # '[','5',';','1','9','H','T','h','i','s',' ','p','r','o','g', # 'r','a','m',' ','h','a','s',' ','b','e','e','n',' ','d','e', # 's','i','g','n','e','d',' ','f','o','r',' ','u','s','e',' ', # 'o','n',"33,'[','7',';','2','9','H','V','T','2','0','0',' ', # 's','e','r','i','e','s',' ','t','e','r','m','i','n','a','l', # 's',"33,'[','9',';','1','9','H','w','i','t','h',' ','t','h', # 'e',' ','U','s','e','r',' ','D','e','f','i','n','e','d',' ', # 'K','e','y','s',' ','(','U','D','K',')',' ','f','e','a','t', # 'u','r','e','.',"33,'[','1','4',';','1','9','H','T','h','i', # 's',' ','t','e','r','m','i','n','a','l',' ','d','i','d',' ', # 'n','o','t',' ','r','e','s','p','o','n','d',' ','a','s',' ', # 'e','x','p','e','c','t','e','d','.',"33,'[','1','7',';','3', # '7','H',"33,'[','1','m','S','o','r','r','y',',',"33,'[','1', # '9',';','3','1','H','p','r','o','g','r','a','m',' ','m','u', # 's','t',' ','a','b','o','r','t','.',"33,'[','0','m',"200/ DATA UDKLKD /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33, # '[','5',';','2','7','H','T','h','e',' ','t','e','r','m','i', # 'n','a','l',' ','r','e','p','o','r','t','s',' ','t','h','a', # 't',"33,'[','7',';','2','2','H','i','t',"47,'s',' ','U','s', # 'e','r',' ','D','e','f','i','n','e','d',' ','K','e','y',' ', # '(','U','D','K',')',' ','f','e','a','t','u','r','e',"33,'[', # '9',';','3','5','H','i','s',' ','l','o','c','k','e','d','.', # "33,'[','1','2',';','2','2','H','T','h','i','s',' ','m','u', # 's','t',' ','b','e',' ','m','a','n','u','a','l','l','y',' ', # 'r','e','s','e','t',' ','t','h','r','o','u','g','h',"33,'[', # '1','4',';','2','4','H','t','h','e',' ','t','e','r','m','i', # 'n','a','l',"47,'s',' ','S','e','t','-','U','p',' ','p','r', # 'o','c','e','d','u','r','e','.',"33,'[','1','7',';','3','7', # 'H',"33,'[','1','m','S','o','r','r','y',',',"33,'[','1','9', # ';','3','1','H','p','r','o','g','r','a','m',' ','m','u','s', # 't',' ','a','b','o','r','t','.',"33,'[','0','m',"200/ DATA BADKEY /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33, # '[','9',';','1','4','H','A','n',' ','i','n','v','a','l','i', # 'd',' ','U','D','K',' ','n','a','m','e',' ','w','a','s',' ', # 'r','e','a','d',' ','f','r','o','m',' ','t','h','e',' ','i', # 'n','p','u','t',' ','s','t','r','e','a','m','.',"33,'[','1', # '7',';','3','7','H',"33,'[','1','m','S','o','r','r','y',',', # "33,'[','1','9',';','3','1','H','p','r','o','g','r','a','m', # ' ','m','u','s','t',' ','a','b','o','r','t','.',"33,'[','0', # 'm',"200/ DATA ECONT /"33,'[','0','m',"33,'[','2','2',';','2','7','H', # 'P','r','e','s','s',' ',"33,'[','7','m','R','E','T','U','R', # 'N',"33,'[','0','m',' ','t','o',' ','c','o','n','t','i','n', # 'u','e','.',"33,'[','2','3',';','4','0','H',"200/ C C Initialize VT240 video terminal operation C CALL PRINT(TM2007) !Make sure that soft reset will work (VT240) CALL PRINT(SRESET) !Request a VT240 soft reset C C Identify the operating system C STRING(1) = PID(27) !Enable use of SCOPY routine CALL SCOPY('RT-11',PID(22)) RT11 = .TRUE. IF(MONTYP() .EQ. 0) GO TO 1 !Skip if this is really RT-11 RT11 = .FALSE. CALL SCOPY('TSX+ ',PID(22)) CALL TSXSTU !Enable TSX+ single character activation 1 PID(27) = STRING(1) IF(RT11) CALL FNCRLF !Force monitor into NO_CRLF state EXTCDE = 1 !Set exit code status to SUCCS$ C C Determine if this task is running under control of C an RT-11 command file and that SET TT: QUIET has been set. C CALL IDFSTS(QUIET) IF(QUIET) GO TO 5 C C Initialize terminal operation C CALL PRINT(INITRM) !Define basic terminal operation states C C Identify the program C CALL PRINT(PID) C C Identify the terminal and be sure UDK keys are unlocked C 5 CALL ISLEEP(0,0,0,20) !Ensure terminal has caught up I = KTRMID(10,TID,LPRVTE) IF(I .LE. 0) GO TO 75 !Insist on a response IF(TID(1) .NE. 62) GO TO 75 !Must be of VT200 series DO 1000 J = 2,I IF(TID(J) .EQ. 8) GO TO 10 !Look for UDK capability 1000 CONTINUE GO TO 75 10 IF(UDKSTS()) 75,15,79 !UDK feature unlocked? C C Clear all previous definitions? C 15 IF(QUIET) GO TO 20 CALL PRINT(CLUDKP) CALL PRINT(YESNOP) 20 CALL GTLIN(STRING) IF(LEN(STRING).EQ.0 .OR. STRING(1).NE.'Y') GO TO 25 CALL PRINT(CLRUDK) C C Query user for a key to program C 25 IF(QUIET) GO TO 30 CALL PRINT(CMENU1) CALL PRINT(CMENU2) 30 IF(.NOT.QUIET) CALL PRINT(CPRMPT) CALL GTLIN(STRING) C C Validate and decode key name C CALL SCRNCH(STRING,I) IF(I .EQ. 0) GO TO 60 IF(STRING(1) .EQ. 'F') GO TO 40 KP = 15 IF(ISCOMP(STRING,'HELP') .EQ. 0) GO TO 45 KP = 16 IF(ISCOMP(STRING,'DO') .EQ. 0) GO TO 45 35 IF(QUIET) GO TO 90 CALL PRINT(BEEP) GO TO 30 40 IF(I .LT. 2 .OR. I .GT. 3) GO TO 35 DECODE(I-1,100,STRING(2),ERR=35) KP 100 FORMAT(I) IF(KP .LT. 6 .OR. KP .GT. 20) GO TO 35 45 KP = KP + 11 IF(KP .GT. 21) KP = KP + 1 IF(KP .GT. 26) KP = KP + 1 IF(KP .GT. 29) KP = KP + 1 CALL SCOPY(PREAMB,BUFR) ENCODE(3,200,BUFR(7)) KP 200 FORMAT(I2,'/') BUFR(10) = 0 IF(.NOT.GETDEF(BUFR(10),QUIET)) GO TO 25 !Get new definition CALL CONCAT(BUFR,ST,BUFR) !Add in string terminator CALL PRINT(BUFR) !Send definition to the terminal IF(UDKSTS()) 75,25,85 !Be sure the terminal accepted it C C Program Termination Section C C Lock against future definitions? C 60 IF(QUIET) GO TO 65 CALL PRINT(LKUDKP) CALL PRINT(YESNOP) 65 CALL GTLIN(STRING) IF(LEN(STRING).EQ.0 .OR. STRING(1).NE.'Y') GO TO 70 CALL PRINT(LOKUDK) 70 CALL IPOKEB("53,EXTCDE) !Define monitor's User Error Byte IF(QUIET) CALL EXIT CALL PRINT(INITRM) CALL PRINT(CLRHME) IF(RT11) CALL ENCRLF !Restore monitor's initial CRLF state CALL EXIT C C Error Handler C 75 CALL PRINT(PID) CALL PRINT(TFOREN) GO TO 95 79 IF(QUIET) GO TO 70 !Gracefully exit, this is probably a re-boot 80 CALL PRINT(PID) CALL PRINT(UDKLKD) GO TO 95 85 CALL PRINT(PID) CALL PRINT(ERLOCK) GO TO 95 90 CALL PRINT(PID) CALL PRINT(BADKEY) 95 CALL GTLIN(STRING,ECONT) EXTCDE = "10 !Set exit code status to SEVER$ GO TO 70 END INTEGER FUNCTION UDKSTS() C C Query terminal to determine whether on not the UDK feature C has been locked against further change. C Function return value = -1 - No or bad response from terminal C 0 - Unlocked C +1 - Locked C INTEGER LESCSQ,I BYTE UDKQRY(7),STRING COMMON /UDK01/ STRING(82) DATA UDKQRY /"33,'[','?','2','5','n',"200/ UDKSTS = -1 !Assume no or bad response CALL PRINT(UDKQRY) !Ask "Are UDK's locked?" I = LESCSQ(STRING) !Accept response IF(I .LE. 0) RETURN IF(STRING(2).NE.'[' .OR. STRING(3).NE.'?' .OR. # STRING(4).NE.'2' .OR. STRING(6).NE. 'n') RETURN IF(STRING(5) .EQ. '0') UDKSTS = 0 !UDK keys are unlocked IF(STRING(5) .EQ. '1') UDKSTS = 1 !UDK feature locked RETURN END