home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
decpro300
/
promnu.mac
< prev
next >
Wrap
Text File
|
1988-08-15
|
101KB
|
3,899 lines
.TITLE KERMNU - Kermit menu routines
.SBTTL S Hecht/D Stevens/R McQueen 14-July-1983
;++
; This module contains the command parser for the menu driven
; commands. It is assumed that this version of KERMIT is installed in
; a menu and run from there.
;--
; Version number
.IDENT /1.0.20/ ; For the loader
; Directives
.ENABL LC ; Enable lower case characters
.NLIST BEX ; Don't list binary expansions
.LIBRARY /KERMLB/ ; Kermit library
.SBTTL Revision History
;++
;
; 1.0.00 By: Robert C. McQueen On: 27-Dec-1983
; Create this module
;
; 1.0.01 By: Robert C. McQueen On: 15-Feb-1984
; Move a few routines to this module from KERMIT.
;
; 1.0.02 By: Robert C. McQueen On: 17-Feb-1984
; Add a new routine to handle the fatal errors from the
; menu processing. This routine will give a better
; error message.
;
; 1.0.03 By: Stuart Hecht On: 24-Feb-1984
; Add code to make help available from the baud rate menus.
;
; 1.0.04 By: Stuart Hecht On: 24-Feb-1984
; Adjust length values since KERMLB was changed to not include
; the null byte.
;
; 1.0.05 By: Robert C. McQueen On: 29-Feb-1984
; Reduce the KERMSG module size by adding the capability
; of not calling an action routine, but making the "routine"
; an address to store the value in. This runs off of FT.STORE
; in the frame block.
;
; 1.0.06 By: Robert C. McQueen On: 29-Feb-1984
; Add validity checks for the values that are set.
;
; 1.0.07 By: Robert C. McQueen On: 5-March-1984
; No need to attach to the terminal, so don't do it.
;
; 1.0.08 By: Robert C. McQueen On: 5-March-1984
; Support P/OS services.
;
; 1.0.09 By: Robert C. McQueen On: 8-March-1984
; Disallow setting parameters when KERFIL is active.
;
; 1.0.10 By: Robert C. McQueen On: 14-March-1984
; Redo inter-task communications. Allow the user to abort
; KERFIL if it is running.
;
; 1.0.11 By: Robert C. McQueen On: 15-March-1984
; Initial work for the remote commands.
;
; 1.0.12 By: Robert C. McQueen On: 19-March-1984
; Add addition remote command support.
;
; 1.0.13 By: Robert C. McQueen On: 20-March-1984
; Change WAIT to be SNDPKT to avoid a global symbol conflict.
;
; 1.0.14 By: David Stevens On: 21-March-1984
; Change Blscal to INPUT to pass along the length of the
; input prompt. Also allow R$DISK to accept a null input.
;
; 1.0.15 By: Robert C. McQueen On: 23-March-1984
; Add additional remote Kermit commands.
;
; 1.0.16 By: Robert C. McQueen On: 26-March-1984
; Add support for the ADDTNL OPTIONS key in menus.
; Use it for chaining the remote commands off of the main menu.
; Remove the REMOTE, LOGOUT and FINISH entries in the main menu.
;
; 1.0.17 By: Robert C. McQueen On: 27-March-1984
; Append the positioning string to the prompts in KERMIT,
; don't hardwire them in here.
;
; 1.0.18 By: Robert C. McQueen On: 28-March-1984
; Fix some minor problems with the main menu not handling
; MAIN SCREEN and EXIT returns correctly.
;
; 1.0.19 By: Robert C. McQueen On: 6-April-1984
; Fix problem with GETINP from the addtion of the SETESC
; routine.
;
; 1.0.20 By: Robert C. McQueen On: 16-April-1984
; KERCON (terminal emulation) is now a seperate task. Handle it
; that way.
;--
.SBTTL Macro library calls
;++
; The following are the various macros that are found in the KERMLB
; macro library. This will cause the macros to be processed in this
; module.
;--
.MCALL BLSCAL ; Macro to call BLISS routines
.MCALL BLSRTN ; Macro to define BLISS callable rtns
.MCALL CHRDEF ; Character name definitions
.MCALL KERDEF ; Kermit symbol definitions
.MCALL BLOCK ; Define data structures macro
.MCALL SETBLK ; Macro to store into the block
.MCALL BITS ; Bit definitions
.MCALL TABLE ; Table building macro for text
.MCALL MSG ; For ASCII text definition
.MCALL PJMP ; Jump to a routine that "popjs"
; Now expand the calls required for the symbol definitions
CHRDEF ; Character definitions
KERDEF ; Kermit symbol definitions
BITS ; Define the bit definitions
;++
; The following are for system directives
;--
.MCALL STSE$S ; Stop and wait for a single event
.MCALL SPWN$S ; Spawn a task
.MCALL DIR$ ; Issue a system directive
.SBTTL Key values
;++
; The following are the various key values that can be returned
; by the MENU processing.
;--
ST.KEY== -14. ; Other than DO key pressed
; KY.RSV= 1. ; Reserved
; KY.RSV= 2. ; Reserved
KY.BRK= 3. ; Break key
KY.STP= 4. ; SETUP key
KY.F5= 5. ; F5 key
; KY.RSV= 6. ; Reserved
KY.RSM= 7. ; RESUME key
KY.CAN= 8. ; CANCEL key
KY.MAI== 9. ; MAIN SCREEN key
KY.EXI== 10. ; EXIT key
KY.F11= 11. ; F11 key
KY.F12= 12. ; F12 key
KY.F13= 13. ; F13 key
KY.AOP= 14. ; Additional options
KY.HLP= 15. ; HELP key
KY.DO= 16. ; DO key
KY.F17= 17. ; F17 key
KY.F18= 18. ; F18 key
KY.F19= 19. ; F19 key
KY.F20= 20. ; F20 key
.SBTTL Macro definitions -- KEYS and KEY macros
;++
; The following defines the KEYS and KEY macros. These are used to
; build the function key dispatch tables. These tables are used to
; call DOMENU.
;--
.MACRO KEYS LABEL,MCRNAM
;;
;; First define the label for the keyword table.
;;
K$'LABEL:
;;
;; The format of the table is that the first word contains the length
;; of the table and the following words contain the information.
;;
.WORD LABEL'$L
;;
;; The following macro will define the key values that are acceptable for
;; this frame.
;;
.MACRO KEY KEYVAL,RTN
.WORD KEYVAL
.ENDM
MCRNAM
LABEL'$L=<<.-K$'LABEL>/2>-1
;;
;; Now expand the macro so that we will have the routines that get called
;; directly after the values.
;;
.MACRO KEY KEYVAL,RTN
.WORD RTN
.ENDM
MCRNAM
.ENDM ; End of KEYS macro definition
.SBTTL Frame block definition
;++
; The following is the offset definitions for the frame blocks. The frame
; blocks are generated by the FRAMES/FRAME and DOFRAM macros. These macros
; can be found on the next page.
;--
BLOCK FR ; Frame block
.X ID ; Frame id block
.XX ILN ; Frame id length
.XX TYP ; Frame type
FT.STATIC=B0 ; Static menu
FT.DYNAMIC=B1 ; Dynamic menu
FT.STORE=B2 ; Store directly instead of calling SET routine
FT.ADDO=B3 ; Additional options allowed
.X MNU ; Address of menu dispatch processing block
.X MLN ; Length of the menu dispatch table
.X LEN,0 ; Length of a frame block
.SBTTL Macro definitions -- FRAMES - Various FRAMES and attributes
;++
; The following macro will define the names of the various possible frames that
; can be found in PRO/Kermit. These are used to call the various routines
; to display the information on the screen.
;
; Usage:
; .macro FRAMES
; FRAME 4-Char-name,Frame-id,Type,Menu-dispatch-table
; .endm
;
;--
.MACRO FRAMES
FRAME MAIN,MAIN,FT.STATIC!FT.ADDO,MAINMN
FRAME REMT,REMOTE,FT.STATIC!FT.ADDO,REMMNU
FRAME REM2,REMOTE2,FT.STATIC!FT.ADDO,RM2MNU
FRAME ACTV,ACTIVE,FT.STATIC,ACTMNU
FRAME POS,POS,FT.STATIC,POSMNU
FRAME SET,SET,FT.STATIC,SETMNU
FRAME LINE,LINE,FT.STATIC,LINMNU
FRAME PAR,PARITY,FT.STATIC,PARMNU
FRAME SEND,SEND,FT.DYNAMIC!FT.STORE,SNDMNU
FRAME RECV,RECEIVE,FT.DYNAMIC!FT.STORE,RCVMNU
FRAME FILE,FILE,FT.DYNAMIC!FT.STORE,FILMNU
FRAME FSPC,FILESPEC,FT.STATIC,FSPMNU
FRAME FMOD,FILEMODE,FT.STATIC,FMDMNU
FRAME FDSP,FILEDISP,FT.STATIC,FDSMNU
FRAME LCHR,LINECHAR,FT.DYNAMIC,LCHMNU
FRAME MODM,MODEM,FT.STATIC,MDMMNU
FRAME TCHR,TERMCHAR,FT.DYNAMIC!FT.STORE,TCHMNU
FRAME GEN,GENERAL,FT.DYNAMIC!FT.STORE,GENMNU
FRAME BCHK,BLOCKCHK,FT.STATUS,BLKMNU
;FRAME DATA,DATABITS,FT.STATIC
.ENDM
.MACRO DOFRAM
;;
;; First expand the frame names
;;
.MACRO FRAME NAME,FRAMEID,TYPE,DSPTBL ;; Define the FRAME macro
MSG NAME,<FRAMEID> ;; to expand the FRAMEID as
.ENDM ;; text
FRAMES ;; Generate the text
;;
;; Now expand the frame information blocks
;;
.MACRO FRAME NAME,FRAMID,TYPE,DSPTBL ;; Define the FRAME macro
F$'NAME: ;; to build the frame info blks
.WORD M$'NAME ;; Generate the addr of the id
.BYTE NAME'$L ;;[04] Generate the length
.BYTE TYPE ;; Generate the menu type
.IF B <DSPTBL>
.WORD 0,0 ;; Zero denotes no table
.IFF
.WORD NAME'$M ;; Point to the action table
.WORD NAME'$C ;; Count of the number of items
.ENDC
.ENDM
FRAMES ;; Generate the frame blocks
;;
;; Now generate the menu action tables if they are needed.
;;
.MACRO FRAME NAME,FRAMID,TYPE,DSPTBL ;; Define the FRAME macro
.IF NB <DSPTBL>
BLDMNU NAME,DSPTBL
.ENDC
.ENDM
FRAMES ;; Generate menu blocks
.ENDM ; End of DOFRAM macro definition
.SBTTL Macro definitions -- BLDMNU - Build menu dispatches
;++
; This macro will build the dispatch tables for the menu processing.
;
; This macro will expand the various other macros
;
; Usage:
; BLDMNU XXXX,Macro.name
;
; Each entry in the 'Macro.name' has the following format:
;
; MN <2-chars>,Action.routine,Input.routine,Dynamic.menu.routine
;
;--
.MACRO BLDMNU NAME,MCRNAM
;;++
;; First build the offset table
;;--
.MACRO MN CHARS,ACTRTN,INPRTN,DYNRTN
.ASCII ^CHARS^ ;; Characters to find routine
.ENDM
NAME'$M: ;; Define the dispatch table
MCRNAM ;; Expand the macro
NAME'$C==<.-NAME'$M> ;; Define the length
;;++
;; Now build the set routines
;;--
.MACRO MN CHARS,ACTRTN,INPRTN,DYNRTN
.IF B <ACTRTN>
.WORD 0 ;; If no routine, gen a zero
.IFF
.WORD ACTRTN ;; Generate the routine address
.ENDC
.ENDM
MCRNAM ;; Define the set routines
;;++
;; Now build the input routines
;;--
.MACRO MN CHARS,ACTRTN,INPRTN,DYNRTN
.IF B <INPRTN>
.WORD 0 ;; If no routine, gen a zero
.IFF
.WORD INPRTN ;; Generate the routine address
.ENDC
.ENDM
MCRNAM ;; Define the input routine
;;++
;; Now build the dynamic set routines
;;--
.MACRO MN CHARS,ACTRTN,INPRTN,DYNRTN
.IF B <DYNRTN>
.WORD 0 ;; If no routine, gen a zero
.IFF
.WORD DYNRTN ;; Generate the routine address
.ENDC
.ENDM ;; End MN macro definition
MCRNAM ;; Define the dynamic routines
.ENDM
.SBTTL Macro definitions -- MAINMN - Main menu
;++
; The following macro definition defines the MAIN MENU definitions and
; command names.
;--
.MACRO MAINMN
MN BE,C$BYE,, ;; BYE command
MN ST,C$SET,, ;; SET command
MN SS,STATE,, ;; STATUS command
MN GE,C$GET,, ;; GET file from remote command
MN SD,C$SEND,, ;; SEND command
MN RE,C$RECV,, ;; RECEIVE command
MN CT,C$CONN,, ;; CONNECT command
MN SR,C$SERV,, ;; Enter SERVER mode command
MN PS,C$POS,, ;; P/OS services
.ENDM
.SBTTL Macro definitions -- ACTMNU - KERFIL Active menu
;++
; This menu will be displayed anytime the user attempts to do a
; function and KERFIL is currently running.
;--
.MACRO ACTMNU
MN AB,CHKABT,, ;; Abort KERFIL
MN RS,CHKRES,, ;; Resume KERFIL status type out
.ENDM
.SBTTL Macro definitions -- REMMNU - Remote Kermit commands
;++
; This frame definition defines the remote Kermit commands.
;--
.MACRO REMMNU
MN TY,R$TYPE,, ;; Remote Type
MN DR,R$DIR,, ;; Remote Directory
MN DS,R$DISK,, ;; Remote Disk Usage
MN DL,R$DEL,, ;; Remote Delete
MN CH,R$CWD,, ;; Remote Change Working Directory
MN ST,R$STAT,, ;; Remote Status
MN HL,R$HELP,, ;; Remote Help
MN LG,C$LOGO,, ;; Remote LOGOUT
MN FN,C$FINI,, ;; Remote FINISH
MN HS,R$HOST,, ;; Remote HOST command
.ENDM
.SBTTL Macro definitions -- RM2MNU - Second remote menu
;++
; This menu describes the actions that can take place under the second
; remote commands menu.
;--
.MACRO RM2MNU
MN WH,R$WHO,, ;; Remote FINGER
MN CO,R$COPY,, ;; Remote COPY
MN RN,R$RENM,, ;; Remote RENAME
.ENDM
.SBTTL Macro definitions -- POSMNU - P/OS menu
;++
; This macro will define the various P/OS utilities that can be called
; from Kermit.
;--
.MACRO POSMNU
MN FI,P$FILE,, ;; File services
MN DI,P$DISK,, ;; Disk services
MN VW,P$VIEW,, ;; View messages/status
MN PR,P$PRIN,, ;; Print services
MN SE,P$STUP,, ;; P/OS setup
.ENDM
.SBTTL Macro definitions -- SETMNU - Set menu
;++
; This macro will define the various set parameters dispatches.
; This menu just dispatches to other menus or resets parameters.
;--
.MACRO SETMNU
MN FI,SETFIL,, ;; Set file parameters
MN GN,SETGEN,, ;; Set general parameters
MN SN,SETSND,, ;; Set send parameters
MN RC,SETRCV,, ;; Set receive parameters
MN LN,SETLIN,, ;; Set line parameters
MN TE,SETTRM,, ;; Set terminal emulation
.ENDM
.SBTTL Macro definitions -- File menu
;++
; This will define the file parameters menu that is a sub-menu of
; the SET menu.
;--
.MACRO FILMNU
MN TY,FILFLG,INPFTY,DYNFTY ;; File type
MN SP,FIL.NORMAL.FORM,INPFSP,DYNFSP ;; File specification
MN DS,ABT.FLAG,INPFDS,DYNFDS ;; File disposition
.ENDM
.SBTTL Macro definitions -- File mode
;++
; This menu will set the mode that the file is written in.
;--
.MACRO FMDMNU
MN AS,RTFASC,, ;; ASCII file type
MN BI,RTFBIN,, ;; BINARY file type
MN BK,RTFBLK,, ;; BLOCK file type
MN FD,RTFFIX,, ;; FIXED file type
.ENDM
.SBTTL Macro definitions -- File specification
;++
; This menu will specify the type of file specification processing that
; is to be done.
;--
.MACRO FSPMNU
MN NM,RTFNRM,, ;; Normal form
MN FL,RTFULL,, ;; Full file specification
MN UN,RTFUNT,, ;; Untranslated
.ENDM
.SBTTL Macro definitions -- File disposition
;++
; This menu will specify the disposition of the file on an incomplete
; transfer.
;--
.MACRO FDSMNU
MN KP,RTFKEP,, ;; Keep
MN DL,RTFDEL,, ;; Delete
.ENDM
.SBTTL Macro definitions -- Set line characteristics
;++
; This macro will determine if we are setting the current, default
; or resetting the line parameters.
;--
.MACRO LINMNU
MN DF,SETLDF,, ;; Set the line defaults
MN CR,SETLCR,, ;; Set the line current parameters
MN RS,SETLRS,, ;; Reset the current parameters to defaults
.ENDM
.SBTTL Macro definitions -- SNDMNU - Send parameter menu
;++
; This menu is for the dynamic menu for the SEND processing. It will
; use all of the possible routines for the menu processing.
;--
.MACRO SNDMNU
MN EL,SND.EOL,INPEOL,DYSEOL ;; End of line character
MN PL,SND.PKT.SIZE,INPPKL,DYSPKL ;; Packet length
MN PC,SND.PADCHAR,INPPDC,DYSPDC ;; Pad character
MN NP,SND.NPAD,INPNPD,DYSNPD ;; Number of padding characters
MN TT,SND.TIMEOUT,INPTIM,DYSTIM ;; Timeout
MN SP,SND.SOH,INPSOP,DYSSOP ;; Start of packet processing
MN QU,SND.QUOTE,INPQUO,DYSQUO ;; Quote character
.ENDM
.SBTTL Macro definitions -- RCVMNU - Receive parameter menu
;++
; This menu is for the dynamic menu for the receive processing. It will
; use all of the possible routines for the menu processing.
;--
.MACRO RCVMNU
MN EL,RCV.EOL,INPEOL,DYREOL ;; End of line character
MN PL,RCV.PKT.SIZE,INPPKL,DYRPKL ;; Packet length
MN PC,RCV.PADCHAR,INPPDC,DYRPDC ;; Pad character
MN NP,RCV.NPAD,INPNPD,DYSNPD ;; Number of padding characters
MN TT,RCV.TIMEOUT,INPTIM,DYRTIM ;; Timeout
MN SP,RCV.SOH,INPSOP,DYRSOP ;; Start of packet processing
MN QU,RCV.QUOTE,INPQUO,DYRQUO ;; Quote character
.ENDM
.SBTTL Macro definitions -- PARMNU - Parity settings
;++
; The following is the dispatch menu for the PARITY values.
;--
.MACRO PARMNU
MN NO,RTNOPR,, ;; Return no parity
MN EV,RTEVPR,, ;; Return even parity
MN OD,RTODPR,, ;; Return odd parity
MN MK,RTMKPR,, ;; Return mark parity
MN SP,RTSPPR,, ;; Return space parity
.ENDM
.SBTTL Macro definitions -- LCHMNU - Line characteristics
;++
;
; The following macros contains the following items
;
; Macro XX,Set.routine,Input.routine,Dynamic routine
;
;--
.MACRO LCHMNU
MN RS,SETRSP,INPSPD,DYNRSP ;; Receive speed
MN XS,SETXSP,INPSPD,DYNXSP ;; Transmit speed
MN PR,SETPAR,INPPAR,DYNPAR ;; Parity routines
; MN DA,SETSDB,INPDAB,DYNDAB
; MN SP,SETSTB,INPSTB,DYNSTB
; MN PY,SETPRT,INPPRT,DYNPRT
MN FC,SETFC ,INPFC ,DYNFC ;; Flow control (XON/XOFF)
; MN 7T,SET7BC,INP7BC,DYN7BC
MN MM,SETMDM,INPMDM,DYNMDM ;; Modem control
; MN RG,SETRNG,INPRNG,DYNRNG
.ENDM
.SBTTL Modem types menu
;++
; This menu is for the setting of the various modem types that can be found
; in PRO/Kermit.
;--
.MACRO MDMMNU
MN NO,RTNOMD,, ;; No modem
MN FS,RTUSFS,, ;; USFSK 103J
MN 21,RTCC21,, ;; CCITTV.21 0..300
MN M1,RTCCM1,, ;; CCITTV.23 Mode 1
MN M2,RTCCM2,, ;; CCITTV.23 Mode 2
MN PS,RTDPSK,, ;; DPSK Bell 212
.ENDM
.SBTTL Frames -- Terminal characteristics
;++
; The following macro will define the various terminal emulation
; characteristics that can be set by the user.
;--
.MACRO TCHMNU
MN LE,LCLECH,INPLCE,DYNLCE ;; Local echo
; MN DP,DUPLEX,INPDPX,DYNDPX ;; Duplex routine
MN IC,IBM.CHAR,INPICH,DYNICH ;; IBM turn around character
MN EC,ESCCHR,INPECH,DYNECH ;; Escape character
MN IB,IBM.FLAG,INPIMD,DYNIMD ;; IBM mode (Same as duplex?)
MN TR,TRMTRN,INPTRN,DYNTRN ;; Transparent terminal emulation
MN 7B,TRM7BT,INP7BT,DYN7BT ;; 7-bit character codes
.ENDM
.SBTTL General parameter menu
;++
; This menu is used to set the various general parameters that can
; be found in Kermit. These range from the 8th-bit quoting to the
; debugging type out.
;--
.MACRO GENMNU
MN 8Q,RCV.8QUOTE.CHAR,INP8QU,DYN8QU ;; 8th bit quoting
MN BL,CHKTYPE,INPBLK,DYNBLK ;; Block check processing
MN RQ,SET.REPT.CHAR,INPRPT,DYNRPT ;; Repeat quote character
MN DB,DEBUG.FLAG,INPDEB,DYNDEB ;; Debugging
MN RI,SI.RETRIES,INPSIR,DYNSIR ;; SI retries
MN RP,PKT.RETRIES,INPPKR,DYNPKR ;; Packet retries
.ENDM
.MACRO BLKMNU
MN 1C,RTBK1C,, ;; One character checksum
MN 2C,RTBK2C,, ;; Two character checksum
MN 3C,RTBK3C,, ;; Three character checksum
.ENDM
.SBTTL Frame and menu macro expansion
;++
; The following defines all of the frame and menus from the macros
; on the previous pages.
;--
.PSECT $PLIT$, RO, D
DOFRAM ; Generate the world
.SBTTL File specifications and help frame-ids
;++
; The following are the file specifications for the various menu
; and help files.
;--
.PSECT $PLIT$, RO, D
MSG MNUF,<LB:[ZZKERMIT]KERMIT.MNU>
MSG HLPF,<LB:[ZZKERMIT]KERMIT.HLP>
MSG HFRM,<MAIN>
; The following are the lengths of the above information
L$MNUF: .WORD MNUF$L ;[04] Length of the menu file specification
L$HLPF: .WORD HLPF$L ;[04] Length of the help file specification
L$HFRM: .WORD HFRM$L ;[04] Length of the default help frame
.SBTTL Argument blocks -- MFILE
;++
; The following is the argument block for the MFILE routine call. This
; is used to open the menu file.
;--
A$MFIL: .BYTE MFIL$L,0 ; Length of the argument block
.WORD STATUS ; Status returned by the routine
.WORD M$MNUF ; Menu file specification
.WORD L$MNUF ; Length of the menu file specification
MFIL$L==<<.-A$MFIL>/2>-1
MSG MOER,<MFILE open failure>
.SBTTL Argument blocks -- HFILE
;++
; The following is the argument block for the HFILE routine call. This
; routine will cause the help file to be opened.
;--
.PSECT $PLIT$, RO, D
A$HFIL: .BYTE HFIL$L,0 ; Length of the argument block
.WORD STATUS ; Status returned by the routine
.WORD M$HLPF ; Help file specification
.WORD L$HLPF ; Length of the file specification
.WORD M$HFRM ; Default help file frame
.WORD L$HFRM ; Length of the default frame
HFIL$L=<<.-A$HFIL>/2>-1
MSG HOER,<HFILE open failure>
.SBTTL Argument blocks -- MFRAME - Get a frame
;++
; This argument block is used to cause a frame to be read into
; the static menu buffer.
;--
.PSECT $PLIT$, RO, D
A$MFRA: .BYTE MFRA$L,0 ; Length of the frame
.WORD STATUS ; Status returned by the call
.WORD MFRMID ; MFRAME - Frame id
.WORD MFRMLN ; MFRAME - Frame length
MFRA$L=<<.-A$MFRA>/2>-1
MSG FRER,<MFRAME failure>
.SBTTL Argument blocks -- MUNPK and DPACK information
;++
; The following are the various names that are used for the text items
; in the menu processing routines.
;--
.PSECT $PLIT$, RO, D
MSG CLRB,CLRB
MSG TITL,TITL
MSG TXT1,TEXT01
MSG TXT2,TEXT02
MSG TXT3,TEXT03
MSG GHLP,GHLP
MSG PRMT,PRMT
L$CLRB: .WORD CLRB$L ;[04] DPACK clear the buffer flag
L$TITL: .WORD TITL$L ;[04] Length of the text
L$TXT1: .WORD TXT1$L ;[04] Length of the text
L$TXT2: .WORD TXT2$L ;[04] Length of the text
L$TXT3: .WORD TXT3$L ;[04] Length of the text
L$GHLP: .WORD GHLP$L ;[04] Length of the global help text
L$PRMT: .WORD PRMT$L ;[04] Length of the prompt text
.MACRO ARGS
UP TITL
UP PRMT
UP TXT1
UP TXT2
UP TXT3
UP GHLP
.ENDM
.MACRO UP NAME
.WORD M$'NAME
.ENDM
UNPARG: ARGS
UNPAGL=.-UNPARG
.MACRO UP NAME
.WORD L$'NAME
.ENDM
ARGS
.SBTTL Argument blocks -- MUNPK and DPACK (options)
;++
; The following are the argument blocks for unpacking and packing of
; the options that are listed on the screen.
;--
L$KEYW: .WORD 6 ; Length of keyword code
L$OPTN: .WORD 6 ; Length of option code
L$ACTN: .WORD 6 ; Length of action code
L$OHLP: .WORD 6 ; Length of the option help code
L$BUF1: .WORD 120 ; Length of the buffer
L$BUF3: .WORD 120
; Table of the nn characters that are appended to things link OHLPnn
NUMTAB: .ASCII '01'
.ASCII '02'
.ASCII '03'
.ASCII '04'
.ASCII '05'
.ASCII '06'
.ASCII '07'
.ASCII '08'
.ASCII '09'
.ASCII '10'
.ASCII '11'
.ASCII '12'
A$UNPO: .BYTE UNPO$L,0 ; Table for unpacking options and
.WORD STATUS ; related information from static buf
.WORD M$OPTN ; Unpack option
.WORD L$OPTN
.WORD BUFF1
.WORD L$BUF1
.WORD BUFF1L
.WORD M$ACTN ; Unpack action
.WORD L$ACTN
.WORD MUNPBF ; Unpacking buffer
.WORD MUNPBL ; Unpacking buffer length
.WORD MUNPRL ; Unpacking return length
.WORD M$OHLP ; Unpack option help
.WORD L$OHLP
.WORD BUFF3
.WORD L$BUF3
.WORD BUFF3L
.WORD M$KEYW ; Unpack keyword
.WORD L$KEYW
.WORD OFKEYW
.WORD KEYWLN
UNPO$L=<<.-A$UNPO>/2>-1 ; Length of unpacking table - 1
A$PACO: .BYTE PACO$L,0 ; Table for packing options and related
.WORD STATUS ; information into dynamic buffer
.WORD M$OPTN ; Pack option
.WORD L$OPTN
.WORD BUFF1
.WORD BUFF1L
.WORD M$ACTN ; Pack action
.WORD L$ACTN
.WORD MUNPBF ; Unpacking buffer
.WORD MUNPRL ; Unpacking buffer length
.WORD M$OHLP ; Pack option help
.WORD L$OHLP
.WORD BUFF3
.WORD BUFF3L
.WORD M$KEYW ; Pack keyword
.WORD L$KEYW
.WORD OFKEYW
.WORD KEYWLN
PACO$L=<<.-A$PACO>/2>-1 ; Length of packing table - 1
.SBTTL Argument blocks -- FATLER args
;++
; The following are the argument blocks for calling FATLER from DPACK and
; MUNPK failures.
;--
A$FATL: .BYTE FATL$L,0 ; Lenth of the argument block
.WORD IOBUFF ; Message to output
.WORD IOBLEN ; Length of the message to output
FATL$L=<<.-A$FATL>/2>-1
MSG UPER,<MUNPK failure>
MSG PKER,<DPACK failure>
.SBTTL Argument blocks -- MENU argument block
;++
; The following is the argument block for calling the static menu processing
; routine.
;--
.PSECT $PLIT$, RO, D
A$DMEN:
A$MENU: .BYTE MENU$L,0 ; Length of the argument block
.WORD STATUS ; Status returned by the routine
.WORD ACTION ; Action string returned by the routine
.WORD ACTNLN ; Length of the action string (max)
.WORD R$ACTN ; Returned length
.WORD 0 ; DISPLAY - Reserved
.WORD ADDOPT ; ADDOPTFLAG - Addtnl options
.WORD MSG1 ; Line 23 message
.WORD L$MSG1 ; Length of line 23 message
.WORD MSG2 ; Line 24 message
.WORD L$MSG2 ; Length of line 24 message
MENU$L=<<.-A$MENU>/2>-1
ACTNLN: .WORD 2 ; Number of characters in action array
.SBTTL Argument blocks -- MPACK - Pack multiple-choice menu
;++
; The following is the argument block for the initial MPACK routine call.
; This call will clear the multi-choice menu buffer
;--
;
; MPACK - with clearing argument block
;
A$MPAC: .BYTE MPAC$L,0 ; Length of the arugment block
.WORD STATUS ; Status information returned
.WORD M$CLRB ; Clear buffer directive
.WORD L$CLRB ; Text length
.WORD M$TITL ; Field id
.WORD L$TITL ; Length of the field id
.WORD M$BTTL ; Title area
.WORD L$BTTL ; And the length of it
MPAC$L=<<.-A$MPAC>/2>-1
.SBTTL Argument blocks -- MMENU - Multiple-choice menu
;++
; The following is the argument block for the dynamic multiple-choice
; menu processing.
;--
A$MMEN: .BYTE MMEN$L,0 ; Length of the argument block
.WORD STATUS ; Status returned by the caller
.WORD OPTSTR ; Option string
.WORD L$OPTS ; Length of the option string
.WORD C$OPTS ; Number of options in the option string
.WORD LIMIT ; Limit on the number of selections
.WORD RESPON ; Number of options selected
.WORD RSPARY ; Action strings
.WORD ADDOPT ; ADDOPTFLAG - Addtnl options
.WORD MSG1 ; Line 23 message
.WORD L$MSG1 ; Length of line 23 message
.WORD MSG2 ; Line 24 message
.WORD L$MSG2 ; Length of line 24 message
MMEN$L=<<.-A$MMEN>/2>-1
LIMIT: .WORD 1 ; Select only one
.SBTTL General error messages
;++
; The following are error messages that are displayed on the user's
; screen.
;--
.PSECT $PLIT$, RO, D
MSG BADK,<You have pressed the wrong key - please try again>
M$BADI: .ASCII <.CHCR><.CHBEL>/Please check your input./
.ASCIZ / Press RESUME to continue/
;
; String to position to accept input
;
M$PPRM: .ASCIZ <.CHCSI>/21;1H/<.CHCSI>/J/
.SBTTL Data areas
.PSECT $OWN$, D
;
; Flags that are used in this module
;
BADINP: .BLKW 1 ; Bad input flag
XITFLG: .BLKW 1 ; Must exit
MAIFLG::.BLKW 1 ; Main screen flag
AOPFLG: .BLKW 1 ; Additional options flag
;
; MENU, DMENU and MMENU arguments
;
ADDOPT: .BLKW 1 ; Additional options flag
L$MSG1: .BLKW 1 ; Lenght of text in MSG1 (always 80.)
L$MSG2: .BLKW 1 ; Ditto for MSG2 (always 80.)
;
; MFRAME arguments
;
MFRMID: .BLKB 8. ; Frame id
MFRMLN: .BLKW 1 ; Frame id length
;
; MUNPK argument block - built on the fly
;
A$MUNP: .BYTE MUNP$L,0 ; Length
.WORD STATUS ; Status returned
UN$AG1=.-A$MUNP
.WORD 0 ; Fieldid
UN$AG2=.-A$MUNP
.WORD 0 ; Maxlen of fieldid
.WORD MUNPBF ; UNPACK buffer
.WORD MUNPBL ; UNPACK buffer length
.WORD MUNPRL ; UNPACK buffer return length
MUNP$L=<<.-A$MUNP>/2>-1
MUNPBF: .BLKB 80. ; Buffer text is stored in
MUNPBL: .WORD 80. ; Length of the buffer
MUNPRL: .BLKW 1 ; Amount stored in MUNPBF
;
; DPACK - with clearing argument block
;
A$DPAC: .BYTE DPAC$L,0 ; Length of the arugment block
.WORD STATUS ; Status information returned
.WORD M$CLRB ; Clear buffer directive
.WORD L$CLRB ; Text length
DP$AG1=.-A$DPAC
.WORD 0 ; Field id
DP$AG2=.-A$DPAC
.WORD 0 ; Length of the field id
.WORD MUNPBF ; Buffer returned by unpacking
.WORD MUNPRL ; And the returned length
DPAC$L=<<.-A$DPAC>/2>-1
;
; DPACK - without clearing argument block
;
A$DPAK: .BYTE DPAK$L,0 ; Length of the arugment block
.WORD STATUS ; Status information returned
DK$AG1=.-A$DPAK
.WORD 0 ; Field id
DK$AG2=.-A$DPAK
.WORD 0 ; Length of the field id
.WORD MUNPBF ; Buffer returned by unpacking
.WORD MUNPRL ; And the returned length
DPAK$L=<<.-A$DPAK>/2>-1
;
; MUNPK and DPACK option names. These names are built on the fly so that
; we can unpack every possible option. All names have '01' to '12' appended
; on the end.
;
M$KEYW: .ascii 'KEYW' ; Code for keyword
KEYWNM: .blkw 1 ; Space for ascii '01' - '12'
OFKEYW: .blkw 1 ; Offset of keyword (returned)
KEYWLN: .blkw 1 ; Keyword length
M$OPTN: .ascii 'OPTN' ; Code for option
OPTNNM: .blkw 1 ; Space for numbers
M$ACTN: .ascii 'ACTN' ; code for action
ACTNNM: .blkw 1 ; Space for numbers
M$OHLP: .ascii 'OHLP' ; Code for option help
OHLPNM: .blkw 1 ; Space for numbers
BUFF1L: .blkw 1 ; (returned from MUNPK)
BUFF3L: .blkw 1
;
; MENU and DMENU information
;
ACTION: .BLKB 2 ; Action string selected
R$ACTN: .BLKW ; Returned action string length
;
; Line characteristics information
;
XKBLK: .BLKW ; XK block to read information from
;
; Location used to return values to the upper levels
;
VALUE: .BLKW ; Location to return values
;
; MPACK - without clearing argument block
;
MPKLEN: .BLKW 1 ; Length of strings for MPACK
A$MPAK: .BYTE MPAK$L,0 ; Length of the arugment block
.WORD STATUS ; Status information returned
MK$AG1=.-A$MPAK
.WORD 0 ; Field id
MK$AG2=.-A$MPAK
.WORD 0 ; Length of the field id
MK$AG3=.-A$MPAK
.WORD 0 ; Buffer returned by unpacking
.WORD MPKLEN ; And the returned length
MPAK$L=<<.-A$MPAK>/2>-1
;
; MMENU items
;
C$OPTS: .BLKW 1 ; Number of options in the option string
L$OPTS: .BLKW 1 ; Length of option string
RESPON: .BLKW 1 ; Number of items selected
RSPARY: .BLKW 1 ; Number of responses selected
OPTSTR: .BLKB 300. ; Option string
.SBTTL Initialization of the command processing
;++
; This routine will initialize the command processor. It will
; store various pieces of information and clear the MSG1 and MSG2
; areas in the common
;
; Usage:
;
; JSR PC,INICMD
; (Return)
;
;--
.PSECT $CODE$, RO
.GLOBL INICMD
INICMD: JSR R1,$SAVE5 ; Save registers R1 to R5
MOV #A$MFIL,R5 ; Point to the argument block
CALL MFILE ; Call the routine
TST STATUS ; Get a good return
BGE 10$ ; Jump if ok
;
; Here if we failed to open the menu file.
;
MOV #M$MOER,R0 ; Get the error block
JSR PC,MERROR ; Issue the error
;
; Now to open the HELP file
;
10$: MOV #A$HFIL,R5 ; Point to the argument block
CALL HFILE ; Open the help file
TST STATUS ; Get a good return?
BGE 20$ ; Branch if ok
;
; Issue the error message for open failures for the HELP file.
;
MOV #M$HOER,R0 ; Get the argument block
JSR PC,MERROR ; Output the error message
;
; Now reset the message areas of the menus
;
20$: MOV #80.,L$MSG1 ; Store the length
MOV #80.,L$MSG2 ; Store the other length
PJMP RSTMSG ; Restore the MSG areas
.SBTTL COMMAN - Process the commands
;++
; This routine is called from the KERMIT.MAC module to process the KERMIT
; commands.
;
; Usage:
; JSR PC,COMMAN
; (Return - When we are exiting)
;
;--
.PSECT $CODE$, RO
.GLOBL COMMAN
COMMAN: CLR XITFLG ; Clear the exit flag
10$: CLR MAIFLG ; Clear the main screen flag
BLSCAL DOMENU,<#F$MAIN,#K$MKEY,#FALSE> ; Call the menu processing
TST AOPFLG ; Additional options?
BNE 20$ ; Yes, handle it
TST XITFLG ; Are we to just exit?
BEQ 10$ ; No, continue with this menu
RTS PC ; Just return if we got a function key
;
; Here when additional options have been pressed
;
20$: CLR MAIFLG ; Clear the MAIN SCREEN flag
BLSCAL DOMENU,<#F$REMT,#K$ANRM,#FALSE> ; Call the menu processing
TST AOPFLG ; Additional options?
BEQ 10$ ; Yes, just loop around
CLR MAIFLG ; Clear this flag again
BLSCAL DOMENU,<#F$REM2,#K$ANRM,#FALSE> ; Call the menu processing
TST MAIFLG ; User type an exit?
BNE 20$ ; Yes, handle it
BR COMMAN ; Go back to the top
;
; Here when the EXIT key is pressed. This routine will set the exit flag
; and return to the calling routine.;
;
SETXIT: COM XITFLG ; Make this -1
RTS PC ; And return to the caller
;
; Define the function keys that are valid in this state.
;
.PSECT $PLIT$, RO, D
.MACRO MKEY
KEY KY.AOP,SETAOP
KEY KY.EXI,SETXIT
KEY KY.MAI,SETXIT
.ENDM
KEYS MKEY,MKEY
;
; The following routine will be called because the MAIN screen key
; was pressed.
;
.PSECT $CODE$, RO, I
SETMAI: COM MAIFLG ; Flag to return to the main screen
RET: RTS PC ; And return
;
; The following are the function keys that are allowed in this screen.
;
.PSECT $PLIT$, RO, D
.MACRO KYNORM
KEY KY.EXI, RET
KEY KY.MAI, SETMAI
.ENDM
KEYS NORM,KYNORM
.MACRO KYCRUN
KEY KY.EXI, SETMAI
KEY KY.MAI, SETMAI
.ENDM
KEYS CRUN,KYCRUN
.MACRO KYANRM
KEY KY.EXI, RET
KEY KY.MAI, SETMAI
KEY KY.AOP, SETAOP
.ENDM
KEYS ANRM,KYANRM
.PSECT $CODE$, RO, I
; Return routines
SETAOP: COM AOPFLG ; Set the value
RTS PC ; Return to the caller
CCMAI: COM MAIFLG ; Set the main screen flag
CCRET: COM BADINP ; Set the bad input flag
RTS PC ; Return to the caller
;
; The following are the function keys that are allowed in this screen.
;
.MACRO KYINRM
KEY KY.EXI, CCRET
KEY KY.MAI, CCMAI
.ENDM
.PSECT $PLIT$, RO, D
KEYS INRM,KYINRM
.SBTTL CMDRUN - Command processing for a running KERFIL
;++
; This routine will handle the command processing for a KERFIL that is running.
; It will prompt the user and call the routines that have to be called.
;
;--
.PSECT $CODE$, RO, I
.GLOBL CMDRUN ; Global routine
CMDRUN: BLSCAL DOMENU,<#F$ACTV,#K$CRUN,#TRUE> ; Call the menu processor
RTS PC ; Return to the caller for now
.SBTTL C$CONN - Connect processing
;++
; This routine will cause the connect task to be spawned.
;--
.PSECT $PLIT$, RO, D
T$CON: .RAD50 /KERCON/
.EVEN
.PSECT $CODE$, RO, I
C$CONN: JSR PC,CHKACT ; Make sure KERFIL doesn't have the port
MOV #T$CON,R0 ; Get the addrses of the task
PJMP DOSPWN ; Spawn the task
.SBTTL C$POS - Process a P/OS function
;++
; This routine will handle the processing of the various P/OS commands.
; All of these commands are handled by spawning off a task that will do
; the correct function.
;--
.PSECT $CODE$, RO, I
C$POS: BLSCAL DOMENU,<#F$POS,#K$NORM,#FALSE> ; Call the menu processor
RTS PC
.SBTTL P$FILE - Process P/OS File services
;++
; This routine will handle the processing of the P/OS File Services
;--
.PSECT $TEXT$, RO, D
FTSK: .RAD50 /C$FUTL/
.EVEN
.PSECT $CODE$, RO, I
P$FILE: MOV #FTSK,R0 ; Get the address of the name
PJMP DOSPWN ; Spawn off the task
.SBTTL P$DISK - Spawn off the Disk/Diskette services
;++
; This routine will handle the spawning of the Disk and Diskette services.
; It will return to the caller when it is finished.
;--
.PSECT $TEXT$, RO, D
DTSK: .RAD50 /C$DUTL/
.EVEN
.PSECT $CODE$, RO, I
P$DISK: MOV #DTSK,R0 ; Get the task name
PJMP DOSPWN ; Spawn the task
.SBTTL P$PRINT - P/OS Print services
;++
; This routine will call the P/OS Print services tasks.
;--
.PSECT $TEXT$, RO, D
PTSK: .RAD50 /C$PUTL/
.EVEN
.PSECT $CODE$, RO, I
P$PRIN: MOV #PTSK,R0 ; Point to the information
PJMP DOSPWN ; Spawn the task
.SBTTL P$VIEW - View status/messages
;++
; This routine will cause the C$VUTL task to be spawned off.
;--
.PSECT $TEXT$, RO, D
VTSK: .RAD50 /C$VUTL/
.EVEN
.PSECT $CODE$, RO, I
P$VIEW: MOV #VTSK,R0 ; Point to the name
PJMP DOSPWN ; Spawn the task
.SBTTL P$STUP - Handle P/OS set up
;++
; THis routine will cause C$SUTL to be spawned.
;--
.PSECT $TEXT$, RO, D
STSK: .RAD50 /C$SUTL/
.EVEN
.PSECT $CODE$, RO, I
P$STUP: MOV #STSK,R0 ; Get the address of the task
PJMP DOSPWN ; Spawn the task
.SBTTL R$TYPE - Remote type command
;++
; This routine will handle the generic type command. It will scan the file
; specification that is to be sent to the remote and then call KERFIL to
; do the dirty work.
;
; Usage:
; JSR PC,R$TYPE
; (RETURN)
;
;--
.PSECT $TYPE$, RO, D
MSG RTYP,<Remote Type>
RTYTXT: .ASCIZ /Enter remote file specification to type/
.PSECT $CODE$, RO, I
R$TYPE: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.TYPE,GENCMD ; Store the command type
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT,<#TRUE,#M$RTYP,#RTYP$L,#RTYTXT,#FILPMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$DIR - Remote directory command
;++
; This routine will handle the scanning of the remote directory that we
; are to list for the user. We will then call KERFIL to do all the dirty
; work.
;
; Usage:
; JSR PC,R$DIR
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RDIR,<Remote Directory>
RDITXT: .ASCIZ /Enter remote directory specification/
RDIPMT: .ASCIZ /Remote Directory: /
.PSECT $CODE$, RO, I
R$DIR: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.DIRECT,GENCMD ; Store the command to do
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT,<#FALSE,#M$RDIR,#RDIR$L,#RDITXT,#RDIPMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$DEL - Remote delete command
;++
; This routine will scan the file specifications that are to be deleted
; by the remote Kermit and then call KERFIL to do the dirty work of
; sending the information to the remote Kermit.
;
;
; Usage:
; JSR PC,R$DEL
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RDEL,<Remote Delete>
RDETXT: .ASCIZ /Enter remote files to be deleted/
.PSECT $CODE$, RO, I
R$DEL: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.DELETE,GENCMD ; Store the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT,<#TRUE,#M$RDEL,#RDEL$L,#RDETXT,#FILPMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$HOST - Send a remote host command
;++
; This command will prompt for a string from the user terminal. It will
; then use this string to send it to the remote to be processed as a host
; command.
;
; Usage:
; JSR PC,R$HOST
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RHST,<Remote Host Command>
RHSTXT: .ASCIZ /Enter command to be executed by the remote system/
M$HSTP: .ASCIZ /Host command: /
.PSECT $CODE$, RO, I
R$HOST: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.COMMAND,GENCMD ; Store the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT,<#TRUE,#M$RHST,#RHST$L,#RHSTXT,#M$HSTP>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$CWD - Remote Change Working Directory
;++
; This routine will scan the directory that we are to change to. It will
; then send to KERFIL to do the protocol between us and the remote to do
; the function.
;
;
; Usage:
; JSR PC,R$CWD
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RCWD,<Remote Change Working Directory>
RCWTXT: .ASCIZ /Enter directory to work in and password if required/
RCWPMT: .ASCIZ /Password: /
PPMT$L =.-RCWPMT
.PSECT $CODE$, RO, I
R$CWD: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.CONNECT,GENCMD ; Get the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT2,<#FALSE,#M$RCWD,#RCWD$L,#RCWTXT,#RDIPMT,#RCWPMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$COPY - Remote COPY command
;++
; This command will cause a remote COPY command to be issued. All of the
; coping gets done on the remote system.
;
; Usage:
; JSR PC,R$COPY
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RCOP,<Remote Copy>
RCPTXT: .ASCIZ /Enter remote files specifications to copy/
RC1PMT: .ASCIZ /From Remote file: /
RC2PMT: .ASCIZ /To Remote file: /
.PSECT $CODE$, RO, I
R$COPY: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.COPY,GENCMD ; Get the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT2,<#3,#M$RCOP,#RCOP$L,#RCPTXT,#RC1PMT,#RC2PMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$WHO - Who is logged in on the remote
;++
; This routine will send the pack to determine who is logged into the remote
; system.
;
; Usage:
; JSR PC,R$WHO
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RWHO,<Remote Who is logged in>
RWHTXT: .ASCIZ /Enter remote user specification/
RW1PMT: .ASCIZ /User: /
RW2PMT: .ASCIZ /Options: /
.PSECT $CODE$, RO, I
R$WHO: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.WHO,GENCMD ; Get the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT2,<#FALSE,#M$RWHO,#RWHO$L,#RWHTXT,#RW1PMT,#RW2PMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$RENM - Remote RENAME command
;++
; This command will cause a remote RENAME command to be issued. All of the
; renaming gets done on the remote system.
;
; Usage:
; JSR PC,R$RENM
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RRNM,<Remote Rename>
RRNTXT: .ASCIZ /Enter remote files specifications to rename/
.PSECT $CODE$, RO, I
R$RENM: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.RENAME,GENCMD ; Get the command
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT2,<#3,#M$RRNM,#RRNM$L,#RRNTXT,#RC1PMT,#RC2PMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL R$STAT - Remote STATUS command
;++
; This routine will handle the remote STATUS command. It will send the
; generic command to the remote and then print the information.
;
;
; Usage:
; JSR PC,R$STAT
; (Return)
;
;--
.PSECT $CODE$, RO, I
R$STAT: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.STATUS,GENCMD ; Store the generic command to do
JSR PC,CLRGEN ; Clear generic commands arguments
MOV #$TKGEN,R0 ; Store the type
PJMP SNDPKT ; Call the remote task
.SBTTL R$HELP - Remote HELP command
;++
; This routine will handle the remote HELP command. It will send
; the generic command to the remote and then wait for the information
; back from the remote.
;
;
; Usage:
; JSR PC,R$HELP
; (Return)
;
;--
.PSECT $CODE$, RO, I
R$HELP: JSR PC,CHKACT ; Is KERFIL active?
MOV #GC.HELP,GENCMD ; Store the command
JSR PC,CLRGEN ; Clear generic arguments
MOV #$TKGEN,R0 ; Get the command to do
PJMP SNDPKT ; Call the routine
.SBTTL R$DISK - Remote disk usage command
;++
; This routine will handle the inquire to the remote Kermit about the
; disk usage.
;
;
; Usage:
; JSR PC,R$DISK
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG RDSK,<Remote Disk Usage>
RDSTXT: .ASCIZ /Enter remote directory/
.PSECT $CODE$, RO, I
R$DISK: MOV #GC.DISK.USAGE,GENCMD ; Store the command to send
JSR PC,CLRGEN ; Clear the generic arguments
BLSCAL INPUT,<#FALSE,#M$RDSK,#RDSK$L,#RDSTXT,#RDIPMT>
TST R0 ; Finished?
BEQ 10$ ; No, process the command
RTS PC ; Return to the caller
;
; Here if we really have to do something
;
10$: MOV #$TKGEN,R0 ; Get the function
PJMP SNDPKT ; Call the common routine
.SBTTL C$SET - Process the set command
;++
; This routine will handle the processing of the set command. It will
; call the menu processor with the SET menu. It will return on the
; to the previous screen on an EXIT key and to the main screen on a
; MAIN SCREEN key.
;--
.PSECT $TEXT$, RO, D
MSG NSET,<Set parameters not allowed while transfer task is active>
.PSECT $CODE$, RO
C$SET: BIT #TRUE,RUN ; Is the remote running?
BEQ 10$ ; No, just get the processing
BLSCAL BL$MOV,<#NSET$L,M$NSET,#MSG1> ; Tell the user
RTS PC ; Return to the caller
;
; Here to get the type of sets to do
;
10$: BLSCAL DOMENU,<#F$SET,#K$NORM,#FALSE> ; Call the menu processor
RTS PC
.SBTTL SETFIL - Set file parameters
;++
; This routine will cause file parameters to be set. These include
; file disposition, file mode, ...
;--
SETFIL: BLSCAL DOMENU,<#F$FILE,#K$NORM,#FALSE> ; Set file parameters
RTS PC ; Return to the caller
.SBTTL SETFIL - File specification type
;++
; The following will handle the setting of the file specification normalization
; processing.
;--
; Table of possible values
.MACRO $FSPC
$TAB FNM.NORMAL,<Normal>
$TAB FNM.FULL,<Full>
$TAB FNM.UNTRAN,<Untranslated>
.ENDM
TABLE FSP,$FSPC
;
; dynamic menu routine
;
DYNFSP: MOV #FSP$L,R1 ; Get the table length
MOV #T$FSP,R0 ; And the address of the table
MOV FIL.NORMAL.FORM,R2 ; Get the type of processing
PJMP DYNFIS ; Find and insert the string into menu
;
; Input routine
;
INPFSP: BLSCAL DOMENU,<#F$FSPC,#K$INRM,#TRUE> ; Input the item
RTS PC ; Return to the caller
.SBTTL SETFIL - File specification normalization types
;++
; Here to return the various file specification normalization types
;--
RTFNRM: MOV #FNM.NORMAL,VALUE ; Store the value
RTS PC ; Return to the caller
RTFULL: MOV #FNM.FULL,VALUE ; Store the value
RTS PC ; Return to the caller
RTFUNT: MOV #FNM.UNTRAN,VALUE ; Store the file specification
RTS PC ; Return to the caller
.SBTTL SETFIL - File dispositions
;++
; The following routines will handle the setting of the file disposition
; for incomplete transfers. These are transfers that have aborted for some
; reason or another.
;--
; Generate the text for the different type of dispositions
.MACRO $FDISP
$TAB TRUE,<Delete>
$TAB FALSE,<Keep>
.ENDM
TABLE FDS, $FDISP
;
; Dynamic menu processing routine
;
.PSECT $CODE$, RO, I
DYNFDS: MOV #FDS$L,R1 ; Get the length
MOV #T$FDS,R0 ; Get the table address
MOV ABT.FLAG,R2 ; Get the flag value
PJMP DYNFIS ; Find and insert the string
;
; Set routine for file disposition
;
INPFDS: BLSCAL DOMENU,<#F$FDSP,#K$INRM,#TRUE> ; Call the menu processor
RTS PC ; Return to the caller
.SBTTL SETFIL - File disposition - Return value routines
;++
; The followingroutines will be called from the menu processing to set the
;value to be returned for the file disposition.
;--
RTFKEP: MOV #FALSE,VALUE ; Store the value
RTS PC ; Return to the caller
RTFDEL: MOV #TRUE,VALUE ; Store the value
RTS PC ; Return to the caller
.SBTTL SETFIL - File type routines
;++
; The following routines will handle the various file types that can
; be found in PRO/Kermit. This will translate the file types into something
; that can be typed and set.
;--
.MACRO FTYPS
$TAB MODASC,<Ascii>
$TAB MODBIN,<Binary>
$TAB MODBLK,<Block>
$TAB MODFIX,<Fixed>
.ENDM
TABLE FTY, FTYPS
;
; Input the file type
;
INPFTY: BLSCAL DOMENU,<#F$FMOD,#K$INRM,#TRUE> ; Call the menu processing
RTS PC ; Return to the caller
;
; Dynamic menu routine
;
DYNFTY: MOV #T$FTY,R0 ; Get the table address
MOV #FTY$L,R1 ; And the length
MOV FILFLG,R2 ; And the item to find
PJMP DYNFIS ; Find and insert the string
.SBTTL SET FILE TYPES - Return value routines
;++
; The following group of routines will return the values associated with
; the different file types
;--
RTFASC: MOV #MODASC,VALUE ; Store the value
RTS PC ; Return
RTFBIN: MOV #MODBIN,VALUE ; Store the value
RTS PC ; Return
RTFBLK: MOV #MODBLK,VALUE ; Store the value
RTS PC ; Return
RTFFIX: MOV #MODFIX,VALUE ; Store the value
RTS PC ; Return
.SBTTL SETGEN - Set general parameters
;++
; This routine will set various general parameters that can be found in
; PRO/Kermit.
;--
SETGEN: BLSCAL DOMENU,<#F$GEN,#K$INRM,#FALSE> ; Set timing parameters
RTS PC ; Return to the caller
.SBTTL SETGEN - Set general - Set block check types
;++
; This routine will set the block check types.
;--
.MACRO BLK
$TAB CHK.1CHAR,<1>
$TAB CHK.2CHAR,<2>
$TAB CHK.CRC,<3>
.ENDM
;
; Now generate the text table
;
.PSECT $PLIT$, RO, D
TABLE BLK,BLK
;
; Block checksum processing
;
.PSECT $CODE$, RO, I
INPBLK: BLSCAL DOMENU,<#F$BCHK,#K$INRM,#TRUE> ; Get the input
RTS PC ; Return to the caller
;
; This routine will handle the dynamic menu processing for the
; block check types.
;
DYNBLK: MOV #T$BLK,R0 ; Get the address of the table
MOV #BLK$L,R1 ; And the length of the table
MOV CHKTYPE,R2 ; And the value
PJMP DYNFIS ; Find and insert the string
.SBTTL SETGEN - Set general - Block check values
;++
; The following routines will return the value for the item.
; selected.
;--
RTBK1C: MOV #CHK.1CHAR,VALUE ; One character checksums
RTS PC ; Return to the caller
RTBK2C: MOV #CHK.2CHAR,VALUE ; Two character checksums
RTS PC ; Return to the caller
RTBK3C: MOV #CHK.CRC,VALUE ; Three chraracter checksums
RTS PC ; Return to the caller
.SBTTL SETGEN - Set general - Send init retries
;++
; This will set the number of retries to attempt for the send-init
; packet.
;--
.PSECT $PLIT$, RO, D
MSG SIR,<Enter the send-init packet count and then press DO:>
.PSECT $CODE$, RO, I
INPSIR: BLSCAL GETINP,<#FALSE,#M$SIR,#10.,#0> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
DYNSIR: MOV SI.RETRIES,R0 ; Get the value
PJMP DYNDEC ; Call the routine
.SBTTL SETGEN - Set general - Set repeat quoting character
;++
; This routine will set the repeat count quoting character.
;--
.PSECT $CODE$, RO, I
;
; Dynamic menu routines
;
DYNRPT: MOV SET.REPT.CHAR,R0 ; Get the repeat character to work on
PJMP DYNCOC ; Call the routine to process it
;
; Set the repeat character routine
;
.PSECT $PLIT$, RO, D
MSG RPT,<Enter repeat character and then press DO:>
.PSECT $CODE$, RO, I
INPRPT: BLSCAL GETINP,<#TRUE,#M$RPT,#10.,#CHKQUO> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
.SBTTL SETGEN - Set General - 8th bit quoting
;++
; This routine will set the 8th-bit quoting.
;--
.PSECT $PLIT$, RO, D
MSG EQU,<Enter the 8th bit quoting character and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INP8QU: BLSCAL GETINP,<#TRUE,#M$EQU,#10.,#CHKQUO> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Receive quoting
;
DYN8QU: MOVB RCV.8QUOTE.CHAR,R1 ; Get the receive quoting
BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL SETGEN - Set general - Set packet retries
;++
; This routine will set the number of retries to attempt for sending a packet
; to the remote system.
;--
.PSECT $PLIT$, RO, D
MSG PKR,<Enter the packet retry count and the press DO:>
.PSECT $CODE$, RO, I
;
; Input routine for the packet retry count
;
INPPKR: BLSCAL GETINP,<#FALSE,#M$PKR,#10.,#0> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routine for the packet retry count
;
DYNPKR: MOV PKT.RETRIES,R0 ; Get the number of retries
PJMP DYNDEC ; Store the information
.SBTTL SETGEN - Set general - Set debugging parameter
;++
; This routine will set the debugging parameter to be either on or off.
;--
.PSECT $CODE$, RO, I
;
; Dynamic menu processing routine for debugging parameter
;
DYNDEB: CLR R0 ; Clear the offset
BIT #1,DEBUG.FLAG ; Is this on or off
BNE 10$ ; Off, so make it the second
INC R0 ; Increment to the second
10$: PJMP DYNBLD ; Bold the correct field
;
; Set routine for the debugging flag
;
INPDEB: MOV #1,R0 ; Get the bit to toggle
MOV DEBUG.FLAG,VALUE ; Move the value
XOR R0,VALUE ; Xor the value
RTS PC ; Return to the caller
.SBTTL SETSND - Set the send packet parameters
;++
; This routine will set the send packet parameters.
;--
SETSND: BLSCAL DOMENU,<#F$SEND,#K$NORM,#FALSE> ; Set send parameters
RTS PC ; Return to the caller
.SBTTL SETRCV - Set the receive packet parameters
;++
; This routine will set the receive packet parameters
;--
SETRCV: BLSCAL DOMENU,<#F$RECV,#K$NORM,#FALSE> ; Set receive parameters
RTS PC ; Return to the caller
.SBTTL SET SEND/RECEIVE - Packet length
;++
; The following routines are the set send/receive routines for the
; packet length.
;--
.PSECT $PLIT$, RO, D
MSG PKTL,<Enter the packet length and then press DO:>
.PSECT $CODE$, RO, I
;++
; Dynamic menu routine
;--
DYRPKL: MOV RCV.PKT.SIZE,R1 ; Get the value
BR DYNPKL ; Process the packet length
DYSPKL: MOV SND.PKT.SIZE,R1 ; Get the value
;
; Common code to set the dynamic menu up for PACKET LENGTH
;
DYNPKL: BLSCAL BL$ABS,R1 ; Get the real value
PJMP DYNDEC ; Insert the value into the menu
;++
; Here to input the packet length
;--
INPPKL: BLSCAL GETINP,<#FALSE,#M$PKTL,#10.,#CHKPKL> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
.SBTTL SET SEND/RECEIVE - End of line
;++
; The following routines are the set send/receive routines for the end of line
; character.
;--
.PSECT $PLIT$, RO, D
MSG EOL,<Enter the end of line value and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPEOL: BLSCAL GETINP,<#FALSE,#M$EOL,#8.,#CHKCTL> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
; Dynamic menu routines
;
; Send EOL
;
DYSEOL: MOVB SND.EOL,R1 ; Get the send eol character
BR DYNEOL ; Join the common code
;
; Receive EOL
;
DYREOL: MOVB RCV.EOL,R1 ; Get the receive eol character
;
; Common routine for the processing of the EOL character into the menu.
;
DYNEOL: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL SET SEND/RECEIVE - Time out
;++
; This routine will set the timeout parameter for the sending and receiving
; of packets.
;--
.PSECT $PLIT$, RO, D
MSG TIM,<Enter the timeout value and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPTIM: BLSCAL GETINP,<#FALSE,#M$TIM,#10.,#CHKTIM> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Send timeout
;
DYSTIM: MOVB SND.TIMEOUT,R1 ; Get the send timeout
BR DYNTIM ; Join the common code
;
; Receive timeout
;
DYRTIM: MOVB RCV.TIMEOUT,R1 ; Get the receive timeout
;
; Common routine for the processing of the timeout and storing into the menu
;
DYNTIM: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNDEC ; Convert to octal and store
.SBTTL SET SEND/RECEIVE - Start of packet
;++
; This routine will set the start of packet characterfor the sending and
; receiving of packets.
;--
.PSECT $PLIT$, RO, D
MSG SOP,<Enter the start of packet character and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPSOP: BLSCAL GETINP,<#TRUE,#M$SOP,#10.,#CHKCTL> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Send start of packet
;
DYSSOP: MOVB SND.SOH,R1 ; Get the send start of packet
BR DYNSOP ; Join the common code
;
; Receive start of packet
;
DYRSOP: MOVB RCV.SOH,R1 ; Get the receive start of packet
;
; Common routine for the processing of the start of packet and storing
; into the menu
;
DYNSOP: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL SET SEND/RECEIVE - Padding character
;++
; This routine will set the padding character for the sending and
; receiving of packets.
;--
.PSECT $PLIT$, RO, D
MSG PDC,<Enter the padding character and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPPDC: BLSCAL GETINP,<#TRUE,#M$PDC,#10.,#CHKPDC> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Send padding
;
DYSPDC: MOVB SND.PADCHAR,R1 ; Get the send padding
BR DYNPDC ; Join the common code
;
; Receive padding
;
DYRPDC: MOVB RCV.PADCHAR,R1 ; Get the receive padding
;
; Common routine for the processing of the padding and storing
; into the menu
;
DYNPDC: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL SET SEND/RECEIVE - Number of padding character
;++
; This routine will set the number of padding characters for the sending and
; receiving of packets.
;--
.PSECT $PLIT$, RO, D
MSG NPD,<Enter the number of padding characters and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPNPD: BLSCAL GETINP,<#FALSE,#M$NPD,#10.,#0> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Send number of padding characters
;
DYSNPD: MOVB SND.NPAD,R1 ; Get the send number of padding characters
BR DYNNPD ; Join the common code
;
; Receive number of padding characters
;
DYRNPD: MOVB RCV.NPAD,R1 ; Get the receive number of padding characters
;
; Common routine for the processing of the number of padding characters
; and storing into the menu
;
DYNNPD: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNDEC ; Convert to octal and store
.SBTTL SET SEND/RECEIVE - Quoting
;++
; This routine will set the quoting characterfor the sending and
; receiving of packets.
;--
.PSECT $PLIT$, RO, D
MSG QUO,<Enter the quoting character and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPQUO: BLSCAL GETINP,<#TRUE,#M$QUO,#10.,#CHKQUO> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Send quoting
;
DYSQUO: MOVB SND.QUOTE,R1 ; Get the send quoting
BR DYNQUO ; Join the common code
;
; Receive quoting
;
DYRQUO: MOVB RCV.QUOTE,R1 ; Get the receive quoting
;
; Common routine for the processing of the quoting and storing
; into the menu
;
DYNQUO: BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL SETLIN - Set line characteristics
;++
; This routine will cause the line characteristics to be set. These could be
; the default parameters, the current parameters or the resetting of the
; parameters.
;--
SETLIN: BLSCAL DOMENU,<#F$LINE,#K$NORM,#FALSE> ; Set line characteristics
RTS PC ; Return to the caller
.SBTTL SETLDF - Set the default line characteristics
;++
; This routine will set the default line characteristics
;--
SETLDF: MOV #DEFXKP,XKBLK ; Set the line defaults
BLSCAL DOMENU,<#F$LCHR,#K$NORM,#FALSE> ; Get the information
JSR PC,DF.INI ; Initialize the default file processing
MOV #XK.IDX,R0 ; Index for the file
MOV #DEFXKP,R1 ; Address of the parameters
MOV #CURXKL,R2 ; Length of the block
JSR PC,DF.WT ; Write the parameters
PJMP DF.FIN ; Close the default file
.SBTTL SETLCR - Set the current line characteristics
;++
; This routine will set the current line characteristics
;--
SETLCR: MOV #CURXKP,XKBLK ; Set the line current parameters
BLSCAL DOMENU,<#F$LCHR,#K$NORM,#FALSE> ; Get the input
RTS PC ; Return to the caller
.SBTTL SET LINE -- Terminal speeds
;++
; These routines will handle the setting of the recieve and the transmit
; baud rates. The only differences between the routines are just where the
; information is stored and the line that is modified for the dynamic
; menu processing.
;--
.MACRO SPD
$TAB S.50,<50>
$TAB S.75,<75>
$TAB S.100,<100>
$TAB S.110,<110>
$TAB S.134,<134>
$TAB S.150,<150>
$TAB S.200,<200>
$TAB S.300,<300>
$TAB S.600,<600>
$TAB S.1200,<1200>
$TAB S.1800,<1800>
$TAB S.2000,<2000>
$TAB S.2400,<2400>
$TAB S.3600,<3600>
$TAB S.4800,<4800>
$TAB S.7200,<7200>
$TAB S.9600,<9600>
$TAB S.19.2,<19200>
; $TAB S.38.4,<38400>
.ENDM
; Now define the item in the table
.PSECT $PLIT$, RO, D
TABLE SPD,SPD ; Define the speed table
.GLOBL T$SPD, SPD$L
.PSECT $CODE$, RO, I
;
; Dynamic menu routines
;
; Transmit speed
;
DYNXSP: MOV #TC.XSP,R0 ; Get the transmit speed
BR DYNSPD ; Join the common routine
;
; Receive speed
;
DYNRSP: MOV #TC.RSP,R0 ; Get the receive speed
;
; Common routine
;
DYNSPD: MOV XKBLK,R1 ; Get the block address
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Get one
BEQ 99$ ; No, just exit
MOVB (R0),R2 ; Get the information
MOV #T$SPD,R0 ; Get the table address
MOV #SPD$L,R1 ; And the length
JSR PC,DYNFIS ; Find and insert the string
99$: RTS PC ; And return
;
; Set routines
;
SETXSP:
MOV #TC.XSP,R0 ; Get the parameter we need
BR SETSPD ; Set the speed
;
; Receive speed routine
;
SETRSP: MOV #TC.RSP,R0 ; Get the parameter
;
; Common routine
;
SETSPD: MOV XKBLK,R1 ; Point to the parameter block
JSR PC,FNDXKP ; Find the parameter
TST R0 ; Find it?
BEQ 99$ ; No, just return
MOVB VALUE,(R0) ; Yes, store the value
99$: RTS PC ; Return to the caller
;
; Input routine
;
; This routine will build the multi-choice menu and call the menu processing
; with it. The frame block will be in the data area.
;
.PSECT $PLIT$, RO, D
MSG BTXT,<50 75 100 110 134 150 200 300 600 1200 1800 2000 2400 3600 4800 7200 9600 19200>
MSG BTTL,<Baud rate>
L$BTTL: .WORD BTTL$L ; Length of the baud rate menu
MSG BTX1,<Press EXIT to return to the previous menu>
MSG BTX2,<Press MAIN SCREEN to return to the PRO/Kermit main menu>
MSG BPRM,<Make a choice and press DO:>
MSG BHLP,<BAUDRATE> ;[03]
.PSECT $CODE$, RO, I
INPSPD: MOV #A$MPAC,R5 ; Get the argument block address
CALL MPACK ; Pack the information into the menu
TST STATUS ; Get the status returned by the routine
BMI 90$ ; Failed, see why
MOV #M$TXT1,A$MPAK+MK$AG1 ; Store for TEXT01 line
MOV #L$TXT1,A$MPAK+MK$AG2 ; And the length
MOV #M$BTX1,A$MPAK+MK$AG3 ; Store the TEXT01 line
MOV #BTX1$L,MPKLEN ; Store the length
MOV #A$MPAK,R5 ; Point to the arguments
CALL MPACK ; Pack the information in
BMI 90$ ; Branch if it failed
MOV #M$TXT2,A$MPAK+MK$AG1 ; Store for TEXT02 line
MOV #L$TXT2,A$MPAK+MK$AG2 ; And the length
MOV #M$BTX2,A$MPAK+MK$AG3 ; Store the TEXT02 line
MOV #BTX2$L,MPKLEN ; Store the length
MOV #A$MPAK,R5 ; Point to the arguments
CALL MPACK ; Pack the information in
BMI 90$ ; Branch if it failed
MOV #M$PRMT,A$MPAK+MK$AG1 ; Store for PRMT line
MOV #L$PRMT,A$MPAK+MK$AG2 ; And the length
MOV #M$BPRM,A$MPAK+MK$AG3 ; Store the PRMT line
MOV #BPRM$L,MPKLEN ; Store the length
MOV #A$MPAK,R5 ; Point to the arguments
CALL MPACK ; Pack the information in
BMI 90$ ; Branch if it failed
MOV #M$GHLP,A$MPAK+MK$AG1 ;[03] Store for GHLP line
MOV #L$GHLP,A$MPAK+MK$AG2 ;[03] And the length
MOV #M$BHLP,A$MPAK+MK$AG3 ;[03] Store the GHLP line
MOV #BHLP$L,MPKLEN ;[03] Store the length
MOV #A$MPAK,R5 ;[03] Point to the arguments
CALL MPACK ;[03] Pack the information in
BMI 90$ ;[03] Branch if it failed
;
; Here to display the multi-choice menu
;
BLSCAL BL$MOV,<#BTXT$L,#M$BTXT,#OPTSTR> ; Copy the string
MOV #5,L$OPTS ; Store the string length
MOV #<BTXT$L/5>,C$OPTS ; Number of options
MOV #A$MMEN,R5 ; Get the argument block address
CALL MMENU ; Display the multi-choice menu
CMP #ST.KEY,STATUS ; Key typed?
BEQ 90$ ; Yes, just return
TST STATUS ; Return ok?
BMI 90$ ; No, issue an error
MOV RSPARY,R0 ; Get the response number
ASL R0 ; Make this a word index
MOV T$SPD-2(R0),VALUE ; Store the value
99$: RTS PC ; Return to the caller
;
; Here if there was an error in the processing of the multi-choice menu
; Just return that we didn't get a value
;
90$: PJMP CCRET ; No value return
.SBTTL SETLINE -- Set flow of control
;++
; These routines will handle the setting of the flow of control parameters
; for the XK. These routines will just toggle the state of the flow
; of control processing.
;--
.PSECT $CODE$, RO, I
;
; Dynamic menu processing routine for flow of control
;
DYNFC: MOV #TC.BIN,R0 ; Get the parameter to look for
MOV XKBLK,R1 ; Point to the block to look in
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Find it?
BEQ 99$ ; No, just exit
MOVB (R0),R1 ; Get the parameter state
CLR R0 ; Assume the first
TST R1 ; Is this enabled?
BEQ 10$ ; Yes, light the first
INC R0 ; No, use the second
10$: JSR PC,DYNBLD ; Do the bolding
99$: RTS PC ; Return to the caller
;
; Set routine for flow of control
;
SETFC: MOV #TC.BIN,R0 ; Get the parameter to look for
MOV XKBLK,R1 ; Get the block we are processing
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Have a value?
BEQ 99$ ; Not in block?
MOVB VALUE,(R0) ; Store the information
99$: RTS PC ; Return to the caller
;
; Input routine for flow of control
;
INPFC: MOV #TC.BIN,R0 ; Get the parameter to look for
MOV XKBLK,R1 ; Get the block we are processing
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Have a value?
BEQ 99$ ; Not in block?
MOVB (R0),VALUE ; Get the item
MOV #1,R0 ; Get this value
XOR R0,VALUE ; And change it
99$: RTS PC ; Return to the caller
.SBTTL SET LINE -- Modem type routines
;++
; These routines will handle the modem type, store the information into
; the dynamic menu, accept it, etc.
;--
.MACRO XTM
$TAB XTM.NO,<No modem, hard-wired line>
$TAB XTM.FS,<USFSK- 0..300 baud Bell 103J>
$TAB XTM.21,<CCITTV.21- 0..300 baud European>
$TAB XTM.M1,<CCITTV.23 Mode 1 - 75/0.. 300 split>
$TAB XTM.M2,<CCITTV.23 Mode 2 - 75/0..1200 split>
$TAB XTM.PS,<DPSK - 1200 baud Bell 212>
.ENDM
;
; Generate the table
;
.PSECT $PLIT$, RO, D
TABLE XTM, XTM ; Generate the table
;
; Routines - Dynamic menu routine
;
.PSECT $CODE$, RO, I
DYNMDM: MOV #XT.MTP,R0 ; Need the modem type
MOV XKBLK,R1 ; From this block
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Have an address?
BEQ 99$ ; No, just leave
MOVB (R0),R2 ; Get the value of the parameter
MOV #T$XTM,R0 ; Get the table address
MOV #XTM$L,R1 ; Get the length
JSR PC,DYNFIS ; Find and insert the string
99$: RTS PC ; Return to the caller
;
; Set routine
;
SETMDM: MOV #XT.MTP,R0 ; Need the modem type
MOV XKBLK,R1 ; Current block we are processing
JSR PC,FNDXKP ; Find the parameter
TST R0 ; Have the address?
BEQ 99$ ; No, just return
MOVB VALUE,(R0) ; Store the value
99$: RTS PC ; Return to the caller
;
; Input routine
;
INPMDM: BLSCAL DOMENU,<#F$MODM,#K$INRM,#TRUE> ; Get the input from a one shot
RTS PC ; Return to the caller
.SBTTL Modem input routines
;++
; The following routines will return the various values for the modem
; types
;--
RTNOMD: MOV #XTM.NO,VALUE ; No modem
RTS PC ; Return to the caller
RTUSFS: MOV #XTM.FS,VALUE ; USFSK 103J
RTS PC ; Return to the caller
RTCC21: MOV #XTM.21,VALUE ; CCITTV.21 0..300
RTS PC ; Return to the caller
RTCCM1: MOV #XTM.M1,VALUE ; CCITTV.23 Mode 1
RTS PC ; Return to the caller
RTCCM2: MOV #XTM.M2,VALUE ; CCITTV.23 Mode 2
RTS PC ; Return to the caller
RTDPSK: MOV #XTM.PS,VALUE ; DPSK Bell 212
RTS PC ; Return to the caller
.SBTTL Set line characteristics -- Parity
;++
; The following routines will set and fix dynamic menus for the parity settings
; for PRO/Kermit.
;--
.MACRO PAR
$TAB PR.NONE,<None>
$TAB PR.EVEN,<Even>
$TAB PR.SPACE,<Space>
$TAB PR.MARK,<Mark>
$TAB PR.ODD,<Odd>
.ENDM
;
; Now generate the parity information
;
TABLE PAR,PAR
;
; Dynamic menu routine for the parity processing.
;
DYNPAR: MOV #T$PAR,R0 ; Get the parity table
MOV #PAR$L,R1 ; Get the length of the table
MOV PARITY,R2 ; Get the current value
PJMP DYNFIS ; Find and insert the string
;
; Set the value routine
;
SETPAR: MOV VALUE,PARITY ; Store the value
CMP #PR.NONE,PARITY ; No parity?
BEQ 10$ ; Yes, handle it
CMP #PR.EVEN,PARITY ; Even parity?
BEQ 20$ ; Yes, handle it
CMP #PR.ODD,PARITY ; Odd parity?
BEQ 30$ ; Yes, handle it
;
; Here if it is a type of parity that we have to handle
;
MOV #FALSE,DEV.PARITY.FLAG ; Note the device is doing it
CLR R2 ; TC.PAR is set to zero
MOV #8.,R3 ; 8 bit data information
CLR R4 ; Clear this
BR 90$ ; Enter common code
;
; Here to handle the no parity setting
;
10$: MOV #TRUE,DEV.PARITY.FLAG ; Note the device is doing it
CLR R2 ; TC.PAR is set to zero
MOV #8.,R3 ; 8 bit data information
CLR R4 ; Clear this
BR 90$ ; Enter common code
;
; Here to handle the even parity setting
;
20$: MOV #TRUE,DEV.PARITY.FLAG ; Note the device is doing it
MOV #1,R2 ; TC.PAR is set to one
MOV #8.,R3 ; 8 bit data information
MOV #1,R4 ; Clear this
BR 90$ ; Enter common code
;
; Here to handle the odd parity setting
;
30$: MOV #TRUE,DEV.PARITY.FLAG ; Note the device is doing it
MOV #1,R2 ; TC.PAR is set to one
MOV #8.,R3 ; 8 bit data information
CLR R4 ; Clear this
;
; First attempt to find the parity setting
;
90$: MOV #TC.PAR,R0 ; Need the parity type
MOV XKBLK,R1 ; From this block
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Have an address?
BEQ 100$ ; Skip if not found
MOVB R2,@R0 ; Store the updated information
;
; Now do the character size
;
100$: MOV #TC.FSZ,R0 ; Get the character size
JSR PC,FNDXKP ; Find it
TST R0 ; Have an address?
BEQ 110$ ; Branch if not found
MOVB R3,@R0 ; Store the updated value
;
; Now do the parity setting
;
110$: MOV #TC.EPA,R0 ; Get the even/odd parity setting
JSR PC,FNDXKP ; Find the XK parameter
TST R0 ; Have it?
BEQ 120$ ; Branch if not found
MOVB R4,@R0 ; Store the updated value
;
; Now return to the caller
;
120$: RTS PC ; Return to the caller
;
; Input routine for the parity processing
;
INPPAR: BLSCAL DOMENU,<#F$PAR,#K$INRM,#TRUE> ; Call the menu processing
RTS PC ; Return to the caller
.SBTTL Return parity types
;++
; The following routines return the different possible parity settings.
;--
RTNOPR: MOV #PR.NONE,VALUE ; Store the value
RTS PC ; Return to the caller
RTEVPR: MOV #PR.EVEN,VALUE ; Store the value
RTS PC ; Return to the caller
RTODPR: MOV #PR.ODD,VALUE ; Store the odd parity value
RTS PC ; Return to the caller
RTMKPR: MOV #PR.MARK,VALUE ; Store the mark parity value
RTS PC ; Return to the caller
RTSPPR: MOV #PR.SPACE,VALUE ; Store the space parity value
RTS PC ; Return to the caller
.SBTTL Terminal emulation -- Connect escape character
;++
; This routine will set the terminal emulation escape character. This
; character will return the user back to the menu for the emulation processor.
;--
.PSECT $PLIT$, RO, D
MSG ECH,<Enter escape character and then press DO:>
.PSECT $CODE$, RW, I
; Input routine
INPECH: BLSCAL GETINP,<#TRUE,#M$ECH,#10.,#0> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines
;
; Connect escape character
;
DYNECH: MOVB ESCCHR,R1 ; Get the receive quoting
BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL Terminal emulation -- IBM turn around character
;++
; This routine will se the IBM turn around character.
;--
.PSECT $PLIT$, RO, D
MSG ICH,<Enter IBM turn around character and then press DO:>
.PSECT $CODE$, RW, I
; Store routines.
SETICH: MOV VALUE,IBM.CHAR ; Store the quoting value
RTS PC ; Return to the caller
; Input routine
INPICH: BLSCAL GETINP,<#TRUE,#M$ICH,#10.,#0> ; Get the input
MOV R0,VALUE ; Store the value
RTS PC ; Return to the caller
;
; Dynamic menu routines receive quoting
;
DYNICH: MOVB IBM.CHAR,R1 ; Get the receive quoting
BLSCAL BL$ABS,R1 ; Make sure this is positive
PJMP DYNCOC ; Convert to octal and store
.SBTTL Terminal emulation -- IBM mode
;++
; This routine will set the IBM mode flag for PRO/Kermit.
;--
.PSECT $CODE$, RO, I
; Dynamic menu routine
DYNIMD: CLR R0 ; Assume it is
BIT #1,IBM.FLAG ; Is this true?
BNE 10$ ; Skip if it is
INC R0 ; No, change to the second
10$: PJMP DYNBLD ; Bold the section
; Input routine
INPIMD: MOV IBM.FLAG,VALUE ; Copy the value
MOV #1,R0 ; Get the value
XOR R0,VALUE ; Convert the value
RTS PC ; And return to the caller
.SBTTL Terminal emulation -- Duplex
;++
; This routine will set the terminal to either half or full duplex.
;--
.PSECT $CODE$, RO, I
; Dynamic menu processing routine
DYNDPX: CLR R0 ; Assume that this is the first item
CMP #DP.FULL,DUPLEX ; Am I correct?
BNE 10$ ; Branch if so
INC R0 ; No, use the second entry
10$: PJMP DYNBLD ; Bold the section on the screen
; Input routine, just toggle the current value to the other valu
INPDPX: MOV #DP.HALF,VALUE ; Assume half duplex
CMP #DP.HALF,DUPLEX ; Am I wrong?
BNE 99$ ; No, just return
MOV #DP.FULL,VALUE ; Already is half, change to full
99$: RTS PC ; Return to the caller
.SBTTL Terminal emulation -- 7-bit character codes
;++
; This routine will set the 7-bit character codes. This should not be
; confused with the parameter in the XK port driver. This one causes the
; 8th bit to be striped only for the terminal emulation and not for the
; transfers. This is useful for talking with DECsystem-10s that sent
; even parity characters to the terminal, but Kermit-10 sends full 8 bit
; information
;--
.PSECT $CODE$, RO, I
;++
; This routine will set the information in the dynamic menu.
;--
DYN7BT: CLR R0 ; Assume that this is the first item
BIT #TRUE,TRM7BT ; Transparent terminal emulation?
BNE 10$ ; Branch if so
INC R0 ; No, use the second entry
10$: PJMP DYNBLD ; Bold the section on the screen
;++
; Input routine for the 7-bit character code processing. Just toggle the
; bit in for this
;--
INP7BT: MOV TRM7BT,VALUE ; Store the value
MOV #TRUE,R0 ; Get the bit to toggle
XOR R0,VALUE ; Change it to the other way
RTS PC ; Return to the caller
.SBTTL Terminal emulation -- Local echo
;++
; These routines will handle the local echo flag. This determines
;whether the terminal emulation will echo the characters from the
;keyboard to the screen.
;--
.PSECT $CODE$, RO, I
;++
; This routine will set the information in the dynamic menu.
;--
DYNLCE: CLR R0 ; Assume that this is the first item
BIT #TRUE,LCLECH ; Local echo on?
BNE 10$ ; Branch if so
INC R0 ; No, use the second entry
10$: PJMP DYNBLD ; Bold the section on the screen
;++
; Input routine for the local echo processing. Just toggle the
; bit in for this.
;--
INPLCE: MOV LCLECH,VALUE ; Store the value
MOV #TRUE,R0 ; Get the bit to toggle
XOR R0,VALUE ; Change it to the other way
RTS PC ; Return to the caller
.SBTTL Terminal emulation -- Transparent function keys
;++
; This routine will set the terminal into transparent mode or not
;--
.PSECT $CODE$, RO, I
; Dynamic menu processing routine
DYNTRN: CLR R0 ; Assume that this is the first item
BIT #TRUE,TRMTRN ; Transparent terminal emulation?
BNE 10$ ; Branch if so
INC R0 ; No, use the second entry
10$: PJMP DYNBLD ; Bold the section on the screen
; Input routine, just toggle the current value to the other valu
INPTRN: MOV TRMTRN,VALUE ; Move the value into the right place
MOV #TRUE,R0 ; Toggle the value
XOR R0,VALUE ; . . .
RTS PC ; Return to the caller
.SBTTL SETLRS - Reset the current line characteristics from defaults
;++
; This routine will reset the current line characteristics from the defaults.
;--
.PSECT $TEXT$, RO, D
MSG LPR,<Line characteristics reset from defaults>
.PSECT $CODE$, RO, I
SETLRS: BLSCAL BL$MOV,<#CURXKL,#DEFXKP,#CURXKP>,+ ; Reset the current
; parameters to defaults
BLSCAL BL$MOV,<#LPR$L,#M$LPR,#MSG1>,- ; Inform user reset
RTS PC ; Return to the caller
.SBTTL SETTRM - Set terminal emulation paramters
;++
; This routine will set the terminal emulation parameters
;--
SETTRM: BLSCAL DOMENU,<#F$TCHR,#K$NORM,#FALSE> ; Set terminal emulation
RTS PC ; Return to the caller
.SBTTL DOMENU - Display and process menus
;++
; This routine will display and process menus.
;
; Usage:
; BLCAL DOMENU,<Frameblockaddress,Keydispatchblock>
;--
.PSECT $CODE$, RO
BLSRTN DOMENU,5,<FRMBLK,KEYBLK,RTNFLG>,<LPIDX>
CLR AOPFLG ; Clear this
;
; First determine if we have to read the frame into the static frame
; buffer. If it is multi-choice we have already set it up.
;
1$: CLR BADINP ; Clear the bad input flag
MOV FRMBLK(SP),R0 ; Get the address of the block
;
; Set up to call MFRAME to read the frame into the static buffer.
; Move length and the id into the argument area.
;
MOVB .FRILN(R0),MFRMLN ; Store in the argument block
BLSCAL BL$MOV,<MFRMLN,.FRID(R0),#MFRMID> ; Move the frame id
MOV #A$MFRAM,R5 ; Point to the argument block
CALL MFRAME ; Call the frame set up
TST STATUS ; Did this work?
BPL 10$ ; Yes, skip error processing
;
; Here if we encountered an error reading the frame into the static buffer
;
MOV #M$FRER,R0 ; Point to the argument block
JSR PC,MERROR ; Issue the erorr
;
; Here if we have gotten the frame read correctly into memory. We must now
; determine which type of routine to call DMENU, MENU, MMENU.
;
10$: MOV FRMBLK(SP),R0 ; Get the frame block address again
CLR ADDOPT ; Clear the additional options flag
BITB #FT.ADDO,.FRTYPE(R0) ; Need to display them
BEQ 13$ ; Branch if no need
COM ADDOPT ; Make this non-zero
13$: BITB #FT.STATIC,.FRTYP(R0) ; Is this a static menu?
BEQ 20$ ; No, must be a dynamic menu
15$: MOV #A$MENU,R5 ; Point to the argument block
CALL MENU ; Process the static menu
BR 100$ ; Join the common code again
;
; Here if we have to unpack, pack and then display the menu.
;
20$: MOV #UNPARG,R1 ; Point to the argument list
MOV (R1),A$MUNP+UN$AG1 ; Store the first argument
MOV (R1),A$DPAC+DP$AG1 ; Store the first argument
MOV UNPAGL(R1),A$MUNP+UN$AG2 ; Store the second argument
MOV UNPAGL(R1),A$DPAC+DP$AG2 ; Store the second argument
MOV R1,LPIDX(SP) ; Save the information
MOV #A$MUNP,R5 ; Get the argument pointer
CALL MUNPK ; Unpack the argument
TST STATUS ; Did this work?
BPL 40$ ; No, just issue an error
;
; Here to issue the error for unpacking the menu item
;
30$: MOV #M$UPER,R0 ; Issue an unpacking error
JSR PC,MERROR ; Issue the erorr
;
; Here if we have unpacked the first entry correctly. Now we must
; pack the entry into the dynamic menu. The first call to DPACK will
; clear the dynamic menu buffer
;
40$: MOV #A$DPAC,R5 ; Get the argument block address
CALL DPACK ; Pack the item
TST STATUS ; Get a good return
BPL 60$ ; Branch if we did
;
; Here to issue the error for the DPACK failure
;
50$: MOV #M$PKER,R0 ; Get the argument block for a failure
JSR PC,MERROR ; Issue the error
;
; Here to loop for all of the other items after the first.
;
60$: ADD #2,LPIDX(SP) ; Point to the next argument
MOV LPIDX(SP),R1 ; Get the loop index
MOV (R1),A$MUNP+UN$AG1 ; Store the first argument
MOV (R1),A$DPAK+DK$AG1 ; Store the first argument
MOV UNPAGL(R1),A$MUNP+UN$AG2 ; Store the second argument
MOV UNPAGL(R1),A$DPAK+DK$AG2 ; Store the second argument
MOV #A$MUNP,R5 ; Get the argument pointer
CALL MUNPK ; Unpack the argument
TST STATUS ; Did this work?
BMI 30$ ; No, just issue an error
MOV #A$DPAK,R5 ; Cheat and use the same argument block
CALL DPACK ; Pack the item into the menu
TST STATUS ; Did we get an error?
BMI 50$ ; Yes, issue an error message
CMP #UNPARG+UNPAGL-2,LPIDX(SP) ; At the end?
BNE 60$ ; No, loop
;
; Now all of the header items have been unpacked and packed. We now must
; pack the selection items.
;
CLR R0 ; Set pointer to first option ('01')
70$: MOV NUMTAB(R0),R1 ; Get ascii for that option
MOV R1,KEYWNM ; and move to locations so that we
MOV R1,OPTNNM ; get keyword, option, action, and
MOV R1,ACTNNM ; option help for each available
MOV R1,OHLPNM ; option
MOV R0,LPIDX(SP) ; Save the pointer to the option number
MOV #A$UNPO,R5 ; Set up unpacking call by putting buf.
CALL MUNPK ; location in R5 and unpack an option
TST STATUS ; Check for error in call
BMI 30$ ; Give the unpack error
TST BUFF1L ; Check for an empty option, if we have
BEQ 75$ ; one we are done so exit
MOV FRMBLK(SP),R0 ; Get the frame block address
MOV .FRMLN(R0),R1 ; Get the menu block length
MOV .FRMNU(R0),R0 ; Get the menu block address
JSR PC,SETDYN ; Call routine to fix each option
;***CROCK TO GET AROUND P/OS BUG***
TST BUFF3L ; Anything in the buffer
BNE 74$ ; Skip this
MOV #1,BUFF3L ; One character
MOV #" ,BUFF3 ; Fill with spaces
74$:
;***END OF CROCK TO GET AROUND P/OS BUG***
MOV #A$PACO,R5 ; Set up call to pack dynamic buffer
CALL DPACK ; Pack buffer
TST STATUS ; Check for error in call
BMI 50$ ; Give the pack error message
MOV LPIDX(SP),R0 ; Restore pointer to option
TST (R0)+ ; Increment the pointer
CMP R0,#11.*2 ; At the end?
BNE 70$ ; If not maximum go on to next option
;
; Now to display the dynamic menu
;
75$: MOV #A$DMEN,R5 ; Get the argument block
CALL DMENU ; Display the menu
;
; Here to handle the results of the menu that we just displayed.
;
100$: JSR PC,RSTMSG ; Reset the message areas
TST STATUS ; Did everything go ok?
BPL 200$ ; Branch if ok so far
;
; Here if an error was encountered. First check to see if it was a function
; key that we can process
;
MOV KEYBLK(SP),R0 ; Get the key block
JSR PC,CHKKEY ; Check to see if it is a valid key
TST R0 ; Did we get a routine address?
BNE 120$ ; Branch if we did
BLSCAL BL$MOV,<#BADK$L,#M$BADK,#MSG1> ; Move the bad function key text
BR 300$ ; Try again
;
; Here if a function key that we can process was found. Just branch to the
; routine to handle the function key.
;
120$: MOV @R0,R0 ; Get the address of the routine
JMP @R0 ; Jump to the routine
;
; Here to handle the action processing for the item selected
;
200$: MOV FRMBLK(SP),R3 ; Get the frame block
MOV .FRMNU(R3),R0 ; Get the menu dispatch
MOV .FRMLN(R3),R1 ; Get the block length
ASR R1 ; Make it number of entries
MOV ACTION,R2 ; Get the item to find
JSR PC,FNDOFS ; Find the item
TST R0 ; Check for something we didn't
BEQ 300$ ; Write yet
ADD .FRMLN(R3),R0 ; Point to the action routine
MOV R0,-(SP) ; Save on the stack
;
; Point to the input routine if there is one and call it
;
ADD .FRMLN(R3),R0 ; Point to the input routine
TST (R0) ; Have a routine to call
BEQ 210$ ; No, skip this then
MOV @R0,R0 ; Get the address of the routine
JSR PC,@R0 ; Call the routine
;
; Here to call the set routine
;
210$: MOV (SP)+,R0 ; Get the routine address from the
; stack
TST BADINP ; Bad input?
BNE 220$ ; Valid input?
MOV @R0,R0 ; Get the address of the routine
MOV FRMBLK(SP),R1 ; Get the frame block address
BITB #FT.STORE,.FRTYP(R1) ; Store directly and not call action
; routine?
BEQ 215$ ; Call action routine
MOV VALUE,@R0 ; Store the value
BR 220$ ; Continue processing
215$: JSR PC,@R0 ; Call the action routine
220$: CMP RTNFLG(SP),#TRUE ; Must we return after one pass?
BEQ 399$ ; Yes, just return right away
;
; Here to redisplay the menu that we are processing.
;
300$: TST MAIFLG ; Return to the main screen?
BNE 399$ ; Yes, just exit
JMP 1$ ; Yes, redisplay it
399$: RTS PC ; Return to the caller
.SBTTL CHKKEY - Check to see if a function key was pressed
;+
; This routine will determine if a function key was pressed. If it was
; a function key then we will determine if the key is valid at this
; point. It it is not a failure return will be passed back otherwise
; the address from the key table will be passed back to the caller.
;
; Usage:
; MOV #Key.table,R0
; JSR PC,CHKKEY
; (Return)
;
; On return:
; R0/ 0 - If not in the key table
; R0/ Address of routine to jump to if in the table.
;
;--
CHKKEY: CMP #ST.KEY,STATUS ; Was this a function key?
BEQ 10$ ; Yes, find it in the table
5$: CLR R0 ; No, return a zero
RTS PC ; Return to the caller
;
; Here if we have a possible function key. STATUS+2 contains the function
; key code.
;
10$: MOV R0,R1 ; Copy the address
MOV (R0)+,R1 ; Get the table length
MOV R1,-(SP) ; Save for later
MOV STATUS+2,R2 ; Get the key code
JSR PC,FNDOFS ; Find it in the table
TST R0 ; Did we find it in the table?
BNE 20$ ; Branch if we found it
TST (SP)+ ; Remove the length
BR 5$ ; Return a failure
;
; Here if we found the function key in the table. Just add the length of
; the table to the item and return to the caller
;
20$: ADD (SP),R0 ; Point to the routine address
ADD (SP)+,R0 ; . . .
RTS PC ; Return to the caller
.SBTTL SETDYN - Routine to set the dynamic menu option
;++
; This routine will be called after the dynamic option has been read into
; the buffer. This routine will then be called to dispatch to the correct
; dynamic menu option. The routine will expect that DMNUAD will contain
; the address of a menu table and that DMNULN will contain the length of the
; menu table. The routine will store the address of the offset into DMNUOF.
;
; Usage:
; R0/ Address of the menu table
; R1/ Length of the menu table in bytes
; JSR PC,SETDYN
; (Return - Menu packed)
;
;--
.PSECT $CODE$, RO
SETDYN: MOV R1,-(SP) ; Save the length on the stack
BEQ 10$ ; If the length is zero just return
ASR R1 ; Make it the number of entries
MOV MUNPBF,R2 ; Get the dynamic option
JSR PC,FNDOFS ; Find the offset into the table
TST R0 ; Find it?
BEQ 10$ ; No, error
ADD (SP),R0 ; Point to the SET routine
ADD (SP),R0 ; Point to the input routine
ADD (SP)+,R0 ; Point to the DYN routine
MOV @R0,R0 ; Get the address
BEQ 5$ ; Branch if no routine
JSR PC,@R0 ; Call the routine
5$: RTS PC ; Return to the caller
; Here if there was an error unpacking the dynamic menu option
10$: TST (SP)+ ; Remove the information from the stack
RTS PC ; Return to the caller for now
.SBTTL Dynamic menu processing - Make a string bold
;++
; This routine will cause a string to be bolded.
;
; Usage:
; MOV #Number,R0 ; Offset to be bolded
; JSR PC,DYNBLD ; Bold it
;
; Number := 0 for first string, 1 for second
;--
DYNBLD: TST R0 ; Is this the first or second?
BNE 10$ ; Branch if the second
MOV #BVID$L,R0 ; Get the length
MOV #M$BVID,R1 ; Get the address of the text
JSR PC,DYNINS ; Insert the string
MOV #NVID$L,R0 ; Back to normal video
MOV #M$NVID,R1 ; Normal video now
JSR PC,DYNINS ; Insert it
JSR PC,DYNDEL ; Delete the string
BR DYNDEL ; Delete the last string
;
; Bold the second string
;
10$: JSR PC,DYNDEL ; Delete the string
JSR PC,DYNDEL ; Delete the string
MOV #BVID$L,R0 ; Get the length
MOV #M$BVID,R1 ; Get the address of the text
JSR PC,DYNINS ; Insert the string
MOV #NVID$L,R0 ; Back to normal video
MOV #M$NVID,R1 ; Normal video now
BR DYNINS ; Insert it
.SBTTL Dynamic menu processing - Store a character and octal number
;++
; This routine will convert and store the character and the octal number
; that is the character. This routine will use the DYNCHR and the DYNOCT
; routines to do all of the work.
;
; Usage:
; MOV #Character,R0
; JSR PC,DYNCOC
; (Return)
;--
DYNCOC: MOV R0,-(SP) ; Save the character on the stack
JSR PC,DYNCHR ; Store the character in the menu
MOV (SP)+,R0 ; Get the character code back
BR DYNOCT ; Store the octal of the character
.SBTTL Dynamic menu processing - Store a special character
;++
; This routine will convert the octal number to a printable character.
; It will convert control characters to ^<char>, deletes to 'del' and
; spaces to 'sp'.
;
; Usage:
; MOV #Char,R0 ; Get the character code
; JSR PC,DYNCHR
; (Return)
;
; On return:
; - String inserted into the menu
;
;--
.PSECT $PLIT$, RO, D
MSG DEL,<del>
MSG SPC,<spc>
.PSECT $CODE$, RO, I
DYNCHR: CMP R0,#.CHDEL ; Is this a delete?
BNE 10$ ; Branch if not a delete
;
; Here if we are processing a delete
;
MOV #DEL$L,R0 ; Get the length
MOV #M$DEL,R1 ; Get the address
BR 99$ ; Store the text and exit
;
; Here if we have something other than a delete
;
10$: CMP R0,#.CHSPC ; Is this a space?
BGT 30$ ; Branch if just a printable character
BEQ 20$ ; Branch if a space
;
; Here if we have a control character
;
MOVB #'^,IOBUFF ; Store an "^"
ADD #'A-1,R0 ; Convert to a printable character
MOVB R0,IOBUFF+1 ; Store the character
MOV #2,R0 ; Get the length
BR 98$ ; Get the address of the buffer and
; store and exit
;
; Here if we have a space
;
20$: MOV #SPC$L,R0 ; Get the length
MOV #M$SPC,R1 ; And the text
BR 99$ ; Common exit
;
; Here if we have just a printable character
;
30$: MOVB R0,IOBUFF ; Store the character
MOV #1,R0 ; Get the length
98$: MOV #IOBUFF,R1 ; And the buffer address
99$: PJMP DYNINS ; Insert the text
.SBTTL Dynamic menu processing - Store an octal number
;++
; This routine will store an octal number into the dynamic menu.
;
; Usage:
; MOV Number,R0
; JSR PC,DYNOCT
;
;--
DYNOCT: MOV R0,-(SP) ; Save on the stack
JSR PC,ALTBUF ; Set up the alternate routine
MOV (SP)+,R2 ; Get the number back
JSR PC,CHGOCT ; Output the number
BLSCAL TT.OUTPUT ; Dump the buffer
MOV IOBLEN,R0 ; Get the length
MOV #IOBUFF,R1 ; Point to the information
JSR PC,DYNINS ; Insert it
PJMP ALTRST ; Restore the output routine
.SBTTL Dynamic menu processing - Store a decimal number
;++
; This routine will store a decimal number into the dynamic menu.
;
; Usage:
; MOV Number,R0
; JSR PC,DYNDEC
;
;--
DYNDEC: MOV R0,-(SP) ; Save on the stack
JSR PC,ALTBUF ; Set up the alternate routine
MOV (SP)+,R2 ; Get the number back
JSR PC,CHGDEC ; Output the number
BLSCAL TT.OUTPUT ; Dump the buffer
MOV IOBLEN,R0 ; Get the length
MOV #IOBUFF,R1 ; Point to the information
JSR PC,DYNINS ; Insert it
PJMP ALTRST ; Restore the output routine
.SBTTL Dynamic menu processing - Delete underscore string
;++
; This routine will eat an underscore string.
;
; Usage:
; JSR PC,DYNDEL
; (Return)
;
;--
DYNDEL: JSR R1,$SAVE3 ; Save a few registers
MOV #BUFF1,R1 ; Address of the string
MOV BUFF1L,R2 ; Length of the string
10$: CMPB (R1)+,#'_ ; Is this the character?
BEQ 20$ ; Branch if so
SOB R2,10$ ; Loop for all characters
RTS PC ; Not found, just return
;
; Here if we have to just move over the characters
;
20$: MOV R1,R3 ; Copy the address of the start
DEC R3 ; Decrement this
30$: DEC BUFF1L ; Decrement the count
CMPB (R1)+,#'_ ; Is this still the underscore?
BNE 40$ ; No, move the rest of the buffer
SOB R2,30$ ; Loop for all characters
RTS PC ; Just return if nothing left
;
; Here to copy the rest of the string
;
40$: DEC R1 ; Back up the byte
50$: MOVB (R1)+,(R3)+ ; Move the byte
SOB R2,50$ ; Loop for all characters
RTS PC ; Return to the caller
.SBTTL Dynamic menu processing - Find and insert string
;++
; This routine will find and insert the string into the menu buffer.
;
; Usage:
; MOV #Address of table,R0
; MOV #Length of table,R1
; MOV #Item to find and insert string of,R2
; JSR PC,DYNFIS
; (Return)
;
;--
DYNFIS: MOV R1,-(SP) ; Save the length
ASR R1 ; Make it the number of words
JSR PC,FNDOFS ; Find the item
TST R0 ; Find it?
BNE 10$ ; Yes, handle it
TST (SP)+ ; Remove the item from the stack
RTS PC ; Return to the caller
;
; Here if we found the item in the table.
;
10$: ADD (SP)+,R0 ; Point to the address of the counted
; text
MOV (R0),R1 ; Get the address of the string-1
MOVB (R1)+,R0 ; Get the count of characters
BNE DYNINS ; Insert the string
RTS PC ; Return to the caller
.SBTTL Dynamic menu processing - Insert string
;++
; This routine will insert the given string into the menu buffer.
; The first underline string will be replaced.
;
; Usage:
; MOV #Length,R0
; MOV #String,R1
; JSR PC,DYNINS
; (Return)
;--
DYNINS: JSR R1,$SAVE3 ; Save R2 and R3
MOV #BUFF1,R2 ; Point to the buffer
MOV BUFF1L,R3 ; Length of the buffer
;
; First determine where the string starts
;
10$: CMPB (R2)+,#'_ ; Is this the start of the
; string?
BEQ 20$ ; Branch if it is
SOB R3,10$ ; Loop for all of the characters
RTS PC ; Return if none
;
; Here if we have found the first of the underline characters
;
20$: DEC R2 ; Back up the pointer
25$: MOVB (R1)+,(R2)+ ; Move the character
DEC R3 ; Decrement the total characters
BEQ 99$ ; Return if nothing else
DEC R0 ; Decrement the characters
BEQ 30$ ; Branch if we are finished
CMPB (R2),#'_ ; Is this still characters to be replaced?
BEQ 25$ ; Yes, continue to loop
RTS PC ; Return if finished replacing
;
; Here to determine if the two strings are exactly the same length
; and if not just fill with spaces.
;
30$: CMPB (R2),#'_ ; Is this still character to be eaten?
BNE 99$ ; No, just return
MOV R2,R1 ; Get a copy of the pointer
40$: CMPB (R2)+,#'_ ; Underscore?
BNE 45$ ; No, copy this and the rest
DEC BUFF1L ; Yes, decrement the length
SOB R3,40$ ; And loop until end of string or underscores
RTS PC ; Underscores were at end, just return
45$: DEC R2 ; Back up so we get this character
50$: MOVB (R2)+,(R1)+ ; Remove the underscore
SOB R3,50$ ; Loop for the remainder of the record
99$: RTS PC ; Return to the caller
.SBTTL Support routines -- GETINP - Get input for SET commands
;++
; THis routine will get input from the terminal for the various set commands.
; The input can be either a character or a string of digits. This routine
; is called with a numeric/character flag, prompt string, radix if numeric
; and a validation routine.
;
; Usage:
; BLSCAL GETINP,<#Character.flag,#Prompt,#Radix,#Checkout.rtn>
;
; On return:
; R1/ Value input
;--
BLSRTN GETINP,5,<CHRFLG,PROMPT,RADIX,CHKOUT>
JSR PC,SETESC ; Allow escape sequences
10$: MOV #IOBUFF,R0 ; Point to the buffer
CLR (R0)+ ; Clear some of it
CLR (R0) ; . . .
TST -(R0) ; Reset to start of buffer
BLSCAL TT.TEXT,#M$PPRM,+ ; Position for the prompt
MOV PROMPT+..STKO+2(SP),R0 ; Get the prompt
BLSCAL TT.TEXT,R0,+ ; Output the prompt
BLSCAL TT.OUTPUT,,- ; Output the text and reset the stack
TST CHRFLG+2(SP) ; Character input?
.IF EQ TRUE
BEQ 50$ ; Yes, branch
.IFF
BNE 50$ ; . . .
.ENDC
;
; Here if we are inputting a character string
;
DIR$ #READ,IOERR ; Get input
MOV #IOBUFF,R1 ; Get the buffer location
20$: MOVB (R1)+,R0 ; Get a character
BEQ 30$ ; Branch if done
CMPB #.CHESC,R0 ; Is this an escape?
BNE 20$ ; No, continue
CLRB -(R1) ; Clear the byte
TSTB (R1)+ ; Point back to the end
; Here if we are done reading the character string
30$: DEC R1 ; Since we passed the last input
; character back up one so we
; can check length
SUB #IOBUFF+3,R1 ; Subtract off the buffer start address
; and subtract three(maximum
; number of digits)
BGT 60$ ; If it is non-negative the input was
; too long so branch to error routine
MOV #IOBUFF,R2 ; Get the I/O buffer address
MOV RADIX+2(SP),R5 ; Get the radix
JSR PC,BASCHK ; Check for illegal characters
BCS 60$ ; If bad characters the jump to bad
MOV #IOBUFF,R2 ; Get the I/O buffer address
JSR PC,ASCBIN ; Convert the ascii to binary
MOV R1,R0 ; Get the result
;
; Now to validity check the input from the user
;
MOV CHKOUT+2(SP),R1 ; Get the routine to call
BEQ 40$ ; Branch if there is no routine
JSR PC,@R1 ; Call the routine
BCS 70$ ; Branch if there was an error
;
; Here if there was no error, just return to the caller
;
40$: RTS PC ; Return to sender
50$: DIR$ #READ1,IOERR ; Get input (read single character,
; pass all)
MOVB IOBUFF,R0 ; Get the character
BR 40$ ; Jump to return routine
60$: MOV #M$BADI,R1 ; Get the error text
;
; Here to issue an error message
;
70$: BLSCAL TT.TEXT,#M$PPRM,+ ; Position for the prompt
BLSCAL TT.TEXT,R1,+ ; Output the error message
BLSCAL TT.OUTPUT,,- ; Output remaining characters.
CALL WTRES ; Wait for resume key
BR 10$ ; Reprompt for input
.SBTTL Support routines -- Validity checks for input
;++
; The following routines are validity checks for the GETINP routine.
; This routines are specified as the argument (CHKOUT) to the routine.
;
; Usage:
; JSR PC,CHKxxx
; (Return)
;
; On return:
; If carry set ==> R0 contains the value
; If carry clear ==> R1 contains the address of the error text
;
;--
.PSECT $TEXT$, RO, D
MSG QERR,<Value must be 41 to 76 or 140 to 176>
.PSECT $CODE$, RO, I
CHKQUO: CMP R0,#41 ; Compare against the lower bound
BLT 10$ ; Branch if less than that
CMP R0,#76 ; Compare against the first upper
BLE 20$ ; Value ok, return to caller
CMP R0,#140 ; Compare against the other lower bound
BLT 10$ ; Bad value
CMP R0,#176 ; And the other upper value
BLE 20$ ; Value ok
;
; Here if the value is not valid
;
10$: MOV #M$QERR,R1 ; Get the error text
SEC ; Set the carry
RTS PC ; Return to the caller
;
; Here if the value is valid
;
20$: CLC ; Clear the carry
RTS PC ; Return to the caller
.SBTTL CHKxxx - CHKCTL - Check to see if a control character
;++
; This routine will determine if the value is a control character. If the
; value is not then an error return will be given (carry bit set and the
; address of the error text in R1).
;--
.PSECT $TEXT$, RO, D
MSG CERR,<Value must be 0 to 37>
.PSECT $CODE$, RO, I
CHKCTL: CMP R0,#37 ; Is this a control character?
BGT 10$ ; Invalid
CLC ; Clear the carry
RTS PC ; Return to the caller
10$: MOV #M$CERR,R1 ; Get the error message
SEC ; Flag it is an error
RTS PC ; Return to the caller
.SBTTL CHKxxx - CHKTIM - Check the timeout value
;++
; This routine will check the timeout value that the user has given.
; If the value is not within the range of 1 to 94 an error return will
; be given by this routine (carry bit set and error text address in R1).
;--
.PSECT $TEXT$, RO, D
MSG TERR,<Timeout must be between 1 and 94>
.PSECT $CODE$, RO, I
CHKTIM: CMP R0,#1 ; Is this within the range?
BLT 10$ ; of 1 to
CMP R0,#94. ; 94?
BGT 10$ ; No, error
CLC ; Clear the carry
RTS PC ; Return to the caller
;
; Here with an illegal value
;
10$: MOV #M$TERR,R1 ; Get the error text
SEC ; Set the carry
RTS PC ; Return to the caller
.SBTTL CHKxxx - CHKPKL - Check for a valid packet length
;++
; This routine will check to determine if there is a valid packet length
; in R0. If the packet length is zero it will return with the carry bit
; set and the address of the error text in R1.
;--
.PSECT $TEXT$, RO, D
MSG PERR,<Packet length must be from 10 to 94 (dec)>
.PSECT $CODE$, RO, I
CHKPKL: CMP R0,#10. ; Is this within the range of
BLT 10$ ; 10 to
CMP R0,#94. ; 94?
BGT 10$ ; Branch if not
CLC ; Clear the carry
RTS PC ; Return to the caller
;
; Here if we have an invalid error, return the address of the error
; text.
;
10$: MOV #M$PERR,R1 ; Get the error text
SEC ; Set the carry
RTS PC ; Return to the caller
.SBTTL CHKxxx - CHKPDC - Check padding character
;++
; This routine will validate the padding character to determine if it is
; a valid value. If it is not, then it will set the carry bit and return
; the text of the error message. Valid values are 0 to 37 or 177.
;--
.PSECT $TEXT$, RO, D
MSG PCER,<Illegal pad character value, must be 0 to 37 or 177>
.PSECT $CODE$, RO, I
CHKPDC: CMP R0,.CHDEL ; Is this the value
BEQ 10$ ; If so, just return
CMP R0,#37 ; Is this a control character?
BGT 20$ ; Branch if illegal
10$: CLC ; Clear the carry
RTS PC ; Return to the caller
;
; Here to return the failure
;
20$: MOV #M$PCER,R1 ; Get the error text
SEC ; Set the carry
RTS PC ; Return to the caller
.SBTTL DOSPWN - Spawn a task
;++
; This routine will spawn a task and return to the caller when the task
; has completed. It will wait until the task is finished.
;
; Usage:
; R0 - Address of the task name
; JSR PC,DOSPWN
; (Return)
;
;--
.PSECT $TEXT$, RO, D
MSG SPWN,<Error spawning task>
.PSECT $CODE$, RO, I
DOSPWN: SPWN$S R0,,,,,#SPNEFN ; Spawn the task
CMP $DSW,#IS.SUC ; Success?
BEQ 10$ ; Branch if so
BLSCAL BL$MOV,<#SPWN$L,#M$SPWN,#MSG1>
RTS PC ; Return to the caller
;
; Here to return to the caller
;
10$: STSE$S #SPNEFN, ; Wait until it finishes
RTS PC ; Return to the caller
.SBTTL Support routines -- RSTMSG - Reset MSG1 and MSG2 buffers
;++
; This routine will reset the MSG1 and MSG2 buffers to spaces. This routine is
; called after every time we process a menu. It will reset the buffers to
; spaces after, so that error messages can be displayed on the screen after the
; user attempts to do something.
;
; Usage:
;
; JSR PC,RSTMSG
; (Return)
;
;--
.PSECT $CODE$, RO
RSTMSG: MOV #MSG1,R0 ; Get the first pointer
MOV #MSG2,R1 ; Point to the other
MOV #40.,R2 ; Number of times to loop
10$: MOV #" ,(R0)+ ; Store a two spaces
MOV #" ,(R1)+ ; And another two
SOB R2,10$ ; Loop until done
RTS PC ; Return to the caller
.SBTTL MERROR - Handle a menu error
;++
; This routine will handle a menu error. It will call the P/OS routine
; FATLER to do most of the work, but this routine will construct the text
; that is to be output to the user.
;
; Usage:
; MOV #Text,R0 ; Starting text to output
; JSR PC,MERROR ; Call the routine
; (No return)
;
;--
.PSECT $TEXT$, RO, D
MSG MERT,< - Status = >
MSG MER1,<, >
.PSECT $CODE$, RO, I
MERROR: JSR R1,$SAVE5 ; Save registers for debugging
MOV R0,R5 ; Save over the call
;
; Build the message
;
JSR PC,ALTBUF ; Alternate output point
BLSCAL TT.TEXT,<R5>,+ ; Output the text
BLSCAL TT.TEXT,<#M$MERT>,+ ; The rest of the text
BLSCAL TT.NUMB,<STATUS>,+ ; Output the first number
BLSCAL TT.TEXT,<#M$MER1>,+ ; More text to output
BLSCAL TT.NUMB,<STATUS+2>,+ ; Output the second word
BLSCAL TT.OUTPUT,,- ; Output the text
;
; Output the message
;
MOV #A$FATL,R5 ; Get the argument block
JSR PC,FATLER ; Issue the error message
HALT ; Should not get here
.SBTTL End of KERMNU
.END ; End of KERMNU