Retro1.org codex

      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