PROGRAM KEYEX(TAPE1=100,OUTPUT=100,TTFILE=100 . ,INPUT=100, KEYPRNT=100, TAPE6 = KEYPRNT . ,TAPE2=OUTPUT,TAPE3=TTFILE,TAPE5=INPUT) *** KEY DEFINITION UTILITY. * * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. * * THE *KEY* COMMAND WAS DESIGNED TO BE USED ONLY ON THE VIKING 721 * TERMINAL. IT MAKES USE OF THE PROGRAMMABLE FUNCTION KEYS ON THE * VIKING 721. YOU CAN CREATE OR EDIT DEFINITIONS FOR FUNCTION * KEYS AND SET TERMINAL CHARACTERISTICS. * * W. F. ANSLEY 83/06/01. CYBER INTERFACE AND PANELS. * S. L. KSANDER 83/06/01. 721 INTERFACE AND Z80 CODE. * 83/11/07. UPDATED TO INCLUDE THE CHECK AND PRINT * COMMANDS. * 84/02/29. UPDATE TO INCLUDE THE PF COMMANDS. * M. D. LEMBCKE 84/10/30. REVISED AND STANDARDIZED. * M. L. SWANSON 85/02/05. *** THE COMMAND FORMATS ARE: KEY,OPTION. OR * KEY(OPTION,FILENAME) * * WHERE OPTION CAN BE ONE OF THE FOLLOWING: * * HELP GIVES THE USER COMPLETE INFORMATION ON THE *KEY* * COMMAND AND ITS USE. *FILENAME* IS IGNORED WITH * THIS OPTION. * * CHECK CHECKS TO SEE IF THE FUNCTION KEYS ARE ALREADY * LOADED. IF NOT, A LOAD WILL BE EXECUTED. THIS * WILL SAVE TIME FOR THE USER OPERATING AT A LOW * BAUD RATE. * * NOTE: A GOOD USE FOR THIS OPTION IS IN A PROLOGUE * AT LOGIN TIME (REFER TO THE UPROC COMMAND). * * DISPLAY DISPLAYS THE FIRST SIXTEEN FUNCTION KEY LABELS THAT * ARE CURRENTLY STORED IN THE 721. * * DEFAULT SETS THE KEY DEFINITIONS FOR THE HELP, EDIT AND STOP * KEY TO THE NOS SYSTEM DEFAULTS. *FILENAME* IS IGNORED * FOR THIS OPTION. THE DEFAULTS SET ARE: HELP KEY = * HELP. EDIT KEY = FSE. STOP KEY = CTRL T/NEXT. * * EDIT ALLOWS THE USER TO UPDATE THEIR EXISTING KEY * DEFINITIONS ON *FILENAME*. IF *FILENAME* IS * NOT SPECIFIED, A FILE NAMED *KEYDEFS* WILL * BE CREATED AND SAVED UNDER THE USER'S USERNAME. * * LOAD THIS WILL DOWNLINE LOAD THE KEY DEFINITIONS FROM THE * SPECIFIED FILE INTO THE TERMINAL WITHOUT ANY USER * INTERACTION. IF NO FILE IS SPECIFIED, THE DEFAULT * FILE *KEYDEFS* WILL BE USED. * * PRINT THIS WILL LIST ONLY THE KEYS THAT ARE DEFINED ON THE * SPECIFIED FILE. THE OUTPUT WILL BE PLACED ON THE * LOCAL FILE *KEYPRNT*. IF NO FILE IS SPECIFIED, * *KEYDEFS* IS USED. THIS DOES NOT NECESSARILY LIST * THE KEY DEFINITIONS THAT ARE CURRENTLY LOADED INTO * THE TERMINAL, JUST THOSE THAT ARE ON THE SPECIFIED * FILE. * * FILENAME THE DEFAULT FILE NAME IS *KEYDEFS*. *** ERROR MESSAGES. * * * PLEASE ENTER THE SYSTEM COMMAND SCREEN(721) * AND RE-ENTER THE KEY COMMAND.* * THE PROGRAM HAS DETECTED THE TERMINAL MODEL NAME DOES * NOT BEGIN WITH THE PREFIX "721" AND HENCE THE TERMINAL * HAS NOT BEEN RECOGNIZED AS A VIKING X. NO PROCESSING * OCCURS IN THIS CASE. *** MESSAGES. * * * FUNCTION KEYS ARE ALREADY LOADED.* * OUTPUT BY ROUTINE *CHECK* TO SIGNIFY NO LOAD WAS * PROCESSED. * * * FUNCTION KEYS ARE NOT LOADED.* * OUTPUT BY ROUTINE *DISPLAY* IF FUNCTION KEYS HAVE NOT * BEEN DEFINED. * * * FUNCTION KEYS HAVE BEEN LOADED.* * OUTPUT BY ROUTINE *LOAD* IF FUNCTION KEYS WERE LOADED. * * * THE FUNCTION KEYS *EDIT*, *HELP*, AND *STOP* HAVE BEEN LOADED.* * OUTPUT BY ROUTINE *DEFAULT* IF *EDIT*, *HELP*, *STOP* * KEYS WERE LOADED. * * * THE KEY DEFINITIONS FILE HAS BEEN REPLACED.* * OUTPUT BY ROUTINE *EDIT* IF KEY DEFINITIONS FILE IS * REPLACED. * * * THE LIST OF DEFINED FUNCTION KEYS IS ON THE LOCAL FILE * *KEYPRNT*.* - OUTPUT BY ROUTINE *PRINT* AS AN INFORM- * ATIVE MESSAGE TO THE USER. *** *KEY* FILES. * * THE FOLLOWING DECKS/FILES ARE ASSOCIATED WITH THE *KEY* UTILITY. * * PROCEDURES: * KEY *CCL* PROCEDURE. * * CODE: * KEYEX KEY EXECUTIVE PROGRAM. * KEYPANS SCREEN FORMATTING PANELS. * KEYUTIL Z80 SOURCE CODE. ** MAIN PROGRAM. ** KEYEX - EXECUTIVE PROGRAM FOR *KEY* UTILITY. * * *KEYEX* SETS UP DEFAULTS IN COMMON BLOCK *INFO*, CRACKS * COMMAND PARAMETERS, AND PROCESSES USER SPECIFIED OPTIONS. * * KEYEX(OPTION, FILENAME) * * ENTRY OPTION - USER SPECIFIED OPTION. * FILENAME - OPTIONAL FILE NAME. * * EXIT *CCL* GLOBAL VARIABLE *R1* = 1 IF TERMINAL TYPE IS * INCORRECT. * * CALLS CHECK, CHKTERM, DEFAULT, DISPLAY, EDIT, HELP, LOAD, * PRINT, SYSKEYS. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS CHARACTER*7 OPTION * OPTION SPECIFIED BY THE USER CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS * 7/ KEY LABEL, 60/ KEY DEFINITION CHARACTER*7 PARM * PARAMETER NAME CHARACTER*7 SETDATA(3) * SETUP TERMINAL CHARACTERISTICS COMMON / INFO / KEYS, FILENM, SETDATA * SET UP DEFAULTS IN COMMON BLOCK AND GET INPUT PARAMETERS. CALL SYSKEYS CALL GETPARM(PARM,OPTION,I) CALL GETPARM(PARM,FILENM,I) * CHECK TERMINAL TYPE AND PROCESS OPTION SPECIFIED BY THE USER. CALL CHKTERM IF(OPTION .EQ. 'CHECK ') THEN CALL CHECK ELSE IF(OPTION .EQ. 'DEFAULT') THEN CALL DEFAULT ELSE IF(OPTION .EQ. 'DISPLAY') THEN CALL DISPLAY ELSE IF(OPTION .EQ. 'EDIT ') THEN CALL EDIT ELSE IF(OPTION .EQ. 'HELP ') THEN CALL HELP ELSE IF(OPTION .EQ. 'LOAD ') THEN CALL LOAD ELSE IF(OPTION .EQ. 'PRINT ') THEN CALL PRINT ENDIF CLOSE(1,STATUS='DELETE') CLOSE(3,STATUS='DELETE') END SUBROUTINE BYTE (CHAR, UBYTE, LBYTE) ** BYTE - CONVERT ADDRESS TO Z80 FORMAT. * * *BYTE* TAKES *CHAR* AND DIVIDES IT, CHANGING THE ADDRESS INTO * 721 Z80 FORMAT AND RETURNS THE RESULT IN *UBYTE* AND *LBYTE*. * * CALL BYTE(CHAR, UBYTE, LBYTE) * * ENTRY CHAR - CHARACTER BYTE ADDRESS. * * EXIT UBYTE - THE UPPER HALF ADDRESS WITH THE PREFIX *60*. * LBYTE - THE LOWER HALF ADDRESS WITH THE PREFIX *20*. * * NOTE THE Z80 MICRO REQUIRES A 16 BIT ADDRESS WITH THE UPPER * BYTE BEFORE THE LOWER BYTE. IMPLICIT INTEGER (A - Z) BOOLEAN ZPREFIX * Z80 CODE PREFIX BOOLEAN Z20CODE * *20* PREFIX FOR Z80 ADDRESS BOOLEAN Z60CODE * *60* PREFIX FOR Z80 ADDRESS DATA ZPREFIX / Z"800" / DATA Z20CODE / Z"20" / DATA Z60CODE / Z"60" / C = AND(CHAR, Z"F0") UBYTE = SHIFT(C, -4) + Z20CODE + ZPREFIX LBYTE = AND(CHAR, Z"0F") + Z60CODE + ZPREFIX RETURN END SUBROUTINE CHECK ** CHECK - CHECK IF FUNCTION KEYS HAVE BEEN LOADED. * * *CHECK* QUERIES THE TERMINAL TO DETERMINE IF Z80 CONTROLWARE * AND KEY DEFINITIONS ARE LOADED INTO THE TERMINAL. * * CALL CHECK * * CALLS LOAD, VERLOAD. * * MESSAGES * FUNCTION KEYS HAVE BEEN LOADED. IMPLICIT INTEGER (A - Z) LOGICAL LOADED * CONTROLWARE LOADED FLAG DATA LOADED / .FALSE. / 10 FORMAT('FUNCTION KEYS ARE ALREADY LOADED.') CALL VERLOAD(LOADED) IF (.NOT.LOADED) THEN CALL LOAD ELSE WRITE(2,10) ENDFILE 2 ENDIF RETURN END SUBROUTINE CHKTERM ** CHKTERM - CHECK TERMINAL MODEL NAME. * * *CHKTERM* VERIFIES THAT THE FIRST THREE CHARACTERS OF THE * TERMINAL MODEL NAME SPECIFIED TO THE SCREEN OR LINE COMMAND * WAS "721". * * CALL CHKTERM * * ERROR *ERR* IS CALLED IF THE TERMINAL MODEL IS NOT PREFIXED * BY "721". * * CALLS ERR, SFGETN. * * MESSAGES * PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721. * AND RE-ENTER THE KEY COMMAND. * STOP. FIX ERROR. IMPLICIT INTEGER (A - Z) CHARACTER*7 MODNAME * TERMINAL MODEL NAME. CHARACTER*3 PREFIX * THREE CHARACTER PREFIX CHARACTER*3 PRE721 * CHARACTER STRING PREFIX FOR 721 EQUIVALENCE (MODNAME, PREFIX) DATA PRE721 / '721' / 10 FORMAT(' PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721.', ./' AND RE-ENTER THE KEY COMMAND.') * GET TERMINAL MODEL NAME. CALL SFGETN(MODNAME) * IF PREFIX IS NOT '721', NOTIFY USER OF ERROR. IF (PREFIX .NE. PRE721) THEN WRITE(2,10) CALL ERR STOP 'FIX ERROR.' ENDIF RETURN END SUBROUTINE CLEAR ** CLEAR - CLEAR THE USER DEFINED FUNCTION KEYS IN THE TERMINAL. * * *CLEAR* CLEARS THE FUNCTION KEY DEFINITIONS WITHIN THE * TERMINAL BY EXECUTING A HOST-LOADED CONTROLWARE ROUTINE * THAT REINITIALIZES THE TERMINALS KEY DEFINITION TABLE. * * CALL CLEAR * * CALLS PACK, SEQPACK. IMPLICIT INTEGER (A - Z) BOOLEAN ZCARRET(1) * HEX CODE FOR CARRIAGE RETURN BOOLEAN ZRESETR(3) * HEX SEQUENCE TO INVOKE RESET ROUTINE DATA ZCARRET / Z"0D" / DATA ZRESETR / Z"1E", Z"12", Z"72" / * RESET KEYS TO THE DEFAULT 721 SETTINGS BY DOING A HOST EXECUTE * OF THE HOST LOADED Z80 CONTROLWARE ROUTINE *RESET*. CALL PACK(1, 0) CALL SEQPACK(ZRESETR,3) CALL SEQPACK(ZCARRET,1) CALL PACK(3, 1) RETURN END SUBROUTINE DEFAULT ** DEFAULT - LOAD DEFAULT FUNCTION KEYS. * * *DEFAULT* LOADS THE *EDIT*, *HELP*, AND *STOP* FUNCTION KEYS. * * CALL DEFAULT * * EXIT *KEYS* AND *SETDATA* ARE SET TO DEFAULT VALUES. * * CALLS CLEAR, SEND. * * MESSAGES * THE FUNCTION KEYS *EDIT*, *HELP*, AND *STOP* HAVE BEEN * LOADED. IMPLICIT INTEGER (A - Z) 10 FORMAT(' THE FUNCTION KEYS *EDIT*, *HELP*, AND *STOP* HAVE ', .'BEEN LOADED.') * CLEAR THE CURRENT FUNCTION KEY DEFINITIONS. CALL CLEAR * SEND DEFAULT DEFINITIONS TO TERMINAL. CALL SEND WRITE(2,10) ENDFILE 2 RETURN END SUBROUTINE DISPLAY ** DISPLAY - DISPLAY FUNCTION KEYS. * * *DISPLAY* DISPLAYS THE FIRST SIXTEEN FUNCTION KEY LABELS THAT * ARE CURRENTLY LOADED IN THE TERMINAL. * * CALL DISPLAY * * EXIT THE FIRST SIXTEEN KEY LABELS DISPLAYED USING * A SCREEN FORMATTING PANEL. * * CALLS ERR, PACK, RDSORC, SEQPACK, SFCLOS, SFOPEN, SFSSHO, * VERLOAD. * * MESSAGES * FUNCTION KEYS ARE NOT LOADED. * * PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721. * AND RE-ENTER THE KEY COMMAND. * STOP. FIX ERROR. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS BOOLEAN ZDISKEY(3) * HEX SEQUENCE TO DISABLE KEYBOARD ENTRY BOOLEAN ZENKEYB(3) * HEX SEQUENCE TO ENABLE KEYBOARD ENTRY BOOLEAN ZHOSTLC(3) * HEX SEQUENCE FOR HOST LOADED CONTROLWARE BOOLEAN ZMCUR80(3) * HEX SEQUENCE TO MOVE CURSOR FOR 80 COLUMN BOOLEAN ZMCUR32(5) * HEX SEQUENCE TO MOVE CURSOR FOR 132 COLUMN CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*112 OPRAM4 * STRING OF USER LABELS CHARACTER*7 PANEL * TEMPORARY PANEL NAME CHARACTER*7 PANEL7 * DISPLAY PANEL FOR 80 CHARACTERS/LINE CHARACTER*7 PANEL8 * DISPLAY PANEL FOR 132 CHARACTERS/LINE CHARACTER*7 SETDATA(3) * TERMINAL CHARACTERISTICS CHARACTER*7 STR80 * 80 CHARACTERS STRING CHARACTER*7 STR132 * 132 CHARACTERS STRING LOGICAL LOADED * CONTROLWARE LOADED FLAG COMMON / INFO / KEYS, FILENM, SETDATA DATA OPRAM4 / ' ' / DATA PANEL7 / 'KEYPAN7' / DATA PANEL8 / 'KEYPAN8' / DATA ZDISKEY / Z"1E", Z"12", Z"4D" / DATA ZENKEYB / Z"1E", Z"12", Z"4E" / DATA ZHOSTLC / Z"1E", Z"12", Z"73" / DATA ZMCUR80 / Z"02", Z"20", Z"23"/ DATA ZMCUR32 / Z"02", Z"7E", Z"20", Z"20", Z"23" / DATA STR80 / '80 ' / DATA STR132 / '132 ' / DATA LOADED / .FALSE. / 12 FORMAT(A112) 13 FORMAT(' FUNCTION KEYS ARE NOT LOADED.') 14 FORMAT(' PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721.', ./' AND RE-ENTER THE KEY COMMAND.') CALL VERLOAD(LOADED) IF (.NOT.LOADED) THEN CALL PACK(1, 0) WRITE(2,13) ELSE CALL RDSORC CALL PACK(1, 0) CALL SEQPACK(ZHOSTLC,3) CALL PACK(3, 1) * READ THE 721 LABELS FROM THE TERMINAL. READ(5, 12) OPRAM4 * DISPLAY THE LABELS USING THE CORRECT SIZE PANEL. IF(SETDATA(3) .EQ. STR132) THEN PANEL = PANEL8 ELSE PANEL = PANEL7 ENDIF CALL SFOPEN(PANEL, STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ELSE CALL SFSWRI(PANEL, OPRAM4) CALL SFCLOS(PANEL, 2) * POSITION CURSOR UNDER THE DISPLAY OF LABELS. CALL PACK(1, 0) IF(SETDATA(3) .EQ. STR80) THEN CALL SEQPACK(ZMCUR80,3) ELSE CALL SEQPACK(ZMCUR32,5) ENDIF ENDIF ENDIF CALL SEQPACK(ZENKEYB,3) CALL PACK(3, 1) RETURN END SUBROUTINE EDIT ** EDIT - EDIT FUNCTION KEYS. * * *EDIT* ALLOWS THE USER TO DEFINE AND LOAD FUNCTION KEYS * AND SET TERMINAL CHARACTERISTICS. * * CALL EDIT * * EXIT *PARM* AND *SETDATA* MAY BE MODIFIED. * * CALLS EDSETUP, ERR, LDSETUP, LOAD, RDSORC, SFCLOS, SFGETK, * SFOPEN, SFSSHO, SYSKEYS, WRSORC. * * MESSAGES * THE KEY DEFINITIONS FILE HAS BEEN REPLACED. * * FUNCTION KEYS HAVE BEEN LOADED. IMPLICIT INTEGER (A - Z) PARAMETER (ORDHELP = 3) * ORDINAL FOR THE HELP KEY PARAMETER (ORDBKW = 8) * ORDINAL FOR THE BKW FUNCTION KEY PARAMETER (ORDFWD = 7) * ORDINAL FOR THE FWD FUNCTION KEY PARAMETER (ORDSTOP = 4) * ORDINAL FOR THE STOP FUNCTION KEY PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS PARAMETER (NPAN = 3) * NUMBER OF EDIT PANELS PARAMETER (NKEYSPP = 15) * NUMBER OF KEYS DEFINABLE PER PANEL DIMENSION BASE(NPAN) * FUNCTION KEYS DIVIDED IN THREE GROUPS CHARACTER*1 PAGE(NPAN) * PAGE NUMBER OF PANEL CHARACTER*7 FILENM * FILE NAME CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*5 LABELS(NPAN, NKEYSPP) * FUNCTION KEY LABELS CHARACTER*7 P1 * BASIC INPUT PANEL CHARACTER*7 P2 * HELP PANEL CHARACTER*7 P3 * ASCII-HEX PANEL CHARACTER*1081 P1IVAR * INPUT STRING FROM THE PANEL CHARACTER*1081 P1OVAR * OUTPUT STRING FOR THE PANEL CHARACTER*72 P1I(NKEYSPP) * INPUT STRING FROM THE PANEL CHARACTER*72 P1O(NKEYSPP) * OUTPUT STRING FOR THE PANEL CHARACTER*1 P2VAR * BLANK OUTPUT STRING CHARACTER*7 SETDATA(3) * SETUP DATA. INTEGER ORDINAL * FUNCTION KEY VALUE INTEGER TYPE * TYPE OF FUNCTION KEY * 0 = PROGRAMMABLE FUNCTION KEY * 1 = LABELED FUNCTION KEY EQUIVALENCE (P1I(1), P1IVAR(2:2)) EQUIVALENCE (P1O(1), P1OVAR(2:2)) COMMON / INFO / KEYS, FILENM, SETDATA DATA PAGE / '1', '2', '3' / DATA P1 / 'KEYPAN4' / DATA P2 / 'KEYPAN3' / DATA P3 / 'KEYPAN6' / DATA BASE / 0, 15, 30 / DATA P1I / 15* ' ' / DATA P1O / 15* ' ' / DATA P2VAR / ' ' / DATA (LABELS(1, I), I = 1, NKEYSPP) / . 'F1 ', 'F2 ', 'F3 ', 'F4 ', 'F5 ' ., 'F6 ', 'F7 ', 'F8 ', 'F9 ', 'F10 ' ., 'F11 ', 'F12 ', 'F13 ', 'F14 ', 'F15 ' ./ DATA (LABELS(2, I), I = 1, NKEYSPP) / . 'RTAB ', 'LTAB ', 'NEXT ', 'DOWN ', 'UP ' ., 'FWD ', 'BKW ', 'HELP ', 'ERASE ', 'EDIT ' ., 'BACK ', 'LAB ', 'DATA ', 'STOP ', 'INSRT ' ./ DATA (LABELS(3, I), I = 1, NKEYSPP) / . 'DLETE', 'CLEAR', 'PRINT', 'PAD 1 ', 'PAD 2 ' ., 'PAD 3', 'PAD 4', 'PAD 5', 'PAD 6 ', 'PAD 7 ' ., 'PAD 8', 'PAD 9', 'PAD 0', 'PAD , ', 'PAD . ' ./ 11 FORMAT(' THE KEY DEFINITIONS FILE HAS BEEN REPLACED.') 12 FORMAT(' PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721.', ./' AND RE-ENTER THE KEY COMMAND.') * READ USER DEFINITIONS FROM SOURCE FILE, IF ANY. CALL RDSORC CALL SFOPEN(P1, STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ENDIF 100 PANEL = 1 * LOAD THE OUTPUT STRING VARIABLE FOR THE PANEL. THE OUTPUT STRING * IS COMPRISED OF THE KEY NAME, LABEL, AND DEFINITION. 110 P1OVAR(1:1) = PAGE(PANEL) DO 120 I = 1, NKEYSPP P1O(I)(01:05) = LABELS(PANEL, I) P1O(I)(06:12) = KEYS(BASE(PANEL) + I)(1:07) P1O(I)(13:72) = KEYS(BASE(PANEL) + I)(8:67) 120 CONTINUE * SHOW KEY DEFINITION PANEL. CALL SFSSHO(P1, P1OVAR, P1IVAR) DO 130 I = 1, NKEYSPP KEYS(BASE(PANEL) + I)(1:07) = P1I(I)(06:12) KEYS(BASE(PANEL) + I)(8:67) = P1I(I)(13:72) 130 CONTINUE * CHECK FOR THE LABELED KEYS *FWD*, *BKW*, AND *HELP*, IGNORING OTHERS. CALL SFGETK(TYPE, ORDINAL) IF(TYPE .EQ. 0) GOTO 140 IF(ORDINAL .EQ. ORDFWD) GOTO 150 IF(ORDINAL .EQ. ORDBKW) GOTO 160 IF(ORDINAL .EQ. ORDHELP) GOTO 190 IF (ORDINAL .EQ. ORDSTOP) GOTO 200 GOTO 110 * CHECK FOR APPLICATION KEYS F1, F2, F3, F4, F5, F6, F7, F8, F9. 140 GOTO (150,160,170,180,190,200,210,220,230) ORDINAL GOTO 110 * F1 KEY: FWD TO NEXT PANEL. 150 PANEL = PANEL + 1 IF (PANEL .EQ. NPAN+1) PANEL = 1 GOTO 110 * F2 KEY: BKW TO LAST PANEL. 160 PANEL = PANEL - 1 IF (PANEL .LT. 1) PANEL = 3 GOTO 110 * F3 KEY: UNDO ALL CHANGES AND RESTART. * REINITIALIZE *KEYS* AND *SETDATA*, AND GET USER DEFINITIONS IF ANY. 170 CALL SYSKEYS CALL RDSORC GOTO 100 * F4 KEY: LOAD. 180 CALL SFCLOS(P1, 1) CALL WRSORC CALL LOAD RETURN * F5 KEY: SHOW HELP PANELS. 190 CALL SFOPEN(P2,STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ENDIF CALL SFSSHO(P2,P2VAR,P2VAR) CALL SFGETK(TYPE, ORDINAL) CALL SFCLOS(P2,0) IF ((TYPE .EQ. 1) .AND. (ORDINAL .EQ. ORDSTOP)) GOTO 200 GOTO 110 * F6 KEY: QUIT. 200 CALL SFCLOS(P1,1) RETURN * F7 KEY: QUIT AND REPLACE FILE. 210 CALL SFCLOS(P1,1) CALL WRSORC CALL LDSETUP WRITE(2,11) RETURN * F8 KEY: DISPLAY ASCII-HEX CHART. 220 CALL SFOPEN(P3,STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ENDIF CALL SFSREA(P3,P2VAR) CALL SFCLOS(P3,0) GOTO 110 * F9 KEY: SET UP TERMINAL CHARACTERISTICS. 230 CALL EDSETUP GOTO 110 END SUBROUTINE EDSETUP ** EDSETUP - EDIT THE SETUP TERMINAL CHARACTERISTICS. * * *EDSETUP* IS CALLED BY *EDIT* AND ALLOWS THE USER TO SET UP THE * TERMINAL CHARACTERISTICS FOR THE NUMBER PAD, SCREEN MODE, AND THE * NUMBER OF CHARACTERS PER LINE. * * CALL EDSETUP * * CALLS SFCLOS, SFGETK, SFOPEN, SFSSHO. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE KEYS PARAMETER (ORDFWD = 7) * ORDINAL FOR THE FWD KEY PARAMETER (ORDBKW = 1) * ORDINAL FOR THE BKW KEY PARAMETER (ORDSTOP = 4) * ORDINAL FOR THE STOP KEY CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*7 PANEL4 * DISPLAY PANEL FOR *EDIT* CHARACTER*7 PANEL5 * DISPLAY PANEL FOR SETUP CHARACTER*7 SETDATA(3) * SETUP TERMINAL CHARACTERISTICS CHARACTER*7 STRDEF * DEFAULT STRING CHARACTER*21 PANELIO * INPUT/OUTPUT STRING FROM THE PANEL CHARACTER*21 TEMPSTR * TEMPORARY TERMINAL CHARACTERISTICS INTEGER ORDINAL * FUNCTION KEY VALUE INTEGER TYPE * TYPE OF FUNCTION KEY * 0 = PROGRAMMABLE FUNCTION KEY * 1 = LABELED FUNCTION KEY EQUIVALENCE (SETDATA(1), TEMPSTR(1:1)) COMMON / INFO / KEYS, FILENM, SETDATA DATA PANEL5 / 'KEYPAN5' / DATA PANEL4 / 'KEYPAN4' / DATA STRDEF / 'DEFAULT' / * CLOSE CURRENT *EDIT* PANEL. CALL SFCLOS(PANEL4,0) * SHOW KEY DEFINITION PANEL. CALL SFOPEN(PANEL5, STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ENDIF PANELIO = STRDEF // STRDEF // STRDEF CALL SFSSHO(PANEL5, PANELIO, PANELIO) CALL SFGETK(TYPE, ORDINAL) CALL SFCLOS(PANEL5, 0) IF (.NOT.((TYPE .EQ. 1) .AND. (ORDINAL .EQ. ORDSTOP))) THEN CALL WRSORC TEMPSTR = PANELIO ENDIF CALL SFOPEN(PANEL4, STAT) IF (STAT .NE. 0) THEN CALL ERR STOP 'SF ERROR.' ENDIF RETURN END SUBROUTINE RDSORC ** RDSORC - READ KEY DEFINITIONS FROM THE SOURCE FILE. * * *RDSORC* READS THE KEY DEFINITIONS FROM THE DEFINITION * SOURCE FILE. * * CALL RDSORC * * USES KEYS, SETDATA. * * CALLS PF. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*60 KEYDEF * FUNCTION KEY DEFINITION CHARACTER*67 KEYS(NKEYS) * LABEL AND KEYDEF CHARACTER*7 LABEL * FUNCTION KEY LABEL CHARACTER*7 SETDATA(3) * SETUP TERMINAL CHARACTERISTICS COMMON / INFO / KEYS, FILENM, SETDATA 10 FORMAT(A7, 1X, A60) 20 FORMAT(A7) * READ USER KEY DEFINITION FILE, IF ANY. CALL PF('GET', 'TAPE1', FILENM, 'NA', IGNORE) * SOURCE FILE CONSISTS OF FUNCTION KEY LABELS, * KEY DEFINITIONS, AND THE TERMINAL'S SETUP DATA. DO 110 I = 1, NKEYS READ(1, 10, END=130) LABEL, KEYDEF IF(KEYDEF .NE. ' ') THEN KEYS(I)(1:07) = LABEL KEYS(I)(8:67) = KEYDEF ENDIF 110 CONTINUE DO 120 I = 1, 3 READ(1, 20, END=130) SETDATA(I) 120 CONTINUE 130 REWIND 1 RETURN END SUBROUTINE HELP ** HELP - PROVIDE HELP INFORMATION FOR THE *KEY* UTILITY. * * *HELP* GIVES THE USER INFORMATION ON THE *KEY* UTILITY, * USING SCREEN FORMATTING DISPLAY PANELS. * * CALL HELP * * CALLS ERR, SFCLOS, SFOPEN, SFSSHO. * * MESSAGES * PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721. * AND RE-ENTER THE KEY COMMAND. * STOP. FIX ERROR. IMPLICIT INTEGER (A - Z) PARAMETER (ORDBKW = 8) * ORDINAL FOR THE BKW KEY PARAMETER (ORDSTOP = 4) * ORDINAL FOR THE STOP KEY CHARACTER*7 PANEL1 * FIRST HELP PANEL CHARACTER*7 PANEL2 * SECOND HELP PANEL CHARACTER*1 PANELIO * OUTPUT STRING FOR THE PANEL INTEGER ORDINAL * SCREEN FORMATTING KEY ORDINAL INTEGER STAT * *SFOPEN* RETURN STATUS INTEGER TYPE * SCREEN FORMATTING KEY TYPE DATA PANEL1 / 'KEYPAN1' / DATA PANEL2 / 'KEYPAN2' / 10 FORMAT(' PLEASE ENTER THE SYSTEM COMMAND: SCREEN,721.', ./' AND RE-ENTER THE KEY COMMAND.') * SHOW HELP PANELS. 100 CALL SFOPEN(PANEL1, STAT) IF (STAT .NE. 0) THEN WRITE(2,10) CALL ERR STOP 'SF ERROR.' ENDIF CALL SFSSHO(PANEL1, PANELIO,PANELIO) CALL SFGETK(TYPE,ORDINAL) CALL SFCLOS(PANEL1, 0) IF ((TYPE .EQ. 1) .AND. (ORDINAL .EQ. ORDSTOP)) RETURN CALL SFOPEN(PANEL2, STAT) IF (STAT .NE. 0) THEN WRITE(2,10) CALL ERR STOP 'SF ERROR.' ENDIF CALL SFSSHO(PANEL2, PANELIO,PANELIO) CALL SFCLOS(PANEL2, 1) CALL SFGETK(TYPE,ORDINAL) CALL SFCLOS(PANEL2, 0) IF ((TYPE .EQ. 1) .AND. (ORDINAL .EQ. ORDBKW)) GOTO 100 RETURN END SUBROUTINE LDSETUP ** LDSETUP - SET UP TERMINAL CHARACTERISTICS. * * *LDSETUP* SETS THE TERMINAL CHARACTERISTICS FOR THE NUMBER PAD, * SCREEN MODE, AND THE NUMBER OF CHARACTERS PER LINE. * * CALL LDSETUP * * CALLS PACK, SEQPACK. * * NOTE *RDSORC* MUST BE CALLED BEFORE THIS CODE IS PROCESSED TO * ENSURE THAT THE PROPER TERMINAL DEFINITIONS ARE LOADED. IMPLICIT INTEGER (A - Z) PARAMETER (KEYL = 45) * NUMBER OF PROGRAMMABLE FUNCTION KEYS BOOLEAN ZCARRET * HEX CODE FOR CARRIAGE RETURN BOOLEAN ZNUMCHR(3) * HEX SEQUENCE FOR CHARACTERS PER LINE BOOLEAN ZNUMPAD(3) * HEX SEQUENCE FOR NUMBER PAD CONDITION BOOLEAN ZOFFSET * HEX CODE FOR ADDRESS OFFSET BOOLEAN ZMODE * HEX CODE FOR SCREEN MODE BOOLEAN ZROLL * HEX CODE FOR ROLL PAGE MODE BOOLEAN ZSHIFT * HEX CODE FOR SHIFTED NUMERIC PAD CODE BOOLEAN Z132 * HEX CODE FOR 132 CHARACTERS PER LINE CHARACTER*7 FILENM * FILE NAME OF KEY DEFINITIONS CHARACTER*67 KEYS(KEYL) * FUNCTION KEY DEFINTIONS CHARACTER*7 SETDATA(3) * TERMINAL SETUP DATA CHARACTER*7 STRDEF * DEFAULT STRING CHARACTER*7 STRROL * ROLL STRING CHARACTER*7 STRSHI * SHIFTED STRING CHARACTER*7 STR132 * 132 STRING LOGICAL DEFNCHR * DEFAULT NUMBER OF CHARACTERS PER LINE LOGICAL DEFNPAD * DEFAULT NUMERIC PAD SETTING LOGICAL DEFPAGE * DEFAULT PAGINATION SETTING COMMON / INFO / KEYS, FILENM, SETDATA DATA ZCARRET / Z"0D" / DATA ZNUMCHR / Z"1E", Z"12", Z"48" / DATA ZNUMPAD / Z"1E", Z"12", Z"6C" / DATA ZOFFSET / Z"800" / DATA ZMODE / Z"16" / DATA ZROLL / Z"12" / DATA ZSHIFT / Z"6B" / DATA Z132 / Z"47" / DATA STRDEF / 'DEFAULT' / DATA STRROL / 'ROLL ' / DATA STRSHI / 'SHIFTED' / DATA STR132 / '132 ' / DATA DEFNCHR / .TRUE. / DATA DEFNPAD / .TRUE. / DATA DEFPAGE / .TRUE. / IF(SETDATA(1).NE. STRDEF) DEFNPAD = .FALSE. IF(SETDATA(2).NE. STRDEF) DEFPAGE = .FALSE. IF(SETDATA(3).NE. STRDEF) DEFNCHR = .FALSE. IF (.NOT.(DEFNPAD .AND. DEFPAGE .AND. DEFNCHR)) THEN CALL PACK(1, 0) ELSE RETURN ENDIF IF (.NOT.DEFNPAD) THEN IF(SETDATA(1) .EQ. STRSHI) ZNUMPAD(3) = ZSHIFT CALL SEQPACK(ZNUMPAD, 3) ENDIF IF (.NOT.DEFPAGE) THEN IF(SETDATA(2) .EQ. STRROL) ZMODE = ZROLL CALL PACK(2, ZOFFSET + ZMODE) ENDIF IF (.NOT.DEFNCHR) THEN IF(SETDATA(3) .EQ. STR132) ZNUMCHR(3) = Z132 CALL SEQPACK(ZNUMCHR, 3) ENDIF IF (.NOT.(DEFNPAD .AND. DEFPAGE .AND. DEFNCHR)) THEN * SEND A CARRIAGE RETURN IF A SEQUENCE WAS SENT TO THE TERMINAL. CALL PACK(2, ZOFFSET + ZCARRET) CALL PACK(3, 1) ENDIF RETURN END SUBROUTINE LOAD ** LOAD - LOAD DEFINITIONS INTO TERMINAL. * * *LOAD* LOADS THE TERMINAL WITH BOTH FUNCTION KEY DEFINITIONS * AND LABELS, AND MODIFIES TERMINAL CHARACTERISTICS. * * CALL LOAD * * CALLS CLEAR, LDSETUP, RDSORC, SEND. * * MESSAGES * FUNCTION KEYS HAVE BEEN LOADED. IMPLICIT INTEGER (A - Z) 10 FORMAT(' FUNCTION KEYS HAVE BEEN LOADED.') * READ SOURCE FILE INTO COMMON BLOCK. CALL RDSORC * CLEAR FUNCTION KEYS OF PREVIOUS DEFINITIONS. CALL CLEAR * DOWNLINE LOAD CURRENT DEFINITIONS INTO TERMINAL. CALL SEND * CHANGE THE SPECIFIED TERMINAL CHARACTERISTICS. CALL LDSETUP WRITE (2,10) ENDFILE 2 RETURN END SUBROUTINE PACK(CODE, BYTE) ** PACK - PACK BUFFER AND WRITE TO TERMINAL. * * *PACK* PACKS 4 BYTES INTO A BUFFER AND WRITES * THE BUFFER TO THE TERMINAL. * * CALL PACK(CODE, BYTE) * * ENTRY CODE = 1, FIRST BYTE IN BUFFER. * = 2, BYTE TO PLACE IN BUFFER. * = 3, LAST BYTE TO PLACE IN BUFFER. * * BYTE = Z80 BYTE TO BE PACKED AND WRITTEN TO TERMINAL. * * CALLS CONNEC. * * NOTES BUFFER FORMAT IS 00074---4---4---4---. * * MESSAGES * NO KEYS SPECIFIED. * NO KEYS WERE SPECIFIED TO BE SENT. * BUFFER OVERFLOW IN PACK. * BUFFER SIZE EXCEEDED LIMITS. IMPLICIT INTEGER (A - Z) PARAMETER (NUMKEYS = 45) * NUMBER OF DEFINABLE KEYS PARAMETER (STORCHR = 70) * STORED CHARACTERS PER DEFINITION PARAMETER (SIZE = (NUMKEYS * STORCHR) + 200) * BUFFER SIZE DIMENSION BUF(SIZE) * OUTPUT BUFFER INTEGER BYT * Z80 CODE DIVIDER INTEGER BYTE * Z80 BYTE CODE INTEGER PTR * INDEX FOR *BUF* * PACK *BYTE* INTO BUFFER FOR GIVEN *CODE*. GOTO (100, 200, 300), CODE * CODE = 1. SET UP INITIAL CODE IN BUFFER. 100 PTR = 0 BYT = 0 BYTE = 07 * CODE = 2. PACK DATA INTO BUFFER. 200 BYT = BYT - 1 IF(BYT .LT. 0) THEN BYT = 4 PTR = PTR + 1 BUF(PTR) = 0 ENDIF BUF(PTR) = OR(BUF(PTR), SHIFT(BYTE, BYT*12)) RETURN * CHECK FOR ERRORS BEFORE STARTING I/O. 300 IF(PTR .LT. 1) STOP ' NO KEYS SPECIFIED.' IF(PTR .GT. SIZE) STOP ' BUFFER OVERFLOW IN PACK ' * OUTPUT INFORMATION WITHOUT HEADER BYTES. CALL CONNEC(3) BUFFER OUT(3, 0) (BUF(1), BUF(PTR)) * LOOP UNTIL I/O COMPLETES. IF(UNIT(3))310,320,320 310 CONTINUE 320 CONTINUE RETURN END SUBROUTINE PRINT ** PRINT - PRINT FUNCTION KEYS TO SPECIFIED FILE. * * *PRINT* COPIES ALL DEFINED FUNCTION KEYS FROM THE SPECIFIED FILE * TO THE LOCAL FILE *KEYPRNT*. * * CALL PRINT * * CALLS RDSORC. * * MESSAGES * THE LIST OF DEFINED FUNCTION KEYS IS ON THE LOCAL * FILE *KEYPRNT*. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS PARAMETER (NKEY = 15) * NUMBER OF KEYS PER SECTION OF *KEYS* PARAMETER (NPAN = 3) * NUMBER OF SECTIONS IN *KEYS* CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*5 LABELS(NPAN, NKEY) * FUNCTION KEY LABELS CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*7 SETDATA(3) * SETUP TERMINAL CHARACTERISTICS COMMON / INFO / KEYS, FILENM, SETDATA DATA (LABELS(1, I), I = 1, NKEY) / . 'F1 ', 'F2 ', 'F3 ', 'F4 ', 'F5 ' ., 'F6 ', 'F7 ', 'F8 ', 'F9 ', 'F10 ' ., 'F11 ', 'F12 ', 'F13 ', 'F14 ', 'F15 ' ./ DATA (LABELS(2, I), I = 1, NKEY) / . 'RTAB ', 'LTAB ', 'NEXT ', 'DOWN ', 'UP ' ., 'FWD ', 'BKW ', 'HELP ', 'ERASE ', 'EDIT ' ., 'BACK ', 'LAB ', 'DATA ', 'STOP ', 'INSRT ' ./ DATA (LABELS(3, I), I = 1, NKEY) / . 'DLETE', 'CLEAR', 'PRINT', 'PAD 1 ', 'PAD 2 ' ., 'PAD 3', 'PAD 4', 'PAD 5', 'PAD 6 ', 'PAD 7 ' ., 'PAD 8', 'PAD 9', 'PAD 0', 'PAD , ', 'PAD . ' ./ 10 FORMAT(5X, 'KEY DEFINITION UTILITY.',// .3X,'KEY LABEL KEY DEFINITIONS'/ .3X,'--- ----- ---------------') 11 FORMAT(1X, A7, 1X, A7, 1X, A60) 12 FORMAT(' THE LIST OF DEFINED FUNCTION KEYS IS ON THE', .' LOCAL FILE *KEYPRNT*.') 13 FORMAT(/7X,'TERMINAL CHARACTERISTICS',/ .7X,'-------- ---------------',/ .9X,'NUMBER PAD - ',A7,/9X,'SCREEN MODE - ',A7/ .9X,'CHARS./ LINE - ',A7) * GET FILE AND OUTPUT USER DEFINED FUNCTION KEYS. CALL RDSORC REWIND 6 WRITE(6, 10) DO 110 I = 1, NPAN DO 100 J = 1, NKEY IF(I .EQ. 1) THEN IF(KEYS(J)(1:7) .NE. ' ') THEN WRITE(6,11) LABELS(I,J), KEYS(J)(1:7), . KEYS(J)(8:67) ENDIF ENDIF IF(I .EQ. 2) THEN IF(KEYS(J + 15)(1:7) .NE. ' ') THEN WRITE(6,11) LABELS(I,J), KEYS(J+15)(1:7), . KEYS(J+15)(8:67) ENDIF ENDIF IF(I .EQ. 3) THEN IF(KEYS(J + 30)(1:7) .NE. ' ') THEN WRITE(6, 11) LABELS(I, J), KEYS(J+30)(1:7), . KEYS(J+30)(8:67) ENDIF ENDIF 100 CONTINUE 110 CONTINUE * OUTPUT USER DEFINED TERMINAL SETUP CHARACTERISTICS. WRITE(6,13) SETDATA REWIND 6 WRITE(2,12) ENDFILE 2 RETURN END SUBROUTINE SEND ** SEND - TRANSFER KEY DEFINITIONS FROM SYSTEM INTO TERMINAL. * * *SEND* TRANSFERS THE KEY DEFINITIONS, KEY LABELS, AND Z80 * ROUTINES INTO THE TERMINAL. * * CALL SEND * * CALLS BYTE, PACK, ZSNDADD, ZSNDCHR, Z80CODE. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS BOOLEAN ZBASE * HEX CODE FOR KEY TABLE OFFSET BOOLEAN ZCARRET(1) * HEX CODE FOR CARRIAGE RETURN BOOLEAN ZDEFKEY(4) * HEX SEQUENCE TO DEFINE FUNCTION KEY BOOLEAN ZDISKEY(3) * HEX SEQUENCE TO DISABLE KEYBOARD ENTRY BOOLEAN ZDISRET(3) * HEX SEQUENCE TO DISABLE CARRIAGE RETURN BOOLEAN ZECHO * HEX CODE FOR ECHO BOOLEAN ZECHOFF * HEX CODE FOR ECHO OFF BOOLEAN ZECHON * HEX CODE FOR ECHO ON BOOLEAN ZENBIAS(2) * HEX SEQUENCE TO ENABLE BIAS BOOLEAN ZENRETN(2) * HEX SEQUENCE TO ENABLE CARRIAGE RETURN BOOLEAN ZENKEYB(3) * HEX SEQUENCE TO ENABLE KEYBOARD ENTRY BOOLEAN ZTRMKEY(2) * HEX SEQUENCE TO TERMINATE KEY DEFINITIONS CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*7 SETDATA(3) * SETUP DATA INTEGER ASCII * Z80 CHARACTER INTEGER LASTNB * LAST NON-BLANK CHARACTER COMMON / INFO / KEYS, FILENM, SETDATA DATA ADDR / Z"C002"/ DATA ADDL / Z"C000"/ DATA ZBASE / Z"30" / DATA ZCARRET / Z"0D" / DATA ZDEFKEY / Z"1E", Z"09", Z"30", Z"34" / DATA ZDISKEY / Z"1E", Z"12", Z"4D" / DATA ZDISRET / Z"1E", Z"12", Z"5A" / DATA ZECHON / Z"34" / DATA ZECHOFF / Z"31" / DATA ZENBIAS / Z"1E", Z"30" / DATA ZENRETN / Z"1E", Z"05" / DATA ZENKEYB / Z"1E", Z"12", Z"4E" / DATA ZFEED / Z"0A" / DATA ZTRMKEY / Z"2F", Z"6F"/ CALL PACK(1, 0) * LOCK THE KEYBOARD DURING WHILE SENDING DATA TO TERMINAL. CALL SEQPACK(ZDISKEY,3) * DISABLE *CR* ON FUNCTION KEYS AND ENABLE BIAS. CALL SEQPACK(ZDISRET,3) CALL SEQPACK(ZENBIAS,2) * PROCESS EACH FUNCTION KEY'S DEFINITION. IF LAST CHARACTER IN THE * DEFINITION FIELD IS AN * (ASTERISK), TURN ECHO ON. DO 260 I = 1, NKEYS IF((KEYS(I)(8:8).EQ. ';') .OR. (KEYS(I)(8:8).EQ. ' ')) GOTO 260 IF(KEYS(I)(67:67).EQ. '*') THEN ZECHO = ZECHON ELSE ZECHO = ZECHOFF ENDIF ZDEFKEY(3) = ZBASE + I ZDEFKEY(4) = ZECHO CALL SEQPACK(ZDEFKEY,4) CALL ZSNDADD(ADDR) * GET ACTUAL CHARACTERS FOR THE DEFINITION. LEN = 0 IF((KEYS(I)(8:8) .EQ. 'Z') .AND. (KEYS(I)(9:9) .EQ. '"')) THEN DO 210 J = 10, 67, 2 K = J + 1 IF(KEYS(I)(J:J) .EQ. '"') GOTO 220 IF(KEYS(I)(K:K) .EQ. '"') GOTO 220 IF(KEYS(I)(J:J) .LE. '9') C1=ICHAR(KEYS(I)(J:J))-Z"10" IF(KEYS(I)(J:J) .GE. 'A') C1=ICHAR(KEYS(I)(J:J))-Z"20"+09 IF(KEYS(I)(K:K) .LE. '9') C2=ICHAR(KEYS(I)(K:K))-Z"10" IF(KEYS(I)(K:K) .GE. 'A') C2=ICHAR(KEYS(I)(K:K))-Z"20"+09 ASCII = C1*16+C2 CALL ZSNDCHR(ASCII) 210 CONTINUE J = 68 220 J = K * PROCESSING CHARACTER DATA. ELSE * COUNT TRAILING BLANKS. DO 225 J = 66, 8, -1 IF(KEYS(I)(J:J) .NE. ' ') THEN LASTNB = J GOTO 227 ENDIF 225 CONTINUE 227 DO 230 J = 8, MIN(66, LASTNB) K = J + 1 IF(KEYS(I)(J:J) .EQ. '!'.AND.((KEYS(I)(K:K) .EQ. ' ') . .OR.(K .EQ. 67))) GOTO 240 IF(KEYS(I)(J:J) .EQ. ';') GOTO 250 IF(KEYS(I)(J:J) .EQ. '!') THEN CALL ZSNDCHR(ZCARRET) IF(KEYS(I)(67:67) .EQ. '*') THEN CALL ZSNDCHR(ZFEED) LEN = LEN + 1 ENDIF ELSE ASCII = ICHAR(KEYS(I)(J:J)) + Z"20" CALL ZSNDCHR(ASCII) ENDIF 230 CONTINUE J = 67 240 CALL ZSNDCHR(ZCARRET) J = J + 1 ENDIF 250 LEN = LEN + J - 8 CALL SEQPACK(ZTRMKEY,2) CALL SEQPACK(ZCARRET,1) ADDR = ADDR + LEN + 1 260 CONTINUE * SET UP AN ADDRESS IN THE 721 TO STORE THE KEY LABELS TO BE USED BY * THE *DISPLAY* OPTION. ZDEFKEY(3) = Z"74" ZDEFKEY(4) = Z"31" CALL SEQPACK(ZDEFKEY,4) CALL ZSNDADD(ADDR) * STORE THE F1 - F15 KEY LABELS IN THE TERMINAL. DO 280 I = 1, 15 DO 270 J = 1, 7 ASCII = ICHAR(KEYS(I)(J:J)) + Z"20" CALL ZSNDCHR(ASCII) 270 CONTINUE 280 CONTINUE * STORE THE 'LAB' LABEL AS F16 IN THE TERMINAL. DO 290 I = 1, 7 ASCII = ICHAR(KEYS(27)(I:I)) + Z"20" CALL ZSNDCHR(ASCII) 290 CONTINUE * TERMINATE KEY DEFINITIONS. CALL SEQPACK(ZTRMKEY,2) CALL SEQPACK(ZCARRET,1) ADDR = (ADDR + (7*16) + 1) - ADDL * SEND LENGTH OF CHARACTER LOAD TO BASE ADDRESS *ADDL*. ZDEFKEY(3) = Z"70" ZDEFKEY(4) = Z"32" CALL SEQPACK(ZDEFKEY,4) CALL ZSNDADD(ADDL) CALL ZSNDADD(ADDR) CALL SEQPACK(ZCARRET,1) * ENABLE KEYBOARD ENTRY. CALL Z80CODE CALL SEQPACK(ZENKEYB,3) CALL PACK(3, 1) RETURN END SUBROUTINE SEQPACK(SEQUENC,NBYTES) ** SEQPACK - PACKS THE GIVEN SEQUENCE INTO A BUFFER FOR OUTPUT. * * *SEQPACK* PACKS THE GIVEN SEQUENCE INTO THE OUTPUT BUFFER VIA * THE *PACK* ROUTINE. * * CALL SEQPACK(SEQUENC,NBYTES) * * ENTRY SEQUENC = ARRAY OF BOOLEAN HEX CODES. * NBYTES = LENGTH OF HEX CODE ARRAY. * * CALLS PACK. IMPLICIT INTEGER (A - Z) PARAMETER (MAXBYTS = 5) * MAXIMUM LENGTH OF *SEQUENC* BOOLEAN OFFSET * OFFSET FOR Z80 PROCESSING BOOLEAN SEQUENC(MAXBYTS) * ARRAY OF BOOLEAN HEX CODES INTEGER NBYTES * LENGTH OF HEX CODE ARRAY DATA OFFSET / Z"800" / DO 100 I = 1, NBYTES CALL PACK(2, OFFSET + SEQUENC(I)) 100 CONTINUE RETURN END SUBROUTINE SYSKEYS ** SYSKEYS - SET SYSTEM DEFAULTS FOR KEYS AND SETUP CHARACTERISTICS. * * *SYSKEYS* INITIALIZES *KEYS* AND TERMINAL SETUP CHARACTERISTICS * WITH THE SYSTEM DEFAULTS. * * CALL SYSKEYS * * USES KEYS, SETDATA. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS BOOLEAN KHELP * HEX CODE FOR HELP KEY BOOLEAN KEDIT * HEX CODE FOR EDIT KEY BOOLEAN KSTOP * HEX CODE FOR STOP KEY BOOLEAN ZBASE * HEX CODE FOR BASE OFFSET OF KEY TABLE CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*67 KEYS(NKEYS) * FUNCTION KEY DEFINITIONS CHARACTER*7 SETDATA(3) * TERMINAL SETUP DATA CHARACTER*7 STRDEF * DEFAULT STRING CHARACTER*7 STRHLP * HELP STRING CHARACTER*7 STRHL1 * HELP WITH CARRIAGE RETURN STRING CHARACTER*7 STREDT * EDIT STRING CHARACTER*7 STRFSE * FSE WITH CARRIAGE RETURN STRING CHARACTER*7 STRSTP * STOP STRING CHARACTER*7 STRCTT * CONTROL-T STOP STRING COMMON / INFO / KEYS, FILENM, SETDATA DATA KHELP / Z"47" / DATA KEDIT / Z"49" / DATA KSTOP / Z"4D" / DATA ZBASE / Z"30" / DATA STRDEF / 'DEFAULT' / DATA STRHLP / 'HELP ' / DATA STRHL1 / 'HELP! ' / DATA STREDT / 'EDIT ' / DATA STRFSE / 'FSE! ' / DATA STRSTP / 'STOP ' / DATA STRCTT / 'Z"140D"' / * INITIALIZE *KEYS*. DO 100 I = 1, NKEYS KEYS(I) = ' ' 100 CONTINUE * INITIALIZE *SETDATA*. SETDATA(1) = STRDEF SETDATA(2) = STRDEF SETDATA(3) = STRDEF * STORE LABEL AND KEY DEFINITION FOR EACH *KEYS(I)*. * EACH *KEYS(I)* = 7/LABEL, 60/DEFINITION. KEYS(KHELP - Z"30")(1:07) = STRHLP KEYS(KHELP - Z"30")(8:67) = STRHLP KEYS(KEDIT - Z"30")(1:07) = STREDT KEYS(KEDIT - Z"30")(8:67) = STRFSE KEYS(KSTOP - Z"30")(1:07) = STRSTP KEYS(KSTOP - Z"30")(8:67) = STRCTT RETURN END SUBROUTINE VERLOAD(LOADED) ** VERLOAD - VERIFY THAT TERMINAL HAS LOADED CONTROLWARE. * * *VERLOAD* INITIATES A LOADED CONTROLWARE SEQUENCE FOLLOWED BY A * MODEL REPORT REQUEST (WHICH IS ALWAYS PRESENT ON A 721 TERMINAL). * IF THE FIRST ITEM THAT COMES BACK IS THE MODEL REPORT REQUEST * DATA, THEN THERE WAS NO LOADED CONTROLWARE PRESENT. * * CALL VERLOAD(LOADED) * * EXIT *LOADED* IS SET IF LOADED CONTROLWARE IS PRESENT. * * CALLS PACK, SEQPACK. IMPLICIT INTEGER (A - Z) BOOLEAN OUT * OCTAL CODE TO INITIATE TRANSPARENT MODE BOOLEAN ZDISKEY(3) * HEX SEQUENCE TO DISABLE KEYBOARD ENTRY BOOLEAN ZENKEYB(3) * HEX SEQUENCE TO ENABLE KEYBOARD ENTRY BOOLEAN ZHOSTLC(3) * HEX SEQUENCE FOR HOST LOADED CONTROLWARE BOOLEAN ZMODREP(3) * HEX SEQUENCE FOR MODEL REPORT REQUEST CHARACTER*2 CTRLT * CONTROL-T TERMINATION SEQUENCE CHARACTER*5 MODREP * TERMINAL MODEL REPORT CHARACTER*7 VERSTR * VERIFICATION STRING IF TERMINAL LOADED INTEGER IOS * IOSTAT VALUE FROM FORMATTED READ CHARACTER*112 OPRAM4 * 721 HEX SEQUENCE CODES LOGICAL LOADED * CONTROLWARE LOADED FLAG DATA MODREP /'536.5'/ DATA VERSTR /'6A536.5'/ DATA CTRLT /'5T'/ DATA OUT /O"00060400001500000000"/ * OUT IS 1 WORD WITH THE DATA LEFT JUSTIFIED * 0006 = INITIATES TRANSPARENT INPUT MODE * 0400 = WORD LENGTH OF BLOCK TO TRANSMIT * 0015 = DELIMITER OF A *CR* DATA OPRAM4 / ' ' / DATA ZDISKEY / Z"1E", Z"12", Z"4D" / DATA ZENKEYB / Z"1E", Z"12", Z"4E" / DATA ZHOSTLC / Z"1E", Z"12", Z"75" / DATA ZMODREP / Z"1E", Z"43", Z"30" / 11 FORMAT(A112) * TURN OFF INPUT PROMPT AND INITIATE TRANSPARENT INPUT. CALL PROMPT CLOSE (2 ,STATUS = 'DELETE' ) OPEN (2, RECL=100, FILE='OUTPUT', FORM = 'UNFORMATTED') 12 WRITE (2) OUT CLOSE (2 ,STATUS = 'DELETE' ) OPEN (2, RECL=100, FILE='OUTPUT') * GET FUNCTION KEY LABELS FROM THE 721. * KEYBOARD MUST BE LOCKED WHILE 721 SENDS FUNCTION KEY DATA UPLINE. CALL PACK(1, 0) CALL SEQPACK(ZDISKEY,3) CALL SEQPACK(ZHOSTLC,3) CALL SEQPACK(ZMODREP,3) CALL PACK(3, 1) * CHECK IF THE MODEL REPORT COMES BACK FIRST. IF SO, KEYS HAVE NOT * BEEN DEFINED. THE VALUE OF THE MODEL REPORT WILL NOT BE AFFECTED BY * SYSTEM CHANGES. READ(5,11,IOSTAT=IOS,ERR=14,END=14)OPRAM4 * CHECK IF TYPED-AHEAD INPUT ENTERED. NOTE THAT THE PROCESS LOOPS * UNTIL ALL TYPED-AHEAD INPUT IS REMOVED, AND IS SATISFIED ONLY * WHEN A CORRECT SEQUENCE IS RECEIVED FROM THE TERMINAL. 13 IF (.NOT.((OPRAM4(3:7) .EQ. MODREP(1:5)).OR. . (OPRAM4(3:5) .EQ. CTRLT(1:2)).OR. . (OPRAM4(3:9) .EQ. VERSTR(1:7)))) THEN GOTO 12 ENDIF CALL PACK(1, 0) CALL SEQPACK(ZENKEYB,3) CALL PACK(3, 1) IF(OPRAM4(3:7) .EQ. MODREP(1:5)) THEN LOADED = .FALSE. ELSE LOADED = .TRUE. ENDIF RETURN 14 REWIND 5 GOTO 13 END SUBROUTINE WRSORC ** WRSORC - WRITE KEY DEFINITIONS TO THE SOURCE FILE. * * *WRSORC* WILL WRITE THE KEY DEFINITIONS TO THE * SOURCE FILE. * * CALL WRSORC * * CALLS PF. IMPLICIT INTEGER (A - Z) PARAMETER (NKEYS = 45) * NUMBER OF DEFINABLE FUNCTION KEYS PARAMETER (NSETUP = 3) * NUMBER OF TERMINAL SETUP CHARACTERISTICS CHARACTER*7 FILENM * KEY DEFINITIONS FILE CHARACTER*60 KEYDEF * FUNCTION KEY DEFINITION CHARACTER*67 KEYS(NKEYS) * LABEL AND KEYDEF CHARACTER*7 LABEL * FUNCTION KEY LABEL CHARACTER*7 SETDATA(3) * SETUP TERMINAL CHARACTERISTICS COMMON / INFO / KEYS, FILENM, SETDATA 10 FORMAT(A7, 1X, A60) 20 FORMAT(A7) REWIND 1 * WRITE FUNCTION KEY DEFINITIONS TO FILE. DO 210 I = 1, NKEYS WRITE(1, 10) KEYS(I)(1:7), KEYS(I)(8:67) 210 CONTINUE * WRITE TERMINAL SETUP CHARACTERISTICS TO FILE. DO 220 I = 1, NSETUP WRITE(1, 20) SETDATA(I) 220 CONTINUE REWIND 1 CALL PF('REPLACE', 'TAPE1', FILENM, 'NA', IGNORE) RETURN END SUBROUTINE ZSNDADD(ADDRESS) ** ZSNDADD - FORMAT AND PACK Z80 ADDRESS INTO BUFFER. * * *ZSNDSEQ* FORMATS THE GIVEN ADDRESS INTO MODIFIED HEX * FORMAT AND PACKS IT INTO THE BUFFER BEING SENT TO THE * TERMINAL. * * CALL ZSNDADD(ADDRESS) * * ENTRY ADDRESS - Z80 ADDRESS IN TERMINAL MEMORY. * * CALLS PACK. IMPLICIT INTEGER (A - Z) BOOLEAN ADDRESS * Z80 ADDRESS IN TERMINAL MEMORY CALL BYTE(SHIFT(AND(ADDRESS, Z"FF00"), -8), U1ADDR, L1ADDR) CALL BYTE(AND(ADDRESS, Z"00FF"), U2ADDR, L2ADDR) CALL PACK(2, U1ADDR) CALL PACK(2, L1ADDR) CALL PACK(2, U2ADDR) CALL PACK(2, L2ADDR) RETURN END SUBROUTINE ZSNDCHR(ZCHAR) ** ZSNDCHR - FORMAT AND PACK Z80 CHARACTER INTO BUFFER. * * *ZSNDCHR* FORMATS THE GIVEN Z80 CHARACTER INTO MODIFIED HEX * FORMAT AND PACKS IT INTO THE BUFFER BEING SENT TO THE * TERMINAL. * * CALL ZSNDCHR(ZCHAR) * * ENTRY ZCHAR - Z80 CHARACTER. * * CALLS PACK. IMPLICIT INTEGER (A - Z) INTEGER TEMP1 * Z80 UPPER BYTE INTEGER TEMP2 * Z80 LOWER BYTE INTEGER ZCHAR * Z80 CHARACTER CALL BYTE(ZCHAR, TEMP1, TEMP2) CALL PACK(2, TEMP1) CALL PACK(2, TEMP2) RETURN END SUBROUTINE ZSNDSEQ(ZARRAY,ZLENGTH) ** ZSNDSEQ - FORMAT AND PACK Z80 CODE SEQUENCE INTO BUFFER. * * *ZSNDSEQ* FORMATS THE Z80 CODE TO A MODIFIED HEX FORMAT * AND THEN PACKS THE SEQUENCE INTO THE BUFFER THAT IS TO * BE SENT TO THE TERMINAL. * * CALL ZSNDSEQ(ZARRAY,ZLENGTH) * * ENTRY ZARRAY - Z80 CODE ARRAY TO BE FORMATTED AND PACKED. * ZLENGTH - LENGTH OF THE ARRAY(SEQUENCE). * * CALLS ZSNDCHR. IMPLICIT INTEGER (A - Z) PARAMETER (MAXSEQ = 50) * MAXIMUM LENGTH OF SEQUENCE BOOLEAN ZARRAY(MAXSEQ) * Z80 CODE SEQUENCE INTEGER ZLENGTH * LENGTH OF THE Z80 CODE SEQUENCE DO 100 I = 1, ZLENGTH CALL ZSNDCHR(ZARRAY(I)) 100 CONTINUE RETURN END SUBROUTINE Z80CODE ** Z80CODE - LOAD Z80 CONTROLWARE INTO TERMINAL. * * *Z80CODE* STORES THE Z80 ROUTINES *PUSH*, *POP*, * *RESET*, AND *LABEL* INTO THE TERMINAL, AND THEN * DEFINES SEVERAL VIRTUAL KEYS WITH THE ADDRESSES OF * THE LOADED CONTROLWARE. LATER, WHEN THE KEY IS * INVOKED, THE TERMINAL KNOWS THAT IT CONTAINS THE * ADDRESS OF THE LOADED CONTROLWARE, AND BEGINS * EXECUTION OF THE LOADED Z80 ROUTINES. * * THE SOURCE FOR THE FOLLOWING HARDCODED ROUTINES IS * CONTAINED ON THE MAINTENANCE PL AS DECKNAME *KEYUTIL*. * * TO REPRODUCE THE Z80 BINARY CODES, RUN THE Z80 VARIANT * OF COMPASS AGAINST THE Z80 ROUTINES IN *KEYUTIL*, THEN * HAND TRANSLATE THE CODE INTO THE ROUTINES BELOW. * * CALL Z80CODE * * CALLS PACK, SEQPACK. * * NOTES THE SOURCE FOR THE Z80 BINARY IS PROVIDED HERE. THIS * SOURCE IS ASSEMBLED USING A Z80 ASSEMBLER, AND THE * BINARY CODES PRODUCED ARE THEN PLACED INTO THE *FORTRAN* * DATA STATEMENTS. IMPLICIT INTEGER (A - Z) PARAMETER (LZPUSH = 27) * LENGTH OF THE Z80 PUSH ROUTINE PARAMETER (LZPOP = 24) * LENGTH OF THE Z80 POP ROUTINE PARAMETER (LZRESET = 30) * LENGTH OF THE Z80 RESET ROUTINE PARAMETER (LZLABEL = 29) * LENGTH OF THE Z80 LABEL ROUTINE PARAMETER (LZVERFY = 6) * LENGTH OF THE Z80 VERIFY ROUTINE PARAMETER (LKEYC = 5) * DIMENSION FOR THE *KEYC* ARRAY BOOLEAN ZABSLOC * ABSOLUTE LOCATION OF Z80 ROUTINES BOOLEAN ZCARRET(1) * HEX CODE FOR CARRIAGE RETURN BOOLEAN ZCONSEQ(4) * HEX SEQUENCE FOR CONTROLWARE SEQUENCE BOOLEAN ZPUSH(LZPUSH) * HEX ARRAY FOR PUSH ROUTINE BOOLEAN ZPOP(LZPOP) * HEX ARRAY FOR POP ROUTINE BOOLEAN ZRESET(LZRESET) * HEX ARRAY FOR RESET ROUTINE BOOLEAN ZLABEL(LZLABEL) * HEX ARRAY FOR LABEL ROUTINE BOOLEAN ZVERFY(LZVERFY) * HEX ARRAY FOR VERIFY ROUTINE INTEGER KEYC(LKEYC, 2) * ARRAY FOR Z80 CODE DATA ZABSLOC / Z"D100" / DATA ZCARRET / Z"0D" / DATA ZCONSEQ / Z"1E", Z"09", Z"70", Z"32" / DATA ZPUSH / * Z80 ROUTINE TO PUSH FUNCTION KEY DEFINITION TABLE IN TERMINAL. . Z"11", Z"76", Z"D1", Z"01", Z"F0", Z"00", Z"21", Z"E0", Z"D7" ., Z"ED", Z"B0", Z"3A", Z"47", Z"E0", Z"32", Z"66", Z"D2", Z"3A" ., Z"B9", Z"E0", Z"32", Z"67", Z"D2", Z"CD", Z"33", Z"D1", Z"C9" ./ DATA ZPOP / * Z80 ROUTINE TO POP FUNCTION KEY DEFINITION TABLE IN TERMINAL. . Z"21", Z"76", Z"D1", Z"01", Z"F0", Z"00", Z"11", Z"E0", Z"D7" ., Z"ED", Z"B0", Z"3A", Z"66", Z"D2", Z"32", Z"47", Z"E0", Z"3A" ., Z"67", Z"D2", Z"32", Z"B9", Z"E0", Z"C9" ./ DATA ZRESET / * Z80 ROUTINE TO RESET FUNCTION KEY DEFINITION TABLE IN TERMINAL. . Z"3A", Z"47", Z"E0", Z"F6", Z"02", Z"32", Z"47", Z"E0", Z"3E" ., Z"00", Z"32", Z"B9", Z"E0", Z"01", Z"F3", Z"00", Z"0B", Z"0B" ., Z"0B", Z"78", Z"B1", Z"C8", Z"21", Z"DD", Z"D7", Z"09", Z"36" ., Z"30", Z"18", Z"F2" ./ DATA ZLABEL / * Z80 ROUTINE TO DISPLAY RESIDENT KEY LABELS. . Z"3A", Z"DD", Z"D8", Z"67", Z"3A", Z"DE", Z"D8", Z"6F", Z"46" ., Z"78", Z"FE", Z"FF", Z"CA", Z"68", Z"D1", Z"E5", Z"CD", Z"87" ., Z"00", Z"E1", Z"23", Z"18", Z"F1", Z"06", Z"0D", Z"CD", Z"87" ., Z"00", Z"C9" ./ DATA ZVERFY / * Z80 ROUTINE TO SEND VERIFICATION CHARACTER TO HOST. . Z"06", Z"41", Z"CD", Z"87", Z"00", Z"C9" / DATA (KEYC(I, 1), KEYC(I, 2), I = 1, LKEYC)/ * ADDRESS OF Z80 ROUTINE *PUSH* IS STORED IN KEY 70. . Z"70", Z"D100" * ADDRESS OF Z80 ROUTINE *POP* IS STORED IN KEY 71. ., Z"71", Z"D11B" * ADDRESS OF Z80 ROUTINE *RESET* IS STORED IN KEY 72. ., Z"72", Z"D133" * ADDRESS OF Z80 ROUTINE *LABEL* IS STORED IN KEY 73. ., Z"73", Z"D151" * ADDRESS OF Z80 ROUTINE *VERIFY* IS STORED IN KEY 75. ., Z"75", Z"D16E" ./ *NOTIFY THE TERMINAL OF FOLLOWING CONTROL SEQUENCE. CALL SEQPACK(ZCONSEQ,4) * STORE ADDRESS FOR THE Z80 PROGRAM. ADDR = ZABSLOC CALL ZSNDADD(ADDR) * STORE Z80 CONTROLWARE ROUTINES IN CONSECUTIVE MEMORY AT *ZABSLOC*. CALL ZSNDSEQ(ZPUSH, LZPUSH) CALL ZSNDSEQ(ZPOP, LZPOP) CALL ZSNDSEQ(ZRESET, LZRESET) CALL ZSNDSEQ(ZLABEL, LZLABEL) CALL ZSNDSEQ(ZVERFY, LZVERFY) CALL SEQPACK(ZCARRET,1) * STORE ADDRESSES OF Z80 ROUTINES AT VIRTUAL 7X KEY DEFINITIONS. DO 110 I = 1, LKEYC ADDR = KEYC(I, 2) ZCONSEQ(3) = KEYC(I, 1) CALL SEQPACK(ZCONSEQ,4) CALL ZSNDADD(ADDR) CALL SEQPACK(ZCARRET,1) 110 CONTINUE RETURN END IDENT PLT ENTRY PLT ENTRY PROMPT ENTRY ERR ENTRY RFL= SPACE 4,10 * COMMON DECKS. *CALL COMCMAC PLT SPACE 4,30 ** PLT - PANEL LOADER TABLE. * * *PLT* FORCES THE CYBER LOADER TO INCLUDE THE SMF PANELS * AS STATICALLY LOADED PANELS, AND ARE THEREFORE STATISFIED * BY THE LOADER AT LOAD TIME. * * NOTE THE FIRST TWO STATEMENTS INDICATE THE NUMBER OF * PANELS. PLT VFD 60/8 VFD 60/8 VFD 60/7LKEYPAN1 VFD 1/1,41/0,18/=XKEYPAN1 VFD 60/7LKEYPAN2 VFD 1/1,41/0,18/=XKEYPAN2 VFD 60/7LKEYPAN3 VFD 1/1,41/0,18/=XKEYPAN3 VFD 60/7LKEYPAN4 VFD 1/1,41/0,18/=XKEYPAN4 VFD 60/7LKEYPAN5 VFD 1/1,41/0,18/=XKEYPAN5 VFD 60/7LKEYPAN6 VFD 1/1,41/0,18/=XKEYPAN6 VFD 60/7LKEYPAN7 VFD 1/1,41/0,18/=XKEYPAN7 VFD 60/7LKEYPAN8 VFD 1/1,41/0,18/=XKEYPAN8 PROMPT SPACE 4,15 ** PROMPT - TURN FORTRAN PROMPTS OFF. * * *PROMPT* TURNS OFF THE FORTRAN PROMPTS IN *CHECK* AND * *DISPLAY* ROUTINES. * * CALLS PROMPT. PROMPT SUBR PROMPT OFF EQ PROMPTX RETURN ERR SPACE 4,30 ** ERR - ERROR PROCESSING. * * *ERR* RESETS THE *R1* REGISTER WHICH IS USED AS AN ERROR FLAG * IN THE *CCL* PROCEDURE. * * ENTRY THE USER IS IN LINE MODE OR DOES NOT HAVE A *721* TYPE * TERMINAL. * * EXIT R1 = 1 * * USES X - 1, 6 * A - 1, 6 * * CALLS GETJCR, SETJCR. ERR SUBR GETJCR REGS SA1 REGS SX6 X1+1 SA6 REGS SETJCR REGS EQ ERRX RETURN REGS CON 0 * BLANK COMMON BLOCK IS USED TO CREATE AN RFL= ENTRY POINT. USE // RFL= BSS 0 END